PROGRAM PLATON
C ********************************************************************
C * THIS PROGRAM MAY BE USED FREE OF CHARGE ONLY FOR USE WITHIN THE  *
C * ACADEMIC COMMUNITY AND NOT FOR PROFIT WITHOUT EXPLICIT PERMISSION*
C * IT IS TO BE UNDERSTOOD THAT THE AUTHOR OR HIS UNIVERSITY CANNOT  *
C * BE HELD RESPONSIBLE FOR ANY PROBLEMS CAUSED BY ERRORS IN THE CODE*
C ********************************************************************
C *                                                                  *
C *                 *******************************                  *
C *                 *    P L A T O N - 2 0 1 4    *                  *
C *                 *******************************                  *
C *                                                                  *
C *                     (C) 1980-2014  A.L.SPEK                      *
C *                                                                  *
C *                         UTRECHT UNIVERSITY                       *
C *              BIJVOET CENTER FOR BIOMOLECULAR RESEARCH            *
C *                 SECTIE KRISTAL- EN STRUCTUURCHEMIE               *
C *                    PADUALAAN 8, 3584 CH UTRECHT,                 *
C *                          THE NETHERLANDS                         *
C *                                                                  *
C *                            a.l.spek@uu.nl                        *
C *                                                                  *
C *   PRELIMINARY VERSION (CDC)  .............         1980          *
C *   MICROVAX-II IMPLEMENTATION .............         1986          *
C *   CONVEX/UNIX       ,,       .............         1989          *
C *   SILICON-GRAPHICS  ,,       .............         1990          *
C *   DEC/ULTRIX        ,,       .............         1991          *
C *   LINUX             ,,       .............         1993          *
C *   DEC/OSF/1         ,,       .............         1993          *
C *   SUN-SOLARIS       ,,       .............         1998          *
C *   MAC OSX           ,,       .............         2009          *
C *                                                                  *
C ********************************************************************
C * THE PROGRAM -PLATON- HAS BEEN DESIGNED FOR AUTOMATED GENERATION  *
C * AND ANALYSIS OF STEREO-CHEMICAL AND MOLECULAR GEOMETRY DATA,     *
C * STARTING FROM A LIST OF ATOMIC COORDINATES.  IN THE CASE OF      *
C * FRACTIONAL COORDINATES, CELL DIMENSIONS AND SYMMETRY SHOULD BE   *
C * SPECIFIED AS WELL. IN GENERAL ONLY GLOBAL INSTRUCTIONS WILL BE   *
C * NECESSARY TO OBTAIN THE REQUIRED DATA OF THE MOLECULAR GEOMETRY  *
C * FROM A STANDARD (FREE FORMATTED) INPUTFILE.                      *
C * IN  THE -INTRA- MODE  THE PROGRAM GENERATES, ON THE BASIS OF AN  *
C * INTERNAL COVALENT-RADII LIST, ALL BOND DISTANCES, BOND ANGLES,   *
C * TORSION ANGLES, LEAST-SQUARES PLANES, RINGS+ PUCKERING ANALYSIS. *
C * IN  THE -INTER- MODE  A LIST IS GENERATED OF ALL SHORT VAN DER   *
C * WAALS CONTACTS. HYDROGEN BONDS ARE EXPLICITLY LISTED AND ANALYZED*
C * IN  THE -COORDN- MODE  A  LIST  IS  GENERATED OF THE BONDS AND   *
C * ANGLES WITHIN A SPECIFIED RADIUS FROM A GIVEN ATOM.              *
C * IN ADDITION, THE THERMAL MOTION IS ANALYSED WHEN ANISOTROPIC     *
C * THERMAL PARAMETERS HAVE BEEN PROVIDED.                           *
C * ALL CALCULATED  VALUES ARE ACCOMPAGNIED BY STANDARD DEVIATIONS   *
C * CALCULATED  FROM  THE  STANDARD  DEVIATIONS IN THE PARAMETERS,   *
C * WHEN SUPPLIED.                                                   *
C * IN  ADDITION THE PROGRAM GENERATES ON UNIT LU2 A LIST OF DATA    *
C * THAT MAY BE LISTED IN A NEAT FORM WITH THE PROGRAM OMEGA OR USED *
C * OTHERWISE (AS AN ALTERNATIVE FOR THE BUILD-IN TABLE FEATURE).    *
C * OPTIONALLY GRAPHICS FILES SHOWING THE STRUCTURE AS PROJECTIONS   *
C * ON THE VARIOUS LEAST-SQUARES PLANES, NEWMAN PROJECTIONS ETC.     *
C * AN EASY TO USE THERMAL MOTION ELLIPSOID PLOT OPTION IS AVAILABLE.*
C *                                                                  *
C * P O T E N T I A L  M A C H I N E  D E P E N D E N C I E S        *
C * - - - - - - - - -  - - - - - - -  - - - - - - - - - - - -        *
C *                                                                  *
C * - 32 BIT-WORDS MINIMUM ASSUMED (IN VIEW OF PACKING)              *
C *                                                                  *
C ********************************************************************
C *                                                                  *
C *                L I M I T A T I O N S  (LOWER BOUND)              *
C *                ---------------------                        (MIN)*
C *                                                                  *
C * THE MAXIMUM NUMBER OF ATOMS IN THE UNIQUE MOLECULE = NP1     250 *
C * MAXIMUM NUMBER OF LEAST SQUARES PLANES             = NP2      50 *
C * MAXIMUM NUMBER OF CONNECTIONS IN ARRAY CON         = NP4       8 *
C * MAXIMUM BOND OVERFLOW                              = NP6      50 *
C * MAXIMUM NUMBER OF ATOMS IN LEAST SQUARES PLANE     = NP7      50 *
C * MAXIMUM NUMBER OF RESIDUES                         =  63         *
C * MAXIMUM NUMBER OF MOLECULES IN MOLECULE LIST       = NP11-1   64 *
C * MAXIMUM NUMBER WITHIN AN ATOM LABEL                = 999         *
C * DEFAULT NUMBER OF DIFFERENT ATOM KINDS             = NP10     16 *
C *                                                                  *
C * * WARNING * ONLY NP1 MAY BE MODIFIED SAFELY IN RANGE 250 - 5000  *
C * NVD SHOULD BE AS LARGE AS POSSIBLE                               *
C ********************************************************************
C *                                                                  *
C *              U N I X  - I M P L E M E N T A T I O N              *
C *              **************************************              *
C *                                                                  *
C * Compile/Link:  gfortran -o platon platon.f xdrvr.c -lX11         *
C * Run:           platon sucrose.spf                                *
C *                                                                  *
C ********************************************************************
C *  S U M M A R Y   O F   P L A T O N   I N S T R U C T I O N S     *
C *---------------------------------------------------------------   *
C *  KEYWORD  I  SUB-KEYWORD(S) I           COMMENT                  *
C *-----------I-----------------I---------------------------------   *
C *ENTRY      I (nr)/(refcode)  |DIR AND POSITION FDAT-FILE (ENTRY)  *
C *-----------I-----------------I---------------------------------   *
C *NOMOVE     I (OFF)           INO MOVE-AROUND OF INPUT ATOMS       *
C *INORG      I                 IINORGANIC MODE                      *
C *ORGA       I                 IORGANIC   MODE                      *
C *ROUND      I ON/OFF/(range)  IROUND OPTION ON/OFF (DEF = ON, 1)   *
C *PARENTHESESI ON/OFF          ILABEL PARENTHESES ON/OFF (DEF = ON) *
C *INCLUDE    I EL1 EL2  (Me)   IINCLUDE SPECIFIED ELEMENTS ONLY     *
C *EXCLUDE    I EL1 EL2  (Me)   IEXCLUDE SPECIFIED ELEMENTS          *
C *SET VDWR   I EL1 rad EL2 rad ISET NON-DEFAULT VDWAALS RADII       *
C *COLOR TYPE I EL1 col1 etc.   ICHANGE DEFAULT COLORS               *
C *-----------I-----------------I------------------------------------*
C *DOAC       IEL1 EL2 ....     IDON./ACCEPT. ATOMS(DEF:N,O,CL,S,F,BR*
C *-----------I-----------------I------------------------------------*
C *HBOND      I(NORM) P1 P2 P3  IH-BOND PARAMETERS (DEF 0.5,-.12,100)*
C *-----------I-----------------I------------------------------------*
C *LINE       IAT1 AT2          IEXPLICIT LINE SPECIFICATION         *
C *-----------I-----------------I------------------------------------*
C *LSPL       IAT1 AT2..DIST AT3IEXPLICIT L.S.-PLANE SPECIFICATION   *
C *-----------I-----------------I------------------------------------*
C *RING       IAT1 AT2 ....     IEXPLICIT RING SPECIFICATION (MAX 30)*
C *-----------I-----------------I------------------------------------*
C *FIT        IA11 A21 A1N A2N..IFIT MOL1 (A11,A12,....,A1N) TO      *
C *           I                 I    MOL2 (A21,A22,....,A2N)         *
C *FIT        IA1A  A1B         ISIMILARLY NUMBERED RESIDUE FIT      *
C *-----------I-----------------I------------------------------------*
C *SAVE       I                 IUSED IN CONJ. WITH ENDS ON TAPE1    *
C *-----------I-----------------I------------------------------------*
C *ASYM       I(AVF)(ZONEX)     IASYM                                *
C *           I(LIST 0/1/2/3)   I                                    *
C *           I(THM thm)(VIEW)  I                                    *
C *           I(EXPECT) (EXPAND)I                                    *
C *           I(VIEW/VALID)     I                                    *
C *-----------I-----------------I------------------------------------*
C *LEPAGE     I(MANG) (MaxDot)  IDO LEPAGE ANALYSIS (METRIC ANGLE)   *
C *           |    (TwoAxCrit)  I                                    *
C *-----------I-----------------I------------------------------------*
C *EXPT       I                 IGIVE # OF EXPECTED REFL FOR RESOLN  *
C *-----------I-----------------I------------------------------------*
C *CALC ADDSYMI (EL/EQUAL/SAVE) ICHECK FOR HIGHER SYMMETRY           *
C *           I (ang d1 d2)     ICHANGE DEFAULT CRITERIA             *
C *           I (SHELX) (NOSF)  IPREPARE NEW FILE FOR SUSPECT ENTRY  *
C *           I (PLOT)          IPLOT NEW AVERAGED STRUCTURE         *
C *-----------I-----------------I------------------------------------*
C *CALC NONSYMI (symmol-tol)    ILOOK FOR NON-CRYST. SYMMETRY        *
C *-----------I-----------------I------------------------------------*
C *CALC NEWSYMI (ang-metric)    ICHECK FOR (HIGHER) SPACE GROUP SYMM *
C *-----------I-----------------I------------------------------------*
C *CALC INTRA I        -        ICALCULATE INTRA MOLECULAR GEO-      *
C *           I                 I METRY USING STANDARD ATOM RADII    *
C *           I                 I D(A-B).LE.R(A)+R(B)+TOLA( =0.4)    *
C *           IEL1 P1 EL2 P2 .. IUSE SPECIFIED ELEMENTAL RADII       *
C *           ITOLA P1          IUSE SPECIFIED TOLERANCE VALUE       *
C *           ITOLEA P1         IADDITIONAL EARTH-ALK. TOLERANCE     *
C *           ITOLM P1          IADDITIONAL TOLERANCE FOR METAL-METAL*
C *           IEWLSPL           IESD-WEIGHT LS-PLANES                *
C *           IUWLSPL           IUNIT-WEIGHT LS-PLANES               *
C *           IAWLSPL           IATOMIC-WEIGHT WEIGHTED LS-PLANES    *
C *           INOTMA            IDO NOT ANALYSE THERMAL MOTION       *
C *           INOBOND           IDO NOT PRINT BOND DISTANCES         *
C *           INOANG            IDO NOT PRINT BOND ANGLES            *
C *           INOTOR            IDO NOT PRINT TORSION ANGLES         *
C *           INOLSP            IDO NOT PRINT L.S-PLANES             *
C *           INORING           IDO NOT SEARCH FOR RINGS             *
C *           INOSTD            IDO NOT CALCULATE ST.DEV. IN PAR.    *
C *           INOMOVE           IDO NOT MOVE PRIMARY ATOMS           *
C *           INOSYMM           IDO NOT APPLY ANY SYMMETRY           *
C *           INOBPA            INO CALCULATION OF BOND/PLANE ANGLES *
C *           ITOLP P1          IMAX OUT OF PLANE DEV. FOR LSP(.1)   *
C *           IMAXDEV           IMAX LIST DIST FROM PLANE (Def 1.5)  *
C *           IMAXRING P1       IMAXIMUM RING-SIZE (default 24)      *
C *-----------I-----------------I------------------------------------*
C *CALC GEOM  I(OMEGA/          IBONDS,ANGLE AND TORSION ANGLES (DEF)*
C *           I SPF/            I(AND GENERATE SPECIFIED FILE)       *
C *           I SHELXL/CSD/     I                                    *
C *           I PDB)            I                                    *
C *           I (NOMOVE)        I DO NOT MOVE INPUT ATOMS            *
C *           I (EXPAND)        I OUTPUT SYMMETRY EXPANDED MOLECULES *
C *           I (BOND) (ANGLE)  I                                    *
C *           I (TORSION)       I                                    *
C *-----------I-----------------I------------------------------------*
C *CALC TMA   I (RMAX)          ITHERMAL MOTION ANALYSIS             *
C *           I (HINCL)         I   INCLUDE ANISOTROPIC H-ATOMS      *
C *           I                 I         (def Rmax=0.25)            *
C *           I (Atmin)         I         (def Min numb at=6)        *
C *           I (Cartesian)     ILIST CARTESIAN UIJ AS WELL          *
C *-----------I-----------------I------------------------------------*
C *CALC INTER I        -        ICALCULATE INTERMOLECULAR GEOMETRY   *
C *           I(NOMOVE)         I WITH VAN DER WAALS RADII + TOLR=0.2*
C *           ITOLR P1          IUSE SPECIFIED TOLERANCE VALUE       *
C *           IEL1 P1 EL2 P2 .. I MODIFY LISTED CONTACT RADII        *
C *-----------I-----------------I------------------------------------*
C *CALC HBONDSI P1 P2 P3        IHBOND - ANALYSIS                    *
C *           I (NONA)          I No Network Analysis                *
C *           I (ICHX)          I INCLUDE C-H...X BONDS              *
C *           I (DISORDER)      I INCLUDE MINOR DISORDER             *
C *-----------I-----------------I------------------------------------*
C *CALC COORDNI (P1)            ICOORDN RADII NON C,H-ATOMS(DEF=3.6) *
C *           IEL1 P1 EL2 P2 .. ICALCULATE COORDN SPHERE GEOMETRY    *
C *           I                 I FOR THE SPECIFIED ELEMENTS ONLY.   *
C *           I (NOANG)         I SUPPRESS ANGLE CALCULATION         *
C *           I (FIVE (TBA))    I ANALYSE FIVE COORDINATION          *
C *           I (SPF)           I(OUTPUT ON SPECIFIED FILE TYPE)     *
C *-----------I-----------------I------------------------------------*
C *CALC COORDNI atom-name p1    I COORDINATION SPHERE FOR SPEC. ATOM *
C *           I (NOANG)         I                                    *
C *-----------I-----------------I------------------------------------*
C *CALC METAL I (p1)            IMETAL..METAL DISTANCES (DEF. 5 Ang) *
C *-----------I-----------------I------------------------------------*
C *CALC RDF   I (p1)            I CALC RADIAL DISTRIBUTION FUNCTION  *
C *-----------I-----------------I------------------------------------*
C *CALC DIST  I EL (p1)         I EL-EL DISTANCE SCAN                *
C *-----------I-----------------I------------------------------------*
C *CALC SOLV  I (PROBE rad)     I DETERMINE SOLVENT ACCESSIBLE AREAS *
C *           I (PSTEP n/GRID x)I GRID = rad / n or as given         *
C *           I (LIST/LISTxyz)  I LIST MAP ON LISTING FILE           *
C *           I (SAR)           I WRITE FILE WITH SOLVENT GRID POINTS*
C *CALC VOID  I (PROBE rad)     I SEARCH FOR VOIDS IN THE STRUCTURE  *
C *           I (PSTEP n)       I GRID = rad / n                     *
C *           I (LIST/LISTxyz)  I LIST MAP ON DISPLAY                *
C *-----------I-----------------I------------------------------------*
C *CALC SQUEEZE        (FCAL)   I (HANDLE DISORDERED SOLVENT REGION) *
C *           I (PROBE radius)  I                                    *
C *           I (PSTEP n)       I                                    *
C *           : (CYCLE n)       I                                    *
C *-----------I-----------------I------------------------------------*
C *CALC FCF   I (GENERATE)      I CALCULATE STRUCTURE FACTORS        *
C *-----------I-----------------I------------------------------------*
C *ABSG       I mu,(ng1,ng2,ng3)I GAUSSIAN INTEGRATION ABS CORRECTION*
C *           I (NOCHECK)(LIST) I                                    *
C *ABST       I mu              I MEULENAAR & TOMPA ABS. CORR.       *
C *           I (NOCHECK)(LIST) I                                    *
C *ABSP       I                 I PSI-SCAN ABS CORRECTION            *
C *           I (NOCHECK)(LIST) I                                    *
C *ABSS       I mu*r            I SPHERICAL ABSORPTION CORRECTION    *
C *           I (NOCHECK)(LIST) I                                    *
C *-----------I-----------------I------------------------------------*
C *MULABS     I mu radius       I MULTISCAN ABSORPTION CORRECTION    *
C *           I (NOCHECK)(LIST) I                                    *
C *-----------I-----------------I------------------------------------*
C *CALC       I (ALL)           IDEFAULT CALCULATION OF ALL GEOMETRY *
C *-----------I-----------------I------------------------------------*
C *LIST/INFO  I CELL            I LIST CELL DIMENSIONS ON DISPLAY    *
C *LIST/INFO  I SYMM            I LIST CURRENT SYMMETRY              *
C *LIST/INFO  I ATOM (type)(res)I LIST CURRENT ATOM-TABLE (SELECT)   *
C *LIST/INFO  I BOND (type)(res)I LIST CURRENT BOND-TABLE (SELECT)   *
C *LIST/INFO  I UIJ             I LIST UIJ                           *
C *LIST/INFO  I RADII           I LIST COVALENT & V.D.WAALS RADII    *
C *LIST/INFO  I IPR (IVL1(IVL2))I LIST INTEGER PARAMETER VALUE       *
C *LIST/INFO  I PAR (IVL1(IVL2))I LIST REAL PARAMETER VALUE          *
C *LIST/INFO  I FLAG            I LIST INTERNAL FLAG VALUES          *
C *-----------I-----------------I------------------------------------*
C *DIST       I AT1 AT2         IINTERACTIVE DISTANCE CALCULATION    *
C *ANGL       I AT1 AT2 AT3(AT4)I    ,,      ANGLE       ,,          *
C *TORS       I AT1 AT2 AT3 AT4 I    ,,      TORSION     ,,          *
C *LSPL       I AT1 AT2 .....   I    ,,      LEAST-SQUARES PL ,,     *
C *LSPL       I AT1 AT2 .. WITH IINTERACTIVE ANGLE BETWEEN PLANES    *
C *           I AT11 AT12 ..    I                                    *
C *           I (DIST AT3 ..)   I            (TO PLANE DISTANCE)     *
C *FIT        IA11 A21 A1N A2N..IFIT MOL1 (A11,A12,....,A1N) TO      *
C *           I                 I    MOL2 (A21,A22,....,A2N)         *
C *GEOM       I AT1             I    ,,      BONDS,ANGLES FOR AT1    *
C *-----------I-----------------I------------------------------------*
C *PLOT       I LSPL            IPLOT SPECIFIED PLANE(S)             *
C *           I PLAN            I     AUTOM.    PLANE(S)             *
C *           I RING            I                RING(S)             *
C *           I RESD            I             RESIDUE(S)             *
C *           I ALONG           IPLOT WITH PLANE NORMAL UPWARDS(Y)   *
C *           I PERP            IPLOT DOWN PLANE NORMAL              *
C *           I (DISPLAY/META)  IPLOT MEDIUM (DEFAULT DISPLAY)       *
C *-----------I-----------------I------------------------------------*
C *PLOT       I NEWMAN (AT1 AT2)INEWMAN PLOT(S) (FOR SPECIFIED BOND) *
C *           I (DISPLAY/META)  IPLOT MEDIUM (DEFAULT DISPLAY)       *
C *           I (COLOR)         I                                    *
C *-----------I-----------------I------------------------------------*
C *PLOT       I ADP             IPLOT ANISOTR. DISPLACEMENT ELLIPSOID*
C *           I (DISPLAY/META)  I     PLOT MEDIUM (DEFAULT DISPLAY)  *
C *           I (COLOR)         ICOLOR O,N AND HALOGENS              *
C *           I (OCTANT/HETERO/ IELLIPSOID TYPE                      *
C *           I  ENVELOPE)      I                                    *
C *           I (LABELS/NOLABEL)ILABEL PLOT                          *
C *           I (HATOM/NOHATOM) IH-ATOM (IN/EX)CLUDE                 *
C *           I (PARENT/NOPAREN)ILabels with or without parentheses  *
C *           I (MARGIN marg)   IOVERLAP MARGIN                      *
C *           I (RESIDUE resnr) IResidue number to be plotted (0=all)*
C *-----------I-----------------I------------------------------------*
C *PLOT       I POLY            IPOLYEDER PLOT (IMPLEM IN PROGRESS)  *
C *-----------I-----------------I------------------------------------*
C *RADII BONDSI (LIST/TO MET/   IRESET (LIST)DEFAULT BOND PARAMETERS *
C *           I TO H/NORMAL/ALL)IFOR ADP PLOT                        *
C *           I(bond-type (rad))I -5 <= bondtype <= 5 and radius(Ang)*
C *-----------I-----------------I------------------------------------*
C *ELLIPSOID  |(C/H/Other)      IPLOT TYPES OF ELLIPSOID SHAPES      *
C *           I type (lines)    Itype 0/1                            *
C *-----------I-----------------I------------------------------------*
C *JOIN       I At1 At2 ((L)DASH) ADD (DASHED) BOND FOR PLOTTING     *
C *DETACH     I At1 At2         IDELETE BOND FROM PLOT LIST          *
C *DEFINE     I At1 TO At2 ..ATnIADD BOND TO CG                      *
C *           I (DASH)          I (Optionally dashed)                *
C *-----------I-----------------I------------------------------------*
C *BOX        I (ON/OFF)        IOUTLINE BOX WITH TEXT ON/OFF        *
C *           I (RATIO ratio)   I HOR/VERT RATIO ADP PLOT            *
C *-----------I-----------------I------------------------------------*
C *VIEW       I                 IDEFAULT 0,0,0                       *
C *VIEW       I (UNIT) (XR P1)  IROTATE ABOUT X,Y,Z BY P1,P2,P3 ETC. *
C *VIEW       I MIN             ICALCULATE MINIMUM OVERLAP ORTEP     *
C *VIEW       I INVERT          IINVERT VIEW-MATRIX                  *
C *-----------I-----------------I------------------------------------*
C *HELP       IMANUAL  (PRINT)  IGIVES (ON LINE/PRINTED) MANUAL      *
C *           ISPGR             ILISTS KNOWN SPACE GROUPS            *
C *-----------I-----------------I------------------------------------*
C *END        I                 INORMAL END OF PROGRAM               *
C *STOP/QUIT  I                 IFORCED END OF PROGRAM               *
C *EXIT       I                 IFORCED END OF PROGRAM               *
C *-----------I-----------------I------------------------------------*
C *MENU       I(ON/OFF)         IMOUSE/MENU ON/OFF                   *
C *-----------I-----------------I------------------------------------*
C *SET        IPAR/IPR nr val   ISET PARAMETERS                      *
C *SET        IPROB (10<-->90)  ISET PROBABILITY LEVEL (DEF=50)      *
C *SET        IPRINTER LEVEL levISET PRINT LEVEL                     *
C *SET        ILABEL SIZE (size)ISET SIZE OF LABELS                  *
C *SET        IWINDOW fraction  IMANIPULATE X-WINDOW-size            *
C *-----------I-----------------I------------------------------------*
C *TABLE      I(SU/AC/JA/IC)    IGENERATE PUBLICATION/SUPPL.MAT.TABL.*
C *           I(NOHATOM)        I                                    *
C *           I(NORESIDUE)      I DO-NOT SPLIT IN RESIDUES           *
C *TABLE      I(CIF/CSD) (LOCAL)I GENERATE CIF-FILE FOR ACC-PUBL.    *
C *-----------I-----------------I------------------------------------*
C *CONTOUR    I                 ICONTOUR PLOTS (IMPL. IN PROGRESS)   *
C *           I(FO/DIFF/SQUEEZE)ITYPE OF MAP (DEFAULT FO)            *
C ********************************************************************
C *                                                                  *
C *    S T A N D A R D  I N P U T  O N  F I L E  <U N I T 1>         *
C * --------------------------------------------------------------   *
C *                                                                  *
C *   TITL  <  TEXT >                                                *
C *   CELL  <LAMBDA, A, B, C, ALPHA, BETA, GAMMA>                    *
C *   CESD  <ST.DEV. A, B, C, ALPHA, BETA, GAMMA>                    *
C *   SPGR  <SPACE GROUP NAME>                                       *
C *   ATOM  <ATOM LABEL, X, Y, Z, POP, SIG(X),SIG(Y),SIG(Z),SIG(POP)>*
C *   UIJ   <ATOM LABEL, U11, U22, U33, U23, U13, U12>               *
C *   SUIJ  <ATOM LABEL, S(U11),S(U22),S(U33),S(U23),S(U13),S(U12)>  *
C *         OR FOR ISOTROPIC TEMPERATURE FACTOR                      *
C *   U     <ATOM LABEL, U, S(U)                                     *
C *                ETC. FOR NEXT ATOMS                               *
C *                                                                  *
C *                    E X A M P L E                                 *
C *                    -------------                                 *
C *                                                                  *
C *   TITL NICKEL COMPOUND C2/C                                      *
C *   CELL 0.71073 11.12 7.564 18.93 90 131.1 90                     *
C *   CESD .01 .005 .01 0 .1 0                                       *
C *   SPGR C2/C                                                      *
C *   ATOM NI  .123 .544 -.176 1 .001 .002 .001 0.0                  *
C *   UIJ  NI  .011 .013 .025 -.011 .004 .009                        *
C *   SUIJ NI  .001 .001 .002 .002 .002 .001                         *
C *   ATOM C1  .345 .675 -.334 1 .010 .009 .005 0.0                  *
C *   U    C1  0.04 .01                                              *
C *                       ETC. ETC.                                  *
C *                                                                  *
C ********************************************************************
C *                                                                  *
C *   A SHELX(L) INPUT FILE WITH ATOM PARAMETERS IS ALSO ACCEPTABLE  *
C *                                                                  *
C ********************************************************************
C *                                                                  *
C *                        R E M A R K S                             *
C *                        - - - - - - -                             *
C * # 1  -  A FILE THAT STARTS WITH THE KEYWORD FVAR IS INTERPRETED  *
C *         FOLLOWING THE CONVENTIONS OF SHELX                       *
C * # 2  -  SYMMETRY MAY BE SPECIFIED ALSO WITH LATT AND SYMM CARDS  *
C *         FOLLOWING THE CONVENTIONS OF SHELX                       *
C * # 3  -  CARDS THAT START WITH AN ATOM LABEL, FOLLOWED BY THREE   *
C *         NUMBERS ARE INTERPRETED AS ATOM CARDS                    *
C * # 4  -  AN ATOMLABEL MAY CONTAIN THE SYMBOLS ' AND "             *
C * # 5  -  AN ATOMLABEL (EXCLUDING PARENTHESES CANNOT TAKE MORE THAN*
C *         FOUR POSITIONS                                           *
C *                                                                  *
C ********************************************************************
C *                    C A L C U L A T I O N S                       *
C *                    -----------------------                       *
C *                                                                  *
C *   CALC INTRA (OR GEOM)    - FOR INTRAMOLECULAR GEOMETRY          *
C *   CALC INTER              - FOR INTERMOLECULAR GEOMETRY          *
C *   CALC COORDN             - FOR COORDINATION   GEOMETRY (NON C,H)*
C *   CALC METAL              - FOR METAL-DISTANCE SCAN              *
C *                                                                  *
C ********************************************************************
C *                                                                  *
C *     A D D I T I O N A L  S P E C I A L  I N S T R U C T I O N S  *
C *  --------------------------------------------------------------- *
C *                   (SHOULD PRECEDE THE ITEMS TO OPERATE ON)       *
C *                                                                  *
C * ANGSTROM  (SCALE)        -  ANGSTROM SCALE (DEFAULT 1.0)         *
C * TRNS      -N.KLM         -  APPLY AND FIX (FIRST ATOM IN RESD.)  *
C * TRNS       N.KLM         -  APPLY AND FIX (NEXT ATOM ONLY)       *
C * TRNS      T11,T12,...T33 -  APPLY CELL AXES TRANSFORMATION       *
C *           (SH1,SH2,SH3)     (+ ORIGIN SHIFT)                     *
C *                                                                  *
C * FVAR                     -  SIGNALS SHELX PARAMETER STYLE        *
C *                                                                  *
C * LABEL    X  Y  Z         -  ALTERNATIVE ATOM PARAMETERS TYPE     *
C *                                                                  *
C ********************************************************************
C ********************************************************************
C *                                                                  *
C *                    F  I  L  E  S                                 *
C *                   ---------------                                *
C *                                                                  *
C * UNIT LU1 - INPUT OF PARAMETER DATA (CIF/RES/SPF etc)             *
C * UNIT LU2 - OUTPUT OF PLATON DATA FOR SHELX(L) ETC.               *
C * UNIT LU3 - SAVE(D) INSTRUCTION FILE (FOR INTERNAL USE ONLY)      *
C * UNIT LU4 - SCRATCH FILE (BINARY) ATOMIC PARAMETERS               *
C * UNIT LU5 - INTERACTIVE INPUT OF CONTROL RECORD(S) FOR CALCN(S)   *
C * UNIT LU6 - INTERACTIVE OUTPUT TO TERMINAL DISPLAY                *
C * UNIT LU7 - LINEPRINTER OUTPUT                                    *
C * UNIT LU8 - SCRATCH-BINARY FILE  (PLANES ETC)                     *
C * UNIT LU9 - REFLECTION SCRATCH (BINARY)                           *
C * UNIT LU10- VALIDATION-LIST-OUTPUT             (SCRATCH IN HELENA)*
C * UNIT LU11- CIF-DATA SCRATCH                   (SCRATCH IN HELENA)*
C * UNIT LU12- IUCR-CHECK-DEF (VALIDATION)                           *
C * UNIT LU13- CKF-FILE (VALIDATION)                                 *
C * UNIT LU14- SCRATCH (ASYM) OR CHECK.SUM                           *
C * UNIT LU15- SAR-FILE                                              *
C * UNIT LU16- REFLECTION DATA IN                                    *
C * UNIT LU17- REFLECTION DATA OUT (HKP)                             *
C * UNIT LU18- REFLECTION DATA OUT (HKS)                             *
C * UNIT LU19- BIN                                                   *
C * UNIT LU20- CHECK-SCRATCH (FORMATTED)                             *
C * UNIT LU21- MODIFIED SHELXL.RES FILE                              *
C * INIT LU22- PLUTON.PJN                                            *
C * UNIT LU23- DEF-FILE                                              *
C * UNIT LU24- SHELXL(20xy) _sx.ins                                  *
C * UNIT LU25- SHELXL(20xy) _sx.hkl                                  *
C * UNIT LU26- SHELXL(20xy) _sx.fab                                  *
C * UNIT LU27- BINARY REFLECTION FILE                                *
C * UNIT LU60- (.RAS,.POV,.SUP,_ACC.CIF)                             *
C * UNIT LU61-                                                       *
C * UNIT LU62-                                                       *
C * UNIT LU63-                                                       *
C * UNIT LU64-                                                       *
C * UNIT LU65-                                                       *
C * UNIT LU98- GRAPHICS                                              *
C *                                                                  *
C ********************************************************************
C **********************************************************************
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
C * MAJOR PLATON LOOP (MANAGED BY THE VALUE OF IGBL(1) = [-2,-1,0,1,2,3,4,5])
C * SET FOR GLOBAL INIT
      IGBL(1) = -2
      DO
        SELECT CASE (IGBL(1))
C * -2 : GLOBAL INIT (IGBL & RGBL), GET COMMAND-LINE ARGUMENTS
C *      CHECK FOR ESCAPE MODES TO (S, HELENA, SHX86, STIDY)
C * -1 : INIT & FILE OPEN
C *  0 : MANAGE DATA FILE LU1
          CASE (-2, -1, 0)
            CALL PLA000
C * RESTART FOR NEW DATASET
          CASE (1)
            CALL PLA001
C * READ DATA AND INSTRUCTIONS
          CASE (2)
            CALL PLA002
C * ERROR HANDLING (AND SUMMARY)
          CASE (3)
            CALL PLA003
C * CLOSE & TERMINATE PLATON RUN
          CASE (4)
            CALL PLA004 (0)
C * EXIT (5)
          CASE DEFAULT
            EXIT
        END SELECT
      END DO
      END PROGRAM PLATON
      SUBROUTINE PLA000
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP38=150,NP39=30,NP45=2048,NP52=200,
     2 NP54=42,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /TIMER/ ISAVEMOD
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      LOGICAL EXST21
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /TODAY/ DATIJD
      CHARACTER DATIJD*25
      COMMON /VALDOC/ NDOC(999)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      LOGICAL OPEND
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CENTRY*75
      COMMON /MSWDS/ DOS
      LOGICAL DOS
C * IGBL(1) =  0 - MANAGE DATA FILE ON UNIT LU1
C * IGBL(1) = -1 - INIT & FILE-OPEN
C * IGBL(1) = -2 - GLOBAL INIT & ESCAPES FOR (S, HELENA, SHX86, STIDY)
      IF (IGBL(1) .EQ. -2) THEN
C * OPEN SCRATCH FILE FOR ALERTS (AND EXIT IN CASE OF SCRATCH OPEN ERROR)
        OPEN (UNIT = LU20, STATUS = 'SCRATCH', FORM = 'FORMATTED',
     1        IOSTAT = IOST)
        IF (IOST .NE. 0) CALL GEN127 ('OPEN ERROR LU20')
C * INIT GLOBAL PARAMETERS
        CALL GEN097 (IGBL, 1, NP38,   0)
        CALL GEN074 (RGBL, 1, NP39, 0.0)
C * SET VERSION DATE
        IGBL(4) = 151014
C * HTTP-SERVER LOCATION
        IF (DOS) THEN
          HTTPSERVER = 'http://www.platonsoft.nl/'
        ELSE
          HTTPSERVER = 'www.platonsoft.nl/'
        END IF
C * CHECK For PLATON & SHELXL ETC.
        CALL PLA259
C * MACHINE SPECIFIC ROUTINE TO GET DATA
        CALL ZDATE (DATIJD)
        PROGNM = 'PLATON-'//DATIJD(5:24)
C * INITIALIZE GLOBAL PARAMETERS
        IWIN     = 0
        ISAVEMOD = 0
        XSH0     = 0.0
        YSH0     = 0.0
        RGBL(1)  = 19.5
        VERT     = RGBL(1)
        RGBL(2)  = 4.0 / 3.0
        HORS     = VERT * RGBL(2)
        RGBL(5)  = 8 * ATAN2 (1.0, 1.0)
        RGBL(6)  = 360.0 / RGBL(5)
        RGBL(7)  = RGBL(5)**2 / 2.0
        RGBL(8)  = 4.0 * RGBL(7)
        RGBL(15) = 20.0
        RGBL(25) = 1.0
        RGBL(26) = 0.4
        RGBL(27) = 0.5
        RGBL(28) = 0.0
        RGBL(29) = 0.0
        RGBL(30) = 0.0
        IGBL(25) = 1
        IGBL(33) = 1
        IGBL(35) = 1
        IGBL(56) = 1
        IGBL(62) = 4
        IGBL(63) = 4
        IGBL(64) = 4
        IGBL(70) = 0
        IGBL(82) = 1
        IGBL(83) = 1
        IGBL(89) = 5
        IGBL(86) = NVD - 6
        IGBL(93) = 1
        IGBL(102) = 51
        IGBL(103) = 1
        IGBL(106) = 1
        IGBL(137) = 1
        CALL GEN097 (NDOC, 1, 999, 0)
        CALL GEN038 (LINE, 1, 80)
        CALL GEN038 (IDM,  1, 80)
        CALL GEN038 (ICL,  1, 80)
        DO I = 1,NP54
          DO J = 1, 4
            IENTRY(I, J) = 0
          END DO
        END DO
C * RUN OVER SWITCHES AND ARGUMENTS
        CALL PLA005 (-1, ICL)
C * SPECIAL ESCAPE OPTIONS
        SELECT CASE (IGBL(3))
C * ESCAPE TO COMPARE TWO FCF REFLECTION SETS '-d' and '-J'
          CASE (6, 47)
            CALL PLA279
C * ESCAPE TO SYSTEM-S  '-s'
          CASE (14)
            CALL PLA017
            CALL S
C * ESCAPE TO HELENA '-k'
          CASE (15)
            CALL PLA017
            CALL PLA240
C * ESCAPE TO EXPLICIT SHX86-MODE '-X'
          CASE (32)
            TREF = 100
            CALL PLA155 (TREF)
C * ESCAPE TO 'NATIVE' STIDY MODE (-Y)
          CASE (39)
            CALL GEN038 (JID,  1, 80)
            CALL PLA301
            IGBL(1) = 4
          CASE DEFAULT
            IGBL(1) = -1
        END SELECT
C * IGBL(1) = -1: INIT & FILE OPEN MODE
      ELSE IF (IGBL(1) .EQ. -1) THEN
        CALL PLA017
        CALL GEN038 (IGGT, 1, 80)
        OPEN (UNIT = LU3, STATUS = 'SCRATCH', FORM = 'FORMATTED')
C * OPEN LU21, LU22, LU23
        OPEN (UNIT = LU21, FILE = NAMEFIL(1:KNMFIL)//'_new.res',
     1                            STATUS = 'UNKNOWN', IOSTAT = IOST)
        OPEN (UNIT = LU22, FILE = NAMEFIL(1:KNMFIL)//'.pjn',
     1                            STATUS = 'UNKNOWN', IOSTAT = IOST)
        OPEN (UNIT = LU23, FILE = NAMEFIL(1:KNMFIL)//'.def',
     1                            STATUS = 'UNKNOWN', IOSTAT = IOST)
        READ (LU23, 99998, IOSTAT = IOST) ICL(1:80)
        IF (IOST .EQ. 0) THEN
          IF (INDEX (ICL, 'CREATED') .NE. 0) THEN
            CALL GEN108 (LU23, 0)
            ENDFILE LU23
            IGBL(23) = 0
          ELSE
            IGBL(23) = 1
          END IF
        END IF
        CALL GEN108 (LU23, 0)
        IF (IGBL(3) .EQ.  8 .OR.
     1      IGBL(3) .EQ. 12 .OR.
     2      IGBL(3) .EQ. 13 .OR.
     3      IGBL(3) .EQ. 26) THEN
          CALL PLUTON (-1)
          IGBL(1) = 4
        ELSE
          OPEN (UNIT = LU11, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1         IOSTAT = IOST)
          IF (IOST .NE. 0) CALL GEN127 ('OPEN ERROR')
C * REDIRECT CONSOLE-OUTPUT for -u & -V (-W) validation modes
          IF (IGBL(3) .EQ. 1 .OR. IGBL(3) .EQ. 33 .OR.
     1        IGBL(3) .EQ. 34) LU6 = LU20
          OPEN (UNIT = LU4, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1         IOSTAT = IOST)
          IF (IOST .NE. 0) CALL GEN127 ('OPEN ERROR')
          OPEN (UNIT = LU8, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1         IOSTAT = IOST)
          IF (IOST .NE. 0) CALL GEN127 ('OPEN ERROR')
          OPEN (UNIT = LU9, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1         IOSTAT = IOST)
          IF (IOST .NE. 0) CALL GEN127 ('OPEN ERROR')
          OPEN (UNIT = LU14, FILE = NAMEFIL(1:KNMFIL)//'.sum',
     1      STATUS = 'UNKNOWN', IOSTAT = IOST)
          OPEN (UNIT = LU17, FILE = NAMEFIL(1:KNMFIL)//'.hkp',
     1      STATUS = 'UNKNOWN', IOSTAT = IOST)
          CALL GEN108 (LU17, 0)
          INQUIRE (FILE = NAMEFIL(1:KNMFIL)//'.bin', EXIST = EXST21)
          OPEN (UNIT = LU19, FILE = NAMEFIL(1:KNMFIL)//'.bin',
     1      STATUS = 'UNKNOWN', FORM = 'UNFORMATTED', IOSTAT = IOST)
          IF (EXST21) THEN
            READ (LU19, IOSTAT = IOST)
            IF (IOST .EQ. 0) IGBL(16) = 1
          END IF
          IPR(437) = 0
          IGBL(1) = 0
        END IF
C * MANAGE DATA FILE ON UNIT LU1
      ELSE IF (IGBL(1) .EQ. 0) THEN
        XLDTP = '  '
        IDATAFRM = 1
C * TARGET DEPENDENCY
        KNMXT = KNMFIL + KXT + 1
        FNLU1 = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
        INQUIRE (FILE = FNLU1, OPENED = OPEND)
        IF (OPEND) THEN
          INQUIRE (FILE = FNLU1, NUMBER = IUNIT)
            LU1 = IUNIT
        ELSE
          INQUIRE (UNIT = LU1, OPENED = OPEND)
          IF (OPEND) CLOSE (UNIT = LU1)
          OPEN (UNIT = LU1, FILE = FNLU1, FORM = 'FORMATTED',
     1                 STATUS = 'OLD', IOSTAT = IOST)
          IF (IOST .NE. 0) THEN
            WRITE (LU6, 99999, IOSTAT = IOST) FNLU1(1:KNMXT)
            IF (IGBL(3) .EQ. 30) RETURN
            IGBL(8)  = 1
            IGBL(39) = 0
            LU1      = LU3
            IDATAFRM = 0
          END IF
        END IF
        IF (IDATAFRM .EQ. 1) THEN
          WRITE (LU6, 99997, IOSTAT = IOST) FNLU1(1:KNMXT)
          IGBL(39) = 1
        END IF
        CALL GEN108 (LU3,  0)
        CALL GEN108 (LU4,  0)
        CALL GEN108 (LU8,  0)
        CALL GEN108 (LU14, 0)
        CALL GEN108 (LU17, 0)
        IGBL(1) = 1
      END IF
      RETURN
99999 FORMAT ('!! File ', A, ' NOT Available, Interactive Input ',
     1        'Assumed', /)
99998 FORMAT (A)
99997 FORMAT (':: Data from: ', A)
      END SUBROUTINE PLA000
      SUBROUTINE PLA001
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP31=34,NP35=110,NP36=3000,NP38=150,NP39=30,
     3 NP41=200,NP47=9,NCS=52,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /CFSPGR/ EXT, ILAT0, ILAT1, LAUE
      CHARACTER EXT(NCS)*1, ILAT0*1, ILAT1*1, LAUE*5
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /PAGEIN/ INDEXP(25), INDP
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /PL266A/ CELAB(2, 6), VCAB(2, 6), ICV(2), TEMPAB(2)
      COMMON /MEN/ MENA(25, NP31), MENS(25, NP31), MENU(50, NP31),
     1        MNH(NP35)
      COMMON /BONDTYPE/ BNDTP(11)
      CHARACTER BNDTP*5
      COMMON /LITREF/ LREF
      CHARACTER LREF(25)*80
      COMMON /FSPGR/ CRI(11), PNZ(13, 10), STLS(20)
      COMMON /ALIASES/ ALAB(NP36), BLAB(NP36)
      CHARACTER ALAB*7, BLAB*7
      CALL GEN097 (MNH, 1, NP35, 0)
      MNH(6)   = 2
      MNH(7)   = 2
      IGBL(6)  = 1
      IPR(683) = 0
      IPR(684) = 0
      DO I = 1, NP36
        ALAB(I) = ' '
        BLAB(I) = ' '
      END DO
      ILAT0    = ' '
      ILAT1    = 'P'
      LAUE     = ' '
      KRAD     = '??'
      INDP     = 0
      PAGET    = 'GENERAL'
      RP(1)    = 1.0
      CALL GEN097 (MLTI, 1, 63, 1)
      IGBL(8) = IABS(IGBL(8))
      IF (IGBL(53) .EQ. 0) THEN
        DO I = 1, 11
          CALL GEN038 (BNDTP(I), 1, 5)
        END DO
      END IF
      CALL GEN038 (JID,  1, 80)
      CALL GEN038 (IGGT, 1, 80)
      DO I = 1, 25
        CALL GEN038 (LREF(I), 1, 80)
      END DO
      DO I = 1, 5
        RLWS(I) = ' ?'
      END DO
      DO I = 1, 4
        CALL GEN038 (SPGRNM(I), 1, 26)
      END DO
      CALL GEN038 (ZSPG     , 1, 7)
      CALL GEN048 (0, I, 0, I)
      CALL GEN097 (IPPR, 1, 129 * 3, 0)
      IPPR(1, 1) = 1000
      IPPR(1, 2) = 0
      IPPR(1, 3) = 1
      DO I = 1, NP10
        IENLB(I) = 0
        DO J = 1, 4
          RADR(I, J) = -1
        END DO
        IACL(I)  = 1
        DO J = 1, 2
          LMT(I, J) = '  '
          IENS(I)   = I
        END DO
      END DO
      CALL GEN074 (TEMPAB, 1,  2, 0.0)
      CALL GEN074 (CELAB,  1, 12, 0.0)
      CALL GEN074 (XJX,    1, 12, 0.0)
      CALL GEN021 (TM1, 1)
      CALL GEN021 (TM2, 1)
      CALL GEN021 (RMAT, 1)
      CALL GEN097 (ICV, 1, 2, 0)
      CALL GEN074 (PAR, 1, NP13, 0.0)
      CALL GEN097 (IPR, 1, NP12, 0)
      CALL GEN074 (PAR,  101, 103,  1.0)
      CALL GEN074 (PAR,  104, 106, 90.0)
      CALL GEN074 (SHFT,   1,   3,  0.0)
      CALL GEN097 (NPOL, 1, NP29, 0)
      PAR(98) = 1.0
      DO I = 1, 3
        KRSYST(1) = '?'
      END DO
      DO I = 1, 20
        CCIF(I) = ' ?'
        NCIF(I) = 2
      END DO
      NEWLAT(1) = 1
      CALL SGSM (IDM, 0, XJX, 0, 1, IERR)
      IPR(48)  = 1
      IPR(146) = 10
      IAN      = 0
      ICLR     = 4
      IPR(34) = 1
      IPR(35) = 2
      IPR(36) = 3
      IPR(28)  = 5
      IPR(40)  = 1
      IPR(41)  = 0
      IPR(45)  = 5
      IGBL(5)  = LU1
      IPR(65)  = 1
      IPR(66)  = 7
      IPR(82)  = 5
      IPR(68)  = 2
      IPR(71)  = 1
      IPR(95)  = 0
      IPR(96)  = NP6
      IPR(110) = 1
      IPR(125) = 1
      IPR(129) = NP29
      IPR(142) = 15
      IPR(143) = 2
      IPR(144) = 3
      IPR(154) = 0
      IPR(159) = 6
      IGBL(134) = 1
      IGBL(75) = 1
      IPR(458) = 1
      IPR(163) = 4
      IPR(21)  = 7
      IPR(175) = 1
      IPR(176) = 1
      IPR(177) = 0
      IPR(178) = 0
      IPR(179) = 1
      IPR(180) = 4
      IPR(181) = 1
      IPR(183) = 6
      IPR(212) = 1
      IPR(214) = 6
      IPR(216) = 6
      IPR(217) = 6
      IPR(218) = 18
      IPR(219) = 24
      IPR(579) = IPR(219)
      IPR(211) = 0
      IPR(324) = 1
C * SET BEL SIGNAL (CTRL-G = ASCII 7)
      IPR(223) = 7
      IPR(331) = 1
      IPR(346) = 1
      IPR(366) = 25
      IPR(460) = 3
      IPR(551) = 3
      IPR(507) = 3
      IPR(467) = 3
      IPR(484) = -1
      IPR(222) = 100
      IPR(243) = 60
      IPR(260) = 1
      IPR(274) = 2
      IPR(300) = 1
      IPR(302) = 25
      IPR(350) = 0
      IPR(353) = 1
      IPR(354) = -1
      IPR(356) = -1
      IPR(355) = 0
      IPR(357) = 1
      IPR(358) = 1
      IPR(359) = 1
      IPR(363) = 1
      IPR(368) = 0
      IPR(392) = 3
      IPR(394) = 3
      IPR(419) = 10
      IPR(480) = 11
      IPR(482) = 4
      IPR(487) =  10
      IPR(492) = 8
      IPR(505) = 1
      IPR(514) = 9
      IPR(515) = 2
      IPR(523) = 6
      IPR(524) = 3
      IPR(532) = 1
      IPR(550) = 50
      IPR(567) = 5
      IPR(569) = 1
      IPR(577) = 5
      IPR(578) = 5
      IPR(582) = 250
      IF (IGBL(47) .GT. 0) THEN
        IPR(590) = 1
      ELSE
        IPR(590) = 0
      END IF
      IPR(594) = 1
      IPR(596) = 50
      IPR(597) = 1
      IPR(598) = 1
      IPR(607) = 25
      IPR(611) = 2
      IPR(682) = 3
      PAR(487) = 10.0
      PAR(488) =  0.0
      IPR(613) = 1
      IPR(645) = 0
      IPR(681) = 1
      PAR(2)   = 0.4
      PAR(3)   = 0.2
      PAR(7)   = 3.6
      PAR(8)   = 0.5
      PAR(9)   = -0.12
      PAR(10)  = 100.0
      PAR(11)  = 1.0
      PAR(12)  = 0.0001
      PAR(15)  = 160.0
      PAR(17)  = -999999.0
      PAR(18)  = 0.01
      PAR(22)  = 0.3
      PAR(24)  = 1.0
      PAR(25)  = 0.4
      PAR(26)  = 0.70
      PAR(27)  = - PAR(2)
      PAR(28)  = 0.25
      PAR(29)  = 1.0
      PAR(30)  = 0.05
      PAR(31)  = 150.0
      PAR(32)  = 1.0
      PAR(33)  = 100.0
      PAR(34)  = 0.25
      PAR(36)  = 6.0
      PAR(37)  = RGBL(1)
      PAR(38)  = RGBL(1)
      PAR(39)  = 1.0
      PAR(40)  = 0.25
      PAR(41)  = 0.75
      PAR(42)  = 100.0
      PAR(43)  = 1.0
      PAR(44)  = 0.075
      PAR(48)  = 0.375
      PAR(49)  = 0.1
      PAR(50)  = (4.0 - IGBL(46)) / 3.0
      PAR(51)  = 1.25
      PAR(52)  = 0.5
      PAR(53)  = 0.2
      PAR(54)  = 1.E-5
      PAR(62)  = 60.0
      PAR(63)  = 0.002
      PAR(69)  = 4.0
      PAR(70)  = 0.3
      PAR(71)  = 0.05
      PAR(72)  = 0.25
      PAR(73)  = 0.1
      PAR(74)  = 1.0
      PAR(75)  = 0.8
      PAR(76)  = 1.5
      PAR(77) = 0.03
      PAR(78) = 0.5
      PAR(80)  = 0.2
      PAR(84)  = 1.20
      PAR(85)  = 4
      PAR(86)  = 0.03
      PAR(87)  = 2
      PAR(88)  = 0.02
      PAR(89)  = 5
      PAR(90)  = 0.05
      PAR(91)  = 2
      PAR(92)  = 0.02
      PAR(93)  = 0.001
      PAR(94)  = 10.0
      PAR(95)  = 5.0
      PAR(96)  = 10.0
      PAR(97)  = 25.0
      PAR(141) = 5.0
      PAR(165) = 90.0
      PAR(199) = -1.0
      PAR(213) = 0.5
      PAR(214) = 109.0
      PAR(215) = 20.0
      PAR(216) = 1.62
      PAR(217) = 0.2
      PAR(218) = 90.0
      PAR(219) = 20.0
      PAR(220) = 1.97
      PAR(221) = 0.4
      PAR(231) = 1.0
      PAR(235) = 1.0
      PAR(239) = 1.0
      PAR(240) = 1.0
      PAR(247) = 0.05
      PAR(248) = 0.6
      PAR(249) = RGBL(15)
      PAR(250) = 0.2
      PAR(251) = -0.25
      PAR(253) = -0.25
      PAR(263) = 3.0
      PAR(264) = 30.0
      PAR(265) = 0.1
      PAR(266) = 0.2
      PAR(268) = 0.5
      PAR(269) = 0.5
      PAR(270) = 0.2
      PAR(271) = 0.3
      PAR(273) = 10.0
      PAR(272) = PAR(273) * 4.0 / 3.0
      PAR(279) = 1.5
      PAR(280) = 0.1
      PAR(281) = 0.2
      PAR(282) = 1.0
      PAR(283) = 0.05
      PAR(284) = 1.E5
      PAR(285) = 0.0
      PAR(286) = 0.15
      PAR(287) = 1.0 / 1.54184
      PAR(288) = 2.0
      PAR(290) = 0.2
      PAR(292) = 500.0
      PAR(294) = 1.19
      PAR(295) = 1.50
      PAR(296) = 1.083
      PAR(297) = 1.009
      PAR(298) = 0.983
      PAR(325) = 1.0
      PAR(326) = 0.5E-15
      PAR(328) = 25.0
      PAR(331) = 0.011
      PAR(349)  = 0.25
      PAR(350) = 0.55
      PAR(371) = 0.1
      PAR(372) = 1.0
      PAR(381) = 1.0
      PAR(382) = 0.5
      PAR(383) = 0.2
      PAR(384) = 1.45
C * ADDSYM ORGANIC PARAMETERS
      PAR(401) = 0.25
      PAR(402) = 0.45
      PAR(403) = 0.45
C * ADDSYM INORGANIC DEFAULTS
      PAR(404) = 0.25
      PAR(405) = 0.25
      PAR(406) = 0.25
      PAR(410) = 0.00000001
      PAR(411) = 0.02
      PAR(412) = 100.0
      PAR(413) = 4.0
      PAR(414) = 0.10
      PAR(415) = 0.1
      PAR(416) = 0.01
      PAR(417) = 5.0
      PAR(418) = 0.0
C * BEAM-STOP THETA-MIN
      PAR(419) = 2.5
      PAR(420) = 0.10
      PAR(421) = 5.0
      PAR(422) = 3.5
      PAR(423) = 2.0
      PAR(424) = 1.5
      PAR(427) = 1.0
C * NEWSYM/LAUE R_MAX
      PAR(429) = 5.0
C * SPGR/LAUE RMAX-GREEN/RED-COLOUR
      PAR(430) = 10.0
C * SPGR/LAUE RMAX=LIST
      PAR(431) = 40.0
C * SPGR/LAUE-%Ct COLOUR
      PAR(432) = 80.0
      PAR(439) = 0.4
      PAR(440) = 1000.0
      PAR(441) = 0.4
      PAR(442) = 0.005
      PAR(447) = 4.0
      PAR(448) = 30.0
      PAR(449) = 0.4
      PAR(450) = 5.0
      PAR(451) = 5.0
      PAR(452) = 0.25
      PAR(454) = 0.04
      PAR(461) = 2.25
      PAR(466) = 0.50
      PAR(467) = 0.30
      PAR(468) = 0.40
      PAR(473) = 0.10
      PAR(475) = 0.02
      PAR(476) = 80.0
      PAR(483) = 0.5
      PAR(484) = 2.0
      PAR(485) = 400.0
      PAR(486) = 0.25
      PAR(540) = 1.0 / 1.54184
      PAR(541) = 0.20
      PAR(542) = 0.35
      PAR(543) = 0.40
      PAR(544) = 0.20
      PAR(545) = 0.20
      PAR(546) = 0.30
      DO I = 262, 272
        IPR(I) = -999999
      END DO
      IPR(267) = - IPR(268)
      IPR(269) = - IPR(270)
      IPR(271) = - IPR(272)
      IPR(261) = -999999
      IPR(310) = -999999
      PAR(158) =  999999.0
      PAR(167) = -999999.0
      PAR(168) = -999999.0
      PAR(170) = -999999.0
      PAR(173) = -999999.0
      PAR(174) = -999999.0
      PAR(175) = -999999.0
      PAR(176) =  999999.0
      PAR(177) = -999999.0
      PAR(178) = -999999.0
      PAR(179) = -999999.0
      PAR(197) = -999999.0
      PAR(198) = -999999.0
      PAR(299) = -999999.0
      PAR(300) = -999999.0
      PAR(302) = -999999.0
      PAR(303) = -999999.0
      PAR(304) = -999999.0
      PAR(305) = -999999.0
      PAR(306) =  999999.0
      PAR(307) =  999999.0
      PAR(309) = -999999.0
      PAR(310) = -999999.0
      PAR(229) = -999999.0
      PAR(312) = -999999.0
      PAR(313) = -999999.0
      PAR(314) = -999999.0
      PAR(425) = -999999.0
      PAR(433) =  999999.0
      PAR(434) =  999999.0
      PAR(435) =  999999.0
      PAR(436) =  999999.0
      PAR(471) = -999999.0
      PAR(474) = -999999.0
      PAR(497) = -999999.0
      PAR(503) =  999999.0
      DO  I = 1, 20
        STLS(I) = ((I * 0.1) ** 0.3333333) / 1.5418
      END DO
      IGBL(1)   = 2
      IGBL(129) = - IABS(IGBL(129))
      RETURN
      END SUBROUTINE PLA001
      SUBROUTINE PLA002
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP24=207,NP25=99,NP29=63,NP31=34,NP35=110,
     3 NP37=191,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,NXT1=100,
     4 NXT2=200,NXT3=100,NXT4=200,NCS=52,NP52=200,NP56=30,
     5 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /GGT/  MEDIUM
      COMMON /P190/ NVRR, PMILL(NXT1, 5), XTLV(7, NXT2), IDG(NXT4, 4),
     1 XYZPL(3, NXT2), CFACE(5, NXT2), IEDGE(NXT3), NFACES, NEDGE, NVER
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /DATASPGR/ EXTYPE, NLAUE
      CHARACTER EXTYPE(NCS)*16, NLAUE(13)*5
      COMMON /CFSPGR/ EXT, ILAT0, ILAT1, LAUE
      CHARACTER EXT(NCS)*1, ILAT0*1, ILAT1*1, LAUE*5
      COMMON // JNSC(2, NP23), VOID(NVD)
      CHARACTER N213*3
      COMMON /TIMER/ ISAVEMOD
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER ICH*1, EXTENS1*9
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, COLR*10, BWCT*10
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /LABMOD/ LMOD
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM(3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /MEN/ MENA(25, NP31), MENS(25, NP31), MENU(50, NP31),
     1        MNH(NP35)
      COMMON /PL266A/ CELAB(2, 6), VCAB(2, 6), ICV(2), TEMPAB(2)
      DIMENSION SAV(16)
      J0 = 0
      J1 = 0
   10 IPR(205) = 0
      IF (IGBL(90) .NE. 0) THEN
        FN(1)    = IGBL(54)
        IGBL(90) = 0
        IPR(220) = 1
        IPR(221) = 1
        CALL PLA009
        IF (ICL(1:4) .EQ. 'END ') THEN
          GO TO 290
        ELSE
          GO TO 10
        END IF
      END IF
      IF (IPR(121) .EQ. 0) THEN
        IPR(473) = 2
C * GET NEXT INPUT-LINE AND CARD TYPE (IN IS)
        CALL PLA006 (0, IS)
        IF (IPR(2) .NE. 0) THEN
          IGBL(1) = 3
          RETURN
        END IF
   20   SELECT CASE (IS)
C * IS = -3: CIF BOND/ANGLE/TORSION/HBOND
          CASE (-3)
            GO TO 10
C * IS = -1: HANDLE END-OF-FILE
          CASE (-1, -2)
            IF (IGBL(5) .EQ. LU5) THEN
              GO TO 290
            ELSE IF (IGBL(5) .EQ. LU3) THEN
              IGBL(5) = LU5
C * OPEN MAIN X-WINDOW
              IGBL(6)  = 10
              IGBL(24) = 1
              GO TO 10
            ELSE
              IF (IPR(37) .EQ. 0 .AND. IPR(367) .EQ. 0 .AND.
     1            PAR(101) .EQ. 0.0) GO TO 300
              IF (IPR(3) .EQ. 1) THEN
                IPR(3) = -1
                GO TO 300
              ELSE
                IGBL(5) = LU3
              END IF
            END IF
            CALL GEN108 (LU3, 0)
            GO TO 10
C * IS = 0: FORMAT/READ - ERROR
          CASE (0)
            IPR(2) = 61
            GO TO 300
C * IS = 1,28: POTENTIAL ATOM LINE/ATOM
          CASE (1, 28)
            IF (IS .EQ. 1) THEN
              IF (IGBL(5) .EQ. 5) GO TO 10
              IPR(473) = 1
              IF (IPR(30) .NE. 0) THEN
C * UNKNOWN CARD ERROR
                IPR(2) = 7
                GO TO 300
              END IF
            END IF
C * ATOMIC COORDS IN FREE-FORMAT INPUT
            IF (IPR(220) .LT. IPR(473) .OR. IPR(221) .LT. 3) THEN
              IPR(471) = IPR(471) + 1
              IF (IGBL(5) .NE. LU5) GO TO 10
C * UNKNOWN CARD ERROR
              IPR(2) = 7
              GO TO 300
            ELSE
              IF (IGBL(8) .EQ. 2 .AND. IGBL(95) .EQ. 1) THEN
                IF (IFL(1)(1:1) .EQ. 'Q' .AND. FN(7) .LT. RGBL(26))
     1            GO TO 10
              END IF
              CALL PLA022 (INQNR)
C * CHECK FOR ERROR RETURN
              IF (IPR(2) .EQ. 0) THEN
                GO TO 10
              ELSE
                GO TO 300
              END IF
            END IF
C * IS = 2: TITL CARD
          CASE (2)
            I0 = 1
            I1 = 0
            CALL GEN039 (0, ICL, 5, 80, I0, I1)
            IF (I1 .GE. I0) THEN
              JID = ICL(I0:I1)
              IF (I1 - I0 + 1 .GT. 32) I1 = I0 + 31
              I2 = INDEX (ICL(I0:I1), ' ')
              IF (I2 .NE. 0) I1 = I0 + I2 - 2
              DATANM = ICL(I0:I1)
            ELSE
              DATANM = 'X'
            END IF
            CALL GEN020 (-1, DATANM, 1, 32)
            WRITE (LU6, 99995, IOSTAT = IOST) JID(1:39)
            IF (IGBL(100) .EQ. 0 .AND. (IABS(IGBL(8)) .EQ. 2 .OR.
     1                                  IABS(IGBL(8)) .EQ. 1)) THEN
              IPR(220) = 1
              IPR(221) = 0
              IGBL(54) = -1
              CALL PLA009
            END IF
            IF (IGBL(100) .GT. 0) THEN
              IGBL(54) = IGBL(54) + 1
            ELSE
              IGBL(54) = 1
            END IF
C * IS = 3: MESSAGE (ECHO)
          CASE (3)
            WRITE (LU6, 99988, IOSTAT = IOST) ICL(5:80)
C * IS = 4: REMARK (SKIP)
          CASE (4)
C * IS = 5: ANGSTROM COORDINATE SCALE
          CASE (5)
            IF (IPR(221) .EQ. 1) THEN
              CALL PLA080
              PAR(11) = FN(1)
            END IF
C * IS = 6: ROUND ON/OFF OPTION
          CASE (6)
            IF (IPR(221) .EQ. 1) THEN
              IPR(68) = MAX (MIN (NINT(FN(1)), 10), 0)
            ELSE
              IPR(68) = 1
            END IF
            IF (IPR(220) .GT. 1) THEN
              IF (IFL(2)(1:3) .EQ. 'OFF') THEN
                IPR(68) = 0
              END IF
            END IF
            IF (IPR(68) .GT. 0) THEN
              CALL GEN040 (IPR(68), NQ1, IP)
              WRITE (LU6, 99990, IOSTAT = IOST) IPR(68) * 10 - 1
            END IF
            GO TO 280
C * IS = 7: FIT MOL1 ON MOL2 (OR INVERTED MOL2)
          CASE (7)
            IF (IGBL(45) .GT. 0 .AND. IGBL(5) .EQ. LU5) THEN
              IGBL(45) = IGBL(45) + 1
              WRITE (LU3, 99984, IOSTAT = IOST) ICL(1:80)
              WRITE (LU6, 99973, IOSTAT = IOST) ICL(1:70)
            END IF
            IF (IPR(220) .EQ. 1 .AND. IPR(221) .EQ. 0) THEN
              IPR(1)  = 7
              IPR(81) = -1
              GO TO 350
            ELSE
              IF (IPR(30) .EQ. 0) THEN
                IF (IPR(221) .EQ. 2) THEN
                  FN1      = FN(1)
                  FN2      = FN(2)
                  IPR(221) = 0
                  CALL PLA066
                  IF (IPR(2) .NE. 0) RETURN
                  CALL PLA072 (-1, -1)
                  FN(1)    = FN1
                  FN(2)    = FN2
                  IPR(221) = 2
                  IPR(220) = - IPR(220)
                ELSE IF (IPR(220) .EQ. 3) THEN
                  IPR220   = IPR(220)
                  IPR(220) = 1
                  CALL PLA066
                  IF (IPR(2) .NE. 0) RETURN
                  CALL PLA072 (-1, -1)
                  IPR(220) = - IPR220
                ELSE
                  NTYP = 0
                  GO TO 40
                END IF
              ELSE
                IPR(220) = - IPR(220)
              END IF
              GO TO 50
            END IF
C * IS = 8: EXPLICIT PLANE SPECIFICATION
          CASE (8)
            NTYP = 4
            GO TO 40
C * IS = 9: EXPLICIT RING SPECIFICATION
          CASE (9)
            NTYP = 2
            GO TO 40
C * IS = 10: NOMOVE (OFF)
          CASE (10)
            IF (IPR(30) .EQ. 0) THEN
              IF (IPR(220) .GT. 1 .AND. IFL(2)(1:3) .EQ. 'OFF') THEN
                IGBL(30) = 0
              ELSE
                IGBL(30) = 1
              END IF
            END IF
C * IS = 11: PSIDIR
          CASE (11)
            IPR(78) = 5
            CALL PLA190
            IF (IPR(2) .EQ. 0) IPR(2) = -9
            IGBL(1) = 3
            RETURN
C * IS = 12: DONOR/ACCEPTOR TYPES
          CASE (12)
            IPR(480) = 0
            DO I = 1, IPR(220)
              CALL PLA037 (I, N, 2)
              IF (N .GT. 0) THEN
                IF (IPR(480) .LE. NP10) THEN
                  IPR(480)        = IPR(480) + 1
                  IDOAC(IPR(480)) = IEN(N)
                ELSE
                  WRITE (LU6, 99979, IOSTAT = IOST) NP10
                END IF
              END IF
            END DO
            GO TO 280
C * IS = 13: SPECIAL LINE MANAGEMENT
          CASE (13)
            IF (IPR(30) .EQ. 0) THEN
              IF (IPR(220) .EQ. 3 .AND. IPR(407) .LT. 10) THEN
                DO I = 2, 3
                  CALL PLA046 (1, IFL(I), IENM, LBB, LBC, LBD,
     1                         INQNR, JNQNR, NIEN)
                  IF (NIEN .LT. 0) GO TO 10
                  SLN(IPR(407) + 1, I - 1) = INQNR
                END DO
                IPR(407) = IPR(407) + 1
                WRITE (LU6, 99987, IOSTAT = IOST)
              END IF
            END IF
C * IS = 14: ENDS
          CASE (14)
            IPR(3)  = 1
            IGBL(8) = - IABS(IGBL(8))
            IGBL(5) = LU3
            CALL GEN108 (LU3, 0)
C * IS = 15: PLOT
          CASE (15)
            GO TO 110
C * IS = 16: YES
          CASE (16)
            GO TO 310
C * IS = 18: CALC
          CASE (18)
            GO TO 120
C * IS = 19: END
          CASE (19)
            GO TO 290
C * IS = 20/21: (1/0)IN/EXCLUDE NAMED ELEMENTS IN/FROM CALCULATIONS
          CASE (20, 21)
            IF (IS .EQ. 20) THEN
              IPR(70) = 1
            ELSE
              IPR(70) = 0
            END IF
            IF (IPR(30) .EQ. 1) THEN
C * INSTRUCTION NOT ALLOWED
              IPR(2) = 11
              GO TO 300
            ELSE
              IPR(4) = 0
              I = 1
              DO WHILE (I .LT. IPR(220))
                I = I + 1
                IF (IFL(I)(1:3) .EQ. 'MET') THEN
                  DO J = 1, IAN
                    IF (IATPR(IEN(J)) .GT. 0) THEN
                      IPR(220)           = IPR(220) + 1
                      N                  = IEL(IEN(J))
                      N1                 = N / 100
                      IFL(IPR(220))(1:3) =
     1                    CHAR(ICHAR('A') - 1 + N1)//'  '
                      N1                 = MOD(N, 100)
                      IF (N1 .GT. 0) THEN
                        IFL(IPR(220))(2:2) = CHAR(ICHAR('A') - 1 + N1)
                      END IF
                    END IF
                  END DO
                  CYCLE
                END IF
                CALL PLA037 (I, N, 2)
                IF (N .GT. 0) THEN
                  IF (IPR(4) .LE. NP10) THEN
                    IPR(4) = IPR(4) + 1
C * SCRATCH USE OF ARRAY RADI FOR INCLUDE OPTION
                    RADR(IPR(4), 2) = N
                  ELSE
                    WRITE (LU6, 99978, IOSTAT = IOST) NP10
                  END IF
                ELSE
                  IPR(2) = 16
                  IPR(4) = 0
                  IAN    = IAN - 1
                  GO TO 300
                END IF
              END DO
              GO TO 280
            END IF
C * IS = 22, 45, 53: STOP/QUIT/EXIT - NO FULL END PROCESSING - TERMINATE JOB
          CASE (22, 45, 53)
            WRITE (LU6, 99999, IOSTAT = IOST)
     1        IGBL(49), NAMEFIL(1 : KNMFIL)
            IGBL(1) = 4
            RETURN
C * IS = 23: HELP (SPGR)
          CASE (23)
            IF (IPR(220) .GT. 1) THEN
              N213 = IFL(2)(1:3)
C * LIST KNOWN SPACE GROUP NAMES
              IF (N213 .EQ. 'SPG') THEN
                CALL SGSM (ICL, 0, XJX, LU6, 14, IERR)
                GO TO 10
              END IF
            END IF
            IWIN = IGBL(25) * IGBL(32)
            CALL PLA299 (1)
            RETURN
C * IS = 24: SAVE INSTRUCTION OPTION ON
          CASE (24)
            IGBL(45) = 1
            ISAVEMOD = 1
            CALL GEN108 (LU3, 0)
C * IS = 25,26: UIJ/SUIJ
          CASE (25, 26)
C * UIJ DATA & SUIJ DATA
            CALL GEN144 (1, FN(1), PAR(135))
            IF (IS .EQ. 26) THEN
              ICT = 3
              GO TO 70
            END IF
            GO TO 60
C * IS = 27, 41: U, B DATA (SHOULD INCLUDE ATOM LABEL)
          CASE (27, 41)
            IF (IS .EQ. 41) THEN
              IF (IPR(220) .EQ. 1) THEN
                IS = 1
                GO TO 20
              END IF
              FN(1) = FN(1) / RGBL(8)
              FN(2) = FN(2) / RGBL(8)
            END IF
            IF (IPR(220) .EQ. 1) THEN
              IS = 1
              GO TO 20
            END IF
            ICT = 4
            GO TO 80
C * IS = 29: LIST/INFO
          CASE (29)
C * LIST OPTION(S) ON DISPLAY (ATOMS/BONDS/SYMM/PAR/IPR/IGBL/RADII/CELL)
            IF (IGBL(8) .EQ. 2 .AND. IGBL(5) .NE. LU5) GO TO 10
            IPR(84) = 0
            IPR(1)  = 4
            IWIN    = IGBL(25) * IGBL(32)
            IF (IPR(220) .GT. 1) THEN
C * LIST IPR/PAR/IGBL/RGBL
              IF (IPR(220) .GE. 2) THEN
                SELECT CASE (IFL(2)(1:3))
                  CASE ('IPR')
                    CALL PLA206 (-1, 'IPR')
                  CASE ('PAR')
                    CALL PLA206 (-1, 'PAR')
                  CASE ('IGB')
                    CALL PLA206 (-1, 'IGB')
                  CASE ('RGB')
                    CALL PLA206 (-1, 'RGB')
C * LIST FLAGS
                  CASE ('FLA')
                    NAT = IPR(39) + IPR(64)
                    WRITE (PRBUF, 99965, IOSTAT = IOST)
                    IF (IWIN .EQ. 1) THEN
                      CALL GGIP (HORS, VERT, 0.0, 1)
                      VRT = VERT - 0.6
                      CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68),
     1                           2, 1.0, VRT)
                      VRT = VRT - 0.2
                    ELSE
                      WRITE (LU6, 99957, IOSTAT = IOST) PRBUF(1:80)
                    END IF
                    DO I = 1, NAT
                      CALL PLA047 (LABA(I), NQ1, IDUM, JDUM,
     1                  IPR(71), IGBL(55), 0, 1 - IGBL(55))
                      CALL GEN048 (-3,  IFG(1, I), 1,  IF1)
                      CALL GEN048 (-1,  IFG(1, I), 4,  IF2)
                      CALL GEN048 (-1,  IFG(1, I), 5,  IF3)
                      CALL GEN048 (-1,  IFG(1, I), 6,  IF4)
                      CALL GEN048 (-1,  IFG(1, I), 7,  IF5)
                      CALL GEN048 (-1,  IFG(1, I), 8,  IF6)
                      CALL GEN048 (-6,  IFG(1, I), 9,  IF7)
                      CALL GEN048 (-4,  IFG(1, I), 15, IF8)
                      CALL GEN048 (-1,  IFG(1, I), 19, IF9)
                      CALL GEN048 (-1,  IFG(1, I), 20, IF10)
                      CALL GEN048 (-1,  IFG(1, I), 21, IF11)
                      CALL GEN048 (-1,  IFG(1, I), 22, IF12)
                      CALL GEN048 (-1,  IFG(1, I), 23, IF13)
                      CALL GEN048 (-4,  IFG(1, I), 24, IF14)
                      CALL GEN048 (-1,  IFG(1, I), 30, IF15)
                      CALL GEN048 (-7,  IFG(2, I),  1, IF16)
                      CALL GEN048 (-1 , IFG(2, I), 10, IF17)
                      CALL GEN048 (-1 , IFG(2, I), 11, IF18)
                      CALL GEN048 (-1 , IFG(2, I), 12, IF19)
                      CALL GEN048 (-10, IFG(2, I), 14, IF20)
                      CALL GEN048 (-3,  IFG(2, I), 24, IF21)
                      WRITE (PRBUF, 99966, IOSTAT = IOST) I, NQ1, IF1,
     1                  IF2, IF3, IF4, IF5, IF6, IF7, IF8, IF9, IF10,
     2                  IF11, IF12, IF13, IF14, IF15, IF16, IF17, IF18,
     3                  IF19, IF20, IF21
                      IF (IWIN .EQ. 1) THEN
                        IF (VRT - 0.4 .LT. 0) THEN
                          CALL PLA013 (1, 1)
                          ICH = IGGT(1:1)
                          CALL GGIP (HORS, VERT, 0.0, 1)
                          IF (ICH .NE. 'Y' .AND. ICH .NE. '!') GO TO 10
                          VRT = VERT
                        END IF
                        VRT = VRT - 0.4
                        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0,
     1                               VRT)
                      ELSE
                        WRITE (LU6, 99984, IOSTAT = IOST) PRBUF(1:80)
                      END IF
                    END DO
                    IF (IWIN .EQ. 1) CALL PLA297 (1)
C * LIST/INFO SYMM
                  CASE ('SYM')
                    CALL PLA274
C * LIST/INFO CELL
                  CASE ('CEL')
                    WRITE (BCD, 99991, IOSTAT = IOST)
     1                (PAR(J), J = 101, 106), CHAR(0)
                    IF (IWIN .EQ. 1) THEN
                      IF (ABS(IGBL(6)) .GE. 10 .AND.
     1                    ABS(IGBL(6)) .LE. 12)
     2                  IGBL(6) = - IABS(IGBL(6))
                      CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 66.0,
     1                            111)
                    ELSE
                      WRITE (LU6, 99946, IOSTAT = IOST) BCD(1:65)
                    END IF
C * LIST/INFO RADII
                  CASE ('RAD')
                    WRITE (PRBUF, 99955, IOSTAT = IOST)
                    IF (IWIN .EQ. 1) THEN
                      CALL GGIP (HORS, VERT, 0.0, 1)
                      VRT = VERT - 2.0
                      CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
                    ELSE
                      WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
                    END IF
                    WRITE (PRBUF, 99954, IOSTAT = IOST)
                    IF (IWIN .EQ. 1) THEN
                      VRT = VRT - 0.6
                      CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
                    ELSE
                      WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
                      END IF
                    WRITE (PRBUF, 99953, IOSTAT = IOST) PAR(2)
                    IF (IWIN .EQ. 1) THEN
                      VRT = VRT - 0.9
                      CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
                    ELSE
                      WRITE (LU6, 99946, IOSTAT = IOST) PRBUF(1:75)
                    END IF
                    WRITE (PRBUF, 99952, IOSTAT = IOST) PAR(542)
                    IF (IWIN .EQ. 1) THEN
                      VRT = VRT - 0.6
                      CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
                    ELSE
                      WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
                    END IF
                    WRITE (PRBUF, 99951, IOSTAT = IOST)
     1                IGBL(97) * PAR(26)
                    IF (IWIN .EQ. 1) THEN
                      VRT = VRT - 0.6
                      CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
                    ELSE
                      WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
                    END IF
                    WRITE (PRBUF, 99950, IOSTAT = IOST) PAR(3)
                    IF (IWIN .EQ. 1) THEN
                      VRT = VRT - 0.6
                      CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
                    ELSE
                      WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
                    END IF
                    WRITE (PRBUF, 99949, IOSTAT = IOST)
                    IF (IWIN .EQ. 1) THEN
                      VRT = VRT - 0.9
                    CALL GGIP09 (0.0, PRBUF, 75, 0.35, 5 + IGBL(68), 2,
     1                           1.0, VRT)
                    ELSE
                      WRITE (LU6, 99946, IOSTAT = IOST) PRBUF(1:75)
                    END IF
                    DO I = 1, IAN
                      WRITE (PRBUF, 99996, IOSTAT = IOST)
     1                  LMT(I, 1), RADR(I, 3), RADR(I, 4), RADR(I, 2)
                     IF (IWIN .EQ. 1) THEN
                       VRT = VRT - 0.6
                       CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0,
     1                              VRT)
                     ELSE
                        WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
                      END IF
                    END DO
                    IF (IWIN .EQ. 1) CALL PLA297 (1)
C * LIST/INFO U1, U2, U3, U(eq) and U3/U1 VALUES
                  CASE ('UIJ')
                    IF (IPR(30) .NE. 0) THEN
                      WRITE (PRBUF, 99980, IOSTAT = IOST)
                      IF (IWIN .EQ. 1) THEN
                        CALL GGIP (HORS, VERT, 0.0, 1)
                        VRT = VERT - 0.6
                        CALL GGIP09 (0.0, PRBUF, 75, 0.35, 5 + IGBL(68),
     1                                 2, 1.0, VRT)
                        VRT = VRT - 0.2
                      ELSE
                        WRITE (LU6, 99984, IOSTAT = IOST) PRBUF(1:75)
                      END IF
                      NAT = IPR(39)
                      DO I = 1, NAT
                        DO J = 1, 12
                          FN(J) = VOID(IPR(297) + (I - 1) * 21 + J)
                        END DO
                        CALL PLA047 (LABA(I), NQ1, IDUM, JDUM,
     1                    IPR(71), IGBL(55), 0, 0)
                        CALL GEN048 (-1, IFG(1, I), 4, IVAL)
                        IF (IVAL .EQ. 1) THEN
                          JMAX  = 5
                          FN(4) = 0.0
                          DO J = 1, 3
                            FN(J) = FN(J + 9)**2
                            FN(4) = FN(4) + FN(J) / 3.0
                          END DO
                          FN(5) = FN(3) / FN(1)
                        ELSE
                          CALL GEN048 (-1, IFG(1, I), 7, IVAL)
                          IF (IVAL .EQ. 1) CYCLE
                          JMAX  = 1
                          FN(1) = FN(10)**2
                        END IF
                        WRITE (PRBUF, 99981, IOSTAT = IOST)
     1                    NQ1, (FN(J), J = 1, JMAX)
                        IF (IWIN .EQ. 1) THEN
                          IF (VRT - 0.4 .LT. 0.0) THEN
                            CALL PLA013 (1, 1)
                            ICH = IGGT(1:1)
                            CALL GGIP (HORS, VERT, 0.0, 1)
                            IF (ICH .NE. 'Y' .AND. ICH .NE. '!')
     1                        GO TO 10
                            VRT = VERT
                          END IF
                          VRT = VRT - 0.4
                          CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0,
     1                       VRT)
                        ELSE
                          WRITE (LU6, 99984, IOSTAT = IOST) PRBUF(1:80)
                        END IF
                      END DO
                      IF (IWIN .EQ. 1) CALL PLA297 (1)
                    END IF
C * LIST ARU
                  CASE ('ARU')
                    CALL PLA043 (0, -2, LU6, 1)
                    IF (IWIN .EQ. 1) CALL PLA297 (1)
C * LIST/INFO ATOMS AND BONDS
                  CASE ('ATO')
                    IF (IPR(39) .GT. 0) THEN
                      IPR(84) = 1
                      GO TO 340
                    ELSE
                      WRITE (LU6, 99992, IOSTAT = IOST)
                    ENDIF
                  CASE ('BON')
                    IF (IPR(39) .GT. 0) THEN
                      IPR(84) = 2
                      GO TO 340
                    ELSE
                      WRITE (LU6, 99992, IOSTAT = IOST)
                    END IF
                END SELECT
                GO TO 10
              END IF
            END IF
            GO TO 340
C * IS = 30: CELL CONSTANTS
          CASE (30)
            IF (IPR(221) .EQ. 1) THEN
              FN(2)    = FN(1)
              FN(3)    = FN(1)
              IPR(221) = 3
            END IF
            IF (IPR(221) .EQ. 3) THEN
              CALL GEN074 (FN, 4, 6, 90.0)
              IPR(221) = 6
            END IF
            IF (IPR(221) .LT. 6 .OR.
     1         (IPR(221) .GT. 7 .AND. IPR(221) .NE. 12)) THEN
              IPR(2) = 5
              GO TO 300
            END IF
            IF (IPR(221) .EQ. 7) THEN
              PAR(16) = FN(1)
              PAR(17) = FN(1)
              K = 1
            ELSE
              K = 0
            END IF
            DO I = 1, 12
              IF (I .LE. 3 .AND. ABS(FN(K + I)) .LT. 2.0) THEN
                IF (IGBL(5) .EQ. LU1) IPR(470) = 1
                IPR(2) = 5
                GO TO 300
              END IF
              PAR(100 + I) = FN(K + I)
            END DO
            IF (K .EQ. 0) GO TO 10
            CALL PLA293 (FN(1))
C * IS = 31: CELL STANDARD DEVIATION (COPY)
          CASE (31)
            CALL GEN113 (FN, PAR(107), 6)
C * IS = 32: SYMM (LATT/SPGR/HALL etc.)
          CASE (32)
            IF (IPR(220) .EQ. 1 .AND.
     1         (IPR(221) .EQ. 9 .OR. IPR(221) .EQ. 12)) THEN
C * SYMM MATRIX R11,R12,..,R33, (T1,T2,T3) INPUT
              IF (IPR(93) .EQ. 0) THEN
                ITRS = 15
                CALL SGSM (ICL, 0,  FN, LU6, ITRS, IERR)
                CALL SGSM (ICL, 0, XJS, LU6,   18, IERR)
                IPR(48) = NINT(XJS(9))
                IF (IGBL(8) .EQ. 3) THEN
                  IF (CCIF(7)(1:1) .EQ. ' ' .AND.
     1                CCIF(16)(1:1) .EQ. '?') THEN
C * ALERT _121
                    CALL PLA231 (121, 0, 1.0, 1.0, ICL(1:7), ' ')
                    ICL = 'SPGR P1'
                    WRITE (LU6, 99958, IOSTAT = IOST)
                    IS = 32
                    GO TO 20
                  END IF
                END IF
              ELSE
C * NO TRANS ALLOWED WITH SYMM MATRIX INPUT
                IPR(2) = 27
                GO TO 300
              END IF
            ELSE
              IF (IGBL(8) .EQ. 2) THEN
                IF (IPR(141) .EQ. 0 .AND. IFL(1)(1:4) .EQ. 'SYMM') THEN
                  IDM = 'LATT 1'
                  CALL SGSM (IDM, 0, XJX, 0, 0, IERR)
                  IPR(141) = 1
                END IF
              END IF
              IF (IPR(93) .EQ. 1 .OR. IPR(139) .EQ. 1) THEN
                ITRS = 16
              ELSE
                ITRS = 0
              END IF
              CALL SGSM (ICL, 0, XJX, LU6, ITRS, IERR)
              IF (IERR .NE. 0) THEN
                IF (IERR .EQ. 14) THEN
                  IPR(2) = 66
                  GO TO 300
                ELSE IF (IERR .EQ. 7) THEN
C * ALERT _126
                  CALL PLA231 (126, 0, 1.0, 1.0, ICL(6:12), ICL(13:19))
                  IPR(673) = 1
                  GO TO 10
                ELSE IF (IERR .EQ. 5) THEN
                  CALL GEN047 (ICL, 6, 16)
C * ALERT _129
                  CALL PLA231 (129, 0, 1.0, 1.0, ICL(6:12), ' ')
                  GO TO 10
                ELSE IF (IERR .EQ. 12) THEN
                  GO TO 10
                ELSE IF (IERR .EQ. 2) THEN
C * ALERT _119
                  CALL PLA231 (119, 0, 1.0, 1.0, ICL(6:12), ' ')
                  GO TO 10
                ELSE
                  IPR(470) = 1
                  IPR(2) = 5
                  GO TO 300
                END IF
              END IF
              CALL SGSM (ICL, 0, XJS, LU6,   18, IERR)
              IPR(48) = NINT(XJS(9))
              IF (IPR(48) .EQ. 0) THEN
C * ALERT _121
                IF (IGBL(8) .EQ. 3)
     1            CALL PLA231 (121, 0, 1.0, 1.0, ICL(1:7), ' ')
              END IF
            END IF
            IPR(141) = 1
            IF (IPR(48) .EQ. 0) THEN
              IF (IGBL(5) .EQ. LU1) IPR(470) = 1
              IPR(2) = 5
              GO TO 300
            END IF
            IF (IPR(39) .EQ. 0) CALL PLA271
C * IS = 33: SPGR
          CASE (33)
            IF (IPR(220) .NE. 1 .OR. IPR(221) .GT. 2) THEN
              IS = 32
            ELSE
              CALL PLA286
              IF (IGBL(15) .GE. 0) THEN
                IF (IPR(221) .GT. 0) THEN
                  IPR(365) = NINT(FN(1))
                  IF (IPR(221) .GT. 1) PAR(141) = FN(2)
                END IF
                CALL PLA080
                IGBL(31) = 5
                CALL PLA292
                CALL PLA042 (0)
                CALL PLA160 (1, TM1)
                IGBL(1) = 3
                RETURN
              ELSE
                IPR(2) = 55
                GO TO 300
              END IF
            END IF
            GO TO 20
C * IS = 34: LATT
          CASE (34)
            IS = 32
            GO TO 20
C * IS = 35: DIST
          CASE (35)
            GO TO 50
C * IS = 36: ANGLE
          CASE (36)
            GO TO 50
C * IS = 37: TORSION
          CASE (37)
            GO TO 50
C * IS = 38: CHANGE H-BOND PARAMETERS FROM DEFAULTS
          CASE (38)
            IF (IPR(220) .GT. 1 .AND. IFL(2)(1:4) .EQ. 'NORM')
     1        IPR(87) = 1
            DO K = 1, IPR(221)
              PAR(7 + K) = FN(K)
            END DO
            GO TO 280
C * IS = 39,40: BIJ, SBIJ
          CASE (39, 40)
C * BIJ & SBIJ DATA
C * (BETA-VALUES ARE TRANSFORMED TO U-VALUES AFTER TRANSFORMATION)
            DO I = 1, 6
              FN(I) = FN(I) / RGBL(7)
            END DO
            IF (IS .EQ. 40) THEN
              ICT = 3
              GO TO 70
            ELSE
              GO TO 60
            END IF
C * IS = 42: TRNS/TRMX
          CASE (42)
            CALL GEN074 (SHFT, 1, 3, 0.0)
            IF (IPR(221) .EQ. 1) THEN
              IF (ABS(FN(1)) .GT. 1000.0) THEN
                ITRNS = INT (FN(1))
              ELSE
                ITRNS = NINT(FN(1) * 1000.0)
              END IF
              IF (IABS(ITRNS) / 1000 .GT. IPR(48)) THEN
                IPR(2) = 15
                GO TO 300
              END IF
              IF (ITRNS .LE. 0) THEN
                IPR(95)  = ITRNS
              ELSE IF (ITRNS .GT. 0) THEN
                IPR(165) = ITRNS
              END IF
              GO TO 10
            ELSE IF (IPR(221) .EQ. 3) THEN
              CALL GEN074 (FN, 1, 9, 0.0)
              FN(1)    = 1.0
              FN(5)    = 1.0
              FN(9)    = 1.0
              IPR(139) = 1
              DO I = 1, 3
                SHFT(I) = - FN(I)
              END DO
            ELSE IF (IPR(221) .EQ. 9) THEN
            ELSE IF (IPR(221) .EQ. 10 .AND. IPR(220) .EQ. 2) THEN
              ILAT0 = IFL(2)(1:1)
              IF (IFL(2)(2:2) .NE. ' ') ILAT1 = IFL(2)(2:2)
              CALL GEN020 (-1, ILAT0, 1, 1)
              IFN10 = NINT(FN(10))
              IF (IFN10 .GT. 0 .AND. IFN10 .LT. 14) THEN
                LAUE = NLAUE(NINT(FN(10)))
              ELSE
                LAUE = ' '
              END IF
            ELSE IF (IPR(221) .EQ. 12) THEN
              IPR(139) = 1
              DO I = 1, 3
                SHFT(I) = - FN(9 + I)
              END DO
            ELSE
              IPR(2) = 63
              GO TO 300
            END IF
            IF (IPR(39) .GT. 0) THEN
C * INSTRUCTION NOT ALLOWED
              IPR(2) = 11
              GO TO 300
            END IF
            K = 0
            DO I = 1, 3
              XJX(9 + I) = - SHFT(I)
              DO J = 1, 3
                K = K + 1
                TM1(I, J) = FN(K)
                XJX(K)    = FN(K)
                PAR(230 + K) = FN(K)
              END DO
            END DO
            CALL GEN003 (TM1, DUMV, DET, 0)
            IF (ABS(ABS(DET) - 1.0) .GT. 0.001) THEN
              WRITE (LU6, 99985, IOSTAT = IOST) DET
              PAR(32) = DET
            END IF
            CALL GEN005 (DUMV, TM2)
            IPR(93) = 1
            WRITE (LU6, 99972, IOSTAT = IOST)
     1        ((TM2(I, J), J = 1, 3), SHFT(I), I = 1, 3)
C * IS = 43: FVAR CARD (SHELX)
          CASE (43)
            IGBL(8) = 2
            IF (IPR(109) + IPR(221) .GT. NP25) THEN
              IPR(2) = 30
              GO TO 300
            END IF
            DO I = 1, IPR(221)
              IF (IPR(109) + I .EQ. 1) THEN
                RP(1) = FN(1)
              ELSE
                RP(IPR(109) + I) = MOD(FN(I) + 5.0, 10.0) - 5.0
              END IF
            END DO
            IF (IPR(109) .EQ. 0) THEN
              PAR(74) = RP(1)
              RP(1)   = 1.0
            END IF
            IPR(109) = IPR(109) + IPR(221)
C * IS = 44: PARENTHESES ON/OFF OPTION
           CASE (44)
            IPR(71) = 1
            IF (IPR(220) .GT. 1) THEN
              IF (IFL(2)(2:2) .EQ. 'F') IPR(71) = 0
            END IF
            GO TO 280
C * IS = 46: SET OPTION(S)
          CASE (46)
C * SET - OPTION(S)
            N213 = IFL(2)(1:3)
C * (RE)SET VAN DER WAALS RADII
            IF (N213 .EQ. 'VDW') THEN
              IF (IPR(220) .GT. 2 .AND. IPR(221) .EQ. IPR(220) - 2) THEN
                DO I = 3, IPR(220)
                  CALL PLA037 (I, NID, 2)
                  IF (NID .GT. 0) RADR(NID, 4) = FN(I - 2)
                END DO
              END IF
              IF (IGBL(5) .EQ. LU5) CALL PLA280 ('LIST RADII')
C * SET RANGE (FOR POLY)
            ELSE IF (N213 .EQ. 'RAN') THEN
              IF (IPR(221) .EQ. 6) THEN
                IPR(354) = 0
                DO I = 1, 6
                  PAR(200 + I) = FN(I)
                END DO
C * SET OMIT RANGE (POLY)
            ELSE IF (N213 .EQ. 'OMI') THEN
              ELSE IF (IPR(221) .EQ. 6) THEN
                IPR(356) = 0
                DO I = 1, 6
                  PAR(206 + I) = FN(I)
                END DO
              END IF
C * SET TETR (POLY)
            ELSE IF (N213 .EQ. 'TET') THEN
              DO I = 1, 4
               IF (FN(I) .NE. 0.0) PAR(213 + I) = FN(I)
              END DO
C * SET OCTA (POLY)
            ELSE IF (N213 .EQ. 'OCT') THEN
              DO I = 1, 4
                IF (FN(I) .NE. 0.0) PAR(217 + I) = FN(I)
              END DO
C * SET LABEL SIZE
            ELSE IF (N213 .EQ. 'LAB') THEN
              IF (IPR(220) .EQ. 3 .AND. IFL(3)(1:1) .EQ. 'S') THEN
                WRITE (LU6, 99994, IOSTAT = IOST) PAR(349)
                IF (IPR(221) .EQ. 1) THEN
                  PAR(349) = FN(1)
                  WRITE (LU6, 99993, IOSTAT = IOST) PAR(349)
                END IF
              END IF
C * SET PRINTER LEVEL (0,1,2,3,4)
            ELSE IF (N213 .EQ. 'PRI') THEN
              IF (IPR(220) .EQ. 3) THEN
                IF (IFL(3)(1 : 1) .EQ. 'L') THEN
                  IF (IPR(221) .GT. 0) THEN
                    IGBL(64) = NINT(FN(1))
                    IGBL(63) = IGBL(64)
                  END IF
                END IF
              END IF
C * SET REVERSE
            ELSE IF (N213 .EQ. 'REV') THEN
              IGBL(68) = MOD (IGBL(68) + 1, 2)
              CALL GGIP (-999.0, FLOAT(IGBL(68)), IGBL(62) * 0.25, 9)
C * SET IPR/PAR/IGBL/RGBL
            ELSE IF (IPR(221) .EQ. 2 .AND. IPR(220) .EQ. 2) THEN
              CALL PLA206 (1, N213)
C * SET PROBABILITY (10 <--> 90 PERCENT)
            ELSE IF (IPR(221) .EQ. 1 .AND. IPR(220) .EQ. 2) THEN
              IF (N213 .EQ. 'PRO') THEN
                IPR(45)  = MAX (1, MIN (9, NINT(FN(1) / 10)))
                IPR(201) = 0
C * SET WINDOW FRACTION
              ELSE IF (N213 .EQ. 'WIN') THEN
                CALL GGIP (-999.0, FLOAT(IGBL(68)), FN(1) * 1000.0, 9)
                IGBL(62) = MIN (MAX (1, NINT(FN(1) / 0.25)), 4)
              END IF
            ELSE IF (IPR(220) .EQ. 3) THEN
              SELECT CASE (N213)
C * SET BEEP ON/OFF
                CASE ('BEE')
                  MEDIUM = 0
C * SET DISPLAY TYPE
                CASE ('DIS')
                  MEDIUM = 1
C * SET META TYPE
                CASE ('MET')
                  MEDIUM = 2
              END SELECT
              IF (IPR(220) .GT. 2) CALL GGIP (-999.0, 0.0, 0.0, 6)
            END IF
            GO TO 280
C * IS = 47: AFIX CARD (SHELX)
          CASE (47)
            IGBL(8) = 2
C * IS = 48: SFAC CARD (SHELX) OR IS = 172: SCAT
          CASE (48, 172)
            IF (IS .EQ. 48) IGBL(8) = 2
            IF (IPR(141) .EQ. 0 .AND. IGBL(8) .EQ. 2) THEN
              IDM = 'LATT 1'
              CALL SGSM (IDM, 0, XJX, 0, 0, IERR)
              IPR(141) = 1
              CALL PLA271
            END IF
            M = IPR(221)
            IF (IPR(220) .GT. 1) THEN
              DO I = 2, IPR(220)
                N12 = 0
                CALL GEN105 (1, IFL(I)(1:1), N)
                IF (N .GT. 0) N12 = (N - ICHAR('A') + 1) * 100
                CALL GEN105 (1, IFL(I)(2:2), N)
                IF (N .GT. 0) N12 = N12 + N - ICHAR('A') + 1
                IF (N12 .EQ. 815) IPR(435) = 1
                IUNKNOWN = 1
                DO J = 1, NP9
                  IF (IEL(J) .EQ. N12) THEN
                    IAN          = IAN + 1
                    IEN(IAN)     = J
                    RADR(IAN, 3) = REL(J)
                    RADR(IAN, 4) = ABS(VDWR(J))
                    IF (IFL(I)(2:2) .EQ. ' ') THEN
                      LMT(IAN, 1) = ' '//IFL(I)(1:1)
                    ELSE
                      LMT(IAN, 1) = IFL(I)(1:2)
                      CALL GEN020 (-1, LMT(IAN, 1), 2, 2)
                    END IF
                    LMT(IAN, 2) = JTP(IABS(IATPR(J)))
                    IF (J .EQ. 3) THEN
                      IACL(IAN) = 2
                    ELSE IF (J .EQ. 4) THEN
                      IACL(IAN) = 4
                    ELSE IF (IATPR(J) .EQ. -7) THEN
                      IACL(IAN) = 3
                    ELSE IF (J .GT. 2) THEN
                      IF (ICLR .LT. 8) ICLR = ICLR + 1
                      IACL(IAN) = ICLR
                    END IF
                    IUNKNOWN = 0
                  END IF
                END DO
                IF (IUNKNOWN .EQ. 1) THEN
                  IPR(2) = 41
                  GO TO 300
                END IF
              END DO
              IF (IPR(220) .EQ. 2 .AND. IPR(221) .GT. 0
     1          .AND. FN(1) .EQ. 0.0) IPR(493) = 6
            END IF
C * IS = 49: UNIT CARD (SHELX)
          CASE (49)
            IGBL(8) = 2
            DO I = 1, IPR(221)
              CONT(I, 3) = FN(I) * PAR(32)
            END DO
C * IS = 50: WGHT CARD (SHELX)
          CASE (50)
            IGBL(8)  = 2
            IPR(632) = 1
            PAR(497) = FN(1)
            PAR(498) = FN(2)
            PAR(499) = FN(3)
C * IS = 51: VIEW CARD(S)
          CASE (51)
C * VIEW MIN
            IF (IFL(2)(1:3) .EQ. 'MIN') THEN
              IPR(201) = 0
              IGBL(67) = 0
            ELSE
C * VIEW (XR xr YR yr ZR zr)
              N = 1
              IF (IPR(220) .EQ. 1) THEN
                CALL PLA226 (0, 0.0)
              ELSE
                CALL GEN021 (RMAT, IGBL(87))
                DO L = 1, 3
                  CALL GEN051 (0, RMAT, - RGBL(27 + L) / RGBL(6), L)
                END DO
                DO I = 2, IPR(220)
                  SELECT CASE (IFL(I)(1:3))
                    CASE ('UNI')
                      CALL PLA226 (0, 0.0)
                    CASE ('INV')
                      CALL PLA226 (-4, 0.0)
                    CASE ('XR ', 'XRO')
                      CALL PLA226 (-1, - FN(N) / RGBL(6))
                      N = N + 1
                    CASE ('YR ', 'YRO')
                      CALL PLA226 (-2, - FN(N) / RGBL(6))
                      N = N + 1
                    CASE ('ZR', 'ZRO')
                      CALL PLA226 (-3, - FN(N) / RGBL(6))
                      N = N + 1
                  END SELECT
                END DO
              END IF
            END IF
            GO TO 280
C * IS = 52: BOX ON/OFF (1/0)
          CASE (52)
            IF (IPR(220) .GT. 1) THEN
              DO I = 2, IPR(220)
                SELECT CASE (IFL(I)(1:3))
C * BOX OFF
                  CASE ('OFF')
                    IGBL(103) = 0
C * BOX ON
                  CASE ('ON ')
                    IGBL(103) = 1
C * BOX RATIO
                  CASE ('RAT')
                    PAR(50) = FN(1)
                END SELECT
              END DO
            END IF
            GO TO 280
C * IS = 54: BOND CARD (SHELX)
          CASE (54)
            IGBL(8) = 2
C * IS = 55: ZERR (SHELXTL/SHELXL)
          CASE (55)
            DO I = 2, 7
              PAR(105 + I) = FN(I)
            END DO
            IGBL(8) = 2
C * IS = 56: GEOM
          CASE (56)
            GO TO 50
C * IS = 57: L.S. CARD (SHELX)
          CASE (57)
            IGBL(8) = 2
C * IS = 58: FMAP CARD (SHELX)
          CASE (58)
            IGBL(8) = 2
C * IS = 59: INFO
          CASE (59)
            IS = 29
            GO TO 20
C * IS = 60: TABLE OPTION
          CASE (60)
            IF (IPR(30) .NE. 0) THEN
              IPR(2) = 31
              GO TO 300
            END IF
            IPR(430) = 1
            IF (IPR(72) .EQ. 0) WRITE (LU6, 99962, IOSTAT = IOST)
            IPR(454) = 1
            IPR(240) = 1
            IPR(71) = 0
            IF (IPR(220) .GT. 1) THEN
              DO I = 2, IPR(220)
                SELECT CASE (IFL(I)(1:3))
C * NO-HATOM
                  CASE ('NHA')
                    IPR(454) = 0
C * RESIDUE SORT/LISTING (NORES)
                  CASE ('NOR')
                    IPR(240) = 0
                  CASE ('SUP')
C * SU  (FULL SUPPLEMENTARY MATERIAL)
                    IPR(431) = 1
                  CASE ('ACC', 'CIF')
C * ACC (ACTA CRYST C - CIF) - NOPARENTHESES
                    IPR(430) =  1
                    IPR(431) = -1
                    IGBL(31) = 8
C * LOCAL
                  CASE ('LOC')
                    IPR(399) = 1
                END SELECT
              END DO
            END IF
            IF (IPR(30) .EQ. 0) THEN
              IPR(220)  = 2
              IFL(2)    = 'OMEGA'
              GO TO 120
            ELSE
C * EXECUTE TABLE OPTIONS
              IF (IPR(430) .GT. 0) THEN
                IPR(31)  = -1
                IPR(17)  = -1
                IPR(90)  =  1
                IGBL(63) =  0
                CALL PLA066
                IF (IPR(2) .NE. 0) RETURN
                CALL PLA172
                IPR(1)  = 1
                IF (IPR(2) .EQ. 0) IPR(2) = -1
                IGBL(1) = 3
                RETURN
              END IF
              RETURN
            END IF
C * IS = 61: RADII BONDS ((LIST/NORMAL/TO H/TO MET/ALL) (#lines (radius)))
          CASE (61)
            DO I = 3, IPR(220)
              SELECT CASE (IFL(I)(1:3))
C * RADII BONDS TO H
                CASE ('H  ')
                  J0 = 3
                  J1 = 3
C * RADII BONDS TO METAL
                CASE ('MET')
                  J0 = 5
                  J1 = 5
C * NORMAL
                CASE ('NOR')
                  J0 = 1
                  J1 = 1
                CASE ('ALL')
                  J0 = 1
                  J1 = 5
                CASE DEFAULT
                  CYCLE
              END SELECT
              DO J = J0, J1, 2
                IF (IPR(221) .GT. 0) THEN
                  IF (ABS(FN(1)) .GT. 5.0) FN(1) = SIGN (5.0, FN(1))
                  PAR(84 + J) = FN(1)
                END IF
                IF (IPR(221) .GT. 1) PAR(85 + J) = FN(2)
              END DO
              IF (.TRUE.) EXIT
            END DO
            WRITE (PRBUF, 99977, IOSTAT = IOST)
            IF (IWIN .EQ. 1) THEN
              CALL GGIP (HORS, VERT, 0.0, 1)
              VRT = VERT - 3.0
              CALL GGIP09 (0.0, PRBUF, 75, 0.35, 5 + IGBL(68), 2,
     1           1.0, VRT)
            ELSE
              WRITE (LU6, 99939, IOSTAT = IOST) PRBUF(1:75)
            END IF
            WRITE (PRBUF, 99976, IOSTAT = IOST)
     1        NINT(PAR(85)), 2**NINT(ABS(PAR(85)) - 1) + 1, PAR(86)
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 1.5
              CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
            ELSE
              WRITE (LU6, 99939, IOSTAT = IOST) PRBUF(1:75)
            END IF
            WRITE (PRBUF, 99975, IOSTAT = IOST)
     1        NINT(PAR(87)), 2**NINT(ABS(PAR(87)) - 1) + 1, PAR(88)
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 1.5
              CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
            ELSE
              WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
            END IF
            IF (IPR(155) .GT. 0) THEN
              WRITE (PRBUF, 99974, IOSTAT = IOST)
     1          NINT(PAR(89)), 2**NINT(ABS(PAR(89)) - 1) + 1, PAR(90)
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 1.5
                CALL GGIP09 (0.0, PRBUF, 75, 0.35, 1, 2, 1.0, VRT)
              ELSE
                WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:75)
              END IF
            END IF
            IF (IWIN .EQ. 1) CALL PLA297 (1)
            GO TO 280
C * IS = 62: BLOC CARD (SHELX)
          CASE (62)
            IGBL(8) = 2
C * IS = 63: MENU (ON/OFF)
          CASE (63)
            IF (IPR(220) .EQ. 2 .AND. IFL(2)(1:3) .EQ. 'OFF') THEN
              IGBL(25)    = 0
            ELSE
              IGBL(25) = 1
              IF (IGBL(6) .LT. 10 .OR. IGBL(6) .GT. 12)
     1          CALL PLA280 ('PLOT')
            END IF
C * IS = 64: OMIT CARD
          CASE (64)
            IF (IGBL(8) .EQ. 2) IPR(220) = 1
            N = IPR(220)
            IF (N .GT. 1) THEN
              IF (IPR(30) .EQ. 0) THEN
                IF (IPR(37) .EQ. 0) THEN
                  IPR(2) = 42
                  GO TO 300
                END IF
                IGBL(52) = MAX (IGBL(52), IPR(23))
                CALL PLA287 (0, 1, 0)
              END IF
              DO I = 2, N
                CALL PLA046 (2, IFL(I), IENM, LBB, LBC, LBD,
     1                          INQNR, JNQNR, NR)
                IF (NR .GT. 0) THEN
                  CALL GEN048 (1, IFG(1, NR), 30, 1)
                ELSE
                  WRITE (LU6, 99937) ICL(1:50)
                  CALL PLA015 (0, 28)
                END IF
              END DO
            ELSE
              M = IPR(221)
              IF (M .EQ. 2) THEN
                PAR(165) = FN(2) / 2.0
                IGBL(8)  = 2
              ELSE IF (M .EQ. 3) THEN
                IF (IPR(620) .LT. 50) THEN
                  IPR(620) = IPR(620) + 1
                  DO I = 1, 3
                    IHKLOMIT(I, IPR(620)) = NINT (FN(I))
                  END DO
                END IF
              END IF
            END IF
C * IS = 65: GRID CARD (SHELX)
          CASE (65)
            IGBL(8) = 2
C * IS = 66: DFIX CARD (SHELX)
          CASE (66)
            IGBL(8) = 2
C * IS = 67: JOIN ATOMS
          CASE (67)
            MODEB = 1
            GO TO 270
C * IS = 68: DETACH ATOMS
          CASE (68)
            MODEB = -1
            GO TO 270
C * IS = 69: DEFINE SUBSTITUTE BOND
          CASE (69)
            MODEB = -1
            GO TO 270
C * IS = 70: HKLF - LINE
          CASE (70)
            CALL PLA080
            IF (IPR(221) .GE. 11) THEN
              DO K = 1, 9
                I        = ((K - 1) / 3)  + 1
                J        = MOD (K - 1, 3) + 1
                QQ(I, J) = FN(K + 2)
              END DO
            ELSE
              CALL GEN021 (QQ, 1)
            END IF
            CALL GEN004 (TM1, QQ, DUMV)
            K = 0
            DO I = 1, 3
              DO J = 1, 3
                K = K + 1
                PAR(230 + K) = DUMV(I, J)
              END DO
            END DO
            WRITE (LU6, 99960, IOSTAT = IOST) (PAR(230 + I), I = 1, 9)
            CALL GEN003 (DUMV, QQ, DET, 0)
            PAR(240) = DET
            IF (ABS(ABS(DET) - 1.0) .GT. 0.001)
     1        WRITE (LU6, 99944, IOSTAT = IOST) DET
            IF (DET .LT. 0.0) THEN
              IPR(2) = 40
              GO TO 300
            END IF
            CALL GEN001 (1, QQ, AA, RAA)
            CALL GEN026 (-1, RAA, PAR(241))
            CALL GEN003 (RAA, RBB, DET, 0)
            IF (DET .LE. 0.0)
     1       CALL GEN127 ('CANNOT INVERT METRICAL MATRIX')
            CALL GEN026 (-1, RBB, PAR(135))
            WRITE (LU6, 99959, IOSTAT = IOST) (PAR(100 + I), I = 1, 6),
     1                         (PAR(240 + I), I = 1, 6)
            CALL GEN025 (RBB, PAR(391), 1)
            IF (NINT(FN(1)) .EQ. 4) CALL PLA286
C * IS = 71: RADN LINE
          CASE (71)
            CALL PLA293 (FN(1))
C * IS = 72: TRMX
          CASE (72)
            IS = 42
            GO TO 20
C * IS = 73: PART - SHELXL STYLE
          CASE (73)
            IPR(612) = NINT(FN(1))
C * IS = 74: INORG (FORCE INORGANIC MODE)
          CASE (74)
            IGBL(97) = 0
C * IS = 75: ORGA (FORCE ORGANIC MODE)
          CASE (75)
            IGBL(97) = 1
C * IS = 78: ENTRY (CSD-FDAT-FILE ENTRY)
          CASE (78)
            CALL PLA009
            IF (ICL(1:4) .EQ. 'END ') GO TO 290
C * IS = 79: ELLIPSOID PARAMETERS
          CASE (79)
            IF (IPR(220) .GT. 1) THEN
              SELECT CASE (IFL(2)(1:3))
                CASE ('C  ')
                  N = 175
                CASE ('H  ')
                  N = 177
                CASE ('OTH')
                  N = 179
              END SELECT
              IF (IPR(221) .GT. 1) THEN
                IPR(N)     = MAX (0, MIN (1, NINT(ABS(FN(1)))))
                IPR(N + 1) = NINT(ABS(FN(2)))
              END IF
            END IF
            WRITE (LU6, 99964, IOSTAT = IOST) (IPR(174 + I), I = 1, 6)
C * IS = 80: ORMA - CAD4 ORIENTATION MATRIX (Reciprocal Axes)
          CASE (80)
            IF (IPR(221) .EQ. 9) THEN
              DO I = 1, 9
                PAR(180 + I) = FN(I)
                J = MOD (I - 1, 3) + 1
                K = ((I - 1) / 3)  + 1
                DAM(J, K)    = FN(I)
              END DO
              CALL GEN003 (DAM, DUMV, DET, 0)
              IF (DET .LE. 0.0) CALL GEN127 ('CANNOT INVERT ORMA')
              WRITE (LU6, 99963, IOSTAT = IOST) 1.0 / DET
              IPR(16) = 1
            ELSE
              IPR(2) = 5
              GO TO 300
            END IF
C * IS = 81: EXTI CARD (SHELXL)
          CASE (81)
            PAR(229) = FN(1)
C * IS = 82: SETUP (EXOR.BIN)
          CASE (82)
            CALL PLA150 (0)
            GO TO 310
C * IS = 83: EXOR
          CASE (83)
            CALL PLA150 (1)
            GO TO 310
C * IS = 84: ABSG(AUSS)
          CASE (84)
            CALL PLA286
            PAR(162) = FN(1)
            IF (IPR(221) .EQ. 4) THEN
              DO I = 2, 4
                IPR(419 + I) = NINT(FN(I))
              END DO
            END IF
            IF (IGBL(37) .EQ. 0) THEN
              IPR(2)  = 56
              IGBL(1) = 3
              RETURN
            END IF
            PAGET   = 'ABSGAUSS'
            IPR(78) = 2
            GO TO 90
C * IS = 85: FACE CARD
          CASE (85)
            IF (FN(4) .LE. 0) THEN
              IPR(2) = 34
              GO TO 310
            END IF
            IF (NFACES .GT. 0) THEN
              DO I = 1, NFACES
                DIFF = 0.0
                DO J = 1, 3
                  DIFF = DIFF + ABS(PMILL(I, J) - FN(J))
                END DO
                IF (DIFF .LT. 0.001) GO TO 10
              END DO
            END IF
            IPR(367) = IPR(367) + 1
            NFACES   = IPR(367)
            DO J = 1, 4
              PMILL(NFACES, J) = FN(J)
            END DO
            PMILL(NFACES, 5) = FN(4)
C * IS = 86: ABST (de MEULENAER-TOMPA)
          CASE (86)
            CALL PLA286
            PAR(162) = FN(1)
            IF (IGBL(37) .EQ. 0) THEN
              IPR(2)  = 56
              IGBL(1) = 3
              RETURN
            END IF
            PAGET   = 'ABSTOMPA'
            IPR(78) = 3
            GO TO 90
C * IS = 87: ABSXTAL
          CASE (87)
            PAR(162) = FN(1)
            IPR(78)  = 1
            GO TO 90
C * IS = 88: LEPAGE METRICAL SYMMETRY ANALYSIS
          CASE (88)
            IGBL(6)  = 20
            IPR(2)   = -1
            IPR(94)  = 2
            IF (FN(1) .NE. 0.0) PAR(441) = FN(1)
            IF (FN(2) .NE. 0.0)
     1        IPR(94)  = MAX (2, MIN (10, NINT(FN(2))))
            IF (FN(3) .NE. 0.0) PAR(439) = FN(3)
            CALL PLA080
            CALL SGSM (ICL, 0, XJX, LU7, 18, IERR)
            CALL PLA164 (0, 0, ICL(13:13), TM1, PAR(439), ' ')
            CALL GEN038 (ICL, 1, 80)
            RETURN
C * IS = 89: ASYM
          CASE (89)
            MODE = 0
            IF (PAR(168) .GT. 0.0) THEN
              IF (IPR(220) .GT. 1) THEN
                IF (IFL(2)(1:5) .EQ. 'VALID') THEN
                  IFL(4) = IFL(2)
                  MODE   = 3
                ELSE IF (IPR(220) .EQ. 3) THEN
                  IF (IFL(2)(1:3) .EQ. 'AVF' .AND.
     1                IFL(3)(1:5) .EQ. 'VALID') THEN
                    MODE = 2
                  ELSE IF (IFL(2)(1:5) .EQ. 'VALID' .AND.
     1                   IFL(3)(1:3) .EQ. 'AVF') THEN
                    MODE = 2
                  END IF
                ELSE IF (IFL(2)(1:6) .EQ. 'EXPECT') THEN
                  MODE = 1
                END IF
              END IF
            END IF
            CALL PLA145 (MODE)
            IF (IPR(2) .EQ. 0) IPR(2) = -14
            IGBL(1) = 3
            RETURN
C * IS = 90: ABSPSI
          CASE (90)
            CALL PLA286
            IF (IGBL(37) .EQ. 0) THEN
              IPR(2)  = 56
              IGBL(1) = 3
              RETURN
            END IF
            PAGET   = 'ABSPSI'
            IPR(78) = 4
            GO TO 90
C * IS = 91: ABSSPHERE
          CASE (91)
            IPR(78) = -1
            GO TO 90
C * IS = 92: CONTOUR-PLOTS
          CASE (92)
            CALL PLA250
            IF (IPR(2) .NE. 0) THEN
              IGBL(1) = 3
              RETURN
            END IF
            IF (IGGT(1:4) .EQ. 'EXIT') THEN
              IGBL(1) = 3
              RETURN
            END IF
            IF (IGBL(3) .GE. 19 .AND. IGBL(3) .LE. 22) THEN
              IGBL(1) = 3
              RETURN
            ELSE
              IGBL(54) = IGBL(54) - 1
              CALL PLA280 ('RESTART')
            END IF
C * IS = 93: RESTART
          CASE (93)
            CALL GEN108 (LU1,  0)
            REWIND (UNIT = LU2, IOSTAT = IOST)
            IF (IOST .NE. 0) CALL GEN148 (LU2, 1)
            CALL GEN108 (LU20, 0)
            IF (IABS(IGBL(8)) .EQ. 3) IGBL(8) = 3
            WRITE (LU6, 99961, IOSTAT = IOST)
            IGBL(1) = 1
            RETURN
C * IS = 94: VALIDATION CHECK MODE (FOR ACTA CRYST ETC)
          CASE (94)
            IF (IGBL(30) .EQ. 1) THEN
              IPR(71)  = 0
              IGBL(36) = 1
              LINE = NAMEFIL(1:KNMFIL)//'.chk'
              WRITE (LU6,
     1         '(/, '' >> CIF-Validation-Check Result on '', A)',
     2         IOSTAT = IOST) LINE
              IGBL(64) = 0
              IGBL(63) = IGBL(64)
              GO TO 120
            ELSE
              CALL PLA015 (0, 47)
              IGBL(3) = 0
              GO TO 10
            END IF
C * IS = 95: EXPT - CALCULATE EXPECTED NUMBER OF REFLECTIONS
          CASE (95)
            CALL PLA086 (LU6)
            CALL PLA086 (LU7)
            IGBL(1) = 3
            RETURN
C * IS = 96: PLUTON
          CASE (96)
            GO TO 100
C * IS = 99: TWIN
          CASE (99)
            DO I = 1, 9
              PAR(331 + I) = FN(I)
            END DO
            IF (IPR(221) .EQ. 0) THEN
              PAR(332) = -1.0
              PAR(336) = -1.0
              PAR(340) = -1.0
            END IF
            IPR(193) = IPR(193) + 1
C * IS = 103: RESI
          CASE (103)
            IPR(538) = NINT(FN(1))
C * IS = 104: SHEL (SHELXL)
          CASE (104)
            IF (IPR(221) .EQ. 2 .AND. FN(2) .GT. 0.0) THEN
              PAR(165) = ASIN (PAR(17) / (2.0 * FN(2))) * RGBL(6)
              IGBL(8)  = 2
            END IF
C * IS = 112: CRYSTAL SIZE
          CASE (112)
            IF (IPR(221) .EQ. 3) THEN
              CALL GEN034 (FN, 1, 3)
              DO I = 1, 3
                PAR(301 + I) = FN(I)
              END DO
            END IF
C * IS = 132: TEMP (SHELX ==> DEG. C) ([C]/K)
          CASE (132)
            IF (IFL(2)(1:1) .EQ. 'K') THEN
              IPR(261) = NINT(FN(1))
            ELSE
              IPR(261) = NINT(FN(1)) + 273
            END IF
C * IS = 142: BASF
          CASE (142)
            IF (IPR(221) .GT. 0) THEN
              DO I = 1, IPR(221)
                BASF(I) = FN(I)
              END DO
              IPR(513) = IPR(221)
              PAR(341) = FN(1)
              IPR(193) = IPR(193) + 1
            END IF
C * IS = 146: HALL
          CASE (146)
            IS = 32
            GO TO 20
C * IS = 148: MULABS
          CASE (148)
            CALL PLA286
            IF (IPR(220) .GT. 1) THEN
              DO I = 2, IPR(220)
                IF (IFL(I)(1:5) .EQ. 'LIST')    IGBL(57) = 1
                IF (IFL(I)(1:7) .EQ. 'NOCHECK') IPR(363) = 0
              END DO
            END IF
            IF (IGBL(37) .EQ. 0) THEN
              IPR(2)  = 56
              IGBL(1) = 3
              RETURN
            END IF
            IPR(78) = -2
            CALL PLA080
            CALL PLA042 (1)
            PAGET = 'MULABS'
            CALL PLA187
            IF (IPR(2) .EQ. 0) IPR(2) = -4
            IGBL(1) = 3
            RETURN
C * IS = 149: HKLFTRANS
          CASE (149)
            IF (IABS(IGBL(8)) .EQ. 2) THEN
              CALL PLA042 (1)
              CALL PLA201
              IF (IPR(2) .EQ. 0) IPR(2) = -15
            ELSE
              IPR(2) = 72
            END IF
            IGBL(1) = 3
            RETURN
C * IS = 150: XTAL-HABIT PLOT
          CASE (150)
            IPR(78) = 0
            CALL PLA190
            IGBL(1) = 4
            RETURN
C * IS = 151: HINCLUDE (ORTEP)
          CASE (151)
            DO I = 2, IPR(220)
              CALL PLA046 (3, IFL(I), IENM, LBB, LBC, LBD,
     1                        INQNR, JNQNR, N1)
              CALL GEN048 (1, IFG(2, N1), 12, 1)
            END DO
            GO TO 280
C * IS = 152: HEXCLUDE (ORTEP)
          CASE (152)
            DO I = 2, IPR(220)
              CALL PLA046 (3, IFL(I), IENM, LBB, LBC, LBD,
     1                        INQNR, JNQNR, N1)
              CALL GEN048 (1, IFG(2, N1), 12, 0)
            END DO
            GO TO 280
C * IS = 153: FILE
          CASE (153)
            CALL PLA004 (1)
            IGBL(8)      = 0
            IGBL(19)     = 1
            I0 = 1
            I1 = 0
            CALL GEN039 (0, ICL, 5, 80, I0, I1)
            FILENAMES(1) = ICL(I0:I1)
            CALL PLA261 (IGBL(19))
            IGBL(1) = -1
            RETURN
C * IS = 154: RENAME (RES)
          CASE (154)
            IF (IABS(IGBL(8)) .EQ. 2) THEN
              IGBL(3)   = 12
              IGBL(105) = 1
              GO TO 100
            END IF
C * IS = 155: SYSTEM S
          CASE (155)
            IGBL(3) = 14
            CLOSE (UNIT = LU1)
            CLOSE (UNIT = LU2)
            CLOSE (UNIT = LU3)
            CLOSE (UNIT = LU4)
            CLOSE (UNIT = LU8)
            CLOSE (UNIT = LU9)
            CLOSE (UNIT = LU16)
            CLOSE (UNIT = LU21)
            CLOSE (UNIT = LU22)
            CALL S
            IGBL(1) = 4
            RETURN
C * IS = 156: DELAUNEY REDUCTION
          CASE (156)
            IF (IPR(221) .GT. 0) THEN
              PAR(382) = FN(1)
              IF (IPR(221) .EQ. 2) PAR(381) = FN(2)
            END IF
            CALL PLA080
            CALL SGSM (ICL, 0, XJX, LU7, 18, IERR)
            CALL PLA079 (ICL(13:13), LU7)
            RETURN
C * IS = 157: EXPAND ASYMMETRIC UNIT CONTENTS TO P1
          CASE (157)
            CALL PLA208
            IGBL(1) = 3
            RETURN
C * IS = 158: ARU
          CASE (158)
            CALL PLA295
C * IS = 159: ANALYSIS OF VARIANCE
          CASE (159)
            CALL PLA111 (0)
            IGBL(1) = 3
            RETURN
C * IS = 160: FCF2HKL
          CASE (160)
            IF (IPR(664) .NE. 0) THEN
              CLOSE (LU25, STATUS = 'DELETE', IOSTAT = IOST)
              IPR(664) = 0
            END IF
            OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sx.hkl',
     1        STATUS = 'UNKNOWN', IOSTAT = IOST)
            CALL PLA134 (LU6, LU16, LU61, IPR(384))
            CLOSE (UNIT = LU61)
            IF (IPR(2) .EQ. 0) IPR(2) = -16
            IGBL(1) = 4
            RETURN
C * IS = 161: PORTRAIT
          CASE (161)
            IGBL(46) = MOD(IGBL(46) + 1, 2)
            PAR(50) = (4.0 - IGBL(46)) / 3.0
            NN = 4 - IGBL(46) * 8
            CALL GGIP (-999.0, 0.0, 0.0, NN)
C * IS = 162: SIMULATED POWDER-PATTERN
          CASE (162)
            IF (IPR(23) .EQ. 0) THEN
              IF (IPR(220) .EQ. 2 .AND. IFL(2)(2:4) .EQ. 'OBS') THEN
                IPR(511) = 1
                IPR(220) = 1
                IPR(393) = 1
                IPR(408) = -1
              END IF
              CALL PLA149
            END IF
            IF (IGBL(3) .EQ. 31) THEN
              IGBL(1) = 4
            ENDIF
            RETURN
C * IS = 163: FSUM
          CASE (163)
C * IS = 164: SCAL
          CASE (164)
            IS = 1
            GO TO 20
C * IS = 165
          CASE (165)
            IS = 1
            GO TO 20
C * IS = 166: TWINROTMAT
          CASE (166)
            CALL PLA111 (1)
            IGBL(1) = 3
            RETURN
C * IS = 167: CAVITY
          CASE (167)
            CALL PLA207
            CALL PLA280 ('RESTART')
C * IS = 168: SHXABS
          CASE (168)
            CALL PLA184
            IGBL(1) = 3
            RETURN
C * IS = 169: DELETE ATOM (ORTEP/SOLV)
          CASE (169)
            N = IPR(220)
            IF (N .GT. 1) THEN
              DO I = 2, N
                CALL PLA046 (2, IFL(I), IENM, LBB, LBC, LBD,
     1                         INQNR, JNQNR, NR)
                IF (NR .GT. 0) THEN
                  CALL GEN048 (1, IFG(2, NR), 27, 1)
                ELSE
                  CALL PLA015 (0, 28)
                END IF
              END DO
            END IF
C * IS = 170: COLOR TYPE INSTRUCTION
          CASE (170)
            N = IPR(220)
            IF (MOD (N, 2) .EQ. 0 .AND. N .GE. 4) THEN
              DO 30 I = 3, N, 2
                NQ1 = IFL(I)(1:2)
                NQ2 = IFL(I + 1)(1:3)
                IF (NQ1(2:2) .EQ. ' ') THEN
                  NQ1 = ' '//IFL(I)(1:1)
                ELSE
                  CALL GEN020 (-1, NQ1, 2, 2)
                END IF
                DO J = 1, IAN
                  IF (NQ1(1:2) .EQ. LMT(J, 1)) THEN
                    DO K = 1, NP10 + 1
                      IF (NQ2(1:3) .EQ. COLR(K)(1:3)) THEN
                        IACL(J) = K
                        GO TO 30
                      END IF
                    END DO
                  END IF
                END DO
   30         CONTINUE
            END IF
C * IS = 171: RESET
          CASE (171)
            CALL PLA011 (0)
            GO TO 290
C * IS = 173: STIDY (Structure Tidy - Parthe & Gelato)
          CASE (173)
            IGBL(30) = 1
            IPR(68)  = 0
            NAT      = IPR(37)
            EXTENS1  = EXTENS
            EXTENS   = 'sty'
            KXT      = 3
            CALL PLA066
            IF (IPR(2) .NE. 0) RETURN
            OPEN (UNIT = LU64,
     1        FILE = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT),
     2        STATUS = 'UNKNOWN')
            IDM = SPGRNM(1)(15:26)
            CALL GEN020 (1, IDM, 1, 16)
            WRITE (LU64, 99971, IOSTAT = IOST) IDM(1:16), JID(1:40)
            WRITE (LU64, 99970, IOSTAT = IOST) (PAR(I), I = 101, 106)
            IF (IPR(202) .NE. 0) THEN
              IW = ISETS (1, IPR(202))
              IF (IW .LT. 0 .OR. IW .EQ. 15)
     1          WRITE (LU64, 99941, IOSTAT = IOST)
            END IF
            DO I = 1, NAT
              CALL GEN048 (-7, IFG(2, I), 1, IPOP)
              IDIS = IPPR (IPOP + 1, 1)
              CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, 0, 0, 0, 0)
              IF (IDIS .LT. 1000) THEN
                WRITE (LU64, 99969, IOSTAT = IOST) NQ1(1:6),
     1            (XXO(I, J), J = 1, 3), IDIS / 1000.0
              ELSE
                WRITE (LU64, 99969, IOSTAT = IOST) NQ1(1:6),
     1            (XXO(I, J), J = 1, 3)
              END IF
            END DO
            WRITE (LU64, 99968, IOSTAT = IOST)
            CLOSE (UNIT = LU64)
            IWIN = IGBL(25) * IGBL(32)
            CALL PLA301
            WRITE (LU6, 99967, IOSTAT = IOST)
     1        NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
            EXTENS = EXTENS1
            IF (IPR(2) .EQ. 0) IPR(2) = -1
            IGBL(1) = 3
            RETURN
C * IS = 174: BIJVOET PAIR ANALYSIS
          CASE (174)
            CALL PLA111 (-1)
            IGBL(1) = 3
            RETURN
C * IS = 175: FLIPPER (FLIP PATT / FLIP SHOW)
          CASE (175)
            IF (IGBL(80) .NE. 0) CALL PLA350
            IGBL(1) = 3
            RETURN
C * IS = 176: STRUCTURE?
          CASE (176)
            IF (IGBL(80) .NE. 0) CALL PLA350
            IGBL(1) = 3
            RETURN
C * IS = 178: STRAIN
          CASE (178)
            IF (CELAB(1, 1) .GT. 0.0 .AND. TEMPAB(1) .NE. TEMPAB(2))
     1        THEN
              DO I = 1, 2
                MORT = 3 - I
                CALL PLA284 (MORT, JID)
              END DO
            ELSE
              WRITE (LU6, 99940, IOSTAT = IOST)
            END IF
            IGBL(1) = 3
            RETURN
C * IS = 179: CELA (STRAIN)
          CASE (179)
            DO I = 1, 6
              CELAB(1, I) = FN(I)
            END DO
            TEMPAB(1) = FN(7)
            IPR(221)  = 6
            IS        = 30
            GO TO 20
C * IS = 180: CELB (STRAIN)
          CASE (180)
            DO I = 1, 6
              CELAB(2, I) = FN(I)
            END DO
            TEMPAB(2) = FN(7)
C * IS = 181: CSUA (STRAIN)
          CASE (181)
            DO I = 1, 6
              VCAB(1, I) = FN(I)
            END DO
            ICV(1) = 1
C * IS = 182: CSUB (STRAIN)
          CASE (182)
            DO I = 1, 6
              VCAB(2, I) = FN(I)
            END DO
            ICV(2) = 1
C * IS = 183: CIF2SHELXL
          CASE (183)
            CALL PLA345
            IF (IPR(663) .EQ. -2) THEN
              IGBL(1) = 4
              RETURN
            END IF
C * IS = 184: NOEXPAND
          CASE (184)
            IGBL(136) = 1
            IPR(129)  = 1
            IGBL(30)  = 1
C * IS = 186: ANOM
          CASE (186)
            CALL PLA370 (1)
C * IS = 187: MU
          CASE (187)
            CALL PLA370 (2)
C * IS = 188: XTPLOT (SHELXT + PLOT)
          CASE (188)
            IF (IGBL(119) .NE. 0) CALL PLA205
C * IS = 189: ABIN (SHELXL COMMAND)
          CASE (189)
C * IS = 190: ANSC (SHELXL COMMAND)
          CASE (190)
C * IS = 191: ANSR (SHELXL COMMAND)
          CASE (191)
C * IS = 192: NEUT (SHELXL COMMAND)
          CASE (192)
            IPR(493) = 6
C * IS = 193: PRIG (SHELXL COMMAND)
          CASE (193)
C * IS = 194: REGU (SHELXL COMMAND)
          CASE (194)
C * IS = 195: STIR (SHELXL COMMAND)
          CASE (195)
C * IS = 196: TWST (SHELXL COMMAND)
          CASE (196)
C * IS = 197: WIGL (SHELXL COMMAND)
          CASE (197)
C * IS = 198: XNPD (SHELXL COMMAND))
          CASE (198)
C * IS = 199: HYBRID, (BYPASS)
          CASE (199, 200)
            CALL PLA258
            IF (IGBL(110) .GT. 0) CALL PLA131 (NINT(FN(1)))
            RETURN
C * IS = 201
          CASE (201)
            IGBL(8) = 2
        END SELECT
C * CATCH OTHERS
        GO TO 10
C * TEST FOR TOO MANY SPECIFIED ATOMS
   40   IF (IPR(220) .GT. NP1 + 1) THEN
          IPR(2) = 8
          GO TO 300
        END IF
        IF (IPR(30) .EQ. 0) THEN
          IF (IPR(145) .LT. NP2) THEN
            IPR(145)         = IPR(145) + 1
            XLS(1, IPR(145)) = NTYP
            DO K = 2, 9
              XLS(K, IPR(145)) = -1
            END DO
            IPR(146) = 1
            DO I = 2, IPR(220)
              CALL PLA046 (1, IFL(I), IENM, LBB, LBC, LBD,
     1                     INQNR, JNQNR, NIEN)
              IF (NIEN .LT. 0) THEN
                IF (IFL(I)(1:3) .EQ. 'DIS') THEN
                  IPR(220) = - IPR(220)
                  GO TO 50
                ELSE IF (IFL(I)(1:4) .EQ. 'WITH') THEN
                  IPR(220) = - IPR(220)
                  GO TO 50
                ELSE
C * UNSUITABLE ATOM LABEL ERROR
                  NQ1 = IFL(I)
                  IPR(2)  = 3
                  GO TO 300
                END IF
              END IF
              IPR(146) = IPR(146) + 1
              IF (IPR(146) .GT. 9) THEN
                IPR(145) = IPR(145) + 1
                IPR(146) = 2
                DO K = 1, 9
                  XLS(K, IPR(145)) = -1
                END DO
              END IF
              XLS(IPR(146), IPR(145)) = INQNR
            END DO
            WRITE (LU6, 99987, IOSTAT = IOST)
          END IF
          GO TO 10
        ELSE
          IF (NTYP .EQ. 4) THEN
            IPR(81) = - IPR(220)
            CALL PLA035 (1)
            GO TO 10
          END IF
        END IF
        IPR(220) = - IPR(220)
C * SINGLE DISTANCE, ANGLE OR TORSION ANGLE CALCULATION (+GEOM)
C * ALSO: ANGLE BETWEEN TWO CRYSTAL PLANES
   50   IF (IPR(220) .EQ. 1) THEN
          IF (IPR(221) .EQ. 6) THEN
            CALL PLA080
            ANG = 180.0 - GEN016 (FN(1), RBB, FN(4))
            WRITE (PRBUF, 99938, IOSTAT = IOST) (NINT(FN(I)), I = 1, 6),
     1        ANG
            WRITE (LU6, 99945, IOSTAT = IOST) PRBUF(1:50)
            SBCD = PRBUF(1:50)//CHAR(0)
            GO TO 10
          ELSE
            IPR(2) = 5
            GO TO 300
          END IF
        ELSE IF (IFL(1)(1:3) .EQ. 'FIT' .OR. IPR(220) .EQ. -1 .OR.
     1          (IPR(220) .GT. 1 .AND. IPR(220) .LT. 6)) THEN
          IPR(1)  = 7
          IPR(81) = IPR(220)
          GO TO 340
        ELSE
          IPR(2) = 5
          GO TO 300
        END IF
   60   IF (IGBL(8) .EQ. 3) THEN
          IF (IFL(2)(1:1) .EQ. '?') GO TO 10
          IF (IPR(221) .NE. 12 .OR.
     1        (FN(2) .EQ. 0.0 .AND. FN(3) .EQ. 0.0 .AND. FN(4) .EQ. 0
     2        .AND. FN(5) .EQ. 0 .AND. FN(6) .EQ. 0)) THEN
            IF (IPR(221) .NE. 0) THEN
              IF (IGBL(3) .EQ. 1) THEN
C * ALERT _217
                CALL PLA231 (217, 0, 1.0, 1.0, IFL(2), ' ')
              ELSE
                IPR(2) = 50
                GO TO 300
              END IF
            ELSE
              GO TO 10
            END IF
          END IF
        END IF
        CALL GEN025 (DUMV, FN, -1)
        CALL GEN001 (1, TM2, DUMV, UIJ)
        CALL GEN025 (UIJ, FN, 1)
        ICT     = 2
        IPR(32) = 2
C * SUIJ DATA
   70   IF (PAR(113) .NE. 0.0) CALL GEN144 (-1, FN(1), PAR(113))
   80   IF (IPR(30) .EQ. 1 .OR. IPR(107) .EQ. 1) THEN
          IPR(471) = IPR(471) + 1
          IF (IGBL(5) .NE. LU5) GO TO 10
C * UNKNOWN CARD ERROR
          IPR(2) = 7
          GO TO 300
        ELSE
          NQ2 = IFL(2)
          IF (IGBL(8) .EQ. 1) THEN
            IF (NQ4 .NE. NQ2) THEN
C * LABEL INCONSISTENT
              IPR(2) = 4
              GO TO 300
            END IF
            INQNR2 = INQNR
          ELSE
            MODE = 0
            CALL PLA046 (-2, NQ2, IENM, LBB, LBC, LBD,
     1                       INQNR2, JNQNR2, IDUM2)
          END IF
          IPR(32) = MAX (IPR(32), 1)
          WRITE (LU4) ICT, INQNR2, (FN(K), K = 1, 8)
          IF (IGBL(8) .EQ. 3) THEN
            IF (IS .EQ. 25) THEN
              IS = 26
              DO I = 1, 6
                FN(I) = FN(I + 6)
              END DO
C * UIJ DATA & SUIJ DATA
              CALL GEN144 (1, FN(1), PAR(135))
              IF (IS .EQ. 26) THEN
                ICT = 3
                GO TO 70
              END IF
              GO TO 60
            END IF
          END IF
          GO TO 10
        END IF
   90   IF (IPR(220) .GT. 1) THEN
          DO I = 2, IPR(220)
            IF (IFL(I)(1:5) .EQ. 'LIST')    IGBL(57) = 1
            IF (IFL(I)(1:7) .EQ. 'NOCHECK') IPR(363) = 0
          END DO
        END IF
        CALL PLA190
        IF (IPR(2) .EQ. 0) THEN
          SELECT CASE (IPR(78))
            CASE (-1)
              IPR(2) = -5
            CASE (1)
              IPR(2) = -1
            CASE (2)
              IPR(2) = -8
            CASE (3)
              IPR(2) = -7
            CASE (4)
              IPR(2) = -6
          END SELECT
        END IF
        IGBL(1) = 3
        RETURN
C * PLUTON/PLOT - TEST FOR 'PLUTON' OR 'PLUTON/RENAME' SHORTCUT
  100   IF (IFL(2)(1:3) .EQ. 'NAT') IGBL(3) = 8
        IF (IGBL(3) .EQ. 8 .OR. IGBL(3) .EQ. 12) GO TO 330
        IFL(2)   = IFL(1)
        IPR(220) = 2
C * PLOT INSTRUCTION CARD
  110   IPR(1)   = 5
        IPR(56)  = 0
        IPR(112) = 0
        IPR(205) = 0
        N        = 1
        K0       = 0
        IF (IGBL(45) .GT. 0 .AND. IGBL(5) .EQ. LU5) THEN
          IGBL(45) = IGBL(45) + 1
          WRITE (LU3, 99984, IOSTAT = IOST) ICL(1:80)
          WRITE (LU6, 99973, IOSTAT = IOST) ICL(1:70)
        END IF
        IF ((IPR(14) .EQ. 0  .OR. IPR(14) .EQ. 4) .AND.
     1       IPR(220) .EQ. 1) THEN
          IPR(220) = 2
          IFL(2)   = 'ADP'
          IF (IPR(346) .EQ. 1) THEN
            IFL(3) = 'COLOR'
            IPR(220) = 3
          END IF
        END IF
        IF (IPR(220) .GT. 1) THEN
          DO I = 2, IPR(220)
            SELECT CASE (IFL(I)(1:4))
              CASE ('RING')
                IPR(55) = 2
                IPR(14) = -1
              CASE ('PLAN')
                IPR(55) = 1
                IPR(14) = -1
              CASE ('RESD')
                IF (IPR(14) .GT. 0) THEN
                  K0 = K0 + 1
                  IF (K0 .LE. IPR(221)) IPR(140) = NINT(FN(K0))
                  IPR(201) = 0
                ELSE
                  IPR(55) = 3
                  IPR(14) = -1
                END IF
              CASE ('LSPL')
                IPR(55) = 4
                IPR(14) = -1
C * DISPLAY ON
              CASE ('DISP')
                CALL GGIP (-999.0, 0.0, 0.0, -3)
                CALL GGIP (-999.0, 0.0, 0.0, 2)
C * META ON
              CASE ('META')
                CALL GGIP (-999.0, 0.0, 0.0, -2)
              CASE ('NEWM')
                IPR(55)  = -1
                IPR(14)  = -1
                IPR(169) = 0
                IF (IPR(30) .NE. 0) CALL GEN108 (LU8, 0)
                IPR(162)    = 0
              CASE ('PERP')
                IPR(56) = 0
              CASE ('ALON')
                IPR(56) = 1
              CASE ('ADP ')
                IPR(14) = 4
              CASE ('TME ')
                IPR(14) = 4
              CASE ('POLY')
                IPR(14) = 5
              CASE ('PLUT')
                IPR(14) = 6
              CASE ('HATO')
                IPR(212) = 1
              CASE ('NOHA')
                IPR(212) = 0
              CASE ('LABE')
                IGBL(75) = 1
              CASE ('NOLA')
                IGBL(75) = 0
              CASE ('ENVE')
                IPR(211) = 1
              CASE ('HETE')
                IPR(211) = 0
              CASE ('OCTA')
                IPR(211) = 2
              CASE ('PARE')
                IPR(350) = 1
              CASE ('NOPA')
                IPR(350) = 0
              CASE ('MARG')
                IF (K0 .LT. IPR(221))  THEN
                  K0 = K0 + 1
                  PAR(44) = FN(K0)
                END IF
              CASE ('TAPE')
                IF (K0 .LT. IPR(221))  THEN
                  K0 = K0 + 1
                  PAR(48) = FN(K0)
                END IF
              CASE ('NET ')
                IPR(112) = 1
              CASE ('MONO')
                IPR(116) = 0
              CASE ('STER')
                IPR(116) = 1
              CASE ('COLO')
                IPR(346) = 1
              CASE DEFAULT
                CALL PLA037 (I, L, 2)
                IF (IPR(2) .EQ. 0) THEN
                  IF (L .LT. 0)
     1              IPR(162)  = IPR(162) * (NP1 + 1) + IABS(L)
                ELSE
                  IPR(2) = 0
                  WRITE (LU6, 99986, IOSTAT = IOST) IFL(I)
                END IF
            END SELECT
          END DO
          IF (IPR(30) .EQ. 0) THEN
            IPR(220) = 2
            IF (IPR(14) .LT. 0) THEN
              WRITE (LU6, 99983, IOSTAT = IOST)
            ELSE
              WRITE (LU6, 99982, IOSTAT = IOST)
            END IF
            GO TO 130
          ELSE
            IF (IPR(14) .GT. 0) GO TO 310
            IF (IPR(136) .NE. 1) THEN
              IPR(2) = 12
              GO TO 300
            END IF
          END IF
          IF (IPR(86) .EQ. 0) GO TO 10
        ELSE
          IF (IPR(14) .EQ. 0) THEN
            IPR(2) = 5
            GO TO 300
          END IF
        END IF
        GO TO 310
C * CALC CONTROL CARD FOR PLA066. THE SUB-KEYWORDS ARE:
C * INTRA, INTER, COORDN, METAL, GEOM, HBOND, TMA, VOID, LIST, ADDSYM
  120   IPR(14)  = 0
        IPR(31)  = 0
        IPR(67)  = 0
        IPR(189) = 0
        IPR(197) = 0
        IPR(200) = 0
        IPR(205) = 0
        IF (IGBL(45) .GT. 0 .AND. IGBL(5) .EQ. LU5) THEN
          IGBL(45) = IGBL(45) + 1
          WRITE (LU3, 99984, IOSTAT = IOST) ICL(1:80)
          WRITE (LU6, 99973, IOSTAT = IOST) ICL(1:70)
        END IF
  130   IPR(136) = 0
C * HANDLE CALC ( = CALC ALL) CASE
        IF (IPR(220) .EQ. 1) THEN
          IF (IGBL(36) .EQ. 0) IGBL(36) = -1
          IGBL(22) = 0
          IPR(121) = 8
          IPR(495) = 1
          IPR(123) = 1
          IPR(326) = 1
          IF (IPR(221) .GT. 0) THEN
            IPR(221) = 0
            IPR(2) = 7
            GO TO 300
          END IF
        ELSE
          IPR(121) = 0
        END IF
      END IF
  140 IF (IPR(30) .EQ. 0) THEN
        IPR(1) = 2
      ELSE
        IPR(1) = 6
      END IF
      IPR(57) = 0
      N       = 0
      IGBL(52) = MAX (IGBL(52), IPR(23))
      PAR(262) = PAR(7)
      IF (IPR(14) .NE. 0) THEN
        IPR(121) = 1
        L        = 2
        GO TO 210
      END IF
      L = 1
C * HANDLE CALC (ALL) CASE
C * (= ADDSYM, INTRA, INTER, COORDN, METAL, SOLV, (ASYM))
      IF (IPR(220) .EQ. 1) THEN
        SELECT CASE (IPR(121))
          CASE (8)
            GO TO 160
          CASE (7)
            GO TO 210
          CASE (6)
            GO TO 230
          CASE (5)
            GO TO 250
          CASE (4)
            GO TO 240
          CASE (3)
            IPR(200) = 2
            GO TO 220
          CASE (2)
C * ASYM (IUCR-CHECK)
            IF (IABS(IGBL(8)) .EQ. 3 .AND. IGBL(94) .EQ. 0) THEN
C * ALERT _091
              IF (IPR(493) .EQ. -2)
     1          CALL PLA231 (91, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _092
              IF (IPR(493) .GT. 4 .AND. IPR(630) .EQ. 0)
     1          CALL PLA231 (92, 4, -999.0, PAR(17), ' ', ' ')
              IPR(121) = IPR(121) - 1
              IF (PAR(168) .GT. 0.0) CALL PLA145 (1)
              IF (IGBL(9) .GT. 0 .AND. IGBL(9) .LT. 27) THEN
                IPR(200) = 0
                IGBL63   = IGBL(63)
                IGBL(63) = 0
                IPR17    = IPR(17)
                IPR(17)  = 0
                IPR(13)  = 0
                CALL PLA145 (2)
                IPR(17)  = IPR17
                IGBL(18) = 0
                IGBL(63) = IGBL63
                IF ((IGBL(133) .GT. 0 .AND. IGBL(133) .LT. 6)
     1            .OR. IGBL(9) .EQ. 1) THEN
                  CALL PLA360
                END IF
              END IF
              IF (IABS(IGBL(8)) .EQ. 3) CALL PLA233
              IPR(2) = -1
              IGBL(1) = 3
              RETURN
            ELSE
              IPR(121) = IPR(121) - 2
              GO TO 290
            END IF
          CASE (1)
            GO TO 290
        END SELECT
      END IF
      IF (IPR(221) .GT. 0) PAR(262) = 0.0
      IPR(121) = 1
  150 L        = L + 1
      IF (L .LE. IPR(220)) THEN
        DO N0 = NP24 + 1, NP22
          NQ1 = IFL(L)
          IF (NQ1(1:4) .EQ. ISWS(N0)) THEN
            ISS = N0 - NP24 + 1
            SELECT CASE (ISS)
C * ISS = 2: GEOM
              CASE (2)
                GO TO 190
C * ISS = 3: TMA, ATOMIC DISPLACEMENT MOTION CALCULATION
              CASE (3)
                IF (IPR(30) .NE. 0) THEN
                  IPR(2) = 29
                  GO TO 300
                END IF
                IPR(5)  = -1
                IF (IPR(221) .GT. 0) THEN
                  PAR(34) = FN(1)
                  IF (IPR(221) .GT. 1) IPR(21) = NINT(FN(2))
                END IF
                IF (IPR(220) .GT. 2 .AND. IFL(3)(1:3) .EQ. 'CAR')
     1            IPR(347) = 1
                GO TO 210
C * ISS = 4: INTRA
              CASE (4)
                GO TO 210
C * ISS = 5: INTER
              CASE (5)
                GO TO 230
C * ISS = 6: NOTM(A)
              CASE (6)
                IPR(5) = 0
C * ISS = 7: NOAN(G)
              CASE (7)
                IPR(7) = 0
C * ISS = 8: NOTO(R)
              CASE (8)
                IPR(8) = 0
C * ISS = 9: NOLS(PL)
              CASE (9)
                IPR(9) = 0
C * ISS = 10: NOST(D)
              CASE (10)
                IPR(72) = 0
C * ISS = 11: NORI(NG)
              CASE (11)
                IPR(10) = 0
C * ISS = 12: NOBOND
              CASE (12)
C * NOBO(ND)/NODI(ST)
                IPR(6) = 0
C * ISS = 13: NOMO(VE) OPTION
              CASE (13)
                IF (IPR(30) .EQ. 1) THEN
C * INSTRUCTION NOT ALLOWED
                  IPR(2) = 11
                  GO TO 300
                ELSE
                  IGBL(30) = 1
                END IF
C * ISS = 14: NOSY(MM) OPTION
              CASE (14)
                IGBL(52) = 1
C * ISS = 15: NOBP(A)
              CASE (15)
                IPR(40) = 0
C * ISS = 16: EWLS
              CASE (16)
C * (E)WLSPL - CALCULATE ESD-WEIGHTED PLANES
                IPR(41) = 2
C * ISS = 17: TOLA
              CASE (17)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(2) = FN(N)
                END IF
C * ISS = 18:
              CASE (18)
                GO TO 250
C * ISS = 19: COORDINATION
              CASE (19)
                GO TO 240
C * ISS = 20: AWLSPL - CALCULATE (ATOM-WEIGHT) WEIGHTED L.S.-PLANES
              CASE (20)
                IPR(41) = 1
C * ISS = 21: HBONDS
              CASE (21)
                IPR(31) = -1
                DO K = 1, IPR(221)
                  PAR(7 + K) = FN(K)
                END DO
                IPR(121) = 0
                IF (IPR(77) .EQ. 1) THEN
                  IPR(2) = 11
                  GO TO 300
                END IF
                IPR(77)  = 1
C * ISS = 22: UWLSPL - LSPL - BASED ON UNIT WEIGHTS
              CASE (22)
                IPR(41) = 0
C * ISS = 23: OUTPUT SHELX(L) RES-FILE (CALC SHELX(L) INSTRUCTION)
              CASE (23)
                IF (IGBL(131) .EQ. 0) THEN
                  IF (EXTENS(1:3) .NE. 'res') THEN
                    IGBL(31) = -2
                  ELSE
                    IPR(121) = 0
                    IPR(2)   = 20
                    IGBL(1)  = 3
                    RETURN
                  END IF
                ELSE
                  IGBL(31) = -3
                END IF
C * SET ROUND OFF
                IPR(68) = 0
                WRITE (LU6, 99989, IOSTAT = IOST)
                GO TO 170
C * ISS = 24: OUTPUT OMEGA INPUT-FILE (CALC OMEGA INSTRUCTION)
              CASE (24)
                IF (IPR(438) .EQ. 0) THEN
                  IGBL(31) = 1
                END IF
                IF (IPR(220) .LT. 4) THEN
                  IPR(6) = 1
                  IPR(7) = 1
                  IPR(8) = 1
                END IF
                GO TO 170
C * ISS = 25:
              CASE (25)
C * ISS = 26: OUTPUT SPF - FILE (CALC SPF INSTRUCTION)
              CASE (26)
                IGBL(31) = 3
C * SET ROUND OFF
                IPR(68) = 0
                WRITE (LU6, 99989, IOSTAT = IOST)
                GO TO 170
C * ISS = 27: FIVE COORDINATION
              CASE (27)
                IPR(122) = 5
                IF (N .LT. IPR(221)) THEN
                  N       = N + 1
                  PAR(35) = FN(N)
                ELSE
                  PAR(35) = 0.0
                END IF
C * ISS = 28: CALC ALL
              CASE (28)
                IPR(121) = 8
                IPR(220) = 1
                GO TO 140
C * ISS = 29: TOLP
              CASE (29)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(49) = FN(N)
                END IF
C * ISS = 30: TOLR
              CASE (30)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(3) = FN(N)
                END IF
C * ISS = 32: VOID
              CASE (32)
                IPR(200) = 1
                GO TO 220
C * ISS = 33: PROBE RADIUS
              CASE (33)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(84) = FN(N)
                END IF
C * ISS = 34: PSTEP
              CASE (34)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  IPR(214) = NINT(FN(N))
                END IF
C * ISS = 35: LIST
              CASE (35)
                IPR(197) = 1
                IF (NQ1(5:7) .NE. '   ') THEN
                  IPR(185) = ICHAR(NQ1(5:5)) - ICHAR('W')
                  IPR(186) = ICHAR(NQ1(6:6)) - ICHAR('W')
                  IPR(187) = ICHAR(NQ1(7:7)) - ICHAR('W')
                END IF
C * ISS = 36: SUBKEYWORD EXPAND
              CASE (36)
                IPR(67) = 1
C * ISS = 37: CALC DIST
              CASE (37)
                IPR(57)  = -2
                PAR(262) = 3.0
                IPR(7)   = 0
                GO TO 260
C * ISS = 38: TOLEA
              CASE (38)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(26) = FN(N)
                END IF
C * ISS = 39: MISS
              CASE (39)
                GO TO 160
C * ISS = 40: SOLV
              CASE (40)
                IPR(326) = 1
                IPR(200) = 2
                GO TO 220
C * ISS = 41: TOLM
              CASE (41)
                N = N + 1
                IF (N .GT. IPR(121)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(27) = FN(N)
                END IF
C * ISS = 42: NOBO(ND)/NODI(ST)
              CASE (42)
                IPR(6) = 0
C * ISS = 43: BOND
              CASE (43)
                IPR(6) = 1
C * ISS = 44: ANGLE
              CASE (44)
                IPR(7) = 1
C * ISS = 45: TORS(ION)
              CASE (45)
                IPR(8) = 1
C * ISS = 46: CSD-QUE
              CASE (46)
                IGBL(31) = 4
                GO TO 170
C * ISS = 47: SQUEEZE
              CASE (47)
C * CHECK FOR SUITABLE MODEL AND REFLECTION FILE COMBINATIONS (PLA286)
C * CASE: SHELXL20xy CIF + FCF (LIST 4)
                IF (IGBL(29) .EQ. 1 .AND. IPR(619) .EQ. 0 .AND.
     1            IPR(663) .NE. 0 .AND. IPR(664) .NE. 0) THEN
C * CASE: SHELXL20xy CIF + FCF (LIST 8) (TWINNING)
                ELSE IF (IGBL(29) .EQ. 3 .AND. IPR(619) .EQ. 1 .AND.
     1            IPR(663) .NE. 0 .AND. IPR(664) .NE. 0) THEN
C * CASE: SHELXL INS/RES + SHELXL HKL
                ELSE IF (IGBL(29) .EQ. -1) THEN
C * CASE: SHELXL INS/RES + SHELXL FCF (LIST 4)
                ELSE IF (IGBL(29) .EQ. -2) THEN
                ELSE
                  IPR(1) = 1
                  IPR(2) = 68
                  GO TO 300
                END IF
                IPR(110) = 0
                IPR(210) = 1
                IPR(326) = 1
                IPR(200) = 2
                GO TO 220
C * ISS = 48: SAR
              CASE (48)
                IPR(326) = -1
C * ISS = 49: CALC FCF
              CASE (49)
                IPR(210) = - 1
                IF (L .EQ. IPR(220)) GO TO 190
C * ISS = 51: CALC NEWSYM
              CASE (51)
                IF (FN(1) .NE. 0.0) PAR(383) = FN(1)
                IPR(210) = -2
                IGBL(31) = 5
                IPR(6)   = 0
                CALL PLA292
                CALL PLA015 (0, 39)
                GO TO 200
C * ISS = 52: NOCHECK (DELABS)
              CASE (52)
                IPR(363) = 0
C * ISS = 53: OUTPUT PDB-FORMATTED FILE
              CASE (53)
                IGBL(31) = 7
                GO TO 170
C * ISS = 54: HINCL (TMA)
              CASE (54)
                IPR(497) = 1
C * ISS = 55: NONSYM
              CASE (55)
                IPR(495) = 3
                IF (IPR(221) .GT. 0) PAR(73) = FN(1)
                IF (IPR(221) .GT. 1) PAR(75) = FN(2)
                CALL PLA015 (0, 39)
                GO TO 200
C * ISS = 56: NONA OPTION (HBONDS)
              CASE (56)
                IPR(300) = 0
C * ISS = 57: MAXDEV
              CASE (57)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(76) = FN(N)
                END IF
C * ISS = 58: WLSP
              CASE (58)
C * (E)WLSPL - CALCULATE ESD-WEIGHTED PLANES
                IPR(41) = 2
C * ISS = 59: FCAL (SQUEEZE OPTION)
              CASE (59)
                IPR(132) = 1
C * ISS = 60: ADDSYM
              CASE (60)
                GO TO 160
C * ISS = 62: NOSORT ATOMS OPTION
              CASE (62)
                IGBL(33) = 0
C * ISS = 63: DISORDER (MINOR) INCLUDED
              CASE (63)
                IPR(303) = 1
C * ISS = 64: GENERATE (HKL) - IPR(408) = 1
              CASE (64)
                IPR(408) = 1
                IPR(700) = NINT(FN(1))
                IF (IPR(210) .EQ. -1) GO TO 190
                GO TO 180
C * ISS = 65: EXPE
              CASE (65)
                IPR(408) = 2
                GO TO 180
C * ISS = 66: MAXRING
              CASE (66)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  IPR(579) = NINT(FN(N))
                END IF
C * ISS = 67: MOLSYM
              CASE (67)
                IPR(495) = 2
                IF (IPR(221) .GT. 0) PAR(73) = FN(1)
                IF (IPR(221) .GT. 1) PAR(75) = FN(2)
                GO TO 200
C * ISS = 68: RENUM KEYWORD
              CASE (68)
                IPR(501) = 1
C * ISS = 69: SOLV PLOT
              CASE (69)
                IPR(326) = 2
C * ISS = 70: CALC RDF
              CASE (70)
                PAR(262) = PAR(450)
                IF (IPR(221) .GT. 0) THEN
                  PAR(262) = FN(1)
                  IF (IPR(221) .GT. 1) PAR(451) = FN(2)
                END IF
                IPR(57)  = 2
                IPR(170) = 0
                CALL PLA144 (0, 0)
                CALL PLA015 (0, 39)
                GO TO 260
C * ISS = 71: SOLV GRID
              CASE (71)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  PAR(80)  = FN(N)
                  IPR(214) = 0
                END IF
C * ISS = 72: SOLV F3D
              CASE (72)
                IPR(326) = 3
C * ISS = 73: NOSF (NO EXPLICTION SCATTERING FACTORS IN RES)
              CASE (73)
                IPR(595) = 1
C * ISS = 74: CYCL
              CASE (74)
                N = N + 1
                IF (N .GT. IPR(221)) THEN
                  IPR(2) = 5
                  GO TO 300
                ELSE
                  IPR(142) = MAX (2, NINT(FN(N)))
                END IF
C * ISS = 75: DIFFOURIER
              CASE (75)
                IPR(210) = 2
                IPR(326) = 0
                IPR(200) = 0
                GO TO 220
              CASE (76)
                IPR(645) = 1
              CASE DEFAULT
                CYCLE
            END SELECT
            GO TO 150
          END IF
        END DO
C * CALC CARD HANDLING
      ELSE
        IF (IPR(39) .GT. 0) THEN
          GO TO 310
        ELSE
C * MESSAGES
          WRITE (LU6, 99992, IOSTAT = IOST)
          GO TO 290
        END IF
      END IF
      IF (IPR(210) .EQ. 0) THEN
C * IF NOT A SUB-KEYWORD THEN ASSUME ELEMENT SYMBOL FOLLOWED BY RADIUS
C * NOTE: INDIVIDUAL ATOM - RADIUS INTERPRETED IN PLA066 FOR IPR(17)=1
        IF (IPR(31) .EQ. 1) THEN
          IF (IPR(221) .GT. 0) THEN
            N = N + 1
            PAR(68) = FN(N)
          ELSE
            PAR(68) = PAR(7)
          END IF
        END IF
        CALL PLA037 (L, NID, 3)
        IF (IPR(31) .EQ. 0) IPR(156) = 1
        IF (L .GT. 2) THEN
          IF (NID .GT. 0) THEN
            IF (IPR(31) .LT. 1) N = N + 1
            IF (IPR(57) .LT. 0) THEN
              IPR(57) = - NID
              IF (N .EQ. IPR(221)) PAR(262) = FN(N)
            ELSE
              IF (N .GT. IPR(221)) THEN
                FNN = PAR(7)
              ELSE
                FNN = FN(N)
              END IF
              RADR(NID, 1) = FNN
            END IF
          ELSE IF (NID .EQ. 0 .AND. IPR(30) .NE. 0) THEN
            IF (IPR(31) .EQ. 1) THEN
              GO TO 10
            ELSE
              IPR(2) = 18
              GO TO 300
            END IF
          END IF
        ELSE
          IPR(2) = 18
          GO TO 300
        END IF
      END IF
      GO TO 150
C * ADDSYM
  160 IPR(121) = IPR(121) - 1
      IF (IPR(37) .NE. 0) THEN
        IPR(30)  = 0
        IPR(205) = 1
        CALL PLA088
        CALL PLA060
C * ERROR TEST
        IF (IPR(2) .EQ. 0) THEN
          IF (IGBL(3) .EQ. 4) THEN
            IPR(1) = 3
            IF (IPR(2) .EQ. 0) IPR(2) = -1
            IGBL(1) = 3
            RETURN
          END IF
          GO TO 10
        END IF
      END IF
      GO TO 300
  170 IF (IPR(438) .EQ. 0) THEN
        CALL PLA292
      END IF
      GO TO 200
  180 CALL PLA293 (PAR(17))
      PAR(165) = ASIN (MIN(1.0, PAR(287) * PAR(17))) * RGBL(6)
      GO TO 150
C * SHORT GEOMETRY CALCULATION (GEOM)
  190 IF (IPR(220) .EQ. 2 .OR.
     1   (IPR(220) .EQ. 3 .AND. IFL(3)(1:3) .EQ. 'NOM')) THEN
        CALL PLA015 (0, 39)
        IPR(6) = 1
        IPR(7) = 1
        IPR(8) = 1
      END IF
  200 IF (IPR(30) .NE. 0) THEN
        IPR(2) = 31
        GO TO 300
      END IF
      IPR(31)  = 0
      IPR(121) = 0
      GO TO 150
C * CALC INTRA (UNIQUE MOLECULE CALCULATION)
  210 IPR(31)  = 0
      IPR(430) = -1
      IF (IPR(30) .NE. 0) THEN
        IPR(2) = 31
        GO TO 300
      END IF
      IF (IPR(5) .EQ. -1) THEN
        IPR(5) = 1
      ELSE
        DO K = 5, 11
          IPR(K) = 1
        END DO
      END IF
      IPR(495) = 1
      IPR(121) = IPR(121) - 1
C * SET FOR CALC INTRA AS LAST INSTRUCTION
      IF (IPR(121) .EQ. 0) IPR(136) = 1
      CALL PLA015 (0, 39)
      GO TO 150
  220 IF (IPR(23) .EQ. 1) THEN
        IPR(2) =  33
        GO TO 300
      END IF
      DO K = 5, 10
        IPR(K)  = 0
      END DO
      IPR(31)  = -1
      IPR(90)  = 1
      IPR(121) = IPR(121) - 1
      GO TO 150
C * CALC INTER
  230 IPR(200) = 0
      IPR(104) = 0
      DO K = 5, 10
        IPR(K)  = 0
      END DO
      IF (IPR(77) .EQ. 1) THEN
        IPR(2) = 11
        GO TO 300
      END IF
      IPR(77)  = 1
      IPR(31)  = -1
      IPR(90)  = 1
      IPR(121) = IPR(121) - 1
      GO TO 150
C * CALC METAL (WHEN METAL PRESENT)
  240 IF (IPR(155) .GT. 0) THEN
        IPR(57)  = 1
        PAR(262) = 5.0
        IPR(170) = 0
        IPR(5)   = 0
        IPR(6)   = 1
        IPR(7)   = 0
        IPR(8)   = 0
        IPR(9)   = 0
        IPR(10)  = 0
        CALL PLA015 (0, 39)
        GO TO 260
      ELSE
        IPR(121) = IPR(121) - 1
        GO TO 10
      END IF
C * CALC COORDN
  250 IPR(5)  = 0
      IPR(6)  = 1
      IPR(7)  = 16
      IPR(8)  = 0
      IPR(9)  = 0
      IPR(10) = 0
      IPR(1)  = 6
      CALL PLA096 (0, '        ', -1.0, PAR(454))
      IF (IPR(30) .EQ. 0) THEN
        DO I = 1, 16
          SAV(I) = FN(I)
        END DO
        CALL PLA066
        IF (IPR(2) .NE. 0) RETURN
        DO I = 1, 16
          FN(I) = SAV(I)
        END DO
      END IF
  260 IPR(31) = 1
      IF (IPR(221) .EQ. 1) THEN
        IF ((IPR(220) .EQ. 3 .AND. IFL(3)(1:3) .EQ. 'NOA') .OR.
     1       IPR(220) .EQ. 2) THEN
          IF (IPR(57) .EQ. 1) IPR(170) = 1
          PAR(262) = FN(1)
        END IF
      END IF
      IPR(121) = IPR(121) - 1
      IPR(122) = 0
      CALL PLA015 (0, 39)
      GO TO 150
  270 IF (IPR(30) .EQ. 0) THEN
        CALL PLA280 (ICL)
        IGBL(52) = MAX (IGBL(52), IPR(23))
        CALL PLA066
        IF (IPR(2) .NE. 0) RETURN
        CALL PLA072 (-1, 1)
        IF (IPR(85) .EQ. 0) THEN
          IPR(5) = 0
          CALL PLA024
        END IF
      ELSE
        CALL PLA288 (MODEB)
      END IF
      GO TO 10
C * SAVE THIS INSTRUCTION
  280 IF (IGBL(45) .GT. 0 .AND. IGBL(5) .EQ. LU5) THEN
        WRITE (LU3, 99984, IOSTAT = IOST) ICL(1:80)
        IGBL(45) = IGBL(45) + 1
        WRITE (LU6, 99973, IOSTAT = IOST) ICL(1:70)
      END IF
      GO TO 10
C * HANDLE END-CARD
  290 IF (IGBL(5) .EQ. LU5) THEN
        IF (IABS(IGBL(45)) .GT. 1) THEN
C * WRITE END CARD TO SAVE-FILE
          WRITE (LU3, 99984, IOSTAT = IOST) ICL(1:80)
          WRITE (LU6, 99973, IOSTAT = IOST) ICL(1:70)
          IGBL(45) = -1
          CALL GEN108 (LU3, 0)
        END IF
        GO TO 300
      END IF
C * TREAT END-CARD AS END-OF-FILE FOR SHELX-INPUT ON LU1
C * BUT IGNORE WHEN Q-PEAKS ARE REQUESTED
      IF (IGBL(5) .EQ. LU1 .AND. IABS(IGBL(8)) .EQ. 2) THEN
        IF (IGBL(95) .EQ. 0) THEN
          IGBL(5) = LU3
          CALL GEN108 (LU3, 0)
        END IF
        GO TO 10
      END IF
      IF (IPR(3) .NE. 0) THEN
        IPR(2)  = 0
        IGBL(5) = LU1
        IGBL(8) = IABS(IGBL(8))
C * GIVE SUMMARY
        IPR(1)  = 3
        IF (IPR(2) .EQ. 0) IPR(2) = -1
        IGBL(1) = 3
        RETURN
      END IF
C * GOTO HANDLING
  300 IF (IGBL(138) .EQ. 0) THEN
        IPR(1) = 1
      ELSE
        IPR(1) = 8
      END IF
      IPR(121) = 0
  310 SELECT CASE (IPR(1))
C * ERROR HANDLING
        CASE (1)
          IF (IPR(2) .EQ. 0) IPR(2) = -1
          IGBL(1) = 3
          RETURN
        CASE (2)
          CALL PLA066
          IF (IPR(2) .NE. 0) RETURN
C * PRINT COORDINATES
          CALL PLA072 (-1, 1)
C * ERROR TEST
          IF (IPR(2) .NE. 0) THEN
            IGBL(1) = 3
            RETURN
          END IF
C * CHECK BONDS ETC IN CIF
          IF (IABS(IGBL(8)) .EQ. 3) CALL PLA272
          GO TO 320
C * EXECUTE PLOT & TABLE OPTION(S)
        CASE (5)
          IF (IPR(14) .LT. 0) THEN
C * NEWMAN, RING, PLAN, LSPL, RESD PLOT
            CALL GEN108 (LU8, 0)
            CALL PLA101
          ELSE IF (IPR(14) .EQ. 4) THEN
C * DISPLACEMENT MOTION ELLIPSOID-PLOT
            IF (IPR(85) .EQ. 0) THEN
              IPR(5) = 0
              CALL PLA024
            END IF
            IF (IPR(140) .GT. IPR(75)) THEN
              IPR(2)  = 13
              IGBL(1) = 3
              RETURN
            END IF
            IF (IPR(460) .LT. 3) THEN
              IGBL(6)  = 9
              LMOD     = 1
              IFL(1)   = 'LSPL'
              CALL PLA015 (476, 1)
              IPR(453) = 0
              IPR(448) = 0
            END IF
            IF (IPR(341) .EQ. 5) THEN
              IGBL(6) = 9
            END IF
            IF (IPR(551) .LT. 3) THEN
              IGBL(6)  = 9
              LMOD     = 1
              IFL(1)   = 'LSPL'
              IPR(551) = 1
              CALL PLA015 (552, 1)
              IPR(453) = 0
              IPR(448) = 0
            END IF
            CALL PLA106
            IF (IPR(2) .NE. 0) THEN
              IGBL(1) = 3
            END IF
          ELSE IF (IPR(14) .EQ. 5) THEN
            MNH(6) = 1
            CALL PLA103
          ELSE IF (IPR(14) .EQ. 6) THEN
            IF (IPR(85) .EQ. 0) THEN
              IPR(5) = 0
              CALL PLA024
            END IF
            GO TO 330
          END IF
          IF (IPR(430) .GT. 0) THEN
            IPR(31)  = -1
            IPR(17)  = -1
            IPR(90)  =  1
            IGBL(63) =  0
            CALL PLA066
            IF (IPR(2) .NE. 0) RETURN
            CALL PLA172
            IPR(1) = 1
            IF (IPR(2) .EQ. 0) IPR(2) = -1
            IGBL(1) = 3
          END IF
          RETURN
C * CALLS TO PLUTON ETC.
        CASE (6)
          GO TO 320
C * LIST ON DISPLAY OPTION(S)
        CASE (7)
          GO TO 350
        CASE (8)
          CALL PLA205
          RETURN
        CASE DEFAULT
          IGBL(1) = 3
          RETURN
      END SELECT
C * CALC INTRA MODE
  320 IF (IPR(31) .EQ. 0) THEN
        IF (IPR(495) .LE. 1) THEN
C * HANDLE DISPLACEMENT PARAMETERS
          CALL PLA024
          IF (IGBL(131) .EQ. 1) THEN
            CALL PLA073 (-2, 0)
            IGBL(1) = 3
            RETURN
          END IF
          IF (IPR(675) .EQ. 1) THEN
            CALL PLA073 (-2, 0)
            IF(IPR(2) .EQ. 0) IPR(2) = -1
            IGBL(1) = 3
            RETURN
          END IF
          IF (IGBL(3) .EQ. 23 .OR. IGBL(3) .EQ. 24 .OR.
     1        IGBL(3) .EQ. 27) THEN
            IPR(1)  = 3
            IF (IPR(2) .EQ. 0) IPR(2) = -1
            IGBL(1) = 3
            RETURN
          ELSE IF (IGBL(3) .EQ. 25) THEN
            CALL PLA134 (LU6, LU16, LU17, IPR(384))
            IGBL(1) = 4
            RETURN
          ELSE
            IF (IPR(504) .EQ. 1) THEN
              CALL PLUTON (1)
              IGBL(1) = 0
              RETURN
            END IF
C * OUTPUT CONNECTION TABLES
            CALL PLA073 (-2, 0)
            IF (IPR(2) .NE. 0) THEN
              IGBL(1) = 3
              RETURN
            END IF
            IF (IGBL(3) .EQ. 11) THEN
              IPR(1)  = 3
              IF (IPR(2) .EQ. 0) IPR(2) = -1
              IGBL(1) = 3
              RETURN
            ELSE
              IF (IPR(14) .NE. 6) THEN
                IF (IPR(14) .NE. 4) THEN
C * LIST INTRA GEOMETRY
                  CALL PLA076
                  IF (IGBL(31) .EQ. 1 .AND. IPR(430) .EQ. 0) IPR(2) = -1
C * GENERATE RINGS AND PLANES
                  CALL PLA077
                  IF (IPR(2) .NE. 0) THEN
                    IGBL(1) = 3
                    RETURN
                  END IF
C * LIST LEAST-SQUARES PLANES
                  CALL PLA074
C * RING PUCKERING ANALYSIS
                  CALL PLA075
                END IF
C * FCF/NEWSYM
                IF (IPR(210) .LT. 0) THEN
                  IF (IPR(493) .EQ. 0) THEN
                    IF (IPR(210) .EQ. -2) THEN
                      IPR(493) = -2
                    ELSE
                      IPR(2)  = 47
                      IGBL(1) = 3
                      RETURN
                    END IF
                  END IF
                  IF (IPR(498) .GT. 0) THEN
                    IPR(2)  = 45
                    IGBL(1) = 3
                    RETURN
                  END IF
                  IF (IPR(210) .EQ. -2) THEN
                    CALL PLA160 (2, TM1)
                  ELSE
                    CALL PLA132
                  END IF
                  IPR(1) = 1
                  IF (IPR(2) .EQ. 0) IPR(2) = -1
                  IGBL(1) = 3
                  RETURN
                END IF
              END IF
            END IF
          END IF
        END IF
C * CALC INTER, VOID, SQUEEZE, NEWSYM AND COORDINATION MODE
      ELSE
        IPR(17)  = IPR(31)
        IPR(189) = IPR(200)
        IF (IPR(210) .NE. 2) THEN
          CALL PLA066
          IF (IPR(2) .NE. 0) RETURN
          IF (IPR(2) .NE. 0) THEN
            IGBL(1) = 3
            RETURN
          END IF
        END IF
        IF (IPR(57) .EQ. 2) THEN
          CALL PLA144 (-1, 0)
          RETURN
        END IF
        IF (IGBL(3) .EQ. 9) THEN
          IPR(1)  = 3
          IF (IPR(2) .EQ. 0) IPR(2) = -1
          IGBL(1) = 3
          RETURN
        END IF
        IF (IGBL(3) .EQ. 5 .AND. IPR(210) .EQ. 0) THEN
          IF (IGBL(31) .NE. 0) THEN
            CLOSE (UNIT = LU2, IOSTAT = IOST)
            IF (IOST .EQ. 0) IGBL(31) = 0
          END IF
          IPR(1) = 3
          IF (IPR(2) .EQ. 0) IPR(2) = -1
          IGBL(1) = 3
          RETURN
        END IF
        IF (IGBL(3) .EQ. 36) THEN
          IF (IPR(2) .EQ. 0) IPR(2) = -1
          IGBL(1) = 3
          RETURN
        END IF
        IF (IPR(210) .GT. 0) THEN
          IF (IPR(498) .EQ. 0) THEN
            IF (IPR(210) .EQ. 1) THEN
              CALL PLA129
            ELSE IF (IPR(210) .EQ. 2) THEN
              CALL PLA360
            END IF
          ELSE
            IPR(2) = 45
          END IF
          IF (IPR(2) .EQ. 0) IPR(2) = -1
          IGBL(1) = 3
        END IF
        RETURN
      END IF
      IPR(1) = 5
      GO TO 310
  330 IF (IGBL(3) .NE. 8  .AND. IGBL(3) .NE. 12 .AND.
     1    IGBL(3) .NE. 13 .AND. IGBL(3) .NE. 26) THEN
        CALL PLUTON (1)
        IGBL(1) = 0
      ELSE
C * EXPLICIT PLUTON
        CALL PLUTON (-1)
        IGBL(1) = 4
      END IF
      RETURN
  340 IF (IPR(30) .EQ. 0) THEN
        IGBL(52) = MAX (IGBL(52), IPR(23))
        IPR(205) = 0
      END IF
C * EXECUTE LIST ON DISPLAY OPTIONS
  350 IF (IPR(30) .EQ. 0) THEN
        CALL PLA066
        IF (IPR(2) .NE. 0) THEN
          IGBL(1) = 3
          RETURN
        END IF
        IF (IPR(205) .NE. 0) THEN
          RETURN
        END IF
        CALL PLA072 (-1, -1)
        IF (IPR(2) .NE. 0) THEN
          IGBL(1) = 3
          RETURN
        END IF
      END IF
      IF (IPR(1) .EQ. 4) THEN
        IF (IPR(84) .EQ. 1) THEN
          CALL PLA072 (1, -1)
        ELSE
          CALL PLA073 (2, -1)
        END IF
        IF (IPR(2) .NE. 0) THEN
          IGBL(1) = 3
          RETURN
        END IF
      ELSE IF (IPR(1) .EQ. 7) THEN
C * INTERACTIVE DIST, ANGLE, TORSION AND LSPL CALCULATION
        CALL PLA035 (1)
      END IF
      IF (IGBL(3) .EQ. 41) THEN
        IPR(2) = -1
        IGBL(1) = 3
      END IF
      RETURN
99999 FORMAT (':: Escape EXIT from PLATON - ', I4, ' Pages',
     1 ' on FILES ', A, '.lis', /)
99996 FORMAT (A, 1X, 4(4X, F10.2))
99995 FORMAT (':: Data Set ', A, /)
99994 FORMAT (/, ':: Old/Current Label Size =', F5.2)
99993 FORMAT (   ':: New         Label Size =', F5.2, /)
99992 FORMAT (':: No ATOMS supplied as yet')
99991 FORMAT ('CELL ', 3F10.4, 3F10.2, A)
99990 FORMAT (':: Rounding Range 1 :', I3)
99989 FORMAT (':: Rounding set to OFF')
99988 FORMAT ('** ', A)
99987 FORMAT (':: LSPL/RING/FIT/LINE calculation will be included in ',
     1        'next CALC GEOM/INTRA run', /)
99986 FORMAT (':: Unrecognised keyword or label (ignored): ', A, /)
99985 FORMAT (':: Transformation on input data with Det =', F6.3, /)
99984 FORMAT (A)
99983 FORMAT (':: AUTO EXEC: Calc Intra',/)
99982 FORMAT (':: Automatic join instruction',/)
99981 FORMAT (A, 1X, 3F8.4, 3X, F8.4, F10.2)
99980 FORMAT ('Atom', 8X , 'U1', 6X, 'U2', 6X, 'U3', 8X, 'U(eq)',
     1         5X, 'U3/U1')
99979 FORMAT (':: No more than', I3, ' Atom Types allowed',
     1             ' on DOAC card', /)
99978 FORMAT (':: No more than', I3, ' Atom Types allowed',
     1             ' on (IN/EX)CLUDE card', /)
99977 FORMAT (':: Bond Type/code = #Lines    Bond Radius (Ang)')
99976 FORMAT (':: Normal   ', I5, I9, 9X, F6.2)
99975 FORMAT (':: To H     ', I5, I9, 9X, F6.2)
99974 FORMAT (':: To Metal ', I5, I9, 9X, F6.2)
99973 FORMAT (':: Saved: ', A)
99972 FORMAT ('::  Transformation for x,y,z coordinates', /,
     1        ':: (', 3F8.4, ') (x)  ', F10.4, /,
     1        ':: (', 3F8.4, ') (y) +', F10.4, /,
     1        ':: (', 3F8.4, ') (z)  ', F10.4, /)
99971 FORMAT (2A)
99970 FORMAT (6F10.4)
99969 FORMAT (A, 4F10.5)
99968 FORMAT ('END', /, 'END')
99967 FORMAT (//, 'Generated INPUT for Structure Tidy on: ', A, /)
99966 FORMAT (I4, 1X, A, I4, 5I2, 2I3, 5I2, I3, I2, I3, 3I2, I5, I2)
99965 FORMAT ('Atom Label   DFN A S P H C  R  T M P D A A  H O  P',
     1        ' U L      N')
99964 FORMAT (/, ':: AtomType  EllipsoidType   NumberOfShadeLines', //,
     1           ':: C        ', I10, 10X, I10, /,
     2           ':: H        ', I10, 10X, I10, /,
     3           ':: Other    ', I10, 10X, I10, //,
     4           'Note: Ellipsoid types: 0 = Principle Ellipsoids, ',
     5           ' 1 = Envelope Type', /)
99963 FORMAT (/, ':: Volume From ORMA =', F10.1, ', Please Check')
99962 FORMAT (/, 'W: No SU''s on parameters supplied on input', /)
99961 FORMAT ('>> RESTART <<')
99960 FORMAT (':: SHELXL HKLF Matrix:', 9F6.2, /)
99959 FORMAT (':: Coord. Cell:', 3F10.3, 3F10.2, /,
     1        ':: Refln. Cell:', 3F10.3, 3F10.2, /)
99958 FORMAT (':: SPGR P1 Substituted', /)
99957 FORMAT (/, A, /)
99955 FORMAT ('INTRA BONDS    for Dist(I-J) < RC(I) + RC(J)',
     1        ' + TOLA + (TOLEA/TOLCUO)')
99954 FORMAT ('INTER CONTACTS for Dist(I-J) < RW(I) + RW(J) + TOLR')
99953 FORMAT ('TolA   [=PAR(2)]   = ', F5.2,
     1        ' Ang., current INTRA tolerance')
99952 FORMAT ('TolCuO [=PAR(542)] = ', F5.2,
     1        ' Ang., add for (Cu...O,N) Contacts')
99951 FORMAT ('TolEA  [=PAR(26)]  = ', F5.2,
     1        ' Ang., add for (Earth)Alkali- non-metal contacts')
99950 FORMAT ('TolR   [=PAR(3)]   = ', F5.2,
     1        ' Ang., current INTER tolerance')
99949 FORMAT ('Element   Covalent(RC) van der Waals(RW) Current')
99946 FORMAT (/, ':: ', A)
99945 FORMAT (':: ', A)
99944 FORMAT (/, ':: Determinant TM = ', F10.5)
99941 FORMAT ('N')
99940 FORMAT (/, ':: No CELA & CELB Data given for STRAIN Analysis')
99939 FORMAT (/, ':: ', A, /)
99938 FORMAT ('ANGLE (', 3I3, ') (', 3I3, ') =', F10.2, ' Deg.')
99937 FORMAT ('ERROR IN RECORD: ', A)
      END SUBROUTINE PLA002
      SUBROUTINE PLA003
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP25=99,NP29=63,NP36=3000,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /PAGENM / PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      CHARACTER DTP*2
      IGBL(1) = 4
      IF (IGBL(63) .GT. 0) THEN
        LU = LU7
        CALL PLA262 (1)
      ELSE
        LU = LU6
      END IF
C * ERROR
   10 IF (IPR(2) .GT. 0) THEN
        SELECT CASE (IPR(2))
C * 1: ATTEMPT TO EXCEED MAX ATOM LIMIT
          CASE (1)
            WRITE (LU, 99984, IOSTAT = IOST) NP1
C * ALERT _807
            CALL PLA231 (807, 0, 1.0, 1.0, ' ', ' ')
            IF (IGBL(3) .EQ. 1) THEN
              IF (IGBL(36) .NE. 0) CALL PLA230 (0)
            END IF
            IGBL(1) = 4
            RETURN
C * 2: LABEL PREOCCURRED
          CASE (2)
            WRITE (LU, 99977, IOSTAT = IOST) NQ1
C * 3: UNSUITABLE ATOM LABEL
          CASE (3)
            WRITE (LU, 99978, IOSTAT = IOST) NQ1
C * ALERT _071
            CALL PLA231 (71, 0, 1.0, 1.0, NQ1, NQ1)
            IF (IGBL(3) .EQ. 1) THEN
              IF (IGBL(36) .NE. 0) THEN
                CALL PLA230 (0)
                IGBL(1) = 1
              END IF
              GO TO 70
            ELSE
              GO TO 30
            END IF
C * 4: LABEL INCONSISTENT
          CASE (4)
            WRITE (LU, 99983, IOSTAT = IOST) IFL(2), NQ4
C * 5: NOT ENOUGH DATA ON CARD
          CASE (5)
            IF (LU .EQ. LU6) THEN
              WRITE (LU, 99982, IOSTAT = IOST) ICL(1:76)
              CALL PLA015 (0, 49)
              IF (IPR(470) .EQ. 1) WRITE (LU, 99961, IOSTAT = IOST)
            END IF
C * 6: INVALID ELEMENT SYMBOL
          CASE (6)
            WRITE (LU, 99981, IOSTAT = IOST) NQ1(1:3)
C * 7: UNKNOWN CARD ERROR
          CASE (7)
            IF (LU .EQ. LU6) WRITE (LU, 99992, IOSTAT = IOST) ICL(1:30)
C * 8: TOO MANY ATOMS SPECIFIED
          CASE (8)
            WRITE (LU, 99976, IOSTAT = IOST) NP1
C * 9: FVAR ERROR (SHELX INPUT STYLE)
          CASE (9)
            WRITE (LU, 99975, IOSTAT = IOST)
            GO TO 30
C * 10: POPULATION PARAMETER OVERFLOW
          CASE (10)
            WRITE (LU, 99974, IOSTAT = IOST)
            GO TO 30
C * 11: INSTRUCTION NOT ALLOWED
          CASE (11)
            WRITE (LU, 99972, IOSTAT = IOST) IFL(1)
C * 12: PLOT INSTRUCTION NOT ALLOWED HERE
          CASE (12)
            IF (LU .EQ. LU6) WRITE (LU, 99970, IOSTAT = IOST)
C * 13: SPECIFIED RESIDUE NUMBER NOT PRESENT
          CASE (13)
            IF (LU .EQ. LU6) WRITE (LU, 99960, IOSTAT = IOST) IPR(140)
C * 14:
          CASE (14)
C * 15: TRNS (FIX) INSTRUCTION N.O.K.
          CASE (15)
            IF (LU .EQ. LU6) WRITE (LU, 99957, IOSTAT = IOST)
C * 16: INVALID ELEMENT SYMBOL
          CASE (16)
            WRITE (LU, 99981, IOSTAT = IOST) NQ3(1:3)
C * 17: TRANSLATION CODE OUT-OF-RANGE
          CASE (17)
            WRITE (LU, 99947, IOSTAT = IOST) (ITR(I), I = 1, 3), NQ1
            GO TO 30
C * 18: INVALID SUB-KEYWORD or ATOM NAME/TYPE
          CASE (18)
            IF (LU .EQ. LU6) WRITE (LU, 99949, IOSTAT = IOST)
C * 19: VOID ARRAY OVERFLOW
          CASE (19)
            IF (LU .EQ. LU6) WRITE (LU, 99946, IOSTAT = IOST) NVD
C * 20: Input and Output Files with the same <name.res>
          CASE (20)
            IF (LU .EQ. LU6) WRITE (LU, 99944, IOSTAT = IOST)
            GO TO 20
C * 21:
          CASE (21)
C * 22: NOT ENOUGH OVERLAP MEMORY
          CASE (22)
             IF (LU .EQ. LU6) WRITE (LU, 99943, IOSTAT = IOST)
C * 23: TOO MANY AXES (ADDSYM) CONDITION
          CASE (23)
            WRITE (LU, 99942, IOSTAT = IOST) PAR(43)
C * 24: TOO MANY SOLVENT AREAS
          CASE (24)
            WRITE (LU, 99940, IOSTAT = IOST)
C * 25: LMX/PLA091 ERROR
          CASE (25)
            WRITE (LU, 99939, IOSTAT = IOST)
            GO TO 30
C * 26: OVERFLOW IN VOID-ROUTINE (NP1)
          CASE (26)
            WRITE (LU, 99938, IOSTAT = IOST)
C * 27: SYMM/TRNS ERROR
          CASE (27)
            WRITE (LU, 99937, IOSTAT = IOST)
C * 28: ARU-OUT OFF RANGE
          CASE (28)
            IPR(600) = IPR(600) + 1
            IF (IGBL(3) .EQ. 1) THEN
              IF (IGBL(36) .NE. 0) CALL PLA230 (0)
              IF (IGBL(3) .EQ. 36) IGBL(1) = 4
              RETURN
            ELSE
              IF (IPR(600) .LT. 10) WRITE (LU, 99935, IOSTAT = IOST)
            END IF
C * 29: TMA-CALCULATION OUT-OF-SEQUENCE
          CASE (29)
            WRITE (LU, 99934, IOSTAT = IOST)
C * 30: TOO MANY FVAR-PARAMETERS
          CASE (30)
            WRITE (LU, 99932, IOSTAT = IOST)
            GO TO 30
C * 31:
          CASE (31)
            WRITE (LU, 99931, IOSTAT = IOST)
C * 32: NON-RECOVERABLE PROBLEM
          CASE (32)
            WRITE (LU, 99929, IOSTAT = IOST) IPR(323)
            IF (LU .NE. LU6) WRITE (LU6, 99929, IOSTAT = IOST) IPR(323)
            GO TO 70
C * 33: CALC SOLV/VOID NOT ALLOWED IN ANGSTROM MODE
          CASE (33)
            WRITE (LU, 99928, IOSTAT = IOST)
C * 34: FACE DIST .LT. 0
          CASE (34)
            WRITE (LU, 99923, IOSTAT = IOST)
C * 35: NO MU-PROVIDED FOR ABSGAUSS or ABSTOMPA
          CASE (35)
            WRITE (LU, 99921, IOSTAT = IOST)
            GO TO 30
C * 36: UNKNOWN ELEMENT TYPE ON SFAC LINE
          CASE (36)
            WRITE (LU, 99920, IOSTAT = IOST)
            GO TO 30
C * 37: NO VALID DIRCOS
          CASE (37)
            WRITE (LU, 99916, IOSTAT = IOST)
            GO TO 30
C * 38: NO VALID PSI-SCAN DATA
         CASE (38)
            WRITE (LU, 99915, IOSTAT = IOST)
            GO TO 30
C * 39: No Refl Supplied
          CASE (39)
            WRITE (LU, 99914, IOSTAT = IOST)
            GO TO 30
C * 40: NO TRMX WITH NEG DET ON HKLF
          CASE (40)
            WRITE (LU, 99913, IOSTAT = IOST)
            GO TO 30
C * 41: UNKNOWN ELEMENT ON SFAC
          CASE (41)
            WRITE (LU, 99912, IOSTAT = IOST)
            GO TO 30
C * 42: NO VALID ATOMS
          CASE (42)
C * ALERT _011
            IF (IGBL(3) .EQ. 1) THEN
              CALL PLA231 (11, 0, 1.0, 1.0, ' ', ' ')
              IGBL(36) = 1
              CALL PLA230 (0)
              IGBL(1) = 4
              RETURN
            ELSE
              WRITE (LU, 99911, IOSTAT = IOST)
              GO TO 30
            END IF
C * 43: NO .hkl or .fcf
          CASE (43)
            WRITE (LU, 99910, IOSTAT = IOST)
     1        NAMEFIL(1:KNMFIL), NAMEFIL(1:KNMFIL)
            GO TO 30
C * 44: NO .hkl file given
          CASE (44)
            WRITE (LU, 99909, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
            GO TO 30
C * 45: SOMETHING WRONG WITH U/UIJ
          CASE (45)
            WRITE (LU, 99907, IOSTAT = IOST) IPR(498)
            GO TO 30
C * 46: NO-SFAC PROBLEM
          CASE (46)
            WRITE (LU, 99906, IOSTAT = IOST) NQ1
            GO TO 30
C * 47: NO LAMBDA GIVEN
          CASE (47)
            WRITE (LU, 99904, IOSTAT = IOST) MAX (0.0, PAR(17))
C * 48: VOID TOO-LARGE
          CASE (48)
            WRITE (LU, 99901, IOSTAT = IOST)
C * 49: SCRATCH OVERRUN IN EXOR/FMAP
          CASE (49)
            WRITE (LU, 99900, IOSTAT = IOST) NP1
            GO TO 30
C * 50: INCOMPLETE UIJ(SUIJ) DATA ON CIF
          CASE (50)
            IF (IGBL(3) .EQ. 1) THEN
              IGBL(36) = 1
              LINE     = NAMEFIL(1:KNMFIL)//'.chk'
              WRITE (LU6, 99842, IOSTAT = IOST) LINE
C * ALERT _806
              CALL PLA231 (806, 0, 1.0, 1.0, ' ', ' ')
	      IF (IGBL(36) .NE. 0) THEN
                CALL PLA230 (0)
                IGBL(1) = 1
              END IF
              GO TO 70
            ELSE
              WRITE (6, 99898, IOSTAT = IOST) IFL(2)
              GO TO 30
            END IF
C * 51: INCOMPLETE ATOM DATA ON CIF
          CASE (51)
            WRITE (6, 99896, IOSTAT = IOST) IFL(2)
C * ALERT _805
            CALL PLA231 (805, 0, 1.0, 1.0, ' ', ' ')
            GO TO 20
C * 52:
          CASE (52)
            WRITE (LU, 99895, IOSTAT = IOST)
            GO TO 30
C * 53:
          CASE (53)
            WRITE (LU, 99894, IOSTAT = IOST)
            GO TO 30
C * 54: SYMM-LABEL PACK PROBLEM
          CASE (54)
            WRITE (LU, 99892, IOSTAT = IOST)
C * 55: NO REFLECTION DATA PROBLEM
          CASE (55)
            WRITE (LU, 99891, IOSTAT = IOST)
C * 56: NO DIR-COS
          CASE (56)
            WRITE (6, 99888, IOSTAT = IOST)
            GO TO 20
C * 57: LABEL ALIAS OVERFLOW
          CASE (57)
            WRITE (6, 99885, IOSTAT = IOST)
            IF (IGBL(61) .EQ. 0 .AND. IPR(30) .EQ. 0) THEN
              IGBL(61) = 1
              CALL PLA011 (1)
              CALL GEN108 (LU20, 0)
              IPR(2) = 0
              GO TO 70
            END IF
C * ALERT _071
            CALL PLA231 (71, 0, 1.0, 1.0, NQ1, NQ1)
C * 58: CELL PROBLEM
          CASE (58)
            IF (IGBL(3) .EQ. 1) THEN
              IGBL(36) = 1
              LINE     = NAMEFIL(1:KNMFIL)//'.chk'
              WRITE (LU6, 99842, IOSTAT = IOST) LINE
C * ALERT _801
              CALL PLA231 (801, 0, 1.0, 1.0, ' ', ' ')
              IF (IGBL(36) .NE. 0) THEN
                CALL PLA230 (0)
                IGBL(1) = 1
              END IF
            ELSE
              WRITE (6, 99848, IOSTAT = IOST)
            END IF
            GO TO 70
C * 59: CIF-LINE TOO LONG
          CASE (59)
            IF (IGBL(3) .EQ. 1) THEN
C * ALERT _802
              CALL PLA231 (802, 0, -999.0, 1.0, ' ', ' ')
              IF (IGBL(36) .NE. 0) THEN
                CALL PLA230 (0)
                IGBL(1) = 1
              END IF
            ELSE
              WRITE (6, 99847, IOSTAT = IOST)
            END IF
            GO TO 70
C * 60: CIF-LOOP PROBLEM
          CASE (60)
            IF (IGBL(3) .EQ. 1) THEN
C * ALERT _803
              CALL PLA231 (803, 0, 1.0, 1.0, ' ', ' ')
              IF (IGBL(36) .NE. 0) THEN
                CALL PLA230 (0)
                IGBL(1) = 1
              END IF
            ELSE
              WRITE (6, 99846, IOSTAT = IOST)
            END IF
            GO TO 70
C * 61: READ/FORMAT ERROR
          CASE (61)
            WRITE (6, 99853, IOSTAT = IOST)
            GO TO 20
C * 62: NSP-Problem
          CASE (62)
            WRITE (LU6, 99852, IOSTAT = IOST)
            GO TO 30
C * 63: TRNS/TRMX PROBLEM
          CASE (63)
            WRITE (LU6, 99850, IOSTAT = IOST)
            GO TO 20
C * 64: DATA FORMAT NOT RECOGNISED
          CASE (64)
            WRITE (LU6, 99849, IOSTAT = IOST)
C * 65: HKLF4 Required
          CASE (65)
            WRITE (LU, 99843, IOSTAT = IOST)
C * 66: Obverse Setting Only
          CASE (66)
            GO TO 20
C * 67: Too many ALIASES
          CASE (67)
            WRITE (LU6, 99841, IOSTAT = IOST) NP36
            IF (IGBL(3) .EQ. 1) THEN
C * ALERT _812
              CALL PLA231 (812, 0, 1.0, FLOAT(NP36), ' ', ' ')
              IF (IGBL(36) .NE. 0) CALL PLA230 (0)
            END IF
            IGBL(1) = 4
            RETURN
C * 68: Unsuitable file type combination for SQUEEZE
          CASE (68)
            WRITE (LU6, 99840, IOSTAT = IOST)
            IGBL(1) = 5
            RETURN
C * 69: No Matching Reflection Data Entry found
          CASE (69)
            WRITE (LU6, 99839, IOSTAT = IOST) JID(1:8)
            GO TO 20
C * 70: No Numerical data on HKLF record
          CASE (70)
            IF (IGBL(3) .EQ. 1) THEN
C * _813 ALERT
              CALL PLA231 (813, 0, -999.0, 1.0, ' ', ' ')
              IF (IGBL(36) .NE. 0) THEN
                CALL PLA230 (0)
                IGBL(1) = 1
              END IF
              GO TO 70
            ELSE
              WRITE (LU6, 99838, IOSTAT = IOST)
              GO TO 30
            END IF
C * 71: Unsuitable file type combination for HYBRID
          CASE (71)
            WRITE (LU6, 99837, IOSTAT = IOST)
            IGBL(1) = 4
            RETURN
C * 72: Unsuitable file type: RES file (.ins or ,res) needed
          CASE (72)
            WRITE (LU6, 99836, IOSTAT = IOST)
            GO TO 20
C * 73: Determinant of the transformation matrix = 0.0
          CASE (73)
            WRITE (LU6, 99835, IOSTAT = IOST)
            GO TO 20
        END SELECT
C * NON-FATAL ERROR
        IF (LU .EQ. LU7) GO TO 50
        IPR(2) = 0
        CALL GEN038 (IGGT, 1, 80)
        IGBL(6)  = 10
        IGBL(24) = 1
        IF (LU .EQ. LU6) WRITE (LU, 99980, IOSTAT = IOST) CHAR(IPR(223))
        GO TO 40
C * FATAL ERROR (EXECUTE EXIT STATEMENT)
   20   FNLU1 = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
        KNMXT = KNMFIL + KXT + 1
        WRITE (6, 99897, IOSTAT = IOST) FNLU1(1:KNMXT)
        CALL GEN127 (' ')
C * FATAL ERROR (EXECUTE END STATEMENT)
   30   IF (LU .EQ. LU7) GO TO 50
        IPR(2) = 0
        WRITE (LU, 99979, IOSTAT = IOST)
        IF (IGBL(54) .LT. IGBL(100)) THEN
          IGBL(54) = IGBL(54) + 1
          FN(1)    = IGBL(54)
          IPR(220) = 1
          IPR(221) = 1
          CALL PLA009
          IGBL(5)  = LU5
          IGBL(1)  = 1
          IPR(121) = 0
          GO TO 70
        END IF
      END IF
   40 IF (IPR(2) .NE. 0) THEN
        IF (LU .EQ. LU7 .OR. IGBL(63) .EQ. 0) THEN
          IUCR = IABS(IGBL(8) * IGBL(12) * IPR(30))
          IF (IUCR .EQ. 3 .OR. IUCR .EQ. 4) THEN
            IF (IGBL(36) .NE. 0) CALL PLA230 (0)
          END IF
        END IF
        PAGET = 'SUMMARY '
        IF (LU .EQ. LU7 .AND. IGBL(63) .GT. 3 .AND.
     1      IGBL(7) .GT. 0) THEN
          IF (IPR(2) .LE. 0 .AND. IPR(3) .LE. 0) THEN
            IF (IABS(IGBL(8)) .EQ. 3 .AND. PAR(160) .NE. 0.0)
     1        CALL PLA173 (0, 1, 1)
            CALL PLA262 (0)
            WRITE (LU, 99962, IOSTAT = IOST) HTTPSERVER
          END IF
        END IF
        IF (IPR(3) .GE. 0 .AND. IPR(37) .GT. 0) THEN
          IF (LU .EQ. LU7) THEN
            CALL PLA262 (0)
            CALL PLA262 (-999)
          END IF
          WRITE (LU, 99991, IOSTAT = IOST)
          IF (IPR(23) .EQ. 0) THEN
            IF (PAR(17)  .LT. 0.001)   WRITE (LU, 99999, IOSTAT = IOST)
            IF (PAR(107) .LT. 0.00001) WRITE (LU, 99998, IOSTAT = IOST)
            IF (IGBL(30) .EQ. 1)       WRITE (LU, 99997, IOSTAT = IOST)
            IF (IGBL(52) .EQ. 1)       WRITE (LU, 99996, IOSTAT = IOST)
          END IF
          IF (IPR(129) .LT. 10) WRITE (LU, 99948, IOSTAT = IOST)
          IF (IPR(209) .NE. 0)  WRITE (LU, 99951, IOSTAT = IOST)
          IF (IPR(118) .NE. 0) WRITE (LU, 99925, IOSTAT = IOST)
          IF (IPR(459) .NE. 0) WRITE (LU, 99903, IOSTAT = IOST)
          IF (IPR(72)  .EQ. 0) WRITE (LU, 99956, IOSTAT = IOST)
          IF (IPR(130) .EQ. 1) WRITE (LU, 99995, IOSTAT = IOST)
          IF (IPR(124) .NE. 0) WRITE (LU, 99886, IOSTAT = IOST)
          IF (IGBL(8)  .EQ. 2) WRITE (LU, 99973, IOSTAT = IOST)
          IF (IPR(23) .EQ. 0 .AND. IPR(202) .EQ. 0)
     1      WRITE (LU, 99950, IOSTAT = IOST)
          IF (PAR(42) .LT. 100.0) WRITE (LU, 99927, IOSTAT = IOST)
          IF (IPR(44) .EQ. 1) WRITE (LU, 99988, IOSTAT = IOST)
          IF (IPR(215) .GT. 0) WRITE (LU, 99952, IOSTAT = IOST)
          IF (IPR(23) .EQ. 0 .AND. IPR(484) .EQ. 0)
     1      WRITE (LU, 99933, IOSTAT = IOST)
          WRITE (LU, 99890, IOSTAT = IOST)
          IF (IPR(153) .GT. 0) WRITE (LU, 99959, IOSTAT = IOST) IPR(153)
          IF (IPR(161) .GT. 0) WRITE (LU, 99889, IOSTAT = IOST) IPR(161)
          IF (IPR(160) .GT. 0) WRITE (LU, 99958, IOSTAT = IOST)
     1     IPR(160), PAR(199), PAR(200)
          IF (IPR(403) .GT. 0) WRITE (LU, 99924, IOSTAT = IOST)
     1      IPR(403), PAR(251), PAR(252)
          IF (IPR(404) .GT. 0) WRITE (LU, 99918, IOSTAT = IOST)
     1      IPR(404), PAR(253), PAR(254)
          IF (IPR(489) + IPR(490) .GT. 0) THEN
            WRITE (LU, 99930, IOSTAT = IOST) IPR(489) + IPR(490)
          END IF
          IF (IPR(50)  .GT. 0) WRITE (LU, 99966, IOSTAT = IOST) IPR(50)
          IF (IPR(204) .GT. 0) WRITE (LU, 99965, IOSTAT = IOST) IPR(204)
          IF (IPR(498) .GT. 0) WRITE (LU, 99907, IOSTAT = IOST) IPR(498)
          IF (PAR(387) .LT. 1.0) WRITE (LU, 99887, IOSTAT = IOST)
     1      PAR(387)
          IF (IPR(93)  .EQ. 1) WRITE (LU, 99990, IOSTAT = IOST)
     1      ((TM1(I, J), J = 1, 3), I = 1, 3)
          IF (IPR(139) .EQ. 1) WRITE (LU, 99968, IOSTAT = IOST)
     1      (SHFT(I), I = 1, 3)
          IF (IPR(100) .GT. 0) WRITE (LU, 99989, IOSTAT = IOST) IPR(100)
          IF (IPR(101) .GT. 0) WRITE (LU, 99987, IOSTAT = IOST) IPR(101)
          IF (IPR(171) .GT. 0) WRITE (LU, 99963, IOSTAT = IOST)
     1      PAR(30), IPR(171)
          IF (IPR(172) .GT. 0) WRITE (LU, 99945, IOSTAT = IOST)
     1      PAR(30), IPR(172)
          IF (IPR(102) .GT. 0) WRITE (LU, 99986, IOSTAT = IOST) IPR(102)
          IF (IPR(103) .GT. 0) WRITE (LU, 99985, IOSTAT = IOST) IPR(103)
          IF (IPR(401) .GT. 0) WRITE (LU, 99922, IOSTAT = IOST) IPR(401)
          IF (IPR(402) .GT. 0) WRITE (LU, 99919, IOSTAT = IOST) IPR(402)
          IF (IPR(471) .NE. 0) WRITE (LU, 99993, IOSTAT = IOST)
     1      IPR(471), IPR(472)
          IF (IPR(683) .NE. 0) WRITE (LU, 99994, IOSTAT = IOST) IPR(683)
          IF (IPR(135) .GT. 0) WRITE (LU, 99971, IOSTAT = IOST) IPR(135)
          IF (IPR(138) .GT. 0) WRITE (LU, 99969, IOSTAT = IOST) IPR(138)
          IF (PAR(150) .GT. 0) WRITE (LU, 99941, IOSTAT = IOST) PAR(150)
          IF (PAR(149) .GT. 0) WRITE (LU, 99926, IOSTAT = IOST)
     1      NINT(PAR(149))
          IF (IPR(126) .GT. 0) WRITE (LU, 99899, IOSTAT = IOST) IPR(126)
          IF (IPR(429) .GT. 0) WRITE (LU, 99893, IOSTAT = IOST) IPR(429)
          IF (IPR(405) .GT. 0) WRITE (LU, 99917, IOSTAT = IOST) IPR(405)
          IF (IPR(149) .GT. 0) WRITE (LU, 99967, IOSTAT = IOST) IPR(149)
          IF (IPR(494) .GT. 0) WRITE (LU, 99902, IOSTAT = IOST) IPR(494)
          WRITE (LU, 99953, IOSTAT = IOST)
        END IF
        IF (IGBL(63) .GT. 0 .AND. IGBL(7) .GT. 0) THEN
          IF (IPR(663) .NE. 0) THEN
            DTP = '14'
          ELSE
            DTP = '  '
          ENDIF
          FNLU1 = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
          KNMXT = KNMFIL + KXT + 1
          IF (FNLU1(1:5) .NE. 'zz123' .AND. IGBL(8) .NE. 0) THEN
            WRITE (LU, 99905, IOSTAT = IOST) FNLU1(1:KNMXT),
     1        DTYPE(IABS(IGBL(8)))(1:3)//DTP
            IF (IGBL(9) .GT. 0 .AND. IGBL(9) .LT. 27) THEN
              IF (LU .EQ. LU7) CALL PLA262 (2)
              WRITE (LU, 99845, IOSTAT = IOST) FNLU16(1:KNM16), RDTYPE
            END IF
          END IF
          IF (IGBL(131) .EQ. 1 .AND. IGBL(138) .EQ. 0) THEN
              WRITE (LU, 99844, IOSTAT = IOST)
     1          NAMEFIL(1:KNMFIL)//'_sx.ins',
     1                          NAMEFIL(1:KNMFIL)//'_sx.hkl'
          END IF
          NPAGE = IGBL(49)
          IF (IGBL(7) .EQ. 1) THEN
            LINE = NAMEFIL(1:KNMFIL)
            NLINE = KNMFIL
          ELSE IF (IGBL(7) .EQ. 2) THEN
            LINE = NAMEFIL(1:KNMFIL)//'_sq'
            NLINE = KNMFIL + 3
          END IF
          IF (IPR(2) .LT. 0) THEN
            IGBL(67) = 0
            IF (IGBL(70) .EQ. 1) THEN
              IF (IGBL(116) .NE. 0 .AND. IGBL(130) .NE. 0) THEN
                WRITE (LU, 99955, IOSTAT = IOST) NPAGE, LINE(1:NLINE),
     1            LINE(1:NLINE), LINE(1:NLINE)
              ELSE
                WRITE (LU, 99955, IOSTAT = IOST) NPAGE, LINE(1:NLINE),
     1            LINE(1:NLINE)
              END IF
            ELSE
              WRITE (LU, 99855, IOSTAT = IOST) NPAGE, LINE(1:NLINE)
            END IF
          ELSE
            WRITE (LU, 99954, IOSTAT = IOST) NPAGE, LINE(1:NLINE),
     1        LINE(1:NLINE)
          END IF
        END IF
        IGBL(8) = IABS(IGBL(8))
      END IF
   50 IF (LU .EQ. LU7) THEN
        LU = LU6
        GO TO 10
      END IF
      IF (IPR(1) .EQ. 1 .OR.
     1    IPR(1) .EQ. 2 .OR.
     2    IPR(1) .EQ. 4 .OR.
     3    IPR(1) .EQ. 5 .OR.
     4    IPR(1) .EQ. 6 .OR.
     5    IPR(1) .EQ. 7) THEN
        IF (IPR(2) .EQ. 0) IGBL(1) = 1
      ELSE IF (IPR(1) .EQ. 3 .AND. IGBL(8) .NE. 2) THEN
        READ (LU1, 99964, IOSTAT = IOST) ICL(1:80)
        IF (IOST .EQ. 0) THEN
          BACKSPACE LU1
          IGBL(1) = 1
        END IF
      END IF
C * ERROR RECOVERY FOR AUTO SEQUENCE
      IF (IPR(3) .EQ. 1) THEN
        IGBL(5) = LU1
        IGBL(1) = 1
      END IF
   70 IF (IGBL(3)  .EQ.  36) IGBL(1) = 4
      IF (IPR(2)   .EQ. -11) IGBL(1) = 4
      IF (IGBL(31) .EQ.  10) IGBL(1) = 4
      RETURN
99999 FORMAT ('W: No wavelength given.')
99998 FORMAT ('W: No Cell estimated standard deviation (CESD) given.')
99997 FORMAT ('W: NOMOVE option used.', /, ':: >>> WARNING:',
     1 ' ''CONNECTED INPUT SET'' is assumed to be TRUE', /,
     2 ':: >>> The Network Analysis may be INCORRECT when this',
     3 '  assumption is FALSE')
99996 FORMAT ('W: NOSYMM option used. (No Symmetry applied)')
99995 FORMAT ('E: Maximum residue number exceeded.')
99994 FORMAT ('N: Number of modified (= # ) ATOM labels ',
     1             33('.'),  I5)
99993 FORMAT ('N: Number of Ignored Lines on INPUT ', 38('.'),
     1   I5, /, 10X, 'of which blank in column 1 ', 37('.'), I5)
99992 FORMAT (':: ** Instruction N.O.K. ** :', A, /,
     1 ':: Check also for mistyped ATOM labels and ATOM types')
99991 FORMAT (/, 'Summary and Remarks : N = NOTE, W = WARNING, E ',
     1 '= ERROR', /, 80('='), /)
99990 FORMAT ('N: Input Data following TRNS ',
     1        '[e.g. (CELL/CESD)/SPGR/COORDS/'
     1 ,'UIJ)] have been', /, 4X, 'transformed according to the ',
     2 'specified Cell Transformation Matrix: ', 3(/, 20X, 3F10.5))
99989 FORMAT ('N: Number of deleted ATOMS from input stream ',
     1        29('.'), I5)
99988 FORMAT ('N: DISORDERED structure - ATOMS with Pop. .LT.',
     1 ' 1.0 are not moved or as a group.')
99987 FORMAT ('N: Number of detected and excluded disorder',
     1        ' operations ',14('.'), I5)
99986 FORMAT ('W: Number of valency check faults for H & C ',
     1        30('.'), I5)
99985 FORMAT ('W: Number of unusual bond angle faults ', 35('.'), I5)
99984 FORMAT (/, ':: FATAL attempt to EXCEED the max.ATOMS limit:', I5)
99983 FORMAT (':: U/UIJ/SUIJ/B/BIJ/SBIJ/ label: ', A, /, 4X,
     1 'inconsistent with ATOM label: ', A, /)
99982 FORMAT (':: Error - Not Enough Data Items on Input Line:',
     1        /, 3X, A)
99981 FORMAT (':: Error - Invalid Element Symbol: ', A)
99980 FORMAT (':: Last Line(s) Ignored', A, /)
99979 FORMAT (':: END Statement Executed for this Entry')
99978 FORMAT (//, ':: Unsuitable Keyword/ATOM label : ', A, //,
     1        3X, 'Legal are: C, H999, O(3), FE(77)', /)
99977 FORMAT (//, ':: Label ', A, ' pre-occurred '/)
99976 FORMAT (':: Too many ATOMS specified, Max.Nr:', I5)
99975 FORMAT (':: FVAR - error')
99974 FORMAT (':: Population parameter OVERFLOW')
99973 FORMAT ('N: SHELX-style data input.')
99972 FORMAT (':: Instruction ', A, ' NOT allowed at this point')
99971 FORMAT ('W: Number of unusual anisotropic displacement ',
     1        'parameters ', 17('.'), I5)
99970 FORMAT (':: * The PLOT instructions should be given after the',
     1 ' execution of ', /, 4X, 'the -CALC INTRA- instruction')
99969 FORMAT ('W:', I5, ' Times MOL-list overflow. Results ????')
99968 FORMAT ('N: Input data (COORDINATES) have been transformed',
     1 /, 4X, 'according to additive coordinate shift vector: ', /,
     2 20X, 3F10.5)
99967 FORMAT ('W: array OVERFLOW in INTER-mode (Results INCOMPLETE)',
     1 ' Code nnmmkk =', I8)
99966 FORMAT ('N: Number of positions fixed with TRNS by user ',
     1        27('.'), I5)
99965 FORMAT ('N: Number of moved primary input atoms: ',34('.'), I5)
99964 FORMAT (A)
99963 FORMAT ('N: Number of Unspecified Non-H Displacement ',
     1        'Parameters set to U =', F5.2, 1X, 3('.'), I5)
99962 FORMAT (//, 58X, 11('='), /, 57('*'), ' N O T I C E ', 50('*'),
     1 /, 58X, 11('='), //, '- PLATON Reference : Spek, A.L. (2003). ',
     2 'J. Appl. Cryst. 36, 7-13.', /, 21X, 'Spek, A.L. (2009). ',
     3 'Acta Cryst. D65, 148-155.', //, '- Output Values (Esd) may ',
     4 'have  been set to 99, 999 or 9999 to Avoid Format Overflow', //,
     5 '- Derived Parameter SU''s (= Esd''s) may be Incorrect in',
     6 ' Cases where Covariances in the Atom Parameters should have',
     7 ' been taken', /, '  into Account (e.g. Those Involving Atoms',
     8 ' That were Refined with Constraints)', //, '- ROUNDING, in',
     9 ' particular of the Input Coordinate Data, may give deviating',
     * ' values for derived geometry parameters.', /, '  However,',
     1 ' differences should be within the associated esd-range.', //,
     2 '- PLATON is NOT a Finished Program. The Implementation of',
     3 ' Additional Options is Planned. Some of the More Advanced', /,
     4 2X, 'Features are Experimental and may Contain Loose Ends.',//,
     5 '- The Communication of Glitches Encountered will be',
     6 ' Appreciated: E-mail: a.l.spek@uu.nl', //,
     7 '- Recent versions of PLATON may be obtained from',
     8 ' http://www.platonsoft.nl/xraysoft', //, '- More INFO',
     9 ' can be found on http://', A, //)
99961 FORMAT (':: Following data will be skipped until End-Of-',
     1        'Section')
99960 FORMAT (':: Specified  RESIDUE number:', I3, ' NOT present')
99959 FORMAT ('W: Structure contains', I3,' isolated H-atom(s).')
99958 FORMAT ('W: Structure contains', I3, ' Intra/Inter contacts',
     1        ' < Sum(vdWrad) ', F5.2, ' A (max ', F5.2,')')
99957 FORMAT (':: TRNS (FIX) instruction N.O.K.')
99956 FORMAT ('N: No S.U.''s (esd) on observed/calculated parameters.')
99955 FORMAT (':: NORMAL END of PLATON :', I6, ' Pages on:', /,
     1        ':: ', A, '.lis (ASCII, 132 Characters Wide)', /,
     2        ':: ', A, '.lps (PostScript Version of .lis)', /,
     3        ':: ', A, '.pdf (PDF        Version of .lis)', /)
99954 FORMAT (':: ABNORMAL END of PLATON :', I6, ' Pages on:', /,
     1        A, '.lis ASCII)', /, A, '.lps (PostScript)', /)
99953 FORMAT (/, 80('='), /)
99952 FORMAT ('W: Unit cell contains non-integral number of atoms',
     1 ' (please check).')
99951 FORMAT ('N: ADDSYM finds additional (pseudo)symmetry in the',
     1 ' structure (please check!)')
99950 FORMAT ('N: No Explicit space group name specified')
99949 FORMAT (':: Subkeyword NOT Acceptable')
99948 FORMAT ('N: Maximum Residue Number Reduced',
     1        ' (Round ARU to 0.1 units)')
99947 FORMAT ('E: Translation code [', 3I3, '] out-of-range -4:4',
     1        ' for ', A)
99946 FORMAT (':: Void-array overflow, Raise NVD to value > ', I7)
99945 FORMAT ('N: Number of Unspecified     H Displacement ',
     1        'Parameters set to U =', F5.2, 1X, 3('.'), I5)
99944 FORMAT ('!! Error: Input and Output with the same <name.res>')
99943 FORMAT (':: Not enough storage available to handle OVERLAP')
99942 FORMAT (':: Too many axes found. Rerun with obl. ang. <', F4.1)
99941 FORMAT ('N: Total Potential Solvent Accessible Void Vol ',
     1            18('.'), F8.1, ' Ang^3')
99940 FORMAT (':: Too many independent solvent areas')
99939 FORMAT (':: STOP LMX/PLA091')
99938 FORMAT (':: Overflow in VOID/SOLV routine (NP1)')
99937 FORMAT (':: No SYMM matrix allowed with TRNS option')
99935 FORMAT (':: ARU-code not representable (out-of-range)')
99934 FORMAT (':: CALC TMA not allowed after previous CALC INTRA')
99933 FORMAT ('N: No-Hydrogen atoms in this structure')
99932 FORMAT ('E: Too many FVAR - parameters (increase NP25)')
99931 FORMAT (':: No CALC INTRA or GEOM after previous (implicit) ',
     1        ' CALC INTRA allowed')
99930 FORMAT ('N: Number of Isotropic Non-H Atoms ', 39('.'), I5)
99929 FORMAT ('E: Non-Recoverable problem in routine PLA', I3.3)
99928 FORMAT (':: CALC SOLV/VOID incompatible with ANGSTROM mode')
99927 FORMAT ('N: Maximum allowed number of residues reduced')
99926 FORMAT ('N: Electron Count / Cell =', I7)
99925 FORMAT ('W: Look carefully at the approximate inversion',
     1        ' symmetry reported by ADDSYM')
99924 FORMAT ('W: Structure contains', I3, ' Intra H..H contacts',
     1        ' < Sum(vdW-rad) ', F5.2, ' A (max ', F5.2,')')
99923 FORMAT ('W: Negative Distance Detected (i.e. Origin Outside ',
     1        'Xtal)')
99922 FORMAT ('W: Number of Carbon Atoms with missing H-atoms ',
     1         27('.'), I5)
99921 FORMAT ('E: No Mu-value provided')
99920 FORMAT ('E: Unknown Element Type on SFAC line, Fatal')
99919 FORMAT ('W: Number of (Carbon) Atoms with no sp(x) ',
     1        'assignment ', 21('.'), I5)
99918 FORMAT ('W: Structure contains', I3, ' Inter H..H contacts',
     1        ' < Sum(vdW-rad) ', F5.2, ' A (max ', F5.2,')')
99917 FORMAT ('N: Number of Non-HBonded D-H atoms ', 39('.'), I5)
99916 FORMAT ('W: No Valid Direction Cosine or Psi-values Found', /)
99915 FORMAT ('W: No Valid Psi-scans Found')
99914 FORMAT ('W: No Reflections Supplied !', /)
99913 FORMAT ('E: I Can''t accept transformations on hkl with a',
     1           ' NEGATIVE Det. ')
99912 FORMAT ('E: Unknown ELEMENT Type on SFAC')
99911 FORMAT ('E: No Valid Atoms found on Input File')
99910 FORMAT ('E: No ', A,'.hkl or ', A,'.fcf Reflection file present')
99909 FORMAT ('E: No ', A,'.hkl Reflection file present', /)
99907 FORMAT ('E: Something wrong with', I5,
     1        ' input U/Uij(s) (incomplete?)', /)
99906 FORMAT ('E: SFAC data incomplete or missing on shelx.res/ins file'
     1         , ' for: ', A, /)
99905 FORMAT (/, ':: Input Xtal Data from File ', A, ' - Data Type ',
     1        A, /)
99904 FORMAT (':: No proper wavelength (Ag,Mo,Cu) recognised (',
     1        F8.5, ')')
99903 FORMAT ('W: Look carefully at the (approximate) Translation',
     1        ' symmetry reported by ADDSYM')
99902 FORMAT ('W: Number of out of range ARU-coding problems =', I5, /,
     1        '   Analysis of Inter Contacts may be incomplete')
99901 FORMAT ('E: Void TOO LARGE to be Interesting; Search Aborted', /,
     1            '(at own risk: SET IPR 491 1000000 before SQUEEZE)')
99900 FORMAT (/, 'E: Scratch Array Overrun in PLA152 (Fatal)', /,
     1        '    Use larger program version i.e. NP1 ',
     2        '> ', I9, /)
99899 FORMAT (/, 'W: # MAXPATH EXCEEDED IN R/S-Assignment Routine =',
     1        I3)
99898 FORMAT (/, 'E: Insufficient Data on UIJ/SUIJ - CIF-Input for ',
     1        A, /)
99897 FORMAT (':: EXIT Statement Executed for: ', A)
99896 FORMAT (/, 'E: Insufficient Data on ATOM - CIF-Input for ',
     1        A, /)
99895 FORMAT (/, 'E: Symmetry Problem in PLA270', /)
99894 FORMAT (/ )
99893 FORMAT ('N: Number of Unrecognized (CIF) Keywords ', 33('.'), I5)
99892 FORMAT ('E: SYMM-LABEL PACK PROBLEM')
99891 FORMAT ('E: No Reflection Data Available')
99890 FORMAT (80('-'))
99889 FORMAT ('W: Structure contains', I3,' isolated O-atom(s).')
99888 FORMAT ('E: No Direction Cosines or Psi found on Reflection Data')
99887 FORMAT ('W: Low density (check!) of ', 38('.'), F8.3, ' gcm-3')
99886 FORMAT ('W: Coordinates do not form a Connected Set')
99885 FORMAT ('E: Label Alias Overflow: TRY: SET IGBL 61  1')
99855 FORMAT (':: NORMAL END of PLATON :', I6, ' Pages on FILE ',
     1        A, '.lis', /)
99853 FORMAT (//, 'E: READ ERROR - FATAL', /)
99852 FORMAT ('E: NSP-Problem in PLA024: Nr species too large')
99850 FORMAT ('W: Incorrect Number of Numerical Arguments on TRNS/TRMX')
99849 FORMAT ('E: Check Data Type (cif,res,spf,pdb) of the Input',
     1        ' (TITL missing?)')
99848 FORMAT (/, ':: CELL PROBLEM')
99847 FORMAT (/, 'CIF-LINE LONGER THAN 2048 CHARACTERS')
99846 FORMAT (/, 'CIF-LOOP PROBLEM')
99845 FORMAT (':: Input Refl Data from File ', A, ' - Data Type ', A, /)
99844 FORMAT (':: SHELXL.INS (From CIF data) on: ', A, /,
     1        ':: SHELXL.HKL (From FCF data) on: ', A, /)
99843 FORMAT (/, ':: HKLF 4 Style Reflection File Needed', /)
99842 FORMAT (/, ' >> CIF-Validation-Check Result on ', A)
99841 FORMAT (/, ' >> More than', I5, ' Aliases. Aborted')
99840 FORMAT (/, '** Unsuitable File Type combination for SQUEEZE', /,
     1        'Valid File Combinations: ', /,
     2        '(Note: CIF with embedded .res & .hkl)', /,
     2        '1 -  SHELXL20xy CIF + FCF (LIST 4)', /,
     3        '2 -  SHELXL20xy CIF + FCF (LIST 8) (TWINNING)', /,
     4        '3 -  SHELXL INS/RES + SHELXL HKL', /,
     5        '4 -  SHELXL INS/RES + SHELXL FCF (LIST 4)')
99839 FORMAT (/, ':: No Matching Reflection Data Entry found for ', A)
99838 FORMAT (/, ':: No Numerical Data on HKLF (res) RECORD in CIF')
99837 FORMAT (/, '** Unsuitable File Type combination for SQUEEZE',/,
     1        '** HYBRID Requires .ins/.res + .hkl or',
     2        ' SHELXL20xy .cif file(s) as input')
99836 FORMAT (/, ':: RES File (.ins or .res) INPUT only !')
99835 FORMAT (/, ':: Determinant for transformation = 0.0', /)
      END SUBROUTINE PLA003
      SUBROUTINE PLA004 (MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP52=200,NP56=30,
     2 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      INTEGER FINDEXE
      LOGICAL EXST
      IF (IGBL(36) * IGBL(66) * IGBL(32) .NE. 0) CALL PLA298 (0)
C * OUTPUT-FILE TYPE
C *  1 - OMEGA,  3 - SPF, 4 - CSD, 7 - PDB
C * 10 - SQUEEZE
C * -2 - SHELXL
      IF (MODE .EQ. 0) THEN
C * STOP AND CLOSE GRAPHICS (IF ANY)
        XGGIP = -999.0
        PCAL  =  0.0
        PLOTS =  0.0
        CALL GGIP (XGGIP, PCAL, PLOTS, -5)
C * CLOSE 'ALERT' FILE
        CLOSE (UNIT = LU20, STATUS = 'DELETE', IOSTAT = IOST)
      END IF
      IF (IGBL(3) .EQ. 1 .OR. IGBL(22) .NE. 0)
     1  CLOSE (UNIT = LU2, STATUS = 'DELETE', IOSTAT = IOST)
      LU   = LU6
      IEND = 1
      IF (IGBL(63) .GT. 0) IEND = 2
      DO I = 1, IEND
        IF (I .EQ. 2) LU = LU7
        SELECT CASE (IGBL(31))
          CASE (1)
            IF (IPR(430) .EQ. 0) THEN
              WRITE (LU, 99997, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
            END IF
          CASE (3)
            IF (IGBL(129) .LE. 0 .AND. IPR(210) .NE. -1) THEN
              IF (LU .NE. LU20) WRITE (LU, 99995, IOSTAT = IOST)
     1          NAMEFIL(1:KNMFIL)
            END IF
          CASE (4)
            IF (LU .NE. LU7 .AND. LU .NE. LU20)
     1        WRITE (LU, 99994, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
          CASE (5)
            WRITE (LU, 99985, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
          CASE (-2, 6)
            WRITE (LU, 99988, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
          CASE (7)
            WRITE (LU, 99977, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
          CASE (10)
            IF (IPR(2) .LE. 0) THEN
              WRITE (LU, 99976, IOSTAT = IOST)
     1          NAMEFIL(1:KNMFIL), NAMEFIL(1:KNMFIL), NAMEFIL(1:KNMFIL),
     2          NAMEFIL(1:KNMFIL), NAMEFIL(1:KNMFIL)
            END IF
        END SELECT
      END DO
      LU6 = 6
      IF (IPR(663) .EQ. -2) THEN
        WRITE (LU6, 99952, IOSTAT = IOST)
     1    NAMEFIL(1:KNMFIL)//'_sx.ins'
      ELSE IF (IPR(663) .EQ. -1) THEN
        CLOSE (UNIT = LU24, STATUS = 'DELETE')
      END IF
      IF (IPR(664) .EQ. -3) THEN
        WRITE (LU6, 99947, IOSTAT = IOST)
     1    NAMEFIL(1:KNMFIL)//'_sx.hkl'
      ELSE IF (IPR(664) .EQ. -2) THEN
        WRITE (LU6, 99951, IOSTAT = IOST)
     1    NAMEFIL(1:KNMFIL)//'_sx.hkl'
      ELSE IF (IPR(664) .EQ. -1) THEN
        CLOSE (UNIT = LU25, STATUS = 'DELETE')
      END IF
      IF (IPR(665) .EQ. -2) THEN
        WRITE (LU6, 99950, IOSTAT = IOST)
     1    NAMEFIL(1:KNMFIL)//'_sx.fab'
      ELSE IF (IPR(665) .EQ. -1) THEN
        CLOSE (UNIT = LU26, STATUS = 'DELETE')
      END IF
      IF (IPR(431) .EQ. 1) THEN
        WRITE (LU6, 99992, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(431) .EQ. -1) THEN
        WRITE (LU6, 99990, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ENDIF
      CLOSE (UNIT = LU14, STATUS = 'DELETE', IOSTAT = IOST)
      IF (IGBL(36) .GT. 0) THEN
        LU6 = 6
        CALL PLA230 (1)
        WRITE (LU6, 99971, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE
        CLOSE (UNIT = LU10, STATUS = 'DELETE', IOSTAT = IOST)
      END IF
      IF (IGBL(129) .NE. 0) THEN
        LU6 = 6
        WRITE (LU6, 99962, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      END IF
      IF (IGBL(16) .EQ. 0)
     1    CLOSE (UNIT = LU19, STATUS = 'DELETE', IOSTAT = IOST)
      IF (IPR(326) .EQ. -1 .AND. IPR(198) .GT. 0 .AND.
     1    IPR(189) .EQ.  2 .AND. IPR(210) .LE. 0) THEN
        WRITE (LU6, 99989, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE
        CLOSE (UNIT = LU15, STATUS = 'DELETE', IOSTAT = IOST)
      END IF
      IF (IGBL(18) .EQ. 1 .AND. IPR(408) .LT. 1
     1    .AND. IGBL(3) .NE. 34 .AND. IGBL(3) .NE. 1 .AND.
     2     IGBL(129) .LE. 0) THEN
        WRITE (LU6, 99966, IOSTAT = IOST) NAMEFIL(1:KNMFIL), IPR(378)
      ELSE IF (IGBL(18) .EQ. 2) THEN
        WRITE (LU6, 99965, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      END IF
      IF (IPR(210) .EQ. -1) THEN
        WRITE (LU6, 99987, IOSTAT = IOST) NAMEFIL(1:KNMFIL),
     1                     NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -4) THEN
        WRITE (LU6, 99972, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -5) THEN
        WRITE (LU6, 99979, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -6 .AND. IPR(432) .GT. 0) THEN
        WRITE (LU6, 99980, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -7 .AND. IPR(432) .GT. 0) THEN
        WRITE (LU6, 99982, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -8 .AND. IPR(432) .GT. 0) THEN
        WRITE (LU6, 99983, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -9) THEN
        WRITE (LU6, 99978, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -10) THEN
        WRITE (LU6, 99963, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -11) THEN
        WRITE (LU6, 99964, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (IPR(2) .EQ. -12) THEN
        WRITE (LU6, 99961, IOSTAT = IOST) NAMEFIL(1:KNMFIL)//'_exp.ins'
        IF (IPR(373) .NE. 0) WRITE (LU6, 99960, IOSTAT = IOST)
     1    NAMEFIL(1:KNMFIL)//'_exp.hkl'
      ELSE IF (IPR(2) .EQ. -13 .AND. IPR(525) .EQ. 0 .AND.
     1   IPR(409) .EQ. 0) THEN
        WRITE (LU6, 99984, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE IF (((IPR(2) .EQ. -14 .AND. IPR(408) .NE. 2) .OR.
     1          IGBL(17) .EQ. 1) .AND. IGBL(22) .EQ. 0) THEN
        IYUNK = IPR(377)
        IF (IGBL(18) .EQ. 0) IYUNK = IYUNK + IPR(378)
        IF (IPR(408) .EQ. 1) THEN
          WRITE (LU6, 99946, IOSTAT = IOST) NAMEFIL(1:KNMFIL), IYUNK
        ELSE
          WRITE (LU6, 99981, IOSTAT = IOST) NAMEFIL(1:KNMFIL), IYUNK
        END IF
      ELSE IF (IPR(2) .EQ. -15) THEN
        WRITE (LU6, 99970, IOSTAT = IOST) NAMEFIL(1:KNMFIL),
     1  NAMEFIL(1:KNMFIL)
      ELSE
        CLOSE (UNIT = LU17, STATUS = 'DELETE', IOSTAT = IOST)
      END IF
      IF (IPR(2) .EQ. -16 .AND. IPR(384) .GT. 0) THEN
        WRITE (LU6, 99948, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      END IF
      CLOSE (UNIT = LU1)
      IF (IGBL(23) .EQ. 0)
     1  CLOSE (UNIT = LU23, STATUS = 'DELETE', IOSTAT = IOST)
      IF (IGBL(20) .EQ. 0) THEN
        IF (IGBL(26) .EQ. 0 .OR. IABS(IGBL(8)) .NE. 2) THEN
          CLOSE (UNIT = LU21, STATUS = 'DELETE', IOSTAT = IOST)
        ELSE
          CALL PLUT29 (-1, ICL, NQ1, 0, LU21)
          WRITE (LU6, 99949, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
        END IF
      END IF
      IF (IGBL(98) .NE. 0) WRITE (LU6, 99999, IOSTAT = IOST)
     1  NAMEFIL(1:KNMFIL)
      IF (IGBL(11) .NE. 0) WRITE (LU6, 99969, IOSTAT = IOST)
     1  NAMEFIL(1:KNMFIL)
      IF ((IGBL(7) .GT. 0 .AND. IGBL(3) .EQ. 1) .OR.
     1   (IPR(123) .EQ. 0 .AND. ((IGBL(7) .GT. 0 .AND. IGBL(3) .EQ. 8)
     1  .OR. IGBL(63) .EQ. 0 .OR. IGBL(6) .EQ. 17
     2  .OR. IGBL(6) .EQ. 18 .OR. IGBL(6) .EQ. 19))) THEN
        CLOSE (UNIT = LU7, STATUS = 'DELETE', IOSTAT = IOST)
      ELSE IF (MODE .EQ. 0) THEN
        IF (IGBL(7) .GT. 0) THEN
          CALL GEN108 (LU7, 0)
          CLOSE (UNIT = LU1)
          IF (IGBL(70) .EQ. 1) THEN
            READ (LU7, 99953, IOSTAT = IOST) PRBUF
            IF (IOST .EQ. 0) THEN
              CALL GEN108 (LU7, 0)
              IF (IGBL(7) .EQ. 1) THEN
                FNLU1  = NAMEFIL(1:KNMFIL) //'.lps'
              ELSE IF (IGBL(7) .EQ. 2) THEN
                FNLU1  = NAMEFIL(1:KNMFIL) //'_sq.lps'
              END IF
              OPEN (UNIT = LU1,  FILE = FNLU1, STATUS = 'UNKNOWN')
              CALL GEN089 (LU7, LU1, IGBL(49), IGBL(102))
              IF (IGBL(116) .NE. 1 .AND. IGBL(130) .NE. 0) THEN
                CLOSE (UNIT = LU1)
                NE = FINDEXE ('PS2PDF', CGETENV, 'ps2pdf')
                IF (IGBL(7) .EQ. 1) THEN
                  CGETENV(NE+1:) =
     1 ' '//NAMEFIL(1:KNMFIL)//'.lps '//NAMEFIL(1:KNMFIL)//'.pdf'
                ELSE IF (IGBL(7) .EQ. 2) THEN
                  CGETENV(NE+1:) =
     1 ' '//NAMEFIL(1:KNMFIL)//'_sq.lps '//NAMEFIL(1:KNMFIL)//'_sq.pdf'
                END IF
                KERR = 0
                CALL SPAWN (CGETENV, KERR)
              END IF
            ELSE
              CLOSE (UNIT = LU7, STATUS = 'DELETE', IOSTAT = IOST)
              IGBL(7) = 0
            END IF
          END IF
        END IF
      END IF
      IF (IGBL(27) .EQ. 1) THEN
        WRITE (LU6, 99973, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      ELSE
        CLOSE (UNIT = LU22, STATUS = 'DELETE', IOSTAT = IOST)
      END IF
      IF (IPR(580) .LT. 0)  THEN
        IF (IPR(580) .EQ. -1) THEN
          WRITE (LU6, 99959, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
        ELSE
          WRITE (LU6, 99958, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
        END IF
      END IF
      IF (IPR(409) .EQ. 1) THEN
        WRITE (LU6, 99957, IOSTAT = IOST) NAMEFIL(1:KNMFIL),
     1    NAMEFIL(1:KNMFIL), NAMEFIL(1:KNMFIL)
        WRITE (LINE, 99954, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
        INQUIRE (FILE = LINE, EXIST = EXST)
        IF (EXST) WRITE (LU6, 99955, IOSTAT = IOST)
     1    NAMEFIL(1:KNMFIL), NAMEFIL (1:KNMFIL)
      END IF
      IF (MODE .NE. 0) THEN
        CLOSE (UNIT = LU7, STATUS = 'DELETE')
        LU1     = 1
        LINE    = ICL(5:80)
        IGBL(7) = 0
        IGBL(8) = 0
      ELSE
        IGBL(1) = 5
      END IF
      RETURN
99999 FORMAT (/,
     1        ':: POV-Ray File on :', A, '.pov')
99997 FORMAT (':: OMEGA File   on :', A, '.ome')
99995 FORMAT (':: SPF File spf on :', A, '_p.spf')
99994 FORMAT (':: CSD-QUE      on :', A, '.que')
99992 FORMAT (':: SUPP. Mat.   on :', A, '.sup')
99990 FORMAT (':: CIF/ACC-File on :', A, '_acc.cif')
99989 FORMAT (':: SAR-File     on :', A, '.sar')
99988 FORMAT (':: SHELXL   res on :', A, '.res')
99987 FORMAT (':: FCF-CIF  cif on :', A, '_p.cif', /,
     1        ':: FCF-CIF  fcf on :', A, '_p.fcf', /)
99985 FORMAT (':: SPGR.PAR     on :', A, '.par')
99984 FORMAT (':: HKLF3.HKL    on :', A, '.hkp')
99983 FORMAT (':: ABSGAUSS hkl on :', A, '.hkp')
99982 FORMAT (':: ABSTOMPA hkl on :', A, '.hkp')
99981 FORMAT (':: ASYM     hkl on :', A, '.hkp (# refl. =', I7, ')')
99980 FORMAT (':: ABSPSI   hkl on :', A, '.hkp')
99979 FORMAT (':: ABSSPHER hkl on :', A, '.hkp')
99978 FORMAT (':: PSIDIR   hkl on :', A, '.hkp')
99977 FORMAT (':: PDB-FILE out on :', A, '.pdb')
99976 FORMAT (':: *** FILES for Refinement based on SHELXL20xy ***',
     1         //,
     2        ':: SQUEEZE  ins on :', A, '_sq.ins', /,
     3        ':: SQUEEZE  hkl on :', A, '_sq.hkl', /,
     4        ':: SQUEEZE  fab on :', A, '_sq.fab', /,
     5        ':: SQUEEZE  cif on :', A, '_sq.sqf', /,
     6        ':: SQUEEZE  xyz on :', A, '_sq.sqz', /)
99973 FORMAT (/,
     1        ':: Journal File on :', A, '.pjn', //,
     2        ':: Normal End of PLATON/PLUTON RUN.')
99972 FORMAT (':: MULABS   hkl on :', A, '.hkp')
99971 FORMAT (':: CheckCIF out on :', A, '.chk')
99970 FORMAT (':: HKLTRANS hkl on :', A, '_trans.hkl', /,
     1        ':: HKLTRANS ins on :', A, '_trans.ins')
99969 FORMAT (':: RASMOL(pdb)  on :', A, '.ras')
99966 FORMAT (':: ASYM    -hkl on :', A, '.hks (# refl. =', I7, ')')
99965 FORMAT (':: POWDER   cpi on :', A, '.cpi')
99964 FORMAT (':: HKLF5.HKL    on :', A, '.hkp')
99963 FORMAT (':: SHXABS   hkl on :', A, '.hkp')
99962 FORMAT (':: CheckFCF out on :', A, '.ckf')
99961 FORMAT (':: Expanded Coordinate Set (shelx-style) on: ', A)
99960 FORMAT (':: Expanded Reflection Set (SHELX-Style) on: ', A)
99959 FORMAT (':: Fourier3D    on :', A, '.fou')
99958 FORMAT (':: Solv3D       on :', A, '.slv')
99957 FORMAT (':: Flip Results on: ', A, '_flp.res',
     1        ' - Concatenation of Flip-maps', /, 20X,
     2        A, '_sol.res - Concatenation of Solutions', /, 20X,
     3        A, '_res.res - Best Solution')
99955 FORMAT (20X, A, '_res.new - Updated version of ', A, '_res.res')
99954 FORMAT (A,'_res.new')
99953 FORMAT (A)
99952 FORMAT (':: SHELXL.INS (From .res in CIF) on :', A)
99951 FORMAT (':: SHELXL.HKL (From .hkl in CIF) on :', A)
99950 FORMAT (':: SHELXL.FAB (From .fab in CIF) on :', A)
99949 FORMAT (/, ':: Modified SHELX-File on ', A, '_new.res')
99948 FORMAT (':: HKLF4.HKL    on :', A, '_sx.hkl')
99947 FORMAT (':: SHELXL.HKL (From  hkl in FCF) on :', A, /)
99946 FORMAT (':: GENERATE hkl on :', A, '_gener.hkl(# refl. =',
     1  I7, ')')
      END SUBROUTINE PLA004
      SUBROUTINE PLA005 (MODE, ICL)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,
     1 NVD=100000000)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER IDM*(80), ICL*(*)
      COMMON /PL266A/ CELAB(2, 6), VCAB(2, 6), ICV(2), TEMPAB(2)
      COMMON /PL005/ NCYCLE
C * MODE = -1
C * MODE =  0 - PLATON
C * MODE =  1 - PLUTON
C * GET ARGUMENTS & FLAGS
      IF (MODE .LT. 0) THEN
C * FIRST CHECK FOR PROGRAM NAME ALIASES (LINKED TO PLATON EXECUTABLE)
        DO J = 0, IARGC()
          CALL GETARG (J, IDM)
          IF (J .EQ. 0) THEN
            IF (INDEX (IDM, 'platon') .NE. 0) THEN
              CYCLE
C * SIMULATE -p option when called as 'pluton'
            ELSE IF (INDEX (IDM, 'pluton') .NE. 0) THEN
              IDM = '-p'
C * SIMULATE -u option when called as 'cifchk'
            ELSE IF (INDEX (IDM, 'cifchk') .NE. 0) THEN
              IDM = '-u'
C * SIMULATE -s option when called as 's'
            ELSE IF (INDEX (IDM, 's ') .NE. 0) THEN
              IDM = '-s'
C * SIMULATE -k option when called as 'helena'
            ELSE IF (INDEX (IDM, 'helena ') .NE. 0) THEN
              IDM = '-k'
C * SIMULATE -Y option when called as 'stidy'
            ELSE IF (INDEX (IDM, 'stidy ') .NE. 0) THEN
              IDM = '-Y'
C * SIMULATE -Z option when called as 'flipper'
            ELSE IF (INDEX (IDM, 'flipper ') .NE. 0) THEN
              IDM = '-Z'
            END IF
          END IF
          IF (IDM(1:1) .EQ. '-') THEN
            ISWVAL = 0
            READ (IDM(3:5), *, IOSTAT = IOST) ISWVAL
            IF (IOST .NE. 0) ISWVAL = 0
            SELECT CASE (IDM(2:2))
C * ADP-ORTEP MODE
              CASE ('a')
                IGBL(3)  = 3
C * CALC GEOM CSD
              CASE ('b')
                IGBL(3) = 11
C * CALC MODE
              CASE ('c')
                IGBL(3) = 2
C * COMPARE REFL FILES
              CASE ('d')
                IGBL(3) = 6
C * MULABS - MODE
              CASE ('e')
                IGBL(3) = 18
C * HFIX
              CASE ('f')
                IGBL(3)  = 13
                IGBL(50) = 1
C * CALC GEOM SHELX
              CASE ('g')
                IGBL(3) = 24
                IGBL(25) = 0
C * HKL CALC
              CASE ('h')
                IGBL(3) = 10
C * PATTERSON PLOT
              CASE ('i')
                IGBL(3) = 22
C * CALC GEOM SPF
              CASE ('j')
                IGBL(3)  = 23
                IGBL(25) = 0
C * HELENA - MODE
              CASE ('k')
                IGBL(3) = 15
                NAMEFIL = 'helena'
                KNMFIL  = 6
                EXTENS  = 'cad'
                KXT     = 3
C * ASYM AVF VIEW
              CASE ('l')
                IGBL(3) = 17
C * ADDSYM - MODE
              CASE ('m')
                IGBL(25) = 0
                IF (ISWVAL .GT. 0) RGBL(15) = FLOAT(100 - ISWVAL)
                IGBL(3) = 4
C * ADDSYM SHELX - MODE
              CASE ('n')
                IGBL(3) = 16
C * MENU OFF
              CASE ('o')
                IGBL(25) = 0
C * PLUTON MODE
              CASE ('p')
                IGBL(3) = 8
C * SQUEEZE/HYBRID - MODE
              CASE ('q')
                IF (ISWVAL .EQ. 0) THEN
                  IGBL(3) = 5
                ELSE
                  NCYCLE = ISWVAL
                  IGBL(3)  = 48
                END IF
C * RENAME MODE
              CASE ('r')
                IGBL(3) = 12
C * S - MODE
              CASE ('s')
                IGBL(3) = 14
                NAMEFIL = 's'
                KNMFIL  = 1
                RETURN
C * TABLE  - MODE
              CASE ('t')
                IGBL(3) = 7
C * IUCR MODE
              CASE ('u')
                IGBL(3)  = 1
                IPR(71)  = 0
                IGBL(36) = 1
                IF (ISWVAL .GT. 0) IGBL(93) = ISWVAL
C * SOLV MODE
              CASE ('v')
                IGBL(3) = 9
C * DIFFERENCE MAP
              CASE ('w')
                IGBL(3) = 19
C * FO MAP
              CASE ('x')
                IGBL(3) = 20
C * SQUEEZE MAP
              CASE ('y')
                IGBL(3) = 21
C * WRITE IDENT
              CASE ('z')
                WRITE (LU6, 99998, IOSTAT = IOST) IGBL(4)
                IF (IOST .EQ. 0 .OR. IOST .NE. 0) CALL GEN127 (' ')
C * PLUTON ANIS
              CASE ('A')
                IGBL(3) = 26
C * BIJVOET ANALYSIS
              CASE ('B')
                IGBL(3) = 46
C * TABL ACC
              CASE ('C')
                IGBL(3) = 35
C * DIFF-FOURIER
              CASE ('D')
                IGBL(3) = 44
C * EXOR
              CASE ('E')
                IGBL(25) = 0
                IGBL(3)  = 42
C * SILENT S NQA - MODE
              CASE ('F')
                IGBL(50) = 2
                IGBL(3)  = 14
                NAMEFIL  = 's'
                KNMFIL   = 1
                RETURN
C * CHEM-MODE CHECKCIF (I MARKED ALERTS IGNORED)
              CASE ('G')
                IGBL(132) = 1
                IPR(71)   = 0
                IGBL(3)   = 1
C * CREATE .ins & .hkl + SHELXL refinement
              CASE ('H')
                IGBL(3)  = 45
                IGBL(25) = 0
C * AUTOMOLFIT
              CASE ('I')
                IGBL(3)  = 41
                IGBL(25) = 0
                IGBL(32) = 0
C * COMPARE PS
              CASE ('J')
                IGBL(25) = 0
                IGBL(3)  = 47
C * CALC KPI
              CASE ('K')
                IGBL(3)  = 36
                IGBL(25) = 0
C * TWINROTMAT (INTERACTIVE)
              CASE ('L')
                IGBL(3) = 40
C * TWINROTMAT (FILTER MODE)
              CASE ('M')
                IGBL(3)  = 37
                IGBL(25) = 0
C * ADDSYM EQUAL SHELX - MODE
              CASE ('N')
                IGBL(3) = 38
C * PLOT ADP PS
              CASE ('O')
                IGBL(25) = 0
                IGBL(3)  = 28
C * HKL2POWDER IOBS
              CASE ('P')
                IGBL(3)  = 29
                RGBL(23) = ISWVAL
C * POWDER ICALC (POSTSCRIPT + CPI)
              CASE ('Q')
                IGBL(3)  = 31
                RGBL(23) = ISWVAL
C * RENUM ==> SHELX
              CASE ('R')
                IGBL(3) = 27
C * CIF2RES & FCF2HKL
              CASE ('S')
                IGBL(3) = 25
C * TWINROTMAT (RL-PLOT)
              CASE ('T')
                IGBL(3) = 30
C * IUCR MODE (without VALIDATION DOC)
              CASE ('U')
                IPR(71)  = 0
                IGBL(3)  = 1
                IGBL(36) = 1
                IGBL(83) = 0
                IF (ISWVAL .GT. 0) IGBL(93) = ISWVAL
C * FCF-VALIDATION (LAUE)
              CASE ('V')
                IGBL(3) = 33
C * FCF-VALIDATION (BIJVOET)
              CASE ('W')
                IGBL(3) = 34
C * SHX86
              CASE ('X')
                IGBL(3) = 32
C * STIDY
              CASE ('Y')
                IGBL(3) = 39
C * ULTRA FLIPPER
              CASE ('Z')
                IGBL(3) = 43
C * DEFAULT
              CASE DEFAULT
                IGBL(8)      = 1
                IGBL(19)     = 1
                FILENAMES(1) = 'zz12345.zzz'
            END SELECT
          ELSE IF (IDM(1:1) .NE. '+') THEN
            IF (IGBL(19) .LT. 2) THEN
              IGBL(19)            = IGBL(19) + 1
              FILENAMES(IGBL(19)) = IDM
            END IF
          END IF
        END DO
C * ANALYZE/STORE FILENAME - DETERMINE FILE EXTENSION
        CALL PLA261 (IGBL(19))
      ELSE
        IPR(599) = 0
        IF (IGBL(3) .NE. 0) CALL GEN038 (ICL, 1, 80)
        SELECT CASE (IGBL(3))
          CASE (1)
            IF (IGBL(12) .NE. 0) THEN
              IF (IABS(IGBL(8)) .EQ. 3) THEN
                ICL      = 'VALID'
                IGBL(45) = 1
                CALL GEN108 (LU3, 0)
              ELSE
                WRITE (6,
     1   '('' ==== >>> Cannot do -u !!! - CIF not Recognized'', /)',
     2          IOSTAT = IOST)
                CALL PLA004 (0)
              END IF
            ELSE
              WRITE (6,
     1   '('' ==== >>> Cannot do -u !!! - no check.def found'', /)',
     2        IOSTAT = IOST)
            END IF
          CASE (2)
            ICL      = 'CALC'
            IGBL(45) = 1
            CALL GEN108 (LU3, 0)
          CASE (3, 28)
            ICL = 'PLOT ADP COLOR'
            IGBL(45) = 1
            IPR(308) = 2
            IPR(324) = 0
            CALL GEN108 (LU3, 0)
          CASE (4)
            ICL = 'CALC ADDSYM'
          CASE (5)
            ICL = 'CALC SQUEEZE'
          CASE (7)
            ICL = 'TABLE SUP'
          CASE (9)
            ICL = 'CALC SOLV'
          CASE (10)
            ICL = 'ASYM GENERATE'
          CASE (11)
            ICL = 'CALC GEOM CSD'
          CASE (16)
            ICL = 'CALC ADDSYM SHELX NOSF'
          CASE (17)
            ICL = 'ASYM AVF VIEW'
          CASE (18)
            ICL = 'MULABS'
          CASE (19)
            PAR(274) = 0.0
            PAR(275) = 0.0
            PAR(276) = 0.0
            ICL      = 'CONTOUR DI TN'
          CASE (20)
            PAR(274) = 0.0
            PAR(275) = 0.0
            PAR(276) = 0.0
            ICL      = 'CONTOUR FO TN'
          CASE (21)
            PAR(274) = 0.0
            PAR(275) = 0.0
            PAR(276) = 0.0
            ICL      = 'CONTOUR SQ TN'
          CASE (22)
            PAR(274) = 0.0
            PAR(275) = 0.0
            PAR(276) = 0.0
            ICL      = 'CONTOUR PT TN'
          CASE (23)
            ICL      = 'CALC GEOM SPF'
          CASE (24)
            ICL      = 'CALC GEOM SHELX'
          CASE (25)
            ICL      = 'CALC GEOM SHELX'
          CASE (27)
            ICL      = 'CALC GEOM RENUM SHELX'
          CASE (29)
            ICL      = 'POWDER IOBS'
          CASE (30, 37, 40)
            ICL = 'ROTMAT'
          CASE (31)
            ICL = 'POWDER'
          CASE (33)
            ICL = 'ASYM AVF VALID'
          CASE (34)
            ICL = 'ASYM VALID'
          CASE (35)
            ICL = 'TABL ACC'
          CASE (36)
            ICL = 'CALC VOID'
          CASE (38)
            ICL = 'CALC ADDSYM EQUAL SHELX NOSF'
          CASE (41)
            ICL = 'FIT'
          CASE (42)
            ICL = 'EXOR'
          CASE (43)
            ICL = 'FLIP'
          CASE (44)
            ICL = 'CALC DIFF'
          CASE (45)
            ICL = 'CIF2SHELXL'
          CASE (46)
            ICL = 'BIJVOET'
          CASE (48)
            WRITE (ICL, '(''HYBRID'', I3)') NCYCLE
          CASE DEFAULT
C * INTERACTIVE OUTPUT PROGRAM HEADER (PLATON)
            IF (MODE .EQ. 0) THEN
              IF (IGBL(72) .EQ. 0) THEN
                WRITE (LU6, 99999, IOSTAT = IOST)
     1            IGBL(4), NVD / 250000
                IGBL(72) = 1
              END IF
              IF (IPR(39) .EQ. 0) THEN
                IF (IABS(IGBL(8)) .EQ. 3) THEN
                  ICL = 'END'
                  RETURN
                ELSE
                  IF (TEMPAB(1) .EQ. 0)
     1              WRITE (LU6, 99997, IOSTAT = IOST)
                END IF
              END IF
            END IF
            IPR(599) = 1
        END SELECT
      END IF
      RETURN
99999 FORMAT ('::', 29X,
     1        'S.e.l.e.c.t.e.d  I.n.s.t.r.u.c.t.i.o.n.s', /,
     2        '::', 1X, 24('*'), 2X,
     3        'CALC for an exhaustive geometry calculation', /,
     4        '::', 1X, '*        PLATON        *', 2X,
     5        'PLOT ADP for default labeled ORTEP-look-alike', /,
     6        '::', 1X, '*        ======        *', 2X,
     7        'TABL CIF for an Acta Cryst C CIF-file', /,
     8        '::', 1X, '*    A Multipurpose    *', 2X,
     9        'LEPAGE to check for higher metrical symmetry', /,
     *        '::', 1X, '*   Crystallographic   *', 2X,
     1        'CALC ADDSYM for a check for MISsed SYMmetry', /,
     2        '::', 1X, '*         Tool         *', 2X,
     3        'CALC NONSYM for a non-cryst. symm. check', /,
     4        '::', 1X, '*          --          *', 2X,
     5        'CALC SOLV to search for missed solvent areas', /,
     6        '::', 1X, '*(C) 1980-2014 A.L.Spek*', 2X,
     7        'CALC SQUEEZE to handle disordered solvents', /,
     8        '::', 1X, '*          --          *', 2X,
     9        'PLOT NEWMAN for NEWMAN-Projection Plots', /,
     *        '::', 1X, '*   version :', I7, '   *', 2X,
     1        'LIST RADII for current radii list', /,
     2        '::', 1X, '*   scratch :', I5, 'MB   *'  2X,
     3        'HELP for Available Instruction Information', /,
     4        '::', 1X, 24('*'), 2X,
     5        'PLUTON to enter the PLUTON sub-program')
99998 FORMAT ('PLATON-Version=', I10)
99997 FORMAT (/, ':: Warning: no ATOMS given yet')
      END SUBROUTINE PLA005
      SUBROUTINE PLA006 (MODE, IS)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP24=207,NP37=191,NP38=150,NP39=30,NP45=2048,NP52=200,
     2 NP56=30,NP57=35,NP58=50)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4  ZSPG*7, SPGRNM(4)*26, UPDATE*12, DISPTYPE*2, CHSG*6
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80, ICH*1
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, COLR*10, BWCT*10
      COMMON /CIFCOM/ NLP(NP58), ILOOP, NL, NLPM, ISEMC, IVOID, KW, NW,
     1 FA(2), CELL(12), NHTP, INUM, NSTR, NSTRS, IRECMAX, LRETCIF
C * FREE FORMAT READ ROUTINE
      NP    = 0
      S     = 0
   10 J     = 0
      ICONT = 0
      A     = 0.0
   20 KN    =  0
      KL    =  0
      IS    = -1
      CALL GEN074 (FN, 1, NP17, 0.0)
      DO I = 1, NP17
        CALL GEN038 (IFL(I), 1, 7)
      END DO
C * CONSIDER INTERACTIVE GRAPHICS INPUT OR AUTO 'PLOT'
      IF (IGGT(1:1) .EQ. ' ') THEN
        IF (IGBL(6) .GT. 0) THEN
          IF (IGBL(6) .LT. 10 .OR. IGBL(6) .GT. 12) THEN
            IF (IGBL(5) * IGBL(24) * IGBL(25) .EQ. LU5) THEN
              ICL = 'PLOT'
              GO TO 50
            END IF
          END IF
        END IF
      ELSE
        ICL = IGGT
        CALL GEN038 (IGGT, 1, 80)
        IF (IGBL(74) .EQ. 1) WRITE (LU6, 99999, IOSTAT = IOST)
     1     IGBL(6), ICL(1:60)
        GO TO 50
      END IF
   30 IF (IGBL(5) .EQ. LU5) THEN
        CALL PLA005 (MODE, ICL)
        IF (IPR(599) .EQ. 0) GO TO 50
      END IF
C * READ CARD-IMAGE IN CHARACTER BUFFER ICL
   40 CALL PLA019 (0, IER)
      IF (IER .NE. 0) THEN
        IGBL(8) = - IABS(IGBL(8))
        GO TO 100
      END IF
      IF (MODE .EQ. 1 .AND. IGBL(5) .EQ. LU1) THEN
        CALL GEN038 (NQ1, 1, 7)
        CALL PLUT29 (1, ICL, NQ1, 0, 0)
      END IF
C * CHECK/FIND-OUT DATA TYPE (= IGBL(8))
   50 IF (IGBL(8) .EQ. 0) THEN
        DO I = 1, 80
          IF (ICL(I:I) .EQ. CHAR(13)) GO TO 40
          IF (ICL(I:I) .EQ. CHAR(35)) GO TO 40
          IF (ICL(I:I) .NE. CHAR(32)) THEN
C * LOOK FOR CIF-STYLE STRUCTURED DATA (TRIGGERED BY data_) (IGBL(8) = 3)
            N = INDEX (ICL, 'data_')
            IF (N .GT. 0 .AND. ICL(1:4) .NE. 'TITL' .AND.
     1        INDEX (ICL, '_data_') .EQ. 0) THEN
              IGBL(8) = 3
              ISEMC   = 0
              IVOID   = 0
              ILOOP   = 0
              NL      = 0
              LRETCIF = 0
              IF (ICL(N + 5:N + 11) .EQ. 'CSD_CIF') IGBL(104) = 1
              IPR(220) = 1
              IPR(221) = 0
              CALL PLA009
              IGBL(30) = 1
              WRITE (LU6, 99996, IOSTAT = IOST)
            END IF
            IF (LRETCIF .EQ. -2) THEN
              IGBL(8) = - IABS(IGBL(8))
              GO TO 100
            END IF
C * CHECK FOR PDB-FILE-STRUCTURE  (IGBL(8) = 4)
            IF (IGBL(8) .EQ. 0) THEN
              LRETPDB = -1
              CALL PLA008 (MODE, LRETPDB)
C * ASSUME SPF = 1 (OR RES = 2)
              IF (IGBL(8) .EQ. 0) THEN
                WRITE(6, '(''>>'',A)') ICL(1:50)
                NQ1 = ICL(1:4)
                IF (NQ1 .EQ. '    ') GO TO 40
                CALL GEN020 (1, NQ1, 1, 4)
                IF (NQ1(1:3) .EQ. 'REM') GO TO 40
                IF (NQ1(1:4) .EQ. 'TITL') THEN
                  IGBL(8) = 1
                ELSE
                  IPR(2)  = 64
                  RETURN
                END IF
              END IF
            END IF
C * FIND REFLECTIONS (fcf or hkl STYLE)
            IF (MODE .EQ. 0 .AND.IGBL(8) .EQ. 3) CALL PLA286
            GO TO 50
          END IF
        END DO
        GO TO 40
C * RESTRICTED CIF - FORMAT (COMPATIBLE WITH SHELXL)
      ELSE IF (IGBL(8) .EQ. 3) THEN
        CALL PLA007 (MODE)
        KL = IPR(220)
        KN = IPR(221)
        SELECT CASE (LRETCIF)
          CASE (1)
            GO TO 90
          CASE (2)
            IGBL(8) = - IABS(IGBL(8))
            GO TO 100
          CASE (3)
            IS      = -2
            IPR(3)  = 1
            IGBL(8) = - IABS(IGBL(8))
            GO TO 100
          CASE (4)
            IS = -3
            RETURN
        END SELECT
C * PDB-FILE STRUCTURE
      ELSE IF (IGBL(8) .EQ. 4) THEN
        LRETPDB = 0
        CALL PLA008 (MODE, LRETPDB)
        IF (LRETPDB .EQ. 0) THEN
          GO TO 90
        ELSE IF (LRETPDB .EQ. 1) THEN
          IGBL(8) = - IABS(IGBL(8))
          GO TO 100
        ELSE IF (LRETCIF .EQ. 2) THEN
          IS      = 0
          IPR(3)  = 1
          IGBL(8) = - IABS(IGBL(8))
          GO TO 100
        END IF
C * SPF or RES  & Instructions
      ELSE
        CALL GEN020 (1, ICL, 1, 4)
        N = INDEX (ICL(1:80), CHAR(13))
        IF (N .NE. 0) ICL(N:N) = CHAR(32)
        IF (ICL(1:4) .EQ. 'TITL' .OR. ICL(1:3) .EQ. 'REM' .OR.
     1      ICL(1:4) .EQ. 'MESS' .OR. ICL(1:4) .EQ. 'FILE') THEN
          I80 = 4
        ELSE IF (ICL(1:4) .EQ. 'ENTR') THEN
          I80 = 5
        ELSE
          I80 = 80
        END IF
        CALL GEN020 (1, ICL, 1, I80)
        IF (IPR(470) .EQ. 1) THEN
          IF (IGBL(5) .EQ. LU1) THEN
            IF (ICL(1:3) .NE. 'END') THEN
              IPR(471) = IPR(471) + 1
              GO TO 20
            END IF
          END IF
          IPR(470) = 0
        END IF
        ICH = ICL(1:1)
        IF (KL .EQ. 0 .AND. KN .EQ. 0 .AND.
     1        (ICH .EQ. ' ' .OR. ICH .EQ. '#' .OR. ICH .EQ. '+')) THEN
          IF (MODE .EQ. 0) THEN
            IF (IGBL(5) .EQ. LU5) THEN
              GO TO 100
            ELSE
              IPR(472) = IPR(472) + 1
              IPR(471) = IPR(471) + 1
            END IF
            GO TO 20
          END IF
        END IF
        IF (IGBL(5) .EQ. LU2 .AND. MODE .NE. 0)
     1      WRITE (LU6, 99997, IOSTAT = IOST) ICL(1:80)
        IF (IGBL(5) .EQ. LU3)
     1    WRITE (LU6, 99998, IOSTAT = IOST) ICL(1:80)
        IMAX  = 80
        ICONT = 0
        DO I = 1, IMAX
          IF (ICL(I:I) .EQ. '!') THEN
            IMAX = I - 1
            EXIT
          ELSE IF (ICL(I:I) .EQ. '=') THEN
            IMAX  = I - 1
            ICONT = 1
            EXIT
          END IF
        END DO
        NCHAR = 7
        I     = 0
        GO TO 70
C * END OF NUMERIC FIELD
   60   IF (KN .LT. NP17) THEN
          KN     = KN + 1
          FN(KN) = S * A / 10.0**NP
        END IF
        IF (ICH .EQ. '+' .OR. ICH .EQ. '-') I = I - 1
   70   A     = 0.0
        IP    = 0
        NP    = 0
        L     = 0
        S     = 1.0
   80   I     = I + 1
        IF (I .LE. IMAX) THEN
          ICH   = ICL(I:I)
          IF (ICH .EQ. CHAR(9)) THEN
            ICH = CHAR(32)
            ICL(I:I) = ICH
          END IF
          IF (L .EQ. 0 .AND. ICH .EQ. ' ') GO TO 80
          L = L + 1
          DO J = 1, 10
            IF (ICH .EQ. CHAR(ICHAR('0') + J - 1)) THEN
              IF (IGBL(5) .NE. LU5 .AND. KL .EQ. 0) GO TO 20
              NP = NP + IP
              A  = 10.0 * A + J - 1
              GO TO 80
            END IF
          END DO
          IF (ICH .EQ. '.') THEN
            IP = 1
          ELSE IF (ICH .EQ. '+') THEN
            IF (L .GT. 1) GO TO 60
            S = 1.0
          ELSE IF (ICH .EQ. '-') THEN
            IF (L .GT. 1) GO TO 60
            S = -1.0
          ELSE IF (ICH .EQ. ']') THEN
            GO TO 60
          ELSE
            IF (L .LE. 1) THEN
C * START NEW LITERAL FIELD
              IF (KL .LT. NP17) KL = KL + 1
              IF (KL .GT. 1 .AND. IS .LT. 0) THEN
                IF (MODE .EQ. 0) THEN
                  CALL GEN102 (IS, IFL(1), ISWS, NP24)
                ELSE
                  CALL GEN102 (IS, IFL(1), CRD,  NP37)
                END IF
C * DO NOT INTERPRETE TITL, REM AND MESS LINES
                IF (IS .GT. 1 .AND. IS .LT. 5) GO TO 100
              END IF
              DO
                IFL(KL)(L:L) = ICH
                L            = L + 1
                IGGTN = (KL - 1) * 7 + L
                IF (IGGTN .LE. 80) IGGT(IGGTN:IGGTN) = ICH
                IF (IGGTN .EQ. 2) CALL GEN038 (IGGT, 3, 80)
                DO
                  I = I + 1
                  IF (I .GT. IMAX) GO TO 70
                  ICH = ICL(I:I)
                  IF (ICH .EQ. ' ' .OR. ICH .EQ. ',') GO TO 70
                  IF (ICH .EQ. '[' .AND. L .GT. 3) GO TO 70
                  IF (ICH .EQ. '.') THEN
                    I = I - 1
                    GO TO 70
                  END IF
                  IF (ICH .EQ. '+' .OR. ICH .EQ. '-') THEN
                    IF (IGBL(8) .NE. 2 .OR. I .GT. 3) THEN
                      I = I - 1
                      GO TO 70
                    END IF
                  END IF
                  IF (L .LE. NCHAR) EXIT
                END DO
              END DO
C * END OF LITERAL FIELD
              GO TO 90
            ELSE
              GO TO 60
            END IF
          END IF
          GO TO 80
        END IF
        IF (L .GT. 0) GO TO 60
      END IF
   90 IF (IS .LT. 0) THEN
        IF (IFL(1)(1:4) .EQ. 'TEXT') THEN
          CALL PLA109 (1, 1, 0.0, 0.0, 0)
          CALL PLA013 (0, 1)
          GO TO 10
        END IF
        IF (MODE .EQ. 0) THEN
          CALL GEN102 (IS, IFL(1), ISWS, NP24)
        ELSE
          CALL GEN102 (IS, IFL(1), CRD,  NP37)
        END IF
      END IF
      IF (ICONT .EQ. 1) THEN
        IF (IS .LT. 2 .OR. IS .GT. 4) GO TO 30
      END IF
      IENDS = 0
      IF (MODE .EQ. 0) THEN
        IF (IS .EQ. 14)  IENDS = 1
      ELSE
        IF (IS .EQ. 140) IENDS = 1
      END IF
      IF (IENDS .EQ. 1) THEN
        CALL PLA019 (0, IER)
          IF (IER .GE. 0) THEN
          BACKSPACE IGBL(5)
        ELSE
          IS = -1
        END IF
      END IF
  100 IPR(220) = KL
      IPR(221) = KN
      IF (MODE .EQ. 1) THEN
        IF (IS .EQ. 93) THEN
          IS = 65
        ELSE IF (IS .EQ. 71) THEN
          IS = 26
        ELSE IF (IS .EQ. 64) THEN
          IS = 40
        ELSE IF (IS .EQ. 32) THEN
          IS = 31
        ELSE IF (IS .EQ. 156) THEN
          IS = 13
        END IF
      END IF
      RETURN
99999 FORMAT (':: GGIP(', I3, '): ', A)
99998 FORMAT (':: SEx:', A)
99997 FORMAT (':: Def:', A)
99996 FORMAT (/, ':: Restricted CIF-File Format assumed',
     1           ' (Automatic NOMOVE effective) ', /)
      END SUBROUTINE PLA006
      SUBROUTINE PLA007 (MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP52=200,NP56=30,NP57=35,
     2 NP58=50,NKW=49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80, ICH*1, ICHU*1
      COMMON /WORDC/ NWRD, STRSAVE
      CHARACTER NWRD*82, STRSAVE*250, KEYWRD*(NKW), QT*1
      COMMON /CIFCOM/ NLP(NP58), ILOOP, NL, NLPM, ISEMC, IVOID, KW, NW,
     1 FA(2), CELL(12), NHTP, INUM, NSTR, NSTRS, IRECMAX, LRETCIF
C * CIF-READ ROUTINE
C * CHECK FOR/HANDLE/SAVE MATERIAL BETWEEN ;;
      CALL PLA264
      IF (LRETCIF .GT. 0) THEN
        LRETCIF = MOD (LRETCIF, 10)
      ELSE
       IF (ICL(1:1) .EQ. '#') RETURN
        DO I = 1, IRECMAX
          IF (ICL(I : I) .NE. CHAR(32)) GO TO 10
        END DO
      END IF
      RETURN
C * GET DATASET HEADER data_ RECORD
   10 IF (ICL(I : I + 4) .EQ. 'data_') THEN
        IF (INDEX (ICL(1:80), '_data_') .EQ. 0) THEN
          IF (IPR(499) .GT. 0) THEN
            IF (INDEX (ICL(1:80), 'global') .NE. 0) RETURN
          END IF
          N = INDEX (ICL(1:80), 'CSD_CIF')
          IF (N .EQ. 0) THEN
            N = I + 5
          ELSE
            IF (ICL(N+8:N+11) .EQ. 'MIF_') THEN
              N = N + 12
            ELSE
              N = N + 8
            END IF
            IGBL(94) = 1
          END IF
          IF (IPR(39) .EQ. 0) THEN
            CALL GEN151 (ICL, N)
            JID = ICL(N:79 + N)
          END IF
          LRETCIF = 0
          CALL PLA265 (0)
          IPR(499) = IPR(499) + 1
          IF (IPR(499) .GT. 1) THEN
            IF (IPR(39) .EQ. 0) THEN
              IF (IGBL(50) .EQ. 0)
     1          WRITE (LU6, 99999, IOSTAT = IOST) JID
              IF (IGBL(94) .EQ. 1) THEN
                IF (IGBL(58) .EQ. 0) THEN
                  IGBL(54) = IGBL(54) + 1
                ELSE
                  IGBL(54) = IGBL(54) - 1
                END IF
              END IF
              RETURN
            END IF
            BACKSPACE IGBL(5)
            IFL(1)   = 'ENDS'
            ICL      = 'ENDS'
            IPR(220) = 1
            IPR(221) = 0
            IGBL(8)  = - IABS(IGBL(8))
            LRETCIF  = 1
            RETURN
          END IF
          ICL    = 'TITL '//JID(1:75)
          IFL(1) = 'TITL'
          IF (IGBL(3) .NE. 14) CALL GEN108 (LU11, 0)
          CALL PLA231 (0, 0, 0.0, 0.0, LINE(I:80), ' ')
          IPR(220) = 1
          IPR(221) = 0
          LRETCIF  = 1
          RETURN
        END IF
C * loop_ RECORD
      ELSE IF (ICL(I : I + 4) .EQ. 'loop_') THEN
        DO J = I + 5, 80
          IF (ICL(J:J) .NE. CHAR(32)) THEN
            IGGT(1:80) = ICL(J:80)
            EXIT
          END IF
        END DO
        ILOOP    = 1
        NLPM     = 0
        IPR(220) = 0
        IPR(221) = 0
        RETURN
C * stop_ RECORD
      ELSE IF (ICL(I : I + 4) .EQ. 'stop_') THEN
        RETURN
      END IF
C * RESET (NON)KEYWORD STATUS FOR NEW RECORD
      KW = 0
      NW = 0
      NL = 0
      CALL GEN038 (KEYWRD, 1, NKW)
   20 IESC = 0
      DO I = 1, IRECMAX + 1
        ICH = ICL(I : I)
        IF (ICHAR(ICH) .LT. 32 .OR. ICHAR(ICH) .GT. 126)
     1    ICH = CHAR(32)
        ICHU = ICH
        CALL GEN020 (1, ICHU, 1, 1)
C * CONTINUE/FINISH BUILDING KEYWORD
        IF (KW .NE. 0) THEN
          CALL PLA267 (ICH, KEYWRD)
          IF (LRETCIF .GT. 0) RETURN
        ELSE
C * START NEW WORD
          IF (NW .EQ. 0) THEN
            IF (ICH .EQ. '_') THEN
              KW          = 1
              KEYWRD(1:1) = ICH
              IF (ILOOP .EQ. 0) NLPM = 1
              LINE = ' '
            ELSE IF (ICH .NE. CHAR(32)) THEN
              IF (ICH .NE. '''' .AND. ICH .NE. '"') THEN
                CALL GEN038 (NWRD, 3, 82)
                NW        = 2
                NWRD(2:2) = ICHU
                QT        = CHAR(32)
              ELSE
                NW        = 1
                QT        = ICH
              END IF
            END IF
          ELSE
            IF (NW .GT. 0 .AND. NW .LE. 80) THEN
              NW          = NW + 1
              NWRD(NW:NW) = ICHU
            ELSE IF (NW .EQ. 81) THEN
              NW          = NW + 1
              NWRD(NW:NW) = NWRD(1:1)
              WRITE (LU6, 99998, IOSTAT = IOST) ICL(1:80), ICL(81:160)
            END IF
            IF ((ICH .EQ. '''' .OR. ICH .EQ. '"') .AND. IESC .EQ. 1)
     1        THEN
              IESC = 0
            ELSE IF (ICH .EQ. CHAR(92)) THEN
              IESC = 1
            ELSE IF (ICH .EQ. QT) THEN
              IF (QT .EQ. ' ' .OR. QT .EQ. '"') NWRD(NW:NW) = ''''
              ILOOP = 0
              IF (NL .EQ. 0) THEN
                IF ((NLP(1) .GE. 337 .AND. NLP(1) .LE. 346) .OR.
     1              (NLP(1) .GE. 424 .AND. NLP(1) .LE. 425)) GO TO 30
                IPR(220) = 0
                IPR(221) = 0
              END IF
              CALL GEN042 (NWRD, 82, FA, INUM)
              IF (INUM .EQ. -2) WRITE (LU6, 99997, IOSTAT = IOST) NWRD
              IF (NL .LT. NLPM) THEN
                NL = NL + 1
                I0 = I
                CALL PLA269 (MODE, I0)
                IF (LRETCIF .GT. 0) THEN
                  LRETCIF = MOD (LRETCIF, 10)
                  RETURN
                ELSE
                  IF (NL .EQ. NLPM) THEN
                    IF (IPR(220) .LE. 0) THEN
                      CALL PLA268 (MODE)
                    ELSE
                      LRETCIF = 1
                      RETURN
                    END IF
                  END IF
                END IF
              END IF
              CALL GEN038  (NWRD, 1, 82)
              NW = 0
            ELSE
              IESC = 0
            END IF
          END IF
        END IF
      END DO
C * HANDLE INCOMPLETE LOOP (CONTINUE ON NEW LINE)
   30 IF (KW .EQ. 0 .AND. NL .LT. NLPM .AND. NL .GT. 0) THEN
        CALL PLA019 (0, IER)
        IF (IER .GE. 0) THEN
          N = INDEX (ICL, 'data_')
          IF (N .NE. 0) THEN
            I     = N
            NLPM  = 1
            ILOOP = 0
            GO TO 10
          ELSE
            IF (ICL(1:1) .EQ. ';') THEN
C * HANDLE ; PROBLEM IN LOOP
              DO
                CALL PLA019 (0, IER)
                IF (IER .GE. 0) THEN
                  IF (ICL(1:1) .NE. ';') CYCLE
                  ICL(1:9) = ' '' ? '' # '
                  EXIT
                ELSE
                  LRETCIF = 2
                  RETURN
                END IF
              END DO
            END IF
            NW = 0
            GO TO 20
          END IF
        ELSE
          LRETCIF = 2
          RETURN
        END IF
      END IF
      RETURN
99999 FORMAT ('W: CIF Data_Record with no Data: Skipped', //,
     1        ':: New Data Set ', A, /)
99998 FORMAT (':: OVERFLOW PROBLEM in RECORD:', /, A, /, A, /,
     1    '... etc ...', /, ':: RECORD TRUNCATED to 80 Characters', /)
99997 FORMAT ('OVERFLOW', /, A)
      END SUBROUTINE PLA007
      SUBROUTINE PLA008 (MODE, LRETPDB)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP52=200,NP56=30,
     2 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 ZSPG*7, SPGRNM(4)*26, UPDATE*12, DISPTYPE*2, CHSG*6
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
C * PDB-READ
      IF (LRETPDB .EQ. 0) THEN
        NATC = 0
        NATO = 0
        NATN = 0
        NATS = 0
        NATH = 0
        NAT  = 0
        NAT2 = 0
        NCRY = 0
        XADD = 25.0
        ADD  = 0.0
        DO
          READ (IGBL(5), 99997, ERR = 30, END = 20) ICL(1:80)
          CALL GEN020 (1, ICL, 1, 80)
          IF (ICL(1:4) .EQ. 'ATOM' .OR. ICL(1:4) .EQ. 'HETA') THEN
            READ (ICL, 99998) NQ1, (FN(L), L = 1, 3)
            FN(1) = FN(1) + ADD
            NB = 1
            NE = 2
            N1 = 0
            N2 = 0
            IF (ICHAR(NQ1(1:1)) .GT. 64 .AND. ICHAR(NQ1(1:1)) .LT. 91)
     1        N1 = 1
            IF (ICHAR(NQ1(2:2)) .GT. 64 .AND. ICHAR(NQ1(2:2)) .LT. 91)
     1        N2 = 1
            IF (N1 .EQ. 1 .AND. N2 .EQ. 0) THEN
              NE = 1
            ELSE IF (N1 .EQ. 0 .AND. N2 .EQ. 1) THEN
              NB = 2
            ELSE IF (N1 .EQ. 1 .AND. N2 .EQ. 1) THEN
              NAT2 = NAT2 + 1
              N    = NAT2
              GO TO 10
            ELSE
              WRITE (LU6, 99995, IOSTAT = IOST) NQ1
              RETURN
            END IF
            IF (NQ1(NB:NE) .EQ. 'C') THEN
              NATC = NATC + 1
              N    = NATC
            ELSE IF (NQ1(NB:NE) .EQ. 'O') THEN
              NATO = NATO + 1
              N    = NATO
            ELSE IF (NQ1(NB:NE) .EQ. 'N') THEN
              NATN = NATN + 1
              N    = NATN
            ELSE IF (NQ1(2:2) .EQ. 'S') THEN
              NATS = NATS + 1
              N    = NATS
            ELSE IF (NQ1(2:2) .EQ. 'H') THEN
              NATH = NATH + 1
              N    = NATH
            ELSE
              NAT  = NAT + 1
              N    = NAT
            END IF
   10       N  = MOD (N, 1000)
            CALL GEN040 (N, NQ2, IP)
            IFL(1)   = NQ1(NB:NE)//NQ2(1:IP)
            IPR(473) = 1
            IPR(220) = 1
            IPR(221) = 3
            IF (MODE .EQ. 0) THEN
              CALL PLA022 (INQNR)
              IF (INQNR .EQ. 0) THEN
                IGBL(54) = IGBL(54) + 1
                GO TO 20
              END IF
            ELSE
              CALL PLUT03 (IER)
            END IF
C * ANISOU
          ELSE IF (ICL(1:6) .EQ. 'ANISOU') THEN
            READ (ICL(29:70), 99996)
     1      FN(1), FN(2), FN(3), FN(6), FN(5), FN(4)
            DO I = 1, 6
              FN(I) = FN(I) / 10000.0
            END DO
            FN(7) = 0.0
            FN(8) = 0.0
            IPR(32) = MAX (IPR(32), 1)
            WRITE (LU4) 2, INQNR, (FN(K), K = 1, 8)
            CYCLE
          ELSE IF (ICL(1:3) .EQ. 'ADD') THEN
            XADD = FN(1)
          ELSE IF (ICL(1:5) .EQ. 'CRYST') THEN
            NCRY = NCRY + 1
            IF (NCRY .EQ. 2) ADD = XADD
          ELSE IF (ICL(1:3) .EQ. 'END') THEN
            IFL(1)   = 'ENDS'
            ICL      = 'ENDS'
            IPR(220) = 1
            IPR(221) = 0
            IGBL(8) = - IABS(IGBL(8))
            RETURN
          ELSE IF (ICL(1:5) .EQ. 'CONECT') THEN
          ELSE IF (ICL(1:5) .EQ. 'MASTER') THEN
          END IF
        END DO
      ELSE IF (LRETPDB .EQ. -1) THEN
C * CHECK FOR PDB-FILE-STRUCTURE (TRIGGERED BY KEYWORD HEADER ON LINE 1)
        IF (ICL(1:6) .EQ. 'HEADER' .OR.
     1      ICL(1:6) .EQ. 'REMARK' .OR.
     2      ICL(1:6) .EQ. 'COMPND') THEN
          IGBL(8) = 4
          IF (ICL(63:66) .NE. '    ') THEN
            JID(1:72) = ICL(63:66)
          ELSE
            JID(1:72) = ICL(8:50)
          END IF
          WRITE (LU6, 99999, IOSTAT = IOST)
          IPR(220) = 1
          IPR(221) = 0
          IF (IGBL(25) .NE. 0) THEN
            CALL PLA009
          ELSE
            CALL GEN108 (LU1, 0)
          END IF
          RETURN
        END IF
        IF (ICL(1:5) .EQ. 'CRYST') THEN
          IGBL(8) = 4
          WRITE (LU6, 99999, IOSTAT = IOST)
          RETURN
        END IF
      END IF
      RETURN
   20 LRETPDB = 1
      RETURN
   30 LRETPDB = 2
      RETURN
99999 FORMAT (/, ':: PDB Type File Format Assumed (HEADER/CRYST)', /)
99998 FORMAT (12X, A, 11X, 3F8.0)
99997 FORMAT (A)
99996 FORMAT (6F7.0)
99995 FORMAT ('Atom ', A, ' - Skipped')
      END SUBROUTINE PLA008
      SUBROUTINE PLA009
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,NP45=2048,NP54=42)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCSD/ RCODE
      CHARACTER RCODE*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CYN*1, REFCOD*8, LIN*80, PRBUF*80, CDATA*75, CENTRY*75
C * HANDLING OF MULTIPLE ENTRY FILES - CREATE DIRECTORY
      PRBUF = ' '
      IF (LU1 .EQ. LU5) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
      ELSE
        IF (IPR(220) .GT. 1) THEN
          REFCOD = IFL(2)
          NENTRY = 0
        ELSE
          REFCOD = ' '
          IF (IPR(221) .GT. 0) THEN
            NENTRY = NINT(FN(1))
            IF (IGBL(100) .NE. 0) GO TO 30
          ELSE
            NENTRY = 0
            IF (IGBL(100) .NE. 0 .AND. IGBL(94) .EQ. 0) THEN
              IPR(462) = 1
              N = MIN (IGBL(100), NP54)
              DO I = 1, N
                WRITE (LU6, 99996) I, CENTRY(I)(1:57),
     1           (IENTRY(I, J), J = 1, 4)
              END DO
            END IF
          END IF
        END IF
        IF (NENTRY .EQ. 0 .OR. IGBL(100) .EQ. 0) THEN
          IF (IGBL(8) .NE. 0 .AND. IABS(IGBL(8)) .LE. 4) THEN
            NCARD     = 0
            NDATA     = 0
            IGBL(100) = 0
            IGBL(86)  = NVD - 6
            ILST      = 1
            XH        = 0.0
            XV        = VERT
            CALL GEN108 (LU1, 0)
C * READ LOOP (DATA ENTRIES)
            DO
              READ (LU1, 99994, IOSTAT = IOST) ICL
              IF (IOST .NE. 0) EXIT
              NCARD = NCARD + 1
              IF (ICL(1:1) .EQ. '#') CYCLE
              NCRD  = 1
C * SPF - SEQUENCE
              IF (ABS(IGBL(8)) .EQ. 1) THEN
                CALL GEN020 (1, ICL(1:4), 1, 4)
                IF (ICL(1:4) .EQ. 'TITL') THEN
                  CDATA = ICL(6:13)
                  NDATA = NCARD - 1
                  GO TO 10
                 ELSE
                   CYCLE
                 END IF
C * RES - SEQUENCE
              ELSE IF (ABS(IGBL(8)) .EQ. 2) THEN
                IF (ICL(1:4) .EQ. 'TITL') THEN
                  NDATA = NCARD - 1
                  CDATA = ICL(6:13)
                  GO TO 10
                ELSE
                  CYCLE
                END IF
C * CIF - SEQUENCE
              ELSE IF (ABS(IGBL(8)) .EQ. 3) THEN
                NPD = INDEX (ICL(1:80), '#')
                IF (NPD .EQ. 0) NPD = 80
                NPC = INDEX (ICL(1:NPD), '_publ_requested_category')
                IF (NPC .NE. 0) THEN
                  IF (INDEX (ICL(NPC + 24: NPD), 'I') .NE. 0) THEN
                    IGBL(99) = 1
                  ELSE IF (INDEX (ICL(NPC + 24: NPD), 'M') .NE. 0) THEN
                    IGBL(99) = 2
                  ELSE IF (INDEX (ICL(NPC + 24: NPD), 'O') .NE. 0) THEN
                    IGBL(99) = 3
                  END IF
                ELSE IF (INDEX(ICL(1:40), 'data_') .NE. 0 .AND.
     1                 INDEX(ICL(1:40), '_data_') .EQ. 0 .AND.
     2                 ICL(1:4) .NE. 'TITL' .AND.
     3                 ICL(1:3) .NE. 'REM') THEN
                  N     = INDEX(ICL(1:40), 'data')
                  CALL GEN151 (ICL, N + 5)
                  CDATA = ICL(N + 5:80)
                  IF (CDATA(1:7) .EQ. 'CSD_CIF') THEN
                    IF (ICL(N + 13:N + 16) .EQ. 'MIF_') THEN
                      CDATA = ICL(N + 17:N + 24)
                    ELSE
                      CDATA = ICL(N + 13:80)
                    END IF
                  ELSE IF (INDEX (CDATA, 'global') .NE. 0) THEN
                    CYCLE
                  END IF
                  NDATA = NCARD - 1
                ELSE IF (INDEX(ICL(1:80), '_cell_length_a') .NE. 0) THEN
                  GO TO 10
                END IF
                CYCLE
              ELSE IF (IABS(IGBL(8)) .EQ. 4 .AND.
     1                 ICL(1:6) .EQ. 'HEADER') THEN
              ELSE
                CYCLE
              END IF
   10         IF (IGBL(86) .GT. 1) THEN
                IGBL(100) = IGBL(100) + 1
                IF (IPR(462) .NE. 1) THEN
                  IF (ABS(IGBL(8)) .EQ. 3) THEN
                    IF (MOD (IGBL(100), 1000) .EQ. 0) THEN
                      IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
                        IF (IGBL(100) .EQ. 1000)
     1                    CALL GGIP (HORS, VERT, 0.0, 1)
                        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 0, 2, 0.5,
     1                     0.5)
                        WRITE (PRBUF, 99995, IOSTAT = IOST) IGBL(100)
                        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 0.5,
     1                     0.5)
                        CALL GGIP (0.0, 0.0, 0.0, 6)
                      END IF
                    END IF
                  END IF
                END IF
                IGBL(86) = IGBL(86) - 1
                IF (ABS(IGBL(8)) .EQ. 1) THEN
                  VOID(NVD - 6 - IGBL(100)) = NDATA
                  IF (IGBL(100) .LE. NP54) THEN
                    CENTRY(IGBL(100))    = CDATA
                    IENTRY(IGBL(100), 1) = IGBL(8)
                    IENTRY(IGBL(100), 2) = NDATA
                  END IF
                ELSE IF (ABS(IGBL(8)) .EQ. 2) THEN
                  VOID(NVD - 6 - IGBL(100)) = NDATA
                  IF (IGBL(100) .LE. NP54) THEN
                    CENTRY(IGBL(100))    = CDATA
                    IENTRY(IGBL(100), 1) = IGBL(8)
                    IENTRY(IGBL(100), 2) = NDATA
                  END IF
                ELSE IF (ABS(IGBL(8)) .EQ. 3) THEN
                  VOID(NVD - 6 - IGBL(100)) = NDATA
                  IF (IGBL(100) .LE. NP54) THEN
                    CENTRY(IGBL(100))    = CDATA
                    IENTRY(IGBL(100), 1) = IGBL(8)
                    IENTRY(IGBL(100), 2) = NDATA
                  END IF
                ELSE
                  VOID(NVD - 6 - IGBL(100)) = NCARD - NCRD
                  IF (IGBL(100) .LE. NP54)
     1              IENTRY(IGBL(100), 1) = NCARD - NCRD
                END IF
C * LIST ENTRIES
                IF (IPR(220) .EQ. 1 .AND. IPR(221) .EQ. 0) THEN
                  IF (ILST * IPR(462) .EQ. 1) THEN
                    IF (ILST .EQ. 1) THEN
                      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND.
     1                    IGBL(100) .EQ. 1)
     2                    CALL GGIP (HORS, VERT, 0.0, 1)
                      IF (ABS(IGBL(8)) .EQ. 1) THEN
                        WRITE (LIN, 99997, IOSTAT = IOST)
     1                    IGBL(100), ICL(6:10)
                      ELSE IF (ABS(IGBL(8)) .EQ. 2) THEN
                        WRITE (LIN, 99997, IOSTAT = IOST)
     1                    IGBL(100), ICL(6:10)
                      ELSE IF (IABS(IGBL(8)) .EQ. 3) THEN
                        IF (IGBL(94) .EQ. 0) THEN
                          M = 74
                        ELSE
                          M = 8
                        END IF
                        WRITE (LIN, 99997, IOSTAT = IOST)
     1                    IGBL(100), CDATA(1:M)
                      ELSE IF (IABS(IGBL(8)) .EQ. 4) THEN
                        IF (ICL(63:66) .NE. '    ') THEN
                          WRITE (LIN, 99997, IOSTAT = IOST)
     1                      IGBL(100), ICL(63:70)
                        ELSE
                          WRITE (LIN, 99997, IOSTAT = IOST)
     1                      IGBL(100), ICL(11:18)
                        END IF
                      END IF
                      XV = XV - 0.45
                      CALL GGIP09 (0.0, LIN, 6 + M, 0.34, 1, 2, XH, XV)
                    END IF
                    IF (MOD(IGBL(100), 43) .EQ. 0) THEN
                      XH = XH + 4.3
                      XV = VERT
                      IF (XH + 4.3 .GE. HORS) THEN
                        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
   20                     CALL PLA013 (3, 1)
                          SELECT CASE (IGGT(1:4))
                            CASE ('PLOT')
                              GO TO 20
                            CASE ('EXIT')
                              CALL GEN038 (IGGT, 1, 80)
                              RETURN
                            CASE ('N   ', 'NO  ')
                              CALL GEN038 (IGGT, 1, 80)
                              RETURN
                          END SELECT
                          CALL GEN072 (IGGT, IFL, FN, IPR(220),
     1                       IPR(221), 0, LU6, 1, 1, 80, 7, NP17)
                          CALL GEN038 (IGGT, 1, 80)
                          IF (IPR(221) .GT. 0) THEN
                            NENTRY = NINT(FN(1))
                            GO TO 30
                          END IF
                        ELSE
                          CALL GEN125 (1, LU6,
     1                      'Continue Listing (Y/N[Y])')
                          READ  (LU5, 99994) CYN
                        END IF
                        CALL GEN020 (1, CYN, 1, 1)
                        IF (CYN .EQ. 'N') THEN
                          ILST = 0
                        ELSE
                          CALL GGIP (HORS, VERT, 0.0, 1)
                          XH = 0.0
                          XV = VERT
                        END IF
                      END IF
                    END IF
                  END IF
                ELSE
                  IF (IABS(IGBL(8)) .EQ. 4) THEN
                    IF (RCODE .EQ. REFCOD) THEN
                      NENTRY   = IGBL(100)
                      IPR(221) = 1
                    END IF
                  ELSE IF (IABS(IGBL(8)) .EQ. 3) THEN
                    IF (ICL(6:13) .EQ. REFCOD) THEN
                      NENTRY   = IGBL(100)
                      IPR(221) = 1
                    END IF
                  ELSE IF (IABS(IGBL(8)) .EQ. 1) THEN
                    IF (ICL(6:13) .EQ. REFCOD) THEN
                      NENTRY   = IGBL(100)
                      IPR(221) = 1
                    END IF
                  END IF
                END IF
              END IF
            END DO
            IF (IPR(462) .EQ. 1) THEN
              DO
                CALL PLA013 (3, 1)
                IF (IGGT(1:4) .NE. 'PLOT') THEN
                  CALL GEN072 (IGGT, IFL, FN, IPR(220), IPR(221), 0,
     1               LU6, 1, 1, 80, 7, NP17)
                  CYN = IGGT(1:1)
                  CALL GEN038 (IGGT, 1, 80)
                  IF (IPR(221) .GT. 0) NENTRY = NINT(FN(1))
                  EXIT
                END IF
              END DO
            END IF
            IPR(462) = 0
            IF (ICL(1:1) .EQ. ';') CALL GEN038 (ICL, 1, 80)
            CALL GEN108 (LU1, 0)
          END IF
        END IF
   30   IF (NENTRY .GT. 0) THEN
          IF (IABS(IGBL(8)) .LE. 4) THEN
            IF (NENTRY .LE. IGBL(100)) THEN
              IGBL(54) = NENTRY - 1
              IF (NENTRY .LE. NP54) THEN
                NCARD = IENTRY(NENTRY, 2)
              ELSE
                NCARD = NINT(VOID(NVD - 6 - NENTRY))
              END IF
              CALL GEN108 (LU1, 0)
              IF (NCARD .GT. 0) THEN
                DO I = 1, NCARD
                  READ (LU1, 99994, IOSTAT = IOST) ICL
                  IF (IOST .NE. 0) CYCLE
                END DO
              END IF
              ICL    = 'END'
              IPR(3) = 1
            ELSE
              WRITE (LU6, 99998, IOSTAT = IOST)
     1          REFCOD, NENTRY, IGBL(100)
              CALL PLA015 (427, 50)
            END IF
          END IF
        ELSE
          IF (IPR(220) .GT. 1) THEN
            WRITE (LU6, 99998, IOSTAT = IOST) REFCOD, NENTRY, IGBL(100)
            CALL PLA015 (427, 50)
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (':: No Entries on File (Instruction Ignored)')
99998 FORMAT (/, ':: Entry not found (', A, 2I10,')')
99997 FORMAT (I5, 1X, A)
99996 FORMAT (I2, 1X, A, 2(I3, I7))
99995 FORMAT ('Count Number of Entries on Input:', I6)
99994 FORMAT (A)
      END SUBROUTINE PLA009
      SUBROUTINE PLA010 (LU)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP52=200,NP54=42,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CENTRY*75
      CALL GEN108 (LU, 0)
      IF (IGBL(15) .GE. 0) THEN
        IGBL(9) = 0
        DO I = 1, 250
          READ (LU, 99999, ERR = 10, END = 10) PRBUF
          IF (INDEX (PRBUF, '_shelx_refln_list_code') .NE. 0) THEN
            IF (INDEX (PRBUF, '3') .NE. 0) THEN
              IGBL(9) = 21
              RDTYPE   = 'LIST3'
            ELSE IF (INDEX (PRBUF, '4') .NE. 0) THEN
              IGBL(9) =  1
              IGBL(37) = -1
              RDTYPE   = 'LIST4'
            ELSE IF (INDEX (PRBUF, '5') .NE. 0) THEN
              IGBL(9) = 22
              RDTYPE   = 'LIST5'
            ELSE IF (INDEX (PRBUF, '6') .NE. 0) THEN
              IGBL(9) = 23
              RDTYPE   = 'LIST6'
            ELSE IF (INDEX (PRBUF, '8') .NE. 0) THEN
              IGBL(9) = 25
              RDTYPE   = 'LIST8'
            END IF
          ELSE IF (INDEX (PRBUF, '_refln_F_squared_calc_comp1')
     1      .NE. 0) THEN
            IGBL(9) = 24
            RDTYPE   = 'LIST7'
          ELSE IF (PRBUF(1:11) .EQ. '# h,k,l, Fo') THEN
            IGBL(9) = 3
            IGBL(37) = -1
            RDTYPE   = 'NRCVAX'
          ELSE IF (PRBUF(1:13) .EQ. '# h,k,l, 10*F') THEN
            IGBL(9) = 4
            IGBL(37) = -1
            RDTYPE   = 'MOLEN'
          ELSE IF (INDEX (PRBUF, 'CRYSTALS') .NE. 0) THEN
            IGBL(9) = 5
            IGBL(37) = -1
            RDTYPE   = 'CRYSTAL'
          ELSE IF (PRBUF(1:11) .EQ. '# h,k,l, Fc') THEN
            IF (PRBUF(12:19) .EQ. '-squared') THEN
              IGBL(9) = 13
              IGBL(37) = -1
              RDTYPE   = 'TEXSAN3'
            ELSE
              IGBL(9) = 6
              IGBL(37) = -1
              RDTYPE   = 'TEXSAN1'
            END IF
          ELSE IF (INDEX (PRBUF, '_refln_intensity_meas') .NE. 0) THEN
            IGBL(9) = 9
            IGBL(37) = -1
            RDTYPE   = 'JANA2'
          ELSE IF (INDEX (PRBUF, '_refln_XD_refine_code') .NE. 0) THEN
            IGBL(9) = 11
            IGBL(37) = -1
            RDTYPE   = 'XD'
          ELSE IF (INDEX (PRBUF, 'CrystalStructure') .NE. 0) THEN
            IGBL(9) = 15
            IGBL(37) = -1
            RDTYPE   = 'RIGAKU'
          ELSE IF (INDEX (PRBUF, '_refln_F_squared') .NE. 0) THEN
            IF (IGBL(9) .EQ. 5) THEN
               IGBL(9) = 8
               IGBL(37) = -1
             END IF
          END IF
        END DO
   10   IF (IGBL(9) .EQ. 0) THEN
          CALL GEN108 (LU, 0)
   20     READ (LU, 99999, ERR = 50, END = 50) PRBUF
          IF (PRBUF(1:5) .EQ. '     ') GO TO 20
          IF (PRBUF(1:5) .EQ. 'data_') GO TO 20
          IF (INDEX(PRBUF, 'loop_') .NE. 0)  THEN
            NSQ = 0
            DO I = 1, 10
              READ (LU, 99999, ERR = 50, END = 50) PRBUF
              IF (INDEX(PRBUF, 'squared') .NE. 0) NSQ = 1
              IF (PRBUF(23:23) .EQ. '.') THEN
                IF (NSQ .EQ. 1) THEN
                  IGBL(9) = 13
                  RDTYPE   = 'TEXSAN3'
                  GO TO 30
                ELSE
                  IGBL(9) = 6
                  RDTYPE   = 'TEXSAN1'
                  GO TO 30
                END IF
              ELSE IF (PRBUF(22:22) .EQ. '.') THEN
                IGBL(9) = 10
                RDTYPE   = 'TEXSAN2'
                GO TO 30
              ELSE IF (PRBUF(18:18) .EQ. '.') THEN
                IF (PRBUF(34:34) .EQ. '.') THEN
                  IGBL(9) = 12
                  RDTYPE   = 'RAELS'
                  GO TO 30
                ELSE
                  IGBL(9) = 7
                  RDTYPE   = 'MolEN1'
                  GO TO 30
                END IF
              ELSE IF (PRBUF(20:20) .EQ. '.') THEN
                IGBL(9) = 14
                RDTYPE   = 'JANA1'
                GO TO 30
              END IF
            END DO
            IGBL(9) = 2
            RDTYPE   = 'XTAL-F'
          ELSE
            IF (PRBUF(88:88) .NE. ' ') THEN
              IGBL(9) = -1
              RDTYPE = 'HKL-EXT'
            END IF
            IGBL(37) = 0
            DO K = 1, 48
              IF (PRBUF(81 - K:81 - K) .NE. ' ' .AND.
     1            PRBUF(81 - K:81 - K) .NE. CHAR(13)) THEN
                IF (K .LT. 10) THEN
                  IGBL(37) = 1
                  GO TO 30
                ELSE
                  IGBL(37) = 2
                  GO TO 30
                END IF
              END IF
            END DO
          END IF
        END IF
   30   CALL GEN108 (LU, 0)
        IF (IGBL(9) .GT. 0) THEN
          M = 0
          DO
     	    READ (LU, 99999, IOSTAT = IOST) PRBUF
            IF (IOST .NE. 0) EXIT
            M = M + 1
            N = INDEX (PRBUF, 'data_')
            IF (N .NE. 0) THEN
              NCR = INDEX (PRBUF, CHAR(13))
              IF (NCR .NE. 0) PRBUF(NCR:NCR) = CHAR(32)
              NHASH = INDEX (PRBUF, '#')
              IF (NHASH .EQ. 0 .OR. NHASH .GT. N + 15) THEN
                IGBL(126)       = IGBL(126) + 1
                IF (IABS(IGBL(8)) .EQ. 3) THEN
                  DO I = 1, IGBL(100)
                    CALL GEN151 (PRBUF, N + 5)
                    IF (CENTRY(I)(1:8) .EQ. PRBUF(N + 5:N + 12)) THEN
                      IENTRY(I, 4) = M
                      IENTRY(I, 3) = IGBL(9)
                    END IF
                  END DO
                ELSE IF (IGBL(100) .EQ. 1) THEN
                  IENTRY(1, 4) = M
                  IENTRY(1, 3) = IGBL(9)
                END IF
              END IF
            END IF
          END DO
          CALL GEN108 (LU, 0)
        END IF
      END IF
   50 RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA010
      SUBROUTINE PLA011 (MODE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
C * RESET INPUT FOR THIS ENTRY
      IF (IPR(663) .NE. 0) THEN
        CLOSE (LU24, STATUS = 'DELETE')
        IPR(663) = 0
      END IF
      IF (IPR(664) .NE. 0) THEN
        CLOSE (LU25, STATUS = 'DELETE')
        IPR(664) = 0
      END IF
      IF (IPR(665) .NE. 0) THEN
        CLOSE (LU26, STATUS = 'DELETE')
        IPR(665) = 0
      END IF
      IF (IABS(IGBL(8)) .EQ. 1 .OR. IABS(IGBL(8)) .EQ. 3) THEN
        IPR(220) = 0
        IPR(221) = 1
        FN(1) = IGBL(54)
        CALL PLA009
        IGBL(24) = 0
        CALL PLA280 ('END')
        IF (MODE .NE. 0) IGBL(1) = 1
      ELSE
        IGBL(54) = 0
        CALL PLA280 ('RESTART')
        IF (MODE .NE. 0) IGBL(1) = 2
      END IF
      IF (MODE .EQ. 0) THEN
        CALL GEN108 (LU20, 0)
        IGBL(31) = 0
      END IF
      RETURN
      END SUBROUTINE PLA011
      SUBROUTINE PLA012
      PARAMETER (NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,NP31=34,
     1 NP35=110,NP38=150,NP39=30,NP40=432)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /MEN/ MENA(25, NP31), MENS(25, NP31), MENU(50, NP31),
     1             MNH(NP35)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XMENU/ MENX, CMEN
      CHARACTER MENX(NP31)*11, CMEN(NP40)*11
      YGGIP = 0.0
      ZGGIP = 0.0
      CALL GGIP (-999.0, YGGIP, ZGGIP, 8)
      MNH(12) = NINT(ZGGIP)
      CALL PLA293 (PAR(17))
      IF (MNH(12) .EQ. 1) THEN
        CMEN(24)(1:3)  = 'EPS'
        CMEN(44)(1:3)  = 'EPS'
        CMEN(104)(1:3) = 'EPS'
        CMEN(148)(5:7) = 'EPS'
      ELSE IF (MNH(12) .EQ. 2) THEN
        CMEN(24)(1:3)  = 'HGL'
        CMEN(44)(1:3)  = 'HGL'
        CMEN(104)(1:3) = 'HGL'
        CMEN(148)(5:7) = 'HGL'
      END IF
      MODE = IGBL(6)
      IF (MODE .EQ. 15) THEN
        MNH(27) = MAX (1, IPR(424) + 1)
        MNH(28) = MAX (1, IPR(425) + 1)
        MNH(29) = IPR(426) + 1
        MNH(47) = IPR(446) + 1
      ELSE IF (MODE .EQ. 17) THEN
        MNH(40) = IABS(IGBL(6)) - 16
      ELSE IF (MODE .EQ. 21) THEN
        MNH(45) = 3 - NINT(LOG(PAR(371)) / LOG(10.0))
        IF (PAR(372) .GE. 1.0) THEN
          MNH(46) = NINT (LOG(PAR(372)) / LOG(2.0)) + 1
        END IF
      ELSE
        MNH(1)  = IPR(140) + 1
        IF (IPR(478) .EQ. 0) THEN
          MNH(2) = 1
        ELSE IF (IPR(478) .EQ. -1) THEN
          MNH(2) = 2
        ELSE
          MNH(2) = 3
        END IF
        IF (IPR(477) .EQ. 0) THEN
          MNH(3) = 1
        ELSE IF (IPR(477) .EQ. -1) THEN
          MNH(3) = 2
        ELSE
          MNH(3) = 3
        END IF
        MNH(5)  = NINT(PAR(349) / 0.05) - 4
        MNH(8)  = IPR(139) + 1
        IF (IPR(111) .NE. 0)
     1    MNH(9) = INT(4 - (LOG(FLOAT(IPR(111))) / LOG(2.0)))
        MNH(10) = NINT (PAR(36) / 0.05) + 1
        MNH(11) = MAX (0, IABS(IGBL(6)) - 1)
        MNH(13) = NINT (PAR(284) / 0.5) + 1
        MNH(14) = NINT ((PAR(350) - 0.20) / 0.05)
        MNH(15) = IPR(232) + 1
        MNH(17) = NINT (PAR(273) / 5.0)
        MNH(18) = NINT (PAR(278) * 10.0)
        IF (IPR(419) .EQ. 0) IPR(419) = 10
        MNH(19) = NINT (LOG(IPR(419) / 2.5) / LOG(2.0))
        MNH(20) = NINT (PAR(279) + 1.5)
        MNH(21) = IGBL(63) + 1
        MNH(22) = NINT ((PAR(325) - 1.0) / 0.25) + 1
        MNH(23) = IPR(346) + 1
        MNH(24) = 6 - NINT(PAR(351) * 10.0)
        MNH(25) = INT((SIN (PAR(166) / RGBL(6)) * 20.0 / PAR(17)) - 0.1)
        MNH(25) = MAX (1, MIN (MNH(25) - 8, 7))
        MNH(26) = MIN (4, IPR(68) + 1)
        MNH(28) = NINT (PAR(86) * 100.0)
        MNH(29) = NINT (PAR(90) * 100.0)
        MNH(30) = NINT (PAR(88) * 100.0)
        MNH(31) = IPR(94) - 1
        MNH(32) = NINT (PAR(441) * 10.0) + 1
        IF (MNH(28) .EQ. MNH(29) .AND. MNH(29) .EQ. MNH(30)) THEN
          MNH(27) = MNH(28)
        ELSE
          MNH(27) = 0
        END IF
        IF (PAR(44) .GT. 0.0) THEN
          MNH(33) = MIN (NINT(LOG(PAR(44) * 2.0) / LOG(2.0) + 4), 6)
        ELSE
          MNH(33) = 1
        END IF
        MNH(34) = NINT(PAR(48) / 0.125) + 1
        IF (IPR(341) .GT. 1 .AND. IPR(341) .LT. 5) THEN
          MNH(35) = IPR(341) - 1
        ELSE
          MNH(35) = 0
        END IF
        MNH(36) = IPR(311)
        MNH(37) = IPR(33)  + 1
        MNH(38) = IPR(177) + 1
        MNH(39) = IPR(460)
        MNH(40) = IABS(IGBL(6)) - 16
        IF (IPR(389) .EQ. 1) THEN
          MNH(41) = 1
        ELSE IF (IPR(389) .EQ. -1) THEN
          MNH(41) = 2
        ELSE
          MNH(41) = 0
        END IF
        MNH(42) = NINT(PAR(58) / 0.05) + 1
        IF (PAR(439) .GT. 0.0) THEN
          MNH(43) = NINT(LOG(PAR(439) / 0.125) / LOG(2.0)) + 1
        END IF
        MNH(44) = IPR(117)
        IF (IABS(IGBL(6)) .EQ. 1) THEN
          MNH(48) = 1
        ELSE
          MNH(48) = MAX (0, IABS(IGBL(6)) - 6)
        END IF
      END IF
      IF (IABS(IPR(493)) .LT. 6) MNH(49) = IABS(IPR(493))
      MNH(50) = IPR(500)
      MNH(51) = IPR(461) + 1
      MNH(52) = IPR(41)  + 1
      MNH(53) = IPR(148) + 1
      MNH(54) = IGBL(62)
      IF (IPR(182) .EQ. 0) THEN
        MNH(55) = IPR(515) + 1
      ELSE
        MNH(55) = IPR(505)
      END IF
      MNH(56) = IPR(507)
      IF (IPR(132) .GE. 0) MNH(57) = IPR(132) + 1
      MNH(58) = NINT (PAR(85))
      MNH(59) = NINT (PAR(89))
      MNH(60) = MIN (NINT(PAR(48) / 10.0) + 1, 7)
      MNH(61) = NINT (PAR(411) * 100.0)
      MNH(62) = (IPR(514) + 1) / 2
      MNH(63) = MIN (NINT(PAR(412) * 6.0), 5)
      MNH(64) = MIN (4, MAX (1, NINT(PAR(2) / 0.2) + 1))
      MNH(65) = MIN (4, MAX (1, NINT(PAR(27) / 0.2) + 3))
      MNH(66) = IGBL(88) + 1
      MNH(67) = IPR(531) + 1
      MNH(68) = IPR(533)
      MNH(69) = IPR(534)
      MNH(70) = MIN (5, 1 + MAX (0, NINT(RGBL(25) / 0.25)))
      MNH(71) = MIN (4, MAX (1, NINT (PAR(7)) - 2))
      MNH(72) = MAX (1, IPR(536))
      MNH(73) = MIN (8, MAX (1, NINT ((PAR(13) - 0.4) * 2.0)))
      MNH(75) = IPR(551)
      IF (PAR(440) .NE. 0.0) THEN
        MNH(74) = NINT(LOG(PAR(440)) / LOG(10.0))
      END IF
      MNH(76) = IGBL(101) + 1
      MNH(77) = NINT (PAR(249) / 10.0) + 1
      MNH(78) = NINT (PAR(43) / 0.2)
      MNH(79) = NINT ((PAR(407) + 0.05) / 0.1)
      MNH(80) = NINT ((PAR(408) + 0.05) / 0.1)
      MNH(81) = NINT ((PAR(409) + 0.05) / 0.1)
      IF (MODE .EQ. 25) THEN
        MNH(82) = NINT (LOG(PAR(413)) / LOG(2.0) - 0.01) + 1
        MNH(83) = NINT (PAR(414) / 0.05)
        MNH(84) = NINT (FLOAT(IPR(550)) / 25)
        MNH(85) = NINT (PAR(415) / 0.1)
        MNH(94) = IPR(567) / 5
      END IF
      MNH(86) = MAX (0, IGBL(6) - 9)
      MNH(87) = MIN (4, MAX (1, NINT(RGBL(26) / 0.20)))
      MNH(88) = MIN (5, 1 + MAX (0, NINT(RGBL(27) / 0.25)))
      MNH(89) = IPR(206) + 1
      IF (IPR(332) .EQ. 1) THEN
        MNH(90) = 1
      ELSE IF (IPR(352) .EQ. 1) THEN
        MNH(90) = 2
      ELSE
        MNH(90) = 0
      END IF
      IF (MODE .EQ. 7) THEN
        IF (ABS(PAR(18)) .GT. 1.0) THEN
          MNH(91) = 2
        ELSE
          MNH(91) = 1
        END IF
      END IF
      MNH(92) = NINT (PAR(449) / 0.1)
      MNH(93) = NINT (PAR(420) / 0.05)
      MNH(95) = MIN (5, NINT (PAR(262) / 2.5))
      MNH(96) = MIN (6, NINT (PAR(451) / 2.5))
      MNH(97) = MIN (6, (IPR(577) + 1) / 2)
      MNH(98) = MIN (6, (IPR(578) + 1) / 2)
      MNH(99) = IGBL(123) + 1
      IF (PAR(453) .LE. 0.54) THEN
        MNH(100) = 1
      ELSE IF (PAR(453) .LE. 0.60) THEN
        MNH(100) = 2
      ELSE IF (PAR(453) .LE. 0.65) THEN
        MNH(100) = 3
      ELSE
        MNH(100) = 4
      END IF
      MNH(101) = IPR(394)
      MNH(102) = IGBL(124) + 1
      MNH(103) = IPR(354)  + 1
      IF (MODE .EQ. 29) THEN
        IF (PAR(452) .LT. 0.01) THEN
          MNH(100) = 1
        ELSE
          MNH(100) = NINT(LOG(PAR(452) / 0.25) / LOG(2.0)) + 2
        END IF
        MNH(104) = MAX (MIN (IPR(611) + 1, 10), 1)
        MNH(105) = MAX (MIN (NINT(PAR(487)) / 5, 10), 1)
      END IF
      MENS(12, 24) = INT(MENS(12, 24) / 100) * 100 + IPR(530) + 1
      IF (MODE .EQ. 1 .OR. MODE .EQ. 8 .OR. MODE .EQ. 9) THEN
        MENS(17, MODE) = INT(MENS(17, MODE) / 100) * 100 + IPR(75) + 1
        MNH(4)      = IPR(45)
      ELSE IF (MODE .EQ. 2 .OR. MODE .EQ. 3 .OR. MODE .EQ. 5 .OR.
     1         MODE .EQ. 6) THEN
        MENS(14, MODE) = INT(MENS(14, MODE) / 100) * 100 + IPR(75) + 1
      ELSE IF (MODE .EQ. 24) THEN
        MENS(10, MODE) = INT(MENS(10, MODE) / 100) * 100 + IPR(75) + 1
      ELSE IF (MODE .EQ. 26) THEN
        MENS(21, MODE) = INT(MENS(21, MODE) / 100) * 100 + IAN + 1
      ELSE IF (MODE .EQ. 10) THEN
        IF (IPR(44) .EQ. 0) IGBL(59) = 1
      END IF
      IF (IPR(116) .EQ. 0) THEN
        MENS(2, 2) = 4
        MENS(2, 1) = 2
      ELSE
        MENS(2, 2) = 1
        MENS(2, 1) = 1
      END IF
      IF (MODE .EQ. 0) THEN
        BCD(1:12) = '           '//CHAR(0)
      ELSE
        BCD(1:12) = MENX(IABS(MODE))//CHAR(0)
      END IF
      COLR = 5.0 + IGBL(68)
      CALL GGIP (-999.0, COLR, 1.0, 10)
      DO I = 1, 25
        BCD(1:12) = '           '//CHAR(0)
        CALL GGIP (-999.0, 0.0, 1.0, 10 + I)
      END DO
      IF (IPR(37) .NE. 0 .OR. IPR(367) .NE. 0 .OR.
     1    PAR(101) .GT. 1.0 .OR. MODE .EQ. 15 .OR.
     2    MODE .EQ. 17 .OR. MODE .EQ. 18 .OR. MODE .EQ. 19 .OR.
     3    MODE .EQ. 32 .OR. MODE .EQ. 34) THEN
        DO I = 1, 25
          IF (MODE .NE. 0) THEN
            J = MENA(I, IABS(MODE))
            IF (J .GT. 0) THEN
              JJ = J / 1000
              J  = MOD(J, 1000)
              IF (JJ .GT. 0) THEN
                K = I
                IF (IABS(IPR(J)) .EQ. JJ) K = K + 25
              ELSE
                KK = 0
                IF (IPR(J) .NE. 0) KK = 25
                K  = KK + I
              END IF
            ELSE IF (J .LT. 0) THEN
              K = MAX (MIN (IABS(IGBL(IABS(J))), 1), 0) * 25 + I
            ELSE
              K = I
            END IF
            BCD(1:12) = CMEN(MOD(MENU(K, IABS(MODE)), 500))//CHAR(0)
            IF (MENU(K, IABS(MODE)) .GT. 500) THEN
              COLR = 2.0
            ELSE
              COLR = 1.0
            END IF
            MNS1 = MENS(I, IABS(MODE)) / 100
            MNS2 = MOD(MENS(I, IABS(MODE)), 100)
            IF (MNS1 .GT. 0) THEN
              XMNS = MNH(MNS1) * 100 + MNS2
            ELSE
              XMNS = MNS2
            END IF
            IF (IABS(MODE) .EQ. 16) THEN
              IF (IPR(78) .NE. -2) THEN
                IF (I .LT. 5) THEN
                  BCD(1:12) = '           '//CHAR(0)
                END IF
              END IF
            END IF
            CALL GGIP (-999.0, COLR, XMNS, 10 + I)
          END IF
        END DO
      END IF
      IF (IPR(182) .EQ. 0) THEN
        BCD = SBCD
      ELSE
        BCD = 'Click on Unique Atoms to be Omitted'//CHAR(0)
      END IF
      CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68) * IGBL(82)), 70.0, 110)
      RETURN
      END SUBROUTINE PLA012
      SUBROUTINE PLA013 (MSBCD, MUPCASE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /GGT/ MEDIUM
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CTRLC/ CC
      COMMON /KEYS/ STRING
      CHARACTER STRING*100
      COMMON /NKEYS/ NCNT
      COMMON /LABMOD/ LMOD
      LOGICAL CC
      MMODE = 0
      LRET  = 0
      IF (IGBL(25) .EQ. 1) THEN
        IF (MSBCD .EQ. -1) THEN
          SBCD = 'Implement new Sublattice ? (y/n[N])'//CHAR(0)
        ELSE IF (MSBCD .EQ. -2) THEN
          SBCD = 'Implement CALC ADDSYM EXACT Mode ? (y/n[Y])'//CHAR(0)
        ELSE IF (MSBCD .EQ. 1) THEN
          SBCD = 'Continue (Y/N[Y])'//CHAR(0)
        ELSE IF (MSBCD .EQ. 2) THEN
          SBCD = 'Hit RETURN to Continue'//CHAR(0)
        ELSE IF (MSBCD .EQ. 3) THEN
          SBCD = 'Enter # of ENTRY or Continue (Y/N[Y])'//CHAR(0)
        ELSE IF (MSBCD .EQ. 4) THEN
          SBCD = '[NEXT]'//CHAR(0)
        ELSE IF (MSBCD .EQ. 5) THEN
          SBCD = '[CALC]'//CHAR(0)
        END IF
        IF (IPR(308) .EQ.  1 .AND. IPR(332) .EQ.  0 .AND.
     1      IPR(335) .EQ.  0 .AND. IPR(351) .EQ.  0 .AND.
     2      IPR(352) .EQ.  0 .AND. IGBL(3)  .NE. 12 .AND.
     3      IGBL(3)  .NE. 13 .AND. IGBL(3)  .NE. 26) THEN
          SBCD = '[END]'//CHAR(0)
        ELSE IF (IPR(308) .EQ. 2) THEN
          SBCD = '[EXIT]'//CHAR(0)
        END IF
      END IF
      ZZ   = 0.0
      LRET = 3
      IF (CC) THEN
        ZZ    = 1.0
        IVENT = 5
      ELSE
        IF (IPR(460) .EQ. 3 .AND. IPR(551) .EQ. 3) THEN
          LMOD  = 0
          CALL PLA015 (-1, 0)
        END IF
   10   X = 0.0
        Y = 0.0
        Z = 0.0
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          MMODE = IGBL(6)
          CALL PLA012
          IF (IGBL(48) .EQ. 0) THEN
            IVENT = 5
            CALL GGIP (X, Y, Z, IVENT)
          ELSE
            X = 1
            Z = 1
            IF (IGBL(3) .EQ. 12) THEN
              Y = 9
            ELSE IF (IGBL(3) .EQ. 13) THEN
              Y = 15
            ELSE IF (IGBL(3) .EQ. 26) THEN
              X = 2
              Y = 15
            END IF
            IVENT    = 2
            IGBL(48) = 0
          END IF
        ELSE
          IVENT = -1
        END IF
        LRET = 1
        IF (IVENT .GE. 0) THEN
          IF (IGBL(81) .EQ. 0) THEN
            MEDIUM      = 2
            IGGT(16:22) = 'OFF    '
            CALL GGIP (-999.0, 0.0, 0.0, 6)
          END IF
          IF (IVENT .EQ. 0) IVENT = 2
          IF (IVENT .EQ. 5) THEN
   20       IF (BCD(1:1) .EQ. CHAR(13)) THEN
              IF (NCNT .EQ. 0) THEN
                IF (IPR(335) .NE. 0) THEN
                  STRING = 'RENAME'
                  NCNT = 6
                ELSE IF (IPR(332) .NE. 0) THEN
                  STRING = 'HFIX'
                  NCNT = 4
                ELSE IF (IPR(352) .NE. 0) THEN
                  STRING = 'ANIS'
                  NCNT = 4
                ELSE IF (IPR(308) .EQ. 1) THEN
                  STRING = 'END '
                  NCNT = 4
                ELSE IF (IPR(308) .EQ. 2) THEN
                  STRING = 'EXIT'
                  NCNT = 4
                ELSE IF (IPR(209) .GT. 0) THEN
                  STRING = 'CALC GEOM SPF'
                  NCNT = 16
                ELSE IF (IPR(205) .EQ. 1) THEN
                  STRING = 'Y'
                  NCNT   = 1
                ELSE
                  STRING(1:1) = '!'
                  NCNT = 1
                END IF
              END IF
              IGBL(5) = LU5
              IF (IPR(308) .EQ. 2) THEN
                CALL GEN020 (1, STRING, 1, 4)
                IF (STRING(1:3) .EQ. 'END') THEN
                  STRING(1:4) = 'EXIT'
                  NCNT = 4
                END IF
                IF (STRING(1:4) .EQ. 'EXIT') LRET = 7
              END IF
              CALL PLA280 (STRING(1:NCNT))
              NCNT     = 0
              IGBL(24) = 1
              IF (STRING(1:1) .NE. '!') THEN
                IF (MMODE .EQ. 10 .OR. MMODE .EQ. 11 .OR.
     1              MMODE .EQ. 12) LRET = 2
              ELSE
                IF (MMODE .EQ. 1) LRET = 3
              END IF
            ELSE IF (BCD(1:1) .EQ. CHAR(8) .OR.
     1               BCD(1:1) .EQ. CHAR(127)) THEN
              IF (NCNT .GT. 0) THEN
                NCNT = NCNT - 1
                IF (NCNT .EQ. 0) THEN
                  BCD = CHAR(0)
                ELSE
                  BCD = STRING(1:NCNT)//CHAR(0)
                END IF
                SBCD = BCD
              END IF
              LRET = -1
            ELSE IF (BCD(1:1) .EQ. CHAR(12)) THEN
              IF (MMODE .EQ. 1) THEN
                CALL PLA280 ('PLOT')
              ELSE
                IF (MMODE .EQ. 3 .OR. MMODE .EQ. 22
     1             .OR. MMODE .EQ. 15 .OR. MMODE .EQ. 17) LRET = 2
                BCD(1:1) = CHAR(13)
                GO TO 20
              END IF
            ELSE IF (BCD(1:1) .EQ. CHAR(0)) THEN
              LRET = -1
            ELSE
              IF (NCNT .LT. 80) THEN
                NCNT = NCNT + 1
                IF (NCNT .GE. 75)
     1            WRITE (LU6, 99997, IOSTAT = IOST) NCNT, CHAR(7)
                STRING(NCNT:NCNT) = BCD(1:1)
                BCD = STRING(1:NCNT)//CHAR(0)
                SBCD = BCD
              END IF
              LRET = -1
            END IF
          ELSE IF (IVENT .EQ. 4) THEN
            CALL PLA280 ('EXIT')
            IF (IGBL(3) .EQ. 4) IGBL(3) = 0
            IF (IGBL(45) .EQ. 0 .OR. IGBL(3) .EQ. 3) THEN
              IF (MMODE .EQ. 1 .OR. MMODE .EQ. 8 .OR.
     1            MMODE .EQ. 9) LRET = 7
            ELSE
              IGBL(45) = 0
              CALL PLA280 ('REM')
              IGBL(6) = 10
              CALL GEN108 (LU3, 0)
              WRITE (LU3, 99998, IOSTAT = IOST)
              ENDFILE LU3
            END IF
            IF (MMODE .EQ. 22) LRET = 1
            IF (MMODE .EQ. 10 .OR. MMODE .EQ. 11 .OR.
     1          MMODE .EQ. 12 .OR. MMODE .EQ. 14) LRET = 2
          ELSE IF (IVENT .EQ. 3) THEN
            IF (NINT(Z) .EQ. 3) CALL PLA300 (3, 0, 0)
            LRET = -1
          ELSE IF (IVENT .EQ. 2) THEN
            IF (NINT(Z) .EQ. 3) THEN
              CALL PLA300 (2, 1, NINT(Y))
              LRET = -1
            ELSE
              IGBL(5) = LU5
              CALL PLA016 (NINT(Y), NINT(X))
            END IF
          ELSE IF (IVENT .EQ. 1) THEN
            CALL PLA020 (X, Y, Z)
          END IF
        ELSE IF (IVENT .EQ. -1) THEN
          IGBL(25) = 0
          IF (IGBL(3) .EQ. 28 .OR. IGBL(3) .EQ. 29 .OR.
     1        IGBL(3) .EQ. 31) THEN
            CALL PLA280 ('END')
            LRET = 7
          END IF
        END IF
        IF (LRET .EQ. -1) THEN
          GO TO 10
        END IF
      END IF
      SBCD = CHAR(0)
      XGGIP = 0.0
      YGGIP = 0.0
      CALL GGIP (XGGIP, YGGIP, ZZ, -1)
      IF (IGBL(74) .EQ. 1)
     1  WRITE (LU6, 99999, IOSTAT = IOST) LRET, IGGT(1:65)
      IF (MUPCASE .GT. 0) CALL GEN020 (1, IGGT, 1, MUPCASE)
      RETURN
99999 FORMAT ('>> LRET =', I2, ', >>', A)
99998 FORMAT (80X, /)
99997 FORMAT ('Position', I3, A)
      END SUBROUTINE PLA013
      SUBROUTINE PLA014 (MODE, NTYP, X, Y, ITEM, IASU)
      PARAMETER (NP0=6,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP48=1000,NP49=2000000)
      COMMON /PLUTOSCRATCH/ YXMOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /TPOS/ XTK(250, 3), NTK(25), KMX, IMIN
      IBEG = 0
      IEND = 0
      IF (NTYP .EQ. 1) THEN
        X1 =   X + PAR(61)
        Y1 = - Y - PAR(62)
      ELSE
        X1 = X
        Y1 = PAR(38) - Y
      END IF
      ITEM   = 0
      DELMIN = 1000.0
      IMIN   = 0
      IASU   = 0
      IF (IABS(MODE) .LE. 2) THEN
        IB = IPR(158)
        IF (MODE .GT. 0) THEN
          IB = IB + IPR(69) * NP0
          IBEG = IPR(69) + 1
          IF (IPR(341) .EQ. 2) THEN
            IEND = IPR(62)
          ELSE
            IEND = IPR(37)
          END IF
        ELSE IF (MODE .EQ. -1) THEN
          IB   = IB + IPR(62) * NP0
          IBEG = IPR(62) + 1
          IEND = IPR(62) + IPR(37)
        ELSE IF (MODE .EQ. -2) THEN
          IB   = IB + (IPR(62) + IPR(37)) * NP0
          IBEG = IPR(62) + IPR(37) + 1
          IEND = IPR(62) + IPR(37) + IPR(42)
        END IF
        DO I = IBEG, IEND
          IB = IB + NP0
          DEL = (RA(IB - 3) - X1)**2
     1        + (RA(IB - 2) - Y1)**2
          IF (DEL .LT. DELMIN - 0.001) THEN
            IASU   = NINT (RA(IB - 5))
            IMIN   = I
            DELMIN = DEL
          END IF
        END DO
      ELSE IF (MODE .EQ. 3) THEN
        DO I = 1, IPR(447)
          DIST = SQRT ((XTK(I, 1) - X1)**2 +
     1        (XTK(I, 2) - Y1)**2)
          IF (DIST .LT. DELMIN) THEN
            DELMIN = DIST
            IMIN = I
          END IF
        END DO
      END IF
      IF (DELMIN .LT. PAR(24) / 4) THEN
        ITEM = IMIN
        IF (MODE .EQ. 1) THEN
          IB = IPR(158) + (IMIN - 1) * NP0
          CALL PLUT31 (IB, 2.0)
          IF (IASU .NE. 0) THEN
            ITEM = IASU / 1000
            IASU = MOD (IASU, 1000)
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA014
      SUBROUTINE PLA015 (NR, IVAL)
      PARAMETER (NP10=16,NP12=700,NP13=550,NP17=99,NP37=191,NP38=150,
     1           NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, COLR*10, BWCT*10
      COMMON /NOTE/ TXT
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER TXT*79
      COMMON /C112/ T112
      CHARACTER T112*80
      IF (IGBL(50) .EQ. 2) GO TO 10
      MODE = IABS(IGBL(6))
      IF (IPR(427) .NE. 0) THEN
        IF (IGBL(6) .GT. 0) THEN
          CALL GEN038 (TXT, 1, 79)
          BCD = TXT//CHAR(0)
          CALL GGIP (-999.0, 0.0, 80.0, 111)
        END IF
        IPR(427) = 0
      END IF
      IF (NR .EQ. 0) THEN
C * ONE LINE NOTIFICATION MESSAGES
        SELECT CASE (IVAL)
          CASE (1)
            TXT = 'No Classic Hydrogen Bonds Found'
          CASE (2)
            TXT =
     1        'Classic Hydrogen Bonds Found (See Listing for Details)'
           CASE (3)
            TXT = 'No Solvent Accessible Void Found'
          CASE (4)
            TXT =
     1      'Solvent Accessible Void Found (See Listing for Details)'
          CASE (5)
            TXT = 'No Obvious Additional Symmetry'
          CASE (6)
            TXT =
     1     'Additional (Pseudo)Symmetry Found (See Listing for details)'
          CASE (7)
            TXT = 'No Proper Reflection Data Available !'
          CASE (8)
            TXT = 'Label Conflict, No Substitution !'
          CASE (9)
            TXT = 'Requested Program not Accessible !'
          CASE (10)
            TXT = 'Instruction Ignored'
          CASE (11)
            TXT = 'DIRDIF PATTY for HEAVY ATOM STRUCTURES ONLY !'
          CASE (12)
            TXT = 'No Model-data found for DIRDIF/ORIENT-run'
          CASE (13)
            TXT =
     1      'Problem in DIRDIF (See tm/sg/dirdif08/lis1 for details)'
          CASE (14)
            TXT = 'DIRDIF not Available (or accessible) !'
          CASE (15)
            TXT = '                                      '
          CASE (16)
            TXT = 'SIR nor Available (or accessible) !'
          CASE (17)
            TXT = 'SHELXS   not Available (or accessible) !'
          CASE (18)
            TXT = 'No (more) NEWMAN, RING or PLANE data (Rewind)? '
          CASE (19)
            TXT = 'No Crystal Description Available !'
          CASE (20)
            TXT = 'No Cell data yet !'
          CASE (21)
            TXT = 'Automatic Invert to enantiomeric space group'
          CASE (22)
            TXT = 'Spacegroup not acceptable, try again'
          CASE (23)
            TXT = 'SPGR # Out of Range [0:NP42], try again'
          CASE (24)
            TXT = 'TRMX nor acceptable, try again'
          CASE (25)
            TXT =
     1      'SPGR-Routine cannot identify appropriate space group'
          CASE (26)
            TXT = 'Formula Requires more Element-number pairs - retry'
          CASE (27)
            TXT = 'No Quest for Polymeric structures'
          CASE (28)
            TXT = 'Unsuitable Instruction. Ignored'
          CASE (29)
            TXT = 'SHELXL not Available (or accessible) !'
          CASE (30)
            TXT = 'HFIX-Instruction Valid for RES-files ONLY'
          CASE (31)
            TXT = 'AutoMolFit not possible for this residue pair'
          CASE (32)
            TXT =
     1      'Unresolved problem in SIR97 (see tm/sg/sir for details)'
          CASE (33)
            TXT = 'Missing Element(s) in Formula (Enter New Formula)'
          CASE (34)
            TXT = 'No Coordinate Data found in Current Input File'
          CASE (35)
            TXT = 'No Direction Cosines found'
          CASE (36)
            TXT = 'An Editor will be invoked prior to the SHELX launch'
          CASE (37)
            TXT = 'Twin[Matrix NOT Acceptable (Determinant = 0)'
          CASE (38)
            TXT = 'SHELXL-Problem, No Suitable Res-file '
          CASE (39)
            TXT = 'Result of Calculation on .lis & .lps Files'
          CASE (40)
            TXT = 'RENAME-function valid for RES-files Only !!'
          CASE (41)
            TXT = '                        '
          CASE (42)
            TXT = 'Incorrect Plane Definition. Try Again.'
          CASE (43)
            TXT =
     1      'No TLS-Analysis for Polymeric or Disordered Structures'
          CASE (44)
            TXT = 'ANIS-Instruction Valid for RES-files ONLY'
          CASE (45)
            TXT = 'Click on ARU-Code to ADD ARU to ORTEP PLOT'
          CASE (46)
            TXT = 'No Mu-value given !!'
          CASE (47)
            TXT = 'Validation requires NOMOVE mode !!'
          CASE (48)
            TXT = 'Problem/Error in JOIN Instruction !!'
          CASE (49)
            TXT = 'Error - Not Enough Data Items on Input Line !!'
          CASE (50)
            TXT = 'Error: Requested Data Entry not Found. Try Again.'
          CASE (51)
            TXT =
     1      'No Matching Reflection Data Set Found on Reflection FCF'
          CASE (52)
            TXT = 'No CAVITY''S Found in this Structure'
          CASE (53)
            TXT = 'Label Conflict, Special Substitution !'
          CASE (54)
            TXT = 'SIR2004 nor Available (or accessible) !'
          CASE (55)
            TXT = 'SHELXD nor Available (or accessible) !'
          CASE (56)
            TXT = 'Insufficient Space for Coordinate Expansion'
          CASE (57)
            TXT = 'Requested SIR version not found !'
          CASE (58)
            TXT = 'No Bijvoet Pairs found !'
          CASE (59)
            TXT = 'SHELXT not Available (or accessible) !'
          CASE (60)
            TXT = 'SIR2011 not Available (or accessible) !'
        END SELECT
      ELSE IF (NR .GT. 0) THEN
        IF (IPR(341) .EQ. 1) CALL PLUT24 (-3, IDUM, IDUM)
        IPRNR    = IPR(NR)
        IPR(329) = 0
        IPR(332) = 0
        IPR(334) = 0
        IPR(338) = 0
        IPR(341) = 0
        IPR(343) = 0
        IPR(344) = 0
        IPR(348) = 0
        IPR(352) = 0
        IPR(448) = 0
        IPR(440) = 0
        IF (IPRNR .EQ. 0 .OR. IPRNR .NE. IVAL) THEN
          IPR(NR) = IVAL
        ELSE
          IPR(NR) = 0
        END IF
        IF (IPR(311) .EQ. 1) THEN
          TXT = 'Click on 2 ATOMS to JOIN'
        ELSE IF (IPR(311) .EQ. 2) THEN
          TXT = 'Click on 2 ATOMS to JOIN DASH'
        ELSE IF (IPR(311) .EQ. 3) THEN
          TXT = 'Click on 2 ATOMS to DETACH '
        ELSE IF (IPR(312) .EQ. 1) THEN
          TXT = 'Click on at least 5 Atom Pairs to FIT'
        ELSE IF (IPR(348) .EQ. 1) THEN
          TXT = 'Click on Atom to SELECT Pattern'
        ELSE IF (IPR(327) .EQ. 1) THEN
          IF (MODE .EQ. 1) THEN
            TXT = 'Click on LABEL [Lower Left Corner] to be DELETED'
          END IF
        ELSE IF (IPR(328) .EQ. 1) THEN
          IF (MODE .EQ. 1) THEN
            TXT = 'Click on (RED) LABEL to INCLUDE LABEL again'
          END IF
        ELSE IF (IPR(349) .EQ. 1) THEN
          IF (MODE .EQ. 1) THEN
            TXT = 'Click on LABEL [Lower Left Corner] to REPOSITION'
          ELSE
            TXT = 'Click on LABEL [Center] to REPOSITION'
          END IF
        ELSE IF (IPR(335) .EQ. 1) THEN
          TXT = 'Click on ATOM to be RENAMED (or RETURN for ATOM loop)'
        ELSE IF (IPR(351) .EQ. 1) THEN
          TXT = 'Click on ATOM to be DELETED [or enter instruction]'
        ELSE IF (IPR(448) .EQ. 1) THEN
          TXT = 'Click on TEXT [Lower Left Corner] to REPOSITION'
        ELSE IF (IPR(344) .EQ. 1) THEN
          TXT = 'Click on Text [Lower Left Corner] to be DELETED'
        ELSE IF (IPR(343) .EQ. 1) THEN
          TXT = 'Click on ATOM as ZOOM CENTRE'
        ELSE IF (IPR(341) .EQ. 1) THEN
          TXT = 'Click on Atom for GEOM Calculation'
        ELSE IF (IPR(341) .EQ. 2) THEN
          TXT = 'Click on 2 ATOMS for DISTANCE'
        ELSE IF (IPR(341) .EQ. 3) THEN
          TXT = 'Click on 3 ATOMS for ANGLE'
        ELSE IF (IPR(341) .EQ. 4) THEN
          TXT = 'Click on 4 ATOMS for TORSION ANGLE'
        ELSE IF (IPR(341) .EQ. 5) THEN
          TXT = 'Click on 2 ATOMS for LINE 1 and 2 ATOMS FOR LINE 2'
        ELSE IF (IPR(329) .EQ. 1) THEN
          TXT = 'Click on 2 ATOMS for VIEW LINE'
        ELSE IF (IPR(329) .EQ. 2) THEN
          TXT = 'Click on 3 ATOMS for VIEW PERP'
        ELSE IF (IPR(329) .EQ. 3) THEN
          TXT = 'Click on 3 ATOMS for VIEW BISECT'
        ELSE IF (IPR(476) .NE. 0) THEN
          TXT = 'Click on Atoms Defining Plane (or Dist/End)'
        ELSE IF (IPR(552) .NE. 0) THEN
          TXT = 'Click on Atoms Defining Planes (or With/End)'
        ELSE IF (IPR(508) .EQ. 1) THEN
          TXT = 'Click on FROM Atom Followed by TO Atoms and END'
        ELSE IF (IPR(508) .EQ. 2) THEN
          TXT = 'Click on Atoms Defining Cg Terminated with END'
        ELSE IF (IPR(338) .EQ. 1) THEN
          TXT = 'Click on ATOM to Select Color'
        ELSE IF (IPR(334) .EQ. 1) THEN
          WRITE (TXT, '(A, ''['', F4.2, '']'')')
     1         'Click on TEXT [Lower Left Corner] to Change Size',
     2          PAR(350)
        ELSE IF (IPR(352) .EQ. 1) THEN
          TXT = 'Click on ATOM for ANIS [or EXIT] '
        ELSE IF (IPR(332) .EQ. 1) THEN
          TXT =
     1    'Click on ATOM for HFIX (or RETURN for loop over ATOMs)'
        ELSE IF (IPR(440) .EQ. 1) THEN
          TXT = 'Click on ATOM for ''CALC COORDINATION atom'''
        ELSE IF (IPR(213) .EQ. 1) THEN
          TXT = 'Click on ARU-Label for ARU to be Excluded'
        ELSE IF (IPR(536) .GT. 0) THEN
          TXT = 'Click on ATOM to change Atom-Type-Color to '//
     1          COLR(IPR(536))
        END IF
        IF (IGBL(45) .NE. 0 .AND. IGBL(3) .NE. 1) THEN
          IF (IPR(20) .EQ. 0) THEN
            IF (IGBL(3) .EQ. 3) THEN
              BCD = 'Click EXIT to Terminate ORTEP/ADP'//CHAR(0)
            ELSE
              BCD =
     1'SAVE-mode Loop (Click on PREV, NEXT or EXIT to escape)'//CHAR(0)
            END IF
          ELSE
            BCD = 'Click on END to return to System-S'//CHAR(0)
          END IF
          CALL GGIP (-999.0, 3.0, 80.0, 112)
        END IF
      END IF
      IF (IGBL(3) .NE. 1) THEN
        BCD = T112
        CALL GGIP (-999.0, 2.0, 80.0, 112)
        IF (IGBL(6) .GT. 0) THEN
          BCD = TXT//CHAR(0)
          CALL GGIP (-999.0, 2.0, 80.0, 111)
        END IF
      END IF
      IF (NR .NE. 0) IPR(427) = 1
      IGBL(6) = IABS (IGBL(6))
   10 RETURN
      END SUBROUTINE PLA015
      SUBROUTINE PLA016 (MENUV, MENUH)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP31=34,NP35=110,NP38=150,NP39=30,NP45=2048,NP52=200,
     2 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /MEN/ MENA(25, NP31), MENS(25, NP31), MENU(50, NP31),
     1             MNH(NP35)
      COMMON /TIMER/ ISAVEMOD
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /GGT/ MEDIUM
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /KEYS/ STRING
      CHARACTER STRING*100
      COMMON /NKEYS/ NCNT
      CHARACTER BWC*5, COLOR*5
      COMMON /LABMOD/ LMOD
      DX = 0.0
      LRET = 1
      IGBL(24) = 1
      IF (IGBL(35) .EQ. 1) THEN
        IF (IPR(504) .EQ. 0) CALL PLA280 ('PLOT')
      ELSE
        CALL GEN038 (IGGT, 1, 80)
      END IF
      IF (IPR(346) .GT. 0) THEN
        COLOR = 'COLOR'
      ELSE
        COLOR = ' '
      END IF
      IF (IPR(345) .GT. 0) THEN
        BWC   = 'BWC'
      ELSE
        BWC   = ' '
      END IF
      MMODE = IGBL(6)
      IF (MMODE .EQ. 1 .OR. MMODE .EQ. 9 .OR. MMODE .EQ. 16) THEN
        PAR(389) = 0.0
        IPR(478) = 0
        ANGC     = 2.0 ** (MENUH - 5)
      END IF
      IF (MMODE .EQ. 2 .OR. MMODE .EQ. 3) THEN
        ANGC = 2.0 ** (MENUH - 5)
        DX   = (MENUH - 1) * 0.25
      END IF
      SELECT CASE (MENUV)
C * MENU BOX # 0 & EXPOSE EVENT
        CASE (0)
        IF (MMODE .EQ. 1 .OR. MMODE .EQ. 8 .OR. MMODE .EQ. 9) THEN
          IPR(201) = 1
          LRET     = 3
        ELSE IF (MMODE .EQ. 10) THEN
          LRET = 1
        ELSE IF (MMODE .EQ. 12) THEN
          CALL PLA280 ('REF')
        ELSE IF (MMODE .EQ. 22) THEN
          LRET = 2
        END IF
C * MENU BOX # 1
        CASE (1)
          SELECT CASE (MMODE)
            CASE (1)
              IF (MENUH .EQ. 1) THEN
                IGBL(6) = 1
              ELSE
                IGBL(6) = MENUH + 6
              END IF
              LRET = -1
            CASE (2)
              IGBL(6) = MENUH + 1
              LRET     = -1
            CASE (3)
              IGBL(6) = MENUH + 1
              LRET     = -1
            CASE (4)
              IGBL(6) = MENUH + 1
              LRET     = -1
            CASE (5)
              IGBL(6) = MENUH + 1
              LRET     = -1
            CASE (6)
              IGBL(6) = MENUH + 1
              LRET     = -1
            CASE (7)
              IGBL(6) = MENUH + 1
              LRET     = -1
            CASE (8)
              IF (MENUH .EQ. 1) THEN
                IGBL(6) = 1
              ELSE
                IGBL(6) = MENUH + 6
              END IF
              IPR(453) = 0
              IPR(448) = 0
              LRET     = -1
            CASE (9)
              IF (MENUH .EQ. 1) THEN
                IGBL(6) = 1
              ELSE
                IGBL(6) = MENUH + 6
              END IF
              IPR(453) = 0
              IPR(448) = 0
              LRET     = -1
            CASE (10)
              IGBL(6) = MENUH + 9
              LRET     = -1
            CASE (11)
              IGBL(6) = MENUH + 9
              LRET     = -1
            CASE (12)
              IGBL(6) = MENUH + 9
              LRET     = -1
            CASE (15)
            CASE (16)
              STRING(1:6) = 'L0MAX '
              NCNT        = 6
              SBCD        = STRING(1:NCNT)//CHAR(0)
              CALL PLA015 (539, 1)
              IPR(441) = 0
              IPR(442) = 0
              IPR(443) = 0
              IPR(444) = 0
              IPR(451) = 0
              IPR(540) = 0
              IPR(541) = 0
              IPR(542) = 0
              LRET = -1
            CASE (17)
              IGBL(6) = 16 + MENUH
              LRET     = -1
            CASE (18)
              IGBL(6) = 16 + MENUH
              LRET     = -1
            CASE (19)
              IGBL(6) = 16 + MENUH
              LRET     = -1
            CASE (20)
              IPR(94) = MENUH + 1
              CALL PLA280 ('RESTART')
            CASE (21)
              IF (MENUH .EQ. 4) THEN
                WL = PAR(16)
              ELSE IF (MENUH .EQ. 3) THEN
                WL = 1.54178
              ELSE IF (MENUH .EQ. 2) THEN
                WL = 0.71073
              ELSE IF (MENUH .EQ. 1) THEN
                WL = 0.56086
              END IF
              IF (MENUH .LT. 6) IPR(493) = MENUH
              CALL PLA293 (WL)
              IPR(500) = 0
              LRET     = 4
            CASE (22)
              IGBL(6)  = 23
              LRET     = -1
            CASE (23)
              IGBL(6)  = 22
              LRET     = -1
            CASE (25)
              IPR(550) = MENUH * 25
              CALL PLA280 ('CALC')
            CASE (26)
              PAR(249) = (MENUH - 1) * 10.0
              CALL PLA280 ('CALC ADDSYM')
            CASE (28)
              IPR(581) = MOD (IPR(581) + 1, 2)
              LRET = 2
            CASE (29)
              IPR(594) = MOD (IPR(594) + 1, 2)
              CALL PLA280 ('FROM')
            CASE (31)
              CALL PLA280 ('PLATON')
            CASE (32)
              CALL PLA280 ('NPP')
            CASE (33)
              CALL PLA280 ('ANOM')
            CASE (34)
              CALL PLA280 ('NPP')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 2
        CASE (2)
          SELECT CASE (MMODE)
            CASE (1)
              IPR(116) = MOD(IPR(116) + 1, 2)
              IF (IPR(116) .EQ. 1) THEN
                IPR(479) = 2
                IF (IGBL(75) .EQ. 1) IPR(201) = 0
                IF (MENUH .EQ. 1) THEN
                  IPR(144) = 3
                ELSE
                  IPR(144) = 4
                END IF
              ELSE
                IPR(479) = 2
                PAR(389) = 0.0
                IPR(201) = 0
              END IF
              LRET = 2
            CASE (2)
              IF (IPR(116) .EQ. 0) THEN
                IF (MENUH .EQ. 1) THEN
                  CALL PLA280 ('STEREO RG')
                ELSE IF (MENUH .EQ. 2) THEN
                  CALL PLA280 ('STEREO RB')
                ELSE IF (MENUH .EQ. 3) THEN
                  CALL PLA280 ('STEREO')
                ELSE
                  CALL PLA280 ('STEREO  S')
                END IF
              ELSE
                CALL PLA280 ('MONO')
              END IF
            CASE (3)
              IPR(173) = MOD(IPR(173) + 1, 2)
              CALL PLA280 ('PLOT')
            CASE (4)
              CALL PLA015 (348, 1)
              IF (IPR(348) .EQ. 1) IPR(345) = 1
              IPR(461) = MENUH - 1
              LRET = -1
            CASE (5)
              CALL PLA280 ('VIEW UNIT')
            CASE (6)
              CALL PLA015 (341, 2)
              LRET = -1
            CASE (7)
              CALL PLA280 ('MENU OFF')
            CASE (8)
              IPR(173) = MOD(IPR(173) + 1, 2)
              LRET     =  4
            CASE (9)
              IGBL(69) = MOD(IGBL(69) + 1, 2)
              YGGIP    = - 100 * (IGBL(69) + 1)
              CALL GGIP (0.0, YGGIP, 0.0, 0)
            CASE (10)
              IF (IPR(30) .EQ. 0) IGBL(30) = MOD(IGBL(30) + 1, 2)
              LRET = -1
            CASE (11)
              IPR(29)  = MOD(IPR(29) + 1, 2)
              IF (IPR(29) .EQ. 0) THEN
                IPR(579) = IPR(219)
              ELSE
                IPR(579) = IPR(216)
              END IF
              LRET     = -1
            CASE (12)
              IGBL(64) = MENUH - 1
              IGBL(63) = IGBL(64)
              LRET = -1
            CASE (14)
              IPR(394) = 1
              LRET     = 3
            CASE (16)
              STRING(1:6) = 'L1MAX '
              NCNT        = 6
              SBCD = STRING(1:NCNT)//CHAR(0)
              CALL PLA015 (540, 1)
              IPR(441) = 0
              IPR(442) = 0
              IPR(443) = 0
              IPR(444) = 0
              IPR(451) = 0
              IPR(539) = 0
              IPR(541) = 0
              IPR(542) = 0
              LRET = -1
            CASE (17, 18)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('LOG')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('RELINK BACK')
              ELSE
                CALL PLA280 ('RELINK FORWARD')
              END IF
            CASE (19)
              IGBL(44) = MOD(IGBL(44) + 1, 2)
              IF (IGBL(44) .EQ. 1) CALL PLA015 (0, 36)
              LRET = -1
            CASE (20)
              PAR(441) = (MENUH - 1) * 0.1
              CALL PLA280 ('RESTART')
            CASE (21)
              CALL PLA015 (549, 1)
              IF (IPR(549) .EQ. 1) THEN
                STRING   = 'RADN '
                NCNT     = 5
                SBCD     = STRING(1:NCNT)//CHAR(0)
                IPR(493) = 5
              ELSE
                STRING = ' '
                NCNT   = 0
              END IF
              LRET = -1
            CASE (22)
              CALL PLA280 ('FO')
              M = MIN (NINT (PAR(412) * 6.0), 5)
              IF (MENUH .NE. M) THEN
                IF (MENUH .LT. 5) THEN
                  PAR(412) = MENUH * 0.15
                ELSE
                  PAR(412) = 99.0
                END IF
                IPR(414) = 1
                LRET     = 3
              ELSE
                IF (IPR(414) .NE. 1) THEN
                  IPR(414)  = 1
                ELSE
                  LRET = -1
                END IF
              END IF
            CASE (23)
              CALL PLA280 ('PT')
              M = MIN (NINT (PAR(412) * 6.0), 5)
              IF (MENUH .NE. M) THEN
                IF (MENUH .LT. 5) THEN
                  PAR(412) = MENUH * 0.15
                ELSE
                  PAR(412) = 99.0
                END IF
                IPR(414) = 5
                LRET     = 3
              ELSE
                IF (IPR(414) .NE. 5) THEN
                  IPR(414) = 5
                ELSE
                  LRET = -1
                END IF
              END IF
            CASE (24)
              IF (IPR(533) .EQ. MENUH) THEN
                IPR(116) = MOD(IPR(116) + 1, 2)
                IPR(533) = 1
              ELSE
                IF (MENUH .EQ. 2 .AND. IPR(116) .EQ. 0) IPR(116) = 1
                IPR(533) = MENUH
              END IF
            CASE (25)
              PAR(413) = 2 ** (MENUH - 1)
              CALL PLA280 ('CALC')
            CASE (26)
              PAR(43) = MENUH * 0.2
              CALL PLA280 ('CALC ADDSYM')
            CASE (28)
              PAR(450) = MENUH * 2.5
              CALL PLA280 ('CALC RDF')
            CASE (29)
              IF (PAR(497) .GT. 0.0) THEN
                IPR(629) = MOD(IPR(629) + 1, 2)
                CALL PLA280 ('WGHT')
              END IF
            CASE (30)
              IPR(346) = MOD(IPR(346) + 1, 2)
              LRET = 3
            CASE (31)
              CALL PLA280 ('CALL ADDSYM PLOT')
            CASE (32)
              CALL PLA280 ('IOSLI')
            CASE (33)
              CALL PLA280 ('MU')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 3
        CASE (3)
          SELECT CASE (MMODE)
            CASE (1)
              IPR(212) = MOD(IPR(212) + 1, 2)
              IPR(201) = 0
              LRET = 4
            CASE (2)
              IF (MENUH .EQ. 1) THEN
                IF (IPR(212) .EQ. 1) THEN
                  CALL PLA280 ('EXCLUDE H')
                  IPR(212) = 0
                ELSE
                  CALL PLA280 ('INCLUDE H')
                  IPR(212) = 1
                END IF
              ELSE IF (MENUH .EQ. 2) THEN
                IF (IPR(212) .EQ. 1) THEN
                  CALL PLA280 ('EXCLUDE CH')
                  IPR(212) = 0
                ELSE
                  CALL PLA280 ('INCLUDE CH')
                  IPR(212) = 1
               END IF
              ELSE IF (MENUH .EQ. 3) THEN
                IF (IPR(212) .EQ. 1) THEN
                  CALL PLA280 ('EXCLUDE DH')
                  IPR(212) = 0
                ELSE
                  CALL PLA280 ('INCLUDE DH')
                  IPR(212) = 1
                END IF
              END IF
            CASE (3)
              IPR(173) = 1
              IPR(344) = 0
              IPR(453) = MOD(IPR(453) + 1, 2)
              IF (IPR(453) .EQ. 1) THEN
                CALL PLA280 ('TEXT')
                IPR(448)  = 0
              ELSE
                IPR(448) = 1
              END IF
            CASE (4)
              CALL PLA015 (338, 1)
              IF (IPR(338) .EQ. 1) THEN
                IPR(346) = 1
              END IF
              LRET = -1
            CASE (5)
              CALL PLA280 ('VIEW MIN')
            CASE (6)
              CALL PLA015 (341, 3)
              LRET = -1
            CASE (7)
              PAR(48) = (MENUH - 1) * 10.0
            CASE (8)
              IPR(173) = 1
              IPR(453) = MOD(IPR(453) + 1, 2)
              LRET     = 5
            CASE (9)
              IPR(346) = MOD(IPR(346) + 1, 2)
              IF (IPR(116) .EQ. 0) THEN
                LRET = 3
              ELSE
                IPR(116) = 0
                IPR(479) = 2
                PAR(389) = 0.0
                IPR(201) = 0
                LRET     = 2
              END IF
            CASE (10)
              IPR(110) = MOD(IPR(110) + 1, 2)
              LRET = -1
            CASE (11)
              IPR(592) = MOD(IPR(592) + 1, 2)
              LRET = -1
            CASE (12)
              IGBL(70) = MOD(IGBL(70) + 1, 2)
              IF (IGBL(70) .EQ. 0) IGBL(130) = 0
              LRET = -1
            CASE (14)
              IPR(394) = 2
              LRET = 3
            CASE (15)
              IPR(446) = MENUH - 1
              IF (IPR(446) .EQ. 0) IPR(428) = 1
            CASE (16)
              STRING(1:5) = 'TMIN '
              NCNT = 5
              SBCD = STRING(1:NCNT)//CHAR(0)
              CALL PLA015 (541, 1)
              IPR(441) = 0
              IPR(442) = 0
              IPR(443) = 0
              IPR(444) = 0
              IPR(451) = 0
              IPR(540) = 0
              IPR(541) = 0
              IPR(542) = 0
              LRET = -1
            CASE (17)
              CALL PLA280 ('MULABS')
            CASE (18)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('TREE')
              ELSE
                CALL PLA280 ('LIST')
              END IF
            CASE (19)
              CALL PLA280 ('EDITRES')
            CASE (20)
              PAR(439) = 0.125 * 2 ** (MENUH - 1)
            CASE (21)
              PAR(372) = 2 ** (MENUH - 1)
              LRET = 3
            CASE (22)
              CALL PLA280 ('FS')
              M = MIN (NINT (PAR(412) * 6.0), 5)
              IF (MENUH .NE. M) THEN
                IF (MENUH .LT. 5) THEN
                  PAR(412) = MENUH * 0.15
                ELSE
                  PAR(412) = 99.0
                END IF
                IPR(414) = 2
                LRET     = 3
              ELSE
                IF (IPR(414) .NE. 2) THEN
                  IPR(414) = 2
                ELSE
                  LRET = -1
                END IF
              END IF
            CASE (24)
              IPR(534) = MENUH
            CASE (25)
              IPR(567) = MENUH * 5
              CALL PLA280 ('CALC')
            CASE (26)
              PAR(404 - IGBL(97) * 3) = MENUH * 0.1  - 0.05
              CALL PLA280 ('CALC ADDSYM')
            CASE (28)
              PAR(451) = MENUH * 2.5
              CALL PLA280 ('CALC RDF')
            CASE (30)
              IPR(355) = MOD(IPR(355) + 1, 2)
              LRET = 3
            CASE (31)
              CALL PLA280 ('ADDSYM SHELX')
            CASE (32)
              CALL PLA280 ('IOSWLI')
            CASE (33)
              CALL PLA280 ('ANOM 1.5418')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 4
        CASE (4)
          SELECT CASE (MMODE)
            CASE (1)
              CALL PLA015 (351, 1)
              IPR(349) = 0
              LRET     = -1
            CASE (2, 4)
              PAR351 = (6 - MENUH) * 0.1
              IF (IABS(IPR(4)) .NE. 1 .OR. PAR(351) .NE. PAR351) THEN
                PAR(351) = PAR351
                IPR(4)   = 0
                CALL PLA280 ('SOLID '//BWC//COLOR)
              ELSE
                CALL PLA280 ('STICK '//COLOR)
              END IF
            CASE (3)
              CALL PLA015 (448, 1)
              IF (IPR(448) .EQ. 1) IPR(453) = 0
              LRET = -1
            CASE (5)
              CALL PLA280 ('VIEW XO')
            CASE (6)
              CALL PLA015 (341, 4)
              LRET = -1
            CASE (7)
              IF (IPR(30) .EQ. 0) THEN
                IGBL(97) = MOD(IGBL(97) + 1, 2)
              END IF
              LRET = -1
            CASE (8)
              CALL PLA015 (448, 1)
              IF (IPR(448) .EQ. 1) IPR(453) = 0
              LRET = -1
            CASE (9)
              IPR(618) = MOD (IPR(618) + 1, 2)
              LRET = 2
            CASE (10)
              IF (IPR(30) .EQ. 0) THEN
                IGBL(97) = MOD(IGBL(97) + 1, 2)
              END IF
              LRET = -1
            CASE (11)
              IGBL(56) = MOD(IGBL(56) + 1, 2)
              LRET     = -1
            CASE (12)
              IF (IGBL(116) .GT. 0) THEN
                IGBL(130) = MOD(IGBL(130) + 1, 2)
                IF (IGBL(130) .EQ. 1) IGBL(70) = 1
              END IF
              LRET = -1
            CASE (14)
              IPR(394) = 3
              LRET     = 3
            CASE (16)
              STRING(1:5) = 'TMAX '
              NCNT        = 5
              SBCD        = STRING(1:NCNT)//CHAR(0)
              CALL PLA015 (542, 1)
              IPR(441) = 0
              IPR(442) = 0
              IPR(443) = 0
              IPR(444) = 0
              IPR(451) = 0
              IPR(539) = 0
              IPR(540) = 0
              IPR(541) = 0
              LRET     = -1
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('ABSTOMPA')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('ABSPSI')
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA280 ('ABSNONE')
              END IF
            CASE (18)
              CALL PLA280 ('REMOVE')
            CASE (20)
              IPR(514) = 2 * MENUH - 1
              CALL PLA280 ('RESTART')
            CASE (21)
              IPR(500) = MENUH
              RGBL(23) = 0.0
              LRET = 3
            CASE (22)
              CALL PLA280 ('DI')
              M = MIN (NINT (PAR(412) * 6.0), 5)
              IF (MENUH .NE. M) THEN
                IF (MENUH .LT. 5) THEN
                  PAR(412) = MENUH * 0.15
                ELSE
                  PAR(412) = 99.0
                END IF
                IPR(414) = 3
                LRET     = 3
              ELSE
                IF (IPR(414) .NE. 3) THEN
                  IPR(414) =  3
                ELSE
                  LRET = -1
                END IF
              END IF
            CASE (24)
              IPR(526) = 1
            CASE (25)
              PAR(414) = MENUH * 0.05
              CALL PLA280 ('CALC')
            CASE (26)
              PAR(405 - IGBL(97) * 3) = MENUH * 0.1 -0.05
              CALL PLA280 ('CALC ADDSYM')
            CASE (30)
              IPR(212) = MOD(IPR(212) + 1, 2)
            CASE (31)
              CALL PLA280 ('ADDSYM EQUAL')
            CASE (32)
              CALL PLA280 ('SIGLI')
            CASE (33)
              CALL PLA280 ('ANOM 0.71073')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 5
        CASE (5)
          SELECT CASE (MMODE)
            CASE (1)
              IPR(45)  = MENUH
              IPR(201) = 0
              LRET     = 2
            CASE (2)
              IF (IABS(IPR(4)) .NE. 2) THEN
                CALL PLA280 ('ROD   '//BWC//COLOR)
              ELSE
                CALL PLA280 ('STICK '//COLOR)
              END IF
            CASE (3, 8)
              PAR(350) =  0.20 + 0.05 * MENUH
              LRET = -1
            CASE (4)
              IF (IABS(IPR(4)) .NE. 2) THEN
                CALL PLA280 ('ROD   '//BWC//COLOR)
              ELSE
                CALL PLA280 ('STICK '//COLOR)
              END IF
            CASE (5)
              CALL PLA280 ('VIEW YO')
            CASE (6)
              CALL PLA015 (341, 1)
              LRET = -1
            CASE (7)
              IGBL(105) = MOD(IGBL(105) + 1, 2)
            CASE (9)
              IGBL(105) = MOD(IGBL(105) + 1, 2)
              IPR(201)  = 0
              LRET      = 2
            CASE (10)
              IPR(68) = MENUH - 1
              LRET = -1
            CASE (11)
              IF (IPR(30) .EQ. 0) THEN
                IPR(501) = MOD (IPR(501) + 1, 2)
                IPR(71)  = 0
              END IF
              LRET = -1
            CASE (12)
              IGBL(137) = MOD (IGBL(137) + 1, 2)
            CASE (15)
              IPR(320) = MOD (IPR(320) + 1, 2)
            CASE (16)
              CALL PLA015 (441, 1)
              IPR(442) = 0
              IPR(443) = 0
              IPR(444) = 0
              IPR(451) = 0
              IPR(539) = 0
              IPR(540) = 0
              IPR(541) = 0
              IPR(542) = 0
              IF (IPR(441) .EQ. 1) THEN
                STRING = 'MU'
                NCNT = 3
                SBCD  = STRING(1:NCNT)//CHAR(0)
              ELSE
                NCNT = 0
                STRING = ' '
              END IF
              LRET = -1
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('TRMX')
              ELSE
                CALL PLA280 ('SPGR')
              END IF
            CASE (18)
              CALL PLA280 ('XTAL')
            CASE (20)
              IPR(117) = MENUH
            CASE (21)
              PAR(411) = MENUH / 100.0
              LRET = 3
            CASE (22)
              IF (IGBL(9) .LT. 0) THEN
                CALL PLA280 ('SQ')
                M = MIN (NINT (PAR(412) * 5.0), 4)
                IF (MENUH .NE. M) THEN
                  IF (MENUH .LT. 4) THEN
                    PAR(412) = MENUH * 0.2
                  ELSE
                    PAR(412) = 99.0
                  END IF
                  IPR(414) = 4
                  LRET     = 3
                ELSE
                  IF (IPR(414) .NE. 4) THEN
                    IPR(414)  = 4
                  ELSE
                    LRET = -1
                  END IF
                END IF
              ELSE
                CALL PLA015 (427, 7)
                LRET = -1
              END IF
            CASE (24)
              IPR(526) = 2
            CASE (25)
              IPR(469) = MOD(IPR(469) + 1, 2)
              CALL PLA280 ('CALC')
            CASE (26)
              PAR(406 - IGBL(97) * 3) = MENUH * 0.1 - 0.05
              CALL PLA280 ('CALC ADDSYM')
            CASE (31)
              CALL PLA280 ('EXOR')
            CASE (32)
              CALL PLA280 ('LSLI')
            CASE (33)
              CALL PLA280 ('ANOM 0.56086')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 6
        CASE (6)
          SELECT CASE (MMODE)
            CASE (1)
              CALL PLA015 (440, 1)
              IPR(351) = 0
              IPR(349) = 0
              IPR(327) = 0
              IPR(328) = 0
              LRET = -1
            CASE (2, 4)
              IF (IABS(IPR(4)) .NE. 3) THEN
                IF (MENUH .EQ. 1) THEN
                  CALL PLA280 ('CPK '//BWC//COLOR)
                ELSE IF (MENUH .EQ. 2) THEN
                  CALL PLA280 ('CPK STICK '//BWC//COLOR)
                END IF
              ELSE
                CALL PLA280 ('STICK '//COLOR)
              END IF
            CASE (3)
              CALL PLA015 (344, 1)
              LRET = -1
            CASE (5)
              CALL PLA280 ('VIEW ZO')
            CASE (6)
              IPR(90) = 256
              CALL PLUT12
            CASE (7)
              IPR(14)  = MOD (IPR(14) + 1, 2)
            CASE (8)
              IPR(453) = 0
              CALL PLA015 (344, 1)
              LRET = -1
            CASE (9)
              IPR(506) = MOD(IPR(506) + 1, 2)
              IPR(201) = 0
              LRET     = 2
            CASE (10)
              IF (IGBL(71) .EQ. 0) IPR(71) = MOD (IPR(71) + 1, 2)
              LRET = -1
            CASE (11)
              IPR(502) = MOD (IPR(502) + 1, 2)
              LRET = -1
            CASE (14)
              IPR(406) = MOD (IPR(406) + 1, 2)
              IPR(389) = 0
              LRET     = 4
            CASE (15)
              IPR(428) = MOD (IPR(428) + 1, 2)
              IF (IPR(428) .EQ. 0) IPR(446) = 1
            CASE (16)
              CALL PLA015 (442, 1)
              IPR(441) = 0
              IPR(443) = 0
              IPR(444) = 0
              IPR(451) = 0
              IPR(539) = 0
              IPR(540) = 0
              IPR(541) = 0
              IPR(542) = 0
              IF (IPR(442) .EQ. 1) THEN
                STRING = 'RADIUS'
                NCNT   = 7
                SBCD   = STRING(1:NCNT)//CHAR(0)
              ELSE
                STRING = ' '
                NCNT   = 0
              END IF
              LRET = -1
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('FORMULA')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('Z')
              ELSE
                CALL PLA280 ('SHELXS86')
              END IF
            CASE (18)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('CELL')
              ELSE
                CALL PLA280 ('HELENA')
              END IF
            CASE (19)
              CALL PLA280 ('TWIN')
            CASE (20)
              PAR(440) = 10 ** MENUH
            CASE (21)
              IF (MENUH .LT. 3) THEN
                PAR(371) = 10 ** (3 - MENUH)
              ELSE
                PAR(371) = 1.0 / 10 ** (MENUH - 3)
              END IF
              LRET = 3
            CASE (22)
              CALL PLA280 ('PLAN')
              IPR(416)  = 0
              IPR(420)  = 0
            CASE (24)
              IPR(526) = 3
            CASE (25)
              MEDIUM      = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              CALL PLA280 ('PLOT')
            CASE (26)
              IPR(568) = MOD (IPR(568) + 1, 2)
              LRET = -1
            CASE (29)
              IPR(611) = MENUH - 1
              CALL PLA280 ('SELECT')
            CASE (33)
              CALL PLA280 ('MU 1.5418')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 7
        CASE (7)
          SELECT CASE (MMODE)
            CASE (1)
              CALL PLA015 (341, MENUH + 1)
              LRET = -1
            CASE (2, 4)
              IF (IABS(IPR(4)) .NE. 4) THEN
                CALL PLA280 ('STRAW '//BWC//COLOR)
              ELSE
                CALL PLA280 ('STICK '//COLOR)
              END IF
            CASE (3, 8)
              CALL PLA015 (334, 1)
              LRET = -1
            CASE (5)
              CALL PLA280 ('VIEW AFACE')
            CASE (6)
              IPR(90) =  16
              CALL PLUT12
            CASE (7)
              IGBL(55) = MOD (IGBL(55) + 1, 2)
            CASE (9)
              IGBL(55) = MOD (IGBL(55) + 1, 2)
            CASE (10)
              IGBL(55) = MOD (IGBL(55) + 1, 2)
              LRET = -1
            CASE (11)
              IPR(497) = MOD(IPR(497) + 1, 2)
              LRET = -1
            CASE (14)
              IPR(387) = MOD (IPR(387) + 1, 2)
              IPR(389) = 0
              LRET     = 4
            CASE (15)
              IF (IPR(370) .EQ. 0) IPR(424) = MENUH - 1
            CASE (16)
              CALL PLA015 (443, 1)
              IPR(441) = 0
              IPR(442) = 0
              IPR(444) = 0
              IPR(451) = 0
              IF (IPR(443) .EQ. 1) THEN
                STRING = 'MUR'
                NCNT   = 4
                SBCD   = STRING(1:NCNT)//CHAR(0)
             ELSE
               STRING = ' '
               NCNT   = 0
              END IF
              LRET = -1
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('SHELXS97 TREF')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('SHELXS97 PATT')
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA280 ('SHELXD')
              ELSE
                CALL PLA280 ('SHELXT')
              END IF
            CASE (18)
              CALL PLA280 ('FLIPPER')
            CASE (22)
              CALL PLA280 ('PLAN')
              IPR(416)  = 1
              IPR(420)  = 0
            CASE (24)
              CALL PLA280 ('REVERSE')
            CASE (25)
              IF (IPR(543) .EQ. 1) THEN
                IPR(543) = 0
              ELSE
                IPR(543) = 1
                CALL PLA280 ('TWIN')
                IPR(576) = 0
              END IF
            CASE (29)
              IPR(666) = MOD (IPR(666) + 1, 2)
            CASE (33)
              CALL PLA280 ('MU 0.71073')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 8
        CASE (8)
          SELECT CASE (MMODE)
            CASE (1)
              CALL PLA015 (311, MENUH)
              LRET = -1
            CASE (2, 4)
              IF (IABS(IPR(4)) .NE. 0) THEN
                CALL PLA280 ('STICK '//COLOR)
              ELSE
                CALL PLA280 ('STRAW '//BWC//COLOR)
              END IF
            CASE (3)
              CALL PLA015 (351, 1)
              IF (IPR(335) .EQ. 1) CALL PLA015 (335, 1)
              IF (IPR(349) .EQ. 1) CALL PLA015 (349, 1)
              IF (IGBL(75) .EQ. 0) THEN
                CALL PLA280 ('LABEL ON')
              ELSE
                LRET = -1
              END IF
            CASE (5)
              CALL PLA280 ('VIEW BFACE')
            CASE (6)
              IPR(90) =  32
              CALL PLUT12
            CASE (7)
              IPR(231) = MOD (IPR(231) + 1, 2)
            CASE (8)
              PAR(7) = 2.0 + MENUH
              LRET = -1
            CASE (9)
              LRET = -1
              IF (IPR(75) .GT. 1) THEN
                CALL PLA015 (312, 1)
                IFL(1)  = 'FIT'
                IPR(33) = MENUH - 1
                IF (IPR(312) .EQ. 0) THEN
                  IPR(81) = - LMOD - 1
                  NASUP   = IPR(39) + IPR(64)
                  CALL PLA034 (-1, NASUP)
                  CALL PLA035 (1)
                  LMOD = 0
                  IGBL(6) = IABS(IGBL(6))
                  LRET = 4
                END IF
              END IF
            CASE (10)
              IPR(324) = MOD (IPR(324) + 1, 2)
              LRET = -1
            CASE (11)
              IGBL(61) = MOD (IGBL(61) + 1, 2)
              LRET = -1
            CASE (14)
              IPR(388) = MOD (IPR(388) + 1, 2)
              IPR(389) = 0
              LRET     = 4
            CASE (15)
              IF (IPR(370) .EQ. 0) IPR(425) = MENUH -1
            CASE (16)
              CALL PLA015 (444, 1)
              IPR(441) = 0
              IPR(442) = 0
              IPR(443) = 0
              IPR(451) = 0
              IF (IPR(444) .EQ. 1) THEN
                STRING = 'GRID'
                NCNT   = 5
                SBCD   = STRING(1:NCNT)//CHAR(0)
              ELSE
                STRING = ' '
                NCNT   = 0
              END IF
              LRET = -1
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('DIRDIF PATTY')
              ELSE
                CALL PLA280 ('DIRDIF ORIENT')
              END IF
            CASE (18)
              VAL = 1.0
              IF (MENUH .EQ. 1) THEN
                VAL = 0.54
              ELSE IF (MENUH .EQ. 2) THEN
                VAL = 0.60
              ELSE IF (MENUH .EQ. 3) THEN
                VAL = 0.65
              END IF
              WRITE (IGGT, 99994, IOSTAT = IOST) VAL
              PAR(453) = VAL
            CASE (19)
              IGBL(91) = MOD(IGBL(91) + 1, 2)
              LRET = -1
            CASE (22)
              CALL PLA280 ('PLAN')
              IPR(416)  = 2
              IPR(420)  = 0
            CASE (23)
              IPR(577) = (MENUH * 2) - 1
              LRET = -1
            CASE (24)
              IPR(598) = MOD (IPR(598) + 1, 2)
            CASE (25)
              IF (IPR(543) .EQ. 2) THEN
                IPR(543) = 0
              ELSE
                IPR(543) = 2
                CALL PLA280 ('TWIN')
                IPR(576) = 0
              END IF
            CASE (29)
              IF (MENUH .EQ. 1) THEN
                PAR(452) = 0.0
              ELSE
                PAR(452) = 0.25 * 2 ** (MENUH - 2)
              END IF
              CALL PLA280 ('SIGMA')
            CASE (32)
              CALL PLA280 ('VARIANCE')
            CASE (33)
              CALL PLA280 ('MU 0.56086')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 9
        CASE (9)
          SELECT CASE (MMODE)
            CASE (1)
              IPR(506) = 1
              IPR(201) = 0
              IF (MENUH .EQ. 1) THEN
                LMOD     = 1
                IFL(1)   = 'DEFINE'
                IPR(507) = 1
                CALL PLA015 (508, 1)
                LRET     = -1
              ELSE IF (MENUH .EQ. 3) THEN
                IF (IPR(508) .EQ. 1) THEN
                  IPR(507) = 3
                  IPR(508) = 0
                  WRITE (IGGT, 99995, IOSTAT = IOST)
     1              (IFL(I), I = 1, LMOD)
                  IGBL(6) = IABS(IGBL(6))
                  LRET = 7
                END IF
              END IF
            CASE (2, 4)
   10         IPR(345) = MOD(IPR(345) + 1, 2)
              IF (IPR(345) .EQ. 1) THEN
                IF (MENUH .EQ. 1) THEN
                  IPR(478) = 0
                ELSE IF (MENUH .EQ. 2) THEN
                  IPR(478) = -1
                ELSE
                  IPR(478) = 1
                END IF
              ELSE
                IF (MENUH * IPR(478) .EQ. -2 .OR.
     1              MENUH * IPR(478) .EQ.  3 .OR.
     2              (MENUH .EQ. 1 .AND. IPR(478) .EQ. 0)) THEN
                  IPR(478) = 0
                ELSE
                  IPR(478) = 0
                  GO TO 10
                END IF
              END IF
              IF (IGBL(35) .EQ. 1) THEN
                CALL PLA280 ('PLOT')
              ELSE
                LRET = -1
              END IF
            CASE (3)
              IF (IPR(351) .EQ. 1) CALL PLA015 (351, 1)
              IF (IPR(349) .EQ. 1) CALL PLA015 (349, 1)
              IF (IGBL(3) .NE. 0) THEN
                CALL PLA015 (335, 1)
                IF (IGBL(75) .EQ. 0) THEN
                  CALL PLA280 ('LABEL ON')
                ELSE
                  LRET = -1
                END IF
              ELSE
                CALL PLA015 (427, 40)
                LRET = -1
              END IF
            CASE (5)
              CALL PLA280 ('VIEW CFACE')
            CASE (6)
              IPR(90) = 512
              CALL PLUT12
            CASE (7)
              IF (IPR(17) .EQ. 0) IGBL(30) = MOD(IGBL(30) + 1, 2)
              LRET = -1
            CASE (8)
              IGBL(52) = MOD (IGBL(52) + 1, 2)
              LRET = -1
            CASE (9)
              IF (IPR(75) .GT. 1) THEN
                IPR(33) = MENUH - 1
                CALL PLA280 ('FIT 1 2')
              ELSE
                LRET = -1
              END IF
            CASE (10)
              IPR(87) = MOD(IPR(87) + 1, 2)
              LRET = -1
            CASE (11)
              IF (IPR(30) .EQ. 0) IPR(181) = MOD(IPR(181) + 1, 2)
              LRET = -1
            CASE (12)
              IF (IPR(33) .EQ. 1) THEN
                IPR(33) = 0
              ELSE
                IPR(33) = 1
              END IF
              LRET = -1
            CASE (15)
              IF (IPR(370) .EQ. 0) IPR(426) = MENUH - 1
            CASE (16)
              CALL PLA015 (451, 1)
              IPR(441) = 0
              IPR(442) = 0
              IPR(443) = 0
              IPR(444) = 0
              IF (IPR(451) .EQ. 1) THEN
                STRING = 'FACE'
                NCNT   = 5
                SBCD   = STRING(1:NCNT)//CHAR(0)
              ELSE
                STRING = ' '
                NCNT   = 0
              END IF
              LRET = -1
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('SIR97')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('SIR2004')
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA280 ('SIR2011')
              END IF
            CASE (18)
              IGBL(97) = MOD(IGBL(97) + 1, 2)
            CASE (19)
              IGBL(51) = MOD(IGBL(51) + 1, 2)
              LRET = -1
            CASE (22)
              CALL PLA280 ('PLAN')
              IPR(416)  = 3
              IPR(420)  = 0
            CASE (23)
              IPR(578) = (MENUH * 2) - 1
              LRET = -1
            CASE (24)
              IPR(537) = MOD(IPR(537) + 1, 2)
            CASE (25)
              IF (IPR(543) .EQ. 3) THEN
                IPR(543) = 0
              ELSE
                IPR(543) = 3
                CALL PLA280 ('TWIN')
                IPR(576) = 0
              END IF
            CASE (26)
              IPR(503) = MOD(IPR(503) + 1, 2)
              LRET = -1
            CASE (29)
              CALL PLA280 ('SET IPR 656 1')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 10
        CASE (10)
          SELECT CASE (MMODE)
            CASE (1)
              IF (MENUH .EQ. 1) THEN
                CALL PLA226 (0, 0.0)
              ELSE IF (MENUH .EQ. 2) THEN
                IGBL(67) = 0
                IPR(201) = 0
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA226 ( 1, -90.0 / RGBL(6))
                CALL PLA226 (-2, -90.0 / RGBL(6))
              ELSE IF (MENUH .EQ. 4) THEN
                CALL PLA226 ( 1, 90.0 / RGBL(6))
                CALL PLA226 (-3, 90.0 / RGBL(6))
              ELSE IF (MENUH .EQ. 5) THEN
                CALL PLA226 (3, 0.0)
              END IF
              MNH(6) = MENUH
              LRET = 4
            CASE (2)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('VIEW UNIT')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('VIEW MIN')
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA280 ('VIEW XO')
              ELSE IF (MENUH .EQ. 4) THEN
                CALL PLA280 ('VIEW YO')
              ELSE IF (MENUH .EQ. 5) THEN
                CALL PLA280 ('VIEW ZO')
              END IF
              MNH(6) = MENUH
            CASE (3)
              CALL PLA015 (349, 1)
              IF (IPR(351) .EQ. 1) CALL PLA015 (351, 1)
              IF (IPR(335) .EQ. 1) CALL PLA015 (335, 1)
              IF (IGBL(75) .EQ. 0) THEN
                CALL PLA280 ('LABEL ON')
              ELSE
                LRET = -1
              END IF
            CASE (4)
              IPR(345) = 0
              IPR(139) = MENUH - 1
            CASE (5)
              CALL PLA280 ('VIEW INVERT')
            CASE (6)
              CALL PLA280 ('LIST CELL')
            CASE (7)
              CALL PLA280 ('HELP')
            CASE (8)
              CALL PLA226 (-4, 0.0)
            CASE (9)
              IPR(41) = MENUH - 1
              LRET = -1
            CASE (10)
              IF (IPR(30) .EQ. 0) IGBL(52) = MOD (IGBL(52) + 1, 2)
              LRET = -1
            CASE (11)
              IPR(41) = MENUH - 1
              LRET = -1
            CASE (12)
              IGBL(106) = MOD(IGBL(106) + 1, 2)
            CASE (14)
              PAR(165) = ASIN((0.45 + MENUH * 0.05) * PAR(17)) * RGBL(6)
          LRET = 3
            CASE (16)
              STRING(1:5) = 'DELF '
              NCNT = 5
              SBCD = STRING(1:NCNT)//CHAR(0)
              LRET = -1
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('EXOR')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('EXORS')
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA280 ('EXORD')
              END IF
            CASE (18)
              IGBL(40) = MOD(IGBL(40) + 1, 2)
            CASE (19)
              IGBL(96) = MOD(IGBL(96) + 1, 2)
              LRET     = -1
            CASE (22)
              CALL PLA280 ('PLAN')
              IPR(416) = 4
              IPR(420) = MENUH
              MNH(16)  = MENUH
              IF (MENUH .EQ. 1) THEN
                PAR(272) = PAR(101)
                PAR(273) = PAR(102)
              ELSE IF (MENUH .EQ. 2) THEN
                PAR(272) = PAR(101)
                PAR(273) = PAR(103)
              ELSE
                PAR(272) = PAR(102)
                PAR(273) = PAR(103)
              END IF
              IF (PAR(272) .LT. PAR(273)) THEN
                PAR(276) = 90.0
                CALL GEN018 (PAR(272), PAR(273))
              ELSE
                PAR(276) = 0
              END IF
              IF (PAR(273) * PAR(50) .LT. PAR(272)) THEN
                PAR(273) = PAR(272) / PAR(50)
              END IF
              PAR(273) = PAR(273) + 3.0
              PAR(272) = PAR(273) * PAR(50)
            CASE (23)
              CALL PLA280 ('F3D')
            CASE (24)
              IPR(140) = MENUH - 1
            CASE (25)
              IF (IPR(543) .EQ. 4) THEN
                IPR(543) = 0
              ELSE
                IPR(543) = 4
                CALL PLA280 ('TWIN')
                IPR(576) = 0
              END IF
            CASE (26)
              IGBL(106) = MOD(IGBL(106) + 1, 2)
            CASE (29)
              CALL PLA280 ('SET IPR 656 2')
            CASE (30)
              IF (MENUH .EQ. 1) THEN
                CALL PLA226 (0, 0.0)
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA226 (2, 90.0 / RGBL(6))
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA226 (1, -90.0 / RGBL(6))
              ELSE IF (MENUH .EQ. 4) THEN
                CALL PLA226 (3, 90.0 / RGBL(6))
              END IF
              MNH(6) = MENUH
              LRET = 3
            CASE (31)
              WRITE (IGGT, 99975, IOSTAT = IOST) MENUH
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 11
        CASE (11)
          SELECT CASE (MMODE)
            CASE (1)
              IF (IPR(44) .NE. 0) THEN
                IF (MENUH - 1 .NE. IGBL(88)) THEN
                  IF (IGBL(59) .EQ. 1) THEN
                    IGBL(88) = MENUH - 1
                  ELSE
                    IGBL(59) = MOD(IGBL(59) + 1, 2)
                  END IF
                ELSE
                  IGBL(59) = MOD(IGBL(59) + 1, 2)
                  IGBL(88) = MENUH - 1
                END IF
              END IF
              IPR(201) = 0
              LRET = 4
            CASE (2)
              IF (MENUH - 1 .NE. IGBL(88)) THEN
                IF (IGBL(59) .EQ. 1) THEN
                  IGBL(88) = MENUH - 1
                ELSE
                  IGBL(59) = MOD(IGBL(59) + 1, 2)
                END IF
              ELSE
                IGBL(59) = MOD(IGBL(59) + 1, 2)
                IGBL(88) = MENUH - 1
              END IF
            CASE (3)
              IPR(351) = 0
              CALL PLA015 (341, 1)
              LRET = -1
            CASE (4)
              IF (MENUH .GT. 1) THEN
                PAR(44) = 0.5 * 2.0 ** (MENUH - 4)
              ELSE
                PAR(44) = 0.0
              END IF
            CASE (5)
              IFL(1) = 'VIEW '
              IFL(2) = 'LINE '
              CALL PLA015 (329, 1)
              LRET = -1
            CASE (6)
              CALL PLA274
              CALL PLA280 ('PLOT')
            CASE (7)
              IGBL(35) = MOD(IGBL(35) + 1, 2)
              LRET = -1
            CASE (8)
              CALL PLA015 (536, MENUH)
              LRET = -1
            CASE (9)
              CALL PLA015 (341, 5)
              LRET = -1
            CASE (10)
              IF (IPR(44) .NE. 0) THEN
                IF (MENUH - 1 .NE. IGBL(88)) THEN
                  IF (IGBL(59) .EQ. 1) THEN
                    IGBL(88) = MENUH - 1
                  ELSE
                    IGBL(59) = MOD(IGBL(59) + 1, 2)
                  END IF
                ELSE
                  IGBL(59) = MOD(IGBL(59) + 1, 2)
                  IGBL(88) = MENUH - 1
                END IF
              END IF
              LRET     = -1
            CASE (11)
              IPR(154) = MOD(IPR(154) + 1, 2)
              LRET = -1
            CASE (12)
              IF (IGBL(136) .EQ. 0) THEN
                CALL PLA280 ('NOEXPAND')
                LRET = 2
              ELSE
                IGBL(136) = 0
              END IF
            CASE (14)
              PAR(284) = (MENUH - 1) * 0.5
              LRET = 3
            CASE (15)
              CALL PLA280 ('RR 1')
            CASE (16)
              IGBL(57) = MOD(IGBL(57) + 1, 2)
            CASE (17)
              WRITE(IGGT(1:14), 99993, IOSTAT = IOST) MENUH - 1
            CASE (18)
              IGBL(41) = MOD(IGBL(41) + 1, 2)
            CASE (19)
              IGBL(125) = MOD(IGBL(125) + 1, 2)
              LRET = -1
            CASE (22)
              PAR(279) = - 1.5 + MENUH
              LRET = 2
            CASE (24)
              IPR(535) = MOD(IPR(535) + 1, 2)
            CASE (25)
              MEDIUM      = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              CALL PLA280 ('TWIN')
            CASE (29)
              CALL PLA280 ('SET IPR 656 -1')
            CASE (30)
              IPR(353) = MOD(IPR(353) + 1, 2)
              LRET = 3
            CASE (31)
              WRITE (IGGT, 99974, IOSTAT = IOST) MENUH * 250
            CASE default
              LRET = -1
          END SELECT
C * MENU BOX # 12
        CASE (12)
          SELECT CASE (MMODE)
            CASE (1)
              IF (MENUH .EQ. IPR(232) + 1)
     1             IGBL(75) = MOD(IGBL(75) + 1, 2)
              IF (MENUH .EQ. 2) THEN
                IPR(232) = 1
                IPR(201) = 0
              ELSE
                IPR(232) = 0
              END IF
              IF (IGBL(75) .EQ. 1) WRITE (LU6, 99999, IOSTAT = IOST)
              IF (IGBL(35) .EQ. 1) THEN
                LRET = 2
              ELSE
                LRET = -1
              END IF
            CASE (2)
              PAR(349) = 0.20 + 0.05 * MENUH
            CASE(3)
              CALL PLA015 (343, 1)
              LRET = -1
            CASE (4)
              PAR(36) = (MENUH - 1) * 0.05
            CASE (5)
              IFL(1) = 'VIEW '
              IFL(2) = 'PERP '
              CALL PLA015 (329, 2)
              LRET = -1
            CASE (6)
              IPR(90)  = 4
              IPR(220) = 2
              CALL PLUT12
            CASE (7)
              PAR(58) = (MENUH - 1) * 0.05
            CASE (8)
              IPR(108) = 1
              IPR(148) = MENUH - 1
              LRET = 2
            CASE (9)
              CALL PLA280 ('RADII BONDS')
            CASE (10)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('LIST ARU')
                LRET = 2
              ELSE
                WRITE (BCD, 99997, IOSTAT = IOST)
     1            (PAR(J), J = 113, 115),
     2            (ACOS(PAR(J)) * RGBL(6), J = 116, 118), PAR(17),
     3            CHAR(0)
                CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
                LRET = -1
              END IF
            CASE (12)
              IPR(594) = MOD (IPR(594) + 1, 2)
              LRET = -1
            CASE (15)
              CALL PLA280 ('RR 2')
            CASE (11, 16)
              IPR(445) = MOD (IPR(445) + 1, 2)
              LRET = -1
            CASE (17)
              WRITE (IGGT(1:16), 99992, IOSTAT = IOST) MENUH - 1
            CASE (18)
              IGBL(34) = MOD(IGBL(34) + 1, 2)
            CASE (22)
              PAR(273) = MENUH * 5.0
              PAR(272) = 4.0 * PAR(273) / 3.0
              CALL PLA280 ('SCAL')
            CASE (24)
              IPR(531) = MENUH - 1
            CASE (25)
              PAR(449) = MENUH * 0.1
              CALL PLA280 ('RESOLUTION')
            CASE (29)
              CALL PLA280 ('SET IPR 656 -2')
            CASE (30)
              IPR(358) = MOD (IPR(358) + 1, 2)
              LRET = 3
            CASE (31)
              WRITE (IGGT, 99973, IOSTAT = IOST) MENUH
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 13
        CASE (13)
          SELECT CASE (MMODE)
            CASE (1)
              CALL PLA015 (349, 1)
              IPR(311) = 0
              IPR(327) = 0
              IPR(328) = 0
              IPR(351) = 0
              LRET     = -1
            CASE (2)
              IF (IPR(46) .EQ. 0) THEN
                CALL PLA280 ('UNIT ON')
              ELSE
                CALL PLA280 ('UNIT OFF')
              END IF
            CASE (3)
              IPR(130) = 0
              PAR(13)  = 0.4 + MENUH * 0.5
              CALL PLA280 ('PLOT')
            CASE (4)
              IPR(111) = 2 ** (4 - MENUH)
              PAR(5)   = 1.0 / (3.33333 ** MENUH)
            CASE (5)
              IFL(1) = 'VIEW '
              IFL(2) = 'BISECT '
              CALL PLA015 (329, 3)
              LRET = -1
            CASE (6)
              IPR(90) = 8
              CALL PLUT12
            CASE (7)
              IGBL(123) = MENUH - 1
            CASE (8)
              IPR(177) = MENUH - 1
              IPR(211) = 0
              LRET = 3
            CASE (9)
              IF (MENUH .EQ. 1) THEN
                WRITE (BCD, 99998, IOSTAT = IOST) PAR(17),
     1           (PAR(J), J = 101, 106), PAR(98), CHAR(0)
                CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
                LRET = -1
              ELSE
                CALL PLA274
                CALL GEN038 (ICL, 1, 80)
                LRET = 4
              END IF
            CASE (10)
              IF (MENUH .EQ. 1) THEN
                IF (PAR(98) .EQ. 1.0) CALL PLA080
                WRITE (BCD, 99998, IOSTAT = IOST) PAR(17),
     1            (PAR(J), J = 101, 106), PAR(98), CHAR(0)
                CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
                LRET = -1
              ELSE
                 CALL PLA280 ('LIST SYMM')
              LRET = 2
             END IF
            CASE (11)
              IPR(363) = MOD (IPR(363) + 1, 2)
              LRET = -1
            CASE (12)
              IGBL(109) = MOD (IGBL(109) + 1, 2)
              LRET = -1
            CASE (14)
              IPR(369) = MOD (IPR(369) + 1, 2)
              IPR(389) = 0
              LRET     = 4
            CASE (15)
              CALL PLA280 ('RR 3')
            CASE (16)
              IPR(363) = MOD (IPR(363) + 1, 2)
              LRET = -1
            CASE (17)
              CALL PLA280 ('TWINMAT')
            CASE (18)
              CALL PLA280 ('PLATON CSD')
            CASE (22)
              IF (MENUH .GT. 3) THEN
                DELTA = (MENUH - 3) * 0.5
              ELSE
                DELTA = (MENUH - 4) * 0.5
              END IF
              PAR(274) = PAR(274) + DELTA * COS(PAR(276) / RGBL(6))
              PAR(275) = PAR(275) + DELTA * SIN(PAR(276) / RGBL(6))
              CALL PLA280 ('SCAL')
            CASE (24)
              IPR(527) = MOD (IPR(527) + 1, 2)
            CASE (25)
              IPR(608) = MOD (IPR(608) + 1, 2)
              CALL PLA280 ('FROM')
            CASE (29)
              IPR(652) = MENUH - 1
              CALL PLA280 ('NPP')
            CASE (30)
              IPR(357) = MOD (IPR(357) + 1, 2)
              LRET = 3
            CASE (31)
              WRITE (IGGT, 99972, IOSTAT = IOST) MENUH * 0.01
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 14
        CASE (14)
          SELECT CASE (MMODE)
            CASE (1)
              PAR(349) = 0.20 + MENUH * 0.05
              IPR(201) = 0
              LRET = 3
            CASE (2, 3, 5, 6)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('ARU RESTORE')
              ELSE
                WRITE (IGGT(1:14), 99971, IOSTAT = IOST) MENUH - 1
              END IF
              IPR(140) = MENUH - 1
            CASE (4)
              IF (IPR(63) .EQ. 0) THEN
                CALL PLA280 ('LABEL ARU')
              ELSE
                CALL PLA280 ('UNLABEL ARU')
              END IF
            CASE (7)
              IF (MENUH .EQ. 1) THEN
                PAR(18) = SIGN (1.0, PAR(18))
              ELSE
                PAR(18) = SIGN (1.333, PAR(18))
              END IF
            CASE (8)
              IPR(211) = 1
              LRET     = 3
            CASE (9)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('LIST ATOMS')
              ELSE
                CALL PLA280 ('LIST UIJ')
              END IF
            CASE (10)
              IF (IPR(30) .EQ. 0) THEN
                CALL PLA066
                IF (IPR(2) .NE. 0) RETURN
              END IF
              IPR(220) = 2
              IPR(221) = 0
              CALL PLA072 (1, 1)
            CASE (11)
              IF (IPR(30) .EQ. 0) IGBL(33) = MOD(IGBL(33) + 1, 2)
              LRET = -1
            CASE (12)
              IGBL(57) = MOD(IGBL(57) + 1, 2)
              LRET = -1
            CASE (15)
              CALL PLA280 ('RR 4')
            CASE (16)
              IPR(331) = MOD (IPR(331) + 1, 2)
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('HDIF')
              ELSE
                CALL PLA280 ('HFIX')
                IF (IPR(351) .EQ. 1) CALL PLA015 (351, 1)
              END IF
            CASE (18)
              CALL PLA280 ('RPLUTO')
            CASE (22)
              IF (MENUH .GT. 3) THEN
                DELTA = (MENUH - 3) * 0.5
              ELSE
                DELTA = (MENUH - 4) * 0.5
              END IF
              PAR(275) = PAR(275) + DELTA * COS(PAR(276) / RGBL(6))
              PAR(274) = PAR(274) - DELTA * SIN(PAR(276) / RGBL(6))
              CALL PLA280 ('SCAL')
            CASE (24)
              IPR(528) = MOD (IPR(528) + 1, 2)
            CASE (25)
            CASE (30)
              IPR(359) = MOD (IPR(359) + 1, 2)
            CASE (31)
              WRITE (IGGT, 99970, IOSTAT = IOST) MENUH * 0.05
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 15
        CASE (15)
          SELECT CASE (MMODE)
            CASE (1)
              CALL PLA015 (327, 1)
              IPR(440) = 0
              IPR(349) = 0
              IPR(328) = 0
              LRET = -1
            CASE (2)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('JOIN RADII INTER HBONDS')
              ELSE
                CALL PLA280 ('JOIN RADII INTER XBONDS')
              END IF
            CASE (3)
              IF (IABS(IGBL(8)) .EQ. 2) THEN
                IF (MENUH .EQ. 1) THEN
                  IF (IPR(351) .EQ. 1) CALL PLA015 (351, 1)
                  IF (IPR(335) .EQ. 1) CALL PLA015 (335, 1)
                  CALL PLA015 (332, 1)
                  IF (IGBL(75) .EQ. 0) THEN
                    CALL PLA280 ('LABEL ON')
                  ELSE
                    LRET = -1
                  END IF
                ELSE IF (MENUH .EQ. 2) THEN
                  CALL PLA015 (352, 1)
                  IF (IGBL(3) .EQ. 26) LRET = -1
                END IF
              ELSE
                IF (MENUH .EQ. 1) THEN
                  CALL PLA015 (427, 30)
                ELSE
                  CALL PLA015 (427, 44)
                END IF
                LRET = -1
              END IF
            CASE (4)
              IF (IPR(339) .EQ. 0) THEN
                CALL PLA280 ('LABEL UNIT')
                IPR(46) = 1
              ELSE
                CALL PLA280 ('UNLABEL UNIT')
              END IF
            CASE (7)
              IGBL(101) = MENUH - 1
              CALL PLA280 ('PLOT POV')
              IPR (340) = 1
              IGBL(98)  = 0
            CASE (8)
              IPR(177) = MENUH - 1
              IPR(211) = 2
              LRET = 3
            CASE (9)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('LIST FLAGS')
              ELSE
                CALL PLA280 ('LIST RADII')
              END IF
            CASE (10)
              IF (IPR(30) .EQ. 0) THEN
                CALL PLA066
                IF (IPR(2) .NE. 0) RETURN
              END IF
              IPR(220) = 2
              IPR(221) = 0
              CALL PLA073 (2, 1)
            CASE (11)
              IGBL(121) = MOD (IGBL(121) + 1, 2)
              LRET = -1
            CASE (12)
              IGBL(74) = MOD (IGBL(74) + 1, 2)
              LRET = -1
            CASE (14)
              IPR(468) = MOD (IPR(468) + 1, 2)
              LRET     = 3
            CASE (15)
              CALL PLA280 ('RR 5')
            CASE (16)
              IPR(388) = MOD (IPR(388) + 1, 2)
            CASE (17)
              WRITE (IGGT(1:16), 99991, IOSTAT = IOST) MENUH - 1
            CASE (18)
              CALL PLA280 ('CONTOUR PT')
            CASE (19)
              IGBL(74) = MOD (IGBL(74) + 1, 2)
              LRET = -1
            CASE (22)
              IF (MENUH .GT. 3) THEN
                ZROT = (MENUH - 3) * 30.0
              ELSE
                ZROT = (MENUH - 4) * 30.0
              END IF
              WRITE (IGGT, 99990, IOSTAT = IOST) ZROT
            CASE (24)
              IPR(529) = MOD (IPR(529) + 1, 2)
              LRET     = 4
            CASE (25)
              IPR(394) = MENUH
              CALL PLA280 ('ZONE')
            CASE (29)
              IPR(593) = MOD (IPR(593) + 1, 2)
              CALL PLA280 ('SLOPE')
            CASE (31)
              WRITE (IGGT, 99976, IOSTAT = IOST) (MENUH - 1) * 0.01
            CASE (32)
              CALL PLA280 ('SCATTER')
            CASE (34)
              CALL PLA280 ('SCATTER')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 16
        CASE (16)
          SELECT CASE (MMODE)
            CASE (1)
              CALL PLA015 (328, 1)
              IGBL(75) = 1
              IPR(440) = 0
              IPR(349) = 0
              IPR(327) = 0
            CASE (2)
              MNH(7) = MENUH
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('ARU NONE 1555')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('ARU UNIQUE')
              ELSE
                WRITE (IGGT(1:46), 99969, IOSTAT = IOST)
     1            0.45 - DX, 0.55 + DX, 0.45 - DX, 0.55 + DX,
     2            0.45 - DX, 0.55 + DX
              END IF
            CASE (3)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('VIEW UNIT')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('VIEW MIN')
              ELSE IF (MENUH .EQ. 3) THEN
                CALL PLA280 ('VIEW XO')
              ELSE IF (MENUH .EQ. 4) THEN
                CALL PLA280 ('VIEW YO')
              ELSE IF (MENUH .EQ. 5) THEN
                CALL PLA280 ('VIEW ZO')
              END IF
              MNH(6) = MENUH
            CASE (4)
              IF (IPR(452) .EQ. 0) THEN
                CALL PLA280 ('LABEL ATOM')
              ELSE
                CALL PLA280 ('UNLABEL ATOM')
              END IF
            CASE (7)
              IPR(71) = MOD (IPR(71) + 1, 2)
            CASE (8)
              IF (IPR(683) .EQ. 0) THEN
                IPR(350) = MOD (IPR(350) + 1, 2)
                IPR(201) = 0
                LRET     = 4
              ELSE
                LRET = -1
              END IF
            CASE (9)
              LRET = 1
              CALL PLA280 ('LIST ARU')
            CASE (10)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('LIST FLAGS')
              ELSE
                CALL PLA280 ('LIST RADII')
              END IF
              LRET = 2
            CASE (11)
              IPR(597) = MOD (IPR(597) + 1, 2)
            CASE (12)
              IGBL(62) = MENUH
              WRITE (IGGT, 99988, IOSTAT = IOST) IGBL(62) / 4.0
              LRET = 2
            CASE (14)
              IPR(132) = MENUH - 1
              LRET = 3
            CASE (15)
              CALL PLA280 ('RR 6')
            CASE (16)
              IGBL(75) = MOD (IGBL(75) + 1, 2)
            CASE (17)
              WRITE (IGGT(1:17), 99989, IOSTAT = IOST)  MENUH - 1
            CASE (18)
              CALL PLA280 ('CONTOUR DF')
            CASE (22)
              CALL PLA015 (458, 1)
              LRET = 2
            CASE (24)
              IPR(532) = MOD (IPR(532) + 1, 2)
            CASE (25)
              IF (MENUH .EQ. 1) THEN
                IPR(389) = 1
              ELSE
                IPR(389) = -1
              END IF
              CALL PLA280 ('NEXT')
            CASE (30)
              IF (MENUH .GT. 1) THEN
                IPR(354) = MENUH - 1
              ELSE
                IPR(354) = -1
              END IF
              LRET = 3
            CASE (32)
              IF (IPR(633) .EQ. 0) THEN
                CALL PLA280 ('LOGLOG')
              ELSE IF (IPR(633) .EQ. 1) THEN
                CALL PLA280 ('LINEAR')
              END IF
            CASE (34)
              IF (IPR(633) .EQ. 0) THEN
                CALL PLA280 ('LOGLOG')
              ELSE IF (IPR(633) .EQ. 1) THEN
                CALL PLA280 ('LINEAR')
              END IF
            CASE DEFAULT
             LRET = -1
          END SELECT
C * MENU BOX # 17
        CASE (17)
          SELECT CASE (MMODE)
            CASE (1, 8, 9)
              IPR(140) = MENUH - 1
              IPR(201) = 0
              LRET     = 4
            CASE (2, 3, 4, 5, 6)
              IF (IGBL(75) .EQ. 1) THEN
                IF (MENUH .NE. IPR(232) + 1) IGBL(75) = 0
              END IF
              IF (MENUH .EQ. 2) THEN
                IPR(232) = 1
              ELSE
                IPR(232) = 0
              END IF
              IF (IGBL(75) .EQ. 0) THEN
                CALL PLA280 ('LABEL ON')
              ELSE
                CALL PLA280 ('LABEL OFF')
              END IF
            CASE (7)
              CALL PLA280 ('PORTRAIT')
            CASE (10)
              IF (IPR(30) .EQ. 0) THEN
                IPR(605) = 1
                CALL PLA280 ('EXCLUDE H')
                LRET = 2
              END IF
            CASE (11)
              PAR(7) = 2.0 + MENUH
              WRITE (BCD, 99977, IOSTAT = IOST) PAR(7), CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
              LRET = -1
            CASE (12)
              CALL PLA280 ('PORTRAIT')
              LRET = 2
            CASE (13)
              CALL PLA280 ('CANDP')
            CASE (15)
              CALL PLA280 ('RR 7')
            CASE (16)
              PAR(325) = 1.0 + (MENUH - 1) * 0.25
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('PLUTON')
              ELSE
                CALL PLA280 ('RENAME')
              END IF
            CASE (18)
              CALL PLA280 ('CONTOUR FO')
            CASE (19)
              IGBL(122) = MOD (IGBL(122) + 1, 2)
              LRET = -1
            CASE (22)
              IF (MENUH .EQ. IPR(232) + 1)
     1          IGBL(75) = MOD(IGBL(75) + 1, 2)
              IF (MENUH .EQ. 2) THEN
                IPR(232) = 1
                IPR(201) = 0
              ELSE
                IPR(232) = 0
              END IF
              LRET = 2
            CASE (24)
              IF (MENUH .EQ. IPR(232) + 1)
     1               IGBL(75) = MOD(IGBL(75) + 1, 2)
              IF (MENUH .EQ. 2) THEN
                IPR(232) = 1
              ELSE
                IPR(232) = 0
              END IF
            CASE (25)
              IPR(575) = MOD (IPR(575) + 1, 2)
              LRET = -1
            CASE (29)
              IPR(613) = 1
              IPR(617) = 0
              PAR(488) = MENUH * 5
              CALL PLA280 ('NUVAL')
            CASE (30)
              IPR(356) = MOD (IPR(356) + 1, 2)
            CASE (32)
              IPR(634) = MOD (IPR(634) + 1, 2)
               CALL PLA280 ('STANDARD')
            CASE DEFAULT
             LRET = -1
          END SELECT
C * MENU BOX # 18
        CASE (18)
          SELECT CASE (MMODE)
            CASE (1)
              IPR(479) = 2
              PAR(389) = ANGC
              IPR(201) = 0
              LRET     = 6
            CASE (2, 3)
              WRITE (IGGT(1:20), 99986, IOSTAT = IOST) ANGC
            CASE (4)
              IF (MENUH .EQ. 1) THEN
                IFL(1)   = 'DEFINE'
                IFL(2)   = 'CG'
                LMOD     = 2
                IPR(507) = 1
                CALL PLA015 (508, 2)
                LRET     = -1
              ELSE IF (MENUH .EQ. 2) THEN
                IF (IPR(508) .EQ. 2) THEN
                  IPR(507) = 2
                  IPR(508) = 0
                  WRITE (IGGT, 99995, IOSTAT = IOST)
     1              (IFL(I), I = 1, LMOD)
                  IGBL(6) = IABS(IGBL(6))
                END IF
              END IF
            CASE (6)
              CALL PLA280 ('ENTRY')
            CASE (7)
              WRITE (IGGT, 99987, IOSTAT = IOST)
            CASE (8)
              PAR(85) = MENUH
              LRET    = 4
            CASE (9)
              WRITE (IGGT, 99987, IOSTAT = IOST)
            CASE (10)
              IF (IABS(IGBL(8)) .EQ. 2) THEN
                RGBL(26) = MENUH  * 0.20
                WRITE (BCD, 99979, IOSTAT = IOST)
     1            RGBL(26), RGBL(27), CHAR(0)
                CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
              END IF
              LRET = -1
            CASE (11)
              IPR(603) = MOD (IPR(603) + 1, 2)
              LRET     = -1
            CASE (12)
              IWIN = 1
              PAR(540) = 0.45 + MENUH * 0.05
              IPR(221) = 1
              FN(1)    = 540
              CALL PLA206 (-1, 'PAR')
              LRET = -1
            CASE (13)
              IGBL(6) = 1
              CALL PLA280 ('PLOT ADP COLOR')
            CASE (14)
              IF (MENUH .EQ. 1) THEN
                IPR(389) = 1
              ELSE
                IPR(389) = -1
              END IF
              LRET = 4
            CASE (15)
              CALL PLA280 ('RR 8')
            CASE (16)
              WRITE (IGGT(1:20), 99985, IOSTAT = IOST) ANGC
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('PLATON')
              ELSE
                CALL PLA280 ('PLATON ADP')
              END IF
            CASE (18)
              CALL PLA280 ('CONTOUR SQ')
            CASE (19)
              WRITE (IGGT, 99987, IOSTAT = IOST)
            CASE (21)
              IPR(650) = MOD(IPR(650) + 1, 2)
              LRET     = 3
            CASE (22)
              PAR(278)  = 0.1 * MENUH
              LRET = 2
            CASE (23)
              PAR(278) = 0.1 * MENUH
              LRET = 2
            CASE (24)
              PAR(349) = 0.20 + MENUH * 0.05
            CASE (25)
              IPR(571) = MOD (IPR(571) + 1, 2)
              LRET = -1
            CASE (26)
              IPR(566) = MOD (IPR(566) + 1, 2)
              LRET     = -1
            CASE (29)
              IPR(613) = MOD (IPR(613) + 1, 2)
              PAR(488) = 0.0
              IPR(617) = 1
              CALL PLA280 ('SWITCH')
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 19
        CASE (19)
          SELECT CASE (MMODE)
            CASE (1, 9)
              IPR(479) = 3
              IF (MENUH .GT. 5) THEN
                PAR(389)  = 2 ** (MENUH - 6)
              ELSE
                PAR(389)  =  - 2 ** (5 - MENUH)
              END IF
              IPR(201) = 0
              LRET     = 2
            CASE (7)
              IGBL(69) = MOD(IGBL(69) + 1, 2)
              YGGIP    = - 100 * (IGBL(69) + 1)
              CALL GGIP (0.0, YGGIP, 0.0, 0)
            CASE (8)
              PAR(89) = MENUH
              LRET    = 4
            CASE (10)
              IF (IABS(IGBL(8)) .EQ. 2) THEN
                RGBL(27) = (MENUH - 1) * 0.25
                WRITE (BCD, 99979, IOSTAT = IOST)
     1            RGBL(26), RGBL(27), CHAR(0)
                CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
              END IF
              LRET   = -1
            CASE (11)
              IPR(645) = MOD(IPR(645) + 1, 2)
            CASE (12)
              IPR(647) = MOD(IPR(647) + 1, 2)
            CASE (13)
              IPR(55) = -1
              CALL PLA280 ('YES')
            CASE (15)
              CALL PLA280 ('RR 9')
            CASE (16)
              IF (MENUH .GT. 5) THEN
                IANG  = 2 ** (MENUH - 6)
              ELSE
                IANG  =  - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:9), 99996, IOSTAT = IOST) 'Z', IANG
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('INVERT')
              ELSE
                CALL PLA280 ('HFREE')
              END IF
            CASE (19)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('ANIS')
              ELSE IF (MENUH .EQ. 2) THEN
              END IF
            CASE (21)
              CALL PLA280 ('LIST')
            CASE (22)
              IPR(419)  = NINT(2.5 * 2 ** MENUH)
              LRET = 2
            CASE (24)
              IPR(479) = 3
              IF (MENUH .GT. 5) THEN
                PAR(389) = 2 ** (MENUH - 6)
              ELSE
                PAR(389) =  - 2 ** (5 - MENUH)
              END IF
              LRET = 3
            CASE (25)
              IPR(572)  = MOD (IPR(572) + 1, 2)
              LRET      = -1
            CASE (26)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('CALC ADDSYM PART 1')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('CALC ADDSYM PART 2')
              END IF
            CASE (30)
              IF (MENUH .GT. 5) THEN
                IANG  = 2 ** (MENUH - 6)
              ELSE
                IANG  =  - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:9), 99996, IOSTAT = IOST) 'Z', IANG
            CASE DEFAULT
              IF (MENUH .GT. 5) THEN
                IANG  = 2 ** (MENUH - 6)
              ELSE
                IANG  =  - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:18), 99984, IOSTAT = IOST) IANG
          END SELECT
C * MENU BOX # 20
        CASE (20)
          SELECT CASE (MMODE)
            CASE (1, 9)
              IPR(479) = 2
              IF (MENUH .GT. 5) THEN
                PAR(389)  = 2 ** (MENUH - 6)
              ELSE
                PAR(389)  =  - 2 ** (5 - MENUH)
              END IF
              IPR(201) = 0
              LRET     = 2
            CASE (7)
              RGBL(25) = (MENUH - 1) * 0.25
              CALL PLA280 ('RESET')
            CASE (8)
              PAR(86) = MENUH * 0.01
              PAR(88) = MENUH * 0.01
              PAR(90) = MENUH * 0.01
              LRET = 4
            CASE (10)
              IF (MENUH .EQ. 1) THEN
                IGBL(95) = MOD (IGBL(95) + 1, 2)
                RGBL(25) = RGBL(27)
              ELSE IF (MENUH .EQ. 2) THEN
                IGBL(95) = 1
              END IF
              CALL PLA280 ('RESTART')
              LRET = 2
            CASE (11)
              IF (IABS(IGBL(8)) .EQ. 2) THEN
                RGBL(25) = (MENUH - 1) * 0.25
                CALL PLA280 ('RESTART')
                LRET = 2
              ELSE
                LRET = -1
              END IF
            CASE (12)
              MNH(12) = MENUH
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('SET META PS')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('SET META HPGL')
              END IF
              LRET = 2
            CASE (13)
              IPR(55) = 2
              CALL PLA280 ('YES')
            CASE (16)
              IF (MENUH .GT. 5) THEN
                IANG  = 2 ** (MENUH - 6)
              ELSE
                IANG  =  - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:9), 99996, IOSTAT = IOST) 'Y', IANG
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('ASYM')
              ELSE
                CALL PLA280 ('ASYM VIEW')
              END IF
            CASE (18)
              CALL PLA280 ('BROWSE PS')
            CASE (19)
              LRET = -1
            CASE (21)
              IPR(649) = MOD (IPR(649) + 1, 2)
              IPR(569) = 0
              IPR(570) = 0
              LRET     = 3
            CASE (22)
              STRING(1:3) = 'CL '
              NCNT = 3
              SBCD = STRING(1:NCNT)//CHAR(0)
              LRET = -1
            CASE (24)
              IPR(479) = 2
              IF (MENUH .GT. 5) THEN
                PAR(389) = 2 ** (MENUH - 6)
              ELSE
                PAR(389) =  - 2 ** (5 - MENUH)
              END IF
              LRET = 3
            CASE (25)
              IPR(573)  = MOD (IPR(573) + 1, 2)
              LRET = -1
            CASE (26)
              CALL PLA280 ('CALC ADDSYM EQUAL')
            CASE (30)
              IF (MENUH .GT. 5) THEN
                IANG  = 2 ** (MENUH - 6)
              ELSE
                IANG  =  - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:9), 99996, IOSTAT = IOST) 'Y', IANG
            CASE (34)
              CALL PLA280 ('REDUCED')
            CASE DEFAULT
              IF (MENUH .GT. 5) THEN
                IANG  = 2 ** (MENUH - 6)
              ELSE
                IANG  =  - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:18), 99983, IOSTAT = IOST) IANG
          END SELECT
C * MENU BOX # 21
        CASE (21)
          SELECT CASE (MMODE)
            CASE (1, 9)
              IPR(479) = 1
              IF (MENUH .GT. 5) THEN
                PAR(389)  = 2 ** (MENUH - 6)
              ELSE
                PAR(389)  =  - 2 ** (5 - MENUH)
              END IF
              IPR(201) = 0
              LRET     = 2
            CASE (7)
              IPR(166) = MOD(IPR(166) + 1, 2)
              IPR(130) = 0
              CALL PLA280 ('PLOT')
            CASE (8)
              PAR(86) = MENUH * 0.01
              LRET = 4
          CASE (10)
              CALL PLA280 ('HELP')
              LRET = 2
            CASE (12)
              IGBL(35) = MOD(IGBL(35) + 1, 2)
              LRET = -1
            CASE (13)
              IPR(55) = 1
              CALL PLA280 ('YES')
            CASE (16)
              IF (MENUH .GT. 5) THEN
                IANG =   2 ** (MENUH - 6)
              ELSE
                IANG = - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:9), 99996, IOSTAT = IOST) 'X', IANG
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('SQUEEZE')
              ELSE
                CALL PLA280 ('FCF')
             END IF
            CASE (18)
              CALL PLA280 ('LASER')
            CASE (19)
              IGBL(124) = MENUH - 1
            CASE (21)
              IPR(569) = MOD (IPR(569) + 1, 2)
              IPR(570) = 0
              IPR(649) = 0
              LRET     = 3
            CASE (22)
              IF (IPR(182) .EQ. 0) THEN
                CALL PLA280 ('OMIT')
                IPR(515) = MENUH - 1
              ELSE
                IPR(505) = MENUH
                IF (MENUH .EQ. 1) THEN
                  CALL PLA280 ('XROT 10')
                ELSE IF (MENUH .EQ. 2) THEN
                  CALL PLA280 ('YROT 10')
                ELSE
                  CALL PLA280 ('ZROT 10')
                END IF
              END IF
            CASE (24)
              IPR(479) = 1
              IF (MENUH .GT. 5) THEN
                PAR(389) = 2 ** (MENUH - 6)
              ELSE
                PAR(389) =  - 2 ** (5 - MENUH)
              END IF
              LRET = 3
            CASE (25)
              IPR(574)  = MOD (IPR(574) + 1, 2)
              LRET = -1
            CASE (26)
              IF (MENUH .EQ. 1) THEN
                NQ1 = ' '
              ELSE
                NQ1 = LMT(MENUH - 1, 1)
              END IF
              CALL PLA280 ('CALC ADDSYM '//NQ1)
            CASE (30)
              IF (MENUH .GT. 5) THEN
                IANG =   2 ** (MENUH - 6)
              ELSE
                IANG = - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:9), 99996, IOSTAT = IOST) 'X', IANG
            CASE (31)
              IPR(640) = MOD(IPR(640) + 1, 2)
            CASE DEFAULT
              IF (MENUH .GT. 5) THEN
                IANG  =   2 ** (MENUH - 6)
              ELSE
                IANG  =  - 2 ** (5 - MENUH)
              END IF
              WRITE (IGGT(1:18), 99982, IOSTAT = IOST) IANG
          END SELECT
C * MENU BOX # 22
        CASE (22)
          SELECT CASE (MMODE)
            CASE (1)
              IGBL(58) = 0
              REWIND LU2
              IF (MENUH .EQ. 1) THEN
                IGBL(54) = MAX (1, IGBL(54) - 1)
                IF (IGBL(54) .GT. 1) IGBL(58) = 1
                WRITE (IGGT, 99981, IOSTAT = IOST) IGBL(54)
              ELSE
                IF (IGBL(54) .LT. IGBL(100)) THEN
                  IGBL(54) = MAX (1, MIN (IGBL(54) + 1, IGBL(100)))
                  WRITE (IGGT, 99981, IOSTAT = IOST) IGBL(54)
                ELSE
                  IGBL(45) = 0
                  CALL PLA280 ('REM')
                  IGBL(6) = 10
                  CALL GEN108 (LU3, 0)
                  WRITE (LU3, 99980, IOSTAT = IOST)
                  ENDFILE LU3
                END IF
              END IF
            CASE (3)
              CALL PLA015 (213, 1)
              IF (IPR(213) .EQ. 1) THEN
                IF (IPR(63) .EQ. 0) THEN
                  CALL PLA280 ('LABEL ARU')
                ELSE
                  LRET = -1
                END IF
              ELSE
                CALL PLA280 ('UNLABEL ARU')
              END IF
              IF (IGBL(35) .EQ. 0) LRET = -1
            CASE (2, 4, 5, 6)
   20         IPR(346) = MOD(IPR(346) + 1, 2)
              IF (IPR(346) .EQ. 1) THEN
                IF (MENUH .EQ. 1) THEN
                  IPR(477) = 0
                ELSE IF (MENUH .EQ. 2) THEN
                  IPR(477) = -1
                ELSE
                  IPR(477) = 1
                END IF
              ELSE
                IF (MENUH * IPR(477) .EQ. -2 .OR.
     1          MENUH * IPR(477) .EQ. 3 .OR.
     2             (MENUH  .EQ. 1 .AND. IPR(477) .EQ. 0)) THEN
                  IPR(477) = 0
                ELSE
                  GO TO 20
                END IF
              END IF
              IF (IGBL(35) .EQ. 1) THEN
                CALL PLA280 ('PLOT')
              ELSE
                LRET = -1
              END IF
            CASE (7)
              IGBL(127) = MOD(IGBL(127) + 1, 2)
            CASE (8)
              PAR(90) = MENUH * 0.01
              LRET = 4
            CASE (9)
                IGBL(104) = MOD(IGBL(104) + 1, 2)
            CASE (10)
              IGBL(58) = 0
              IF (MENUH .EQ. 1) THEN
                IGBL(54) = MAX (1, IGBL(54) - 1)
                IF (IGBL(54) .GT. 1) IGBL(58) = 1
              ELSE IF (MENUH .EQ. 2) THEN
                IGBL(54) = MAX (1, MIN (IGBL(54) + 1, IGBL(100)))
              END IF
              IPR(220) = 0
              IPR(221) = 1
              FN(1) = IGBL(54)
              CALL PLA009
              IGBL(24) = 0
              CALL PLA280 ('END')
              LRET = 3
            CASE (11)
              IF (IPR(30) .EQ. 0) PAR(27) = (MENUH - 3) * 0.2
              WRITE (BCD, 99978, IOSTAT = IOST) PAR(2), PAR(27), CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
              LRET = -1
            CASE (12)
              IGBL(69) = MOD(IGBL(69) + 1, 2)
              YGGIP = - 100 * (IGBL(69) + 1)
              CALL GGIP (0.0, YGGIP, 0.0, 0)
            CASE (13)
              IPR(346) = MOD(IPR(346) + 1, 2)
              CALL PLA280 ('REF')
            CASE (16)
              CALL PLA280 ('NEXT')
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('PLATON ADDSYM')
              ELSE
                CALL PLA280 ('PLATON SOLV')
              END IF
            CASE (18)
              IF (IGBL(43) .EQ. 1) IGBL(42) = 1
              IGBL(42) = MOD(IGBL(42) + 1, 2)
              IGBL(43) = 0
              CALL PLA280 ('BROWSE LPS')
            CASE (19)
              CALL PLA280 ('CGLS')
            CASE (21)
              IPR(570) = MOD (IPR(570) + 1, 2)
              IPR(569) = 0
              IPR(649) = 0
              LRET     = 3
            CASE (22)
              IF (IPR(415) .GT. 0) THEN
                IPR(182) = MOD(IPR(182) + 1, 2)
                IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
                  IF (IPR(182) .NE. 0) THEN
                    BCD = 'Click on Unique Atoms to be Omitted'//CHAR(0)
                    CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68) * IGBL(82)),
     1                     30.0, 110)
                    CALL GGIP (0.0, 0.0, 0.0, 6)
                    LRET = -1
                  ELSE
                    LRET = 2
                  END IF
                END IF
              ELSE
                LRET = -1
              END IF
            CASE (24)
              IPR(346) = MOD(IPR(346) + 1, 2)
            CASE (25)
              PAR(415) = MENUH * 0.1
              CALL PLA280 ('CALC')
            CASE (26)
              CALL PLA280 ('CALC ADDSYM EXACT')
            CASE (29)
              IPR(636) = MOD(IPR(636) + 1, 2)
            CASE DEFAULT
              LRET = -1
            CASE (31)
              CALL PLA280 ('SHOW')
          END SELECT
C * MENU BOX # 23
        CASE (23)
          SELECT CASE (MMODE)
            CASE (1)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
              LRET = 3
            CASE (2, 5, 6)
              IF (IGBL(103) .EQ. 1) THEN
                CALL PLA280 ('BOX OFF')
              ELSE
                CALL PLA280 ('BOX ON')
              END IF
            CASE (3)
              CALL GEN038 (IGGT, 1, 80)
              IPR(141) = MOD(IPR(141) + 1, 2)
              IF (IPR(141) .EQ. 1) THEN
                CALL PLA280 (
     1           'OMIT OUTSIDE -0.1 1.1 -0.1 1.1 -0.1 1.1')
              ELSE
                CALL PLA280 ('OMIT OUTSIDE 0')
              END IF
            CASE (4)
              IF (MENUH .EQ. 1) THEN
                LMOD     = 1
                IFL(1)   = 'DEFINE'
                IPR(507) = 1
                CALL PLA015 (508, 1)
                LRET     = -1
              ELSE IF (MENUH .EQ. 3) THEN
                IF (IPR(508) .NE. 0) THEN
                  IPR(507) = 3
                  IPR(508) = 0
                  WRITE (IGGT, 99995, IOSTAT = IOST)
     1              (IFL(I), I = 1, LMOD)
                  IGBL(6) = IABS(IGBL(6))
                END IF
              END IF
            CASE (7)
              IGBL(58) = 0
              IF (MENUH .EQ. 1) THEN
                IGBL(54) = MAX (1, IGBL(54))
                IF (IGBL(54) .GT. 1) IGBL(58) = 1
              ELSE
                IGBL(54) = IGBL(54) + 1
                IF (IGBL(54) .LT. IGBL(100)) THEN
                  IGBL(54) = MAX (1, MIN (IGBL(54) + 1, IGBL(100)))
                END IF
              END IF
              WRITE (IGGT, 99981, IOSTAT = IOST) IGBL(54)
              IGBL(67) = 0
              LRET = 3
            CASE (8)
              PAR(88) = MENUH * 0.01
              LRET = 4
            CASE (9)
              IF (MENUH .EQ. 1) THEN
                LMOD     = 1
                IFL(1)   = 'LSPL'
                IPR(551) = 1
                CALL PLA015 (552, 1)
                IPR(453) = 0
                IPR(448) = 0
                IPR(460) = 3
                IPR(476) = 0
                LRET     = -1
              ELSE IF (MENUH .EQ. 2) THEN
                IF (IPR(552) .NE. 0 .AND. LMOD .GT. 3) THEN
                  LMOD      = LMOD + 1
                  IPR(551)  = 2
                  IFL(LMOD) = 'WITH'
                END IF
                LRET = -1
              ELSE IF (MENUH .EQ. 3) THEN
                IF (IPR(552) .NE. 0) THEN
                  IPR(551) = 3
                  CALL PLA015 (552, 1)
                  IPR(81)  = - LMOD
                  CALL PLA035 (1)
                  LMOD     = 0
                  IGBL(6) = IABS(IGBL(6))
                ELSE
                  IGBL(6) = 10
                  IF (IABS(IGBL(45)) .NE. 0) THEN
                    CALL PLA280 ('END')
                  ELSE
                    CALL PLA280 ('REM')
                  END IF
                END IF
              END IF
            CASE (10)
              IGBL(45) = MOD(IGBL(45) + 1, 2)
              ISAVEMOD = 1
              CALL GEN108 (LU3, 0)
              LRET = -1
            CASE (11)
              IF (IPR(30) .EQ. 0) PAR(2) = (MENUH - 1) * 0.2
              WRITE (BCD, 99978, IOSTAT = IOST) PAR(2), PAR(27), CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
              LRET = -1
            CASE (12)
              CALL PLA280 ('SET REVERSE')
              LRET = 2
            CASE (13)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
              CALL PLA280 ('REF')
            CASE (14)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
              IPR(389) = 0
              LRET     = 4
            CASE (16)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
            CASE (17)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('VALID')
              ELSE
                CALL PLA280 ('REPORT')
              END IF
            CASE (18)
              IF (IGBL(42) .EQ. 1) IGBL(43) = 1
              IGBL(43) = MOD(IGBL(43) + 1, 2)
              IGBL(42) = 0
              CALL PLA280 ('BROWSE LIS')
            CASE (19)
              CALL PLA280 ('SHELXL')
            CASE (21)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
            CASE (22)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
              LRET = 2
            CASE (24)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
            CASE (25)
              PAR(420) = MENUH * 0.05
              CALL PLA280 ('CALC')
            CASE (26)
              CALL PLA280 ('CALC ADDSYM PLOT')
            CASE (28)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
            CASE (29)
              IPR(634) = MOD(IPR(634) + 1, 2)
            CASE (30)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
              LRET = 3
            CASE (31)
              CALL PLA280 ('CONTINUE')
            CASE (33)
              IGBL(103) = MOD(IGBL(103) + 1, 2)
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 24
        CASE (24)
          SELECT CASE (MMODE)
            CASE (1)
              IPR(346) = MENUH - 1
              CALL PLA015 (0, 0)
              MEDIUM      = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              LRET = 3
            CASE (3)
              IGBL(128) = MOD(IGBL(128) + 1, 2)
              IPR(130) = 0
              CALL PLA280 ('PLOT')
            CASE (2, 5, 6)
              IF (MENUH .EQ. 1) THEN
                CALL PLA015 (0, 0)
                MEDIUM      = 2
                IGGT(16:22) = 'ON     '
                CALL GGIP (-999.0, 0.0, 0.0, 6)
                CALL PLA280 ('PLOT')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('PLOT POV')
                IPR (340) = 1
                IGBL(98)  = 0
              ELSE IF (MENUH .EQ. 3) THEN
                IPR (340) = 1
                CALL PLA280 ('PLOT PDB')
              END IF
            CASE (4)
              CALL PLA015 (311, MENUH)
              LRET = -1
            CASE (7)
              CALL PLA015 (462, 1)
              IF (IPR(462) .EQ. 1) THEN
                CALL PLA280 ('ENTRY')
              ELSE
                WRITE (IGGT, 99981, IOSTAT = IOST) IGBL(54)
              END IF
            CASE (8)
              PAR(48) = (MENUH - 1) * 0.125
              LRET    = 4
            CASE (9)
              IF (MENUH .EQ. 1) THEN
                LMOD     = 1
                IFL(1)   = 'LSPL'
                IPR(460) = 1
                CALL PLA015 (476, 1)
                IPR(453) = 0
                IPR(448) = 0
                IPR(551) = 3
                IPR(552) = 0
                LRET     = -1
              ELSE IF (MENUH .EQ. 2) THEN
                IF (IPR(476) .NE. 0 .AND. LMOD .GT. 3) THEN
                  LMOD      = LMOD + 1
                  IPR(460)  = 2
                  IFL(LMOD) = 'DIST'
                END IF
                LRET = -1
              ELSE IF (MENUH .EQ. 3) THEN
                IF (IPR(476) .NE. 0) THEN
                  IPR(460) = 3
                  CALL PLA015 (476, 1)
                  IPR(81)  = - LMOD
                  CALL PLA035 (1)
                  LMOD     = 0
                  IGBL(6) = IABS(IGBL(6))
                ELSE
                  IGBL(6) = 10
                  IF (IABS(IGBL(45)) .NE. 0) THEN
                    CALL PLA280 ('END')
                  ELSE
                    CALL PLA280 ('REM')
                  END IF
                END IF
              END IF
            CASE (10)
              CALL PLA015 (462, 1)
              IF (IPR(462) .EQ. 1) THEN
                CALL PLA280 ('ENTRY')
              ELSE
                WRITE (IGGT, 99981, IOSTAT = IOST) IGBL(54)
              END IF
              LRET = 2
            CASE (12)
              IGBL(47) = - IGBL(47)
              IPR(590) = MOD (IPR(590) + 1, 2)
              CALL PLA280 ('REM')
              IGBL(6) = 10
              LRET = 2
            CASE (13)
              IPR(346) = MENUH - 1
              CALL PLA015 (0, 0)
              MEDIUM = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              CALL PLA280 ('REF')
            CASE (16)
              CALL PLA280 ('CALC')
            CASE (17)
              CALL PLA280 ('RENUM')
            CASE (18)
              CALL PLA280 ('PRUNE')
            CASE (19)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('LRES')
              ELSE
                CALL PLA280 ('SHXLPS')
              END IF
            CASE (20)
              CALL PLA280 ('NEXT')
            CASE (21)
              MEDIUM = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
            CASE (22)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('UP')
              ELSE
                CALL PLA280 ('DOWN')
              END IF
            CASE (24)
              MEDIUM      = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
            CASE (25)
              CALL PLA280 ('HKLF')
            CASE (26)
              CALL PLA280 ('CALC ADDSYM SHELX NOSF')
            CASE (28)
              MEDIUM = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
            CASE (29)
              MEDIUM = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              IF (IPR(621) .EQ. 1) THEN
                CALL PLA280 ('NPP')
                IPR(621) = -1
              END IF
            CASE (30)
              IPR(346) = MENUH - 1
              CALL PLA015 (0, 0)
              MEDIUM      = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              LRET = 3
            CASE (31)
              CALL PLA280 ('CONVERGE')
            CASE (32)
              MEDIUM = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              CALL PLA280 ('PLOT')
              LRET = 2
            CASE (33)
              MEDIUM = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
            CASE (34)
              MEDIUM = 2
              IGGT(16:22) = 'ON     '
              CALL GGIP (-999.0, 0.0, 0.0, 6)
              CALL PLA280 ('PLOT')
              LRET = 2
            CASE DEFAULT
              LRET = -1
          END SELECT
C * MENU BOX # 25
        CASE (25)
          SELECT CASE (MMODE)
            CASE (1, 8, 9)
              IF (MENUH .EQ. 1) THEN
                LRET = 1
                CALL PLA280 ('PLUTON')
                IPR(327) = 0
                IPR(328) = 0
                IPR(349) = 0
                IPR(440) = 0
              ELSE IF (MENUH .EQ. 2) THEN
                LRET = 1
                IF (IABS(IGBL(45)) .NE. 0) THEN
                  IF (IPR(308) .EQ. 2) THEN
                    CALL PLA280 ('EXIT')
                    LRET = 7
                  ELSE
                    CALL PLA280 ('END')
                  END IF
                  IPR(351) = 0
                ELSE
                  CALL PLA280 ('REM')
                END IF
              END IF
            CASE (2, 3, 4, 5, 6, 7)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('RESET')
              ELSE IF (MENUH .EQ. 2) THEN
                IGBL(24) = 0
                CALL PLA280 ('END')
                IGBL(67) = 0
                LRET     = 3
              END IF
            CASE (10, 11, 12)
              IF (MENUH .EQ. 1) THEN
                CALL PLA011 (0)
                LRET = 2
              ELSE IF (MENUH .EQ. 2) THEN
                IGBL(24) = 0
                CALL PLA280 ('END')
                LRET = 3
              END IF
            CASE (13)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('PLUTON')
              ELSE IF (MENUH .EQ. 2) THEN
                CALL PLA280 ('NO')
              END IF
            CASE (14)
              IF (MENUH .EQ. 1) THEN
                MEDIUM      = 2
                IGGT(16:22) = 'ON     '
                CALL GGIP (-999.0, 0.0, 0.0, 6)
                IPR(389) = 0
              ELSE
                CALL PLA280 ('END')
                LRET = 2
              END IF
            CASE (15)
              CALL PLA280 ('CALC')
            CASE (16)
              IF (MENUH .EQ. 1) THEN
                MEDIUM      = 2
                IGGT(16:22) = 'ON     '
                CALL GGIP (-999.0, 0.0, 0.0, 6)
                CALL PLA280 ('PLOT')
              ELSE
                CALL PLA280 ('END')
              END IF
            CASE (17, 18, 19)
              IF (MENUH .EQ. 1) THEN
                CALL PLA280 ('SKIP')
              ELSE
                CALL PLA280 ('!')
              END IF
            CASE (20)
              CALL PLA280 ('END')
            CASE (21)
              IGBL(6) = 10
              CALL PLA011 (0)
              LRET     = 2
            CASE (22)
              IF (MENUH .EQ. 1) THEN
                MEDIUM      = 2
                IGGT(16:22) = 'ON     '
                CALL GGIP (-999.0, 0.0, 0.0, 6)
                CALL PLA280 ('EPS')
                LRET = 2
              ELSE
                CALL PLA280 ('QUIT')
              END IF
            CASE (24)
              LRET = 2
            CASE (25)
              CALL PLA280 ('END')
            CASE (26)
              CALL PLA280 ('END')
            CASE (27)
              IF (MENUH .EQ. 1) THEN
               CALL PLA280 ('SKIP')
              ELSE
                CALL PLA280 ('!')
              END IF
            CASE (28)
              CALL PLA280 ('END')
            CASE (29)
              CALL PLA280 ('END')
            CASE (30)
              CALL PLA280 ('END')
            CASE (31)
              CALL PLA280 ('END')
            CASE (32)
              CALL PLA280 ('END')
            CASE (33)
              IGBL(6) = 10
              CALL PLA011 (0)
              LRET     = 2
            CASE (34)
              CALL PLA280 ('END')
            CASE DEFAULT
              LRET = -1
          END SELECT
      END SELECT
      RETURN
99999 FORMAT ('>> Labels may be moved by ''clicking'' on them',
     1        ' (When in LabPosOn-Mode)', //)
99998 FORMAT ('CELL', F9.5, 3F9.4, 3F8.2, F12.2, A)
99997 FORMAT ('RCELL ', 3F10.6, 3F9.2, F10.5, A)
99996 FORMAT (A, 'ROT', I5)
99995 FORMAT (10(A, 1X))
99994 FORMAT ('STLM', F10.2, 5X)
99993 FORMAT ('SHELXL ISO', I3, 1X)
99992 FORMAT ('SHELXL ANISO', I3, 1X)
99991 FORMAT ('SHELXL HATOM', I3, 1X)
99990 FORMAT ('ZROT ', F10.2)
99989 FORMAT ('SHELXL WEIGHT', I3, 1X)
99988 FORMAT ('SET WINDOW', F8.2)
99987 FORMAT ('SET REVERSE')
99986 FORMAT ('CROTY COLOR', F8.2)
99985 FORMAT ('CROTY ', F8.2)
99984 FORMAT ('VIEW CUR ZROT', I5)
99983 FORMAT ('VIEW CUR YROT', I5)
99982 FORMAT ('VIEW CUR XROT', I5)
99981 FORMAT ('ENTRY', I6)
99980 FORMAT (80X, /)
99979 FORMAT ('Min. QPeak Height', F6.2, ', Min. QPeak Dist.', F6.2, A)
99978 FORMAT ('TolA =', F6.2, ', TolM =', F6.2, A)
99977 FORMAT ('Coordination Radius =', F6.1, A)
99976 FORMAT ('UISO', F10.3)
99975 FORMAT ('NTRY', I10)
99974 FORMAT ('NLOOP', I10)
99973 FORMAT ('NSOLVE', I10)
99972 FORMAT ('DELTA', F10.3)
99971 FORMAT ('ARU NONE ', I5)
99970 FORMAT ('PERC', F12.3)
99969 FORMAT ('PACK RANGE', 6F6.2)
      END SUBROUTINE PLA016
      SUBROUTINE PLA017
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /GGT/ MEDIUM
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      IF ((IGBL(3) .NE. 1 .AND. IGBL(3) .NE. 33 .AND. IGBL(3) .NE. 34)
     1  .AND. (IGBL(50) .GT. -1 .AND. IGBL(50) .LT. 2))  THEN
        IF (IGBL(3) .EQ. 6 .OR. IGBL(3) .EQ. 47) THEN
          N10 = 1
          N11 = INDEX (FILENAMES(1), '.') - 1
          DO N = 1, N11
            IF (FILENAMES(1)(N:N) .EQ. '/') N10 = N + 1
          END DO
          N20 = 1
          N21 = INDEX (FILENAMES(2), '.') - 1
          DO N = 1, N21
            IF (FILENAMES(2)(N:N) .EQ. '/') N20 = N + 1
          END DO
          NAMEFIL = FILENAMES(1)(N10:N11)//'_'//FILENAMES(2)(N20:N21)
          KNMFIL  = N11 - N10 + N21 - N20 + 3
        END IF
        IGGT(2:80) = NAMEFIL(1:79)
        PAR1       = -999.0
        PAR2       = FLOAT(-KNMFIL)
        CALL GGIP (PAR1, PAR2, 0.0, 5)
        IF (IGBL(3) .EQ. 28 .OR. IGBL(3) .EQ. 47) THEN
          MEDIUM      = 1
          IGGT(16:22) = 'OFF    '
          CALL GGIP (-999.0, 0.0, 0.0, 6)
        END IF
        YGGIP = 0.0
        ZGGIP = 0.0
        CALL GGIP (-999.0, YGGIP, ZGGIP, 8)
        IGBL(32) = NINT(YGGIP)
      END IF
      RETURN
      END SUBROUTINE PLA017
      SUBROUTINE PLA018 (MODE, X, Y, NQ)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31, NP25=99, NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50),  RORO(3, 3), NCIF(NP56)
      CHARACTER NQ*7, NQ1*7
      DELMIN = 100000.0
      IMIN   = 1
      NQ     = '*******'
      NAT    = IPR(39) + IPR(64)
      DO I = 1, NAT
        II = IATC(I)
        IF (II .NE. 0) THEN
          CALL GEN048 (-1, IFG(2, II), 27, ISKP)
          IF (ISKP .EQ. 0) THEN
            IF (IGBL(59) .NE. 0) THEN
              CALL GEN048 (-7, IFG(2, II), 1, IPP)
              NPOP = IPPR(IPP + 1, 1)
              IF (NPOP .LT. 1000) THEN
                IF (IGBL(88) .EQ. 0) THEN
                  IF (NPOP .LT. 500) CYCLE
                ELSE
                  IF (NPOP .GT. 500) CYCLE
                END IF
              END IF
            END IF
            CALL PLA047 (LABA(IATC(I)), NQ1, IDUM, JDUM, 1,
     1        IGBL(55), 0, 0)
            IF (NQ1(1:2) .NE. 'Cg' .OR. IPR(506) .EQ. 1) THEN
              DEL = (XXO(I, 1) - X) ** 2 + (XXO(I, 2) - Y) ** 2
              IF (DEL .LT. DELMIN) THEN
                DELMIN = DEL
                IMIN   = I
              END IF
            END IF
          END IF
        END IF
      END DO
      IF (DELMIN .LT. 0.5) THEN
        IF (MODE .LE. 0) THEN
          IMN = IATC(IMIN)
          CALL PLA047 (LABA(IMN), NQ, IDUM, JDUM, 1, 1, 0, 0)
          IF (MODE .EQ. -1 ) THEN
            IF (IMN .LE. IPR(37)) THEN
              CALL GEN048 (1, IFG(1, IMN), 30, 1)
            ELSE
              CALL PLA015 (427, 28)
              RETURN
            END IF
          END IF
          DSH = 0.15
          XX  = XXO(IMIN, 1)
          YY  = XXO(IMIN, 2)
          CALL GGIP (0.0, 2.0, 0.0, 0)
          CALL GGIP (XX,       YY + DSH, 0.0, 3)
          CALL GGIP (XX + DSH, YY,       0.0, 2)
          CALL GGIP (XX,       YY - DSH, 0.0, 2)
          CALL GGIP (XX - DSH, YY,       0.0, 2)
          CALL GGIP (XX,       YY + DSH, 0.0, 2)
          CALL GGIP (0.0, 0.0, 0.0, 6)
        ELSE
          IMIN = IATC(IMIN)
          CALL GEN048 (1, IFG(2, IMIN), 27, 1)
          IPR(201) = 0
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA018
      SUBROUTINE PLA019 (MODE, IER)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP46=15,
     2 NP52=200,NP56=30,NP57=35)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER DIRC*7
      CHARACTER OPTS*10
      COMMON /CMEN/ OPTS(NP46, 7)
      COMMON /IMEN/ IOPT(NP46, 7)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      LU  = 0
      IER = 0
      IF (MODE .EQ. 0) THEN
        LU = IGBL(5)
        IF (LU .EQ. LU5) THEN
          IF (IGBL(3) .EQ. 0 .AND. IGBL(25) * IGBL(32) .EQ. 1) THEN
            IF (IABS(IGBL(6)) .GE. 10 .AND.
     1          IABS(IGBL(6)) .LE. 12) THEN
              IF (IGBL(6) .LT. 0) GO TO 20
              WRITE (LU6, 99996, IOSTAT = IOST)
C * OPEN MAIN X-WINDOW, GET INPUT FROM MENU/KEYPRESS
              IGBL(72) = 1
   10         BCD(1:12) = 'P.L.A.T.O.N'//CHAR(0)
              VERT = RGBL(1)
              HORS = VERT * RGBL(2)
              CALL GGIP (HORS, VERT, 0.0, 1)
              SIZ  = HORS / 63.0
              LINE = 'P L A T O N'
              CALL GGIP09 (0.0,  LINE, 11, 2.0, 4, 15, 3.7, VERT - 2.4)
              CALL GGIP09 (0.0,  LINE, 11, 2.0, 2, 15, 3.5, VERT - 2.5)
              LINE = 'A Multipurpose Crystallographic Tool'
              CALL GGIP09 (0.0,  LINE, 36, 0.6, 1, 3, 3.9, VERT - 3.5)
              CALL GEN040 (IGBL(4), NQ1, IP)
              LINE =
     1       '(C) 1980-2014 A.L.Spek - Version: '//NQ1
              CALL GGIP09 (0.0,  LINE, 50, 0.4, 3, 2, 5.8, VERT - 4.5)
C * GET PLATON UPDATE INFO
              CALL PLA260 (UPDATE)
              IF (IGBL(13) .GT. 0) THEN
                CALL GGIP09 (0.0,  '[WEB:'//UPDATE//']', 18, 0.4,
     1            IGBL(14), 2, HORS - 6.1, VERT - 4.5)
              END IF
              IF (IPR(37) .NE. 0 .OR. IPR(367) .NE. 0 .OR.
     1          PAR(101) .GT. 1.0) THEN
C * REPORT ON PARAMETER INPUT FILE
                FNLU1  = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
                KNMXT  = KNMFIL + KXT + 1
                NKNMXT = MIN (KNMXT, 25)
                WRITE (LINE, 99999, IOSTAT = IOST)
     1            DTYPE(IABS(IGBL(8)))(1:3)//XLDTP, FNLU1(1:NKNMXT),
     2            IGBL(54), MAX (1, IGBL(100)), JID(1:8)
                CALL GGIP09 (0.0,  LINE, 80, SIZ, 3, 2,
     1                 0.1, VERT - 17.5)
C * REPORT ON REFLECTION DATA FILE
                NKNM16 = MIN (KNM16, 25)
                IF (IGBL(15) .GE. 0) THEN
                  IF (IGBL(37) .EQ. -1) THEN
                    DIRC = 'FCF'
                  ELSE IF (IGBL(37) .EQ. 1) THEN
                    DIRC = 'DIR-COS'
                  ELSE IF (IGBL(37) .EQ. 2) THEN
                    DIRC = 'ABS-PSI'
                  ELSE
                    DIRC = 'NO-DIRC'
                  END IF
                  CALL GGIP (0.0, 3.0, 0.0, 0)
                  WRITE (LINE, 99998, IOSTAT = IOST) RDTYPE,
     1              FNLU16(1:NKNM16), DIRC, IGBL(126),
     2              JID(1:8)
                  KNMXT = KNM16 + 60
                ELSE
                  CALL GGIP (0.0, 4.0, 0.0, 0)
                  WRITE (LINE, 99997, IOSTAT = IOST) FNLU16(1:NKNM16)
                  KNMXT = KNM16 + 40
                END IF
                CALL GGIP09 (0.0,  LINE, KNMXT, SIZ, -1, 2, 0.1,
     1               VERT - 18.2)
                WRITE (LINE, 99993, IOSTAT = IOST)
     1            HTTPSERVER(1:IGBL(135))
                CALL GGIP09 (0.0, LINE, 42, 0.25, 1, 1, 0.1,
     1               VERT - 19.3)
                WRITE (LINE, 99994, IOSTAT = IOST)
     1            HTTPSERVER(1:IGBL(135))
                CALL GGIP09 (0.0, LINE, 44, 0.25, 1, 1, 10.0,
     1               VERT - 19.3)
C * REPORT CHECK-DEF
                IF (IGBL(12) .EQ. 0 .AND. IABS(IGBL(8)) .EQ. 3) THEN
                  LINE = 'No check.def file found for CIF-Validation'
                  CALL GGIP09 (0.0,  LINE, 42, SIZ, 4, 2, 0.1,
     1                         VERT - 18.8)
                END IF
                CALL GGIP (0.0,  1.0, 0.0, 0)
                CALL GGIP (0.0, -2.0, 0.0, 0)
                XB = 0.0
                YB = VERT - 5.0
                CALL GGIP (XB, YB, 0.0, 3)
                XB = HORS
                CALL GGIP (XB, YB, 0.0, 2)
                XB = HORS
                YB = 0.0
                CALL GGIP (XB, YB, 0.0, 3)
                XB = HORS
                YB = VERT
                CALL GGIP (XB, YB, 0.0, 2)
                LINE(1:41)  =
     1              ' GRAPHICS  GEOM-CALC VOIDS FLIP SYMMETRY '
                LINE(42:73) = ' ABSORPTION   REPORT  MISC-TOOLS'
                CALL GGIP09 (0.0,  LINE, 73, SIZ, 5 + IGBL(68), 2, 0.1,
     1               VERT - 5.6)
                DO I = 1, NP46
                  DO J = 1, 7
                    IF (I .EQ. 3 .AND. J .EQ. 3 .AND. IGBL(29) .EQ. 0)
     1                THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE IF (I .EQ. 15 .AND. J .EQ. 7 .AND.
     1                 IPR(663) .NE. 0 .AND. IPR(664) .NE. 0) THEN
                    ELSE IF (I .EQ. 4 .AND. J .EQ. 3 .AND.
     1                 IGBL(110) .GT. 0 .AND.
     1                 IPR(663) .NE. 0 .AND. IPR(664) .NE. 0) THEN
                      CALL GGIP (0.0, 1.0, 0.0, 0)
                    ELSE IF ((IGBL(15) .LT. 0 .AND. IOPT(I, J) .GT. 1)
     1               .OR. (IOPT(I, J) .EQ. 5 .AND.
     2                 (IGBL(9) .LT. 1 .OR. IGBL(9) .GT. 26))) THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE IF (IGBL(15) .GE. 0 .AND. IGBL(9) .EQ. 0
     1                   .AND. IOPT(I, J) .EQ. 3) THEN
                    ELSE IF (IOPT(I, J) .EQ. -2 .AND. (IPR(30) .NE. 0
     1                .OR. IPR(37) .EQ. 0))
     1                THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE IF (IOPT(I, J) .EQ. -3 .AND. IPR(17) .NE. 0)
     1                THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE IF (IOPT(I, J) .EQ. -4 .AND. IPR(30) .NE. 0
     1                                 .AND.  IPR(136) .EQ. 0) THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE IF (IOPT(I, J) .EQ. -5 .AND. IPR(37) .EQ. 0)
     1                THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE IF (IOPT(I, J) .EQ. -8 .AND. (IPR(23) .EQ. 1
     1                .OR. IPR(30) .NE. 0 .OR. IPR(37) .EQ. 0)) THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE IF (IOPT(I, J) .EQ. -9) THEN
                      CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE
                      CALL GGIP (0.0, 1.0, 0.0, 0)
                    END IF
                    IF (IOPT(I, J) .EQ. -1) THEN
                      IF (IPR(30) .NE. 0 .OR. IGBL(12) .EQ. 0 .OR.
     1                    IABS(IGBL(8)) .LT. 3 .OR.
     2                    IABS(IGBL(8)) .GT. 3) THEN
                        CALL GGIP (0.0, 4.0, 0.0, 0)
                      ELSE
                        CALL GGIP (0.0, 1.0, 0.0, 0)
                      END IF
                    END IF
                    IF (IGBL(9) .NE. -1) THEN
                      IF (J .EQ. 3 .AND. (I .EQ. 5 .OR. I .EQ. 6)) THEN
                        CALL GGIP (0.0, 4.0, 0.0, 0)
                      END IF
                    END IF
                    IF (IGBL(119) .EQ. 0) THEN
                      IF (I .EQ. 14 .AND. J .EQ. 1)
     1                     CALL GGIP (0.0, 4.0, 0.0, 0)
                    END IF
                    IF (IGBL(76) .EQ. 0) THEN
                      IF ((I .EQ. 11 .AND. J .EQ. 6) .OR.
     1                    (I .EQ. 12 .AND. J .EQ. 6))
     2                     CALL GGIP (0.0, 4.0, 0.0, 0)
                    END IF
                    IF (IPR(75) .EQ. 1) THEN
                      IF (J .EQ. 1 .AND. I .EQ. 9)
     1                     CALL GGIP (0.0, 4.0, 0.0, 0)
                    END IF
                    YVERT = VERT - I * 11.0 / NP46 - 5.6
                    XHORS = 9 * SIZ * (J - 1) + 0.1
                    CALL GGIP09 (0.0,  OPTS(I, J), 10, SIZ, -1, 2,
     1                           XHORS, YVERT)
                  END DO
                END DO
                CALL GGIP (0.0, -2.0, 0.0, 0)
                CALL GGIP (0.0, 1.0, 0.0, 0)
                XB = 0.0
                YB = VERT - 5.8
                CALL GGIP (XB, YB, 0.0, 3)
                XB = HORS
                CALL GGIP (XB, YB, 0.0, 2)
                XB = 0.0
                YB = VERT - 16.8
                CALL GGIP (XB, YB, 0.0, 3)
                XB = HORS
                CALL GGIP (XB, YB, 0.0, 2)
                XB = 0.0
                XBS = HORS / 7.0
                DO I = 1, 7
                  XB = XB + XBS
                  YB = VERT - 16.8
                  CALL GGIP (XB, YB, 0.0, 3)
                  YB = VERT - 5.0
                  CALL GGIP (XB, YB, 0.0, 2)
                END DO
                CALL GGIP (0.0, -1.0, 0.0, 0)
              ELSE
                LINE(1:26)  = 'NO PROPER INPUT FILE FOUND'
                CALL GGIP09 (0.0,  LINE, 26, 0.7, 2, 3, 4.8, VERT - 7.0)
                LINE(1:33)  = 'NO ATOM DATA, FACES OR CELL FOUND'
                CALL GGIP09 (0.0,  LINE, 33, 0.7, 2, 3, 2.7, VERT - 8.5)
                LINE(1:34)  = 'TO PROCEED'
                CALL GGIP09 (0.0,  LINE, 34, 0.7, 1, 3, 2.7, VERT - 11.)
                LINE(1:35)  = 'Enter ''FILE filename'' via Keyboard'
                CALL GGIP09 (0.0,  LINE, 35, 0.5, 1, 2, 2.7,
     1                       VERT - 12.5)
                LINE(1:26)  = 'or Enter Data via Keyboard'
                CALL GGIP09 (0.0,  LINE, 26, 0.5, 1, 2, 2.7,
     1                       VERT - 14.0)
                LINE(1:25)  = 'or Click on HELP for INFO'
                CALL GGIP09 (0.0,  LINE, 25, 0.5, 1, 2, 2.7,
     1                       VERT - 15.5)
              END IF
              IF (IGBL(47) .GT. 0) THEN
                LINE = 'Browser STARTUP'
                CALL GGIP09 (0.0,  LINE, 15, 0.5, 0, 3, HORS - 8.8, 0.7)
                LINE = 'Browser -'
                CALL GGIP09 (0.0,  LINE, 9, 0.5, 1, 3, HORS - 8.8, 0.7)
                LINE = 'HELP'
                CALL GGIP09 (0.0,  LINE,  4, 1.0, 1, 4, HORS - 3.5, 0.3)
                CALL GGIP (0.0, 0.0, 0.0, 6)
              END IF
   20         CALL PLA013 (0, 1)
              SELECT CASE (LRET)
                CASE (1)
                  GO TO 10
                CASE (2, 3)
                  GO TO 30
                CASE (4)
                  CALL GEN038 (IGGT, 1, 80)
                  RETURN
              END SELECT
   30         ICL = IGGT
              CALL GEN038 (IGGT, 1, 80)
              RETURN
            END IF
          ELSE
            IF (IGBL(50) .EQ. 0) THEN
              CALL GEN125 (0, LU6, '>>')
            ELSE
              ICL = 'END'
              CALL GEN038 (IGGT, 1, 80)
              RETURN
            END IF
          END IF
        END IF
      ELSE IF (MODE .EQ. 1) THEN
        LU = LU5
C * CHECK FOR CONTINUE
        CALL GEN125 (1, LU6, ' ..... more (Y/N[Y])?')
      END IF
C * ACTUAL FILE READ
      IF (MODE .EQ. 1) THEN
        READ (LU, 99995, IOSTAT = IOST) ICL(1:80)
        IF (IOST .EQ. 0) THEN
          IF (ICL(1:1) .EQ. 'N' .OR. ICL(1:1) .EQ. 'n') THEN
            IER = 1
            RETURN
          END IF
        ELSE
C * READ FAILURE
          IER = -1
          RETURN
        END IF
      ELSE
        READ (LU, 99995, IOSTAT = IOST) ICL
        IF (IOST .NE. 0) THEN
C * READ FAILURE
          IER = -1
          RETURN
        END IF
      END IF
      RETURN
99999 FORMAT ('Xtal Data (', A, '  ) ', A, '- Set', I5, '(', I5, '): ',
     1        A)
99998 FORMAT ('Refl Data (', A, ') ', A,  ' [ ', A, ']', 2X,
     1       '(', I2, '): ', A)
99997 FORMAT ('No Refl_Data on     ', A, ', .FCF, .fcf or .hkl')
99996 FORMAT (/, ':: PLATON may be run without graphical-menu ',
     1        'with ''platon -o xxxx.yyy'' ', /)
99995 FORMAT (A)
99994 FORMAT ('http://', A, 'PLATON_HOW_TO.pdf')
99993 FORMAT ('http://', A, 'PLATON-MANUAL.pdf')
      END SUBROUTINE PLA019
      SUBROUTINE PLA020 (X, Y, Z)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP37=191,NP38=150,NP39=30,
     3 NP41=200,NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // YXMOL(2, NP23), VOID(NVD)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50),  RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, COLR*10, BWCT*10
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /TPOS/ XTK(250, 3), NTK(25), KMX, IMIN
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /KEYS/ STRING
      CHARACTER STRING*100
      COMMON /NKEYS/ NCNT
      CHARACTER NTYP*4, TADD*7
      COMMON /IITEM/ ITEM
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /SIAT/ IAT, IATK
      COMMON /LABMOD/ LMOD
      YY    = VERT - Y
      MMODE = IGBL(6)
      JATK  = 0
      IASU  = 0
      LRET  = 1
      IF (IPR(344) .EQ. 1) THEN
        IF (IPR(447) .GT. 0) THEN
          IF (MMODE .EQ. 3) THEN
            CALL PLA109 (3, 1, X, Y, 0)
          ELSE IF (MMODE .EQ. 8) THEN
            CALL PLA109 (3, 0, X, Y, 0)
          END IF
          LRET = -1
          GO TO 10
        END IF
      ELSE IF (IPR(334) .EQ. 1) THEN
        IF (IPR(447) .GT. 0) THEN
          IF (MMODE .EQ. 3) THEN
            CALL PLA109 (4, 1, X, Y, 0)
          ELSE
            CALL PLA109 (4, 0, X, Y, 0)
          END IF
        END IF
        LRET = -1
        GO TO 10
      ELSE IF (IPR(343) .EQ. 1) THEN
        CALL PLA014 (1, 1, X, Y, ITEM, IASU)
        IPR(342) = ITEM
      ELSE IF (IPR(329) .GT. 0) THEN
        CALL PLA014 (1, 1, X, Y, ITEM, IASU)
        IF (ITEM .EQ. 0) THEN
          LRET = -1
          GO TO 10
        END IF
        LMOD = LMOD + 1
        CALL PLUT25 (1, ITEM, IDUM)
        IFL(LMOD + 2) = NQ1
        IF (IPR(329) .EQ. 1) THEN
          IF (LMOD .LT. 2) THEN
            LRET = -1
            GO TO 10
          END IF
        ELSE
          IF (LMOD .LT. 3) THEN
            LRET = -1
            GO TO 10
          END IF
        END IF
        IPR(220) = LMOD + 2
        CALL PLUT06
        IPR(329) = 0
        LMOD     = 0
        GO TO 10
      ELSE IF (IPR(182) .EQ. 1) THEN
        CALL PLA018 (-1, X, YY, NQ1)
        LRET = -1
        GO TO 10
      ELSE IF (IPR(415) .GT. 0) THEN
        CALL PLA018 (0, X, YY, NQ1)
        CALL PLA280 (NQ1)
        GO TO 10
      ELSE IF (IPR(312) .GT. 0) THEN
        CALL PLA018 (0, X, YY, NQ1)
        IF (NQ1(1:1) .NE. '*') THEN
          LMOD = LMOD + 1
          IF (MOD(LMOD, 2) .EQ. 1) THEN
            XHORS = HORS - 4.0
            YHORS = VERT - 0.5 - (LMOD + 1) * 0.25
          ELSE
            XHORS = HORS - 2.0
            YHORS = VERT - 0.5 - LMOD * 0.25
          END IF
          CALL GGIP09 (0.0, NQ1, 6, 0.3, 5 + IGBL(68), 1,
     1                 XHORS, YHORS)
          IFL(LMOD + 1) = NQ1
          WRITE (LU6,'(I5, 1X, A)', IOSTAT = IOST) LMOD, NQ1
        END IF
        LRET = -1
        GO TO 10
      ELSE IF (IPR(536) .GT. 0) THEN
        CALL PLA018 (0, X, YY, NQ1)
        CALL PLA046 (3, NQ1, IENM, LBB, LBC, LBD, INQNR, JNQNR, N1)
        CALL PLA280 ('COLOR TYPE '//LMT(IENM, 1)//' '//COLR(IPR(536)))
        IPR(536) = 0
        GO TO 10
      ELSE IF (IPR(341) .GT. 0) THEN
        IF (IABS(MMODE) .EQ. 1 .OR. IABS(MMODE) .EQ. 8 .OR.
     1      IABS(MMODE) .EQ. 9) THEN
          CALL PLA018 (0, X, YY, NQ1)
          LMOD = LMOD + 1
          IFL(LMOD + 1) = NQ1
          WRITE (SBCD, 99999, IOSTAT = IOST) (IFL(I), I = 1, LMOD + 1)
          IF (LMOD .GE. MIN(4,IPR(341))) THEN
            IPR(81) = LMOD + 1
            CALL PLA035 (1)
            LMOD     = 0
            IGBL(6) = IABS(IGBL(6))
          END IF
          LRET = -1
          GO TO 10
        ELSE
          CALL PLA014 (1, 1, X, Y, ITEM, IASU)
          IF (ITEM .EQ. 0) THEN
            LRET = -1
            GO TO 10
          END IF
          IF (IPR(341) .EQ. 1) THEN
            IFL(1) = 'GEOM'
          ELSE IF (IPR(341) .EQ. 2) THEN
            IFL(1) = 'DIST '
            IF (IASU .GT. 1) THEN
              IF (LMOD .EQ. 0) THEN
                LRET = -1
                GO TO 10
              ELSE IF (LMOD .EQ. 1) THEN
                FN(1)    = - IASU
                IPR(221) = 1
              END IF
            END IF
          ELSE IF (IPR(341) .EQ. 3) THEN
            IFL(1) = 'ANGLE'
          ELSE IF (IPR(341) .EQ. 4) THEN
            IFL(1) = 'TORSION'
          END IF
          LMOD = LMOD + 1
          CALL PLUT25 (1, ITEM, IDUM)
          IFL(LMOD + 1) = NQ1
          WRITE (SBCD, 99999, IOSTAT = IOST) (IFL(I), I = 1, LMOD + 1),
     1      CHAR(0)
          IF (LMOD .LT. IPR(341)) THEN
            LRET = -1
            GO TO 10
          END IF
          IPR(220) = LMOD + 1
          IPR(163) = 0
          CALL PLUT24 (LMOD, IPR(38), IDUM)
          LMOD = 0
          IF (IPR(130) .EQ. 0) GO TO 10
        END IF
      ELSE IF ((IPR(476) .NE. 0 .OR. IPR(552) .NE. 0)
     1         .AND. MMODE .EQ. 9) THEN
        CALL PLA018 (0, X, YY, NQ1)
        LMOD      = LMOD + 1
        IFL(LMOD) = NQ1
        LRET = -1
        GO TO 10
      ELSE IF (IPR(508) .NE. 0 .AND. MMODE .EQ. 1) THEN
        CALL PLA018 (0, X, YY, NQ1)
        LMOD      = LMOD + 1
        IFL(LMOD) = NQ1
        IF (LMOD .EQ. 2) THEN
          LMOD      = LMOD + 1
          IFL(LMOD) = 'TO'
          IPR(507)  = 2
        END IF
        LRET = -1
        GO TO 10
      ELSE IF (IPR(508) .NE. 0 .AND. MMODE .EQ. 4) THEN
        CALL PLA014 (1, 1, X, Y, ITEM, IASU)
        IF (ITEM .EQ. 0) THEN
          LMOD = 0
          LRET = -1
          GO TO 10
        END IF
        CALL PLUT25 (1, ITEM, IDUM)
        LMOD = LMOD + 1
        IFL(LMOD) = NQ1
        IF (LMOD .EQ. 2) THEN
          LMOD      = LMOD + 1
          IFL(LMOD) = 'TO'
          IPR(507)  = 2
        END IF
        LRET = -1
        GO TO 10
      ELSE IF (IPR(311) .NE. 0) THEN
        IF (IABS(MMODE) .EQ. 1 .OR. IABS(MMODE) .EQ. 8) THEN
          LMOD = LMOD + 1
          IF (LMOD .EQ. 1) THEN
            CALL PLA018 (0, X, YY, NQ1)
            LRET = -1
            GO TO 10
          ELSE
            CALL PLA018 (0, X, YY, NQ2)
            IF (IPR(311) .EQ. 1) THEN
              CALL PLA280 ('JOIN '//NQ1//NQ2)
            ELSE IF (IPR(311) .EQ. 2) THEN
              CALL PLA280 ('JOIN DASH '//NQ1//NQ2)
            ELSE
              CALL PLA280 ('DETACH '//NQ1//NQ2)
            END IF
            GO TO 10
          END IF
        ELSE IF (MMODE .EQ. 4) THEN
          CALL PLA014 (1, 1, X, Y, ITEM, IASU)
          IF (ITEM .EQ. 0) THEN
            LMOD = 0
            LRET = -1
            GO TO 10
          END IF
          LMOD = LMOD + 1
          CALL PLUT25 (LMOD, ITEM, IDUM)
          IF (LMOD .EQ. 1) THEN
            IAT  = ITEM
            IATK = IDUM
          ELSE
            JAT  = ITEM
            JATK = IDUM
          END IF
          IF (LMOD .LT. 2) THEN
            LRET = -1
            GO TO 10
          END IF
          IF (IPR(221) .EQ. 0) THEN
            CALL PLUT22 (IAT, JAT, DIST)
            IF (DIST .GT. RADR(IATK, 3) + RADR(JATK, 3) + 0.8) THEN
              TADD = ' 0.05 2'
            ELSE
              TADD = '       '
            END IF
          END IF
          IF (IPR(311) .EQ. 1) THEN
            CALL PLA280 ('JOIN '//NQ1//NQ2//TADD)
          ELSE IF (IPR(311) .EQ. 2) THEN
            CALL PLA280 ('JOIN DASH '//NQ1//NQ2//TADD)
          ELSE
            CALL PLA280 ('DETACH '//NQ1//NQ2)
          END IF
          GO TO 10
        END IF
      ELSE IF (IPR(439) .EQ. 1) THEN
        GO TO 10
      END IF
      SELECT CASE (MMODE)
        CASE (1)
          IPR(478) = 0
          IF (IPR(351) .EQ. 1) THEN
            CALL PLA018 (1, X, YY, NQ1)
          ELSE IF (IPR(440) .EQ. 1) THEN
            CALL PLA018 (0, X, YY, NQ1)
            CALL GEN020 (1, NQ1, 1, 7)
            IF (NQ1(2:2) .EQ. ' ') THEN
              NQ1(2:3) = '()'
            ELSE
              DO III = ICHAR('A'), ICHAR('Z')
                IF (NQ1(2:2) .EQ. CHAR(III)) THEN
                  IF (NQ1(3:3) .EQ. ' ') THEN
                    NQ1(3:4) = '()'
                  END IF
                END IF
              END DO
            END IF
            CALL PLA280 ('CALC COORDN '//NQ1)
          ELSE IF (IPR(440) .EQ. -1) THEN
            IF (X .LT. PAR(37) / 2) THEN
              IMIN = 0
              DISM = 1000.0
              DO III = 1, 100
                DIS = ABS(YY - YMOL(1, III))
                IF (DIS .LT. DISM) THEN
                  IMIN = III
                  DISM = DIS
                END IF
              END DO
              IF (IMIN .NE. 0) THEN
                FN(1)    = YMOL(2, IMIN)
                IPR(221) = 1
                CALL PLA295
              END IF
            END IF
          ELSE IF (IPR(349) .NE. 0 .OR. IPR(327) .NE. 0
     1                 .OR. IPR(328) .NE. 0) THEN
            IF (LMOD .EQ. 0) THEN
              DELMIN = 1000.0
              IMIN = 1
              DO I = 1, IPR(39) + IPR(64)
                III = I * (NP4 + 15)
                DEL = (VOID(III - 2) - X)**2 + (VOID(III - 1) - YY)**2
                IF (IGBL(59) .NE. 0) THEN
                  CALL GEN048 (-7, IFG(2, I), 1, IPP)
                  NPOP = IPPR(IPP + 1, 1)
                  IF (NPOP .LT. 1000) THEN
                    IF (IGBL(88) .EQ. 0) THEN
                      IF (NPOP .LT. 500) CYCLE
                    ELSE
                      IF (NPOP .GT. 500) CYCLE
                    END IF
                  END IF
                END IF
                IF (IPR(328) .EQ. 1) THEN
                  IVAL = 1
                ELSE
                  CALL GEN048 (-1, IFG(2, I), 11, IVAL)
                END IF
                IF (IVAL .EQ. 1 .AND. DEL .LT. DELMIN) THEN
                  CALL GEN048 (-1, IFG(1, I), 7, IHAT)
                  IF (IHAT .NE. 1 .OR. IPR(212) * IPR(232) .NE. 0)
     1               THEN
                    IMIN   = I
                    DELMIN = DEL
                  END IF
                END IF
              END DO
              CALL PLA047 (LABA(IMIN), NQ1, IDUM, JDUM,
     1                     IPR(350) * 2 - 1, IGBL(55), 0, 0)
              LMOD = 1
              X    = VOID (IMIN * (NP4 + 15) - 2)
              YY   = VOID (IMIN * (NP4 + 15) - 1)
            ELSE
              LMOD = 0
              VOID (IMIN * (NP4 + 15) - 2) = X
              VOID (IMIN * (NP4 + 15) - 1) = YY
            END IF
            IF (IPR(328) .EQ. 1) THEN
              CALL GEN048 (1, IFG(2, IMIN), 11, 1)
              LMOD = 0
            END IF
            YGGIP = FLOAT(1 - LMOD)
            CALL GGIP09 (0.0, NQ1, 6, PAR(349), NINT(YGGIP), 1, X, YY)
            IF (IPR(327) .EQ. 1) THEN
              CALL GEN048 (1, IFG(2, IMIN), 11, 0)
              LMOD = 0
            END IF
            LRET = -1
            GO TO 10
          ELSE
            LRET = -1
            GO TO 10
          END IF
        CASE (2)
          LRET = -1
          GO TO 10
        CASE (3)
          IF (IPR(349) .EQ. 1) THEN
            IF (LMOD .EQ. 0) THEN
              CALL PLA014 (-1, 1, X, Y, ITEM, IASU)
              NRCOL = 0
              CALL PLUT14 (-1, ITEM, IASU, NRCOL, XL, YL, ZL, RL)
              IF (ITEM .NE. 0) THEN
                CALL GGIP (0.0, 0.0, 0.0, 0)
                CALL PLUT25 (1, ITEM - IPR(62), IATK)
                CALL PLUT04 (1, ITEM - IPR(62))
                IPR(117) = 0
                CALL GGIP (0.0, 1.0, 0.0, 0)
                LMOD = 1
              END IF
            ELSE
              XL    =   X + PAR(61)
              YL    = - Y - PAR(62)
              NRCOL = 0
              CALL PLUT14 (1, ITEM, IASU, NRCOL, XL, YL, ZL, RL)
              CALL PLUT15 (4, ITEM - IPR(62), 37, 15)
              LMOD = 0
              CALL PLUT04 (1, ITEM - IPR(62))
              IPR(117) = 0
            END IF
            LRET = -1
            GO TO 10
          ELSE IF (IPR(213) .EQ. 1) THEN
            CALL PLA014 (-2, 1, X, Y, ITEM, IASU)
            ITEM = ITEM - IPR(62) - IPR(37)
            IF (ITEM .GT. 0) THEN
              CALL PLUT17 (FLOAT(ITEM), 1005, M, LU6)
            ELSE
              LRET = -1
              GO TO 10
            END IF
          ELSE IF (IPR(332) .EQ. 1 .OR. IPR(335) .EQ. 1 .OR.
     1      IPR(351) .EQ. 1 .OR. IPR(352) .EQ. 1) THEN
            CALL PLA014 (1, 1, X, Y, ITEM, IASU)
            IF (ITEM .NE. 0) THEN
              CALL PLUT25 (1, ITEM, IATK)
              IF (IPR(351) .EQ. 1) THEN
                WRITE (IGGT(1:), '(''DELETE '', A)', IOSTAT = IOST) NQ1
              ELSE IF (IPR(352) .EQ. 1) THEN
                WRITE (IGGT(1:), '(''ANIS '', A)', IOSTAT = IOST) NQ1
                CALL PLUT15 (1, ITEM, 41, 1)
              ELSE IF (IPR(332) .EQ. 1) THEN
                IF (IGBL(25) .EQ. 0) THEN
                  WRITE (LU6, 99992, IOSTAT = IOST) NQ1
                  READ (LU5, 99995) NQ2
                  WRITE (IGGT(1:), 99993, IOSTAT = IOST) NQ1, NQ2
                ELSE
                  IF (NCNT .EQ. 0) THEN
                    STRING(1:4) = 'HFIX'
                    NCNT = 4
                  END IF
                  CALL GEN039 (1, NQ1, 1, 7, NB, NE)
                  STRING(NCNT + 1:) = ' '//NQ1(1:NE)//' '
                  NCNT = NCNT + NE + 2
                  SBCD = STRING(1:NCNT)//CHAR(0)
                  CALL GEN038 (IGGT, 1, 80)
                  CALL PLA280 (STRING(1:NCNT))
                  NCNT = 0
                  GO TO 10
                END IF
              ELSE IF (IPR(335) .EQ. 1) THEN
                IF (IGBL(25) .EQ. 0) THEN
                  READ (LU5, 99995) NQ2
                  WRITE (IGGT(1:), 99994, IOSTAT = IOST) NQ1, NQ2
                ELSE
                  IF (NCNT .EQ. 0) THEN
                    STRING(1:6) = 'RENAME'
                    NCNT = 6
                    CALL GEN039 (1, NQ1, 1, 7, NB, NE)
                    STRING(NCNT + 1:) = ' '//NQ1(1:NE)//' '
                    NCNT = NCNT + NE + 2
                  END IF
                  CALL GGIP( 0.0,  1.0,  0.0, 0)
                  SBCD = STRING(1:NCNT)//CHAR(0)
                  CALL GEN038 (IGGT, 1, 80)
                  CALL PLA280 (STRING(1:NCNT))
                  NCNT = 0
                  GO TO 10
                END IF
              ELSE
                LRET = -1
                GO TO 10
              END IF
            ELSE
              LRET = -1
              GO TO 10
            END IF
          ELSE
            CALL PLA109 (5, 1, X, Y, LMOD)
            LRET = -1
            GO TO 10
          END IF
        CASE (4)
          CALL PLA014 (1, 1, X, Y, ITEM, IASU)
          IF (ITEM .NE. 0) THEN
            CALL PLUT25 (1, ITEM, IATK)
            NET = IEL(IEN(IATK))
            N1 = NET / 100
            N2 = NET - N1 * 100
            NTYP = ' '//CHAR(ICHAR('A') + N1 - 1)//'  '
            IF (N2 .NE. 0) NTYP(3:3) = CHAR(ICHAR('a') + N2 - 1)
            IF (IPR(348) .EQ. 1) THEN
              IF (IPR(461) .EQ. 0) THEN
                IF (IPR(478) .EQ. 0) THEN
                  IPR(340) = IPR(340) + 1
                  IF (IPR(340) .GT. 17) IPR(340) = 1
                  CALL PLA280 ('BWC TYPE'//NTYP//BWCT(IPR(340)))
                END IF
              ELSE
                IPR(139) = IPR(139) + 1
                IF (IPR(139) .GT. 17) IPR(139) = 1
                CALL PLA280 ('PLOT')
              END IF
            ELSE IF (IPR(338) .EQ. 1) THEN
              IPR(337) = IPR(337) + 1
              IF (IPR(337) .GT. 9) IPR(337) = 1
              CALL PLA280 ('COLOR TYPE'//NTYP//COLR(IPR(337)))
            END IF
          ELSE
            LRET = -1
            GO TO 10
          END IF
        CASE (5, 6)
          LRET = -1
          GO TO 10
        CASE (8, 9)
          CALL PLA109 (5, 0, X, Y, LMOD)
          LRET = -1
          GO TO 10
        CASE (7, 10, 11, 12)
          CALL PLA021 (X, Y, Z)
        CASE (17)
          IF (IGBL(28) .GT. 0) THEN
            NV =  NINT((Y - RGBL(1) + PAR(360) + PAR(361) / 2.0)
     1             / PAR(361))
            IF (NV .LE. 0) THEN
              CALL PLA280 ('PLOT')
            ELSE
              IF (IGBL(28) .EQ. 1) THEN
                 IF (NV .LT. 10) THEN
                  WRITE (IGGT, 99998, IOSTAT = IOST) NV
                ELSE
                  WRITE (IGGT, 99997, IOSTAT = IOST) NV
                END IF
              ELSE IF (IGBL(28) .EQ. 2) THEN
                NV = - NV
                IF (NV .LT. 10) THEN
                  WRITE (IGGT, 99997, IOSTAT = IOST) NV
                ELSE
                  WRITE (IGGT, 99996, IOSTAT = IOST) NV
                END IF
              END IF
            END IF
          ELSE
            CALL PLA280 ('PLOT')
          END IF
        CASE (18)
          IF (IGBL(28) .EQ. 1) THEN
            NV = MIN (17, MAX (0, INT(Y - 1.5)))
            IF (NV .LT. 10) THEN
              WRITE (IGGT, 99998, IOSTAT = IOST) NV
            ELSE
              WRITE (IGGT, 99997, IOSTAT = IOST) NV
            END IF
          ELSE
            CALL PLA280 ('PLOT')
          END IF
        CASE (19, 22)
          LRET = -1
          GO TO 10
      END SELECT
   10 RETURN
99999 FORMAT (6(A, 1X))
99998 FORMAT (I1)
99997 FORMAT (I2)
99996 FORMAT (I3)
99995 FORMAT (A)
99994 FORMAT ('REN ', A, A)
99993 FORMAT ('HFIX ', A, A)
99992 FORMAT ('HFIX ', A, 1X, $)
      END SUBROUTINE PLA020
      SUBROUTINE PLA021 (X, Y, Z)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP46=15)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /IMEN/ IOPT(NP46, 7)
      CHARACTER OPTS*10
      COMMON /CMEN/ OPTS(NP46, 7)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
C * MAIN MENU (NH & NV)
      SIZ   = HORS / 63.0
      IF (IPR(462) .EQ. 0) THEN
        IF (IPR(37) .NE. 0 .OR. IPR(367) .NE. 0 .OR.
     1      PAR(101) .GT. 1.0) THEN
          NH = INT(7.0 * X / HORS) + 1
          IF (NH .LT. 1 .OR. NH .GT. 7) THEN
            LRET = -1
            RETURN
          ENDIF
          NV = INT((Y - 4.8) * NP46 / 11.0)
          IF (NV .LT. 0 .OR. NV .GT. NP46) THEN
            NH = 7
            NV = NP46 + 1
          END IF
        ELSE
          NH = 7
          NV = NP46 + 1
        END IF
        IF (NH .EQ. 7 .AND. (NV .EQ. NP46 + 1)) THEN
          CALL PLA300 (1, 0, 0)
          LRET = -1
          RETURN
        ELSE IF (NINT(Z) .EQ. 3) THEN
          CALL PLA300 (1, NH, NV)
          LRET = -1
          RETURN
        END IF
        IF (NV .GT. 0 .AND. NV .LE. NP46) THEN
          IF (NV .EQ. 15 .AND. NH .EQ. 7 .AND. IPR(664) .NE. 0) THEN
          ELSE IF (NV .EQ. 4 .AND. NH .EQ. 3 .AND. IGBL(110) .GT. 0
     1       .AND. IPR(663) .NE. 0 .AND. IPR(664) .NE. 0) THEN
          ELSE
            IF ((IOPT(NV, NH) .GT. 1 .AND. IGBL(15) .LT. 0) .OR.
     1        (IOPT(NV, NH) .EQ. 3 .AND. IGBL(15) .EQ. 0 .AND.
     2          IGBL(9) .EQ. 0)) THEN
              CALL PLA015 (427, 7)
              LRET = -1
              RETURN
            END IF
          END IF
        ELSE
          LRET = -1
          RETURN
        END IF
        YVERT = VERT - NV * 11.0 / NP46 - 5.6
        XHORS = 9 * SIZ * (NH - 1) + 0.1
        CALL GGIP09 (0.0,  OPTS(NV, NH), 10, SIZ, 2, 2, XHORS, YVERT)
C * SELECT FROM MAIN MENU
C * NH = 1 - GRAPHICS TOOLS
        SELECT CASE (NH)
          CASE (1)
            SELECT CASE (NV)
              CASE (1)
                IGBL(6)  = 1
                IGBL(24) = 1
                IPR(68)  = 0
                IPR(324) = 0
                IPR(495) = 0
                CALL PLA280 ('PLUTON')
              CASE (2)
                IGBL(3) = 3
                IGBL(6) = 1
                IPR(324) = 0
                CALL PLA280 ('PLOT ADP COLOR')
              CASE (3)
                CALL PLA280 ('PLOT NEWMAN COLOR')
              CASE (4)
                CALL PLA280 ('PLOT RING COLOR')
                IGBL(6) = 13
              CASE (5)
                CALL PLA280 ('PLOT PLAN COLOR')
                IGBL(6) = 13
              CASE (6)
                IGBL(6) = 30
                CALL PLA280 ('PLOT POLY')
              CASE (7)
                IGBL(6) = 9
                PAR(274) = 0.0
                PAR(275) = 0.0
                PAR(276) = 0.0
                CALL PLA280 ('CONTOUR DI TN')
              CASE (8)
                IGBL(6) = 9
                PAR(274) = 0.0
                PAR(275) = 0.0
                PAR(276) = 0.0
                CALL PLA280 ('CONTOUR FO TN')
              CASE (9)
                CALL PLA280 ('FIT')
              CASE (10)
                CALL PLA280 ('POWDER IOBS')
              CASE (11)
                CALL PLA280 ('POWDER')
              CASE (12)
                CALL PLA280 ('CALC RDF')
              CASE (13)
                CALL PLA280 ('SETUP PATT')
              CASE (14)
                CALL PLA280 ('XTPLOT')
              CASE (15)
                IGBL(3)  = 8
                IGBL(6)  = 2
                IGBL(24) = 1
                IGBL(75) = 0
                CALL PLA280 ('PLUTON NATIVE')
                LRET = 3
            END SELECT
C * NH = 2 - GEOM TOOLS
          CASE (2)
              SELECT CASE (NV)
              CASE (1)
                IGBL(70) = 1
                CALL PLA280 ('CALC')
              CASE (2)
                CALL PLA280 ('CALC INTRA')
              CASE (3)
                CALL PLA280 ('CALC INTER')
              CASE (4)
                CALL PLA280 ('CALC COORDN')
              CASE (5)
                CALL PLA280 ('CALC METAL')
              CASE (6)
                CALL PLA280 ('CALC GEOM')
              CASE (7)
                CALL PLA280 ('CALC HBONDS')
              CASE (8)
                CALL PLA280 ('CALC TMA')
              CASE (9)
                IPR(460) = 1
                CALL PLA280 ('PLOT ADP COLOR')
              CASE (10)
                IPR(551) = 1
                CALL PLA280 ('PLOT ADP COLOR')
              CASE (11)
                IPR(341) = 5
                CALL PLA280 ('PLOT ADP COLOR')
              CASE (12)
                IPR(551) = 1
                CALL PLA280 ('PLOT ADP COLOR')
              CASE (13)
                CALL PLA280 ('PLOT RING COLOR')
                IGBL(6) = 13
              CASE (14)
                IGBL(121) = 1
                CALL PLA280 ('CALC COORDN NOANG 4.0')
              CASE (15)
                IF (IABS(IGBL(8)) .EQ. 2) THEN
                  IGBL(3) = 13
                  CALL PLA280 ('PLUTON')
                ELSE
                  CALL PLA015 (427, 30)
                  LRET = -1
                  RETURN
                END IF
            END SELECT
C * NH = 3
          CASE (3)
            SELECT CASE (NV)
              CASE (1)
                CALL PLA280 ('CALC SOLV')
              CASE (2)
                CALL PLA280 ('CALC VOID')
              CASE (3)
                CALL PLA280 ('CALC SQUEEZE')
              CASE (4)
                CALL PLA280 ('HYBRID')
              CASE (5)
                IF (IGBL(9) .EQ. -1) THEN
                  CALL PLA280 ('CALC FCF')
                ELSE
                  LRET = -1
                  RETURN
                END IF
              CASE (6)
                IF (IGBL(9) .EQ. -1) THEN
                  IGBL(6)  = 9
                  PAR(274) = 0.0
                  PAR(275) = 0.0
                  PAR(276) = 0.0
                  IPR(515) = 0
                  CALL PLA280 ('CONTOUR SQ TN')
                ELSE
                  LRET = -1
                  RETURN
                END IF
              CASE (7)
                CALL PLA280 ('CALC SOLV GRID 0.35 F3D')
              CASE (8)
                CALL PLA280 ('CALC SOLV PLOT')
              CASE (9)
                CALL PLA280 ('CAVITY')
              CASE (10)
              CASE (11)
                CALL PLA280 ('FLIP MENU')
              CASE (12)
                CALL PLA280 ('FLIP PATT SHOW')
              CASE (13)
                CALL PLA280 ('FLIP 1 5000')
              CASE (14)
                CALL PLA280 ('FLIP')
              CASE (15)
                CALL PLA280 ('STRUCTURE')
            END SELECT
C * NH = 4
          CASE (4)
              SELECT CASE (NV)
              CASE (1)
                CALL PLA280 ('CALC ADDSYM')
              CASE (2)
                CALL PLA280 ('CALC ADDSYM EQUAL')
              CASE (3)
                CALL PLA280 ('CALC ADDSYM EXACT')
              CASE (4)
                CALL PLA280 ('CALC ADDSYM PLOT')
              CASE (5)
                CALL PLA280 ('CALC ADDSYM SHELX NOSF')
              CASE (6)
                CALL PLA280 ('CALC NEWSYM')
              CASE (7)
                CALL PLA280 ('CALC NONSYM')
              CASE (8)
                CALL PLA280 ('LEPAGE')
              CASE (9)
                CALL PLA280 ('DELRED')
              CASE (10)
                CALL PLA280 ('CALC MOLSYM')
              CASE (11)
                CALL PLA280 ('SPGR')
              CASE (12)
                CALL PLA280 ('ASYM')
              CASE (13)
                CALL PLA280 ('ASYM AVF')
              CASE (14)
                CALL PLA280 ('LEPAGE 0.0 6')
              CASE (15)
                CALL PLA280 ('ROTMAT')
            END SELECT
C * NH = 5
          CASE (5)
            SELECT CASE (NV)
              CASE (1)
                CALL PLA280 ('MULABS')
                IGBL(6) = 16
              CASE (2)
                CALL PLA280 ('ABSP')
              CASE(3)
                CALL PLA280 ('ABST')
              CASE (4)
                CALL PLA280 ('ABSG')
              CASE (5)
                CALL PLA280 ('ABSX')
              CASE (6)
                CALL PLA280 ('ABSS')
              CASE (7)
                CALL PLA280 ('SHXABS')
              CASE (8)
                BCD = 'ENTER: ''ANOM ElementName Wavelength'' or '//
     1            '''ANOM wavelength'' or ''ANOM ElementName'''//CHAR(0)
                CALL GGIP (-999.0, 2.0, 85.0, 111)
              CASE (9)
                CALL PLA280 ('ANOM')
              CASE (10)
                CALL PLA280 ('MU')
              CASE (11)
              CASE (12)
              CASE (13)
              CASE (14)
                BCD = 'ENTER: ANGLE h1 k1 l1 h2 k2 l2'//CHAR(0)
                CALL GGIP (-999.0, 2.0, 80.0, 111)
              CASE (15)
                CALL PLA280 ('XTAL')
            END SELECT
C * NH = 6
          CASE (6)
            SELECT CASE (NV)
              CASE (1)
                IF (IABS(IGBL(8)) .NE. 3 .OR. IPR(30) .NE. 0) THEN
                  LRET = -1
                  RETURN
                END IF
                IGBL(66) = 1
                IGBL(12) = IABS(IGBL(12))
                IGBL(3)  = 1
                LU6      = LU20
                CALL PLA280 ('VALI')
              CASE (2)
                CALL PLA280 ('ASYM AVF VIEW')
                IGBL(6) = 14
              CASE (3)
                CALL PLA280 ('ASYM AVF VALID')
              CASE (4)
                CALL PLA280 ('CALC DIFF')
              CASE (5)
                IF (IGBL(9) .GE. 1 .AND. IGBL(9) .LT. 27) THEN
                  IGBL(6) = 32
                  CALL PLA280 ('VARIANCE')
                ELSE
                  LRET = -1
                  RETURN
                END IF
              CASE (6)
                CALL PLA280 ('BIJVOET')
              CASE (7)
                CALL PLA280 ('ASYM EXPECT')
              CASE (8)
                CALL PLA280 ('ASYM VALID')
              CASE (9)
                CALL PLA280 ('TABLE SUP')
              CASE (10)
                CALL PLA280 ('EXPT')
              CASE (11)
                CALL PLA294 (1)
                CALL PLA280 ('RESTART')
                LRET = -1
                RETURN
              CASE (12)
                CALL PLA280 ('CALC GEOM CSD')
              CASE (13)
                CALL PLA280 ('STIDY')
              CASE (14)
                CALL PLA280 ('STRAIN')
              CASE (15)
                CALL PLA280 ('TABL ACC LOCAL')
            END SELECT
C * NH = 7 - MISC-TOOLS
          CASE (7)
            SELECT CASE (NV)
              CASE (1)
                CALL PLA280 ('SYST')
              CASE (2)
                CALL PLA280 ('FCF2HKL')
              CASE (3)
                CALL PLA280 ('EXP1')
              CASE (4)
                CALL PLA280 ('CALC FCF GENER')
              CASE (5)
                CALL PLA280 ('ASYM GENERATE')
              CASE (6)
                CALL PLA280 ('HKLTRANS')
              CASE (7)
                CALL PLA280 ('EXOR')
              CASE (8)
                IF (IABS(IGBL(8)) .EQ. 2) THEN
                  IGBL(3) = 26
                  CALL PLA280 ('PLUTON')
                END IF
              CASE (9)
                IF (IABS(IGBL(8)) .EQ. 2) THEN
                  IGBL(3)   = 12
                  IGBL(105) = 1
                  CALL PLA280 ('PLUTON')
                ELSE
                  CALL PLA015 (427, 40)
                END IF
              CASE (10)
                IGBL(3) = 27
                CALL PLA280 ('CALC GEOM RENUM SHELX NOSF')
              CASE (11)
                IPR(675) = 1
                CALL PLA280 ('CALC SPF')
              CASE (12)
                IPR(675) = 1
                CALL PLA280 ('CALC SHELX NOSF')
              CASE (13)
                CALL PLA280 ('TABL ACC')
              CASE (14)
                IPR(675) = 1
                CALL PLA280 ('CALC PDB EXPAND')
              CASE (15)
                CALL PLA280 ('CIF2SHELXL')
            END SELECT
        END SELECT
        IF (IGGT(1:1) .EQ. ' ') THEN
          LRET = -1
          RETURN
        END IF
        LRET = 2
        RETURN
      ELSE IF (IPR(462) .EQ. 1) THEN
        NH = INT (6 * X / (RGBL(1) * RGBL(2)))
        NV = INT (43 * Y / RGBL(1)) + 1
        WRITE (IGGT, 99999, IOSTAT = IOST)
     1     INT((IGBL(100) - 1) / 258) * 258 + NH * 43 + NV
      END IF
      RETURN
99999 FORMAT (I6.6)
      END SUBROUTINE PLA021
      SUBROUTINE PLA022 (INQNR)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /LMEM/ IATYC, IATYO, IATYN
C * INVESTIGATE THE PARAMETERS OF A (POTENTIALLY) NEW ATOM
      IENR = 0
      ISU  = 0
      NSYM = IPR(48)
      IPR(107) = 0
      NAT  = IPR(39)
      IF (NAT .GE. NP1) THEN
        IPR(2) = 1
      ELSE
        IF (NAT .EQ. 0) THEN
          IPR(463) = 128
          IPR(464) = 51200000
          IPR(465) = 400000
          IPR(466) = IPR(465) * 2
        END IF
        NATP1  = NAT + 1
        KL     = IPR(220)
        KN     = IPR(221)
        MODE   = 100
        RGBL25 = MAX (0.05, RGBL(25))
        NQ1    = IFL(IPR(473))
        IF (IGBL(8) .EQ. 3) THEN
          IF (KN .NE. 10) THEN
            IF (IGBL(3) .EQ. 1) THEN
C * ALERT _170 - INSUFFICIENT DATA
              CALL PLA231 (170, 0, 1.0, 1.0, IFL(2), ' ')
            ELSE
              IPR(2) = 51
            END IF
            RETURN
          END IF
          IF (NAT .EQ. 0) THEN
            IF (PAR(101) .LT. 1.1) THEN
              IPR(2) = 58
              RETURN
            END IF
            IGBL(59) = 0
            IATYC    = 0
            IATYO    = 0
            IATYN    = 0
            IF (IPR(319) .EQ. 0) THEN
C * ALERT _124 - PROBLEM WITH EQUIVALENT POSITIONS
              CALL PLA231 (124, 0, 1.0, 1.0, CCIF(7)(1:7), ' ')
              IF (SPGRNM(1)(1:1) .EQ. ' ') THEN
C * ALERT _121 - INVALID SPACE GROUP
                CALL PLA231 (121, 0, 1.0, 1.0, CCIF(6), ' ')
                CALL SGSM (IDM, 0, XJX, 0, 1, IERR)
                IPR(48) = 1
              END IF
            END IF
          END IF
C * ALERT _017 - CHECK SCATTERING TYPE CONSISTENCY (SHELXL-CIF)
          IF (KL .EQ. 3) THEN
            IF (IFL(3)(2:2) .NE. ' ') THEN
              N2 = 2
            ELSE
              N2 = 1
            END IF
            IF (INDEX(IFL(2), IFL(3)(1:N2)) .EQ. 0) THEN
              CALL PLA231 (17, 0, -999.0, 0.0, IFL(2), IFL(3))
            END IF
          END IF
        ELSE IF (IGBL(8) .EQ. 2) THEN
          IF (IPR(538) .NE. 0) THEN
            N = INDEX (NQ1, ' ')
            IF (N .NE. 0) THEN
              IF (IPR(538) .LT. 10) THEN
                WRITE (NQ1(N:N + 1), 99994, IOSTAT = IOST) IPR(538)
              ELSE
                WRITE (NQ1(N:N + 2), 99993, IOSTAT = IOST) IPR(538)
              END IF
            END IF
            IFL(IPR(473)) = NQ1
          END IF
        END IF
        NQ2 = NQ1
        NQ4 = NQ1
        LOP = 0
        DO
          CALL PLA046 (MODE, NQ1, IENM1, LBB, LBC, LBD, INQNR, JNQNR,
     1                 NIEN)
          IF (LBB .EQ. 0 .AND. NIEN .GE. 0) THEN
            IF (NQ1(2:2) .NE. '0') THEN
              CALL GEN020 (-1, NQ1, 2, 2)
C * ALERT _069
              CALL PLA231 (69, 0, -999.0, 1.0, NQ1, ' ')
            END IF
          END IF
          IF (NIEN .LT. 0) THEN
            IF (NIEN .EQ. -7) THEN
              IPR(2) = 67
              RETURN
            ELSE IF (NIEN .EQ. -12) THEN
              NQ1    = NQ2
              IPR(2) = 57
              RETURN
            END IF
            IF (IABS(IGBL(8)) .EQ. 3) THEN
              IF (KL .EQ. 3) THEN
                LOP = LOP + 1
                IF (LOP .EQ. 1) THEN
                  NQ1 = IFL(3)
                ELSE
                  MODE     = 100
                  NQ1      = IFL(2)
                  IPR(220) = 2
                  KL       = 2
                  CYCLE
                END IF
              ELSE
                LOP = LOP + 1
                IF (((ICHAR(IFL(2)(2:2)) .GE. 48 .AND.
     1              ICHAR(IFL(2)(2:2)) .LE. 57) .OR.
     2              IFL(2)(2:2) .EQ. '(')  .AND.
     2              LOP .LT. 3) THEN
                  NQ1 = IFL(2)(1:1)//'      '
                ELSE
                  IPR(2) = 3
                  RETURN
                END IF
              END IF
            ELSE IF (IABS(IGBL(8)) .EQ. 2) THEN
              IF (IAN .GT. 0 .AND. NINT(FN(1)) .LE. IAN) THEN
                NQ1 = LMT(NINT(FN(1)), 1)//'     '
              ELSE
                IPR(2) = 46
                RETURN
              END IF
            ELSE IF (IGBL(8) .EQ. 1) THEN
            ELSE
              IPR(2) = 3
              RETURN
            END IF
            IF (NQ1(1:1) .EQ. ' ') THEN
              NQ1(1:1) = NQ1(2:2)
              NQ1(2:4) = '999'
            ELSE IF (NQ1(2:2) .EQ. ' ') THEN
              NQ1(2:4) = '999'
            ELSE
              NQ1(3:4) = '99'
            END IF
            MODE = 99
            CYCLE
          END IF
          IF (MODE .EQ. 100) THEN
            DO K = 1, NAT
              IF (LABA(K) .EQ. INQNR) THEN
C * ALERT _070 - DUPLICATE LABEL
                CALL PLA231 (70, 0, 1.0, 1.0, NQ2, ' ')
                MODE = 99
                EXIT
              END IF
            END DO
          ELSE IF (MODE .EQ. 99) THEN
            EXIT
          END IF
          IF (MODE .NE. 99) EXIT
        END DO
        IF (IABS (IGBL(8)) .EQ. 2) THEN
          IPR(32) = MAX (IPR(32), 1)
          IF (KN .EQ. 7) KN = 6
          IF (KN .EQ. 20) THEN
            DO K = 12, 20
              FN(9 + K) = FN(K)
              FN(K)     = 0.0
            END DO
            KN  = 11
            KNS = 9
          ELSE IF (KN .EQ. 10) THEN
            DO K = 7, 10
              FN(14 + K) = FN(K)
              FN(K)      = 0.0
            END DO
            KN  = 6
            KNS = 4
          ELSE
            KNS = 0
          END IF
          IF (KN .NE. 6  .AND. KN .NE. 11) THEN
            IPR(498) = IPR(498) + 1
            IF (KN .EQ. 4) FN(5) = 11.0
            FN(6) = PAR(30)
            KN    = 6
          END IF
          IENR = NINT(FN(1))
          DO K = 2, KN
            YY = FN(K)
            IF (ABS(YY) .GT. 5.0) THEN
              I  = NINT(ABS(YY) * 0.1)
              IF (I .EQ. 1) THEN
                RPI = 1.0
              ELSE
                RPI = RP(I)
              END IF
              SJ = SIGN (0.5, YY)
              IF (I .NE. 1 .AND. I .GT. IPR(109)) THEN
                IPR(2) = 9
                RETURN
              END IF
              YY = (YY - I * SJ * 20.0) * (RPI + SJ - 0.5)
            END IF
            FN(K - 1) = YY
          END DO
          KN = KN - 1
          IF (KN .EQ. 5) THEN
            FN(9)  = FN(5)
            FN(10) = 0.0
            KN     = 10
          ELSE
            IPR(32) = 2
            DO K = 1, 6
              FN(15 - K) = FN(11 - K)
            END DO
            CALL GEN074 (FN, 15, 20, 0.0)
            KN = 20
          END IF
          CALL GEN074 (FN, 5, 8, 0.0)
          IF (FN(4) .LT. 0.0001) THEN
            IPR(100) = IPR(100) + 1
            IPR(471) = IPR(471) + 1
            IPR(2)   = 0
            RETURN
          END IF
          IF (KNS .GT. 0) THEN
            DO K = 1, 3
              FN(K + 4) = FN(20 + K)
            END DO
            IF (KNS .EQ. 4) THEN
              FN(10) = FN(24)
            ELSE
              DO K = 1, 6
                FN(14 + K) = FN(23 + K)
              END DO
            END IF
          END IF
        ELSE
          IF (KN .EQ. 5) KN = 3
          KNP1 = KN + 1
          CALL GEN074 (FN, KNP1, 9, 0.0)
          IF (KN .EQ. 6) THEN
            DO K = 1, 4
              FN(9 - K) = FN(8 - K)
            END DO
            FN(4) = 0.0
          END IF
          IF (IPR(23) .NE. 0) THEN
            ISU = 0
            DO K = 1, 3
              FN(K)     = FN(K)     * PAR(11)
              FN(K + 4) = FN(K + 4) * PAR(11)
              IF (FN(K + 4) .GT. 0) ISU = 1
            END DO
          END IF
        END IF
        IF (FN(24) .EQ. 1 .AND. FN(8) .EQ. 0.0) THEN
          IF (FN(4) .EQ. 0.330) FN(4) = 0.33333
          IF (FN(4) .EQ. 0.670) FN(4) = 0.66667
        END IF
        IF (IPR(23) .EQ. 0) CALL PLA080
        CALL GEN002 (1, TM2, FN, XJX, XLNG)
        DO K = 1, 3
          DUMA(K) = 0.0
          FNK4    = FN(K + 4)
          IF (FNK4 .GT. 0.0) IPR(72) = 1
          IF (FNK4 .LT. 0.0) FNK4    = 0.0
          FN(K + 4) = FNK4**2
        END DO
        DO K = 1, 3
          IF (IPR(23) .EQ. 0) THEN
            DO L = 1, 3
              DUMA(K) = DUMA(K) + TM2(K, L)**2 * FN(L + 4)
            END DO
          ELSE
            DUMA(K) = FN(K + 4)
          END IF
        END DO
        DO K = 1, 3
          XJX(K)              = XJX(K) + SHFT(K)
          FN(K)               = XJX(K)
          FN(K + 4)           = SQRT(DUMA(K))
          XJX(K + 3)          = 0.0
          CON(NATP1, K + 2)   = FN(K)
          CON(NATP1, K + 5)   = DUMA(K)
          CON(NAT + 2, K + 2) = 0.0
          MULTX               = 0
        END DO
        IPR94 = 0
        IF (IEN(NIEN + 1) .EQ. 1 .OR. IEN(NIEN + 1) .EQ. 33 .OR.
     1      IEN(NIEN + 1) .EQ. 113) THEN
          IPR94 = 1
        END IF
        MULT = IPR(23)
        IF (MULT .EQ. 0) THEN
          XJX(10) = 0.0
          CALL SGSM (IDM, 0, XJX, LU6, 19, IERR)
          IF (IGBL(8) .EQ. 3) THEN
            IF (XJX(10) .NE. 1.0 .AND. IPR(612) .GE. 0) THEN
              FN(4) = FN(4) * XJX(10)
              IF (FN(8) .GT. 0.0) FN(8) = FN(8) * XJX(10)
            ELSE
              IF (IPR94 .EQ. 0 .AND. IGBL(94) .EQ. 0) THEN
C * ALERT _161
                IF (FN(5) .LE. 0.0) CALL PLA231 (
     1                    161, 0, 1.0, 1.0, NQ2(1:7), ' ')
C * ALERT _162
                IF (FN(6) .LE. 0.0) CALL PLA231 (
     1                    162, 0, 1.0, 1.0, NQ2(1:7), ' ')
C * ALERT _163
                IF (FN(7) .LE. 0.0) CALL PLA231 (
     1                    163, 0, 1.0, 1.0, NQ2(1:7), ' ')
              END IF
            END IF
          END IF
          IF (IPR94 .EQ. 0) THEN
            IF (XJX(10) .EQ. 1.0) THEN
              ISU = 1
              IF (FN(5) .LE. 0.0 .AND. FN(6) .LE. 0.0 .AND.
     1            FN(7) .LE. 0.0) ISU = 0
            ELSE
              ISU = 0
              IF (FN(5) .GT. 0.0 .OR. FN(6) .GT. 0.0 .OR. FN(7) .GT. 0)
     1          ISU = 1
            END IF
          ELSE
            ISU = 0
            IF (FN(5) .GT. 0.0 .OR. FN(6) .GT. 0.0 .OR. FN(7) .GT. 0)
     1        ISU = 1
          END IF
          IF (IGBL(8) .EQ. 3 .AND. IPR(612) .NE. 0) THEN
            MULT = 1
          ELSE
            IF (ABS(FN(4) / XJX(10) - 0.5) .GT. 0.4998) THEN
              DO J = 1, NSYM
                JSYM = J
                CALL SGSM (ICL, JSYM, XJX, LU7, 3, IERR)
                DO I = 1, NATP1
                  VERS = 0.0
                  DO K = 1, 3
                    DUMA(K) = CON(I, K + 2) - XJX(K + 6)
                    DO WHILE (DUMA(K) .GT. 0.5)
                      XJX(K + 6) = XJX(K + 6) + 1.0
                      DUMA(K)    = DUMA(K)    - 1.0
                    END DO
                    DO WHILE (DUMA(K) .LE. - 0.5)
                      XJX(K + 6) = XJX(K + 6) - 1.0
                      DUMA(K)    = DUMA(K)    + 1.0
                    END DO
                  END DO
                  VERS = SQRT(PAR(129) * DUMA(1) ** 2
     1                      + PAR(130) * DUMA(2) ** 2
     2                      + PAR(131) * DUMA(3) ** 2
     3                      + PAR(132) * DUMA(1) * DUMA(2)
     4                      + PAR(133) * DUMA(1) * DUMA(3)
     5                      + PAR(134) * DUMA(2) * DUMA(3))
                  IF (VERS .LT. RGBL25) THEN
                    CALL GEN048 (-1, IFG(1, I), 7, IHAT)
                    IF (IHAT .EQ. 1 .OR. IPR94 .EQ. 1) THEN
                      IF (VERS .GT. PAR(22)) CYCLE
                    END IF
                    IF (NQ2(1:1) .NE. 'Q' .AND. VERS .GT. PAR(22))
     1                CYCLE
                    IF (I .NE. NATP1) THEN
                      CALL PLA047 (LABA(I), NQ2, IENM, JDUM,
     1                  IPR(71), IGBL(55), 0, 0)
                      IPR(100) = IPR(100) + 1
                      WRITE (LU6, 99997, IOSTAT = IOST) NQ1, VERS, NQ2
                      IF (VERS .LT. PAR(22)) THEN
                        IF (IEN(IENM1) .EQ. JDUM) THEN
                          DO K = 1, 3
                            FN(K) = (CON(I, K + 2) + XJX(K + 6)) / 2.0
                            CON(I, K + 2) = FN(K)
                          END DO
                          FN(4) = - 1.0
                          WRITE (LU4) 11, CON(I, 2), (FN(K), K = 1, 8)
                        END IF
                        WRITE (LU6, 99996, IOSTAT = IOST)
     1                    NQ1, VERS, NQ2, (FN(K), K = 1, 3)
                      END IF
C * ALERT _310
                      CALL PLA231 (310, 3, VERS, VERS, NQ1, NQ2)
                      IPR(471) = IPR(471) + 1
                      IPR(107) = 1
                      IPR(2)   = 0
                      RETURN
                    ELSE
                      IF (MULT .EQ. 0 .OR. IABS(IGBL(8)) .NE. 2 .OR.
     1                               IABS(IGBL(8)) .NE. 3) THEN
                        MULTX = MULTX + 1
                        MULT  = MULT + 1
                        DO K = 1, 3
                          CON(NAT + 2, K + 2) = CON(NAT + 2, K + 2)
     1                                        + XJX(K + 6)
                        END DO
                      END IF
                    END IF
                  END IF
                END DO
              END DO
            ELSE
              MULT = NINT(1.0 / XJX(10))
            END IF
          END IF
        END IF
        IF (IGBL(8) .EQ. 3 .AND. FN(35) .EQ. 1.0 .AND. MULT .NE. 1) THEN
          FN(4) = FN(4) * MULT
          FN(8) = FN(8) * MULT
        END IF
        CALL PLA047 (INQNR, NQ2, MN, JDUM, 0, IGBL(55), 0, 0)
        DO K = 1, 7
          IF (NQ2(K : K) .EQ. '#') THEN
            IF (IPR(683) .EQ. 1) THEN
              IPR(71)  = 0
              IPR(350) = 0
            END IF
            CALL PLA282 (IPR(683), IFL(IPR(473)), NQ2, LU6)
            EXIT
          END IF
        END DO
        IF (IPR(39) .EQ. 0) IPPR(1, 3) = NSYM
        IPR(39)       = IPR(39) + 1
        IPR(37)       = IPR(39)
        LABA(IPR(39)) = INQNR
        IF (IABS(IGBL(8)) .EQ. 2) THEN
          CON(IPR(39), NP4 - 1) = IENR
          CON(IPR(39), NP4)     = FN(4)
        END IF
        IF (IPR(37) .EQ. 1) THEN
          IF (IGBL(8) .EQ. 3 .AND. IGBL(94) .EQ. 0) THEN
            IF (CCIF(7)(1:11) .NE. CCIF(8)(1:11) .AND.
     1          IPR(319) * IPR(318) .EQ. 1) THEN
              IDM = CCIF(8)
              CALL GEN047 (IDM, 1, 20)
              NQ2 = IDM(1:7)
              CALL GEN020 (-1, NQ2, 2, 7)
              IF (NQ2(1:1) .EQ. ' ') NQ2(1:1) = '?'
              J = INDEX (NQ2(2:7), 'r')
              IF (J .NE. 0) NQ2(J+1:J+1) = 'R'
              IF (J .EQ. 0 .OR. IPR(606) .NE. 8) THEN
                IDM = CCIF(6)
                CALL GEN047 (IDM, 1, 20)
C * ALERT _120
                IF (IDM(1:1) .NE. '?')
     1            CALL PLA231 (120, 0, 1.0, 1.0, IDM(1:7), NQ2)
              END IF
            END IF
          END IF
        END IF
        DO I = 1, 3
          IFG(I, IPR(39)) = 0
        END DO
        IF (IABS(IGBL(8)) .EQ. 3) THEN
          IF (FN(21) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 1, 1)
          IF (FN(22) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 2, 1)
          IF (FN(23) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 3, 1)
          IF (FN(22) .EQ. 1.0) THEN
C * ALERT _166
            IF ((FN(5) .GT. 0.0 .OR. FN(6) .GT. 0.0 .OR.
     1          FN(7) .GT. 0.0) .AND. FN(30) .NE. 1.0 .AND.
     2          FN(26) .NE. 1.0) THEN
                  CALL PLA231 (166, 0, 1.0, 1.0, IFL(IPR(473)), ' ')
            END IF
          END IF
          IF (FN(24) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 4, 1)
          IF (FN(25) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 5, 1)
          IF (FN(26) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 6, 1)
          IF (FN(27) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 7, 1)
          IF (FN(28) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 8, 1)
          IF (FN(29) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 9, 1)
          IF (FN(30) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 10, 1)
          IF (IPR94 .EQ. 0 .AND. FN(26) .EQ. 1.0) THEN
            IPR(164) = IPR(164) + 1
          END IF
          IF (FN(31) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 11, 1)
          IF (FN(32) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 12, 1)
          IF (FN(33) .EQ. 1.0) CALL GEN048 (1, IFG(3, IPR(39)), 13, 1)
        END IF
        IVL = IPR(612) + 16
        CALL GEN048 (5, IFG(3, IPR(39)), 14, IVL)
        IF (MULT .GT. 1) CALL GEN048 (1, IFG(1, IPR(39)), 6 , 1)
        CALL GEN048 (4, IFG(1, IPR(39)), 15, NIEN)
        IF (IPR(165) .GT. 0) THEN
          ITRNS    = IPR(165)
          IPR(165) = 0
        ELSE
          ITRNS    = IPR(95)
        END IF
        IATP(IPR(39)) = ITRNS
        CALL GEN048 (-1, IFG(3, IPR(39)), 10, IPOPRES)
        CALL GEN048 (1, IFG(1, IPR(39)), 7, IPR94)
        IF (IATPR(IEN(NIEN + 1)) .GT. 0) THEN
          CALL GEN048 (1, IFG(1, IPR(39)), 19, 1)
          IPR(155) = 1
          PAR(85)  = 2
          PAR(87)  = 1
        END IF
        NORGA = 0
        NORGB = 0
        NORGC = 0
        IPR(325) = -1
        DO K = 1, NIEN + 1
          IF (IEN(K) .EQ.  2) NORGA = 1
          IF (IEN(K) .EQ.  1) NORGB = 1
          IF (IEN(K) .EQ. 38) NORGB = 1
          IF (IATPR(IEN(K)) .GT. 0) NORGC = 1
        END DO
        IF (NORGA + NORGB .EQ. 2) THEN
          IPR(325) = NORGC
          IF (IGBL(99) .NE. 1) IGBL(97) = 1
        END IF
        NPOP   = IPR(65)
        POPPAR = FN(4) * MULT
        IF (IABS(IGBL(8)) .EQ. 3) THEN
C * ALERT _075
          IF (POPPAR .GT. 1.001 .AND. IGBL(94) .EQ. 0)
     1        CALL PLA231 (75, 0, 1.0, POPPAR, IFL(IPR(473)), ' ')
C * ALERT _076
          IF (POPPAR .LT. 1.0 .AND. MULT .NE. 1
     1        .AND. ABS(MULT * POPPAR - 1.0) .LT. 0.01
     2        .AND. IPOPRES .EQ. 0) THEN
              CALL PLA231 (76, 3, 0.5, POPPAR, IFL(IPR(473)), ' ')
          END IF
        END IF
        IF (IGBL(8) .EQ. 3) THEN
          IF (MOD (JNQNR, 40) .EQ. 0) THEN
            N   = IEN(IENM1)
            IF (N .EQ. 2) THEN
              IF (JNQNR .GT. IATYC) THEN
                IATYC = JNQNR
              ELSE
                IPR(545) = IPR(545) + 1
                IF (IPR(545) .EQ. 1) THEN
C * ALERT _795
                  CALL PLA231 (795, 0, -999.0, 1.0, NQ1, ' ')
                END IF
              END IF
            ELSE IF (N .EQ. 3) THEN
              IF (JNQNR .GT. IATYO) THEN
                IATYO = JNQNR
              ELSE
                IPR(546) = IPR(546) + 1
                IF (IPR(546) .EQ. 1) THEN
C * ALERT _796
                  CALL PLA231 (796, 0, -999.0, 1.0, NQ1, ' ')
                END IF
              END IF
            ELSE IF (N .EQ. 4) THEN
              IF (JNQNR .GT. IATYN) THEN
                IATYN = JNQNR
              ELSE
                IPR(547) = IPR(547) + 1
                IF (IPR(547) .EQ. 1) THEN
C * ALERT _797
                  CALL PLA231 (797, 0, -999.0, 1.0, NQ1, ' ')
                END IF
              END IF
            END IF
          END IF
        END IF
        IF (IABS(IGBL(8)) .EQ. 3) THEN
          FN(4) = POPPAR
        ELSE
          FN(4) = MIN (1.0, POPPAR)
        END IF
        FN(8) = FN(8) * MULT
        IF (IGBL(8) .NE. 3) THEN
          IF (FN(4) .LT. PAR(12)) FN(4) = 1.0
        END IF
        IF (FN(8) .LT. 0.0) FN(8) = 0.0
        IF (FN(4) .LT. 0.5) JNQNR = JNQNR + 150 * 4000
        JR(IPR(39)) = JNQNR
        INTPOP      = NINT(FN(4) * 1000.0)
        IF (INTPOP .EQ. 500) THEN
          IF (FN(4) .GT. 0.5) INTPOP = 501
          IF (FN(4) .LT. 0.5) INTPOP = 499
        END IF
        IPPR(NPOP + 1, 1) = INTPOP
        IPPR(NPOP + 1, 2) = NINT(FN(8) * 1000.0)
        IPPR(NPOP + 1, 3) = NSYM  / MULT
        FN(4)             = FN(4) / MULT
        FN(8)             = FN(8) / MULT
        IF (IPR94 .EQ. 0) PAR(386) = PAR(386) + NSYM * FN(4)
        PAR(388) = PAR(388) + NSYM * FN(4) * ATWT(IEN(NIEN + 1))
        PAR(387) = PAR(388) / (PAR(98) * 0.60221)
        IF (MULTX .GT. 1 .AND. INTPOP .EQ. 1000) THEN
          DO K = 1, 3
            CON(NAT + 1, K + 2) = CON(NAT + 2, K + 2) / MULTX
            FN(K) = CON(NAT + 1, K + 2)
          END DO
        END IF
        MULT = NSYM / MULT
        IF (MOD(IPPR(NPOP + 1, 1), 1000) .NE. 0) THEN
          IPR(44) = 1
          IF (IPR94 .EQ. 0) IPR(43) = 1
        END IF
        DO I = 1, NPOP
          IF (IPPR(I, 3) .EQ. IPPR(NPOP + 1, 3) .AND.
     1        IPPR(I, 1) .EQ. IPPR(NPOP + 1, 1)) THEN
            IPOP = I - 1
            GO TO 50
          END IF
        END DO
        IPOP = NPOP
        IF (IPOP .GT. 127) THEN
          IPR(92) = IPR(92) + 1
        ELSE
          IPR(65) = IPR(65) + 1
        END IF
   50   CALL GEN048 (7, IFG(2, IPR(39)), 1, IPOP)
        CALL GEN048 (1,  IFG(2, IPR(39)), 10, ISU)
        CALL GEN048 (-1, IFG(1, IPR(39)), 7, JHAT)
        IF (JHAT .EQ. 1) IPR(564) = IPR(564) + ISU
        CALL GEN048 (1, IFG(2, IPR(39)), 11, 1)
        WRITE (LU4) 1, INQNR, (FN(K), K = 1, 8)
        IF (IABS(IGBL(8)) .EQ. 2) THEN
          IF (FN(9) .LT. 0.0) THEN
            FN(9) = - FN(9) * PAR(61)
          ELSE
            IF (IPR94 .EQ. 0) PAR(61) = FN(9)
          END IF
        END IF
        IF (KN .EQ. 10) WRITE (LU4) 4, INQNR, (FN(K), K = 9, 16)
        IF (KN .EQ. 20) THEN
          CALL GEN048 (1, IFG(1, IPR(39)), 4, 1)
          CALL GEN144 (1, FN(9), PAR(135))
          CALL GEN025 (DUMV, FN(9), -1)
          CALL GEN001 (1, TM2, DUMV, UIJ)
          CALL GEN025 (UIJ, FN(9), 1)
          CALL GEN144 (-1, FN(9), PAR(113))
          IF (IABS(IGBL(8)) .EQ. 2 .AND. IPR94 .EQ. 0) THEN
            CALL GEN025 (UIJ, FN(9), -1)
            CALL GEN114 (PAR, OR, UIJ, UIJC, DUMA, DUMV, PAR(61))
          END IF
          WRITE (LU4) 2, INQNR, (FN(K), K =  9, 16)
          WRITE (LU4) 3, INQNR, (FN(K), K = 15, 22)
        END IF
      END IF
      RETURN
99997 FORMAT (':: ATOM ', A, ' DELETED from INPUT STREAM, ',
     1          F5.2, ' Ang. From ', A)
99996 FORMAT (':: ATOM ', A, ' at', F5.2, ' Ang. from ', A,
     1        ' - New Av Pos:', 3F8.4)
99994 FORMAT ('_', I1)
99993 FORMAT ('_', I2)
      END SUBROUTINE PLA022
      SUBROUTINE PLA023 (MBRAV)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION RIK(3, 3), UKL(3, 3)
      NAT   = IPR(37)
      NSYMR = IPR(255)
      NSYMI = IPR(257)
      IF (MBRAV .NE. 0) THEN
        IBV = IPR(256)
      ELSE
        IBV = 1
      END IF
      NSYML = NSYMR * NSYMI * IBV
      IF (NAT * NSYML .GT. NP1) THEN
        WRITE (LU6, 99997, IOSTAT = IOST) NP1
        IPR(589) = -1
        RETURN
      END IF
      CALL GEN021 (UKL, 0)
C * GET ATOM PARAMETERS FROM (SAVE-)FILE
      NUEQ = 0
      NPDS = 0
      CALL GEN108 (LU4, 0)
      DO
        READ (LU4, IOSTAT = IOST) ICT, INQNR, (FN(K), K = 1, 8)
        IF (IOST .NE. 0) EXIT
        DO I = 1, NAT
          IF (LABA(I) .EQ. INQNR) THEN
            K = I
            SELECT CASE (ICT)
              CASE (1)
                CALL GEN048 (-1, IFG(1, K), 30, IVAL)
                IF (IVAL .EQ. 1) THEN
                  FN(4) = 0.0
                  CALL PLA047 (INQNR, NQ1, MN, IENR, 1, IGBL(55), 0, 0)
                  WRITE (LU6, 99996, IOSTAT = IOST) NQ1
                  WRITE (LU7, 99996, IOSTAT = IOST) NQ1
                END IF
                DO J = 1, 4
                  XXO(K, J) = FN(J)
                END DO
                CALL GEN048 (-4, IFG(1, K), 15, NO1)
                M = IEN (NO1 + 1)
                IF (IABS(IPR(493)) .NE. 6) THEN
                  M = (M - 1) * 17
                  DO J = 1, 9
                    CON(K, J) = SFAC(M + J)
                  END DO
                ELSE
                  CON(K, 9) = RNSCL(M)
                END IF
                IATP(K) = NO1 + 1
              CASE (2)
                DO J = 1, 6
                  XSD(K, J) = FN(J)
                END DO
              CASE (4)
                XSD(K, 1) = FN(1) + 100.0
              CASE (6)
                GO TO 10
            END SELECT
            EXIT
          END IF
        END DO
      END DO
   10 IF (IPR(210) .EQ. -2) THEN
        DO K = 1, NAT
          XSD(K, 1) = PAR(247)
          CALL GEN048 (1, IFG(1, K), 4, 0)
        END DO
      END IF
      KAT = NAT
      IF (NSYML .GT. 1) THEN
        DO L = 2, NSYML
          DO IAT = 1, NAT
            CALL GEN048 (-1, IFG(1, IAT), 4, IVAL)
            DO M = 1, 3
              XJX(M)     = XXO(IAT, M)
              XJX(M + 3) = 0.0
            END DO
            CALL SGSM (ICL, L, XJX, LU7, 3, IERR)
            KAT = KAT + 1
            DO M = 1, 3
              XXO(KAT, M) = XJX(M + 6)
            END DO
            LABA(KAT)   = LABA(IAT)
            XXO(KAT, 4) = XXO(IAT, 4)
            DO M = 1, 3
              IFG(M, KAT) = IFG(M, IAT)
            END DO
            DO M = 1, 9
              CON(KAT, M) = CON(IAT, M)
            END DO
            IATP(KAT) = IATP(IAT)
            IF (IVAL .EQ. 1) THEN
              CALL SGSM (ICL, L, XJX, LU7, 6, IERR)
              DO M = 1, 9
                J = MOD (M - 1, 3) + 1
                K = ((M - 1) / 3)  + 1
                RIK(K, J) = XJX(M)
              END DO
              DO J = 1, 6
                DUMA(J) = XSD(IAT, J)
              END DO
              CALL GEN025 (UKL, DUMA, -1)
              CALL GEN001 (1, RIK, UKL, UIJ)
              CALL GEN025 (UIJ, DUMA, 1)
              DO J = 1, 6
                XSD(KAT, J) = DUMA(J)
              END DO
            ELSE
              XSD(KAT, 1) = XSD(IAT, 1)
            END IF
          END DO
        END DO
      END IF
      IF (NUEQ .GT. 0) WRITE (LU6, 99999, IOSTAT = IOST) NUEQ
      IF (NPDS .GT. 0) WRITE (LU6, 99998, IOSTAT = IOST) NPDS
      IPR(589) = KAT
99999 FORMAT (':: # Anisotropic atoms converted to isotropic =', I4)
99998 FORMAT (':: # of NPDs reset to U = 0.03 =', I4)
99997 FORMAT ('F: # of Atoms in Expanded set exceeds NP1 =', I5)
99996 FORMAT (':: ', A, ' OMITted From SF-Calculations')
      END SUBROUTINE PLA023
      SUBROUTINE PLA024
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      CHARACTER NOTE1*1
      CALL GEN074 (UIJC, 1, 9, 0.0)
      NAT  = IPR(37)
      NATB = IPR(39)
      DO I = 1, NATB
        CALL PLA099 (1, I, NANG, ANG1, ANG2, ANG3, NOTE1)
      END DO
      CALL PLA034 (1, NATB)
      IPR(297) = NP1 * (NP4 + 15)
      IPR(298) = IPR(297) + NP1 * 21
      WRITE (LU4) 6, (FN(K), K = 1, 9)
      CALL GEN108 (LU4, 0)
      CALL GEN074 (DATC, 1, NAT, 0.0)
      DO
        READ (LU4) ICT, INQNR, (FN(K), K = 1, 8)
        IF (ICT .EQ. 6) EXIT
        DO I = 1, NAT
          IF (LABA(I) .EQ. INQNR) THEN
            IF (MOD(ICT, 10) .EQ. 1) THEN
              IF (FN(4) .GT. 0.0) THEN
                JM = 4
              ELSE
                JM = 3
              END IF
              DO J = 1, JM
                CON(I, J) = FN(J)
                YUNK      = FN(J + 4)
                IF (YUNK .LT. 0.0) YUNK = 0.0
                CON(I, J + 4) = YUNK
              END DO
              IF (ICT .EQ. 1) THEN
                ANIS(I, 1) = 0.0
                SUAN(I, 1) = 0.0
              END IF
            ELSE IF (ICT .EQ. 2) THEN
              DO J = 1, 6
                ANIS(I, J) = FN(J)
                SUAN(I, J) = 0.0
              END DO
              CALL GEN048 (1, IFG(1, I), 4, 1)
            ELSE IF (ICT .EQ. 3) THEN
              DO J = 1, 6
                IF (FN(J) .GT. 0.0) SUAN(I, J) = FN(J)
              END DO
            ELSE IF (ICT .EQ. 4) THEN
              ANIS(I, 1) = FN(1)
              DATC(I)    = FN(1)
              IF (FN(2) .LE. 0.0) FN(2) = 0.0
              SUAN(I, 1) = FN(2)
            ELSE
              N = NINT(FN(1))
              CALL PLA025 (I, N)
              CYCLE
            END IF
            CYCLE
          END IF
        END DO
      END DO
      DO I = NAT + 1, NATB
        ILABA = - LABA(I)
        CALL PLA047 (ILABA, NQ1, MNM, JDUM, IPR(71), 1, 0, 0)
        CALL GEN098 (MOL(MNM), PAR(42), N, MT1, MT2, MT3, MR1)
        FN(2) = MT1
        FN(3) = MT2
        FN(4) = MT3
        CALL PLA046 (2, NQ1, IENM, LBB, LBC, LBD, ILMP, JNQNR, J)
        IF (J .LT. 0) THEN
          WRITE (LU6, 99999, IOSTAT = IOST) J, NQ1
          CALL PLA004 (0)
          EXIT
        ELSE
          DO K = 1, NP4
            CON(I, K) = CON(J, K)
          END DO
          DO K = 1, 6
            ANIS(I, K) = ANIS(J, K)
            SUAN(I, K) = SUAN(J, K)
          END DO
          CALL GEN048 (-1, IFG(1, J), 4, IVAL)
          CALL GEN048 ( 1, IFG(1, I), 4, IVAL)
          CALL PLA025 (I, N)
        END IF
      END DO
      DO I = 1, NP1
        CALL GEN048 (-1, IFG(1, I), 7, IHAT)
        CALL GEN048 (-1, IFG(1, I), 4, IVAL)
        IF (I .LE. NATB) THEN
          IF (ANIS(I, 1) .LE. 0.0 .AND. IVAL .EQ. 0) THEN
            IF (IHAT .EQ. 0) THEN
              ANIS(I, 1) = PAR(30)
              IPR(171)  = IPR(171) + 1
            ELSE
              ANIS(I, 1) = PAR(30)
              IPR(172)  = IPR(172) + 1
            END IF
          END IF
          IF (IVAL .NE. 0) THEN
            DO K = 1, 6
              DUMA(K) = ANIS(I, K)
            END DO
            CALL GEN025 (UIJ, DUMA, -1)
          ELSE
            UIJ(1, 1) = ANIS(I, 1)
          END IF
        ELSE
          IVAL      = 0
          IHAT      = 0
          UIJ(1, 1) = - 0.1
        END IF
        IF (IVAL .EQ. 0) THEN
          T1 = SQRT (MAX (0.0, UIJ(1, 1)))
          IF (IPR(32) .EQ. 0 .OR. T1 .LE. 0 .OR. IHAT .EQ. 1) THEN
            IF (IHAT .EQ. 1) THEN
              IF (IPR(603) .EQ. 0) T1 = PAR(265)
            ELSE
              T1 = PAR(266)
            END IF
          END IF
          DO J = 1, 3
            DUMA(J) = T1
            DO K = 1, 3
              DAM(J, K) = ROR(J, K)
              IF (J .EQ. K) THEN
                UIJC(J, K) = T1
              ELSE
                UIJC(J, K) = 0.0
              END IF
            END DO
          END DO
        ELSE
          CALL GEN114 (PAR, OR, UIJ, UIJC, DUMA, PAT, T1)
          CALL GEN019 (AA, BB, PAT(1, 1), PAT(1, 3), DAM(1, 1), -1)
          DO J = 1, 3
            T2      = DUMA(J)
            DUMA(J) = SIGN (SQRT (ABS(T2)), T2)
          END DO
        END IF
        DO J = 1, 9
          K0 = MOD(J - 1, 3) + 1
          K1 = ((J - 1) / 3) + 1
          VOID(IPR(297) + I * 21 + J - 21) = DAM(K0, K1)
          VOID(IPR(297) + I * 21 + J -  9) = UIJC(K0, K1)
        END DO
        DO J = 1, 3
          VOID(IPR(297) + I * 21 + J - 12) = DUMA(J)
        END DO
      END DO
      IF (IPR(14) .EQ. 0 .OR. IPR(14) .EQ. 4 .OR.
     1    IPR(14) .EQ. 6) THEN
        CALL PLA026
        IF (IPR(504) .EQ. 0 .AND. IGBL(22) .NE. -1) THEN
          IF (IPR(14) .NE. 6) CALL PLA027
        END IF
      END IF
      CALL PLA034 (-1, NATB)
      IPR(85) = 1
      RETURN
99999 FORMAT (//, 'Label Problem #', I3, ' for ', A)
      END SUBROUTINE PLA024
      SUBROUTINE PLA025 (I, N)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ISCR/ RIK(3, 3), UKL(3, 3), INSCR(3)
      CHARACTER LINE*80
C * SUPPORT PLA024
      LU = 0
      DO J = 1, 3
        XJX(J)     = CON(I, J)
        XJX(J + 3) = FN(J + 1)
      END DO
      CALL SGSM (LINE, N, XJX, LU, 3, IERR)
      DO J = 1, 3
        CON(I, J)  = XJX(J + 6)
        XJX(J)     = CON(I, J + 4)
        XJX(J + 3) = 0.0
      END DO
      CALL SGSM (LINE, -N, XJX, LU, 3, IERR)
      DO J = 1, 3
        CON(I, J + 4) = XJX(J + 6)
      END DO
      CALL GEN048 (-1, IFG(1, I), 4, IVAL)
      IF (IVAL .GT. 0) THEN
        IF (N .GT. 0) THEN
          CALL SGSM (LINE, N, XJX, LU, 6, IERR)
          DO K = 1, 9
            K0 = MOD (K - 1, 3) + 1
            K1 = ((K - 1) / 3)  + 1
            RIK(K1, K0) = XJX(K)
          END DO
          DO K = 1, 6
            DUMA(K) = ANIS(I, K)
          END DO
          CALL GEN025 (UKL, DUMA, -1)
          CALL GEN001 (1, RIK, UKL, UIJ)
          CALL GEN025 (UIJ, DUMA, 1)
          DO K = 1, 6
            ANIS(I, K) = DUMA(K)
          END DO
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA025
      SUBROUTINE PLA026
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NCS=52)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /DATASPGR/ EXTYPE, NLAUE
      CHARACTER EXTYPE(NCS)*16, NLAUE(13)*5
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER LSB*1, RSB*1, ND13*1, FORMA*136, FORMB*47, DISOR*1
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      FORMA(1:26)    = '(I4,1X, A ,F8.4,''('',I2,'')'''
      FORMA(27:42)   = ',F9.4,''('',I2,'')'''
      FORMA(43:74)   =  FORMA(27:42)//FORMA(27:42)
      FORMA(75:106)  =  FORMA(43:74)
      FORMA(107:136) =  FORMA(27:42)//',3F7.4,F7.2,A)'
      FORMB(1:27)    = '(I4,1X, A ,F8.4,''('',I2,'')'','
      FORMB(28:47)   = '65X,F9.4,''('',I2,'')'')'
      PAGET = 'ADP-Anal'
      XI    = 0.0
      YI    = 0.0
      ZI    = 0.0
      DO I = 1, IAN + 1
        BOK(I, 1) = 0.0
        BOK(I, 2) = 9999.0
        BOK(I, 3) = 0.0
        KBO(I, 1) = 0
      END DO
      WAVELTH = PAR(17)
      IPR493  = IABS(IPR(493))
      IF (IPR493 .EQ. 0) THEN
        WAVELTH = 0.71073
        IPR493  = 2
        WRITE (LU6, 99958, IOSTAT = IOST)
      END IF
      NAT  = IPR(37)
      NATB = IPR(39)
      NRES = IPR(75)
      IF (IPR(67) .EQ. 0) THEN
        NATC = NAT
      ELSE
        NATC = NATB
      END IF
      IF (IGBL(31) .EQ. 0) THEN
        IGBL(31) = 3
        CALL PLA292
      END IF
      IF (IGBL(31) .LT. 0) IPR(109) = 1
      IF (IGBL(31) .EQ. 7) THEN
        WRITE (LU2, 99963, IOSTAT = IOST) JID(1:73),
     1    (PAR(100 + I), I = 1, 6), SPGRNM(4),
     2    ((ROR(I, J), J = 1, 3), 0.0, I = 1, 3)
      END IF
      IF (IGBL(31) .NE. 0 .AND. IGBL(31) .NE. 2 .AND.
     1    IGBL(31) .NE. 4 .AND. IGBL(31) .NE. 7) THEN
        REWIND LU2
        WRITE (LU2, 99982, IOSTAT = IOST) JID(1:74)
        IF (IGBL(31) .EQ. 3 .AND.
     1     (IPR(209) .GT. 0 .OR. IPR(504) .GT. 0)) THEN
          WRITE (LU2, 99973, IOSTAT = IOST)
     1      ((ROTM2(I, J), J = 1, 3), I = 1, 3), (ORG(J), J = 1, 3)
          WRITE (LU2, 99960, IOSTAT = IOST) 0.7
        END IF
        IF (IGBL(31) .EQ. -2) THEN
          CALL GEN066 (2, PAR(101), PAR(107), SPGRNM(1)(12:12))
        END IF
        IF (IPR(23) .EQ. 0) THEN
          WRITE (LU2, 99974, IOSTAT = IOST)
     1      WAVELTH, (PAR(100 + I), I = 1, 6)
        END IF
        IF (IPR(438) .EQ. 1 .OR. IGBL(31) .EQ. 3) THEN
          IF (IPR(23) .EQ. 0) THEN
            WRITE (LU2, 99979, IOSTAT = IOST) (PAR(106 + I), I = 1, 6)
          END IF
          IF (PAR(2) .NE. 0.4) WRITE (LU2, 99951, IOSTAT = IOST) PAR(2)
        ELSE IF (IGBL(31) .EQ. -2 .OR. IGBL(31) .EQ. -3) THEN
          IF (IPR(276) .GT. 0) THEN
            IZET = IPR(276)
          ELSE IF (IPR(260) .GT. 0) THEN
            IZET = IPR(260)
          ELSE
            IZET = 1
          END IF
          WRITE (LU2, 99971, IOSTAT = IOST)
     1      IZET, (PAR(106 + I), I = 1, 6)
        END IF
        IF (IPR(438) .EQ. 1)
     1    WRITE (LU2, 99990, IOSTAT = IOST) PAR(98), PAR(21)
        IF (IPR(256) .EQ. 0 .OR. IGBL(31) .LT. 0) THEN
          IF (IGBL(31) .LT. 0) THEN
            WRITE (LU2, 99975) IPR(242)
            ISW = 17
          ELSE
            IF (IPR(23) .EQ. 0) THEN
              WRITE (LU2, 99978) SPGRNM(1)(13:13), SPGRNM(1)(14:14)
            END IF
            ISW = 2
          END IF
          IF (IPR(23) .EQ. 0) THEN
            CALL SGSM (ICL, 0, XJX, LU6, 2, IERR)
            DO I = 2, IPR(255)
              CALL SGSM (ICL, I, XJX, 0, ISW, IERR)
              WRITE (LU2, 99977) ICL(1:60)
            END DO
          END IF
        ELSE
          IF (IGBL(31) .EQ. 3 .AND. IPR(67) .NE. 0) THEN
            WRITE (LU2, 99989)
          ELSE
            IF (SPGRNM(1)(1:3) .EQ. '   ' .AND. IPR(209) .EQ. 0
     1          .AND. IPR(504) .EQ. 0) THEN
              IF (IPR(23) .EQ. 0) THEN
                WRITE (LU2, 99978) SPGRNM(1)(13:13), SPGRNM(1)(14:14)
                ISW = 2
                DO I = 2, IPR(255)
                  CALL SGSM (ICL, I, XJX, 0, ISW, IERR)
                  WRITE (LU2, 99977) ICL(1:60)
                END DO
              END IF
            ELSE
              IF (SPGRNM(2)(1:1) .NE. '?' .AND. SPGRNM(2)(1:1) .NE. ' '
     1            .AND. IGBL(31) .EQ. 3) THEN
                J   = 2
                LSB = '['
                RSB = ']'
              ELSE
                J   = 1
                LSB = ' '
                RSB = ' '
              END IF
              IF (INDEX(SPGRNM(J)(1:11), ':') .NE. 0) THEN
                WRITE (LU2, 99976) LSB, SPGRNM(J)(1:11),RSB
              ELSE
                IF (SPGRNM(J)(8:11) .EQ. '    ') THEN
                  I = ICHAR(' ')
                ELSE
                  I = ICHAR('.')
                END IF
                WRITE (LU2, 99976)
     1               LSB, SPGRNM(J)(1:7), CHAR(I), SPGRNM(J)(8:11), RSB
              END IF
            END IF
          END IF
        END IF
        IF (IPR(504) .EQ. 2) THEN
          WRITE (LU2, 99994) (LMT(IENS(K), 1), K = 1, IAN)
        END IF
        IF ((IGBL(31) .EQ. 3 .OR. IGBL(3) .LT. 0) .AND. IPR(310) .GT. 0)
     1      WRITE (LU2, 99998) IPR(310) - 273
      END IF
C * OUTPUT (LU2) SHELXL - SFAC, UNIT, FVAR
      IF (IGBL(31) .LT. 0) THEN
        IAN0 = 0
        DO K = 1, IAN
          IF (LMT(IENS(K), 1) .NE. 'Cg') THEN
            IAN0 = IAN0 + 1
            IENS(IAN0) = IENS(K)
          ELSE
            KCG = IENS(K)
          END IF
        END DO
        IF (IAN0 .LT. IAN) IENS(IAN) = KCG
        NFVR = IPR(109)
        IF (IPR(595) .EQ. 0) THEN
          DO K = 1, IAN0
            L   = IEN(IENS(K))
            IF (IPR493 .LT. 5) THEN
              J   = (L - 1) * 17
              FAC = ANOM(IENS(K), 1)
              FDC = ANOM(IENS(K), 2)
              RMU = ANOM(IENS(K), 3)
              WRITE (LU2, 99981) LMT(IENS(K), 1),
     1          (SFAC(J + I), I = 1, 9), FAC, FDC, RMU, REL(L),
     2           SATWT(IENS(K))
            ELSE
              WRITE (LU2, 99981) LMT(IENS(K), 1), 0.0, 0.0, 0.0, 0.0,
     1          0.0, 0.0, 0.0, 0.0, RNSCL(L), 0.0, 0.0, 0.0, REL(L),
     2          SATWT(IENS(K))
            END IF
          END DO
        ELSE
          IF (IPR493 .EQ. 6) WRITE (LU2, 99933)
          IF (IGBL(8) .NE. 2) THEN
            WRITE (LU2, 99941) (LMT(IENS(K), 1), K = 1, IAN0)
            IF (IABS(IPR(493)) .EQ. 5) THEN
              DO K = 1, IAN0
                WRITE (LU2, 99936)
     1            LMT(IENS(K), 1), (ANOM(IENS(K), L), L = 1, 3)
              END DO
            END IF
          ELSE
            WRITE (LU2, 99941) (LMT(K, 1), K = 1, IAN)
          END IF
        END IF
        IF (IGBL(8) .NE. 2) THEN
          WRITE (LU2, 99980) (NINT(CONT(IENS(L), 2)), L = 1, IAN0)
        ELSE
          WRITE (LU2, 99980) (NINT(CONT(L, 2)), L = 1, IAN)
        END IF
        IF (IPR(310) .GT. 0) WRITE (LU2, 99998) IPR(310) - 273
        WRITE (LU2, 99942)
        IF (IPR(275) .EQ. 1) THEN
          IF (PAR(433) .LT. 999999.0) THEN
            YUNK = PAR(433)
          ELSE
            YUNK = 0.0
          END IF
          WRITE (LU2, 99937) YUNK
        END IF
        IF (PAR(229) .GT. 0.0) WRITE (LU2, 99935) PAR(229)
        IF (PAR(497) .LT. 0.0 .OR. PAR(498) .LT. 0.0) THEN
          WRITE (LU2, 99939) 0.1
        ELSE
          WRITE (LU2, 99939) PAR(497), PAR(498)
        END IF
        WRITE (LU2, 99999) PAR(74), (RP(L), L = 2, NFVR)
      ELSE IF (IGBL(31) .EQ. 3 .AND. IPR(209) .EQ. 0) THEN
        WRITE (LU2, 99970)
      END IF
      IF (IPR(32) .NE. 0 .AND. IGBL(63) .GT. 2) THEN
         CALL PLA262 (-2)
         WRITE (LU7, 99984) CHAR(ICHAR('#'))
      END IF
      CALL GEN074 (XPV, 1, 4, 0.0)
      DO N = 1, NRES
        DO I = 1, IAN + 1
          BOK(I, 5) = 9999.0
          BOK(I, 6) = 0.0
        END DO
        CALL GEN074 (DEV, 1, 6, 0.0)
        NDEV = 0
        NADD = 0
        IF (RCONT(N) .LT. IPR(487) .AND. NRES .GT. 1) NADD = 1
        IF (IPR(32) .NE. 0) THEN
          NLN = 5
          IF (NRES .GT. 1) NLN = NLN + 5
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (NLN)
            IF (NRES .NE. 1) WRITE (LU7, 99993) N
            WRITE (LU7, 99991)
          END IF
        END IF
        IF (IPR(438) .EQ. 1 .OR. IGBL(31) .EQ. 3) WRITE (LU2, 99992) N
        NRAT   = 0
        IPARTO = 0
        DO I = 1, NATB
          CALL GEN048 (-6, IFG(1, I), 9, IRESI)
          IF (N .EQ. IRESI) THEN
            CALL GEN048 (-1, IFG(1, I), 7, NHAT)
            IF (IGBL(31) .LT. 0) THEN
              IF (NHAT .EQ. 0) THEN
                XI = VOID((I - 1) * (NP4 + 15) + 4)
                YI = VOID((I - 1) * (NP4 + 15) + 5)
                ZI = VOID((I - 1) * (NP4 + 15) + 6)
              ELSE
                CYCLE
              END IF
            END IF
            CALL GEN048 (-1, IFG(1, I), 19, IMET)
            CALL GEN048 (-4, IFG(1, I), 15, NIEN)
            NIEN = NIEN + 1
            IF (IGBL(31) .EQ. 3 .AND. IPR(501) .EQ. 0) THEN
              IALIAS = 1
            ELSE
              IALIAS = IGBL(55)
            END IF
            CALL PLA036 (-I, 1, 1, IDISD, IDUM1, IDUM2, 0, IALIAS)
            CALL PLA036 (-I, 1, 2, IDISD, IDUM1, IDUM2, 0, IGBL(55))
            IF (NHAT .EQ. 0) THEN
              XPV(1 + NADD) = XPV(1 + NADD) + IDISD
              IF (IDISD .LT. 1000)
     1          XPV(3 + NADD) = XPV(3 + NADD) + IDISD
            END IF
            CALL GEN048 (-1, IFG(1, I), 4, IVAL)
            IF (IVAL .GT. 0) THEN
              JM = 6
            ELSE
              JM = 1
              CALL GEN048 (-1, IFG(1, I), 7, IHA)
              IF (IHA .EQ. 0 .AND. I .LE. NAT .AND. IDISD .GT. 500)
     1          IPR(489 + NADD) = IPR(489 + NADD) + 1
            END IF
            DO J = 1, JM
              CALL GEN041 (ANIS(I, J), SUAN(I, J), ISDV(J), 5, NDEC,
     1                    IPR(68))
              ISDV(J) = MIN (99, ISDV(J))
              IF (ISDV(J) .LE. 0) SUAN(I, J) = -1.0
              IF (JM .EQ. 1) THEN
                FORMB(15:15) = CHAR(ICHAR('0') + NDEC)
                FORMB(35:35) = CHAR(ICHAR('0') + NDEC)
              ELSE
                IFT = -1 + J * 16
                FORMA(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
              END IF
            END DO
            DO K = 1, 4
              CALL GEN041 (CON(I, K), CON(I, K + 4), IDUM, IPR(183),
     1                   NDEC, IPR(68))
              IF (1.1 * CON(I, K + 4) .LT. 1.0 / 10 ** IPR(183))
     1           CON(I, K + 4) = -1.0
            END DO
            IF (IGBL(31) .EQ. 7) THEN
              IPDB = 1
            ELSE
              IPDB = 0
            END IF
            CALL PLA047 (LABA(I), NQ2, IDUM, JDUM, 0, IGBL(55),
     1        IPDB, 0)
            IF (IGBL(31) .EQ. 7) THEN
              DO K = 1, 3
                V1(K) = CON(I, K)
              END DO
              CALL GEN002 (1, OR, V1, V3, XLNG)
              IF (NQ2(1:1) .EQ. CHAR(32)) THEN
                NB = 2
                NE = 5
              ELSE
                NB = 1
                NE = 4
              END IF
              WRITE (LU2, 99962) I, NQ2(NB:NE), 0, (V3(K), K = 1, 3),
     1                           1.0, 0.0, NQ2(1:2)
            END IF
            IF (I .LE. NATC) THEN
              IF (IGBL(31) .LT. 0) THEN
                DO L = 1, IAN0
                  IF (IENS(L) .EQ. NIEN) THEN
                    ISCFT = L
                    EXIT
                  END IF
                END DO
                POPL = 10.0 + CON(I, 4)
                IF (CON(I, 4) .LT. 0.99) THEN
                  DO K = 1, 3
                    XJX(K) = CON(I, K)
                  END DO
                  XJX(10) = 0.05
                  CALL SGSM (ICL, 0, XJX, LU6, 19, IERR)
                  DO K = 1, 3
                    CON(I, K) = XJX(6 + K)
                  END DO
                END IF
              ELSE IF (IPR(438) .EQ. 1 .OR. IGBL(31) .EQ. 3) THEN
                DISOR = NAMS(1, 1)(1:1)
                IF (DISOR .NE. ' ') DISOR = 'X'
                CALL GEN048 (-5, IFG(3, I), 14, IPART)
                IPARTN = IPART - 16
                IF (IPARTN .NE. IPARTO) THEN
                  WRITE (LU2, 99934 ) IPARTN
                  IPARTO = IPARTN
                END IF
                IF (IPR(23) .EQ. 0) THEN
                  WRITE (LU2, 99987)
     1                NAMS(1, 2)(2:7), (CON(I, K), K = 1, 8)
                ELSE
                  WRITE (LU2, 99955)
     1                NAMS(1, 2)(2:7), DISOR, (CON(I, K), K = 1, 8)
                END IF
              END IF
            END IF
            IF (JM .GT. 1) THEN
              DO K = 1, 6
                DUMA(K) = ANIS(I, K)
              END DO
              CALL GEN025 (UIJ, DUMA, -1)
              CALL GEN114 (PAR, OR, UIJ, UIJC, DUMA, DUMV, UEQ)
              NRESD = 0
              SUEQ  = 0.0
              DO J = 1, 3
                IF (SUAN(I, J) .GT. 0.0) THEN
                  NRESD = NRESD + 1
                  SUEQ = SUEQ + SUAN(I, J) ** 2
                END IF
              END DO
              IF (NRESD .GT. 0) SUEQ = SQRT(SUEQ) / NRESD
              CALL GEN041 (UEQ, SUEQ, ISUEQ, 5, NDEC, IPR(68))
              ISUEQ = MIN (99, ISUEQ)
              IF (I .LE. NAT) THEN
                DO K = 1, 6
                  DEV(K) = DEV(K) + ANIS(I, K)
                END DO
                NDEV = NDEV + 1
                IF (IPR(85) .EQ. 0 .AND. DATC(I) .GT. 0.0) THEN
                  YUNK = DATC(I) - UEQ
                  WRITE (NQ3, 99938) YUNK
C * ALERT _224
                  IF ((SUEQ .LE. 0.0 .AND. ABS(YUNK) .GT. 0.001) .OR.
     1                (SUEQ .GT. 0.0 .AND. ABS(YUNK) .GT. SUEQ)) THEN
                    CALL PLA231 (
     1                224, 3, ABS(YUNK), 1.0, NQ3, NAMS(1, 2)(2:8))
                  END IF
                END IF
              END IF
              FORMA(111:111) = CHAR(ICHAR('0') + NDEC)
              IF (ISUEQ .LE. 0) SUEQ = -1
              IF (DUMA(1) .LT. PAR(12)) THEN
                D13 = -1.0
                IF (DUMA(1) .LT. 0) THEN
                  NQ3 = 'N.P.D. '
                ELSE
                  NQ3 = '2Dimens'
                END IF
              ELSE
                D13 = DUMA(3) / DUMA(1)
                D21 = DUMA(2) - DUMA(1)
                D32 = DUMA(3) - DUMA(2)
                IF (D32 .LT. D21) THEN
                  NQ3 = 'oblate '
                ELSE
                  NQ3 = 'prolate'
                END IF
              END IF
              DATC(I) = UEQ
              IF (I .LE. NAT) THEN
                IF (NHAT .EQ. 0) THEN
                  BOK(1, 1) = BOK(1, 1)     + UEQ
                  BOK(1, 2) = MIN (BOK(1, 2), UEQ)
                  BOK(1, 3) = MAX (BOK(1, 3), UEQ)
                  KBO(1, 1) = KBO(1, 1) + 1
                END IF
                BOK(NIEN + 1, 1) = BOK(NIEN + 1, 1)     + UEQ
                BOK(NIEN + 1, 2) = MIN (BOK(NIEN + 1, 2), UEQ)
                BOK(NIEN + 1, 3) = MAX (BOK(NIEN + 1, 3), UEQ)
                KBO(NIEN + 1, 1) = KBO(NIEN + 1, 1) + 1
                BOK(NIEN + 1, 5) = MIN (BOK(NIEN + 1, 5), UEQ)
                BOK(NIEN + 1, 6) = MAX (BOK(NIEN + 1, 6), UEQ)
                IF (D13 .GT. 0.0) SQD13 = SQRT(D13)
                ND13     = ' '
                IF (D13 .LE. 0.0 .OR. SQD13 .GT. 2.0) THEN
                  IF (D13 .GT. 9.0 .OR. D13 .LT. 0.0) THEN
                    WRITE (LU6, 99959)
     1              NAMS(1, 2), (DUMA(J), J = 1, 3), D13, NQ3
                    ND13     = '#'
                    IPR(135) = IPR(135) + 1
                  END IF
                  IF (D13 .LT. 0) THEN
                    NCOD = 211 + NADD
C * ALERT _211 +
                    IF (IGBL(22) .NE. -1) CALL PLA231 (
     1                     NCOD, 1, 1.0, 1.0, NAMS(1, 2)(2:8), ' ')
                  ELSE
                    IF (NAMS(1, 1)(1:1) .EQ. '*') THEN
                      NCOD = 215 + NADD
                      IF (IGBL(22) .NE. -1) CALL PLA231 (
     1                  NCOD, 1, SQD13, SQD13, NAMS(1, 1)(2:8), ' ')
                    ELSE
C * ALERT _213 - Oblate/Prolate UIJ
                      IF (NHAT .EQ. 0) THEN
                        NCOD = 213 + NADD
                        IF (IGBL(22) .NE. -1) CALL PLA231 (
     1                    NCOD, 1, SQD13, SQD13, NAMS(1, 2)(2:8), NQ3)
                      END IF
                    END IF
                  END IF
                END IF
                IF (IPR(32) .NE. 0) THEN
                  NRAT = NRAT + 1
                  IF (IGBL(63) .GT. 2) THEN
                    WRITE (PRBUF, FORMA) NRAT, NAMS(1, 2),
     1                (ANIS(I, J), ISDV(J), J = 1, 6), UEQ, ISUEQ,
     2                (DUMA(J), J = 1, 3), D13, ND13
                    CALL PLA263 (LU7, PRBUF, 132, 1, 9)
                    CALL GEN025 (UIJC, DUMA, 1)
                    IF (IPR(347) .GT. 0) THEN
                      CALL PLA262 (1)
                      WRITE (LU7, 99972) (DUMA(J), J = 1, 6)
                    END IF
                  END IF
                END IF
              END IF
              IF (I .LE. NATC) THEN
                IF (IGBL(31) .LT. 0) THEN
                  CALL GEN048 (-5, IFG(3, I), 14, IPART)
                  IPARTI = IPART - 16
                  IF (IPARTI .NE. IPARTO) THEN
                    WRITE (LU2, 99934 ) IPARTI
                    IPARTO = IPARTI
                  END IF
                  WRITE (LU2, 99997) NQ2(1:4), ISCFT,
     1            (CON(I, K), K = 1, 3), CHAR(ICHAR('=')),
     2             POPL, (ANIS(I, K), K = 1, 6)
                ELSE IF (IPR(438) .EQ. 1 .OR. IGBL(31) .EQ. 3) THEN
                  WRITE (LU2, 99986) NAMS(1, 2)(2:7),
     1                               (ANIS(I, K), K = 1, 6), UEQ
                  WRITE (LU2, 99985) NAMS(1, 1)(2:7),
     1                               (SUAN(I, K), K = 1, 6), SUEQ
                END IF
              END IF
            ELSE IF (JM .EQ. 1) THEN
              DATC(I) = ANIS(I, 1)
              IF (I .LE. NATC) THEN
                IF (IGBL(31) .LT. 0) THEN
                  CALL GEN048 (-5, IFG(3, I), 14, IPART)
                  IPARTI = IPART - 16
                  IF (IPARTI .NE. IPARTO) THEN
                    WRITE (LU2, 99934) IPARTI
                    IPARTO = IPARTI
                  END IF
                WRITE (LU2, 99996) NQ2(1:4), ISCFT,
     1            (CON(I, K), K = 1, 3), POPL, ANIS(I, 1)
                ELSE IF (IPR(438) .EQ. 1 .OR. IGBL(31) .EQ. 3) THEN
                  WRITE (LU2, 99988) NAMS(1, 2)(2:7),
     1                                ANIS(I, 1), SUAN(I, 1)
                END IF
              END IF
              IF (IPR(32) .NE. 0 .AND. I .LE. NAT) THEN
                NRAT = NRAT + 1
                IF (NHAT .EQ. 0) THEN
                  BOK(1, 1) = BOK(1, 1)     + ANIS(I, 1)
                  BOK(1, 2) = MIN (BOK(1, 2), ANIS (I, 1))
                  BOK(1, 3) = MAX (BOK(1, 3), ANIS(I, 1))
                  KBO(1, 1) = KBO(1, 1) + 1
                END IF
                BOK(NIEN + 1, 1) = BOK(NIEN + 1, 1)     + ANIS(I, 1)
                BOK(NIEN + 1, 2) = MIN (BOK(NIEN + 1, 2), ANIS(I, 1))
                BOK(NIEN + 1, 3) = MAX (BOK(NIEN + 1, 3), ANIS(I, 1))
                KBO(NIEN + 1, 1) = KBO(NIEN + 1, 1) + 1
                BOK(NIEN + 1, 5) = MIN (BOK(NIEN + 1, 5), ANIS(I, 1))
                BOK(NIEN + 1, 6) = MAX (BOK(NIEN + 1, 6), ANIS(I, 1))
                IF (IGBL(63) .GT. 2) THEN
                  WRITE (PRBUF, FORMB) NRAT, NAMS(1, 2),
     1              ANIS(I, 1), ISDV(1), ANIS(I, 1), ISDV(1)
                  CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                END IF
              END IF
            END IF
            IF (IGBL(31) .LT. 0) THEN
              JSCFT = 0
              DO J = 1, IAN
                IF (IEN(IENS(J)) .EQ. 1) JSCFT = J
              END DO
              NCH = 0
              NM  = 3
              CALL GEN048 (-3, IFG(2, I), 24,  NCH)
              CALL GEN048 (-3, IFG(3, I), 25,  NHAT)
              IF (NCH .GT. 0) THEN
                IF (IEN(NIEN) .EQ. 2) THEN
                  CALL GEN048 (-4, IFG(1, I), 24, IHYB)
                  IF (NCH .EQ. 1) THEN
                    IF (IHYB .EQ. 1) THEN
                      NM = 163
                    ELSE IF (IHYB .EQ. 2) THEN
                      NM = 43
                    ELSE IF (IHYB .EQ. 3) THEN
                      NM = 13
                    END IF
                  ELSE IF (NCH .EQ. 2) THEN
                    IF (IHYB .EQ. 2) THEN
                      NM = 93
                    ELSE IF (IHYB .EQ. 3) THEN
                      NM = 23
                    END IF
                  ELSE IF (NCH .EQ. 3) THEN
                    IF (IHYB .EQ. 3) THEN
                      IF (NHAT .EQ. 6) THEN
                        NM = 127
                      ELSE
                        NM = 137
                      END IF
                    END IF
                  END IF
                END IF
                IAFIX = 0
                IF (IMET .EQ. 1) THEN
                  DISTMAX = 1.8
                ELSE
                  DISTMAX = 1.2
                END IF
                DO J = 1, NATC
                  CALL GEN048 (-1, IFG(1, J), 7, JHAT)
                  IF (JHAT .NE. 0) THEN
                    CALL GEN048 (-5, IFG(3, J), 14, JPART)
                    IPARTJ = JPART - 16
                    JUNK   = 0
                    IF (IPARTI .EQ. IPARTJ) THEN
                      JUNK = 1
                    ELSE IF (IPARTI .EQ. 0 .OR. IPARTJ .EQ. 0) THEN
                      JUNK = 1
                    END IF
                    IF (JUNK .EQ. 1) THEN
                      XJ = VOID((J - 1) * (NP4 + 15) + 4)
                      YJ = VOID((J - 1) * (NP4 + 15) + 5)
                      ZJ = VOID((J - 1) * (NP4 + 15) + 6)
                      DIST = SQRT ((XI - XJ)**2 + (YI - YJ)**2
     1                     +       (ZI - ZJ)**2)
                      IF (DIST .LT. DISTMAX) THEN
                        IF (IPR493 .EQ. 6) THEN
                          YNK = ANIS(I, 1)
                        ELSE
                          YNK = -1.2
                          IF (NM .EQ. 127 .OR. NM .EQ. 137 .OR.
     1                      (NM .EQ. 3 .AND. IEN(IENS(ISCFT)) .EQ. 3))
     2                      YNK = -1.5
                        END IF
                        JUNK = 0
                        IF (IPARTO .NE. IPARTJ) THEN
                          WRITE (LU2, 99934) IPARTJ
                          IPARTO = IPARTJ
                        ENDIF
                        IAFIX = IAFIX + 1
                        IF (IAFIX .EQ. 1) WRITE (LU2, 99961) NM
                        CALL PLA047 (LABA(J), NQ3, IDUM, JDUM, 0,
     1                    IGBL(55), IPDB, 0)
                        WRITE (LU2, 99953) NQ3(1:4), JSCFT,
     1                    (CON(J, K), K = 1, 3), 10.0 + CON(J, 4), YNK
                      END IF
                    END IF
                  END IF
                END DO
                IF (IAFIX .GT. 0) WRITE (LU2, 99961) 0
              END IF
            END IF
            IF (JM .GT. 1) THEN
              J = IPR(297) + (I - 1) * 21
              DO K = 1, 3
                V8(K) = VOID(J + K + 6)
              END DO
              XDUM = SQRT (GEN009 (V8, V8))
              DO K = 1, 3
                V8(K) = V8(K) * (VOID(J + 12) - MAX(VOID(J + 10), 0.0))
     1                / XDUM
              END DO
              CALL GEN002 (1, ROR, V8, V6, XLNG)
              J = (I - 1) * (NP4 + 15)
              DO K = 1, 3
                V5(K) = VOID(J + K) - V6(K)
                V8(K) = VOID(J + K) + V6(K)
              END DO
              IF (I .LE. NATC .AND. IGBL(63) .GT. 2) THEN
                CALL PLA262 (1)
                WRITE (LU7, 99952) (V5(K), K = 1, 3), (V8(K), K = 1, 3)
              END IF
            END IF
          END IF
        END DO
        IF (IPR(32) .NE. 0) THEN
          DO I = 2, IAN + 1
            IF (BOK(I, 5) .GT. 0.0) THEN
              BOK(I, 4) = MIN (9.9999, BOK(I, 6) / BOK(I, 5))
            ELSE
              BOK(I, 4) = 0.0
            END IF
            IF (BOK(I, 5) .GT. 1000.0) BOK(I, 5) = 0.0
          END DO
          DO I = 1, IAN
            J = IENS(I)
            IF (BOK(J + 1, 4) .GT. 1.5) THEN
              IF (LMT(J, 1) .EQ. ' H' .OR. LMT(J, 1) .EQ. ' D') THEN
                K = 2 + NADD
              ELSE
                K = NADD
              END IF
C * ALERT _220 +
              IF (IGBL(22) .NE. -1) CALL PLA231 (
     1         220 + K, 1, BOK(J + 1, 4), BOK(J + 1, 4), LMT(J, 1), ' ')
            END IF
          END DO
        END IF
        IF (NDEV .GT. 0) THEN
          DO I = 1, 6
            DEV(I) = DEV(I) / NDEV
          END DO
          CALL GEN025 (UIJ, DEV, -1)
          CALL GEN114 (PAR, OR, UIJ, UIJC, DUMA, DUMV, UEQ)
          CALL PLA262 (3)
          RATIO = DUMA(3) / DUMA(1)
          IF (IGBL(63) .GT. 2) WRITE (LU7, 99948) (DEV(K), K = 1, 6),
     1            UEQ, (DUMA(K), K = 1, 3), RATIO
C * ALERT _250
          IF (NDEV .GT. 5 .AND. IGBL(22) .NE. -1)
     1      CALL PLA231 (250, 1, RATIO, RATIO, ' ', ' ')
        END IF
      END DO
      IF (IPR(32) .NE. 0) THEN
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (15)
          WRITE (LU7, 99983)
          CALL PLA262 (6)
          WRITE (LU7, 99968) (LMT(IENS(I), 1), I = 1, IAN)
          WRITE (LU7, 99967) BOK(1, 1) / MAX (1, KBO(1, 1)),
     1      (BOK(IENS(I) + 1, 1) /
     2      MAX (1, KBO(IENS(I) + 1, 1)), I = 1, IAN)
        END IF
        DO I = 1, IAN + 1
          IF (BOK(I, 2) .GT. 0.0) THEN
            BOK(I, 1) = MIN (9.9999, BOK(I, 3) / BOK(I, 2))
          ELSE
            BOK(I, 1) = 0.0
          END IF
          IF (BOK(I, 2) .GT. 1000.0) BOK(I, 2) = 0.0
        END DO
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (4)
          WRITE (LU7, 99966) BOK(1, 2), (BOK(IENS(I) + 1, 2),
     1                       I = 1, IAN)
          WRITE (LU7, 99965) BOK(1, 3), (BOK(IENS(I) + 1, 3),
     1                       I = 1, IAN)
          WRITE (LU7, 99964) BOK(1, 1), (BOK(IENS(I) + 1, 1),
     1                       I = 1, IAN)
          WRITE (LU7, 99957) KBO(1, 1), (KBO(IENS(I) + 1, 1),
     1                       I = 1, IAN)
        END IF
      END IF
      IF (IGBL(31) .EQ. -2 .OR. IGBL(31) .EQ. -3) THEN
        IF (GEN135 (PAR(231)) .EQ. 0.0) THEN
          WRITE (LU2, 99969) (PAR(230 + I), I = 1, 9)
        ELSE
          WRITE (LU2, 99940)
        END IF
        IF (IPR(209) .GT. 0) THEN
          DO I0 = 1, 12
            IF (LAUEGR .EQ. NLAUE(I0)) EXIT
          END DO
          WRITE (LU2, 99954) (PAR(230 + I), I = 1, 9),
     1      SPGRNM(1)(12:13), I0, SPGRNM(1)(1:7)
        END IF
      END IF
      IF (IGBL(31) .LT.  0) WRITE (LU2, 99995)
      IF (IGBL(31) .EQ. 3 .AND. IPR(504) .NE. 2) THEN
        IF (GEN135 (PAR(231)) .EQ. 0.0) THEN
          WRITE (LU2, 99969) (PAR(230 + I), I = 1, 9)
        ELSE
          WRITE (LU2, 99969)
        END IF
        IF (IGBL(97) .EQ. 0) THEN
          WRITE (LU2, 99944)
        ELSE
          WRITE (LU2, 99943)
        END IF
      END IF
      IF (IPR(43) .GT. 0 .AND. IGBL(22) .NE. -1) THEN
C * ALERT _301
        IF (XPV(3) .GT. 0.0)
     1    CALL PLA231 (301, 0, -999.0,
     2                 XPV(3) * 100.0 / XPV(1), ' ', ' ')
C * ALERT _302
        IF (XPV(4) .GT. 0.0)
     1    CALL PLA231 (302, 0, -999.0,
     2                 XPV(4) * 100.0 / XPV(2), ' ', ' ')
      END IF
      IF (IPR(504) .EQ. 2) THEN
        IF (GEN135 (PAR(231)) .EQ. 0.0) THEN
          WRITE (LU2, 99969) (PAR(I), I = 231, 239)
        ELSE
          WRITE (LU2, 99940)
        END IF
        IF (IPR(595) .EQ. 0) THEN
          WRITE (LU2, 99956) IPR(209), ' '
        ELSE
          WRITE (LU2, 99956) IPR(209), 'NOSF'
        END IF
        CLOSE (UNIT = LU1, IOSTAT = IOST)
        CLOSE (UNIT = LU2, IOSTAT = IOST)
        IF (IOST .EQ. 0 .OR. IOST .NE. 0) CALL PLA280 ('END')
        KXT    = 3
        EXTENS = 'eld'
        FNLU1 = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
        OPEN (UNIT = LU1, FILE = FNLU1, FORM = 'FORMATTED',
     1         STATUS = 'OLD')
        IPR(3)  = 1
        IGBL(8) = 1
      END IF
      IF (IGBL(94) .EQ. 0) THEN
        IF (IPR(489) + IPR(490) .GT. 0) THEN
C * ALERT _201
          IF (IPR(489) .GT. 0 .AND. IGBL(22) .NE. -1) THEN
            IF (IPR(105) .EQ. 0) THEN
              CALL PLA231 (201, 0, FLOAT(IPR(489)), FLOAT(IPR(489)),
     1                     ' ', ' ')
            ELSE
              CALL PLA231 (201, 0, -999.0, FLOAT(IPR(489)), ' ', ' ')
            END IF
          END IF
C * ALERT _202
          IF (IPR(490) .GT. 0 .AND. IGBL(22) .NE. -1) THEN
            IF (IPR(105) .EQ. 0) THEN
              CALL PLA231 (202, 0, FLOAT(IPR(490)), FLOAT(IPR(490)),
     1                     ' ', ' ')
            ELSE
              CALL PLA231 (202, 0, -999.0, FLOAT(IPR(490)), ' ', ' ')
            END IF
          END IF
        END IF
C * ALERT _210
        IF (IPR(32) .EQ. 0 .AND. IGBL(22) .NE. -1) THEN
          IF (IPR(105) .EQ. 0) THEN
            CALL PLA231 (210, 0, 1.0, 1.0, ' ', ' ')
          ELSE
            CALL PLA231 (210, 0, -999.0, 1.0, ' ', ' ')
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT ('FVAR ', 6F10.5, ' =', 8(/, 5X, 6F10.5, '='))
99998 FORMAT ('TEMP ', I5)
99997 FORMAT (A, I3, 3F9.5, 1X, A, /, 5X, F10.5, 6F9.4)
99996 FORMAT (A, I3, 3F9.5, F10.5, F9.4)
99995 FORMAT ('END')
99994 FORMAT ('SCAT', 16(1X, A))
99993 FORMAT (/, 57X, 13('='), /, 56('*'), ' Residue = ', I3, 1X,
     1 61('*'), /, 57X, 13('=')/)
99992 FORMAT ('RESD ', I5)
99991 FORMAT (132('-'), /, 'Atom  Label', 3X, 'U11 or Uiso', 6X, 'U22',
     1 10X, 'U33', 10X, 'U23', 10X, 'U13', 10X, 'U12', 8X, 'Ueq(sUeq)',
     2 5X, 'U1', 5X, 'U2', 5X, 'U3', 2X, 'U3/U1', /, 132('-'))
99990 FORMAT ('VOLU ', 2F10.3)
99989 FORMAT ('SPGR P1')
99988 FORMAT ('U    ', A, 2F10.5)
99987 FORMAT ('ATOM ', A, 1X, 2(3F9.6, F7.4))
99986 FORMAT ('UIJ  ', A, 1X, 7F9.5)
99985 FORMAT ('SUIJ ', A, 1X, 7F9.5)
99984 FORMAT ('(An)isotropic, Equivalent and Main Axes Displacement ',
     1 'Parameters - Unusual Values Marked with a ', A,
     2 ' - [Optional Coordinate Split-up]', /, 132('-'))
99983 FORMAT (/, 49X, 21('='), /, 38X, 'The Displacement Factor has ',
     1 'the Form of Exp(-T)'//54X, 'where'//29X, 'T = 8*(pi**2)*Uiso*',
     2 'sin(theta/lambda)**2, for Isotropic Atoms,'//2X, 'T = 2*(pi',
     3 '**2)*(U11*(h*as)**2+U22*(k*bs)**2+U33*(l*cs)**2+2*U23*k*l*',
     4 'bs*cs+2*U13*h*l*as*cs+2*U12*h*k*as*bs),for Anisotr. Atoms'//
     5 37X, ' Ueq = 1/3 Sum(i,j) (Uij*as(i)*as(j)*a(i).a(j))',//, 34X,
     6 ' U1, U2, U3 are the three Main Axes Components of Uij', //,
     7 'Reference U(eq): R.X. Fischer & E. Tillmanns, ',
     8 'Acta Cryst. (1988). C44, 775-776')
99982 FORMAT ('TITL ', A)
99981 FORMAT ('SFAC ', A, 7F10.5, ' =', /, 7X, 4F10.5, F10.3, 2F10.5)
99980 FORMAT ('UNIT ', 2I5, 14I4)
99979 FORMAT ('CESD', 9X, 3F10.4, 3F10.3)
99978 FORMAT ('LATT ', A, 2X, A)
99977 FORMAT ('SYMM ', A)
99976 FORMAT ('SPGR ', 5A)
99975 FORMAT ('LATT', I4)
99974 FORMAT ('CELL', F9.5, 3F10.4, 3F10.3)
99973 FORMAT ('TRNS ', 9F8.4, ' = ', /, 5X, 3F8.4)
99972 FORMAT (13X, 6(F13.4))
99971 FORMAT ('ZERR', I9, 3F10.4, 3F10.3)
99970 FORMAT ('NOMOVE')
99969 FORMAT ('HKLF 4 1', 9F8.4)
99968 FORMAT (/, 'Ueq [or U(iso)] Averages per Element', /,
     1        132('-'), /, 10X, 'Non-H', 16(3X, A, 2X))
99967 FORMAT (132('-'), /, 'Average', 1X, 17F7.4)
99966 FORMAT ('Minimum', 1X, 17F7.4)
99965 FORMAT ('Maximum', 1X, 17F7.4)
99964 FORMAT ('Ratio  ', 1X, 17F7.4)
99963 FORMAT ('HEADER', 1X, A, /, 'CRYST1', 3F9.3, 3F7.2, 1X, A, /,
     1        'SCALE1', 4X, 3F10.7, 5X, F10.7, /,
     2        'SCALE2', 4X, 3F10.7, 5X, F10.7, /,
     3        'SCALE3', 4X, 3F10.7, 5X, F10.7)
99962 FORMAT ('ATOM', 2X, I5, 1X, A, 5X, I5, 4X, 3F8.3, 2F6.2, 10X, A)
99961 FORMAT ('AFIX', I4)
99960 FORMAT ('REM RESET CLOSENESS CRITERIUM', /,
     1 'SET PAR 22', F10.3)
99959 FORMAT (':: ADP ', A, 3F8.3, ' - RATIO(MAX/MIN) = ', F8.1, 1X, A)
99958 FORMAT ('W: No Wavelength given, MoKa - assumed for SFAC')
99957 FORMAT ('Number', 2X, 17I7)
99956 FORMAT ('SET IPR 209', I3, /, 'CALC SHELX ', A, /, 'END')
99955 FORMAT ('ATOM ', A, 1X, A, 1X, 3F9.4, F6.3, 3F9.4, F6.2)
99954 FORMAT ('REM TRMX', 9F7.3, 1X, A, I3, /, 'REM SPGR ', A)
99953 FORMAT (A, I3, 5F9.5, F9.3)
99952 FORMAT (15X, '[', F9.4, 2F13.4, ']  [', F9.4, 2F13.4,']')
99951 FORMAT ('SET PAR 2', F6.2)
99948 FORMAT (/, 'U(i,j)-Average', F11.4, 5F13.4, 6X, 4F7.4, F7.2, /)
99944 FORMAT ('INORGANIC')
99943 FORMAT ('ORGANIC')
99942 FORMAT ('L.S. 5', /, 'FMAP 2', /, 'PLAN -20', /, 'ACTA', /,
     1        'BOND $H', /, 'CONF')
99941 FORMAT ('SFAC', 16(1X, A))
99940 FORMAT ('HKLF 4')
99939 FORMAT ('WGHT', 2F10.5)
99938 FORMAT (F7.3)
99937 FORMAT ('BASF', F10.3, /, 'TWIN')
99936 FORMAT ('DISP', 1X, A, 2F10.3, F10.1)
99935 FORMAT ('EXTI', F11.4)
99934 FORMAT ('PART', I4)
99933 FORMAT ('NEUT')
      END SUBROUTINE PLA026
      SUBROUTINE PLA027
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /PL26/ VALI(3), VI(3, 3), VT(3, 3), XOCG(3), XCG(3),
     1 D(3, 3), HCTI(3, 3), HITC(3, 3), R(3, 3), UC(3, 3), UI(3, 3),
     2 ROL(3), SL(3, 3), SO(3, 3), TO(3, 3), TW2(3, 3), TT2(3, 3),
     3 SOM(3,3), TOM(3,3), W3D(3), TOM2(3, 3), TTOM2(3, 3), TOM3(3),
     4 TL(3, 3), AO(20), AN(250), BN(25), AMC(3, 3), ALC(3, 3),
     5 ATC(3, 3), ALM(3, 3), ATM(3, 3), W1(3, 3), W2(3, 3), W3(3),
     6 S1(3, 3), T1(3, 3), T2(3, 3), T3(3)
       CHARACTER ITLS*1
      RIND  = 0.0
      RIND1 = 0.0
      IF (IPR(32) .NE. 0 .AND. IPR(5) .NE. 0 .AND. IPR(14) .NE. 4) THEN
        NMAX = IPR(39)
        NRES = IPR(75)
        DO I = 1, NMAX
          DO J = 1, 6
            CON(I, J) = ANIS(I, J)
          END DO
          CALL GEN048 (-4, IFG(1, I), 15, IVL)
          CON(I, 7) = SATWT(IVL + 1)
          CON(I, 8) = (SUAN(I, 1) + SUAN(I, 2) + SUAN(I, 3)) / 3
        END DO
        DO NRS = 1, NRES
          NATR    = 0
          IPR(73) = 1
          IPR(74) = 1
          ITLS    = 'S'
          DO I = 1, NMAX
            IVL = NP1 + I
            CALL GEN048 (-6, IFG(1, I), 9, IVAL)
            IF (IVAL .EQ. NRS) THEN
              CALL GEN048 (-1, IFG(1, I), 4, IVAL)
              IF (IVAL .NE. 0) THEN
                IF (IPR(497) .NE. 0) THEN
                  IVAL = 0
                ELSE
                  CALL GEN048 (-1, IFG(1, I), 7, IVAL)
                END IF
                IF (IVAL .EQ. 0) THEN
                  IVL  = I
                  NATR = NATR + 1
                  CALL PLA047 (LABA(I), NQ1, IVAL, JDUM, IPR(71),
     1                         IGBL(55), 0, 0)
                END IF
              END IF
            END IF
            IATP(I) = IVL
          END DO
          IF (IPR(32) .NE. 0) THEN
            RMSD = 0.0
            IF (NATR .GE. IPR(21)) THEN
              CALL PLA054 (1)
              M = 0
              DO N = 1, NMAX
                I = IATP(N)
                IF (I .LE. NP1) THEN
                  M    = M + 1
                  RMSD = RMSD +
     1                   (XPV(1) * XXO(I, 4) + XPV(2) * XXO(I, 5) +
     2                    XPV(3) * XXO(I, 6) - XPV(4)) ** 2
                END IF
              END DO
              RMSD = SQRT (RMSD / M)
            END IF
            IF (RMSD .LT. 0.05) THEN
              WRITE (LU6, 99998, IOSTAT = IOST) NRS, IPR(21)
            ELSE
              DO I = 1, 3
                VALI(I)  =  DUMA(I)
                XOCG(I)  =  V7(I)
                VI(I, 3) =  DUMV(I, 1)
                VI(I, 1) =  DUMV(I, 3)
                VI(I, 2) = -DUMV(I, 2)
                VT(3, I) =  DUMV(I, 1)
                VT(1, I) =  DUMV(I, 3)
                VT(2, I) = -DUMV(I, 2)
              END DO
              CALL GEN018 (VALI(1), VALI(3))
              DO K = 1, NMAX
                IF (IATP(K) .LE. NP1) THEN
                  DO I = 1, 3
                    XXO(K, I) = 0.0
                    DO J = 1, 3
                      XXO(K, I) = XXO(K, I) + (XXO(K, J + 3)
     1                          - XOCG(J)) * VI(J, I)
                    END DO
                  END DO
                END IF
              END DO
              DO I = 1, 3
                DO J = 1, 3
                  IF (I .EQ. J) THEN
                    D(I, I) = PAR(112 + I)
                  ELSE
                    D(I, J) = 0.0
                  END IF
                END DO
              END DO
              CALL GEN132 (VT, OR, D, HCTI)
              CALL GEN003 (HCTI, HITC, DET, 0)
              DO N = 1, NMAX
                IF (IATP(N) .LE. NP1) THEN
                  DO I = 1, 6
                    DUMA(I) = CON(N, I)
                  END DO
                  CALL GEN025 (UC, DUMA, -1)
                  CALL GEN001 (1, HCTI,  UC,   UI)
                  SUAN(N, 1) = UI(1, 1)
                  SUAN(N, 2) = UI(1, 2)
                  SUAN(N, 3) = UI(1, 3)
                  SUAN(N, 4) = UI(2, 2)
                  SUAN(N, 5) = UI(2, 3)
                  SUAN(N, 6) = UI(3, 3)
                END IF
              END DO
              CALL GEN074 (BN, 1, 25,  0.0)
              CALL GEN074 (AN, 1, 250, 0.0)
              NN = 12 + IPR(74) * 8
              DO I = 1, NMAX
                IF (IATP(I) .LE. NP1) THEN
                  DO JLOOP = 1, 6
                    J = JLOOP
                    CALL GEN100 (AO, J, XXO(I, 1), XXO(I, 2), XXO(I, 3))
                    M = NN + 1
                    DO N = 1, NN
                      Y     = AO(N)
                      L     = M
                      M     = M + NN - N + 1
                      BN(N) = BN(N) + Y * SUAN(I, J)
                      IF (ABS(Y) .GT. 1.0E-15) THEN
                        AN(N) = AN(N) + Y**2
                      END IF
                      DO K = N, NN
                        IF (ABS(Y) .GT. 1.0E-15 .AND.
     1                      ABS(AO(K)) .GT. 1.0E-15) THEN
                          AN(L) = AN(L) + Y * AO(K)
                        END IF
                        L = L + 1
                      END DO
                    END DO
                  END DO
                END IF
              END DO
              IF (IGBL(63) .GT. 2) THEN
                IF (IPR(322) .EQ. 0) THEN
                  CALL PLA262 (-2)
                  WRITE (LU7, 99999, IOSTAT = IOST)
                END IF
                IF (NRES .NE. 1) THEN
                  CALL PLA262 (5)
                  WRITE (LU7, 99997, IOSTAT = IOST) NRS
                END IF
              END IF
              IF (IPR(322) .EQ. 0) THEN
                CALL GEN012 (AN, BN, NN, 0.0, PAR(410), 1.0)
                IF (IGBL(63) .GT. 2) THEN
                  CALL PLA262 (5)
                  WRITE (LU7, 99996, IOSTAT = IOST)
                END IF
                NNA   = 0
                SUM   = 0.0
                SUM1  = 0.0
                SUMN  = 0.0
                SUMN1 = 0.0
                DELM  = 0.0
                DO I = 1, NMAX
                  IF (IATP(I) .LE. NP1) THEN
                    DO JLOOP = 1, 6
                      J       = JLOOP
                      DUMA(J) = - SUAN(I, J)
                      SUMN    = SUMN  + DUMA(J)**2
                      SUMN1   = SUMN1 + ABS(DUMA(J))
                      CALL GEN100 (AO, J, XXO(I, 1), XXO(I, 2),
     1                             XXO(I, 3))
                      DO K = 1, NN
                        DUMA(J) = DUMA(J) + AO(K) * AN(K)
                      END DO
                      SUM  = SUM  + DUMA(J)**2
                      SUM1 = SUM1 + ABS(DUMA(J))
                      IF (ABS(DUMA(J)) .GT. DELM) DELM = ABS(DUMA(J))
                    END DO
                    NNA = NNA + 6
                    IF (IGBL(63) .GT. 2) THEN
                      CALL PLA047 (LABA(I), NQ1, IDUM, JDUM,
     1                  IPR(71), IGBL(55), 0, 1 - IGBL(55))
                      CALL PLA262 (2)
                      UEQO = (SUAN(I, 1) + SUAN(I, 4) + SUAN(I, 6))
     1                     / 3.0
                      UEQC = UEQO + (DUMA(1) + DUMA(4) + DUMA(6)) / 3.0
                      WRITE (LU7, 99995, IOSTAT = IOST)
     1                NQ1, (SUAN(I, K), DUMA(K), K = 1, 6), UEQO, UEQC
                      UI(1, 1) = DUMA(1)
                      UI(1, 2) = DUMA(2)
                      UI(1, 3) = DUMA(3)
                      UI(2, 1) = UI(1, 2)
                      UI(2, 2) = DUMA(4)
                      UI(2, 3) = DUMA(5)
                      UI(3, 1) = UI(1, 3)
                      UI(3, 2) = UI(2, 3)
                      UI(3, 3) = DUMA(6)
                      CALL GEN001 (1, HITC, UI, UC)
                      WRITE (LU7, 99993, IOSTAT = IOST)
     1                  CON(I, 1), UC(1, 1), CON(I, 6), UC(1, 2),
     2                  CON(I, 5), UC(1, 3), CON(I, 2), UC(2, 2),
     3                  CON(I, 4), UC(2, 3), CON(I, 3), UC(3, 3)
                    END IF
                  END IF
                END DO
                SIG   = SQRT(SUM / (NNA - IPR(73) * NN))
                RIND1 = SUM1 / SUMN1
                RIND  = SQRT(SUM / SUMN)
                IF (IGBL(63) .GT. 2) THEN
                  CALL PLA262 (17)
                  WRITE (LU7, 99994, IOSTAT = IOST)
     1              RIND1, RIND, SIG, NATR, IPR(73), NN, DELM, ITLS
                END IF
                DO I = 1, NN
                  BN(I) = BN(I) * SIG
                END DO
                CALL PLA043 (0, 1, LU7, 0)
              END IF
              IF (RIND .GT. PAR(34) .OR. IPR(322) .GT. 0) THEN
                CALL PLA029 (0, W1, W2, NRS)
              ELSE
                CALL PLA029 (1, W1, W2, NRS)
              END IF
            END IF
          END IF
        END DO
      END IF
      RETURN
99999 FORMAT ('V.Schomaker and K.N.Trueblood Rigid Body Motion',
     1 ' Analysis, TLS - Model   (Acta Cryst. (1968), B24, 63-76)',
     2 '  -  see also Dunitz, p244', /, 132('='))
99998 FORMAT (/, ':: No TLS-Analysis for Resd Nr:', I3,
     1 ', # non-H atoms <', I3, ' and/or Planar Molecule', /)
99997 FORMAT (/, 57X, 13('='), /, 56('*'), ' Residue =', I4, 1X,
     1 61('*'), /, 57X, 13('='), /)
99996 FORMAT ('Observed Vibration Tensor in Inertial System ',
     1 'I(1) = L, I(2) = M',
     2 ', I(3) = N (Difference U(calc) - U(obs) in Parentheses)', /,
     3 132('='), /, 'Label     U(L,L)', 12X, 'U(L,M)', 12X, 'U(L,N)',
     4 12X, 'U(M,M)', 12X, 'U(M,N)', 12X, 'U(N,N)', 9X,
     5 'Ueq(obs) Ueq(cal)', /, 12X, 'U11', 15X, 'U12', 15X, 'U13',
     6 15X, 'U22', 15X, 'U23', 15X, 'U33', /, 132('-'))
99995 FORMAT (A, 6(F9.5, '[', F7.5, ']'), F8.4, F9.4)
99994 FORMAT (//
     1 'R1 = Sum(abs(U(obs)-U(calc)))/Sum(abs(U(obs)))     =', F10.5,//
     2 'R2 = Sqrt(Sum((U(obs)-U(calc))**2)/Sum(U(obs)**2)) =', F10.5,//
     3 'S  = Sqrt(Sum((U(obs)-U(calc))**2)/(6*N-NS*M))     =', F10.5,//
     4 'N  = Number of Atoms in Rigid Group', 16X,        '=', I10  ,//
     5 'NS = Symmetry Factor', 31X, '=', I10, //, 'M  = Number of ',
     6 'Rigid-Body Parameters', 15X, '=', I10, //, 5X,
     7 'Largest abs(U(obs)-U(calc))', 19X, '=', F10.5, //, 54X, 'TL', A,
     8 '-Mode')
99993 FORMAT (7X, 6(F9.5, '[', F7.5, ']'))
       END SUBROUTINE PLA027
      SUBROUTINE PLA028
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PL26/ VALI(3), VI(3, 3), VT(3, 3), XOCG(3), XCG(3),
     1 D(3, 3), HCTI(3, 3), HITC(3, 3), R(3, 3), UC(3, 3), UI(3, 3),
     2 ROL(3), SL(3, 3), SO(3, 3), TO(3, 3), TW2(3, 3), TT2(3, 3),
     3 SOM(3,3), TOM(3,3), W3D(3), TOM2(3, 3), TTOM2(3, 3), TOM3(3),
     4 TL(3, 3), AO(20), AN(250), BN(25), AMC(3, 3), ALC(3, 3),
     5 ATC(3, 3), ALM(3, 3), ATM(3, 3), W1(3, 3), W2(3, 3), W3(3),
     6 S1(3, 3), T1(3, 3), T2(3, 3), T3(3)
      K = 0
      DO I = 1, 3
        DO J = I, 3
          K = K + 1
          W1(I, J) = AN(K)
          W1(J, I) = AN(K)
          T1(I, J) = AN(K + 6)
          T1(J, I) = T1(I, J)
          S1(I, J) = 0.0
          S1(J, I) = 0.0
        END DO
      END DO
      BN(21) = 0.0
      IF (IPR(74) .NE. 0) THEN
        S1(1, 1) = AN(13)
        S1(1, 2) = AN(14)
        S1(1, 3) = AN(15)
        S1(2, 1) = AN(16)
        S1(2, 2) = AN(17)
        S1(2, 3) = AN(18)
        S1(3, 1) = AN(19)
        S1(3, 2) = AN(20)
        S1(3, 3) = -AN(13) - AN(17)
        BN(21) = SQRT(BN(13)**2 + BN(17)**2)
      END IF
      CALL GEN024 (W1, W2, W3, TW2)
      CALL GEN024 (T1, T2, T3, TT2)
      CALL GEN004 (VT, OR, AMC)
      CALL GEN132 (W2, VT, OR, ALC)
      CALL GEN002 (1, ROR, XOCG, XCG, XLNG)
      CALL GEN001 (1, W2, S1, SL)
      CALL GEN001 (1, W2, T1, TL)
      ROL(1) = (SL(2, 3) - SL(3, 2)) / (W3(2) + W3(3))
      ROL(2) = (SL(3, 1) - SL(1, 3)) / (W3(3) + W3(1))
      ROL(3) = (SL(1, 2) - SL(2, 1)) / (W3(1) + W3(2))
      R(1, 1) =   0.0
      R(1, 2) =   ROL(3)
      R(1, 3) = - ROL(2)
      R(2, 1) = - ROL(3)
      R(2, 2) =   0.0
      R(2, 3) =   ROL(1)
      R(3, 1) =   ROL(2)
      R(3, 2) = - ROL(1)
      R(3, 3) =   0.0
      DO N = 1, 3
        DO I = 1, 3
          SO(N, I) = R(I, N) * W3(N) + SL(N, I)
        END DO
      END DO
      DO I = 1, 3
        DO L = 1, 3
          TO(I, L) = 0.0
          DO J = 1, 3
            TO(I, L) = TO(I, L) + R(I, J) * R(L, J) * W3(J)
     1               + R(I, J) * SL(J, L) + R(L, J) * SL(J, I)
          END DO
          TO(I, L) = TO(I, L) + TL(I, L)
        END DO
      END DO
      CALL GEN001 (1, TW2, TO, TOM)
      CALL GEN001 (1, TW2, SO, SOM)
      CALL GEN024 (TOM, TOM2, TOM3, TTOM2)
      CALL GEN132 (TOM2, VT, OR, ATC)
      DO I = 1, 3
        W3D(I) = W3(I) * RGBL(6)**2
        DO J = 1, 3
          AMCIJ = AMC(I, J) / PAR(100 + J)
          IF (ABS(AMCIJ) .GT. 1.0) AMCIJ = SIGN (1.0, AMCIJ)
          AMC(I, J) = ACOS (AMCIJ) * RGBL(6)
          ALCIJ     = ALC(I, J) / PAR(100 + J)
          IF (ABS(ALCIJ) .GT. 1.0) ALCIJ = SIGN (1.0, ALCIJ)
          ALC(I, J) = ACOS(ALCIJ) * RGBL(6)
          ATCIJ     = ATC(I, J) / PAR(100 + J)
          IF (ABS(ATCIJ) .GT. 1.0) ATCIJ = SIGN (1.0, ATCIJ)
          ATC(I, J) = ACOS(ATCIJ)      * RGBL(6)
          ALM(I, J) = ACOS(W2(I, J))   * RGBL(6)
          ATM(I, J) = ACOS(TOM2(I, J)) * RGBL(6)
        END DO
      END DO
      TRSO = T3(1)   + T3(2)   + T3(3)
      TRSN = TOM3(1) + TOM3(2) + TOM3(3)
      DO I = 1, 21
        IF (ABS(BN(I)) .GT. 0.99999) BN(I) = 0.999989
      END DO
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (0)
        WRITE (LU7, 99999, IOSTAT = IOST)
     1    (I, (VT(I, J), J = 1, 3), VALI(I),
     2    (AMC(I, J), J = 1, 3), CHAR(ICHAR('W') + I), XCG(I), I = 1, 3)
        WRITE (LU7, 99998, IOSTAT = IOST)
     1   (W1(1, J), NINT(BN(J) * 1.0E+5), J = 1, 3),
     2   (W2(1, J), J = 1, 3), W3(1), W3D(1), SQRT (MAX (0.0, W3D(1))),
     3   (W1(2, J), NINT(BN(J + 2) * 1.0E+5), J = 2, 3),
     4   (W2(2, J), J = 1, 3), W3(2), W3D(2), SQRT (MAX (0.0, W3D(2))),
     5    W1(3, 3), NINT(BN(6) * 1.0E+5),
     6   (W2(3, J), J = 1, 3), W3(3), W3D(3), SQRT (MAX(0.0, W3D(3)))
        WRITE (LU7, 99997, IOSTAT = IOST)
     1    (T1(1, J), NINT(BN(J + 6) * 1.0E+5), J = 1, 3),
     2    (T2(1, J), J = 1, 3), T3(1), SQRT (T3(1)),
     3    (T1(2, J),  NINT(BN(J + 8) * 1.0E+5), J = 2, 3),
     4    (T2(2, J), J = 1, 3), T3(2), SQRT(MAX (0.0, T3(2))),
     5    T1(3, 3), NINT(BN(12) * 1.0E+5),
     6    (T2(3, J), J = 1, 3), T3(3), SQRT (MAX (0.0, T3(3)))
        IF (IPR(74) .NE. 0) THEN
          WRITE (LU7, 99996, IOSTAT = IOST)
     1      (S1(1, J), NINT(BN(J + 12) * 1.0E+5), J = 1, 3),
     2      (S1(2, J), NINT(BN(J + 15) * 1.0E+5), J = 1, 3),
     3      (S1(3, J), NINT(BN(J + 18) * 1.0E+5), J = 1, 3)
          WRITE (LU7, 99995, IOSTAT = IOST) TRSO, TRSN
          WRITE (LU7, 99994, IOSTAT = IOST)
     1      (I, ROL(I), (SOM(I, J), J = 1, 3),
     2      (TOM(I, J), J = 1, 3), I, (TOM2(I, J), J = 1, 3),
     3      TOM3(I), I = 1, 3)
        END IF
        WRITE (LU7, 99993, IOSTAT = IOST)
        WRITE (LU7, 99992, IOSTAT = IOST)
     1    (I, (ALM(I, J), J = 1, 3), (ALC(I, J), J = 1, 3),
     2     I, (ATM(I, J), J = 1, 3), (ATC(I, J), J = 1, 3), I = 1, 3)
      END IF
      RETURN
99999 FORMAT ('Inertial Tensor I, Eigenvectors and Eigenvalues ',
     1 'of I in the Cartesian XO,YO,ZO System and Angular Relation',
     2 ' with X,Y,Z System', /, 132('-'), /, 15X, 'XO', 8X, 'YO',
     3 8X, 'ZO', 10X, 'Value', 14X, 'X', 9X, 'Y', 9X, 'Z', 5X, 'Origin',
     4 ' (Mass-Weighted)', /, 132('-'), /, 3('I(', I1, ')', 3X,
     5 3F10.5, 5X, F10.2, 6X, 3F10.2, 3X, A, ' =', F9.5, /))
99998 FORMAT ('Librational Tensor, L(rad**2)', 25X, 'Eigenvectors ',
     1 'and Eigenvalues of L in the Inertial System XI,YI,ZI', /,
     2 132('-'), /, 66X, 'XI', 8X, 'YI', 8X, 'ZI', 9X, 'rad**2', 4X,
     3 'Deg**2', 7X, 'Deg', /, 132('-'), /, F8.5, '(', I3, ')', F11.5,
     4 '(', I3, ')', F11.5, '(', I3, ')', 9X, 'L(1)', 3F10.5, 5X,
     5 F10.5, 2F10.2, /, 16X, F8.5, '(', I3, ')', F11.5, '(', I3,
     6 ')', 9X, 'L(2)', 3F10.5, 5X, F10.5, 2F10.2, /, 32X, F8.5, '(',
     7 I3, ')', 9X, 'L(3)', 3F10.5, 5X, F10.5, 2F10.2, /)
99997 FORMAT ('Translational Tensor, T(ang**2)', 23X, 'Eigenvectors',
     1 ' and Eigenvalues of T in the Inertial System XI,YI,ZI', /,
     2 132('-'), /, 66X, 'XI', 8X, 'YI', 8X, 'ZI', 10X, 'Ang^2', 12X,
     3 'Ang', /, 132('-'), /, F8.5, '(', I3, ')', F11.5, '(', I3,
     4 ')', F11.5, '(', I3, ')', 9X, 'T(1)', 3F10.5, 2F15.5, /, 16X,
     5 F8.5, '(', I3, ')', F11.5, '(', I3, ')', 9X, 'T(2)', 3F10.5,
     6 2F15.5, /, 32X, F8.5, '(', I3, ')', 9X, 'T(3)', 3F10.5,
     7 2F15.5)
99996 FORMAT ('Cross Tensor, S(rad*Ang)', /, 132('-'),
     1 3(/, F8.5, '(', I3, ')', 2(F11.5, '(', I3, ')')), /)
99995 FORMAT ('Calculation of the Origin Shift that Symmetrizes S',
     1 23X, '-  Trace old-T = ', F10.5, 7X, 'Trace new-T = ', F10.5, /,
     2 132('-'), /, 'Shift Origin in I', 17X, 'New S-Tensor', 17X,
     3 'New T-Tensor', 8X, 'Eigenvectors and Values of New-T in ',
     4 'I-System', /, 132('-'))
99994 FORMAT ('Rol(', I1, ')', F10.5, 3X, 3F10.5, 3X, 3F10.5, 1X,
     1 'New T(', I1, ')', 3F9.5, 4X, F9.5)
99993 FORMAT (/43X, 'Angular Relationships (Degrees)', /, 43X, 31('='))
99992 FORMAT ('Libration Axes  -  Inertial  Axes  ',
     1 'Libration Axes - Crystal Axes  ',
     2 'Translation Axes - Inertial  Axes  ',
     3 'Translation Axes - Crystal Axes', /, 64('-'), 2X, 67('-'), /,
     4 15X, 'XI', 6X, 'YI', 6X, 'ZI', 14X, 'X', 7X, 'Y', 7X, 'Z',
     5 18X, 'XI', 6X, 'YI', 6X, 'ZI', 15X, 'X', 7X, 'Y', 7X, 'Z', /,
     6 3('L(', I1, ')', 5X, 3F8.2, 7X, 3F8.2,
     7 2X, 'New T(', I1, ')', 2X, 3F8.2, 8X, 3F8.2, /))
      END SUBROUTINE PLA028
      SUBROUTINE PLA029 (MODE, W, W2, NRS)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION W(3, 3), WO(3, 3), DY(3), Z(3), W2(3, 3), ANGL(3)
      CHARACTER XMRK*1, FORM*114
      FORM(1:41)   = '(A,''- '',A,F6.0,''('',I3,'')'',F11.4,3F8.4,1X,'
      FORM(42:79)  = 'F7.0,''('',I2,'')'',1X,F7.0,''('',I2,'')'',1X,'
      FORM(80:114) = 'F7.0,''('',I2,'')'',1X,A,F9.4,2X,3F7.2)'
      NMAX = IPR(39)
      IF (MODE .NE. 0) THEN
        CALL PLA028
        TRACE = W(1, 1) + W(2, 2) + W(3, 3)
        DO I = 1, 3
          DO J = 1, 3
            IF (I .EQ. J) THEN
              TADD = TRACE
            ELSE
              TADD = 0.0
            END IF
            WO(I, J) = (TADD - W(I, J)) / 2
          END DO
        END DO
      ELSE
        IF (IPR(322) .NE. 0 .OR. IPR(43) .NE. 0) THEN
          CALL PLA015 (0, 43)
          WRITE (LU6, 99993, IOSTAT = IOST)
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99993, IOSTAT = IOST)
          END IF
        ELSE
          WRITE (LU6, 99990, IOSTAT = IOST) NRS, PAR(34)
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99990, IOSTAT = IOST) NRS, PAR(34)
          END IF
        END IF
        CALL GEN074 (ANGL, 1, 3, 0.0)
        CALL GEN074 (DY,   1, 3, 0.0)
      END IF
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (-7)
        WRITE (LU7, 99995, IOSTAT = IOST)
        WRITE (LU7, 99994, IOSTAT = IOST)
      END IF
      DELIJ = 0
      NRB   = 0
      NATR  = 0
      DO I = 1, NMAX
        CALL GEN048 (-7, IFG(2, I), 1, IDS)
        IDS = IPPR(IDS + 1, 1)
        CALL GEN048 (-4, IFG(1, I), 24, IHYB)
        CALL GEN048 (-6, IFG(1, I), 9, IVAL)
        NADD = 0
        IF (RCONT(IVAL) .LT. IPR(487) .AND. IPR(75) .GT. 1) NADD = 1
        CALL GEN048 (-1, IFG(1, I), 19, IVALI)
        IF (IATP(I) .LE. NP1) THEN
          CALL PLA047 (LABA(I), NQ1, IDUM, IENI, IPR(71),
     1       IGBL(55), 0, 1 - IGBL(55))
          RVLI   = REL(IENI)
          IATPRI = IATPR(IENI)
          NR1    = IATNR(IENI)
          NATR   = NATR + 1
          DO J = I, NMAX
            IF (I .NE. J .AND. IATP(J) .LE. NP1) THEN
              CALL GEN048 (-7, IFG(2, J), 1, JDS)
              JDS = IPPR(JDS + 1, 1)
              CALL GEN048 (-4, IFG(1, J), 24, JHYB)
              CALL PLA047 (LABA(J), NQ2, IDUM, IENJ, IPR(71),
     1                     IGBL(55), 0, 1 - IGBL(55))
              IATPRJ = IATPR(IENJ)
              CALL GEN048 (-1, IFG(1, J), 31, IVAL)
              IF (IATPRI * IVAL .LE. 0) THEN
                NR2  = IATNR(IENJ)
                IF (IATPRI .GT. 0 .AND. IATPRJ .GT. 0) THEN
                  DMAX = 2.0
                ELSE
                  DMAX = RVLI + REL(IENJ) + PAR(2)
                END IF
                DO K = 1, 3
                  V7(K) = XXO(I, K) - XXO(J, K)
                END DO
                CALL PLA053 (I, J, 0, 0, S, SSU, ISSU, NDEC, IER)
                IF (S .GT. 0.001 .AND. S .LT. DMAX) THEN
                  SC = 0.0
                  IF (MODE .NE. 0) CALL GEN002 (1, WO, V7, DY, XLNG)
                  DO K = 1, 3
                    IF (MODE .NE. 0) THEN
                      Z(K) = V7(K) + DY(K)
                      SC   = SC + Z(K)**2
                    END IF
                    V7(K) = V7(K) / S
                  END DO
                  IF (MODE .NE. 0) THEN
                    CALL GEN002 (1, W2, V7, ANGL, XLNG)
                    DO K = 1, 3
                      ANG = MAX (-1.0, MIN (1.0, ANGL(K)))
                      ANGL(K) = ACOS(ANG) * RGBL(6)
                    END DO
                    SC = SQRT(SC)
                  END IF
                  VI = 0.0
                  VJ = 0.0
                  DO K = 1, 3
                    DO L = 1, 3
                      M = K * L
                      IF (M .EQ. 6) M = 5
                      IF (M .EQ. 9) M = 6
                      VI = VI + V7(K) * SUAN(I, M) * V7(L)
                      VJ = VJ + V7(K) * SUAN(J, M) * V7(L)
                    END DO
                  END DO
                  SVI = CON(I, 8)
                  CALL GEN041 (VI, SVI, ISVI, 5, NSVI, IPR(68))
                  SVJ = CON(J, 8)
                  CALL GEN041 (VJ, SVJ, ISVJ, 5, NSVJ, IPR(68))
                  ISVI = MAX (0, MIN (99, ISVI))
                  ISVJ = MAX (0, MIN (99, ISVJ))
                  DIJ  = ABS(VI - VJ)
                  XMRK = ' '
                  NDIJ = 5
                  IF (ISVI .GT. 0 .AND. ISVJ .GT. 0) THEN
                    SDIJ = SQRT(CON(I, 8)**2 + CON(J, 8)**2)
                    CALL GEN041 (DIJ, SDIJ, IDIJ, 5, NDIJ, IPR(68))
                    IDIJ   = MIN (99, IDIJ)
                    THIRSH = DIJ / SDIJ
                    IF (THIRSH .GT. PAR(421)) XMRK = '#'
                  ELSE
                    IDIJ = 0
                  END IF
                  DELIJ = DELIJ + DIJ**2
                  NRB   = NRB + 1
                  SDIJ  = SQRT(DIJ)
                  IF (I .LE. IPR(37)) THEN
                    CALL GEN048 (-1, IFG(1, I), 6, IGEN)
                    IF (IGEN .EQ. 1) THEN
                      JUNK = IPR(37)
                    ELSE
                      JUNK = IPR(39)
                    END IF
                    IF ((IDS .EQ. JDS  .AND. IDS .GT. 500)  .OR.
     1                  (IDS .LT. 1000 .AND. JDS .EQ. 1000) .OR.
     2                  (IDS .EQ. 1000 .AND. JDS .LT. 1000)) THEN
                      IF (J .LE. JUNK .AND. NR2 .LE. NR1) THEN
                        IF (IGBL(63) .GT. 2) THEN
                          ISSU = MIN (999, ISSU)
                          FORM(14:14) = CHAR(ICHAR('0') + NDEC)
                          FORM(45:45) = CHAR(ICHAR('0') + NSVI)
                          FORM(64:64) = CHAR(ICHAR('0') + NSVJ)
                          FORM(83:83) = CHAR(ICHAR('0') + NDIJ)
                          WRITE (PRBUF, FORM, IOSTAT = IOST)
     1                      NQ1, NQ2, S, ISSU, SC, DY, VI, ISVI, VJ,
     2                      ISVJ, DIJ, IDIJ, XMRK, SDIJ, ANGL
                          CALL PLA263 (LU7, PRBUF, 132, 1, 3)
                        END IF
                        IF (IDIJ .NE. 0) THEN
                          IF (THIRSH .GT. PAR(421))
     1                      WRITE (LU6, 99991, IOSTAT = IOST)
     2                      NQ1, NQ2, THIRSH
                          IF (THIRSH .GT. 2.0 .AND. DIJ .GT. 0.001) THEN
                            CALL GEN048 (-1, IFG(1, J), 19, IVALJ)
                            NAD = NADD + 2 * MAX (IVALI, IVALJ)
C * ALERT _234
                            IF (THIRSH .LE. 5.0) THEN
                              CALL PLA231 (234, 2, SDIJ, SDIJ, NQ1, NQ2)
                            ELSE
C * ALERT _23x : Hirshfeld
                              THIRSH0 = THIRSH
                              IF (NR2 .EQ. 8) THEN
                                IF (NR1 .EQ. 30) THEN
                                  DISTMAX = 2.3
                                ELSE IF (NR1 .GT. 36) THEN
                                  DISTMAX = 2.6
                                ELSE
                                  DISTMAX = 10.0
                                ENDIF
                                IF (S .GT. DISTMAX) THIRSH0 = -999.0
                              END IF
                              IF (IDS .LT. 1000 .OR. JDS .LT. 1000)
     1                          THIRSH0 = -999.0
                              IF (IHYB .EQ. 1 .OR. JHYB .EQ. 1)
     1                          THIRSH0 = -999.0
                              IF ((IATPRI .GT. 0 .AND. IATPRJ .EQ. -7)
     1                          .OR.
     2                           (IATPRI .EQ. -7 .AND. IATPRJ .GT. 0))
     3                          THIRSH0 = -999.0
                              IF ((NR1 .EQ. 14 .AND. IATPRJ .EQ. -7)
     1                          .OR.
     2                           (IATPRI .EQ. -7 .AND. NR2 .EQ. 14))
     3                          THIRSH0 = -999.0
                              IF (NAD .NE. 0) THEN
                                IF ((PAR(287) .GT. 0.65 .AND.
     1                               THIRSH .LE. 15.0) .OR.
     2                              (PAR(287) .GT. 0.6 .AND.
     3                               THIRSH .LT. 10.0) .OR.
     4                               (PAR(173) .LT. 2.0 .AND.
     5                                PAR(168) .GT. 27.45))
     6                                 THIRSH0 = -999.0
                              END IF
                              CALL PLA231 (
     1                          230 + NAD, 1, THIRSH0, THIRSH, NQ1, NQ2)
                            END IF
                          END IF
                        END IF
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END DO
        END IF
      END DO
      IF (NRB .GT. 0) DELIJ = SQRT(DELIJ / NRB)
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (5)
        WRITE (LU7, 99992, IOSTAT = IOST) DELIJ, PAR(421)
      END IF
      IF (NATR .LE. 40) THEN
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (0)
          CALL PLA262 (5)
          WRITE (LU7, 99999, IOSTAT = IOST) (J, J = 1, NATR)
          WRITE (LU7, 99998, IOSTAT = IOST)
        END IF
        N0 = 0
        DO I = 1, NMAX
          IF (IATP(I) .LE. NP1) THEN
            CALL PLA047 (LABA(I), NQ1, IDUM, IENI, IPR(71),
     1        IGBL(55), 0, 0)
            RVLI = REL(IENI)
            N0 = N0 + 1
            N  = 0
            DO J = 1, NMAX
              IF (IATP(J) .LE. NP1) THEN
                CALL GEN048 (-4, IFG(1, J), 15, IVLJ)
                DMAX = RVLI + REL(IEN(IVLJ + 1)) + PAR(2)
                S = 0
                V = 0
                IF (I .NE. J) THEN
                  DO K = 1, 3
                    V7(K) = XXO(I, K) - XXO(J, K)
                    S     = S + V7(K)**2
                  END DO
                  S = SQRT(S)
                  V = S
                  IF (I .LT. J .AND. S .GT. 0.001) THEN
                    DO K = 1, 3
                      V7(K) = V7(K) / S
                    END DO
                    V = 0
                    DO K = 1, 3
                      DO L = 1, 3
                        M = K * L
                        IF (M .EQ. 6) M = 5
                        IF (M .EQ. 9) M = 6
                        V = V + V7(K) * SUAN(I, M) * V7(L)
     1                    - V7(K) * SUAN(J, M) * V7(L)
                      END DO
                    END DO
                    V = V * 1000.0
                  END IF
                END IF
                N = N + 1
                IATC(N) = MIN (99, NINT(ABS(V)))
                IF (S .LT. DMAX) IATC(N) = -IATC(N)
              END IF
            END DO
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (1)
              WRITE (LU7, 99997, IOSTAT = IOST)
     1          N0, NQ1(1:6), (IATC(K), K = 1, N)
            END IF
          END IF
        END DO
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262(8)
          WRITE (LU7, 99996, IOSTAT = IOST)
        END IF
      END IF
      RETURN
99999 FORMAT ('Test Matrix for Rigid-Body Vibrations - /Del(A,B)/ = ',
     1 '/Z(A,B)**2 - Z(B,A)**2/ Should be Near Zero (Acta Cryst. A34,',
     2 ' 1978, 828)', /, 132('='), //, 'Atom-Atom   ', 40I3)
99998 FORMAT (132('-'))
99997 FORMAT (I2, 1X, A, ' - ', 40I3)
99996 FORMAT (/, 'Remarks', /, 7('-'), /, '- Upper Triangle Entries ',
     1 'Represent /Del(A,B)/*1000 Values'//'- Lower Triangle Entries ',
     2 'Represent Distances (A-B) Angstrom'//'- Negative Entries ',
     3 'Indicate Bonded Atoms')
99995 FORMAT ('Rigid-Body Model Libration Corrections for Bond',
     1 ' Distances and "Hirshfeld Rigid-Bond" Test (Acta Cryst., 1976,',
     2 ' A32, 239-244)', /, 132('=')/)
99994 FORMAT (75X, 'MSDA from U(obs)', /, 5X, 'Bond', 11X,
     1 'Bond Distance   Components of the Correction  Vibration Along',
     2 ' the Interatomic Bond', 8X, 'Angle with Lib. Axes', //,
     3 'Atom(I)  Atom(J)', 7X, 'Obsd', 6X, 'Calcd', 2X,
     4 'Del(L)  Del(M)  Del(N)', 4X, 'I to J', 6X,  'J to I', 4X,
     5 'Difference', 2X, 'Sqrt(Diff)    L(1)   L(2)   L(3)', /,
     6  132('-'))
99993 FORMAT (/,
     1      ':: No TLS-Analysis for Polymeric or Disordered Structures')
99992 FORMAT (/, 59X , 'Sqrt(Sum(DelIJ**2)/Nrb) = ', F10.4, //,
     1 30X, '# - Indicates bonds exceeding the', F4.1,
     2 ' sigma test level')
99991 FORMAT (':: ', A, '-', A, 'fails Hirshfeld Rigid Bond test at',
     1 F6.2, ' sigma level')
99990 FORMAT (/, ':: No TLS-Analysis for Residue Nr:', I3,
     1 ', Because R >', F6.2)
      END SUBROUTINE PLA029
      SUBROUTINE PLA030 (XXO, CON, NT, IFG, IPPR, BOND)
      PARAMETER (NP1=20000,NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,
     2 NP17=99,NVD=100000000,NP23=28000,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2 * NP23), VOID(NVD)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION XXO(NP1, 6), NT(NP1), CON(NP1, NP4), IFG(3, NP1),
     1 BOND(*), ISMLST(5), ITMPL(4), IPRIOR(4), NPRIOR(4), WPRIOR(4),
     2 IFTM(4), ISHLPRI(4), IPADF(4), V1(3), V2(3), V3(3), V4(3), V5(3),
     3 V6(3), V7(3), JR(100), JLN(100), NCN(100), IPTR(2, NP1), INB(9),
     4 INE(9), INL(9), LST(9), DTC(NP10), ITC(NP10), IPPR(129, 3)
      CHARACTER NOTE1*1
C * DETERMINE R/S CHIRALITY FOR FOUR COORDINATED ATOMS
C * THIS ROUTINE IS INSPIRED BY THE CODE OF THE FROGRAM CHIRAL BY
C * BY J.G.VINTER, A, DAVIS & P.M. WILLIAMS
      NAT  = IPR(39)
      NATO = IPR(39)
      NBD  = IPR(131)
      CALL PLA034 (1, NAT)
      DO I = 1, NAT
        NC = - NINT(CON(I, NP4))
        IF (NC .GT. 0 .AND. NC .LT. NP4) THEN
          K0 = 0
          DO J = 1, NC
            K = NINT(CON(I, J))
            CALL GEN048 (-7, IFG(2, K), 1, KP)
            KP = IPPR(KP + 1, 1) / IPR(582)
            IF (KP .GT. 0) THEN
              K0 = K0 + 1
              CON(I, K0) = CON(I, J)
            END IF
          END DO
          CON(I, NP4) = - K0
        END IF
      END DO
      DO I = 1, NAT
        CALL PLA099 (0, I, NANG, ANG1, ANG2, ANG3, NOTE1)
      END DO
      DO I = 1, IAN
        DTC(I) = ATWT(IEN(I))
        ITC(I) = I
      END DO
      CALL GEN013 (DTC, ITC, 1, IAN)
      DO I = 1, IAN
        DTC(I) = ITC(I)
        ITC(I) = I
      END DO
      CALL GEN013 (DTC, ITC, 1, IAN)
      DO I = 1, NAT
        CALL GEN048 (-4, IFG(1, I), 15, IDUM)
        NT(I) = ITC(IDUM + 1)
      END DO
      DO I = 1, NBD
        IPQ1 = NINT(BOND(I * 3 - 2))
        IPQ2 = NINT(BOND(I * 3 - 1))
        CALL PLA050 (IPQ1, IPQ2, 0, 0, DIST)
        CALL GEN048 (-4, IFG(1, IPQ1), 24, IHYA)
        CALL GEN048 (-4, IFG(1, IPQ2), 24, IHYB)
        CALL GEN048 (-4, IFG(1, IPQ1), 15, NOIP)
        CALL GEN048 (-4, IFG(1, IPQ2), 15, NOIQ)
        NOIP = IEN(NOIP + 1)
        NOIQ = IEN(NOIQ + 1)
        IF (IHYA .EQ. 1 .AND. IHYB .EQ. 1) THEN
          IBNDO = 3
        ELSE IF (IHYA * IHYB .EQ. 2) THEN
          IBNDO = 2
        ELSE IF (IHYA .EQ. 2 .AND. IHYB .EQ. 2) THEN
          IBNDO = 2
          IF (NOIP .EQ. 2 .AND. NOIQ .EQ. 2) THEN
            IF (DIST .GT. PAR(384)) IBNDO = 1
          END IF
        ELSE IF (NOIP .EQ. 8 .AND. NOIQ .EQ. 3 .AND.
     1           IHYA .EQ. 3 .AND. IHYB .EQ. 2) THEN
          IBNDO = 2
        ELSE
          IBNDO = 1
        END IF
        IF (IBNDO .GT. 1) THEN
          DO J = 2, IBNDO
            ITMP1 = - NINT(CON(IPQ1, NP4)) + 1
            ITMP2 = - NINT(CON(IPQ2, NP4)) + 1
            IF (ITMP1 .LE. 4 .OR. ITMP2 .LE. 4) THEN
              IF (ITMP1 .LE. 4) THEN
                NATO             = NATO + 1
                NT(NATO)         = NT(IPQ2)
                CON(NATO, 1)     = IPQ1
                CON(NATO, NP4)   = - 1
                CON(IPQ1, ITMP1) = NATO
                CON(IPQ1, NP4)   = - ITMP1
              END IF
              IF (ITMP2 .LE. 4) THEN
                NATO             = NATO + 1
                NT(NATO)         = NT(IPQ1)
                CON(NATO, 1)     = IPQ2
                CON(NATO, NP4)   = - 1
                CON(IPQ2, ITMP2) = NATO
                CON(IPQ2, NP4)   = - ITMP2
              END IF
            END IF
          END DO
        END IF
      END DO
      DO I = 1, NAT
        CALL GEN048 (-4, IFG(1, I), 24, IHYA)
        CALL GEN048 (-1, IFG(1, I), 19, IMET)
        NC  = - NINT(CON(I, NP4))
        IF (NC .EQ. 4 .AND. IMET .EQ. 0 .AND. IHYA .EQ. 3) THEN
          JCAI = 2
        ELSE
          JCAI = 0
        END IF
        CALL GEN048 (2, IFG(1, I), 28, JCAI)
        IF (NC .GT. 1) THEN
          IF (NC .LT. 0) NC = NP4
          DO J = 2, NC
            L = NINT(CON(I, J))
            DO K = J - 1, 1, -1
              IF (NT(NINT(CON(I, K))) .GE. NT(L)) GO TO 10
              CON(I, K + 1) = CON(I, K)
            END DO
            K = 0
   10       CON(I, K + 1) = L
          END DO
        END IF
      END DO
      NRTM   = IPR(492)
      NPK    = (NRTM + 1) * 4
      MAXPAD = NP23 * 2 / NPK
      DO 130 KCENT = 1, NAT
        CALL GEN048 (-2, IFG(1, KCENT), 28, JCAK)
        IF (JCAK .EQ. 2) THEN
          CALL GEN048 (2, IFG(1, KCENT), 28, 0)
          ICHIRAL = 2
          DO I = 1, 4
            NPRIOR(I) = NINT(CON(KCENT, I))
            WPRIOR(I) = NT(NINT(CON(KCENT, I)))
          END DO
          CALL GEN013 (WPRIOR, NPRIOR, 1, 4)
          ISMPNTR = 1
   20     NSAME     = 1
          ISMLST(1) = NPRIOR(ISMPNTR)
          DO I = 1, 4 - ISMPNTR
            IF (WPRIOR(ISMPNTR + I) .NE. WPRIOR(ISMPNTR)) EXIT
            ISMLST(I + 1) = NPRIOR(ISMPNTR + I)
            NSAME         = NSAME + 1
          END DO
          IF (NSAME .NE. 1) THEN
            CALL GEN048 (-1, IFG(1, ISMLST(1)), 7,  IDUM)
            IF (IDUM .EQ. 1) GO TO 130
            CALL GEN097 (JNSC, 1, 2 * NP23, 0)
            MAXNUMPAD = 1
            DO ISAM = 1, NSAME
              IHINP = 0
              ISMLST(NSAME + 1) = KCENT
              IPRIOR(ISAM) = 0
              IATOM        = ISMLST(ISAM)
              IPADNUM      = 0
              NRT          = 1
              JR(1)        = KCENT
              JR(2)        = IATOM
   30         IF (NRT .GT. 0) THEN
                NRT = NRT + 1
                IF (NRT .GT. NRTM)  GO TO 50
                IF (NRT .GT. 3) THEN
                  DO K = NRT - 3, 1, -1
                    IF (JR(NRT) .EQ. JR(K)) GO TO 50
                  END DO
                END IF
                NC = - NINT(CON(JR(NRT), NP4))
                IF (NC .LT. 0) NC = NP4
                IF (NC .EQ. 1) GO TO 50
                NCN(NRT) = NC
                JLN(NRT) = 0
   40           IF (NRT .LE. 1) GO TO 60
                JLN(NRT) = JLN(NRT) + 1
                IF (JLN(NRT) .GT. NCN(NRT)) THEN
                  NRT = NRT - 1
                  GO TO 40
                END IF
                JR(NRT + 1) = NINT(CON(JR(NRT), JLN(NRT)))
                IF (JR(NRT + 1) .EQ. JR(NRT - 1)) GO TO 40
                GO TO 30
   50           DO I = 2, NRT
                  JNSC(IPADNUM * NPK + (I - 2) * 4 + ISAM) = JR(I)
                END DO
                IPADNUM = IPADNUM + 1
                NRT = NRT - 1
                JNSC((IPADNUM - 1) * NPK + NRTM * 4 + ISAM) = NRT
                IHINP = MAX (IHINP, NRT)
                IF (IPADNUM .GT. MAXNUMPAD) MAXNUMPAD = IPADNUM
                IF (IPADNUM .EQ. MAXPAD) THEN
                  IPR(126) = IPR(126) + 1
                  WRITE (LU6, 99999, IOSTAT = IOST) MAXPAD
                  ISMLST(1) = -1
                  GO TO 120
                END IF
                GO TO 40
              END IF
   60         DO ISHL = IHINP, 1, -1
                DO J = 1, IPADNUM -1
                  I1 = JNSC(J * NPK + (ISHL - 1) * 4 + ISAM)
                  I2 = JNSC(J * NPK +       NRTM * 4 + ISAM)
                  IF (I1 .GT. 0 .AND. I1 .LE. NATO) THEN
                    I3 = NT(I1)
                  ELSE
                    I3 = 0
                  END IF
                  DO K = 1, IHINP
                    JR(K) = JNSC(J * NPK + (K - 1) * 4 + ISAM)
                  END DO
                  DO I = J, 1, -1
                    I4 = JNSC((I - 1) * NPK + (ISHL - 1) * 4 + ISAM)
                    IF (I4 .GT. 0 .AND. I4 .LE. NATO) THEN
                      I5 = NT(I4)
                    ELSE
                      I5 = 0
                    END IF
                    IF (I5 .GE. I3) GO TO 70
                    DO K = 1, IHINP
                      JNSC(I * NPK + (K - 1) * 4 + ISAM) =
     1                JNSC((I - 1) * NPK + (K - 1) * 4 + ISAM)
                    END DO
                    JNSC(I * NPK + NRTM * 4 + ISAM)
     1                = JNSC((I - 1) * NPK + NRTM * 4 + ISAM)
                  END DO
                  I = 0
   70             JNSC(I * NPK + (ISHL - 1) * 4 + ISAM) = I1
                  DO K = 1, IHINP
                    JNSC(I * NPK + (K - 1) * 4 + ISAM) = JR(K)
                  END DO
                  JNSC(I * NPK + NRTM * 4 + ISAM) = I2
                END DO
              END DO
            END DO
            CALL GEN097 (IPADF, 1, NSAME, 0)
            DO IPAD = 1, MAXNUMPAD
              IHP = 0
              DO I = 1, NSAME
                IHP = MAX (IHP, JNSC((IPAD - 1) * NPK + NRTM * 4 + I))
              END DO
              DO ISHL = 1, IHP
                NCMAX = 0
                DO I = 1, NSAME
                  IPNTR = JNSC((IPAD - 1) * NPK + (ISHL - 1) * 4 + I)
                  IF (IPNTR .GT. 0) THEN
                    IF (NINT(CON(IPNTR, NP4)) .LT. - NCMAX) THEN
                      NCMAX = - NINT(CON(IPNTR, NP4))
                      IF (NCMAX .GT. 6) GO TO 120
                    END IF
                  END IF
                END DO
                DO I = 1, NSAME
                  IF (IPADF(I) .EQ. 0) THEN
                    ISHLPRI(I) = 0
                    IPNTR = JNSC((IPAD - 1) * NPK + (ISHL - 1) * 4 + I)
                    IF (IPNTR .GT. 0) THEN
                      NC =  - NINT(CON(IPNTR, NP4))
                      IF (NC .LT. 0) NC = NP4
                      DO J = 1, NC
                        ISHLPRI(I) = ISHLPRI(I) +
     1                    NT(NINT(CON(IPNTR, J))) *
     2                    (IAN + 1) ** (NCMAX - J)
                      END DO
                    END IF
                  END IF
                END DO
                NFOUND = 0
                DO 80 I = 1, NSAME
                  IF (IPADF(I) .EQ. 1) THEN
                    NFOUND = NFOUND + 1
                  ELSE
                    DO J = 1, NSAME
                      IF (I .NE. J) THEN
                        IF (ISHLPRI(I) .EQ. ISHLPRI(J)
     1                    .AND. IPADF(J) .EQ. 0) GO TO 80
                      END IF
                    END DO
                    IPADF(I) = 1
                    NFOUND   = NFOUND + 1
                    IFTM(I)  = ISHL
                  END IF
   80           CONTINUE
                DO 100 I = 1, NSAME
                  ILOWEST  = ISHLPRI(1) + 1
                  IHIGHEST = 0
                  IHI      = 1
                  ILO      = 1
                  DO J = 1, NSAME
                    IF (ISHLPRI(J) .GT. IHIGHEST) THEN
                      IHI      = J
                      IHIGHEST = ISHLPRI(J)
                    END IF
                    IF (ISHLPRI(J) .LT. ILOWEST .AND.
     1                  ISHLPRI(J) .NE. -1) THEN
                      ILO     = J
                      ILOWEST = ISHLPRI(J)
                    END IF
                  END DO
                  IF (IHIGHEST .NE. 0 .AND. IPADF(IHI) .EQ. 1 .AND.
     1              IFTM(IHI) .EQ. ISHL) THEN
                    DO J = 1, NSAME
                      IF (IPRIOR(J) .EQ. 0) THEN
                        IPRIOR(J)    = IHI
                        ISHLPRI(IHI) = -1
                        GO TO 90
                      END IF
                    END DO
                  END IF
   90             IF (ILOWEST .NE. 0 .AND. IPADF(ILO) .EQ. 1 .AND.
     1               IFTM(ILO) .EQ. ISHL) THEN
                    DO J = NSAME, 1, -1
                      IF (IPRIOR(J) .EQ. 0) THEN
                        IPRIOR(J)    = ILO
                        ISHLPRI(ILO) = - 1
                        GO TO 100
                      END IF
                    END DO
                  END IF
  100           CONTINUE
                IF (NFOUND .EQ. NSAME) THEN
                  DO I = 1, NSAME
                    IF (IPRIOR(I) .LT. 1 .OR. IPRIOR(I) .GT. 4)
     1                  GO TO 120
                    ITMPL(I) = ISMLST(IPRIOR(I))
                  END DO
                  DO I = 1, NSAME
                    ISMLST(I) = ITMPL(I)
                  END DO
                  GO TO 110
                END IF
              END DO
            END DO
            GO TO 130
  110       DO I = 1, NSAME
              IF (ISMLST(I) .LT. 0) GO TO 130
            END DO
          END IF
          DO I = 1, NSAME
            NPRIOR(ISMPNTR + I - 1) = ISMLST(NSAME    - I + 1)
            WPRIOR(ISMPNTR + I - 1) = NT(ISMLST(NSAME - I + 1))
          END DO
          ISMPNTR = ISMPNTR + NSAME
          IF (ISMPNTR .LE. 4) GO TO 20
          DO I = 1, 3
            V1(I) = XXO(NPRIOR(4), I + 3)
            V2(I) = XXO(NPRIOR(3), I + 3)
            V3(I) = XXO(NPRIOR(2), I + 3)
            V4(I) = XXO(NPRIOR(1), I + 3)
          END DO
          CALL GEN008 (V2, V3, V5, 0)
          D =  GEN009 (V1, V5)
          CALL GEN008 (V1, V2, V6, 0)
          CALL GEN015 (V5, V6, V7, 1.0)
          CALL GEN008 (V3, V1, V6, 0)
          CALL GEN015 (V6, V7, V5, 1.0)
          IF (GEN009 (V4, V5) .LT. D) THEN
            ICHIRAL = 1
          ELSE
            ICHIRAL = 3
          END IF
          IF (IABS(2 - ICHIRAL) .EQ. 1) IPR(583) = IPR(583) + 1
  120     CALL GEN048 (2, IFG(1, KCENT), 28, ICHIRAL)
        END IF
  130 CONTINUE
      IF (IGBL(3) .NE. 1 .AND. IGBL(3) .NE. 33 .AND.
     1    IGBL(3) .NE. 34) THEN
        CALL GEN097 (JNSC, 1, 2 * NP23, 0)
        INB(1) = 1
        INE(1) = NATO
        DO I = INB(1), INE(1)
          JNSC ((I - 1) * 8 + 1) = NT(I)
          IPTR (1, I) = NT(I)
          IPTR (2, I) = I
        END DO
        CALL GEN037 (IPTR, INB(1), INE(1))
        MPG    = 0
  140   DO I = INB(1), INE(1)
          NC = - NINT(CON(I, NP4))
          IF (NC .LT. 0 .OR. NC .GT. 6) NC = 6
          IF (NC .GT. 0) THEN
            DO J = 1, NC
              LST(J) = NT(NINT(CON(I, J)))
            END DO
            CALL GEN022 (LST, 1, NC)
            DO K = 1, NC
              JNSC((I - 1) * 8 + K + 1) = LST (NC + 1 - K)
            END DO
          END IF
        END DO
        M          = 1
        MPRI       = 1
  150   INL(M)     = INB(M) - 1
        INB(M + 1) = INB(M)
        N          = JNSC((IPTR(2, INB(M)) - 1) * 8 + M)
        NVB        = JNSC((IPTR(2, INB(M)) - 1) * 8 + M + 1)
        ISORT      = 0
  160   INL(M) = INL(M)  + 1
        IF (INL(M) .LE. INE(M)) THEN
          IPTM = IPTR(2, INL(M))
          IF (JNSC((IPTM - 1) * 8 + M) .EQ. N) THEN
            NVX             = JNSC ((IPTM - 1) * 8 + M + 1)
            IPTR(1, INL(M)) = NVX
            IF (NVX .NE. NVB) ISORT = 1
            NT(IPTM) = MPRI
            GO TO 160
          END IF
        END IF
        INE(M + 1) = INL(M) - 1
        IF (ISORT .EQ. 1) THEN
          CALL GEN037 (IPTR, INB(M + 1), INE(M + 1))
        ELSE
          IF (NVB .EQ. 0) GO TO 170
        END IF
        DO KKK = 1, NATO
          III = IPTR(2, KKK)
          DO NNN = 1, 6
            IF (JNSC((III - 1) * 8 + NNN) .EQ. 0) EXIT
          END DO
        END DO
        IF (M .LT. 8) THEN
          M = M + 1
          GO TO 150
        END IF
  170   INB(M + 1) = INL(M)
        IF (INB(M + 1) .LE. INE(M)) THEN
          N      = JNSC((IPTR(2, INB(M + 1)) - 1) * 8 + M)
          NVB    = JNSC((IPTR(2, INB(M + 1)) - 1) * 8 + M + 1)
          ISORT  = 0
          MPRI   = MPRI + 1
          INL(M) = INL(M) - 1
          GO TO 160
        ELSE
          M = M - 1
          IF (M .EQ. 0) GO TO 180
          GO TO 170
        END IF
  180   IF (MPRI .GT. MPG) THEN
          MPG = MPRI
          GO TO 140
        END IF
        DO K = 1, NAT
          IVAL = NT(K)
          CALL GEN048 (10, IFG(2, K), 14, IVAL)
        END DO
      END IF
      CALL PLA034 (-1, NAT)
      RETURN
99999 FORMAT (':: MAXPATH = ', I4, ' EXCEEDED')
      END SUBROUTINE PLA030
      SUBROUTINE PLA031
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      DIMENSION XMD(9, 2), IXMD(9), ICSD(6)
      CHARACTER FORM*160, FORMI*79, FORMJ*68
      FORMI( 1:28) = '(''Centroid '',A,'': x ,y ,z '','
      FORMI(29:62) = 'F10.5,''('',I4,'')'',F10.5,''('',I4,'')'','
      FORMI(63:79) = 'F10.5,''('',I4,'')'')'
      FORMJ( 1:17) = '(16X,''XO,YO,ZO '','
      FORMJ(18:68) = FORMI(29:79)
      FORM(  1: 15) = '('' From: '',A   '
      FORM( 16: 31) = ',F8.4,''('',I3,'')'''
      FORM( 32: 79) = FORM(16:31)//FORM(16:31)//FORM(16:31)
      FORM( 80:127) = FORM(32:79)
      FORM(128:160) = FORM(16:31)//FORM(16:31)//')'
      NRAT     = IPR(12)
      NAT      = IPR(39)
      IPR(64)  = IPR(64) + 1
      KRC      = NAT + IPR(64)
      DO I = 1, 3
        IFG(I, KRC) = IFG(I, JR(1))
      END DO
      NTRNS(KRC) = NTRNS(JR(1))
      CALL GEN048 (-6, IFG(1, KRC), 9, NRES)
      CALL GEN040 (IPR(19) + IATP(KRC), NQ2, IP)
      NQ1(1:7)      = 'CG     '
      NQ1(3:2 + IP) = NQ2(1:IP)
      CALL PLA046 (1, NQ1, IENM, LBB, LBC, LBD,
     1             INQNR, JNQNR, NIEN)
      CALL GEN048 (6, IFG(1, KRC), 15, NIEN)
      LABA(KRC) = INQNR
      CALL PLA047 (INQNR, NQ1, MN, JDUM, IPR(71), IGBL(55), 0, 0)
      DO K = 1, 3
        YUNK = SQRT(XSD(KRC, K))
        CALL GEN041 (XXO(KRC, K), YUNK, ICSD(K), IPR(183),
     1               NDEC, IPR(68))
        NDC           = K * 17 + 16
        YUNK = SQRT(XSD(KRC, K + 3))
        CALL GEN041 (XXO(KRC, K + 3), YUNK, ICSD(K + 3), 5, NDECJ,
     1       IPR(68))
        NDCJ          = K * 17 + 5
        FORMI(NDC:NDC)   = CHAR(ICHAR('0') + NDEC)
        FORMJ(NDCJ:NDCJ) = CHAR(ICHAR('0') + NDECJ)
        ICSD(K)          = MIN (99, ICSD(K))
        ICSD(K + 3)      = MIN (99, ICSD(K + 3))
      END DO
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (1)
        WRITE (LU7, '(/)', IOSTAT = IOST)
        WRITE (PRBUF, FORMI, IOSTAT = IOST)
     1    NQ1(1:6), (XXO(KRC, K), ICSD(K), K = 1, 3)
        CALL PLA263 (LU7, PRBUF, 132, 1, 3)
        WRITE (PRBUF, FORMJ, IOSTAT = IOST)
     1    (XXO(KRC, K), ICSD(K), K = 4, 6)
        CALL PLA263 (LU7, PRBUF, 132, 1, 3)
      END IF
      IF (NRAT .LE. 7) THEN
        NRAT          = NRAT + 1
        NAMS(NRAT, 1) = ' '//NQ1
        NRT           = NRAT + 1
        NAMS(NRT, 1)  = '  RING '
        NM = 0
        DO 120 I = 1, NAT
          CALL GEN048 (-1, IFG(1, I), 19, MET)
          IF (MET .EQ. 0) GO TO 120
          JR(NRAT)    = KRC
          CALL PLA050 (I, KRC, 0, 0, DCEN)
          IF (DCEN .GT. PAR(422)) GO TO 120
          CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, IPR(71),
     1      IGBL(55), 0, 0)
          CALL PLA055
          CALL PLA056 (XPV(1), I, XMD(NRT, 1), XMD(NRT, 2),
     1                 IDUM1, 5, IDUM2)
          XMD(NRT, 1) = ABS(XMD(NRT, 1))
          IXMD(NRT)   = MIN (999, NINT(10000 * XMD(NRT, 2)))
          DO J = 1, NRAT
            CALL PLA053 (I, JR(J), 0, 0, XMD(J, 1), XMD(J, 2),
     1                  IXMD(J), NDEC, IER)
            IF (IER .EQ. 0) THEN
              IF (XMD(J, 1) .LT. PAR(12)) GO TO 120
              IFT = 4 + J * 16
              FORM(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
            END IF
          END DO
          DPERP = - XPV(4)
          DO J = 1, 3
            DPERP = DPERP + XPV(J) * XXO(I, J + 3)
          END DO
          DSH = SQRT (MAX(0.0, DCEN**2 - ABS(DPERP)**2))
          IF (DSH .GT. PAR(423) .OR. ABS(DPERP) .LT. PAR(424)) GO TO 120
          IF (IGBL(63) .GT. 2) THEN
            NM = NM + 1
            IF (NM .EQ. 1) THEN
              WRITE (LU7, 99998, IOSTAT = IOST)
     1          PAR(422), PAR(424), PAR(423)
              WRITE (LU7, 99997, IOSTAT = IOST)
     1          (NAMS(II, 1)(2:7), II = 1, NRT)
              WRITE (LU7, 99996, IOSTAT = IOST)
            END IF
            WRITE (PRBUF, FORM, IOSTAT = IOST)
     1         NQ1(1:7), (XMD(J, 1), IXMD(J), J = 1, NRT)
            CALL PLA263 (LU7, PRBUF, 132, 1, 3)
            WRITE (LU7, 99999, IOSTAT = IOST) DSH
          END IF
          IF (DSH .LT. PAR(70)) THEN
            JR(NRAT) = I
            DO MM = 1, IPR(51)
              IF (MM .EQ. 1) THEN
                DO J = 2, NRAT
                  CALL PLA100 (JR(NRAT), JR(J - 1), -1, -1.0)
                END DO
                CALL PLA100 (JR(NRAT), KRC, 1, -1.0)
              ELSE
                CALL GEN098 (MOL(MM), PAR(42), IPR(54),
     1               ITR(1), ITR(2), ITR(3), IR)
                IF (NRES .EQ. IR) THEN
                  KAT       = IPR(39) + IPR(64) + 1
                  IF (MN .GT. IPR(463)) THEN
                    IPR(2) = 54
                    GO TO 130
                  END IF
                  LABA(KAT) = LABA(KRC) + MM - 1
                  DO J = 1, IPR(64)
                    IF (LABA(KAT) .EQ. LABA(IPR(39) + J)) THEN
                      KAT = IPR(39) + J
                      GO TO 70
                    END IF
                  END DO
                  IPR(64) = IPR(64) + 1
                  CALL PLA059 (KRC, KAT)
                  DO J = 1, 3
                    IFG(J, KAT) = IFG(J, KRC)
                  END DO
                  DO J = 1, 6
                    VOID((KAT - 1) * (NP4 + 15) + J)     = XXO(KAT, J)
                    VOID((KAT - 1) * (NP4 + 15) + J + 6) = XSD(KAT, J)
                  END DO
                  CALL GEN048 (6, IFG(1, KAT), 9, IR)
   70             DO 100 J = 1, NRAT
                    KAT1 = KAT + 1
                    CALL PLA059 (JR(NRAT + 1 - J), KAT1)
                    DO K = 1, NAT
                      CALL PLA050 (K, KAT1, 0, 0, DIST)
                      IF (DIST .LT. 0.05) THEN
                        IF (J .EQ. 1) THEN
                          KMETAL = K
                          CALL PLA100 (KMETAL, KAT, 1, -1.0)
                        ELSE
                          CALL PLA100 (KMETAL, K, -1, -1.0)
                        END IF
                        GO TO 100
                      ENDIF
                    END DO
  100             CONTINUE
                END IF
              END IF
            END DO
          END IF
  120   CONTINUE
      END IF
  130 RETURN
99999 FORMAT (/, 'Ring-Slippage: Distance Between Perpendicular ',
     1 'Projection of Heavy Atom on Ring L.S.-Plane and Ring ',
     2 'Centroid =', F6.3, ' Ang'/)
99998 FORMAT (///, 10X, 'Metal - Ring Geometry [d(Metal-Cg) < ',
     1 F5.1, ' Ang., d(perp) > ', F5.1, ' Ang., Slippage < ',
     2 F6.3, ' Ang.]', /, 10X, 102('='), /)
99997 FORMAT ('Distance (Ang) to:', 1X, A, 8(7X, A))
99996 FORMAT (132('-'))
      END SUBROUTINE PLA031
      SUBROUTINE PLA032 (NRSD)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER FORM*73
      SA   = 0.0
      ISA  = 0
      NDEC = 0
      IF (IPR(8) .GT. 0) THEN
        IPR(60) = 0
        NAT     = IPR(37)
        MTL     = 3
        NTOR    = 0
        KB      = 0
        FORM(1 :4)  = '(1X,'
        FORM(5:24)  = '4(A),F8.2,''('',I3,'')'''
        FORM(25:48) = ',4X,'//FORM(5:24)
        FORM(49:73) = FORM(25:48)//')'
        DO NHB = 1, 2
          IHB = NHB - 1
          IF (IHB .EQ. 1 .AND. IGBL(63) .GT. 2) THEN
            CALL PLA262 (1)
            WRITE (LU7, '( )', IOSTAT = IOST)
          END IF
          DO 70 JAT = 1, NAT
            JR(2)   = JAT
            JATL    = LABA(JAT) / IPR(463)
            CALL GEN048 (-6, IFG(1, JAT), 9, IRESJ)
            IF (IRESJ .NE. NRSD) GO TO 70
            CALL GEN048 (-1, IFG(1, JAT), 7, IHJ)
            NJ = - NINT(CON(JAT, NP4))
            IF (NJ .LT. 0) THEN
              NJ = NP4
              CALL GEN048 (-1, IFG(1, JAT), 8, IVAL)
              IF (IVAL .GT. 0) NJ = NJ + IPR(76)
            END IF
            IF (NJ .LE. 1) GO TO 70
            DO 60 KJ = 1, NJ
               IF (KJ .LE. NP4) THEN
                 KAT = NINT(CON(JAT, KJ))
               ELSE
                 IF (IBON(KJ - NP4, 1) .NE. JAT) GO TO 60
                 KAT = IBON(KJ - NP4, 2)
               END IF
               JR(3) = KAT
               KATL = LABA(KAT) / IPR(463)
               IF (JATL .GT. KATL) GO TO 60
               NK = - NINT(CON(KAT, NP4))
               IF (NK .LT. 0) THEN
                 NK = NP4
                 CALL GEN048 (-1, IFG(1, KAT), 8, IVAL)
                 IF (IVAL .GT. 0) NK = NK + IPR(76)
               END IF
               IF (NK .LE. 1) GO TO 60
               CALL GEN048 (-1, IFG(1, KAT), 7,  IHK)
               IF (NJ .LE. IPR(163) .AND. NK .LE. IPR(163))
     1            CALL PLA033 (NJ, NK)
               DO 50 KI = 1, NJ
                  IF (KI .LE. NP4) THEN
                    IAT = NINT(CON(JAT, KI))
                  ELSE
                    IF (IBON(KI - NP4, 1) .NE. JAT) GO TO 50
                    IAT = IBON(KI - NP4, 2)
                  END IF
                  JR(1) = IAT
                  IF (IAT .EQ. KAT) GO TO 50
                  CALL GEN048 (-1, IFG(1, IAT), 7,  IHI)
                  DO 40 KK = 1, NK
                     IF (KK .LE. NP4) THEN
                       LAT = NINT(CON(KAT, KK))
                     ELSE
                       IF (IBON(KK - NP4, 1) .NE. KAT) GO TO 40
                       LAT = IBON(KK - NP4, 2)
                     END IF
                     JR(4) = LAT
                     IF (LAT .EQ. JAT) GO TO 40
                     IF (IAT .EQ. LAT) GO TO 40
                     CALL GEN048 (-1, IFG(1, LAT), 7, IHL)
                     IHA = IHI + IHJ + IHK + IHL
                     IF (IHB .EQ. 0) THEN
                       IF (IHA .GT. 0) GO TO 40
                     ELSE
                       IF (IHA .EQ. 0) GO TO 40
                     END IF
                     KB1 = KB + 1
                     CALL PLA036 (IAT, KB1, 1, IDS1, MNUM1, ISP1,
     1                            IPR(71), IGBL(55))
                     IF (IDS1 .LT. 500) GO TO 50
                     CALL PLA036 (JAT, KB1, 2, IDS2, MNUM2, ISP2,
     1                            IPR(71), IGBL(55))
                     IF (IDS2 .LT. 500) GO TO 70
                     CALL PLA036 (KAT, KB1, 3, IDS3, MNUM3, ISP3,
     1                            IPR(71), IGBL(55))
                     IF (IDS3 .LT. 500) GO TO 60
                     CALL PLA036 (LAT, KB1, 4, IDS4, MNUM4, ISP4,
     1                            IPR(71), IGBL(55))
                     IF (IDS4 .LT. 500) GO TO 40
                     IVLT = 0
                     IF (MNUM1 .GT. 1) THEN
                       IVLT = IVLT + 1
                     END IF
                     IF (MNUM2 .GT. 1) THEN
                       IVLT = IVLT + 1
                     END IF
                     IF (MNUM3 .GT. 1) THEN
                       IVLT = IVLT + 1
                     END IF
                     IF (MNUM4 .GT. 1) THEN
                       IVLT = IVLT + 1
                     END IF
                     ITEST = (4 - ISP1 - ISP2 - ISP3 - ISP4) / 2
                     IF (IVLT .GT. ITEST) GO TO 40
                     CALL PLA050 (IAT, JAT, KAT, 0, A)
                     IF (A .GT. PAR(15)) GO TO 40
                     CALL PLA050 (JAT, KAT, LAT, 0, A)
                     IF (A .GT. PAR(15)) GO TO 40
                     CALL PLA053 (IAT, JAT, KAT, LAT, A, SA, ISA,
     1                            NDEC, IER)
                     IF (IER .NE. 0) GO TO 40
                     KB        = KB + 1
                     NTOR      = NTOR + 1
                     DBUF(KB)  = A
                     IDBUF(KB) = ISA
                     IFT       = -11 + KB * 24
                     FORM(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
                     IF (IPR(438) .EQ. 1) THEN
                       IF(IPR(430) .LE. 0 .OR. IHA .EQ. 0) THEN
                         IPR(253) = IPR(253) + 1
                         WRITE (LU2, 99998, IOSTAT = IOST)
     1                    (NAMS(KB, M)(2:8), M = 1, 4), A, SA
                       END IF
                     END IF
                     CALL GEN048 (-3, IFG(2, KAT), 24, KMET)
                     CALL GEN048 (-4, IFG(1, KAT), 24, KHYB)
                     NCK = NINT(CON(KAT, NP4))
                     CALL GEN048 (-3, IFG(2, JAT), 24, JMET)
                     CALL GEN048 (-4, IFG(1, JAT), 24, JHYB)
                     NCJ = NINT(CON(JAT, NP4))
                     IF (NCK .EQ. -4) THEN
                       IF (KMET .EQ. 3 .AND. JHYB .EQ. 2) THEN
                         IF (180.0 - ABS(A) .LT. 0.15) THEN
C * ALERT _380
                           CALL PLA231 (
     1                       380, 2, -999.0, 1.0, NAMS(KB, 3)(2:8), ' ')
                         END IF
                       END IF
                     END IF
                     IF (NCJ .EQ. -4) THEN
                       IF (JMET .EQ. 3 .AND. KHYB .EQ. 2) THEN
                         IF (180.0 - ABS(A) .LT. 0.15) THEN
C * ALERT _380
                           CALL PLA231 (
     1                       380, 2, -999.0, 1.0, NAMS(KB, 2)(2:8), ' ')
                         END IF
                       END IF
                     END IF
                     IF (NTOR .EQ. 1) THEN
                       IF (IPR(134) .EQ. 1) THEN
                         IF (IGBL(63) .GT. 2) THEN
                           CALL PLA262 (4)
                           WRITE (LU7, 99996, IOSTAT = IOST) NRSD
                         END IF
                         IPR(134) = 0
                       END IF
                       IF (IGBL(63) .GT. 2) THEN
                         CALL PLA262 (3)
                         WRITE (LU7, 99997, IOSTAT = IOST) '>', PAR(15)
                       END IF
                     END IF
                     IF (KB .LT. MTL) GO TO 40
                     IF (IGBL(63) .GT. 2) THEN
                       WRITE (PRBUF, FORM, IOSTAT = IOST)
     1                   ((NAMS(L, M)(2:8), M = 1, 4),
     2                   DBUF(L), IDBUF(L), L = 1, MTL)
                       CALL PLA263 (LU7, PRBUF, 132, 1, 3)
                     END IF
                     KB = 0
   40             CONTINUE
   50          CONTINUE
   60       CONTINUE
   70     CONTINUE
          IF (KB .GT. 0) THEN
            IF (IGBL(63) .GT. 2) THEN
              WRITE (PRBUF, FORM, IOSTAT = IOST)
     1          ((NAMS(L, M)(2:8), M = 1, 4),
     2          DBUF(L), IDBUF(L), L = 1, KB)
              CALL PLA263 (LU7, PRBUF, 132, 1, 3)
            END IF
            KB = 0
          END IF
        END DO
        IF (IPR(60) .NE. 0) CALL PLA033 (0, 0)
      END IF
      RETURN
99998 FORMAT ('TORS ', 4(A, 2X), 2F7.2)
99997 FORMAT (/, 'Torsion/Dihedral Angles (Deg.) - Klyne & Prelog',
     1 ' Convention (Dunitz, p241) - (Excl. Minor Disorder & Embedded',
     2 ' Bond Angl. ', A, F5.0, ' Deg.)', /, 132('='))
99996 FORMAT (/, 57X, 13('='), /, 56('*'), ' Residue =', I4, 1X,
     1 61('*'), /, 57X, 13('='))
      END SUBROUTINE PLA032
      SUBROUTINE PLA033 (NJ, NK)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION YUNK(3, 3)
      NTYP = -1
      IF (NJ .NE. 0) THEN
        IPR(60) = IPR(60) + 1
        J       = JR(2)
        K       = JR(3)
        CALL PLA227 (K, J, RMAT(1, 3))
        DEN = SQRT(RMAT(1, 3)**2 + RMAT(2, 3)**2)
        IF (DEN .LT. PAR(12)) THEN
          RMAT(1, 2) = 0.0
          RMAT(2, 2) = 1.0
        ELSE
          RMAT(1, 2) =  RMAT(2, 3) / DEN
          RMAT(2, 2) = -RMAT(1, 3) / DEN
        END IF
        RMAT(3, 2) = 0.0
        CALL GEN008 (RMAT(1, 2), RMAT(1, 3), RMAT(1, 1), 1)
        CALL GEN005 (RMAT, YUNK)
        CALL GEN052 (YUNK, RMAT)
        JJ = 0
        DO I = 1, NJ
          I1 = NINT(CON(J, I))
          IF (I1 .NE. K) THEN
            JJ = JJ + 1
            IATC(JJ) = I1 + NP1
          END IF
        END DO
        DO I = 1, NK
          I1 = NINT(CON(K, I))
          IF (I1 .NE. J) THEN
            JJ = JJ + 1
            IATC(JJ) = I1
          END IF
        END DO
        CALL PLA044 (RMAT, J, XR0, YR0, ZR0, 0.0, 0.0, 0.0, 1.0, 0.0)
        DO I = 1, JJ
          DATC(I) = 90.0
          L = MOD(IATC(I), NP1)
          CALL PLA044 (RMAT, L, XR, YR, ZR, XR0, YR0, ZR0, 1.0, 0.0)
          IF (ABS(XR) .GT. 0.00001) THEN
            DATC(I) = ATAN2(YR, XR) * RGBL(6)
            IF (DATC(I) .LT. 0.0) DATC(I) = DATC(I) + 360.0
          END IF
        END DO
        CALL GEN013 (DATC, IATC, 1, JJ)
        ISH           = (IPR(60) - 1) * 60
        IATP(1 + ISH) = JJ
        IATP(2 + ISH) = J
        IATP(3 + ISH) = K
        DO I = 1, JJ
          IATP(I + 3  + ISH) = IATC(I)
          IATP(I + 20 + ISH) = NINT(100.0 * (DATC(I) - DATC(1)))
          IATP(I + 38 + ISH) = NINT(100.0 * (DATC(I) - DATC(1)))
        END DO
        DO I = 2, JJ
          DO J = 1, 6
            DELX = PAR(24) * ABS(COS(IATP(I + 38 + ISH) / RGBL(6))
     1       - COS(IATP(I + 37 + ISH) / RGBL(6)))
            DELY = PAR(24) * ABS(SIN(IATP(I + 38 + ISH) / RGBL(6))
     1       - SIN(IATP(I + 37 + ISH) / RGBL(6)))
            IF (4.5 * DELX .GT. 6.0 * PAR(25) .OR.
     1          4.5 * DELY .GT. PAR(25)) GO TO  10
            IATP(I + 38 + ISH) = IATP(I + 38 + ISH) + 1
            IATP(I + 37 + ISH) = IATP(I + 37 + ISH) - 1
          END DO
   10     CONTINUE
        END DO
        IATP(JJ + 4  + ISH) = IATC(1)
        IATP(JJ + 21 + ISH) = IATP(21 + ISH) + 36000
        IF (IPR(60) .NE. 4) GO TO 20
      END IF
      WRITE (LU8) NTYP, IPR(60), JR, RMAT
      WRITE (LU8) (IATP(L4), L4 = 1, 240)
      IPR(60) = 0
   20 RETURN
      END SUBROUTINE PLA033
      SUBROUTINE PLA034 (MODE, NAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP19=31,NVD=100000000,NP23=28000,NP25=99,NP29=63,
     2 NP41=200,NP47=9,NP56=30)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON // JNSC(2, NP23), VOID(NVD)
      K = 0
      IF (MODE .EQ. 1) THEN
        DO I = 1, NAT
          DO J = 1, 6
            VOID(K + J)     = XXO(I, J)
            VOID(K + J + 6) = XSD(I, J)
         END DO
          DO J = 1, NP4
            VOID(K + J + 12) = CON(I, J)
          END DO
          K = K + NP4 + 15
        END DO
      ELSE IF (MODE .EQ. -1) THEN
        DO I = 1, NAT
          DO J = 1, 6
            XXO(I, J) = VOID(K + J)
            XSD(I, J) = VOID(K + J + 6)
          END DO
          DO J = 1, NP4
            CON(I, J) = VOID(K + J + 12)
          END DO
          K = K + NP4 + 15
        END DO
      END IF
      RETURN
      END SUBROUTINE PLA034
      SUBROUTINE PLA035 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION ISPV(8)
      CHARACTER INQ1*1, FORMA*48, FORMB*48, FORMT*48, FORMC*35,
     1 FORMD*34, FORME*40, FORML*58, FORM*87, FORMH*36
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IWIN = IGBL(25) * IGBL(32)
      FORM(1:28)   = '(''P ='',F8.4,''('',I4,''), Q ='','
      FORM(29:61)  = 'F8.4,''('',I4,''), R ='',F8.4,''('',I4,'
      FORM(62:86)  = '''), S ='',F8.4,''('',I4,'')'')'
      FORMB( 1:11) = '( ''DIST '',1'
      FORMB(12:48) = '( A ,''.. ''), A ,'' ='',F9.4,''('',I3,'')'')'
      FORMA( 1:48) = '(''ANGLE '',2'//FORMB(12:48)
      FORMT( 1:48) = '( ''TORS '',3'//FORMB(12:48)
      FORMC( 1:35) = '(1X,A,'' -- '',A,11X,F8.4,''('',I3,'')'')'
      FORMD( 1:34) = '(1X,2(A,'' -- ''),A,F8.2,''('',I3,'')'')'
      FORME( 1:40) = '(A,1X,A,'' : '',F10.0,''('',I2,'')   '',6F8.4)'
      FORML( 1:30) = '( ''ANGLE '',A,''- '',A,''with '',A,'
      FORML(31:58) = '''- '',A,'' ='',F9.3,''('',I3,'')'')'
      FORMH( 1:36) = '(''Dihedral Angle ='',F7.0,''('',I2,'')'')'
      ANG   = 0.0
      SANG  = 0.0
      D     = 0.0
      SD    = 0.0
      ISANG = 0
      ISD   = 0
      PAGET = 'SelGeom'
      NAT     = IPR(39)
      NMAX    = NAT + IPR(64)
      N       = IPR(81)
      IPR(97) = IPR(97) + 1
      IF (IPR(97) .EQ. 1 .AND. IGBL(63) .GT. 1 .AND. MODE .EQ. 1) THEN
        CALL PLA262 (-3)
        WRITE (LU7, 99997, IOSTAT = IOST)
      END IF
      IF (N .LT. 0) THEN
        IPR(12) = 0
        N       = - N
        NANAL = 0
        IF (IFL(1) .EQ. 'FIT') THEN
   10     IF (N .EQ. 1 .AND. IPR(75) .GT. 1) THEN
            IF (IPR(221) .EQ. 0) THEN
              FN(1)    = 2
              FN(2)    = 1
              IPR(221) = 2
            END IF
            IF (IPR(221) .EQ. 2) THEN
              NRES1 = NINT(FN(1))
              NRES2 = NINT(FN(2))
              N2    = 0
              DO 20 I = 1, NAT
                CALL GEN048 (-1, IFG(1, I), 7, IHAT)
                IF (IHAT .EQ. 0) THEN
                  CALL GEN048 (-6, IFG(1, I), 9, NRESI)
                  IF (NRESI .EQ. NRES1) THEN
                    CALL GEN048 (-10, IFG(2, I), 14, LBN1)
                    IF (I .LT. NAT) THEN
                      DO J = 1, NAT
                        IF (J .NE. I) THEN
                          CALL GEN048 (-10, IFG(2, J), 14, LBN2)
                          IF (LBN1 .EQ. LBN2) THEN
                            CALL GEN048 (-6, IFG(1, J), 9, NRESJ)
                            IF (NRESI .EQ. NRESJ) GO TO 20
                          END IF
                        END IF
                      END DO
                    END IF
                    DO J = 1, NAT
                      CALL GEN048 (-1, IFG(1, J), 7, IHAT)
                      IF (IHAT .EQ. 0) THEN
                        CALL GEN048 (-6, IFG(1, J), 9, NRESJ)
                        IF (NRESJ .EQ. NRES2) THEN
                          CALL GEN048 (-10, IFG(2, J), 14, LBN2)
                          IF (LBN1 .EQ. LBN2) THEN
                            N2         = N2 + 2
                            JR(N2 - 1) = I
                            JR(N2)     = J
                            GO TO 20
                          END IF
                        END IF
                      END IF
                    END DO
                  END IF
                END IF
   20         CONTINUE
              IF (N2 .GE. IPR(28) * 2) THEN
                IPR(12) = N2
                WRITE (LU6, 99994, IOSTAT = IOST) NRES1, NRES2, N2 / 2
              ELSE
                N = -3
                GO TO 10
              END IF
            ELSE
              GO TO 70
            END IF
          ELSE IF (ABS(N) .EQ. 3) THEN
            NANAL = 1
            IF (N .EQ. 3) THEN
              CALL PLA046 (4, IFL(2), IENM, LBB, LBC, LBD,
     1                     INQNR, JNQNR, N1)
              IF (N1 .LT. 0) THEN
                IF (N1 .EQ. -4) THEN
                  GO TO 70
                ELSE
                  GO TO 60
                END IF
              END IF
              CALL GEN048 (-6, IFG(1, N1), 9, NRES1)
              CALL PLA046 (4, IFL(3), IENM, LBB, LBC, LBD,
     1                     INQNR, JNQNR, N2)
              IF (N2 .LT. 0) THEN
                IF (N2 .EQ. -4) THEN
                  GO TO 70
                ELSE
                  GO TO 60
                END IF
              END IF
              CALL GEN048 (-6, IFG(1, N2), 9, NRES2)
            END IF
            N1 = -1
            N2 =  0
            DO I = 1, NAT
              CALL GEN048 (-1, IFG(1, I), 7, IHAT)
              IF (IHAT .EQ. 0) THEN
                CALL GEN048 (-6, IFG(1, I), 9, NRES)
                IF (NRES .EQ. NRES1) THEN
                  N1     = N1 + 2
                  JR(N1) = I
                ELSE IF (NRES .EQ. NRES2) THEN
                  N2     = N2 + 2
                  JR(N2) = I
                END IF
              END IF
            END DO
            DO K = 1, N2 - 1, 2
              JCA(JR(K)) = JR(K + 1)
            END DO
            IPR(12) = N2
            WRITE (LU6, 99994, IOSTAT = IOST) NRES1, NRES2, N2 / 2
            IF (N2 .NE. N1 + 1) THEN
              WRITE (LU6, 99993, IOSTAT = IOST)
              GO TO 50
            END IF
          ELSE
            DO I = 2, N
              CALL PLA046 (4, IFL(I), IENM, LBB, LBC, LBD,
     1                     INQNR, JNQNR, NIEN)
              IF (NIEN .LT. 0) THEN
                IF (NIEN .EQ. -4) THEN
                  GO TO 70
                ELSE
                  GO TO 60
                END IF
              END IF
              IPR(12)     = IPR(12) + 1
              JR(IPR(12)) = NIEN
            END DO
          END IF
          IF (IPR(12) .GE. IPR(28) * 2) THEN
            VARDIST = 999.0
            CALL PLA085 (1, VARDIST)
            IF (NANAL .NE. 0) CALL PLA084 (NRES1, NRES2)
          ELSE
            CALL PLA015 (0, 31)
            WRITE (LU6, 99998, IOSTAT = IOST)
          END IF
        ELSE
          LOOP = 1
          NW   = 0
          DO I = 2, N
            IF (IFL(I) .EQ. 'WITH') THEN
              NW   = I
              LOOP = 2
            END IF
          END DO
          DO ILP = 1, LOOP
            IF (LOOP .EQ. 1) THEN
              IBEG = 2
              IEND = N
            ELSE
              IF (ILP .EQ. 1) THEN
                IBEG = 2
                IEND = NW - 1
              ELSE
                IBEG = NW + 1
                IEND = N
              END IF
            END IF
C * LEAST-SQUARES PLANE REQUESTED
            DO I = 1, NMAX
              IATP(I) = I + 2 * NP1
            END DO
            IMODE = 0
            NDIST = 0
            DO I = IBEG, IEND
              IF (IFL(I) .EQ. 'DIST') THEN
                IMODE = 1
              ELSE
                CALL PLA046 (4, IFL(I), IENM, LBB, LBC, LBD,
     1                       INQNR, JNQNR, NIEN)
                IF (NIEN .LT. 0) THEN
                  IF (NIEN .EQ. -4) THEN
                    GO TO 70
                  ELSE
                    GO TO 60
                  END IF
                END IF
                IPR(12)    = IPR(12) + 1 - IMODE
                NDIST      = NDIST + 1
                IATP(NIEN) = NIEN + IMODE * NP1
              END IF
            END DO
            CALL GEN022 (IATP, 1, NMAX)
            IF (IEND - IBEG .GT. 1) THEN
              CALL PLA055
              DO I = 1, 4
                XLS(I, ILP)     = XPV(I)
                XLS(I + 4, ILP) = XSPV(I)
              END DO
              IFT = -10
              DO I = 5, 8
                CALL GEN041 (XPV(I), XSPV(I), ISPV(I), 4, NDEC, IPR(68))
                IFT = IFT + 21
                FORM(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
              END DO
            ELSE
              CALL PLA227 (IATP(1), IATP(2), VECN)
              CALL PLA053 (IATP(1),IATP(2), 0, 0, D, SD, IDUM1,
     1          IDUM2, IER)
            END IF
            IF (IWIN .EQ. 1) THEN
              IF (ILP .EQ. 1) THEN
                CALL GGIP (HORS, VERT, 0.0, 1)
                VRT = VERT - 0.7
                WRITE (PRBUF, 99990, IOSTAT = IOST)
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2,
     1                       1.0, VRT)
                VRT = VRT - 0.7
                WRITE (PRBUF, 99989, IOSTAT = IOST)
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2,
     1                       1.0, VRT)
                WRITE (LU6, 99986, IOSTAT = IOST)
                WRITE (LU6, 99990, IOSTAT = IOST)
                WRITE (LU6, 99989, IOSTAT = IOST)
              ELSE
                VRT = VRT - 1.0
                WRITE (LU6, 99987, IOSTAT = IOST)
              END IF
              IF (IEND - IBEG .GT. 1) THEN
                WRITE (PRBUF, FORM, IOSTAT = IOST)
     1            (XPV(I), ISPV(I), I = 5, 8)
                VRT = VRT - 0.6
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
                WRITE (PRBUF, 99991, IOSTAT = IOST)
                VRT = VRT - 0.7
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2,
     1                       1.0, VRT)
              ELSE IF (IEND - IBEG .EQ. 1) THEN
                CALL GGIP09 (0.0, '  Bond', 6, 0.35, 5 + IGBL(68), 2,
     1                       1.0, VRT)
              END IF
              VRT = VRT - 0.2
            END IF
            IF (IEND - IBEG .GT. 1) THEN
              WRITE (LU6, FORM, IOSTAT = IOST)
     1          (XPV(I), ISPV(I), I = 5, 8)
              WRITE (LU6, 99987, IOSTAT = IOST)
              WRITE (LU6, 99991, IOSTAT = IOST)
              IF (IGBL(63) .GT. 1) THEN
                CALL PLA262 (8)
                WRITE (LU7, 99986, IOSTAT = IOST)
                WRITE (LU7, 99990, IOSTAT = IOST)
                WRITE (LU7, 99989, IOSTAT = IOST)
                WRITE (LU7, FORM, IOSTAT = IOST)
     1            (XPV(I), ISPV(I), I = 5, 8)
                WRITE (LU7, 99987, IOSTAT = IOST)
                WRITE (LU7, 99991, IOSTAT = IOST)
              END IF
            END IF
            CALL GEN003 (OR, UIJ, DET, 0)
            IF (DET .LE. 0.0) CALL GEN127 ('CANNOT INVERT OR')
            IF (IEND - IBEG .GT. 1) THEN
              DO I = 1, NDIST
                IF (I .GT. IPR(12)) THEN
                  INQ1 = ' '
                ELSE
                  INQ1 = '*'
                END IF
                IATPI = MOD(IATP(I), NP1)
                CALL PLA047 (LABA(IATPI), NQ1, IDUM, JDUM,
     1            IPR(71), IGBL(55), 0, 1 - IGBL(55))
                CALL PLA056 (XPV(1), IATPI, DIS, SDIS, ISDIS, 5, NDEC)
                ISDIS = MIN (99, ISDIS)
                FORME(19:19) = CHAR(ICHAR('0') + NDEC)
                DO J = 1, 3
                  V2(J) = XXO(IATPI, J + 3)
                END DO
                CALL GEN002 (1, UIJ, V2, V1, YUNK)
                WRITE (PRBUF, FORME, IOSTAT = IOST)
     1            INQ1, NQ1, DIS, ISDIS,
     2            (V1(J), J = 1, 3), (V2(J), J = 1, 3)
                CALL GEN065 (LU6, PRBUF, 80, 1)
                IF (IWIN .EQ. 1) THEN
                  VRT = VRT - 0.45
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
                END IF
                IF (IGBL(63) .GT. 1) THEN
                  CALL PLA262 (1)
                  WRITE (LU7, 99999, IOSTAT = IOST) PRBUF
                END IF
              END DO
            ELSE IF (IEND - IBEG .EQ. 1) THEN
              DO I = 1, 2
                CALL PLA047 (LABA(IATP(I)), NQ1, IDUM, JDUM,
     1            IPR(71), IGBL(55), 0, 1 - IGBL(55))
                DO J = 1, 3
                  V2(J) = XXO(IATP(I), J + 3)
                END DO
                CALL GEN002 (1, UIJ, V2, V1, YUNK)
                WRITE (PRBUF, 99985, IOSTAT = IOST) NQ1,
     1                (V1(J), J = 1, 3), (V2(J), J = 1, 3)
                CALL GEN065 (LU6, PRBUF, 80, 1)
                IF (IWIN .EQ. 1) THEN
                  VRT = VRT - 0.45
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
                END IF
                IF (IGBL(63) .GT. 1) THEN
                  CALL PLA262 (1)
                  WRITE (LU7, 99999, IOSTAT = IOST) PRBUF
                END IF
              END DO
            END IF
          END DO
          IF (LOOP .EQ. 2) THEN
            IF (IEND - IBEG .GT. 1) THEN
              ANG = RGBL(6) * ACOS(MIN(ABS(XLS(1, 1) * XLS(1, 2) +
     1          XLS(2, 1) * XLS(2, 2) + XLS(3, 1) * XLS(3, 2)), 1.0))
                SANG = 0
              DO I = 5, 7
                SANG = SANG + XLS(I, 1)**2 + XLS(I, 2)**2
              END DO
              SANG = RGBL(6) * SQRT(SANG)
              FORMH(3:10) = 'Dihedral'
            ELSE IF (IEND - IBEG .EQ. 1) THEN
              ANG = 90.0 - ACOS(MIN(ABS(XLS(1, 1) * VECN(1) +
     1          XLS(2, 1) * VECN(2) + XLS(3, 1) * VECN(3)), 1.0)) *
     2          RGBL(6)
              SANG = 0.0
              DO L = 1, 3
                SANG = SANG + XLS(L + 4, 1)**2 + (VECN(L) * SD / D)**2
              END DO
              SANG = RGBL(6) * SQRT(SANG)
              FORMH(3:10) = 'LsplBond'
            END IF
            IF (IEND - IBEG .GT. 0) THEN
              CALL GEN041 (ANG, SANG, ISANG, 2, NDEC, IPR(68))
              ISANG        = MIN (99, ISANG)
              FORMH(24:24) = CHAR(ICHAR('0') + NDEC)
              WRITE (PRBUF, FORMH, IOSTAT = IOST) ANG, ISANG
              CALL GEN065 (LU6, PRBUF, 80, 1)
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 1.00
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
              END IF
            END IF
          END IF
          IF (IPR(41) .EQ. 0) THEN
            PRBUF = 'UNIT WEIGHTS'
          ELSE IF (IPR(41) .EQ. 1) THEN
            PRBUF = 'ATWT WEIGHTS'
          ELSE
            PRBUF = 'ESD/SU WEIGHTS'
          END IF
          WRITE (LU6, 99988, IOSTAT = IOST) PRBUF
          IF (IGBL(63) .GT. 1) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99988, IOSTAT = IOST) PRBUF
          END IF
          IF (IWIN .EQ. 1) THEN
            VRT = VRT - 1.0
            CALL GGIP09 (0.0, PRBUF, 30, 0.35, 5 + IGBL(68), 2,
     1                   1.0, VRT)
            CALL PLA297 (0)
          END IF
        END IF
C * DISTANCES & ANGLES
      ELSE
        DO I = 2, N
          NQ2 = IFL(I)
          DO 30 J = 1, 2
            CALL PLA046 (4, NQ2, IENM, LBB, LBC, LBD,
     1                   INQNR, JNQNR, NIEN)
            IF (NIEN .LT. 0) THEN
              IF (NIEN .EQ. -4) THEN
                DO L = 1, 6
                  IF (NQ2(7-L:7-L) .NE. ' ') THEN
                    NQ2(8-L:8-L) = NQ2(7-L:7-L)
                    NQ2(7-L:7-L) = '_'
                    GO TO 30
                  END IF
                END DO
              END IF
              GO TO 60
            END IF
            CALL PLA047 (INQNR, NQ1, IDUM, JDUM, IPR(71), IGBL(55),
     1                   0, 1 - IGBL(55))
            NAMS(I, 1) = ' '//NQ1
            GO TO 40
   30     CONTINUE
          GO TO 70
   40     JATC(I) = NIEN
        END DO
        IF (N .EQ. 2) THEN
          I   = JATC(2)
          NC  = - NINT(CON(I, NP4))
          IF (NC .LT. 0) NC = NP4
          DO J = 1, NC
            J0 = NINT(CON(I, J))
            CALL PLA053 (I, J0, 0, 0, D, SD, ISD, NDEC, IER)
            IF (IER .EQ. 0) THEN
              FORMC(23:23) = CHAR(ICHAR('0') + NDEC)
              ISD = MIN (999, ISD)
              CALL PLA047 (LABA(J0), NQ2, IDUM, JDUM, IPR(71),
     1                     IGBL(55), 0, 1 - IGBL(55))
              IF (MODE .EQ. 0) CALL PLA262 (1)
              WRITE (PRBUF, FORMC, IOSTAT = IOST) NQ2, NQ1, D, ISD
              IF (MODE .EQ. 1) CALL GEN065 (LU6, PRBUF, 80, 1)
              IF (IGBL(63) .GT. 1) CALL GEN065 (LU7, PRBUF, 80, 1)
              DO K = J + 1, NC
                IF (K .LE. NC) THEN
                  K0 = NINT(CON(I, K))
                  CALL PLA053 (K0, I, J0, 0, ANG, SANG, ISANG, NDEC,
     1                         IER)
                  IF (IER .EQ. 0) THEN
                    FORMD(22:22) = CHAR(ICHAR('0') + NDEC)
                    ISANG = MIN (999, ISANG)
                    CALL PLA047 (LABA(K0), NQ3, IDUM, JDUM,
     1                IPR(71), IGBL(55), 0, 1 - IGBL(55))
                    IF (MODE .EQ. 0) CALL PLA262 (1)
                    WRITE (PRBUF, FORMD, IOSTAT = IOST)
     1                NQ2, NQ1, NQ3, ANG, ISANG
                    IF (MODE .EQ. 1) CALL GEN065 (LU6, PRBUF, 80, 1)
                    IF (IGBL(63) .GT. 1)
     1                CALL GEN065 (LU7, PRBUF, 80, 1)
                  END IF
                END IF
              END DO
            END IF
          END DO
        ELSE IF (N .EQ. 3) THEN
          CALL PLA053 (JATC(2), JATC(3), 0, 0, D, SD, ISD, NDEC, IER)
          IF (IER .EQ. 0) THEN
            ISD          = MIN (99, ISD)
            FORMB(36:36) = CHAR(ICHAR('0') + NDEC)
            WRITE (PRBUF, FORMB, IOSTAT = IOST)
     1        (NAMS(I, 1)(2:8), I = 2, 3), D, ISD
            CALL GEN065 (LU6, PRBUF, 80, 1)
            IF (IGBL(63) .GT. 1) CALL PLA263 (LU7, PRBUF, 80, 1, 1)
          ELSE
            WRITE (LU6, 99995, IOSTAT = IOST)
          END IF
        ELSE IF (N .EQ. 4) THEN
          CALL PLA053 (JATC(2), JATC(3), JATC(4), 0, ANG, SANG,
     1                 ISANG, NDEC, IER)
          IF (IER .EQ. 0) THEN
            ISANG        = MIN (999, ISANG)
            FORMA(36:36) = CHAR(ICHAR('0') + NDEC)
            WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1        (NAMS(I, 1)(2:8), I = 2, 4), ANG, ISANG
            CALL GEN065 (LU6, PRBUF, 80, 1)
            IF (IGBL(63) .GT. 1) CALL PLA263 (LU7, PRBUF, 80, 1, 1)
          ELSE
            WRITE (LU6, 99995, IOSTAT = IOST)
          END IF
        ELSE IF (N .EQ. 5) THEN
          IF (IFL(1)(1:3) .EQ. 'ANG' .OR. IPR(341) .EQ. 5) THEN
            NEX = NMAX + 1
            DO I = 4, 6
              XXO(NEX, I) = XXO(JATC(5), I) + XXO(JATC(2), I)
     1                    - XXO(JATC(4), I)
              XSD(NEX, I) = XSD(JATC(5), I)
            END DO
            CALL PLA053 (JATC(3), JATC(2), NEX, 0, ANG, SANG,
     1                   ISANG, NDEC, IER)
            IF (IER .EQ. 0) THEN
              ISANG        = MIN (999, ISANG)
              FORML(46:46) = CHAR(ICHAR('0') + NDEC)
              WRITE (PRBUF, FORML, IOSTAT = IOST)
     1          (NAMS(I, 1)(2:8), I = 2, 5), ANG, ISANG
              CALL GEN065 (LU6, PRBUF, 80, 1)
              IF (IGBL(63) .GT. 1) CALL PLA263 (LU7, PRBUF, 80, 1, 1)
            END IF
          ELSE
            CALL PLA053 (JATC(2), JATC(3), JATC(4), JATC(5),
     1                   ANG, SANG, ISANG, NDEC, IER)
            IF (IER .EQ. 0) THEN
              ISANG        = MIN (999, ISANG)
              FORMT(36:36) = CHAR(ICHAR('0') + NDEC)
              CALL PLA050 (JATC(2), JATC(3), JATC(4), 0, ANG1)
              CALL PLA050 (JATC(3), JATC(4), JATC(5), 0, ANG2)
              CALL PLA050 (JATC(2), JATC(3), 0, 0, DIS1)
              CALL PLA050 (JATC(3), JATC(4), 0, 0, DIS2)
              CALL PLA050 (JATC(4), JATC(5), 0, 0, DIS3)
              WRITE (PRBUF, FORMT, IOSTAT = IOST)
     1          (NAMS(I, 1)(2:8), I = 2, 5), ANG, ISANG
              CALL GEN065 (LU6, PRBUF, 80, 1)
              WRITE (LU6, 99996, IOSTAT = IOST)
     1          ANG1, ANG2, DIS1, DIS2, DIS3
              IF (IGBL(63) .GT. 1) THEN
                CALL PLA263 (LU7, PRBUF, 80, 1, 1)
                CALL PLA262 (2)
                WRITE (LU7, 99996, IOSTAT = IOST)
     1            ANG1, ANG2, DIS1, DIS2, DIS3
              END IF
            END IF
          END IF
        ELSE
          GO TO 70
        END IF
      END IF
   50 IF (MODE .EQ. 1) THEN
        IF (IFL(1)(1:3) .EQ. 'DIS' .OR. IFL(1)(1:3) .EQ. 'ANG'
     1      .OR. IFL(1)(1:3) .EQ. 'TOR' .OR. IPR(341) .NE. 0) THEN
          IF (IPR(2) .NE. 0) THEN
            PRBUF = 'Label Error :  '//IFL(I)
            IPR(2)   = 0
            WRITE (LU6, 99999, IOSTAT = IOST) PRBUF(1:50)
          END IF
          IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
            IGBL(6) = - IABS(IGBL(6))
            SBCD = PRBUF(1:60)//CHAR(0)
          END IF
        END IF
      END IF
      RETURN
   60 IPR(2) = 3
      GO TO 50
   70 IPR(2) = 7
      GO TO 50
99999 FORMAT (A)
99998 FORMAT (/, ':: Not Enough Atoms to Fit on', /)
99997 FORMAT ('Selected Geometrical Data', /, 132('=')/)
99996 FORMAT ('ANGLE', 6X, F9.2, F10.2, /, 'BOND', 2X, 3(F10.4))
99995 FORMAT (':: Input Error, Try again')
99994 FORMAT (/, ':: Fit for RESD =', I3,
     1        ' and RESD =', I3, ' [N(fit) =', I3, ']')
99993 FORMAT (/, ':: Residues contain unequal number of atoms, nofit')
99991 FORMAT  (2X, 'Atom', 12X, 'Distance', 8X, 'x', 7X,
     1        'y', 7X, 'z', 6X, 'X', 7X, 'Y', 7X, 'Z')
99990 FORMAT ('The equation of the plane is of the form:',
     1           ' P * x + Q * y + R * z - S = 0')
99989 FORMAT ('where P, Q, R, S are constants and x, y, z',
     1           ' are fractional coordinates.')
99988 FORMAT (/, A)
99987 FORMAT (1X)
99986 FORMAT (//)
99985 FORMAT (2X, A, 20X, 6F8.4)
      END SUBROUTINE PLA035
      SUBROUTINE PLA036 (IAT, KB, NA, IDS, MNUM, ISPOS, IPAR, IALIAS)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP19=31,NP22=287,NP25=99,NP29=63,NP41=200,
     2 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER NQ*7
      I = IABS(IAT)
      IF (IAT .GT. 0) THEN
        ILABI =   LABA(I)
      ELSE
        ILABI = - LABA(I)
      END IF
      CALL GEN048 (-1, IFG(1, I), 6, ISPOS)
      CALL GEN048 (-7, IFG(2, I), 1, IDS)
      IDS = IPPR(IDS + 1, 1)
      IF (IDS .EQ. 1000) THEN
        NAMDIS = ICHAR(' ')
      ELSE IF (IDS .GT. 500) THEN
        NAMDIS = ICHAR('>')
      ELSE IF (IDS .EQ. 500) THEN
        NAMDIS = ICHAR('*')
      ELSE
        NAMDIS = ICHAR('<')
      END IF
      CALL PLA047 (ILABI, NQ, MNUM, JDUM, IPAR, IALIAS, 0,
     1  1 - IALIAS)
      NAMS(KB, NA) = CHAR(NAMDIS)//NQ
      RETURN
      END SUBROUTINE PLA036
      SUBROUTINE PLA037 (K, N, M)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP52=200,NP56=30,
     2 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      NQ3 = IFL(K)
      IF (NQ3(3:3) .EQ. ' ') THEN
        DO I = 1, 26
          IF (NQ3(1:1) .EQ. CHAR(ICHAR('A') + I - 1)) THEN
            N = I * 100
            IF (NQ3(2:2) .EQ. ' ') GO TO 10
            DO J = 1, 26
              IF (NQ3(2:2) .EQ. CHAR(ICHAR('A') + J - 1)) THEN
                N =  N + J
                GO TO 10
              END IF
            END DO
            GO TO 20
          END IF
        END DO
   10   DO J = 1, IAN
          IF (N .EQ. IEL(IEN(J))) THEN
            N = J
            RETURN
          END IF
        END DO
      END IF
   20 N = 0
      CALL PLA046 (M, NQ3, IENM, LBB, LBC, LBD,
     1             INQNR, JNQNR, NIEN)
      IF (NIEN .LT. 0) THEN
        IPR(2) = 3
      ELSE
        N = - NIEN
      END IF
      RETURN
      END SUBROUTINE PLA037
      SUBROUTINE PLA038 (IAT, JAT, IFIN)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /PL38/ IENI, KI, IMET, JMET, LABI, NC, IATNRI, IXX, NAT
C * SUBROUTINE GENERATES SEQUENCE OF UNIQUE BONDS (IAT, JAT)
C * INITIALIZED BY IFIN = -3, -2, -1 ; END SIGNAL WITH IFIN = 1 ON RETURN
      IF (IFIN .EQ. 0) THEN
        GO TO 20
      ELSE IF (IFIN .EQ. -3) THEN
        NAT = IPR(39)
        IXX = 0
      ELSE IF (IFIN .EQ. -2) THEN
        NAT = IPR(39)
        IXX = 1
      ELSE
        NAT = IPR(37)
        IXX = 0
      END IF
      IFIN = 0
      IAT  = 0
      IMET = 0
      JMET = 0
      IENI = 0
   10 IAT  = IAT + 1
      IF (IAT .GT. NAT) THEN
        IFIN = 1
        RETURN
      END IF
      CALL GEN048 (-1, IFG(1, IAT), 7, IHA)
      IF (IHA .EQ. 1) GO TO 10
      CALL GEN048 (-1, IFG(1, IAT), 19, IMET)
      CALL PLA047 (LABA(IAT), NQ1, IDUM, IENI, IPR(71), IGBL(55),
     1  0, 1 - IGBL(55))
      IF (IXX .EQ. 0) THEN
        IATNRI = IATNR(IENI)
        LABI   = LABA(IAT) / IPR(463)
      END IF
      NC = - NINT(CON(IAT, NP4))
      IF (NC .EQ. 0) THEN
        GO TO 10
      ELSE IF (NC .LT. 0) THEN
        NC = NP4
        CALL GEN048 (-1, IFG(1, IAT), 8, IVAL)
        IF (IVAL .GT. 0) NC = NC + IPR(76)
      END IF
      KI = 0
   20 KI = KI + 1
      IF (KI .GT. NC) GO TO 10
      IF (KI .LE. NP4) THEN
        JAT = NINT(CON(IAT, KI))
      ELSE
        IF (IBON(KI - NP4, 1) .EQ. IAT) THEN
          JAT = IBON(KI - NP4, 2)
        ELSE
          GO TO 20
        END IF
      END IF
      IF (IPR(133) .GE. 0) THEN
        CALL GEN048 (-1, IFG(1, JAT), 7, IHA)
        IF (IHA .NE. IPR(133)) GO TO 20
      END IF
      CALL PLA047 (LABA(JAT), NQ2, IDUM, IENJ, IPR(71), IGBL(55),
     1     0, 1 - IGBL(55))
      CALL GEN048 (-1, IFG(1, JAT), 19, JMET)
      IF (IMET .EQ. 1 .AND. IENJ .EQ. 2 .OR.
     1    JMET .EQ. 1 .AND. IENI .EQ. 2) THEN
        NDIST = 0
        IF (IENJ .EQ. 2) THEN
          NCJ   = - NINT(CON(JAT, NP4))
          DO KJ = 1, NCJ
            KAT = NINT(CON(JAT, KJ))
            CALL GEN048 (-4, IFG(1, KAT), 15, NEL)
            NEL = IEN(NEL + 1)
            IF (NEL .EQ. 3) THEN
              CALL PLA050 (IAT, KAT, 0, 0, DIST)
              IF (IENI .GT. 0) THEN
                IF (DIST .LT. REL(IENI) + 1.10) NDIST = NDIST + 1
              END IF
            END IF
          END DO
          IF (NDIST .GE. 2) GO TO 20
        ELSE
          NCI = - NINT(CON(IAT, NP4))
          DO K = 1, NCI
            KAT = NINT(CON(IAT, K))
            CALL GEN048 (-4, IFG(1, KAT), 15, NEL)
            NEL = IEN(NEL + 1)
            IF (NEL .EQ. 3) THEN
              CALL PLA050 (JAT, KAT, 0, 0, DIST)
              IF (DIST .LT. REL(IENJ) + 1.20) NDIST = NDIST + 1
            END IF
          END DO
          IF (NDIST .GE. 2) GO TO 20
        END IF
      END IF
      IF (IXX .EQ. 0) THEN
        JUNK = IATNRI - IATNR(IENJ)
        IF (JUNK .LT. 0) THEN
          GO TO 20
        ELSE IF (JUNK .EQ. 0) THEN
          LABJ = LABA(JAT) / IPR(463)
          IF (LABI .GT. LABJ) GO TO 20
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA038
      SUBROUTINE PLA039 (IAT, JAT, KAT, NRSD, A, SA, ISA, ND, KB, IFIN)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /PL39/ NAT, NC, KI, KJ, IHI, IHJ, IHK
      IF (IFIN .EQ. 0) THEN
        GO TO 30
      ELSE IF (IFIN .EQ. -1) THEN
        NAT = IPR(37)
      END IF
      IFIN = 0
      JAT  = 0
   10 JAT  = JAT + 1
      IF (JAT .GT. NAT) THEN
        IFIN = 1
        RETURN
      END IF
      CALL GEN048 (-1, IFG(1, JAT), 7,  IHJ)
      IF (IHJ .EQ. 1) GO TO 10
      CALL GEN048 (-6, IFG(1, JAT), 9, IRESJ)
      IF (IRESJ .NE. NRSD) GO TO 10
      NC = - NINT(CON(JAT, NP4))
      IF (NC .LT. 0) THEN
        NC = NP4
        CALL GEN048 (-1, IFG(1, JAT), 8, IVAL)
        IF (IVAL .GT. 0) NC = NC + IPR(76)
      END IF
      IF (NC .LE. 1) GO TO 10
      KI = 0
   20 KI = KI + 1
      IF (KI .GE. NC) GO TO 10
      IF (KI .LE. NP4) THEN
        IAT = NINT(CON(JAT, KI))
      ELSE
        IF (IBON(KI - NP4, 1) .NE. JAT) GO TO 20
        IAT = IBON(KI - NP4, 2)
      END IF
      KJ = KI
      CALL GEN048 (-1, IFG(1, IAT), 7,  IHI)
   30 KJ = KJ + 1
      IF (KJ .GT. NC) GO TO 20
      IF (KJ .LE. NP4) THEN
        KAT = NINT(CON(JAT, KJ))
      ELSE
        IF (IBON(KJ - NP4, 1) .NE. JAT) GO TO 30
        KAT = IBON(KJ - NP4, 2)
      END IF
      CALL GEN048 (-1, IFG(1, KAT), 7,  IHK)
      IHA  = IHI + IHJ + IHK
      IF (IPR(133) .EQ. 0) THEN
        IF (IHA .GT. 0) GO TO 30
      ELSE
        IF (IHA .EQ. 0) GO TO 30
      END IF
      KB1 = KB + 1
      CALL PLA036 (IAT, KB1, 1, IDS1, MNUM1, ISP1, IPR(71), IGBL(55))
      CALL PLA036 (JAT, KB1, 2, IDS2, MNUM2, ISP2, IPR(71), IGBL(55))
      CALL PLA036 (KAT, KB1, 3, IDS3, MNUM3, ISP3, IPR(71), IGBL(55))
      IF (IDS1 .LT. 1000 .AND. IDS3 .LT. 1000) THEN
        IF (IDS1 .NE. IDS3) GO TO 30
        IF (IDS2 .LT. 1000) THEN
          IF (IDS1 .NE. IDS2 .OR. IDS2 .NE. IDS3) GO TO 30
        END IF
      END IF
      CALL PLA053 (IAT, JAT, KAT, 0, A, SA, ISA, ND, IER)
      IF (IER .NE. 0) GO TO 30
      IF (ISP2 .EQ. 1 .AND. MNUM3 .GT. 1) THEN
        CALL PLA050 (IAT, JAT, KAT, 0, A1)
        IF (ABS(A1) .GT. 179.9) THEN
          A  = 180.0
          SA = 0.0
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA039
      SUBROUTINE PLA040 (MODE, IAT, IVAL, KAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      IF (MODE .LT. 0) THEN
        NC = - NINT(CON(IAT, NP4))
        IF (NC .NE. 0) THEN
          IF (NC .LT. 0) THEN
            NC = NP4
            CALL GEN048 (-1, IFG(1, IAT), 8, IVL)
            IF (IVL .GT. 0) NC = NC + IPR(76)
          END IF
          DO L = 1, NC
            IF (L .GT. NP4) THEN
              IF (IBON(L - NP4, 1) .NE. IAT) CYCLE
              IF (IBON(L - NP4, 2) .EQ. KAT) THEN
                IVAL = L
                RETURN
              END IF
            ELSE
              IF (NINT(CON(IAT, L)) .EQ. KAT) THEN
                IVAL = L
                RETURN
              END IF
            END IF
          END DO
        END IF
        IVAL = 0
      ELSE IF (MODE .EQ. 0) THEN
        DO K = IAT, IVAL
          CON(K, NP4) = KAT
        END DO
      ELSE
        IVAL = 0
        IPR(147) = IPR(147) + 1
        IF (CON(IAT, NP4) .GT. 0) THEN
          CALL GEN048 (1, IFG(1, IAT), 8, 1)
          IF (IPR(76) .NE. IPR(96)) THEN
            IPR(76)          = IPR(76) + 1
            IBON(IPR(76), 1) = IAT
            IBON(IPR(76), 2) = KAT
            IVAL             = NP4 + IPR(76)
          END IF
        ELSE
          CON(IAT, NP4)  =   CON(IAT, NP4) - 1
          IVAL           = - NINT(CON(IAT, NP4))
          CON(IAT, IVAL) =   KAT
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA040
      SUBROUTINE PLA041 (IATPR, N)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      IPRN = IPR(509 + N)
      IF (IPRN .EQ. 10 .OR. IPRN .EQ. 11 .OR.
     1    IPRN .EQ. 13 .OR. IPRN .EQ. 30 .OR.
     2    IPRN .EQ. 31 .OR. IPRN .EQ. 59 .OR.
     3    IPRN .EQ. 94 .OR. IPRN .EQ. 95 .OR.
     4    IPRN .EQ. 103) THEN
            IPRM = IPRN
      ELSE IF (IATPR .EQ. 5 .OR. IATPR .EQ. 6) THEN
            IPRM = 1
      ELSE IF (IPR(325) .EQ. 1 .AND. IATPR .LT. 0) THEN
        IF (IPRN .EQ. 3 .OR. IPRN .EQ. 4) THEN
          IPRM = - IPRN
        ELSE
          IPRM = -1
        END IF
      ELSE IF (IPR(325) .EQ. 0 .AND. IATPR .LT. 0) THEN
        IF (IPRN .GE. 3 .AND. IPRN .LE. 5) THEN
          IPRM = - IPRN
        ELSE
          IPRM = -1
        END IF
      ELSE IF (IPR(325) .EQ. -1 .AND. IATPR .EQ. -1) THEN
        IF (IPRN .EQ. 3 .OR. IPRN .EQ. 4) THEN
          IPRM = - IPRN
        ELSE
          IPRM = -1
        END IF
      ELSE
        IPRM = 0
      END IF
      IPR(157 + N) = IPRM
      IPR(191 + N) = ISIGN (1, IATPR)
      IF (N .GT. 0) THEN
        PAR(293) = 0.0
        IF (IPR(156) .EQ. 0) THEN
          ITST = IPR(157) * IPR(158)
          IF (ITST .EQ. -309 .OR. ITST .EQ. -412) THEN
            PAR(293) = PAR(541)
          ELSE IF (ITST .EQ. -30 .OR. ITST .EQ.  -40 .OR.
     1      ITST .EQ. -50 .OR. ITST .EQ. -120) THEN
            PAR(293) = PAR(542)
          ELSE IF (ITST .EQ. -177 .OR. ITST .EQ. -236) THEN
            PAR(293) = PAR(543)
          ELSE IF (ITST .EQ. -39 .OR. ITST .EQ. -52) THEN
            PAR(293) = PAR(544)
          ELSE IF (ITST .EQ. -93 .OR. ITST .EQ. -124) THEN
            PAR(293) = PAR(545)
          ELSE IF (ITST .EQ. -285 .OR. ITST .EQ. -380) THEN
            PAR(293) = PAR(546)
          ELSE IF (ITST .EQ. -1 .OR. ITST .EQ. -3 .OR.
     1      ITST .EQ. -4 .OR. ITST .EQ. -5) THEN
            PAR(293) = IGBL(97) * PAR(26)
          END IF
          IF (IPR(191) + IPR(192) .EQ. 2) PAR(293) = PAR(27)
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA041
      SUBROUTINE PLA042 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER FCELA*120, FCELB*89, FCELC*89, FCELV*95
      COMMON /TODAY/ DATIJD
      CHARACTER DATIJD*25
C * HEADER, CELL, SYMM LISTING
      IF (IPR(680) .EQ. 0) THEN
        FCELA(  1: 38) = '( ''a ='',F9.4,''('',I3,'')  Angstrom'',16X,'
        FCELA( 39: 75) = '''alpha ='',F9.3,''('',I3,'') Degree'',13X,'
        FCELA( 76:106) = '''a  ='',F9.3,5X,''alpha  ='',F8.2,'
        FCELA(107:120) = '''  V  ='',F8.1)'
        FCELB(  1: 28) = '( ''b ='',F9.4,''('',I3,'')'',26X,'
        FCELB( 29: 58) = ''' beta ='',F9.3,''('',I3,'')'',20X,'
        FCELB( 59: 89) = '''b  ='',F9.3,5X,''beta   ='',F8.2)'
        FCELC(  1: 28) = '( ''c ='',F9.4,''('',I3,'')'',26X,'
        FCELC( 29: 58) = '''gamma ='',F9.3,''('',I3,'')'',20X,'
        FCELC( 59: 89) = '''c  ='',F9.3,5X,''gamma  ='',F8.2)'
        FCELV(  1: 40) = '( ''V ='',F9.2,''('',I3,'') Cubic-Angstrom'','
        FCELV( 41: 64) = '10X,''d(100) ='',F12.4,3X,'
        FCELV( 65: 95) = '''Angstrom'',24X,''Niggli Values'')'
        IF (MODE .NE. 2) THEN
C * ALERT _155
          IF (SPGRNM(1)(12:12) .EQ. 'a') THEN
            IF (ABS(PAR(101) - PAR(123)) .GT. 0.01 .OR.
     1          ABS(PAR(102) - PAR(124)) .GT. 0.01 .OR.
     2          ABS(PAR(103) - PAR(125)) .GT. 0.01 .OR.
     3          ABS(PAR(104) - PAR(126)) .GT. 0.1  .OR.
     4          ABS(PAR(105) - PAR(127)) .GT. 0.1  .OR.
     5          ABS(PAR(106) - PAR(128)) .GT. 0.1)
     6          CALL PLA231 (155, 0, 1.0, 1.0, ' ', ' ')
          END IF
        END IF
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (-5)
          WRITE (LU7, 99999, IOSTAT = IOST)
     1      IGBL(4), JID(1:71), DATIJD(5:24)
        END IF
        IF (IPR(23) .NE. 0) THEN
          WRITE (LU6, 99995, IOSTAT = IOST) PAR(11)
        ELSE
          WRITE (LU6, 99998, IOSTAT = IOST)
     1      JID(1:70), (PAR(100 + I), I = 1, 6),
     2      PAR(98), SPGRNM(1)(15:26), CHSG
          IPR(83) = 34
          IF (IGBL(63) .GT. 2) THEN
            WRITE (LU7, 99993, IOSTAT = IOST)
     1        SPGRNM(1)(13:13), MAX (0, IPR(310))
            FCELA(12 : 12) = CHAR(ICHAR('0') + IPR(287))
            FCELA(52 : 52) = CHAR(ICHAR('0') + IPR(290))
            WRITE (PRBUF, FCELA, IOSTAT = IOST)
     1        PAR(101), IPR(281), PAR(104), IPR(284), PAR(123),
     2        PAR(126), PAR(99)
            CALL GEN065 (LU7, PRBUF, 132, 3)
            FCELB(12 : 12) = CHAR(ICHAR('0') + IPR(288))
            FCELB(42 : 42) = CHAR(ICHAR('0') + IPR(291))
            WRITE (PRBUF, FCELB, IOSTAT = IOST)
     1        PAR(102), IPR(282), PAR(105), IPR(285), PAR(124),
     2        PAR(127)
            CALL GEN065 (LU7, PRBUF, 132, 3)
            FCELC(12 : 12) = CHAR(ICHAR('0') + IPR(289))
            FCELC(42 : 42) = CHAR(ICHAR('0') + IPR(292))
            WRITE (PRBUF, FCELC, IOSTAT = IOST)
     1        PAR(103), IPR(283), PAR(106), IPR(286), PAR(125),
     2        PAR(128)
            CALL GEN065 (LU7, PRBUF, 132, 3)
            WRITE (LU7, 99991, IOSTAT = IOST)
            FCELV(12 : 12) = CHAR(ICHAR('0') + IPR(294))
            WRITE (PRBUF, FCELV, IOSTAT = IOST)
     1       PAR(98), IPR(293), 1.0 / PAR(113)
            CALL GEN065 (LU7, PRBUF, 132, 3)
            WAVL = MAX (0.0, PAR(17))
            WRITE (LU7, 99990, IOSTAT = IOST)
     1        1.0 / PAR(114), (PAR(150 + J), J = 1, 3), KRAD,
     2        WAVL, 1.0 / PAR(115), (PAR(150 + J), J = 4, 6)
            CALL PLA262 (1)
            WRITE (LU7, 99997, IOSTAT = IOST)
            WRITE (LU7, 99994, IOSTAT = IOST)
            WRITE (PRBUF, 99989, IOSTAT = IOST) (OR(1, J), J = 1, 3),
     1                           (ROR(1, K), K = 1, 3)
            CALL GEN065 (LU7, PRBUF, 132, 2)
            WRITE (PRBUF, 99988, IOSTAT = IOST) (OR(2, J), J = 1, 3),
     1                           (ROR(2, K), K = 1, 3)
            CALL GEN065 (LU7, PRBUF, 132, 2)
            WRITE (PRBUF, 99987, IOSTAT = IOST) (OR(3, J), J = 1, 3),
     1                           (ROR(3, K), K = 1, 3)
            CALL GEN065 (LU7, PRBUF, 132, 2)
            IF (MODE .GT. 0) THEN
              WRITE (LU7, 99996, IOSTAT = IOST)
              IF (SPGRNM(1)(1:1) .NE. ' ') THEN
                NRXX = 0
                IF (INDEX (SPGRNM(1)(1:11), ':') .NE. 0) THEN
                  WRITE (ICL, 99986, IOSTAT = IOST) SPGRNM(1)(1:11)
                ELSE
                  WRITE (ICL, 99985, IOSTAT = IOST)
     1            SPGRNM(1)(1:7)//' '//SPGRNM(1)(8:11)
                  IF (SPGRNM(1)(13:13) .NE. ' ') ICL(13:13) = '.'
                END IF
                CALL SGSM (ICL, NRXX, XJX, LU6, 0, IERR)
              END IF
              CALL SGSM (ICL, 0, XJX, LU7, 2, IERR)
            END IF
          END IF
          IPPR(1, 3) = IPR(48)
        END IF
        IPR(680) = 1
      END IF
      RETURN
99999 FORMAT ('PLATON(V-', I6, ')-Run for: ', A, 9X, 'TIME: ', A, /,
     1 132('='), /, 110X, '(C) 1980-2014 A.L.Spek')
99998 FORMAT (/, ':: TITL ', A, /,
     1        ':: CELL ', 3F10.4, 3F10.3, F10.1, /,
     2        ':: SPGR ', A, 2X, A)
99997 FORMAT (48X, 26('=')/, 47('='), ' Orthogonalization Matrices ',
     1 57('='), /, 48X, 26('='))
99996 FORMAT (/, 50X, 20('='), /, 49('='), ' Space Group Symmetry ',
     1 61('='), /, 50X, 20('='), //, '(See e.g. G. Burns & A.M. ',
     2 'Glazer, Space Groups for Solid State Scientists, ',
     3 'Academic Press, 1990 or Int. Tables A)', /)
99995 FORMAT (':: Angstrom Coordinate Data Scale = ', F10.4, /)
99994 FORMAT (/, '(See e.g. J.D.Dunitz, Xray Analysis and Structure',
     1 ' Determination of Organic Molecules, Cornell Univ. Press,',
     2 ' 1979, P236)', /)
99993 FORMAT (55X, 12('='), /, 54('='), ' Crystal Data ', 64('='), /,
     1 55X, 12('=') / 24X, 'Input Cell', 2X, '(Lattice Type: ', A1,')',
     2 3X, '-   Temp =', I4, 'K', 13X, 'Reduced Cell', 5X,
     3 '(Acta Cryst.(1976),A32,297-298)', /, 81('-'), 3X, 48('-'))
99991 FORMAT (1X)
99990 FORMAT (42X, 'd(010) =', F12.4, 26X, 3F10.3, /,
     1        'Lambda(', A, ') =', F10.5, ' Angstrom', 9X,
     2        'd(001) =', F12.4, 26X, 3F10.3, /)
99989 FORMAT ('(XO)   (', 3F10.5, ' ) (X)   ,   (X)   (', 3F10.5,
     1 ' ) (XO)', 5X, ' Orthogonal Axes AO, BO and CO')
99988 FORMAT ('(YO) = (', 3F10.5, ' )*(Y)   ,   (Y) = (', 3F10.5,
     1 ' )*(YO)', 13X, 'are defined as:')
99987 FORMAT ('(ZO)   (', 3F10.5, ' ) (Z)   ,   (Z)   (', 3F10.5,
     1 ' ) (ZO)', 5X, 'AO // A, CO // C*, BO // CO X AO')
99986 FORMAT ('SPGR ', A, 64X)
99985 FORMAT ('SPGR ' , A, 63X)
      END SUBROUTINE PLA042
      SUBROUTINE PLA043 (MODE, ITYPE, LU, NWIN)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER ILTR*3, FORMA*46, CFXML*11
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      FORMA(1:33)  = '(A,''['',F9.2,''] = '',A,'' = [ '',5I3,'
      FORMA(34:46) = ''' ] '',3F11.3)'
      IHOR  = -1
      IF (IWIN .EQ. 1) THEN
        IF (NWIN .EQ. 1) CALL GGIP (HORS, VERT, 0.0, 1)
        IF (ITYPE .NE. 0) VRT = VERT - 0.6
      END IF
      IF (ITYPE .EQ. 0) THEN
        FORMA(8:11) = 'F7.0'
      ELSE
        IF (PAR(42) .LT. 100.0) FORMA(11:11) = '1'
      END IF
      IF (MODE .GE. 0) THEN
        NMOL = IPR(13)
        IF (NMOL .GT. 1) THEN
          NPRNT = 0
          DO 10 I = 1, NMOL
            IF (ITYPE .EQ. 0) THEN
              IF (MP(I) .EQ. 0) GO TO 10
            END IF
            ML = MOL(I)
            IF (ML .NE. 0) THEN
              XML = ML / PAR(42)
              IF (I .GT. 1 .AND. ITYPE .LE. 0) THEN
                XML = INT(XML)
                DO J = 1, I - 1
                  IF (MP(J) .EQ. 1) THEN
                    YML = INT (MOL(J) / PAR(42))
                    IF (XML .EQ. YML) GO TO 10
                  END IF
                END DO
              END IF
              CALL GEN098 (ML, PAR(42), MOL1, MOL2, MOL3, MOL4, IRS0)
              IF (IRS0 .GT. 0) THEN
                IF (MOL1 .GT. IPR(48)) THEN
                  IF (I .EQ. (IPR(13) - IPR(101) + 1) .AND.
     1                      IGBL(63) .GT. 2) THEN
                    IF (LU .EQ. LU7) CALL PLA262 (4)
                    WRITE (LU, 99996, IOSTAT = IOST)
                  END IF
                  MOL1 = MOL1 - IPR(48)
                  ILTR = '* ='
                  XML  = XML - IPR(48) * 1000
                END IF
                IF (I .GT. 1) THEN
                  IF (IPR(17) .EQ. 0 .OR. ITYPE .LT. 0) THEN
                    IF (I .LE. 27) THEN
                      ILTR = CHAR(ICHAR('a') + I - 2)//' ='
                    ELSE
                      ILTR = '* ='
                    END IF
                  ELSE
                    ILTR = '   '
                  END IF
                  CALL SGSM (ICL, 0, XJX, 0, 2, IERR)
                  XJX(4) = MOL2
                  XJX(5) = MOL3
                  XJX(6) = MOL4
                  CALL SGSM (ICL, MOL1, XJX, 0, 20, IERR)
                  DO K = 1, 3
                    XJX(K) = RCG(K, IRS0)
                  END DO
                  CALL SGSM (ICL, MOL1, XJX, LU, 3, IERR)
                  IF (IGBL(63) .GT. 2) THEN
                    IF (NPRNT .EQ. 0 .AND. LU .GT. 0) THEN
                      IF (ITYPE .EQ. 1) THEN
                        IF (LU .EQ. LU7) CALL PLA262 (7)
                        WRITE (LU, 99998, IOSTAT = IOST)
                      ELSE IF (ITYPE .EQ. 0) THEN
                        IF (LU .EQ. LU7) CALL PLA262 (3)
                        WRITE (LU, 99997, IOSTAT = IOST)
                      END IF
                      NPRNT = 1
                    END IF
                  END IF
                  IF (IGBL(63) .GT. 2 .OR. LU .NE. LU7) THEN
                    CALL GEN020 (-1, ICL, 1, 33)
                    IF (IABS(IGBL(8)) .EQ. 3) THEN
                      CALL PLA273 (2, 0, XML, N0, N1, N2, N3, IER)
                      WRITE (CFXML, 99994, IOSTAT = IOST)
     1                  N0, N1 + 5, N2 + 5, N3 + 5
                    ELSE
                      CFXML = ' '
                    END IF
                    WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1                ILTR, XML, CFXML//ICL(1:33), MOL1, MOL2, MOL3,
     2                MOL4, IRS0, (XJX(K), K = 7, 9)
                    CALL GEN065 (0, PRBUF, 132, 7)
                    IF (LU .EQ. LU7) CALL PLA262 (1)
                    IF (ITYPE .EQ. 1) THEN
                      WRITE (LU, 99995, IOSTAT = IOST) PRBUF
                    ELSE
                      IF (LU .GT. 0) THEN
                        WRITE (LU, 99995, IOSTAT = IOST) PRBUF(1:49)
                        IF (IWIN .EQ. 1 .AND. ITYPE .NE. 0) THEN
                          VRT = VRT - 0.45
                          CALL GGIP09 (0.0, PRBUF, 50, 0.30,
     1                                 5 + IGBL(68), 2, 1.0, VRT)
                        END IF
                      ELSE
                        IF (IWIN .EQ. 1) THEN
                          IHOR = MOD(IHOR + 1, 2)
                          IF (IHOR .EQ. 0) VRT  = VRT - 0.45
                          HOR = IHOR * HORS / 2 + 0.35
                          CALL GGIP09 (0.0, PRBUF, 49, 0.28, 1, 2,
     1                                 HOR, VRT)
                        END IF
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END IF
   10     CONTINUE
          IF (LU .EQ. 0 .AND. NMOL .GT. 0) VRT = VRT - 0.5
          IF (ITYPE .EQ. 1 .AND. IGBL(63) .GT. 2) THEN
            IF (LU .EQ. LU7) CALL PLA262 (7)
            WRITE (LU, 99999, IOSTAT = IOST)
          END IF
          IF (MODE .NE. 0) CALL PLA094 (0, 0, 0, 0, 0, 0)
        END IF
      END IF
      RETURN
99999 FORMAT (/, 'Note: Symmetry Operations Refer to the Coordinates ',
     1 'listed in the Fractional Coordinate Table given above',
     2 //, 65X, 'SYM', 9X, '-  Number of the Symmetry Operator.',
     3 /, 'X(J) = X(sym) + TX , Y(J) = Y(sym) + TY , ',
     4 'Z(J) = Z(sym) + TZ,', 4X, 'Ires', 8X, '-  Residue Number.', /,
     5 65X, 'TX, TY, TZ  -  Unit Cell Translations.')
99998 FORMAT (/, 42X, 'Asymmetric Residue Unit (= ARU) Code List', /,
     1 42X, 41('='), //, 5X, 'ARU-CODE', 5X, 'CIF-CODE', 4X,
     2 'Symmetry-Code', 23X, 'sym TX TY TZ', ' Ires', 6X, 'x(cen)',
     3  5X, 'y(cen)', 5X, 'z(cen)', /, 132('-'))
99997 FORMAT (/, 'Translation of ARU-Code to CIF and Equivalent ',
     1        'Position Code', /, 59('='))
99996 FORMAT (/, 37X, 'Detected and Excluded Disorder Asymmetric ',
     1 'Residue Units', /, 37X, 55('='), /)
99995 FORMAT (A)
99994 FORMAT ('[', I3, '_', 3I1, '] =')
      END SUBROUTINE PLA043
      SUBROUTINE PLA044 (R, IAT, XR, YR, ZR, SX, SY, SZ, SC, SXY)
      DIMENSION R(3, 3)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP19=31,NP25=99,NP29=63,NP41=200,NP47=9, NP56=30)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      IF (IAT .LT. 0) THEN
        N   = - IAT
        XOR = XLS(1, N) * XLS(4, N)
        YOR = XLS(2, N) * XLS(4, N)
        ZOR = XLS(3, N) * XLS(4, N)
      ELSE
        XOR = XXO(IAT, 4)
        YOR = XXO(IAT, 5)
        ZOR = XXO(IAT, 6)
      END IF
      XR = SC * (R(1, 1) * XOR + R(1, 2) * YOR + R(1,3) * ZOR -SX) + SXY
      YR = SC * (R(2, 1) * XOR + R(2, 2) * YOR + R(2,3) * ZOR -SY) + SXY
      ZR = SC * (R(3, 1) * XOR + R(3, 2) * YOR + R(3,3) * ZOR -SZ) + SXY
      RETURN
      END SUBROUTINE PLA044
      SUBROUTINE PLA045 (NTYP)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      IF (IPR(52) .LT. NP2) THEN
        NMAX  = IPR(39)
        IPR52 = IPR(52)
        CALL PLA054 (0)
        DO I = 1, 4
          XLS(I, IPR52 + 1) = XPV(I)
        END DO
        IF (NTYP .EQ. 1) THEN
          IF (IPR52 .GT. 0) THEN
            DO J = 1, IPR52
              DMIN = 0
              DO K = 1, 4
                DMIN = DMIN + ABS(XLS(K, IPR52 + 1) - XLS(K, J))
              END DO
              IF (DMIN .LT. 0.00001) RETURN
            END DO
          END IF
        END IF
        CALL GEN022 (IATP, 1, NMAX)
        IPR(52) = IPR(52) + 1
        IF (NTYP .EQ. 3) THEN
          CALL GEN004 (ROR, DUMV, ORRES)
          CALL GEN003 (ORRES, RMAT, DET, 0)
        END IF
        CALL GEN005 (DUMV, RMAT)
        DO K = 1, 3
          TEMP = RMAT(1, K)
          RMAT(1, K) = - RMAT(3, K)
          RMAT(3, K) = TEMP
        END DO
        IF (NTYP .EQ. 2) THEN
          IPR(69)  = IPR(69) + 1
          IF (IPR(12) .GT. 4 .AND. IPR(12) .LT. 8) THEN
            IYUNK = 2 * (IPR(12) - 5)
            IPR(496) = IPR(496) + 10 ** IYUNK
          END IF
        END IF
        WRITE (LU8) NTYP, IPR(12), JR, RMAT
        WRITE (LU8) (IATP(L4), L4 = 1, IPR(39))
      END IF
      RETURN
      END SUBROUTINE PLA045
      SUBROUTINE PLA046 (MODUS, NQ, IENM, LBB, LBC, LBD, INQNR, JNQNR,
     1                   NIEN)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP36=3000,NP38=150,NP39=30,NP41=200,NP45=2048,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER NQ*7, ICH*1, NQJ*2
      III = 0
      NAT = 0
      NQJ = '  '
      MODE = MODUS
      MODX = 0
      IF (MODUS .GT. 98) THEN
        MODE = MODUS - 100
        MODX = 1
      END IF
      IF (MODE .NE. -1) THEN
        IF (MODE .EQ. -2) THEN
          N    = 0
          MODE = 2
        ELSE
          N = INDEX (NQ, '_')
          IF (N .LT. 5) THEN
            M = INDEX (NQ(N + 1 : 7), '_')
            N = N + M
          END IF
          IF (N .LT. 7) THEN
            IF (N .NE. 0) THEN
              ICH = NQ(N + 1 : N + 1)
              DO I = 1, 10
                IF (ICH .EQ. CHAR(ICHAR('0') + I - 1)) THEN
                  N = 0
                  GO TO 10
                END IF
              END DO
              NQJ    = NQ(N : N + 1)
              NQ(N:) = ' '
            END IF
          ELSE
            NIEN = -15
            RETURN
          END IF
        END IF
   10   IF (IPR(683) .GT. 0) THEN
          MSUBST = 0
          CALL PLA281 (1, NQ, MSUBST)
          IF (N .NE. 0) THEN
            M = INDEX (NQ, ' ')
            NQ(M:) = NQJ
          END IF
          IF (MSUBST .NE. 0) GO TO 30
        END IF
        IF (N .NE. 0) NQ(N:) = NQJ
      END IF
      IF (MODX .EQ. 1 .AND. IABS(IGBL(8)) .EQ. 3) THEN
        CALL GEN020 (1, NQ, 2, 2)
        KL = IPR(220)
        IF (KL .EQ. 3) THEN
          IF (IFL(3)(2:2) .EQ. ' ') THEN
            N = 1
          ELSE
            N = 2
          END IF
          IF (NQ(1:N) .EQ. IFL(3)(1:N)) THEN
            IF (N .EQ. 1) THEN
              IF (ICHAR(NQ(2:2)) .GE. 65 .AND. ICHAR(NQ(2:2)) .LE. 90)
     1            GO TO 20
            END IF
          ELSE
            GO TO 20
          END IF
        END IF
        IF (NQ(1:2) .EQ. 'HO' .AND. IPR(435) .EQ. 0) THEN
          GO TO 20
        ELSE IF (NQ(1:2) .EQ. 'HN') THEN
          GO TO 20
        ELSE IF (NQ(2:2) .EQ. '0') THEN
          GO TO 20
        ELSE IF (NQ(2:3) .EQ. '00') THEN
          GO TO 20
        END IF
        GO TO 30
   20   IF (KL .EQ. 3) THEN
          IF (IFL(3)(1:2) .NE. 'HO') THEN
            NIEN = -8
            RETURN
          ELSE
            IPR(435) = 1
          END IF
        END IF
      END IF
   30 LBA   = 0
      LBC   = 0
      NR    = 0
      NCH   = 0
      ITEL  = 0
      NIEN  = 0
      INQNR = 0
      JNQNR = 0
      IF (MODE .EQ. 8)  THEN
        LBB = -1
        LBD = 27
      ELSE
        LBB = 0
        LBD = 0
      END IF
      LEV = 1
      NB  = 1
      NE  = 7
      CALL GEN039 (1, NQ, 1, 7, NB, NE)
      DO 40 I = 1, NE
        ICH = NQ(I : I)
        IF (ICH .EQ. '*') THEN
          NIEN = -14
          RETURN
        ELSE IF (ICH .EQ. CHAR(92)) THEN
          NIEN = -10
          RETURN
        ELSE IF (ICH .EQ. '(')  THEN
          LBB = 0
          LEV = 2
        ELSE IF (ICH .EQ. ')') THEN
          LEV = 4
        ELSE IF (ICH .EQ. '_') THEN
          IF (MODE .NE. 0) THEN
            LEV = 4
          ELSE
            NIEN = -11
            RETURN
          END IF
        ELSE IF (ICH .EQ. '''') THEN
          IF (LBC .EQ. 0) THEN
            LBC  = 1
            LEV  = 3
          ELSE
            NIEN = -9
            RETURN
          END IF
        ELSE IF (ICH .EQ. '"') THEN
          IF (LBC .EQ. 0) THEN
            LBC  = 2
            LEV  = 3
          ELSE
            NIEN = -9
            RETURN
          END IF
        ELSE IF (ICH .EQ. '#') THEN
          IF (MODE .GT. 0) THEN
            LBC = 3
            LEV = 3
          ELSE
            GO TO 50
          END IF
        ELSE
          DO J = 1, 26
            IF (ICH .EQ. CHAR(ICHAR('A') + J - 1) .OR.
     1          ICH .EQ. CHAR(ICHAR('a') + J - 1)) THEN
              IF (LEV .EQ. 1) THEN
                NR = NR + 1
                IF (NR .EQ. 1) THEN
                  NQJ = ' '//CHAR(ICHAR('A') + J - 1)
                  LBA = J * 100
                ELSE IF (NR .EQ. 2) THEN
                  NQJ(1:1) = NQJ(2:2)
                  NQJ(2:2) = CHAR(ICHAR('a') + J - 1)
                  LBA      = LBA + J
                ELSE
                  LBA = -1
                  GO TO 50
                END IF
                GO TO 40
              ELSE IF (LEV .EQ. 2) THEN
                IF (NCH .EQ. 0 .AND. LBC .EQ. 0 .AND.
     1              IGBL(61) .EQ. 0) THEN
                  NCH = NCH + 1
                  LBC = 3 + J
                  LEV = 3
                ELSE
                  NIEN = -8
                  RETURN
                END IF
              ELSE IF (LEV .EQ. 3) THEN
                NIEN = -8
                RETURN
              ELSE
                IF (MODE .LE. 0) THEN
                  GO TO 50
                ELSE
                  LBD = J
                  GO TO 40
                END IF
              END IF
            END IF
          END DO
          DO J = 1, 10
            IF (ICH .EQ. CHAR(ICHAR('0') + J - 1)) THEN
              IF (LEV .LE. 2) THEN
                IF (MODE .EQ. 8 .AND. LBB .EQ. -1) LBB = 0
                LBB  = LBB * 10 + J - 1
                IF (LBB .EQ. 0) THEN
                  NIEN = -13
                  NQ(I:) = ' '
                  RETURN
                END IF
                ITEL = ITEL + 1
                LEV  = 2
                GO TO 40
              ELSE
                NIEN = -8
                RETURN
              END IF
            END IF
          END DO
        END IF
   40 CONTINUE
   50 ITEL = ITEL + NR
      IF (LBC .GT. 0)  ITEL = ITEL + 1
      IENM = 0
      IF (IAN .GT. 0) THEN
        DO I = 1, IAN
          IF (LBA .EQ. IEL(IEN(I))) THEN
            IENM = I
            GO TO 60
          END IF
        END DO
      END IF
      DO III = 1, NP9
        IF (LBA .EQ. IEL(III)) GO TO 60
      END DO
      III = 0
   60 IF (MODE .EQ. 8) THEN
        IF (IENM .GT. 0) RETURN
        IF (III .GE. NP9 - 3 .AND. III .LE. NP9) IENM = III
      ELSE IF (MODE .LT. 8) THEN
        IF (IENM .EQ. 0) THEN
          IF (IABS(IGBL(8)) .NE. 2 .OR. NQJ .EQ. 'Cg' .OR.
     1                          NQJ .EQ. ' Q') THEN
            IF (III .GT. 0) THEN
              IAN = IAN + 1
              IF (IAN .GT. NP10) THEN
                NIEN = -2
                RETURN
              END IF
              IEN(IAN)    = III
              JJ          = IABS(IATPR(III))
              LMT(IAN, 2) = JTP(JJ)
              LMT(IAN, 1)  = NQJ
              RADR(IAN, 3) = REL(III)
              RADR(IAN, 4) = ABS(VDWR(III))
              IF (III .EQ. 3) THEN
                IACL(IAN) = 2
              ELSE IF (III .EQ. 4) THEN
                IACL(IAN) = 4
              ELSE IF (IATPR(III) .EQ. -7) THEN
                IACL(IAN) = 3
              ELSE IF (III .GT. 2) THEN
                IF (ICLR .LT. 8) ICLR = ICLR + 1
                IACL(IAN) = ICLR
              END IF
              IENM = IAN
            END IF
          ELSE
            NIEN = -3
            RETURN
          END IF
        END IF
        IF (IENM .LE. 0) THEN
          NIEN = -5
          RETURN
        END IF
        IF (MODE .LT. 0 .OR. (MODE .EQ. 0 .AND. ITEL .GT. 4)) THEN
          LBC  = 3
          ITEL = 3
          IF (MOD(LBA, 100) .NE. 0) ITEL = ITEL + 1
          IF (IPR(683) .GE. NP36) THEN
            NIEN = -7
            RETURN
          ELSE
            IPR(683) = IPR(683) + 1
          END IF
          IENLB(IENM) = IENLB(IENM) + 1
          LBB         = IENLB(IENM)
          IF (LBB .GE. 10)   ITEL = ITEL + 1
          IF (LBB .GE. 100)  ITEL = ITEL + 1
          IF (LBB .GE. 1000) ITEL = ITEL + 1
          IF (LBB .GT. 9999 .AND. IGBL(61) .EQ. 0) THEN
            NIEN = -12
            RETURN
          END IF
          IF (ITEL .GT. 4) IPR(71) = 0
        END IF
        JNQNR = ((120 - IATNR(IEN(IENM))) * 10000  + LBB) * 40 + LBC
        IF (IGBL(61) .EQ. 0) THEN
          IF (LBC .GT. 0) LBC = LBC + 10
          IF (LBB .GE. 10 ** (5 - NR) .AND. LBC .EQ. 0) THEN
            LBB1 = LBB / 10
            LBC  = LBB - LBB1 * 10 + 1
            LBB  = LBB1
          END IF
          NQX = LBB * 40 + LBC
        ELSE
          NQX = LBB * 4 + LBC
        END IF
        IF (LBD .GE. 128) THEN
          NIEN = -6
          RETURN
        END IF
        INQNR = (IENM * 400000 + NQX) * 128 + LBD
        IF (MODE .GT. 1) THEN
          IF (MODE .EQ. 2) THEN
            NAT = IPR(37)
          ELSE IF (MODE .EQ. 3) THEN
            NAT = IPR(39)
          ELSE IF (MODE .EQ. 4) THEN
            NAT = IPR(39) + IPR(64)
          END IF
          DO I = 1, NAT
            IF (INQNR .EQ. LABA(I)) THEN
              NIEN = I
              RETURN
            END IF
          END DO
          NIEN = - 4
        ELSE
          NIEN = IENM - 1
        END IF
C * PLUTON PACK MODE
      ELSE IF (MODE .EQ. 9 .OR. MODE .EQ. 10) THEN
        IF (IENM .EQ. 0) THEN
          IF (III .EQ. 0) THEN
            NIEN = -1
            RETURN
          ELSE
            IAN = IAN + 1
            IF (IAN .GT. NP10) THEN
              NIEN = -2
              RETURN
            END IF
            RADR(IAN, 3) = REL(III)
            RADR(IAN, 4) = ABS(VDWR(III))
            IEN(IAN) = III
            IENM     = IAN
          END IF
        END IF
        IF (ITEL .GT. 4 .OR. MODE .EQ. 10) THEN
          LBC         = 3
          IENLB(IENM) = IENLB(IENM) + 1
          LBB         = IENLB(IENM)
        END IF
        NQX   = LBB * 32 + LBC
        INQNR = (IENM - 1) * 64000 + NQX
        JNQNR = (120 - IATNR(IEN(IENM))) * 64000 + NQX
      END IF
      RETURN
      END SUBROUTINE PLA046
      SUBROUTINE PLA047 (INQNR, NQ, MN, IENR, IPAR, IALIAS, IPDB, IMU)
      PARAMETER (NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,NP36=3000,
     1 NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /ALIASES/ ALAB(NP36), BLAB(NP36)
      CHARACTER ALAB*7, BLAB*7
      DIMENSION NUM(4)
      CHARACTER NQ*(*), NQ1*9, NQ2*9, NQ3*9
      K = 0
      JPAR = IPAR
      IF (IGBL(71) .GT. 0 .AND. IALIAS .EQ. 0 .AND. JPAR .EQ. 1)
     1    JPAR = 0
      NQ   = ' '
      NQ3  = ' '
      IENR = 0
      MN   = 0
      JX3  = ABS(INQNR)
      IF (JX3 .GT. 0) THEN
        JX1 = JX3 / 51200000
        JX3 = MOD(JX3, 51200000)
        JX2 = JX3 / 128
        JX3 = MOD(JX3, 128)
        IF (IGBL(61) .EQ. 0) THEN
          JX4 = MOD(JX2, 40)
          JX2 = JX2 / 40
          IF (JX4 .GT. 0 .AND. JX4 .LT. 11) THEN
            JX2 = JX2 * 10 + JX4 - 1
            JX4 = 0
          ELSE
            JX4 = JX4 - 10
          END IF
        ELSE
          JX4 = MOD(JX2, 4)
          JX2 = JX2 / 4
        END IF
        MN  = JX3 + 1
        IF (JX2 .EQ. 0) JPAR = MIN (JPAR, 0)
        IF (INQNR  .LT. 0) JX3  = 0
        IENR = IEN(JX1)
        JX1  = IEL(IENR)
        J1   = JX1 / 100
        J2   = MOD(JX1, 100)
        K    = 1
        IF (IPDB .EQ. 1 .AND. J2 .EQ. 0) K = 2
        NQ3(K : K) = CHAR(ICHAR('A') + J1 - 1)
        K = K + 1
        IF (J2 .GT. 0) THEN
          IF (IPDB .LE. 0) THEN
            NQ3(K : K) = CHAR(ICHAR('a') + J2 - 1)
          ELSE
            NQ3(K : K) = CHAR(ICHAR('A') + J2 - 1)
          END IF
          K = K + 1
        END IF
        IF (JPAR .GT. 0) THEN
          NQ3(K : K) = '('
          K = K + 1
        END IF
        J2     = JX2 / 10
        NUM(4) = MOD(JX2, 10)
        J3     = J2 / 10
        NUM(3) = MOD(J2, 10)
        NUM(1) = J3 / 10
        NUM(2) = MOD(J3, 10)
        J2     = 0
        DO J = 1,  4
          IF (NUM(J) .GT. 0 .OR. J2 .GT. 0) THEN
            NQ3(K : K) = CHAR(ICHAR('0') + NUM(J))
            K  = K  + 1
            J2 = J2 + 1
          END IF
        END DO
        IF (JX4 .GT. 0) THEN
          IF (JX4 .EQ. 1) THEN
            NQ3(K : K) = ''''
          ELSE IF (JX4 .EQ. 2) THEN
            NQ3(K : K) = '"'
          ELSE IF (JX4 .EQ. 3) THEN
            NQ3(K : K) = '#'
          ELSE IF (JX4 .GT. 3) THEN
            NQ3(K : K) = CHAR(ICHAR('A') + JX4 - 4)
          END IF
          K  = K  + 1
        END IF
        IF (JPAR .GT. 0) THEN
          NQ3(K : K) = ')'
          K = K + 1
        END IF
        IF (JX3 .GT. 0) THEN
          IF (JPAR .EQ. 0) THEN
            NQ3(K : K) = '_'
            K          = K + 1
          END IF
          IF (JX3 .LT. 27) THEN
            NQ3(K : K) = CHAR(ICHAR('a') + JX3 - 1)
          ELSE
            NQ3(K : K) = '*'
          END IF
          K = K + 1
        END IF
        NQ3(K : K) = ' '
      END IF
      IF (K .GT. 1 .AND. IPR(683) .GT. 0 .AND. IALIAS .EQ. 0) THEN
        NQ1 = NQ3(1:K)
        K0  = K
        IF (JX3 .GT. 0) THEN
          K0  = K0 - 1
          NQ3(K0:K0) = ' '
          IF (JPAR .EQ. 0) K0 = K0 - 1
          NQ3(K0:K0) = ' '
        END IF
        DO I = 1, IPR(683)
          IF (IPR(501) .EQ. 0) THEN
            N = INDEX (BLAB(I), '#')
          ELSE
            N = INDEX (BLAB(I), ' ')
          END IF
          IF (N .GT. 0) THEN
            IF (NQ3(1:N) .EQ. BLAB(I)(1:N)) THEN
              M  = INDEX (ALAB(I), ' ') - 1
              IF (IMU .EQ. 0) THEN
                IF (INDEX (ALAB(I), '_') .NE. 0) THEN
                  NQ = NQ1
                  RETURN
                END IF
              END IF
              IF (M .LT. 1 .OR. M .GT. (7 + K0 - K)) THEN
                NQ = NQ1
              ELSE
                NQ2 = ALAB(I)(1:M)//NQ1(K0:K)
                CALL GEN020 (-1, NQ3, 1, 2)
                IF (NQ2(1:2) .EQ. NQ3(1:2)) NQ2(1:2) = BLAB(I)(1:2)
                NQ = NQ2(1:7)
              END IF
              RETURN
            END IF
          END IF
        END DO
        NQ = NQ1
      ELSE
        NQ = NQ3(1:7)
      END IF
      RETURN
      END SUBROUTINE PLA047
      SUBROUTINE PLA048
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      DIMENSION B(3, 3), C(3, 3), XXX(12), ICSD(6), UVIJ(3)
      CHARACTER FORMI*119, FORMJ*116, FORMK*120
      FORMI( 1:31)   = '(A           ,F10.6,''('',I4,'')'','
      FORMI(32:68)   = 'F10.6,''('',I4,'')'',F10.6,''('',I4,'')'',7X,'
      FORMI(69:119)  = FORMI(15:64)//')'
      FORMJ(1:30)    = '(A,''-'',A,''['',I2,''] -> '',A,''['','
      FORMJ(31:69)   = 'F9.2,'']'',F7.3,''('',I3,'')  '',3F7.4, F9.4,'
      FORMJ(70:95)   = 'F7.3,F7.2,F8.2,''('',I3,'')'','
      FORMJ(96:116)  = 'F8.4,''('',I3,'')'',F7.0)'
      FORMK(1:33)    = '(A,''['',I2,''] -> '',A,''['',F9.2,'']'','
      FORMK(34:70)   = 'F7.4,''('',I3,'') '',3F7.4,F9.4,F6.2,''('','
      FORMK(71:108)  = 'I2,'')'',2F6.1,F7.4,''('',I3,'')'',F7.4,''('','
      FORMK(109:120) = 'I3,'')'',F8.3)'
      DMIN  = 0.0
      ANG2M = 0.0
      NTMP  = 0
      NPRT  = 0
      NSYM    = IPR(48)
      NRING   = IPR(64)
      NMAX    = IPR(39)
      IRMST   = 0
      ISANG1  = 0
      ISDIST1 = 0
      ISDIST3 = 0
      NDEC0   = 0
      NDEC1   = 0
      NDEC3   = 0
      SANG1   = 0
      SDIST1  = 0
      SDIST3  = 0
      DIST4   = 0.0
      DO MODE = 1, 5
        CALL PLA097 (0, 0.0)
        IF (MODE .EQ. 1) THEN
          DMAX = PAR(36)
          DMIN = 2.5
        ELSE IF (MODE .EQ. 2) THEN
          DMAX = PAR(69)
          DMIN = 2.0
          ANG2M = 45.0
        ELSE IF (MODE .EQ. 3) THEN
          DMAX = 3.0
          DMIN = 1.5
        ELSE IF (MODE .EQ. 4) THEN
          DMAX  = PAR(263)
          DMIN  = 2.0
          ANG3M = PAR(264)
        ELSE IF (MODE .EQ. 5) THEN
          DMAX = PAR(447)
          DMIN = 2.5
          ANG3M = PAR(448)
        END IF
        DO I = 1, 3
          V3(I) = DMAX * PAR(112 + I)
        END DO
        IF (MODE .GT. 2) THEN
          NBEG = 1
          NEND = IPR(37)
          NTMP = 0
          NPRT = 0
        ELSE
          NBEG = NMAX + 1
          NEND = NMAX + NRING
        END IF
        NR = 0
        DO 80 N = NBEG, NEND
          NEWTMP = NMAX + NRING
          CALL GEN048 (-1, IFG(1, N), 19, MET)
          CALL GEN048 (-1, IFG(1, N), 7, NHAT)
          IF (MODE .EQ. 3) THEN
            IF (MET .EQ. 0) GO TO 80
            NTMP = 0
          ELSE IF (MODE .EQ. 4) THEN
            IF (NHAT .EQ. 0) GO TO 80
            NTMP = 0
          ELSE IF (MODE .EQ. 5) THEN
            IF (NINT(CON(N, NP4)) .NE. -1 .OR.
     1          MET .NE. 0 .OR. NHAT .NE. 0) GO TO 80
            NTMP = 0
          END IF
          CALL GEN048 (-6, IFG(1, N), 9, IRES)
          CALL PLA047 (LABA(N), NQ1, IDUM, JDUM, IPR(71),
     1      IGBL(55), 0, 1 - IGBL(55))
          IF (MODE .EQ. 2) THEN
            JBEG = 1
            JEND = IPR(37)
          ELSE
            JBEG = NMAX + 1
            JEND = NMAX + NRING
          END IF
          DO 60 J = JBEG, JEND
            IF (MODE .EQ. 2) THEN
              CALL GEN048 (-1, IFG(1, J), 19, MET)
              IF (MET .EQ. 0) GO TO 60
            END IF
            CALL GEN048 (-6, IFG(1, J), 9, JRES)
            DO 50 NSM = 1, NSYM
              DO I = 1, 3
                XXX(I)     = XXO(J, I)
                XXX(I + 3) = 0.0
                V4(I)      = 0.0
              END DO
              NS = NSM
              CALL SGSM (LINE, NS, XXX, 6, 3, IERR)
              IF (MODE .EQ. 3 .AND. NSM .EQ. 1) THEN
                K = 3
                GO TO 40
              ELSE
                K = 1
              END IF
   10         IF ((XXO(N, K) - XXX(6 + K)) .GT. V3(K)) GO TO 30
              XXX(6 + K) = XXX(6 + K) - 1.0
              V4(K)      = V4(K) - 1.0
              GO TO 10
   20         K = K - 1
   30         XXX(6 + K) = XXX(6 + K) + 1.0
              V4(K)      = V4(K) + 1.0
              IF ((XXO(N, K)  - XXX(6 + K)) .GE. V3(K)) GO TO 30
              IF ((XXX(6 + K) - XXO(N, K))  .LE. V3(K)) GO TO 40
              K = K - 1
              IF (K .GT. 0) THEN
                GO TO 30
              ELSE
                GO TO 50
              END IF
   40         K = K + 1
              IF (K .GT. 3) THEN
                DO L = 1, 3
                  V5(L) = XXX(6 + L) - XXO(N, L)
                END DO
                CALL GEN002 (1, OR, V5, V6, DUM)
                CALL GEN002 (2, OR, V5, V7, DIST1)
                IF (IATP(N) .LE. 0) THEN
                  WRITE (LU6, 99993, IOSTAT = IOST) IATP(N)
                  RETURN
                END IF
                IF (DIST1 .LT. DMAX .AND. DIST1 .GT. DMIN) THEN
                  NEWTMP = NEWTMP + 1
                  IF (NEWTMP .EQ. 0) GO TO 20
                  IPR(54) = NS
                  DO I = 1, 3
                    ITR(I) = NINT(V4(I))
                  END DO
                  CALL PLA059 (J, NEWTMP)
                  DO I = 1, 3
                    IFG(I, NEWTMP) = IFG(I, J)
                  END DO
                  IF (MODE .LT. 3) THEN
                    NPL = IPR(19) + IATP(N)
                    IF (NPL .GT. NP2) THEN
                      WRITE (LU6, 99993, IOSTAT = IOST) IATP(N)
                      RETURN
                    END IF
                    CALL PLA056 (XLS(1,NPL), NEWTMP, DIST3, SDIST3,
     1                IDIST3, 4, NDEC3)
                  END IF
                  IF (MODE .EQ. 3) THEN
                    IF (IATP(J) .GT. 0) THEN
                      NPL = IPR(19) + IATP(J)
                      IF (NPL .GT. NP2) THEN
                        WRITE (LU6, 99993, IOSTAT = IOST) IATP(J)
                        RETURN
                      END IF
                      DIST3 = ABS(XLS(1, NPL) * XXO(N, 4)
     1                      + XLS(2, NPL)     * XXO(N, 5)
     2                      + XLS(3, NPL)     * XXO(N, 6)
     3                      - XLS(4, NPL))
                      IF (ABS(DIST3) .LT. DMIN) THEN
                        NEWTMP = NEWTMP -1
                        GO TO 60
                      END IF
                    END IF
                  END IF
                  ARUJ = NS * 1000.0 + V4(1) * 100 + V4(2) * 10 + V4(3)
     1                + 555 + JRES / PAR(42)
                  CALL PLA047 (LABA(J), NQ2, IDUM, JDUM, IPR(71),
     1                         IGBL(55), 0, 0)
                  LABA(NEWTMP) = LABA(J)
                  IF (MODE .LT. 3) THEN
                    NPL8 = IPR(19) + IATP(N)
                    V8(1) = XLS(1, NPL8)
                    V8(2) = XLS(2, NPL8)
                    V8(3) = XLS(3, NPL8)
                    ANG2  = GEN027 (V8, V7, RGBL(6))
                    IF (ANG2 .GT. 90.0) ANG2 = 180.0 - ANG2
                  END IF
                  IF (MODE .EQ. 1 .OR. MODE .EQ. 4
     1                            .OR. MODE .EQ. 5) THEN
                    IF (IATP(J) .LE. 0 .OR. IATP(J) .GT. NP2) THEN
                      WRITE (LU6, 99993, IOSTAT = IOST) IATP(J)
                      RETURN
                    END IF
                    NPL5  = IPR(19) + IATP(J)
                    V5(1) = XLS(1, NPL5)
                    V5(2) = XLS(2, NPL5)
                    V5(3) = XLS(3, NPL5)
                    V1(4) = XLS(4, NPL5)
                    CALL SGSM (LINE, NS, XJS, 6, 6, IERR)
                    K0 = 0
                    DO I1 = 1, 3
                      V2(I1) = V4(I1) + XJS(I1 + 9)
                      DO J1 = 1, 3
                        K0 = K0 + 1
                        UIJ(I1, J1) = XJS(K0)
                      END DO
                    END DO
                    CALL GEN005 (OR, B)
                    CALL GEN004 (UIJ, B, C)
                    CALL GEN005 (ROR, B)
                    CALL GEN004 (B, C, UIJ)
                    CALL GEN002 (1, UIJ, V5, V1, DUM)
                    CALL GEN002 (-1, OR, V1, V6, DUM)
                    V1(4) = V1(4) + GEN009(V6, V2)
                    ANG3  = GEN027 (V1, V7, RGBL(6))
                    IF (ANG3 .GT. 90.0) ANG3 = 180.0 - ANG3
                    CALL PLA056 (V1, N, DIST2, SDIST2, IDIST2, 4, NDEC2)
                    ANG1  = GEN027 (V8, V1, RGBL(6))
                    IF (ANG1 .GT. 90.0) ANG1 = 180.0 - ANG1
                    SANG1 = 0.0
                    IF (MODE .EQ. 1) THEN
                      SANG1 = XLS(5, NPL8)**2 + XLS(5, NPL5)**2
     1                      + XLS(6, NPL8)**2 + XLS(6, NPL5)**2
     2                      + XLS(7, NPL8)**2 + XLS(7, NPL5)**2
                      SANG1 = RGBL(6) * SQRT(SANG1)
                      IF (SANG1 .GT. 0.0001 .AND. SANG1 .LT. 0.9) THEN
                        CALL GEN041 (ANG1, SANG1, ISANG1, 2,
     1                    NDECA1, IPR(68))
                      ELSE
                        SANG1  = 0.0
                        ISANG1 = 0
                        NDECA1 = 0
                      END IF
                      IF (ANG2 .LT. PAR(62)) THEN
                        NR = NR + 1
                        IF (NR .EQ. 1) THEN
                          CALL PLA262 (-14)
                          WRITE (LU7, 99999, IOSTAT = IOST)
     1                      PAR(36), PAR(62)
                          CALL GEN074 (DUMA, 1, 6, 99999.0)
                          DUMA(4) = 0.0
                        END IF
                        CALL PLA053 (N, NEWTMP, 0, 0, DIST1, SDIST1,
     1                               ISDIST1, NDEC1, IER)
                        IF (IER .NE. 0) DIST1 = 0.0
                        FORMK(37:37)   = CHAR(ICHAR('0') + NDEC1)
                        FORMK(65:65)   = CHAR(ICHAR('0') + NDECA1)
                        FORMK(87:87)   = CHAR(ICHAR('0') + NDEC2)
                        FORMK(103:103) = CHAR(ICHAR('0') + NDEC3)
                        IF (ANG1 .LT. 0.05) THEN
                          DIST4 = DIST1 * SIN (ANG2 / RGBL(6))
                          WRITE (PRBUF, FORMK, IOSTAT = IOST)
     1                      NQ1, IRES, NQ2, ARUJ, DIST1, ISDIST1,
     2                     (V1(L), L = 1, 4), ANG1, ISANG1, ANG2, ANG3,
     3                     DIST2, IDIST2, DIST3, IDIST3, DIST4
                        ELSE
                          WRITE (PRBUF, FORMK, IOSTAT = IOST)
     1                      NQ1, IRES, NQ2, ARUJ, DIST1, ISDIST1,
     2                      (V1(L), L = 1, 4), ANG1, ISANG1, ANG2, ANG3,
     3                      DIST2, IDIST2, DIST3, IDIST3
                        END IF
                        CALL PLA263 (LU7, PRBUF, 132, 1, 3)
                        CALL PLA097 (1, ARUJ)
                        DUMA(1) = MIN (DUMA(1), DIST1)
                        DUMA(2) = MIN (DUMA(2), ANG1)
                        DUMA(3) = MIN (DUMA(3), ANG2)
                        DUMA(4) = MAX (DUMA(4), ANG3)
                        DUMA(5) = MIN (DUMA(5), DIST2)
                        DUMA(6) = MIN (DUMA(6), DIST3)
                      END IF
                    ELSE
                      IF (ANG3 .LT. ANG3M) THEN
                        IF (NINT(CON(N, NP4)) .EQ. -1) THEN
                          I = NINT(CON(N, 1))
                          CALL PLA047 (LABA(I), NQ3, IDUM, JDUM,
     1                      IPR(71), IGBL(55), 0, 1 - IGBL(55))
                          CALL PLA227 (I, N, UVIJ)
                          ANG4  = GEN027 (V1, UVIJ, RGBL(6))
                          IF (ANG4 .GT. 90.0) ANG4 = 180.0 - ANG4
                          ANG4 = 90.0 - ANG4
                          IF (MODE .EQ. 4) ANG4 = NINT(ANG4)
                          CALL PLA053 (I, N, NEWTMP, 0, ANG1, SANG1,
     1                                 ISANG1, NDEC0, IER)
                          IF (IER .NE. 0) ANG1 = 0
                          IF (ISANG1 .EQ. 0) THEN
                            NDEC0 = 0
                            ANG1  = NINT (ANG1)
                          END IF
                          FORMJ(83:83) = CHAR(ICHAR('0') + NDEC0)
                          CALL PLA053 (N, NEWTMP, 0, 0, DIST1, SDIST1,
     1                                 ISDIST1, NDEC1, IER)
                          IF (IER .NE. 0) DIST1 = 0.0
                          FORMJ(43:43) = CHAR(ICHAR('0') + NDEC1)
                          CALL PLA053 (I, NEWTMP, 0, 0, DIST3, SDIST3,
     1                                 ISDIST3, NDEC3, IER)
                          IF (IER .NE. 0) DIST3 = 0.0
                          FORMJ(99:99) = CHAR(ICHAR('0') + NDEC3)
                          NR = NR + 1
                          IF (NR .EQ. 1) THEN
                            CALL PLA262 (-12)
                            IF (MODE .EQ. 4) THEN
                              WRITE (LU7, 99992, IOSTAT = IOST)
     1                          DMAX, ANG3M
                            ELSE
                              WRITE (LU7, 99998, IOSTAT = IOST)
     1                          DMAX, ANG3M
                            END IF
                            CALL GEN074 (DUMA, 1, 5, 99999.0)
                            DUMA(4) = 0.0
                            DUMA(6) = 0.0
                          END IF
                          IF (MODE .EQ. 5) THEN
                            FORMJ(73:73)   = '3'
                            FORMJ(112:115) = 'F7.2'
                            WRITE (PRBUF, FORMJ, IOSTAT = IOST)
     1                        NQ3, NQ1, IRES, NQ2, ARUJ, DIST1, ISDIST1,
     2                       (V1(L), L = 1, 4), DIST2, ANG3, ANG1,
     3                       ISANG1, DIST3, ISDIST3, ANG4
                          ELSE
                            FORMJ(73:73)   = '2'
                            FORMJ(112:115) = 'I7  '
                            WRITE (PRBUF, FORMJ, IOSTAT = IOST)
     1                        NQ3, NQ1, IRES, NQ2, ARUJ, DIST1, ISDIST1,
     2                        (V1(L), L = 1, 4), DIST2, ANG3, ANG1,
     3                        ISANG1, DIST3, ISDIST3, NINT(ANG4)
                          END IF
                          CALL PLA263 (LU7, PRBUF, 132, 1, 3)
                          CALL PLA097 (1, ARUJ)
                          DUMA(1) = MIN (DUMA(1), DIST1)
                          DUMA(2) = MIN (DUMA(2), DIST2)
                          DUMA(5) = MIN (DUMA(5), DIST3)
                          DUMA(3) = MIN (DUMA(3), ANG3)
                          DUMA(4) = MAX (DUMA(4), ANG1)
                          DUMA(6) = MAX (DUMA(6), ANG4)
                        END IF
                      END IF
                    END IF
                  ELSE IF (MODE .EQ. 2) THEN
                    IF (ANG2 .LT. ANG2M) THEN
                      NR = NR + 1
                      IF (NR .EQ. 1) THEN
                         CALL PLA262 (8)
                         WRITE (LU7, 99997, IOSTAT = IOST) DMAX
                      END IF
                      CALL PLA262 (1)
                      WRITE (LU7, 99996, IOSTAT = IOST)
     1                  NQ1, IRES, NQ2, ARUJ, DIST1, DIST3, ANG2
                      CALL PLA097 (1, ARUJ)
                    END IF
                  ELSE IF (MODE .EQ. 3) THEN
                    IF (NTMP .LT. NP4 - 1) THEN
                      NTMP = NTMP + 1
                      IATC(NTMP) = NEWTMP
                    ELSE
                      IRMST = IRMST + 1
                    END IF
                  END IF
                END IF
                GO TO 20
              END IF
              GO TO 10
   50       CONTINUE
   60     CONTINUE
          IF (MODE .EQ. 3) THEN
            IF (NTMP .GT. 0) THEN
              DO I = 1, NP4
                DATC(I) = CON(N, I)
              END DO
              NC = - NINT (CON(N, NP4))
              IF (NC .LT. 0) THEN
                NC = NP4
                CALL GEN048 (-1, IFG(1, N), 8, IVAL)
                IF (IVAL .GT. 0) NC = NC + IPR(76)
              END IF
              DO I = 1, NTMP
                CON(N, I) = IATC(I)
              END DO
              NTMPC = NTMP
              DO 70 I = 1, NC
                IF (I .LE. NP4) THEN
                  K = NINT(DATC(I))
                ELSE
                  IF (IBON(I - NP4, 1) .NE. N) GO TO 70
                  K = IBON(I - NP4, 2)
                END IF
                DO L = 1, NTMPC
                  CALL PLA050 (IATC(L), K, 0, 0, DIST2)
                  IF (DIST2 .LT. 1.5) GO TO 70
                END DO
                IF (NTMP .LT. NP4 - 1) THEN
                  NTMP = NTMP + 1
                  CON(N, NTMP) = K
                ELSE
                  IRMST = IRMST + 1
                END IF
   70         CONTINUE
              CON(N, NP4) = - NTMP
              IF (NPRT .EQ. 0) THEN
                CALL PLA262 (0)
                NPRT = 1
                CALL PLA262 (3)
                WRITE (LU7, 99995, IOSTAT = IOST)
              END IF
              IPR(81) = 2
              IFL(2)  = NQ1
              CALL PLA035 (0)
              DO I = 1, NP4
                CON(N, I) = DATC(I)
              END DO
            END IF
          END IF
   80   CONTINUE
        IF (MODE .EQ. 1 .AND. NR .GT. 0) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99989, IOSTAT = IOST) (DUMA(L), L = 1, 6)
        ELSE IF ((MODE .EQ. 4 .OR. MODE .EQ. 5) .AND. NR .GT. 0) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99990, IOSTAT = IOST) (DUMA(L), L = 1, 6)
        END IF
        CALL PLA097 (-1, 0.0)
      END DO
      CALL PLA262 (5)
      WRITE (LU7, 99991, IOSTAT = IOST)
      DO I = NMAX + 1, NMAX + NRING
        CALL PLA262 (1)
        DO K = 1, 3
          YUNK = SQRT(XSD(I, K))
          CALL GEN041 (XXO(I, K), YUNK, ICSD(K), IPR(183),
     1                 NDEC, IPR(68))
          NDC  = K * 17 + 2
          YUNK = SQRT(XSD(I, K + 3))
          CALL GEN041 (XXO(I, K + 3), YUNK, ICSD(K + 3), 5, NDECJ,
     1       IPR(68))
          NDCJ             = K * 17 + 56
          FORMI(NDC:NDC)   = CHAR(ICHAR('0') + NDEC)
          FORMI(NDCJ:NDCJ) = CHAR(ICHAR('0') + NDECJ)
          ICSD(K)          = MIN (99, ICSD(K))
          ICSD(K + 3)      = MIN (99, ICSD(K + 3))
        END DO
        CALL PLA047 (LABA(I), NQ2, IDUM, JDUM, IPR(71),
     1                         IGBL(55), 0, 0)
        WRITE (PRBUF, FORMI, IOSTAT = IOST)
     1    NQ2(1:6), (XXO(I, K), ICSD(K), K = 1, 6)
        CALL PLA263 (LU7, PRBUF, 132, 1, 3)
      END DO
      IF (IRMST .GT. 0) THEN
        WRITE (LU6, 99994, IOSTAT = IOST)
        WRITE (LU7, 99994, IOSTAT = IOST)
      END IF
      RETURN
99999 FORMAT ('Analysis of Short Ring-Interactions with Cg-Cg ',
     1 'Distances < ', F5.1, ' Angstrom and Beta <', F5.1, 'Deg.', /,
     2 132('='), /, '- Cg(I)    = Plane number I (= ring number in ',
     3 '() above)', /, '- Alpha    = Dihedral Angle between Planes ',
     4 'I and J (Deg)', /, '- Beta     = Angle Cg(I)-->Cg(J) or ',
     5 'Cg(I)-->Me vector and normal to plane I (Deg)', /,
     6 '- Gamma    = Angle Cg(I)-->Cg(J) vector and normal to',
     7 ' plane J (Deg)', /,
     8 '- Cg-Cg    = Distance between ring Centroids (Ang.)', /,
     9 '- CgI_Perp = Perpendicular distance of Cg(I) on',
     * ' ring J (Ang.)', /,
     1 '- CgJ_Perp = Perpendicular distance of Cg(J) on',
     2 ' ring I (Ang.)', /,
     3 '- Slippage = Distance between Cg(I) and Perpendicular',
     4 ' Projection of Cg(J) on Ring I (Ang).', /,
     5 '- P,Q,R,S  = J-Plane Parameters for Carth. Coord.',
     6 ' (Xo, Yo, Zo)', //, 'Cg(I) Res(I)', 3X,
     7 'Cg(J)  [', 3X, 'ARU(J)] ', 6X, 'Cg-Cg', 1X,
     8 'Transformed J-Plane P, Q, R, S', 5X, 'Alpha', 2X,
     9 'Beta', 1X, 'Gamma', 4X, 'CgI_Perp    CgJ_Perp  Slippage', /)
99998 FORMAT (/, 'Analysis of Y-X...Cg(Pi-Ring) Interactions',
     1 ' (X..Cg <', F4.1, ' Ang. - Gamma < ', F5.1, ' Deg)', /,
     2         132('='), //, '   Y--X(I)    Res(I)', 3X,
     3 'Cg(J)  [', 3X, 'ARU(J)]', 7X, 'X..Cg', 2X,
     4 'Transformed J-Plane P, Q, R, S  X-Perp Gamma', 6X,
     5 'Y-X..Cg', 8X, 'Y..Cg Y-X,Pi', /)
99997 FORMAT (//, 'Ring-Metal Interactions with Cg-Me < ', F5.1,
     1 ' Ang.', /, 132('='), //,
     2 'Cg(I) Res(I)', 3X, 'Me(J)   [', 3X, 'ARU(J)]  Cg(I)-Me(J)',
     3 ' MeJ_Perp    Beta', /)
99996 FORMAT (A, '[', I2, '] -> ', A, ' [', F9.2, '] ', 2F10.3, F9.2)
99995 FORMAT ('Geometry around Metals Involving Ring centroids', /,
     1        132('='), /)
99994 FORMAT (/, 'W: Ring-Metal Search Truncated', /)
99993 FORMAT (/, 'W: Problem - Ring-(Ring/Metal) search aborted', I5,/)
99992 FORMAT (/, 'Analysis of X-H...Cg(Pi-Ring) Interactions',
     1 ' (H..Cg <', F4.1, ' Ang. - Gamma < ', F5.1, ' Deg)', /,
     2   132('='), /,
     3 '- Cg(J)   = Center of gravity of ring J (Plane number above)', /
     4 , '- H-Perp  = Perpendicular distance of H to ring plane J', /,
     5 '- Gamma   = Angle between Cg-H vector and ring J normal', /,
     6 '- X-H..Cg = X-H-Cg angle (degrees)', /,
     7 '- X..Cg   = Distance of X to Cg (Angstrom)', /,
     8 '- X-H, Pi = Angle of the X-H bond with the Pi-plane (i.e.'
     9 ' Perpendicular = 90 degrees, Parallel = 0 degrees)', //,
     * '   X--H(I)    Res(I)', 3X,
     1 'Cg(J)  [', 3X, 'ARU(J)]', 7X, 'H..Cg', 2X,
     2 'Transformed J-Plane P, Q, R, S  H-Perp Gamma', 6X,
     3 'X-H..Cg', 8X, 'X..Cg X-H,Pi', /)
99991 FORMAT (/, 'The Cg(I) refer to the Ring Centre-of-Gravity ',
     1        'numbers given in () in the Ring-Analysis above', //,
     2        'Cg(I)', 11X, 'x', 15X, 'y', 15X, 'z', 20X,
     3        'Xo', 14X, 'Yo', 14x, 'Zo', /)
99990 FORMAT (43X,10('-'), 33X, 46('-'), /, 36X, 'Min or Max',
     1        F7.3, 32X, F7.3, F7.1, 5X, F8.2, 5X, F8.3, F7.2)
99989 FORMAT (35X, 10('-'), 33X, 44('-'), /, 28X, 'Min or Max',
     1        F7.3, 35X, 3F6.1, 2F12.3, F8.3)
      END SUBROUTINE PLA048
      SUBROUTINE PLA049 (IFUN, D)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP19=31,NP25=99,NP29=63,NP41=200,NP47=9, NP56=30)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /DERIV/ NDIR, VIJ(3), VJK(3)
      DIMENSION DSV(8), VIJK(3), VIJKD(3)
C * DETERMINE DERIVED PARAMETER ERROR BY ERROR PROPAGATION
      KM     = 1
      DSV(1) = D
      DSV(2) = XPV(1)
      IF (IFUN .EQ. 2) THEN
        CALL GEN008 (VIJ, VJK, VIJK, 0)
      ELSE IF (IFUN .EQ. 4) THEN
        DO I = 1, 8
          DSV(I) = XPV(I)
        END DO
        KM = 4
      END IF
      DO I = 1, NDIR
        ITP = IDIR(I)
        DO J = 1, 3
          ITEK = 1
          SINC = SQRT(XSD(ITP, J + 3))
          XXO(ITP, J + 3) = XXO(ITP, J + 3) + SINC
C * BOND
          IF (IFUN .EQ. 1) THEN
            CALL PLA050 (IDIR(1), IDIR(2), 0, 0, XPV(1))
C * ANGLE
          ELSE IF (IFUN .EQ. 2) THEN
            CALL PLA050 (IDIR(1), IDIR(2), IDIR(3), 0, XPV(1))
            CALL GEN008 (VIJ, VJK, VIJKD, 0)
            IF (GEN009 (VIJK, VIJKD) .LT. 0.0) XPV(1) = 360.0 - XPV(1)
C * TORSION
          ELSE IF (IFUN .EQ. 3) THEN
            CALL PLA050 (IDIR(1), IDIR(2), IDIR(3), IDIR(4), XPV(1))
            IF ((DSV(1) - XPV(1)) .GT. 180.0)  THEN
              XPV(1) = XPV(1) + 360.0
            ELSE IF ((DSV(1) - XPV(1)) .LT. -180.0) THEN
              XPV(1) = XPV(1) - 360.0
            END IF
C * PLANE
          ELSE IF (IFUN .EQ. 4) THEN
            CALL PLA054 (0)
            ITEK = NINT(GEN009(XPV, DSV))
          END IF
          XXO(ITP, J + 3) = XXO(ITP, J + 3) - SINC
          DO K = 1, KM
            XDIR(I, J, K) = ITEK * XPV(K) - DSV(K)
          END DO
        END DO
      END DO
      D      = DSV(1)
      XPV(1) = DSV(2)
      IF (IFUN .EQ. 4) THEN
        DO I = 1, 8
          XPV(I) = DSV(I)
        END DO
      END IF
      RETURN
      END SUBROUTINE PLA049
      SUBROUTINE PLA050 (I, J, K, L, D)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DERIV/ NDIR, VIJ(3), VJK(3)
      DIMENSION VKL(3), R(3), S(3), T(3)
      IF (I .LE. 0   .OR. J .LE. 0)   GO TO 40
      IF (I .GT. NP1 .OR. J .GT. NP1) GO TO 40
      IF (K .EQ. 0) THEN
        D = 0
        DO KK = 1, 3
          DK = XXO(I, KK + 3) - XXO(J, KK + 3)
          D = D + DK**2
        END DO
        D = SQRT(D)
      ELSE IF (K .GT. 0 .AND. L .EQ. 0) THEN
        IF (K .GT. NP1) GO TO 40
        DAK = 0
        DBK = 0
        DAB = 0
        DO KK = 1, 3
          VIJ(KK)  = XXO(I, KK + 3) - XXO(J, KK + 3)
          VJK(KK)  = XXO(K, KK + 3) - XXO(J, KK + 3)
          DAK      = DAK + VIJ(KK)**2
          DBK      = DBK + VJK(KK)**2
          DAB      = DAB + VIJ(KK)*VJK(KK)
        END DO
        IF (DAK .LE. 0.0 .OR. DBK .LE. 0.0) THEN
          D = 0
        ELSE
          C = DAB / SQRT(DAK * DBK)
          C = MAX (-1.0, MIN (1.0, C))
          D = ACOS(C) * RGBL(6)
        END IF
      ELSE IF (L .GT. 0) THEN
        IF (L .GT. NP1) GO TO 40
        DO N = 1, 3
          VIJ(N) = XXO(J, N + 3) - XXO(I, N + 3)
          VJK(N) = XXO(K, N + 3) - XXO(J, N + 3)
          VKL(N) = XXO(L, N + 3) - XXO(K, N + 3)
        END DO
        CALL GEN008 (VIJ, VJK, R, 1)
        CALL GEN008 (VJK, VKL, S, 1)
        CALL GEN008 (R, S, T, 1)
        D = MAX (-1.0, MIN (1.0, GEN009(R, S)))
        D = ACOS(D) * RGBL(6)
        IF (GEN009 (VJK, T) .LT. 0.0) D = - D
      ELSE
        GO TO 40
      END IF
      RETURN
   40 WRITE (LU6, 99999, IOSTAT = IOST) I, J, K, L
      WRITE (LU7, 99999, IOSTAT = IOST) I, J, K, L
      RETURN
99999 FORMAT (/, 'F: Invalid arg(s) in call to PLA050 ', 4I8, /)
      END SUBROUTINE PLA050
      SUBROUTINE PLA051 (IAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP19=31,NP25=99,NP29=63,NP41=200,NP47=9,NP56=30)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /DERIV/ NDIR, VIJ(3), VJK(3)
      NDIR = NDIR + 1
      IDIR(NDIR) = IAT
      DO I = 1, 3
        DO J = 1, 4
          XDIR(NDIR, I, J) = 0.0
        END DO
      END DO
      RETURN
      END SUBROUTINE PLA051
      SUBROUTINE PLA052 (IFUN, SD)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP19=31,NP25=99,NP29=63,NP41=200,NP47=9,NP56=30)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /DERIV/ NDIR, VIJ(3), VJK(3)
      DIMENSION SD(*)
      IF (IFUN .EQ. 4) THEN
        KM = 4
        DO K = 1, KM
          SD(K) = 0.0
        END DO
      ELSE
        KM    = 1
        SD(1) = 0.0
      END IF
      DO I = 1, NDIR
        DO J = 1, 3
          DO K = 1, KM
            YUNK = XDIR(I, J, K)
            IF (ABS(YUNK) .GT. 1.0E-15) SD(K) = SD(K) + YUNK**2
          END DO
        END DO
      END DO
      DO K = 1, KM
        SD(K) = SQRT(SD(K))
      END DO
      RETURN
      END SUBROUTINE PLA052
      SUBROUTINE PLA053 (I0, J0, K0, L0, D, SD, ISD, NDEC, IER)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /DERIV/ NDIR, VIJ(3), VJK(3)
      DIMENSION SDD(2)
C * CALCULATE DISTANCE (MODE = 1 - K0 = 0 & L0 = 0),
C *           ANGLE    (MODE = 2 - L0 = 0) OR
C *           TORSION  (MODE = 3) WITH S.U. (E.S.D.)
      I     = I0
      J     = J0
      K     = K0
      L     = L0
      IHAT  = 0
      JHAT  = 0
      KHAT  = 0
      LHAT  = 0
      IER   = 0
      NOESD = 1
      SD    = 0.0
      IF (L .LT. 0) THEN
        L    = -L
        NRND = 1
      ELSE
        NRND = 0
      END IF
      CALL PLA050 (I, J, K, L, D)
      CALL GEN048 (-1, IFG(2, I), 10, NESDI)
      CALL GEN048 (-1, IFG(1, I), 7, IHAT)
      IF (IHAT .EQ. 1) NOESD = MIN (NOESD, NESDI)
      IF (NESDI .EQ. 1) THEN
        CALL GEN048 (-1, IFG(2, I), 30, IVAL)
        IF (IVAL .EQ. 1) NESDI = 0
      END IF
      CALL GEN048 (-1, IFG(2, J), 10, NESDJ)
      CALL GEN048 (-1, IFG(1, J), 7, JHAT)
      IF (JHAT .EQ. 1) NOESD = MIN (NOESD, NESDJ)
      IF (NESDJ .EQ. 1) THEN
        CALL GEN048 (-1, IFG(2, J), 30, IVAL)
        IF (IVAL .EQ. 1) NESDJ = 0
      END IF
      IF (K .EQ. 0) THEN
        MODE  = 1
        NDCD  = 4
        NESDK = 0
        NESDL = 0
      ELSE
        CALL GEN048 (-1, IFG(2, K), 10, NESDK)
        CALL GEN048 (-1, IFG(1, K), 7, KHAT)
        IF (KHAT .EQ. 1) NOESD = MIN (NOESD, NESDK)
        IF (NESDK .EQ. 1) THEN
          CALL GEN048 (-1, IFG(2, K), 30, IVAL)
          IF (IVAL .EQ. 1) NESDK = 0
        END IF
        NDCD = 2
        IF (L .EQ. 0) THEN
          MODE  = 2
          NESDL = 0
          IF (D .LT. 1.0)  IER = - 1
          CALL GEN048 (-1, IFG(1, I), 5, IVAL)
          CALL GEN048 (-1, IFG(1, J), 6, JVAL)
          CALL GEN048 (-1, IFG(1, K), 5, KVAL)
          IF (ABS (180.0 - D) .LT. 0.05) THEN
            IF (JVAL .EQ. 1 .AND. IVAL + KVAL .EQ. 1) NOESD = 0
          ELSE IF (ABS(120.0 - D) .LT. 0.05 .OR.
     1             ABS(60.0  - D) .LT. 0.05) THEN
            CALL GEN048 (-1, IFG(1, J), 6, IVAL)
            IF (JVAL .EQ. 1 .AND. IVAL + KVAL .EQ. 1) THEN
              IF (IPR(259) .EQ. 5 .OR. IPR(259) .EQ. 6) NOESD = 0
            END IF
          END IF
        ELSE
          CALL GEN048 (-1, IFG(2, L), 10, NESDL)
          CALL GEN048 (-1, IFG(1, L), 7, LHAT)
          IF (LHAT .EQ. 1) NOESD = MIN (NOESD, NESDL)
          IF (NESDL .EQ. 1) THEN
            CALL GEN048 (-1, IFG(2, L), 30, IVAL)
            IF (IVAL .EQ. 1) NESDL = 0
          END IF
          MODE = 3
          CALL PLA050 (I, J, 0, 0, D1)
          IF (D1 .LT. 0.1) IER = - 1
          CALL PLA050 (K, L, 0, 0, D1)
          IF (D1 .LT. 0.1) IER = - 1
          CALL PLA050 (I, K, 0, 0, D1)
          IF (D1 .LT. 0.1) IER = - 1
          CALL PLA050 (J, L, 0, 0, D1)
          IF (D1 .LT. 0.1) IER = - 1
        END IF
      END IF
      IF (NOESD .EQ. 1) THEN
        IF (NESDI + NESDJ + NESDK + NESDL .NE. 0) THEN
          NDIR = 0
          CALL PLA051 (I)
          CALL PLA051 (J)
          IF (K .GT. 0) CALL PLA051 (K)
          IF (L .GT. 0) CALL PLA051 (L)
          CALL PLA049 (MODE, D)
          CALL PLA052 (MODE, SDD)
        ELSE
          SDD = 0.0
        END IF
        IF (K .EQ. 0) THEN
          SD = SQRT(SDD(1)**2 + (PAR(13) * D)**2)
        ELSE
          SD = SQRT(SDD(1)**2 + PAR(14)**2)
        END IF
      END IF
      IDUM = NDCD
      DO
        CALL GEN041 (D, SD, ISD, IDUM, NDEC, IPR(68))
        IF (IPR(68) .EQ. 0) THEN
          IF (ISD .GT. 99 .AND. IDUM .GT. 0) THEN
            IDUM = IDUM - 1
            CYCLE
          END IF
          IPR68 = 10
          EXIT
        ELSE
          IPR68 = IPR(68)
          EXIT
        END IF
      END DO
      IF (ISD .GT. IPR68 * 10 - 1) THEN
        ISD  = -1
        NDEC = 0
        SD   = -1.0
      END IF
      IF (ISD .EQ. 0 .AND. NRND .EQ. 0) THEN
        NHAT = IHAT + JHAT + KHAT + LHAT
        IF (NHAT .NE. 0) THEN
          IF (MODE .EQ. 1) THEN
            NDEC = 2
            D = NINT (D * 100.0) / 100.0
          ELSE
            NDEC = 0
            D = NINT (D)
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA053
      SUBROUTINE PLA054 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION DUMW(3, 3), EV(3, 3), EW(3)
      NMAX = IPR(39)
      WHT = 1.0
      IF (MODE .EQ. 1) THEN
        IWHT = 1
      ELSE
        IWHT = IPR(41)
      END IF
      CALL GEN074 (V7, 1, 3, 0.0)
      KP = 0
      WM = 0
      DO N = 1, NMAX
        I = IATP(N)
        IF (I .LE. NP1) THEN
          IF (IWHT .EQ. 1) THEN
            CALL GEN048 (-4, IFG(1, I), 15, IVL)
            WHT = SATWT(IVL + 1)
          ELSE IF (IWHT .EQ. 2) THEN
            WHT = 3.0 / (XSD(I, 4) + XSD(I, 5) + XSD(I, 6))
          END IF
          KP = KP + 1
          WM = WM + WHT
          DO J = 1, 3
            V7(J) = V7(J) + WHT * XXO(I, J + 3)
          END DO
        END IF
      END DO
      DO I = 1, 3
        V7(I) = V7(I) / WM
        DO J = 1, 3
          DUMW(I, J) = 0.0
        END DO
      END DO
      DO N = 1, NMAX
        I = IATP(N)
        IF (I .LE. NP1) THEN
          IF (IWHT .EQ. 1) THEN
            CALL GEN048 (-4, IFG(1, I), 15, IVL)
            WHT = SATWT(IVL + 1)
          ELSE IF (IWHT .EQ. 2) THEN
            WHT = 3.0 / (XSD(I, 4) + XSD(I, 5) + XSD(I, 6))
          END IF
          XX  = XXO(I, 4) - V7(1)
          YY  = XXO(I, 5) - V7(2)
          ZZ  = XXO(I, 6) - V7(3)
          XSQ = XX**2
          YSQ = YY**2
          ZSQ = ZZ**2
          DUMW(1, 1) = DUMW(1, 1) + WHT * (YSQ + ZSQ)
          DUMW(1, 2) = DUMW(1, 2) - WHT * XX * YY
          DUMW(1, 3) = DUMW(1, 3) - WHT * XX * ZZ
          DUMW(2, 2) = DUMW(2, 2) + WHT * (ZSQ + XSQ)
          DUMW(2, 3) = DUMW(2, 3) - WHT * YY * ZZ
          DUMW(3, 3) = DUMW(3, 3) + WHT * (XSQ + YSQ)
        END IF
      END DO
      CALL GEN024 (DUMW, EV, EW, DUMV)
      DO I = 1, 3
        XPV(I)  = DUMV(I, 1)
        DUMA(I) = EW(I)
      END DO
      XPV(4) = GEN009(XPV, V7)
      XPV(8) = XPV(4)
      RETURN
      END SUBROUTINE PLA054
      SUBROUTINE PLA055
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /DERIV/ NDIR, VIJ(3), VJK(3)
      NMAX   = IPR(39)
      CALL PLA054 (0)
      CALL GEN002 (-1, OR, XPV(1), XPV(5), XLNG)
      CALL GEN074 (XSPV, 1, 8, 0.0)
      IF (IPR(72) .GT. 0) THEN
        NDIR = 0
        N = 0
        DO I = 1, NMAX
          IATPI = IATP(I)
          IF (IATPI .LE. NP1) THEN
            N = N + 1
            IF (N .GT. NP7) GO TO 60
            CALL PLA051 (IATPI)
          END IF
        END DO
        D = 0.0
        CALL PLA049 (4, D)
        CALL PLA052 (4, XSPV)
        DO J = 1, 3
          XSPV(4 + J) = 0.0
          DO K = 1, 3
            YUNK = XSPV(K) * OR(K, J)
            IF (ABS(YUNK) .GT. 1.0E-15) THEN
              XSPV(4 + J) = XSPV(4 + J) + YUNK**2
            END IF
          END DO
        END DO
        DO K = 5, 7
          XSPV(K) = SQRT(XSPV(K))
        END DO
        XSPV(8) = XSPV(4)
      END IF
   60 RETURN
      END SUBROUTINE PLA055
      SUBROUTINE PLA056 (PV, IAT, D, SD, ISD, NDECD, NDEC)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      DIMENSION PV(*)
      NDEC  = NDECD
      D     = - PV(4)
      DO I = 1, 3
         D = D + PV(I) * XXO(IAT, I + 3)
      END DO
      SD  = 0
      ISD = 0
      IF (IPR(72) .NE. 0) THEN
        DO I = 1, 3
          XXO(IAT, I + 3) = XXO(IAT, I + 3) + PAR(12)
          DAC = - PV(4)
          DO J = 1, 3
            DAC = DAC + PV(J) * XXO(IAT, J + 3)
          END DO
          XXO(IAT, I + 3) = XXO(IAT, I + 3) - PAR(12)
          DIR = (DAC - D) / PAR(12)
          SD = SD + XSD(IAT, I + 3) * DIR**2
        END DO
        SD = SQRT(SD)
        CALL GEN041 (D, SD, ISD, NDECD, NDEC, IPR(68))
      END IF
      RETURN
      END SUBROUTINE PLA056
      SUBROUTINE PLA057 (IAT, JAT, KAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER MARK*2, IMRK1*5, FORMI*98, FORMJ*24, FORMK*6, CXMOL2*9
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      PAGET = 'INTER'
      ANGLE = 0.0
      DIJ   = 0.0
      SDIJ  = 0.0
      NDEC1 = 0
      NDEC2 = 0
      ISDIJ = 0
      NATHX = 0
      NATHY = 0
C * SETUP PRINT FORMATS
      FORMI( 1: 32) = '(   A,1X,''.... '',A,''['',A   ,'']'','
      FORMI(33: 65) = 'F8.3,''('',I3,'')'',A,F5.2,F6.2,1X,A,'
      FORMI(66: 98) = '1X,2(3F7.4,2X),A,F7.2,''('',I3,'')'')'
      FORMJ( 1: 24) = '(112X,A,F7.2,''('',I3,'')'')'
      FORMK( 1: 6 ) = '(F9.2)'
      IF (PAR(42) .LT. 100.0) FORMK(5:5) = '1'
      IF (IPR(90) .EQ. 1) THEN
        IF (IPR(15) .LE. 0) THEN
          IF (IPR(15) .EQ. 0 .AND. IGBL(63) .GT. 2) THEN
            CALL PLA262 (-6)
            IF (LMT(IENS(IAN), 1) .EQ. 'Cg') THEN
              IAN0 = IAN - 1
            ELSE
              IAN0 = IAN
            END IF
            WRITE (LU7, 99997, IOSTAT = IOST) PAR(1), PAR(33),
     1        (LMT(IENS(K), 1), K = 1, IAN0)
            WRITE (LU7, 99996, IOSTAT = IOST)
     1       (RADR(IENS(K), 2), K = 1, IAN0)
            IF (IGBL(63) .GT. 3) THEN
              CALL PLA262 (6)
              WRITE (LU7, 99998, IOSTAT = IOST)
            END IF
          END IF
          CALL PLA065 (0, 0, 0, 0, 0.0, 0.0, 0.0, 0.0, 0.0)
          IF (IPR(2) .NE. 0) CALL GEN127 ('302')
          PAR(67) = 1555.0 + IPR(61) / PAR(42)
          IF (IPR(75) .NE. 1 .AND. IGBL(63) .GT. 2) THEN
            CALL PLA262 (6)
            WRITE (LU7, 99999, IOSTAT = IOST) PAR(67)
          END IF
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (3)
            WRITE (LU7, 99995, IOSTAT = IOST) PAR(67)
          END IF
          IPR(15) = 1
        END IF
        CALL PLA036 (IAT, 1, 1, IPOPI, IDUM1, IDUM2, IPR(71), IGBL(55))
        IDSORD = 0
        IF (IPR(67) .NE. 0) IPOPI = 1000
        IF (IPOPI .LT. 1000) THEN
          IDSORD = IDSORD + 10
          X1 = - IAT
        ELSE
          X1 = IAT
        END IF
        X3  = 0.0
        NCI = - NINT(CON(IAT, NP4))
        IF (NCI .LT. 0) NCI = NP4
        IF (NCI .GT. 0) THEN
          INCX = NINT(CON(IAT, 1))
          IF (INCX .GT. 0 .AND. INCX .LE. NP1) THEN
            X3 = INCX
            CALL GEN048 (-3, IFG(2, INCX), 24, NATHX)
          ELSE
            RETURN
          END IF
        END IF
        CALL PLA036 ( KAT, 1, 4, IPOPK, MN, IDUM2, IPR(71), IGBL(55))
        CALL PLA036 (-KAT, 1, 2, IPOPK, MN, IDUM2, IPR(71), IGBL(55))
        IF (IPOPK .LT. 1000) THEN
          IDSORD = IDSORD + 1
          X2 = - JAT
        ELSE
          X2 = JAT
        END IF
        X4  = 0.0
        NCJ = - NINT(CON(JAT, NP4))
        IF (NCJ .LT. 0) NCJ = NP4
        IF (NCJ .GT. 0) THEN
          JNCX = NINT(CON(JAT, 1))
          IF (JNCX .GT. 0 .AND. JNCX .LE. NP1) THEN
            X4 = JNCX
            CALL GEN048 (-3, IFG(2, JNCX), 24, NATHY)
          ELSE
            RETURN
          END IF
        END IF
        MOL2 = MOL(MN)
        IARU = NINT(PAR(42))
        IF (MOL2 .EQ. 1555 * IARU) MOL2 = MOL2 + IPR(62)
        XMOL2 = MOL2 / PAR(42)
        CALL PLA053 (IAT, KAT, 0, 0, DIJ, SDIJ, ISDIJ, NDEC1, IER)
        ISDIJ = MIN (999, ISDIJ)
        MARK  = '  '
        DMX0  = PAR(23) - PAR(1)
        DELT  = DIJ - DMX0
        DIJ29 = DIJ
        IF (DELT .LT. 0) THEN
          DIJ29 = DIJ29 + 100.0
          MARK  = ' <'
          IF (DELT + PAR(1) .LT. 0.0) THEN
            CALL GEN048 (-1, IFG(1, IAT), 7, IHA)
            CALL GEN048 (-1, IFG(1, KAT), 7, KATHA)
            CALL GEN048 (-1, IFG(1, IAT), 20, IDOH)
            CALL GEN048 (-1, IFG(1, KAT), 20, KDOH)
            CALL GEN048 (-1, IFG(1, IAT), 23, IDOA)
            CALL GEN048 (-1, IFG(1, KAT), 23, KDOA)
            IF (DELT .LT. PAR(199) .AND. IAT .LT. KAT) THEN
              IF ((IDOH .EQ. 1 .OR. KDOA .EQ. 1) .AND.
     1            (IDOA .EQ. 1 .OR. KDOH .EQ. 1)) THEN
                IPR(160) = IPR(160) + 1
              END IF
              PAR(200) = MIN (DELT, PAR(200))
            END IF
            IF (DELT .LT. PAR(251 + 2 * IPR(20))
     1          .AND. IAT .LE. JAT) THEN
              IF (IHA .EQ. 1 .AND. KATHA .EQ. 1 .AND.
     1            (IPOPI .EQ. 1000 .OR. IPOPK .EQ. 1000)) THEN
                ISKIP = 0
                IF (KAT .EQ. JAT) THEN
                  DO I = 1, NCI
                    DO J = 1, NCJ
                      IF (NINT(CON(IAT, I)) .EQ. NINT(CON(JAT, J)))
     1                  ISKIP = 1
                    END DO
                  END DO
                END IF
                IF (ISKIP .EQ. 0) THEN
                  IPR(403 + IPR(20)) = IPR(403 + IPR(20)) + 1
                  PAR(252 + 2 * IPR(20)) =
     1                    MIN (DELT, PAR(252 + 2 * IPR(20)))
                  IPR20 = IPR(20)
                  IKDOH = IDOH + KDOH
                  IF (IKDOH .EQ. 0) THEN
                    IF (NATHX .EQ. 3 .OR. NATHY .EQ. 3)
     1                IPR20 = IPR20 + 2
                  ELSE IF (IKDOH .EQ. 1) THEN
                    IPR20 = IPR(20) + 4
                  ELSE IF (IKDOH .EQ. 2) THEN
                    IPR20 = IPR(20) + 6
                  END IF
C * ALERT _41x
                  CALL PLA231 (410 + IPR20, 2,
     1              - DELT, DIJ, NAMS(1, 1)(2:8), NAMS(1, 2)(2:8))
                END IF
              END IF
            END IF
            DIJ29 = DIJ29 + 100.0
            MARK = '<<'
            IF (IPOPI .GE. 500 .AND. IPOPK .GE. 500) THEN
              IF (IHA .NE. 1 .AND. KATHA .NE. 1 .AND. IPR(20) .EQ. 1)
     1          THEN
                  IF (IPR(88) .LT. NP2) THEN
                    IPR(88)         = IPR(88) + 1
                    XLS(1, IPR(88)) = IAT
                    XLS(2, IPR(88)) = PAR(67)
                    XLS(3, IPR(88)) = JAT
                    XLS(4, IPR(88)) = XMOL2
                    XLS(5, IPR(88)) = IPR(61)
                    XLS(6, IPR(88)) = DIJ
                    XLS(7, IPR(88)) = DELT
                    XLS(8, IPR(88)) = IDSORD
                  ELSE
                    IPR(149) = IPR(149) + 100
                  END IF
              END IF
            END IF
          END IF
        END IF
        IF (IPR(20) .EQ. 1) THEN
          CALL PLA065 (1, MOL2, NATHX, NATHY, X1, X2, X3, X4, DIJ29)
          IF (IPR(2) .NE. 0) CALL GEN127 ('303')
        END IF
        IF (IPR(20) .EQ. 0) THEN
          IMRK1 = 'Intra'
        ELSE
          IMRK1 = '     '
        END IF
        ANGL  = -1.0
        SA    = 0.0
        IANGL = 0
        NC    = - NINT(CON(IAT, NP4))
        N     = 0
        NLINE = 0
   30   N     = N + 1
        IF (N .GT. NC) THEN
          IF (NLINE .NE. 0) GO TO 40
        ELSE
          K = NINT(CON(IAT, N))
          IF (K .GT. IPR(37)) GO TO 30
          CALL PLA053 (K, IAT, KAT, 0, ANGLE, SA, IANGL, NDEC2, IER)
          IF (IER .NE. 0) GO TO 30
          IF (ANGLE .LT. PAR(33)) GO TO 30
          CALL PLA036 (K, 1, 3, IDUM1, IDUM2, IDUM3, IPR(71), IGBL(55))
          ANGL  = ANGLE
          IANGL = MIN (999, IANGL)
        END IF
        IF (NLINE .EQ. 0) THEN
          WRITE (CXMOL2, FORMK, IOSTAT = IOST) XMOL2
          IF (INT(XMOL2) .EQ. 1555) CXMOL2 = '         '
          FORMI(36 : 36) = CHAR(ICHAR('0') + NDEC1)
          IF (ANGL .LT. 0) THEN
            WRITE (PRBUF, FORMI, IOSTAT = IOST) (NAMS(1, L), L = 1, 2),
     1      CXMOL2, DIJ, ISDIJ, MARK, DMX0, DELT, IMRK1,
     2       (XXO(IAT, L), L = 1, 3), (XXO(KAT, L), L = 1, 3)
          ELSE
            FORMI(86 : 86) = CHAR(ICHAR('0') + NDEC2)
            WRITE (PRBUF, FORMI, IOSTAT = IOST) (NAMS(1, L), L = 1, 2),
     1       CXMOL2, DIJ, ISDIJ, MARK, DMX0, DELT, IMRK1,
     2        (XXO(IAT, L), L = 1, 3), (XXO(KAT, L), L = 1, 3),
     3        NAMS(1, 3), ANGL, IANGL
          END IF
          IF (MN .LT. 28) THEN
            IF (IPR(438) * IGBL(97) .EQ. 1) THEN
              IPR(254) = IPR(254) + 1
              WRITE (LU2, 99994, IOSTAT = IOST)
     1          NAMS(1, 1)(2:8), NAMS(1, 4)(2:8), DIJ, SDIJ
            END IF
          END IF
        ELSE
          FORMJ(12 : 12) = CHAR(ICHAR('0') + NDEC2)
          WRITE (PRBUF, FORMJ, IOSTAT = IOST) NAMS(1, 3), ANGL, IANGL
        END IF
        IF (IGBL(63) .GT. 2) CALL PLA263 (LU7, PRBUF, 132, 1, 11)
        NLINE = NLINE + 1
        GO TO 30
      END IF
   40 RETURN
99999 FORMAT (/, 57X, 13('='), /, 56('*'), ' ARU =', F8.2, 1X,
     1        61('*'), /, 57X, 13('='), /)
99998 FORMAT (/, 'Default Contact Radii are those given by A.Bondi',
     1 ', J.Phys.Chem. (1964),68,441. (or Coval. Rad. + 0.8 Ang.',
     2 ' when not given)', //, '* WARNING * : no Far-Reaching',
     3 ' Conclusions should be drawn based on the Default Radii',
     4 ' Assigned to Metals', //, 'Short "INTRA" Distances between',
     5 ' two Atoms that are Separated by less than 4 Bonds are NOT',
     6 ' Listed (Except for Potential D/A Contacts)', /)
99997 FORMAT ('Analysis of Short Intra- and Inter-molecular Contacts',
     1 ' ,  d(I-J) <  R(I) + R(J) + Tolr, With Tolr =', F5.1,
     2 ' Ang. (X - I...J) >', F5.0, ' Deg.', /, 132('-'), /,
     3 'Contact Radii :', 16(3X, A))
99996 FORMAT ('(Angstrom)', 5X, 16F5.2)
99995 FORMAT (132('-')/, 'At(I)[', F7.2, '] At(J)  [  ARU(J) ]',
     1 7X, 'D(I-J)  SumRad  Del  Type    X(I)   Y(I)   Z(I)', 5X,
     2 'X(J)   Y(J)   Z(J)   X', 9X, 'X - I...J', /, 132('-'))
99994 FORMAT ('NONB ', 2(A, 2X), 2F8.4)
      END SUBROUTINE PLA057
      SUBROUTINE PLA058 (INUM, JCA, X, Y, M)
      DIMENSION JCA(*)
      IF (INUM .LE. 0) THEN
        Y = 1.555
      ELSE
        IF (M .GT. 0) THEN
          IF (X .GE. 0) THEN
            N = INT (X)
            Z = X - N
          ELSE
            N = - INT (ABS (X))
            Z = ABS(X) + N
          END IF
          DO I = 1, M
            IF (JCA(I) .EQ. N) THEN
              Y = Z + I
              RETURN
            END IF
          END DO
        END IF
        Y = X
      END IF
      RETURN
      END SUBROUTINE PLA058
      SUBROUTINE PLA059 (JAT, KAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
C * ORTHOGONALISE - SYMMETRY INFO TRANSFERRED THROUGH ITR & IPR(54)
      IF (JAT .GT. NP1 .OR. JAT .LE. 0) THEN
        WRITE (LU6, 99999, IOSTAT = IOST) JAT, KAT
        CALL GEN127 ('Report problem to Author')
      ELSE
        IF (JAT .NE. KAT) THEN
          DO I = 1, 3
            XJX(I + 3) = 0.0
            XJX(I)     = XXO(JAT, I)
          END DO
          CALL SGSM (ICL, IPR(54), XJX, LU7, 3, IERR)
          DO I = 4, 6
            XJS(I)           = XJX(I + 3) + ITR(I - 3)
            XJS(IPR(30 + I)) = XJS(I)
          END DO
          IF (IPR(189) .EQ. 0) THEN
            DO I = 1, 3
              XJX(I) = XSD(JAT, I)
            END DO
            NSMM = -IPR(54)
            CALL SGSM (ICL, NSMM, XJX, LU7, 3, IERR)
          END IF
        END IF
        DO I = 1, 3
          J   = 4 - I
          JP3 = J + 3
          IF (JAT .NE. KAT) THEN
            XXO(KAT, J) = XJS(JP3)
            XSD(KAT, J) = XJX(J + 6)
          END IF
          XXO(KAT, JP3) = 0.0
          XSD(KAT, JP3) = 0.0
          DO L = J, 3
            ORJK = OR(J, L)
            XXO(KAT, JP3) = XXO(KAT, JP3) + XXO(KAT, L) * ORJK
            IF (IPR(189) .EQ. 0) THEN
              IF (IPR(72) .NE. 0) THEN
                XSD(KAT, JP3) = XSD(KAT, JP3) + XSD(KAT, L) * ORJK**2
              END IF
            END IF
          END DO
        END DO
      END IF
      RETURN
99999 FORMAT (/, 'Problem in PLA059; JAT & KAT =', 2I12, /)
      END SUBROUTINE PLA059
      SUBROUTINE PLA060
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP20=20,
     2 NP22=287,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION DHX(3, 37)
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      DIMENSION AANG(NP20), PERPAX(NP20), HX(4, 37), SHRT(4, 4), ROW(3),
     1 IROW0(3), TTRANS(3, 3), TTRM1(3, 3), BTRANS(3, 3), BTRM1(3, 3),
     2 DEL(3), TRANSL(3), RATOM(3), ATOM2(3, 2), ROTAX(3, 4),
     3 ORIG(3), IROW(3), GLITOT(2), GLIDO(3, 2), IMPROP(64)
      CHARACTER  STAR*2, TEXT1*7
      COMMON /TIMER/ ISAVEMOD
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DIMENSION GLY(3)
      COMMON /PL60/ LU, XMISR(3, 3, 15), XMISL(3, 15), XMISG(3, 15),
     1 NMIS(15), RH(3, 3, NP20), ORGM(3), OSHFT(3), OADD(3), FRACT(10),
     2 GLIDE(3), NA(3), DSMAX, NSGTR, NFT, LOOPR, IMETRIC, NFTX,
     3 NCHIR, NCHIRF,  NLCLP, NEWS, NNFIT, NNNFIT, NSV, INVST, NORG,
     4 NORGM, NOINV, NEWLT, NAL112S, NAL110, JERR
      COMMON /PL60C/ FSYM, XSUB, CENT, LATT
      CHARACTER XSUB*1, CENT*1, LATT*1, FSYM*3
      DATA (FRACT(I), I = 1, 10) /
     1  0.0, 0.2, 0.25, 0.33333, 0.4, 0.5, 0.6, 0.66667, 0.75, 0.8/
      CHARACTER PARTNUM*8
      REAL, ALLOCATABLE, DIMENSION(:,:) :: COR, HH, PH
      INTEGER, ALLOCATABLE, DIMENSION(:) :: LCOR, NCOR, MCOR
C * ADDSYM - CHECKING ROUTINE FOR MISSED HIGHER (PSEUDO) SYMMETRY
C * NO ADDSYM CHECK FOR ANGSTROM DATA OR NO LATTICE TYPE GIVEN
      IF (IPR(23) .EQ. 1 .OR. IPR(241) .EQ. 0) RETURN
      ALLOCATE (LCOR(NP1), NCOR(NP1), MCOR(NP1), COR(NP1, 6),
     1  HH(4, NP20), PH(3, NP20))
      PAGET   = 'ADDSYM'
      LU      = 0
C * SET SUB-MENU NUMBER
      IGBL(6) = 26
C * SET DEFAULT TO 'EQUAL' WITH FCF-VALIDATION RUN AND LOW SYMMETRY
      IF (IGBL(3) .EQ. 1 .AND. IPR(48) .LE. 8 .AND.
     1  IPR(37) .LT. 250) THEN
        IPR(207) = 0
      ELSE
        IPR(207) = 1
      END IF
      IPR(595) = 0
      DO I = 1, 3
        PAR(406 + I) = PAR(403 + I - IGBL(97) * 3)
      END DO
      IF (SPGRNM(1)(1:1) .EQ. ' ') THEN
        CALL SGSM (ICL, 0, XJX, 0, 25, IERR)
      END IF
C * RESTART POINT
   10 JERR     = 0
      IPR(206) = 0
      IPR(504) = 0
      IPR(410) = 0
      INVST    = 0
      NCHIR    = 0
      NNF111   = 0
      NAL110   = 0
      NAL112S  = 0
      NOINV    = 0
      LOOPR    = 1
C * ANALYSE ADDSYM INSTRUCTION RECORD
      IF (IPR(220) .GT. 2) THEN
        DO I = 3, IPR(220)
          SELECT CASE (IFL(I)(1:4))
            CASE ('EQUA')
              IPR(207) = 0
            CASE ('PLOT')
              IPR(504) = 1
            CASE ('SHEL')
              IPR(504) = 2
            CASE ('EXAC')
              PAR(249) = 0.00
              IF (IPR(221) .EQ. 0) THEN
                FN(1)   = 0.30
                IF (LOOPR .LT. 3) THEN
                  FN(2) = 0.25
                  FN(3) = 0.25
                  FN(4) = 0.25
                ELSE
                  FN(2) = 0.1
                  FN(3) = 0.1
                  FN(4) = 0.1
                END IF
                IPR(221) = 4
              END IF
            CASE ('NOSF')
              IPR(595) = 1
            CASE ('ELD ')
              IGBL(65) = 1
            CASE ('KEEP')
              IGBL(106) = 1
            CASE ('PART')
              IPR(410) = NINT (FN(1))
            CASE DEFAULT
              CALL PLA037 (I, N, 2)
              IF (N .GT. 0) IPR(206) = N
          END SELECT
        END DO
      END IF
      IF (IPR(221) .GT. 0) THEN
        IF (FN(1) .GT. 0.0) PAR(43)  = FN(1)
        IF (IPR(221) .GT. 1) THEN
          IF (FN(2) .GT. 0.0) PAR(407) = FN(2)
          IF (IPR(221) .GT. 2) THEN
            IF (FN(3) .GT. 0.0) PAR(408) = FN(3)
            IF (IPR(221) .GT. 3) THEN
              IF (FN(4) .GT. 0.0) PAR(409) = FN(4)
              IF (IPR(221) .GT. 4) THEN
                IF (FN(5) .GT. 0.0) PAR(249) = FN(5)
              END IF
            END IF
          END IF
        END IF
      END IF
      IWIN  = 0
      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IPR(504) .EQ. 0 .AND.
     1    IPR(121) .EQ. 0) IWIN = 1
      IPR(209) = 0
      N = 0
      CALL GEN101 (2, N, DHX)
      XSUB  = CHAR(32)
      NLCLP = 0
      NLTX  = 1
C * MISSED TRANSLATION SYMMETRY (RESTART) LOOP
   20 NLCLP = NLCLP + 1
      IF (IWIN .EQ. 1) THEN
        CALL GGIP (HORS, VERT, 0.0, 1)
        VRT = VERT - 0.5
        WRITE (PRBUF, 99986, IOSTAT = IOST) JID(1:20)
        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
      END IF
C * GET REDUCED CELL
      CALL PLA202 (NLTX)
      NRXX  = 0
      NSGTR = 0
      NEWLT = 0
      IF (IPR(100) .GT. 0) WRITE (LU6, 99965, IOSTAT = IOST)
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (-2)
        WRITE (LU7, 99999, IOSTAT = IOST)
      END IF
      IF (IPR(206) .EQ. 0) THEN
        IF (IPR(207) .NE. 0) THEN
          IF (IPR(410) .EQ. 0) THEN
            PARTNUM = ' '
          ELSE
            WRITE (PARTNUM, 99988, IOSTAT = IOST) IPR(410)
          END IF
          WRITE (PRBUF, 99993, IOSTAT = IOST) NINT(PAR(249)), PARTNUM
        ELSE
          WRITE (PRBUF, 99992) NINT(PAR(249))
        END IF
      ELSE
        CALL GEN020 (-1, NQ3, 2, 2)
        WRITE (PRBUF, 99994, IOSTAT = IOST) NQ3, NINT(PAR(249))
      END IF
      WRITE (LU6, 99972, IOSTAT = IOST)
      WRITE (LU6, 99990, IOSTAT = IOST) PRBUF
      IF (IPR(206) .EQ. 0 .AND. IPR(207) .NE. 0)
     1   WRITE (LU6, 99983, IOSTAT = IOST)
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (2)
        WRITE (LU7, 99990, IOSTAT = IOST) PRBUF
      END IF
      IF (IWIN .EQ. 1) THEN
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 3, 2, 1.0, VRT)
      END IF
      NEWS  = 0
      NSYM = IPR(255) * IPR(257)
      DO I = 1, NSYM
        CALL SGSM (ICL, I, XJX, LU6, 6, IERR)
        IMPROP(I) = NINT(GEN130(XJX))
      END DO
      NATOMS = 0
      NSKIP  = 0
      NINC   = 0
      DO I = 1, IPR(37)
        CALL GEN048 (-4, IFG(1, I), 15, NO1)
        NO1 = NO1 + 1
        IF (IPR(206) .EQ. 0 .OR. NO1 .EQ. IPR(206)) THEN
          CALL GEN048 (-2, IFG(1, I), 28, JCAI)
          IF (JCAI .GT. 0) THEN
            JR(I) = JCAI - 2
            NCHIR = NCHIR + 1
          ELSE
            JR(I) = 0
          END IF
          IF (IEN(NO1) .NE. 1) THEN
            INCGO = 1
            CALL GEN048 (-7, IFG(2, I), 1, IDSO)
            IF (IPPR(IDSO + 1, 1) .LT. 1000) INCGO = 0
            IF (IPR(410) .NE. 0) THEN
              INCGO = 1
              CALL GEN048 (-5, IFG(3, I), 14, IPNUM)
              IF (IPNUM - 16 .NE. IPR(410)) INCGO = 0
            END IF
            IF (INCGO .EQ. 1) THEN
              DO L = 1, 3
                XJX(L)     = XXO(I, L)
                XJX(L + 3) = 0.0
              END DO
              NINC = NINC + 1
              CALL GEN048 (-1, IFG(1, I), 19, IMET)
              IF (NLCLP .EQ. 1) THEN
                NATOMB = NATOMS
              ELSE
                NATOMB = 0
              END IF
              DO 40 J = 1, NSYM
                CALL SGSM (ICL, J, XJX, LU6, 3, IERR)
                CALL GEN002 (1, TRNSM1, XJX(7), V2, XLNG)
                DO K = 1, 3
                  COR(NATOMS + 1, K) = MOD (V2(K) + 10.0, 1.0)
                END DO
                IF (NATOMS .GT. NATOMB) THEN
                  DO 30 L = NATOMB + 1, NATOMS
                    DO M = 1, 3
                      XDUM = MOD (COR(NATOMS + 1, M) - COR(L, M), 1.0)
                      IF (ABS(ABS(XDUM) - 0.5) .LT. 0.49) GO TO 30
                    END DO
                    GO TO 40
   30             CONTINUE
                END IF
                IF (NATOMS .LT. NP1) THEN
                  NATOMS       = NATOMS + 1
                  LCOR(NATOMS) = LABA(I)
                  JCA(NATOMS)  = IMET
                  IFNT(NATOMS) = JR(I) * IMPROP(J)
                  MCOR(NATOMS) = (IEN(NO1) - 1) * IPR(207) + 1
                ELSE
                  WRITE (LU6, 99969, IOSTAT = IOST) NP1
                  JERR = 1
                  GO TO 170
                END IF
   40         CONTINUE
            ELSE
              NSKIP = NSKIP + 1
              IF (NSKIP .EQ. 1) THEN
                IF (IGBL(63) .GT. 0) THEN
                  CALL PLA262 (2)
                  WRITE (LU7, 99962, IOSTAT = IOST)
                END IF
              END IF
              CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, 0, IGBL(55),
     1          0, 0)
              IF (IGBL(63) .GT. 0) THEN
                IF (MOD (NSKIP, 8) .NE. 0) THEN
                  WRITE (LU7, 99971, IOSTAT = IOST) NQ1
                ELSE
                  WRITE (LU7, 99966, IOSTAT = IOST) NQ1
                  CALL PLA262 (1)
                END IF
              END IF
            END IF
          END IF
        END IF
      END DO
      NCHIRF = NCHIR
      IF (NATOMS .EQ. 0) THEN
        WRITE (PRBUF, 99968, IOSTAT = IOST)
        WRITE (LU6, 99963, IOSTAT = IOST) PRBUF(1:80)
        IF (IWIN .EQ. 1) THEN
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
        END IF
      ELSE IF (IPR(206) .EQ. 0 .AND. IPR(410) .EQ. 0 .AND.
     1         NSKIP / 2  .GT. (NSKIP / 2 + NINC) / 4) THEN
C * ALERT _811
        CALL PLA231 (811, 0, -999.0, 1.0, ' ', ' ')
        WRITE (PRBUF, 99997, IOSTAT = IOST)
        WRITE (LU6, 99963, IOSTAT = IOST) PRBUF(1:80)
        IF (IGBL(63) .GT. 0)
     1    WRITE (LU7, 99963, IOSTAT = IOST) PRBUF(1:80)
        IF (IWIN .EQ. 1) THEN
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
        END IF
      ELSE
        IF (NSKIP .GT. 0) THEN
          WRITE (LU6, 99975, IOSTAT = IOST) NSKIP
          IF (IGBL(63) .GT. 0) THEN
            CALL PLA262 (1)
            WRITE (LU7, 99975, IOSTAT = IOST) NSKIP
          END IF
        END IF
        IF (PAR(386) .NE. 0.0) THEN
          YUNK = PAR(98) / PAR(386)
        ELSE
          YUNK = 0.0
        END IF
        WRITE (PRBUF, 99985, IOSTAT = IOST) PAR(387), YUNK
        WRITE (LU6, 99998, IOSTAT = IOST) NINC, NATOMS
        WRITE (LU6, 99990, IOSTAT = IOST) PRBUF(1:80)
        IF (IGBL(63) .GT. 0) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99998, IOSTAT = IOST) NINC, NATOMS
          WRITE (LU7, 99990, IOSTAT = IOST) PRBUF(1:80)
        END IF
        IF (IWIN .EQ. 1) THEN
          IF (PAR(387) .LT. 1.0) THEN
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
          END IF
        END IF
        NSV      = 0
        N2       = 0
        IMETRIC  = 0
        IPR(118) = 0
        IPR(459) = 0
        NROT     = 0
        NNFIT    = 100
        NNNFIT   = 100
        NFT      = 100
        ANGMAX  = SIN(PAR(43) / RGBL(6))**2
        DO I = 1, 37
          CALL GEN002 (2, ADIR, DHX(1, I), HX(1, I), HX(4, I))
        END DO
        DO I = 1, 37
          CALL GEN002 (-2, AINV, DHX(1, I), V1, XLNG)
          DO J = 1, 37
            MULT = NINT (ABS (GEN009 (DHX(1, I), DHX(1, J))))
            IF (MULT .EQ. 1 .OR. MULT .EQ. 2) THEN
              CALL GEN008 (V1, HX(1, J), V5, -1)
              IF (V5(1) .LT. ANGMAX) THEN
                IF (N2 .GE. NP20) THEN
                  IPR(2) = 23
                  GO TO 170
                END IF
                N2 = N2 + 1
                DO K = 1, 3
                  PH(K, N2)    = DHX(K, I)
                  HH(K, N2)    = HX (K, J)
                  RH(K, 3, N2) = DHX(K, J)
                END DO
                AANG(N2)   = ASIN(SQRT(V5(1))) * RGBL(6)
                PERPAX(N2) = 2.0
                HH(4, N2)  = HX(4, J)
              END IF
            END IF
          END DO
        END DO
        MSYM = N2
        IF (N2 .GT. 0) THEN
          IF (N2 .GT. 2) THEN
            DO I = 1, N2 - 2
              DO 50 J = I + 1, N2 - 1
                NMX   = 2
                CALL GEN008 (HH(1, I), HH(1, J), V6 , 0)
                DO K = J + 1, N2
                  IF (ABS(GEN009 (V6, HH(1, K))) .LE. 0.01)
     1                NMX = NMX + 1
                END DO
                DO K = 1, N2
                  IF (ABS(GEN009(PH(1, K), RH(1, 3, I))) .LE. 0.01)
     1              THEN
                    IF (ABS(GEN009(PH(1, K), RH(1, 3, J))) .LE. 0.01)
     1                THEN
                      IF (NMX .GT. PERPAX(K)) PERPAX(K) = NMX
                      GO TO 50
                    END IF
                  END IF
                END DO
                IF (NMX .GT. 2) THEN
                  CALL GEN002 ( 2, AINV, V6, V4, XLEN)
                  CALL GEN002 (-2, ADIR, V6, V3, XLNG)
                  SMR = 2.0
                  SMD = 2.0
                  DO K = 1, 3
                    IF (ABS(V3(K)) .GT. 0.1 .AND. ABS(V3(K)) .LT. SMR)
     1                      SMR = ABS(V3(K))
                    IF (ABS(V4(K)) .GT. 0.1 .AND. ABS(V4(K)) .LT. SMD)
     1                      SMD = ABS(V4(K))
                  END DO
                  DO K = 1, 3
                    V3(K) = NINT(V3(K) / SMR)
                    V4(K) = NINT(V4(K) / SMD)
                  END DO
                  CALL GEN002 (-2, AINV, V3, V1, XLNG)
                  CALL GEN002 ( 2, ADIR, V4, V2, XLEN)
                  CALL GEN008 (V1, V2, V5, -1)
                  IF (V5(1) .LT. ANGMAX) THEN
                    MSYM = MSYM + 1
                    DO K = 1, 3
                      PH(K,    MSYM) = V3(K)
                      RH(K, 3, MSYM) = V4(K)
                      HH(K,    MSYM) = V2(K)
                    END DO
                    AANG(MSYM)   = ASIN(SQRT(V5(1))) * RGBL(6)
                    PERPAX(MSYM) = NMX
                    HH(4, MSYM)  = XLEN
                  END IF
                END IF
   50         CONTINUE
            END DO
            DO I = 1, MSYM - 1
              AIMAX = PERPAX(I) - AANG(I)
              KMAX  = I
              DO J = I + 1, MSYM
                AJMAX = PERPAX(J) - AANG(J)
                IF (AJMAX .GT. AIMAX) THEN
                  AIMAX = AJMAX
                  KMAX  = J
                END IF
              END DO
              CALL GEN018 (PERPAX(I), PERPAX(KMAX))
              DO K = 1, 3
                CALL GEN018 (RH(K, 3, I), RH(K, 3, KMAX))
                CALL GEN018 (PH(K, I),    PH(K, KMAX))
                CALL GEN018 (HH(K, I),    HH(K, KMAX))
              END DO
              CALL GEN018 (AANG(I), AANG(KMAX))
              CALL GEN018 (HH(4, I), HH(4, KMAX))
            END DO
          END IF
          DO IT = 1, MSYM
            J = 0
            DO I = 1, 37
              IF (ABS(GEN009 (DHX(1, I), PH(1, IT))) .LT. 0.01) THEN
                J = J + 1
                DO K = 1, 3
                  SHRT(K, J) = DHX(K, I)
                END DO
                IF (J .EQ. 2) GO TO 60
              END IF
            END DO
   60       ISWTCH = 1
            DO WHILE (ISWTCH .EQ. 1)
              ISWTCH = 0
              DO I = 1, 3
                SHRT (I, 3) = SHRT (I, 1) + SHRT (I, 2)
                SHRT (I, 4) = SHRT (I, 1) - SHRT (I, 2)
              END DO
              DO I = 1, 4
                CALL GEN002 (2, ADIR, SHRT(1, I), V5, SHRT(4, I))
              END DO
              DO I = 1, 2
                DO J = 2, 4
                  IF (SHRT(4, J) .LT. SHRT(4, I)) THEN
                    DO K = 1, 4
                      CALL GEN018 (SHRT(K, I), SHRT(K, J))
                    END DO
                    ISWTCH = 1
                  END IF
                END DO
              END DO
            END DO
            CALL GEN002 (2, ADIR, SHRT(1, 1), SHRT(1, 3), XLEN)
            CALL GEN002 (2, ADIR, SHRT(1, 2), SHRT(1, 4), XLEN)
            IF (GEN009 (SHRT(1, 3), SHRT(1, 4)) .GT. 0.000001) THEN
              DO NX = 1, 3
                SHRT(NX, 2) = - SHRT(NX, 2)
              END DO
            END IF
            SGN0 = SIGN (1.0, GEN009 (RH(1, 3, IT), PH(1, IT)))
            CALL GEN008 (SHRT(1, 1), SHRT(1, 2), V3, 0)
            SGN = SIGN (1.0, GEN009 (V3, RH(1, 3, IT)))
            DO NX = 1, 3
              RH(NX, 3, IT) = SGN * RH(NX, 3, IT)
              PH(NX, IT)    = SGN * PH(NX, IT) * SGN0
              DO NY = 1, 2
                RH(NX, NY, IT) = SGN * SHRT(NX, NY)
              END DO
            END DO
          END DO
        END IF
        MSYM        = MSYM + 1
        PH(1, MSYM) = 0.0
        PH(2, MSYM) = 0.0
        PH(3, MSYM) = 1.0
        CALL GEN021 (RH(1, 1, MSYM), 1)
        DSCENT   = 999.0
        DLIM     = PAR(407)
        PAR(291) = 0.0
        WRITE (LINE, 99989, IOSTAT = IOST)
        WRITE (IDM,  99980, IOSTAT = IOST)
     1    PAR(43), PAR(407), PAR(408), PAR(409)
        DO I = 1, 2 + IWIN
          IF (I .EQ. 1) THEN
            IF (IGBL(63) .LE. 2) CYCLE
            LUX = LU7
            CALL PLA262 (6)
          ELSE IF (I .EQ. 2) THEN
            LUX = LU6
          ELSE
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, IDM, 80, 0.35, 3, 2, 1.0, VRT)
            WRITE (PRBUF, 99978, IOSTAT = IOST)
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 1.0,
     1                   VRT)
            WRITE (PRBUF, 99977, IOSTAT = IOST)
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 1.0,
     1                   VRT)
            CALL GGIP (0.0, 1.0, 0.0, 0)
            CALL GGIP (0.0,  VRT - 0.2, 0.0, 3)
            CALL GGIP (HORS, VRT - 0.2, 0.0, 2)
            VRT = VRT - 0.3
            CALL GGIP (0.0, 0.0, 0.0, 6)
            CYCLE
          ENDIF
          WRITE (LUX, 99990, IOSTAT = IOST) LINE(1:78)
          WRITE (LUX, 99990, IOSTAT = IOST) IDM
          WRITE (LUX, 99972, IOSTAT = IOST)
          WRITE (LUX, 99978, IOSTAT = IOST)
          WRITE (LUX, 99977, IOSTAT = IOST)
          WRITE (LUX, 99976, IOSTAT = IOST)
        END DO
        DO 160  ISYM = 1, MSYM
          DO I = 1, 3
            DO J = 1, 3
              BTRANS(I, J) = RH(I, J, ISYM)
            END DO
            IROW0(I) = NINT (RH(I, 3, ISYM))
          END DO
          CALL GEN003 (BTRANS, BTRM1, DET, 0)
          IRCTR = 0
          DO I = 1, 3
            IF (ABS (ABS (BTRM1(3, I)) - 0.5) .LT. 0.48) IRCTR = I
          END DO
          DO I = 1, NATOMS
            DO J = 1, 3
              V1(J) = COR(I, J)
            END DO
            CALL GEN002 (1, BTRM1, V1, V2, XLNG)
            DO J = 1, 3
              COR(I, J + 3) = V2(J)
            END DO
          END DO
          IF (ISYM .LT. MSYM) THEN
            IPERP = NINT (PERPAX(ISYM))
            ANG   = AANG(ISYM)
            MULT  = NINT (GEN009 (RH(1, 3, ISYM), PH(1, ISYM)))
            DLE   = HH(4, ISYM)
            IF (IPERP .GE. 6) THEN
              ITYPB = 1
              ITYPE = 4
            ELSE IF (IPERP .EQ. 3) THEN
              ITYPB = 2
              ITYPE = 2
            ELSE IF (IPERP .GE. 4) THEN
              ITYPB = 3
              ITYPE = 4
            ELSE
              ITYPB = 4
              ITYPE = 4
            END IF
          ELSE
            ITYPB = 5
            ITYPE = 5
            INVST = 0
          END IF
          DO ITYP = ITYPB, ITYPE
            IF (ITYP .EQ. 1) THEN
              NROT = 6
            ELSE IF (ITYP .EQ. 2) THEN
              NROT = 3
            ELSE IF (ITYP .EQ. 3) THEN
              NROT = 4
            ELSE IF (ITYP .EQ. 4) THEN
              NROT = 2
            END IF
            DO NTYP = 1, 2
              ITRY  = ITYP * (-1) ** NTYP
              IF (ITRY .EQ. 5 .AND. NOINV .EQ. 1) CYCLE
              JROT  = 6 - NTYP
              DSMAX = -1.0
              NCHR  = 0
              IF (ITRY .EQ. 5) THEN
                DLIM = PAR(408)
              ELSE IF (ITRY .EQ. -5) THEN
                DLIM = PAR(409)
              END IF
              DO I = 1, 3
                ROTAX(I, 4) = 0.0
                TRANSL(I)   = ROT(I, JROT, ITYP)
                DO J = 1, 3
                  TEMP = ROT(I, J, ITYP)
                  IF (ITRY .LT. 0) TEMP = - TEMP
                  ROTAX(I, J) = TEMP
                  IF (I .EQ. J) TEMP = TEMP - 1.0
                  ROTM1(I, J) = TEMP
                END DO
              END DO
              DO 70 I = 1, 3
                V6(I) = 1.0
                DO J = 1, 3
                  IF (ROTM1(I, J) .NE. 0.0) GO TO 70
                  IF (ROTM1(J, I) .NE. 0.0) GO TO 70
                END DO
                V6(I)       = 0.0
                ROTM1(I, I) = 1.0
   70         CONTINUE
              CALL GEN003 (ROTM1, ROTM2, DET, 0)
              DO I = 1, 3
                ROTM2(I, I) = ROTM2(I, I) * V6(I)
              END DO
              IAT1  = 1
              MCAT1 = MCOR(IAT1)
              IFNT1 = IFNT(IAT1)
              DO I = 1, 3
                RATOM(I) = 0.0
                DO J = 1, 3
                  RATOM(I) = RATOM(I) + ROTAX(I, J) * COR(IAT1, J + 3)
                END DO
              END DO
              DO 150 IAT2 = 1, NATOMS
                IFNT2 = IFNT(IAT2)
                IF (NTYP .EQ. 1 .OR. ITRY .EQ. 5) THEN
                  IF ((IFNT1 + IFNT2) .NE. 0) GO TO 150
                ELSE IF (NTYP .EQ. 2 .OR. ITRY .EQ. -5) THEN
                  IF ((IFNT1 - IFNT2) .NE. 0) GO TO 150
                END IF
                NCHR  = IABS(IFNT1)
                DSMAX = -1.0
                DSAVR = 0.0
                NSAVR = 1
                IF (MCOR(IAT2) .EQ. MCAT1) THEN
                  DO I = 1, 3
                    ATOM2(I, 1) = COR(IAT2, I + 3)
                  END DO
                  IF (IRCTR .NE. 0) THEN
                    JM = 2
                    DO I = 1, 3
                      ATOM2(I, 2) = ATOM2(I, 1) + BTRM1(I, IRCTR)
                    ENDDO
                  ELSE
                    JM = 1
                  END IF
                  DO J = 1, JM
                    GLITOT(J) = 0.0
                    DO I = 1, 3
                      GLIDO(I, J) = 0.0
                      IF (TRANSL(I) .GE. 0.1 .OR. ITRY .EQ. -5) THEN
                        GLIDO(I, J) = ATOM2(I, J) - COR(IAT1, I + 3)
                        GLITOT(J)   = GLITOT(J)   + GLIDO(I, J)**2
                        GLITOT(J)   = GLITOT(J)   - INT(GLITOT(J) + 0.1)
                        IF (ITRY .NE. - 5) THEN
                          XDUM = MOD (12.0 * GLIDO(I, J) /
     1                                       TRANSL(I) + 10.0, 1.0)
                          IF (ABS (XDUM - 0.5) .LE. 0.45) GO TO 150
                        END IF
                      END IF
                    END DO
                  END DO
                  JG = 1
                  IF (IRCTR .NE. 0) THEN
                    IF (ABS (GLITOT(2)) .LT. ABS(GLITOT(1))) JG = 2
                  END IF
                  DO I = 1, 3
                    ROTAX(I, 4) = GLIDO(I, JG) * 12.0
                    V1(I) = RATOM(I) - ATOM2(I, JG) + GLIDO(I, JG)
                  END DO
                  CALL GEN002 (1, ROTM2, V1, ORIG, XLNG)
                  P249  = PAR(249)
                  NLOOP = 0
   80             NFIT  = 0
                  NNFIT = 100
                  DO I = 1, NATOMS
                    NCOR(I) = 0
                  END DO
                  NCOR(IAT1) = 2
                  NCOR(IAT2) = 2
                  DO 100 IAT3 = 2, NATOMS
                    IFNT3 = IFNT(IAT3)
                    DO K = 1, 3
                      V1(K) = COR(IAT3, K + 3) - ORIG(K)
                    END DO
                    DO K = 1, 3
                      V2(K) = ROTAX(K, 4) / 12.0 + ORIG(K)
                      DO J = 1, 3
                        V2(K) = V2(K) + ROTAX(K, J) * V1(J)
                      END DO
                    END DO
                    CALL GEN002 (1, BTRANS, V2, V3, XLNG)
                    IIAT3 = MCOR(IAT3)
                    DO 90 IAT4 = 1, NATOMS
                      IFNT4 = IFNT(IAT4)
                      IF (NTYP .EQ. 1 .OR. ITRY .EQ. 5) THEN
                        IF ((IFNT3 + IFNT4) .NE. 0) GO TO 90
                      ELSE IF (NTYP .EQ. 2 .OR. ITRY .EQ. -5) THEN
                        IF ((IFNT3 - IFNT4) .NE. 0) GO TO 90
                      END IF
                      IF (MCOR(IAT4) .EQ. IIAT3)
     1                  THEN
                        IF (ITRY .NE. -5 .OR. IAT3 .NE. IAT4) THEN
                          DO K = 1, 3
                            DELTA = MOD (V3(K) - COR(IAT4, K), 1.0)
                            IF (ABS (DELTA) .GT. 0.5)
     1                        DELTA = DELTA - SIGN (1.0, DELTA)
                            IF (ABS (DELTA) .GT. 0.2) GO TO 90
                            DEL(K) = DELTA
                          END DO
                          CALL GEN002 (2, ADIR, DEL, V4, DIS)
                          DIS = DIS / 2
                          IF (DIS .LE. DLIM) THEN
                            IF (DIS .GT. DSMAX) THEN
                              DSMAX = DIS
                              DSAVR = DSAVR + DIS
                              NSAVR = NSAVR + 1
                              CALL PLA047 (LCOR(IAT3), NQ3,
     1                          IDUM, JDUM, 0, IGBL(55), 0,
     2                          1 - IGBL(55))
                              CALL PLA047 (LCOR(IAT4), NQ4,
     1                          IDUM, JDUM, 0, IGBL(55), 0,
     2                          1 - IGBL(55))
                              NQ3(6 : 6) = '-'
                            END IF
                            NCOR(IAT3) = NCOR(IAT3) + 1
                            NCHR = NCHR + IABS(IFNT3)
                            GO TO 100
                          END IF
                        END IF
                      END IF
   90               CONTINUE
                    NFIT = NFIT + 1
                    IF (NFIT * 100.0 / NATOMS .GT. P249) GO TO 150
  100             CONTINUE
                  IF (ITRY .EQ. 5) THEN
                    IF (IPR(257) .EQ. 1) THEN
                      IF (NFIT .NE. 0) IPR(118) = 1
                    END IF
                  END IF
                  NQ1  = ' '
                  NFTX = 0
                  CALL GEN038 (LINE, 1, 80)
                  DO N = 1, NATOMS
                    IF (NCOR(N) .LT. 1) THEN
                      CALL PLA047 (LCOR(N), NQ2, IDUM, JDUM, 0,
     1                             IGBL(55), 0, 0)
                      IF (NQ2 .NE. NQ1) THEN
                        NQ1 = NQ2
                        IF (JCA(N) .EQ. 1 .AND. ITRY .EQ. 5) THEN
                          IF (NFTX .NE. 0) THEN
                            WRITE (LU6, 99972, IOSTAT = IOST)
                            IF (IGBL(63) .GT. 0) THEN
                              CALL PLA262 (1)
                              WRITE (LU7, 99972, IOSTAT = IOST)
                            END IF
                          END IF
                          GO TO 150
                        END IF
                        NFTX = NFTX + 1
                        IF (NFTX .LT. 12) THEN
                          LINE((NFTX - 1) * 5 + 1:) = NQ1
                        END IF
                      END IF
                    END IF
                  END DO
                  FIT = NFTX * 100.0 / NINC
                  IF (FIT .GT. P249) THEN
                    IPR(118) = 0
                    GO TO 150
                  END IF
                  IF (NFTX .EQ. 0) THEN
                    NNFIT = 100
                  ELSE
                    NNFIT = INT(100.0 - FIT)
                  END IF
                  CALL GEN004 (TRNS,   BTRANS, TTRANS)
                  CALL GEN003 (TTRANS, TTRM1,  DET, 0)
                  CALL GEN132 (TTRANS, ROTAX, TTRM1, ROTM1)
                  ISTR = 1
                  STAR = ' *'
                  IF (ITRY .NE. -5) THEN
                    DO 110 I = 1, NSYM
                      CALL SGSM (ICL, I, XJX, LU6, 6, IERR)
                      ITEL = 0
                      DO IR = 1, 3
                        DO IL = 1, 3
                          ITEL = ITEL + 1
                          IF (ABS (ROTM1(IR, IL) - XJX(ITEL))
     1                        .GT. 0.01) GO TO 110
                        END DO
                      END DO
                      ISTR = 0
                      STAR = '  '
                      IF (NFIT .GT. 0 .AND. NLCLP .EQ. 1) THEN
                        P249  = 0.0
                        NLOOP = NLOOP + 1
                        IF (NLOOP .LT. 10) GO TO 80
                      END IF
                      GO TO 120
  110               CONTINUE
                    IPR(209) = 1
                  END IF
  120             FSYM  = ' '
                  NRT   = NROT
                  IF (ITRY .GT. 0 .AND. ITYP .NE. 4) THEN
                    FSYM(1 : 1) = '-'
                    IF (NRT .EQ. 4) NRT = 5
                  END IF
                  FSYM(2 : 2) = CHAR(ICHAR('0') + NROT)
                  IF (ITRY .EQ. -4) THEN
                    FSYM(2 : 2) = 'm'
                    NRT         = 0
                  END IF
                  IGLIDE = 0
                  DO I = 1, 3
                    ORI = MOD (ORIG(I), 1.0)
                    IF (ORI .LT. -0.45) ORI = ORI + 1.0
                    IF (ORI .GT.   0.6) ORI = ORI - 1.0
                    ORIG(I) = ORI
                    GLI     = MOD (GLIDO(I, JG), 1.0)
                    IF (GLI .LT. -0.45) GLI = GLI + 1.0
                    IF (GLI .GT.  0.6)  GLI = GLI - 1.0
                    GLIDE(I) = GLI
                    IF (ABS(GLI) .GE. 0.05) IGLIDE = 1
                  END DO
                  CALL GEN002 (1, BTRANS, GLIDE,        V1, XLNG)
                  CALL GEN002 (1, TRNS ,  V1,        GLIDE, XLNG)
                  CALL GEN002 (1, TRNS ,  V1,          GLY, XLNG)
                  CALL GEN002 (1, BTRANS, ORIG ,        V1, XLNG)
                  CALL GEN002 (1, TRNS ,  V1 ,        ORIG, XLNG)
                  CALL GEN002 (1, TRNS ,  RH(1, 3, ISYM), ROW, XLNG)
                  DO I = 1, 3
                    IF (ISYM .GE. MSYM) THEN
                      ORIG(I) = MOD (1.0 + ORIG(I), 0.5)
                    ELSE
                      IF (ORIG(I) .LT. - 0.1) ORIG(I) = ORIG(I) + 1.0
                    END IF
                  END DO
                  IF (DSMAX .LT. 0.0001) THEN
                    NQ3 = ' '
                    NQ4 = ' '
                  END IF
                  IF (ITYP .NE. 5) THEN
                    ISIG  = 0
                    DO I = 1, 3
                      IF (ISIG .EQ. 0 .AND. ROW(I) .LT. -0.01)
     1                    ISIG = -1
                      IF (ISIG .EQ. 0 .AND. ROW(I) .GT.  0.01)
     1                    ISIG = 1
                    END DO
                    IMULT = 0
  130               IMULT = IMULT + ISIG
                    DO I = 1, 3
                      IROW(I) = NINT(IMULT * ROW(I))
                      IF (ABS(ABS(ROW(I) * IMULT) - IABS(IROW(I)))
     1                    .GT. 0.01) GO TO 130
                    END DO
                    IF (ITRY .LT. 0) THEN
                      DO I = 1, 3
                        GLIDE(I) = ISIG * GLIDE(I)
                        GLY(I)   = GLIDE(I)
                      END DO
                    END IF
                    IF (IGLIDE .EQ. 1) THEN
                      TEXT1 = 'Screw  '
                      DO I = 1, 3
                        ITR(I)   = MOD (NINT(12.0 * GLIDE(I)) + 12, 12)
                        GLIDE(I) = ITR(I) / 12.0
                        ISHFT    = ITR(I) * IROW(I)
                        ITRI0    = ITR(I)
                        IF (ISHFT .NE. 0) THEN
                          IF (NROT .EQ. 3) THEN
                            IF (ITRI0 .EQ. 2) THEN
                              ITRI0 = 4
                            ELSE IF (ITRI0 .EQ. 10) THEN
                              ITRI0 = 8
                            END IF
                          END IF
                          FSYM(3:3) =
     1                      CHAR(ICHAR('0') + ITRI0 * NROT / 12)
                        END IF
                      END DO
                      IF (ITRY .EQ. - 4) THEN
                        NRT   = 0
                        FSYM(3:3) = ' '
                        TEXT1 = 'Glide  '
                        IF (ITR(1) .EQ. 0 .AND. ITR(2) .EQ. 0) THEN
                          FSYM(2 : 2) = 'c'
                        ELSE IF (ITR(1) .EQ. 0 .AND. ITR(3) .EQ. 0) THEN
                          FSYM(2 : 2) = 'b'
                        ELSE IF (ITR(2) .EQ. 0 .AND. ITR(3) .EQ. 0) THEN
                          FSYM(2 : 2) = 'a'
                        ELSE IF (MOD (ITR(1), 6) .EQ. 3 .OR.
     1                           MOD (ITR(2), 6) .EQ. 3) THEN
                          FSYM(2 : 2) = 'd'
                        ELSE
                          FSYM(2 : 2) = 'n'
                        END IF
                      END IF
                      IPRMX = 80
                    ELSE
                      IPRMX = 55
                    END IF
                    NEWS = NEWS + 1
                    NMIS(NEWS) = (6 - NRT) * 100 + NEWS
                    DO IR = 1, 3
                      DO IK = 1, 3
                        XMISR(IR, IK, NEWS) = ROTM1(IR, IK)
                      END DO
                      XMISL(IR, NEWS) = ORIG(IR)
                      XMISG(IR, NEWS) = GLY(IR) * ISIG
                    END DO
                    IF (NFTX .GT. 0) THEN
                      WRITE (LU6, 99964, IOSTAT = IOST)
                      WRITE (LU6, 99979, IOSTAT = IOST) LINE(1:75)
                      WRITE (LU6, 99972, IOSTAT = IOST)
                      WRITE (LU6, 99972, IOSTAT = IOST)
                      IF (IGBL(63) .GT. 0) THEN
                        CALL PLA262 (4)
                        WRITE (LU7, 99964, IOSTAT = IOST)
                        WRITE (LU7, 99979, IOSTAT = IOST) LINE(1:75)
                        WRITE (LU7, 99972, IOSTAT = IOST)
                      END IF
                    END IF
                    IF (STAR .EQ. ' *') THEN
C * ALERT _112 - Additional (Pseudo) Symmetry Element Found
                      CALL PLA231 (112, 0, -999.0, FLOAT(NNFIT),
     1                  '    '//FSYM, ' ')
                    END IF
                    DSAVR = DSAVR / NSAVR
                    WRITE (PRBUF, 99995, IOSTAT = IOST)
     1                FSYM(1:2), STAR, IROW, IROW0, DLE, IPERP, MULT,
     2                ANG, NNFIT, DSAVR, ORIG
                    NNNFIT = MIN (NNNFIT, NNFIT)
                    CALL GEN065 (0, PRBUF, 81, 23)
                    WRITE (LU6, 99979, IOSTAT = IOST) PRBUF(1:80)
                    IF (NNFIT .LT. 100 .AND. ISTR .EQ. 1) ISTR = 5
                    IF (IWIN .EQ. 1 .AND. VRT .GT. 6.0) THEN
                      VRT = VRT - 0.5
                      CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1 + ISTR,
     1                             2, 1.0, VRT)
                    END IF
                    IF (IGBL(63) .GT. 2) THEN
                      CALL PLA262 (1)
                      WRITE (LU7, 99979, IOSTAT = IOST) PRBUF(1:80)
                    END IF
                    WRITE (PRBUF, 99991, IOSTAT = IOST) FSYM(3:3),
     1                NQ3(1:6), NQ4(1:6), DSMAX, TEXT1, GLIDE
                    CALL GEN065 (0, PRBUF, IPRMX + 1, 7)
                    WRITE (LU6, 99979, IOSTAT = IOST) PRBUF(1:IPRMX)
                    IF (IWIN .EQ. 1 .AND. VRT .GT. 6.0) THEN
                      DO I = 1, IPRMX
                        IF (PRBUF(I:I) .NE. ' ') THEN
                          VRT = VRT - 0.5
                          CALL GGIP09 (0.0, PRBUF, IPRMX, 0.35,
     1                         1 + ISTR, 2,  1.0, VRT)
                          GO TO 140
                        END IF
                      END DO
                    END IF
  140               IF (IWIN .EQ. 1) CALL GGIP (0.0, 0.0, 0.0, 6)
                    IF (IGBL(63) .GT. 2) THEN
                      CALL PLA262 (1)
                      WRITE (LU7, 99979, IOSTAT = IOST) PRBUF(1:IPRMX)
                    END IF
                    IF (DSMAX .GT. PAR(291)) PAR(291) = DSMAX
                    NSV         = NSV + 1
                    KBO(NSV, 1) = NROT
                    KBO(NSV, 2) = ISYM
                    KBO(NSV, 3) = ISTR
                    KBO(NSV, 4) = NINT (DLE * 10000.0)
                  ELSE
                    IF (ITRY .LT. 0) THEN
                      CALL PLA064 (NEWLAT)
                      GO TO 150
                    ELSE
                      IF (IPR(257) .EQ. 1) INVST = 1
                      IF (STAR .EQ. ' *') THEN
                        IF (LOOPR .EQ. 1) NNF111 = NNFIT
                      END IF
                      DSAVR = DSAVR / NSAVR
                      WRITE (PRBUF, 99987, IOSTAT = IOST)
     1                  STAR, NNFIT, DSAVR, ORIG
                      IF (DSMAX .LT. DSCENT) THEN
                        NFT     = NNFIT
                        DSCENT  = DSMAX
                        ORGM(1) = ORIG(1)
                        ORGM(2) = ORIG(2)
                        ORGM(3) = ORIG(3)
                      END IF
                      CALL GEN065 (0, PRBUF, 81, 7)
                      WRITE (LU6, 99979, IOSTAT = IOST) PRBUF(1:80)
                      IF (IGBL(63) .GT. 2) THEN
                        CALL PLA262 (1)
                        WRITE (LU7, 99979, IOSTAT = IOST) PRBUF(1:80)
                      END IF
                      IF (NNFIT .LT. 100 .AND. ISTR .EQ. 1) ISTR = 5
                      IF (IWIN .EQ. 1 .AND. VRT .GT. 6.0) THEN
                        VRT = VRT - 0.5
                        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1 + ISTR,
     1                               2, 1.0, VRT)
                      END IF
                      IF (STAR .EQ. ' *') THEN
                        WRITE (PRBUF, 99970, IOSTAT = IOST)
     1                    NQ3(1:6), NQ4(1:6), DSMAX
                          CALL GEN065 (0, PRBUF, 81, 7)
                        WRITE (LU6, 99979, IOSTAT = IOST) PRBUF(1:80)
                        IF (IWIN .EQ. 1 .AND. VRT .GT. 6.0) THEN
                          VRT = VRT - 0.5
                          CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1 + ISTR,
     1                                 2, 1.0, VRT)
                        END IF
                        IF (IGBL(63) .GT. 2) THEN
                          CALL PLA262 (1)
                          WRITE (LU7, 99979, IOSTAT = IOST) PRBUF(1:80)
                        END IF
                      END IF
                    END IF
                  END IF
                  IF (ITYP .NE. 5 .OR. STAR .EQ. '  ') GO TO 160
                END IF
  150         CONTINUE
            END DO
            IF (ITRY .NE. 5) NCHIRF = MIN (NCHIRF, NCHR / NSYM)
          END DO
          IF (ISYM .LT. MSYM) THEN
            IMETRIC = IMETRIC + 1
            WRITE (PRBUF, 99996, IOSTAT = IOST)
     1        IROW0, DLE, IPERP, MULT, ANG
            CALL GEN065 (0, PRBUF, 61, 20)
            WRITE (LU6, 99961, IOSTAT = IOST) PRBUF(1:61)
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (2)
              WRITE (LU7, 99961, IOSTAT = IOST) PRBUF(1:61)
            END IF
          END IF
  160   CONTINUE
        IF (NEWLT .GT. 0 .AND. IPR(503) .EQ. 0) THEN
          CALL PLA063 (NEWLAT, NEWLT, IPR(241), NLTX)
          IF (NLTX .GT. 0) THEN
            IF (IWIN .EQ. 1) THEN
              IF (NNFIT .EQ. 100) THEN
                XSUB = 'S'
                GO TO 20
              ELSE
                CALL PLA013 (-1, 1)
              END IF
            ELSE
              IGGT  = 'Y'
            END IF
            IF (IGGT(1:1) .EQ. 'Y') THEN
              WRITE (PRBUF, 99982, IOSTAT = IOST) JID(1:21)
              WRITE (LU6, 99967, IOSTAT = IOST) PRBUF
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 1.5
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 4.0, VRT)
                CALL PLA297 (0)
              END IF
              IF (IGBL(63) .GT. 2) THEN
                CALL PLA262 (3)
                WRITE (LU7, 99963, IOSTAT = IOST) PRBUF
              END IF
              XSUB = 'S'
              GO TO 20
            ELSE
              IPR(459) = 0
              IPR(209) = 0
            END IF
          END IF
        END IF
C * ANALYSE SYMMETRY OPERATIONS INTO STANDARD SPACE GROUP
        CALL PLA061
        IF (SPGRNM(1)(1:1) .NE. ' ') THEN
          IF (INDEX (SPGRNM(1)(1:11), ':') .NE. 0) THEN
            WRITE (ICL, 99973, IOSTAT = IOST) SPGRNM(1)(1:11)
          ELSE
            WRITE (ICL, 99974, IOSTAT = IOST)
     1        SPGRNM(1)(1:7)//' '//SPGRNM(1)(8:11)
            IF (SPGRNM(1)(13:13) .NE. ' ') ICL(13:13) = '.'
          END IF
          CALL SGSM (ICL, NRXX, XJX, LU6, 0, IERR)
        ELSE
          CALL SGSM (ICL, 0, XJX, 0, 26, IERR)
        END IF
        IF (LOOPR .LT. 3 .AND. JERR .GT. 0) THEN
C * ALERT _115 - Non-crystallographic Inversion
          IF (NNF111 .NE. 0)
     1      CALL PLA231 (115, 0, -999.0, FLOAT(NNF111), ' ', ' ')
          PRBUF = 'Local/Non-Crystallographic Inversion Center Detected'
          IF (IWIN .EQ. 1) THEN
            VRT = VRT - 1.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 4.0, VRT)
          END IF
          WRITE (LU6, 99963, IOSTAT = IOST) PRBUF(1:80)
          IF (IGBL(63) .GT. 0) THEN
            CALL PLA262 (3)
            WRITE (LU7, 99963, IOSTAT = IOST) PRBUF(1:80)
          END IF
          NNF111   = 0
          IPR(209) = 0
          IF (IWIN .EQ. 1) THEN
            CALL PLA013 (-2, 1)
          ELSE
            IGGT = 'Y'
          END IF
          IF (IGGT(1:1) .NE. 'N') THEN
            LOOPR         = LOOPR + 1
            IPR(220)      = IPR(220) + 1
            IFL(IPR(220)) = 'EXACT'
            IPR(221)      = 0
            NOINV         = 1
            IF (LU .EQ. 0) LU = LU6
            WRITE (LU, 99984, IOSTAT = IOST)
            GO TO 10
          END IF
        ELSE
C * ALERT _111 - ADDITIONAL (Pseudo) Centre of Symmetry found
          IF (NNF111 .NE. 0) THEN
            IF (NNF111 .GT. 90) THEN
              CALL PLA231 (111, 0, FLOAT(NNF111), FLOAT(NNF111), ' ',
     1                     ' ')
            ELSE IF (NNF111 .GT. 50) THEN
              CALL PLA231 (111, 0, -999.0, FLOAT(NNF111), ' ', ' ')
            END IF
          END IF
        END IF
        IF ((ISAVEMOD .EQ. 0 .OR. IGBL(65) .EQ. 1) .AND.
     1     (IPR(209) .GT. 0 .OR. IPR(504) .GT. 0)) THEN
          IF (SPGRNM(2)(1:1) .EQ. '?') THEN
            SPGRNM(2) = SPGRNM(1)
            CALL GEN074 (ORG, 1, 3, 0.0)
            WRITE (LU6, 99981, IOSTAT = IOST)
            IF (IGBL(63) .GT. 0) THEN
              CALL PLA262 (2)
              WRITE (LU7, 99981, IOSTAT = IOST)
            END IF
          END IF
          CALL PLA280 ('CALC GEOM SPF')
          JID(33:45) = ' New: '//SPGRNM(2)(1:7)
        END IF
        IGBL(67) = 0
      END IF
  170 IF (IWIN .EQ. 1) CALL PLA013 (0, 1)
      SELECT CASE (IGGT(1:4))
        CASE ('PLOT')
          CALL PLA280 ('CALC ADDSYM')
        CASE ('!   ')
          CALL PLA280 ('CALC ADDSYM')
        CASE ('END ')
          CALL PLA280 ('!')
      END SELECT
      IF (LOOPR .GT. 0) THEN
        IF (IPR(121) .GT. 0) IPR(220) = 1
      END IF
      IGBL(6) = 10
      DEALLOCATE (LCOR, NCOR, MCOR, COR, HH, PH)
      RETURN
99999 FORMAT ('ADDSYM - CHECK  (cf. MISSYM (C): Le Page, Y.,',
     1        ' J. Appl. Cryst. (1987), 20, 264-269; J. Appl.',
     2        ' Cryst. (1988), 21, 983-984)', /, 132('-'))
99998 FORMAT ('- Number of Input Atoms Included in Search', I5,
     1        ' (Unitcell', I5, ')')
99997 FORMAT (':: No ADDSYM Analysis: Too many Excluded Atoms')
99996 FORMAT (14X, '[', 3I2, ']', F6.2, 2I3, F6.2, 14X, ' Metric')
99995 FORMAT (2A, ' [', 3I2, '] [', 3I2, ']', F6.2, 2I3, F6.2,
     1        I5, F8.3, '  Through', 3F6.3)
99994 FORMAT ('ADDSYM Search on Chemical Type ', A, 'ONLY',
     1        ' [Max NonFit', I3, ' Perc]')
99993 FORMAT ('ADDSYM Search on ALL NON-H Chemical Types',
     1        ' [Max NonFit', I3, ' Perc]', A)
99992 FORMAT ('ADDSYM Search on ALL NON-H Chem. Types (Treated EQUAL)',
     1        ' [Max NonFit', I3, ' Perc]')
99991 FORMAT (2X, A, 33X, 2A, F5.3, 2X, A, 3F6.3)
99990 FORMAT ('- ', A)
99989 FORMAT ('The Structure Implies the Following Symmetry ',
     1        'Elements Subject to the Criteria:')
99988 FORMAT (' PART', I3)
99987 FORMAT ('-1', A, 1X, 35('='), 2X, I3, F8.3, 2X, 'at', 5X,
     1         3F6.3, 1X)
99986 FORMAT (25X, 'PLATON/ADDSYM for ', A)
99985 FORMAT ('Density based on Input Atom Set =', F6.3,
     1        ' g.cm-3 - Vol / Non-H atom =', F5.1, ' Ang+3')
99984 FORMAT (/, ':: Restart with CALC ADDSYM EXACT')
99983 FORMAT ('- The  ADDSYM Search may be rerun for a choosen atom',
     1        ' type', /
     1         '- Use LIST RADII for an overview of the atom types', /)
99982 FORMAT ('Forced RESTART of ADDSYM to Implement TRANSLATION for ',
     1        A)
99981 FORMAT (/, ':: Higher (pseudo)symmetry not compatible,',
     1           '(current symmetry retained)')
99980 FORMAT ('Criteria', F5.2, ' Deg (Metric),', F5.2, ' Ang (Rot.),'
     1        , F5.2, ' Ang (Inv),', F5.2, ' Ang (Transl)')
99979 FORMAT (A)
99978 FORMAT ('Symm.  Input  Reduced  (Ang)', 8X, '(Deg)', 1X,
     1        'Perc', 1X, 'AvrDev.(Ang)', 10X, 'Input Cell')
99977 FORMAT ('Elem', 1X, 'Cell_Row', 1X, 'Cell_Row', 3X,
     1        'd  Typ Dot Angle Fit  MaxDev.', 13X,
     2        'x     y     z')
99976 FORMAT (80('-'))
99975 FORMAT (/, '- Number of Excluded Disordered Input Atoms = ', I5)
99974 FORMAT ('SPGR ' , A, 63X)
99973 FORMAT ('SPGR ', A, 64X)
99972 FORMAT (1X)
99971 FORMAT (3X, A, $)
99970 FORMAT (36X, 2A, F5.3)
99969 FORMAT (':: Over', I7, 'atoms in the Primitive Cell',
     1        ' (ADDSYM request aborted!)')
99968 FORMAT (':: No Fully Occ. Atoms found in list ...',
     1        ' ADDSYM request aborted!')
99967 FORMAT (/, ':: ', A, /)
99966 FORMAT (3X, A)
99965 FORMAT (/, ':: Note: Atoms deleted from input !')
99964 FORMAT (/, ':: NonFits (i.e. Atoms with no symmetry related',
     1           ' counterpart):')
99963 FORMAT (/, A, /)
99962 FORMAT (/, ':: Excluded Disorder Atoms From ADDSYM Analysis:')
99961 FORMAT (A, /)
      END SUBROUTINE PLA060
      SUBROUTINE PLA061
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP20=20,
     2 NP22=287,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      DIMENSION TTRM1(3, 3), TR1(3, 3)
      COMMON /CTRNS/ TRTYP
      CHARACTER TRTYP(8)*5
      DIMENSION DUMMY(3, 3), DUM1(3, 3), DUM2(3, 3), DUM3(3, 3),
     1 DUM4(3, 3)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER ZSPG0*7
      COMMON /PL60/ LU, XMISR(3, 3, 15), XMISL(3, 15), XMISG(3, 15),
     1 NMIS(15), RH(3, 3, NP20), ORGM(3), OSHFT(3), OADD(3), FRACT(10),
     2 GLIDE(3), NA(3), DSMAX, NSGTR, NFT, LOOPR, IMETRIC, NFTX,
     3 NCHIR, NCHIRF,  NLCLP, NEWS, NNFIT, NNNFIT, NSV, INVST, NORG,
     4 NORGM, NOINV, NEWLT, NAL112S, NAL110, JERR
      COMMON /PL60C/ FSYM, XSUB, CENT, LATT
      CHARACTER FSYM*3, XSUB*1, CENT*1, LATT*1
      CHARACTER ZSPG2*7, ZSPG3*7
C * ANALYZE THE 'NSV' SYMMETRY ELEMENTS INTO (STANDARD/NEW) SPACE GROUP
      IN1   = 0
      ISYST = 8
      MLAUE = 12
      NRXX  = 0
      IF (NSV .EQ. 2) THEN
        DO I = 1, 2
          IF (KBO(I, 3) .EQ. 1) THEN
            KBO(I, 1) = 0
            EXIT
          END IF
        END DO
      END IF
      IF (NSV .GT. 1) THEN
        JMX = NSV - 1
        NB  = 1
        DO WHILE (NB .NE. 0)
          NB  = 0
          DO J = 1, JMX
            IF (KBO(J, 1) .LT. KBO(J + 1, 1)) THEN
              DO K = 1, 3
                CALL GEN014 (KBO(J, K), KBO(J + 1, K))
              END DO
              NB = 1
            END IF
          END DO
        END DO
      END IF
      IF (NSV .EQ. 2) NSV = 1
      IF (NSV .EQ. 0) THEN
        CALL GEN021 (PAT, 1)
        ISYST = 1
        MLAUE = 1
      ELSE
        NROT = KBO(1, 1)
        IF (NSV .EQ. 7 .AND. NROT .NE. 6) THEN
          K = 4
        ELSE
          K = 0
        END IF
        IF (K .EQ. 4 .OR. NSV .EQ. 3 .OR. NSV .EQ. 13) THEN
          IF (NSV .EQ. 3) THEN
            NB  = 1
            DO WHILE (NB .NE. 0)
              NB  = 0
              DO I = 1, 2
                IF (KBO(I, 4) .GT. KBO(I + 1, 4)) THEN
                  DO J = 1, 4
                    CALL GEN014 (KBO(I, J), KBO(I + 1, J))
                  END DO
                  NB = 1
                END IF
              END DO
            END DO
          END IF
          DO I = 1, 3
            DO J = 1, 3
              PAT(I, J) = RH(J, 3, KBO(K + I, 2))
            END DO
          END DO
          IF (NSV .EQ. 3) THEN
            ISYST = 3
            MLAUE = 3
          ELSE IF (NSV .EQ. 7) THEN
            ISYST = 7
            MLAUE = 10
          ELSE
            ISYST = 7
            MLAUE = 11
          END IF
        ELSE
          ISYM = KBO(1, 2)
          DO J = 1, 3
            DO K = 1, 3
              PAT(K, J) = RH(J, K, ISYM)
            END DO
          END DO
          IF (NSV .EQ. 1) THEN
            IF (NROT .EQ. 2) THEN
              ISYST = 2
              MLAUE = 2
              DO J = 1, 3
                CALL GEN018 (PAT(2, J), PAT(3, J))
              END DO
            ELSE IF (NROT .EQ. 3) THEN
              ISYST = 5
              MLAUE = 6
            ELSE IF (NROT .EQ. 4) THEN
              ISYST = 4
              MLAUE = 4
            ELSE
              ISYST = 6
              MLAUE = 8
            END IF
          ELSE IF (NSV .EQ. 4) THEN
            IF (NROT .NE. 4) THEN
              ISYST = 5
              MLAUE = 7
            ELSE
              ISYST = 4
              MLAUE = 5
            END IF
          ELSE IF (NSV .EQ. 5) THEN
            ISYST = 4
            MLAUE = 5
          ELSE IF (NSV .EQ. 7) THEN
            ISYST = 6
            MLAUE = 9
          END IF
        END IF
      END IF
      CALL GEN010 (PAT, IDET, 0)
      IF (IDET .LT. 0) THEN
        DO J = 1, 3
          PAT(2, J) = - PAT(2, J)
        END DO
      END IF
      CALL GEN003 (PAT, ROTM1, DET, 0)
      IDET = NINT(DET)
      IF (IDET .EQ. 4) THEN
        LATT = 'F'
      ELSE IF (IDET .EQ. 3) THEN
        LATT = 'R'
        V1(1) = 2.0
        V1(2) = 1.0
        V1(3) = 1.0
        CALL GEN094 (PAT, V1, 3, IDUM)
        IF (IDUM .NE. 0) THEN
          CALL GEN021 (DAM, 1)
          DAM(1, 2) =  1.0
          DAM(2, 1) = -1.0
          DAM(2, 2) =  0.0
          CALL GEN004 (DAM, PAT, PAT)
        END IF
      ELSE IF (IDET .EQ. 2) THEN
        V1(1) = 0.0
        V1(2) = 1.0
        V1(3) = 1.0
        N     = 0
        CALL GEN094 (PAT, V1, 2, IDUM)
        IF (IDUM .EQ. 0) THEN
          LATT = 'A'
          N    = 1
        ELSE
          CALL GEN018 (V1(1), V1(2))
          CALL GEN094 (PAT, V1, 2, IDUM)
          IF (IDUM .EQ. 0) THEN
            LATT = 'B'
            N    = 2
          ELSE
            CALL GEN018 (V1(2), V1(3))
            CALL GEN094 (PAT, V1, 2, IDUM)
            IF (IDUM .EQ. 0) THEN
              LATT = 'C'
            ELSE
              V1(3) = 1.0
              CALL GEN094 (PAT, V1, 2, IDUM)
              IF (IDUM .EQ. 0) THEN
                LATT = 'I'
              ELSE
                LATT = ' '
              END IF
            END IF
          END IF
        END IF
        IF (N .NE. 0) THEN
          DO I = 1, 3
            PAT(2, I) = - PAT(2, I)
            CALL GEN018 (PAT(N, I), PAT(3, I))
          END DO
          LATT = 'C'
        END IF
      ELSE
        LATT = 'P'
      END IF
      IF (ISYST .EQ. 5) THEN
        LAT0 = 6
      ELSE
        LAT0 = ISYST
      END IF
      IF (LAT0 .EQ. 2 .AND. LATT .EQ. 'I' .AND. IGBL(106) .EQ. 0) THEN
        LATT = 'C'
        CALL GEN021 (DAM, 1)
        DAM(1, 3) =  1.0
        DAM(3, 1) = -1.0
        DAM(3, 3) =  0.0
        CALL GEN004 (DAM, PAT, PAT)
      END IF
      CALL GEN005 (TRNS, QM)
      CALL GEN004 (PAT, QM, ROTM2)
      IF (LAT0 .LT. 4) THEN
        CALL GEN104 (LAT0, ROTM2, DUM4)
      ELSE
        CALL GEN021 (DUM4, 1)
      ENDIF
      CALL GEN004 (DUM4, PAT, PAT)
      CALL GEN004 (PAT, QM, ROTM2)
      CALL GEN005 (ROTM2, TR1)
      CALL GEN003 (TR1, ROTM1, DET, 0)
      CALL GEN038 (SPGRNM(2), 1, 11)
      IF (INVST .EQ. 1) THEN
        CALL GEN002 (1, ROTM1, ORGM, ORG, XLNG)
      ELSE
        CALL GEN074 (ORG, 1, 3, 0.0)
      END IF
      IF (INVST .EQ. 1 .OR. IPR(257) .EQ. 2) THEN
        CENT = 'C'
      ELSE
        CENT = 'A'
      END IF
      IF (LAT0 .EQ. 7) THEN
        DO JN = 1, NEWS
          IN = NMIS(JN) / 100
          IF (IN .EQ. 3) NMIS(JN) = NMIS(JN) + 300
        END DO
      END IF
      CALL GEN022 (NMIS, 1, NEWS)
      NRT1 = 0
      NNRT = 0
      DO I = 1, 3
        OADD(I) = 0.25
      END DO
C * LOOP OVER DETECTED SYMMETRY ELEMENTS
      DO JN = 1, NEWS
        IN  = MOD (NMIS(JN), 100)
        NRT = 6 - NMIS(JN) / 100
        IF (NRT .EQ. 5) THEN
          NRT  = 4
          NNRT = 1
        END IF
        CALL GEN004 (ROTM1, XMISR(1, 1, IN), XMISR(1, 1, IN))
        CALL GEN004 (XMISR(1, 1, IN), TR1, XMISR(1, 1, IN))
        CALL GEN002 (1, ROTM1, XMISL(1, IN), XMISL(1, IN), XLNG)
        CALL GEN002 (1, ROTM1, XMISG(1, IN), XMISG(1, IN), XLNG)
        IF (JN .EQ. 1) THEN
          IF (INVST .EQ. 0 .AND. IPR(257) .EQ. 1) THEN
            IN1 = IN
            DO I = 1, 3
              ORG(I) = XMISL(I, IN)
            END DO
            NRT1   = NRT
            IF (LAT0 .EQ. 4) THEN
              OADD(3) = 0.125
            ELSE IF (LAT0 .EQ. 6) THEN
              OADD(1) = 0.3333
              OADD(2) = 0.3333
              OADD(3) = 0.5 / NRT1
            ELSE IF (LAT0 .EQ. 7) THEN
              DO I = 1, 3
                OADD(I) = 0.125
              END DO
            END IF
          ELSE
            IF (NRT .EQ. 3 .OR. NRT .EQ. 6) THEN
              ORG(1) = ORG(1) +
     1           0.5 * MOD (NINT((XMISL(1, IN) - ORG(1)) * 6), 2)
              ORG(2) = ORG(2) +
     1           0.5 * MOD (NINT((XMISL(2, IN) - ORG(2)) * 6), 2)
            END IF
          END IF
        ELSE IF (JN .EQ. 2 .AND. NNRT .EQ. 0) THEN
          IF (INVST .EQ. 0 .AND. IPR(257) .EQ. 1) THEN
            IF (NRT1 .GT. 2) THEN
              IF (NRT .EQ. 4) THEN
                IF (XMISR(1, 1, IN1) .EQ. 1) THEN
                  ORG(1) = XMISL(1, IN)
                ELSE IF (XMISR(2, 2, IN1) .EQ. 1) THEN
                  ORG(2) = XMISL(2, IN)
                ELSE IF (XMISR(3, 3, IN1) .EQ. 1) THEN
                  ORG(3) = XMISL(3, IN)
                END IF
              ELSE
                ORG(3) = XMISL(3, IN)
              END IF
            ELSE
              IF (NINT(XMISR(1, 1, IN1)) .EQ.  1 .AND.
     1            NINT(XMISR(2, 2, IN1)) .EQ. -1 .AND.
     2            NINT(XMISR(3, 3, IN1)) .EQ. -1) THEN
                ORG(1) = XMISL(1, IN)
              ELSE IF (NINT(XMISR(1, 1, IN1)) .EQ. -1 .AND.
     1                 NINT(XMISR(2, 2, IN1)) .EQ.  1 .AND.
     2                 NINT(XMISR(3, 3, IN1)) .EQ. -1) THEN
                ORG(2) = XMISL(2, IN)
              ELSE IF (NINT(XMISR(1, 1, IN1)) .EQ. -1 .AND.
     1                 NINT(XMISR(2, 2, IN1)) .EQ. -1 .AND.
     2                 NINT(XMISR(3, 3, IN1)) .EQ.  1) THEN
                ORG(3) = XMISL(3, IN)
              END IF
            END IF
          END IF
        END IF
        DO IR = 1, 3
          XMISL(IR, IN) = XMISL(IR, IN) - ORG(IR)
        END DO
      END DO
      NORG  = -1
      NORGM =  1
C * FIND CONVENTIONAL ORIGIN
      DO
        IF (NORG .LT. NORGM) THEN
          CALL PLA062
          WRITE (ICL, 99958,IOSTAT = IOST) LATT, CENT
          CALL SGSM (ICL, 0, FN, LU6, 0, IERR)
          DO JN = 1, NEWS
            IN = MOD (NMIS(JN), 100)
            DO J = 1, 3
              V5(J) = - XMISL(J, IN) + OSHFT(J)
            END DO
            CALL GEN002 (1, XMISR(1, 1, IN), V5, V6, XLNG)
            K = 0
            DO I = 1, 3
              FN(9 + I) = NINT (24.0 * MOD (XMISL(I, IN) - OSHFT(I) +
     1                     V6(I) + XMISG(I, IN) + 10.0, 1.0)) / 24.0
              DO J = 1, 3
                K     = K + 1
                FN(K) = XMISR(I, J, IN)
              END DO
            END DO
            CALL SGSM (ICL, 0, FN, LU6, 15, IERR)
            IF (IERR .NE. 0) THEN
              IF (LOOPR .EQ. 1) THEN
                JERR = JERR + 10
                RETURN
              ELSE
                EXIT
              END IF
            END IF
          END DO
          IF (IERR .EQ. 0) THEN
            IF (IBVL(LAT0)//LATT .EQ. 'mI' .AND. IGBL(106) .EQ. 1) THEN
              CALL SGSM (ICL, 0, FN, 0, 18, IERR)
            ELSE
              CALL SGSM (ICL, 0, FN, 0, 24, IERR)
            END IF
            SPGRNM(2) = ICL(1:26)
            IF (IBVL(LAT0)//LATT .EQ. ICL(12:13)) THEN
              IF (SPGRNM(2)(1:5) .NE. 'C2/n') THEN
                IF (SPGRNM(2)(1:2) .NE. '  ') GO TO 20
              END IF
            END IF
          END IF
        ELSE
          SPGRNM(2)(1:1) = ' '
          JERR = JERR + 100
          RETURN
        END IF
      END DO
   20 DO J = 1, 3
        ORG(J)   = ORG(J) + OSHFT(J)
        OSHFT(J) = 0.0
      END DO
      IF (SPGRNM(2)(1:1) .EQ. ' ') THEN
        SPGRNM(2)(1:1) = '?'
        CALL SGSM (ICL, 0, FN, LU6, 18, IERR)
        SPGRNM(2) = ICL(1:26)
        ISGNR     = NINT(FN(1))
        LAT0      = NINT(FN(2))
        LATT      = SPGRNM(2)(13:13)
      ELSE
        IF (SPGRNM(2)(12:12) .EQ. 'm') THEN
          IF (SPGRNM(2)(1:7) .EQ. 'Pa     ') THEN
            SPGRNM(2)(1:11) = 'Pc     C-BA'
          ELSE IF (SPGRNM(2)(1:7) .EQ. 'P2/a   ') THEN
            SPGRNM(2)(1:11) = 'P2/c   C-BA'
          ELSE IF (SPGRNM(2)(1:7) .EQ. 'P21/a  ') THEN
            SPGRNM(2)(1:11) = 'P21/c  C-BA'
          ELSE IF (IGBL(106) .EQ. 0) THEN
            IF (SPGRNM(2)(1:7) .EQ. 'Pn     ') THEN
              SPGRNM(2)(1:11) = 'Pc     A-B-'
            ELSE IF (SPGRNM(2)(1:7) .EQ. 'P2/n   ') THEN
              SPGRNM(2)(1:11) = 'P2/c   A-B-'
            ELSE IF (SPGRNM(2)(1:7) .EQ. 'P21/n  ') THEN
              SPGRNM(2)(1:11) = 'P21/c  A-B-'
            END IF
          END IF
        ELSE IF (SPGRNM(2)(12:12) .EQ. 'c') THEN
          IF (SPGRNM(2)(1:7) .EQ. 'Pb-3   ') THEN
            SPGRNM(2)(1:11) = 'Pa-3   BA-C'
            OSHFT(2) = 0.5
          END IF
        END IF
        CALL GEN020 (1, SPGRNM(2), 8, 11)
        N = 0
        IF (.FALSE.) THEN
          DUM433 = 0.0
          CALL SGSM (ICL, 0, FN, 0,  23, IERR)
          DO K = 1, 6
            IF (FN(K) .NE. 0) THEN
              CALL GEN052 (TRDAT(1, 1, K), DUM1)
              CALL GEN004 (DUM1, PAT, DUM2)
              CALL GEN004 (DUM2, QM,  DUM3)
              CALL GEN004 (DUM3, AA,  DUM4)
              CALL GEN005 (DUM3, DUM3)
              CALL GEN004 (DUM4, DUM3, DUM4)
              IF (DUM4(3, 3) .GT. DUM433) THEN
                DUM433 = DUM4(3, 3)
                N      = K
              ELSE IF (DUM4(3, 3) .EQ. DUM433) THEN
                IF (DUM4(1, 1) .LT. DUM4(2, 2)) THEN
                  N = K
                END IF
              END IF
              IF (DUM4(1, 1) .LT. DUM4(2, 2) .AND.
     1            DUM4(2, 2) .LT. DUM4(3, 3)) THEN
                 N = K
                 GO TO 30
              END IF
            END IF
          END DO
        ELSE
          DO K = 1, 8
            IF (SPGRNM(2)(8:11) .EQ. TRTYP(K)(1:4)) THEN
              N = K
              GO TO 30
            END IF
          END DO
        END IF
   30   WRITE (ICL, 99968, IOSTAT = IOST) SPGRNM(2)(1:7)
        CALL SGSM (ICL, NRXX, XJX, LU6, 0, IERR)
        CALL SGSM (ICL, 0, FN, LU6, 18, IERR)
        SPGRNM(2) = ICL(1:26)
        ISGNR     = NINT(FN(1))
        LAT0      = NINT(FN(2))
        LATT      = SPGRNM(2)(13:13)
        IF (N .NE. 0) THEN
          CALL GEN052 (TRDAT(1, 1, N), DUM1)
        ELSE
          CALL GEN021 (DUM1, 1)
        END IF
        CALL GEN052 (PAT, DUM2)
        CALL GEN004 (DUM1, DUM2, DUM3)
        CALL GEN004 (DUM3, QM, ROTM2)
        CALL GEN021 (DUM4, 1)
        CALL GEN004 (DUM4, DUM3, PAT)
        CALL GEN004 (DUM4, DUM1, DUM1)
        CALL GEN005 (DUM1, TR1)
        CALL GEN003 (TR1, TTRM1, DET, 0)
        CALL GEN002 (1, TTRM1, ORG, ORG, XLNG)
      END IF
      DO J = 1, 3
        ORG(J) = ORG(J) + OSHFT(J)
        IF (ORG(J) .LT. - 0.5) ORG(J) = ORG(J) + 1.0
        IF (ORG(J) .GT.   0.5) ORG(J) = ORG(J) - 1.0
      END DO
      LU = LU6
      IF (LU .GT. 0) THEN
        WRITE (LU6, 99997, IOSTAT = IOST)
        IF (IWIN .EQ. 1 .AND. LU .NE. 0) THEN
          WRITE (PRBUF, 99987, IOSTAT = IOST)
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
          CALL GGIP (0.0, 1.0, 0.0, 0)
          CALL GGIP (0.0,  VRT - 0.2, 0.0, 3)
          CALL GGIP (HORS, VRT - 0.2, 0.0, 2)
          VRT = VRT - 0.3
        END IF
      END IF
      CALL GEN003 (ROTM2, DUMMY, DET, 0)
      CALL GEN005 (DUMMY, DUMMY)
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (8)
        WRITE (LU7, 99997, IOSTAT = IOST)
      END IF
      WRITE (PRBUF, 99996, IOSTAT = IOST) (PAT(1, J), J = 1, 3),
     1    (QM(1, J), J = 1, 3), (ROTM2(1, J), J = 1, 3)
      CALL GEN065 (LU, PRBUF, 80, 16)
      IF (IWIN .EQ. 1 .AND. LU .NE. 0) THEN
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
      END IF
      IF (IGBL(63) .GT. 2) WRITE (LU7, 99960, IOSTAT = IOST) PRBUF
      WRITE (PRBUF, 99995, IOSTAT = IOST) (PAT(2, J), J = 1, 3),
     1    (QM(2, J), J = 1, 3), (ROTM2(2, J), J = 1, 3)
      CALL GEN065 (LU, PRBUF, 80, 16)
      IF (IWIN .EQ. 1 .AND. LU .NE. 0) THEN
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
      END IF
      IF (IGBL(63) .GT. 2)  WRITE (LU7, 99960, IOSTAT = IOST) PRBUF
      WRITE (PRBUF, 99994, IOSTAT = IOST) (PAT(3, J), J = 1, 3),
     1    (QM(3, J), J = 1, 3), (ROTM2(3, J), J = 1, 3), DET
      CALL GEN065 (LU, PRBUF, 80, 16)
      IF (IWIN .EQ. 1 .AND. LU .NE. 0) THEN
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
      END IF
      IF (IGBL(63) .GT. 0) WRITE (LU7, 99960, IOSTAT = IOST) PRBUF
      CALL GEN004 (ROTM2, AA, DUMV)
      CALL GEN005 (ROTM2, ROTM1)
      CALL GEN004 (DUMV, ROTM1, DUMV)
      CALL GEN026 (-1, DUMV, PAR(143))
      CALL GEN003 (DUMV, ROTM1, DET, 0)
      PAR(100) = SQRT(DET)
      DDIS     = 0.0
      DANG     = 0.0
      IF (ISYST .EQ. 2) THEN
        DANG = MAX (ABS(PAR(146) - 90.0), DANG)
        DANG = MAX (ABS(PAR(148) - 90.0), DANG)
      ELSE IF (ISYST .EQ. 3) THEN
        DANG = MAX (ABS(PAR(146) - 90.0), DANG)
        DANG = MAX (ABS(PAR(147) - 90.0), DANG)
        DANG = MAX (ABS(PAR(148) - 90.0), DANG)
      ELSE IF (ISYST .EQ. 4) THEN
        DDIS = MAX (ABS(PAR(143) - PAR(144)), DDIS)
        DANG = MAX (ABS(PAR(146) - 90.0), DANG)
        DANG = MAX (ABS(PAR(147) - 90.0), DANG)
        DANG = MAX (ABS(PAR(148) - 90.0), DANG)
      ELSE IF (ISYST .EQ. 5 .OR. ISYST .EQ. 6) THEN
        DDIS = MAX (ABS(PAR(143) - PAR(144)), DDIS)
        DANG = MAX (ABS(PAR(148) - 120.0), DANG)
      ELSE IF (ISYST .EQ. 7) THEN
        DDIS = MAX (ABS(PAR(143) - PAR(144)), DDIS)
        DDIS = MAX (ABS(PAR(143) - PAR(145)), DDIS)
        DDIS = MAX (ABS(PAR(144) - PAR(145)), DDIS)
        DANG = MAX (ABS(PAR(146) - 90.0), DANG)
        DANG = MAX (ABS(PAR(147) - 90.0), DANG)
        DANG = MAX (ABS(PAR(148) - 90.0), DANG)
      END IF
      IF (IGBL(63) .GT. 2) THEN
        JMAX = 2
      ELSE
        JMAX = 1
      END IF
      DO JPRLP = 1, JMAX
        IF (JPRLP .EQ. 2) THEN
          LU = LU7
          CALL PLA262 (6)
        ELSE
          LU = LU6
        END IF
        WRITE (LU, 99969, IOSTAT = IOST)
        WRITE (LU, 99998, IOSTAT = IOST)
        WRITE (LU, 99964, IOSTAT = IOST)
        WRITE (LU, 99993, IOSTAT = IOST)
     1    SPGRNM(1)(12:13), (PAR(100 + I), I = 1, 6),
     2    NINT(PAR(98)), KRSYST(2),  LAUEGR
        WRITE (LU, 99992, IOSTAT = IOST)
     1   (PAR(122 + I), I = 1, 6), NINT(PAR(99))
        LAT1 = LAT0
        IF (LAT1 .EQ. 5) LAT1 = 6
        KRSYST(3) = XSYST(ISYST)
        CALL GEN020 (-1, KRSYST(3), 1, 12)
        WRITE (LU, 99991, IOSTAT = IOST)
     1    IBVL(LAT1), LATT, (PAR(142 + I), I = 1, 6),
     2    NINT(PAR(100)), KRSYST(3), LGR(MLAUE)
        IF (JPRLP .EQ. 1) THEN
          IF (IWIN .EQ. 1) THEN
            WRITE (PRBUF, 99998, IOSTAT = IOST)
            VRT = VRT - 0.8
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 1.0,
     1                   VRT)
            CALL GGIP (0.0, 1.0, 0.0, 0)
            CALL GGIP (0.0,  VRT - 0.2, 0.0, 3)
            CALL GGIP (HORS, VRT - 0.2, 0.0, 2)
            WRITE (PRBUF, 99993, IOSTAT = IOST)
     1             SPGRNM(1)(12:13), (PAR(100 + I), I = 1, 6),
     2                    NINT(PAR(98)), KRSYST(2),  LAUEGR
            VRT = VRT - 0.8
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
            WRITE (PRBUF, 99992, IOSTAT = IOST)
     1            (PAR(122 + I), I = 1, 6), NINT(PAR(99))
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
            LAT1 = LAT0
            IF (LAT1 .EQ. 5) LAT1 = 6
            WRITE (PRBUF, 99991, IOSTAT = IOST)
     1        IBVL(LAT1), LATT, (PAR(142 + I), I = 1, 6),
     2        NINT(PAR(100)), KRSYST(3), LGR(MLAUE)
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
          END IF
          IF (NLCLP .EQ. 1) THEN
            N0 = INDEX (ZSPG, ':')
            IF (N0 .NE. 0) THEN
              ZSPG0 = ZSPG(1:N0-1)
            ELSE
              ZSPG0 = ZSPG
            END IF
            IF (ZSPG0 .EQ. SPGRNM(2)(1:7)) THEN
              IF (ABS(PAR(101) - PAR(143)) .GT. 0.01 .OR.
     1            ABS(PAR(102) - PAR(144)) .GT. 0.01 .OR.
     2            ABS(PAR(103) - PAR(145)) .GT. 0.01 .OR.
     3            ABS(PAR(104) - PAR(146)) .GT. 0.1  .OR.
     4            ABS(PAR(105) - PAR(147)) .GT. 0.1  .OR.
     5            ABS(PAR(106) - PAR(148)) .GT. 0.1) THEN
                IF (SPGRNM(2)(12:12) .NE. 'o' .AND.
     1              SPGRNM(2)(12:12) .NE. 'a') THEN
C * ALERT _158
                  CALL PLA231 (158, 0, -999.0, 1.0, ' ', ' ')
                  WRITE (PRBUF, 99983, IOSTAT = IOST)
                  IF (IWIN .EQ. 1) THEN
                    VRT = VRT - 0.9
                    CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
                  END IF
                  WRITE (LU, 99972, IOSTAT = IOST) PRBUF(1:60)
                END IF
              END IF
              IF (SPGRNM(1)(1:1) .EQ. ' ') THEN
                NSP = 2
              ELSE
                NSP = 1
              END IF
              WRITE (LU, 99984, IOSTAT = IOST) SPGRNM(NSP)(1:11)
              IF (IWIN .EQ. 1) THEN
                IF (ABS(ORG(1)) + ABS(ORG(2)) + ABS(ORG(3)) .GT.
     1              0.001) THEN
                  WRITE (PRBUF, 99988, IOSTAT = IOST)
     1              ORG(1), ORG(2), ORG(3)
                  VRT = VRT - 0.7
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
                END IF
                VRT = VRT - 0.9
                IF (NSGTR .EQ. 0) THEN
                  WRITE (PRBUF, 99963, IOSTAT = IOST) SPGRNM(NSP)(1:11)
                  NCOL = 3
                ELSE
                  WRITE (PRBUF, 99971, IOSTAT = IOST) SPGRNM(NSP)(1:11)
                  NCOL = 2
                END IF
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, NCOL, 2, 1.0,
     1                       VRT)
              END IF
            ELSE
              IF (INDEX (SPGRNM(2), '?') .NE. 0) THEN
                IF (LOOPR .LT. 3) THEN
                  JERR = JERR + 1000
                  RETURN
                END IF
                IF (IWIN .EQ. 1) THEN
                  VRT = VRT - 0.9
                  WRITE (PRBUF, 99973, IOSTAT = IOST)
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
                END IF
                WRITE (LU, 99972, IOSTAT = IOST) PRBUF
C * ALERT _114
                CALL PLA231 (114, 0, 1.0, 1.0, ' ', ' ')
              END IF
            END IF
          END IF
        END IF
        IF (DDIS .GT. 0.0001) WRITE (LU, 99967, IOSTAT = IOST) DDIS
        IF (DANG .GT. 0.001)  WRITE (LU, 99966, IOSTAT = IOST) DANG
      END DO
      IF ((ZSPG .NE. SPGRNM(2)(1:7) .AND.
     1     SPGRNM(2)(1:1) .NE. '?') .OR. NLCLP .NE. 1) THEN
        WRITE (LU6, 99975, IOSTAT = IOST)
        IF (IGBL(63) .GT. 0) THEN
          CALL PLA262 (-4)
          WRITE (LU7, 99975, IOSTAT = IOST)
        END IF
        CALL SGSM (ICL, 0, FN, LU6, 2, IERR)
        IF (IGBL(63) .GT. 0) CALL SGSM (ICL, 0, FN, LU7, 2, IERR)
        IF (IPR(209) .EQ. 0 .AND. IPR(118) .EQ. 0 .AND.
     1      IPR(459) .EQ. 0) THEN
          IF (IGBL(94) .EQ. 0) THEN
            IF (SPGRNM(2)(1:7) .EQ. 'P21/n  ') THEN
              ZSPG3 = '  '//SPGRNM(2)(1:5)
            ELSE IF (SPGRNM(2)(1:7) .EQ. 'I2/n   ') THEN
              ZSPG3 = '   '//SPGRNM(2)(1:4)
            ELSE IF (SPGRNM(2)(1:7) .EQ. 'I2/a   ') THEN
              ZSPG3 = '   '//SPGRNM(2)(1:4)
            ELSE IF (SPGRNM(2)(1:7) .EQ. 'I2/m   ') THEN
              ZSPG3 = '   '//SPGRNM(2)(1:4)
            ELSE
              ZSPG3 = SPGRNM(2)(1:7)
            END IF
            IF (ZSPG(1:7) .EQ. 'P21/n  ') THEN
              ZSPG2 = '  '//ZSPG(1:5)
            ELSE IF (ZSPG(1:7) .EQ. 'I2/n   ') THEN
              ZSPG2 = '   '//ZSPG(1:4)
            ELSE IF (ZSPG(1:7) .EQ. 'C2/m   ') THEN
              ZSPG2 = '   '//ZSPG(1:4)
            ELSE IF (ZSPG(1:7) .EQ. 'C2/c   ') THEN
              ZSPG2 = '   '//ZSPG(1:4)
            ELSE
              ZSPG2 = ZSPG
            END IF
C * ALERT _128
            CALL PLA231 (128, 0, -999.0, 1.0, ZSPG2, ZSPG3)
          END IF
          WRITE (PRBUF, 99989, IOSTAT = IOST) ZSPG, SPGRNM(2)(1:7)
          WRITE (LU6, 99961, IOSTAT = IOST) PRBUF(1:80)
          IF (IWIN .EQ. 1) THEN
            VRT = VRT - 0.8
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 3, 2, 1.0, VRT)
          END IF
          IF (IGBL(63) .GT. 0) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99961, IOSTAT = IOST) PRBUF(1:80)
          END IF
        END IF
      END IF
      DO JPRLP = 1, JMAX
        IF (JPRLP .EQ. 2) THEN
          LU = LU7
        ELSE
          LU = LU6
        END IF
        IF (IMETRIC .GT. 0) THEN
          IF (JPRLP .EQ. 2) CALL PLA262 (2)
          WRITE (LU, 99979, IOSTAT = IOST)
        END IF
        IF (IPR(209) .EQ. 0) THEN
          IF (IPR(118) .EQ. 0 .AND. IPR(459) .EQ. 0
     1      .AND. NSGTR .EQ. 0) THEN
            IF (JPRLP .EQ. 1) THEN
              CALL PLA015 (0, 5)
            ELSE IF (JPRLP .EQ. 2) THEN
              CALL PLA262 (3)
              WRITE (LU, 99985, IOSTAT = IOST)
              IF (IPR(207) .NE. 0) THEN
                CALL PLA262 (1)
                WRITE(LU, 99970, IOSTAT = IOST)
              END IF
            END IF
          ELSE
            IF (IPR(459) .NE. 0) THEN
              WRITE (PRBUF, 99977, IOSTAT = IOST)
              IF (JPRLP .EQ. 1) THEN
                IF (IWIN .EQ. 1) THEN
                  VRT = VRT - 1.0
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
                END IF
              END IF
              IF (JPRLP .EQ. 2) CALL PLA262 (1)
              WRITE (LU, 99974, IOSTAT = IOST) PRBUF
            END IF
            IF (IPR(118) .NE. 0) THEN
              WRITE (PRBUF, 99978, IOSTAT = IOST)
              IF (JPRLP .EQ. 1) THEN
                IF (IWIN .EQ. 1) THEN
                  VRT = VRT - 1.0
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
                END IF
              END IF
              IF (JPRLP .EQ. 2) CALL PLA262 (1)
              WRITE (LU, 99974, IOSTAT = IOST) PRBUF
              CALL PLA262 (1)
              WRITE (LU, 99976, IOSTAT = IOST)
            END IF
          END IF
        ELSE
          IF (JPRLP .EQ. 2) CALL PLA262 (12)
          WRITE (LU, 99965, IOSTAT = IOST) ORG(1), ORG(2), ORG(3),
     1          ((DUMMY(I, J), J = 1, 3), -ORG(I), I = 1, 3)
          IF (IGBL(45) .GT. 0) IGBL(45) = - 1
          NNNFIT = MIN (NNNFIT, NFT)
          WRITE (LU, 99999, IOSTAT = IOST)
          IF (SPGRNM(1)(1:11) .NE. SPGRNM(2)(1:11) .OR.
     1      XSUB .EQ. 'S') THEN
            IF (SPGRNM(2)(1:11) .NE. '?' .OR. NNNFIT .EQ. 100) THEN
              IF (JPRLP .EQ. 2) CALL PLA262 (3)
            LAT1 = LAT0
            IF (LAT1 .EQ. 5) LAT1 = 6
            WRITE (LU, 99959, IOSTAT = IOST)
     1        JID(1:23), SPGRNM(1)(12:13), IBVL(LAT1), LATT, PAR(142),
     2        NCHIR, NCHIRF, DDIS, DANG, PAR(291), XSUB, NNNFIT,
     3        SPGRNM(2)(1:11), CHAR(IPR(223))
          END IF
C * ALERT _113 - REPORT NEW SPACE GROUP
            IF (SPGRNM(2)(1:11) .NE. '?' .AND.
     1          SPGRNM(2)(1:11) .NE. ' ') THEN
                 IF (IPR(325) .GE. 0) THEN
                   CALL PLA231 (113, 0,  FLOAT(NNNFIT), FLOAT(NNNFIT),
     1               SPGRNM(2)(1:10), ' ')
                 ELSE
                   CALL PLA231 (113, 0,  -999.0, FLOAT(NNNFIT),
     1               SPGRNM(2)(1:10), ' ')
                 END IF
            END IF
          END IF
          IF (JPRLP .EQ. 1) THEN
            IF (IWIN .EQ. 1) THEN
              IF (ABS(ORG(1)) + ABS(ORG(2)) + ABS(ORG(3)) .GT. 0.001)
     1          THEN
                WRITE (PRBUF, 99988, IOSTAT = IOST)
     1            ORG(1), ORG(2), ORG(3)
                VRT = VRT - 0.7
                CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
              END IF
              IF (SPGRNM(2)(1:11) .NE. '?') THEN
                VRT = VRT - 0.5
                IF (NNNFIT .EQ. 100) THEN
                  WRITE (PRBUF, 99990, IOSTAT = IOST)
     1              SPGRNM(2)(1:11), ISGNR
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 2, 2, 1.0, VRT)
                ELSE
                  WRITE (PRBUF, 99986, IOSTAT = IOST)
     1              SPGRNM(2)(1:11), ISGNR
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 6, 2, 1.0, VRT)
                  WRITE (PRBUF, 99962, IOSTAT = IOST)
                  VRT = VRT - 0.7
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 6, 2, 1.0, VRT)
                END IF
              END IF
            END IF
            CALL PLA015 (0, 6)
          END IF
          IF (ISYST .GT. IPR(259)) THEN
            IF (JPRLP .EQ. 2) CALL PLA262 (1)
            WRITE (LU, 99982, IOSTAT = IOST) PAR(291)
          ELSE IF (IPR(259) .NE. 8) THEN
            IF (MLAUE .NE. IPR(258)) THEN
              IF (JPRLP .EQ. 2) CALL PLA262 (1)
              WRITE (LU, 99981, IOSTAT = IOST) DSMAX
            END IF
          END IF
          IF (INVST .EQ. 1) THEN
            IPR(457) = 1
            PAR(291) = MAX (PAR(291), 2.0 * MAX (0.25, DSMAX))
            IF (DSMAX .GT. 0.0) THEN
              IF (JPRLP .EQ. 2) CALL PLA262 (1)
              WRITE (LU, 99980, IOSTAT = IOST) DSMAX
            END IF
          END IF
        END IF
      END DO
      RETURN
99999 FORMAT (/, ':: - Symmetry Elements Preceded by an Asterisk ',
     1        'are New and Indicate', /,
     2        '::   Missed/Pseudosymmetry.',
     3        ':: - Proposed Inversion or (Glide) Planes do NOT Apply',
     4        /, '::   for Chiral Molecules.', /,
     5        ':: - Glide Plane Codes are with Reference ',
     6        'to the Input Cell !!')
99998 FORMAT ('Cell Lattice', 2X, 'a', 7X, 'b', 7X, 'c', 4X,
     1        'Alpha', 3X, 'Beta', 2X, 'Gamma Volume', 1X,
     2        'CrystalSystem Laue')
99997 FORMAT (/, 9X, 'T.R.A.N.S.F.O.R.M.A.T.I.O.N  M.A.T.R.I.X',
     1        ' for CELL and HKL DATA', /, 9X, 62('='),
     2        /, 3X, 'Reduced->Convent', 9X, 'Input->Reduced', 7X,
     3          'T = Input->Convent:    a'' = T a', /, 80('-'))
99996 FORMAT ('(', 3F6.2, ' )   (', 3F6.2, ' )   (', 3F6.2, ' )',
     1         5X, 'Det(T)')
99995 FORMAT ('(', 3F6.2, ' ) X (', 3F6.2, ' ) = (', 3F6.2, ' )',
     1         7X, '=')
99994 FORMAT ('(', 3F6.2, ' )   (', 3F6.2, ' )   (', 3F6.2, ' )',
     1         F10.3)
99993 FORMAT ('Input   ',  A,  F7.3, 2F8.3, 3F7.2, I7, 1X, A, 1X, A)
99992 FORMAT ('Reduced ',' P', F7.3, 2F8.3, 3F7.2, I7)
99991 FORMAT ('Convent ', 2A,  F7.3, 2F8.3, 3F7.2, I7, 1X, A, 1X, A)
99990 FORMAT ('Missed/Additional Symmetry : Suggested SPGR = ', A,
     1        '(No', I4,')')
99989 FORMAT (':: Input ', A, ' Non-Standard Setting is ',
     1        'Alternate for Standard ', A, ' Setting')
99988 FORMAT (':: Origin Shifted to:', F6.3, ',', F6.3, ',', F6.3,
     1        ' after Cell Transformation')
99987 FORMAT ('  Reduced-to-Convent', 7X, 'Input-to-Reduced', 5X,
     3          'T = Input-to-Convent:   a'' = T a')
99986 FORMAT ('Missed/Additional Symmetry (Ignore Nonfit):',
     1        ' Suggested SPGR = ', A, '(No', I4,')')
99985 FORMAT (/, ':: *** No Obvious Extra Crystallographic Symmetry',
     1         ' was Detected ***', /)
99984 FORMAT (/, ':: SpaceGroup = ', A,
     1        ' - No Obvious Spacegroup Change Needed/Suggested', //,
     2           ':: An Alternative Analysis for Missed Symmetry may ',
     3           'be tried with ''CALC NEWSYM''.', /)
99983 FORMAT (':: Input Cell is not Standard/Reduced')
99982 FORMAT (':: Change of Crystal System indicated.',
     1        ' (Maxdev. = ', F6.3, ' Ang.)')
99981 FORMAT (':: Change of Laue Class without change of System',
     1        ' indicated (Maxdev = ', F6.3, ' Ang)')
99980 FORMAT (':: Addition of an Inversion Center Indicated.',
     1        ' (Maxdev. = ', F6.3, ' Ang.)')
99979 FORMAT (/, ':: Lattice Features Additional Metrical Symmetry ',
     1           'not Supported by Contents.')
99978 FORMAT (':: Check for (Approximate/Pseudo) Inversion Symmetry.')
99977 FORMAT (':: Check for (Approximate/Pseudo) Translat. Symmetry.')
99976 FORMAT ('   See e.g. R.E. Marsh, Acta Cryst. (1994). C50,',
     1        ' 1713-1715', /)
99975 FORMAT (/, 10X, 'Conventional, New or Pseudo Symmetry', /,
     1        80('='), /)
99974 FORMAT (A, /)
99973 FORMAT (':: ADDSYM Could Not (Re)Construct Proper Spacegroup')
99972 FORMAT (/, A)
99971 FORMAT (':: Spacegroup: ', A, ' Not Changed but Check ',
     1        'Pseudo-Translations')
99970 FORMAT (':: Note: Rerun in EQUAL Atom Type Mode for more Checks')
99969 FORMAT (1X)
99968 FORMAT ('SPGR ' , A, 68X)
99967 FORMAT (/, ':: Axial Lengths differ by', F6.3, ' Ang.')
99966 FORMAT (/, ':: Cell Angles differ', F5.2, ' Deg. from (90/120)')
99965 FORMAT (/, ':: Origin Shifted to:', F7.4, ',', F7.4, ',', F7.4,
     1        ' after Transformation', //,
     2        '::                      (', 3F8.4, ') (', F8.4, ')', /,
     2        ':: R/t for Coordinates  (', 3F8.4, ') (', F8.4, ')', /,
     2        '::                      (', 3F8.4, ') (', F8.4, ')', /)
99964 FORMAT (80('-'))
99963 FORMAT (':: SpaceGroup = ', A,
     1        ' - No Obvious Spacegroup Change Needed/Suggested')
99962 FORMAT (' *** PLEASE COMPARE with ''CALC ADDSYM EXACT'' ')
99961 FORMAT (/, A, /)
99960 FORMAT (A)
99959 FORMAT (/, 'P! ', A, 5X, A, '=>', 2A, F4.1, 2I3, F6.3, F5.2,
     1        F6.3, 1X, A, I4, '% ', A, /, A, //,
     2        ':: An SPF-style file is written',
     3        ' to be used for the cell transformation.', /)
99958 FORMAT ('LATT ', A, 1X, A, 72X)
      END SUBROUTINE PLA061
      SUBROUTINE PLA062
      PARAMETER (NP20=20)
      COMMON /PL60/ LU, XMISR(3, 3, 15), XMISL(3, 15), XMISG(3, 15),
     1 NMIS(15), RH(3, 3, NP20), ORGM(3), OSHFT(3), OADD(3), FRACT(10),
     2 GLIDE(3), NA(3), DSMAX, NSGTR, NFT, LOOPR, IMETRIC, NFTX,
     3 NCHIR, NCHIRF,  NLCLP, NEWS, NNFIT, NNNFIT, NSV, INVST, NORG,
     4 NORGM, NOINV, NEWLT, NAL112S, NAL110, JERR
      COMMON /PL60C/ FSYM, XSUB, CENT, LATT
      CHARACTER FSYM*3, XSUB*1, CENT*1, LATT*1
      NORG = NORG + 1
      IF (NORG .NE. 0) THEN
        IF (CENT .EQ. 'A') THEN
          OSHFT(3) = OSHFT(3) + OADD(3)
          IF (OSHFT(3) .GT. 0.99) THEN
            OSHFT(3) = 0.0
            OSHFT(2) = OSHFT(2) + OADD(2)
            IF (OSHFT(2) .GT. 0.99) THEN
              OSHFT(2) = 0.0
              OSHFT(1) = OSHFT(1) + OADD(1)
            END IF
          END IF
          IF (OSHFT(1) .LT. 1.0) NORGM = NORG + 1
        ELSE
          IF (LATT .EQ. 'P') THEN
            NORGM = 3
            CALL GEN074 (OSHFT, 1, 3, 0.0)
            OSHFT(NORG) = 0.50
          ELSE IF (LATT .EQ. 'A') THEN
            OSHFT(2) = 0.25
            OSHFT(3) = 0.25
            NORGM    = 1
          ELSE IF (LATT .EQ. 'B') THEN
            OSHFT(1) = 0.25
            OSHFT(3) = 0.25
            NORGM    = 1
          ELSE IF (LATT .EQ. 'C') THEN
            OSHFT(1) = 0.25
            OSHFT(2) = 0.25
            NORGM    = 1
          ELSE IF (LATT .EQ. 'F') THEN
            NORGM = 3
            CALL GEN074 (OSHFT, 1, 3, 0.25)
            OSHFT(NORG) = 0.00
          ELSE IF (LATT .EQ. 'I') THEN
            NORGM = 7
            IF (NORG .EQ. 1) THEN
              CALL GEN074 (OSHFT, 1, 3, 0.25)
            ELSE IF (NORG .GE. 2 .AND. NORG .LE. 4) THEN
              CALL GEN074 (OSHFT, 1, 3, 0.0)
              OSHFT(NORG - 1) = 0.50
            ELSE IF (NORG .GE. 5 .AND. NORG .LE. 7) THEN
              CALL GEN074 (OSHFT, 1, 3, 0.25)
              OSHFT(NORG - 3) = 0.75
            END IF
          ELSE IF (LATT .EQ. 'R') THEN
            IF (NORG .EQ. 1) THEN
              OSHFT(1) = 0.33333
              OSHFT(2) = 0.16667
              OSHFT(3) = 0.16667
              NORGM    = 2
            ELSE
              OSHFT(1) = 0.16667
              OSHFT(2) = 0.33333
              OSHFT(3) = 0.33333
            END IF
          END IF
        END IF
      ELSE
        CALL GEN074 (OSHFT, 1, 3, 0.0)
      END IF
      RETURN
      END SUBROUTINE PLA062
      SUBROUTINE PLA063 (NEWLAT, NLT, NBRAV, NLTX)
      PARAMETER (NP20=20,NP47=9)
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      DIMENSION NEWLAT(NP47), A(3, 20), B(3, 3), C(3, 3)
      COMMON /PL60/ LU, XMISR(3, 3, 15), XMISL(3, 15), XMISG(3, 15),
     1 NMIS(15), RH(3, 3, NP20), ORGM(3), OSHFT(3), OADD(3), FRACT(10),
     2 GLIDE(3), NA(3), DSMAX, NSGTR, NFT, LOOPR, IMETRIC, NFTX,
     3 NCHIR, NCHIRF,  NLCLP, NEWS, NNFIT, NNNFIT, NSV, INVST, NORG,
     4 NORGM, NOINV, NEWLT, NAL112S, NAL110, JERR
C * ADDSYM-NEWLAT SUPPORT - FIND TRANSFORMATION TO SUBLATTICE
C * NEWLAT - ARRAY WITH (NEW) LATTICE POINTS
C * NLT    - NUMBER OF LATTICE POINTS                   (INPUT)
C * NBRAV  - BRAVAIS LATTICE NUMBER                     (INPUT)
C * NLTX   - TRANSFORMATION MATRIX TO PRIMITIVE LATTICE (OUTPUT)
      NLTX = 0
      IF (NLT .LE. NP47 - 3) THEN
        DO I = 1, NLT
          NA(3) = NEWLAT(I)
          NA(1) = NA(3) / 10000
          NA(2) = NA(3) - NA(1) * 10000
          NA(3) = MOD(NA(2), 100)
          NA(2) = NA(2) / 100
          DO J = 1, 3
            IF (NA(J) .LE. 6) THEN
              A(J, I) = FRACT(NA(J))
            ELSE
              A(J, I) = FRACT(NA(J)) - 1.0
            END IF
          END DO
        END DO
        L = NLT
        DO I = 1, 3
          L = L + 1
          DO J = 1, 3
            A(J, L) = TRNSX(I, J, NBRAV)
          END DO
        END DO
C * FIND 3 THREE VECTORS THAT SPAN A LATTICE WITH SMALLEST DETERMINANT
        DETMIN = 1.0
        DO I = 1, L - 2
          DO N = 1, 3
            B(1, N) = A(N, I)
          END DO
          DO J = I + 1, L - 1
            DO N = 1, 3
              B(2, N) = A(N, J)
            END DO
            DO K = J + 1, L
              DO N = 1, 3
                B(3, N) = A(N, K)
              END DO
              CALL GEN003 (B, C, DET, 0)
              IF (DET .NE. 0.0) THEN
                IF (ABS(DET) .LT. DETMIN) THEN
                  DETMIN = ABS(DET)
                  NLTX = 128
                  DO N = 1, 3
                    IF (N .EQ. 1 .AND. DET .LT. 0.0) THEN
                      IS = -1
                    ELSE
                      IS = 1
                    END IF
                    DO M = 1, 3
                      TRNSX(N, M, NLTX) = B(N, M) * IS
                    END DO
                  END DO
                END IF
              END IF
            END DO
          END DO
        END DO
      END IF
      RETURN
      END SUBROUTINE PLA063
      SUBROUTINE PLA064 (NEWLAT)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP20=20,NP38=150,NP39=30,NP47=9,NP52=200,
     2 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /PL60/ LU, XMISR(3, 3, 15), XMISL(3, 15), XMISG(3, 15),
     1 NMIS(15), RH(3, 3, NP20), ORGM(3), OSHFT(3), OADD(3), FRACT(10),
     2 GLIDE(3), NA(3), DSMAX, NSGTR, NFT, LOOPR, IMETRIC, NFTX,
     3 NCHIR, NCHIRF,  NLCLP, NEWS, NNFIT, NNNFIT, NSV, INVST, NORG,
     4 NORGM, NOINV, NEWLT, NAL112S, NAL110, JERR
      COMMON /PL60C/ FSYM, XSUB, CENT, LATT
      CHARACTER FSYM*3, XSUB*1, CENT*1, LATT*1
      DIMENSION NEWLAT(NP47)
      DO I = 1, 3
        GLIDE(I) = MOD (GLIDE(I), 1.0)
        IF (GLIDE(I) .LT. -0.05) GLIDE(I) = GLIDE(I) + 1.0
        YUNK  = 99.0
        NA(I) = -1
        DO J = 1, 10
          IF (ABS(GLIDE(I) - FRACT(J)) .LT. YUNK) THEN
            YUNK   = ABS(GLIDE(I) - FRACT(J))
            NA(I) = J
          END IF
        END DO
      END DO
      NLCP  = NA(1) * 10000 + NA(2) * 100 + NA(3)
      NLCP1 = MAX(1, MOD(12 - NA(1), 11)) * 10000 +
     1        MAX(1, MOD(12 - NA(2), 11)) * 100   +
     2        MAX(1, MOD(12 - NA(3), 11))
      IF (NEWLT .GT. 0) THEN
        DO J = 1, NEWLT
          IF (NEWLAT(J) .EQ. NLCP .OR. NEWLAT(J) .EQ. NLCP1) RETURN
        END DO
      END IF
      IF (NLCP .EQ. 10101) THEN
        FSYM = ' P '
      ELSE
        IF (NLCP .EQ. 10606) THEN
          FSYM = ' A '
        ELSE IF (NLCP .EQ. 60106) THEN
          FSYM = ' B '
        ELSE IF (NLCP .EQ. 60601) THEN
          FSYM = ' C '
        ELSE IF (NLCP .EQ. 60606) THEN
          FSYM = ' I '
        ELSE IF (NLCP .EQ. 40808) THEN
          FSYM = ' R '
        ELSE IF (NLCP .EQ. 60101) THEN
          FSYM = ' X '
        ELSE IF (NLCP .EQ. 10601) THEN
          FSYM = ' Y '
        ELSE IF (NLCP .EQ. 10106) THEN
          FSYM = ' Z '
        ELSE
          FSYM = ' S '
          NAL112S = NAL112S + 1
        END IF
        NSGTR = 1
        IF (NFTX .GT. 0) THEN
          WRITE (LU6, 99998, IOSTAT = IOST)
          WRITE (LU6, 99996, IOSTAT = IOST) LINE(1:75)
          WRITE (LU6, 99995, IOSTAT = IOST)
          WRITE (LU6, 99995, IOSTAT = IOST)
          IF (IGBL(63) .GT. 0) THEN
            CALL PLA262 (4)
            WRITE (LU7, 99998, IOSTAT = IOST)
            WRITE (LU7, 99996, IOSTAT = IOST) LINE(1:75)
            WRITE (LU7, 99995, IOSTAT = IOST)
          END IF
        END IF
        IF (FSYM .NE. ' S ') THEN
C * ALERT _112 - Additional (Pseudo) Symmetry Element Found
          IF (IPR(325) .GE. 0) THEN
            CALL PLA231 (112, 0, FLOAT(NNFIT),
     1        FLOAT(NNFIT), '     '//FSYM, ' ')
          ELSE
            CALL PLA231 (112, 0, -999.0,
     1        FLOAT(NNFIT), '     '//FSYM, ' ')
          END IF
        ELSE IF (NAL112S .EQ. 1) THEN
          CALL PLA231 (112, 0, -999.0,
     1      FLOAT(NNFIT), '     '//FSYM, ' ')
        END IF
        WRITE (PRBUF, 99999, IOSTAT = IOST)
     1    FSYM(1:2), NNFIT, DSMAX, GLIDE
        CALL GEN065 (0, PRBUF, 81, 7)
        WRITE (LU6, 99996, IOSTAT = IOST) PRBUF(1:80)
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99996, IOSTAT = IOST) PRBUF(1:80)
        END IF
        IF (IWIN .EQ. 1 .AND. VRT .GT. 6.0) THEN
          VRT = VRT - 0.5
          IF (NNFIT .EQ. 100) THEN
            NCOL = 2
          ELSE
            NCOL = 6
          END IF
          CALL GGIP09 (0.0, PRBUF, 80, 0.35, NCOL, 2, 1.0, VRT)
        END IF
        WRITE (PRBUF, 99997, IOSTAT = IOST)
     1    NQ3(1:6), NQ4(1:6), DSMAX
        CALL GEN065 (0, PRBUF, 81, 7)
        WRITE (LU6, 99996, IOSTAT = IOST) PRBUF(1:80)
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99996, IOSTAT = IOST) PRBUF(1:80)
        END IF
        IF (IWIN .EQ. 1 .AND. VRT .GT. 6.0) THEN
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, PRBUF, 80, 0.35, NCOL, 2, 1.0, VRT)
        END IF
        IF (NLCLP .EQ. 1) THEN
          IF (NNFIT .GE. (100 - IPR(568) * NINT(PAR(249)))) THEN
            NAL110 = NAL110 + 1
C * ALERT _110 - Report Potential Lattice Centering or Halving
            IF (NAL110 .EQ. 1) THEN
              IF (IPR(325) .GE. 0) THEN
                CALL PLA231 (110, 0, 1.0, 1.0, ' ', ' ')
              ELSE
                CALL PLA231 (110, 0, -999.0, 1.0, ' ', ' ')
              END IF
            END IF
            IF (IPR(503) .EQ. 0 .AND. ((IGBL(3) .EQ. 1 .OR.
     1        IGBL(3) .EQ. 4 .OR. IGBL(3) .EQ. 16) .AND. NNFIT .EQ. 100)
     2        .OR. (IGBL(3) .EQ. 0)) THEN
              NEWLT         = NEWLT + 1
              NEWLAT(NEWLT) = NLCP
              IPR(209)      = 1
              IPR(459)      = 1
              NNFIT         = 100
            END IF
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (A, ' *', 3X,  '(NonSpacegroup) Translation', 8X, I3,
     1        F8.3, 9X, 3F6.3)
99998 FORMAT (/, ':: NonFits (i.e. Atoms with no symmetry related',
     1           ' counterpart):')
99997 FORMAT (36X, 2A, F5.3)
99996 FORMAT (A)
99995 FORMAT (1X)
      END SUBROUTINE PLA064
      SUBROUTINE PLA065 (MODE, MOLX, NATHX, NATHY, X1, X2, X3, X4, DIST)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER MARK*2, IDS1*1, IDS2*1, FORMI*81
      DIMENSION ZMOLX(6), AMOLX(51)
      FORMI( 1:43) = '(I4,'' ['',F9.2,'']'',I8,F11.4,F7.2,4X,I1,1X,A,'
      FORMI(44:81) = '''-'',2A,''... '',2A,''-'',A,I2,3X,A,6F10.2)'
      IF (PAR(42) .LT. 100.0) THEN
        FORMI(13:13) = '1'
        FORMI(80:80) = '1'
      END IF
      N = IPR(49)
      IF (MODE .EQ. 0) THEN
        IPR(49) = 0
      ELSE IF (MODE .LT. 0) THEN
        IF (N .GT. 0 .AND. IPR(149) .LE. 0) THEN
          NSMOL  = IPR(51)
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (8)
            WRITE (LU7, 99999, IOSTAT = IOST) PAR(3), IPR(104)
          END IF
          NI = 0
          DO K = 1, NSMOL
            ML = MOL(K)
            CALL GEN098 (ML, PAR(42), M1, M2, M3, M4, NRES)
            IF (NRES .EQ. 0) THEN
              NRES = IPR(104)
              ML = ML + NRES
            END IF
            IF (NRES .EQ. IPR(104)) THEN
              RMOL = ML / PAR(42)
              DO 10 I = 1, N
                LABN1 = NINT(ABS(BOK(I, 2)))
                LABN2 = NINT(ABS(BOK(I, 3)))
                LABN3 = NINT(ABS(BOK(I, 4)))
                LABN4 = NINT(ABS(BOK(I, 5)))
                MARK  = '  '
                DIJ   = MOD(BOK(I, 1), 100.0)
                ISML  = INT(BOK(I, 1) / 100.0)
                IF (ISML .GT. 0) MARK = ' <'
                IF (ISML .GT. 1) MARK = '<<'
                CALL GEN098 (KBO(I, 1), PAR(42), M1, M2, M3, M4, MRES)
                VMOL = KBO(I, 1) / PAR(42)
                CALL PLA270 (RMOL, VMOL, XMOLX)
                IF (IPR(2) .NE. 0) GO TO 30
                ZMOLX(1) = XMOLX
                IF (BOK(I, 2) .LT. 0) THEN
                  IDS1 = '*'
                ELSE
                  IDS1 = ' '
                END IF
                IF (BOK(I, 3) .LT. 0) THEN
                  IDS2 = '*'
                ELSE
                  IDS2 = ' '
                END IF
                NQ1 = '       '
                NQ2 = '       '
                NQ3 = '       '
                NQ4 = '       '
                LABN1 = - LABA(LABN1)
                CALL PLA047 (LABN1, NQ1, IDUM, IENI, IPR(71),
     1                       IGBL(55), 0, 1 - IGBL(55))
                LABN2 = - LABA(LABN2)
                CALL PLA047 (LABN2, NQ2, IDUM, IENJ, IPR(71),
     1                       IGBL(55), 0, 1 - IGBL(55))
                IF (LABN3 .GT. 0) THEN
                  LABN3 = - LABA(LABN3)
                  CALL PLA047 (LABN3, NQ3, IDUM, IENK, IPR(71),
     1                         IGBL(55), 0, 1 - IGBL(55))
                END IF
                IF (LABN4 .GT. 0) THEN
                  LABN4 = - LABA(LABN4)
                  CALL PLA047 (LABN4, NQ4, IDUM, IENL, IPR(71),
     1                         IGBL(55), 0, 1 - IGBL(55))
                END IF
                SUMRAD = ABS(VDWR(IENI)) + ABS(VDWR(IENJ))
                DEL    = DIJ - SUMRAD
                NSML   = 1
                IF (NSMOL .GT. 1) THEN
                  DO L = 2, NSMOL
                    ML = MOL(L)
                    CALL GEN098 (ML, PAR(42), L1, L2, L3, L4, MLRES)
                    IF (IPR(2) .NE. 0) GO TO 30
                    IF (MLRES .EQ. MRES .AND. NSML .LT. 6) THEN
                      YMOLX = ML / PAR(42)
                      CALL PLA270 (XMOLX, YMOLX, ZMOLX(NSML + 1))
                      IF (IPR(2) .EQ. 52) GO TO 30
                      IF (IPR(2) .EQ. 28) THEN
                        IPR(2) = 0
                      ELSE
                        NSML = NSML + 1
                      END IF
                    END IF
                  END DO
                END IF
                IF (NSML .GT. 1) THEN
                  DO I1 = 1, NSML
                    K1 = NSML + 1
                    DO J1 = I1 + 1, NSML
                      K1 =  K1 - 1
                      IF (ZMOLX(K1) .LT. ZMOLX(K1 - 1))
     1                  CALL GEN018 (ZMOLX(K1), ZMOLX(K1 - 1))
                    END DO
                  END DO
                END IF
                AMOLX(NI + 1) = ZMOLX(1)
                IF (NI .GT. 0) THEN
                  DO I1 = 1, NI
                    IF (AMOLX(I1) .EQ. ZMOLX(1)) GO TO 10
                  END DO
                END IF
                IF (NI .LT. 50) NI = NI + 1
                IF (IGBL(63) .GT. 2) THEN
                  CALL PLA262 (1)
                  WRITE (LU7, FORMI, IOSTAT = IOST)
     1             NI, XMOLX, KBO(I, 2), DIJ, DEL,
     2              KBO(I, 3), NQ3, IDS1, NQ1, IDS2, NQ2, NQ4,
     3            KBO(I, 4), MARK, (ZMOLX(L), L = 1, NSML)
                END IF
   10         CONTINUE
            END IF
          END DO
          IPR(49) = 0
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (4)
            WRITE (LU7, 99997, IOSTAT = IOST) PAR(3)
          END IF
        END IF
      ELSE
        IF (N .GT. 0) THEN
          DO I = 1, N
            IF (KBO(I, 1) .EQ. MOLX) THEN
              KBO(I, 2) = KBO(I, 2) + 1
              IF (MOD(DIST, 100.0) .GT. MOD(BOK(I, 1), 100.0)) THEN
                GO TO 30
              ELSE
                GO TO 20
              END IF
            END IF
          END DO
        END IF
        I = N + 1
        IF (I .GT. NP8) THEN
          IPR(149) = IPR(149) + 1
          GO TO 30
        END IF
        KBO(I, 1) = MOLX
        KBO(I, 2) = 1
        IPR(49)   = IPR(49) + 1
   20   BOK(I, 1) = DIST
        BOK(I, 2) = X1
        BOK(I, 3) = X2
        BOK(I, 4) = X3
        BOK(I, 5) = X4
        KBO(I, 3) = NATHX
        KBO(I, 4) = NATHY
      END IF
   30 RETURN
99999 FORMAT (//, 'Summary of Shortest Inter Contacts with d(I-J) < ',
     1 ' R(I) + R(J) + ', F4.1, ' of Residue #', I3,
     2 ' to Neighbouring ARU''S', /, 132('='), //, 2X,
     3 'Nr', 7X, 'ARU', 4X, 'Nr.Cont.', 3X, 'd(min)', 4X, 'Del',
     4 2X, 'XHn X      - At(I)', 7X, 'At(J)  - Y    YHn  Note', 2X,
     5 'Partaking ARU''s in Close Contact Resd.', /, 132('-'))
99997 FORMAT (/, 'Symbols :: < denotes contacts less than the sum of ',
     1 'the van der Waals Radii and << contacts less than this sum ',
     2 'minus', F4.1, ' Angstrom.',/,
     3 11X, 'Nr.Cont. = Number of short contacts from current ARU to',
     4 ' surrounding ARU''s (from list above).')
      END SUBROUTINE PLA065
      SUBROUTINE PLA066
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IF (IPR(92) .EQ. 0) THEN
        IWIN = 0
        CALL PLA293 (PAR(17))
        IF (IPR(37) .GT. 0) CALL PLA087
        IF (IPR(2) .EQ. 0) THEN
          NSYM = IPR(48)
          NAT  = IPR(37)
          IF (IPR(17) .EQ. 0) THEN
            PAGET = 'INTRA'
            NNAT = 1
            CALL GEN074 (RCG, 1, NP29 * 4, 0.0)
          ELSE
            NNAT = 0
          END IF
   10     IAT    = 0
          IATNF  = 0
          IATHF  = 0
          IATINC = 0
C * BRANCH FOR INTRA (0), INTER/VOID (-1) OR COORDINATION CALCULATIONS (1)
          IF (IPR(17) .EQ. 0) THEN
            MNAT = NNAT
            INXT = 0
            DO N = MNAT, NAT
              CALL GEN048 (-4, IFG(1, N), 15, IVAL)
              IATPRP = IATPR(IEN(IVAL + 1))
              CALL GEN048 (-3, IFG(1, N), 1, IVAL)
              IF (IVAL .GT. 3) THEN
                CALL GEN048 (-1, IFG(2, N), 9, NCONS)
                IF (IATPRP .LT. 0) THEN
                  IF (NCONS .EQ. 1) THEN
                    IAT = N
                    CALL GEN048 (1, IFG(1, IAT), 3, 1)
                    CALL GEN048 (1, IFG(2, IAT), 9, 1)
                    IATINC = 0
                    GO TO 20
                  ELSE
                    IF (IATNF .EQ. 0) IATNF = N
                  END IF
                ELSE
                  IF (NCONS .EQ. 1) THEN
                    IF (IATHF .LE. 0) IATHF = N
                  ELSE
                    IF (IATHF .EQ. 0) IATHF = - N
                  END IF
                END IF
              ELSE IF (IVAL .EQ. 3) THEN
                IF (N .EQ. NNAT) NNAT = NNAT + 1
              ELSE
                IF (INXT .LE. 0) THEN
                  IF (IATPRP .LT. 0) THEN
                    INXT = N
                    CALL GEN048 (-7, IFG(2, N), 1, IPP)
                    IPR(184) = IPPR(IPP + 1, 1)
                  ELSE
                    IF (INXT .EQ. 0) INXT = - N
                    CALL GEN048 (-7, IFG(2, N), 1, IPP)
                    IPR(184) = IPPR(IPP + 1, 1)
                  END IF
                END IF
              END IF
            END DO
            IF (IAT .EQ. 0) THEN
              IF (IATHF .GT. 0) THEN
                IAT = IATHF
                CALL GEN048 (1, IFG(1, IAT), 3, 1)
                CALL GEN048 (1, IFG(2, IAT), 9, 1)
                IATINC = 0
                GO TO 20
              ELSE IF (IATHF .LT. 0) THEN
                IF (IATNF .NE. 0) THEN
                  IAT = IATNF
                ELSE
                  IAT = - IATHF
                END IF
                CALL GEN048 (-7, IFG(2, IABS(IAT)), 1, IPP)
                IF (IPPR(IPP + 1, 1) .EQ. 1000) THEN
                  IF (IPR(124) .EQ. 0) THEN
                    CALL GEN048 (-4, IFG(1, IABS(IAT)), 15, IVAL)
                    IF (IATPR(IEN(IVAL + 1)) .NE. 5) THEN
                      IPR(124) = 1
                    ELSE
                      IPR(124) = -1
                    END IF
                  END IF
                ELSE
                  IPR(124) = -1
                END IF
                CALL GEN048 (1, IFG(1, IAT), 3, 1)
                CALL GEN048 (1, IFG(2, IAT), 9, 1)
                IATINC = 0
                GO TO 20
              ELSE
                IF (IATNF .NE. 0) THEN
                  IAT = IATNF
                  CALL GEN048 (-7, IFG(2, IAT), 1, IPP)
                  IF (IPPR(IPP + 1, 1) .EQ. 1000) THEN
                    IF (IPR(124) .EQ. 0) THEN
                      CALL GEN048 (-4, IFG(1, IABS(IAT)), 15, IVAL)
                      IF (IATPR(IEN(IVAL + 1)) .NE. 5) THEN
                        IPR(124) = 1
                      ELSE
                        IPR(124) = -1
                      END IF
                    END IF
                  ELSE
                    IPR(124) = -1
                  END IF
                  CALL GEN048 (1, IFG(1, IAT), 3, 1)
                  CALL GEN048 (1, IFG(2, IAT), 9, 1)
                  IATINC = 0
                  GO TO 20
                END IF
              END IF
              IF (IPR(75) .GT. 0) THEN
                ICG  = IPR(39) + IPR(24) + 1
                KAT1 = ICG  + 1
                ICG1 = KAT1 + 1
                DO J = 1, 3
                  IF (RCG(4, IPR(75)) .NE. 0.0)
     1              RCG(J, IPR(75)) = RCG(J, IPR(75)) / RCG(4, IPR(75))
                  XXO(ICG,  J) = RCG(J, IPR(75))
                  XXO(KAT1, J) = PAR(63 + J)
                  XSD(ICG,  J) = 0.0
                  XSD(KAT1, J) = 0.0
                END DO
                IATP(ICG) = 1555
                IF (IGBL(30) .EQ. 0) THEN
                  DUM5 = 99999.0
                  CALL PLA059 (KAT1, KAT1)
                  DO J = 1, NSYM
                    IPR(54) = J
                    DO L = 1, 3
                      ITR(L) = 0
                    END DO
                    CALL PLA059 (ICG, ICG1)
                    DO L = 1, 3
                      DUM1 = MOD(XXO(ICG1, L), 1.0)
                      IF (DUM1 .LT. 0.0) DUM1 = DUM1 + 1.0
                      ITR(L)       = NINT(DUM1 - XXO(ICG1, L))
                      XXO(ICG1, L) = DUM1
                    END DO
                    CALL PLA059 (ICG1, ICG1)
                    CALL PLA050 (ICG1, KAT1, 0, 0, DUM4)
                    IF (DUM4 .LT. DUM5) THEN
                      DUM5  = DUM4
                      FN(1) = J
                      DO L = 1, 3
                        FN(L + 1) = ITR(L)
                      END DO
                    END IF
                  END DO
                  YM1  = FN(1) * 1000 + FN(2) * 100.0 + FN(3) * 10.0 +
     1                   FN(4) + 555 + IPR(75) / PAR(42)
                  CALL PLA270 (YM1, 0.0, YMM1)
                  DO I = 1, ICG
                    CALL GEN048 (-6, IFG(1, I), 9, JJRES)
                    IF (IPR(75) .EQ. JJRES) THEN
                      ITRNS = NINT(FN(1) * 1000 + 555)
                      DO L = 1, 3
                        XXO(KAT1, L) = XXO(I, L)
                        XSD(KAT1, L) = XSD(I, L)
                        ITR(L)       = NINT(FN(L + 1))
                        IF (IABS(ITR(L)) .GT. 4) THEN
                          CALL PLA047 (LABA(KAT1), NQ1, IDUM,
     1                      JDUM, 0, IGBL(55), 0, 0)
                          IPR(2) = 17
                          GO TO 30
                        END IF
                        ITRNS = ITRNS + ITR(L) * 10**(3 - L)
                      END DO
                      IF (ITRNS .NE. 1555) THEN
                        IF (I .LT. ICG) WRITE (LU4) 5, LABA(I),
     1                     (FN(L), L = 1, 8)
                        IPR(54) = NINT(FN(1))
                        CALL PLA059 (KAT1, I)
                      END IF
                      YM2 = IATP(I)
                      CALL PLA270 (YM1, YM2, YM3)
                      IATP(I) = NINT(YM3)
                      CALL GEN048 (1, IFG(1, I), 2, 1)
                    END IF
                  END DO
                  L2 = IPR(13)
                  DO L = 1, L2
                    ML = MOL(L)
                    CALL GEN098 (ML, PAR(42), MOL1, MOL2, MOL3, MOL4,
     1                           JJRES)
                    IF (IPR(75) .EQ. JJRES) THEN
                      IF (MOL1 .GT. IPR(48)) THEN
                        MOL0 = NINT(IPR(48) * 1000.0 * PAR(42))
                      ELSE
                        MOL0 = 0
                      END IF
                      ML  = ML - MOL0
                      YM3 = ML / PAR(42)
                      CALL PLA270 (YM1, YM3, YM2)
                      CALL PLA270 (YM2, YMM1, YM3)
                      MOL(L) = NINT(YM3 * PAR(42)) + MOL0
                    END IF
                  END DO
                END IF
              END IF
C * BEGIN A NEW RESIDUE ?
              IF (INXT .NE. 0) THEN
                IAT     = IABS(INXT)
                IPR(75) = IPR(75) + 1
                IF (IPR(75) .GT. IPR(129)) THEN
                  IPR(75)  = IPR(129)
                  IPR(130) = 1
                END IF
                CALL GEN048 (6, IFG(1, IAT), 9, IPR(75))
                CALL PLA070 (IAT)
                IF (IPR(2) .NE. 0) THEN
                  CALL PLA047 (LABA(IAT), NQ1, IDUM, JDUM,
     1              IPR(71), IGBL(55), 0, 0)
                  GO TO 30
                ELSE
                  IPR(166) = IABS(IATP(IAT))
                  CALL GEN048 (1, IFG(1, IAT), 3, 1)
                  CALL GEN048 (1, IFG(2, IAT), 9, 1)
                  IATINC = 0
                  GO TO 20
                END IF
              ELSE
                CALL PLA071 (IPR(110))
                IF (IPR(2) .NE. 0) RETURN
                DO I = 1, IPR(13)
                  MOLS(I) = MOL(I)
                END DO
                IPR(53) = IPR(13)
                GO TO 30
              END IF
            END IF
            CALL GEN048 (1, IFG(1, IAT), 3, 1)
            CALL GEN048 (1, IFG(2, IAT), 9, 1)
            IATINC = 0
            GO TO 20
          ELSE IF (IPR(17) .LT. 0) THEN
            IPR(13) = IPR(51)
            IF (IPR(189) .NE. 0) THEN
              IF (IPR(210) .EQ. 0 .OR. IPR(210) .EQ. 1) CALL PLA125
              GO TO 30
            END IF
          ELSE IF (IPR(17) .GT. 0) THEN
            IF (IPR(168) .GT. 0) THEN
              IAT    = IPR(168)
              IATINC = 0
              GO TO 20
            ELSE
              IPR(13) = IPR(51)
              IATINC  = 1
              GO TO 20
            END IF
          END IF
          IATINC = 1
   20     DO
            IF (IATINC .NE. 0) THEN
              IAT = IAT + 1
              IF (IAT .GT. NAT) EXIT
            END IF
            CALL GEN048 (-4, IFG(1, IAT), 15, IPR(58))
            IPR(509) = IEN(IPR(58) + 1)
            CALL GEN048 (-7, IFG(2, IAT), 1, IPP)
            IPR(128) = IPPR(IPP + 1, 1) * IPPR(IPP + 1, 3) / NSYM
            IPR(119) = IPPR(IPP + 1, 1)
            IF (IPR(119) .LT. 1000) THEN
              IPR(98) = 1 - IPR(502) * IABS(IPR(17))
              CALL GEN048 (-5, IFG(3, IAT), 14, IVL)
              IPR(661) = IVL - 16
            ELSE
              IPR(98) = 0
            END IF
            CALL GEN048 (-6, IFG(1, IAT), 9, IPR(61))
            PAR(19) = RADR(IPR(58) + 1, 2) + PAR(1)
            IF (IPR(17) .EQ. 0) THEN
              IATPRI = IATPR(IPR(509))
              CALL PLA041 (IATPRI, 0)
            ELSE IF (IPR(17) .LT. 0) THEN
              IF (IPR(104) .NE. IPR(61)) THEN
                IATINC = 1
                GO TO 20
              END IF
            ELSE IF (IPR(17) .GT. 0) THEN
              IF (IPR(168) .EQ. 0) THEN
                IF (RADR(IPR(58) + 1, 2) .LT. 0.001) THEN
                  IATINC = 1
                  GO TO 20
                END IF
              ELSE IF (IPR(168) .EQ. IAT) THEN
                PAR(19) = PAR(68)
              ELSE
                IATINC = 1
                GO TO 20
              END IF
              IPR(13) = IPR(51)
              IPR(24) = 0
              IPR(79) = 0
            END IF
C * START LOOP OVER JAT-(AND SYMMETRY RELATED) ATOMS
            CALL PLA067 (IAT, KAT)
            IF (IPR(2) .NE. 0) GO TO 30
C * END OF LOOP ON ATOMS JAT
C * BRANCH FOR INTER, INTRA OR COORDN CALCULATION
            IF (IPR(17) .EQ. 0) THEN
              IF (IPR(203) .EQ. 0) THEN
                DO JJ = 1, 3
                  RCG(JJ, IPR(75)) = RCG(JJ, IPR(75)) + XXO(IAT, JJ)
                END DO
                RCG(4, IPR(75)) = RCG(4, IPR(75)) + 1
              END IF
              GO TO 10
            ELSE IF (IPR(17) .GT. 0) THEN
              IF (IPR(138) .EQ. 0) THEN
                IF (IPR(57) .NE. 2) THEN
                  CALL PLA078 (IAT)
                ELSE
                  CALL PLA144 (1, IAT)
                END IF
              ELSE
                WRITE (LU6, 99999, IOSTAT = IOST) NP11
                IPR(138) = 0
                IF (IPR(168) .EQ. 0) THEN
                  RADR(IPR(58) + 1, 2) = RADR(IPR(58) + 1, 2) - 1.0
                ELSE
                  PAR(68) = PAR(68) - 1.0
                END IF
                IAT = IAT - 1
              END IF
              IF (IPR(168) .GT. 0) EXIT
            END IF
          END DO
C * END OF LOOP ON IAT, ALL ATOMS PROCESSED
          IF (IPR(17) .LT. 0) THEN
            IF (IPR(90) .EQ. 1) THEN
              CALL PLA065 (-1, 0, 0, 0, 0.0, 0.0, 0.0, 0.0, 0.0)
              IF (IPR(2) .NE. 0) GO TO 30
            END IF
            IPR(104) = IPR(104) + 1
            IF (IPR(104) .LE. IPR(75)) THEN
              IAT     = 0
              IPR(15) = - IABS(IPR(15))
              IATINC  = 1
              GO TO 20
            END IF
            IF (IPR(90) .GT. 0) CALL PLA043 (0, 1, LU7, 0)
            IF (IPR(149) .EQ. 0) THEN
              CALL PLA091 (1)
              IF (IPR(2) .NE. 0) GO TO 30
            END IF
            CALL PLA089
            IF (IPR(149) .EQ. 0 .AND. IPR(300) .GT. 0) THEN
              CALL PLA091 (0)
              IF (IPR(2) .NE. 0) GO TO 30
              CALL PLA092
            END IF
          END IF
        END IF
      ELSE
        IPR(2) = 10
      END IF
   30 IF (IWIN .EQ. 1) THEN
        IF (IPR(168) .EQ. 0 .AND. IPR(326) .LT. 2) CALL PLA297 (0)
        IF (IPR(189) .NE. 0 .AND. IPR(121) .EQ. 0 .AND.
     1      IABS(IPR(326)) .NE. 1) CALL PLA280 ('RESTART')
      END IF
      IF (IPR(17) .EQ. 0 .AND. IPR(37) .GT. 100) IGBL(75) = 0
      RETURN
99999 FORMAT (/, ':: ARU-LIST Overflow (', I3, '), Radius Reduced', /)
      END SUBROUTINE PLA066
      SUBROUTINE PLA067 (IAT, KAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER CSCRAT*1
      P23K = 0.0
      NSYM = IPR(48)
      NAT  = IPR(37)
      DO K = 1, 3
        INDX           = IPR(33 + K)
        V7(INDX)       = XXO(IAT, K)
        DUMA(INDX + 3) = PAR(112 + K)
      END DO
      IPR(203) = 0
   10 KAX      = -1
      IPR(80)  = 0
   20 DO
        IF (KAX .EQ. 0) THEN
          GO TO 40
        ELSE IF (KAX .GT. 0) THEN
          KAX = KAX - 1
          GO TO 60
        END IF
        IPR(54) = 0
   30   IPR(54) = IPR(54) + 1
        KAX     = -1
        IF (IPR(54) .GT. NSYM) THEN
          IF (IPR(17) .EQ. 0) THEN
            IF (IPR(80) .NE. 0) GO TO 10
            CALL GEN048 (3, IFG(1, IAT), 1, 3)
          END IF
          RETURN
        END IF
        JAT = 0
   40   JAT = JAT + 1
        IF (JAT .GT. NAT) GO TO 30
        IF (IPR(189) .NE. 0) THEN
          CALL GEN048 (-1, IFG(2, JAT), 27, IOMT)
          IF (IOMT .NE. 0) GO TO 40
        ELSE
          CALL GEN048 (-7, IFG(2, JAT), 1, JPP)
          IPR(120) = IPPR(JPP + 1, 1)
          CALL GEN048 (-5, IFG(3, JAT), 14, IVL)
          IPR(662) = IVL - 16
        END IF
        CALL GEN048 (-10, IFG(1, JAT), 9, IHLP)
        IPR(59)  = IHLP / 64
        IPR(62)  = MOD(IHLP, 64)
        PAR(23)  = PAR(19)
        PAR(293) = 0.0
        IPR(510) = IEN(IPR(59) + 1)
        IF (IPR(17) .GT. 0) THEN
          IF (IPR(57) .NE. 0) THEN
            IF (RADR(IPR(59) + 1, 2) .LT. 0.001) GO TO 40
          END IF
        ELSE IF (IPR(17) .EQ. 0) THEN
          IF (IPR(509) * IPR(510) .EQ. 1) GO TO 40
          IATPRJ = IATPR(IPR(510))
          IF (IPR(119) .LT. 1000 .AND. IPR(120) .LT. 1000) THEN
            IF (IATPR(IPR(509)) .EQ. -7 .AND. IATPRJ .EQ. -7) GO TO 40
          END IF
          CALL PLA041 (IATPRJ, 1)
          IF (IPR(62) .NE. 0) THEN
            IF (IPR(62) .NE. IPR(61)) THEN
              GO TO 40
            END IF
          END IF
          IF (IPR(509) .EQ. 3 .AND. IPR(510) .EQ. 1)
     1      PAR(23) = PAR(23) - 0.15
        END IF
        IF (IPR(17) .LE. 0) THEN
          PAR(23) = PAR(23) + RADR(IPR(59) + 1, 2) + PAR(293)
          YUNK    = GEN128 (IPR(509), IPR(510))
          IF (YUNK .LT. -9.0) THEN
            PAR(23) = 2.0
          ELSE
            PAR(23) = PAR(23) + YUNK
          END IF
        END IF
        P23K = PAR(23)**2
        DO I = 1, 3
          DUMA(I) = DUMA(I + 3) * PAR(23)
          ITR(I)  = 0
        END DO
        IF (IPR(27) .EQ. 1) THEN
          IPR(26) = 1555
          KAT     = JAT
          KAX     = 0
          GO TO 80
        END IF
        DO I = 1, 3
          XJS(I + 3) = 0.0
          XJS(I)     = XXO(JAT, I)
        END DO
        CALL SGSM (CSCRAT, IPR(54), XJS, LU7, 3, IERR)
        DO I = 1, 3
          XJS(IPR(33 + I)) = XJS(I + 6)
        END DO
        KAX = 1
   50   IF (V7(KAX) - XJS(KAX) .LE. DUMA(KAX)) THEN
          XJS(KAX) = XJS(KAX) - 1.0
          GO TO 50
        END IF
   60   XJS(KAX) = XJS(KAX) + 1.0
        IF (V7(KAX) - XJS(KAX) .LT. DUMA(KAX)) THEN
          IF (XJS(KAX) - V7(KAX) .LE. DUMA(KAX)) GO TO 70
          KAX = KAX - 1
          IF (KAX .LE. 0) GO TO 40
        END IF
        GO TO 60
   70   KAX = KAX + 1
        IF (KAX .LT. 4) GO TO 50
        NPOW    = 1000
        IPR(26) = IPR(54) * NPOW + 555
        DO J = 1, 3
          NPOW       = NPOW / 10
          TEMP       = XJS(IPR(33 + J))
          ITR(J)     = ITR(J) + NINT(TEMP - XJS(J + 6))
          XJS(J + 6) = TEMP
          IF (IABS(ITR(J)) .GT. 4) THEN
            IPR(494) = IPR(494) + 1
            GO TO 20
          END IF
          IPR(26)    = IPR(26) + ITR(J) * NPOW
        END DO
        KAT = IPR(39) + IPR(24) + 1
        IF (KAT .GT. NP1 - IPR(75)) THEN
          IPR(2) = 1
          RETURN
        END IF
        IF (IPR(189) .EQ. 0) THEN
          DO I = 1, 3
            XJX(I) = XSD(JAT, I)
          END DO
          NSMM = - IPR(54)
          CALL SGSM (CSCRAT, NSMM, XJX, LU7, 3, IERR)
        END IF
        DO N = 1, 3
          J   = 4 - N
          JP3 = J + 3
          IF (JAT .NE. KAT) THEN
            XXO(KAT, J) = XJS(J + 6)
            XSD(KAT, J) = XJX(J + 6)
          END IF
          XXO(KAT, JP3) = 0
          XSD(KAT, JP3) = 0
          DO L = J, 3
            ORJK = OR(J, L)
            XXO(KAT, JP3) = XXO(KAT, JP3) + XXO(KAT, L) * ORJK
            IF (IPR(189) .EQ. 0) THEN
              IF (IPR(72) .NE. 0) THEN
                XSD(KAT, JP3) = XSD(KAT, JP3)
     1                        + XSD(KAT, L) * ORJK**2
              END IF
            END IF
          END DO
        END DO
   80   DIJK = (XXO(IAT, 4) - XXO(KAT, 4))**2 +
     1         (XXO(IAT, 5) - XXO(KAT, 5))**2 +
     2         (XXO(IAT, 6) - XXO(KAT, 6))**2
        IF (DIJK .LE. P23K) THEN
          DIJ = SQRT(DIJK)
          IF (IPR(189) .EQ. 0) THEN
            IF (IPR(26) .EQ. 1555 .AND. IAT .EQ. JAT) GO TO 20
            CALL GEN048 (-1, IFG(1, JAT), 23, IVAL)
            CALL GEN048 (-1, IFG(2, JAT), 28, IVAL1)
            IPR(63) = IVAL + IVAL1 * IGBL(56)
            IF (IPR(17) .EQ. 0) THEN
              IPOPTEST = 1000
            ELSE
              IPOPTEST = 500
            END IF
            IF (IPR(120) .LT. IPOPTEST) THEN
              IPR(99) = 1 - IPR(502) * IABS(IPR(17))
            ELSE
              IPR(99) = 0
            END IF
            IF (IPR(98) + IPR(99) .EQ. 2) THEN
              IF (IPR(17) .EQ. 0) THEN
                IF (IPR(661) .LT. 0 .AND. IPR(662) .NE. 0) THEN
                  IF (IPR(54) .GT. 1) GO TO 20
                END IF
                IF (ABS(IPR(119) - IPR(120)) .GT. 1) THEN
                  IF (2 * IPR(120) .NE. IPR(119)) GO TO 20
                END IF
                IF (IPR(119) .EQ. 500 .AND. IPR(120) .EQ. 500) THEN
                  IF (ABS(IPR(661)) .GT. 0 .AND. ABS(IPR(662)) .GT. 0)
     1              THEN
                      IF (ABS(IPR(661)) .NE. ABS(IPR(662))) GO TO 20
                  END IF
                  IF (IPR(54) .NE. 1) GO TO 20
                END IF
                CALL GEN048 (6, IFG(1, JAT), 9, IPR(75))
                CALL GEN048 (-1, IFG(1, JAT), 1, IBT1)
                CALL GEN048 (-1, IFG(1, JAT), 2, IBT2)
                IF (IBT2 .EQ. 0 .AND. IBT1 .EQ. 0) THEN
                  IF (ABS(IPR(119) - IPR(120)) .GT. 1) THEN
                    CALL GEN048 (3, IFG(1, JAT), 1, 6)
                  END IF
                ELSE IF (IPR(26) .EQ. 1555) THEN
                  CALL GEN048 (1, IFG(2, JAT), 9, 1)
                  IF (IBT1 .EQ. 0) CALL GEN048 (1, IFG(1, JAT), 3, 1)
                END IF
              END IF
              IF (ABS(IPR(119) - IPR(120)) .GT. 1) THEN
                IF (IPR(119) .LT. 500 .AND. IPR(120) .LT. 500) THEN
                  IF (IABS(2 * IPR(119) - IPR(120)) .GT. 1 .AND.
     1              IABS(2 * IPR(120) - IPR(119)) .GT. 1) GO TO 20
                ELSE IF (IPR(119) + IPR(120) .GE. 999) THEN
                  GO TO 20
                END IF
              END IF
              IF (IPR(154) .EQ. 0) THEN
                IF (IPR(128) .EQ. 500 .AND. IPR(54) .GT. 1) GO TO 20
              END IF
            END IF
            IF (IPR(17) .NE. 0) THEN
              IPR(20) = 1
              IARU    = NINT(PAR(42))
              IF (IPR(61) .EQ. IPR(62)) THEN
                IF (IPR(26) .NE. 1555) THEN
                  CALL GEN048 (-1, IFG(1, JAT), 6, JSP)
                  IF (JSP .EQ. 1) THEN
                    IF (IPR(17) .LT. 0) THEN
                     DO L = 1, IPR(37)
                         CALL PLA050 (L, KAT, 0, 0, DST)
                        IF (DST .LT. 0.001) GO TO 20
                      END DO
                    END IF
                  END IF
                END IF
                NITJ = IPR(26) * IARU
                IF (NITJ .NE. 1555 * IARU) NITJ = NITJ + IPR(62)
                N51 = IPR(51)
                DO L = 1, N51
                  MOLL = MOL(L)
                  IF (L + IPR(101) .GT. N51)
     1              MOLL = MOLL - NSYM * 1000 * IARU
                  IF (MOLL .EQ. NITJ) THEN
                    IF (L + IPR(101) .GT. N51) GO TO 20
                    IPR(20) = 0
                    EXIT
                  END IF
                END DO
              END IF
            END IF
            IF (IPR(17) .LT. 0) THEN
              PAR26 = REL(IPR(509)) + REL(IPR(510))
              IF (IPR(510) .EQ. 3 .AND. IPR(509) .EQ. 1) THEN
                PAR26 = PAR26 + 0.25
              ELSE IF (IPR(509) * IPR(510) .EQ. 1) THEN
                PAR26 = 0.1
              ELSE
                PAR26 = PAR26 + PAR(2)
              END IF
            ELSE
              PAR26 = PAR(18)
            END IF
            IF (IPR(27) .NE. 0 .OR. DIJ .GT. PAR26) THEN
              CALL PLA068 (IAT, JAT, KAT, DIJ)
            END IF
            IF (IPR(2) .NE. 0) RETURN
          ELSE
            IF (DIJ .GT. PAR(23) - PAR(20)) THEN
              IPR(199) = -1
              GO TO 20
            ELSE
              IPR(199) = 1
              RETURN
            END IF
          END IF
        END IF
      END DO
      END SUBROUTINE PLA067
      SUBROUTINE PLA068 (IAT, JAT, KAT, DIATKAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
C * SUBROUTINE HANDLES SHORT INTRA, INTER AND COORDINATION DISTANCES FOUND
      IDS  = 0
      IAUX = 0
      NAT  = IPR(39)
      IARU = NINT(PAR(42))
C * DECIDE WHAT TO DO WITH THIS CONNECTION (INTRA, INTER, COORDN)
C * INTRA MODE
      IF (IPR(17) .EQ. 0) THEN
        IF (IPR(509) .EQ. 1 .OR. IPR(510) .EQ. 1) THEN
          IF (DIATKAT .GT. PAR(461)) RETURN
        END IF
C * DECIDE TO MOVE ATOM JAT OR NOT
        CALL GEN048 (-1, IFG(1, JAT), 7, JHAT)
        IF (JHAT .EQ. 1) THEN
          IF (IPR(509) .EQ. 2) THEN
            CALL GEN048 (-1, IFG(3, JAT), 6, IVAL)
            IF (IVAL .EQ. 0) THEN
              CALL GEN048 (-6, IFG(1, JAT), 9, IYK)
              IF (IYK .EQ. 0) THEN
                CALL GEN048 (-1, IFG(2, JAT), 10, IESD)
                IPR(474) = IPR(474) + IESD
              END IF
            END IF
          END IF
        END IF
        CALL GEN048 (6, IFG(1, JAT), 9, IPR(75))
        CALL GEN048 (-1, IFG(1, JAT), 1, IBT1)
        CALL GEN048 (-1, IFG(1, JAT), 2, IBT2)
        IF (IBT2 .EQ. 1 .AND. IPR(26) .EQ. 1555) THEN
          CALL GEN048 (1, IFG(2, JAT), 9, 1)
        END IF
        IF (IBT1 .EQ. 0) CALL GEN048 (1, IFG(1, JAT), 3, 1)
        CALL GEN048 (-1, IFG(1, JAT), 3, IBT3)
        IF (IBT2 .EQ. 0) THEN
          IF (IPR(99) .NE. 0) THEN
            IF (IPR(26) .NE. IPR(166)) THEN
              IF (IBT1 .EQ. 0) CALL GEN048 (1, IFG(1, JAT), 3, 0)
              RETURN
            END IF
          END IF
          CALL GEN048 (1, IFG(1, JAT), 2, 1)
          CALL GEN048 (1, IFG(2, JAT), 9, 1)
          IF (IPR(157) .GE. 0 .AND. IPR(158) .LT. 0) IPR(203) = 1
          IF (IATP(JAT) .LE. 0) IATP(JAT) = 1555
          IF (IPR(26) .NE. 1555) THEN
            DO L = 1, 6
              XXO(JAT, L) = XXO(KAT, L)
              XSD(JAT, L) = XSD(KAT, L)
            END DO
            FN(1) = IPR(54)
            ITRNS = IPR(54) * 1000 + 555
            DO L = 2, 4
              FN(L) = ITR(L - 1)
              ITRNS = ITRNS + ITR(L - 1) * 10**(4 - L)
            END DO
            IATP(JAT) = ITRNS
            WRITE (LU4) 5, LABA(JAT), (FN(L), L = 1, 8)
          END IF
          KAT     = JAT
          IPR(80) = 1
          RETURN
        END IF
      ELSE IF (IPR(17) .LT. 0) THEN
        IF (IPR(120) .LT. 1000) THEN
          CALL PLA050 (IAT, JAT, 0, 0, DIATJAT)
          CALL PLA050 (JAT, KAT, 0, 0, DJATKAT)
          IF (DIATJAT .LT. 1.8) THEN
            IF (DJATKAT .GT. 0.0001 .AND. DJATKAT .LT. 1.8) RETURN
          END IF
        END IF
        N51    = IPR(51)
        N511   = N51 - IPR(101)
        MOL511 = (IPR(48) * 1000 + IPR(26)) * IARU + IPR(62)
        DO K = 1, N51
          IF (K .GT. N511) THEN
            IF (MOL(K) .EQ. MOL511) RETURN
          END IF
          MOLK = MOL(K) / IARU
          IRES = MOL(K) - MOLK * IARU
          IF (MOLK .EQ. IPR(26)) THEN
            IF (IRES .EQ. 0 .OR. IPR(62) .EQ. IRES) THEN
              DO N = 1, NAT
                CALL PLA050 (N, KAT, 0, 0, D)
                IF (D .LT. PAR(18)) THEN
                  KAT = N
                  IF (IPR(61) .NE. IPR(62)) THEN
                    CALL PLA069 (IAT, JAT, KAT, NAT, IAUX, DIATKAT)
                    RETURN
                  ELSE
                    CALL GEN048 (-1, IFG(1, JAT), 23, JATDOAC)
                    NCIAT = - NINT(CON(IAT, NP4))
                    IF (NCIAT .LT. 0) NCIAT = NP4
                    NCKAT = - NINT(CON(KAT, NP4))
                    IF (NCKAT .LT. 0) NCKAT = NP4
                    DO MIAT = 1, NCIAT
                      LIAT = NINT(CON(IAT, MIAT))
                      IF (LIAT .LE. NP1) THEN
                        CALL GEN048 (-1, IFG(1, LIAT), 19, LIMET)
C * SKIP 1-BOND CONTACTS
                        IF (LIAT .EQ. KAT) RETURN
                        CALL GEN048 (-4, IFG(1, LIAT), 15, NOLI)
                        IF (MOD(IATPR(IEN(NOLI + 1)), 7) .LT. 5) THEN
                          DO MKAT = 1, NCKAT
                            LKAT = NINT(CON(KAT, MKAT))
                            IF (LKAT .LE. NP1) THEN
                              CALL GEN048 (-4, IFG(1, LKAT), 15, NOLK)
                              KAL = MOD(IATPR(IEN(NOLK + 1)), 7)
C * SKIP 2-BOND CONTACTS (1-3 CONTACTS NOT INVOLVING C,N etc)
                              IF (LIAT .EQ. LKAT) THEN
                                IF (LIMET .NE. 0) CALL PLA069 (IAT, JAT,
     1                            KAT, NAT, IAUX, DIATKAT)
                                RETURN
                              ELSE
                                NCLKAT = - NINT(CON(LKAT, NP4))
                                IF (NCLKAT .LT. 0) NCLKAT = NP4
                                DO MLKAT = 1, NCLKAT
                                  LLKAT = NINT(CON(LKAT, MLKAT))
C * SKIP 3-BOND CONTACTS
                                  IF (LLKAT .EQ. LIAT) THEN
                                    IF ((KAL .LT. 5 .AND. LIMET .EQ. 0)
     1                                .OR. JATDOAC .EQ. 1) THEN
                                      CALL PLA069 (IAT, JAT, KAT, NAT,
     1                                  IAUX, DIATKAT)
                                    END IF
                                    RETURN
                                  END IF
                                END DO
                              END IF
                            END IF
                          END DO
                        END IF
                      END IF
                    END DO
                    CALL PLA069 (IAT, JAT, KAT, NAT, IAUX, DIATKAT)
                    RETURN
                  END IF
                END IF
              END DO
              RETURN
            END IF
          END IF
        END DO
      END IF
      IF (IPR(17) .GE. 0) THEN
        NTOT = IPR(39) + IPR(24)
        DO I = 1, NTOT
          CALL PLA050 (I, KAT, 0, 0, D)
          IF (D .LT. PAR(18)) THEN
            KAT = I
            IF (IPR(17) .GT. 0) THEN
              NCX  = IPR(79)
              KATX = KAT + IPR(20) * NP1
              DO L = 1, NCX
                IF (KATX .EQ. IATC(L)) RETURN
              END DO
            END IF
            CALL PLA069 (IAT, JAT, KAT, NAT, IAUX, DIATKAT)
            RETURN
          END IF
        END DO
        IF (IPR(17) .EQ. 0) THEN
          IF (IPR(98) + IPR(99) .GT. 0) THEN
            IF (DIATKAT + 2 * PAR(2) .LE. PAR(23))
     1         IDS = IPR(154) * IPR(48) * 1000 * IARU
          END IF
          GO TO 10
        END IF
      END IF
      IPR(24) = IPR(24) + 1
      IAUX    = 1
      DO I = 1, 3
        IFG(I, KAT) = IFG(I, JAT)
      END DO
      CALL GEN048 (1, IFG(1, KAT), 5, 1)
C * ADD ARU TO LIST, REDUNDANT ARU'S ARE NOT ENTERED
   10 NMOL = IPR(13)
      IF (IPR(26) .NE. 1555) THEN
        IF (IPR(62) .EQ. 0) IPR(62) = IPR(61)
        MOL(NMOL + 1) = IPR(26) * IARU + IPR(62) + IDS
        IF (NMOL .GT. 1) THEN
          DO MM = 2, NMOL
            IF (MOL(MM) .EQ. MOL(NMOL + 1)) GO TO 20
            IF (MOL(MM) - IPR(48) * 1000 * IARU .EQ.
     1          MOL(NMOL + 1)) THEN
              IPR(24) = IPR(24) - IAUX
              RETURN
            END IF
            IF (MOL(MM) + IDS .EQ. MOL(NMOL + 1)) THEN
              MOL(MM) = MOL(NMOL + 1)
              GO TO 20
            END IF
          END DO
        END IF
        IF (IPR(13) + 3 .LT. NP11) THEN
          IPR(13)       = IPR(13) + 1
          MM            = IPR(13)
          MLTI(IPR(62)) = MLTI(IPR(62)) + 1
        ELSE
          IPR(138)      = IPR(138) + 1
          IPR(24)       = IPR(24)  - IAUX
          RETURN
        END IF
   20   IF (IPR(17) .NE. 0) THEN
          IF (MM .GT. IPR(463) - 1) THEN
            IPR(2) = 54
            RETURN
          END IF
          LABA(KAT) = LABA(JAT) + MM - 1
        END IF
      END IF
      CALL PLA069 (IAT, JAT, KAT, NAT, IAUX, DIATKAT)
      RETURN
      END SUBROUTINE PLA068
      SUBROUTINE PLA069 (IAT, JAT, KAT, NAT, IAUX, DIATKAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
C * INTRA MODE
      IF (IPR(17) .EQ. 0) THEN
        IF (KAT .LE. IPR(37)) THEN
          CALL GEN048 (-1, IFG(1, IAT), 23, IDOA)
          CALL GEN048 (-1, IFG(1, KAT), 7,  IHA)
          IF (IDOA .EQ. 1 .AND. IHA .EQ. 1) THEN
            CALL GEN048 (1, IFG(1, IAT), 21, 1)
            CALL GEN048 (1, IFG(1, KAT), 20, 1)
          END IF
        END IF
C * INTER MODE
      ELSE IF (IPR(17) .LT. 0) THEN
        CALL PLA057 (IAT, JAT, KAT)
        CALL GEN048 (-1, IFG(1, IAT), 7, IHA)
        IF (IHA .EQ. 1 .AND. IPR(63) .EQ. 1) THEN
          IF (DIATKAT .LE. (PAR(23) - PAR(1) + PAR(9))) THEN
            KAT = KAT + NP1
            CALL PLA040 (-1, IAT, IVAL, KAT)
            IF (IVAL .EQ. 0) THEN
              CALL PLA040 (1, IAT, IVAL, KAT)
              IF (KAT .GT. NAT) IAUX = 0
            END IF
          END IF
        END IF
        IPR(24) = IPR(24) - IAUX
C * COORDN: STORE THIS CONNECTION IAT TO JAT IN ARRAY IATC (MAX = NP1)
      ELSE
        IPR(79)       = IPR(79) + 1
        IATC(IPR(79)) = KAT + IPR(20) * NP1
        DATC(IPR(79)) = DIATKAT
        IF (IPR(79) .GE. NP1) THEN
          CALL GEN013 (DATC, IATC, 1, IPR(79))
          IPR(79) = NP1 - 5
          PAR(23) = DATC(IPR(79))
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA069
      SUBROUTINE PLA070 (I)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CALL GEN048 (-1, IFG(1, I), 2, IVAL)
      IF (IGBL(30) .EQ. 1) THEN
        ITRNS = 1555
      ELSE IF (IVAL .EQ. 1) THEN
        ITRNS = IATP(I)
      ELSE
        KAT  = IPR(39) + IPR(24) + 1
        KAT1 = KAT + 1
        IF (KAT1 .GT. NP1) THEN
          IPR(2) = 1
          ITRNS   = 1555
          GO TO 40
        END IF
        ITRNS = IABS(IATP(I))
        IF (ITRNS .NE. 0) THEN
          IGBL(30) = -1
          IPR(50) = IPR(50) + 1
          J       = ITRNS / 1000
          FN(1)   = J
          J       = ITRNS - J * 1000
          ITR(1)  = J / 100
          J       = J - ITR(1) * 100
          ITR(2)  = J / 10
          ITR(3)  = J - ITR(2) * 10
          DO J = 1, 3
            FN(J + 1) = ITR(J) - 5
          END DO
        ELSE
          FN(1) = 1.0
          CALL GEN074 (FN, 2, 4, 0.0)
        END IF
        ITRNS = NINT(FN(1) * 1000 + 555)
        DO L = 1, 3
          XXO(KAT, L) = XXO(I, L)
          XSD(KAT, L) = XSD(I, L)
          ITR(L)      = NINT(FN(L + 1))
          IF (IABS(ITR(L)) .GT. 4) IPR(2) = 17
          ITRNS       = ITRNS + ITR(L) * 10**(3 - L)
        END DO
        IF (ITRNS .NE. 1555) THEN
          WRITE (LU4) 5, LABA(I), (FN(L), L = 1, 8)
          IPR(54) = NINT(FN(1))
          CALL PLA059 (KAT, I)
        END IF
      END IF
   40 IATP(I) = ITRNS
      CALL GEN048 (1, IFG(1, I), 2, 1)
      RETURN
      END SUBROUTINE PLA070
      SUBROUTINE PLA071 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2 * NP23), VOID(NVD)
      COMMON /PL40/ LHNT(4, 3, 5), NETH(64, 3), MXL, NETTYPE
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      DIMENSION IRCONT(NP29), JRCONT(NP29), MOLSV(NP11), MLTISV(NP29),
     1 NPOLSV(NP29)
C * EXPAND PRIMARY ATOM/MOLECULE LIST
C * SET-UP ATOMS FOR SYMMETRY RELATED UNITS
      IER     =  0
      IPR(30) =  1
      IF (IABS(IGBL(8)) .EQ. 3)
     1  CALL PLA273 (0, LU11, 0.0, 0, 0, 0, 0, IER)
      CALL PLA094 (-1, 0, 0, 0, 0, 0)
      NATC = IPR(37)
      NSYM = IPR(48)
      NRES = IPR(75)
      IARU = NINT(PAR(42))
      IGBL(60) = 0
      DO I = 1, NATC
        IF (IATP(I) .NE. 1555) IGBL(60) = IGBL(60) + 1
      END DO
      NMOL = IPR(13)
      MMO  = IPR(13)
      IF (NMOL .GT. 1 .AND. IGBL(136) .EQ. 0) THEN
        IF (MODE .GT. 0) THEN
          DO I = 2, NMOL
            K = NMOL + 2 - I
            CALL GEN098 (MOL(K), PAR(42), IS1, IX1, IY1, IZ1, IR1)
            DO J = 1, K - 1
              L = K - J
              CALL GEN098 (MOL(L), PAR(42), IS2, IX2, IY2, IZ2, IR2)
              IF (IS1 .EQ. IS2) THEN
                IF (IR2 .EQ. 0) IR2 = IR1
                IF (IR1 .EQ. IR2) THEN
                  IX3 = IX2 - IX1
                  IY3 = IY2 - IY1
                  IZ3 = IZ2 - IZ1
                  IF (IABS(IX3) + IABS(IY3) + IABS(IZ3) .NE. 0) THEN
                    CALL PLA094 (1, IX3, IY3, IZ3, IR2, 0)
                  END IF
                END IF
              END IF
            END DO
          END DO
          CALL GEN022 (MOL, 2, NMOL)
          IPR13 = NMOL
          CALL GEN133 (MOL,  MOLSV,  NP11)
          CALL GEN133 (MLTI, MLTISV, NP29)
   10     MMO  = IPR(13)
          IF (IGBL(97) .NE. 0) THEN
            DO I = 1, MMO
              J = MMO + 1 - I
              IF (MOL(J) / (1000 * IARU) .LE. NSYM) THEN
                IPR(101) = IPR(13) - J
                MMO      = J
                EXIT
              END IF
            END DO
            MM1 = MMO + 1
   20       MM1 = MM1 - 1
            IF (MM1 .GT. 1) THEN
              CALL GEN098 (MOL(MM1), PAR(42), IS1, IX1, IY1, IZ1, IR1)
              XM1 = MOL(MM1) / PAR(42)
              MM2 = MMO + 1
   30         MM2 = MM2 - 1
              IF (MM2 .EQ. 1) GO TO 20
              CALL GEN098 (MOL(MM2), PAR(42), IS2, IX2, IY2, IZ2, IR2)
              XM2  = MOL(MM2) / PAR(42)
              IF (IR2 .NE. IR1) GO TO 30
              CALL PLA270 (XM1, XM2, XM3)
              IF (IPR(2) .NE. 0) RETURN
              IF (XM3 .EQ. 0.0) THEN
                IF (IPR(210) .LE. 0) THEN
                  CALL GEN133 (MOLSV,  MOL,  NP11)
                  CALL GEN133 (MLTISV, MLTI, NP29)
                  IPR(13) = IPR13
                  GO TO 40
                ELSE
                  WRITE (LU6, 99999,IOSTAT = IOST)
                  CALL PLA004 (0)
                END IF
              END IF
              MOLN = NINT(XM3 * PAR(42))
              CALL GEN098 (MOLN, PAR(42), IS3, IX3, IY3, IZ3, IR3)
              IF (IS3 .EQ. 1) THEN
                IF (IABS(IX3) + IABS(IY3) + IABS(IZ3) .NE. 0) THEN
                  MLTI(IR3) = -1
                  CALL PLA094 (1, IX3, IY3, IZ3, IR3, 0)
                END IF
                GO TO 30
              END IF
              DO L = 1, MMO
                CALL GEN098 (MOL(L), PAR(42), IS4, IX4, IY4, IZ4, IR4)
                IF (L .EQ. 1) IR4 = IR3
                IF (IR3 .EQ. IR4 .AND. IS3 .EQ. IS4) THEN
                  IX5 = IX4 - IX3
                  IY5 = IY4 - IY3
                  IZ5 = IZ4 - IZ3
                  IF (IABS(IX5) + IABS(IY5) + IABS(IZ5) .NE. 0) THEN
                    CALL PLA094 (1, IX5, IY5, IZ5, IR3, 0)
                  END IF
                  GO TO 30
                END IF
              END DO
              IF (IPR(13) + 3 .LT. NP11) THEN
                IPR(13)      = IPR(13) + 1
                MOL(IPR(13)) = MOLN
                IF (MLTI(IR3) .GT. 0) MLTI(IR3) = MLTI(IR3) + 1
                CALL GEN022 (MOL, 2, IPR(13))
                GO TO 10
              ELSE
                IPR(138) = IPR(138) + 1
              END IF
            END IF
          END IF
   40     DO MM = 2, MMO
            M1 = MOD(MOL(MM), IARU)
            M2 = MOL(MM) / IARU
            MOL(MM) = M1 * 1000000 + M2
          END DO
          CALL GEN022 (MOL, 2, MMO)
          DO MM = 2, MMO
            M1 = MOL(MM) / 1000000
            M2 = MOD(MOL(MM), 1000000)
            MOL(MM) = M2 * IARU + M1
          END DO
        END IF
        DO MM = 2, MMO
          CALL GEN098 (MOL(MM), PAR(42), IPR(54), ITR(1), ITR(2),
     1         ITR(3), IR)
          IF (MM .GT. IPR(463) - 1) THEN
            IPR(2) = 54
            RETURN
          END IF
          MN = MM - 1
          DO 50 I = 1, NATC
            CALL GEN048 (-6, IFG(1, I), 9, IRESI)
            IF (IRESI .EQ. IR) THEN
              CALL GEN048 (-7, IFG(2, I), 1, IPP)
              IPR(128) = IPPR(IPP + 1, 1) * IPPR(IPP + 1, 3) / NSYM
              IPR(119) = IPPR(IPP + 1, 1)
              IF (IPR(119) .LT. 1000) THEN
                IPR(98) = 1
              ELSE
                IPR(98) = 0
              END IF
              KAT = IPR(39) + 1
              IF (KAT .GE. NP1) THEN
                IPR(2) = 1
                GO TO 70
              END IF
              CALL PLA059 (I, KAT)
              NAT = IPR(39)
              DO J = 1, NAT
                CALL PLA050 (J, KAT, 0, 0, DIJ)
                IF (DIJ .LT. PAR(18)) GO TO 50
              END DO
              IPR(39) = IPR(39) + 1
              IF (MN .GT. IPR(463) - 1) THEN
                IPR(2) = 54
              RETURN
              END IF
              LABA(KAT) = LABA(I) + MN
              DO K = 1, 3
                IFG(K, KAT)  = IFG(K, I)
              END DO
              CALL GEN048 (1, IFG(1, KAT), 5, 1)
              CON(KAT, NP4) = 0.0
              IF (MODE .EQ. 1) THEN
                XM1 = (MOL(MM) - IR) / PAR(42)
                XM2 = IABS(IATP(I))
                CALL PLA270 (XM1, XM2, XM3)
                IF (IPR(2) .NE. 0) GO TO 70
                IATP(KAT) = INT(XM3)
              END IF
            END IF
   50     CONTINUE
        END DO
      END IF
      DO I = 1, NRES
        IRCONT(I) = (NP1 * 100 + I) * 1000 + MLTI(I) + 1
      END DO
      NAT = IPR(39)
      DO I = 1, NAT
        CALL GEN048 (-6, IFG(1, I), 9, IRESI)
        CALL GEN048 (-1, IFG(1, I), 7, IHAT)
        IRCONT(IRESI) = IRCONT(IRESI) - 100000 * (1 - IHAT)
        IF (I .GT. 1) THEN
          N2  = I - 1
          CALL GEN048 (-4, IFG(1, I), 15, NO1)
          IENI     = IEN(NO1 + 1)
          DMX      = RADR(NO1 + 1, 2) + PAR(1)
          IATPRI   = IATPR(IENI)
          IPR(191) = ISIGN (1, IATPRI)
          NUMO = 0
          NUMS = 0
          NUMC = 0
          NUMH = 0
          IF (IENI .EQ. 2 .OR. IENI .GE. 4 .AND. IENI .LE. 8 .OR.
     1        IENI .EQ. 20) THEN
            DO J = 1, NAT
              IF (I .NE. J) THEN
                CALL PLA050 (I, J, 0, 0, DIST)
                IF (DIST .LT. 2.1) THEN
                  CALL GEN048 (-4, IFG(1, J), 15, IVAL)
                  IVAL = IEN(IVAL + 1)
                  IF (DIST .LT. 1.27) THEN
                    IF (IVAL .EQ. 1) NUMH = NUMH + 1
                  ELSE IF (DIST .LT. 1.7) THEN
                    IF (IVAL .EQ. 3) NUMO = NUMO + 1
                  END IF
                  IF (IVAL .EQ. 2) NUMC = NUMC + 1
                  IF (IVAL .EQ. 6) NUMS = NUMS + 1
                END IF
              END IF
            END DO
            IF (IENI .EQ. 20 .AND. NUMH .GE. 3) NUMH = -1
            IF (IENI .EQ. 2 .AND. NUMO .EQ. 2) NUMO = -1
            IF (IENI .EQ. 4 .AND. NUMO .EQ. 3) NUMO = -1
            IF (IENI .EQ. 5 .AND. NUMO .EQ. 4) NUMO = -1
            IF (IENI .EQ. 6) THEN
              IF (NUMO .EQ. 4) THEN
                NUMO = -1
              ELSE IF (NUMO .EQ. 3 .AND. NUMC .EQ. 1) THEN
                NUMO = -1
              END IF
            END IF
            IF (IENI .EQ. 8 .AND. (NUMO + NUMS) .EQ. 4) NUMO = -1
            IF (NUMO .LT. 0) CALL GEN048 (1, IFG(1, I), 31, 1)
          END IF
          IPR(509) = IENI
          CALL PLA041 (IATPRI, 0)
          CALL GEN048 (-7, IFG(2, I), 1, IDS1)
          IDS1 = IPPR(IDS1 + 1, 1)
          CALL GEN048 (-5, IFG(3, I), 14, IVL)
          IPRT1 = IVL - 16
          DO 60 J = 1, N2
            CALL GEN048 (-1, IFG(1, J), 6, JSPPOS)
            CALL GEN048 (-6, IFG(1, J), 9, IRESJ)
            CALL GEN048 (-1, IFG(1, J), 7, JHAT)
            IF (IRESI .EQ. IRESJ) THEN
              IF (IHAT .EQ. 1 .AND. JHAT .EQ. 1) GO TO 60
              CALL GEN048 (-1, IFG(1, J), 31, JUNK)
              IF (IATPRI .GT. 0 .AND. JUNK .EQ. 1) GO TO 60
              CALL GEN048 (-4, IFG(1, J), 15, NO2)
              IENJ   = IEN(NO2 + 1)
              IATPRJ = IATPR(IENJ)
              IF (IATPRJ .LE. 0 .OR. NUMO .GE. 0) THEN
                IPR(510) = IENJ
                CALL PLA041 (IATPRJ, 1)
                IF (IPR(191) * IENJ .EQ. 20 .OR.
     1               IPR(192) * IENI .EQ. 20) THEN
                  IF (NUMH .LT. 0) THEN
                    PAR(23) = 0.0
                  ELSE
                    PAR(23) = RADR(NO1 + 1, 2) + RADR(NO2 + 1, 2) + 0.05
                  END IF
                ELSE
                  PAR(23) = DMX + RADR(NO2 + 1, 2) + PAR(293)
                END IF
                IF (IENI .EQ. 1 .OR. IENJ .EQ. 1)
     1              PAR(23) = MIN (PAR(23), PAR(461))
                IF ((IENI .EQ. 63 .AND. IENJ .EQ. 85) .OR.
     1              (IENI .EQ. 85 .AND. IENJ .EQ. 63)) THEN
                  CALL PLA050 (I, J, 0, 0, DIST)
                  IF (DIST .GT. 3.1) PAR(23) = 0.0
                END IF
                YUNK = GEN128 (IENI, IENJ)
                IF (YUNK .LT. -9.0) THEN
                  PAR(23) = 2.0
                ELSE
                  PAR(23) = PAR(23) + YUNK
                END IF
                CALL GEN048 (-7, IFG(2, J), 1, IDS2)
                IDS2 = IPPR(IDS2 + 1, 1)
                CALL GEN048 (-5, IFG(3, J), 14, IVL)
                IPRT2 = IVL - 16
C * CHECK FOR NON-CONTACTS BASED ON PART NUMBERS
                JUNK = 0
                IF (IPRT1 .NE. IPRT2) THEN
                  IF (IPRT1 .EQ. 0 .OR. IPRT2 .EQ. 0) JUNK = 1
                ELSE IF (IPRT1 .EQ. IPRT2) THEN
                  JUNK = 1
                END IF
                IF (JUNK .EQ. 0) GO TO 60
                IF (IDS1 .LT. 1000 .AND. IDS2 .LT. 1000) THEN
                  IF (IDS1 .EQ. 500 .AND. IDS2 .EQ. 500) THEN
                    IF (ABS(IPRT1) .GT. 0 .AND. ABS(IPRT2) .GT. 0)
     1                THEN
                      IF (IPRT1 .NE. IPRT2) GO TO 60
                    END IF
                  END IF
                  IF (ABS(IDS1 - IDS2) .GT. 1) THEN
                    IF (IABS(2 * IDS1 - IDS2) .GT. 1 .AND.
     1                  IABS(2 * IDS2 - IDS1) .GT. 1) GO TO 60
                  END IF
                  IF (IPR(154) .EQ. 0) THEN
                    MNI = MOD(LABA(I), IPR(463))
                    MNJ = MOD(LABA(J), IPR(463))
                    IF (IDS1 .EQ. 500 .AND. MNI .NE. MNJ
     1                 .AND. JSPPOS .EQ. 0) GO TO 60
                  END IF
                END IF
                CALL PLA050 (I, J, 0, 0, DSQ)
                IF (DSQ .LE. PAR(23) .AND. DSQ .GT. 0.1) THEN
                  IF (IATPRJ .GT. 0) THEN
                    IF (IENI .EQ. 4 .OR. IENI .EQ. 8 .OR.
     1                  IENI .EQ. 20) THEN
                      NUMB = 0
                      DO K = 1, NAT
                        IF (K .NE. I .AND. K .NE. J) THEN
                          CALL GEN048 (-1, IFG(1, K), 7, KHAT)
                          CALL GEN048 (-7, IFG(2, K), 1, IDS3)
                          IDS3 = IPPR(IDS3 + 1, 1)
                          IF (IDS3 .EQ. 1000) THEN
                            CALL PLA050 (K, I, 0, 0, DIST)
                            IF (IENI .EQ. 8) THEN
                              IF (KHAT .EQ. 1) THEN
                                IF (DIST .LT. 1.7) NUMB = NUMB + 1
                              ELSE
                                IF (DIST .LT. 1.9) NUMB = NUMB + 1
                              END IF
                            END IF
                            IF (DIST .LT. 1.7) THEN
                              CALL PLA050 (J, I, K, 0, ANGLE)
                              IF (ANGLE .LT. 45.0) GO TO 60
                            END IF
                          END IF
                        END IF
                      END DO
                      IF (IENI .EQ. 8 .AND. NUMB .EQ. 4) GO TO 60
                    END IF
                  ELSE IF (IATPRI .GT. 0) THEN
                    IF (IENJ .EQ. 4 .OR. IENJ .EQ. 8
     1                  .OR. IENJ .EQ. 20) THEN
                      NUMB = 0
                      DO K = 1, NAT
                        IF (K .NE. I .AND. K .NE. J) THEN
                          CALL GEN048 (-1, IFG(1, K), 7, KHAT)
                          CALL GEN048 (-7, IFG(2, K), 1, IDS3)
                          IDS3 = IPPR(IDS3 + 1, 1)
                          IF (IDS3 .EQ. 1000) THEN
                            CALL PLA050 (K, J, 0, 0, DIST)
                            IF (IENI .EQ. 8) THEN
                              IF (KHAT .EQ. 1) THEN
                                IF (DIST .LT. 1.7) NUMB = NUMB + 1
                              ELSE
                                IF (DIST .LT. 1.9) NUMB = NUMB + 1
                              END IF
                            END IF
                            IF (DIST .LT. 1.7) THEN
                              CALL PLA050 (I, J, K, 0, ANGLE)
                              IF (ANGLE .LT. 45.0) GO TO 60
                            END IF
                          END IF
                        END IF
                      END DO
                      IF (IENJ .EQ. 8 .AND. NUMB .EQ. 4) GO TO 60
                    END IF
                  END IF
                  CALL PLA040 ( 1, I, KI,   J)
                  CALL PLA040 (-1, J, IVAL, I)
                  IF (IVAL .LE. 0) CALL PLA040 (1, J, KJ, I)
                END IF
              END IF
            END IF
   60     CONTINUE
        END IF
      END DO
      IF (NRES .GT. 1) THEN
        IF (IPR(597) .EQ. 1) CALL GEN022 (IRCONT, 1, NRES)
        DO I = 1, NRES
          MLTI(I)   = MOD(IRCONT(I), 1000) - 1
          IRCONT(I) = IRCONT(I) / 1000
          J         = MOD(IRCONT(I), 100)
          JRCONT(J) = I
        END DO
        NMOL = IPR(13)
        IF (NMOL .GT. 1) THEN
          DO J = 2, NMOL
            CALL GEN098 (MOL(J), PAR(42), IS1, IX1, IY1, IZ1, IR1)
            IF (IR1 .GT. 0) THEN
              MOL(J) = (IS1 * 1000 + IX1 * 100 + IY1 * 10 + IZ1 + 555) *
     1                IARU + JRCONT(IR1)
            END IF
          END DO
        END IF
        IF (MXL .GT. 0) THEN
          DO J = 1, MXL
            JUNK = NETH(J, 1)
            NETH(J, 1) = JRCONT(JUNK)
            MPOL(JRCONT(JUNK)) = NETH(J, 2)
          END DO
        END IF
        CALL GEN133 (NPOL, NPOLSV, NP29)
        DO J = 1, NRES
          NPOL(J) = NPOLSV(JRCONT(J))
        END DO
      END IF
      I = 0
      DO WHILE (I .LT. NAT)
        I = I + 1
        NTRNS(I) = IATP(I)
        IF (NRES .GT. 1) THEN
          CALL GEN048 (-6, IFG(1, I), 9, IVAL)
          CALL GEN048 ( 6, IFG(1, I), 9, JRCONT(IVAL))
        END IF
        IF (IPR(72) .EQ. 1) THEN
          DO J = 1, 3
            FSDV = SQRT(XSD(I, J))
            CALL GEN041 (XXO(I, J), FSDV, IDUM, IPR(183), NDEC, IPR(68))
            XSD(I, J) = FSDV**2
          END DO
          CALL PLA059 (I, I)
        END IF
      END DO
      IPR(51) = IPR(13)
   70 DO IAT = 1, IPR(39)
        CALL GEN048 (-1, IFG(1, IAT), 23, IDAC)
        IF (IDAC .EQ. 1) THEN
          CALL GEN048 (-4, IFG(1, IAT), 15, NO1)
          IENI = IEN(NO1 + 1)
          IF (IENI .EQ. 4 .OR. IENI .EQ. 6) THEN
            NC = - NINT(CON(IAT, NP4))
            IF (NC .GT. 0) THEN
              NRBO = 0
              DO JJ = 1, NC
                KK = NINT(CON(IAT, JJ))
                CALL GEN048 (-4, IFG(1, KK), 15, NO2)
                IENK = IEN(NO2 + 1)
                IF (IENK .EQ. 3) NRBO = NRBO + 1
              END DO
              IF (NRBO .GT. 2)
     1          CALL GEN048 (1, IFG(1, IAT), 23, 0)
            END IF
          END IF
        END IF
      END DO
      IPR(297) = NP1 * (NP4 + 15)
      IPR(298) = IPR(297) + NP1 * 21
      IPR(131) = 0
      IPR(133) = -1
      DO
        IPR(133) = IPR(133) + 1
        IF (IPR(133) .GT. 1) EXIT
        IFIN = -2
        DO
          CALL PLA038 (I, J, IFIN)
          IF (IFIN .EQ. 1) EXIT
          CALL PLA100 (I, J, 1, 1.0)
        END DO
      END DO
      IF (IPR(324) .EQ. 1 .AND. IPR(322) .EQ. 0 .AND.
     1  MODE .GE. 0 .AND. IGBL(129) .LE. 0 .AND.
     2  IGBL(3) .NE. 3) THEN
        CALL PLA030 (XXO, CON, JATC, IFG, IPPR, VOID(IPR(298) + 1))
        DO I = 1, IPR(37)
          CALL GEN048 (-2, IFG(1, I), 28, ICHIRAL)
          IF (IABS(2 - ICHIRAL) .EQ. 1) THEN
            CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, IPR(71),
     1                  IGBL(55), 0, 1 - IGBL(55))
            IF (ICHIRAL .EQ. 1) THEN
              NQ2 = '      S'
            ELSE
              NQ2 = '      R'
            END IF
            IF (CHSG(1:1) .EQ. 'C') THEN
C * ALERT _791 - CHIRAL ATOM IN CHIRAL SPACE GROUP
              CALL PLA231 (791, 0, -999.0, 0.0, NQ1, NQ2)
            ELSE
              IF (IPR(275) .EQ. 1) THEN
C * ALERT _792 - CHIRAL ATOM IN POLAR SPACE GROUP
                CALL PLA231 (792, 0, -999.0, 0.0, NQ1, NQ2)
              ELSE
C * ALERT _793 - CHIRAL ATOM IN CENTRO SPACE GROUP
                CALL PLA231 (793, 0, -999.0, 0.0, NQ1, NQ2)
              END IF
            END IF
          END IF
        END DO
C * GENERAL AUTO-RENUMBERING
        IF (IPR(501) .EQ. 1) CALL PLA228 (LU6)
      END IF
      RETURN
99999 FORMAT ('UNRESOLVABLE ARU-PROBLEM - SQUEEZE ABORTED')
      END SUBROUTINE PLA071
      SUBROUTINE PLA072 (LIST, NSMPR)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,
     2 NP22=287,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NMA=550,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /FORMT/ FORM
      CHARACTER ICH*1, FORM*109, NRND*4,
     1 KTYPE*3, IYSP1*1, SPSITE*6, MOVE*8, VLAG*4
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /XVLAG/ CVLAG
      CHARACTER CVLAG(7)*1
      DATA CVLAG /'S', 'G', 'R', 'D', 'T', 'U', 'P'/
      IWIN = IGBL(25) * IGBL(32)
      KL   = IPR(220)
      KN   = IPR(221)
      NATX = IPR(37)
      NAT  = IPR(39)
      NRES = IPR(75)
      NSYM = IPR(48)
      LTYPE = 0
      LRES  = 0
      NHAT  = 0
C * LIST ATOMS
      IF (LIST .GT. 0) THEN
        IF (IWIN .EQ. 1) CALL GGIP (HORS, VERT, 0.0, 1)
        IF (LIST .EQ. 1) NAT = NAT + IPR(64)
        IF (KN .GT. 0) LRES = NINT(FN(1))
        IF (KL .GT. 2) CALL PLA037 (3, LTYPE, 2)
        NDLPM = 1
        WRITE (PRBUF, 99979, IOSTAT = IOST)
        IF (IWIN .EQ. 1) THEN
          VRT = VERT - 0.4
          CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2,
     1                 1.0, VRT)
          VRT = VRT - 0.2
        ELSE
          WRITE (LU6, 99983, IOSTAT = IOST) PRBUF(1:80)
        END IF
      ELSE
        NDLPM = 2
        PAGET = 'GEOMETRY'
        IF (IPR(113) .NE. 0) GO TO 30
        IPR(113) = 1
        IF (IGBL(63) .GT. 1) THEN
          IF (IPR(23) .EQ. 0) THEN
            CALL PLA262 (0)
          ELSE
            CALL PLA262 (3)
            WRITE (LU7, 99977,IOSTAT = IOST) PAR(11)
          END IF
        END IF
        IF (IPR(72) .EQ. 0 .OR. IPR(68) .EQ. 0) THEN
          NRND = ' Not'
        ELSE
          CALL GEN040 (IPR(68) * 10 - 1, NQ1, IP)
          NRND = '1:'//NQ1(1:2)
        END IF
C * GET SHELDRICK TYPE ROUNDED ATOM WEIGHTS
        DO I = 1, IAN
          K = IENS(I)
          L = IEN(K)
          IF (IPR(181) .EQ. 1) THEN
            IF (L .EQ. 1) THEN
              YUNK = 1000.0
            ELSE
              YUNK = 100.0
            END IF
            ATWTL = ATWT(L)
            IF (ATWTL .EQ. 106.42) ATWTL = 106.40
            SATWT(K) = NINT(ATWTL * YUNK) / YUNK
          ELSE
            SATWT(K) = ATWT(L)
          END IF
        END DO
        DO I = 1, IAN
          J = IEN(IENS(I))
          IF (IABS(IPR(493)) .NE. 6) THEN
            J     = (J - 1) * 17
            FN(I) = 0.0
            DO K = 1, 9, 2
              FN(I) = FN(I) + SFAC(J + K)
            END DO
          ELSE
            FN(I) = RNSCL(J)
          END IF
          IPR(22) = MAX (IPR(22), IATNR(IEN(IENS(I))))
        END DO
        IF (IGBL(63) .GT. 3) THEN
          CALL PLA262 (16)
          WRITE (LU7, 99997, IOSTAT = IOST) NRND
          WRITE (LU7, 99991, IOSTAT = IOST)
     1      (LMT(IENS(I), 1), I = 1, IAN)
          WRITE (LU7, 99994, IOSTAT = IOST)
     1      (RADR(IENS(I), 2),    I = 1, IAN)
          WRITE (LU7, 99984, IOSTAT = IOST)
     1      (ATVOL(IEN(IENS(I))), I = 1, IAN)
          WRITE (LU7, 99992, IOSTAT = IOST)
     1      (IATNR(IEN(IENS(I))), I = 1, IAN)
          WRITE (LU7, 99993, IOSTAT = IOST)
     1      (SATWT(IENS(I)),      I = 1, IAN)
          IF (IABS(IPR(493)) .NE. 6) THEN
            WRITE (LU7, 99987, IOSTAT = IOST) (FN(I), I = 1, IAN)
          ELSE
            WRITE (LU7, 99988, IOSTAT = IOST) (FN(I), I = 1, IAN)
          END IF
        END IF
        IF (IABS(IPR(493)) .GT. 0 .AND. IABS(IPR(493)) .LT. 6) THEN
          DO I = 1, IAN
            IENSI = IENS(I)
            IF (IABS(IPR(493)) .EQ. 5) THEN
              IATNUM = IATNR(IEN(IENSI))
              CALL PLA371 (IATNUM, PAR(17), ANOM(IENSI, 1),
     1          ANOM(IENSI, 2), ANOM(IENSI, 3), 0)
            ELSE IF (IABS(IPR(493)) .LT. 5) THEN
              DO K = 1, 2
                J = IEN(IENSI) * 17 + K - 2 * IABS(IPR(493))
                ANOM (IENSI, K) = SFAC(J)
                PAR(512 + K) = MAX(PAR(512 + K), SFAC(J))
              END DO
              ANOM(IENSI, 3) = AMR(IEN(IENSI), IABS(IPR(493)))
            ELSE
              ANOM(IENSI, 3) = 0.0
            END IF
          END DO
          IF (IPR(639) .GT. 0 .AND. IGBL(104) .NE. 1) THEN
            YUNK1 = 0
            YUNK2 = 0
            DO I = 1, IPR(639)
              YUNK1 = YUNK1 + ABS(DISPVAL(I, 1))
              YUNK2 = YUNK2 + ABS(DISPVAL(I, 2))
            END DO
            IF (YUNK1 .EQ. 0.0)
     1        CALL PLA231 (986, 0, -999.0, 0.0, ' ', ' ')
            IF (YUNK1 .EQ. 0.0)
     1        CALL PLA231 (981, 0, -999.0, 0.0, ' ', ' ')
            DO I = 1, IAN
              IENSI = IENS(I)
              DO K = 1, IPR(639)
                IF (LMT(IENSI, 1) .EQ. DISPTYPE(K)) THEN
                  NQ1 = ' '//DISPTYPE(K)(1:2)//'-f''='
                  NQ2 = ' '//DISPTYPE(K)(1:2)//'-f"='
                  WRITE (NQ3, '(F7.3)', IOSTAT = IOST) ANOM(IENSI, 1)
                  WRITE (NQ4, '(F7.3)', IOSTAT = IOST) ANOM(IENSI, 2)
                  YUNK3 = ABS(DISPVAL(K, 1) - ANOM(IENSI, 1))
                  IF (YUNK1 .GT. 0 .AND. YUNK3 .GT. 0.001) THEN
                    IF (IPR(493) .LT. 5) THEN
                      CALL PLA231 (982, 3, -999.0, DISPVAL(K, 1), NQ1,
     1                             NQ3)
                    ELSE
                      CALL PLA231 (984, 3, -999.0, DISPVAL(K, 1), NQ1,
     1                             NQ3)
                    END IF
                  END IF
                  YUNK4 = ABS(DISPVAL(K, 2) - ANOM(IENSI, 2))
                  IF (YUNK2 * YUNK4 * YUNK3 .GT. 0.001) THEN
                    IF (IPR(493) .LT. 5) THEN
                      CALL PLA231 (983, 3, -999.0, DISPVAL(K, 2), NQ2,
     1                             NQ4)
                    ELSE
                      CALL PLA231 (985, 3, -999.0, DISPVAL(K, 2), NQ2,
     1                             NQ4)
                    END IF
                  END IF
                END IF
              END DO
            END DO
          ELSE
            IF (IGBL(104) .NE. 1 .AND. IPR(105) .EQ. 0) THEN
              CALL PLA231 (980, 0, -999.0, 0.0, ' ', ' ')
            END IF
          END IF
          IF (IGBL(63) .GT. 3) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99986, IOSTAT = IOST)
     1        (ANOM(IENS(I), 1), I = 1, IAN)
            WRITE (LU7, 99985, IOSTAT = IOST)
     1        (ANOM(IENS(I), 2), I = 1, IAN)
          END IF
        END IF
        IF (IABS(IPR(493)) .GT. 0 .AND. IABS(IPR(493)) .LT. 6) THEN
          DO I = 1, IAN
            IF (SATWT(IENS(I)) .GT. 0.1) THEN
              FN(I) = ANOM(IENS(I), 3) / (SATWT(IENS(I)) * 1.66054)
            ELSE
              FN(I) = 0.0
            END IF
          END DO
          IF (IGBL(63) .GT. 3) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99998, IOSTAT = IOST) KRAD, (FN(I), I = 1, IAN)
            WRITE (LU7, 99990, IOSTAT = IOST)
     1        (LMT(IENS(I), 2), I = 1, IAN)
          END IF
        END IF
        IF (IGBL(63) .GT. 3) THEN
          IF (IPR(181) .EQ. 1) THEN
            NQ2 = 'SHELXL '
            NQ3 = ' '
          ELSE
            NQ2 = 'IUPAC 1'
            NQ3 = '993'
          END IF
          CALL PLA262 (6)
          IF (IGBL(30) .EQ. 1) THEN
            NQ1 = 'NOMOVE'
          ELSE
            NQ1 = ' '
          END IF
          WRITE (LU7, 99995, IOSTAT = IOST) NQ2, NQ3, NQ1
        END IF
        IF (IPR(23) .EQ. 0) THEN
          FORM(1:8)    = '(A,1X,A,'
          FORM(9:47)   = 'F11.0,A,I2,A,F11.0,A,I2,A,F11.0,A,I2,A,'
          FORM(48:88)  = 'F8.0,A,I2,A,F8.0,A,I2,A,F8.0,A,I2,A,A,I3,'
          FORM(89:109) = '2F6.3,A,I3,A,A,1X,A3)'
        ELSE
          FORM(1:37)   = '(I4,1X,A,42X,F9.0,A,I2,A,F9.0,A,I2,A,'
          FORM(38:56)  = 'F9.0,A,I2,A,35X,A3)'
        END IF
      END IF
C * LOOP OVER RESIDUES
      IF (NRES .EQ. 0) THEN
        NRES0 = 0
      ELSE
        NRES0 = 1
      END IF
      DO N = NRES0, NRES
        IF (LIST .GT. 0) THEN
          IF (IWIN .EQ. 0) THEN
            IF (NRES .GT. 1) WRITE (LU6, 99982, IOSTAT = IOST) N
          END IF
        ELSE
          IF (IGBL(63) .GT. 2) THEN
            IF (NRES .GT. 1) THEN
              CALL PLA262 (5)
              WRITE (LU7, 99981, IOSTAT = IOST) N
            END IF
            CALL PLA262 (3)
            WRITE (LU7, 99989, IOSTAT = IOST)
          END IF
        END IF
        NHAT = 0
        NDIS = 0
        DO NDLP = 1, NDLPM
          NRAT = 0
          DO 20 I = 1, NAT
            CALL GEN048 (-6, IFG(1, I), 9, IRESI)
            IF (N .EQ. IRESI) THEN
              CALL PLA036 (I, 1, 1, IDIS1, IDUM, ISP1, IPR(71),
     1                     IGBL(55))
              CALL GEN048 (-1, IFG(1, I), 23, IDA0)
              CALL GEN048 (-1, IFG(1, I), 20, IDH0)
              CALL GEN048 (-1, IFG(1, I), 19, IMET)
              CALL GEN048 (-1, IFG(1, I), 7,  IHAT)
              CALL GEN048 (-1, IFG(2, I), 10, ISU)
              IF (I .LE. IPR(37) .AND. NDLP .EQ. 1) THEN
                IF (IDH0 .NE. 0 .AND. ISU .EQ. 0) THEN
                  IPR(658) = IPR(658) + 1
                END IF
              END IF
              VLAG = '-   '
              IF (IABS(IGBL(8)) .EQ. 3) THEN
                CALL GEN048 (-1, IFG(3, I), 1, IVLAG)
                IF (IVLAG .EQ. 1) VLAG(1:1) = 'd'
                CALL GEN048 (-1, IFG(3, I), 2, IVLAG)
                IF (IVLAG .EQ. 1) VLAG(1:1) = 'c'
                K = 1
                DO J = 4, 10
                  CALL GEN048 (-1, IFG(3, I), J, IVLAG)
                  IF (IVLAG .EQ. 1) THEN
                    IF (K .LT. 4) THEN
                      K = K + 1
                      VLAG(K:K) = CVLAG(J - 3)
                    END IF
                  END IF
                END DO
              END IF
              IF (LIST .LT. 0) THEN
                DO J = 1, 3
                  XSIGMA = SQRT(XSD(I, J))
                  IF (IHAT .EQ. 1) THEN
                    NDEF = 5
                  ELSE IF (INT(XSIGMA * 100000.0)  .EQ. 0 .AND.
     1                     INT(XSIGMA * 1000000.0) .GT. 0) THEN
                    NDEF = 6
                  ELSE
                    NDEF = 5
                  END IF
                  CALL GEN041 (XXO(I, J), XSIGMA, IXSD(J),
     1                         NDEF, NDEC, IPR(68))
                  XSD(I, J) = XSIGMA ** 2
                  IF (IPR(23) .EQ. 0) THEN
                    NDC           = J * 13
                    FORM(NDC:NDC) = CHAR(ICHAR('0') + NDEC)
                  END IF
                  IXSD(J)       = MIN (99, IXSD(J))
                  XSIGMA = SQRT(ABS(XSD(I, J + 3)))
                  NDEF   = 4
                  YUNK   = XXO(I, J + 3)
                  IYUNK  = IXSD(J + 3)
                  CALL GEN041 (YUNK, XSIGMA, IYUNK, NDEF, NDEC, IPR(68))
                  IF (IPR(23) .EQ. 0) THEN
                    NDC = J * 12 + 39
                  ELSE
                    NDC = J * 12 + 5
                  END IF
                  FORM(NDC:NDC) = CHAR(ICHAR('0') + NDEC)
                  IXSD(J + 3)   = MIN (99, IYUNK)
                END DO
              END IF
              CALL GEN048 (-4, IFG(1, I), 15, NO1)
              NO1 = NO1 + 1
              IF (IEN(NO1) .EQ. 5 .OR. IEN(NO1) .EQ. 6 .OR.
     1            IEN(NO1) .EQ. 8) THEN
                IF (NINT(CON(I, NP4)) .LT. -3) THEN
                  IDA0 = 0
                  CALL GEN048 (1, IFG(1, I), 23, IDA0)
                END IF
              END IF
              IAH0 = 0
              IF (IHAT .EQ. 1) THEN
                IF (NINT(CON(I, NP4)) .EQ. -1) THEN
                  J = NINT(CON(I, 1))
                  CALL GEN048 (-4, IFG(1, J), 15, NO2)
                  IF (IEN(NO2 + 1) .EQ. 20) THEN
                    IAH0 = 1
                    CALL GEN048 (1, IFG(2, I), 28, 1)
                  END IF
                END IF
              END IF
              IF (NDLP .EQ. 1) THEN
                IF (LIST .LT. 0) THEN
                  IF (IEN(NO1) .EQ. 1) THEN
                    IF (NHAT .EQ. 0) THEN
                      IF (IGBL(63) .GT. 2) THEN
                        CALL PLA262 (1)
                        WRITE (LU7, 99976, IOSTAT = IOST)
                      END IF
                      NHAT = 1
                    END IF
                  ELSE
                    IF (NHAT .EQ. 1) THEN
                      IF (IGBL(63) .GT. 2) THEN
                        CALL PLA262 (1)
                        WRITE (LU7, 99976, IOSTAT = IOST)
                      END IF
                      NHAT = 0
                    END IF
                  END IF
                END IF
              END IF
              IF (ISP1 .EQ. 1) THEN
                IYSP1   = 'S'
                XJX(1)  = XXO(I, 1)
                XJX(2)  = XXO(I, 2)
                XJX(3)  = XXO(I, 3)
                XJX(10) = 0.0
                CALL SGSM (LINE, 0, XJX, LU6, 19, IERR)
                SPSITE = ' '//LINE(1:5)
              ELSE
                IYSP1  = ' '
                SPSITE = '      '
              END IF
              KTYPE = ' - '
              IF (IAH0 .EQ. 1) KTYPE = 'A-H'
              IF (IDA0 .EQ. 1) KTYPE = 'D/A'
              IF (IDH0 .EQ. 1) KTYPE = 'D-H'
              IF (IMET .EQ. 1) KTYPE = 'Met'
              CALL GEN048 (-7, IFG(2, I), 1, IPP)
              IPP  = IPP + 1
              PPAR = IPPR(IPP, 1) / 1000.0
              SPAR = IPPR(IPP, 2) / 1000.0
              CALL GEN041 (PPAR, SPAR, IPPAR, 3, NDEC, IPR(68))
              IF (IPR(23) .EQ. 0) FORM(93:93) =
     1          CHAR(ICHAR('0') + NDEC)
              MULT  = NSYM / IPPR(IPP, 3)
              SOF   = PPAR / MULT
              ATTRS = NTRNS(I) / 1000.0
              IF (LIST .GT. 0) THEN
                IF (LTYPE .EQ. 0   .AND. LRES .EQ. 0 .OR.
     1              LTYPE .EQ. 0   .AND. LRES .EQ. N .OR.
     2              LTYPE .EQ. NO1 .AND. LRES .EQ. 0 .OR.
     3              LTYPE .EQ. NO1 .AND. LRES .EQ. N) THEN
                  IF (IPR(23) .EQ. 0) THEN
                    WRITE (PRBUF, 99978, IOSTAT = IOST) I, NAMS(1, 1),
     1                                   (XXO(I, K), K = 1, 3),
     2              RADR(NO1, 2), IYSP1, MULT, PPAR, ATTRS, KTYPE
                  ELSE
                    WRITE (PRBUF, 99996, IOSTAT = IOST) I, NAMS(1, 1),
     1                                   (XXO(I, K), K = 1, 3),
     2              RADR(NO1, 2), IYSP1, MULT, PPAR, ATTRS, KTYPE
                  END IF
                  K = INDEX (PRBUF, ' 1.000 ')
                  IF (K .GT. 0) PRBUF(K:K+5) = '   -  '
                  K = INDEX (PRBUF, ' 1.555 ')
                  IF (K .GT. 0) PRBUF(K:K+5) = '   -  '
                  IF (IWIN .EQ. 1) THEN
                    IF (VRT - 0.4 .LT. 0) THEN
                      CALL PLA013 (1, 1)
                      ICH = IGGT(1:1)
                      CALL GGIP (HORS, VERT, 0.0, 1)
                      IF (ICH .NE. 'Y' .AND. ICH .NE. '!') GO TO 40
                      VRT = VERT
                    END IF
                    VRT = VRT - 0.4
                    CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
                  ELSE
                    WRITE (LU6, 99980, IOSTAT = IOST) PRBUF(1:80)
                  END IF
                END IF
              ELSE
                IF (PPAR .LT. 0.5) THEN
                  IF (NDLP .EQ. 1) GO TO 20
                  NDIS = NDIS + 1
                  IF (NDIS .LT. 2) THEN
                    IF (IGBL(63) .GT. 2) THEN
                      CALL PLA262 (4)
                      WRITE (LU7, 99999, IOSTAT = IOST) '<'
                    END IF
                  END IF
                  GO TO 10
                END IF
                IF (NDLP .EQ. 2) GO TO 20
   10           NRAT = NRAT + 1
                MOVE = '    -   '
                IF (NINT(ATTRS * 1000.0) .NE.  1555)
     1              WRITE (MOVE, 99974, IOSTAT = IOST) ATTRS
                IF (IPR(23) .EQ. 0) THEN
                  IF (IATP(I) .NE. 1555 .AND. I .LE. NATX) THEN
                      IPR(204) = IPR(204) + 1
                  END IF
                  WRITE (PRBUF, FORM, IOSTAT = IOST)
     1              VLAG, NAMS(1, 1), (XXO(I, K),
     2              '(', IXSD(K), ')', K = 1, 6), SPSITE, MULT, SOF,
     3              PPAR, '(', IPPAR, ')', MOVE, KTYPE
                ELSE
                  WRITE (PRBUF, FORM, IOSTAT = IOST)
     1              NRAT, NAMS(1, 1), (XXO(I, K),
     1              '(', IXSD(K), ')', K = 4, 6), KTYPE
                END IF
                IF (IGBL(63) .GT. 2)
     1            CALL PLA263 (LU7, PRBUF, 132, 1, 7)
              END IF
            END IF
   20     CONTINUE
        END DO
      END DO
      IF (LIST .LE. 0) THEN
        IF (IPR(23) .EQ. 0 .AND. IPR(13) .GT. 1) THEN
          CALL PLA262 (0)
          CALL PLA043 (NSMPR, 1, LU7, 0)
        END IF
        CALL PLA081
        IF (IGBL(3) .NE. 1 .AND. IGBL(3) .NE. 3) THEN
          IF (IPR(495) .NE. 0 .AND. IPR(200) .EQ. 0) THEN
            IF (IPR(322) .EQ. 0 .AND. IGBL(3) .NE. 28) THEN
              IF (IGBL(3) .NE. 1 .AND. IPR(39) .LT. NMA) THEN
                IF (IPR(23) .EQ. 0 .OR. IPR(495) .EQ. 3) THEN
                  CALL PLA211 (LU6, LU7, JID, 1)
                  CALL PLA211 (LU6, LU7, JID, 2)
                END IF
              ELSE
                WRITE (LU6, 99975, IOSTAT = IOST)
              END IF
              IF (IPR(495) .EQ. 1 .OR. IPR(495) .EQ. 3) CALL PLA082
            END IF
          END IF
        END IF
      END IF
   30 IF (IWIN .EQ. 1 .AND. LIST .GT. 0) CALL PLA297 (0)
   40 RETURN
99999 FORMAT (/, 'Disordered Atoms with S.O.F ', A, ' 0.5', /)
99998 FORMAT ('Mu/Rho(', A, '):', 16F7.2)
99997 FORMAT ('(', A, '-Rule Rounded) Coordinates of Unique',
     1 ' Residue(s) Identified.  Standard Deviations in the Last ',
     2 'Digit are in Parentheses.', /, 132('-'), /,
     3 10X, 'Site    = Site Symmetry; SSN = Site Symmetry Number; ',
     4 'SSOF = SHELX Site Occupation Factor (= S.O.F / SSN).',
     5 /, '*******   Move    = Transformation on Input Data',
     6 ': N.IJK (N = SymOp, IJK = Translation) i.e. 1.555 = nomove', /,
     7 'SYMBOLS:  Type    = D/A = Potential Donor or Acceptor atom,',
     8 ' D-H = H on Donor atom, MET = Metal.', /,
     9 '*******   El Type = AK = Alkali Metal, AE = Alkaline Earth,',
     * ' HL = Halogen, AN = Actinide, LN = Lanthanide,',
     1 ' TR = Transition Element.', /,
     2 10X, 'ARU     = Asymmetric Residue Unit encoded as sklm.nn,',
     3 ' with s = symmetry op, klm = translation, nn = residue #.', /,
     4 10X, 'RESIDUE = collection of ARU''s constituting an isolated',
     5 ' unit (= molecule, ion).', /,
     6 10X, 'FLAGS   : d = determined, c = calculated, R = riding ',
     7 'G = group', /, 132('-'))
99996 FORMAT (I4, 1X, A, F8.4, 2F9.4, F7.2, 2X, A, I4, F7.3, F8.3,
     1 2X, A3)
99995 FORMAT (132('-'), /, 'Sources - Cov. Radii : Manual Cambridge',
     1  ' Crystallographic Data Base', /, 8X,
     2  '- Atom Volume: D.W.M. Hofmann (2002). Acta Cryst. B58,',
     3  ' 489-493', /, 8X,
     4  '- Atomic Wt. : ', 2A, 89X, A, /, 8X,
     5  '- Scat. Fact.: SHELXL (International Tables)', /, 8X,
     6  '- mu/rho     : International Tables C, Table 4.2.4.2, 193-199',
     7 ' - [Multiply by Atom Weight and 1.66054 for Barns/atom values]')
99994 FORMAT ('Cov.Rad(Ang):', 16F7.2)
99993 FORMAT ('Atom Weight :', 2F7.3, 14F7.2)
99992 FORMAT ('Atom Number :', 16I7)
99991 FORMAT ('Atom Types  : ', 16(4X, A, 1X))
99990 FORMAT ('Elem. Type  : ', 16(4X, A, 1X))
99989 FORMAT (132('-'), /, 'Flags Label', 9X,
     1 'Fractional Coordinates (x,y,z)', 10X,
     2 'Orthogonal Coordinates (XO,YO,ZO)', 3X, 'Site SSN*SSOF =', 4X,
     3 'S.O.F', 3X, 'Move Type', /, 132('-'))
99988 FORMAT ('NScat.Length:',  16F7.3)
99987 FORMAT ('Scat.Fact.f0:',  16F7.3)
99986 FORMAT ('Scat.Fact.f'':', 16F7.3)
99985 FORMAT ('Scat.Fact.f":',  16F7.3)
99984 FORMAT ('Atom Volume :', 16F7.2)
99983 FORMAT (/, A, /)
99982 FORMAT (/, 34X, 'Residue =', I4, /)
99981 FORMAT (/, 57X, 13('='), /, 56('*'), ' Residue =', I4, 1X,
     1 61('*'), /, 57X, 13('='), /)
99980 FORMAT (A)
99979 FORMAT ('Atom  Label', 5X, 'Fractional Coordinates', 3X,
     1 'Radius Sp SSN  Ppar    Move Type')
99978 FORMAT (I4, 1X, A, F8.5, 2F9.5, F7.2, 2X, A, I4, F7.3, F8.3,
     1 2X, A3)
99977 FORMAT ('Angstrom coordinates. - Input data multiplied by:',
     1         F15.5, //)
99976 FORMAT (1X)
99975 FORMAT (':: Too Many Atoms for MOLSYM')
99974 FORMAT (F8.3)
      END SUBROUTINE PLA072
      SUBROUTINE PLA073 (LIST, NSMPR)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23), VOID(NVD)
      CHARACTER ICH*1, CHYB*3, IRS0*1, NOTE*1, NOTE1*1, VLAG*4
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      DIMENSION CORDN(3)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IWIN = IGBL(25) * IGBL(32)
      JBN    = 0
      IATCAR = 0
      NC2    = 0
      KL   = IPR(220)
      KN   = IPR(221)
      NATX = IPR(37)
      NAT  = IPR(39)
      NRES = IPR(75)
      LTYPE = 0
      IRS0  = ' '
      LRES  = 0
      NHATX = 0
      NCEFF = 0
      IF (LIST .GT. 0) THEN
        IF (IWIN .EQ. 1) CALL GGIP (HORS, VERT, 0.0, 1)
        IF (KN .GT. 0) LRES = NINT(FN(1))
        IF (KL .GT. 2) CALL PLA037 (3, LTYPE, 2)
        NDLPM = 1
      ELSE
        NDLPM = 2
        PAGET = 'GEOMETRY'
      END IF
      IF (IPR(147) .NE. 0) THEN
        IF (IGBL(31) .EQ. 4) THEN
          REWIND (UNIT = LU2, IOSTAT = IOST)
          IF (IOST .NE. 0) CALL GEN148 (LU2, 1)
          WRITE (LU2, 99989, IOSTAT = IOST)
        END IF
        VRT = 0.0
        DO N = 1, NRES
          NRS  = N
          NADD = 0
          IF (RCONT(NRS) .LT. IPR(487)) NADD = 1
          IF (IGBL(31) .EQ. 4) THEN
            CALL GEN040 (NRS, NQ1, IP)
            WRITE (LU2, 99982, IOSTAT = IOST) NQ1(1:IP)
            JBN = NP1
          END IF
          IF (LIST .LT. 0) THEN
            IF (IGBL(63) .GT. 2) THEN
              IF (NRS .EQ. 1) THEN
                CALL PLA262 (-11)
                WRITE (LU7, 99998, IOSTAT = IOST)
              END IF
              IF (NRES .GT. 1) THEN
                CALL PLA262 (-5)
                WRITE (LU7, 99994, IOSTAT = IOST) NRS
              END IF
              CALL PLA262 (3)
              WRITE (LU7, 99997, IOSTAT = IOST)
            END IF
          ELSE
            IF (IWIN .EQ. 0) THEN
              IF (NRES .GT. 1) WRITE (LU6, 99995, IOSTAT = IOST) N
              WRITE (LU6, 99977, IOSTAT = IOST) PRBUF(1:80)
            END IF
          END IF
          NDIS = 0
          DO NDLP = 1, NDLPM
            NRAT  = 0
            NHRAT = 0
            DO I = 1, NAT
              IAT    = I
              UEQAVR = 0.0
              NUEQ   = 0
              NROX   = 0
              NROX0  = 0
              NRFL   = 0
              NRCAR  = 0
              CALL GEN048 (-6, IFG(1, IAT), 9, IRESI)
              IF (NRS .EQ. IRESI) THEN
                CALL GEN048 (-1, IFG(1, IAT), 7,  IHAT)
                CALL PLA036 (IAT, 1, 2, IDS1, IDUM1, IDUM2, IPR(71),
     1                       IGBL(55))
                IF (IDS1 .GE. 500) THEN
                  IF (NDLP .EQ. 2) CYCLE
                ELSE
                  IF (NDLP .EQ. 1) CYCLE
                  NDIS = NDIS + 1
                  IF (NDIS .EQ. 1 .AND. IGBL(63) .GT. 2) THEN
                    CALL PLA262 (3)
                    WRITE (LU7, 99999, IOSTAT = IOST) '<'
                  END IF
                END IF
                CALL GEN048 (-4, IFG(1, IAT), 15, NO1)
                NO1 = NO1 + 1
                IATAK = IATPR(IEN(NO1))
                IF (IATAK .EQ. 5 .OR. IATAK .EQ. 6) THEN
                  IATALK = 1
                ELSE
                  IATALK = 0
                END IF
                IF (IGBL(31) .EQ. 4) THEN
                  IF (IEN(NO1) .EQ. 2) THEN
                    IATCAR = 1
                  ELSE
                    IATCAR = 0
                  END IF
                  IF (NDLP .EQ. 1 .AND. IEN(NO1) .NE. 1) THEN
                    NHRAT = NHRAT + 1
                    JNSC(1, IAT) = NHRAT
                  END IF
                END IF
                CALL GEN048 (-1, IFG(1, IAT), 19, IMET)
                IATMET = IMET
                IF (LIST .LT. 0) THEN
                  IF (IEN(NO1) .EQ. 1) THEN
                    IF (NHATX .EQ. 0) THEN
                      IF (IGBL(63) .GT. 2) THEN
                        CALL PLA262 (1)
                        WRITE (LU7, 99986, IOSTAT = IOST)
                      END IF
                      NHATX = 1
                    END IF
                  ELSE
                    IF (NHATX .EQ. 1) THEN
                      IF (IGBL(63) .GT. 2) THEN
                        CALL PLA262 (1)
                        WRITE (LU7, 99986, IOSTAT = IOST)
                      END IF
                      NHATX = 0
                    END IF
                  END IF
                END IF
                NOTE  = ' '
                NOTE1 = ' '
                KMT   = 0
                DMX   = 0.0
                DMN   = 999.0
                DMNNH = 0.0
                NRAT  = NRAT + 1
                NBNDS = 0
                NC    = - NINT(CON(IAT, NP4))
                IF (NC .LT. 0) THEN
                  NC = NP4
                  CALL GEN048 (-1, IFG(1, IAT), 8, IVAL)
                  IF (IVAL .GT. 0) NC = NC + IPR(76)
                END IF
                PNC   = 0
                NRMET = 0
                KATS  = 0
                IDISO = 0
                NCSUM = 0
                DO J = 1, NP4
                  IF (J .GT. NC) THEN
                    NAMS(J, 1) = ' -------'
                  ELSE
                    IF (J .LE. NP4) THEN
                      KAT = NINT(CON(IAT, J))
                    ELSE
                      IF (IBON(J - NP4, 1) .NE. IAT) CYCLE
                      KAT = IBON(J - NP4, 2)
                    END IF
                    KAT = MOD(KAT, NP1)
                    CALL GEN048 (-1, IFG(1, KAT), 7, JHAT)
                    CALL GEN048 (-4, IFG(1, KAT), 15, NO3)
                    NO3 = NO3 + 1
                    IF (IEN(NO3) .EQ. 2) NRCAR = NRCAR + 1
                    IF (NRCAR .EQ. 1) THEN
                      CALL PLA050 (IAT, KAT, 0, 0, DIST)
                      CORDN(1) = DIST
                    ENDIF
                    IF (IEN(NO3) .EQ. 3) THEN
                      NROX = NROX + 1
                      IF (NROX .LT. 3) THEN
                        NCKAT = - NINT(CON(KAT, NP4))
                        IHAT2 = -1
                        IF (NCKAT .EQ. 2) THEN
                          IAT1 = NINT(CON(KAT, 1))
                          IAT2 = NINT(CON(KAT, 2))
                          IF (IAT2 .EQ. IAT) CALL GEN014 (IAT1, IAT2)
                          CALL GEN048 (-1, IFG(1, IAT2), 7, IHAT2)
                        ENDIF
                        IF (IHAT2 .NE. 0) THEN
                          NROX0 = NROX0 + 1
                          CALL PLA050 (IAT, KAT, 0, 0, DIST)
                          CORDN(NROX0 + 1) = DIST
                          CALL GEN048 (-7, IFG(2, KAT), 1, IPOP)
                          IDISO = IDISO + IPPR (IPOP + 1, 1)
                        ENDIF
                      ENDIF
                    ELSE IF (IEN(NO3) .EQ. 38) THEN
                      NRFL = NRFL + 1
                    ENDIF
                    IF (LIST .EQ. -2 .AND. KAT .LE. NATX) THEN
                      IF (JHAT .EQ. 0) THEN
                        NUEQ   = NUEQ   + 1
                        UEQAVR = UEQAVR + DATC(KAT)
                        KATS   = KAT
                      END IF
                    END IF
                    CALL GEN048 (-1, IFG(1, KAT), 19, KATMET)
                    NRMET = NRMET + KATMET
                    CALL GEN048 (-4, IFG(1, KAT), 15, NOK)
                    NOK = NOK + 1
                    IF (IGBL(31) .EQ. 4) THEN
                      IF (JHAT .EQ. 0 .AND. NDLP .EQ. 1) THEN
                        IF (IEN(NOK) .EQ. 2) THEN
                          KATCAR = 1
                        ELSE
                          KATCAR = 0
                        END IF
                        IF ((IATMET .NE. 1 .OR. KATCAR .NE. 1) .AND.
     1                    (KATMET .NE. 1 .OR. IATCAR .NE. 1)) THEN
                          CALL PLA036 (KAT, 1, 2, IDS2, IDUM1, IDUM2,
     1                                 IPR(71), IGBL(55))
                          IF (IDS2 .GT. 500) THEN
                            NBNDS = NBNDS + 1
                            IF (KAT .GT. IAT) THEN
                              JBN = JBN + 1
                              JNSC(1, JBN) = IAT
                              JNSC(2, JBN) = KAT
                            END IF
                          END IF
                        END IF
                      END IF
                    END IF
                    CALL PLA036 (KAT, J, 1, IDS2, MNUM, ISPOS,
     1                           IPR(71), IGBL(55))
                    NCSUM = NCSUM + IDS2
                    CALL GEN048 (-1, IFG(1, KAT), 19, KMET)
                    KMT = KMT + 1
                    IF (IDS1 .NE. 0) THEN
                      PNC = PNC + MIN (1.0, FLOAT(IDS2) / FLOAT(IDS1))
                    ELSE
                      PNC = PNC + 1.0
                    END IF
                    IF (LIST .LT. 0) THEN
                      CALL PLA050 (IAT, KAT, 0, 0, DIST)
                      DMX = MAX (DMX, DIST)
                      DMN = MIN (DMN, DIST)
                      IF (JHAT .EQ. 0) THEN
                        DMNNH = DMNNH + DIST
                      END IF
                      IF (KMET .EQ. 1) IMET = IMET + 1
                    END IF
                  END IF
                END DO
                IF (LIST .GT. 0) THEN
                  WRITE (PRBUF, 99992, IOSTAT = IOST)
                  IF (IWIN .EQ. 1 .AND. VRT .EQ. 0.0) THEN
                    VRT = VERT - 0.4
                    CALL GGIP09 (0.0, PRBUF, 80, 0.3, 5 + IGBL(68), 2,
     1                           1.0, VRT)
                    VRT = VRT - 0.2
                  END IF
                  IF (LTYPE .EQ. 0   .AND. LRES .EQ. 0   .OR.
     1                LTYPE .EQ. 0   .AND. LRES .EQ. NRS .OR.
     2                LTYPE .EQ. NO1 .AND. LRES .EQ. 0   .OR.
     3                LTYPE .EQ. NO1 .AND. LRES .EQ. NRS) THEN
                        WRITE (PRBUF, 99991, IOSTAT = IOST)
     1                    NRAT, NAMS(1, 2), (NAMS(L, 1)(1:8), L = 1, 8)
                    IF (IWIN .EQ. 1) THEN
                      IF (VRT - 0.4 .LT. 0.0) THEN
                        CALL PLA013 (1, 1)
                        ICH = IGGT(1:1)
                        CALL GGIP (HORS, VERT, 0.0, 1)
                        IF (ICH .NE. 'Y' .AND. ICH .NE. '!') RETURN
                        VRT = VERT
                      END IF
                      VRT = VRT - 0.4
                      CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0,
     1                             VRT)
                    ELSE
                      WRITE (LU6, 99984, IOSTAT = IOST) PRBUF(1:80)
                    END IF
                  END IF
                  GO TO 10
                END IF
                INC = NINT(PNC)
                IF (IATMET .EQ. 1) THEN
                  IF (IGBL(97) .NE. 0 .AND. IATALK .EQ. 0) THEN
                    IF (NAMS(1, 2)(2:3) .NE. 'Cg') THEN
                      IF (IAT .LE. NATX) THEN
                        IF (INC .EQ. 0) THEN
C * ALERT _307
                          CALL PLA231 (307, 1, 1.0, 1.0, NAMS(1, 2),
     1                                 ' ')
                        ELSE IF (INC .EQ. 1) THEN
C * ALERT _308
                          CALL PLA231 (308, 1, 1.0, 1.0, NAMS(1, 2),
     1                                 ' ')
                        END IF
                      END IF
                    END IF
                  END IF
                END IF
                IF (IEN(NO1) .EQ. 1) THEN
                  IF (INC .NE. 1 .AND. IMET .EQ. 0) NOTE = 'V'
                  IF (IAT .LE. NATX .AND. IDS1 .EQ. 1000) THEN
                    IF (NCSUM .GT. 1001 .AND. IGBL(94) .EQ. 0) THEN
                      YUNK = NCSUM / 1000.0
C * ALERT _303
                      IF (IMET .EQ. 0) THEN
                        CALL PLA231 (303, 2, YUNK, YUNK,
     1                    NAMS(1, 2), ' ')
                      ELSE
                        CALL PLA231 (303, 2, -999.0, YUNK,
     1                    NAMS(1, 2), ' ')
                      END IF
                    END IF
                    IF (INC .EQ. 0) THEN
                      IPR(153) = IPR(153) + 1
C * ALERT _305
                      CALL PLA231 (305, 1, 1.0, 1.0, NAMS(1, 2), ' ')
                    END IF
                  END IF
                END IF
                IF (IEN(NO1) .EQ. 2 .AND. KMT .LE. 1 .AND.
     1             (INC .EQ. 0 .OR. INC .GT. 4)) NOTE = 'V'
                IF (NC .EQ. 0) DMN = 0.0
                IF (IEN(NO1) .EQ. 3 .AND. IAT .LE. NATX) THEN
                  IF (INC .EQ. 0) THEN
                    NOTE = 'V'
                    IPR(161) = IPR(161) + 1
                    IF (IDS1 .EQ. 1000) THEN
C * ALERT _306
                      CALL PLA231 (306, 1, 1.0, 1.0, NAMS(1, 2), ' ')
                    ELSE
C * ALERT _311
                      CALL PLA231 (311, 1, -999.0, 1.0,
     1                  NAMS(1, 2)(2:), ' ')
                    END IF
                  ELSE IF (INC .EQ. 1 .AND. PNC .LT. 1.3) THEN
                    KAT = NINT(CON(IAT, 1))
                    CALL GEN048 (-4, IFG(1, KAT), 15, NO2)
                    IF (IEN(NO2 + 1) .EQ. 2) THEN
                      CALL PLA050 (IAT, KAT, 0, 0, DIST)
                      IF (DIST .GT. 1.3) THEN
                        YUNK = 1.0
                        DO LAT = 1, NATX
                          CALL GEN048 (-1, IFG(1, LAT), 20, IDH)
                          IF (IDH .EQ. 1) THEN
                            CALL PLA050 (IAT, LAT, 0, 0, DIST)
                            IF (DIST .LT. 2.0) THEN
                              YUNK = -999.0
                              EXIT
                            END IF
                          END IF
                        END DO
                        CALL PLA047 (LABA(IAT), NQ1, IDUM, JDUM,
     1                               IPR(71), IGBL(55), 0, 0)
C * ALERT _309
                        CALL PLA231 (309, 1, YUNK, 1.0, ' '//NQ1, ' ')
                      END IF
                    END IF
                  ELSE IF (INC .EQ. 2) THEN
                    KAT = NINT(CON(IAT, 1))
                    LAT = NINT(CON(IAT, 2))
                    CALL GEN048 (-1, IFG(1, KAT), 19, METK)
                    CALL GEN048 (-1, IFG(1, LAT), 19, METL)
                    CALL GEN048 (-4, IFG(1, KAT), 15, NO2)
                    IF (IEN(NO2 + 1) .EQ. 2) THEN
                      CALL PLA050 (IAT, KAT, 0, 0, DIST)
                      IF (DIST .LT. 1.25) THEN
                        CALL GEN048 (-4, IFG(1, LAT), 15, NO2)
                        IF (IEN(NO2 + 1) .EQ. 1) THEN
                          CALL PLA047 (LABA(IAT), NQ1, IDUM, JDUM,
     1                                 IPR(71), IGBL(55), 0, 0)
C * ALERT _312
                          CALL PLA231 (
     1                       312, 1, 1.25 - DIST, 1.0, ' '//NQ1, ' ')
                        END IF
                      END IF
                    END IF
                    CALL PLA050 (KAT, IAT, LAT, 0, ANG3)
                    IF (ANG3 .GT. 120) THEN
                      IF (METK .EQ. 0 .AND. METL .EQ. 0) THEN
                        CALL GEN048 (-4, IFG(1, KAT), 15, NOK)
                        CALL GEN048 (-4, IFG(1, LAT), 15, NOL)
                        IF (IEN(NOK + 1) .EQ. 85 .AND.
     1                      IEN(NOL + 1) .EQ. 85) THEN
C * ALERT _396
                          IF (ABS(ANG3 - 150.0) .GT. 10.0) CALL PLA231
     1                      (396, 1, -999.9, ANG3, NAMS(1, 2), ' ')
                        ELSE
C * ALERT _395
                          CALL PLA231 (395,
     1                      1, ANG3 - 120.0, ANG3, NAMS(1, 2), ' ')
                        END IF
                      END IF
                    END IF
                  ELSE IF (INC .EQ. 3) THEN
                    KAT1 = NINT(CON(IAT, 1))
                    KAT2 = NINT(CON(IAT, 2))
                    KAT3 = NINT(CON(IAT, 3))
                    CALL GEN048 (-1, IFG(1, KAT1), 19, KAT1M)
                    CALL GEN048 (-1, IFG(1, KAT2),  7, KAT2H)
                    CALL GEN048 (-1, IFG(1, KAT3),  7, KAT3H)
                    IF (KAT1M * KAT2H * KAT3H .NE. 0) THEN
                      CALL PLA050 (KAT1, IAT, KAT2, 0, ANGH1)
                      CALL PLA050 (KAT1, IAT, KAT3, 0, ANGH2)
                      CALL PLA047 (LABA(IAT), NQ1, IDUM, JDUM,
     1                             IPR(71), IGBL(55), 0, 0)
                        CALL PLA047 (LABA(KAT2), NQ2, IDUM, JDUM,
     1                               IPR(71), IGBL(55), 0, 0)
                        CALL PLA047 (LABA(KAT3), NQ3, IDUM, JDUM,
     1                               IPR(71), IGBL(55), 0, 0)
                      IF (ANGH1 .LT. 95.0) THEN
                        CALL PLA231 (314, 2, 1.0, ANGH1, NQ1, NQ2)
                      END IF
                      IF (ANGH2 .LT. 95.0) THEN
                        CALL PLA231 (314, 2, 1.0, ANGH2, NQ1, NQ3)
                      END IF
                    ELSE
                      DISTM = 0.0
                      DO LL = 1, 3
                        KAT = NINT(CON(IAT, LL))
                        CALL PLA050 (IAT, KAT, 0, 0, DIST)
                        DISTM = MAX (DISTM, DIST)
                      END DO
                      IF (DISTM .LT. 1.6 .AND. IDS1 .EQ. 1000) THEN
                        CALL PLA047 (LABA(IAT), NQ1, IDUM, JDUM,
     1                               IPR(71), IGBL(55), 0, 0)
C * ALERT _313
                        CALL PLA231 (313, 0, 1.0, 1.0, NQ1, ' ')
                      END IF
                    END IF
                  END IF
                END IF
                CALL PLA099 (1, IAT, NANG, ANG1, ANG2, ANG3, NOTE1)
                CALL GEN048 ( -4, IFG(1, IAT), 24, IHYB)
                CALL GEN048 ( -3, IFG(2, IAT), 24, NATH)
                CALL GEN048 ( -4, IFG(3, IAT), 28, NCEFF)
                CALL GEN048 (-10, IFG(2, IAT), 14, LNR)
                IF (IAT .LE. NATX .OR. IPR(322) .EQ. 0) THEN
                  IF (IHYB .EQ. 1) THEN
                    CHYB = 'sp '
                  ELSE IF (IHYB .EQ. 2) THEN
                    CHYB = 'sp2'
                  ELSE IF (IHYB .EQ. 3) THEN
                    CHYB = 'sp3'
                  ELSE
                    CHYB = '   '
                  END IF
                END IF
                IF (IPR(324) .EQ. 1) THEN
                  IRS0 = ' '
                  IF (IHYB .EQ. 3) THEN
                    CALL GEN048 (-2, IFG(1, IAT), 28, JCAI)
                    IF (JCAI .EQ. 1) THEN
                      IRS0 = 'S'
                    ELSE IF (JCAI .EQ. 2) THEN
                      IRS0 = '?'
                    ELSE IF (JCAI .EQ. 3) THEN
                      IRS0 = 'R'
                    END IF
                  END IF
                END IF
                VLAG = '-   '
                IF (IABS(IGBL(8)) .EQ. 3) THEN
                  VLAG = 'd   '
                  CALL GEN048 (-1, IFG(2, IAT), 29, IVLAG)
                  IF (IVLAG .EQ. 1) VLAG(1:1) = 'c'
                  CALL GEN048 (-1, IFG(2, IAT), 30, IVLAG)
                  IF (IVLAG .EQ. 1) VLAG(2:2) = 'R'
                  CALL GEN048 (-1, IFG(2, IAT), 31, IVLAG)
                  IF (IVLAG .EQ. 1) VLAG(2:2) = 'G'
                END IF
                IF (IGBL(31) .EQ. 4 .AND. IEN(NO1) .NE. 1) THEN
                  IF (NDLP .EQ. 1) THEN
                    CALL GEN040 (NHRAT, NQ1, IP)
                    JX1 = IEL(IEN(NO1))
                    J1  = JX1 / 100
                    J2  = MOD(JX1, 100)
                    NQ1(5 : 5) = CHAR(ICHAR('A') + J1 - 1)
                    IF ( J2 .NE. 0) THEN
                      NQ1(6 : 6) = CHAR(ICHAR('A') + J2 - 1)
                    ELSE
                      NQ1(6 : 6) = ' '
                    END IF
                    WRITE (LU2, 99981, IOSTAT = IOST)
     1                NQ1(1:IP), NQ1(5:6), NBNDS
                  END IF
                END IF
                IF (IAT .LE. NATX) THEN
                  IF (IEN(NO1) .EQ. 4) THEN
                    IF (NRMET .GT. 0 .AND. NCEFF .EQ. 3 .AND.
     1                DMN .GT. 1.45 .AND. ANG3 .LT. 114.0) THEN
C * ALERT _324 +
                      CALL PLA231 (
     1                  324 + NADD, 1, 1.0, 1.0, NAMS(1, 2), ' ')
                      NOTE = '?'
                    END IF
                    IF (IHYB  .EQ. 0 .AND. NRMET. EQ. 0 .AND.
     1                  NCEFF .EQ. 3 .AND. DMN .LT. 1.1 .AND.
     2                  DMNNH .GT. 2.8 .AND. ANG3 .EQ. 120.0) THEN
C * ALERT _318 +
                      CALL PLA231 (
     1                  318 + NADD, 1, -999.0, 1.0, NAMS(1, 2), ' ')
                    END IF
                  ELSE IF (IEN(NO1) .EQ. 2) THEN
                    IF (NCEFF .EQ. 3 .AND. NRMET .EQ. 0) THEN
                      IF (DMN .GT. 1.45 .AND. ANG3 .LT. 112.0) THEN
C * ALERT _326 +
                        CALL PLA231 (
     1                    326 + NADD, 1, 1.0, 1.0, NAMS(1, 2), ' ')
                        NOTE = '?'
                      END IF
                    END IF
                  ELSE IF (IEN(NO1) .EQ. 8) THEN
                    IF (NCEFF .EQ. 3 .AND. NRMET .GT. 0) THEN
C * ALERT _328
                      IF (ANG3 .LT. 115.0) THEN
                        CALL PLA231 (
     1                   328, 1, -999.0, 1.0, NAMS(1, 2), ' ')
                      END IF
                    END IF
                  END IF
                END IF
                IF (NAMS(1, 2)(1:1) .EQ. CHAR(32)) THEN
                  DO LL = 1, NP4
                    IF (NAMS(LL, 1)(1:1) .NE. CHAR(32)) THEN
                      NOTE  = ' '
                      NOTE1 = ' '
                      EXIT
                    END IF
                  END DO
                  IF (NOTE  .EQ. 'V') IPR(102) = IPR(102) + 1
                  IF (NOTE1 .EQ. 'A') IPR(103) = IPR(103) + 1
                ELSE
                  NOTE  = ' '
                  NOTE1 = ' '
                END IF
                IF (IPR(483) .GT. 0 .AND. IPR(484) .GT. 0) THEN
                  NADD1 = NADD
                  IF (IEN(NO1) .NE. 2) THEN
                    IF (NADD1 .EQ. 0) THEN
                      NADD1 = 2
                    ELSE IF (NADD1 .EQ. 1) THEN
                      NADD1 = 3
                    END IF
                  END IF
                  IF (IAT .LT. NATX) THEN
C * ALERT _343 +
                    IF (NOTE1 .EQ. 'A') THEN
                      CALL PLA231 (343 + NADD1, 1, -999.0, 0.0,
     1                             CHYB, NAMS(1, 2))
                    ELSE IF (NOTE1 .EQ. '?') THEN
C * ALERT _343 +
                      CALL PLA231 (343 + NADD1, 1, -999.0, 0.0,
     1                             'sp?', NAMS(1, 2))
                    ELSE IF (NOTE1 .EQ. 'H') THEN
C * ALERT _316 +
                      CALL PLA231 (316 + NADD1, 1, 1.0, 1.0,
     1                             NAMS(1, 2), ' ')
                    END IF
                  END IF
                END IF
                IF (NOTE .NE. ' ' .OR. NOTE1 .NE. ' ') THEN
                  WRITE (LU6, 99996, IOSTAT = IOST) NAMS(1, 2),
     1              (NAMS(LL, 1), LL = 1, 7), NOTE, NOTE1
                END IF
                IF (IGBL(63) .GT. 2) THEN
                  CALL PLA262 (1)
                  WRITE (LU7, 99993, IOSTAT = IOST) VLAG, NAMS(1, 2),
     1             (NAMS(LL, 1), LL = 1, NP4), NANG, NINT(ANG1),
     2             NINT(ANG2), ANG3, DMN, DMX, NCEFF, LNR, CHYB, IRS0,
     3             NOTE, NOTE1
                END IF
                IF (IRS0 .NE. ' ') WRITE (LU6, 99990, IOSTAT = IOST)
     1            NAMS(1, 2), NRS, LNR, IRS0
                IF (LIST .EQ. -2 .AND. IAT .LE. NATX) THEN
                  NQ4  = NAMS(1, 2)(2 : 8)
                  IF (NC .EQ. 3 .AND. NRCAR .EQ. 1 .AND. NROX0 .EQ. 2
     1              .AND. IDISO .EQ. 2000) THEN
                    DISTSUM = CORDN(2) + CORDN(3)
C * ALERT _782 - TEST FOR C-CO2
                    IF (IEN(NO1) .EQ. 2) THEN
                      IF (DISTSUM .LT. 2.48 .AND. CORDN(1) .LT. 1.48)
     1                  THEN
                        IF (DISTSUM .LT. 2.45) THEN
                          YUNK = 1.5
                        ELSE
                          YUNK = 0.5
                        END IF
                        CALL PLA231 (782, 0, YUNK, YUNK, 'C-CO2', NQ4)
                      END IF
C * ALERT _782 - TEST FOR C-NO2
                    ELSE IF (IEN(NO1) .EQ. 4) THEN
                      IF (DISTSUM .GT. 2.48 .AND. CORDN(1) .GT. 1.48)
     1                  CALL PLA231 (782, 0, 1.5, 1.5, 'C-NO2', NQ4)
                    ENDIF
                  ENDIF
                  IF (IHAT .EQ. 0) THEN
                    IF (NUEQ .GT. 1) THEN
                      UEQAVR = UEQAVR / NUEQ
                      DUEQ   = DATC(IAT) - UEQAVR
                      NADD2  = 0
                      IF (RCONT(NRS) .LT. IPR(487) .AND. NRES .GT. 1)
     1                  NADD2 = 2
C * ALERT _241 & _243 - TEST HIGH Ueq
                      IF (IDS1 .EQ. 1000) THEN
                        IF (DUEQ .GT. 0.005) THEN
                          CALL PLA231 (241 + NADD2, 3, DUEQ, DUEQ,
     1                      NQ4, ' ')
                        ELSE IF (- DUEQ .GT. 0.005) THEN
C * ALERT _242 & _244
                          IENNO1 = IEN(NO1)
                          IF ((IENNO1 .EQ. 5  .AND. NROX .EQ. 4) .OR.
     1                        (IENNO1 .EQ. 2  .AND. NRFL .GE. 3) .OR.
     1                        (IENNO1 .EQ. 20 .AND. NRFL .EQ. 4) .OR.
     2                        (IENNO1 .EQ. 8  .AND. NRFL .GE. 6)) THEN
                            IF (DATC(IAT) .LT. 0.025) THEN
                              CALL PLA231 (242 + NADD2, 3, - DUEQ,
     1                          - DUEQ, NQ4, ' ')
                            ELSE
                              CALL PLA231 (242 + NADD2, 3, -999.0,
     1                          - DUEQ, NQ4, ' ')
                            END IF
                          ELSE
                            CALL PLA231 (242 + NADD2, 3, - DUEQ,
     1                        - DUEQ, NQ4, ' ')
                          END IF
                        END IF
                      END IF
                    END IF
                  ELSE
                    IF (KATS .GT. 0) THEN
                      DUEQ = DATC(IAT) - DATC(KATS)
                      CALL PLA047 (LABA(KATS), NQ3, IDUM, JDUM,
     1                  IPR(71), IGBL(55), 0, 1 - IGBL(55))
C * ALERT _245
                      IF (DUEQ .LT. 0.0) CALL PLA231 (245, 3,
     1                  -DUEQ, -DUEQ, NQ4, NQ3)
                    END IF
                  END IF
                END IF
   10           NC1 = NP4
                DO
                  NC1 = NC1 + 1
                  IF (NC1 .GT. NC) GO TO 20
                  NCL = 0
                  DO NC0 = NC1, NC
                    NC2 = NC0
                    IF (IBON(NC0 - NP4, 1) .EQ. IAT) THEN
                      NCK = MOD(IBON(NC0 - NP4, 2), NP1)
                      NCL = NCL + 1
                      CALL PLA036 (NCK, NCL, 1, IDIS, MNUM, ISPOS,
     1                             IPR(71), IGBL(55))
                      IF (NCL .EQ. NP4) EXIT
                    END IF
                  END DO
                  IF (NCL .GT. 0) THEN
                    IF (LIST .GT. 0) THEN
                      WRITE (LU6, 99988, IOSTAT = IOST)
     1                  (NAMS(LL, 1)(2:7), LL = 1, NCL)
                    ELSE
                      IF (IGBL(63) .GT. 2) THEN
                        CALL PLA262 (1)
                        WRITE (LU7, 99987, IOSTAT = IOST)
     1                    (NAMS(LL, 1), LL = 1, NCL)
                      END IF
                    END IF
                  END IF
                  NC1 = NC2
                END DO
              END IF
   20         CONTINUE
            END DO
          END DO
          IF (IGBL(31) .EQ. 4) THEN
            DO K = NP1 + 1, JBN
              WRITE (LU2, 99980, IOSTAT = IOST) JNSC(1, JNSC(1, K)),
     1                           JNSC(1, JNSC(2, K))
            END DO
            WRITE (LU2, 99978, IOSTAT = IOST)
          END IF
        END DO
        IF (IGBL(31) .EQ. 4) THEN
          IF (IPR(322) .EQ. 0) THEN
            CALL PLA294 (0)
          ELSE
            CALL PLA015 (0, 27)
          END IF
        END IF
C * PRINT SYMMETRY CODES
        CALL PLA043 (NSMPR, 1, LU7, 0)
      END IF
      IF (IWIN .EQ. 1 .AND. LIST .GT. 0) CALL PLA297 (0)
      RETURN
99999 FORMAT (/, 'Disordered Atoms with S.O.F ', A, ' 0.5', /)
99998 FORMAT ('Analysis of Bond Distance and Angle Values',
     1 ' - Identification of Chiral Center(s) and Their (R/S)-',
     2 'Configuration (Cahn-Ingold-Prelog)', /, 132('='), /,
     3 4X, 'The Following Tests are done. Faults are Marked ',
     4 'Under Note', /, 4X, '-- V : Valency Check Fault for H, C ', /,
     5 4X, '-- S : Bond Too Short ', /, 4X, '-- A : Unusual Bond Angle',
     6 ' Values (PLEASE CHECK)', /, 132('='), /,
     7 ' *** PLEASE NOTE: R/S ASSIGNMENTS ARE TENTATIVE  ***',
     8 ' (CIP Special rules NOT Implemented)', /,
     9 ' *** See Angew.Chem.Intern. Ed. Eng.,(1966),5,385 & ',
     * '(1982),21,567 for Authoritative Details for Special Cases', /)
99997 FORMAT (87X, '=A.N.G.L.E.S=   =B.O.N.D.S=', /, 'Flag Label  -',
     1 ' Connected to  (May be Incomplete for Polymeric Structures)',
     2 12X, 'nra min max  Aver  min', 3X,
     3 'max nrb tnr Hyb RS Note', /, 132('-'))
99996 FORMAT ('N: ', A, ' : ', 7(A), 1X, 2A)
99995 FORMAT (/, 34X, 'Residue =', I4, /)
99994 FORMAT (/, 57X, 13('='), /, 56('*'), ' Residue =', I4, 1X,
     1 61('*'), /, 57X, 13('='), /)
99993 FORMAT (A, A, '-', 9(A), I2, 2I4, F6.1, 2F6.3, I3, I4, 1X,
     1 A3, 2X, A, 2X, 2A)
99992 FORMAT ('Atom  Label  - Bonded to ')
99991 FORMAT (I4, 1X, A, ' : ', 9(A))
99990 FORMAT ('::', A, ' RES =', I5, ' LNR =', I5, ' Chiral: ', A)
99989 FORMAT ('SAVE 3')
99988 FORMAT (15X, 9(A, 1X))
99987 FORMAT (13X, 9(A))
99986 FORMAT (1X)
99984 FORMAT (A)
99982 FORMAT ('T', A, ' *CONNSER')
99981 FORMAT ('AT', A, 2X, A, I5)
99980 FORMAT ('BO', 2I6, ' 99')
99978 FORMAT ('END')
99977 FORMAT (//, A, /, 80('-'))
      END SUBROUTINE PLA073
      SUBROUTINE PLA074
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER IE3*4, ISRT*4, IPROB*4, FORMA*73, FORMB*73,
     1 FORMC*73, FORMD*157, FORME*218, FORMF*188, CPLM*1, CDUM*1
      DIMENSION ISPV(8), IPLA(7, 2)
      IDUM1 = 0
      IDUM2 = 0
      IRES1 = 0
      FORMA(1:9)     = '(     A ,'
      FORMA(10:41)   = 'F8.4,''('',I4,'')'',F8.4,''('',I4,'')'','
      FORMA(42:73)   =  FORMA(10:41)
      FORMB(1:9)     = '( ''A'',I3,'
      FORMB(10:73)   =  FORMA(10:73)
      FORMC(1:29)    = '(60X,                        '
      FORMC(30:73)   =  FORMC(8:29)//FORMC(8:29)
      FORMD(74:94)   = '1X,A,F6.3,''('',I2,'')'','
      FORMD(95:136)  =  FORMD(74:94)//FORMD(74:94)
      FORMD(137:157) = '1X,A,F6.3,''('',I2,'')'')'
      FORME(1:32)    = '(I2,'','',I2,''= '',F5.2,''('',I3,'')'','
      FORME(33:63)   = 'I4,'','',I2,''= '',F5.2,''('',I3,'')'','
      FORME(64:156)  =  FORME(33:63)//FORME(33:63)//FORME(33:63)
      FORME(157:187) =  FORME(33:63)
      FORME(188:218) = 'I4,'','',I2,''= '',F5.2,''('',I3,'')'')'
      FORMF(1:18)    = '(   3A,I2,''M =  '','
      FORMF(19:52)   = 'F6.2,''('',I2,''),'',F6.2,''('',I2,''),'','
      FORMF(53:154)  =  FORMF(19:52)//FORMF(19:52)//FORMF(19:52)
      FORMF(155:188) = 'F6.2,''('',I2,''),'',F6.2,''('',I2,''),'')'
      IF (IPR(147) .GT. 0) THEN
        CALL GEN108 (LU8, 0)
        SD    = 0.0
        NMAX  = IPR(39)
        NLSPL = 0
C * LOOP OVER PLANES
        DO
          READ (LU8, IOSTAT = IOST) MARK, IPR(12), JR, RMAT
          IF (IOST .NE. 0) RETURN
          IF (MARK .LT. 0) THEN
            IF (MARK .EQ. -100) EXIT
            READ (LU8)
          ELSE
            READ (LU8) (IATP(L4), L4 = 1, NMAX)
            NLSPL = NLSPL + 1
            IF (NLSPL .EQ. 1) THEN
              IF (IPR(41) .EQ. 0) THEN
                IE3 = 'UNIT'
              ELSE IF (IPR(41) .EQ. 1) THEN
                IE3 = 'ATWT'
              ELSE
                IE3 = 'ESD '
              END IF
              IF (IGBL(63) .GT. 2) THEN
                CALL PLA262 (- 15 - IPR(155) * 3)
                WRITE (LU7, 99998, IOSTAT = IOST)
     1            IPR(579), PAR(49), PAR(76), IE3
                IF (IPR(155) .GT. 0)
     1            WRITE (LU7, 99995, IOSTAT = IOST) IPR(217), IPR(159)
                WRITE (LU7, 99997, IOSTAT = IOST)
              END IF
            END IF
            IF (NLSPL .GT. NP2) RETURN
            CALL PLA055
            DO I = 1, 4
              K = I + 4
              XLS(I, NLSPL) = XPV(I)
              XLS(K, NLSPL) = XSPV(I)
              IFT = -3 + 16 * I
              CALL GEN041 (XPV(I), XSPV(I), ISPV(I), 4, NDEC, IPR(68))
              FORMA(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
              CALL GEN041 (XPV(K), XSPV(K), ISPV(K), 4, NDEC, IPR(68))
              FORMB(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
            END DO
            CPLM = '#'
            IF (MARK .EQ. 1) THEN
              ISRT = 'Plan'
            ELSE IF (MARK .EQ. 2) THEN
              ISRT = 'Ring'
            ELSE IF (MARK .EQ. 3) THEN
              ISRT = 'Resd'
            ELSE IF (MARK .EQ. 4) THEN
              ISRT = 'Lspl'
              IPR(19) = IPR(19) + 1
            ELSE IF (MARK .EQ. 5) THEN
              ISRT = 'Crdn'
            END IF
            DO I = 1, 8
              ISPV(I) = MIN (99, ISPV(I))
            END DO
            SGREF = 0
            SDK   = 0
            NATP  = IPR(12)
            DO J = 1, NATP
              IP = IATP(J)
              SGREF = SGREF + XSD(IP, 4) + XSD(IP, 5) + XSD(IP, 6)
              D = - XPV(4)
              DO I = 1, 3
                D = D + XPV(I) * XXO(IP, I + 3)
              END DO
              SDK = SDK + D**2
            END DO
            SIGPL = 0
            IF (NATP .GT. 3) SIGPL = SQRT(SDK / (NATP - 3))
            SGREF = SQRT(SGREF / (NATP * 3))
            CHIK  = 0.0
            IF (SGREF .GT. PAR(12))
     1        CHIK = MIN (999999.9, SDK / SGREF**2)
              IDOF  = NATP - 3
              IF (IPR(72) .NE. 0) THEN
              CALL GEN093 (IDOF, CHIK, IPROB)
            ELSE
              IPROB = '    '
            END IF
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (3)
              WRITE (LU7, 99999, IOSTAT = IOST)
     1          NLSPL, SGREF, SIGPL, CHIK, IPROB
            END IF
            MLL = 0
            ISX = 0
C * CALCULATE PLANE DEVIATIONS
            DO II = 1, NMAX
              IATPI = MOD(IATP(II), NP1)
              CALL GEN048 (-1, IFG(1, IATPI), 7, IVAL)
              IF (IVAL .EQ. 1 .AND. II .GT. NATP) THEN
                IF (II .EQ. NMAX) GO TO 10
                CYCLE
              END IF
              CALL GEN048 (-6, IFG(1, IATPI), 9, IRESII)
              IF (II .EQ. 1) THEN
                IRES1 = IRESII
              ELSE IF (II .GT. NATP) THEN
                IF (IRES1 .NE. IRESII .AND. II .GT. 8) THEN
                  IF (II .EQ. NMAX) GO TO 10
                  CYCLE
                END IF
              END IF
              CALL PLA056 (XLS(1, NLSPL), IATPI, DEVMLL, SDVMLL,
     1                     ISDVML, 3, NDEC)
              IF (ABS(DEVMLL) .GT. PAR(76) .AND. II .GT. NATP) THEN
                IF (II .EQ. NMAX) GO TO 10
                CYCLE
              END IF
              CALL PLA047 (LABA(IATPI), NQ1, IDUM, JDUM, IPR(71),
     1          IGBL(55), 0, 1 - IGBL(55))
              MLL              = MLL + 1
              IF (II .GT. NATP) CPLM = ' '
              NAMS(MLL, 1)     = CPLM//NQ1
              DEV(MLL)         = DEVMLL
              SDV(MLL)         = SDVMLL
              ISDV(MLL)        = MIN (99, ISDVML)
              IFT              = 61 + MLL * 21
              FORMD(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
              IF (II .NE. NMAX) THEN
                IF (MLL .LT. 4) CYCLE
              END IF
   10         IF (ISX .EQ. 4) THEN
                FORMD(1 : 73) = FORMB
                IF (IGBL(63) .GT. 2) THEN
                  WRITE (PRBUF, FORMD, IOSTAT = IOST) IPR(12),
     1            (XPV(I + ISX), ISPV(I + ISX), I = 1, 4),
     2             (NAMS(LL, 1)(1:7), DEV(LL), ISDV(LL), LL = 1, MLL)
                  CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                END IF
                ISX = ISX + 4
              ELSE IF (ISX .GT. 4) THEN
                IF (MLL .EQ. 0) CYCLE
                FORMD(1 : 73) = FORMC
                IF (IGBL(63) .GT. 2) THEN
                  WRITE (PRBUF, FORMD, IOSTAT = IOST) (NAMS(LL, 1)(1:7),
     1              DEV(LL), ISDV(LL), LL = 1, MLL)
                  CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                END IF
              ELSE
                FORMD(1 : 73) = FORMA
                IF (IGBL(63) .GT. 2) THEN
                  WRITE (PRBUF, FORMD, IOSTAT = IOST) ISRT,
     1             (XPV(I + ISX), ISPV(I + ISX), I = 1, 4),
     2             (NAMS(LL, 1)(1:7), DEV(LL), ISDV(LL), LL = 1, MLL)
                  CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                END IF
                NAMS(1, 1) = '        '
                ISX = ISX + 4
              END IF
              MLL = 0
            END DO
          END IF
        END DO
C * INTERPLANE ANGLES AND BOND/PLANE ANGLES
        IF (NLSPL .GT. 1 .AND. IGBL(63) .GT. 0) THEN
          KB = 0
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (3)
            WRITE (LU7, 99996, IOSTAT = IOST)
          END IF
          DO I = 1, NLSPL - 1
            DO J = I + 1, NLSPL
              KB = KB + 1
              DBUF(KB) = RGBL(6) * ACOS(MIN(ABS(XLS(1, I) * XLS(1, J) +
     1           XLS(2, I) * XLS(2, J) + XLS(3, I) * XLS(3, J)), 1.0))
              A = 0
              DO K = 5, 7
                A = A + XLS(K, I)**2 + XLS(K, J)**2
              END DO
              A = RGBL(6) * SQRT(A)
              CALL GEN041 (DBUF(KB), A, ISIGA, 2, NDEC, IPR(68))
              IDBUF(KB)     = MIN (99, ISIGA)
              IPLA(KB, 1) = I
              IPLA(KB, 2) = J
              IFT         = - 11 + KB * 31
              FORME(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
              IF (KB .GE. 7) THEN
                IF (IGBL(63) .GT. 2) THEN
                 WRITE (PRBUF, FORME, IOSTAT = IOST)
     1             ((IPLA(L, M), M = 1, 2),
     2             DBUF(L), IDBUF(L), L = 1, 7)
                  CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                END IF
                KB = 0
              END IF
            END DO
          END DO
          IF (KB .GT. 0 .AND. IGBL(63) .GT. 2) THEN
            WRITE (PRBUF, FORME, IOSTAT = IOST)
     1        ((IPLA(L, M), M = 1, 2), DBUF(L),
     2        IDBUF(L), L = 1, KB)
              CALL PLA263 (LU7, PRBUF, 132, 1, 1)
          END IF
        END IF
        IF (NLSPL .GT. 0 .AND. IGBL(63) .GT. 0) THEN
          IF (IPR(40) .GT. 0) THEN
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (7)
              WRITE (LU7, 99994, IOSTAT = IOST) '>', (I, I = 1, 10)
            END IF
            KB       = 0
            IPR(133) = - IPR(368)
            IFIN     = -3
            N        = 0
            NEXB     = IPR(407) + 6
            NQ1(1:6) = 'Axes O'
            NQ2(1:6) = '--->a '
   20       IF (N .GE. 6) THEN
              N = N + 1
              IF (N .GT. NEXB) THEN
                CALL PLA038 (I, J, IFIN)
                IF (IFIN .EQ. 1) RETURN
                CDUM = '-'
              ELSE
                I = NINT(SLN(N - 6, 1))
                J = NINT(SLN(N - 6, 2))
                CALL PLA047 (LABA(I), NQ1, IDUM1, IDUM2, IPR(71),
     1                       IGBL(55), 0, 1 - IGBL(55))
                CALL PLA047 (LABA(J), NQ2, IDUM1, IDUM2, IPR(71),
     1                       IGBL(55), 0, 1 - IGBL(55))
                CDUM = '.'
              END IF
              CALL PLA227 (I, J, VECN)
              CALL PLA053 (I, J, 0, 0, D, SD, IDUM1, IDUM2, IER)
              IF (IER .NE. 0) GO TO 20
            ELSE
              N = N + 1
              IF (N .LT. 4) THEN
                NQ2(5:5) = CHAR(ICHAR('a') - 1 + N)
                D        = PAR(100 + N)
                SD       = 0.0
                DO K = 1, 3
                  VECN(K) = OR(K, N) / D
                END DO
              ELSE
                NQ2(5:6) = CHAR(ICHAR('a') - 4 + N)//'*'
                D        = PAR(109 + N)
                SD       = 0.0
                DO K = 1, 3
                  VECN(K) = ROR(N - 3, K) / D
                END DO
              END IF
              CDUM = ' '
            END IF
            IF (D .NE. 0.0) THEN
              DO K = 1, NLSPL
                KB = KB + 1
                DBUF(KB) = 90.0 - ACOS(MIN(ABS(XLS(1, K) * VECN(1) +
     1          XLS(2, K) * VECN(2) + XLS(3, K) * VECN(3)), 1.0)) *
     2          RGBL(6)
                A = 0
                DO L = 1, 3
                  A = A + XLS(L + 4, K)**2 + (VECN(L) * SD / D)**2
                END DO
                A = RGBL(6) * SQRT(A)
                CALL GEN041 (DBUF(KB), A, ISIGA, 2, NDEC, IPR(68))
                IDBUF(KB) = MIN (99, ISIGA)
                IFT = 5 + KB * 17
                FORMF(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
                IF (KB .GE. 10) THEN
                  K0 = K / 10 - 1
                  IF (IGBL(63) .GT. 2) THEN
                    IF (K0 .EQ. 0) THEN
                      NQ1(7:7) = CDUM
                      NQ2(7:7) = ' '
                      CPLM     = '/'
                    END IF
                    WRITE (PRBUF, FORMF, IOSTAT = IOST) NQ1, NQ2, CPLM,
     1                K0, (DBUF(L), IDBUF(L), L = 1, 10)
                    CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                    NQ1  = ' '
                    NQ2  = ' '
                    CPLM = ' '
                  END IF
                  KB = 0
                END IF
              END DO
            END IF
            IF (KB .GT. 0) THEN
              K0 = NLSPL / 10
              IF (IGBL(63) .GT. 2) THEN
                IF (K0 .EQ. 0) THEN
                  NQ1(7:7) = CDUM
                  NQ2(7:7) = ' '
                  CPLM     = '/'
                END IF
                WRITE (PRBUF, FORMF, IOSTAT = IOST) NQ1, NQ2, CPLM, K0,
     1                               (DBUF(L), IDBUF(L), L = 1, KB)
                CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                NQ1  = '       '
                NQ2  = '       '
                CPLM = ' '
              END IF
              KB = 0
            END IF
            GO TO 20
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (132('-'), /, 'Nr', I3, 8X, 'P', 13X, 'Q', 13X, 'R', 13X,
     1 'S', 5X, 'Sigref', F7.3, 5X, 'Sigpln', F7.3, 5X, 'Chisq ', F9.1,
     2 4X, 'Pl.Hyp.', 4X, A4, /, 132('-'))
99998 FORMAT ('Automatic Search for Rings (3 to', I3, '-Membered) and',
     1 ' Planes Determined by 4 or More Connected Atoms (with',
     2 ' Deviation <', F5.2, ' Ang.)', /, 132('-'), //,
     3 'Least-Squares Planes - P*X+Q*Y+R*Z=S   ::', 2X, 'First Line',
     4 ' Orthogonal(XO,YO,ZO), Second Line Fractional(X,Y,Z)', /,
     5 36('='), 7X, 'Ring/Plan/Resd/Lspl N Indicates that the Ring/',
     6 'Plane/Residue Involves N Atoms', /, 43X, 'Sigref - R.M.S-Error',
     7 ' of the Contributing Atoms', /, '  The Deviation D of an Atom',
     8 ' with', 10X, 'Sigpln - Sqrt(Sum(j=1:N)(D(j)**2/(N-3))',/, 43X,
     9 'Chisq  - Chi-Squared = Sum(j=1:N)(D(j)**2)/Sigref**2', /,
     * '  Fractional Coordinates X,Y,Z may be', 6X, 'Pl.Hyp. - Result',
     1 ' of the Chi.Sq. Test for Planarity (See Stout & Jensen, p424)',
     2 //, 2X, 'Calculated via Substitution in',
     3 /43X,
     4 '**** - Atoms Deviating by More Than ', F3.1, ' Angstrom and',
     5 ' Hydrogen Atoms are NOT Listed', /, 2X, 'D = P*X + Q*Y + R*Z',
     6 ' - S (2nd Line)', 7X, 'Note - Weights : ', A4)
99997 FORMAT (48X, '- Deviations from planes are in Angstrom Units', /,
     1        48X, '- The Plane determining Atoms have been Marked #',
     2     /, 48X, '- DISTANCES TO PLANES ROUNDED TO 3 DECIMALS !!',
     3        '(Use Graphical Interface for more)')
99996 FORMAT (/, '(Acute) Angles (Degrees) Between Planes ',
     1 '(Numbers I,J from List Above)', /, 132('-'))
99995 FORMAT (43X, '**** - Maximum Metal Containing Ring Size:',
     1 I6, /, 48X, '- Maximum Number of Bonds to Ring Metal:', I3)
99994 FORMAT (//, '(Acute) Angles (Degrees) Between Axes, Lines,',
     1 ' and Bonds with L.S.-Planes', /, 132('-'), /, 1X,
     2 'Bond  /  Plane NM --', A, ' M', I7, 9(I11), /, 132('-'))
      END SUBROUTINE PLA074
      SUBROUTINE PLA075
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      IF (IPR(69) .NE. 0 .AND. IPR(55) .EQ. 0) THEN
        CALL GEN108 (LU8, 0)
        NRING = 0
        NHEAD = 0
   10   READ (LU8) MARK, IPR(12), JR, RMAT
        IF (MARK .NE. -100) THEN
          IF (MARK .NE. 2) THEN
            READ (LU8)
            GO TO 10
          END IF
          READ (LU8) (IATP(L4), L4 = 1, IPR(39))
          NRING = NRING + 1
          IF (IPR(12) .GT. 3) CALL PLA095 (NRING, NHEAD, 0)
          GO TO 10
        END IF
      END IF
      CALL GEN108 (LU8, 0)
      IF (IPR(23) .EQ. 0 .AND. IPR(64) .GT. 0 .AND. IGBL(97) .EQ. 1
     1    .AND. IGBL(63) .GT. 1) CALL PLA048
      RETURN
      END SUBROUTINE PLA075
      SUBROUTINE PLA076
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      CHARACTER FORMA*126, FORMB*129
      A    = 0.0
      D    = 0.0
      SA   = 0.0
      SD   = 0.0
      ISA  = 0
      ISD  = 0
      NDEC = 0
      CALL GEN108 (LU8, 0)
      IPR(52) = 0
      IF (IPR(147) .EQ. 0) THEN
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99985, IOSTAT = IOST) '<', PAR(1)
        END IF
        WRITE (LU6, 99985, IOSTAT = IOST) '<', PAR(1)
        GO TO 190
      END IF
      NMAX = IPR(39)
      NRES = IPR(75)
      NCB  = IPR(131)
      MBL  = 4
      MAL  = 3
      IF (IGBL(31) .EQ. 2) THEN
        DO I = 1, NMAX
          CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, 0, IGBL(55),
     1    0, 0)
          WRITE (LU2, 99999, IOSTAT = IOST)
     1      NQ1(1:4), (XXO(I, J), J = 4, 6)
        END DO
        WRITE (LU2, 99998, IOSTAT = IOST)
        DO N = 1, NCB
          FLI = VOID(IPR(298) + N * 3 - 2)
          FLJ = VOID(IPR(298) + N * 3 - 1)
          WRITE (LU2, 99997, IOSTAT = IOST) NINT(FLI), NINT(FLJ)
        END DO
        WRITE (LU2, 99996, IOSTAT = IOST)
      END IF
      CALL PLA098 (0, 0, 0, 0.0, 0.0, 0.0, 0, 0)
      IF (IPR(6) + IPR(7) + IPR(8) .EQ. 0) GO TO 190
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (0)
        WRITE (LU7, 99993, IOSTAT = IOST)
        WRITE (LU7, 99989, IOSTAT = IOST)
     1    PAR(1), IGBL(97) * PAR(26), PAR(27)
        IF (IPR(44) .EQ. 1) WRITE (LU7, 99984, IOSTAT = IOST) '>', '<'
        NLINE = 3 + IPR(44)
      END IF
      IF (PAR(107) .GT. 0.0 .AND. IGBL(63) .GT. 2) THEN
        NLINE = NLINE + 4
        WRITE (LU7, 99983, IOSTAT = IOST) PAR(13), PAR(14)
        WRITE (LU7, 99981, IOSTAT = IOST)
      END IF
      IF (IGBL(63) .GT. 2) CALL PLA262 (NLINE)
      FORMB( 1:  4)  = '(   '
      FORMB( 5: 32)  = ' A ,''- '', A ,F8.4,''('',I2,'')'''
      FORMB(33: 64)  = ',4X,'//FORMB(5:32)
      FORMB(65:129)  =  FORMB(33:64)//FORMB(33:64)//')'
      FORMA( 1:  4)  = '(   '
      FORMA( 5: 26)  = ' A ,''- '', A ,''- '', A ,'
      FORMA(27: 41)  = 'F7.2,''('',I3,'')'''
      FORMA(42: 83)  = ', 6X,'//FORMA(5:26)//FORMA(27:41)
      FORMA(84:126)  =  FORMA(42:83)//')'
      DO NRSD = 1, NRES
        NDIS = 0
        KB   = 0
        IHB  = 0
        IF (NRES .GT. 1) THEN
           IPR(134) = 1
        ELSE
           IPR(134) = 0
        END IF
        IF (IPR(438) .EQ. 1) WRITE (LU2, 99995, IOSTAT = IOST) NRSD
        IF (IPR(6) .NE. 0) THEN
          IPR(133) = -1
   70     IPR(133) = IPR(133) + 1
          IF (IPR(133) .GT. 1) GO TO 100
          IFIN     = -1
   80     CALL PLA038 (I, J, IFIN)
          IF (IFIN .EQ. 1) GO TO 70
          CALL GEN048 (-6, IFG(1, I), 9, IRESI)
          IF (IRESI .NE. NRSD) GO TO 80
          CALL GEN048 (-1, IFG(1, J), 7, IHJ)
          IF (IHJ .NE. IHB) THEN
            IHB = 1
            IF (KB .GT. 0) THEN
              IF (IGBL(63) .GT. 2) THEN
                WRITE (PRBUF, FORMB, IOSTAT = IOST)
     1            ((NAMS(L, M), M = 1, 2),
     2            DBUF(L), IDBUF(L), L = 1, KB)
                CALL PLA263 (LU7, PRBUF, 132, 1, 1)
              END IF
              KB = 0
            END IF
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (1)
              WRITE (LU7, 99992, IOSTAT = IOST)
            END IF
          END IF
          CALL PLA053 (I, J, 0, 0, D, SD, ISD, NDEC, IER)
          IF (IER .NE. 0) GO TO 80
          KB        = KB + 1
          NDIS      = NDIS + 1
          CALL PLA036 (I, KB, 1, IDS1, IDUM1, IDUM2, IPR(71), IGBL(55))
          CALL PLA036 (J, KB, 2, IDS2, IDUM1, IDUM2, IPR(71), IGBL(55))
          DIFF  = 0.0
          IDS12 = IDS1 + IDS2
          CALL PLA098 (I, J, KB, D, SD, DIFF, IDS12, 1)
          DBUF(KB)  = D
          IDBUF(KB) = MIN (99, ISD)
          IFT       = -11 + 32 * KB
          FORMB(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
          IFT       = -22 + 32 * KB
          FORMB(IFT : IFT) = '-'
          IF (DIFF .GT.   PAR(280)) FORMB(IFT : IFT) = '>'
          IF (DIFF .LT. - PAR(280)) FORMB(IFT : IFT) = '<'
          IF (IPR(438) .EQ. 1) THEN
            IPR(251) = IPR(251) + 1
            WRITE (LU2, 99991, IOSTAT = IOST)
     1        (NAMS(KB, M)(2:8), M = 1, 2), D, SD
          END IF
          IF (NDIS .EQ. 1) THEN
             IF (IPR(134) .EQ. 1) THEN
               IF (IGBL(63) .GT. 2) THEN
                 CALL PLA262 (4)
                 WRITE (LU7, 99994, IOSTAT = IOST) NRSD
               END IF
               IPR(134) = 0
             END IF
             IF (IGBL(63) .GT. 2) THEN
               CALL PLA262 (3)
               WRITE (LU7, 99990, IOSTAT = IOST)
             END IF
          END IF
          IF (KB .GE. MBL) THEN
            IF (IGBL(63) .GT. 2) THEN
              WRITE (PRBUF, FORMB, IOSTAT = IOST)
     1          ((NAMS(L, M), M = 1, 2),
     2          DBUF(L), IDBUF(L), L = 1, MBL)
              CALL PLA263 (LU7, PRBUF, 132, 1, 1)
            END IF
            KB = 0
          END IF
          GO TO 80
  100     IF (KB .GT. 0 .AND. IGBL(63) .GT. 2) THEN
            WRITE (PRBUF, FORMB, IOSTAT = IOST)
     1        ((NAMS(L, M), M = 1, 2),
     2        DBUF(L), IDBUF(L), L = 1, KB)
            CALL PLA263 (LU7, PRBUF, 132, 1, 1)
          END IF
        END IF
        IF (IPR(7) .NE. 0) THEN
          NANG = 0
          KB   = 0
          IPR(133) = -1
  170     IPR(133) = IPR(133) + 1
          IF (IPR(133) .GT. 1) GO TO 175
          IF (IPR(133) .EQ. 1 .AND. IGBL(63) .GT. 2) THEN
            IF (KB .GT. 0) THEN
              IF (IGBL(63) .GT. 2) THEN
                WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1            ((NAMS(L, M), M = 1, 3),
     2            DBUF(L), IDBUF(L), L = 1, KB)
                CALL PLA263 (LU7, PRBUF, 132, 1, 3)
              END IF
              KB = 0
            END IF
            CALL PLA262 (1)
            WRITE (LU7, 99992, IOSTAT = IOST)
          END IF
          IFIN = -1
  160     CALL PLA039 (IAT, JAT, KAT, NRSD, A, SA, ISA, NDEC, KB, IFIN)
          IF (IFIN .EQ. 1) GO TO 170
          NANG      = NANG + 1
          KB        = KB + 1
          DBUF(KB)  = A
          IDBUF(KB) = MIN (999, ISA)
          IFT       = -12 + 42 * KB
          FORMA(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
          IF (IPR(438) .EQ. 1) THEN
            IPR(252) = IPR(252) + 1
            WRITE (LU2, 99988, IOSTAT = IOST)
     1            (NAMS(KB, M)(2:8), M = 1, 3), A, SA
          END IF
          IF (NAMS(KB, 2)(2:2) .EQ. 'C') THEN
            NC = - NINT(CON(JAT, NP4))
            CALL GEN048 (-3, IFG(2, JAT), 24, JMET)
            IF (JMET .EQ. 3 .AND. NC .EQ. 4) THEN
              DANG = ABS (109.5 - A)
              IF (DANG .GT. 0.1) THEN
                CALL GEN048 (-1, IFG(1, IAT), 7, IHAT)
                CALL GEN048 (-1, IFG(1, KAT), 7, KHAT)
                NDISO = 0
                IF (NAMS(KB, 1)(1:1) .NE. ' ') NDISO = NDISO + 1
                IF (NAMS(KB, 2)(1:1) .NE. ' ') NDISO = NDISO + 1
                IF (NAMS(KB, 3)(1:1) .NE. ' ') NDISO = NDISO + 1
C * ALERT _389 +
                IF (NDISO .LT. 2) CALL PLA231 (389 + IHAT + KHAT,
     1            0, DANG, A, NAMS(KB, 2)(2:8), ' ')
              END IF
            END IF
          END IF
          IF (NANG .EQ. 1) THEN
            IF (IPR(134) .EQ. 1) THEN
              IF (IGBL(63) .GT. 2) THEN
                CALL PLA262 (4)
                WRITE (LU7, 99994, IOSTAT = IOST) NRSD
              END IF
              IPR(134) = 0
            END IF
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (3)
              WRITE (LU7, 99987, IOSTAT = IOST)
            END IF
          END IF
          IF (KB .GE. MAL) THEN
            IF (IGBL(63) .GT. 2) THEN
              WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1          ((NAMS(L, M), M = 1, 3),
     2          DBUF(L), IDBUF(L), L = 1, MAL)
              CALL PLA263 (LU7, PRBUF, 132, 1, 3)
            END IF
            KB = 0
          END IF
          GO TO 160
  175     IF (KB .GT. 0) THEN
            IF (IGBL(63) .GT. 2) THEN
              WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1          ((NAMS(L, M), M = 1, 3),
     2          DBUF(L), IDBUF(L), L = 1, KB)
              CALL PLA263 (LU7, PRBUF, 132, 1, 3)
            END IF
            KB = 0
          END IF
        END IF
        CALL PLA032 (NRSD)
      END DO
  190 CALL PLA098 (0, 0, 0, 0.0, 0.0, 0.0, 0, -1)
      RETURN
99999 FORMAT (A, 3X, 3F10.4)
99998 FORMAT ('END')
99997 FORMAT (I4, 1X, I4)
99996 FORMAT ('END', /, 'END')
99995 FORMAT ('RESD ', I5)
99994 FORMAT (/, 57X, 13('='), /, 56('*'), ' Residue =', I4, 1X,
     1 61('*'), /, 57X, 13('='))
99993 FORMAT ('Analysis of the IntraMolecular Geometry in Terms of',
     1 ' Unique Molecule(s)/Ions, with Bond Criterium:',
     2 ' d(i-j) < R(i) + R(j) + Tol', /, 132('-'))
99992 FORMAT (' ')
99991 FORMAT ('BOND ', 2(A, 2X), 2F8.4)
99990 FORMAT (/'Bond Lengths (Angstrom). - (Bonds are ordered on the',
     1 ' first label, left to right and  top to bottom) - ',
     2 'su in last digit in ().', /, 132('='))
99989 FORMAT ('-- Tol = ', F4.2, ' Ang. for Normal Bonds + ', F4.2,
     1        ' for (Earth)alkali-NonMetal Contacts and adjusted by ',
     2          F4.2, ' Ang. for Metal-Metal Distances')
99988 FORMAT ('ANGL ', 3(A, 2X), 2F7.2)
99987 FORMAT (/'Bond/Valence Angles (Degrees) - (Angles are ordered',
     1 ' on the middle label, left to right and top to bottom) -',
     2 ' su in last digit in ().', /, 132('='))
99985 FORMAT (/, ':: Note: No Intra-Bonds with d(I-J) ',
     1 A,' R(I) + R(J) + (Tol=', F5.2, ')')
99984 FORMAT ('-- Disordered Atoms are Indicated with ', A, ' or ', A,
     1 ' Attached to the Atom Label, indicating Major and Minor Form',
     2 ' Respectively')
99983 FORMAT ('-- The Bond Distance and Angle su''s have been',
     1 ' Incremented to Include the Effect of the Unit-cell su.',/,
     2 3X, '(Rel.Error in Dist.', F7.4, ' Ang. , Abs. Angle Error',
     3 F6.3, ' Deg.)')
99981 FORMAT ('-- Bonds below with ''>'' or ''<'' Substituted for',
     1 ' ''-'' have Distances that Deviate from Expected Values',
     2 '(Based on the hybridisations).', /, 132('-'))
      END SUBROUTINE PLA076
      SUBROUTINE PLA077
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      NAT  = IPR(37)
      NMAX = IPR(39)
      NRES = IPR(75)
      NEXB = 0
      IF (IPR(407) .GT. 0) THEN
        DO 20 I = 1, IPR(407)
          NEXB = NEXB + 1
          DO 10 J = 1, 2
            DO K = 1, NMAX
              IF (NINT(SLN(I, J)) .EQ. LABA(K)) THEN
                SLN(NEXB, J) = K
                GO TO 10
              END IF
            END DO
            NEXB = NEXB - 1
            GO TO 20
   10     CONTINUE
   20   CONTINUE
        IPR(407) = NEXB
      END IF
      IF (IPR(147) .NE. 0) THEN
        IPR(146) = 0
        DO WHILE (IPR(146) .LT. IPR(145))
          IPR(146) = IPR(146) + 1
          IPR(12)  = 0
          NTYP = NINT(XLS(1, IPR(146)))
          IF (NTYP .GE. 0) THEN
            DO I = 1, NMAX
              IATPI = NP1 + I
              XLBL  = LABA(I)
              I1    = IPR(146)
              GO TO 40
   30         I1 = I1 + 1
              IF (XLS(1, I1) .GT. 0) GO TO 60
   40         I2 = 1
   50         I2 = I2 + 1
              IF (I2 .GT. 9) GO TO 30
              XLS12 = XLS(I2, I1)
              IF (XLS12 .GE. 0.0) THEN
                IF (ABS(XLBL - XLS12) .GT. 0.001) GO TO 50
                IPR(12) = IPR(12) + 1
                JR((I1 - IPR(146)) * 8 + I2 - 1) = I
                IATPI   = I
              END IF
   60         IATP(I) = IATPI
            END DO
            IF (IPR(12) .LT. NP7) THEN
              IF (NTYP .EQ. 0) THEN
                IF (IPR(12) .GE. 2) THEN
                  VARDIST = 999.0
                  CALL PLA085 (0, VARDIST)
                ELSE
                  WRITE (LU6, 99998, IOSTAT = IOST)
                END IF
              ELSE
                IF (IPR(12) .GE. 3) THEN
                  CALL PLA045 (NTYP)
                ELSE
                  WRITE (LU6, 99998, IOSTAT = IOST)
                END IF
              END IF
            ELSE
              WRITE (LU6, 99998, IOSTAT = IOST)
            END IF
          END IF
        END DO
        IF (IPR(10) .NE. 0 .AND. IGBL(97) .NE. 0) THEN
          IF (NMAX .GT. 250 .OR. IPR(44) .EQ. 1) THEN
            IPR(579) = MIN (IPR(219), IPR(216))
            WRITE (LU6, 99999, IOSTAT = IOST) IPR(579)
          END IF
          DO 110 NR = 1, NRES
            NRING = 0
            DO 100 K = 3, IPR(579)
            NRTM = K + 1
            DO 90 J = 1, NAT
              CALL GEN048 (-6, IFG(1, J), 9, IRESJ)
              IF (IRESJ .NE. NR) GO TO 90
              IF (IPR(44) .GT. 0) THEN
                CALL GEN048 (-7, IFG(2, J), 1, IPP)
                IF (IPPR(IPP + 1, 1) .LE. IPR(222)) GO TO 90
              END IF
              NHAT = NINT(RCONT(IRESJ))
              IF (NHAT .LT. 5 .OR. NHAT .LT. K) GO TO 90
              LRT   = 2
              NRT   = 1
              JR(1) = J
   70         CALL GEN048 (-1, IFG(1, JR(NRT)),  7, IVAL1)
              CALL GEN048 (-1, IFG(2, JR(NRT)), 13, IVAL2)
              IF (IVAL1 .EQ. 1 .OR. IVAL2 .EQ. 1) THEN
                IF (LRT .EQ. 1) THEN
                  GO TO 80
                ELSE IF (LRT .EQ. 2) THEN
                  GO TO 90
                END IF
              END IF
              CALL GEN048 (-1, IFG(1, JR(NRT)), 8, IVAL)
              IF (IVAL .EQ. 1) THEN
                IF (LRT .EQ. 1) THEN
                  GO TO 80
                ELSE IF (LRT .EQ. 2) THEN
                  GO TO 90
                END IF
              END IF
              NCN(NRT) = - NINT(CON(JR(NRT), NP4))
              IF (NCN(NRT) .LT. 0) NCN(NRT) = NP4
              IF (NCN(NRT) .LT. 2) THEN
                IF (LRT .EQ. 1) THEN
                  GO TO 80
                ELSE IF (LRT .EQ. 2) THEN
                  GO TO 90
                END IF
              END IF
              CALL GEN048 (-1, IFG(1, JR(NRT)), 19, IVAL)
              IF (IVAL .EQ. 1) THEN
                IF (NCN(NRT) .GT. IPR(159)) THEN
                  IF (LRT .EQ. 1) THEN
                    GO TO 80
                  ELSE IF (LRT .EQ. 2) THEN
                    GO TO 90
                  END IF
                END IF
                CALL GEN048 (-4, IFG(1, JR(NRT)), 15, NO1)
                IF (IATPR(IEN(NO1 + 1)) .GT. 4) THEN
                  IF (LRT .EQ. 1) THEN
                    GO TO 80
                  ELSE IF (LRT .EQ. 2) THEN
                    GO TO 90
                  END IF
                END IF
              END IF
              LRT      = 1
              NRT      = NRT + 1
              JLN(NRT) = 0
   80         JLN(NRT) = JLN(NRT) + 1
              IF (JLN(NRT) .GT. NCN(NRT - 1)) THEN
                NRT = NRT - 1
                IF (NRT .GT. 1) GO TO 80
                GO TO 90
              END IF
              JR(NRT) = NINT(CON(JR(NRT - 1), JLN(NRT)))
              IF (JR(NRT) .GE. JR(1)) THEN
                IF (NRT .GT. 3) THEN
                  IF (NRT .EQ. NRTM) THEN
                    NRTM2 = 1
                    ELSE
                      NRTM2 = NRT - 2
                    END IF
                    DO I = 2, NRTM2
                      IF (JR(NRT) .EQ. JR(I)) GO TO 80
                    END DO
                  END IF
                  IF (JR(NRT) .EQ. JR(1)) THEN
                    IF (NRT .LT. NRTM) GO TO 80
                    NRMET = 0
                    DO I = 2, NRT
                      CALL GEN048 (-1, IFG(1, JR(I)), 19, IVAL)
                      NRMET = NRMET + IVAL
                      IF (IVAL * (NRT - 1) .GT. IPR(217)) GO TO 80
                    END DO
                    IF (NRMET .EQ. NRT - 1) GO TO 80
                    IF (JR(2) .LE. JR(NRT - 1)) THEN
                      DO I = 1, NMAX
                        IATP(I) = NP1 + I
                      END DO
                      IPR(12) = NRT - 1
                      IPOP = 1000
                      DO I = 1, IPR(12)
                        IF (IPR(44) .GT. 0) THEN
                          CALL GEN048 (-7, IFG(2, JR(I)), 1, IPP)
                          IPAR = IPPR(IPP + 1, 1)
                          IF (IPAR .NE. IPOP) THEN
                            IF (IPOP .LT. 1000 .AND. IPAR .LT. 1000 .OR.
     1                          IPOP .LE. IPR(222) .OR.
     2                          IPAR .LE. IPR(222)) THEN
                              GO TO 80
                            ELSE
                              IF (IPOP .EQ. 1000) IPOP = IPAR
                            END IF
                          END IF
                        END IF
                        IATP(JR(I)) = JR(I)
                      END DO
                      IF (K .GT. 3 .OR.
     1                   (K .EQ. 3 .AND. IPR(69) .LE. 10)) THEN
                        CALL PLA045 (2)
                        NRING = NRING + 1
                        IF (NRING .GE. IPR(302) + IPR(592) * 1000) THEN
                          IPR(579) = K
                          WRITE (LU6, 99999, IOSTAT = IOST) K
                          GO TO 110
                        END IF
                      ELSE
                        GO TO 100
                      END IF
                    END IF
                    IF (NRT .EQ. NRTM) NRT = NRT - 1
                    GO TO 80
                  END IF
                  IF (NRT .LT. NRTM) GO TO 70
                END IF
                GO TO 80
   90         CONTINUE
  100       CONTINUE
  110     CONTINUE
        ELSE
          IF (IGBL(99) .EQ. 1) WRITE (LU6, 99997, IOSTAT = IOST)
        END IF
        IF (ABS(IGBL(3)) .NE. 1 .AND. IPR(11) .NE. 0 .AND.
     1    IGBL(97) .NE. 0) THEN
          DO JAT = 1, NAT
            CALL GEN048 (-1, IFG(1, JAT), 19, IVAL)
            IF (IVAL .EQ. 1) THEN
              IF (NINT(CON(JAT, NP4)) .EQ. -4) THEN
                DO I = 1, NMAX
                  IATP(I) = NP1 + I
                END DO
                DO I = 1, 4
                  IATP(I) = NINT(CON(JAT, I))
                END DO
                IPR(12) = 4
                CALL PLA045 (5)
              END IF
            END IF
          END DO
          DO NRS = 1, NRES
            IPR(12) = 0
            DO I = 1, NMAX
              IATPI = NP1 + I
              CALL GEN048 (-6, IFG(1, I), 9, IVAL)
              IF (IVAL .EQ. NRS) THEN
                CALL GEN048 (-1, IFG(1, I), 7, IVAL)
                IF (IVAL .EQ. 0) THEN
                  IPR(12) = IPR(12) + 1
                  IATPI   = I
                END IF
              END IF
              IATP(I) = IATPI
            END DO
            IF (IPR(12) .GT. 5) CALL PLA045 (3)
          END DO
        END IF
        IF (IPR(9) .NE. 0) THEN
          DO 160 JAT = 1, NMAX
            IF (IPR(44) .GT. 0) THEN
              CALL GEN048 (-7, IFG(2, JAT), 1, IPP)
              IF (IPPR(IPP + 1, 1) .LT. 1000) GO TO 160
            END IF
            CALL GEN048 (-1, IFG(1, JAT), 7, IVAL)
            IF (IVAL .GT. 0) GO TO 160
            CALL GEN048 (-1, IFG(1, JAT), 5, IVAL)
            IF (IVAL .GT. 0) GO TO 160
            CALL GEN048(-6, IFG(1, JAT), 9, IRESJ)
            NC = - NINT(CON(JAT, NP4))
            IF (NC .LT. 0) NC = NP4
            IF (NC .GT. 1) THEN
              N = NC - 1
              DO 150 KI = 1, N
                IAT = NINT(CON(JAT, KI))
                IF (IPR(44) .GT. 0) THEN
                  CALL GEN048 (-7, IFG(2, IAT), 1, IPP)
                  IF (IPPR(IPP + 1, 1) .LT. 1000) GO TO 150
                END IF
                CALL GEN048 (-1, IFG(1, IAT), 7, IVAL)
                IF (IVAL .EQ. 0) THEN
                  J1 = KI + 1
                  DO KJ = J1, NC
                    KAT = NINT(CON(JAT, KJ))
                    CALL GEN048 (-1, IFG(1, KAT), 7, IVAL)
                    IF (IVAL .EQ. 0) THEN
                      DO I = 1, NMAX
                        IATP(I) = NP1 + I
                      END DO
                      IATP(IAT) = IAT
                      IATP(JAT) = JAT
                      IATP(KAT) = KAT
                      IPR(12)   = 3
  120                 CALL PLA054 (0)
                      I = 0
  130                 I = I + 1
                      IF (I .GT. NMAX) GO TO 140
                      IF (IPR(44) .GT. 0) THEN
                        CALL GEN048 (-7, IFG(2, I), 1, IPP)
                        IF (IPPR(IPP + 1, 1) .LT. 1000) GO TO 130
                      END IF
                      IF (IATP(I) .LT. NP1) GO TO 130
                      CALL GEN048 (-6, IFG(1, I), 9, IRESI)
                      IF (IRESI .NE. IRESJ) GO TO 130
                      CALL GEN048 (-1, IFG(1, I), 7, IVAL)
                      IF (IVAL .GT. 0) GO TO 130
                      NCI = - NINT(CON(I, NP4))
                      IF (NCI .LT. 0) NCI = NP4
                      IF (NCI .EQ. 0) GO TO 130
                      UITW = - XPV(4)
                      DO J = 1, 3
                        UITW = UITW + XPV(J) * XXO(I, J + 3)
                      END DO
                      IF (ABS(UITW) .GT. PAR(49)) GO TO 130
                      DO J = 1, NMAX
                        IF (IATP(J) .LE.  NP1) THEN
                          DO IJ = 1, NCI
                            IF (NINT(CON(I, IJ)) .EQ. J) THEN
                              IPR(12) = IPR(12) + 1
                              IATP(I) = I
                              GO TO 120
                            END IF
                          END DO
                        END IF
                      END DO
                      GO TO 130
  140                 IF (IPR(12) .GT. 3) CALL PLA045 (1)
                    END IF
                  END DO
                END IF
  150         CONTINUE
            END IF
  160     CONTINUE
        END IF
      END IF
      WRITE (LU8) -100, 0, JR, RMAT
      IPR(86) = 1
      RETURN
99999 FORMAT (/, ':: Maximum Ring-size has been Reset to:', I3, /)
99998 FORMAT ('W: User-specified Ring/Plane/Fit/Line not accepted', /)
99997 FORMAT (/, ':: Note: Ring-search Suppressed in Inorganic Mode.',
     1        /)
      END SUBROUTINE PLA077
      SUBROUTINE PLA078 (IAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER IMRK0*4, IMRK1*5, IMRK2*4, FORMA*71, FORMB*133, POLY*4,
     1 FORMC*96, FORMD*76, FORME*156, FORMF*132, FORMK*6, CXMOL*9
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER NQ5*7
      DIMENSION YP(3, 12)
C * COORDINATION ANALYSIS
      IPR(440) = - IABS(IPR(440))
      DO I = 1, 100
        YMOL(1, I) = -1000.0
      END DO
   10 IMRK2  = ' '
      ANGLE  = 0.0
      SANGL  = 0.0
      DIJ    = 0.0
      SDIJ   = 0.0
      SOME   = 0.0
      ISANGL = 0
      NDEC   = 0
      NDEC1  = 0
      NDEC2  = 0
      ISANG  = 0
      INUM   = 0
      IDIS   = 0
      ISDIJ  = 0
      PSCL   = 0.0
      J2     = 0
      FORMA( 1: 31) = '(I2,F8.4,''('',I2,'')'', A,A,''['',A,'
      FORMA(32: 71) = '''='',A   ,''] '',A,2F7.2,1X,3F9.5,2X,3F8.4)'
      FORMB( 1:  4) = '(   '
      FORMB( 5: 33) = ' A , '', '', A ,F7.2,''('',I3,'')'''
      FORMB(34: 66) = ',4X,'//FORMB(5:33)
      FORMB(67:133) =  FORMB(34:66)//FORMB(34:66)//')'
      FORMC( 1: 45) = '(F4.1,'' Angstrom Coordination Sphere Around '''
      FORMC(46: 78) = ',''Atom I = '',A,''[ARU ='',F8.2,'']'','
      FORMC(79: 96) = '7X,3F9.5,2X,3F8.4)'
      FORMD( 1: 39) = '(A,'' , '',A,F8.2,''('',I3,'')'',5X,F8.4,''('','
      FORMD(40: 76) = 'I3,'')'',3X,4(F8.1,''('',I3,'')''),2(2X,A))'
      FORME( 1: 29) = '(''Dist. '',A,'' - Polyh_C.G.:'','
      FORME(30: 57) = 'F7.3,''('',I3,'') Ang,  C.G.:'','
      FORME(58: 73) = 'F9.5,''('',I2,'')'','
      FORME(74:108) = FORME(58:73)//FORME(58:73)//'4X,'
      FORME(109:124)= 'F9.4,''('',I2,'')'','
      FORME(125:156)= FORME(109:124)//FORME(109:123)//')'
      FORMK(1:6)    = '(F9.2)'
      FORMF(1:  23) = '(1X,A,F8.4,''('',I3,''),'','
      FORMF(24: 89) = FORMF(2:23)//FORMF(2:23)//FORMF(2:23)
      FORMF(90:132) = FORMF(2:23)//FORMF(2:20)//''')'
      IF (PAR(42) .LT. 100.0) THEN
        FORMK(5:5)   = '1'
        FORMC(73:73) = '1'
      END IF
      CALL PLA047 (LABA(IAT), NQ3, MNX, IENI, 0, IGBL(55), 0,
     1     1 - IGBL(55))
      NC = IPR(79)
      IF (NC .EQ. 0) THEN
        IF (IPR(57) .EQ. 1)
     1    WRITE (LU6, 99996, IOSTAT = IOST) PAR(262), NQ3
        GO TO 50
      END IF
      CALL GEN048 (-1, IFG(1, IAT), 23, IDOA)
      NMAX = IPR(39)
      KPC  = NMAX + IPR(24) + 1
      IF (KPC + NC .GT. NP1 - IPR(75)) THEN
        IPR(2) = 1
        GO TO 50
      END IF
      IF (IPR(15) .EQ. 0) THEN
        IF (IGBL(63) .GT. 2) THEN
          IF (IPR(57) .EQ. 0) THEN
            PAGET  = 'COORDN'
            CALL PLA262 (0)
            WRITE (LU7, 99990, IOSTAT = IOST)
          ELSE IF (IPR(57) .LT. 0) THEN
            PAGET  = 'DSCAN'
            CALL PLA262 (0)
            WRITE (LU7, 99986, IOSTAT = IOST) LMT(- IPR(57), 1)
          ELSE
            PAGET  = 'METAL'
            CALL PLA262 (0)
            WRITE (LU7, 99989, IOSTAT = IOST)
          END IF
          WRITE (LU7, 99988, IOSTAT = IOST)
        END IF
        IPR(15) = 1
      END IF
      VDWI = ABS(VDWR(IENI))
      CALL GEN048 (-6, IFG(1, IAT),  9, IRESI)
      CALL GEN048 (-5, IFG(3, IAT), 14, IPART)
      IPART0 = IPART - 16
      CALL PLA036 (IAT, 1, 1, IDUM1, MNI, IDUM3, IPR(71), IGBL(55))
      NCI = 0
      NDB = 0
      DO J = 1, NC
        KAT  = IATC(J)
        MKAT = MOD (KAT, NP1)
        IDUB = 0
        IF (J .GT. 1) THEN
          DO K = 2, J
            IF (MKAT .EQ. MOD(IATC(K - 1), NP1)) THEN
              IDUB = 2
              NDB  = NDB + 1
            END IF
          END DO
        END IF
        CALL GEN048 (-1, IFG(1, MKAT), 7, IHA)
        PADD = (IDUB + IHA + 1) * PAR(23)
        IF (KAT .LE. NP1) THEN
          CALL PLA040 (-1, IAT, JJ, KAT)
          IF (JJ .GT. 0) THEN
            NCI  = NCI + 1
            PADD = 0
          END IF
        END IF
        DATC(J) = PADD + DATC(J)
      END DO
      CALL GEN013 (DATC, IATC, 1, NC)
      NC = NC - NDB
      XMOL1 = (1555 * PAR(42) + IRESI) / PAR(42)
      IF (IENI .NE. 2) THEN
        CALL PLA096 (0, NAMS(1, 1)(1:8), FLOAT(IAT), PAR(454))
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (-4)
          WRITE (PRBUF, FORMC, IOSTAT = IOST)
     1      PAR(23), NAMS(1, 1)(2:8), XMOL1,
     2      (XXO(IAT, L), L = 1, 6)
          CALL PLA263 (LU7, PRBUF, 132, 1, 10)
          WRITE (LU7, 99981, IOSTAT = IOST)
          WRITE (LU7, 99987, IOSTAT = IOST)
        END IF
      END IF
      IF (IPR(168) .NE. 0 .OR. IPR(170) .NE. 0) THEN
        WRITE (PRBUF, 99980, IOSTAT = IOST) PAR(23), NAMS(1, 1)(2:8)
        WRITE (LU6, 99984, IOSTAT = IOST) PRBUF(1:46)
        IWIN = 0
        IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IPR(121) .EQ. 0) THEN
          IWIN = 1
          CALL GGIP (HORS, VERT, 0.0, 1)
          VRT = VERT - 0.6
          CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
          VRT  = VRT - 0.1
          PXOR = 0.80 * HORS
          PYOR = 0.72 * VERT
          PSCL = 0.22 * HORS / PAR(23)
        END IF
      END IF
      DMAX = 0
      DO J = 1, NC
        ICOL    = 1
        KAT     = IATC(J)
        IPR(20) = 0
        IF (KAT .GT. NP1) THEN
          KAT     = KAT - NP1
          IATC(J) = KAT
          IPR(20) = 1
        END IF
        CALL GEN048 (-6, IFG(1, KAT),  9, IRESJ)
        CALL GEN048 (-5, IFG(3, KAT), 14, KPART)
        KPART0 = KPART - 16
        CALL PLA036 (KAT, 1, 2, IDUM1, MNJ, IDUM3, IPR(71), IGBL(55))
        IF (MNJ .GT. 1) THEN
          MOLMNJ = MOL(MNJ)
        ELSE
          MOLMNJ = NINT(1555 * PAR(42) + IRESJ)
        END IF
        XMOL = MOLMNJ / PAR(42)
        IF (ABS(XMOL1 - XMOL) .LT. 0.005) IPR(20) = 0
        CALL GEN048 (-1, IFG(1, KAT), 23, KDOA)
        ILABX = - LABA(KAT)
        CALL PLA047 (ILABX, NQ4, MNY, IENK, IPR(71), IGBL(55), 0,
     1               1 - IGBL(55))
        NQ5 = NQ4
        CALL PLA046 (2, NQ4, IDUM, LBB, LBC, LBD, ILMP, JNQNR, KATP)
        CALL PLA047 (LABA(KAT), NQ3, MNY, IENK, IPR(71), IGBL(55),
     1               0, 1 - IGBL(55))
        VDWIK = ABS(VDWR(IENK)) + VDWI
        CALL PLA053 (IAT, KAT, 0, 0, DIJ, SDIJ, ISDIJ, NDEC, IER)
        IF (IER .EQ. 0) THEN
          IF (DIJ .LT. DMAX .AND. IGBL(63) .GT. 2
     1                      .AND. IENI .NE. 2) THEN
            CALL PLA262 (1)
            WRITE (LU7, 99999, IOSTAT = IOST)
          END IF
          IF (J .GT. NCI) THEN
            DELTA = DIJ - VDWIK
            IF (DELTA .GT. 0.0) THEN
              IMRK0 = ' .. '
              ICOL  = 3
            ELSE
              IF (DELTA .LT. - 0.2) THEN
                IMRK0 = ' << '
                ICOL  = 2
              ELSE
                IMRK0 = ' .< '
                ICOL  = 6
              END IF
              IF (IPR(20) .NE. 0 .AND. IAT .LE. KATP) THEN
                CALL GEN048 (-1, IFG(1, IAT), 19, IMET)
                CALL GEN048 (-1, IFG(1, KAT), 19, KMET)
                CALL GEN048 (-7, IFG(2, KAT),  1, KPP)
                IF (IRESI .NE. IRESJ .OR. MPOL(IRESI) .EQ. 0 .OR.
     1            MPOL(IRESJ) .EQ. 0) THEN
                  IF (IDOA + KDOA .EQ. 2) THEN
                    CALL GEN048 (-1, IFG(1, IAT), 21, IDO)
                    CALL GEN048 (-1, IFG(1, KAT), 21, KDO)
                    IF (IMET + KMET .EQ. 0) THEN
                      IF (IATPR(IENI) .NE. -7 .AND.
     1                    IATPR(IENK) .NE. -7 .AND. DIJ .LT. 2.9) THEN
                        IF (IDO + KDO .EQ. 0 .AND. IPR(484) .GT. 0) THEN
                          IF (IPART0 .EQ. 0 .OR. KPART0 .EQ. 0) THEN
C * ALERT _430
                            CALL PLA231 (430, 2,
     1                        - DELTA, DIJ, NAMS(1, 1)(2:8), NQ5(1:7))
                          END IF
                        END IF
                      ELSE IF (IATPR(IENI) .EQ. -7) THEN
                        IF ((IPR(119) .EQ. 1000 .OR. IPR(128) .EQ. 1000)
     1                    .AND. KDO .EQ. 0) THEN
                          DIJT = 10.0
                          NADD = 0
                          IF (IENI .EQ. 38 .AND. IENK .EQ. 38) THEN
                            DIJT = 2.6
                            NADD = 3
                          END IF
                          IF (IENI .EQ. 5) THEN
                            IF (IENK .EQ. 5) THEN
                              DIJT = 2.60
                              NADD = 3
                            ELSE IF (IENK .EQ. 3) THEN
                              DIJT =  2.85
                            ELSE IF (IENK .EQ. 38) THEN
                              DIJT = 2.60
                              NADD = 3
                            END IF
                          END IF
                          IF (IENI .EQ. 7) THEN
                            IF (IENK .EQ. 7) THEN
                              DIJT = 3.35
                              NADD = 3
                            ELSE IF (IENK .EQ. 5) THEN
                              DIJT = 2.6
                              NADD = 3
                            ELSE IF (IENK .EQ. 38) THEN
                              DIJT = 2.6
                              NADD = 3
                            ELSE IF (IENK .EQ. 4) THEN
                              DIJT = 2.75
                            END IF
                          END IF
                          IF (IENI .EQ. 9) THEN
                            IF (IENK .EQ. 9) THEN
                              DIJT = 3.5
                              NADD = 3
                            ELSE IF (IENK .EQ. 7) THEN
                              DIJT = 2.8
                              NADD = 3
                            ELSE IF (IENK .EQ. 5) THEN
                              DIJT = 2.8
                              NADD = 3
                            ELSE IF (IENK .EQ. 38) THEN
                              DIJT = 2.8
                              NADD = 3
                            ELSE IF (IENK .EQ. 3) THEN
                              CALL GEN048 (-4, IFG(3, IAT), 28, IYUNK)
                              IF (IYUNK .EQ. 1) THEN
                                DIJT = 3.0
                              ELSE
                                DIJT = 2.5
                              END IF
                            ELSE IF (IENK .EQ. 4) THEN
                              DIJT = 2.65
                            END IF
                          END IF
                          IF (DIJ .LT. DIJT) THEN
C * ALERT _431 & _434
                            CALL PLA231 (431 + NADD, 2,
     1                      - DELTA, DIJ, NAMS(1, 1)(2:8), NQ5(1:7))
                          ELSE IF (DELTA .LT. -0.1) THEN
                            CALL PLA231 (431 + NADD, 2, -999.0, DIJ,
     1                        NAMS(1, 1)(2:8), NQ5(1:7))
                          END IF
                        END IF
                      END IF
                    END IF
                  ELSE
                    CALL GEN048 (-1, IFG(1, IAT), 7, IHAT)
                    CALL GEN048 (-1, IFG(1, KAT), 7, KHAT)
                    IF (IHAT + KHAT + IMET + KMET .EQ. 0) THEN
C * ALERT _432 & _433 : HANDLE MINOR-MINOR DISORDER
                      IF (IPR(119) .GT. 150 .OR. IPR(120) .GT. 150) THEN
                        N = 432
                      ELSE
                        N = 433
                      END IF
                      IF (IPART0 .EQ. 0 .OR. KPART0 .EQ. 0) THEN
                         IF (DELTA .LT. -0.2) CALL PLA231 (N, 2,
     1                    -999.0, DIJ, NAMS(1, 1)(2:8), NQ5(1:7))
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END IF
          ELSE
            IMRK0 = ' -- '
          END IF
          DMAX  = DIJ
          ISDIJ = MIN (99, ISDIJ)
          FORMA(8 : 8) = CHAR(ICHAR('0') + NDEC)
          CALL PLA050 (IAT, KAT, 0, 0, DIJN)
          DO JJ = 4, 6
            XXO(KPC, JJ) = (XXO(KAT, JJ) - XXO(IAT, JJ)) / DIJN
            XSD(KPC, JJ) = XSD(IAT, JJ)
          END DO
          DO JJ = 4, 6
            XXO(KPC + J, JJ) = XXO(IAT, JJ) + XXO(KPC, JJ)
            XSD(KPC + J, JJ) = XSD(IAT, JJ)
          END DO
          LABA(KPC + J) = LABA(KAT)
          JATC(J) = IATC(J)
          IF (ABS(XXO(KPC, 6)) .LT. 0.999) THEN
            XMU = 90.0 - RGBL(6) * ACOS(XXO(KPC, 6))
            PHI = RGBL(6) * ATAN2(XXO(KPC, 5), XXO(KPC, 4))
          ELSE
            XMU = SIGN (90.0, XXO(KPC, 6))
            PHI = 0.0
          END IF
          IF (IPR(20) .EQ. 0) THEN
            IMRK1 = 'Intra'
          ELSE
            IMRK1 = '     '
          END IF
          CALL GEN098 (MOLMNJ, PAR(42), MOL0, MOL1, MOL2, MOL3, IDUM)
          XJX(4) = MOL1
          XJX(5) = MOL2
          XJX(6) = MOL3
          CALL SGSM (IDM, MOL0, XJX, 0, 20, IERR)
          CALL GEN020 (-1, IDM, 1, 20)
          IF (IDM(1 : 6) .EQ. 'x,y,z ') IDM(1:5) = '     '
          WRITE (CXMOL, FORMK, IOSTAT = IOST) XMOL
          IF (XMOL .EQ. XMOL1) CXMOL = '         '
          IF (INT(XMOL) .EQ. 1555) CXMOL(1:7) = '       '
          IF (IMRK2 .NE. IMRK0) THEN
            VRT = VRT - 0.2
            IMRK2 = IMRK0
          END IF
          JPR = MIN (J, 99)
          CALL PLA096 (1, NAMS(1, 2)(1:8), DIJ, PAR(454))
          WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1      JPR, DIJ, ISDIJ, IMRK0, NAMS(1, 2),
     2      IDM(1:20), CXMOL, IMRK1, PHI, XMU, (XXO(KAT, L), L = 1, 6)
          IF (CXMOL .EQ. '         ') CALL GEN038 (PRBUF, 27, 58)
          IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
            CALL PLA263 (LU7, PRBUF, 132, 1, 3)
            IF (J .EQ. NCI .AND. NCI .GT. 0 .AND. NC .GT. NCI) THEN
              CALL PLA262 (1)
              WRITE (LU7, 99999, IOSTAT = IOST)
            END IF
          END IF
          IF (IPR(168) .NE. 0 .OR. IPR(170) .NE. 0) THEN
            CALL PLA263 (LU6, PRBUF, 58, 1, 3)
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 0.5
              YMOL(1, JPR) = VRT + 0.175
              YMOL(2, JPR) = XMOL
              IF (ICOL .EQ. 2) THEN
                NRLN = 2 + KDOA
              ELSE
                NRLN = 2
              END IF
              LINE = PRBUF(1:26)//' '//PRBUF(49:57)//' = '//PRBUF(28:47)
              CALL GGIP09 (0.0, LINE, 59, 0.35, ICOL, NRLN, 0.1, VRT)
              DO L = 1, 3
                V1(L) = (XXO(KAT, L + 3) - XXO(IAT, L + 3)) * PSCL
              END DO
              CALL GEN002 (-1, RMAT, V1, V2, YUNK)
              IF (ICOL .NE. 3) THEN
                CALL GGIP09 (0.0, PRBUF, 2, 0.4, ICOL, NRLN,
     1               PXOR + V2(1) - 0.4, PYOR + V2(2) - 0.20)
                IF (V2(3) .GE. 0) THEN
                  ICOL0 = 3
                ELSE
                  ICOL0 = 4
                END IF
                CALL GGIP (0.0, FLOAT(ICOL0), 0.0, 0)
                CALL GGIP (PXOR, PYOR, 0.0, 3)
                QXOR = PXOR + V2(1) * 0.9
                QYOR = PYOR + V2(2) * 0.9
                CALL GGIP (QXOR, QYOR, 0.0, 2)
              END IF
            END IF
          END IF
          IF (IGBL(31) .EQ. 3) WRITE (LU2, 99994, IOSTAT = IOST)
     1      NQ3(1:6), (XXO(KAT, L), L = 4, 6), (XSD(KAT, L), L = 4, 6)
        END IF
      END DO
      IF (IENI .NE. 2) CALL PLA096 (-1, NAMS(1, 1)(1:8), 0.0, PAR(454))
      IF (IGBL(31) .EQ. 3) THEN
        WRITE (LU2, 99993, IOSTAT = IOST)
        IF (IOST .NE. 0) STOP 'LU2 - 78'
      END IF
      IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
        IF (NCI .GE. 4 .AND. NCI .LE. 12) THEN
          DO J = 1, NCI
            DO K = 1, 3
              YP(K, J) = XXO(IATC(J), K + 3) - XXO(IAT, K + 3)
            END DO
          END DO
          CALL PLA278 (NCI, YP, LU7)
        END IF
      END IF
      IF (IPR(7) .NE. 0) THEN
        IF (IPR(122) .LT. 0) IPR(122) = 0
        IF (IPR(122) .EQ. 0 .AND. NCI .EQ. 5 .AND. IPR(7) .GT. 0)
     1      IPR(122) = -5
        IHEADER = 0
        KB = 0
        NN = NC - 1
        DO J1 = 1, NN
          JB1 = JATC(J1)
          CALL GEN048 (-1, IFG(1, JB1), 7, IVL)
          IF (IVL .EQ. 0 .OR. IPR(521) .NE. 0) THEN
            MM  = MAX (J1, IABS(IPR(122))) + 1
            DO 20 J2 = MM, NC
              JB2 = JATC(J2)
              CALL GEN048 (-1, IFG(1, JB2), 7, IVL)
              IF (IVL .EQ. 0 .OR. IPR(521) .NE. 0) THEN
                CALL PLA053 (JB1, IAT, JB2, 0, ANGLE, SANGL, ISANGL,
     1                       NDEC, IER)
                IF (IER .NE. 0) GO TO 20
                KB  = KB + 1
                CALL PLA036 (JB1, KB, 2, IDUM1, IDUM2, IDUM3, IPR(71),
     1                       IGBL(55))
                CALL PLA036 (JB2, KB, 3, IDUM1, IDUM2, IDUM3, IPR(71),
     1                       IGBL(55))
                DBUF(KB)  = ANGLE
                IDBUF(KB) = MIN (999, ISANGL)
                IFT       = -11 + KB * 33
                FORMB(IFT : IFT) = CHAR(ICHAR('0') + NDEC)
                IF (KB .GE. 4) THEN
                  IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
                    IF (IHEADER .EQ. 0) THEN
                      IHEADER = 1
                      CALL PLA262 (3)
                      WRITE (LU7, 99998, IOSTAT = IOST) NAMS(1, 1)(1:7)
                    END IF
                    WRITE (PRBUF, FORMB, IOSTAT = IOST) ((NAMS(L, M),
     1                M = 2, 3), DBUF(L), IDBUF(L), L = 1, KB)
                    CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                  END IF
                  KB = 0
                END IF
              END IF
   20       CONTINUE
          END IF
        END DO
        IF (KB .GT. 0 .AND. IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
          IF (IHEADER .EQ. 0) THEN
            IHEADER = 1
            CALL PLA262 (3)
            WRITE (LU7, 99998, IOSTAT = IOST) NAMS(1, 1)(1:7)
          END IF
          WRITE (PRBUF, FORMB, IOSTAT = IOST) ((NAMS(L, M), M = 2, 3),
     1                         DBUF(L), IDBUF(L), L = 1, KB)
          CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        END IF
        NC = MIN (NC, IABS(IPR(122)))
        IF (NC .EQ. 0 .OR. NC .LT. IABS(IPR(122))) GO TO 50
        DO I = 1, NMAX
          IATP(I) = I + 2 * NP1
        END DO
        DO I = 1, 5
          IATP(JATC(I)) = JATC(I)
        END DO
        IATP(IAT) = IAT + NP1
        NANG      = 0
        ANG1      = 0.0
        ANG2      = 0.0
        DO JJ = 1, 6
          XXO(KPC, JJ) = 0.0
          XSD(KPC, JJ) = 0.0
        END DO
        DO II = 1, NC
          IP = IATC(II)
          DO JJ = 1, 3
            XXO(KPC, JJ)     = XXO(KPC, JJ)     + XXO(IP, JJ)
            XXO(KPC, JJ + 3) = XXO(KPC, JJ + 3) + XXO(IP, JJ + 3)
            XSD(KPC, JJ)     = XSD(KPC, JJ)     + XSD(IP, JJ)
            XSD(KPC, JJ + 3) = XSD(KPC, JJ + 3) + XSD(IP, JJ + 3)
          END DO
          DATC(II) = 0.0
          IF (IPR(125) .EQ. 1 .AND. IABS(IPR(122)) .GT. 0)
     1        IATC(II) = KPC + II
        END DO
        YUNK = 0.0
        DO JJ = 1, 3
          XXO(KPC, JJ)     = XXO(KPC, JJ) / NC
          XXO(KPC, JJ + 3) = XXO(KPC, JJ + 3) / NC
          XSD(KPC, JJ)     = XSD(KPC, JJ)     / (NC**2)
          XSD(KPC, JJ + 3) = XSD(KPC, JJ + 3) / (NC**2)
          YUNK             = YUNK + XSD(KPC, JJ)
        END DO
        IF (YUNK .GT. 0.0) CALL GEN048 (1, IFG(2, KPC), 10, 1)
        CALL PLA262 (2)
        IF (IPR(125) .EQ. 0) THEN
          POLY = 'Real'
        ELSE
          POLY = 'Unit'
        END IF
        CALL PLA053 (IAT, KPC, 0, 0, DBUF(1), SDIJ, IDIS, INUM, IER)
        IF (IER .EQ. 0) THEN
          IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
            CALL PLA262 (3)
            IDBUF(1) = MIN (999, IDIS)
            FORME(33:33) = CHAR(ICHAR('0') + INUM)
            IFT0 = 45
            DO JJ = 1, 6
              IF (JJ .EQ. 4) IFT0 = 48
              XSIG = SQRT(XSD(KPC, JJ))
              CALL GEN041 (XXO(KPC, JJ), XSIG, IDBUF(JJ + 1), IPR(183),
     1                     NDEC, IPR(68))
              XSD(KPC, JJ)  = XSIG ** 2
              DBUF(JJ + 1)  = XXO(KPC, JJ)
              IDBUF(JJ + 1) = MIN (99, IDBUF(JJ + 1))
              IFT           = IFT0 + JJ * 16
              FORME(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
            END DO
            WRITE (LU7, 99999, IOSTAT = IOST)
            WRITE (PRBUF, FORME, IOSTAT = IOST) NAMS(1, 1)(2:7),
     1                          (DBUF(JJ), IDBUF(JJ), JJ = 1, 7)
            CALL PLA263 (LU7, PRBUF, 132, 1, 3)
            WRITE (LU7, 99985, IOSTAT = IOST) NAMS(1, 1)(1:7), POLY
          END IF
        END IF
        NN = NC - 1
        DO J1 = 1, NN
          JB1 = IATC(J1)
          IF (JB1 .GT. KPC) THEN
            IB1 = JATC(JB1 - KPC)
          ELSE
            IB1 = JB1
          END IF
          MM = J1 + 1
          DO 40 J2 = MM, NC
            JB2 = IATC(J2)
            IF (JB2 .GT. KPC) THEN
              IB2 = JATC(JB2 - KPC)
            ELSE
              IB2 = JB2
            END IF
            IF (NC .EQ. IABS(IPR(122))) THEN
              ANG = 0.0
              JX  = 0
              JY  = 0
              DO J3 = 1, NC
                IF (J3 .NE. J1 .AND. J3 .NE. J2) THEN
                  JB3 = IATC(J3)
                  DO J4 = 1, NC
                    IF (J4 .NE. J1 .AND. J4 .NE. J2 .AND. J4 .NE. J3)
     1                THEN
                      JB4 = IATC(J4)
                      CALL PLA050 (JB3, JB1, JB2, JB4, OME)
                      IF (ABS(OME) .GT. ANG) THEN
                        JX  = JB3
                        JY  = JB4
                        ANG = ABS(OME)
                      END IF
                    END IF
                  END DO
                END IF
              END DO
              IF (JX .EQ. 0 .OR. JY .EQ. 0) THEN
                WRITE (LU6, 99982, IOSTAT = IOST)
                GO TO 50
              END IF
              DO II = 1, NC
                JZ = IATC(II)
                IF (JZ .NE. JB1 .AND. JZ .NE. JB2 .AND.
     1              JZ .NE. JX .AND. JZ .NE. JY) GO TO 30
              END DO
   30         SOME = 0.0
              CALL PLA053 (JX, JB1, JB2, -JY, DBUF(3), SOME, IDUM1,
     1                    IDUM2, IER)
              IF (IER .NE. 0) GO TO 40
              IDBUF(3) = MIN (999, NINT(SOME * 100.0))
              CALL PLA053 (JX, JB1, JB2, -JZ, DBUF(4), SOME, IDUM1,
     1                     IDUM2, IER)
              IF (IER .NE. 0) GO TO 40
              IDBUF(4) = MIN (999, NINT(SOME * 100.0))
              CALL PLA053 (JZ, JB1, JB2, -JY, DBUF(5), SOME, IDUM1,
     1                     IDUM2, IER)
              IF (IER .NE. 0) GO TO 40
              IDBUF(5) = MIN (999, NINT(SOME * 100.0))
              DBUF(6)  = 180.0 - ABS(DBUF(4) + DBUF(5))
              IDBUF(6) = (IDBUF(4) + IDBUF(5)) / 2
              IF (DBUF(6) .GT. 0) THEN
                NANG         = NANG + 1
                KBO(NANG, 1) = JB1
                KBO(NANG, 2) = JB2
                BOK(NANG, 1) = DBUF(6)
                DATC(J1)     = DATC(J1) + 1
                DATC(J2)     = DATC(J2) + 1
              END IF
            END IF
            CALL PLA053 (IB1, IAT, IB2, 0, DBUF(1), SANGL, ISANG,
     1                   NDEC1, IER)
            IF (IER .NE. 0) GO TO 40
            CALL PLA053 (IB1, IB2,   0, 0, DBUF(2),  SDIJ, IDIS,
     1                   NDEC2, IER)
            IF (IER .EQ. 0) THEN
              IDBUF(1) = MIN (999, ISANG)
              IDBUF(2) = MIN (999, IDIS)
              FORMD(15 : 15) = CHAR(ICHAR('0') + NDEC1)
              FORMD(34 : 34) = CHAR(ICHAR('0') + NDEC2)
              CALL PLA036 (IB1, 1, 1, IDIS1, IDUM1, IDUM2, IPR(71),
     1                     IGBL(55))
              CALL PLA036 (IB2, 1, 2, IDIS2, IDUM1, IDUM2, IPR(71),
     1                     IGBL(55))
              CALL PLA047 (LABA(JX), NQ2, IDUM, JDUM, IPR(71),
     1                     IGBL(55), 0, 1 - IGBL(55))
              CALL PLA047 (LABA(JY), NQ3, IDUM, JDUM, IPR(71),
     1                     IGBL(55), 0, 1 - IGBL(55))
              IF (DBUF(1) .GT. ANG1) THEN
                ANG2 = ANG1
                ANG1 = DBUF(1)
              ELSE IF (DBUF(1) .GT. ANG2) THEN
                ANG2 = DBUF(1)
              END IF
              IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
                WRITE (PRBUF, FORMD, IOSTAT = IOST)
     1            (NAMS(1, M)(1:7), M = 1, 2),
     2            (DBUF(L), IDBUF(L), L = 1, 6), NQ2, NQ3
                CALL PLA263 (LU7, PRBUF, 132, 1, 3)
              END IF
            END IF
   40     CONTINUE
        END DO
        IF (IPR(122) .NE. 0) THEN
          IF (NC .EQ. 5) THEN
            IF (PAR(35) .GT. 0.0) THEN
              TBA = PAR(35)
            ELSE IF (IENI .EQ. 103) THEN
              TBA = 158
            ELSE
              TBA  = PAR(31)
            END IF
            PHC  = COS(TBA / (2 * RGBL(6)))
            PHS  = SIN(TBA / (2 * RGBL(6)))
            SPA1 = 180.0 - RGBL(6) * ATAN((1.0 + PHC) * SQRT(2.0) / PHS)
            SPA2 = 180.0 - 2.0 * RGBL(6) * ATAN(SQRT(2.0 / (1.0 + PHC)))
            TPA1 = 180.0 - 2.0 * RGBL(6) * ATAN(2.0 / SQRT(6.0))
            TPA2 = 180.0 - 2.0 * RGBL(6) * ATAN(2.0)
            DTP  = 4.0 * ABS(TPA1 - SPA1) + 2.0 * ABS(TPA1 - SPA2) +
     1        2.0 * ABS(TPA2 - SPA2) + TPA2
            IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
              CALL PLA262 (4)
              WRITE (LU7, 99979, IOSTAT = IOST)
              WRITE (PRBUF, 99977, IOSTAT = IOST)
     1           ANG1, ANG2, (ANG1 - ANG2) / 60.0
              WRITE (LU7, 99978, IOSTAT = IOST) PRBUF
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 0.6
                CALL GGIP09 (0.0, PRBUF, 132, 0.25, 5 + IGBL(68),
     1            2, 0.2, VRT)
              END IF
              CALL PLA262 (8)
              WRITE (LU7, 99983, IOSTAT = IOST)
     1          TBA, TPA1, TPA2, SPA1, SPA2, DTP
            END IF
            CALL GEN013 (DATC, IATC, 1, NC)
            CALL GEN013 (DATC, JATC, 1, NC)
            STP1 = 0.0
            SSP1 = 0.0
            SSP2 = 0.0
            SSP3 = 0.0
            DO II = 1, NANG
              JB1 = KBO(II, 1)
              JB2 = KBO(II, 2)
              ANG = BOK(II, 1)
              DO JJ = 1, NC
                IF (IATC(JJ) .EQ. JB1) J1 = JJ
                IF (IATC(JJ) .EQ. JB2) J2 = JJ
              END DO
              IF (J1 .GT. J2) THEN
                J0 = J1
                J1 = J2
                J2 = J0
              END IF
              IF (J1 .GT. 2) THEN
                TP1 = TPA2
              ELSE
                TP1 = TPA1
              END IF
              STP1 = STP1 + ABS(TP1 - ANG)
              SP1  = SPA1
              SP2  = SPA1
              SP3  = SPA1
              IF (J1 .EQ. 4 .AND. J2 .EQ. 5) SP1 = 0.0
              IF (J1 .EQ. 3 .AND. J2 .EQ. 5) SP2 = 0.0
              IF (J1 .EQ. 3 .AND. J2 .EQ. 4) SP3 = 0.0
              IF (J1 .EQ. 3 .OR.  J2 .EQ. 3) SP1 = SPA2
              IF (J1 .EQ. 4 .OR.  J2 .EQ. 4) SP2 = SPA2
              IF (J1 .EQ. 5 .OR.  J2 .EQ. 5) SP3 = SPA2
              SSP1 = SSP1 + ABS(SP1 - ANG)
              SSP2 = SSP2 + ABS(SP2 - ANG)
              SSP3 = SSP3 + ABS(SP3 - ANG)
            END DO
            QSP1 = DTP - SSP1
            QSP2 = DTP - SSP2
            QSP3 = DTP - SSP3
            CALL PLA047 (LABA(IATC(3)), NQ1, IDUM, JDUM, IPR(71),
     1                   IGBL(55), 0, 1 - IGBL(55))
            CALL PLA047 (LABA(IATC(4)), NQ2, IDUM, JDUM, IPR(71),
     1                   IGBL(55), 0, 1 - IGBL(55))
            CALL PLA047 (LABA(IATC(5)), NQ3, IDUM, JDUM, IPR(71),
     1                   IGBL(55), 0, 1 - IGBL(55))
            CALL PLA050 (IATC(4), IAT, IATC(5), 0, TH11)
            CALL PLA050 (IATC(3), IAT, IATC(5), 0, TH21)
            CALL PLA050 (IATC(3), IAT, IATC(4), 0, TH31)
            CALL PLA050 (IATC(1), IAT, IATC(2), 0, TH00)
            CALL PLA050 (IATC(1), IATC(4), IATC(5), IATC(2), OME)
            DLP1 = 180.0 - ABS(OME)
            CALL PLA050 (IATC(1), IATC(3), IATC(5), IATC(2), OME)
            DLP2 = 180.0 - ABS(OME)
            CALL PLA050 (IATC(1), IATC(3), IATC(4), IATC(2), OME)
            DLP3 = 180.0 - ABS(OME)
            CALL PLA262 (6)
            BDIF = STP1 - QSP1
            IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
              WRITE (LU7, 99991, IOSTAT = IOST)
     1          DTP, NQ1, STP1, SSP1, QSP1, DLP1, TH11, TH00, NQ2, STP1,
     2          SSP2, QSP2, DLP2, TH21, TH00, NQ3, STP1, SSP3, QSP3,
     3          DLP3, TH31, TH00
            END IF
            IF (STP1 - QSP2 .LT. BDIF) THEN
              NQ1   = NQ2
              QSP1  = QSP2
              BDIF  = STP1 - QSP1
            END IF
            IF (STP1 - QSP3 .LT. BDIF) THEN
              NQ1   = NQ3
              QSP1  = QSP3
              BDIF  = STP1 - QSP3
            END IF
            BAVER = (STP1 + QSP1) / 2.0
            PSTP1 = BAVER * 100.0 / DTP
            DO JATCI = 1, 5
              CALL PLA047 (LABA(JATC(JATCI)), NQ2, IDUM, JDUM,
     1          IPR(71), IGBL(55), 0, 1 - IGBL(55))
              IF (NQ2(1:6) .EQ. NQ1(1:6)) THEN
                IATP(JATC(JATCI)) = JATC(JATCI) + NP1
              END IF
            END DO
            IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
              CALL PLA262 (7)
              WRITE (LU7, 99999, IOSTAT = IOST)
              WRITE (PRBUF, 99992, IOSTAT = IOST) PSTP1, '>', '>'
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 0.5
                CALL GGIP09 (0.0, PRBUF, 132, 0.23, 5 + IGBL(68),
     1            2, 0.2, VRT)
              END IF
              WRITE (LU7, 99978, IOSTAT = IOST) PRBUF
              WRITE (LU7, 99976, IOSTAT = IOST) NQ1(1:6), BAVER, BDIF
            END IF
          END IF
          IF (PSTP1 .GT. 50) THEN
            IPR(12) = 4
            CALL GEN022 (IATP, 1, NMAX)
            CALL PLA055
            SGN = 1
            DO I = 1, 6
              IATPI = MOD(IATP(I), NP1)
              CALL PLA036 (IATPI, I, 1, IDUM1, IDUM2, IDUM3, IPR(71),
     1                     IGBL(55))
              CALL PLA056 (XPV(1), IATPI, DEV(I), SDV(I), ISDV(I),
     1                     5, NDEC)
              ISDV(I) = MIN (99, ISDV(I))
              IFT           = -12 + I * 22
              FORMF(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
            END DO
            IF (DEV(4) .LT. 0.0) SGN = -1.0
            IF (IGBL(63) .GT. 2 .AND. IENI .NE. 2) THEN
              CALL PLA262 (3)
              WRITE (LU7, 99999, IOSTAT = IOST)
              WRITE (PRBUF, 99997, IOSTAT = IOST)
     1          (NAMS(I, 1)(2:8), I = 1, 4)
              WRITE (LU7, 99978, IOSTAT = IOST) PRBUF
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 0.5
                CALL GGIP09 (0.0, PRBUF, 80, 0.25, 5 + IGBL(68),
     1            2, 0.0, VRT)
              END IF
              WRITE (PRBUF, FORMF, IOSTAT = IOST)
     1          (NAMS(I, 1)(2:8), DEV(I) * SGN, ISDV(I), I = 1, 6)
                CALL PLA263 (LU7, PRBUF, 132, 1, 3)
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 0.5
                CALL GGIP09 (0.0, PRBUF, 132, 0.23, 5 + IGBL(68),
     1            2, 0.0, VRT)
              END IF
            END IF
          END IF
        END IF
      END IF
   50 IF (IWIN .EQ. 1) THEN
        IF (IABS(IGBL(6)) .EQ. 1) THEN
          CALL PLA015 (0, 45)
        END IF
        CALL PLA297 (2)
        IF (IGGT(1:4) .EQ. 'CALC') GO TO 10
      END IF
      IPR(440) = IABS(IPR(440))
      RETURN
99999 FORMAT (1X)
99998 FORMAT (/, 'Angles (Degrees)  At1...V...At2 with Vertex V = ',
     1  A, /, 132('-'))
99997 FORMAT (
     1 ' Distance (Ang) to SP Square Base Plane Defined by:', 4(1X, A))
99996 FORMAT (':: No Metal-Metal Distances within ', F5.1,
     1        ' Ang. for ', A)
99994 FORMAT ('ATOM ', A, 6F8.4)
99993 FORMAT ('ENDS')
99992 FORMAT ('Trigonal Bipyramid (TP) to Square Pyramid (SP)',
     1 ' ::: Perc. Along Berry Pseudorotation Coordinate:', F6.1, 2X,
     2 ':::  D3h  ---', A, ' C2v ---', A, ' C4v')
99991 FORMAT (/, 'Pivot(3)', 4X, 'Sum(/Del:C - Del:TP/)', 8X, 'Sum(',
     1 '/Del:C - Del:SP/)', 8X, F5.1, ' - Sum(/Del:C - Del:SP/)', 5X,
     2 'Del(24)   Th(24)   Th(15)', /, 132('-'), 3(/, 1X, A, 8X,
     3 3(F8.1, ' Deg.', 16X), 3F9.2))
99990 FORMAT ('Analysis of the Coordination Geometry')
99989 FORMAT ('Analysis of Metal-Metal Geometry')
99988 FORMAT (132('-'), //, 'Distances are calculated from atom I',
     1 ' of Unique Molecule Coordinate List to atom J in Asymmetric',
     2 ' Residue Unit: ARU.', //, 'Phi = Azimuth angle(counter',
     3 ' clockwise from XO in XO,YO-Plane), Mu  = Angle between D and',
     4 ' XO,YO-plane.', //, '''To-Code'' : ''--'' = Bonded atoms, ',
     5 ' ''<<'' = .LT. sum vdW-radii - 0.2, ''.<'' = .LT. sum vdW',
     6 '-radii, ''..'' = .GT. sum vdW-radii.', //,
     7 '>>>> NOTICE >>>> : The Symmetry Code',
     8 ' Character Added to the Atom Label Applies to the Current',
     9 ' Coordination Sphere Only.', /,
     * '>>>>>>>>>>>>>>>> : Symmetry operations refer to the',
     1 ' coordinates listed in the fractional coordinate table',
     2 ' given above', //, 19X, 'The List May be',
     * ' Limited to the Shortest Distances.')
99987 FORMAT (1X, 'Nr     d(I,J) To  Atom J  Symm_Oper. on Atom',
     3  ' J', 4X, 'ARU(J)  Type', 5X, 'Phi', 5X, 'Mu', 9X, 'X', 8X,
     4 'Y', 8X, 'Z', 8X, 'XO', 6X, 'YO', 6X, 'ZO', /, 132('-'))
99986 FORMAT ('Distance Scan for Element ', A)
99985 FORMAT (/, 'Real Angles I - ', A, ' - J', 8X, 'Real Edge I - J',
     1 5X, A4, ' Polyhedron Dihedral Angles', 5X, 'Norm. IJK:IJL', 2X,
     2 'K', 8X, 'L', /, 132('-'))
99984 FORMAT (/, A, /)
99983 FORMAT (//, 'Analysis of Five-Coordination (See R.R. Holmes in ',
     1 'Progress in Inorg. Chem. Vol. 32 (1984),119-235 and References',
     2 ' Therein)', /, 132('-'), /, 'Idealized Dihedral Angles for',
     3 ' Trans Basal Angle  :', F6.1, /8X, 'Del(13) & Del(23) Trigonal',
     4 ' Bipyramid (TP):', 2F6.1, /, 12X, 'Del(12) & Del(13) Square',
     5 ' Pyramid (SP):', 2F6.1, /, 'Distance Between TP and SP Along',
     6 ' Berry Coordinate:', F6.1)
99982 FORMAT (/, ':: Coordination Analysis Aborted !', //)
99981 FORMAT (132('-'))
99980 FORMAT (F5.1, ' Ang. Coordination Sphere Around ', A,
     1  2X, 'Green = Above, Blue = Below Plane')
99979 FORMAT (/, 'Tau-Descriptor for 5-Coordination (A.W.Addison,T.N.',
     1 'Rao,J.Reedijk,J.van Rijn,G.C.Verschoor, J.Chem.Soc.Dalton ',
     2 'Trans.(1984),1349-1356)', /, 132('-'))
99978 FORMAT (A)
99977 FORMAT ('Tau = (Beta - Alpha) / 60 = (', F6.2, '-', F6.2,
     1        ') / 60 =', F5.2,
     2        '  :  (Extreme forms: Tau = 0.00 for SP and 1.00 for TP)')
99976 FORMAT (/, 'NOTE: This Analysis Depends on the Value of the',
     1 ' Trans Basal Angle that is used (Default Value = 150 Deg.).', /,
     2 6X, 'The Pivot Atom that Best Describes a Berry Pseudo',
     3 ' Rotation is: ', A, /, 6X, 'The Percentage has been',
     4 ' Calculated for the Average value,', F7.1, ' Deg., of the',
     5 ' Second and Fourth Table Entry.', /, 5X, ' The Difference,',
     6 F7.1, ' Deg., Between the Second and Fourth Table Entry',
     7 ' (for pivot) should be Zero for a True',
     * ' Berry Rotation.')
      END SUBROUTINE PLA078
      SUBROUTINE PLA079 (NPC, LU)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      INTEGER KJ(3), NCL(30), SKI(8, 30), INC(3, 7), IG(4, 4), NQ(7),
     1 MQ(7), GC(4, 4), Q(27), NVV(8), MVV(8), LVV(8), TR(3, 3, 85),
     2 IV(7, 7), NL(4), TP(4, 4, 7), SB(30), IDT(13), TT(20, 14)
      REAL G(4, 4), GN(4, 4), A(4, 4), AW(3, 3), AV(4, 4), PP(4, 4, 6),
     1 GW(3, 3), GG(3, 3), AC(6), E(4,4), GV(4, 4), GS(7, 7), AD(4, 4),
     2 O(7, 7)
      CHARACTER Y(6)*1, HT(7)*1, NPC*1, PRBUF*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      DATA Y /
     1 'a', 'm', 'o', 't', 'h', 'c'/
      DATA HT /
     1 'P', 'A', 'B', 'C', 'F', 'I', 'R'/
      DATA GC /
     1 0, 12, 13, 14, 12, 0, 23, 24, 13, 23, 0, 34, 14, 24, 34, 0/
      DATA Q /
     1 1, 1, 4, 1, 1, 2, 3, 2, 2, 1, 1, 3, 1, 1, 4, 4, 2, 2, 2, 3, 3,
     2 4, 2, 3, 4, 4, 1/
      DATA PP /
     1 -1.0,  0.0,  0.0,  0.0,  1.0,  0.0,  1.0,  0.0,  0.0,  1.0,  0.0,
     2  0.0,  1.0,  0.0,  0.0,  1.0, -1.0,  0.0,  0.0,  0.0,  1.0,  1.0,
     3  0.0,  0.0,  0.0,  0.0,  1.0,  0.0,  1.0,  0.0,  0.0,  1.0, -1.0,
     4  0.0,  0.0,  0.0,  1.0,  1.0,  0.0,  0.0,  0.0,  0.0,  0.0,  1.0,
     5  1.0,  0.0,  1.0,  0.0,  0.0, -1.0,  0.0,  0.0,  1.0,  1.0,  0.0,
     6  0.0,  0.0,  0.0,  1.0,  0.0,  0.0,  1.0,  0.0,  1.0,  0.0, -1.0,
     7  0.0,  0.0,  1.0,  1.0,  0.0,  0.0,  0.0,  0.0,  0.0,  1.0,  0.0,
     8  1.0,  1.0,  0.0,  0.0,  0.0, -1.0,  0.0,  1.0,  0.0,  1.0,  0.0,
     9  0.0,  0.0,  0.0,  1.0,  0.0,  1.0,  1.0,  0.0/
      DATA NVV /
     1 14, 15, 19, 14, 14, 17, 18, 16/
      DATA IV /
     1 0, 5, 6, 7, 2, 3, 4, 5, 0, 7, 6, 1, 4, 3, 6, 7, 0, 5, 4, 1, 2, 7,
     2 6, 5, 0, 3, 2, 1, 2, 1, 4, 3, 0, 0, 0, 3, 4, 1, 2, 0, 0, 0, 4, 3,
     3 2, 1, 0, 0, 0/
      DATA INC /
     1 1, 0, 0, 0, 1, 0, 0, 0, 1, -1, -1, -1, 1, 1, 0, 1, 0, 1, 0, 1, 1/
      DATA SKI /
     1  0,  0, 14,  0, 14, 14,  1, 61,  0,  0, 14, 14, 14,  0,  2, 61,
     2  0, 13, 13, 13, 13,  0,  3, 65, 12, 12, 12, 12, 12, 12,  4, 66,
     3 12,  0, 12,  0, 12, 34,  1, 51,  0, 13, 13, 13, 24,  0,  5, 57,
     4 12, 12, 14, 12, 14, 14,  6, 57,  0,  0, 14,  0, 14, 34,  1, 41,
     5  0,  0, 14, 14, 24,  0,  2, 41,  0,  0, 14, 23,  0, 23, 13, 41,
     6  0, 13, 13, 13, 13, 34,  7, 46, 12, 13, 13, 13, 13, 12,  4, 46,
     7  0,  0, 14,  0, 24, 34,  1, 31,  0,  0, 14, 23, 24,  0,  2, 31,
     8  0, 13, 14, 14, 13,  0,  4, 36,  0, 13, 13, 23, 23,  0,  7, 36,
     9 12,  0, 14,  0, 12, 34,  8, 34, 12,  0, 14,  0, 14, 34,  9, 34,
     *  0, 13, 13, 23, 23, 34,  7, 36, 12, 13, 14, 14, 13, 12,  4, 36,
     1 12, 13, 13, 13, 13, 34,  3, 35,  0, 13, 14,  0, 24, 34,  1, 21,
     2  0, 13, 14, 23, 23,  0, 10, 26,  0, 13, 14, 23, 13,  0, 28, 26,
     3  0, 13, 14, 14, 13, 34, 11, 26,  0, 13, 14, 13, 14, 34, 12, 26,
     4  0, 13, 14, 23, 23, 34, 10, 26, 12, 13, 14, 14, 13, 34, 11, 26,
     5 12, 13, 14, 13, 14, 34, 12, 26, 12, 13, 14, 23, 24, 34,  1, 11/
      DATA (((TR(I, J, K), I = 1, 3), J = 1, 3), K = 1, 21) /
     1 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1,
     2 1, 1, 0,-1, 1, 0, 1, 1, 2, 0, 1, 1, 1, 0, 1, 1, 1, 0,
     3 1, 0, 0, 0, 0, 1, 1, 3, 2, 1,-1, 0, 0, 1,-1, 1, 1, 1,
     4 1, 0, 0, 0, 1, 0, 1, 1, 2, 2, 1, 0, 0, 1, 0, 0, 0, 1,
     5 1,-1, 0, 1, 1, 0, 0, 0, 1,-1,-1,-2, 0, 1, 0, 1, 0, 0,
     6 0, 1, 1, 1, 1, 0,-1, 0,-1,-1,-1,-1, 1,-1, 0, 0, 0, 1,
     7 0, 1, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1,
     8 0,-1, 0,-1, 0, 0, 0, 0,-1, 0, 0,-1, 0,-1, 0,-1, 0, 0,
     9 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0,
     *-1, 0, 0, 0, 0,-1, 0,-1, 0, 1, 0, 0, 0,-1, 0,-1, 0,-1,
     1 0, 0,-1, 0, 1, 0, 1, 0, 1/
      DATA (((TR(I, J, K), I = 1, 3), J = 1, 3), K = 22, 85) /
     1 1, 0, 1, 0, 1, 0,-1, 0, 0, 1, 0, 1, 0,-1, 0, 0, 0,-1,
     2 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0,-1, 0, 0, 0,-1,
     3-1, 0, 0, 0, 1, 0, 0, 0,-1,-1, 0, 0, 0,-1, 0, 0, 0, 1,
     4 1, 1, 0, 0,-1,-1,-1, 0,-1, 1, 1, 0, 0,-1, 1, 1,-1,-1,
     5-1,-1, 0, 0, 1, 1,-1, 1,-1,-1, 1, 0, 0,-1,-1,-1,-1, 1,
     6 1, 0, 1, 1, 0,-1, 0, 1, 0, 0, 1, 1, 0,-1, 1, 1, 0, 0,
     7 0, 0, 1, 1, 1, 0,-1, 1,-1, 0, 0, 1, 1,-1, 0, 1, 1,-1,
     8 1, 0, 0, 0, 1, 1,-1,-1, 1, 1, 0, 0, 0,-1, 1,-1,-1,-1,
     9 0, 1, 0, 1, 0, 1, 1,-1,-1, 0, 1, 0, 1, 0,-1,-1,-1,-1,
     *-1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 1, 0,-1, 0, 1,
     1 0,-1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1,-1, 0,
     2 0, 1, 1, 1, 0, 0, 0, 0,-1, 1, 0,-1, 0, 1, 0, 0, 0, 1,
     3 1, 0, 0, 1, 2, 0, 0, 0, 1, 0, 1, 0,-2,-1, 0, 0, 0, 1,
     4 1, 2, 1, 1, 0, 0, 0, 0,-1, 1, 0,-1, 1, 2, 0, 0, 0, 1,
     5-1, 1, 1, 1, 1, 0, 0, 0,-1, 1, 1,-1,-1, 1, 0, 0, 0, 1,
     6 2, 1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 1, 2, 1, 0, 0, 1,-1,
     7 6,-6, 0, 0, 6,-6, 3, 3, 3, 6, 6, 0, 0,-6, 6, 3,-3,-3,
     8-6,-6, 0, 0, 6, 6,-3, 3,-3,-6, 6, 0, 0,-6,-6,-3,-3, 3,
     9 3,-3, 3, 6, 6, 0,-3, 3, 3,-3,-3, 3, 6,-6, 0, 3, 3, 3,
     *-3, 3, 3, 6, 0, 6, 3, 3,-3, 3, 3, 3, 6, 0,-6,-3, 3,-3,
     1 3, 3,-3, 0, 6, 6, 3,-3, 3, 3,-3,-3, 0, 6,-6, 3, 3, 3,
     2 3,-3, 0, 3, 3, 0, 0, 0, 6, 3, 0, 3, 3, 0,-3, 0, 6, 0,
     3 0, 3, 3, 0,-3, 3, 6, 0, 0, 3,-3, 0, 0, 3,-3, 6, 6, 6,
     4 3, 3, 0, 0,-3, 3, 6,-6,-6,-3,-3, 0, 0, 3, 3,-6, 6,-6,
     5-3, 3, 0, 0,-3,-3,-6,-6, 6, 0, 0, 6, 3, 3, 0,-3, 3, 0,
     6 0, 0, 6, 3,-3, 0, 3, 3, 0, 6, 0, 0, 0, 3, 3, 0,-3, 3,
     7 6, 0, 0, 0,-3, 3, 0,-3,-3, 0, 6, 0, 3, 0, 3, 3, 0,-3,
     8 0, 6, 0, 3, 0,-3,-3, 0,-3, 0, 0, 6, 6, 0, 0, 2, 4,-2,
     9 2,-2,-2, 6, 6, 0, 0, 0, 6, 4, 2,-4, 0, 6, 0, 0, 0, 6,
     * 0,-3, 3, 6, 0, 0, 0, 3, 3, 3, 0,-3, 0, 6, 0, 3, 0, 3,
     1 3, 3, 0, 0, 0, 6, 3,-3, 0,-4,-8,-2, 6, 0, 0,-2,-4, 2,
     2 2,-2,-2, 6, 6, 0, 4,-4, 2, 8, 4,-2, 0, 6, 0, 4, 2, 2/
      DATA MVV /
     1 14, 15, 14, 17, 19, 14, 18, 16/
      DATA LVV /
     1 14, 14, 20, 22, 16, 21, 14, 23/
      DATA TT /
     1  141, 1741, 1841,  657, 2957, 3057, 3157,  131,  934, 3234, 3334,
     2  121, 1721, 1821, 3426, 3526, 3626, 3726, 3826, 3926,  146, 1746,
     3 1846, 5457, 5557, 5657, 5757,  136,  935, 3235, 3335,  126, 1726,
     4 1826, 5826, 5926, 6026, 6126, 6226, 6326, 6446, 6546, 6646, 6757,
     5 6857, 6957, 7057,  135, 6436, 6536, 6636, 6426, 6526, 6626, 7126,
     6 7226, 7326, 7426, 7526, 7626,  131,  934,  121, 1721, 1821, 3426,
     7 3526,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     8    0,    0,    0,  136,  935,  126, 1726, 1826, 5826, 5926,    0,
     9    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     *    0, 4634,  934, 4734,  121, 4826, 4926, 5026, 5126, 5226, 5326,
     1    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 7726,
     2 7826, 7926,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     3    0,    0,    0,    0,    0,    0,    0,    0,  121, 1721, 1821,
     4    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     5    0,    0,    0,    0,    0,    0, 8021, 4026, 4126,    0,    0,
     6    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     7    0,    0,    0,    0, 8121, 4226, 4326,    0,    0,    0,    0,
     8    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     9    0,    0, 8221, 4426, 4526,    0,    0,    0,    0,    0,    0,
     *    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     1 8026, 8126, 8226,    0,    0,    0,    0,    0,    0,    0,    0,
     2    0,    0,    0,    0,    0,    0,    0,    0,    0,  126, 1726,
     3 1826,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     4    0,    0,    0,    0,    0,    0,    0, 8326, 8426, 8526,    0,
     5    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     6    0,    0,    0,    0,    0/
      DATA SB /
     1 21, 21, 21, 21, 11, 4, 4, 8, 8, 8, 8, 8, 4, 4, 4, 4, 4,
     2  4,  4,  4,  4,  1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA IDT /
     161, 66, 65, 41, 46, 51, 57, 31, 32, 33, 34, 35, 36/
      DATA TP /
     1 6, 0, 0, 0, 0, 6, 0, 0, 0, 0, 6, 0, 0, 0, 0, 6, 6, 0, 0, 0, 0, 3,
     2 3, 0, 0,-3, 3, 0, 0, 6, 0, 6, 3, 0,-3, 0, 0, 6, 0, 0, 3, 0, 3, 0,
     3 0, 0, 6, 6, 3, 3, 0, 0,-3, 3, 0, 0, 0, 0, 6, 0, 6, 0, 0, 6, 0, 3,
     4 3, 0, 3, 0, 3, 0, 3, 3, 0, 0, 0, 0, 0, 6,-3, 3, 3, 0, 3,-3, 3, 0,
     5 3, 3,-3, 0, 3, 3, 3, 6, 4, 2, 2, 0,-2, 2, 2, 0,-2,-4, 2, 0, 6, 6,
     6 0, 6/
      BCD(1:24) = 'Delaunay Cell Reduction'//CHAR(0)
      CALL GGIP (HORS, VERT, 0.0, 1)
      CALL GGIP09 (0.0,  BCD, 24, 1.2, 4, 8, 0.6, VERT - 1.8)
      CALL GGIP09 (0.0,  BCD, 24, 1.2, 2, 8, 0.5, VERT - 1.9)
      PAGET = 'DELRED'
      M     = 0
      ZW4   = 0.0
      ISYS  = 1
      NBR   = 1
      ISE   = 1
      NCP   = 0
      IZ    = 1
      INO   = 0
      IK    = 0
      CALL GEN074 (AW, 1, 9, 0.0)
      CALL GEN097 (NCL, 1, 30, 0)
      DO I = 1, 6
        AC(I) = PAR(100 + I)
      END DO
      DO I = 1, 7
        NQ(I) = I
      END DO
      CALL PLA262 (0)
      VRT  = VERT - 5.0
      WRITE (PRBUF, 99999, IOSTAT = IOST) PAR(382), PAR(381)
      IF (IOST .EQ. -999) RETURN
      WRITE (LU, 99986, IOSTAT = IOST) PRBUF(1:80)
      CALL GGIP09 (0.0, PRBUF, 80, 0.45, 1, 2, 0.2, VRT)
      WRITE (PRBUF, 99998, IOSTAT = IOST)
      WRITE (LU, 99985, IOSTAT = IOST) PRBUF(1:80)
      VRT = VRT - 1.5
      CALL GGIP09 (0.0, PRBUF, 80, 0.40, 1, 2, 0.2, VRT)
      WRITE (PRBUF, 99997, IOSTAT = IOST) NPC, AC
      WRITE (LU, 99987, IOSTAT = IOST) PRBUF(1:80)
      VRT = VRT - 1.5
      CALL GGIP09 (0.0, PRBUF, 80, 0.40, 5 + IGBL(68), 2, 0.2, VRT)
      CALL GEN026 (1, GG, PAR(101))
      DO I = 1, 7
        IF (NPC .EQ. HT(I)) M = I
      END DO
      DO I = 1, 4
        DO J = 1, 4
          G(I, J)  = 0.0
          AV(I, J) = 0.0
          AD(I, J) = TP(I, J, M) / 6.0
          IF (I .LT. 4 .AND. J .LT. 4) GW(I, J) = AD(I, J)
        END DO
      END DO
      CALL GEN001 (-1, GW, GG, GG)
      DO I = 1, 3
        DO J = 1, 3
          G(I, J) = GG(I, J)
          G(4, 4) = G(4, 4) + GG(I, J)
          G(I, 4) = G(I, 4) - GG(I, J)
        END DO
        G(4, I) = G(I, 4)
      END DO
      CALL GEN074 (GW, 1, 9, 0.0)
      MC = -1 0
      DO WHILE (MC .NE. 0)
        MC = 0
        DO I = 1, 4
          DO J = 1, 4
            A(I, J)  = AD(I, J)
            GN(I, J) = G(I, J)
            IF (ABS(G(I, J)) .LT. 0.00006) G(I, J) = 0.0
            IF (MC .EQ. 0 .AND. J .GT. I .AND. G(I, J) .GT. 0.0)
     1        MC = J + 2 * I - 3 - I / 3
          END DO
        END DO
        IF (MC .NE. 0) THEN
          DO I = 1, 4
            DO J = 1, 4
              G(I, J) = 0.0
              AD(I, J) = 0.0
              DO K = 1, 4
                AD(I, J) = AD(I, J) + A(I, K) * PP(K, J, MC)
                DO L = 1, 4
                  G(I, J) = G(I, J) +
     1                      GN(K, L) * PP(K, I, MC) * PP(L, J, MC)
                END DO
              END DO
            END DO
          END DO
          CYCLE
        END IF
      END DO
      DO IST = 0, 10
        DO I = 1, 4
          DO J = 1, 4
            IG(I, J) = GC(I, J)
            A(I, J)  = AD(I, J)
          END DO
        END DO
        DO I = 1, 3
          DO J = I, 4
            ZW1 = 0.0025 * (G(I, I) + G(J, J)) * IST
            IF (ABS(G(I, J)) .LT. ZW1) IG(I, J) = 0
            DO K = 1, 3
              DO L = K, 4
                IF (IG(K, L) .EQ. 10 * K + L .AND.
     1              (K .GT. I .OR. L .GT. J) .AND.
     2              ABS(G(I, J) - G(K, L)) .LT. 3.0 *
     3             (ZW1 + 0.0025 * (G(K, K) + G(L, L)) * IST))
     4              IG(K, L) = IG(I, J)
              END DO
            END DO
            IG(J, I) = IG(I, J)
          END DO
        END DO
        DO IC = 1, 30
          DO INL1 = 1, 4
            NL(1) = INL1
            DO INL2 = 1, 4
              NL(2) = INL2
              IF (NL(1) .NE. NL(2)) THEN
                DO 40 INL3 = 1, 4
                  NL(3) = INL3
                  IF (NL(3) .EQ. NL(1) .OR. NL(3) .EQ. NL(2)) GO TO 40
                  NL(4) = 10 - NL(1) - NL(2) - NL(3)
                  DO MX = 1, 6
                    M1 = NL(1 + MX / 4 + MX / 6)
                    M2 = NL(1 + MX - 2 * (MX / 4) - MX / 6)
                    IYUNK = IG(M1, M2) - 5 * SKI(MX, IC)
                    IF (IYUNK .GT. 0) THEN
                      GO TO 40
                    ELSE IF (IYUNK .LT. 0) THEN
                      N1 = NL(SKI(MX, IC) / 10)
                      N2 = NL(SKI(MX, IC) - 10 * (SKI(MX, IC) / 10))
                      IF (IG(M1, M2) .NE. IG(N1, N2)) GO TO 40
                    END IF
                  END DO
                  IF (NCP .GT. 0) THEN
                    DO I = 1, NCP
                      IF (IC .EQ. NCL(I)) GO TO 40
                    END DO
                  END IF
                  NCP = NCP + 1
                  NCL(NCP) = IC
                  ISE = SB(IC)
                  DO IS = 1, ISE
                    IF (IC .NE. 30) THEN
                      IF (IS .LE. 1) THEN
                        DO I = 1, 4
                          DO J = 1, 4
                            GV(J, I) = 0.0
                            E(J, I)  = 0.0
                          END DO
                          E(NL(I), I) = 1.0
                        END DO
                        DO I = 1, 4
                          DO J = 1, 4
                            A(I, J) = AD(I, 1) * E(1, J)
     1                              + AD(I, 2) * E(2, J)
     1                              + AD(I, 3) * E(3, J)
     3                              + AD(I, 4) * E(4, J)
                            DO K = 1, 4
                              DO L = 1, 4
                                GV(I, J) = GV(I, J)
     1                                   + G(K, L) * E(L, J) * E(K, I)
                              END DO
                            END DO
                          END DO
                        END DO
                        DO I = 1, 3
                          DO J = 1, 3
                            GN(I, J) = GV(I, J)
                            A(I, J)  = A(I, J) - A(4, J)
                          END DO
                        END DO
                      END IF
                      ISYS = SKI(8, IC) / 10
                      NBR  = SKI(8, IC) - 10 * ISYS
                      N    = SKI(7, IC)
                      IF (IS .NE. 1) THEN
                        DO I = 1, 3
                          DO J = 1, 3
                            A(I, J)  = AW(I, J)
                            GN(I, J) = GW(I, J)
                          END DO
                        END DO
                        N = TT(IS - 1, IK) / 100
                        ISYS = (TT(IS - 1, IK) - 100 * N) / 10
                        NBR  = TT(IS - 1, IK) - 100 * N - 10 * ISYS
                      END IF
                      ZW1 = 1.0 - 0.83333333 * FLOAT(N / 54)
                      DO I = 1, 3
                        DO J = 1, 3
                          AV(I, J) = 0.0
                          GV(I, J) = 0.0
                          DO K = 1, 3
                            AV(I, J) = AV(I, J)
     1                               + A(I, K) * ZW1 * TR(K, J, N)
                            DO L = 1, 3
                              GV(I, J) = GV(I, J) + ZW1 * ZW1 * GN(K, L)
     1                                 * TR(L, J, N) * TR(K, I, N)
                            END DO
                          END DO
                        END DO
                      END DO
                      IZ = 1
                      IF (ISYS .LT. 3) THEN
                        ZW = GV(1, 1) + GV(3, 3) - GV(1, 3)
     1                     * SIGN (2.0, GV(1, 3))
                        IF (ZW .LT. GV(1, 1)) IZ = IZ + 1
                        IF (ZW .LT. GV(3, 3)) IZ = IZ + 2
                        IF (GV(3, 3) .LT. GV(1, 1)) IZ = IZ + 4
                        IF (NBR .EQ. 6) NBR = 2 * (MOD(IZ + 2, 4)
     1                                      + (IZ / 6) * (6 / IZ))
                        DO I = 1, 3
                          DO J = 1, 3
                            E(I, J) = TR(I, J, LVV(IZ))
                            IF (I .NE. 3) E(I, J) = - E(I, J)
     1                                            * SIGN (1.0, GV(1, 3))
                          END DO
                        END DO
                      ELSE IF (ISYS .GT. 3) THEN
                        GO TO 10
                      ELSE
                        IF (GV(1, 1) .GT. GV(2, 2)) IZ = IZ + 1
                        IF (GV(1, 1) .GT. GV(3, 3)) IZ = IZ + 2
                        IF (GV(2, 2) .GT. GV(3, 3)) IZ = IZ + 4
                        DO L = 1, 3
                          DO M = 1, 3
                            E(L, M) = TR(L, M, MVV(IZ))
                          END DO
                        END DO
                        IF (NBR .GT. 1 .AND. NBR .LT. 5)
     1                    NBR = 4 - IZ / 3
                      END IF
                    ELSE
                      DO I = 1, 7
                        DO J = 1, 7
                          IF (I .LT. 4 .AND. J .LT. 4) A(I, J) =
     1                                       A(I, J) - A(4, J)
                          GS(I, J) = 0.0
                          DO K = 1, 3
                            DO L = 1, 3
                              GS(I, J) = GS(I, J) + G(K, L)
     1                                 * INC(K, I) * INC(L, J)
                            END DO
                          END DO
                        END DO
                      END DO
                      DO I = 1, 6
                        DO J = I, 7
                          O(I, J) = GS(I, I) * GS(J, J)
     1                            - GS(I, J) * GS(I, J)
                          IF (GS(I, I) .GT. GS(J, J)) THEN
                            NQ(I) = NQ(I) + 1
                            NQ(J) = NQ(J) - 1
                          END IF
                          O(J, I) = O(I, J)
                        END DO
                      END DO
                      DO I = 1, 7
                        MQ(NQ(I)) = I
                      END DO
                      ZW1 = GS(MQ(1), MQ(1))
                      ZW2 = GS(MQ(2), MQ(2))
                      ZW3 = GS(MQ(3), MQ(3))
                      IF (IV(MQ(1), MQ(2)) .EQ. MQ(3))
     1                    ZW3 = GS(MQ(4), MQ(4))
                      DO I = 1, 5
                        ID = MQ(I)
                        IF (ZW1 .GE. GS(ID, ID)) THEN
                          DO J = I, 6
                            JD = MQ(J)
                            IF (J .NE. I .AND. ZW2 .GE. GS(JD, JD)) THEN
                              DO K = J, 7
                                KD = MQ(K)
                                IF (K .NE. J .AND. ZW3 .GE. GS(KD, KD)
     1                            .AND. KD .NE. IV(ID, JD)) THEN
                                  IF (O(ID, JD) + O(JD, KD)
     1                                        + O(ID, KD) .GE. ZW4) THEN
                                    KJ(1) = ID
                                    KJ(2) = JD
                                    KJ(3) = KD
                                    ZW4   = O(ID, JD) + O(ID, KD)
     1                                    + O(JD, KD)
                                  END IF
                                END IF
                              END DO
                            END IF
                          END DO
                        END IF
                      END DO
                      DO M = 1, 3
                        DO L = 1, 3
                          GV(M, L) = GS(KJ(M), KJ(L))
                          GN(M, L) = 0.0
                          IF (GV(M, L) .NE. 0.0) GN(M, L) =
     1                        GV(M, L) / ABS(GV(M, L))
                          DO J = 1, 3
                            AV(L, M) =
     1                      AV(L, M) + A(L, J) * INC(J, KJ(M))
                          END DO
                        END DO
                      END DO
                      N = INT(14.5 + GN(1, 2) + 3.0 * GN(1, 3)
     1                  + 9.0 * GN(2, 3))
                      IF (GV(1, 1) .EQ. GV(2, 2) .AND.
     1                   ABS(GV(2, 3)) .GT. ABS(GV(1, 3))) IZ = IZ + 1
                      IF (GV(3, 3) .EQ. GV(2, 2) .AND.
     1                   ABS(GV(1, 3)) .GT. ABS(GV(1, 2))) IZ = IZ + 2
                      IF (GV(1, 1) .EQ. GV(3, 3) .AND.
     1                   ABS(GV(2, 3)) .GT. ABS(GV(1, 2))) IZ = IZ + 4
                      DO I = 1, 3
                        DO J = 1, 3
                          E(I, J) = 0.0
                          DO K = 1, 3
                            E(I, J) = E(I, J) + TR(I, K, 23 + Q(N))
     1                              * TR(K, J, NVV(IZ))
                          END DO
                        END DO
                      END DO
                    END IF
                    DO I = 1, 3
                      DO J = 1, 3
                        A(I, J)  = AV(I, J)
                        GN(I, J) = GV(I, J)
                      END DO
                    END DO
                    DO I = 1, 3
                      DO J = 1, 3
                        AV(I, J) = A(I, 1) * E(1, J) + A(I, 2) * E(2, J)
     1                           + A(I, 3) * E(3, J)
                        GV(I, J) = 0.0
                        DO K = 1, 3
                          DO L = 1, 3
                            GV(I, J) = GV(I, J)
     1                               + GN(K, L) * E(L, J) * E(K, I)
                          END DO
                        END DO
                      END DO
                    END DO
                    IF (ISYS .EQ. 2 .AND. GV(1, 3) .GT. 0.0) THEN
                      DO I = 1, 3
                        AV(I, 3) = - AV(I, 3)
                      END DO
                      GV(1, 3) = - GV(1, 3)
                      GV(3, 1) =   GV(1, 3)
                    END IF
   10               DO I = 1, 2
                      II = I + 1
                      DO J = II, 3
                        N       = 6 - I - J
                        A(N, N) = AV(I, I) * AV(J, J)
     1                          - AV(I, J) * AV(J, I)
                        A(J, I) = AV(N, I) * AV(J, N)
     1                          - AV(N, N) * AV(J, I)
                        A(I, J) = AV(N, J) * AV(I, N)
     1                          - AV(N, N) * AV(I, J)
                      END DO
                    END DO
                    ZW1 = A(1, 1) * AV(1, 1) + A(1, 2) * AV(2, 1)
     1                  + A(1, 3) * AV(3, 1)
                    DO I = 1, 3
                      DO J = 1, 3
                        AV(I, J) = AV(I, J) * SIGN (1.0, ZW1)
                        IF (IS .EQ. 1) THEN
                          AW(I, J) = AV(I, J)
                          GW(I, J) = GV(I, J)
                        END IF
                        A(J, I) = A(J, I) / ABS(ZW1)
                      END DO
                      AC(I) = SQRT(GV(I, I))
                      J     = I + 1 - 3 * (I / 3)
                      ZW    = GV(I, J) / SQRT(GV(I, I) * GV(J, J))
                      AC(9 - I - J) = 57.29578
     1                              * ATAN2(SQRT(1.0 - ZW * ZW), ZW)
                    END DO
                    IF (ISYS .EQ. 2) THEN
                      XM = GV(1, 1) / GV(2, 2)
                      YM = GV(3, 3) / GV(2, 2)
                      ZM = XM + YM + 2.0 * GV(1, 3) / GV(2, 2)
                      IF (NBR .NE. 1) THEN
                        ZW = GV(3, 3) + FLOAT(NBR / 4)
     1                     * (GV(1, 1) - GV(3, 3))
     2                     + FLOAT(NBR / 6) * (GV(3, 3)
     3                     + GV(1, 3) * 2.0)
                        ZM = (GV(1, 1) + FLOAT((NBR / 4) - (NBR / 6)) *
     1                       (GV(3, 3) - GV(1, 1))) / ZW
                        YM = GV(2, 2) / ZW
                        XM = ((GV(1, 1) + GV(3, 3) + GV(1, 3) * 2.0) *
     1                       FLOAT((NBR / 2) - (NBR / 4)) *
     2                       FLOAT(1 - (NBR / 6))
     2                     + FLOAT(NBR / 6) * GV(3, 3)) / ZW
                      END IF
                    END IF
                    IF (IS .EQ. 1) THEN
   20                 CALL PLA015 (0, 39)
                      CALL PLA013 (1, 1)
                      CALL GEN020 (1, IGGT, 1, 80)
                      IF (IGGT(1:4) .EQ. 'PLOT') THEN
                        GO TO 20
                      ELSE IF (IGGT(1:4) .EQ. 'EXIT' .OR.
     1                         IGGT(1:1) .EQ. 'N') THEN
                        CALL GEN038 (IGGT, 1, 80)
                        RETURN
                      END IF
                      CALL PLA262 (0)
                      CALL GGIP (HORS, VERT, 0.0, 1)
                      WRITE (PRBUF, 99993, IOSTAT = IOST)
     1                  NCP, IC, IST, Y(ISYS), HT(NBR)
                      WRITE (LU, 99987, IOSTAT = IOST) PRBUF(1:80)
                      VRT = VERT - 0.7
                      CALL GGIP09 (0.0, PRBUF, 80, 0.40, 5 + IGBL(68),
     1                             2, 0.2, VRT)
                      VRT = VRT - 0.2
                    END IF
                    ISJ = IS - 1
                    IF (IS .NE. 1) THEN
                      WRITE (PRBUF, 99991, IOSTAT = IOST)
     1                  ISJ, Y(ISYS), HT(NBR)
                      WRITE (LU, 99988, IOSTAT = IOST) PRBUF(1:80)
                      VRT = VRT - 0.7
                      CALL GGIP09 (0.0, PRBUF, 80, 0.40, 3, 2, 0.2, VRT)
                    END IF
                    IF (ISYS .EQ. 2) THEN
                      WRITE (PRBUF, 99989, IOSTAT = IOST) XM, YM, ZM
                      WRITE (LU, 99988, IOSTAT = IOST) PRBUF(1:80)
                    END IF
                    IF ((ISYS .NE. 1 .AND. ISYS .NE. 5 .AND.
     1                (ABS(AC(4) - 90.0) .GE. PAR(381) .OR.
     2                 ABS(AC(6) - 90.0) .GE. PAR(381))) .OR.
     3                 (ISYS .GT. 2 .AND. ABS(AC(5) - 90.0)
     4                 .GE. PAR(381))
     5                 .OR. (ISYS .EQ. 5 .AND. (ABS(AC(6) - 120.0) .GE.
     6                 PAR(381) .OR. ABS(AC(4) - 90.0) .GE. PAR(381)))
     7                 .OR. (ISYS .GT. 3 .AND. ABS(AC(1) - AC(2)) .GE.
     8                 PAR(382)) .OR. (ISYS .EQ. 6
     9                .AND. (ABS(AC(1) - AC(3)) .GE. PAR(382) .OR.
     *                 ABS(AC(2) - AC(3)) .GE. PAR(382)))) THEN
                      WRITE (PRBUF, 99990, IOSTAT = IOST)
     1                  (AC(I), I = 1, 6)
                      VRT = VRT - 0.40
                      CALL GGIP09 (0.0, PRBUF, 80, 0.30, 2, 2, 0.2, VRT)
                      WRITE (LU, 99988, IOSTAT = IOST) PRBUF(1:80)
                      IF (INO .NE. 1) GO TO 30
                    END IF
                    WRITE (PRBUF, 99996, IOSTAT = IOST)
     1                (AC(I), I = 1, 3)
                    VRT = VRT - 0.7
                    CALL GGIP09 (0.0, PRBUF, 80, 0.40, 1, 2, 0.2, VRT)
                    WRITE (LU, 99988, IOSTAT = IOST) PRBUF(1:80)
                    WRITE (PRBUF, 99995, IOSTAT = IOST)
     1                (AC(I), I = 4, 6)
                    VRT = VRT - 0.55
                    CALL GGIP09 (0.0, PRBUF, 80, 0.40, 1, 2, 0.2, VRT)
                    WRITE (LU, 99987, IOSTAT = IOST) PRBUF(1:80)
                    WRITE (PRBUF, 99994, IOSTAT = IOST)
                    VRT = VRT - 0.7
                    CALL GGIP09 (0.0, PRBUF, 80, 0.40, 5 + IGBL(68),
     1                           2, 0.2, VRT)
                    WRITE (LU, 99988, IOSTAT = IOST) PRBUF(1:80)
                    DO I = 1, 3
                      WRITE (PRBUF, 99992, IOSTAT = IOST)
     1                  (GV(I, J), J = 1, 3),
     2                  (AV(I, K), K = 1, 3), (A(I, L), L = 1, 3)
                      WRITE (LU, 99987, IOSTAT = IOST) PRBUF(1:80)
                      VRT = VRT - 0.55
                      CALL GGIP09 (0.0, PRBUF, 80, 0.40, 1, 2, 0.2, VRT)
                    END DO
   30               DO I = 1, 13
                      IF (IS .EQ. 1 .AND. 10 * ISYS + NBR .EQ. IDT(I))
     1                    IK = I
                    END DO
                    IF (IK .EQ. 7 .AND. IC .EQ. 6) IK = 14
                  END DO
   40           CONTINUE
              END IF
            END DO
          END DO
        END DO
      END DO
      CALL PLA015 (0, 39)
      CALL PLA013 (1, 1)
      RETURN
99999 FORMAT ('Delaunay Cell Reduction [Tol-Axis =', F5.2,
     1        ', Tol-Angle =', F5.2, ']')
99998 FORMAT ('See: H. Zimmermann & H. Burzlaff, ',
     1        'Z. fur Krist. (1985) 170, 241-246')
99997 FORMAT ( 'INPUT CELL:   ', A, 6F9.3)
99996 FORMAT (9X, 'a =', F9.3, 11X, 'b =', F9.3, 11X, 'c =', F9.3)
99995 FORMAT ( 5X, 'alpha =', F9.3, 8X, 'beta =', F9.3, 7X,
     1       'gamma =', F9.3)
99994 FORMAT (7X, 'Metric Tensor', 12X, 'Transf.-Matrix', 6X,
     1        'Inverse Matrix')
99993 FORMAT (2X, ' Proposal', I3, '   Delaunay Case',
     1        I3, 4X, 'Cycle', I3, 6X, 'Lattice Type: ', 2A)
99992 FORMAT (3(F9.2), 2X, 3(F6.2), 2X, 3(F6.2))
99991 FORMAT (4X, 'Subgroup Cell No.', I3, 24X, 'Lattice Type: ', 2A)
99990 FORMAT (5X, 'Out of Range [', 6F9.3, ']')
99989 FORMAT (' Reduced Monoclinic Lattice Coordinates:',
     1        3X, 'xm = ', F6.3, 1X, 'ym = ', F6.3, 1X, 'zm = ', F6.3)
99988 FORMAT (/, A)
99987 FORMAT (A)
99986 FORMAT (A, /, 80('='), /)
99985 FORMAT (A, /)
      END SUBROUTINE PLA079
      SUBROUTINE PLA080
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION KAX(3)
      IF (IPR(39) .EQ. 0) THEN
        IF (IPR(48) .GT. 48) THEN
          IPR(129) = 9
          PAR(42)  = 10.0
          WRITE (LU6, 99999, IOSTAT = IOST)
        END IF
        IF (PAR(101) .LT. 1.1) THEN
          IGBL(52) = 1
          IPR(23)  = 1
          IPR(34)  = 1
          IPR(35)  = 2
          IPR(36)  = 3
        ELSE
          CALL SGSM (ICL, 0, XJX, LU7, -18, IERR)
          SPGRNM(1) = ICL(1:26)
          SPGRNM(4) = ICL(15:26)
          IF (IGBL(8) .EQ. 3 .AND. IPR(522) .EQ. 0) THEN
C * ALERT _123
            IF (SPGRNM(1)(1:1) .EQ. ' ')
     1          CALL PLA231 (123, 0, 1.0, 1.0, ' ', ' ')
          END IF
          KRSYST(2) = ICL(27:38)
          LAUEGR    = ICL(39:43)
          CALL GEN020 (-1, KRSYST(2), 1, 12)
          IF (ICL(72:72) .EQ. 'C') THEN
            CHSG    = 'Chiral'
            IPR(33) = 1
          END IF
          CALL GEN020 (-1, SPGRNM(1), 16, 26)
          IPR(202) = NINT(XJX(1))
          IPR(241) = NINT(XJX(7))
          IPR(242) = NINT(XJX(8))
          IPR(255) = NINT(XJX(4))
          IPR(256) = NINT(XJX(6))
          IPR(257) = NINT(XJX(5))
          IPR(258) = NINT(XJX(3))
          IPR(259) = NINT(XJX(2))
          IF (ICL(12:12) .EQ. 'h') THEN
            PAR(261) = 120.0
          ELSE
            PAR(261) = 90.0
          END IF
        END IF
        IF (PAR(104) .EQ. 0.0) PAR(104) = 90.0
        IF (PAR(105) .EQ. 0.0) PAR(105) = 90.0
        IF (PAR(106) .EQ. 0.0) PAR(106) = PAR(261)
        PAR(13) = 0
        PAR(14) = 0
        IF (INDEX (KRSYST(2), 'trigonal') .NE. 0) THEN
          IF (ABS(PAR(106) - PAR(105)) .LT. 0.5) THEN
            KRSYST(2) = 'rhombohedral'
          END IF
        END IF
        IF (IGBL(94) .EQ. 0 .AND. IPR(522) .EQ. 0) THEN
          YUNK    = PAR(107) / PAR(101)
          AXISMIN = MIN (PAR(101), PAR(102), PAR(103))
          AXISMAX = MAX (PAR(101), PAR(102), PAR(103))
          AXISRAT = (AXISMAX - AXISMIN) / AXISMIN
          IF (YUNK .LT. 0.000001) THEN
            IF (YUNK .GT. 0.0) THEN
              YUNK1 = -999.0
            ELSE
              YUNK1 = 1.0
            ENDIF
C * ALERT _141
            CALL PLA231 (141, 5, YUNK1, PAR(107), ' ', ' ')
          ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
            CALL PLA231 (148, 3, 1.0, PAR(107), '     a ', ' ')
          END IF
          IF (INDEX (KRSYST(2), 'triclinic') .NE. 0) THEN
            YUNK = PAR(108) / PAR(102)
            IF (YUNK .LT. 0.000001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _142
              CALL PLA231 (142, 5, YUNK1, PAR(108), ' ', ' ')
            ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
              CALL PLA231 (148, 3, 1.0, PAR(108), '     b ', ' ')
            END IF
            YUNK = PAR(109) / PAR(103)
            IF (YUNK .LT. 0.000001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _143
              CALL PLA231 (143, 5, YUNK1, PAR(109), ' ', ' ')
            ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
              CALL PLA231 (148, 3, 1.0, PAR(109), '     c ', ' ')
            END IF
            IF (PAR(107) .GT. 0.00001 .AND. AXISRAT .GT. 0.5) THEN
C * ALERT _153
              IF (PAR(107) .EQ. PAR(108) .AND. PAR(108) .EQ. PAR(109))
     1          CALL PLA231 (153, 5, -999.0, PAR(107), ' ', ' ')
            END IF
            IF (PAR(110) .LT. 0.0005) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _144
              CALL PLA231 (144, 4, YUNK1, PAR(110), ' ', ' ')
            ELSE IF (PAR(110) .GT. 0.05) THEN
C * ALERT _149
              CALL PLA231 (149, 2, PAR(110), PAR(110), ' alpha ', ' ')
            END IF
            IF (PAR(111) .LT. 0.0005) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _145
              CALL PLA231 (145, 4, YUNK1, PAR(111), ' ', ' ')
            ELSE IF (PAR(111) .GT. 0.05) THEN
C * ALERT _149
              CALL PLA231 (149, 2, PAR(111), PAR(111), '  beta ', ' ')
            END IF
            IF (PAR(112) .LT. 0.0005) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C *ALERT _146
              CALL PLA231 (146, 4, YUNK1, PAR(112), ' ', ' ')
            ELSE IF (PAR(112) .GT. 0.05) THEN
C * ALERT _149
              CALL PLA231 (149, 2, PAR(112), PAR(112), ' gamma ', ' ')
            END IF
C * ALERT _154 - TEST FOR EQUAL CELL ANGLE SU's
            IF (PAR(110) .GT. 0.0005) THEN
              IF (PAR(110) .EQ. PAR(111) .AND. PAR(111) .EQ. PAR(112))
     1          CALL PLA231 (154, 5, -999.0, PAR(110), ' ', ' ')
            END IF
C * ALERT _156
          ELSE IF (INDEX (KRSYST(2), 'monoclinic') .NE. 0) THEN
            N90  = 0
            MSET = 0
            IF (PAR(104) .NE. 90.0) THEN
              N90  = N90 + 1
              MSET = 1
            END IF
            IF (PAR(105) .NE. 90.0) THEN
              N90  = N90 + 1
              MSET = 2
            END IF
            IF (PAR(106) .NE. 90.0) THEN
              N90  = N90 + 1
              MSET = 3
            END IF
            IF (N90 .EQ. 0) THEN
C * ALERT _181
              CALL PLA231 (181, 0, 1.0, 1.0, ' ', ' ')
              IF (PAR(110) + PAR(111) + PAR(112) .EQ. 0.0) THEN
C * ALERT _182
                CALL PLA231 (182, 0, 1.0, 1.0, ' ', ' ')
              END IF
            ELSE IF (N90 .GT. 1) THEN
C * ALERT _138
              CALL PLA231 (138, 0, 1.0, 1.0, ' ', ' ')
            END IF
            YUNK = PAR(108) / PAR(102)
            IF (YUNK .LT. 0.00001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _142
              CALL PLA231 (142, 5, YUNK1, PAR(108), ' ', ' ')
            ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
              CALL PLA231 (148, 4, 1.0, PAR(108), '     b ', ' ')
            END IF
            YUNK = PAR(109) / PAR(103)
            IF (YUNK .LT. 0.00001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _143
              CALL PLA231 (143, 5, YUNK1, PAR(109), ' ', ' ')
            ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
              CALL PLA231 (148, 3, 1.0, PAR(109), '     c ', ' ')
            END IF
            IF (PAR(107) .GT. 0.00001 .AND. AXISRAT .GT. 0.5) THEN
C * ALERT _153
              IF (PAR(107) .EQ. PAR(108) .AND. PAR(108) .EQ. PAR(109))
     1          CALL PLA231 (153, 5, -999.0, PAR(107), ' ', ' ')
            END IF
            IF (MSET .EQ. 1) THEN
              IF (PAR(110) .LT. 0.0005) THEN
                IF (YUNK .GT. 0.0) THEN
                  YUNK1 = -999.0
                ELSE
                  YUNK1 = 1.0
                ENDIF
C * ALERT _145
                CALL PLA231 (145, 4, YUNK1, PAR(110), ' ', ' ')
              ELSE IF (PAR(110) .GT. 0.05) THEN
C * ALERT _149
                CALL PLA231 (149, 2, 1.0, PAR(110), ' alpha ', ' ')
              END IF
            ELSE IF (MSET .EQ. 2) THEN
              IF (PAR(111) .LT. 0.0005) THEN
                IF (YUNK .GT. 0.0) THEN
                  YUNK1 = -999.0
                ELSE
                  YUNK1 = 1.0
                ENDIF
C * ALERT _145
                CALL PLA231 (145, 4, YUNK1, PAR(111), ' ', ' ')
              ELSE IF (PAR(111) .GT. 0.05) THEN
C * ALERT _149
                CALL PLA231 (149, 2, 1.0, PAR(111), '  beta ', ' ')
              END IF
            ELSE IF (MSET .EQ. 3) THEN
              IF (PAR(112) .LT. 0.0005) THEN
                IF (YUNK .GT. 0.0) THEN
                  YUNK1 = -999.0
                ELSE
                  YUNK1 = 1.0
                ENDIF
C * ALERT _146
                CALL PLA231 (146, 4, YUNK1, PAR(112), ' ', ' ')
              ELSE IF (PAR(112) .GT. 0.05) THEN
C * ALERT _149
                CALL PLA231 (149, 2, 1.0, PAR(112), ' gamma ', ' ')
              END IF
            END IF
C * ALERT _157
            IF (PAR(105) .LT. 90.0)
     1        CALL PLA231 (157, 2, 1.0, PAR(105), ' ', ' ')
            IF (PAR(104) .EQ. 90.0 .AND. PAR(105) .NE. 90.0 .AND.
     1          PAR(106) .EQ. 90.0) THEN
C * ALERT _147
              IF (PAR(110) .NE. 0.0 .OR. PAR(112) .NE. 0.0)
     1          CALL PLA231 (147, 0, 1.0, 1.0, ' ', ' ')
            END IF
C * ALERT _137
          ELSE IF (INDEX (KRSYST(2), 'orthorhombic') .NE. 0) THEN
            IF (PAR(104) .NE. 90.0 .OR. PAR(105) .NE. 90.0 .OR.
     1          PAR(106) .NE. 90.0) CALL PLA231 (137, 0, 1.0, 1.0,
     2                                           ' ', ' ')
            YUNK = PAR(108) / PAR(102)
            IF (YUNK .LT. 0.00001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _142
              CALL PLA231 (142, 5, YUNK1, PAR(108), ' ', ' ')
            ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
              CALL PLA231 (148, 4, 1.0, PAR(108), '     b ', ' ')
            END IF
            YUNK = PAR(109) / PAR(103)
            IF (YUNK .LT. 0.00001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _143
              CALL PLA231 (143, 5, YUNK1, PAR(109), ' ', ' ')
            ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
              CALL PLA231 (148, 3, 1.0, PAR(109), '     c ', ' ')
            END IF
            IF (PAR(107) .GT. 0.00001 .AND. AXISRAT .GT. 0.5) THEN
C * ALERT _153
              IF (PAR(107) .EQ. PAR(108) .AND. PAR(108) .EQ. PAR(109))
     1          CALL PLA231 (153, 5, -999.0, PAR(107), ' ', ' ')
            END IF
C * ALERT _147
            IF (PAR(110) .NE. 0.0 .OR. PAR(111) .NE. 0.0 .OR.
     1          PAR(112) .NE. 0.0)
     2            CALL PLA231 (147, 0, 1.0, 1.0, ' ', ' ')
          ELSE IF (INDEX (KRSYST(2), 'tetragonal') .NE. 0) THEN
C * ALERT _135
            IF (PAR(101) .NE. PAR(102))
     1        CALL PLA231 (135, 0, 1.0, 1.0, ' ', ' ')
            YUNK = PAR(109) / PAR(103)
            IF (YUNK .LT. 0.00001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
C * ALERT _143
              CALL PLA231 (143, 5, YUNK1, PAR(109), ' ', ' ')
            ELSE IF (YUNK .GT. 0.001) THEN
C * ALERT _148
              CALL PLA231 (148, 3, 1.0, PAR(109), '     c ', ' ')
            END IF
C * ALERT _136
            IF (PAR(104) .NE. 90.0 .OR. PAR(105) .NE. 90.0 .OR.
     1          PAR(106) .NE. 90.0)
     2            CALL PLA231 (136, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _147
            IF (PAR(110) .NE. 0.0 .OR. PAR(111) .NE. 0.0 .OR.
     1          PAR(112) .NE. 0.0)
     2            CALL PLA231 (147, 0, 1.0, 1.0, ' ', ' ')
          ELSE IF (INDEX (KRSYST(2), 'rhombohedral') .NE. 0) THEN
C * ALERT _139
            IF (PAR(101) .NE. PAR(102) .OR. PAR(101) .NE. PAR(103))
     1        CALL PLA231 (139, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _140
            IF (PAR(104) .NE. PAR(105) .OR. PAR(104) .NE. PAR(106))
     1        CALL PLA231 (140, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _144
            IF (PAR(110) .LT. 0.0005) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
              CALL PLA231 (144, 4, YUNK1, PAR(110), ' ', ' ')
            END IF
          ELSE IF (INDEX (KRSYST(2), 'trigonal') .NE. 0 .OR.
     1             INDEX (KRSYST(2), 'hexagonal') .NE. 0) THEN
C * ALERT _132
            IF (PAR(101) .NE. PAR(102))
     1        CALL PLA231 (132, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _133
            IF (PAR(104) .NE. 90.0 .OR. PAR(105) .NE. 90.0)
     1        CALL PLA231 (133, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _134
            IF (PAR(106) .NE. 120.0)
     1        CALL PLA231 (134, 0, 1.0, 1.0, ' ', ' ')
            YUNK = PAR(109) / PAR(103)
C * ALERT _143
            IF (YUNK .LT. 0.00001) THEN
              IF (YUNK .GT. 0.0) THEN
                YUNK1 = -999.0
              ELSE
                YUNK1 = 1.0
              ENDIF
              CALL PLA231 (143, 5, YUNK1, PAR(109), ' ', ' ')
C * ALERT _148
            ELSE IF (YUNK .GT. 0.001) THEN
              CALL PLA231 (148, 3, 1.0, PAR(109), '     c ', ' ')
            END IF
          ELSE IF (INDEX (KRSYST(2), 'cubic') .NE. 0) THEN
C * ALERT _130
            IF (PAR(101) .NE. PAR(102) .OR. PAR(101) .NE. PAR(103))
     1        CALL PLA231 (130, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _131
            IF (PAR(104) .NE. 90.0 .OR. PAR(105) .NE. 90.0 .OR.
     1        PAR(106) .NE. 90.0) CALL PLA231 (131, 0, 1.0, 1.0,
     2         ' ', ' ')
C * ALERT _147
            IF (PAR(110) .NE. 0.0 .OR. PAR(111) .NE. 0.0 .OR.
     1          PAR(112) .NE. 0.0)
     2            CALL PLA231 (147, 0, 1.0, 1.0, ' ', ' ')
          END IF
        END IF
        CALL GEN026 (1, RAA, PAR(101))
        CALL GEN113 (PAR(101), PAR(241), 6)
        CALL GEN003 (RAA, RBB, DET, 0)
        IF (DET .LT. 0.0) CALL GEN127 ('CANNOT INVERT METRICAL MATRIX')
        CALL GEN026 (-1, RBB, PAR(135))
        CALL GEN025 (RBB, PAR(391), 1)
        CALL GEN001 (1, TM1, RAA, AA)
        CALL GEN003 (AA, BB, DET, 0)
        IF (DET .LT. 0.0) CALL GEN127 ('CANNOT INVERT METRICAL MATRIX')
        PAR(98) = SQRT(DET)
        DO I = 1, 3
          PAR(128 + I) = AA(I, I)
          PAR(112 + I) = SQRT(BB(I, I))
          PAR(190 + I) = BB(I, I)
        END DO
        PAR(194) = BB(2, 3)
        PAR(195) = BB(1, 3)
        PAR(196) = BB(1, 2)
        PAR(132) = AA(1, 2) * 2.0
        PAR(133) = AA(1, 3) * 2.0
        PAR(134) = AA(2, 3) * 2.0
        CALL GEN026 (-1, AA, PAR(101))
        CALL GEN067 (TM1, PAR(241), PAR(101), PAR(107), PAR(107))
        CALL GEN066 (1, PAR(101), PAR(107), SPGRNM(1)(12:12))
        NZERO = 0
        DO I = 1, 3
          CALL GEN041 (PAR(100 + I), PAR(106 + I), IPR(280 + I), 5,
     1         IPR(286 + I), IPR(68))
            IF (IPR(280 + I) .GT. 0) THEN
              IF (MOD(NINT(PAR(100 + I) * 10 ** IPR(286 + I)), 10)
     1          .EQ. 0) THEN
                IF (IPR(280 + I) .EQ. 10) THEN
                  IPR(280 + I) = 1
                  IPR(286 + I) = IPR(286 + I) - 1
                ELSE
                  NZERO = NZERO + 1
                END IF
              END IF
            END IF
          CALL GEN041 (PAR(103 + I), PAR(109 + I), IPR(283 + I), 4,
     1         IPR(289 + I), IPR(68))
            IF (IPR(283 + I) .GT. 0) THEN
              IF (MOD(NINT(PAR(103 + I) * 10 ** IPR(289 + I)), 10)
     1          .EQ. 0) THEN
                IF (IPR(283 + I) .EQ. 10) THEN
                  IPR(283 + I) = 1
                  IPR(289 + I) = IPR(289 + I) - 1
                ELSE
                  NZERO = NZERO + 1
                END IF
              END IF
            END IF
        END DO
C * ALERT _180
        IF (NZERO .GT. 2)
     1    CALL PLA231 (180, 0, -999.0, FLOAT(NZERO), ' ', ' ')
        DO I = 1, 3
          R = PAR(106 + I) / PAR(100 + I)
          IF (R .GT. PAR(13)) PAR(13) = R
          IF (PAR(109 + I) .GT. PAR(14)) PAR(14) = PAR(109 + I)
        END DO
        DO I = 1, 3
          V4(I) = COS(PAR(103 + I) / RGBL(6))
          IF (ABS(V4(I)) .LT. 1E-6) V4(I) = 0.0
          V3(I) = SIN(PAR(103 + I) / RGBL(6))
        END DO
        CALL GEN068 (PAR(101), PAR(98), PAR(107), PAR(21))
        CALL GEN041 (PAR(98), PAR(21), IPR(293), 3, IPR(294), IPR(68))
        IF (PAR(21) .GT. 0.0) THEN
          XDUM = ABS (PAR(164) - PAR(98)) / PAR(21)
          IF (IPR(522) .EQ. 0) THEN
C * ALERT _150
            IF (XDUM .GT. 0.01 .AND. IGBL(94) .EQ. 0)
     1        CALL PLA231 (150, 2, XDUM, PAR(164), ' ', ' ')
C * ALERT _152
            IF (PAR(327) .GT. 0.0) THEN
              IYUNK = MAX (IPR(294), IPR(314))
              IPR293 = IPR(293) * 10**(IYUNK - IPR(294))
              IPR313 = IPR(313) * 10**(IYUNK - IPR(314))
              YUNK = IPR293 - IPR313
              IF (ABS(YUNK) .GT. 1.0) THEN
                CALL PLA231 (152, 0, -999.0, YUNK, ' ', ' ')
              END IF
            END IF
          END IF
        END IF
        PAR(116) = (V4(2) * V4(3) - V4(1)) / (V3(2) * V3(3))
        PAR(117) = (V4(1) * V4(3) - V4(2)) / (V3(1) * V3(3))
        PAR(118) = (V4(1) * V4(2) - V4(3)) / (V3(1) * V3(2))
        DO K = 16, 18
          PAR(103 + K) = SQRT(1.0 - PAR(100 + K)**2)
        END DO
        CALL GEN044 (PAR(101), OR, 1)
        CALL GEN003 (OR, ROR, DET, 0)
        IF (DET .LT. 0.0) CALL GEN127 ('CANNOT INVERT OR MATRIX')
        DO I = 1, 3
          KAX(I) = NINT(PAR(100 + I) * 10.0) * 10 + I
        END DO
        CALL GEN022 (KAX, 1, 3)
        DO I = 1, 3
          K = KAX(4 - I) / 10
          IPR(33 + I) = KAX(4 - I) - K * 10
        END DO
        IPR(185) = IPR(36)
        IPR(186) = IPR(35)
        IPR(187) = IPR(34)
        CALL GEN108 (LU4, 0)
        IF (IPR(23) .EQ. 0) THEN
          NEWLAT(1) = 0
          CALL PLA202 (1)
        END IF
        IPR(522) = 1
      END IF
99999 FORMAT (':: Maximum number of allowed residues reduced:',
     1        ' Round ARU to 0.1 units!', /)
      RETURN
      END SUBROUTINE PLA080
      SUBROUTINE PLA081
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,
     2 NP22=287,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER ICH*1, JCH*1, FORMA*82, ISORD*4, SPSITE*6, WNOTE(2)*42,
     1 CDUM*(NP52)
      DIMENSION PERC(NP10), ISOF(48)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER CN3*1, CN31*1
      DATA (ISOF(I), I = 1, 48) /
     1 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,
     2 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
     3 0, 0, 0, 0, 0, 1/
      IWIN = IGBL(25) * IGBL(32)
      WNOTE(1) = ' '
      WNOTE(2) = '[Note: Based on SHELXL2014 Atomic Weights]'
      FORMA( 1:40) = '( 6X,''Calculated Density ='',F8.4,''('',I2,'
      FORMA(41:82) = ''') g cm-3 [= Mg m-3]'',30x,''** WARNING **'')'
      NATX = IPR(37)
      NAT  = IPR(39)
      NRES = IPR(75)
      NSYM = IPR(48)
      IPR(488) = 3
      PAR(163) = 0.0
      PAR(157) = 0.0
      DO J = 1, NP10
        CONT(J, 2) = 0.0
      END DO
      IF (IGBL(63) .GT. 2) THEN
        IF (IPR(44) .EQ. 1) THEN
          CALL PLA262 (3)
          WRITE (LU7, 99986, IOSTAT = IOST)
          ISORD = 'Diso'
        ELSE
          ISORD = '   O'
        END IF
        IF (IPR(683) .NE. 0) THEN
          CALL PLA262 (3)
          WRITE (LU7, 99982, IOSTAT = IOST)
        END IF
        NWL = 34 + NRES - IPR(23) * 15
        CALL PLA262 (NWL)
        WRITE (LU7, 99999, IOSTAT = IOST)
     1    ISORD, (LMT(IENS(K), 1), K = 1, IAN)
        WRITE (LU7, 99985, IOSTAT = IOST)
      END IF
      DO IRES = 1, NRES
        MULT = MLTI(IRES)
        IF (MULT .LE. 0) MULT = 1
        NN = NP1 + 1 - IRES
        DO J = 1, 5
          XXO(NN, J) = 0.0
          XSD(NN, J) = 0.0
        END DO
        XXO(NN, 6) = 1.0
        DO J = 1, NP10
          CONT(J, 1) = 0.0
        END DO
        SUMWT = 0.0
        DO 20 J = 1, NAT
          CALL GEN048 (-6, IFG(1, J), 9, IRESJ)
          IF (IRESJ .EQ. IRES) THEN
            IF (J .GT. NATX) THEN
              KMX = J - 1
              DO 10 K = 1, KMX
                DO L = 1, 3
                  DIF = ABS(XXO(J, L) - XXO(K, L))
                  IF (ABS(MOD(DIF, 1.0)) .GT. 0.0001) GO TO 10
                END DO
                GO TO 20
   10         CONTINUE
            END IF
            CALL GEN048 (-7, IFG(2, J), 1, NPP)
            NPP = NPP + 1
            PPM = MULT * IPPR(NPP, 3) * IPPR(NPP, 1) / (NSYM * 1000.0)
            CALL GEN048 (-4, IFG(1, J), 15, NO1)
            NO1 = NO1 + 1
            WT  = SATWT(NO1)
            IF (NINT(WT) .EQ. 0) WT = 1.0
            SUMWT = SUMWT + WT
            DO L = 1, 3
              XXO(NN, L) = XXO(NN, L) + XXO(J, L) * WT
            END DO
            IF (J .LE. NATX) THEN
              CONT(NO1, 1) = CONT(NO1, 1) + PPM
              XXO(NN, 4)   = XXO(NN, 4)   + WT * PPM
              XXO(NN, 5)   = MAX(XXO(NN, 5), IPPR(NPP, 1) / 1000.0)
              XXO(NN, 6)   = MIN(XXO(NN, 6), IPPR(NPP, 1) / 1000.0)
            END IF
          END IF
   20   CONTINUE
        IF (XXO(NN, 5) .NE. XXO(NN, 6)) XXO(NN, 5) = 1.000
        IF (SUMWT .EQ. 0.0) THEN
          IPR(2)   = 32
          IPR(323) = 8
          RETURN
        END IF
        DOM = 1
        DO J = 1, 3
          XJX(J)     = XXO(NN, J) / SUMWT
          XXO(NN, J) = XJX(J)
        END DO
        SPSITE = '      '
        IF (IPR(101) .GT. 0) THEN
          NMOL = IPR(13)
          DO K = 2, NMOL
            ML  = MOL(K)
            XML = ML / PAR(42)
            CALL GEN098 (ML, PAR(42), MOL1, MOL2, MOL3, MOL4, IRES0)
            IF (IRES0 .EQ. IRES) THEN
              IF (MOL1 .GT. IPR(48)) THEN
                MOL1   = MOL1 - IPR(48)
                XML    = XML  - IPR(48) * 1000
                XJX(4) = MOL2
                XJX(5) = MOL3
                XJX(6) = MOL4
                CALL SGSM (ICL, MOL1, XJX, LU6, 3, IERR)
                DO J = 1, 3
                  XXO(NN, J) = XXO(NN, J) + XJX(J + 6)
                END DO
                DOM = DOM + 1
              END IF
            END IF
          END DO
          DO K = 1, 3
            XXO(NN, K) = XXO(NN, K) / DOM
          END DO
        END IF
        DO K = 1, 3
          XJX(K) = XXO(NN, K)
        END DO
        XJX(10)  = 0.0
        CALL SGSM (LINE, 0, XJX, LU6, 19, IERR)
        SPSITE   = ' '//LINE(1:5)
        PAR(163) = PAR(163) + XXO(NN, 4) * NSYM / MULT
        RCONT(IRES) = 0.0
        IF (NPOL(IRES) .GT. 0) THEN
          MM0 = IPR(255) * IPR(257)
          DO I = 1, IAN
            C1  = CONT(I, 1) * MM0
            IC1 = NINT(C1)
            IF (ABS(C1 - IC1) .GT. 0.01) GO TO 30
            IATC(I) = IC1
          END DO
          MULT          = MULT * MM0
          IATC(IAN + 1) = MULT
          CALL GEN107 (IATC, IAN + 1, IGGD)
          MULT       = MULT / IGGD
          XXO(NN, 4) = XXO(NN, 4) * MM0 / IGGD
          DO I = 1, IAN
            CONT(I, 1) = CONT(I, 1) * MM0 / IGGD
          END DO
        END IF
   30   DO I = 2, 48
          IF (ISOF(I) .EQ. 1) THEN
            DO L = 1, IAN
              IF (ABS(MOD(CONT(L, 1) / XXO(NN, 5), 1.0) - 1.0 /
     1          FLOAT(I)) .LT. 0.001) THEN
                IF (MOD(NSYM, I) .EQ. 0) THEN
                  DO L9 = 1, IAN
                    CONT(L9, 1) = CONT(L9, 1) * FLOAT(I)
                  END DO
                  MULT = MULT * I
                  XXO(NN, 4) = XXO(NN, 4) * FLOAT(I)
                END IF
                GO TO 40
              END IF
            END DO
          END IF
        END DO
   40   NSP = IPR(488)
        NONINT = 0
        IF (NSP .GT. 3) THEN
          DO 50 K = 4, NSP
            DO L = 1, IAN
              IF (ABS(CONT(L, K) - CONT(L, 1) / XXO(NN, 5)) .GT. 0.03)
     1          GO TO 50
            END DO
            NSP = K
            GO TO 60
   50     CONTINUE
        END IF
        NSP      = NSP + 1
        IPR(488) = NSP
        IF (NSP .GT. 99) THEN
          IPR(2) = 62
          RETURN
        END IF
        CONT(NP10 + 1, NSP) = 0.0
   60   IZET = NSYM / MULT
        IF (IZET * MULT .NE. NSYM) THEN
          DO L = 1, IAN
            CONT(L, 1) = CONT(L, 1) * NSYM / MULT
          END DO
          XXO(NN, 4) = XXO(NN, 4) * NSYM / MULT
          IZET = 1
          DO L = 1, IAN
            IF (ABS(NINT (CONT(L, 1) / 2.0) - CONT(L, 1) / 2.0)
     1        .GT. 0.01) GO TO 70
          END DO
          DO L = 1, IAN
            CONT(L, 1) = CONT(L, 1) / 2.0
          END DO
          XXO(NN, 4) = XXO(NN, 4) / 2.0
          IZET = 2
        END IF
   70   YUNK = 1.0 / XXO(NN, 5)
        JZET = IZET
        IF (IPR(322) .NE. 0) THEN
          IF (ABS(YUNK - NINT(YUNK)) .LT. 0.0001) THEN
            IZET = IZET * NINT(YUNK)
            YUNK = 1.0
          END IF
        END IF
        DO L = 1, IAN
          CONT(L, 2) = CONT(L, 2) + CONT(L, 1) * JZET
          CONT(L, 1) = CONT(L, 1) * YUNK
          NCNT       = NINT (CONT(L, 1))
          IF (ABS(CONT(L, 1) - NCNT) .GT. PAR(331)) NONINT = 1
          CONT(L, NSP) = CONT(L, 1)
          IF (IEN(L) .NE. 1) RCONT(IRES) = RCONT(IRES) + CONT(L, 1)
        END DO
        CONT(NP10 + 1, NSP) = CONT(NP10 + 1, NSP)
     1                      + IZET * XXO(NN, 5)
        N = 0
        CALL PLA283 (1, 1, N, CDUM)
        IF (N .GT. 0 .AND. N .LT. NP52 + 1)
     1    WRITE (LU6, 99983, IOSTAT = IOST)
     2      IRES, XXO(NN, 5), IZET, CDUM(N:NP52)
        INSIDE = 1
        DO K = 1, 3
          IF (XXO(NN, K) .GT. 1.1  .OR. XXO(NN, K) .LT. -0.1) THEN
            INSIDE = 0
          END IF
        END DO
        IF (INSIDE .EQ. 0) THEN
          IF (N .GT. 0 .AND. N .LT. NP52 + 1 .AND. IGBL(94) .EQ. 0) THEN
C * ALERT _790
            IF (IRES .EQ. 1) THEN
              YUNK = 1.0
            ELSE
              YUNK = -999.0
            END IF
            CALL PLA231 (-790, 0, YUNK, FLOAT(IRES), ' ', ' ')
            CALL PLA231 (0, 0, 0.0, 0.0,
     1                   '              '//CDUM(N:NP52), ' ')
          END IF
        END IF
        IF (NONINT .GT. 0) THEN
          WRITE (PRBUF, 99984, IOSTAT = IOST)
     1      IRES, SPSITE, (XXO(NN, K), K = 1, 5),
     2      IZET, (CONT(IENS(L), 1), L = 1, IAN)
        ELSE
          IF (IRES .EQ. 1 .AND. NRES .EQ. 1) IPR(260) = IZET
          WRITE (PRBUF, 99981, IOSTAT = IOST)
     1      IRES, SPSITE, (XXO(NN, K), K = 1, 5),
     2      IZET, (NINT(CONT(IENS(L), 1)), L = 1, IAN)
          DO K = 51, 128
            IF (PRBUF(K : K + 4) .EQ. '    0') PRBUF(K+4:K+4) = '-'
          END DO
        END IF
        IF (IGBL(63) .GT. 2) CALL GEN065 (LU7, PRBUF, 130, 7)
      END DO
      NCMX = 1
      IF (NRES .GT. 1) THEN
        DO K = 1, NRES
          IF (RCONT(K) .GT. RCONT(NCMX)) NCMX = K
        END DO
      END IF
      IF (RCONT(NCMX) .LT. 15) IPR(487) = 0
      LCD = 0
      DO L = 4, IPR(488)
        LCD = MAX (LCD, NINT(CONT(NP10 + 1, L)))
      END DO
      DO 80 K = 1, LCD
        KZ = LCD + 1 - K
        DO L = 4, IPR(488)
          LZ = NINT(CONT(NP10 + 1, L))
          IF (ABS(CONT(NP10 + 1, L) - LZ) .LT. 0.00001) THEN
            IF (MOD(LZ, KZ) .NE. 0) GO TO 80
          END IF
        END DO
        GO TO 90
   80 CONTINUE
      KZ = NSYM
   90 IF (KZ * 2 .EQ. NSYM) THEN
        DO L = 1, IAN
          LZ = NINT(CONT(L, 2))
          IF (MOD (LZ, 2) .NE. 0) GO TO 100
        END DO
        IF (MOD (NINT(CONT(NP10 + 1, 4)), NSYM) .EQ. 0) KZ = KZ * 2
      END IF
  100 MZ = 1
      IF ((KZ / 2) * 2 .EQ. KZ) THEN
        DO L = 1, IAN
  110     LZ = NINT(CONT(L, 2) * MZ)
          IF (ABS(CONT(L, 2) * MZ - LZ) .LT. 0.001) THEN
            IF ((LZ / KZ) * KZ .NE. LZ) THEN
              IF (MZ .EQ. 1) THEN
                MZ = 2
                GO TO 110
              ELSE
                GO TO 120
              END IF
            END IF
          END IF
        END DO
        KZ = KZ / MZ
      END IF
  120 IPR(260) = KZ
      PAR(162) = 0.0
      PAR(462) = 0.0
      PAR(463) = 0.0
      IPR(215) = 0
      F000A    = 0.0
      F000B    = 0.0
      NHEAVY   = 0
      RESSCAT  = 0.0
      RESSCAN  = 0.0
      FRIEDIFT = 0.0
      FRIEDIFN = 0.0
      IF (IPR(261) .GT. 0) THEN
        ITEMP = IPR(261)
      ELSE
        ITEMP = 298
      END IF
      DO L = 1, IAN
        IENL     = IEN(L)
        PAR(462) = PAR(462) + CONT(L, 2) * ATVOL(IENL)
        PAR(463) = PAR(463) + CONT(L, 2) * ATVOL(IENL) *
     1             (1.0 + 0.000095 * (ITEMP - 298))
        NHEAVY   = MAX (NHEAVY, IATNR(IENL))
        J        = (IENL - 1) * 17
        YMR      = 0.0
        FDELA    = 0.0
        FDELB    = 0.0
        IF (IABS(IPR(493)) .GT. 0 .AND. IABS(IPR(493)) .LT. 6) THEN
          FDELA = ANOM(L, 1)
          FDELB = ANOM(L, 2)
          YMR   = ANOM(L, 3)
        END IF
        FZEROL = 0.0
        DO K = 1, 9, 2
          F000A  = F000A + CONT(L, 2) * SFAC(J + K)
          FZEROL = FZEROL + SFAC(J + K)
        END DO
        F000A = F000A + CONT(L, 2) * FDELA
        F000B = F000B + CONT(L, 2) * FDELB
        DO M = 1, IAN
          JM     = (IEN(M) - 1) * 17
          FDELBM = 0.0
          IF (IABS(IPR(493)) .GT. 0 .AND. IABS(IPR(493)) .LT. 6) THEN
            FDELBM = ANOM(M, 2)
          END IF
          FZEROM = 0.0
          DO K = 1, 9, 2
            FZEROM = FZEROM + SFAC(JM + K)
          END DO
          FRIEDIFT = FRIEDIFT + CONT(L, 2) * CONT(M, 2) *
     1               (FZEROL * FDELBM - FZEROM * FDELB) **2
        END DO
        FRIEDIFN = FRIEDIFN + CONT(L, 2) * (FZEROL**2 + FDELB**2)
        RESSCAT = RESSCAT + CONT(L, 2) * FDELB**2
        RESSCAN = RESSCAN +
     1            CONT(L, 2) * FZEROL**2
        IF (IABS(IPR(493)) .NE. 6) THEN
          PAR(157) = PAR(157) + CONT(L, 2) * IATNR(IENL)
        ELSE
          PAR(157) = PAR(157) + CONT(L, 2) * RNSCL(IENL)
        END IF
        PERC(L)    = CONT(L, 2) * SATWT(L) * 100.0 / PAR(163)
        PAR(162)   = PAR(162) + CONT(L, 2) * YMR * 0.1
        NCNT       = NINT(CONT(L, 2))
        CONT(L, 3) = CONT(L, 2) - NCNT
        IF (ABS(CONT(L, 3)) .GT. NCNT * PAR(331))
     1          IPR(215) = IPR(215) + 1
      END DO
      PAR(474) = 2.0 * SQRT(FRIEDIFT) / FRIEDIFN
      PAR(425) = SQRT (2.0 * RESSCAT / RESSCAN)
      PAR(426) = SQRT (F000A**2 + F000B**2)
      PAR(160) = PAR(163) / (PAR(98) * 0.60221)
      DXREP    = IPR(276) * PAR(308) / (PAR(98) * 0.60221)
      IF (PAR(267) .GT. 0.0 .AND. IGBL(94) .EQ. 0) THEN
        XDIF = 100 * ABS (PAR(267) - DXREP) / PAR(267)
C * ALERT _046
        IF (XDIF .GT. 0.5) CALL PLA231 (46, 3, XDIF, DXREP, ' ', ' ')
      END IF
      PAR(162) = PAR(162) / PAR(98)
      SIGD     = (PAR(160) / PAR(98)) * PAR(21)
      CALL GEN041 (PAR(160), SIGD, IPR(295), 4, IPR(296), IPR(68))
      FORMA(32:32) = CHAR(ICHAR('0') + IPR(296))
      PAR(142) = FLOAT(IPR(260)) / NSYM
      CALL PLA283 (0, 1, N, CDUM)
      IF (IGBL(94) .EQ. 0) THEN
        IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
          N3 = 0
          DO N2 = N, NP52
            ICH = CDUM(N2:N2)
  130       N3  = N3 + 1
            CN3 = RLWS(4)(N3:N3)
            IF (CN3 .EQ. '+' .OR. CN3 .EQ. '-') GO TO 130
            CN31 = RLWS(4)(N3 + 1:N3 + 1)
            IF (ICH .NE. CN3) THEN
              CALL GEN105 (3, CN3, J)
              IF (CN3 .EQ. CHAR(32)) THEN
                GO TO 130
              ELSE IF (ICH .EQ. CHAR(32) .AND.
     1                 CN3//CN31 .EQ. '1 ') THEN
                GO TO 130
              ELSE IF (J .GE. 0 .AND. (CN31 .EQ. '+' .OR.
     1                                   CN31 .EQ. '-')) THEN
                N3 = N3 + 1
                GO TO 130
              ELSE
                CALL GEN020 (1, ICH, 1, 1)
                IF (ICH .NE. CN3) THEN
C * ALERT _042
                  CALL PLA231 (42, 0, -999.0, 1.0, ' ', ' ')
                  GO TO 140
                ELSE
                  CALL GEN020 (-1, RLWS(4), N3, N3)
                END IF
              END IF
            END IF
          END DO
        ELSE
C * ALERT _048
          CALL PLA231 (48, 0, 1.0, 1.0, ' ', ' ')
        END IF
      END IF
  140 XDIF  = 100 * ABS (PAR(163) - PAR(308) * IPR(276)) / PAR(163)
      XDIF1 = ABS((PAR(163) - PAR(308) * IPR(276)) / IPR(260))
C * ALERT _043
      IF (XDIF .GT. 0.1 .AND. IGBL(94) .EQ. 0 .AND. IPR(651) .EQ. 0)
     1    CALL PLA231 (43, 2, XDIF, XDIF1, ' ', ' ')
      XDIF1 = ABS(PAR(160) - PAR(267))
      XDIF  = 100.0 * XDIF1 / PAR(160)
C * ALERT _044
      IF (XDIF .GT. 0.5 .AND. IGBL(94) .EQ. 0) THEN
        IF (IPR(651) .EQ. 0) THEN
          CALL PLA231 (44, 4, XDIF, XDIF1, ' ', ' ')
        ELSE
          CALL PLA231 (44, 4, -999.0, XDIF1, ' ', ' ')
        END IF
      END IF
C * ALERT _049 (includes squeeze test)
      IF (PAR(160) .LT. 1.0 .AND. IPR(651) .EQ. 0)
     1  CALL PLA231 (49, 4, 0.5, PAR(160), ' ', ' ')
      IF (IPR(260) .NE. IPR(276)) THEN
        IF (IPR(276) .NE. 0) THEN
          RATIO = FLOAT(IPR(260)) / FLOAT(IPR(276))
        ELSE
          RATIO = 0.0
        END IF
C * ALERT _045
        IF (IGBL(94) .EQ. 0) CALL PLA231 (45, 2, -999.0, RATIO,
     1      ' ', ' ')
      END IF
      IF (IABS(IGBL(8)) .EQ. 3 .AND. IPR(276) .NE. 0) THEN
        CALL PLA283 (2, IPR(276), N1, ICL(1:NP52))
        IF (IGBL(94) .EQ. 0) THEN
          IF (INDEX (RLWS(5), '?') .EQ. 0) THEN
            N3 = 0
            DO N2 = N1, NP52
              ICH = ICL(N2:N2)
  150         N3  = N3 + 1
              JCH = RLWS(5)(N3:N3)
              IF (ICH .NE. JCH) THEN
                IF (ICH .EQ. ' ' .AND.
     1            RLWS(5)(N3:N3+1) .EQ. '1 ') GO TO 150
                CALL GEN020 (1, ICH, 1, 1)
                IF (ICH .NE. JCH) THEN
C * ALERT _041
                  CALL PLA231 (41, 0, 1.0, 1.0, ' ', ' ')
                  GO TO  160
                ELSE
                  CALL GEN020 (-1, RLWS(5), N3, N3)
                END IF
              END IF
            END DO
          ELSE
C * ALERT _047
            CALL PLA231 (47, 0, 1.0, 1.0, ' ', ' ')
          END IF
        END IF
      END IF
      CALL PLA283 (2, IPR(260), N1, ICL(1:NP52))
  160 WRITE (LU6, 99998, IOSTAT = IOST) CDUM(N:NP52), ICL(N1:NP52),
     1       PAR(163) / IPR(260), WNOTE(IPR(181) + 1), IPR(260)
      IF (IPR(23) .EQ. 0) THEN
        WRITE (LU6, 99992, IOSTAT = IOST) IPR(48), PAR(142)
        IF (IGBL(63) .GT. 2) THEN
          WRITE (LU7, 99989, IOSTAT = IOST)
     1      PAR(163), (NINT(CONT(IENS(L), 2)), L = 1, IAN)
          IF (IPR(215) .GT. 0) THEN
            WRITE (LU7,  99990, IOSTAT = IOST)
     1        (CONT(IENS(L), 3), L = 1, IAN)
          END IF
          WRITE (LU7, 99988, IOSTAT = IOST)
     1      (PERC(IENS(L)), L = 1, IAN)
          WRITE (LU7, 99996, IOSTAT = IOST) CDUM(N:NP52), ICL(N1:NP52),
     1      PAR(163) / IPR(260), WNOTE(IPR(181) + 1), IPR(260),
     2      IPR(48), IPR(260), IPR(48), PAR(142)
          WRITE (LU7, 99979, IOSTAT = IOST)
          WRITE (PRBUF, FORMA, IOSTAT = IOST) PAR(160), IPR(295)
          CALL GEN065 (LU7, PRBUF, 130, 1)
          WRITE (LU7, 99987, IOSTAT = IOST) PAR(157), PAR(426)
        END IF
C * ALERT _720
        IF (IPR(683) .GT. 0)
     1    CALL PLA231 (720, 0, -999.0, FLOAT(IPR(683)), ' ', ' ')
C * ALERT _164
        IF (IPR(474) .GT. 0 .AND. NHEAVY .GT. 18 .AND.
     1    IGBL(94) .EQ. 0)
     2    CALL PLA231 (164, 0, -999.0, FLOAT(IPR(474)), ' ', ' ')
C * ALERT _165
        IF (IPR(164) .GT. 0)
     1    CALL PLA231 (165, 0, 1.0, FLOAT(IPR(164)), ' ', ' ')
        IF (KRAD(1:2) .NE. '??') THEN
          IF (IGBL(63) .GT. 2) THEN
            WRITE (LU7, 99991, IOSTAT = IOST)
     1        KRAD, PAR(162) * 10.0, PAR(162)
            WRITE (LU6, 99997, IOSTAT = IOST)
     1        KRAD, PAR(162) * 10.0, PAR(162)
            IF (IPR(257) .EQ. 1) THEN
               WRITE (LU7, 99978, IOSTAT = IOST)
     1           NINT(PAR(425) * 10000.0), NINT(PAR(474) * 10000.0)
               WRITE (LU6, 99977, IOSTAT = IOST)
     1           NINT(PAR(425) * 10000.0), NINT(PAR(474) * 10000.0)
            END IF
          END IF
        END IF
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (4)
          WRITE (LU7, 99993, IOSTAT = IOST) PAR(462), PAR(463), ITEMP
          WRITE (LU7, 99994, IOSTAT = IOST)
          WRITE (LU6, 99980, IOSTAT = IOST) PAR(462), PAR(463), ITEMP
        END IF
      END IF
      IPR(483) = 0
      IPR(484) = 0
      DO L = 1, IAN
        IENL = IEN(L)
        IF (IENL .EQ. 1 .OR. IENL .EQ. 33 .OR. IENL .EQ. 113) THEN
          IF (CONT(L, 2) .GT. 0) IPR(484) = 1
        ELSE IF (IENL .EQ. 2) THEN
          IF (CONT(L, 2) .GT. 0) IPR(483) = 1
        END IF
      END DO
C * ALERT _034 - CHECK FOR FLACK PARAMETER (XRAY ONLY)
      IF (IPR(493) .NE. 6) THEN
        IF (PAR(433) .EQ. 999999.0 .AND. IPR(22) .GT. 14 .AND.
     1    IPR(275) .EQ. 1 .AND. IGBL(94) .EQ. 0 .AND. IPR(105) .EQ. 0)
     2      CALL PLA231 (34, 0, 1.0, 1.0, ' ', ' ')
      END IF
      IF (IPR(275) .NE. 2 .AND. IGBL(94) .EQ. 0
     1                    .AND. IPR(583) .GT. 0) THEN
        N = INDEX (CCIF(17), '?')
C * ALERT _035
        IF (N .NE. 0 .AND. IABS(IGBL(8)) .EQ. 3 .AND.
     1    CHSG(1:1) .EQ. 'C') THEN
          IF (IPR(105) .EQ. 0) THEN
            CALL PLA231 (35, 0, 1.0, 1.0, ' ', ' ')
          ELSE
            CALL PLA231 (35, 0, -999.0, 1.0, ' ', ' ')
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (/, A4, 'rdered Structure', 34X, 'Unit Cell Contents',
     1 ' (Based on Contents of Atom List, that may be Incomplete)', /,
     2 132('='), /, 'Resd Site  X(cen) Y(cen) Z(cen)  Mol.Wt S.O.F',
     3 '   Z', 5X, A, 4X, A, 14(3X, A))
99998 FORMAT (':: Moiety_Formula = ', A, /,
     1        ':: Sum_Formula    = ', A, /,
     2        ':: Formula_Weight = ', F11.2, 1X, A, /,
     3        ':: Formula_Z      = ', I11)
99997 FORMAT (':: mu(', A, ')       =', F12.2, ' cm-1 = ', F7.3,
     1        ' mm-1')
99996 FORMAT (/, 10X, 'Moiety_Formula = ', A, //,
     1        13X, 'Sum_Formula = ', A, //,
     2        10X, 'Formula_Weight =', F12.2, 1X, A, //,
     3        15X, 'Formula_Z =', I12, //,
     4        12X, 'SpaceGroup_Z =', I12,
     5        '  ===>  Z'' =', I3, ' /', I3, ' =',  F8.3)
99994 FORMAT (/,
     1 'Note on F000: The first number is a pure electron count, the ',
     2 'second number between [] is calculated from f,f'' & f"')
99993 FORMAT (/, 8X, 'Predicted Volume =  ', F10.1, '[', F10.1, ']',
     1        ' Ang**3, 298[', I3, ']K - (D.W.M. Hofmann (2002).',
     2        ' Acta Cryst. B58, 489-493)')
99992 FORMAT (
     1        ':: SpaceGroup_Z   = ', I11, /,
     2        ':: Formula_Z''     = ', F11.3)
99991 FORMAT (16X, 'mu(', A, ') =', F12.2, ' cm-1 =', F8.3, ' mm-1', /)
99990 FORMAT (37X, 'Add Non-Int. ', 2F6.2, 14F5.2)
99989 FORMAT (30X, 102('-'), /, 8X, 'Unit Cell Weight =', F13.2,
     1 11X, 2I6, 14I5)
99988 FORMAT (/, 1X, 'Calculated Analysis (%) =',
     1 17X, F13.1, F6.1, 14F5.1)
99987 FORMAT (75X, 'Please Check the Derived Crystal Data.', /,
     1 18X, 'F(000) = ', F11.1, ' [', F11.2, ']', 23X,
     2 'They may be Incorrect for Disordered,', /, 75X,
     3 'Incomplete or Polymeric Structures.')
99986 FORMAT (/, 'NOTE: Atoms preceded by > * or < indicate ',
     1 'disordered positions (SOF : < 50%, 50%, > 50%)', /)
99985 FORMAT (132('='))
99984 FORMAT (I3, A, 3F7.3, F9.2, F6.3, I4, 1X, 2F6.1, 14F5.1)
99983 FORMAT (':: Resd', I3, ', SOF', F6.3, ', Z', I3,  ', ', A)
99982 FORMAT (/, 'NOTE: A # in the Atom Label Indicates a Label that',
     1 ' was Modified to Conform with the Label Convention (A4)', /)
99981 FORMAT (I3, A, 3F7.3, F9.2, F6.3, I4, 1X, 2I6, 14I5)
99980 FORMAT (':: Predicted Vol  =', F12.1, '[', F10.1, ']',
     1        ' Ang**3, 298[', I3, ']K')
99979 FORMAT (1X)
99978 FORMAT (5X, 'Resonant Scattering =  ', I10, ' * 0.0001 - ',
     1  '(E. Girard et al. (2003). Acta Cryst. D59, 1914-1922)',
     2  //, 5X, 'Friedif             =  ', I10, 9X, ' - ',
     3  '(H. Flack & U. Shmueli (2007). Acta Cryst. A63, 257-265)')
99977 FORMAT (':: Res.Scat.      =', I12, ' x 0.0001', /
     1        ':: Friedif        =', I12)
      END SUBROUTINE PLA081
      SUBROUTINE PLA082
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION DHX(3, 37), DUMVA(3, 3), DUMVB(3, 3), EWA(3), EWB(3),
     1 V2A(3), V2B(3), IANG(3, 3)
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      DIMENSION YUNK(3, 3)
      IF (IPR(23) .EQ. 0) THEN
        NX    = 0
        NVEC  = 0
        NMAX  = IPR(39)
        NRES  = IPR(75)
        PAGET = 'NONSYM'
        CALL GEN101 (2, NVEC, DHX)
        DO I = 1, 3
          EWA(I) = 0.0
          V2A(I) = 0.0
          DO J = 1, 3
            DUMVA(I, J) = 0.0
          END DO
        END DO
        WHTA = 0.0
        NATA = 0
        NATTA = 0
        IDETA = 0
        DO I = 1, NRES
          CALL PLA083 (I, DUMVA, EWA, V2A, WHTA, NATA, NATTA, IDETA)
          IF (NATA .GT. 0) THEN
            NX = NX + 1
            IF (NX .EQ. 1) THEN
              IF (IGBL(63) .GT. 0) THEN
                CALL PLA262 (0)
                WRITE (LU7, 99999, IOSTAT = IOST)
                WRITE (LU7, 99991, IOSTAT = IOST)
              END IF
            END IF
            DO J = 1, 3
              DO K = 1, 3
                ANG = 0.0
                DO L = 1, 3
                  ANG = ANG + DUMVA(L, J) * OR(L, K) / PAR(100 + K)
                END DO
                IF (ANG .GT.  1.0) ANG =  1.0
                IF (ANG .LT. -1.0) ANG = -1.0
                IANG(J, K) = NINT(ACOS(ANG) * RGBL(6))
              END DO
            END DO
            II = I * IDETA
            IF (IGBL(63) .GT. 0) THEN
              WRITE (LU7, 99987, IOSTAT = IOST)
     1          II, (XXO(NMAX + I, K), K = 1, 3),
     2          (DUMVA(I0, 1), I0 = 1, 3), NINT(EWA(1)), ABS(V2A(1)),
     3          (IANG(1, I0), I0 = 1, 3)
              WRITE (LU7, 99986, IOSTAT = IOST)
     1          (XXO(NMAX + I, K), K = 4, 6),
     2          (DUMVA(I0, 2), I0 = 1, 3), NINT(EWA(2)), ABS(V2A(2)),
     3          (IANG(2, I0), I0 = 1, 3)
              WRITE (LU7, 99985, IOSTAT = IOST)
     1          WHTA, (DUMVA(I0, 3), I0 = 1, 3),
     2          NINT(EWA(3)), ABS(V2A(3)), (IANG(3, I0), I0 = 1, 3)
            END IF
          END IF
        END DO
        IF (NX .GT. 1) THEN
          DO I = 1, NMAX
            CALL GEN048 (-6, IFG(1, I), 9, IRES)
            DIST = 0.0
            DO J = 4, 6
              DIST = DIST + (XXO(NMAX + IRES, J) - XXO(I, J))**2
            END DO
            IATC(I) = I
            DATC(I) = SQRT(DIST)
          END DO
          CALL GEN013 (DATC, IATC, 1, NMAX)
          IF (NRES .GT. 1) THEN
            DO 30 IRES = 1, NRES - 1
              CALL PLA083 (IRES, DUMVA, EWA, V2A, WHTA, NATA, NATTA,
     1                     IDETA)
              IF (NATA .EQ. 0) GO TO 30
              II = IRES * IDETA
              DO 20 JRES = IRES + 1, NRES
                CALL PLA083 (JRES, DUMVB, EWB, V2B, WHTB, NATB, NATTB,
     1                       IDETB)
                IF (NATB .EQ. 0) GO TO 20
                JJ = JRES * IDETB
                IF (ABS (WHTB - WHTA) .LT. 0.1 .AND.
     1            NATTA .EQ. NATTB) THEN
                  IDETR = IDETA * IDETB
                  CALL GEN005 (DUMVA, QM)
                  CALL GEN004 (DUMVB, QM, UIJ)
                  UIJSUM = (UIJ(1, 1) + UIJ(2, 2) + UIJ(3, 3)) * IDETR
                  DO K = 4, 6
                    V2(K - 3) = (XXO(NMAX + JRES, K)
     1                        +  XXO(NMAX + IRES, K)) / 2.0
                    V3(K - 3) =  XXO(NMAX + JRES, K)
     1                        -  XXO(NMAX + IRES, K)
                  END DO
                  IF (UIJSUM .LT. 2.999) THEN
                    CALL GEN074 (V1, 1, 3, 0.0)
                    DO I1 = 1, 3
                      J1 = MOD(I1, 3) + 1
                      DO K1 = 1, 3
                        V4(K1) = UIJ(K1, I1) * IDETR
                        V5(K1) = UIJ(K1, J1) * IDETR
                      END DO
                      V4(I1) = V4(I1) - 1
                      V5(J1) = V5(J1) - 1
                      CALL GEN008 (V4, V5, V6, 1)
                      IF (GEN009 (V1, V6) .GE. 0.0) THEN
                        CALL GEN015 (V1, V6, V1, 1.0)
                      ELSE
                        CALL GEN015 (V1, V6, V1, -1.0)
                      END IF
                    END DO
                    XX = GEN017 (V1)
                    ANGMAX = 99999.0
                    DO I = 1, 37
                      CALL GEN002 (-2, ROR, DHX(1, I), V8, XLNG)
                      CALL GEN008 (V8, V1, V5, -1)
                      IF (V5(1) .LT. ANGMAX) THEN
                        ANGMAX = V5(1)
                        DO K1 = 1, 3
                          V6(K1) = DHX(K1, I)
                        END DO
                      END IF
                    END DO
                    ANGMAX = ABS(ASIN(SQRT(ANGMAX)) * RGBL(6))
                    ANGMAX = MIN (ANGMAX, 180 - ANGMAX)
                    WRITE (LU6, 99989, IOSTAT = IOST)
     1                (V6(I), I = 1, 3), ANGMAX
                    IF (IGBL(63) .GT. 0) THEN
                      CALL PLA262 (0)
                      CALL PLA262 (3)
                      WRITE (LU7, 99989, IOSTAT = IOST)
     1                  (V6(I), I = 1, 3), ANGMAX
                    END IF
                    DO I1 = 1, 3
                      PAT(I1, 3) = V1(I1)
                    END DO
                    XX = SQRT(V1(1)**2 + V1(2)**2)
                    IF (XX .GT. 0.0001) THEN
                      PAT(1, 1) =   V1(2) / XX
                      PAT(2, 1) = - V1(1) / XX
                      PAT(3, 1) =   0.0
                    ELSE
                      PAT(1, 1) = 0.0
                      PAT(2, 1) = 1.0
                      PAT(3, 1) = 0.0
                    END IF
                    CALL GEN008 (PAT(1, 3), PAT(1, 1), PAT(1, 2), 1)
                    CALL GEN005 (PAT, YUNK)
                    CALL GEN052 (YUNK, PAT)
                    CALL GEN004 (PAT, UIJ, UIJC)
                    CALL GEN005 (PAT, YUNK)
                    CALL GEN052 (YUNK, PAT)
                    CALL GEN004 (UIJC, PAT, YUNK)
                    CALL GEN052 (YUNK, UIJC)
                    V1(4) = (ATAN2((UIJC(2, 1) - UIJC(1, 2)) * IDETR,
     1                (UIJC(1, 1) + UIJC(2, 2)) * IDETR)) * RGBL(6)
                    CALL GEN002 (1, ROR, V1, V4, DUM)
                    V4MX = MAX (ABS(V4(1)), ABS(V4(2)), ABS(V4(3)))
                    DO K = 1, 3
                      V4(K) = V4(K) / V4MX
                    END DO
                    IF (IDETR .GT. 0) THEN
                      GLIDEA = GEN009 (V1, V3)
                      WRITE (LU6, 99996, IOSTAT = IOST) II, JJ,
     1                  (V4(I2), I2 = 1, 3), V1(4), GLIDEA
                      IF (IGBL(63) .GT. 0) THEN
                        CALL PLA262 (4)
                        WRITE (LU7, 99990, IOSTAT = IOST)
                        WRITE (LU7, 99996, IOSTAT = IOST) II, JJ,
     1                      (V4(I2), I2 = 1, 3), V1(4), GLIDEA
                      END IF
                    ELSE
                      WRITE (LU6, 99994, IOSTAT = IOST) II, JJ,
     1                  (V4(I2), I2 = 1, 3), V1(4)
                      IF (IGBL(63) .GT. 0) THEN
                        CALL PLA262 (4)
                        WRITE (LU7, 99990, IOSTAT = IOST)
                        WRITE (LU7, 99994, IOSTAT = IOST) II, JJ,
     1                    (V4(I2), I2 = 1, 3), V1(4)
                      END IF
                      CALL GEN008 (V1, V3, V8, 1)
                      CALL GEN008 (V8, V1, V5, 1)
                      GLIDEB = GEN009 (V5, V3)
                      CALL GEN002 (1, ROR, V5, V6, DUM)
                      V6MX = MAX (ABS(V6(1)), ABS(V6(2)), ABS(V6(3)))
                      DO K = 1, 3
                        V6(K) = V6(K) / V6MX
                      END DO
                      WRITE (LU6, 99995, IOSTAT = IOST) II, JJ,
     1                    (V6(I2), I2 = 1, 3), GLIDEB
                      IF (IGBL(63) .GT. 0) THEN
                        CALL PLA262 (1)
                        WRITE (LU7, 99995, IOSTAT = IOST)
     1                    II, JJ, (V6(I2), I2 = 1, 3), GLIDEB
                      END IF
                    END IF
                  ELSE
                    IF (IDETR .LT. 0) THEN
                      CALL GEN002 (1, ROR, V2, V8, DUM)
                      WRITE (LU6, 99998, IOSTAT = IOST)
     1                  II, JJ, (V8(K), K = 1, 3)
                      IF (IGBL(63) .GT. 0) THEN
                        CALL PLA262 (4)
                        WRITE (LU7, 99990, IOSTAT = IOST)
                        WRITE (LU7, 99998, IOSTAT = IOST)
     1                    II, JJ, (V8(K), K = 1, 3)
                      END IF
                    ELSE
                      CALL GEN002 (1, ROR, V3, V8, DUM)
                      V8MX = MAX (ABS(V8(1)), ABS(V8(2)), ABS(V8(3)))
                      DO K = 1, 3
                        V8(K) = V8(K) / V8MX
                      END DO
                      WRITE (LU6, 99997, IOSTAT = IOST)
     1                  II , JJ, (V8(K), K = 1, 3)
                      IF (IGBL(63) .GT. 0) THEN
                        CALL PLA262 (4)
                        WRITE (LU7, 99990, IOSTAT = IOST)
                        WRITE (LU7, 99997, IOSTAT = IOST)
     1                    II , JJ, (V8(K), K = 1, 3)
                      END IF
                    END IF
                  END IF
                  VARDIST = 0.0
                  NVAR    = 0
                  IPR(12) = 0
                  DO L = 1, NMAX
                    IATC(L) = IABS(IATC(L))
                  END DO
                  DO 10 L0 = 1, NMAX
                    L = IATC(L0)
                    IF (L .GT. 0) THEN
                      CALL GEN048 (-6, IFG(1, L), 9, IRESL)
                      IF (IRESL .EQ. IRES) THEN
                        CALL GEN048 (-1, IFG(1, L), 7, IVL)
                        IF (IVL .EQ. 0) THEN
                          DO I = 1, 3
                            V6(I) = XXO(L, I + 3)
     1                            - XXO(NMAX + IRES, I + 3)
                          END DO
                          CALL GEN002 (1, UIJ, V6, V8, DUM)
                          DO I = 1, 3
                            V8(I) = V8(I) + XXO(NMAX + IRES, I + 3)
                          END DO
                          CALL GEN015 (V8, V3, V8, 1.0)
                          DISTMN = 99999.0
                          MDIST  = 0
                          CALL PLA047 (LABA(L), NQ1, IDUM, IENR1,
     1                      0, IGBL(55), 0, 0)
                          CALL GEN048 (-10, IFG(2, L), 14, LBN1)
                          DO M0 = 1, NMAX
                            M = IATC(M0)
                            IF (M .GT. 0) THEN
                              CALL GEN048 (-6, IFG(1, M), 9, IRESM)
                              IF (IRESM .EQ. JRES) THEN
                                CALL PLA047 (LABA(M), NQ2, IDUM,
     1                            IENR2, 0, IGBL(55), 0, 0)
                                IF (IENR1 .EQ. IENR2) THEN
                                  CALL GEN048 (-1, IFG(1, M), 7, IVL)
                                  IF (IVL .EQ. 0) THEN
                                    CALL GEN048 (-10, IFG(2, M), 14,
     1                                           LBN2)
                                    IF (LBN2 .EQ. LBN1) THEN
                                      DO I = 1, 3
                                        V6(I) = XXO(M, I + 3)
                                      END DO
                                      CALL GEN015 (V8, V6, V5, -1.0)
                                      DIST = SQRT(GEN009 (V5, V5))
                                      IF (DIST .LT. DISTMN) THEN
                                        DISTMN = DIST
                                        MDIST  = M0
                                      END IF
                                    END IF
                                  END IF
                                END IF
                              END IF
                            END IF
                          END DO
                          M0 = MDIST
                          IF (M0 .EQ. 0) GO TO 10
                          MDIST  = IATC(M0)
                          JCA(L) = MDIST
                          IATC(M0) = - IATC(M0)
                          JR(IPR(12) + 1) = L
                          JR(IPR(12) + 2) = MDIST
                          IPR(12)         = IPR(12) + 2
                          VARDIST         = VARDIST + DISTMN**2
                          NVAR            = NVAR    + 1
                          IF (IGBL(63) .GT. 0) THEN
                            CALL PLA047 (LABA(MDIST), NQ2, IDUM,
     1                        IENR2, 0, IGBL(55), 0, 0)
                            IF (NVAR .EQ. 1) THEN
                              CALL PLA262 (5)
                              WRITE (LU7, 99992, IOSTAT = IOST)
                            END IF
                            CALL PLA262 (1)
                            WRITE (LU7, 99993, IOSTAT = IOST)
     1                        NQ1, (V8(J), J = 1, 3), DATC(L0),
     2                        NQ2, (XXO(MDIST, J + 3), J = 1, 3),
     3                        DATC(M0), DISTMN, LBN1
                          END IF
                        END IF
                      END IF
                    END IF
   10             CONTINUE
                  IF (NVAR .NE. 0) THEN
                    VARDIST = SQRT(VARDIST / NVAR)
                    WRITE (LU6, 99988, IOSTAT = IOST) VARDIST
                    IF (IGBL(63) .GT. 0) THEN
                      CALL PLA262 (2)
                      WRITE (LU7, 99988, IOSTAT = IOST) VARDIST
                    END IF
                  ELSE
                    VARDIST = 999.0
                  END IF
C * QUATERNION-FIT
                  IF (IGBL(63) .GT. 0 .AND. NVAR .GT. 5) THEN
                    CALL PLA085 (0, VARDIST)
                    WRITE (LU6, 99983, IOSTAT = IOST)
                    CALL PLA262 (3)
                    WRITE (LU7, 99983, IOSTAT = IOST)
                    IF (VARDIST .LT. PAR(483)) THEN
                      CALL PLA084 (IRES, JRES)
                    ELSE
                      CALL PLA262 (2)
                      WRITE (LU6, 99984, IOSTAT = IOST) PAR(483)
                      WRITE (LU7, 99984, IOSTAT = IOST) PAR(483)
                    ENDIF
                  END IF
                END IF
   20         CONTINUE
   30       CONTINUE
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT ('NONSYM Search for Additional (Non)Crystallographic',
     1  ' Symmetry between Residues (Experimental)', /, 132('='), //,
     2  '- Residue numbers with opposite signs indicate ',
     3  'potential enantiomeric pairs', /,
     4  '- Hydrogen atoms omitted from the analysis', /,
     5  '- Residues with more than 6 atoms are analysed only', /)
99998 FORMAT (':: Inversion at  :', 2I5, '   ', 3F7.3)
99997 FORMAT (':: Translation   :', 2I5, '   ', 3F7.3)
99996 FORMAT (':: Rotation      :', 2I5, '  [', 3F7.3, ']', F8.2, F8.3)
99995 FORMAT (':: GlidePlane    :', 2I5, '  [', 3F7.3, ']', 8X,   F8.3)
99994 FORMAT (':: Rota-Inversion:', 2I5, '  [', 3F7.3, ']', F8.2)
99993 FORMAT (A, 3F7.3, F6.2, 2X, A, 3F7.3, F6.2, F10.3, I5)
99992 FORMAT (/, 'Comparison of Orthogonal Coordinates of Transformed',
     1        ' Residue #I with those of Residue #J', /, 132('='), /,
     2        'Atom I', 6X, 'XI', 5X, 'YI', 5X, 'ZI', 4X, 'RI', 2X,
     3        'Atom J', 6X, 'XJ', 5X, 'YJ', 5X, 'ZJ', 4X, 'RJ', 1X,
     4        'Dist(Ang)  Tnr', /, 85('-'))
99991 FORMAT (/, 'RES#', ' Coords Center of Gravity', 8X,
     1           'Main axes (hor)', 3X, 'EigenV', 3X, 'Asym',
     2         ' Angle a,b,c', /, 80('-'))
99990 FORMAT (/, 3X, 'Symm Op', 8X, 'Res#i Res#j', 6X, 'DirLatt Vector',
     1   3X, 'Angle(Deg)', 1X, 'Shift(Ang)', /, 80('='))
99989 FORMAT (/, ':: Smallest angle of [RotAx] with Plane normal (',
     1           3F4.0, ') = ', F6.3, ' Deg.', /)
99988 FORMAT (/, ':: RMS-Fit = ', F10.3, ' Ang.',
     1           ' (Note: Use Quaternion FIT for an accurate fit)')
99987 FORMAT (I3, F8.4, 2F9.4, 2X, 3F7.3, I8, F8.2, 3I4)
99986 FORMAT (3X, F8.4, 2F9.4, 2X, 3F7.3, I8, F8.2, 3I4)
99985 FORMAT (7X, 'Res.Mol.Wt. =', F9.2, 2X, 3F7.3, I8, F8.2, 3I4, /)
99984 FORMAT (':: RMS-FIT .GT.', F5.2, ' >>>  NO Bond Comparison', /)
99983 FORMAT (/, ':: Warning: The Pairwise Atom Association',
     1           ' is Tentative and may be Erroneous', /)
      END SUBROUTINE PLA082
      SUBROUTINE PLA083 (NR, DUMVX, EWX, V2X, WHTX, NATX, NATT, IDETX)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION DUMW(3, 3), EV(3, 3), EWX(3), DUMVX(3, 3), V2X(3)
      NMAX = IPR(39)
      CALL GEN074 (V1, 1, 3, 0.0)
      CALL GEN074 (V7, 1, 3, 0.0)
      KP  = 0
      KPT = 0
      WM  = 0
      DO N = 1, NMAX
        CALL GEN048 (-6, IFG(1, N), 9, IRESN)
        IF (IRESN .EQ. NR) THEN
          CALL GEN048 (-7, IFG(2, N), 1, IPP)
          IF (IPPR(IPP + 1, 1) .LT. 1000) THEN
            KP = 0
            GO TO 10
          END IF
          KPT = KPT + 1
          CALL GEN048 (-1, IFG(1, N), 7, IVL)
          IF (IVL .EQ. 0) THEN
            CALL GEN048 (-4, IFG(1, N), 15, IVL)
            WHT = SATWT(IVL + 1)
            KP  = KP + 1
            WM  = WM + WHT
            DO J = 1, 3
              V1(J) = V1(J) + WHT * XXO(N, J)
              V7(J) = V7(J) + WHT * XXO(N, J + 3)
            END DO
          END IF
        END IF
      END DO
      IF (KP .LE. 6 .OR. WM .EQ. 0.0) THEN
        KP = 0
        GO TO 10
      END IF
      WHTX = WM
      DO I = 1, 3
        V1(I) = V1(I) / WM
        V7(I) = V7(I) / WM
        XXO(NMAX + NR, I)     = V1(I)
        XXO(NMAX + NR, I + 3) = V7(I)
        DO J = 1, 3
          DUMW(I, J) = 0.0
        END DO
      END DO
      DO N = 1, NMAX
        CALL GEN048 (-6, IFG(1, N), 9, IRESN)
        IF (IRESN .EQ. NR) THEN
          CALL GEN048 (-1, IFG(1, N), 7, IVL)
          IF (IVL .EQ. 0) THEN
            CALL GEN048 (-4, IFG(1, N), 15, IVL)
            WHT = SATWT(IVL + 1)
            XX  = XXO(N, 4) - V7(1)
            YY  = XXO(N, 5) - V7(2)
            ZZ  = XXO(N, 6) - V7(3)
            XSQ = XX**2
            YSQ = YY**2
            ZSQ = ZZ**2
            DUMW(1, 1) = DUMW(1, 1) + WHT * (YSQ + ZSQ)
            DUMW(1, 2) = DUMW(1, 2) - WHT * XX * YY
            DUMW(1, 3) = DUMW(1, 3) - WHT * XX * ZZ
            DUMW(2, 2) = DUMW(2, 2) + WHT * (ZSQ + XSQ)
            DUMW(2, 3) = DUMW(2, 3) - WHT * YY * ZZ
            DUMW(3, 3) = DUMW(3, 3) + WHT * (XSQ + YSQ)
          END IF
        END IF
      END DO
      CALL GEN024 (DUMW, EV, EWX, DUMVX)
      CALL GEN074 (V2X, 1, 3, 0.0)
      DO N = 1, NMAX
        CALL GEN048 (-6, IFG(1, N), 9, IRESN)
        IF (IRESN .EQ. NR) THEN
          CALL GEN048 (-1, IFG(1, N), 7, IVL)
          IF (IVL .EQ. 0) THEN
            CALL GEN048 (-4, IFG(1, N), 15, IVL)
            WHT   = SATWT(IVL + 1)
            DO I = 1, 3
              V3(I) = XXO(N, I + 3) - V7(I)
            END DO
            DO J = 1, 3
              DO I = 1, 3
                YUNK = WHT * DUMVX(I, J) * V3(I)
                IF (ABS(YUNK) .GT. 1.0E-10) THEN
                  V2X(J) = V2X(J) + YUNK**3
                END IF
              END DO
            END DO
          END IF
        END IF
      END DO
      DO J = 1, 3
        IF (V2X(J) .LT. 0.0) THEN
          DO I = 1, 3
            DUMVX(I, J) = - DUMVX(I, J)
          END DO
          V2X(J) = - ABS(V2X(J)) ** (1.0 / 3.0)
        ELSE
          V2X(J) =   V2X(J) ** (1.0 / 3.0)
        END IF
      END DO
      CALL GEN010 (DUMVX, IDETX, 0)
   10 NATX = KP
      NATT = KPT
      RETURN
      END SUBROUTINE PLA083
      SUBROUTINE PLA084 (IRES, JRES)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CGRAPH/ GRAPH(44)
      CHARACTER GRAPH*125
      CHARACTER FORMA*74, FORMB*66
      FORMB(1 :37) = '(A,''-'',A,5X,A,''-'',A,F10.4,''('',I3,'')'','
      FORMB(38:66) = 'F10.4,''('',I3,'')'',F10.4,F10.4)'
      FORMA(1:32)  =  '(A,''-'',A,''-'',A,3X,A,''-'',A,''-'',A,'
      FORMA(33:64) = 'F8.2,''('',I3,'')'',F8.2,''('',I3,'')'','
      FORMA(65:74) = 'F8.2,F8.2)'
      D1   = 0.0
      D2   = 0.0
      A1   = 0.0
      SA1  = 0.0
      SD1  = 0.0
      SD2  = 0.0
      ND1  = 0
      ND2  = 0
      ISD1 = 0
      ISD2 = 0
      ISA1 = 0
      CALL PLA262 (0)
      CALL PLA262 (5)
      WRITE (LU7, 99999, IOSTAT = IOST) IRES, JRES
      IPR(133) = 0
      VDIF     = 0.0
      NV       = 0
      IFIN     = -1
      NSIG     = 1
   10 CALL PLA038 (I, J, IFIN)
      IF (IFIN .NE. 1) THEN
        CALL GEN048 (-6, IFG(1, I), 9, IRESI)
        IF (IRESI .EQ. IRES) THEN
          CALL PLA053 (I, J, 0, 0, D1, SD1, ISD1, ND1, IER)
          IF (IER .EQ. 0) THEN
            IAT = JCA(I)
            JAT = JCA(J)
            CALL PLA053 (IAT, JAT, 0, 0, D2, SD2, ISD2, ND2, IER)
            IF (IER .EQ. 0) THEN
              CALL PLA047 (LABA(I), NQ3, IDUM, JDUM, IPR(71),
     1                     IGBL(55), 0, 0)
              CALL PLA047 (LABA(J), NQ4, IDUM, JDUM, IPR(71),
     1                     IGBL(55), 0, 0)
              CALL PLA047 (LABA(IAT), NQ1, IDUM, JDUM, IPR(71),
     1                     IGBL(55), 0, 0)
              CALL PLA047 (LABA(JAT), NQ2, IDUM, JDUM, IPR(71),
     1                     IGBL(55), 0, 0)
              DIF = D1 - D2
              DS  = SQRT (SD1**2 + SD2**2)
              IF (DS .NE. 0) THEN
                DS = DIF / DS
              ELSE
                NSIG = 0
              END IF
              VDIF = VDIF + DIF**2
              NV   = NV + 1
              FORMB(25:25) = CHAR(ICHAR('0') + ND1)
              FORMB(42:42) = CHAR(ICHAR('0') + ND2)
              WRITE (PRBUF, FORMB, IOSTAT = IOST)
     1          NQ3, NQ4, NQ1, NQ2, D1, ISD1, D2, ISD2, DIF, DS
              CALL PLA263 (LU7, PRBUF, 132, 1, 3)
              DATC(NV) = ABS(DS)
            END IF
          END IF
        END IF
        GO TO 10
      END IF
      VDIF = SQRT (VDIF / NV)
      CALL PLA262 (2)
      WRITE (LU7, 99997, IOSTAT = IOST) VDIF
      IF (NV .GT. 5 .AND. NSIG .EQ. 1) THEN
        CALL PLA262 (0)
        CALL GEN116 (1, DATC(1), DATC(NV + 1), NV, GRAPH, LU7)
      END IF
      CALL PLA262 (0)
      CALL PLA262 (5)
      WRITE (LU7, 99996, IOSTAT = IOST) IRES, JRES
      IPR(133) = 0
      VDIS     = 0.0
      NV       = 0
      KB       = 0
      IFIN     = -1
      NSIG     = 1
   20 CALL PLA039 (I, J, K, IRES, A, SA, ISA, NDEC, KB, IFIN)
      IF (IFIN .NE. 1) THEN
        IAT = JCA(I)
        JAT = JCA(J)
        KAT = JCA(K)
        IF (IAT .NE. 0 .AND. JAT .NE. 0 .AND. KAT .NE. 0) THEN
          CALL PLA047 (LABA(IAT), NQ1, IDUM, JDUM,
     1                 IPR(71), IGBL(55), 0, 0)
          CALL PLA047 (LABA(JAT), NQ2, IDUM, JDUM,
     1                 IPR(71), IGBL(55), 0, 0)
          CALL PLA047 (LABA(KAT), NQ3, IDUM, JDUM,
     1                 IPR(71), IGBL(55), 0, 0)
          CALL PLA053 (IAT, JAT, KAT, 0, A1, SA1, ISA1, ND1, IER)
          IF (IER .EQ. 0) THEN
            DIF = A - A1
            DS  = SQRT (SA**2 + SA1**2)
            IF (DS .NE. 0) THEN
              DS = DIF / DS
            ELSE
              NSIG = 0
            END IF
            VDIS = VDIS + DIF**2
            NV   = NV + 1
            FORMA(36:36) = CHAR(ICHAR('0') + NDEC)
            FORMA(52:52) = CHAR(ICHAR('0') + ND1)
            WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1        (NAMS(1, M)(2:8), M = 1, 3),
     2        NQ1, NQ2, NQ3, A, ISA, A1, ISA1, DIF, DS
            CALL PLA263 (LU7, PRBUF, 132, 1, 3)
            DATC(NV) = ABS(DS)
          END IF
        END IF
        GO TO 20
      END IF
      VDIS = SQRT (VDIS / NV)
      CALL PLA262 (2)
      WRITE (LU7, 99994, IOSTAT = IOST) VDIS
      IF (NV .GT. 5 .AND. NSIG .EQ. 1) THEN
        CALL PLA262 (0)
        CALL GEN116 (1, DATC(1), DATC(NV + 1), NV, GRAPH, LU7)
      END IF
      RETURN
99999 FORMAT ('Comparison of the Bonds of the Fitted Residues', /,
     1        46('='), //, 'Resd#',I1, 14X, 'Resd#', I1, 18X, 'Dist#1',
     2        9X, 'Dist#2', 6X, 'Diff', 2X, 'Diff/Sig', /, 85('='))
99997 FORMAT (/, ':: RMS Bond Fit = ', F10.4, ' Ang.')
99996 FORMAT ('Comparison of the Bond Angles of the Fitted Residues', /,
     1        52('='), //, 'Resd#', I1, 20X, 'Resd#', I1, 25X,
     2        'Ang#1', 8X, 'Ang#2', 4X, 'Diff', 1X, 'Diff/Sig', /,
     3         91('='))
99994 FORMAT (/, ':: RMS Angle Fit = ', F10.3, ' Deg.')
      END SUBROUTINE PLA084
      SUBROUTINE PLA085 (LU, VARDIST)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION DUMW(3), V(3)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER INVRT*8, INCF*1
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      ISN = 0
C * QUATERNION-MOLFIT ROUTINE
      NATC = IPR(12) / 2
      NAT1 = IPR(12) - 1
      NAT2 = IPR(12)
      CALL GEN048 (-6, IFG(1, JR(1)), 9, NRES1)
      CALL GEN048 (-6, IFG(1, JR(2)), 9, NRES2)
      IF (LU .EQ. 1) WRITE (LU6, 99999, IOSTAT = IOST)
      CALL PLA262 (-3)
      WRITE (LU7, 99999, IOSTAT = IOST)
      IF (LU .NE. 0) OPEN (UNIT = LU60,
     1   FILE = NAMEFIL(1:KNMFIL)//'_fit.spf', STATUS = 'UNKNOWN')
      CALL GEN074 (DUMA, 1, 6, 0.0)
      DO 10 I = 1, IPR(39)
        DO J = 1, IPR(12)
          IF (JR(J) .EQ. I) THEN
            K = MOD(J + 1, 2) * 3
            DO N = 1, 3
              DUMA(N + K) = DUMA(N + K) + XXO(JR(J), 3 + N) / NATC
            END DO
            GO TO 10
          END IF
        END DO
        CALL GEN048 (-6, IFG(1, I), 9, NRES)
        IF (NRES .EQ. NRES1) THEN
          NAT1     = NAT1 + 2
          JR(NAT1) = I
        ELSE IF (NRES .EQ. NRES2) THEN
          NAT2     = NAT2 + 2
          JR(NAT2) = I
        END IF
   10 CONTINUE
      DO WHILE (NAT2 .NE. NAT1 + 1)
        IF (NAT2 .GT. NAT1 + 1) THEN
          NAT1     = NAT1 + 2
          JR(NAT1) = 0
        ELSE IF (NAT2 .LT. NAT1 + 1) THEN
          NAT2     = NAT2 + 2
          JR(NAT2) = 0
        END IF
      END DO
      ISN1 = 1
      ISN7 = 7
      IF (IPR(33) .NE. 0) THEN
        ISNS = 2
        IF (IPR(33) .EQ. 2) THEN
          ISN1 = 2
          ISN7 = 8
        END IF
      ELSE
        ISNS = 1
      END IF
      TH   = 0.0
      BEST = 99999.0
      ISNB = 1
      MBST = 0
      DO ISN0 = ISN1, ISN7, ISNS
        IF (ISN0 .EQ. ISN7) THEN
          ISN = ISNB
          M   = MBST
          IF (ISN .EQ. -1) THEN
            IF (LU .EQ. 1) WRITE (LU6, 99994, IOSTAT = IOST)
     1        NRES1, NRES2
            CALL PLA262 (2)
            WRITE (LU7, 99994, IOSTAT = IOST) NRES1, NRES2
            CALL PLA262 (2)
            INVRT = '(INVERT)'
          ELSE
            INVRT = '        '
          END IF
          IF (LU .NE. 0) WRITE (LU60, 99991, IOSTAT = IOST)
     1      JID(1:8), NRES1, INVRT, NRES2, NATC
        ELSE
          M = INT((ISN0 - 1) / 2)
          IF (MOD(ISN0, 2) .EQ. 0) THEN
            ISN = -1
          ELSE
            ISN = 1
          END IF
        END IF
        CALL GEN021 (DUMV, 0)
        CALL GEN074 (DUMW, 1, 3, 0.0)
        CALL GEN074 (V5,   1, 3, 0.0)
        CALL GEN074 (V6,   1, 3, 0.0)
        DO I = 1, IPR(12), 2
          DO J = 1, 3
            V1(J) =  (XXO(JR(I), MOD(J + M, 3) + 4)
     1             - DUMA(MOD(J + M, 3) + 1)) * ISN
            V2(J) = XXO(JR(I + 1), J + 3) - DUMA(J + 3)
            V3(J) =   V1(J) + V2(J)
            V4(J) = - V1(J) + V2(J)
          END DO
          DUMV(1, 1) = DUMV(1, 1) + V3(2)**2 + V3(3)**2
          DUMV(2, 2) = DUMV(2, 2) + V3(1)**2 + V3(3)**2
          DUMV(3, 3) = DUMV(3, 3) + V3(1)**2 + V3(2)**2
          DUMV(1, 2) = DUMV(1, 2) - V3(1) * V3(2)
          DUMV(1, 3) = DUMV(1, 3) - V3(1) * V3(3)
          DUMV(2, 3) = DUMV(2, 3) - V3(2) * V3(3)
          DUMW(1)    = DUMW(1)    - V3(3) * V4(2) + V3(2) * V4(3)
          DUMW(2)    = DUMW(2)    + V3(3) * V4(1) - V3(1) * V4(3)
          DUMW(3)    = DUMW(3)    - V3(2) * V4(1) + V3(1) * V4(2)
        END DO
        DUMV(2, 1) = DUMV(1, 2)
        DUMV(3, 1) = DUMV(1, 3)
        DUMV(3, 2) = DUMV(2, 3)
        CALL GEN003 (DUMV, RMAT, DET, 0)
        CALL GEN002 (1, RMAT, DUMW, V8, XLNG)
        THETA = 2 * ATAN(SQRT(GEN009(V8, V8)))
        TH    = THETA * RGBL(6)
        IF (ABS(TH) .LT. 0.001) THEN
          CALL PLA262 (5)
          IF (LU .EQ. 1) THEN
            WRITE (LU6, 99993, IOSTAT = IOST)
            WRITE (LU6, 99998, IOSTAT = IOST) TH, V5, V6
          END IF
          WRITE (LU7, 99993, IOSTAT = IOST)
          WRITE (LU7, 99998, IOSTAT = IOST) TH, V5, V6
          RETURN
        END IF
        DO I = 1, 3
          V(I) = V8(I) / TAN(THETA / 2)
        END DO
        IF (ISN0 .EQ. ISN7) THEN
          STHH  = SIN(THETA / 2.0)
          CTHH  = COS(THETA / 2.0)
          V5(1) = STHH * V(1)
          V5(2) = STHH * V(2)
          V5(3) = STHH * V(3)
          VAL   = SIN( -(M + 1) * 60.0 / RGBL(6)) / SQRT(3.0)
          CALL GEN074 (V6, 1, 3, VAL)
          VAL   = COS(-(M + 1) * 60.0 / RGBL(6))
          THH   = CTHH * VAL  - GEN009 (V5, V6)
          THH   = MAX (-1.0, MIN (THH, 1.0))
          TH    = MOD (2.0 * ACOS(THH) *  RGBL(6) + 360.0, 360.0)
          IF (TH .GT. 180.0) TH = TH - 360.0
          CALL GEN008 (V5, V6, V1, 0)
          SHH   = SQRT (1.0 - THH **2)
          IF (SHH .NE. 0.0) THEN
            DO I = 1, 3
              V1(I) = (V1(I) + V5(I) * VAL + CTHH * V6(I)) / SHH
            END DO
          END IF
          CALL GEN002 (1, ROR, V1, V2, DUM)
          V2MAX = MAX (ABS(V2(1)), ABS(V2(2)), ABS(V2(3)))
          IF (V2MAX .NE. 0.0) THEN
            DO I = 1, 3
              V2(I) = V2(I) / V2MAX
            END DO
          END IF
          IF (LU .EQ. 1) WRITE (LU6, 99998, IOSTAT = IOST)
     1      TH, (V1(I), I = 1, 3), (V2(I), I = 1, 3)
          CALL PLA262 (8)
          WRITE (LU7, 99998, IOSTAT = IOST)
     1      TH, (V1(I), I = 1, 3), (V2(I), I = 1, 3)
        END IF
        THH   = THETA / 2
        F1    = COS(THH)**2 - SIN(THH)**2
        F2    = SIN(THETA)
        F3    = 2 * SIN(THH)**2
        RMSQ  = 0.0
        URMS  = 0.0
        SUMW  = 0.0
        RMSQ1 = 0.0
        URMS1 = 0.0
        SUMW1 = 0.0
        NONHA = 0
        DO J = 1, NAT1, 2
          I    = JR(J)
          K    = JR(J + 1)
          WGHT = 0.0
          DO N = 1, 3
            IF (I .EQ. 0) THEN
              V1(N) = 0.0
            ELSE
              MODNM = MOD(N + M, 3)
              V1(N) =  (XXO(I, MODNM + 4) - DUMA(MODNM + 1)) * ISN
            END IF
            IF (K .EQ. 0) THEN
              V2(N) = 0.0
            ELSE
              V2(N) = XXO(K, N + 3) - DUMA(N + 3)
            END IF
            WGHT  = WGHT + V1(N)**2
          END DO
          F4 = F3 * GEN009 (V, V1)
          CALL GEN008 (V, V1, V4, 0)
          DO N = 1, 3
            V3(N) = F1 * V1(N) + F2 * V4(N) + F4 * V(N)
          END DO
          DIST = (V2(1) - V3(1))**2 + (V2(2) - V3(2))**2
     1         + (V2(3) - V3(3))**2
          IF (J .LT. IPR(12)) THEN
            INCF = '*'
            RMSQ = RMSQ + WGHT * DIST
            SUMW = SUMW + WGHT
            URMS = URMS + DIST
          ELSE
            INCF = ' '
          END IF
          IF (I .NE. 0) THEN
            CALL GEN048 (-1, IFG(1, I), 7, IHAT)
            IF (IHAT .EQ. 0) THEN
              NONHA = NONHA + 1
              RMSQ1 = RMSQ1 + WGHT * DIST
              SUMW1 = SUMW1 + WGHT
              URMS1 = URMS1 + DIST
            END IF
            DIST = SQRT(DIST)
          END IF
          IF (ISN0 .EQ. ISN7) THEN
            IF (I .NE. 0) THEN
              CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, IPR(71),
     1          IGBL(55), 0, 0)
              CALL PLA047 (LABA(I), NQ3, IDUM, JDUM, IPR(71),
     1          1, 0, 0)
            ELSE
              CALL GEN038 (NQ1, 1, 7)
              NQ3 = NQ1
            END IF
            IF (K .NE. 0) THEN
              CALL PLA047 (LABA(K), NQ2, IDUM, JDUM, IPR(71),
     1          IGBL(55), 0, 0)
            ELSE
              CALL GEN038 (NQ2, 1, 7)
            END IF
            IF (JR(J) .NE. 0 .AND. LU .NE. 0) THEN
              WRITE (LU60, 99992, IOSTAT = IOST)
     1          NQ1, NQ3, (V3(N), N = 1, 3)
            END IF
            WRITE (PRBUF, 99996, IOSTAT = IOST)
     1        NQ1(1:6), (V3(N), N = 1, 3),
     2        NQ2(1:6), (V2(N), N = 1, 3), DIST, INCF
            IF (I .EQ. 0) CALL GEN038 (PRBUF, 1, 32)
            IF (K .EQ. 0) CALL GEN038 (PRBUF, 35, 68)
            IF (I .EQ. 0 .OR. K .EQ. 0) CALL GEN038 (PRBUF, 70, 80)
            CALL PLA262 (1)
            IF (LU .EQ. 1) WRITE (LU6, 99989, IOSTAT = IOST) PRBUF(1:80)
            WRITE (LU7, 99989) PRBUF(1:80)
          END IF
        END DO
        URMS  = SQRT(URMS  / NATC)
        RMSQ  = SQRT(RMSQ  / SUMW)
        URMS1 = SQRT(URMS1 / NONHA)
        RMSQ1 = SQRT(RMSQ1 / SUMW1)
        IF (ISN0 .EQ. ISN7) THEN
          CALL PLA262 (5)
          IF (LU .EQ. 1)
     1      WRITE (LU6, 99995, IOSTAT = IOST) RMSQ, URMS, NATC,
     2        RMSQ1, URMS1, NONHA
          WRITE (LU7, 99995, IOSTAT = IOST)
     1      RMSQ, URMS, NATC, RMSQ1, URMS1, NONHA
        ELSE
          IF (RMSQ .LT. BEST) THEN
            BEST = RMSQ
            ISNB = ISN
            MBST = M
          END IF
        END IF
      END DO
      IF (LU .NE. 0) THEN
        WRITE (LU60, 99990, IOSTAT = IOST)
        DO I = 1, NAT2, 2
          K    = JR(I + 1)
          IF (K .NE. 0) THEN
            CALL PLA047 (LABA(K), NQ2, IDUM, JDUM, IPR(71),
     1        1, 0, 0)
            CALL PLA047 (LABA(K), NQ4, IDUM, JDUM, IPR(71),
     1        IGBL(55), 0, 0)
            WRITE (LU60, 99992, IOSTAT = IOST) NQ4, NQ2,
     1        (XXO(K, N) - DUMA(N), N = 4, 6)
          END IF
        END DO
        WRITE (LU60, 99997, IOSTAT = IOST)
        CLOSE (UNIT = LU60)
        IF (IGBL(25) .NE. 0 .OR. IGBL(3) .EQ. 41) THEN
          KERR = 0
          CALL SPAWN
     1    (PLAPATH(1:IGBL(80))//' -p '//NAMEFIL(1:KNMFIL)//'_fit.spf',
     2    KERR)
        END IF
      END IF
      VARDIST = RMSQ
      RETURN
99999 FORMAT ('Molfit with Quaternion Transformation Method',
     1 ' (see: A.L. Mackay, Acta Cryst.(1984), A40, 165-166)', /,
     2 132('='), /)
99998 FORMAT ('Fit Rotation angle about (Pseudo)axis [l,m,n] = ',
     1  F10.2,  ' Degree', /,
     2  'Direction Cosines with Orthogonal Cell l,m,n  = ',
     3 3F10.6, /, 'Components in crystal system', 20X, 3F10.6, //,
     4 'Starred Atom Pairs are those used for the FIT. ',
     5 'Other Atoms are Paired on Sequence Number and need not to ',
     6 'Correspond.', //,  'Transf. Orthogonal Coord. Mol1', 5X,
     8 'Orth. Coord. Mol2 with Resp. to C.G.', 1X,
     9 'Dist (A)', /, 80('-'))
99997 FORMAT ('STRAW', /, 'COLOR RESD', /, 'OVERLAP MARGIN 0.0', /,
     1 'SET PAR 149 0.0', /, 'LABEL ON', /, 'PLOT')
99996 FORMAT (1X, 2(A, 1X, 3F8.3, 4X), F7.3, 1X, A)
99995 FORMAT (/, ':: Weighted and Unit Weight RMS-Fit: ',
     1  2F7.3 ,' Ang, No of Fitted Atoms:', I4, /,
     2        /, ':: Weighted and Unit Weight RMS-Fit: ',
     3  2F7.3 ,' Ang, No of Non-H  Atoms:', I4)
99994 FORMAT (':: FIT Inverted Resd', I2, '  on Resd', I2,
     1        ' gives the best fit', /)
99993 FORMAT (':: Residues are IDENTICAL', /)
99992 FORMAT (A, A, 3F10.3)
99991 FORMAT ('TITL ', A, ' - FIT RESD', I3, A, ' TO RESD', I3,
     1        ', N =', I3, /, 'RESD 1')
99990 FORMAT ('RESD 2')
99989 FORMAT (A)
      END SUBROUTINE PLA085
      SUBROUTINE PLA086 (LU)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CALL PLA080
      CONST = 16.0 * RGBL(5) * PAR(98) / 3.0
      IF (LU .EQ. LU7) CALL PLA262 (0)
      WRITE (LU, 99999, IOSTAT = IOST) IPR(48)
      DO I = 20, 30
        STHL = SIN (I / RGBL(6)) / 0.71073
        NREF1 = NINT (CONST * STHL ** 3)
        NREF2 = NREF1 / IPR(48)
        NREF3 = NREF2 / (3 - IPR(275))
        XJ    = ASIN (MIN(1.0, STHL * 1.5418)) * RGBL(6)
        WRITE (LU, 99998, IOSTAT = IOST)
     1    I, NREF1, NREF2, NREF3, XJ , STHL
      END DO
99999 FORMAT (/, 'Expected number of reflections in sphere ',
     1 '(NSYM =', I3, ')', //,
     2 'THMAX(MoKa)       N      N/NSYM   N(LAUE) ',
     3 'THMAX(CuKa) SINT/LAMBDA', /, 80('='), /)
99998 FORMAT (I5, 5X, 3I10, F10.2, F12.3)
      RETURN
      END SUBROUTINE PLA086
      SUBROUTINE PLA087
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      IF (IPR(30) .EQ. 0) THEN
        CALL PLA088
        NAT    = IPR(37)
        NDOAC  = IPR(480)
        CALL PLA040 (0, 1, NP1, 0)
        IPR(13) = 1
        MOL(1)  = NINT(1555 * PAR(42))
        IPR(51) = IPR(13)
        IPR(75) = 0
        IPR(17) = 0
        DO I = 1, NAT
          CALL GEN048 (-4, IFG(1, I), 15, NO1)
          NO1 = NO1 + 1
          CALL GEN048 (3, IFG(1, I), 1, 0)
          IKAT = I
          CALL PLA059 (IKAT, IKAT)
          IVAL = 0
          DO J = 1, NDOAC
            IF (IEN(NO1) .EQ. IDOAC(J)) THEN
              IVAL = 1
              EXIT
            END IF
          END DO
          CALL GEN048 (1, IFG(1, I), 23, IVAL)
          IF (IGBL(30) .EQ. 1 .OR. IATP(I) .GT. 0)  CALL PLA070 (I)
        END DO
      END IF
      IF (IPR(17) .LT. 0) THEN
        DO I = 1, IAN
          RADR(I, 2) = RADR(I, 4)
        END DO
        IF (IPR(189) .EQ. 0) THEN
          PAR(1) = PAR(3)
        ELSE
          PAR(1) = 0.0
        END IF
      ELSE IF (IPR(17) .EQ. 0) THEN
        DO I = 1, IAN
          RADR(I, 2) = RADR(I, 3)
        END DO
        PAR(1) = PAR(2)
        IF (IPR(31) .NE. 0) GO TO 40
      ELSE
        PAR(1) = 0.0
        DO I = 1, IAN
          RVAL = 0.0
          IF (IPR(57) .EQ. 1) THEN
            IELTP = IATPR(IEN(I))
            IF (IELTP .GT. 0) RVAL = PAR(262)
          ELSE IF (IPR(57) .EQ. 2) THEN
            RVAL = PAR(262)
          ELSE IF (IPR(57) .LT. 0) THEN
            IF (IPR(57) + I .EQ. 0) RVAL = PAR(262)
          ELSE
            IF (IABS(IGBL(8)) .EQ. 2 .OR. IABS(IGBL(8)) .EQ. 3) THEN
              ICARB = 1
            ELSE
              ICARB = 2
            END IF
            IF (IEN(I) .GT. ICARB .AND. IEN(I) .NE. 33 .AND.
     1          IEN(I) .NE. 113) RVAL = PAR(262)
          END IF
          RADR(I, 2) = RVAL
        END DO
        IPR(168) = 0
        IF (IPR(220) .GE. 3) THEN
          IF (IFL(3)(1:3) .EQ. 'NOA') THEN
            IPR(7) = 0
          ELSE
            CALL PLA037 (3, NID, 3)
            IF (NID .LT. 0) THEN
              IPR(168) = - NID
            ELSE IF (NID .EQ. 0) THEN
              IPR(2) = 18
              RETURN
            END IF
          END IF
        END IF
      END IF
      DO J = 1, IAN
        RADJ       = RADR(J, 1)
        RADR(J, 1) = -1.0
        IF (RADJ .GE. 0.0) RADR(J, 2) = RADJ
      END DO
   40 IPR(15)  = 0
      IPR(104) = 1
      IPR(24)  = 0
      IF (IPR(23) .EQ. 1 .OR. IGBL(52) .EQ. 1) THEN
        IPR(27)  = 1
        IGBL(30) = 1
      ELSE
        IPR(27) = 0
      END IF
      RETURN
      END SUBROUTINE PLA087
      SUBROUTINE PLA088
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      NAT = IPR(37)
      IF (IPR(30) .EQ. 0) THEN
        KINC   = IPR(4)
        IPR(4) = 0
        IF (IPR(208) .EQ. 0) THEN
          CALL PLA042 (1)
          MODE = 0
          DO I = 1, IAN
            IF (IEN(I) .EQ. 2) THEN
              MODE = 1
              EXIT
            END IF
          END DO
          CALL GEN123 (MODE, IEN, IENS, IEL, IAN)
          DO I = 1, NAT
            CALL GEN048 (-4, IFG(1, I), 15, NO1)
            IF (KINC .GT. 0) THEN
              IVAL = 1 - IPR(70)
              DO J = 1, KINC
                IF (NO1 + 1 .EQ. NINT(RADR(J, 2))) THEN
                  IVAL = IPR(70)
                  EXIT
                END IF
              END DO
              JR(I) = JR(I) * IVAL
            END IF
          END DO
          IF (IGBL(33) .NE. 0) THEN
            ND = 2**(INT((ALOG(FLOAT(NAT)) / ALOG(2.0)) + 1.0E-5)) - 1
            DO WHILE (ND .GT. 0)
              I = 1
              DO
                J      = I
                NIAP   = IATP(I + ND)
                JRSAVE = JR(I   + ND)
                LBSAVE = LABA(I + ND)
                DO K = 1, 3
                  IDBUF(K) = IFG(K, I + ND)
                END DO
                DO K = 3, NP4
                  DBUF(K) = CON(I + ND, K)
                END DO
   10           IF (JRSAVE .LT. JR(J)) THEN
                  IATP(J + ND) = IATP(J)
                  JR(J   + ND) = JR(J)
                  LABA(J + ND) = LABA(J)
                  DO K = 1, 3
                    IFG(K, J + ND) = IFG(K, J)
                  END DO
                  DO K = 3, NP4
                    CON(J + ND, K) = CON(J, K)
                  END DO
                  J = J - ND
                  IF (J .GT. 0) GO TO 10
                END IF
                IATP(J + ND) = NIAP
                JR(J   + ND) = JRSAVE
                LABA(J + ND) = LBSAVE
                DO K = 1, 3
                  IFG(K, J  + ND) = IDBUF(K)
                END DO
                DO K = 3, NP4
                  CON(J + ND, K) = DBUF(K)
                END DO
                I = I + 1
                IF (I + ND .GT. NAT) EXIT
              END DO
              ND = (ND - 1) / 2
            END DO
          END IF
          K = 0
          DO I = 1, NAT
            IF (JR(I) .NE. 0) THEN
              K       = K + 1
              LABA(K) = LABA(I)
              DO J = 1, 3
                IFG(J, K)  = IFG(J, I)
              END DO
              IATP(K) = IATP(I)
              DO J = 1, 3
                XXO(K, J) = CON(I, J + 2)
                IF (IABS(IGBL(8)) .NE. 2) THEN
                  XSD(K, J) = CON(I, J + 5)
                ELSE
                  XSD(K, J) = 0.0
                END IF
              END DO
            END IF
          END DO
          IPR(37)  = K
          IPR(39)  = K
          IPR(208) = 1
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA088
      SUBROUTINE PLA089
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /CFORM/ FORM, FORMA, FORMB, CXMOL3
      COMMON /C89/ ISA(3), ISD(3), IDEC(8), A0, SA0, IOLD, KOLD, IDISK,
     1 NFOUND, IRES, NTEL, NHEAD, ITLC, NC, IDC, LOOPT, IVLC, INORM
      CHARACTER FORM*105, FORMA*70, FORMB*43, CXMOL3*9
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER IYH*1, NYH*1
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IGBL(6) = 10
      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IPR(121) .EQ. 0 .AND.
     1    IPR(430) .EQ. 0) THEN
        IWIN = 1
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL GGIP09 (0.0, JID, 9, 0.30, 5 + IGBL(68), 2, HORS - 3.0,
     1               0.1)
        IF (IGBL(60) .GT. 0) THEN
          WRITE (PRBUF, 99991, IOSTAT = IOST)
          CALL GGIP09 (0.0, PRBUF, 17, 0.3, 2, 1, 0.1, 0.1)
        END IF
        VRT = VERT - 0.6
        WRITE (PRBUF, 99992, IOSTAT = IOST)
        CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
        VRT = VRT - 0.4
      ELSE
        IWIN = 0
      END IF
      FORM(1 :40)  = '(I2,A,I2,   A,''--'',A,''..'',A,''['',A   ,'']'''
      FORM(41:56)  = ',F7.4,''('',I2,'')'''
      FORM(57:105) = FORM(41:56)//FORM(41:56)//',F7.1,''('',I2,'')'')'
      FORMB(1:36)  = '(8X,I2,A,''--'',A,''.. ?'',16X,F7.4,''('','
      FORMB(37:43) = 'I2,'')'')'
      NHEAD = 0
      ITLC  = 0
      KOLD  = 0
      IOLD  = 0
      IDC   = 0
      NTEL  = 0
      A0    = 0.0
      SA0   = 0.0
      IF (IPR(87) .NE. 0) WRITE (LU6, 99994, IOSTAT = IOST)
      NAT     = IPR(37)
      NATM    = IPR(39)
      IPR(88) = 0
      CALL GEN097 (IATP, 1, NATM, 0)
      CALL GEN097 (IFNT, 1, NATM, 0)
      CALL GEN097 (JCA,  1, NATM, 0)
      CALL GEN097 (MP,   1, NP11, 0)
      CALL GEN097 (ISA,  1, 3, 0)
      CALL GEN097 (ISD,  1, 3, 0)
      CALL GEN097 (IDEC, 1, 8, 0)
C * LOOP OVER NON-C-H AND C-H ATOMS ALTERNATIVELY
      DO LOOPT = 1, 2 - IPR(645)
        INRM  = 0
C * LOOP OVER ALL ATOMS TO FIND HYDROGEN BRIDGED H-ATOMS
        DO 20 IAT = 1, NAT
          CALL GEN048 (-1, IFG(1, IAT), 7, IHA)
          IF (IHA .NE. 0) THEN
            INRM  = INRM + 1
            INORM = NATM + IPR(24) + INRM
            IF (LOOPT .EQ. 1) THEN
              DO J = 1, 6
                XXO(INORM, J) = XXO(IAT, J)
                XSD(INORM, J) = XSD(IAT, J)
              END DO
              LABA(INORM) = LABA(IAT)
              DO J = 1, 3
                IFG(J, INORM)  = IFG(J, IAT)
              END DO
            END IF
            CALL PLA036 (IAT, 1, 2, IPOPI, IDUM1, IDUM2,
     1        IPR(71), IGBL(55))
            IF (IPOPI .GE. 500) THEN
              NC = - NINT(CON(IAT, NP4))
              IF (NC .LT. 0) NC = NP4
              IF (NC .NE. 0) THEN
                KAT = NINT(CON(IAT, 1))
                IF (KAT .LE. 0) THEN
                  WRITE (LU6, 99989, IOSTAT = IOST) IAT, KAT, NC
                  CALL PLA004 (0)
                ELSE IF (KAT .LT. NP1) THEN
                  CALL GEN048 (-4, IFG(1, KAT), 19, IMET)
                  CALL GEN048 (-4, IFG(1, KAT), 15, IVLC)
                  IF (IMET .NE. 1 .AND. IVLC .NE. 20) THEN
                    CALL GEN048 (-6, IFG(1, KAT), 9, IRES)
                    IVLC = IEN(IVLC + 1)
                    CALL PLA036 (KAT, 1, 1, IPOPK, IDIM1, IDUM2,
     1                         IPR(71), IGBL(55))
                    IF (LOOPT .EQ. 1) THEN
                      IF (IPR(87) .GT. 0) THEN
                        CALL GEN048 (1, IFG(2, INORM), 10, 0)
                        CALL PLA050 (KAT, INORM, 0, 0, V6(1))
                        IF (IVLC .EQ. 2) THEN
                          V6(1) = PAR(296) / V6(1)
                        ELSE IF (IVLC .EQ. 4) THEN
                          V6(1) = PAR(297) / V6(1)
                        ELSE IF (IVLC .EQ. 3) THEN
                          V6(1) = PAR(298) / V6(1)
                        ELSE IF (IVLC .EQ. 20) THEN
                          V6(1) = PAR(294) / V6(1)
                        ELSE IF (IVLC .EQ. 85) THEN
                          V6(1) = PAR(295) / V6(1)
                        END IF
                        DO L = 4, 6
                          YUNK = (XXO(INORM, L) - XXO(KAT, L)) * V6(1)
                          XXO(INORM, L) = XXO(KAT, L) + YUNK
                          XSD(INORM, L) = 0.0
                        END DO
                      END IF
                      IF (IVLC .EQ. 2 .AND. IPR(645) .EQ. 0) GO TO 20
                      IF (NC .LT. 2) THEN
                        IF (IGBL(63) .GT. 2) THEN
                          IF (NHEAD .NE. 1) THEN
                            NHEAD = 1
                            CALL PLA262 (-7)
                            WRITE (LU7, 99997, IOSTAT = IOST)
     1                        PAR(8), PAR(9), PAR(10)
                            WRITE (LU7, 99996, IOSTAT = IOST)
                          END IF
                        END IF
                        CALL PLA053 (KAT, INORM, 0, 0, V6(1), V8(1),
     1                               ISD(1), IDEC(1), IER)
                        IF (IER .EQ. 0) THEN
                          IF (ISD(1) .EQ. 0) THEN
                            IDEC(1) = 2
                            V6(1) = NINT (V6(1) * 100.0) / 100.0
                          END IF
                        END IF
                        GO TO 10
                      END IF
                    ELSE IF (LOOPT .EQ. 2) THEN
                      IF (NC .LT. 2) GO TO 20
                      IF (IVLC .NE. 2 .AND. IPR(645) .EQ. 0)
     1                  GO TO 20
                    END IF
                    IF (IPOPK .LT.  501) THEN
                      IF (IPOPK .LT. 500) GO TO 20
                      IDISK = 10
                    ELSE
                      IDISK = 0
                    END IF
                    CALL PLA053 (KAT, INORM, 0, 0, V6(1), V8(1), ISD(1),
     1                           IDEC(1), IER)
                    IF (IER .NE. 0) GO TO 20
                    CALL PLA090 (IAT, KAT)
                    IF (IPR(2) .NE. 0) RETURN
                    IF (NFOUND .EQ. 0) GO TO 10
                  END IF
                END IF
              END IF
            END IF
          END IF
          GO TO 20
   10     IF (LOOPT .EQ. 1 .AND. IVLC .NE. 2) THEN
            IF (IGBL(63) .GT. 2) THEN
              IF (NHEAD .NE. 1) THEN
                NHEAD = 1
                CALL PLA262 (-5)
                WRITE (LU7, 99997, IOSTAT = IOST)
     1            PAR(8), PAR(9), PAR(10)
                IF (IPR(87) .GT. 0) THEN
                  CALL PLA262 (3)
                  WRITE (LU7, 99988, IOSTAT = IOST)
                END IF
                CALL PLA262 (2)
                WRITE (LU7, 99996, IOSTAT = IOST)
                IF (IGBL(60) .GT. 0) WRITE (LU6, 99991, IOSTAT = IOST)
                WRITE (LU6, 99992, IOSTAT = IOST)
              END IF
              ISD(1) = MIN (99, ISD(1))
              FORMB(31:31) = CHAR(ICHAR('0') + IDEC(1))
              WRITE (PRBUF, FORMB, IOSTAT = IOST) IRES, NAMS(1, 1)(1:7),
     1               NAMS(1, 2)(2:8), V6(1), ISD(1)
              CALL PLA263 (LU7, PRBUF, 132, 1, 3)
              WRITE (LU6, 99987, IOSTAT = IOST) PRBUF(12:79)
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 0.5
                CALL GGIP09 (0.0, PRBUF(12:90), 79, 0.35, 2, 2, 1.0,
     1                       VRT)
              END IF
              CALL PLA262 (1)
            END IF
            IF (NAMS(1, 1)(2:2) .NE. 'B' .AND.
     1          NAMS(1, 1)(2:2) .NE. 'P') THEN
              IF (NAMS(1, 1)(2:2) .EQ. 'O') THEN
                W = 2.0
              ELSE
                W = 1.0
              END IF
C * ALERT _420
              CALL PLA231 (420, 0, W, W, NAMS(1, 1)(1:7), NAMS(1, 2))
            END IF
            IPR(405) = IPR(405) + 1
          END IF
   20   CONTINUE
      END DO
      IF (IPR(88) .EQ. 0) THEN
        LINE = ':: No Classic Hydrogen Bonds Found'
        CALL PLA015 (0, 1)
        WRITE (LU6, 99986, IOSTAT = IOST) LINE
        IF (IWIN .EQ. 1) THEN
          VRT = VRT - 2.5
          CALL GGIP09 (0.0, LINE, 50, 0.70, 2, 2, 2.5, VRT)
          VRT = VRT - 1.5
        END IF
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99986, IOSTAT = IOST) LINE
        END IF
      ELSE
        CALL PLA015 (0, 2)
      END IF
      IF (IPR(87) .NE. 0 .AND. INRM .NE. 0) THEN
        CALL PLA262 (5)
        WRITE (LU7, 99985, IOSTAT = IOST)
        DO I = 1, INRM
          J = NATM + IPR(24) + I
          CALL PLA047 (LABA(J), NQ1, MNM, JDUM, IPR(71), IGBL(55),
     1      0, 0)
          DO K = 1, 3
            V5(K) = XXO(J, K + 3)
          END DO
          CALL GEN002 (1, ROR, V5, V4, XLNG)
          CALL PLA262 (1)
          WRITE (LU7, 99984, IOSTAT = IOST) NQ1, (V4(K), K = 1, 3),
     1                            (V5(K), K = 1, 3)
        END DO
      END IF
      IF (IPR(300) .GT. 0 .AND. NHEAD .NE. 0) THEN
        IF (NTEL .GT. 0) THEN
          VRT = VRT - 0.4
          CALL PLA043 (0, 0, 0, 0)
          CALL PLA043 (0, 0, LU6, 0)
        END IF
        CALL PLA043 (0, 0, LU7, 0)
        IF (IDC .GT. 0 .AND. IGBL(63) .GT. 2) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99995, IOSTAT = IOST)
        END IF
        IF (ITLC .GT. 0 .AND. IGBL(63) .GT. 2) THEN
          CALL PLA262 (6)
          WRITE (LU7, 99993, IOSTAT = IOST)
        END IF
        IF (IPR(88) .GT. 0) THEN
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (6)
            WRITE (LU7, 99999, IOSTAT = IOST)
          END IF
          DO I = 1, NAT
            CALL GEN048 (-1, IFG(1, I), 23, IDA)
            IF (IDA .EQ. 1) THEN
              CALL PLA036 (I, 1, 1, IDS1, IDUM1, IDUM2, IPR(71),
     1                     IGBL(55))
              IF (IDS1 .GE. 500) THEN
                CALL GEN048 (-1, IFG(1, I), 21, IH)
                IF (IH .EQ. 1) THEN
                  IYH = 'H'
                ELSE
                  IYH = '-'
                END IF
                NC   = - NINT(CON(I, NP4))
                NCV  = 0
                NCVH = 0
                DO J = 1, NC
                  K = NINT(CON(I, J))
                  IF (K .LE. NP1) THEN
                    NCV = NCV + 1
                    CALL GEN048 (-1, IFG(1, K), 7, IHA)
                    NCVH = NCVH + IHA
                  END IF
                END DO
                IF (NCVH .EQ. 0) THEN
                  NYH = ' '
                ELSE
                  WRITE (NYH, 99990, IOSTAT = IOST) NCVH
                END IF
                IF (IGBL(63) .GT. 2) THEN
                  CALL PLA262 (1)
                  NSUMH = IATP(I) + IFNT(I) + JCA(I)
                  NSUMT = NSUMH   + NCV - NCVH
                  WRITE (LU7, 99998, IOSTAT = IOST)
     1              I, NAMS(1, 1), NCV, NYH, IYH,
     2              IATP(I), IFNT(I), JCA(I), NSUMH, NSUMT
                END IF
              END IF
            END IF
          END DO
        END IF
      END IF
      RETURN
99999 FORMAT (/, 'Analysis of Potential Donor/Acceptor Atoms',
     1 ' -- (Major Disorder Form Only)', /, 132('='), //,
     2 'At.Nr  D/A', 4X, '#Cov.Bonds', 4X, '# H', 5X, '#D-H..A', 3X,
     3 '#A..H', 3X, '#A..H-C', 2X, 'Sum(A-H)', 3X, 'Sum(A-X)', /,
     4 132('-'))
99998 FORMAT (I4, 2X, A, 2X, I6, 6X, A, 1X, A, 5I9)
99997 FORMAT ('Analysis of Potential Hydrogen Bonds and Schemes with ',
     1 'd(D...A) < R(D)+R(A)+0', F3.2, ', d(H...A) < R(H)+R(A)',
     2 F5.2, ' Ang., D-H...A >', F6.1, ' Deg', /,
     3 132('='), /, 'Note: - ARU codes in [] are with reference to',
     4 ' the Coordinates printed above (Possibly transformed, when',
     5 ' MOVE .NE. 1.555)', /, 132('='), /)
99996 FORMAT ('Nr Typ Res Donor --- H....Acceptor [    ARU  ]', 6X,
     1 'D - H', 6X, 'H...A', 6X, 'D...A', 2X, 'D - H...A', 4X, 'A..H',
     2 '..A*', 1X, 'A''..H..A" Sum(XY,YZ)  Sum(XZ)', /, 132('-'))
99995 FORMAT (/, 'For C--H...Acceptor Interactions See: ',
     1 'Th. Steiner, Cryst. Rev, (1996), 6, 1-57')
99994 FORMAT (/, ':: X-H Distances have been NORMALIZED', /)
99993 FORMAT (/, 'H-Bond classification [G.A.Jeffrey, H.Maluszynska &',
     1 ' J.Mitra., Int.J.Biol.Macromol.(1985),7,336-348]', /, 132('-'),
     3 /, '2-Centre   (linear)     D-H...X most prob. angle 160 deg',
     4 '  - also: G.A.Jeffrey & W.Saenger, Hydrogen Bonding in ',
     5 'Biological Structures', /,
     6 '3-Centre (bifurcated)   SUM of 3 angl. about H = 360 deg',
     7 20X, 'Springer-Verlag, Berlin, 1991, pp 20.', /,
     8 '4-Centre (trifurcated)')
99992 FORMAT ('Donor --- H....Acceptor [    ARU  ]', 6X,
     1 'D - H', 6X, 'H...A', 6X, 'D...A', 2X, 'D - H...A')
99991 FORMAT ('Input Atoms Moved')
99990 FORMAT (I1)
99989 FORMAT (/, 'Problem in PLA089', 3I10, /)
99988 FORMAT ('X-H Bonds normalized: G.A. Jeffrey & L. Lewis',
     1 ', Carbohydr.Res. (1978), 60, 179', /,
     2 22X, 'R.Taylor & O.Kennard, Acta Cryst. (1983), B39, 133)', /)
99987 FORMAT (A)
99986 FORMAT (/, A, /)
99985 FORMAT (/, 'Normalized X-H Atom Positions', /, 132('='), /,
     1        'Atom', 10X,  'x', 9X, 'y', 9X, 'z', 9X, 'XO', 8X, 'YO',
     2        8X, 'ZO', /, 132('-'))
99984 FORMAT (A, 6F10.4)
      END SUBROUTINE PLA089
      SUBROUTINE PLA090 (IAT, KAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /CFORM/ FORM, FORMA, FORMB, CXMOL3
      COMMON /C89/ ISA(3), ISD(3), IDEC(8), A0, SA0, IOLD, KOLD, IDISK,
     1 NFOUND, IRES, NTEL, NHEAD, ITLC, NC, IDC, LOOPT, IVLC, INORM
      CHARACTER FORM*105, FORMA*70, FORMB*43, CXMOL3*9
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER INTRA*6
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CALL GEN048 (-1, IFG(1, IAT), 20, IHB)
      IF (IVLC .EQ. 2 .AND. IPR(645) .EQ. 1) IHB = 1
      NFOUND = 0
      DO L = 2, NC
        M = NINT(CON(IAT, L))
        M = MOD(M, NP1)
        CALL GEN048 (-1, IFG(1, M), 23, IVAL)
        CALL GEN048 (-1, IFG(2, M), 28, IVAL1)
        IF (IVAL .NE. 0 .OR. IVAL1 .NE. 0) THEN
          CALL PLA036 ( M, 1, 4, IPOPM, IDUM1, IDUM2, IPR(71), IGBL(55))
          CALL PLA036 (-M, 1, 3, IPOPM, IDUM1, IDUM2, IPR(71), IGBL(55))
          IF (IPOPM .LT. 501) THEN
            IF (IPOPM .LT. 500 .AND. IPR(303) .EQ. 0) CYCLE
            IDSORD = IDISK + 1
          ELSE
            IDSORD = IDISK
          END IF
          ILABM = - LABA(M)
          CALL PLA047 (ILABM, NQ3, MNM, JDUM, IPR(71), IGBL(55),
     1      0, 0)
          CALL PLA046 (-2, NQ3, IENM, LBB, LBC, LBD,
     1                 ILMP, JNQNR, NIEN)
          IF (NIEN .LT. 0) THEN
            NQ1    = NQ3
            IPR(2) = 3
            RETURN
          END IF
          IF (IEL(IEN(IENM)) .NE. 321) THEN
            MPRIM = NIEN
            CALL GEN048 (-6, IFG(1, M), 9, IRESM)
            XMOL3 = MOL(MNM) / PAR(42)
            IF (NINT(XMOL3) .EQ. 1555)
     1        XMOL3 = XMOL3 + IRESM / PAR(42)
            CALL GEN048 (-4, IFG(1, KAT), 15, IVWK)
            CALL GEN048 (-4, IFG(1, IAT), 15, IVWI)
            CALL GEN048 (-4, IFG(1, M), 15, IVWM)
            CALL PLA053 (M, INORM, 0, 0, V6(2), V8(2), ISD(2),
     1                   IDEC(2), IER)
            IF (IER .EQ. 0 .AND. V6(2) .LE. (RADR(IVWI + 1, 2) +
     1        RADR(IVWM + 1, 2) + PAR(9))) THEN
              CALL PLA053 (KAT, INORM, M, 0, V2(1), V3(1),
     1                     ISA(1), IDEC(4), IER)
              IF (IER .EQ. 0 .AND. V2(1) .GE. PAR(10)) THEN
                CALL PLA053 (KAT, M, 0, 0, V6(3), V8(3), ISD(3),
     1                       IDEC(3), IER)
                IF (IER .EQ. 0 .AND. V6(3) .LE. (RADR(IVWK + 1, 2) +
     1            RADR(IVWM + 1, 2) + PAR(8))) THEN
                  ISD(1) = MIN (99, ISD(1))
                  FORM(45:45) = CHAR(ICHAR('0') + IDEC(1))
                  ISD(2) = MIN (99, ISD(2))
                  FORM(61:61) = CHAR(ICHAR('0') + IDEC(2))
                  ISD(3) = MIN (99, ISD(3))
                  FORM(77:77) = CHAR(ICHAR('0') + IDEC(3))
                  ISA(1) = MIN (99, ISA(1))
                  FORM(93:93) = CHAR(ICHAR('0') + IDEC(4))
                  IF (NHEAD .NE. 1) THEN
                    NHEAD = 1
                    IF (IGBL(63) .GT. 2) THEN
                      PAGET = 'H-BONDS'
                      CALL PLA262 (-7)
                      WRITE (LU7, 99999, IOSTAT = IOST)
     1                  PAR(8), PAR(9), PAR(10)
                      WRITE (LU7, 99998, IOSTAT = IOST)
                      WRITE (LU6, 99994, IOSTAT = IOST)
                      IF (IGBL(60) .GT. 0)
     1                  WRITE (LU6, 99995, IOSTAT = IOST)
                      WRITE (LU6, 99996, IOSTAT = IOST)
                    END IF
                  END IF
                  XMOL2 = (1555 * PAR(42) + IRES) / PAR(42)
                  IF (IHB .NE. 0) THEN
                    IPR(88) = IPR(88) + 1
                    IF (IPR(88) .LE. NP2) THEN
                      XLS(1,  IPR(88)) = KAT
                      XLS(2,  IPR(88)) = XMOL2
                      XLS(3,  IPR(88)) = MPRIM
                      XLS(4,  IPR(88)) = XMOL3
                      XLS(8,  IPR(88)) = IDSORD
                      XLS(9,  IPR(88)) = V2(1)
                      XLS(10, IPR(88)) = IAT
                      IATP(KAT)        = IATP(KAT) + 1
                      IFNT(MPRIM)      = IFNT(MPRIM) + 1
                      CALL GEN048 (1, IFG(1, MPRIM), 22, 1)
                    ELSE
                      IPR(149) = IPR(149) + 10000
                    END IF
                  ELSE
                    JCA(MPRIM) = JCA(MPRIM) + 1
                  END IF
                  IF (IRESM .EQ. IRES .AND. MNM .LE. IPR(51)) THEN
                    INTRA = ' Intra'
                  ELSE
                    INTRA = '      '
                  END IF
                  IF (LOOPT .EQ. 2) THEN
                    IF (IDC .EQ. 0 .AND. IGBL(63) .GT. 2) THEN
                      CALL PLA262 (1)
                      VRT = VRT - 0.3
                      WRITE (LU6, 99994, IOSTAT = IOST)
                      WRITE (LU7, 99994, IOSTAT = IOST)
                    END IF
                    IDC = IDC + 1
                  END IF
                  ITLC    = ITLC + 1
                  MP(MNM) = 1
                  IF (INT(XMOL3) .EQ. 1555) THEN
                    CXMOL3 = '         '
                  ELSE
                    WRITE (CXMOL3, 99997, IOSTAT = IOST) XMOL3
                  END IF
                  WRITE (PRBUF, FORM, IOSTAT = IOST) ITLC, INTRA, IRES,
     1              NAMS(1, 1)(1:7), (NAMS(1, L9)(2:8), L9 = 2, 3),
     2              CXMOL3, V6(1), ISD(1), V6(2), ISD(2), V6(3), ISD(3),
     3              V2(1), ISA(1)
                  IF (KAT .NE. KOLD .OR. IAT .NE. IOLD) THEN
                    KOLD  = KAT
                    IOLD  = IAT
                    MPRM  = M
                    MDPRM = 0
                    A0    = V2(1)
                    SA0   = V3(1)
                    GO TO 10
                  END IF
                  CALL PLA053 (MPRM, INORM, M, 0, V2(2),
     1                         V3(2), ISA(2), IDEC(5), IER)
                  IF (IER .EQ. 0) THEN
                    FORMA(1:21)  = '(A,F6.1,''('',I2,'')'',A,'
                    ISA(2) = MIN (99, ISA(2))
                    FORMA(7:7) = CHAR(ICHAR('0') + IDEC(5))
                    IF (V2(2) .GT. 0.1) THEN
                      SUM  = A0 + V2(1) + V2(2)
                      SSUM = SQRT(SA0**2 + V3(1)**2 + V3(2)**2)
                      CALL GEN041 (SUM, SSUM, ISUM, 2, IDEC(7), IPR(68))
                      ISUM = MIN (99, ISUM)
                      IF (ISUM .EQ. 0) IDEC(7) = 0
                      IF (MDPRM .EQ. 0) THEN
                        FORMA(22:41) = '10X,F6.1,''('',I2,'')'')'
                        FORMA(29:29) =  CHAR(ICHAR('0') + IDEC(7))
                        WRITE (PRBUF(91:132), FORMA(1:41),IOSTAT = IOST)
     1                    CHAR(39), V2(2), ISA(2), CHAR(39), SUM, ISUM
                        MDPRM = M
                        SUM4  = V2(1)
                        SSUM4 = V3(1)**2
                        GO TO 10
                      END IF
                      FORMA(22:37) = 'F6.1,''('',I2,'')'','
                      FORMA(38:70) = FORMA(22:37)//FORMA(22:37)//')'
                      CALL PLA053 (MDPRM, INORM, M, 0,
     1                  V2(3), V3(3), ISA(3), IDEC(6), IER)
                      IF (IER .NE. 0) CYCLE
                      ISA(3) = MIN (99, ISA(3))
                      IF (ISA(3) .EQ. 0) IDEC(6) = 0
                      FORMA(25:25) = CHAR(ICHAR('0') + IDEC(6))
                      FORMA(41:41) = CHAR(ICHAR('0') + IDEC(7))
                      IF (V2(3) .GT. 0.1) THEN
                        SUM4  = SUM4 + V2(1) + V2(3)
                        SSUM4 = SQRT(SSUM4 + V3(1)**2 + V3(3)**2)
                        CALL GEN041 (SUM4, SSUM4, ISUM4,
     1                    2, IDEC(8), IPR(68))
                        ISUM4 = MIN (99, ISUM4)
                        IF (ISUM4 .EQ. 0) IDEC(8) = 0
                        FORMA(57:57) = CHAR(ICHAR('0') + IDEC(8))
                        WRITE (PRBUF(91:132), FORMA, IOSTAT = IOST)
     1                    CHAR(34), V2(2), ISA(2), CHAR(34), V2(3),
     2                    ISA(3), SUM, ISUM, SUM4, ISUM4
                        GO TO 10
                      END IF
                    END IF
                    ITLC = ITLC - 1
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
        CYCLE
   10   IF (IGBL(63) .GT. 2) THEN
          CALL PLA263 (LU7, PRBUF, 132, 1, 3)
          IF (IWIN .EQ. 1) THEN
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF(12:90), 79, 0.35, 1, 2, 1.0, VRT)
            NTEL = NTEL + 1
          END IF
          WRITE (LU6, 99993, IOSTAT = IOST) PRBUF(12:90)
        END IF
        IF (IPR(438) .EQ. 1) THEN
          IPR(452) = IPR(452) + 1
          WRITE (LU2, 99992, IOSTAT = IOST)
     1      (NAMS(1, L9)(2:8), L9 = 1, 2), NAMS(1, 4)(2:8), V6(1),
     2      V8(1), V6(2), V8(2), V6(3), V8(3), V2(1), V3(1), LABA(M)
        END IF
        NFOUND = NFOUND + 1
      END DO
      RETURN
99999 FORMAT ('Analysis of Potential Hydrogen Bonds and Schemes with ',
     1 'd(D...A) < R(D)+R(A)+0', F3.2, ', d(H...A) < R(H)+R(A)',
     2 F5.2, ' Ang., D-H...A >', F6.1, ' Deg', /,
     3 132('='), /, 'Note: - ARU codes in [] are with reference to',
     4 ' the Coordinates printed above (Possibly transformed, when',
     5 ' MOVE .NE. 1.555)', /, 132('='), /)
99998 FORMAT ('Nr Typ Res Donor --- H....Acceptor [    ARU  ]', 6X,
     1 'D - H', 6X, 'H...A', 6X, 'D...A', 2X, 'D - H...A', 4X, 'A..H',
     2 '..A*', 1X, 'A''..H..A" Sum(XY,YZ)  Sum(XZ)', /, 132('-'))
99997 FORMAT (F9.2)
99996 FORMAT ('Donor --- H....Acceptor [    ARU  ]', 6X,
     1 'D - H', 6X, 'H...A', 6X, 'D...A', 2X, 'D - H...A')
99995 FORMAT ('Input Atoms Moved')
99994 FORMAT (1X)
99993 FORMAT (A)
99992 FORMAT ('HBON ', 3(A, ' '), 4F8.4, ' = ', /,
     1        5X, 2F10.4, 2F10.2, I12)
      END SUBROUTINE PLA090
      SUBROUTINE PLA091 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON // JNSC(2 * NP23), VOID(NVD)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER IDS1*1, IDS2*1, FORMI*58, FORMJ*31, FORMK*16
      DIMENSION NRESCNT(64)
      FORMI( 1:40) = '(I4,6X,2A,''['',F9.2,''] ... '',2A,''['',F9.2,'
      FORMI(41:58) = ' ''] = '',F6.3,F7.2)'
      FORMJ( 1:31) = '(I2,I3,F9.2,''  -- '',11(F9.2,A))'
      FORMK( 1:16) = '(19X,11(F9.2,A))'
C * MODE = 0 - HYDROGEN BONDED AGGREGATE ANALYSIS
C * MODE = 1 - SHORT INTER CONTACT CLUSTER ANALYSIS
      ITL = IPR(88)
      IF (ITL .GT. 0) THEN
        NR1   = 0
        NS1   = 0
        NT11  = 0
        NT12  = 0
        NT13  = 0
        IAGGP = 0
        NRES  = IPR(75)
        NINTRES = IPR(51)
        NSYM  = IPR(48)
        NTOP  = IPR(299)
        CALL GEN074 (VOID, NTOP + 1, 100000, 0.0)
        CALL GEN074 (DATC, 1, NP1, 0.0)
        CALL GEN097 (JR  , 1, NP1, 0)
        IARU  = NINT(PAR(42))
        IF (IARU .LT. 100) THEN
          FORMI(18:18) = '1'
          FORMI(39:39) = '1'
          FORMJ(11:11) = '1'
          FORMJ(27:27) = '1'
          FORMK(12:12) = '1'
        END IF
C * GENERATE COMPLETE LIST OF ASYMMETRIC RESIDUES IN UNIT CELL
        NARU = 0
        DO J = 1, NSYM
          DO I = 1, NRES
            IF (NARU .LT. NP1) THEN
              NARU       = NARU + 1
              IATP(NARU) = (J * 1000 + 555) * IARU + I
            ELSE
              IF (LU6 .NE. 0) WRITE (LU6, 99985, IOSTAT = IOST)
              RETURN
            END IF
          END DO
        END DO
C * TEST FOR H-BOND CASE (MODE = 0)
        IF (MODE .EQ. 0) THEN
          CALL PLA094 (-3, 0, 0, 0, 0, 0)
          ITL2 = ITL * 2
          IF (ITL2 .LE. NP2) THEN
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (0)
              IF (IGBL(63) .GT. 3) THEN
                CALL PLA262 (10)
                WRITE (LU7, 99999, IOSTAT = IOST)
                WRITE (LU7, 99990, IOSTAT = IOST)
              END IF
            END IF
            DO I = 1, ITL
              IATC(I)         = 1
              XLS(5, I)       = MOD(NINT(XLS(2, I) * IARU), IARU)
              MR1             = MOD(NINT(XLS(4, I) * IARU), IARU)
              XLS(5, ITL + I) = MR1
              XLS(9, ITL + I) = XLS(9, I)
              CALL PLA270 (XLS(4, I), 0.0, XLS(2, ITL + I))
              IF (IPR(2) .EQ. 0) THEN
                CALL PLA270 (XLS(2, ITL + I), XLS(2, I),
     1                       XLS(4, ITL + I))
                IF (IPR(2) .EQ. 0) THEN
                  XLS(2, ITL + I) = (1555 * PAR(42) + MR1) / PAR(42)
                  J               = NINT(XLS(1, I))
                  K               = NINT(XLS(3, I))
                  XLS(1, ITL + I) = K
                  XLS(3, ITL + I) = J
                  IDSORD = NINT(XLS(8, I))
                  IF (IDSORD .EQ. 10) THEN
                    IDISO = 1
                  ELSE IF (IDSORD .EQ. 1) THEN
                    IDISO = 10
                  ELSE
                    IDISO = IDSORD
                  END IF
                  XLS(8, ITL + I) = IDISO
                  CALL PLA093 (I, J, K, 1)
                  CALL PLA093 (ITL + I, K, J, -1)
                ELSE
                  IF (LU6 .NE. 0) WRITE (LU6, 99985, IOSTAT = IOST)
                  RETURN
                ENDIF
              ELSE
                IF (LU6 .NE. 0) WRITE (LU6, 99985, IOSTAT = IOST)
                RETURN
              END IF
            END DO
          ELSE
            IF (LU6 .NE. 0) WRITE (LU6, 99989, IOSTAT = IOST)
            RETURN
          END IF
C * SHORT INTER CONTACT MODE = 1
        ELSE
          CALL PLA094 (-2, 0, 0, 0, 0, 0)
          ITL2 = ITL
          IF (IGBL(63) .GT. 2) CALL PLA262 (0)
          IF (IGBL(63) .GT. 3) THEN
            CALL PLA262 (5)
            WRITE (LU7, 99992, IOSTAT = IOST)
          END IF
          DO I = 1, ITL
            IDSORD = NINT(XLS(8, I))
            IF (IDSORD / 10 .EQ. 1) THEN
              IDS1 = '*'
            ELSE
              IDS1 = ' '
            END IF
            IF (MOD(IDSORD, 10) .EQ. 1) THEN
              IDS2 = '*'
            ELSE
              IDS2 = ' '
            END IF
            LABN1 =  LABA(NINT(XLS(1, I)))
            LABN3 = -LABA(NINT(XLS(3, I)))
            CALL PLA047 (LABN1, NQ1, IDUM, JDUM, IPR(71),
     1        IGBL(55), 0, 0)
            CALL PLA047 (LABN3, NQ2, IDUM, JDUM, IPR(71),
     1        IGBL(55), 0, 0)
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (1)
              WRITE (LU7, FORMI, IOSTAT = IOST)
     1          I, IDS1, NQ1(1:6), XLS(2, I), IDS2,
     2          NQ2(1:6), XLS(4, I), XLS(6, I), XLS(7, I)
            END IF
          END DO
        END IF
        IAGG = 0
        L0   = 1
        NADD = 25
        DO I = 1, NARU
          N1   = 0
          LMX  = 1
          DMOL = IATP(I) / PAR(42)
          VOID(NTOP + (I - 1) * NADD + 1)  = DMOL
          VOID(NTOP + (I - 1) * NADD + 25) = 0.0
          CALL GEN098 (IATP(I), PAR(42), MS1, MT1, MT2, MT3, MR0)
          IF (NINTRES .GT. 1) THEN
            DO K = 2, NINTRES
              ML = MOL(K)
              IF (MOD(ML, IARU) .EQ. MR0) THEN
                XMOL1 = ML / PAR(42)
                CALL PLA270 (DMOL, XMOL1, XMOL2)
                IF (IPR(2) .EQ. 0) THEN
                  LMX = LMX + 1
                  VOID(NTOP + (I - 1) * NADD + LMX) = XMOL2
                  MLX = NINT (XMOL2 * PAR(42))
                  CALL GEN098 (MLX, PAR(42), MSX1, MTX1, MTX2, MTX3,
     1              MRX0)
                  IF (MSX1 .EQ. MS1) THEN
                    MTX1 = MTX1 - MT1
                    MTX2 = MTX2 - MT2
                    MTX3 = MTX3 - MT3
                    CALL PLA094 (1, MTX1, MTX2, MTX3, 0 , 0)
                    IFNT(LMX) = ICHAR('#')
                  ELSE
                    IFNT(LMX) = ICHAR('*')
                  END IF
                ELSE
                  IF (LU6 .NE. 0) WRITE (LU6, 99985, IOSTAT = IOST)
                  RETURN
                END IF
              END IF
            END DO
          END IF
          IF (L0 .LE. I) THEN
            IAGGP = 1
            L0    = L0 + 1
            IF (NINTRES .GT. 1) THEN
              DO K = 2, NINTRES
                ML = MOL(K)
                IF (MOD(ML, IARU) .EQ. MR0) THEN
                  XMOL1 = ML / PAR(42)
                  DMOL =  VOID(NTOP + (I - 1) * NADD + 1)
                  CALL PLA270 (DMOL, XMOL1, XMOL2)
                  IF (IPR(2) .EQ. 0) THEN
                    MOL1 = INT(XMOL2 / 1000.0)
                    ML   = NINT(XMOL2 * PAR(42))
                    NMOL = MOL1 * 1000 * IARU + 555 * IARU + MR0
                    DO L = L0, NARU
                      IF (IATP(L) .EQ. NMOL) THEN
                        IATP(L)  = IATP(L0)
                        IATP(L0) = ML
                        L0       = L0 + 1
                        EXIT
                      END IF
                    END DO
                  ELSE
                    IF (LU6 .NE. 0) WRITE (LU6, 99985, IOSTAT = IOST)
                    RETURN
                  END IF
                END IF
              END DO
            END IF
          END IF
          DO 10 K = 1, ITL2
            N = NINT(XLS(5, K))
            IF (MR0 .EQ. N) THEN
              CALL PLA270 (DMOL, XLS(4, K), XMOL)
              IF (IPR(2) .EQ. 0) THEN
                N1 = N1 + 1
                DO L = 1, LMX
                  DMOLL = VOID(NTOP + (I - 1) * NADD + L)
                  IF (NINT((DMOLL - XMOL) * PAR(42)) .EQ. 0) THEN
                    IF (L .EQ. 1) N1 = N1 - 1
                    GO TO 10
                  END IF
                END DO
                LMX = LMX + 1
                VOID(NTOP + (I - 1) * NADD + LMX) = XMOL
                IFNT(LMX) = ICHAR(' ')
                NMOL      = NINT(XMOL * PAR(42))
                CALL GEN098 (NMOL, PAR(42), MS2, MT21, MT22, MT23, MR2)
                DO L = 1, NARU
                  CALL GEN098 (IATP(L), PAR(42), MS1, MT11, MT12,
     1               MT13, MR1)
                  IF (MS2 .EQ. MS1 .AND. MR2 .EQ. MR1) THEN
                    IF (L .LT. L0) THEN
                      MD1 = MT21 - MT11
                      MD2 = MT22 - MT12
                      MD3 = MT23 - MT13
                      IF (IABS(MD1) + IABS(MD2) + IABS(MD3) .GT. 0)
     1                  THEN
                        CALL PLA094 (1, MD1, MD2, MD3,   0 , 0)
                        IFNT(LMX) = ICHAR('T')
                      END IF
                    ELSE
                      IATP(L)  = IATP(L0)
                      IATP(L0) = NMOL
                      L0       = L0 + 1
                      IF (NINTRES .GT. 1) THEN
                        DO K2 = 2, NINTRES
                          ML = MOL(K2)
                          IF (MOD(ML, IARU) .EQ. MR2) THEN
                            XMOL1 = ML / PAR(42)
                            CALL PLA270 (XMOL, XMOL1, XMOL2)
                            IF (IPR(2) .EQ. 0) THEN
                              MOL2  = INT(XMOL2 / 1000.0)
                              NMOL2 = (MOL2 * 1000 + 555) * IARU + MR2
                              DO L2 = L0, NARU
                                IF (IATP(L2) .EQ. NMOL2) THEN
                                  IATP(L2) = IATP(L0)
                                  IATP(L0) = NINT(XMOL2 * PAR(42))
                                  L0       = L0 + 1
                                  EXIT
                                END IF
                              END DO
                            ELSE
                              IF (LU6 .NE. 0)
     1                          WRITE (LU6, 99985, IOSTAT = IOST)
                              RETURN
                            END IF
                          END IF
                        END DO
                      END IF
                    END IF
                  END IF
                END DO
              ELSE
                IF (LU6 .NE. 0) WRITE (LU6, 99985, IOSTAT = IOST)
                RETURN
              END IF
            END IF
   10     CONTINUE
          M1 = LMX - 1
          IF (M1 .GT. 0) THEN
            IF (IAGGP .GT. 0) THEN
              IAGG  = IAGG + 1
              IF (IGBL(63) .GT. 2) THEN
                CALL PLA262 (7)
                IF (MODE .EQ. 0) THEN
                  WRITE (LU7, 99998, IOSTAT = IOST)
     1            ' Aggregate =', IAGG
                  WRITE (LU7, 99997, IOSTAT = IOST)
                ELSE
                  WRITE (LU7, 99998, IOSTAT = IOST)
     1              '  Cluster  =', IAGG
                  WRITE (LU7, 99995, IOSTAT = IOST)
                END IF
              END IF
              IAGGP = 0
            END IF
            IF (LMX .GT. 12) THEN
              LMZ = 12
            ELSE
              LMZ = LMX
            END IF
            NTP = NTOP + (I - 1) * NADD
            VOID(NTP + 25) = LMX
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (1)
              WRITE (LU7, FORMJ, IOSTAT = IOST) N1, M1, VOID(NTP + 1),
     1          (VOID(NTP + L), CHAR(IFNT(L)), L = 2, LMZ)
            END IF
            IF (LMX .GT. 12) THEN
              LMB = 2
              DO
                LMB = LMB + 11
                LMZ = LMB + 10
                IF (LMZ .GT. LMX) LMZ = LMX
                IF (IGBL(63) .GT. 2) THEN
                  CALL PLA262 (1)
                NTP = NTOP + (I - 1) * NADD
                  WRITE (LU7, FORMK, IOSTAT = IOST)
     1                  (VOID(NTP + L), CHAR(IFNT(L)), L = LMB, LMZ)
                END IF
                IF (LMZ .GE. LMX) EXIT
              END DO
            END IF
          END IF
        END DO
        CALL PLA094 (0, 0, 0, 0, 0, IAGG)
C * SEARCH FOR ARU-CIRCUITS AND CHAINS
        IF (MODE .EQ. 0 .AND. IGBL(63) .GT. 2) THEN
          NCIR = 0
          NCHN = 0
          N1   = 1
          N2   = 2
          MCIR = IPR(66)
          IF (MCIR .EQ. 0) N1 = 2
          MCHN = IPR(82)
          IF (MCHN .EQ. 0) N2 = 1
          IF (N2 .GE. N1) THEN
            DO N3 = N1, N2
              IF (N3 .EQ. 1) THEN
                MC   = MCIR
                NCRA = 0
              ELSE
                MC   = MCHN
                NCRA = NCIR + 1
              END IF
              DO 80 NR = 1, NRES
                DO I = 1, NARU
                  IF (MOD(IATP(I), IARU) .EQ. NR) EXIT
                END DO
                NRT       = 1
                L0        = NARU
                KDATC     = I
   20           JR(NRT)   = NTOP + (KDATC - 1) * NADD
                DATC(NRT) = VOID(JR(NRT) + 1)
                IF (NRT .GT. 2) THEN
                  MDATCNRT = NINT (DATC(NRT) * PAR(42))
                  DO K = 2, NRT - 1
                    IF (MDATCNRT .EQ. NINT (DATC(K) * PAR(42))) THEN
                      NRT = NRT - 1
                      GO TO 60
                    END IF
                  END DO
                END IF
                IF (NRT .GT. 1) THEN
                  MOL2 = NINT(DATC(NRT) * PAR(42))
                  CALL GEN098 (MOL2, PAR(42), NS2, NT21, NT22, NT23,
     1                         NR2)
                  IF (NS1 .EQ. NS2 .AND. NR1 .EQ. NR2) THEN
                    ND1 = NT21 - NT11
                    ND2 = NT22 - NT12
                    ND3 = NT23 - NT13
                    ND123 = IABS(ND1) + IABS(ND2) + IABS(ND3)
                    IF (N3 .EQ. 1) THEN
                      IF (ND123 .NE. 0) GO TO 50
                    ELSE
                      IF (ND123 .EQ. 0 .OR. NRT .GT. MCHN) GO TO 50
                    END IF
                    DO K = 1, NRT
                      JNSC(NCIR * 100 + K) = NINT(DATC(K) * PAR(42))
                    END DO
                    IF (NCIR .GT. NCRA) THEN
                      DO J = NCRA, NCIR - 1
                        DO 40 K0 = 1, NRT - 1
                          DO K = 1, NRT - 1
                            KK0 = MOD(K + K0 - 2, NRT - 1) + 1
                            IF (JNSC(NCIR * 100 + KK0) .NE.
     1                          JNSC(J * 100 + K)) GO TO 30
                          END DO
                          NRT = NRT - 1
                          GO TO 60
   30                     DO K = 1, NRT - 1
                            KK0 = MOD(K + K0 - 2, NRT - 1) + 1
                            IF (JNSC(NCIR * 100 + NRT - KK0) .NE.
     1                          JNSC(J * 100 + K)) GO TO 40
                          END DO
                          NRT = NRT - 1
                          GO TO 60
   40                   CONTINUE
                      END DO
                    END IF
                    IF (N3 .EQ. 1) THEN
                      NCIR = NCIR + 1
                      IF (NCIR .EQ. 1) THEN
                        CALL PLA262 (0)
                        CALL PLA262 (2)
                        WRITE (LU7, 99996, IOSTAT = IOST) MCIR - 1
                      ELSE IF ((NCIR + 1) * 100 .GT. 2.0 * NP23
     1                     .OR. NCIR .GT. 29) THEN
                        CALL PLA262 (4)
                        WRITE (LU7, 99988, IOSTAT = IOST)
                        GO TO 90
                      END IF
                    ELSE IF (N3 .EQ. 2) THEN
                      NCHN = NCHN + 1
                      IF (NCHN .EQ. 1) THEN
                        CALL PLA262 (0)
                        CALL PLA262 (2)
                        WRITE (LU7, 99986, IOSTAT = IOST) MCHN - 1
                      ELSE IF ((NCHN + 1) * 100 .GT. 2.0 * NP23
     1                     .OR. NCHN .GT. 29) THEN
                        CALL PLA262 (4)
                        WRITE (LU7, 99988, IOSTAT = IOST)
                        GO TO 90
                      END IF
                    ENDIF
                    CALL PLA262 (3 + NRT / 14)
                    IF (ND123 .EQ. 0) THEN
                      CALL GEN097 (NRESCNT, 1, 64, 0)
                      DO K = 1, NRT - 1
                        IYUNK = MOD (NINT (DATC(K) * IARU), IARU)
                        NRESCNT(IYUNK) = NRESCNT(IYUNK) + 1
                      END DO
                      KKMAX = MIN (30, IPR(75))
                      WRITE (LU7, 99993, IOSTAT = IOST) NRT - 1,
     1                  (NRESCNT(K), K = 1, KKMAX)
                      WRITE (LU7, 99991, IOSTAT = IOST)
     1                  (DATC(K), K = 1, NRT)
                    ELSE
                      WRITE (LU7, 99994, IOSTAT = IOST)
     1                  NRT - 1, ND1, ND2, ND3
                      WRITE (LU7, 99991, IOSTAT = IOST)
     1                  (DATC(K), K = 1, NRT)
                    END IF
                    NRT = NRT - 1
                    GO TO 60
                  END IF
                ELSE
                  MOL1 = NINT(DATC(1) * PAR(42))
                  CALL GEN098 (MOL1, PAR(42), NS1, NT11, NT12, NT13,
     1                         NR1)
                END IF
   50           NCN(NRT) = NINT(VOID(JR(NRT) + 25))
                IF (NRT .EQ. 1) THEN
                  IF (NCN(1) .LT. 3) GO TO 80
                END IF
                IF (NRT .LT. MC) THEN
                  NRT       = NRT + 1
                  JLN(NRT)  = 1
                END IF
   60           IF (NRT .GT. 1) THEN
                  JLN(NRT)  = JLN(NRT) + 1
                  IF (JLN(NRT) .GT. NCN(NRT - 1)) THEN
                    NRT = NRT - 1
                    IF (NRT .GT. 1) GO TO 60
                    GO TO 80
                  END IF
                  XMOL = VOID(JR(NRT - 1) + JLN(NRT))
                  IF (NRT .GT. 2) THEN
                    IF (XMOL .EQ. DATC(NRT - 2)) GO TO 60
                  END IF
                  NMOL = NINT(XMOL * PAR(42))
                  CALL GEN098 (NMOL, PAR(42), MS2, MT21, MT22, MT23,
     1                         MR2)
                  DO 70 L = 1, NARU
                    CALL GEN098 (IATP(L), PAR(42), MS1, MT11, MT12,
     1                           MT13, MR1)
                    IF (MS2 .EQ. MS1 .AND. MR2 .EQ. MR1) THEN
                      MD1 = MT21 - MT11
                      MD2 = MT22 - MT12
                      MD3 = MT23 - MT13
                      IF (IABS(MD1) + IABS(MD2) + IABS(MD3) .NE. 0) THEN
                        NAD   = MD1 * 100 + MD2 * 10 + MD3
                        IYUNK = IATP(L) + NAD * 100
                        DO K = 1, L0
                          IF (IATP(K) .EQ. IYUNK) THEN
                            KDATC = K
                            GO TO 70
                          END IF
                        END DO
                        IF (L0 .LT. NP1) THEN
                          L0       = L0 + 1
                          IATP(L0) = IYUNK
                          N0     = INT(VOID(NTOP + (L - 1) * NADD + 25))
                          VOID(NTOP + (L0 - 1) * NADD + 25) = N0
                          DO N = 1, N0
                            MOLY = NINT(VOID(NTOP + (L  - 1) * NADD + N)
     1                         * PAR(42))
                            CALL GEN098 (MOLY, PAR(42), MS3, MT31, MT32,
     1                                 MT33, MR3)
                            MT31 = MT31 + MD1
                            IF (MT31 .LT. -5 .OR. MT31 .GT. 4) GO TO 60
                            MT32 = MT32 + MD2
                            IF (MT32 .LT. -5 .OR. MT32 .GT. 4) GO TO 60
                            MT33 = MT33 + MD3
                            IF (MT33 .LT. -5 .OR. MT33 .GT. 4) GO TO 60
                            VOID(NTOP + (L0 - 1) * NADD + N) =
     1                      VOID(NTOP + (L  - 1) * NADD + N) + NAD
                          END DO
                          KDATC = L0
                        ELSE
                          WRITE (LU6, 99987, IOSTAT = IOST)
                          GO TO 80
                        END IF
                      ELSE
                        KDATC = L
                      END IF
                    END IF
   70             CONTINUE
                  GO TO 20
                END IF
   80         CONTINUE
   90         CONTINUE
            END DO
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT ('Analysis of Hydrogen Bonded Molecular Aggregates',
     1 ' (See also Acta Cryst. B36, 1980, 2113 - 2115)',
     2 ' -- (Major Disorder Component Only)', /, 132('='), /)
99998 FORMAT (/, 57X, 14('='), /, 56('*'), A, I3,
     1 1X, 60('*'), /, 57X, 14('='), /)
99997 FORMAT ('(N:M)  :  ARU   --    Connected with N Hydrogen Bonds',
     1 ' to/from M ARU(S).', 4X, 'T = Translated Molecule (Infinite',
     2 ' chain etc.)', /, 132('-'))
99996 FORMAT ('Search for ARU-Circuits (Max =', I3, ' Membered)', /,
     1 132('='))
99995 FORMAT ('(N:M)  :  ARU   --    Connected  with (N) Interactions',
     1 ' to/from (M) ARU(S).', 4X, 'T = Translated Molecule (Infinite',
     2 ' chain etc.)', /, 132('-'))
99994 FORMAT (/, I3, '-Membered Infinite ARU-Chain (Translation [',
     1        3I3, '])')
99993 FORMAT (/, I3, '-Membered ARU-Circuit - ResCount - ',
     1        30(I2, ','))
99992 FORMAT ('Analysis of Short Non-Hydrogen Inter-Molecular',
     1 ' Contacts For Inter-Molecular Clusters and/or Networks',
     2   3X,'(Minor Disorder Excluded)', /, 132('='), //,
     3 'Contact-Nr Atom I[   ARU   ]', 6X, 'Atom J[   ARU   ]', 4X,
     4 'd(I-J)', 3X, 'Del', /, 132('-'))
99991 FORMAT (14F9.2)
99990 FORMAT (/, 20X, 'Coordinates of Donor and Acceptor Atoms', 32X,
     1 'Coordinates of D/A-Bonded Atom(s)', /, 20X, 39('='), 32X,
     2 33('='), //, '  D/A I  [    ARU  ]      X      Y      Z   --',
     3 '  D/A J  [    ARU  ]      X      Y      Z', 3X,
     4 'Atom K     X      Y      Z   I..J--K Angle', /, 132('-'))
99989 FORMAT (':: Too Many Interactions for Aggregate Analysis', /)
99988 FORMAT (//, '*** etc, etc, etc ..  ***', /)
99987 FORMAT (/, ':: Search Aborted - Storage Overflow')
99986 FORMAT ('Search for Infinite ARU-Chains (Max =', I3, ')', /,
     1        132('='))
99985 FORMAT ('Error in PLA091')
      END SUBROUTINE PLA091
      SUBROUTINE PLA092
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER IDS1*1, IDS2*1, IYA*1, COPT*5
      ITL = IPR(88)
      IF (ITL .EQ. 0) GO TO 180
      MXLSP = NP2
      CALL PLA094 (-3, 0, 0, 0, 0, 0)
      MXRING = IPR(218)
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (-3)
        WRITE (LU7, 99998, IOSTAT = IOST) MXRING
      END IF
      NETW = 0
      L0   = 0
      KAT  = IPR(39) + IPR(24) + 1
      JAT  = KAT + 1
      IAT  = JAT + 1
      I    = 0
   10 I    = I + 1
      IF (I .GT. ITL) GO TO 120
      LFORW = 1
      IF (L0 .LE. I) THEN
        L0 = 0
        DO J = I, ITL
          IF (IATC(J) .GT. 0) THEN
            L1 = NINT(XLS(1, J))
            CALL GEN048 (-1, IFG(1, L1), 22, IA)
            IF (IA .EQ. 0) GO TO 20
            IF (L0 .EQ. 0) L0 = J
          END IF
        END DO
        IF (L0 .EQ. 0) THEN
          GO TO 120
        ELSE
          J = L0
        END IF
   20   CALL PLA094 (0, 0, 0, 0, 0, 0)
        NETW = NETW + 1
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (7)
          WRITE (LU7, 99997, IOSTAT = IOST) NETW
          WRITE (LU7, 99996, IOSTAT = IOST)
        END IF
        J0    = J
        L0    = I
        XLSI3 = XLS(1, J0)
        XLSI4 = XLS(2, J0)
        JMX   = 99
        GO TO 40
      END IF
   30 IF (XLS(8, I) .LE. 0) THEN
        J0        = I
        LFORW     = -1
        XLS(8, I) = 1
        XLSI3     = XLS(1, J0)
        XLSI4     = XLS(2, J0)
        JMX       = 99
        GO TO 40
      END IF
      XLSI2 = XLS(2, I)
      XLSI3 = XLS(3, I)
      XLSI4 = XLS(4, I)
      M     = NINT(XLS(1, I))
      N     = NINT(XLSI3)
      NH    = NINT(XLS(10, I))
      CALL PLA047 (LABA(M),  NQ1, IDUM, JDUM, IPR(71), IGBL(55),
     1  0, 0)
      CALL PLA047 (LABA(N),  NQ2, IDUM, JDUM, IPR(71), IGBL(55),
     1  0, 0)
      CALL PLA047 (LABA(NH), NQ3, IDUM, JDUM, IPR(71), IGBL(55),
     1  0, 0)
      CALL GEN048 (-7, IFG(2, M), 1, IDIS1)
      IPOPM = IPPR(IDIS1 + 1, 1)
      IF (IPOPM .LT. 1000) THEN
        IDS1 = '*'
      ELSE
        IDS1 = ' '
      END IF
      CALL GEN048 (-7, IFG(2, N), 1, IDIS2)
      IPOPN = IPPR(IDIS2 + 1, 1)
      IF (IPOPN .LT. 1000) THEN
        IDS2 = '*'
      ELSE
        IDS2 = ' '
      END IF
      MS1 = NINT(XLSI2 * PAR(42))
      CALL GEN098 (MS1, PAR(42), IPR(54), ITR(1), ITR(2), ITR(3), IML)
      CALL PLA059 (M,  KAT)
      CALL PLA059 (NH, IAT)
      MS2 = NINT(XLSI4 * PAR(42))
      CALL GEN098 (MS2, PAR(42), IPR(54), ITR(1), ITR(2), ITR(3), IML)
      CALL PLA059 (N, JAT)
      CALL GEN048 (-1, IFG(1, M), 22, IA)
      IF (IA .EQ. 1) THEN
        IYA = 'A'
      ELSE
        IYA = ' '
      END IF
      JMX = 4
   40 K = 0
   50 K = K + 1
      IF (K .GT. ITL) GO TO 100
      IF (IATC(K) .NE. 0) THEN
        IF (XLS(1, K) .EQ. XLSI3) THEN
          IHBD = 1
          CALL PLA270 (XLS(2, K), 0.0, XLSK2)
          IF (IPR(2) .NE. 0) GO TO 180
          CALL PLA270 (XLSK2, XLS(4, K), XLSK4)
          IF (IPR(2) .NE. 0) GO TO 180
          CALL PLA270 (XLSI4, XLSK4, XLS4)
          IF (IPR(2) .NE. 0) GO TO 180
          XLS2 = XLSI4
          GO TO 60
        END IF
        IF (K .NE. I) THEN
          IF (NINT(XLS(3, K)) .EQ. NINT(XLSI3)) THEN
            IHBD = -1
            CALL PLA270 (XLS(4, K), 0.0, XLSK4)
            IF (IPR(2) .NE. 0) GO TO 180
            CALL PLA270 (XLSK4, XLS(2, K), XLSK2)
            IF (IPR(2) .NE. 0) GO TO 180
            CALL PLA270 (XLSI4, XLSK2, XLS2)
            IF (IPR(2) .NE. 0) GO TO 180
            XLS4 = XLSI4
            GO TO 60
          END IF
        END IF
      END IF
      GO TO 50
   60 XML = K + 0.555
      L = L0
   70 L = L - 1
      IF (L .NE. 0) THEN
        IF (XLS(1, L) .NE. XLS(1, K)) GO TO 70
        IF (XLS(3, L) .NE. XLS(3, K)) GO TO 70
        ID1 = INT(XLS2)
        ID2 = INT(XLS(2, L))
        IF (ID1 / 1000 .NE. ID2 / 1000) GO TO 70
        IDF1 = ID1 - ID2
        ID3  = INT(XLS4)
        ID4  = INT(XLS(4, L))
        IF (ID3 / 1000 .NE. ID4 / 1000) GO TO 70
        IDF2 = ID3 - ID4
        IF (IDF1 .NE. IDF2) GO TO 70
        XML = L + (IDF1 + 555) / 1000.0
        IF (IDF1 .EQ. 0) THEN
          IF (LFORW .GT. 0) THEN
             IXPVJ = 82
          ELSE
             IXPVJ = 32
          END IF
        ELSE
          IXPVJ = 84
          IDFX  = IDF1 + 555
          MD1   = IDFX / 100
          IDFX  = IDFX - MD1 * 100
          MD1   = MD1 - 5
          MD2   = IDFX / 10
          MD3   = IDFX - MD2 * 10 - 5
          MD2   = MD2 - 5
          CALL PLA094 (1, MD1, MD2, MD3, IML, 0)
        END IF
        GO TO 90
      END IF
      IXPVJ  = 32
      IATCK  = IATC(K)
      IATCL0 = 0
      IF (IATCK .GE. 0) THEN
        IATCL0 = -1
        IATCK  = 0
      END IF
      IATCTL = IATC(L0)
      IF (L0 .EQ. K) IATCTL = 0
      IF (ITL .EQ. MXLSP) GO TO 50
      ITL = ITL + 1
      DO J = 1, 10
        XLS(J, ITL) = XLS(J, L0)
      END DO
      IATC(K)     = IATCK
      IATC(ITL)   = IATCTL
      IATC(L0)    = IATCL0
      XLS(1,  L0) = XLS(1, K)
      XLS(3,  L0) = XLS(3, K)
      XLS(2,  L0) = XLS2
      XLS(4,  L0) = XLS4
      XLS(5,  L0) = 0.0
      XLS(6,  L0) = 0.0
      XLS(7,  L0) = 0.0
      XLS(8,  L0) = IHBD
      XLS(9,  L0) = XLS(9, K)
      XLS(10, L0) = XLS(10, K)
      XML        = L0 + 0.555
      L0         = L0 + 1
      IF (L0 .GT. ITL) GO TO 90
      IF (IATCTL  .EQ. 0) GO TO 80
      IF (IATC(K) .NE. 0) GO TO 90
      DO J = 1, 10
         XLS(J, K) = XLS(J, ITL)
      END DO
      IATC(K) = IATC(ITL)
   80 ITL     = ITL - 1
   90 IF (JMX  .GT. 7) GO TO 50
      IF (IHBD .LT. 0) GO TO 50
      JMX         = JMX + 1
      XLS(JMX, I) = XML
      IXPV(JMX)   = IXPVJ
      GO TO 50
  100 IF (JMX .EQ. 99) GO TO 30
      YI   = I + 0.555
      JMX0 = JMX
      IF (JMX0 .GT. 7) JMX0 = 7
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (2)
        WRITE (LU7, 99995, IOSTAT = IOST)
     1    YI, IYA, IDS1, NQ1(1:6), XLSI2,
     2    (XXO(KAT, J), J = 1, 3),  IDS2, NQ2(1:6), XLS(4, I),
     3    (XXO(JAT, J), J = 1, 3),
     4    (XLS(J, I), CHAR(IXPV(J)), J = 5, JMX0)
        WRITE (LU7, 99993, IOSTAT = IOST) NQ3, (XXO(IAT, J), J = 1, 3)
      END IF
  110 IF (JMX0 .LT. JMX) THEN
        JMXB = JMX0 + 1
        JMX0 = JMX
        IF (JMX0 .GT. JMXB + 2) JMX0 = JMXB + 2
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99994, IOSTAT = IOST)
     1      (XLS(J, I), CHAR(IXPV(J)), J = JMXB, JMX0)
        END IF
        GO TO 110
      END IF
      GO TO 10
  120 CALL PLA094 (0, 0, 0, 0, 0, 0)
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (9)
        WRITE (LU7, 99999, IOSTAT = IOST)
      END IF
      IPR(224) = ITL
      NRRING = 0
      KAT    = IPR(39) + IPR(24)
      NRTM     = MXRING + 1
      DO 170 J = 1, ITL
        JAT = NINT(XLS(1, J))
        CALL GEN048 (-1, IFG(1, JAT), 22, IA)
        IF (IA .GT. 0) THEN
          JR(1) = J * 1000 + 555
          ML    = NINT(XLS(2, J) * PAR(42))
          CALL GEN098 (ML, PAR(42), IPR(54), ITR(1), ITR(2), ITR(3),
     1                 MR1)
          JRAT = KAT + 1
          CALL PLA059 (JAT, JRAT)
          NRT      = 1
  130     NCN(NRT) = 4
          JRNRT    = JR(NRT) / 1000
          DO I = 5, 7
            IF(XLS(I, JRNRT) .NE. 0.0) NCN(NRT) = I
          END DO
          NRT      = NRT + 1
          JLN(NRT) = 4
  140     JLN(NRT) = JLN(NRT) + 1
          IF (JLN(NRT) .GT. NCN(NRT - 1)) THEN
            NRT = NRT - 1
            IF (NRT .GT. 1) GO TO 140
            GO TO 170
          END IF
          NRTM1   = NRT - 1
          NRTM2   = NRT - 2
          JRNRTM1 = JR(NRTM1) / 1000
          JRDIF   = MOD(JR(NRTM1), 1000)
          IF (NRT .EQ. NRTM) NRTM2 = 1
          JR(NRT) = NINT(XLS(JLN(NRT), JRNRTM1) * 1000 - 555 + JRDIF)
          J0    = JR(NRT) / 1000
          JRDIF = MOD(JR(NRT), 1000)
          IF (J0 .EQ. 0) THEN
            WRITE (LU6, '(''>> J0=0 Problem in PLA092, Loop abort'')',
     1        IOSTAT = IOST)
            GO TO 180
          END IF
          ML    = NINT((XLS(2, J0) - 555 + JRDIF) * PAR(42))
          CALL GEN098 (ML, PAR(42), IPR(54), ITR(1), ITR(2), ITR(3),
     1                 MR1)
          JAT = NINT(XLS(1, J0))
          JRAT = KAT + NRT
          IF (JAT .LE. 0) THEN
            WRITE (LU6, 99989, IOSTAT = IOST) NRT, J0, JAT
            WRITE (LU7, 99989, IOSTAT = IOST) NRT, J0, JAT
            GO TO 180
          END IF
          CALL PLA059 (JAT, JRAT)
          IF (NRT .GT. 3) THEN
            DO I = 2, NRTM2
              IF (JR(NRT) .EQ. JR(I)) GO TO 140
            END DO
          END IF
          JRD  = JR(NRT) / 1000
          JRDT = JR(NRT) - JRD * 1000
          IF (JRD .EQ. J) THEN
            IF (JRDT .EQ. 555) THEN
              COPT = 'Ring '
            ELSE
              COPT = 'Chain'
              GO TO 150
            END IF
          ELSE
            IF (JR(NRT) .LT. JR(1)) THEN
              GO TO 140
            ELSE IF (JR(NRT) .GT. JR(1)) THEN
              GO TO 160
            END IF
          END IF
          IF (NRTM1 .LT. 3) GO TO 140
  150     IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (NRTM1 + 5)
            WRITE (LU7, 99992, IOSTAT = IOST) NRTM1, COPT, JRDT
          END IF
          NRRING = NRRING + 1
          IF (NRRING .GT. 15) THEN
            WRITE (LU6, 99988, IOSTAT = IOST)
            GO TO 180
          END IF
          WRITE (LU6, 99990, IOSTAT = IOST) NRTM1, COPT, JRDT
          DO K = 1, NRTM1
            L    = JR(K) / 1000
            IDIF = JR(K) - L * 1000
            M    = NINT(XLS(1, L))
            CALL PLA047 (LABA(M), NQ1, IDUM, JDUM, IPR(71),
     1        IGBL(55), 0, 0)
            IF (IGBL(63) .GT. 2) WRITE (LU7, 99991, IOSTAT = IOST)
     1        JR(K) / 1000.0, NQ1(1:6), XLS(2, L) - 555 + IDIF,
     2         (XXO(KAT + K, N), N = 1, 6), XLS(9, L)
          END DO
          IF (NRT .EQ. NRTM) NRT = NRT - 1
          GO TO 140
  160     IF (NRT .EQ. NRTM) GO TO 140
          GO TO 130
        END IF
  170 CONTINUE
  180 RETURN
99999 FORMAT (/, 44X, 30('-'), //, 'Hydrogen Bonds are Coded as',
     1 ' N.IJK Where N       = Sequence Number of Hydrogen Bond',
     2 ' (NOTE: New Hbond Numbering system)', /,
     3   40X, 'I - 5   = Nr of Translation Units Along A-Axis', /,
     4   40X, 'J - 5   = Nr of Translation Units Along B-Axis', /,
     5   40X, 'K - 5   = Nr of Translation Units Along C-Axis', //,
     6 'Ring Closure Links are Indicated',
     7 ' with ''R'' and Infinite Chain Links With ''T'' ')
99998 FORMAT ('Analysis of the (Cooperative) Hydrogen Bond Network',
     1 '  (i.e. (In)Finite O-H...O-H...O-H..  Chains and/or Rings',
     2 ' (Max =', I3, ' Membered))', /, 132('='), /)
99997 FORMAT (/, 57X, 12('='), /, 56('*'), ' NetworK =', I3, 1X,
     1 62('*'), /, 57X, 12('='), /)
99996 FORMAT (2X, 'Code Acc    Donor Atom', 10X, 'X', 7X, 'Y', 7X, 'Z',
     1 7X, 'Acceptor Atom', 7X, 'X', 7X, 'Y', 7X, 'Z ',
     2 'up to BondCode(s) of Forward Link(s)', /, 132('-'))
99995 FORMAT (F6.3, 2X, A, 2X, A, A, '[', F9.2,']', 3F8.4, 2X, A,
     1 A, '[', F9.2, ']', 3F8.4, 3(F9.3, A))
99994 FORMAT (96X, 3(F9.3, A))
99993 FORMAT (12X, A, 10X, 3F8.4)
99992 FORMAT (/, 'Directed', I3,
     1  '-Membered Cooperative O-H...O-H...O-H.. ', A, ', - Code',
     2  I4, /, 90('='), /, 'BondCode', 2X, 'Donor Atom', 12X, 'X',
     3 7X, 'Y', 7X, 'Z', 10X, 'XO', 7X, 'YO', 7X, 'ZO', 4X, 'D-H...A',
     4 /, 90('='))
99991 FORMAT (F7.3, 2X, A, '[', F9.2, ']', 2X, 3F8.4, 2X, 3F9.4, F9.2)
99990 FORMAT (':: Directed', I3, '-Membered O-H...O-H...O-H.. ',
     1        A, ' - Code', I4)
99989 FORMAT (/, '=>> Problem with ring-search; aborted', 3I10, /)
99988 FORMAT (/, ':: Too many rings - Listing Aborted')
      END SUBROUTINE PLA092
      SUBROUTINE PLA093 (I, J, K, IDIRCT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER DIRECT*4, IDS*1, FORMA*27, FORMB*78, FORMC*32
C * SUPPORT ROUTINE FOR PLA091
C * LISTING & HANDLING OF DONOR-ACCEPTOR/CONTACT INTERACTIONS
      A3   = 0.0
      SA3  = 0.0
      ISA3 = 0
      NDEC = 0
      FORMA(1:27)  = '   A,3F7.4,F8.2,''('',I3,'')'')'
      FORMB(1:39)  = '(1X,A,''['',F9.2,''], '',3F7.4,2A,''['',F9.2,'
      FORMB(40:51) = '''], '',3F7.4,'
      FORMC(1:5)   = '(89X,'
      IF (IDIRCT .GT. 0) THEN
        DIRECT = ' >> '
      ELSE
        DIRECT = ' << '
      END IF
      IDSORD = NINT(XLS(8, I))
      CALL PLA047 (LABA(J), NQ1, IDUM, JDUM, IPR(71), IGBL(55),
     1  0, 0)
      IF (IDSORD / 10 .EQ. 1) THEN
        IDS = '*'
      ELSE
        IDS = ' '
      END IF
      NAMS(1, 1) = IDS//NQ1
      CALL PLA047 (LABA(K), NQ2, IDUM, JDUM, IPR(71), IGBL(55),
     1  0, 0)
      IF (MOD(IDSORD, 10) .EQ. 1) THEN
        IDS = '*'
      ELSE
        IDS = ' '
      END IF
      NAMS(1, 2) = IDS//NQ2
      NMOL = NINT(XLS(4, I) * PAR(42))
      CALL GEN098 (NMOL, PAR(42), MS1, MT1, MT2, MT3, MR1)
      DO L = 1, 3
         XJX(L) = XXO(K, L)
      END DO
      XJX(4) = MT1
      XJX(5) = MT2
      XJX(6) = MT3
      CALL SGSM (ICL, MS1, XJX, LU7, 3, IERR)
      IF (IPR(39) + 2 .LE. NP1 - IPR(75)) THEN
        K0 = IPR(39) + 1
        DO L = 1, 3
          XXO(K0, L) = XJX(L + 6)
        END DO
        IF (IPR(167) .EQ. 1) THEN
          WRITE (LU2, 99999, IOSTAT = IOST)
     1     NQ1(1:6), XLS(2, I), (XXO(J,  L), L = 1, 3),
     2     NQ2(1:6), XLS(4, I), (XXO(K0, L), L = 1, 3)
        END IF
        CALL PLA059 (K0, K0)
        NC = - NINT(CON(K, NP4))
        IF (NC .LT. 0) NC = NP4
        IF (NC .GT. 0) THEN
          DO 10 L = 1, NC
            M = NINT(CON(K, L))
            IF (M .LE. NP1) THEN
              CALL PLA047 (LABA(M), NQ3, IDUM, JDUM, IPR(71),
     1          IGBL(55), 0, 0)
              CALL GEN048 (-7, IFG(2, M), 1, IDIS3)
              IPOPM = IPPR(IDIS3 + 1, 1)
              IF (IPOPM .LT. 1000) THEN
                IDS = '*'
              ELSE
                IDS = ' '
              END IF
              NAMS(1, 3) = IDS//NQ3
              DO N = 1, 3
                XJX(N) = XXO(M, N)
              END DO
              CALL SGSM (ICL, MS1, XJX, LU7, 3, IERR)
              N0 = IPR(39) + 2
              DO N = 1, 3
                XXO(N0, N) = XJX(N + 6)
              END DO
              CALL PLA059 (N0, N0)
              CALL PLA053 (J, K0, N0, 0, A3, SA3, ISA3, NDEC, IER)
              IF (IER .NE. 0) GO TO 10
              FORMA(15:15) = CHAR(ICHAR('0') + NDEC)
              IF (IGBL(63) .GT. 3) THEN
                IF (L .EQ. 1) THEN
                  FORMB(52:78) = FORMA
                  WRITE (PRBUF, FORMB, IOSTAT = IOST)
     1              NAMS(1, 1), XLS(2, I),
     2              (XXO(J,  N), N = 1, 3), DIRECT, NAMS(1, 2),
     3              XLS(4, I), (XXO(K0, N), N = 1, 3), NAMS(1, 3),
     4              (XXO(N0, N), N = 1, 3), A3, ISA3
                ELSE
                  FORMC(6:32) = FORMA
                  WRITE (PRBUF, FORMC, IOSTAT = IOST) NAMS(1, 3),
     1              (XXO(N0, N), N = 1, 3), A3, ISA3
                END IF
                CALL PLA263 (LU7, PRBUF, 132, 1, 3)
              END IF
            END IF
   10     CONTINUE
        END IF
      END IF
      RETURN
99999 FORMAT ('HBON ', A, '[', F8.2, ']', 3F7.4,
     1        1X, A, '[', F8.2, ']', 3F7.4)
      END SUBROUTINE PLA093
      SUBROUTINE PLA094 (MODE, M1, M2, M3, M4, M5)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PL40/ LHNT(4, 3, 5), NETH(64, 3), MXL, NETTYPE
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      CHARACTER LINE*80, LINE1*80
      DIMENSION KVEC(4)
C * ASSEMBLE 1D, 2D, 3D NETWORK INFORMATION
      MD1   = M1
      MD2   = M2
      MD3   = M3
      MD4   = M4
      IDISP = M5
C * INITIALISE NETWORK
      IF (MODE .LT. 0) THEN
        MXL     = 0
        NETTYPE = - MODE
        IF (NETTYPE .EQ. 1) IPR(322) = 0
C * OUTPUT RESULTS (NO ARU OUT-OF-RANGE CASE)
      ELSE IF (MODE .EQ. 0 .AND. IPR(600) .EQ. 0) THEN
        IF (NETTYPE .EQ. 1) THEN
          NRX = IPR(75)
        ELSE
          NRX = 0
        END IF
        IF (MXL .GT. 0) THEN
          IPRINT = 0
          DO N = 1, NRX
            DO L = 1, MXL
              IF (NETH(L, 1) .EQ. N) THEN
                IF (IGBL(63) .GT. 2) CALL PLA262 (2)
C * 1 = LINEAR NET
                IF (NETH(L, 2) .EQ. 1) THEN
                  WRITE (LINE, 99999, IOSTAT = IOST)
     1              NETH(L, 1), NETTYPE, (LHNT(1, J, L), J = 1, 3)
                  WRITE (LU6,  99989, IOSTAT = IOST)
                  WRITE (LU6,  99987, IOSTAT = IOST) LINE
                  WRITE (LU6,  99989, IOSTAT = IOST)
                  IF (IWIN * IDISP .GT. 0) THEN
                    IF (IDISP .EQ. 1 .AND. L .EQ. 1) THEN
                      VRT = VRT - 1.0
                    ELSE
                      VRT = VRT - 0.45
                    END IF
                    CALL GGIP09 (0.0, LINE,  80, 0.35, 1, 2, 1.0, VRT)
                  END IF
                  IF (IGBL(63) .GT. 2) THEN
                    IPRINT = IPRINT + 1
                    IF (IPRINT .EQ. 1) THEN
                      IF (IPR(51) .GT. 1) THEN
                        WRITE (LU7, 99995, IOSTAT = IOST)
                        CALL PLA262 (2)
                      END IF
                      CALL PLA262 (2)
                      IF (NETTYPE .EQ. 1) THEN
                        WRITE (LU7, 99992, IOSTAT = IOST)
                      ELSE IF (NETTYPE .EQ. 2) THEN
                        WRITE (LU7, 99991, IOSTAT = IOST)
                      ELSE IF (NETTYPE .EQ. 3) THEN
                        WRITE (LU7, 99990, IOSTAT = IOST)
                      END IF
                    END IF
                    WRITE (LU7, 99989, IOSTAT = IOST)
                    WRITE (LU7, 99999, IOSTAT = IOST)
     1                NETH(L, 1), NETTYPE, (LHNT(1, J, L), J = 1, 3)
                    CALL PLA262 (1)
                  END IF
C * 2 = TWO DIMENSIONAL NET
                ELSE IF (NETH(L, 2) .EQ. 2) THEN
                  LHNT(3, 1, L) = LHNT(1, 2, L) * LHNT(2, 3, L)
     1                          - LHNT(1, 3, L) * LHNT(2, 2, L)
                  LHNT(3, 2, L) = LHNT(1, 3, L) * LHNT(2, 1, L)
     1                          - LHNT(1, 1, L) * LHNT(2, 3, L)
                  LHNT(3, 3, L) = LHNT(1, 1, L) * LHNT(2, 2, L)
     1                          - LHNT(1, 2, L) * LHNT(2, 1, L)
                  DO 10 I = 1, 3
                    IVL = LHNT(3, I, L)
                    IF (IVL .NE. 0) THEN
                      DO J = 1, 3
                        IVL1 = LHNT(3, J, L) / IVL
                        IF (IVL1 * IVL .NE. LHNT(3, J, L)) GO TO 10
                      END DO
                      DO J = 1, 3
                        LHNT(3, J, L) = LHNT(3, J, L) / IVL
                      END DO
                      EXIT
                    END IF
   10             CONTINUE
                  WRITE (LINE,  99994, IOSTAT = IOST)
     1              NETH(L, 1), NETTYPE
                  WRITE (LINE1, 99986, IOSTAT = IOST)
     1               (I, (LHNT(I, J, L), J = 1, 3), I = 1, 2),
     2                              (LHNT(3, J, L), J = 1, 3)
                  WRITE (LU6,   99989, IOSTAT = IOST)
                  WRITE (LU6,   99987, IOSTAT = IOST) LINE
                  WRITE (LU6,   99987, IOSTAT = IOST) LINE1
                  WRITE (LU6,   99989, IOSTAT = IOST)
                  IF (IWIN * IDISP .GT. 0) THEN
                    IF (IDISP .EQ. 1 .AND. L .EQ. 1) THEN
                      VRT = VRT - 1.0
                    ELSE
                      VRT = VRT - 0.45
                    END IF
                    CALL GGIP09 (0.0, LINE,  80, 0.35, 1, 2, 1.0, VRT)
                    VRT = VRT - 0.45
                    CALL GGIP09 (0.0, LINE1, 80, 0.35, 1, 2, 1.0, VRT)
                  END IF
                  IF (IGBL(63) .GT. 2) THEN
                    IPRINT = IPRINT + 1
                    IF (IPRINT .EQ. 1) THEN
                      IF (IPR(51) .GT. 1) THEN
                        WRITE (LU7, 99995, IOSTAT = IOST)
                        CALL PLA262 (2)
                      END IF
                      CALL PLA262 (2)
                      IF (NETTYPE .EQ. 1) THEN
                        WRITE (LU7, 99992, IOSTAT = IOST)
                      ELSE IF (NETTYPE .EQ. 2) THEN
                        WRITE (LU7, 99991, IOSTAT = IOST)
                      ELSE IF (NETTYPE .EQ. 3) THEN
                        WRITE (LU7, 99990, IOSTAT = IOST)
                      END IF
                    END IF
                    WRITE (LU7, 99989, IOSTAT = IOST)
                    WRITE (LU7, 99998, IOSTAT = IOST)
     1                NETH(L, 1), NETTYPE,
     2                (I, (LHNT(I, J, L), J = 1, 3), I = 1, 2),
     3                (LHNT(3, J, L), J = 1, 3)
                    CALL PLA262 (1)
                  END IF
C * 3 = THREE DIMENSIONAL NET
                ELSE IF (NETH(L, 2) .EQ. 3) THEN
                  WRITE (LINE,  99993, IOSTAT = IOST)
     1              NETH(L, 1), NETTYPE, NETH(L, 3)
                  WRITE (LINE1, 99988, IOSTAT = IOST)
     1              (I, (LHNT(I, J, L), J = 1, 3), I = 1, 3)
                  WRITE (LU6, 99989, IOSTAT = IOST)
                  WRITE (LU6, 99987, IOSTAT = IOST) LINE
                  WRITE (LU6, 99987, IOSTAT = IOST) LINE1
                  WRITE (LU6, 99989, IOSTAT = IOST)
                  IF (IWIN * IDISP .GT. 0) THEN
                    IF (IDISP .EQ. 1 .AND. L .EQ. 1) THEN
                      VRT = VRT - 1.0
                    ELSE
                      VRT = VRT - 0.45
                    END IF
                    CALL GGIP09 (0.0, LINE,  80, 0.35, 1, 2, 1.0, VRT)
                    VRT = VRT - 0.45
                    CALL GGIP09 (0.0, LINE1, 80, 0.35, 1, 2, 1.0, VRT)
                  END IF
                  IF (IGBL(63) .GT. 2) THEN
                    IPRINT = IPRINT + 1
                    IF (IPRINT .EQ. 1) THEN
                      IF (IPR(51) .GT. 1) THEN
                        WRITE (LU7, 99995, IOSTAT = IOST)
                        CALL PLA262 (2)
                      END IF
                      CALL PLA262 (2)
                      IF (NETTYPE .EQ. 1) THEN
                        WRITE (LU7, 99992, IOSTAT = IOST)
                      ELSE IF (NETTYPE .EQ. 2) THEN
                        WRITE (LU7, 99991, IOSTAT = IOST)
                      ELSE IF (NETTYPE .EQ. 3) THEN
                        WRITE (LU7, 99990, IOSTAT = IOST)
                      END IF
                    END IF
                    WRITE (LU7, 99989, IOSTAT = IOST)
                    WRITE (LU7, 99997, IOSTAT = IOST)
     1                NETH(L, 1), NETTYPE, NETH(L, 3),
     1                          (I, (LHNT(I, J, L), J = 1, 3), I = 1, 3)
                    CALL PLA262 (1)
                  END IF
                END IF
                IF (IPR(17) .EQ. 0) THEN
                  IPR(322) = MAX (IPR(322), NETH(L, 2))
                ELSE IF (IPR(17) .LT. 0) THEN
                END IF
                NETH(L, 2) = 0
                NETH(L, 3) = 0
              END IF
            END DO
          END DO
          IF (IPR(17) .EQ. 0) THEN
            CALL PLA231 (4, 0, -999.0, FLOAT(IPR(322)), ' ', ' ')
          END IF
        END IF
C * MODE = 1,  ADD NEW TRANSLATION
      ELSE
        IF (MD4 .LT. 0) THEN
          IF (ABS(IGBL(3)) .NE. 1) WRITE (6, 99985) MD4
        ELSE
          L = 0
          IF (MXL .GT. 0) THEN
            DO I = 1, MXL
              IF (NETH(I, 1) .EQ. MD4) THEN
                L = I
                EXIT
              END IF
            END DO
          END IF
          IF (MXL .GE. 5) THEN
            WRITE (LU6, 99996, IOSTAT = IOST)
          ELSE
            IF (L .EQ. 0) THEN
              MXL          = MXL + 1
              NPOL(MD4)    = MXL
              NETH(MXL, 1) = MD4
              NETH(MXL, 2) = 0
              NETH(MXL, 3) = 99999
              L            = MXL
            END IF
            K1 = MD1
            K2 = MD2
            K3 = MD3
            IF (K1 .EQ. 0) THEN
              IF (K2 .LT. 0) THEN
                K2 = - K2
                K3 = - K3
              ELSE  IF (K2 .EQ. 0) THEN
                IF (K3 .LT. 0) K3 = - K3
              END IF
            ELSE IF (K1 .LT. 0) THEN
              K1  = - K1
              K2  = - K2
              K3  = - K3
            END IF
            LHNT(NETH(L, 2) + 1, 1, L) = K1
            LHNT(NETH(L, 2) + 1, 2, L) = K2
            LHNT(NETH(L, 2) + 1, 3, L) = K3
            NDIM = NETH(L, 2)
            IF (NDIM .EQ. 2) THEN
              DO I = 1, 3
                IF (LHNT(1, I, L) .EQ. 1) THEN
                  N = LHNT(2, I, L)
                  IF (N .NE. 0) THEN
                    DO J = 1, 3
                      LHNT(2, J, L) = LHNT(2, J, L) - N * LHNT(1, J, L)
                     END DO
                    EXIT
                  END IF
                END IF
              END DO
            END IF
            IF (NETH(L, 2) .EQ. 1) THEN
              IF ((LHNT(1, 1, L) * LHNT(2, 2, L) -
     1             LHNT(2, 1, L) * LHNT(1, 2, L) .EQ. 0) .AND.
     2            (LHNT(1, 1, L) * LHNT(2, 3, L) -
     3             LHNT(2, 1, L) * LHNT(1, 3, L) .EQ. 0) .AND.
     4            (LHNT(1, 2, L) * LHNT(2, 3, L) -
     5             LHNT(2, 2, L) * LHNT(1, 3, L) .EQ. 0)) THEN
                IF ((IABS(LHNT(2, 1, L)) + IABS(LHNT(2, 2, L)) +
     1               IABS(LHNT(2, 3, L))) .LT.
     2              (IABS(LHNT(1, 1, L)) + IABS(LHNT(1, 2, L)) +
     3               IABS(LHNT(1, 3, L)))) THEN
                  DO K = 1, 3
                    LHNT(1, K, L) = LHNT(2, K, L)
                  END DO
                END IF
                RETURN
              END IF
            ELSE IF (NETH(L, 2) .EQ. 2) THEN
              CALL GEN131 (LHNT, 1, 2, 3, L, IDET)
              NETH(L, 3) = IDET
              IF (NETH(L, 3) .EQ. 0) RETURN
            ELSE IF (NETH(L, 2) .EQ. 3) THEN
              IF (NETH(L, 3) .GT. 1) THEN
                CALL GEN131 (LHNT, 1, 2, 4, L, IDET)
                IF (IDET .GT. 0 .AND. IDET .LT. NETH(L, 3)) THEN
                  NETH(L, 3) = IDET
                  DO K = 1, 3
                    LHNT(3, K, L) = LHNT(4, K, L)
                  END DO
                  RETURN
                END IF
                CALL GEN131 (LHNT, 1, 3, 4, L, IDET)
                IF (IDET .GT. 0 .AND. IDET .LT. NETH(L, 3)) THEN
                  NETH(L, 3) = IDET
                  DO K = 1, 3
                    LHNT(2, K, L) = LHNT(4, K, L)
                  END DO
                  RETURN
                END IF
                CALL GEN131 (LHNT, 2, 3, 4, L, IDET)
                IF (IDET .GT. 0 .AND. IDET .LT. NETH(L, 3)) THEN
                  NETH(L, 3) = IDET
                  DO K = 1, 3
                    LHNT(1, K, L) = LHNT(4, K, L)
                  END DO
                  RETURN
                END IF
              END IF
              RETURN
            END IF
            NETH(L, 2) = NETH(L, 2) + 1
            NRDIM = NETH(L, 2)
            IF (NRDIM .GT. 1) THEN
   20         DO K = 1, NRDIM
                KVEC(K) = 0
                DO I = 1, 3
                  KVEC(K) = KVEC(K) + 10**(3 - I) * LHNT(K, I, L)
                END DO
                N = IABS(KVEC(K))
                IF (N .EQ. 1 .OR. N .EQ. 10 .OR. N .EQ. 100) THEN
                  IF (KVEC(K) .LT. 0) THEN
                    LHNT(K, 1, L) = IABS(LHNT(K, 1, L))
                    LHNT(K, 2, L) = IABS(LHNT(K, 2, L))
                    LHNT(K, 3, L) = IABS(LHNT(K, 3, L))
                    GO TO 20
                  END IF
                END IF
              END DO
              DO I = 1, NRDIM
                N = KVEC(I)
                IF (N .EQ. 1) THEN
                  K = 3
                ELSE IF (N .EQ. 10) THEN
                  K = 2
                ELSE IF (N .EQ. 100) THEN
                  K = 1
                ELSE
                  CYCLE
                END IF
                DO J = 1, NRDIM
                  IF (J .NE. I) THEN
                    IF (LHNT(J, K, L) .NE. 0) THEN
                      LHNT(J, K, L) = 0
                      GO TO 20
                    END IF
                  END IF
                END DO
              END DO
            END IF
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (':: Resd', I3, ' - Infinite (Type', I1, ') 1D-Chain   ',
     1 ' - Base Vector: [', 3I3, ']')
99998 FORMAT (':: Resd', I3, ' - Infinite (Type', I1, ') 2D-Network ',
     1 ':: Base Vectors', ':', 2(' #', I1, ' = [', 3I3, '], '),
     2 ' - Plane: (', 3I3, ')')
99997 FORMAT (':: Resd', I3, ' - Infinite (Type', I1, ') 3D-Framework'
     1 , ' :: Det =', I2, ', Base Vectors: ', 3(' #', I1,
     2 ' =[', 3I3, '], '))
99996 FORMAT (/, ':: Maximum number of Polymeric Residues Exceeded')
99995 FORMAT (/, ':: Starred ARUs belong (chemically) to the ',
     1           'previous ARU and',
     2           ' Hashed  ARUs are also in Translation')
99994 FORMAT (':: Resd', I3, ' - Infinite (Type', I1, ') 2D-Network')
99993 FORMAT (':: Resd', I3, ' - Infinite (Type', I1, ') 3D-Framework',
     1 ': Det =', I2)
99992 FORMAT (/, ':: Analysis of Covalent/Coordination ',
     1              'Type1 Polymeric Structure(s)')
99991 FORMAT (/, ':: Analysis of Short Contact Cluster ',
     1              'Type2 Polymeric Structure(s)')
99990 FORMAT (/, ':: Analysis of H-Bonded Aggregate ',
     1              'Type3 Polymeric Structure(s)')
99989 FORMAT (1X)
99988 FORMAT (':: Base Vectors: ', 3(I5, ' : ', 3I3, ' , '))
99987 FORMAT (A)
99986 FORMAT (':: Base Vectors: ', 2(I5, ' : [', 3I3, '], '),
     3   ' Plane: (', 3I3, ')')
99985 FORMAT ('Problem in PLA094: MD4 =', I10, 2X, '(Ignored)')
      END SUBROUTINE PLA094
      SUBROUTINE PLA095 (NRING, NHEAD, MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP5=250,NP6=100,NP7=50,NP8=50,
     1 NP9=118,NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,
     2 NVD=100000000,NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,
     3 NP39=30,NP41=200,NP47=9,NP52=200,NP56=30,NP57=35,
     4 NPX = 2 * NP23 - 41 * NP5 - 6)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // Q(NP5), SPHI(NP5), PHI(NP5), KPHI(NP5), SSQ(NP5),
     1 NPHI(NP5), ZP(NP5), TRA(NP5), DCSV(NP5), DCSB(NP5), DC2V(NP5),
     2 DC2B(NP5), KZP(NP5), KTRA(NP5), STRA(NP5), KDCSV(NP5), NQ(NP5),
     3 KDCSB(NP5), KDC2V(NP5), KDC2B(NP5), KQ(NP5), XYZR(NP5, 4),
     4 RBO(NP5), KRBO(NP5), RANG(NP5), KRANG(NP5), HDCSV(NP5),
     5 HDC2V(NP5), HDCSB(NP5), HDC2B(NP5), FCS(NP5), HFCS(NP5),
     6 KFCS(NP5), FC2(NP5), HFC2(NP5), NRANG(NP5), NTRA(NP5),
     7 NRBO(NP5), XYZD(3), XYZDD(3), ISCR(NPX), VOID(NVD)
      CHARACTER KDES*2, TXT1*5, TXT2*5, ACONF*1
      CHARACTER FORMA*158, FORMB*158, FORMC*158, FORMD*158, FORME*158,
     1  FORMF*158, FORMG*158, FORMH*158, FORMI*56, FORMK*73, FORML*37,
     2  FORMP*106, FORMQ*63, FORMX*54, CHYB*3
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IF (MODE .NE. 0) THEN
        CALL GGIP (HORS, VERT, 0.0, 1)
        VRT = VERT
      END IF
      NRAT  = IPR(12)
      NMAX  = IPR(39)
      RBOMN = 1000.0
      RBOMX = 0.0
      D     = 0.0
      SD    = 0.0
      SANG  = 0.0
      SRANG = 0.0
      SRBO  = 0.0
      ANG   = 0.0
      NDEC  = 0
      ISANG = 0
      ISD   = 0
      ION2  = 0
      ION5  = 0
      N     = 0
      IC2   = 0
      ATERM = 0.0
      BTERM = 0.0
      SIGAK = 0.0
      SIGBK = 0.0
      FORMA(1:30)   = '( ''Dev. (Ang)'',10X,           '
      FORMA(31:46)  = 'F8.4,''('',I3,'')'','
      FORMA(47:94)  = FORMA(31:46)//FORMA(31:46)//FORMA(31:46)
      FORMA(95:158) = FORMA(47:94)//'F8.4,''('',I3,'')'')'
      FORMB(1:30)   = '( ''Cs(I)-Asym-Par (Deg)'',     '
      FORMB(31:158) = FORMA(31:158)
      FORMC(1:30)   = '( ''C2(I)-Asym-Par (Deg)'',     '
      FORMC(31:158) = FORMA(31:158)
      FORMD(1:30)   = '( ''Ring Bond Angle(Deg)'',     '
      FORMD(31:158) = FORMA(31:158)
      FORME(1:30)   = '( ''Tors(I-J) (Deg)'',10X,      '
      FORME(31:158) = FORMA(31:158)
      FORMF(1:30)   = '( ''Cs(I-J)-Asym-Par   (Deg) '','
      FORMF(31:158) = FORMA(31:158)
      FORMG(1:30)   = '( ''C2(I-J)-Asym-Par   (Deg) '','
      FORMG(31:158) = FORMA(31:158)
      FORMH(1:30)   = '( ''Ring Bond Distance (Ang) '','
      FORMH(31:158) = FORMA(31:158)
      FORMI(1:34)   = '(   A,'' - '',A,F10.4,''('',I3,'')'',5X,'
      FORMI(35:56)  = 'F10.2,''('',I3,'')'',2X,A)'
      FORMK( 1:28)  = '(''Q('',I1,'')  ='',F9.4,''('',I5,'
      FORMK(29:58)  = ''') Ang.,  Phi('',I1,'') ='',F8.2,'
      FORMK(59:73)  = '''('',I5,'') Deg'')'
      FORML( 1:37)  = FORMK(1:35)//''')'
      FORMP( 1:34)  = '(''Puckering Amplitude (Q) ='',F8.4,'
      FORMP(35:63)  = '''('',I5,'') Ang, Theta ='',F8.2,'
      FORMP(64:91)  = '''('',I5,'') Deg,  Phi ='',F8.2,'
      FORMP(92:106) = '''('',I5,'') Deg'')'
      FORMQ(1 :38)  = '(''Angle between '',3A,'' and '',3A,'' = '','
      FORMQ(39:63)  = 'F10.0,''('',I3,'')'','' deg.'')'
      FORMX(1:38)   = '(''Total Puckering Amplitude Q ='',F8.4,'
      FORMX(39:54)   ='''('',I5,'') Ang.'')'
      CALL PLA055
      KRC = NMAX + IPR(64) + 1
      IATP(KRC) = NRING
      DO K = 1, 3
        XXO(KRC, K)     = 0.0
        XXO(KRC, K + 3) = 0.0
        XSD(KRC, K)     = 0.0
        XSD(KRC, K + 3) = 0.0
        XYZD(K)         = 0.0
        XYZDD(K)        = 0.0
      END DO
      ISUGR  = 0
      IF (NRAT .EQ. 5) THEN
        DO J = 1, NRAT
          CALL GEN048 (-4, IFG(1, JR(J)), 15, JDUM)
          JDUM = IEN(JDUM + 1)
          IF (JDUM .EQ. 2) THEN
            ISUGR = ISUGR + 1
          ELSE IF (JDUM .EQ. 3) THEN
            ISUGR = ISUGR + 100
          END IF
        END DO
        IF (ISUGR .EQ. 104) THEN
          ISUGL = 2
   10     ISUGL = ISUGL - 1
          IF (ISUGL .LT. 0) THEN
            ISUGR = 0
            GO TO 20
          END IF
          IC2  = 0
          ION2 = 0
          J2   = JR(2)
          NC   = - NINT(CON(J2, NP4))
          IF (NC .LT. 0) NC = NP4
          IF (NC .LE. 3) THEN
            ISUGR = 0
            GO TO 20
          END IF
          DO K = 1, NC
            M = NINT(CON(J2, K))
            IF (M .NE. JR(1) .AND. M .NE. JR(3)) THEN
              CALL GEN048 (-4, IFG(1, M), 15, JDUM)
              JDUM = IEN(JDUM + 1)
              IF (JDUM .EQ. 3 .OR. JDUM .EQ. 4) THEN
                ION2 = 1
              END IF
              IF (JDUM .EQ. 2) IC2 = 1
            END IF
          END DO
          ION5 = 0
          J5   = JR(5)
          NC = - NINT(CON(J5, NP4))
          IF (NC .LT. 0) NC = NP4
          IF (NC .LE. 3) THEN
            ISUGR = 0
            GO TO 20
          END IF
          DO K = 1, NC
            M = NINT(CON(J5, K))
            IF (M .NE. JR(1) .AND. M .NE. JR(4)) THEN
              CALL GEN048 (-4, IFG(1, M), 15, JDUM)
              JDUM = IEN(JDUM + 1)
              IF (JDUM .EQ. 3 .OR. JDUM .EQ. 4) ION5 = 1
              IF (JDUM .EQ. 2) THEN
                ACONF = 'L'
                CALL PLA053 (M, JR(5), JR(1), JR(2),
     1              ANG, SANG, ISANG, NDEC, IER)
                IF (IER .EQ. 0 .AND. ANG .GT. 0.0) ACONF = 'D'
              END IF
            END IF
          END DO
          IF (ION5 .EQ. 1) THEN
            CALL GEN014 (JR(2), JR(5))
            CALL GEN014 (JR(3), JR(4))
            GO TO 10
          END IF
        END IF
      END IF
   20 BAV    = 0.0
      BAVK   = 0.0
      SWT    = 0.0
      TAU    = 0.0
      TAUK   = 0.0
      STWT   = 0.0
      SMSIGJ = 0.0
      NCARB  = 0
      NHAT = 0
      DO J = 1, NRAT
        I    = JR(J)
        CALL GEN048 (-4, IFG(1, I), 15, JDUM)
        IF (IEN(JDUM + 1) .EQ. 2) THEN
          NCARB = NCARB + 1
          NC = - NINT(CON(I, NP4))
          IF (NC .LT. 0) NC = NP4
          DO K = 1, NC
            M = NINT(CON(I, K))
            CALL GEN048 (-1, IFG(1, M), 7, IHAT)
            NHAT = NHAT + IHAT
          END DO
        END IF
        NRJ = NRAT + J
        I1 = JR(MOD(NRJ - 2, NRAT) + 1)
        I2 = JR(MOD(NRJ - 1, NRAT) + 1)
        I3 = JR(MOD(NRJ,     NRAT) + 1)
        I4 = JR(MOD(NRJ + 1, NRAT) + 1)
        CALL PLA053 (I2, I3, 0, 0, RBO(J), SRBO, KRBO(J), NRBO(J),
     1               IER)
        IF (IER .NE. 0) GO TO 50
        IF (SRBO .LE. 0.0) THEN
          WBO = 1.0
        ELSE
          WBO = 1.0 / SRBO**2
        END IF
        RBOMX = MAX (RBOMX, RBO(J))
        RBOMN = MIN (RBOMN, RBO(J))
        BAV   = BAV  + WBO * RBO(J)
        BAVK  = BAVK + WBO * RBO(J)**2
        SWT   = SWT  + WBO
        CALL PLA053 (I1, I2, I3, 0, RANG(J), SRANG, KRANG(J),
     1               NRANG(J), IER)
        IF (IER .NE. 0) GO TO 50
        CALL PLA053 (I1, I2, I3, I4, TRA(J), STRA(J), KTRA(J),
     1               NTRA(J), IER)
        IF (IER .NE. 0) GO TO 50
        IF (STRA(J) .LE. 0) THEN
          WTAU  = 1.0
        ELSE
          WTAU  = 1.0 / STRA(J)**2
        END IF
        TAU  = TAU  + WTAU * ABS(TRA(J))
        TAUK = TAUK + WTAU * TRA(J)**2
        STWT = STWT + WTAU
        IP   = JR(J)
        SIGJ = 0.0
        DO K = 1, 3
          XYZR(J,  K)     = XXO(IP,  K + 3)
          XXO(KRC, K)     = XXO(KRC, K)     + XXO(IP, K)
          XXO(KRC, K + 3) = XXO(KRC, K + 3) + XXO(IP, K + 3)
          XSD(KRC, K)     = XSD(KRC, K)     + XSD(IP, K)
          XSD(KRC, K + 3) = XSD(KRC, K + 3) + XSD(IP, K + 3)
          SIGJ            = SIGJ            + XSD(IP, K + 3)
        END DO
        XYZR(J, 4) = SIGJ / 3
        SMSIGJ     = SMSIGJ + SIGJ / 3
      END DO
      IF (NHEAD .EQ. 0 .AND. IGBL(63) .GT. 3) THEN
        NHEAD = 1
        CALL PLA262 (-53)
        WRITE (LU7, 99970, IOSTAT = IOST)
        NRNG = IPR(496)
        IF (MOD (NRNG, 100) .GT. 0) WRITE (LU7, 99969, IOSTAT = IOST)
        NRNG = NRNG / 100
        IF (MOD (NRNG, 100) .GT. 0) WRITE (LU7, 99968, IOSTAT = IOST)
        NRNG = NRNG / 100
        IF (MOD (NRNG, 100) .GT. 0) WRITE (LU7, 99967, IOSTAT = IOST)
        NRNG = NRNG / 100
        IF (NRNG .GT. 0)
     1    WRITE (LU7, 99966, IOSTAT = IOST) '<', '>', '>', '>',
     2      '>', '>'
        WRITE (LU7, 99965, IOSTAT = IOST)
        WRITE (LU7, 99964, IOSTAT = IOST)
        WRITE (LU7, 99982, IOSTAT = IOST)
      END IF
      DO K = 1, 3
        XSD(KRC, K)     = XSD(KRC, K)    / (NRAT**2)
        XSD(KRC, K + 3) = XSD(KRC, K + 3)/ (NRAT**2)
        XXO(KRC, K)     = XXO(KRC, K)    /  NRAT
        XXO(KRC, K + 3) = XXO(KRC, K + 3)/  NRAT
      END DO
      DO K = 1, 6
        VOID((KRC - 1) * (NP4 + 15) + K)     = XXO(KRC, K)
        VOID((KRC - 1) * (NP4 + 15) + K + 6) = XSD(KRC, K)
      END DO
      BAV    = BAV / SWT
      BAVK   = BAVK / SWT
      KBAV   = MIN (999, NINT(10000.0 / SQRT(SWT)))
      KBAVE  = MIN (999, NINT(10000.0 * SQRT(ABS(BAVK
     1         - BAV**2) / (NRAT - 1))))
      TAU    = TAU / STWT
      TAUK   = TAUK / STWT
      KTAU   = MIN (999, NINT(100.0 / SQRT(STWT)))
      KTAUE  = MIN (999, NINT(100.0 * SQRT(ABS(TAUK - TAU**2) /
     1         (NRAT - 1))))
      SMSIGJ = SMSIGJ / (NRAT**2)
      DO J = 1, NRAT
        DO K = 1, 3
          XYZR(J, K) = XYZR(J, K) - XXO(KRC, K + 3)
        END DO
        XYZR(J, 4) = XYZR(J, 4) + SMSIGJ
        SINF   = SIN(RGBL(5) * (J - 1) / NRAT)
        COSF   = COS(RGBL(5) * (J - 1) / NRAT)
        DO L = 1, 3
          XYZD(L)  = XYZD(L)  + XYZR(J, L) * SINF
          XYZDD(L) = XYZDD(L) + XYZR(J, L) * COSF
        END DO
      END DO
      CALL GEN008 (XYZD, XYZDD, XPV, 1)
      IE  = 0
      BQ  = 0.0
      SBQ = 0.0
      DO J = 1, NRAT
        ZP(J) = XPV(1) * XYZR(J, 1) + XPV(2) * XYZR(J, 2)
     1        + XPV(3) * XYZR(J, 3)
        IF (ABS(ZP(J)) .LT. 1.0E-15) ZP(J) = 0.0
        BQ    = BQ  + ZP(J)**2
        SBQ   = SBQ + ZP(J)**2 * XYZR(J, 4)
      END DO
      BQ  = SQRT(BQ)
      IF (BQ .GT. 0.0) SBQ = SQRT(SBQ) / BQ
      DO J = 1, NRAT
        DCSV(J)  = 0.0
        DC2V(J)  = 0.0
        DCSB(J)  = 0.0
        DC2B(J)  = 0.0
        FCS(J)   = 0.0
        FC2(J)   = 0.0
        HDCSV(J) = 0.0
        HDC2V(J) = 0.0
        HDCSB(J) = 0.0
        HDC2B(J) = 0.0
        HFCS(J)  = 0.0
        HFC2(J)  = 0.0
        NRD2     = NRAT / 2
        NRD3     = (NRAT - 1) / 2
        NRJ      = NRAT + J
        DO K = 1, NRD2
          ITRA0 = MOD(NRJ + K - 1, NRAT) + 1
          ITRA1 = MOD(NRJ + K - 2, NRAT) + 1
          ITRA2 = MOD(NRJ - K - 1, NRAT) + 1
          TRA0  = TRA(ITRA0)
          STRA0 = STRA(ITRA0)**2
          TRA1  = TRA(ITRA1)
          STRA1 = STRA(ITRA1)**2
          TRA2  = TRA(ITRA2)
          STRA2 = STRA(ITRA2)**2
          SZP0  = SQRT(XYZR(ITRA0, 4))
          SZP2  = SQRT(XYZR(ITRA2, 4))
          T1P2S = (TRA1 + TRA2)**2
          T1M2S = (TRA1 - TRA2)**2
          T0P2S = (TRA0 + TRA2)**2
          T0M2S = (TRA0 - TRA2)**2
          ZP0P2 = ABS(ZP(ITRA0) + ZP(ITRA2))
          ZP0M2 = ABS(ZP(ITRA0) - ZP(ITRA2))
          IF (ZP0P2 .LT. 1.0E-15) THEN
            Z0P2S = 0.0
          ELSE
            Z0P2S = ZP0P2**2
          END IF
          IF (ZP0M2 .LT. 1.0E-15) THEN
            Z0M2S = 0.0
          ELSE
            Z0M2S = ZP0M2**2
          END IF
          DCSV(J)  = DCSV(J)  + T1P2S
          HDCSV(J) = HDCSV(J) + T1P2S * (STRA1 + STRA2)
          DC2V(J)  = DC2V(J)  + T1M2S
          HDC2V(J) = HDC2V(J) + T1M2S * (STRA1 + STRA2)
          IF (K .LE. NRD3) THEN
            FC2(J)   = FC2(J)   + Z0P2S
            HFC2(J)  = HFC2(J)  + Z0P2S * (SZP0  + SZP2)
            FCS(J)   = FCS(J)   + Z0M2S
            HFCS(J)  = HFCS(J)  + Z0M2S * (SZP0  + SZP2)
            DCSB(J)  = DCSB(J)  + T0P2S
            HDCSB(J) = HDCSB(J) + T0P2S * (STRA0 + STRA2)
            DC2B(J)  = DC2B(J)  + T0M2S
            HDC2B(J) = HDC2B(J) + T0M2S * (STRA0 + STRA2)
          END IF
        END DO
        IF (DCSV(J) .LT. 1E-5) THEN
          HDCSV(J) = 0
        ELSE
          HDCSV(J) = SQRT(ABS(HDCSV(J)) / (NRD2 * DCSV(J)))
        END IF
        DCSV(J)  = SQRT(ABS(DCSV(J)) / NRD2)
        IF (DC2V(J) .LT. 1E-5) THEN
          HDC2V(J) = 0
        ELSE
          HDC2V(J) = SQRT(ABS(HDC2V(J)) / (NRD2 * DC2V(J)))
        END IF
        DC2V(J)  = SQRT(ABS(DC2V(J)) / NRD2)
        IF (DCSB(J) .LT. 1E-5) THEN
          HDCSB(J) = 0
        ELSE
          HDCSB(J) = SQRT(ABS(HDCSB(J)) / (NRD3 * DCSB(J)))
        END IF
        DCSB(J)  = SQRT(ABS(DCSB(J)) / NRD3)
        IF (FCS(J) .LT. 1E-5) THEN
          HFCS(J) = 0.0
        ELSE
          HFCS(J) = SQRT(ABS(HFCS(J)) / (NRD3 * FCS(J)))
        END IF
        FCS(J)   = SQRT(ABS(FCS(J)) / NRD3)
        IF (FC2(J) .LT. 1E-5) THEN
          HFC2(J) = 0.0
        ELSE
          HFC2(J)  = SQRT(ABS(HFC2(J)) / (NRD3 * FC2(J)))
        END IF
        FC2(J)   = SQRT(ABS(FC2(J)) / NRD3)
        IF (DC2B(J) .LT. 1E-5) THEN
          HDC2B(J) = 0.0
        ELSE
          HDC2B(J) = SQRT(ABS(HDC2B(J)) / (NRD3 * DC2B(J)))
        END IF
        DC2B(J)  = SQRT(ABS(DC2B(J)) / NRD3)
      END DO
      NSP2 = 0
      NSP3 = 0
      II1  = -7
   30 II1  = II1 + 8
      II2  = II1 + 7
      IF (II2 .GT. NRAT) II2 = NRAT
      JJ = 0
      DO II = II1, II2
        JJ = JJ + 1
        IP = JR(II)
        CALL PLA047 (LABA(IP), NQ1, IDUM, JDUM, IPR(71),
     1    IGBL(55), 0, 1 - IGBL(55))
        NAMS(JJ, 1) = ' '//NQ1
        CALL GEN048 (-4, IFG(1, IP), 24, IHYB)
        IF (IHYB .EQ. 1) THEN
          CHYB = 'sp'
        ELSE IF (IHYB .EQ. 2) THEN
          CHYB = 'sp2'
          NSP2 = NSP2 + 1
        ELSE IF (IHYB .EQ. 3) THEN
          CHYB = 'sp3'
          NSP3 = NSP3 + 1
        ELSE
          CHYB = ' '
        END IF
        NAMS(JJ, 2) = CHYB
      END DO
      IF (II1 .NE. 1) THEN
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (5)
          WRITE (LU7, 99996, IOSTAT = IOST)
     1      (NAMS(II, 1)(2:7), II = 1, JJ)
          WRITE (LU7, 99971, IOSTAT = IOST)
          WRITE (LU7, 99962, IOSTAT = IOST)
     1      (NAMS(II, 2)(1:3), II = 1, JJ)
        END IF
      ELSE
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (-4)
          IF (ISUGR .EQ. 104) THEN
            CALL PLA262 (1)
            IF (IC2 .EQ. 1) THEN
              WRITE (LU7, 99991, IOSTAT = IOST)
            ELSE
              WRITE (LU7, 99990, IOSTAT = IOST)
            END IF
          END IF
          WRITE (PRBUF, 99997, IOSTAT = IOST) NRAT, IPR(19) + NRING,
     1                       (NAMS(II, 1)(2:7), II = 1, JJ)
          WRITE (LU7, 99961, IOSTAT = IOST) PRBUF
          IF (MODE .NE. 0) THEN
            VRT = VRT - 0.7
            CALL GGIP09 (0.0, PRBUF, 132, 0.3, 5 + IGBL(68), 2, 0.1,
     1        VRT)
          END IF
          WRITE (LU7, 99971, IOSTAT = IOST)
          WRITE (PRBUF, 99962, IOSTAT = IOST)
     1      (NAMS(II, 2)(1:3), II = 1, JJ)
          WRITE (LU7, 99961, IOSTAT = IOST) PRBUF
          IF (MODE .NE. 0) THEN
            VRT = VRT - 0.9
            CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
          END IF
        END IF
      END IF
      IF (IGBL(63) .GT. 2) THEN
        IFT = 18
        I68 = IPR(68)
        DO II = II1, II2
          IFT = IFT + 16
          SX = SQRT (XYZR(II, 4))
          CALL GEN041 (ZP(II), SX, KZP(II),            4, NDEC, I68)
          FORMA(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
          CALL GEN041 (DCSV(II), HDCSV(II), KDCSV(II), 2, NDEC, I68)
          FORMB(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
          CALL GEN041 (DC2V(II), HDC2V(II), KDC2V(II), 2, NDEC, I68)
          FORMC(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
          FORMD(IFT:IFT) = CHAR(ICHAR('0') + NRANG(II))
          FORME(IFT:IFT) = CHAR(ICHAR('0') + NTRA(II))
          CALL GEN041 (DCSB(II), HDCSB(II), KDCSB(II), 2, NDEC, I68)
          FORMF(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
          CALL GEN041 (DC2B(II), HDC2B(II), KDC2B(II), 2, NDEC, I68)
          FORMG(IFT:IFT) = CHAR(ICHAR('0') + NDEC)
          FORMH(IFT:IFT) = CHAR(ICHAR('0') + NRBO(II))
        END DO
        WRITE (PRBUF, FORMA, IOSTAT = IOST)
     1    (ZP(II),   KZP(II),   II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (PRBUF, FORMB, IOSTAT = IOST)
     1    (DCSV(II), KDCSV(II), II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (PRBUF, FORMC, IOSTAT = IOST)
     1    (DC2V(II), KDC2V(II), II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (PRBUF, FORMD, IOSTAT = IOST)
     1    (RANG(II), KRANG(II), II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (LU7, 99974, IOSTAT = IOST)
        WRITE (PRBUF, FORME, IOSTAT = IOST)
     1    (TRA(II),  KTRA(II),  II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.9
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (PRBUF, FORMF, IOSTAT = IOST)
     1    (DCSB(II), KDCSB(II), II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (PRBUF, FORMG, IOSTAT = IOST)
     1    (DC2B(II), KDC2B(II), II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (PRBUF, FORMH, IOSTAT = IOST)
     1    (RBO(II),  KRBO(II),  II = II1, II2)
        CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
      END IF
      IF (II2 .LT. NRAT) GO TO 30
      M = (NRAT - 1) / 2
      IF (NRAT .EQ. 6 .AND. NCARB .EQ. 6) THEN
        IF (NSP2 .EQ. 6) THEN
          IF (NHAT .GT. 4) THEN
            NADD   = 0
            BAVEXP = 1.395
            DIFF   = 0.005
          ELSE
            NADD   = 3
            BAVEXP = 1.410
            DIFF   = 0.01
          END IF
          IF (TAU .LT. 5.0) THEN
            BAVDIF = BAV - BAVEXP
            IF (BAVDIF .GT. DIFF) THEN
              IF (NADD .EQ. 3) BAVDIF = -999.0
C * ALERT _330 +
              CALL PLA231 (330 + NADD, 2, BAVDIF, BAV,
     1               NAMS(1, 1) (2:8), NAMS(6, 1) (2:8))
            ELSE IF (BAVDIF .LT. - DIFF) THEN
C * ALERT _331 +
              CALL PLA231 (331 + NADD, 2, - BAVDIF, BAV,
     1               NAMS(1, 1) (2:8), NAMS(6, 1) (2:8))
            END IF
          END IF
          IF (TAU .LT. 12.0) THEN
            YUNK  = RBOMX - RBOMN
            YUNK1 = YUNK
            IF (NADD .EQ. 3) YUNK = -999.0
            IF (YUNK1 .GT. 0.15) THEN
C * ALERT _332 +
              CALL PLA231 (332 + NADD, 2, YUNK, YUNK1,
     1          NAMS(1, 1) (2:8), NAMS(6, 1) (2:8))
            END IF
          END IF
        ELSE IF (NSP3 .EQ. 6) THEN
C * ALERT _338
          CALL PLA231 (338, 2, 60.0 - TAU, TAU, NAMS(1, 1)(2:8),
     1       NAMS(6, 1)(2:8))
        END IF
      END IF
      IF (IGBL(63) .GT. 2) THEN
        CALL PLA262 (5)
        WRITE (LU7, 99974, IOSTAT = IOST)
        WRITE (PRBUF, 99960, IOSTAT = IOST) BAV, KBAV, KBAVE
        WRITE (LU7, 99961, IOSTAT = IOST) PRBUF
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.9
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (PRBUF, 99959, IOSTAT = IOST) TAU, KTAU, KTAUE
        WRITE (LU7, 99961, IOSTAT = IOST) PRBUF
        IF (MODE .NE. 0) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
        END IF
        WRITE (LU7, 99974, IOSTAT = IOST)
        IF (NRAT .EQ. 4) THEN
          CALL PLA053 (JR(1), JR(2), JR(4), JR(3), TRA(5), STRA(5),
     1        KTRA(5), NTRA(5), IER)
          IF (IER .EQ. 0) THEN
            FORMQ(43:43) = CHAR(ICHAR('0') + NTRA(5))
            WRITE (PRBUF, FORMQ, IOSTAT = IOST)
     1      NAMS(1, 1)(2:7), NAMS(2, 1)(2:7), NAMS(4, 1)(2:7),
     2      NAMS(2, 1)(2:7), NAMS(3, 1)(2:7), NAMS(4, 1)(2:7),
     3      ABS(TRA(5)), KTRA(5)
            CALL PLA263 (LU7, PRBUF, 132, 1, 1)
          END IF
          CALL PLA053 (JR(2), JR(3), JR(1), JR(4), TRA(6), STRA(6),
     1                 KTRA(6), NTRA(6), IER)
          IF (IER .EQ. 0) THEN
            FORMQ(43:43) = CHAR(ICHAR('0') + NTRA(6))
            WRITE (PRBUF, FORMQ, IOSTAT = IOST)
     1      NAMS(1, 1)(2:7), NAMS(2, 1)(2:7), NAMS(3, 1)(2:7),
     2      NAMS(1, 1)(2:7), NAMS(3, 1)(2:7), NAMS(4, 1)(2:7),
     3      ABS(TRA(6)), KTRA(6)
            CALL PLA263 (LU7, PRBUF, 132, 1, 1)
          END IF
          WRITE (LU7, 99974, IOSTAT = IOST)
        END IF
      END IF
      RMXMN = 100.0 * ABS (RBOMX - RBOMN) / BAV
      IF (TAU .GT. PAR(95)) THEN
        IF (IGBL(63) .GT. 2) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99992, IOSTAT = IOST)
        END IF
        IF (NRAT / 2 .GT. M) IE = 1
        IF (M .GT. 1) THEN
          DO N = 2, M
            QS    = 0.0
            QC    = 0.0
            SQ    = 0.0
            CQ    = 0.0
            ATERM = 0
            BTERM = 0
            SIGAK = 0
            SIGBK = 0
            DO J = 1, NRAT
              COSNF = COS(RGBL(5) * N * (J - 1) / NRAT)
              SINNF = SIN(RGBL(5) * N * (J - 1) / NRAT)
              QC = QC + ZP(J) * COSNF
              QS = QS + ZP(J) * SINNF
              SQ = SQ + XYZR(J, 4) * SINNF**2
              CQ = CQ + XYZR(J, 4) * COSNF**2
              IF (NRAT .EQ. 5) THEN
                ATERM = ATERM + TRA(J) * COSNF
                BTERM = BTERM + TRA(J) * SINNF
                SIGAK = SIGAK + (STRA(J) * COSNF)**2
                SIGBK = SIGBK + (STRA(J) * SINNF)**2
              END IF
            END DO
            QC      =  QC * SQRT (2.0 / NRAT)
            QS      = -QS * SQRT (2.0 / NRAT)
            CQ      =  CQ * 2.0 / NRAT
            SQ      =  SQ * 2.0 / NRAT
            Q(N)    = SQRT (QC**2 + QS**2)
            SNTH    = 0.0
            CSTH    = 0.0
            PHI(N)  = 0.0
            SPHI(N) = 0.0
            SSQ(N)  = 0.0
            KQ(N)   = 0
            NQ(N)   = 0
            KPHI(N) = 0
            NPHI(N) = 0
            IF (Q(N) .GT. 0.0001) THEN
              SNTH = QS / Q(N)
              CSTH = QC / Q(N)
              IF (CSTH .GE. 0) THEN
                PHI(N) = ASIN(SNTH) * RGBL(6)
                IF (PHI(N) .LT. 0) PHI(N) = PHI(N) + 360.0
              ELSE
                PHI(N) = ACOS(CSTH) * RGBL(6)
                IF (SNTH .LT. 0) PHI(N) = 360.0 - PHI(N)
              END IF
              SSQ(N) = SQRT(ABS(CQ * CSTH**2 + SQ * SNTH**2))
              SPHI(N) = SQRT(ABS(CQ * SNTH**2
     1                + SQ * CSTH**2)) * RGBL(6) / Q(N)
            END IF
            IF (IGBL(63) .GT. 2) THEN
              QQN = Q(N)
              CALL GEN041 (QQN, SSQ(N), KQ(N), 4, NQ(N), IPR(68))
              CALL GEN041 (PHI(N), SPHI(N), KPHI(N), 4, NPHI(N),
     1                  IPR(68))
              IF (N .LT. 10) THEN
                FORMK(8:8)   = '1'
                FORMK(18:18) = '9'
                FORMK(46:46) = '1'
                FORMK(55:55) = '8'
              ELSE
                FORMK(8:8)   = '2'
                FORMK(18:18) = '8'
                FORMK(46:46) = '2'
                FORMK(55:55) = '7'
              END IF
              FORMK(20:20) = CHAR(ICHAR('0') + NQ(N))
              FORMK(57:57) = CHAR(ICHAR('0') + NPHI(N))
              WRITE (PRBUF, FORMK, IOSTAT = IOST)
     1          N, QQN , KQ(N), N, PHI(N), KPHI(N)
              CALL PLA263 (LU7, PRBUF, 132, 1, 1)
              IF (MODE .NE. 0) THEN
                VRT = VRT - 0.9
                CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
              END IF
            END IF
          END DO
        END IF
        IF (IE .EQ. 1) THEN
          N2    = NRAT / 2
          Q(N2) = 0.0
          QN2   = 0
          DO J = 1, NRAT
            Q(N2) = (-1)**(J - 1) * ZP(J) + Q(N2)
            QN2   = QN2 + XYZR(J, 4)
          END DO
          SSQ(N2) = SQRT(ABS(QN2 / NRAT))
          Q(N2)   = Q(N2) * SQRT(1.0 / NRAT)
          IF (IGBL(63) .GT. 2) THEN
            QQN2 = Q(N2)
            CALL GEN041 (QQN2, SSQ(N2), KQ(N2), 4, NQ(N2), IPR(68))
            IF (N2 .LT. 10) THEN
              FORML(8:8)   = '1'
              FORML(18:18) = '9'
            ELSE
              FORML(8:8)   = '2'
              FORML(18:18) = '8'
            END IF
            FORML(20:20) = CHAR(ICHAR('0') + NQ(N2))
            WRITE (PRBUF, FORML, IOSTAT = IOST) N2, QQN2, KQ(N2)
            CALL PLA263 (LU7, PRBUF, 132, 1, 1)
            IF (MODE .NE. 0) THEN
              VRT = VRT - 0.7
              CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
            END IF
          END IF
          AAZ = Q(N2)
        ELSE
          AAZ = 0
        END IF
        IF (NRAT .GT. 6 .AND. IGBL(63) .GT. 2) THEN
          WRITE (LU7, 99974, IOSTAT = IOST)
          CALL GEN041 (BQ, SBQ, KBQ, 4, NBQ, IPR(68))
          FORMX(37:37) = CHAR(ICHAR('0') + NBQ)
          WRITE (PRBUF, FORMX, IOSTAT = IOST) BQ, KBQ
          CALL PLA263 (LU7, PRBUF, 132, 1, 1)
        END IF
        IF (RMXMN .GT. PAR(328) .AND. IGBL(63) .GT. 2) THEN
          CALL PLA262 (4)
          WRITE (LU7, 99994, IOSTAT = IOST) RMXMN, PAR(328)
          IF (MODE .NE. 0) THEN
            VRT = VRT - 0.7
            CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
          END IF
        END IF
        IF (NRAT .EQ. 8) THEN
            IF (IGBL(63) .GT. 3) THEN
              CALL PLA262 (4)
              WRITE (LU7, 99979, IOSTAT = IOST)
            END IF
        ELSE IF (NRAT .EQ. 6) THEN
          IF (BQ .GT. PAR(12)) THEN
            CSTH = Q(N2) / BQ
          ELSE
            CSTH = 0.0
          END IF
          IF (CSTH .GT.  1.0) CSTH =  1.0
          IF (CSTH .LT. -1.0) CSTH = -1.0
          TH  = ACOS(CSTH) * RGBL(6)
          IF (BQ .GT. PAR(12)) THEN
            STH = SQRT(ABS((SSQ(2)**2 - SSQ(3)**2)
     1          * CSTH**2 + SSQ(3)**2)) * RGBL(6) / BQ
          ELSE
            STH = 0.0
          END IF
          IF (IGBL(63) .GT. 2) THEN
            CALL GEN041 (TH, STH, KTH, 2, NTH, IPR(68))
            CALL GEN041 (BQ, SBQ, KBQ, 4, NBQ, IPR(68))
            CALL PLA262 (1)
            WRITE (LU7, 99974, IOSTAT = IOST)
            FORMP(33:33) = CHAR(ICHAR('0') + NBQ)
            FORMP(62:62) = CHAR(ICHAR('0') + NTH)
            FORMP(90:90) = CHAR(ICHAR('0') + NPHI(2))
            WRITE (PRBUF, FORMP, IOSTAT = IOST)
     1        BQ, KBQ, TH, KTH, PHI(2), KPHI(2)
            CALL PLA263 (LU7, PRBUF, 132, 1, 1)
            IF (MODE .NE. 0) THEN
              VRT = VRT - 0.9
              CALL GGIP09 (0.0, PRBUF, 132, 0.3, 1, 1, 0.1, VRT)
            END IF
            IF (IGBL(63) .GT. 3) THEN
              CALL PLA262 (5)
              WRITE (LU7, 99981, IOSTAT = IOST)
            END IF
          END IF
        ELSE IF (NRAT .EQ. 5) THEN
          ATERM = ATERM * 0.4
          BTERM = -0.4 * BTERM
          SIGAK = 0.16 * SIGAK
          SIGBK = 0.16 * SIGBK
          TAUM  = SQRT(ATERM**2 + BTERM**2)
          PPAR  = ATAN2(BTERM, ATERM)
          STAUM = SQRT(SIGAK * ATERM**2 + SIGBK * BTERM**2) / TAUM
          SPPAR = SQRT(SIGBK * ATERM**2 + SIGAK * BTERM**2) / (TAUM**2)
          PPAR  = PPAR  * RGBL(6)
          SPPAR = SPPAR * RGBL(6)
          IPPAR = MIN (999, NINT(SPPAR * 10.0))
          ITAUM = MIN (999, NINT(STAUM * 10.0))
          IP    = JR(1)
          CALL GEN048 (-4, IFG(1, IP), 15, NO1)
          IF (IEN(NO1 + 1) .EQ. 3) THEN
            PPAR = PPAR + 288.0
            KK = 3
          ELSE
            KK = 1
          END IF
          IF (IGBL(63) .GT. 3) THEN
            CALL PLA262 (5)
            WRITE (LU7, 99980, IOSTAT = IOST)
          END IF
          PPAR = MOD(PPAR + 360.0, 360.0)
          IF (IGBL(63) .GT. 2) THEN
            WRITE (LU7, 99999, IOSTAT = IOST)
            WRITE (PRBUF, 99998, IOSTAT = IOST) PPAR, IPPAR, TAUM,
     1        ITAUM, NAMS(KK, 1)(2:7), NAMS(KK + 1, 1)(2:7)
            CALL GEN065 (LU7, PRBUF, 132, 1)
            WRITE (LU7, 99983, IOSTAT = IOST)
            WRITE (LU7, 99989, IOSTAT = IOST) 2.0 * PPAR
            CALL PLA262 (7)
            IF (ISUGR .EQ. 104 .AND. ION2 .EQ. 1) THEN
              CALL PLA262(5)
              WRITE (LU7, 99988, IOSTAT = IOST)
              IBPAR = MOD(NINT(PPAR / 18.0), 20)
              IF (MOD(IBPAR, 2) .EQ. 0) THEN
                IBP = (IBPAR / 2) + 3
                IBP1 = MOD (IBP + 4, 5) + 1
                IBP2 = MOD (IBP    , 5) + 1
                TXT1 = '-exo '
                TXT2 = '-endo'
                IF (MOD (IBP, 2) .EQ. 0) THEN
                  TXT1 = '-endo'
                  TXT2 = '-exo '
                END IF
                WRITE (LU7, 99987, IOSTAT = IOST)
     1            NAMS(IBP1, 1)(2:7), TXT1, NAMS(IBP2, 1)(2:7), TXT2,
     2            ACONF
              ELSE
                IBP = (IBPAR - 1) / 2 + 3
                IBP1 = MOD (IBP, 5) + 1
                TXT1 = '-endo'
                IF (MOD (IBP, 2) .EQ. 0) TXT1 = '-exo '
                WRITE (LU7, 99986, IOSTAT = IOST)
     1            NAMS(IBP1, 1)(2:7), TXT1, ACONF
              END IF
            ELSE
              IBPAR = MOD(NINT(PHI(2) / 18.0), 20)
              CALL PLA262 (3)
              IF (MOD(IBPAR, 2) .EQ. 1) THEN
                IBP = (IBPAR / 2)
                IBP1 = MOD (IBP,     5) + 1
                IBP2 = MOD (IBP + 1, 5) + 1
                WRITE (LU7, 99985, IOSTAT = IOST) NAMS(IBP1, 1)(2:7),
     1                             NAMS(IBP2, 1)(2:7)
              ELSE
                IBPAR = IBPAR / 2
                IBP1 = MOD (IBPAR, 5) + 1
                WRITE (LU7, 99984, IOSTAT = IOST) NAMS(IBP1, 1)(2:7)
              END IF
            END IF
            WRITE (LU7, 99974, IOSTAT = IOST)
          END IF
        END IF
        IF (IGBL(63) .GT. 2) CALL PLA218 (Q, PHI, AAZ, NRAT, LU7)
      ELSE
        IF (TAU .LT. PAR(95) .AND.
     1      IGBL(63) .GT. 2)  THEN
          CALL PLA262 (3)
          WRITE (LU7, 99974, IOSTAT = IOST)
          WRITE (PRBUF, 99995, IOSTAT = IOST) TAU, PAR(95)
          WRITE (LU7, 99961, IOSTAT = IOST) PRBUF
          WRITE (LU7, 99974, IOSTAT = IOST)
          IF (MODE .NE. 0) THEN
            VRT = VRT - 0.9
            CALL GGIP09 (0.0, PRBUF, 132, 0.3, 2, 1, 0.1, VRT)
          END IF
        END IF
      END IF
      IF (TAU .LT. PAR(96)) CALL PLA031
      IF (IPR(2) .NE. 0) IPR(2) = 0
      IF (NRAT .EQ. 6 .AND. TAU .GT. PAR(97) .OR.
     1    NRAT .EQ. 5 .AND. TAU .GT. PAR(94)) THEN
        NBND = 0
        NHAT = 0
        DO L = 1, 2
          DO I = 1, NRAT
            J  = JR(I)
            NC = - NINT(CON(J, NP4))
            IF (NC .LT. 0) NC = NP4
            CALL PLA047 (LABA(J), NQ1, IDUM, JDUM, IPR(71),
     1        IGBL(55), 0, 1 - IGBL(55))
            DO 40 K = 1, NC
              M = NINT(CON(J, K))
              N = I + NRAT - 2
              IF (M .EQ. JR(MOD(I, NRAT) + 1) .OR.
     1            M .EQ. JR(MOD(N, NRAT) + 1)) GO TO 40
              CALL GEN048 (-1, IFG(1, M), 7, IHAT)
              IF (L + IHAT .EQ. 2) GO TO 40
              NHAT = NHAT + IHAT
              CALL PLA047 (LABA(M), NQ2, IDUM, JDUM, IPR(71),
     1          IGBL(55), 0, 1 - IGBL(55))
              CALL PLA053 (J, M, 0, 0, D, SD, ISD, NDEC, IER)
              IF (IER .EQ. 0) THEN
                FORMI(19:19) = CHAR(ICHAR('0') + NDEC)
                CALL PLA227 (J, M, VECN)
                ANG = XPV(1) * VECN(1) + XPV(2) * VECN(2)
     1              + XPV(3) * VECN(3)
                ANG = ABS(ANG)
                IF (ANG .GT. 1.0) ANG = 1.0
                IANG = 0
                ANG  = ACOS(ANG) * RGBL(6)
                A    = 0
                IF (D .NE. 0.0) THEN
                  DO KKK = 1, 3
                    A = A + XSPV(KKK)**2 + (VECN(KKK) * SD / D)**2
                  END DO
                  A = RGBL(6) * SQRT(A)
                END IF
                CALL GEN041 (ANG, A, IANG, 2, NDEC, IPR(68))
                FORMI(39:39) = CHAR(ICHAR('0') + NDEC)
                KDES = 'Bi'
                IF (ANG .GT. 60) KDES = 'Eq'
                IF (ANG .LT. 30) KDES = 'Ax'
                NBND = NBND + 1
                IF (IGBL(63) .GT. 2) THEN
                  IF (NBND .EQ. 1) THEN
                    CALL PLA262 (4)
                    WRITE (LU7, 99972, IOSTAT = IOST)
                  END IF
                  IF (NHAT .EQ. 1) THEN
                    CALL PLA262 (1)
                    WRITE (LU7, 99974, IOSTAT = IOST)
                  END IF
                  WRITE (PRBUF, FORMI, IOSTAT = IOST)
     1              NQ1, NQ2, D, ISD, ANG, IANG, KDES
                  CALL PLA263 (LU7, PRBUF, 132, 1, 1)
                END IF
              END IF
   40       CONTINUE
          END DO
        END DO
      END IF
   50 IF (MODE .NE. 0) THEN
        CALL GGIP (0.0, 0.0, 0.0, 3)
        CALL PLA013 (1, 1)
      END IF
      RETURN
99999 FORMAT (/, 'Pseudorotation Parameters P and Tau(M), (S.T.Rao, ',
     1 'E.Westhof & M.Sundaralingam, Acta Cryst (1981), A37, 421-425)',
     2 /, 132('-'))
99998 FORMAT ('P =', F6.1, '(', I3, ') Degree, Tau(M) =', F6.1,
     1 '(', I3, ') Deg. for Reference Bond ', A, '--> ', A,
     2 ' [add 144 Deg. to P for each shift to next Bond]')
99997 FORMAT (I3, '-Membered Ring (', I2, ')',
     1         8(3X, A, ' -->'))
99996 FORMAT (132('-'), /, 5X, '(Continued)', 6X, 8(3X, A, ' -->'))
99995 FORMAT ('No C & P - Puckering Analysis since <Tau> =', F5.1,
     1         ' < ', F6.1, ' Deg.')
99994 FORMAT (/, ':: C & P - Puckering Analysis may be DUBIOUS since',
     1' %(Bond Distance Range/Average) =', F6.1, ' > ', F5.1, ' %', /)
99992 FORMAT ('Cremer & Pople Puckering Parameters', 2X,
     1 '[D. Cremer & J.A. Pople, J.Amer.Chem.Soc., 97, (1975), ',
     2 '1354-1358]', /, 132('-'))
99991 FORMAT ('Hexafuranose Nomencl.', 4X, 'O5', 11X, 'C2', 11X,
     1        'C3', 11X, 'C4', 11X, 'C5', 9X,
     2        '(IUPAC-IUB: Eur.J.Biochem. (1983), 131, 5-7)')
99990 FORMAT ('Pentafuranose Nomencl.', 3X, 'O4', 11X, 'C1', 11X,
     1        'C2', 11X, 'C3', 11X, 'C4', 9X,
     2        '(IUPAC-IUB: Eur.J.Biochem. (1983), 131, 5-7)')
99989 FORMAT (/, 'Note: DELTA [Defined in Altona,C.,Geise,H.J.,',
     1        'Romers,C.(1968). Tetrahedron, 24, 13-32] = 2 * P =',
     2        F7.1, ' Deg.')
99988 FORMAT (/, 'Nearest Furanose Pucker Descriptor - (see W. Saenger',
     1        ', Principles of Nucleic Acid Structure, 1983, pp19',
     2        /, 132('-'))
99987 FORMAT ('Descriptor: T(wisted)  ', 2A, ', ', 2A, 5X,
     1        'Absolute Configuration: ', A)
99986 FORMAT ('Descriptor: E(nvelope) ', 2A, 5X,
     1        'Absolute Configuration: ', A)
99985 FORMAT (/, 'Closest Pucker Descriptor: Twisted on ',
     1        A, '-- ', A)
99984 FORMAT (/, 'Closest Pucker Descriptor: Envelope on ', A)
99983 FORMAT (84X, '[Ring-Sequence Change of Sense : P ---->>> - P]')
99982 FORMAT (//, '*** NOTE *** ',
     1 '- For Ring Puckering Comparisons: Make Sure that the',
     2 ' Absolute Configuration, Pivot Atom and Cyclic Sense Agree.',
     3 /, 13X, '- The "RING AT1 AT2 AT3 ... ATn" Instruction Gives',
     4 ' the User Explicit Choice of Pivot Atom (AT1) and Sense',
     5 ' (AT2).', /, 13X, '- Use TRNS Instructions to Obtain the',
     6 ' Required Absolute Configuration.',/, 13X, '- The Values of',
     7 ' Theta and Phi [ = Phi(2)] Depend on the Abs. Conf. and the',
     8 ' Choice of the First and Second Ring Atom.', /, 13X,
     9 '- Alternatively, Appropriate Phase Shifts may be Applied',
     * ' to the Same Effect (see Below)', //, 13X, 'For Correct Usage',
     1 ' of C&P Puckering Parameters see also: D. Cremer, ',
     2 'Acta Cryst. (1984). B40, 498-500.', /)
99981 FORMAT (//, '* NOTE * ',
     1 '- A Change of the Absolute Configuration Transforms Theta',
     2 ' into 180 - Theta and Phi into 180 + Phi.', /, 9X,
     3 '- A Cyclic Forward Shift of the Pivot Atom from At1 to At2',
     4 ' Transforms Theta into 180 - Theta and Phi into Phi + 120.',
     5 /, 9X,
     6 '- A Change of the Sense Transforms Theta into 180 - Theta',
     7 ' and Phi into 180 - Phi, and Vice Versa.')
99980 FORMAT (/, '* NOTE * ',
     1 '- A Change of the Absolute Configuration Transforms Phi(2)',
     2 ' into 180 + Phi(2).', /, 9X,
     3 '- A Cyclic Forward Shift of the Pivot Atom from At1 to At2',
     4 ' Transforms Phi(2) into Phi(2) + 144.', /, 9X,
     5 '- A Change of the Sense Transforms Phi(2) into 180 - Phi(2).')
99979 FORMAT (/, '* NOTE * ',
     1 '- A Cyclic Forward Shift of the Pivot Atom from At1 to At2',
     2 ' Transforms Q(4) into - Q(4), Phi(2) into Phi(2) + 90 and', /,
     3 11X, 'Phi(3) into Phi(3) + 135')
99974 FORMAT (1X)
99972 FORMAT (31X, 'Analysis of Ring Substituents', /, 31X,
     1 29('='), /, 6X, 'Bond', 13X, 'Distance', 5X,
     2 'Angle with C&P Plane Normal', /, 63('-'))
99971 FORMAT (132('-'))
99970 FORMAT ('Ring Puckering Analysis (Cremer & Pople) - (e.s.d.',
     1 ' following Norrestam, Acta Cryst. (1981), A37, 764-765)', /,
     2 132('-'), //, 19X, 'Symmetrical Forms', 70X, 'References', /,
     3 19X, 17('-'), 70X, 10('-'))
99969 FORMAT ('5-Membered Rings : E : Envelope  - Phi = k X 36',  24X,
     1 'D. Cremer & J.A. Pople, J.Amer.Chem.Soc., 97,(1975),1354-1358',
     2 /, 19X, 'T : Half Chair- Phi = k X 36 + 18 ', /)
99968 FORMAT ('6-Membered Rings : C : Chair     - Th = 0.0', 37X,
     1 'J.C.A. Boeyens, J.Cryst.Mol.Struct. 8,(1978),317-320', /, 19X,
     2 'H : Half-Chair- Th = 50.8; Phi = k X 60 + 30', /, 19X,
     3 'E : Envelope  - Th = 54.7; Phi = k X 60', /, 19X,
     4 'S : Screw-Boat- Th = 67.5; Phi = k X 60 + 30', /, 19X,
     5 'B : Boat      - Th = 90.0; Phi = k X 60', /, 19X,
     6 'T : Twist-Boat- Th = 90.0; Phi = k X 60 + 30', /)
99967 FORMAT ('7-Membered Rings : C : Chair', 43X,
     1 'I.K. Boessenkool et al., J.Cryst.Mol.Struct., 10,(1980),11-18',
     2 /, 18X, 'TC : Twist-Chair', /, 19X, 'B : Boat', /, 18X,
     3 'TB : Twist-Boat', /)
99966 FORMAT ('8-Membered Rings :CR : Crown     - Q(2)=Q(3)=0,    Q',
     1 '(4)', 2A, '0', 28X, 'Palyulin et al., J.Mol.Struct.,70,(1981',
     2 '),65-75'/19X,'B : Boat      - Q(3)=Q(4)=0,    Q(2)',A,' 0 Ph',
     3 'i(2) = k X 90 + 45'/18X, 'BB : Boat-Boat - Q(3)=Q(4)=0,  ',
     4 '  Q(2)', A, ' 0 Phi(2) = k X 90 '/19X, 'C : Chair     - ',
     5 'Q(2)=Q(4)=0,    Q(3)', A, ' 0 Phi(3) = k X 45 '/18X, 'LC : L',
     6 'ong-Chair- Q(2)=Q(4)=0,    Q(3)', A, ' 0 Phi(3) = k X 45',
     7 ' + 22.5'/)
99965 FORMAT (/, 'Definitions (All Values Rounded on Esd)', /,
     1  40('-'), /, 'Dev', 12X, '- Deviation of Atom I from ',
     2 'Cremer&Pople Plane (Defined Differently from Least-Squares ',
     3 'Plane)', /, 'Cs(I),C2(I)    - Mirror Plane and 2-Axis Asym. ',
     4 'Par. for Atom I (See Duax et al., Topics in Stereochemistry,',
     5 'V-9, (1976) pp.271-383)', /, 'Cs(I-J),C2(I-J)- Asymmetry ',
     6 'Parameters for Bond I-J', /, 'Tors(I-J)      - Torsion Angle',
     7 ' for Bond I-J', /)
99964 FORMAT (//,
     1 'Descriptors for Torsion Angles', 40X, 'Descriptors for Ring ',
     2 'Substituents (J.Appl.Cryst.,1983,16,431)', /, 30('-'), 40X,
     3 62('-'), //, 'Torsion Angle Range', 5X, 'Full Descriptor', 5X,
     4 'Short Descriptor', 10X, 'Angle Range of Subst.   Full ',
     5 'Descriptor', 5X, 'Short Descriptor', /, 60('-'), 10X, 60('-'),
     5 /, 4X, '0   TO   30 Deg', 5X, '+  Syn-Periplanar', 7X, '+sp',
     6 23X, '0    TO  30 Deg.', 12X, 'Axial', 12X, 'ax', /, 3X,
     7 '30   to   90', 9X, '+  Syn-Clinal', 11X, '+sc', 22X,
     8 '30    to  60', 11X, 'Bisectional', 12X, 'bi', /, 3X,
     9 '90   to  150', 9X, '+ Anti-Clinal',11X, '+ac', 22X,
     * '60    to  90', 12X, 'Equatorial', 12X, 'eq', /, 2X,
     1 '150   to  180', 9X, '+ Anti-Periplanar', 7X, '+ap', /, 4X,
     2 '0   to  -30', 9X, '-  Syn-Periplanar', 7X, '-sp', /, 2X,
     3 '-30   to  -90', 9X, '-  Syn-Clinal', 11X, '-sc', /, 2X,
     4 '-90   to -150', 9X, '- Anti-Clinal', 11X, '-ac', /, 1X,
     5 '-150   to -180', 9X, '- Anti-Periplanar', 7X, '-ap')
99962 FORMAT (20X, 8(10X, A))
99961 FORMAT (A)
99960 FORMAT ('Weighted Average Ring Bond Distance = ', F6.4, '(',
     1 I3,',',I3,') Ang. - NOTE: 1st esd. Internal, 2nd esd External.')
99959 FORMAT ('Weighted Average Abs. Torsion Angl. = ', F6.2, '(', I3,
     1 ',',I3,') Deg.',3X,'see: e.g. Domenicano et al., Acta Cryst.',
     2 '(1975), B31, 221-234.')
      END SUBROUTINE PLA095
      SUBROUTINE PLA096 (MODE, XNQ, D, CRIT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,
     1 NP9=118,NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP50=100,
     3 NP51=100,NP53=1630,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /BONDVAL/ VALENCE(NP53)
      CHARACTER VALENCE*18
      COMMON /PLC96/ NQ1, NQ2(NP50), NQ3, NQ4, VL(9), NQ5(NP51)
      COMMON /PL096/ DIST(NP50), NVAL(NP51), SUM, MAT, NVL, NAT, ISKP
      CHARACTER XNQ*8, NQ*7, NQ1*7, NQ2*7, NQ3*2, NQ4*2, NQ5*7, VL*2
      COMMON /C112/ T112
      CHARACTER VAL(10)*6
      CHARACTER T112*80
      CHARACTER SOURCE*25
      DATA (VAL(I), I = 1, 10) /'(I)', '(II)', '(III)', '(IV)', '(V)',
     1  '(VI)', '(VII)', '(VIII)', '(IX)', ' '/
C * VALENCE BOND ANALYSIS
      NB   = 0
      NE   = 0
      NSUM = 0
      VSUM = 0.0
      NQ   = XNQ(2:7)
      IF (IPR(57) .EQ. 0) THEN
        NSUM = 0
        IF (MODE .EQ. 0) THEN
          IF (D .LT. 0.0) THEN
            NAT         = 0
            SUM         = 0.0
            NB          = 0
            NE          = 0
            T112        = ' '
            T112(76:76) = CHAR(0)
            IF (IGBL(121) .GT. 0) THEN
              ISKP = 0
            ELSE
              ISKP = 1
            END IF
          ELSE
            IAT = NINT(D)
            CALL GEN048 (-1, IFG(1, IAT), 19, IMET)
            CALL GEN048 (-4, IFG(1, IAT), 15, IVAL)
            IATPRP = IATPR(IEN(IVAL + 1))
            IF ((IGBL(121) .GT. 0 .OR.
     1        ((IMET .GT. 0 .OR. IEN(IVAL + 1) .EQ. 92) .AND.
     2          IATPRP .NE. 5 .AND. IATPRP .NE. 6))
     3        .AND. XNQ(1:1) .EQ. ' ') THEN
              ISKP = 0
            ELSE
              ISKP = 1
            END IF
            IF (NAT .LT. NP51) THEN
              NAT      = NAT + 1
              NQ1      = NQ
              NQ5(NAT) = NQ
              MAT      = 0
              CALL GEN105 (2, NQ(2:2), N)
              IF (N .LT. 0) THEN
                NQ3 = NQ(1:1)
              ELSE
                NQ3 = NQ(1:2)
              END IF
              NVL   = 0
              IVLMX = 9
              DO 10 J = 1, NP53
                IF (VALENCE(J)(1:2) .EQ. NQ3) THEN
                  IF (NVL .EQ. 0) THEN
                    NVL   = 1
                    VL(1) = ' '//VALENCE(J)(3:3)
                  ELSE
                    IF (' '//VALENCE(J)(3:3) .NE. VL(NVL)) THEN
                      NVL     = NVL + 1
                      VL(NVL) = ' '//VALENCE(J)(3:3)
                    END IF
                  END IF
                ELSE IF (VALENCE(J)(4:5) .EQ. NQ3) THEN
                  IF (NVL .EQ. 0) THEN
                    NVL   = 1
                    VL(1) = VALENCE(J)(6:7)
                  ELSE
                    DO I = 1, NVL
                      IF (VALENCE(J)(6:7) .EQ. VL(I)) GO TO 10
                    END DO
                    NVL     = NVL + 1
                    VL(NVL) = VALENCE(J)(6:7)
                  END IF
                END IF
                IF (IPR(325) .GE. 0 .AND. NVL .GT. 0) THEN
                  READ (VL(NVL), 99995) IVL
                  SELECT CASE (NQ3)
                    CASE ('O ')
                      IVLMX = -9
                    CASE ('N ')
                      IVLMX = -9
                    CASE ('Ag')
                      IVLMX = 1
                    CASE ('Cr')
                      IVLMX = 3
                    CASE ('Fe')
                      IVLMX = 3
                    CASE ('Mn')
                      IVLMX = 4
                    CASE ('Ni')
                      IVLMX = 3
                    CASE ('Ti')
                      IVLMX = 4
                    CASE ('Ru')
                      IVLMX = 3
                    CASE ('Pd')
                      IVLMX = 2
                    CASE ('Ir')
                      IVLMX = 3
                    CASE ('Co')
                      IVLMX = 3
                    CASE ('Pt')
                      IVLMX = 2
                    CASE ('V ')
                      IVLMX = 5
                    CASE ('Sb')
                      IVLMX = 5
                    CASE ('Eu')
                      IVLMX = 3
                  END SELECT
                  IF (IVL .GT. IVLMX .OR. IVL .LT. 0) NVL = NVL - 1
                END IF
   10         CONTINUE
            END IF
          END IF
        ELSE IF (MODE .EQ. 1 .AND. ISKP .EQ. 0) THEN
          IF (XNQ(1:1) .EQ. ' ') THEN
            IF (MAT .LT. NP50) THEN
              MAT       = MAT + 1
              NQ2(MAT)  = NQ
              DIST(MAT) = D
            END IF
          ELSE
            IF (XNQ(2:3) .NE. 'H(') ISKP = 1
          END IF
        ELSE IF (MODE .EQ. -1) THEN
          IF (ISKP .EQ. 0) THEN
            DIFM = 10.0
            DIF  = 10.0
            DO K = 1, NVL
              READ (VL(K), 99995) IVL
              IF (IGBL(63) .GT. 2) THEN
                CALL PLA262 (0)
                WRITE (LU7, 99998, IOSTAT = IOST) VL(K), CRIT
                WRITE (LU7, 99996, IOSTAT = IOST)
              END IF
              NDUB = 0
              SUM  = 0.0
              DMX  = 0.0
              L    = 0
              IGN  = 0
              IF (MAT .GT. 0) THEN
                DO 30 I = 1, MAT
                  NTV = 0
                  IF (NAT .GT. 0) THEN
                    DO NT = 1, NAT
                      CALL GEN039 (1, NQ5(NT), 1, 7, NB, NE)
                      IF (NQ2(I)(1:NE) .EQ. NQ5(NT)(1:NE))
     1                    NTV = NVAL(NT)
                    END DO
                  END IF
                  CALL GEN105 (2, NQ2(I)(2:2), N)
                  IF (N .LT. 0) THEN
                    NQ4 = NQ2(I)(1:1)
                  ELSE
                    NQ4 = NQ2(I)(1:2)
                  END IF
                  IF (NQ3 .EQ. NQ4) THEN
                    IF (NQ3 .EQ. 'O ' .OR. NQ3 .EQ. 'N ') GO TO 30
                  END IF
                  IF (NQ3 .EQ. 'N ' .AND. NQ4 .EQ. 'C ') GO TO 30
                  DO 20 J = 1, NP53
                    IF (VL(K)(1:1) .NE. '-') THEN
                      IF (VL(K)(2:2) .EQ. VALENCE(J)(3:3)) THEN
                        IF (NQ3 .EQ. VALENCE(J)(1:2) .AND.
     1                    NQ4 .EQ. VALENCE(J)(4:5)) THEN
                          READ (VALENCE(J), 99997) R, B
                          BV = EXP ((R - DIST(I)) / B)
                          IF (BV .GT. IVL * CRIT) THEN
                            SUM = SUM + BV
                            DIF = ABS(IVL - SUM)
                            L   = L + 1
                            DMX = MAX (DMX, DIST(I))
                            IF (IGBL(63) .GT. 2) THEN
                              IF (VALENCE(J)(18:18) .EQ. '*') THEN
                                SOURCE = 'PLATON'
                              ELSE
                                SOURCE = ' '
                              END IF
                              WRITE (LU7, 99999, IOSTAT = IOST) L, NQ1,
     1                          NQ2(I), DIST(I), R, B, BV, SUM, DIF,
     2                          SOURCE
                            END IF
                          ELSE
                            IF (IGBL(63) .GT. 0) THEN
                              WRITE (LU7, 99990, IOSTAT = IOST)
     1                          NQ1, NQ2(I), DIST(I)
                            END IF
                          END IF
                          GO TO 30
                        END IF
                      END IF
                    ELSE
                      IF (VL(K) .EQ. VALENCE(J)(6:7)) THEN
                        IF (NQ3 .EQ. VALENCE(J)(4:5) .AND.
     1                      NQ4 .EQ. VALENCE(J)(1:2)) THEN
                          IF (NTV .GT. 0) THEN
                            READ (VALENCE(J)(3:3), 99994) M
                            IF (M .NE. NTV) GO TO 20
                          END IF
                          READ (VALENCE(J), 99997) R, B
                          BV  = EXP ((R - DIST(I)) / B)
                          IF (BV .GT. IABS(NTV) * CRIT) THEN
                            SUM = SUM + BV
                            DIF = ABS(IABS(IVL) - SUM)
                            L   = L + 1
                            DMX = MAX (DMX, DIST(I))
                            IF (IGBL(63) .GT. 2) THEN
                              WRITE (LU7, 99999, IOSTAT = IOST) L, NQ1,
     1                          NQ2(I), DIST(I), R, B, BV, SUM, DIF
                            END IF
                          ELSE
                            IF (IGBL(63) .GT. 2) THEN
                              WRITE (LU7, 99990, IOSTAT = IOST)
     1                          NQ1, NQ2(I), DIST(I)
                            END IF
                          END IF
                          GO TO 30
                        END IF
                      END IF
                    END IF
   20             CONTINUE
                  NDUB = NDUB + 1
                  IF (IGBL(63) .GT. 2) THEN
                    WRITE (LU7, 99991, IOSTAT = IOST)
     1                NQ1, NQ2(I), DIST(I)
                  END IF
                  IHTEST = 0
                  IF (NQ2(I)(1:1) .EQ. 'H') THEN
                    CALL GEN105 (2, NQ2(I)(2:2), IHTEST)
                  END IF
                  IF (IHTEST .LT. 0) THEN
                    IF (DIST(I) .LT. 1.0) NDUB = NDUB + 1
                  ELSE
                    IF (DIST(I) .LT. 2.4) NDUB = NDUB + 1
                  END IF
   30           CONTINUE
                IF (NDUB .EQ. 0 .AND. DIF .LT. DIFM .AND. IGN .EQ. 0)
     1            THEN
                  NVAL(NAT) = IVL
                  DIFM      = DIF
                  VSUM      = SUM
                  NSUM      = L
                  DMAX      = DMX
                END IF
              END IF
            END DO
            IF (VSUM .GT. 0.0 .AND. NSUM .GT. 0) THEN
              N = NVAL(NAT)
              IF (N .LT. 1 .OR. N .GT. 9) N = 10
              NQ1 = VAL(N)
              IF (NQ5(NAT)(1:2) .NE. 'Cu' .OR. NSUM .NE. 4) THEN
                IF (LU6 .NE. 0) THEN
                  WRITE (T112(1:75), 99993, IOSTAT = IOST)
     1              NQ5(NAT), NQ1, VSUM, DMAX, NSUM
                  WRITE (LU6, 99992, IOSTAT = IOST) T112(1:75)
                  T112(76:76) = CHAR(0)
                END IF
C * ALERT _794
                CALL PLA231 (794, 2, -999.0, VSUM, NQ5(NAT), NQ1)
              END IF
            END IF
            CALL PLA262 (0)
          ELSE
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (I2, 2X, 2A, F10.4, F7.4, F5.2, 3F6.3, ' - ', A)
99998 FORMAT ('Bond Valence Analysis - Assume Valence = ', A,
     1        ' -- Min. BondVal Contribution = ', F5.2,
     2        ' * Cation Val.', /, 100('='), /,
     1        'N.E. Brese & M. O''Keeffe',
     2        ' (1991) Acta Cryst. B47, 192-197.', /,
     3        'I.D. Brown (2002). The Chemical Bond in Inorganic',
     4        ' Chemistry: The Bond Valence Model. ',
     5        'Oxford University Press.')
99997 FORMAT (7X, F6.0, F4.0)
99996 FORMAT (/, 'Nr', 6X, 'Bond', 12X, 'Dist', 6X, 'R',
     1         4X, 'B  BVal   Sum  Diff - Source')
99995 FORMAT (I2)
99994 FORMAT (I1)
99993 FORMAT (2A, ' Vsum =', F6.2, ', Dmax =', F8.4, ', Nsum =', I3)
99992 FORMAT (/, ':: ', A)
99991 FORMAT (4X, 2A, F10.4, 33X,
     1       '(Contribution not Tabulated, Result Dubious !)')
99990 FORMAT (4X, 2A, F10.4, 33X,
     1       '(Contribution below Minimum, Skipped)')
      END SUBROUTINE PLA096
      SUBROUTINE PLA097 (MODE, ARU)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      IF (MODE .EQ. 0) THEN
        IPR(25) = 0
      ELSE IF (MODE .GT. 0) THEN
        IF (IPR(13) + IPR(25) + 2 .LT. NP11) THEN
          NEWARU = NINT(ARU * PAR(42))
          IF (IPR(25) .GT. 0) THEN
            DO I = 1, IPR(25)
              IF (NEWARU .EQ. MOL(IPR(13) + I)) GO TO 10
            END DO
          END IF
          IPR(25) = IPR(25) + 1
          MOL(IPR(25) + IPR(13)) = NEWARU
        END IF
      ELSE IF (MODE .LT. 0) THEN
        IF (IPR(25) .GT. 0) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99998, IOSTAT = IOST)
          DO I = 1, IPR(25)
            ML = MOL(IPR(13) + I)
            CALL GEN098 (ML, PAR(42), MOL1, MOL2, MOL3, MOL4, IRS0)
            XJX(4) = MOL2
            XJX(5) = MOL3
            XJX(6) = MOL4
            CALL SGSM (ICL, MOL1, XJX, 0, 20, IERR)
            ML = INT(ML / PAR(42))
            CALL PLA262 (1)
            WRITE (LU7, 99999, IOSTAT = IOST) ML, ICL(1:30)
          END DO
        END IF
      END IF
   10 RETURN
99999 FORMAT ('[', I6, '] = ', A)
99998 FORMAT (1X)
      END SUBROUTINE PLA097
      SUBROUTINE PLA098 (N1, N2, KB, DIS, SDIS, DIFF, IDS12, MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION KSM(71)
      CHARACTER NOTE*1, HYB1*1, HYB2*1, BNDPR*8
      COMMON /BONDTYPE/ BNDTP(11)
      CHARACTER BNDTP*5
      TDIS  = 0.0
      BNDPX = 0.0
      IF (MODE .GT. 0) THEN
        CALL GEN048 (-4, IFG(1, N1), 24, IHYB1)
        CALL GEN048 (-4, IFG(1, N2), 24, IHYB2)
        CALL GEN048 (-4, IFG(1, N1), 15, NO1)
        CALL GEN048 (-4, IFG(1, N2), 15, NO2)
        IF (IHYB1 .EQ. 0) IHYB2 = 0
        IF (IHYB2 .EQ. 0) IHYB1 = 0
        NOA  = NO1 * 10 + IHYB1
        NOB  = NO2 * 10 + IHYB2
        IEN1 = IEN(NO1 + 1)
        IEN2 = IEN(NO2 + 1)
        IAT1 = IATNR(IEN1)
        IAT2 = IATNR(IEN2)
        IF (IAT1 .LT. IAT2) THEN
          CALL GEN014 (NOA,   NOB)
          CALL GEN014 (IEN1, IEN2)
          CALL GEN014 (IAT1, IAT2)
        END IF
        IF (IAT2 .GT. 1) IPR(315) = IPR(315) + 1
        IF (IDS12 .NE. 2000) GO TO 50
        IEN12 = IEN1 * 1000 + IEN2
        IF (IHYB1 .LT. IHYB2) CALL GEN014 (IHYB1, IHYB2)
        INR = 0
        IF (IEN12 .EQ. 2001) THEN
          IF (IABS(IPR(493)) .EQ. 6) THEN
            TDIS = 1.08
          ELSE
            TDIS = 0.96
          END IF
          INR  = 350
        ELSE IF (IEN12 .EQ. 4001) THEN
          IF (IABS(IPR(493)) .EQ. 6) THEN
            TDIS = 1.009
          ELSE
            TDIS = 0.87
          END IF
          INR  = 352
        ELSE IF (IEN12 .EQ. 3001) THEN
          NC =  - NINT(CON (N2, NP4))
          IF (NC .EQ. 1) THEN
            IF (IABS(IPR(493)) .EQ. 6) THEN
              TDIS = 0.983
            ELSE
              TDIS = 0.82
            ENDIF
            INR  = 354
          END IF
        ELSE IF (IEN12 .EQ. 2002) THEN
          IF (SDIS .GT. 0.0001) THEN
            IPR(317) = IPR(317) + 1
            PAR(318) = PAR(318) + SDIS
          END IF
          IF (IPR(483) .GT. 0 .AND. IPR(484) .GT. 0) THEN
            IF (IHYB1 .EQ. 3) THEN
              IF (IHYB2 .EQ. 3) THEN
                TDIS = 1.54
                INR  = 360
              ELSE IF (IHYB2 .EQ. 2) THEN
                TDIS = 1.52
                INR  = 362
              ELSE IF (IHYB2 .EQ. 1) THEN
                TDIS = 1.46
                INR  = 364
              ELSE
                TDIS = 1.50
                INR  = 366
              END IF
            ELSE IF (IHYB1 .EQ. 2) THEN
              IF (IHYB2 .EQ. 2) THEN
                NROXY = 0
                DO I = 1, 3
                  M1 = NINT (CON(N1, I))
                  M2 = NINT (CON(N2, I))
                  CALL GEN048 (-4, IFG(1, M1), 15, K)
                  IF (IEN(K + 1) .EQ. 3) NROXY = NROXY + 1
                  CALL GEN048 (-4, IFG(1, M2), 15, K)
                  IF (IEN(K + 1) .EQ. 3) NROXY = NROXY + 1
                END DO
                IF (NROXY .NE. 4) THEN
                  TDIS = 1.34
                  INR  = 368
                END IF
              ELSE IF (IHYB2 .EQ. 1) THEN
                TDIS = 1.31
                INR  = 370
                MSP  = 0
                IF (NINT (CON(N1, NP4)) .EQ. -2) THEN
                  MSP = NINT(CON(N1, 1))
                ELSE IF (NINT (CON(N2, NP4)) .EQ. -2) THEN
                  MSP = NINT(CON(N2, 1))
                END IF
                IF (MSP .NE. 0) THEN
                  CALL GEN048 (-4, IFG(1, MSP), 15, K)
                  IF (IEN(K + 1) .EQ. 4) TDIS = 1.44
                END IF
              ELSE
                TDIS = 1.50
                INR  = 366
              END IF
            ELSE IF (IHYB1 .EQ. 1) THEN
              IF (IHYB2 .EQ. 1) THEN
                TDIS = 1.25
                INR  = 372
              ELSE
                TDIS = 1.50
                INR  = 366
              END IF
            ELSE
              TDIS = 1.50
              INR  = 366
            END IF
          END IF
        ELSE IF (IEN12 .EQ. 4004) THEN
          IF (DIS .GT. 1.45) THEN
C * ALERT _374
            CALL PLA231 (374, 2, DIS - 1.45,  DIS, NAMS(KB, 1)(1:7),
     1                   NAMS(KB, 2)(1:7))
          END IF
          GO TO 10
        END IF
        IF (INR .NE. 0) THEN
          DIFF = ABS(DIS - TDIS)
          IF (DIFF .GT. 0.001) THEN
            IF (DIS .GT. TDIS) INR = INR + 1
C * ALERT _3xx
            IF (INR .EQ. 371 .AND. DIFF .GT. 0.1) DIFF = -999.0
            CALL PLA231 (
     1        INR, 2, DIFF, DIS, NAMS(KB, 1)(1:7), NAMS(KB, 2)(1:7))
          END IF
        END IF
   10   NO12  = NOA  * 1000 + NOB
        IM    = IPR(47)
        IF (IM .GT. 0) THEN
          DO I = 1, IM
            IF (NO12 .EQ. KBO(I, 1)) THEN
              IF (KBO(I, 2) .EQ. 0) BOK(I, 1) = 9999.0
              KBO(I, 2) = KBO(I, 2) + 1
              BOK(I, 3) = BOK(I, 3) + DIS
              IF (SDIS .GT. 0.0) THEN
                KBO(I, 5) = KBO(I, 5) + 1
                BOK(I, 6) = BOK(I, 6) + SDIS
              END IF
              IF (DIS .LT. BOK(I, 1)) BOK(I, 1) = DIS
              IF (DIS .GT. BOK(I, 2)) BOK(I, 2) = DIS
              RETURN
            END IF
          END DO
        END IF
        IF (IPR(47) .LT. NP8) THEN
          IPR(47)   = IPR(47) + 1
          I         = IPR(47)
          KBO(I, 1) = NO12
          BOK(I, 1) = DIS
          BOK(I, 2) = DIS
          BOK(I, 3) = DIS
          KBO(I, 2) = 1
          IF (SDIS .GT. 0.0) THEN
            KBO(I, 5) = 1
            BOK(I, 6) = SDIS
          END IF
        END IF
      ELSE IF (MODE .LT. 0) THEN
        IF (IPR(6) .NE. 0) THEN
          IF (IPR(317) .GT. 0) THEN
            PAR(318) = PAR(318) / IPR(317)
            IF (IPR(22) .LT. 20) THEN
              IBPR = 340
            ELSE IF (IPR(22) .GE. 40) THEN
              IBPR = 342
            ELSE
              IBPR = 341
            END IF
C * ALERT _340, _341, _342
            CALL PLA231 (IBPR, 4, PAR(318), PAR(318), ' ', ' ')
          END IF
          IM = IPR(47)
          IF (IGBL(63) .GT. 2) THEN
            CALL PLA262 (-6)
            WRITE (LU7, 99999, IOSTAT = IOST)
          END IF
          DO I = 1, IM
            DO J = 1, 71
              KSM(J) = 0
            END DO
            IPR(133) = -1
   20       IPR(133) = IPR(133) + 1
            IF (IPR(133) .GT. 1) GO TO 40
            IFIN = -1
   30       CALL PLA038 (I0, J0, IFIN)
            IF (IFIN .EQ. 1) GO TO 20
            CALL GEN048 (-4, IFG(1, I0), 24, IHYB1)
            CALL GEN048 (-4, IFG(1, J0), 24, IHYB2)
            CALL GEN048 (-4, IFG(1, I0), 15, NO1)
            CALL GEN048 (-4, IFG(1, J0), 15, NO2)
            IF (IHYB1 .EQ. 0) IHYB2 = 0
            IF (IHYB2 .EQ. 0) IHYB1 = 0
            NOA = NO1 * 10 + IHYB1
            NOB = NO2 * 10 + IHYB2
            IF (IATNR(IEN(NO1 + 1)) .LT. IATNR(IEN(NO2 + 1))) THEN
              CALL GEN014 (NOA, NOB)
            END IF
            NO12 = NOA * 1000 + NOB
            IF (KBO(I, 1) .NE. NO12) GO TO 30
            CALL PLA050 (I0, J0, 0, 0, DIST)
            NDIS      = MIN (71, NINT(DIST * 20 + 1))
            KSM(NDIS) = KSM(NDIS) + 1
            GO TO 30
   40       DO J = 1, 71
              IDMJ = KSM(J)
              IF (IDMJ .LE. 0) THEN
                IDM(J:J) = '.'
              ELSE IF (IDMJ .LE. 9) THEN
                IDM(J:J) = CHAR(ICHAR('0') + IDMJ)
              ELSE IF (IDMJ .LE. 35) THEN
                IDM(J:J) = CHAR(ICHAR('Z') - 35 + IDMJ)
              ELSE
                IDM(J:J) = '*'
              END IF
            END DO
            HYB1 = ' '
            HYB2 = ' '
            K = KBO(I, 1) / 1000
            L = KBO(I, 1) - K * 1000
            IHYB1 = MOD (K, 10)
            IHYB2 = MOD (L, 10)
            K = K / 10 + 1
            L = L / 10 + 1
            IF (IHYB1 .NE. 0) THEN
              IF (IEN(K) .EQ. 2 .OR. IEN(K) .EQ. 4)
     1            HYB1 = CHAR(IHYB1 + 49)
              IF (IEN(L) .EQ. 2 .OR. IEN(K) .EQ. 4)
     1            HYB2 = CHAR(IHYB2 + 49)
            END IF
            SUMR = RADR(K, 2) + RADR(L, 2)
            IF (KBO(I, 2) .GT. 0) BOK(I, 3) = BOK(I, 3) / KBO(I, 2)
            IF (KBO(I, 5) .GT. 0) THEN
              BOK(I, 6) = BOK(I, 6) / KBO(I, 5)
              WRITE (BNDPR, 99995, IOSTAT = IOST) BOK(I, 6)
            ELSE
              CALL GEN038 (BNDPR, 1, 8)
            END IF
            IF (BOK(I, 1) + 0.4 .LT. SUMR .AND. KBO(I, 2) .GT. 0)
     1        THEN
              NOTE = 'S'
            ELSE
              NOTE = ' '
            END IF
            IF (KBO(I, 5) .GT. 0 .AND. BOK(I, 6) .GT. BNDPX) THEN
              IF (LMT(L, 1) .NE. ' H' .AND. LMT(L, 1) .NE. ' D' .AND.
     1            LMT(L, 1) .NE. 'Hw') THEN
                BNDTP(1) = LMT(K, 1)//'-'//LMT(L, 1)
                BNDPX    = BOK(I, 6)
              END IF
            END IF
            IF (IGBL(63) .GT. 2) THEN
              CALL PLA262 (2)
              WRITE (LU7, 99998, IOSTAT = IOST)
     1          LMT(K, 1), HYB1, LMT(L, 1), HYB2, KBO(I, 2), BNDPR,
     2          (BOK(I, J), J = 1, 3), SUMR, NOTE, IDM(1:71)
            END IF
          END DO
          IF (PAR(318) .GT. 0) THEN
            BNDTP(1) = '  C-C'
          ELSE
            PAR(318) = BNDPX
          END IF
          IF (IGBL(63) .GT. 3) THEN
            CALL PLA262 (22)
            WRITE (LU7, 99997, IOSTAT = IOST)
            WRITE (LU7, 99996, IOSTAT = IOST)
          END IF
        END IF
        IF (IPR(315) .NE. 0) THEN
          RATIO = FLOAT(IPR(316)) / FLOAT(IPR(315))
C * ALERT _763
          IF (RATIO .LT. 1.0 .AND. IGBL(8) .EQ. 3)
     1      CALL PLA231 (763, 2, 1.0 - RATIO, RATIO, ' ', ' ')
C * ALERT _764
          IF (RATIO .GT. 1.1)
     1      CALL PLA231 (764, 2, -999.0, RATIO, ' ', ' ')
        END IF
      ELSE
        IPR(47)  = 0
        IPR(317) = 0
        PAR(318) = 0
        DO I = 1, NP8
          DO J = 1, 5
            KBO(I, J) = 0
          END DO
          DO J = 1, 6
            BOK(I, J) = 0.0
          END DO
        END DO
      END IF
   50 RETURN
99999 FORMAT ('Statistics of Bond Length per Bond Type (NOTE: ',
     1 'A Indicates 10 Occurrences, B Indicates 11, Etc. and',
     2 ' * more than 35)', /, 132('='), //, 'Bond Type   Nr', 4X,
     3 'B.P.', 2X, 'd(min)', 2X, 'd(max)', 3X, 'd(av) Sumrad Note',
     4 2X, '0.0', 7X, '0.5', 7X, '1.0', 7X, '1.5', 7X, '2.0', 7X,
     5 '2.5', 7X, '3.0 Angstrom', /, 58('-'), 3X, 35('I-'), 'I')
99998 FORMAT (2A, ' -- ', 2A, I4, A, 3F8.4, F7.2, 4X, A, 3X, A, /)
99997 FORMAT (//, 'Selected Bond Lengths (Angstrom) - ',
     1 'see M.F.C. Ladd & R.A. Palmer, ',
     2 'Structure Determination by X-Ray Crystallography (1985)', /,
     3 132('='), //, 49X, 'Formal single bonds', /, 49X, 19('-'), /,
     4 'C4-C4 1.54   C4-C3 1.52   C4-C2 1.46   C4-N3 1.47   C4-N2 ',
     5 '1.47   C4-O2 1.43   C3-C3 1.46   C3-C2 1.45   C3-N3 1.40   ',
     6 'C3-N2 1.40', /, 'C3-O2 1.36   C2-C2 1.38   C2-N3 1.33   C2-N2',
     7 ' 1.33   C2-O2 1.36   N3-N3 1.45   N3-N2 1.45   N3-O2 1.36   ',
     8 'N2-N2 1.45   N2-O2 1.41', //, 49X, 'Formal double bonds', /,
     9 49X, 19('-'), /, 'C3-C3 1.34   C3-C2 1.31   C3-N2 1.32   C3-O1',
     * ' 1.22   C2-C2 1.28   C2-N2 1.32   C2-O1 1.16   N3-O1 1.24   ',
     1 'N2-N2 1.25   N2-O1 1.21', /)
99996 FORMAT ('Formal triple bonds', 17X,
     1 'Aromatic bonds', /, 19('-'), 17X, 14('-'), /, 'C2-C2 1.20',
     2 '   C2-N1 1.16   C3-C3 1.40   C2-N2 1.34   N2-N2 1.35', //,
     3 'The notation in the table indicates the connectivity of the',
     4 ' atoms', //,
     5 'For more detailed standard bond distance tabulations see: ',
     6 'J. Chem. Soc. Perkin II, (1987), S1-S19;', /,
     7 'J. Chem. Soc. Dalton Trans. (1989), S1 - S83 or ',
     8 'International Tables C, (1992), 707-791.')
99995 FORMAT (F8.4)
      END SUBROUTINE PLA098
      SUBROUTINE PLA099 (MODE, IAT, NANG, ANG1, ANG2, ANG3, NOTE1)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER NOTE1*1
      CALL GEN048 (-1, IFG(1, IAT), 19, IMET)
      NMET = 0
      NATX = IPR(37)
      NAT  = IPR(39)
      CALL GEN048 (-4, IFG(1, IAT), 15, NO1)
      NO1 = NO1 + 1
      CALL GEN048 (-7, IFG(2, IAT), 1, IPPIAT)
      IPPIAT = IPPR(IPPIAT + 1, 1)
      NC = - NINT(CON(IAT, NP4))
      IF (NC .LT. 0) THEN
        NC = NP4
        CALL GEN048 (-1, IFG(1, IAT), 8, IVAL)
        IF (IVAL .GT. 0) NC = NC + IPR(76)
      END IF
      MSKP  = 0
   10 NANG  = 0
      ANG3  = 0.0
      ANG2  = 0.0
      EFNC  = 0.0
      ENCH  = 0.0
      DISM  = 99.0
      ISHCN = 0
      NHAT  = 0
      IF (NC .GT. 0) THEN
        ANG1 = 9999.0
        NMET = 0
C * LOOP OVER NC CONNECTIONS TO ATOM IAT
        DO J = 1, NC
          IF (J .LE. NP4) THEN
            JAT = NINT(CON(IAT, J))
          ELSE
            IF (IBON(J - NP4, 1) .NE. IAT) CYCLE
            JAT = IBON(J - NP4, 2)
          END IF
          CALL GEN048 (-5, IFG(3, JAT), 14, JATPART)
          JATPART = JATPART - 16
          CALL GEN048 (-1, IFG(1, JAT), 7, IHAT)
          NHAT = NHAT + IHAT
          IF (IEN(NO1) .EQ. 2) THEN
            CALL GEN048 (-4, IFG(1, JAT), 15, NO2)
            NO2 = NO2 + 1
            IF (IEN(NO2) .EQ. 4) THEN
              CALL PLA050 (JAT, IAT, 0, 0, DIS0)
              IF (DIS0 .LT. 1.35) ISHCN = 1
            END IF
          END IF
          IF (IHAT .EQ. 0) THEN
            CALL PLA050 (JAT, IAT, 0, 0, DIS0)
            DISM = MIN (DISM, DIS0)
          END IF
          CALL GEN048 (-1, IFG(1, JAT), 19, IVL1)
          IF (MSKP * IVL1 .NE. 1) THEN
            NMET = NMET + IVL1
            CALL GEN048 (-7, IFG(2, JAT), 1, IPPJAT)
            IPPJAT = IPPR(IPPJAT + 1, 1)
            IF (IPPJAT .EQ. 1000) THEN
              EFNC = EFNC + 1.0
            ELSE
              EFNC = EFNC + FLOAT(IPPJAT) / FLOAT(IPPIAT)
            END IF
            CALL GEN048 (-1, IFG(1, JAT), 7, IHAT)
            IF (IHAT .EQ. 1)
     1        ENCH = ENCH + FLOAT(IPPJAT) / FLOAT(IPPIAT)
            IF (J .LT. NC) THEN
              K1 = J + 1
C * JAT-IAT-KAT ANGLE LOOP
              DO K = K1, NC
                IF (K .LE. NP4) THEN
                  KAT = NINT(CON(IAT, K))
                ELSE
                  IF (IBON(K - NP4, 1) .NE. K) CYCLE
                  KAT = IBON(K - NP4, 2)
                END IF
                CALL GEN048 (-5, IFG(3, KAT), 14, KATPART)
                KATPART = KATPART - 16
                JUNK = 0
                IF (JATPART .EQ. 0 .OR. KATPART .EQ. 0) THEN
                  JUNK = 1
                ELSE IF (JATPART .EQ. KATPART) THEN
                  JUNK = 1
                END IF
                IF (JUNK .EQ. 1) THEN
                  CALL GEN048 (-7, IFG(2, KAT), 1, IPPKAT)
                  IPPKAT = IPPR(IPPKAT + 1, 1)
                  IF (IPPJAT .GT. 0 .AND. IPPKAT .GT. 0) THEN
                    IF (IPPJAT .EQ. 1000 .OR. IPPJAT .EQ. IPPKAT) THEN
                      CALL PLA050 (JAT, IAT, KAT, 0, ANG)
                      IF (IEN(NO1) .EQ. 2 .AND. IVL1 .EQ. 1 .AND.
     1                  ANG .LE. 85) THEN
                        MSKP = 1
                        GO TO 10
                      END IF
                      NANG = NANG + 1
                      ANG2 = MAX (ANG2, ANG)
                      ANG1 = MIN (ANG1, ANG)
                      ANG3 = ANG3 + ANG
                    END IF
                  END IF
                END IF
              END DO
            END IF
          END IF
        END DO
        IF (NHAT .EQ. 0) ISHCN = 0
        IF (NANG .GT. 0) THEN
          ANG3 = ANG3 / NANG
        ELSE
          ANG1 = 0.0
        END IF
      ELSE
        ANG1 = 0.0
      END IF
      IHYB = 0
      IF (MODE .EQ. 0) THEN
        NCEFF = NC
      ELSE
        NCEFF = NINT(EFNC + 0.001)
      END IF
      IF (IEN(NO1) .EQ. 20) THEN
        NBOBO = 0
        IF (NC .GT. 0) THEN
          DO J = 1, NC
            IF (J .LE. NP4) THEN
              JAT = NINT(CON(IAT, J))
              CALL GEN048 (-4, IFG(1, JAT), 15, NO2)
              NO2 = NO2 + 1
              IF (IEN(NO2) .EQ. 20) NBOBO = NBOBO + 1
              IF (NBOBO .EQ. 2) THEN
                CALL GEN048 (1, IFG(2, IAT), 13, 1)
                EXIT
              END IF
            END IF
          END DO
        END IF
      END IF
      IF (IAT .LE. NAT) THEN
        IF (IEN(NO1) .EQ. 2 .OR. IEN(NO1) .EQ. 85) THEN
          IF (ANG1 .LT. 35.0) NOTE1 = 'A'
          IF (NCEFF .EQ. 4) THEN
            IF (ABS(ANG3 - 108.0) .LT. 2.5) THEN
              IF (NMET .EQ. 2) THEN
                IHYB = 2
              ELSE
                IF (ISHCN .EQ. 1) NOTE1 = 'H'
                IHYB = 3
              END IF
            END IF
            IF (ANG2 .GT. 125.0 .AND. ANG1 .GT. 61
     1                          .AND. IMET .EQ. 0) THEN
              NOTE1    = 'A'
            END IF
          ELSE IF (NCEFF .EQ. 3) THEN
            IF (ABS(ANG3 - 120.0) .LT. 4.0) THEN
              IHYB = 2
            END IF
          ELSE IF (NCEFF .EQ. 2) THEN
            IF (ABS(ANG3 - 180.0) .LT. 15.0) THEN
              IHYB = 1
            END IF
          ELSE IF (NCEFF .EQ. 1) THEN
            IF (MODE .EQ. 1 .AND. IAT .LE. NATX)
     1          IPR(401) = IPR(401) + 1
            IF (IEN(NO1) .EQ. 2) THEN
              IF (IEN(NO2) .EQ. 4) THEN
                IF (DISM .LT. 1.2) IHYB = 1
                NOTE1 = ' '
              END IF
            ELSE
              NOTE1    = '?'
            END IF
          END IF
          IF (IHYB .EQ. 0 .AND. IMET .EQ. 0) THEN
            IF (IEN(NO1) .EQ. 2) THEN
              IF (MODE .EQ. 1 .AND. IAT .LE. NATX) THEN
                  IF (ABS(NCEFF - EFNC) .LT. 0.002)
     1                IPR(402) = IPR(402) + 1
              END IF
              NOTE1 = '?'
            END IF
          END IF
        ELSE IF (IEN(NO1) .EQ. 3) THEN
          IF (NC .EQ. 2) THEN
            IHYB = 3
          ELSE IF (NC .EQ. 1) THEN
            CALL PLA050 (NINT(CON(IAT, 1)), IAT, 0, 0, DIST)
            IHYB = 2
          END IF
        ELSE IF (IEN(NO1) .EQ. 4) THEN
          IF (NC .EQ. 1) THEN
            CALL PLA050 (NINT(CON(IAT, 1)), IAT, 0, 0, DIST)
            IF (DIST .LT. 1.2) IHYB = 1
          END IF
          IF (NC .EQ. 3) THEN
             IF (ABS (ANG3 - 120.0) .LT. 1.5) THEN
               IHYB = 2
             ELSE IF (ANG3 .LT. 112) THEN
               IHYB = 3
             END IF
          ELSE IF (NC .EQ. 4 .AND. ABS(ANG3 - 109.5) .LT. 1.0) THEN
            IHYB = 3
          END IF
        ELSE IF (IEN(NO1) .EQ. 8 .OR. IEN(NO1) .EQ. 6) THEN
          IF (NC .EQ. 4 .AND. ABS(ANG3 - 109.5) .LT. 1.0) IHYB = 3
        END IF
      END IF
      IF (IAT .LE. NATX .AND. IHYB .EQ. 0) THEN
        IF (ANG1 .LT. 90.0 .AND. ANG1 .GT. 0.1) THEN
          IF (NO1 .EQ. 3 .AND. NC .EQ. 2) THEN
            NOTE1 = ' '
          ELSE IF (IMET .EQ. 0 .AND. NC .LT. 6 .AND.
     1             IEN(NO1) .NE. 92) THEN
            NOTE1 = 'A'
          END IF
        END IF
      END IF
      NATH = MIN (NINT(ENCH), 7)
      CALL GEN048 (4, IFG(1, IAT), 24, IHYB)
      CALL GEN048 (3, IFG(2, IAT), 24, NATH)
      CALL GEN048 (3, IFG(3, IAT), 25, NHAT)
      CALL GEN048 (4, IFG(3, IAT), 28, NCEFF)
      RETURN
      END SUBROUTINE PLA099
      SUBROUTINE PLA100 (IAT, JAT, MODE, DASH)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,
     3 NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON // JNSC(2, NP23), VOID(NVD)
      DASH0 = DASH
      NB = IPR(131)
      I = IAT
      J = JAT
      N = 0
      IF (I .GT. J) CALL GEN014 (I, J)
      IF (NB .GT. 0) THEN
        DO K = 1, NB
          IA = NINT(VOID(IPR(298) + K * 3 - 2))
          JA = NINT(VOID(IPR(298) + K * 3 - 1))
          IF (I .EQ. IA .AND. J .EQ. JA) THEN
            IF (MODE .EQ. -1) THEN
              VOID(IPR(298) + K * 3 - 2) = VOID(IPR(298) + NB * 3 - 2)
              VOID(IPR(298) + K * 3 - 1) = VOID(IPR(298) + NB * 3 - 1)
              VOID(IPR(298) + K * 3)     = VOID(IPR(298) + NB * 3)
              IPR(131)                   = IPR(131) - 1
            ELSE
              N = K
            END IF
            EXIT
          END IF
        END DO
      END IF
      IF (MODE .GT. 0) THEN
        IF (N .EQ. 0) THEN
          IPR(131) = IPR(131) + 1
          N        = IPR(131)
          IPR(299) = IPR(298) + N * 3
        END IF
        XBND     = 1.0
        CALL GEN048 (-1, IFG(1, I), 19, METI)
        CALL GEN048 (-1, IFG(1, J), 19, METJ)
        IF (METI .EQ. 1 .OR. METJ .EQ. 1) XBND = 5.0
        CALL GEN048 (-1, IFG(1, I), 7, IHAT)
        CALL GEN048 (-1, IFG(1, J), 7, JHAT)
        IF (IHAT .EQ. 1 .OR. JHAT .EQ. 1) XBND = 3.0
        VOID(IPR(298) + N * 3 - 2) = I
        VOID(IPR(298) + N * 3 - 1) = J
        IF (DASH0 .LT. 2.0) THEN
          CALL GEN048 (-7, IFG(2, I), 1, IPP)
          CALL GEN048 (-7, IFG(2, J), 1, JPP)
          IPP = IPPR(IPP + 1, 1) / 500
          JPP = IPPR(JPP + 1, 1) / 500
          IF (IPP .LT. 2 .OR. JPP .LT. 2) THEN
            XBND = 7.0
            IF (IPP * JPP .EQ. 0) DASH0 = -1.0
          END IF
        ELSE
          DASH0 = 1.0
        END IF
        IF (DASH0 .LT. -1.0) THEN
          DASH0 = -1.0
          XBND  = 7.0
        END IF
        VOID(IPR(298) + N * 3) = SIGN (XBND, DASH0)
      END IF
      RETURN
      END SUBROUTINE PLA100
      SUBROUTINE PLA101
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80, TYPE*4
      J1    = 0
      J2    = 0
      XOS   = 0.0
      YOS   = 0.0
      IENR  = 0
      NRING = 0
      NHEAD = 0
      IGBL(6) = 13
   10 IOPEN    = 0
      NR       = 0
      NAT      = IPR(39)
   20 READ (LU8) MARK, IPR(12), JR, RMAT
      IF (MARK .EQ. -100) THEN
        CALL PLA015 (0, 18)
        CALL GEN108 (LU8, 0)
        IPR(169) = 0
        GO TO 70
      END IF
      NL4 = NAT
      IF (MARK .EQ. -1) NL4 = 240
      READ (LU8) (IATP(L4), L4 = 1, NL4)
      IF (MARK .NE. IPR(55)) THEN
        IF (IPR(55) .EQ. 1) THEN
          IF (MARK .LT. 1 .OR. MARK .GT. 4) GO TO 20
        ELSE
          GO TO 20
        END IF
      END IF
   30 IF (IOPEN .EQ. 0) THEN
        HORS = 25.0
        VERT = 25.0
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL PLA110 (HORS, VERT, -1)
        IOPEN = 1
        IF (IPR(55) .NE. -1)
     1    CALL GGIP09 (0.0, JID(75:80), 6, 0.45, 1, 2, 10.5, 24.25)
      END IF
C * PLAN, RING, RESD, LSPL
      IF (IPR(55) .GT. 0) THEN
        CALL PLA102 (PMAX, SX, SY, SZ)
        IF (MARK .EQ. 1) THEN
          TYPE = 'Plan'
        ELSE IF (MARK .EQ. 2) THEN
          TYPE  = 'Ring'
          NRING = NRING + 1
        ELSE IF (MARK .EQ. 3) THEN
          TYPE = 'Resd'
        ELSE IF (MARK .EQ. 4) THEN
          TYPE = 'Lspl'
        END IF
        CALL GGIP09 (0.0, TYPE, 4, 0.45, 1, 2, 23.0, 24.0)
        NR  = NR + 1
        SXY = VERT / 2.0
        SC  = SXY  * 0.8 / PMAX
        CALL GEN096 (RMAT, IROTX, IROTY, IROTZ, IDET, V6, YANK, QM)
        RGBL(28) = IROTX
        RGBL(29) = IROTY
        RGBL(30) = IROTZ
        IGBL(87) = IDET
        IGBL(67) = 1
        CALL GEN040 (IROTX, NQ1, IP)
        CALL GEN040 (IROTY, NQ2, IP)
        CALL GEN040 (IROTZ, NQ3, IP)
        CALL GGIP09 (0.0, NQ1, 4, 0.4, 1, 2, 23.6, 0.15)
        CALL GGIP09 (0.0, NQ2, 4, 0.4, 1, 2, 0.15, 24.5)
        CALL GGIP09 (0.0, NQ3, 4, 0.4, 1, 2, 0.15, 0.15)
        CALL GEN040 (IPR(140), NQ1, IP)
        CALL GGIP09 (0.0, NQ1, 2, 0.4, 1, 2, 22.5, 0.15)
        YRR   = 0.4
        IPR12 = IPR(12)
        IF (IPR12 .LE. 20) THEN
          DO I = 1, IPR12
            CALL PLA047 (LABA(IATP(I)), NQ1, IDUM, JDUM, IPR(71),
     1                   IGBL(55), 0, 0)
            YRR = YRR + 0.5
            YR  = YRR
            XR  = 1.0
            CALL GGIP09 (0.0, NQ1, 5, 0.35, 1 + IPR(346), 2, XR, YR)
          END DO
        END IF
        IF (IPR(56) .NE. 0) THEN
          CALL PLA044 (RMAT, -NR, XR, YR, ZR, SX, SY, SZ, SC, SXY)
          YR    = YR + 0.05
          CALL GGIP (2.0,  YR, 0.0, 3)
          CALL GGIP (23.0, YR, 0.0, 2)
          YR    = YR - 0.1
          CALL GGIP (23.0, YR, 0.0, 3)
          CALL GGIP (2.0,  YR, 0.0, 2)
          CALL GEN040 (NR, NQ1, IP)
          CALL GGIP09 (0.0, NQ1, IP, 0.5, 1, 2, 23.0, 24.3)
        END IF
        I = 0
        DO WHILE (I .LT. NAT)
          I = I + 1
          IF (IATC(I) .NE. 0) THEN
            CALL GEN048 (-1, IFG(1, I), 7, IVAL)
            IF (IVAL .LE. 0) THEN
              CALL PLA044 (RMAT, I, XR, YR, ZR, SX, SY, SZ, SC, SXY)
              XR0      = XR
              YR0      = YR
              NQ1(1:1) = '.'
              DO II = 1, IPR12
                IF (I .EQ. IATP(II)) THEN
                  NK0 = 1 + IPR(346)
                  GO TO 40
                END IF
              END DO
              CALL GGIP (0.0, 1.0, 0.0, 0)
              NK0 = 1
   40         CALL GGIP09 (0.0, NQ1, 1, 0.5, NK0, 2, XR0, YR0)
              CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, IPR(71),
     1          IGBL(55), 0, 0)
              XR0 = XR + 0.5
              YR0 = YR + 0.5
              CALL GGIP09 (0.0, NQ1, 6, 0.4, NK0, 2, XR0, YR0)
            END IF
            JM = - NINT(CON(I, NP4))
            IF (JM .LT. 0) JM = NP4
            IF (JM .GT. 0) THEN
              CALL GEN048 (-1, IFG(1, I), 7, IHAT)
              CALL PLA044 (RMAT, I, XR1, YR1, ZR1, SX, SY, SZ, SC, SXY)
              DO J = 1, JM
                K = NINT(CON(I, J))
                IF (I .LT. K) THEN
                  IF (IATC(K) .NE. 0) THEN
                    CALL GEN048 (-1, IFG(1, K), 7, KHAT)
                    IF (IHAT + KHAT .GT. 0) THEN
                      IF (IPR(346) .GT. 0) CALL GGIP (0.0, 4.0, 0.0, 0)
                    ELSE
                      DO II = 1, IPR12
                        IF (I .EQ. IATP(II) .OR. K .EQ. IATP(II)) THEN
                          IF (IPR(346) .GT. 0) CALL GGIP (0.0, 2.0,
     1                      0.0, 0)
                          GO TO 50
                        END IF
                      END DO
                      IF (IPR(346) .GT. 0) CALL GGIP (0.0, 3.0, 0.0, 0)
                    END IF
   50               CALL PLA044 (RMAT, K, XR2, YR2, ZR2, SX, SY, SZ, SC,
     1                           SXY)
                    XR3   = XR2 - XR1
                    YR3   = YR2 - YR1
                    XYR3  = SQRT(XR3**2 + YR3**2 + PAR(12))
                    XR3   = 0.4 * XR3 / XYR3
                    YR3   = 0.4 * YR3 / XYR3
                    XR1   = XR1 + XR3
                    YR1   = YR1 + YR3
                    ZGGIP = 0.0
                    CALL GGIP (XR1, YR1, ZGGIP, 3)
                    XR1 = XR1 - XR3
                    YR1 = YR1 - YR3
                    XR2 = XR2 - XR3
                    YR2 = YR2 - YR3
                    CALL GGIP (XR2, YR2, ZGGIP, 2)
                  END IF
                END IF
              END DO
            END IF
          END IF
        END DO
C * NEWMAN PLOT
      ELSE IF (IPR(55) .EQ. -1) THEN
        IPR(169) = IPR(169) + 1
        IF (IPR(162) .GT. 0) THEN
          J1 = IPR(162) / (NP1 + 1)
          J2 = MOD(IPR(162), NP1 + 1)
        END IF
        IF (IOPEN .EQ. 1) THEN
          CALL GGIP (0.0,   VERT, 0.0, 3)
          CALL GGIP (HORS,  VERT, 0.0, 2)
          CALL GGIP (0.0,   0.0,  0.0, 3)
          CALL GGIP (HORS,  0.0,  0.0, 2)
          XGGIP = IGBL(103)
          YGGIP = VERT / 2.0
          CALL GGIP (XGGIP, YGGIP, 0.0, 3)
          CALL GGIP (HORS,  YGGIP, 0.0, 2)
          YGGIP = VERT - 1.0
          CALL GGIP (XGGIP, YGGIP, 0.0, 3)
          CALL GGIP (HORS,  YGGIP, 0.0, 2)
          YGGIP = VERT / 2.0 - 1.0
          CALL GGIP (XGGIP, YGGIP, 0.0, 3)
          CALL GGIP (HORS,  YGGIP, 0.0, 2)
          YGGIP = IGBL(103)
          CALL GGIP (XGGIP, YGGIP, 0.0, 3)
          CALL GGIP (HORS,  YGGIP, 0.0, 2)
          XGGIP = HORS / 2.0
          YGGIP = IGBL(103)
          CALL GGIP (XGGIP, YGGIP,  0.0, 3)
          CALL GGIP (XGGIP, VERT,   0.0, 2)
          XGGIP = IGBL(103)
          CALL GGIP (XGGIP, YGGIP,  0.0, 3)
          CALL GGIP (XGGIP, VERT,   0.0, 2)
          XGGIP = HORS / 2.0 + IGBL(103)
          CALL GGIP (XGGIP, YGGIP,  0.0, 3)
          CALL GGIP (XGGIP, VERT,   0.0, 2)
          CALL GGIP (HORS,  YGGIP,  0.0, 3)
          CALL GGIP (HORS,  VERT,   0.0, 2)
          IOPEN = 2
        END IF
        IVWP = 0
        DO
          IVWP = IVWP + 1
          IF (IVWP .GT. IPR(12)) THEN
            IF (IPR(162) .GT. 0) THEN
              GO TO 20
            ELSE
              GO TO 60
            END IF
          END IF
          ISH = (IVWP - 1) * 60
          J   = IATP(2 + ISH)
          K   = IATP(3 + ISH)
          IF (IPR(162) .GT. 0) THEN
            IF ((J1 .NE. J .OR. J2 .NE. K) .AND.
     1          (J1 .NE. K .OR. J2 .NE. J)) THEN
              CYCLE
            ELSE
              IPR(162) = 0
              IVWP     = 0
              CYCLE
            END IF
          END IF
          CALL PLA047 (LABA(J), NQ1, IDUM, JDUM, 0, IGBL(55),
     1      0, 0)
          CALL PLA047 (LABA(K), NQ2, IDUM, JDUM, 0, IGBL(55),
     1      0, 0)
          IF (IVWP .EQ. 1) THEN
            XOR = HORS / 4.0
            YOR = 3.0 * VERT / 4.0
            XOS = XOR
            YOS = YOR
          ELSE IF (IVWP .EQ. 2) THEN
            XOR = HORS / 2.0
            YOR = 0.0
            XOS = XOS + XOR
          ELSE IF (IVWP .EQ. 3) THEN
            XOR = - HORS / 2.0
            YOR = - VERT / 2.0
            XOS = XOS + XOR
            YOS = YOS + YOR
          ELSE IF (IVWP .EQ. 4) THEN
            XOR = HORS / 2.0
            YOR = 0.0
            XOS = XOS + XOR
          END IF
          CALL GGIP (XOR, YOR, 0.0, -3)
          XR = -2.5
          YR =  5.5
          NK0 = 1
          IF (IPR(346) .EQ. 1) NK0 = 5
          CALL GGIP09 (0.0, NQ1//'-'//NQ2, 15, 0.5, NK0, 2, XR, YR)
          NWMNR = (IPR(169) - 1) * 4 + IVWP
          CALL GEN040 (NWMNR, NQ1, IP)
          XR = 5.9 - (IP * 0.4 * 6.0) / 7.0
          CALL GGIP09 (0.0, NQ1, IP, 0.4, 1, 2, XR, YR)
          CALL PLA289 (0.0, 0.0, 1.0, 24)
          NWM   = IATP(1 + ISH)
          IPHIP = 90
          DO I = 1, NWM
            PHI   = IATP(20 + ISH + I) / (RGBL(6) * 100.0)
            PHIL  = IATP(38 + ISH + I) / (RGBL(6) * 100.0)
            IPHI  = NINT((IATP(21 + ISH + I) - IATP(20 + ISH + I))
     1            / 100.0)
            CALL GEN040 (IPHI, NQ1, IP)
            PHIB  = PHI + IPHI / (RGBL(6) * 2)
            RADCP = PAR(24) * COS(PHI)
            RADSP = PAR(24) * SIN(PHI)
            XPL   = RADCP * 3
            YPL   = RADSP * 3
            XLB   = PAR(24) * COS(PHIL) * 4
            YLB   = PAR(24) * SIN(PHIL) * 4
            XAG   = PAR(24) * COS(PHIB) * 2
            YAG   = PAR(24) * SIN(PHIB) * 2
            IF (IP .LE. 1) THEN
              XAG   = XAG * 1.75
              YAG   = YAG * 1.75
            ELSE
              IF (IPHI .LE. 40) THEN
                XAG  = XAG * 1.4
                YAG  = YAG * 1.4
              END IF
            END IF
            XAG   = XAG - IP * PAR(25) / 2
            YAG   = YAG - PAR(25) / 2
            IF (IATP(I + 3 + ISH) .LE. NP1) THEN
              XST = RADCP
              YST = RADSP
            ELSE
              XST = 0.0
              YST = 0.0
            END IF
            L = MOD(IATP(I + 3 + ISH), NP1)
            CALL PLA047 (LABA(L), NQ3, IDUM, IENR, 0, IGBL(55),
     1        0, 0)
            DO L0 = 1, 5
              IF (NQ3(6-L0:6-L0) .NE. ' ') EXIT
            END DO
            L0 = 6 - L0
            IF (COS(PHIL) .LT. 0) THEN
              XLB = XLB + L0 * PAR(25) * COS(PHIL) * 5.0 / 6.0
              IF (IGBL(103) .EQ. 1) XLB = MAX (XLB, -5.0)
              IF (IPHIP .LT. 25) THEN
                YLB = YLB - PAR(25) - 0.05
              END IF
            ELSE
              IF (IPHIP .LT. 25) THEN
                YLB = YLB + PAR(25) + 0.05
              END IF
            END IF
            CALL GGIP (XST, YST, 0.0, 3)
            CALL GGIP (XPL, YPL, 0.0, 2)
            NK0 = 1
            IF (IPR(346) .EQ. 1 .AND. IENR .NE. 1) NK0 = 2
            CALL GGIP09 (0.0, NQ3, L0, PAR(25), NK0, 2, XLB, YLB)
            IF (IPR(346) .EQ. 1) NK0 = 3
            CALL GGIP09 (0.0, NQ1, IP, 0.5, NK0, 2, XAG, YAG)
            IPHIP = IPHI
          END DO
        END DO
      END IF
   60 CALL GGIP (0.0, 1.0, 0.0, 0)
      CALL GGIP (0.0, 0.0, 0.0, 3)
   70 CALL GGIP (-XOS, - YOS, 0.0, -3)
      CALL PLA013 (1, 1)
      IF (IGBL(5) .EQ. LU5) THEN
        CALL GEN020 (1, IGGT, 1, 80)
        IF (IGGT(1:1) .EQ. ' ') WRITE (LU6, 99999, IOSTAT = IOST)
        IF (IGGT(1:1) .EQ. '!' .OR. IGGT(1:1) .EQ. 'Y') GO TO 10
        IF (IGGT(1:5) .EQ. 'CANDP') THEN
          IF (IPR(55) .EQ. 2 .AND. IPR(12) .GT. 0 .AND. IPR(12) .LE. 8)
     1      CALL PLA095 (NRING, NHEAD, 1)
          GO TO 10
        END IF
        CALL PLA006 (0, IS)
        IF (IFL(1)(1:3) .EQ. 'REF') THEN
          IOPEN    = 0
          IPR(169) = IPR(169) - 1
          GO TO 30
        ELSE
          IPR(201) = 0
          CALL PLA280 (ICL)
          IGBL(6) = 10
        END IF
      ELSE
        GO TO 10
      END IF
      IPR(1) = 5
      RETURN
99999 FORMAT (':: Type Y(es) to continue this plot sequence, ',
     1 ' or another instruction', /)
      END SUBROUTINE PLA101
      SUBROUTINE PLA102 (PMAX, SX, SY, SZ)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      IF (IPR(56) .NE. 0) THEN
        DO I = 1, 3
          TEMP       = RMAT(1, I)
          RMAT(1, I) = RMAT(2, I)
          RMAT(2, I) = RMAT(3, I)
          RMAT(3, I) = TEMP
        END DO
      END IF
      NAT = IPR(39)
      DO I = 1, 3
        PAR(54 + I) = 1.0E10
        PAR(57 + I) =-1.0E10
      END DO
      DO I = 1, NAT
        IATC(I) = 1
        IF (IPR(140) .GT. 0) THEN
          CALL GEN048 (-6, IFG(1, I), 9, IRESI)
          IF (IRESI .NE. IPR(140)) THEN
            IATC(I) = 0
            CYCLE
          END IF
        END IF
        DO K = 1, 3
          V5(K) = XXO(I, K + 3)
        END DO
        CALL GEN002 (1, RMAT, V5, V6, XLNG)
        DO K = 1, 3
          PAR(57 + K) = MAX (PAR(57 + K), V6(K))
          PAR(54 + K) = MIN (PAR(54 + K), V6(K))
        END DO
      END DO
      SX   = (PAR(55) + PAR(58)) * 0.5
      SY   = (PAR(56) + PAR(59)) * 0.5
      SZ   = (PAR(57) + PAR(60)) * 0.5
      PMAX = MAX (PAR(58) - SX, PAR(59) - SY)
      IF (ABS(PMAX) .LT. 0.0001) PMAX = 1.0
      RETURN
      END SUBROUTINE PLA102
      SUBROUTINE PLA103
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP26=6000,NP27=1000,NP28=3024,
     3 NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,NP52=200,
     4 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23),
     1 VOID(NVD - 5 * NP26 - 9 * NP27 - NP28 - 1560), B(24),
     1 A(NP26, 5), IP(NP27, 9), IO(NP28), CY(36), D(300, 5)
      COMMON /PL103/ NATP, NCIRC, NPOLY
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      LOGICAL LOGIC
   10 IER   = 0
      NAT   = IPR(37)
      NSYM  = IPR(48)
      NCIRC = 0
      NPOLY = 0
      NATP  = 8
      NATPS = 0
      PAR(224) = 1.0
      DO I = 1, 8
        A(I, 1) = I * 10
        DO J = 2, 4
          A(I, J) = 0.0
        END DO
      END DO
      A(2, 2) = 1.0
      A(3, 3) = 1.0
      A(4, 4) = 1.0
      A(5, 2) = 1.0
      A(5, 3) = 1.0
      A(6, 2) = 1.0
      A(6, 4) = 1.0
      A(7, 3) = 1.0
      A(7, 4) = 1.0
      A(8, 2) = 1.0
      A(8, 3) = 1.0
      A(8, 4) = 1.0
      C73   = MAX (PAR(216) + PAR(217), PAR(220) + PAR(221))
      V2(1) = ABS (C73 / OR(1, 1))
      V2(2) = ABS (C73 / (V2(1) * OR(1, 2) - OR(2, 2)))
      V2(3) = ABS (C73 / (V2(2) * OR(1, 3) + OR(3, 3)))
      IF (IPR(354) .EQ. -1) IPR(354) = 0
      DO I = 1, 5, 2
        J = (I + 1) / 2
        PAR(200 + I) = (1 - (IPR(354) + 1)) * 0.5 - V2(J)
        PAR(201 + I) = (1 + (IPR(354) + 1)) * 0.5 + V2(J)
      END DO
C * DEFAULT OMIT OUTSIDE RANGE
      IF (IPR(356) .LT. 0) THEN
        DO I = 1, 5, 2
          PAR(206 + I) = -0.01
          PAR(207 + I) =  1.01
        END DO
        IPR(356) = 0
      END IF
      DO I = 1, 6
        IO(I) = IFIX(PAR(200 + I) - SIGN (1E-4, PAR(200 + I)) + 10.0)
      END DO
      WRITE (LU6, 99998, IOSTAT = IOST)
     1  (PAR(J), J = 201, 202), (IO(J) -10, J = 1, 2),
     2  (PAR(J), J = 203, 204), (IO(J) -10, J = 3, 4),
     3  (PAR(J), J = 205, 206), (IO(J) -10, J = 5, 6)
      DO INAT = 1, NAT
        CALL PLA047 (LABA(INAT), NQ1, IDUM, IENR, 0, IGBL(55),
     1    0, 0)
        IF (IENR .NE. 1 .OR. IPR(212) .EQ. 1) THEN
          N2 = NATP
          DO 20 J = 1, NSYM
            NATP       = NATP + 1
            IF (NATP .GT. NP26) GO TO 90
            A(NATP, 1) = (IENR * 10000 + INAT) * 10
            A(NATP, 5) = REL(IENR) * PAR(213)
            DO L = 1, 3
              XJX(L)     = XXO(INAT, L)
              XJX(L + 3) = 0.0
            END DO
            CALL SGSM (LINE, J, XJX, LU7, 3, IERR)
            DO L = 2, 4
              A(NATP, L) = MOD(XJX(L + 5) + 10.0, 1.0)
            END DO
            IF (J .GT. 1) THEN
              DO L = N2, NATP - 1
                IF (ABS(A(L, 2) - A(NATP, 2)) .LT. 0.001) THEN
                  IF (ABS(A(L, 3) - A(NATP, 3)) .LT. 0.001) THEN
                    IF (ABS(A(L, 4) - A(NATP, 4)) .LT. 0.001) THEN
                      NATP = NATP - 1
                      GO TO 20
                    END IF
                  END IF
                END IF
              END DO
            END IF
            DO L = 2, 4
              K = (L - 1) * 2
              IF (A(NATP, L) .LT. PAR(199 + K) .OR.
     1            A(NATP, L) .GT. PAR(200 + K)) THEN
                A(NATP, 1) = SIGN (A(NATP, 1), -1.0)
                GO TO 20
              END IF
            END DO
            IF (IPR(356) .EQ. 1) THEN
              DO L = 2, 4
                K = (L + 102) * 2
                IF (A(NATP, L) .LT. PAR(K - 1) .OR.
     1            A(NATP, L) .GT. PAR(K)) THEN
                  A(NATP, 1) = FLOAT(IFIX(A(NATP, 1) * 0.1) * 10 + 5)
                  GO TO 20
                END IF
              END DO
            END IF
   20     CONTINUE
        END IF
      END DO
      NATPS = NATP
      DO I = 9, NATPS
        CY(1) = ABS(IFIX(A(I, 1) * 0.1) * 10)
        CY(2) = A(I, 2)
        CY(3) = A(I, 3)
        CY(4) = A(I, 4)
        CY(5) = A(I, 5)
        DO J = IO(1), IO(2)
          DO K = IO(3), IO(4)
            DO 30  L = IO(5), IO(6)
              IF (J .NE. 10 .OR. K .NE. 10 .OR. L .NE. 10) THEN
                NATP = NATP + 1
                IF (NATP .GT. NP26) GO TO 90
                A(NATP, 1) = CY(1)
                A(NATP, 2) = CY(2) + FLOAT(J) - 10.0
                A(NATP, 3) = CY(3) + FLOAT(K) - 10.0
                A(NATP, 4) = CY(4) + FLOAT(L) - 10.0
                A(NATP, 5) = CY(5)
                DO M = 2, 4
                  M2 = (M - 1) * 2
                  IF (A(NATP, M) .LT. PAR(199 + M2) .OR.
     1                A(NATP, M) .GT. PAR(200 + M2)) THEN
                    NATP = NATP - 1
                    GO TO 30
                  END IF
                END DO
                IF (IPR(356) .EQ. 1) THEN
                  DO M = 2, 4
                    M2 = (M + 102) * 2
                    IF (A(NATP, M) .LT. PAR(M - 1) .OR.
     1                  A(NATP, M) .GT. PAR(M)) THEN
                      A(NATP, 1) = FLOAT(IFIX(A(NATP, 1) * 0.1)
     1                           * 10 + 5)
                      GO TO 30
                    END IF
                  END DO
                END IF
              END IF
   30       CONTINUE
          END DO
        END DO
      END DO
      CALL GEN021 (RMAT, 1)
      DO I = 1, 3
        X =  - RGBL(27 + I) / RGBL(6)
        CALL GEN051 (0, RMAT, X, I)
      END DO
      DO I = 1, NATP
        DO J = 1, 3
          V3(J) = A(I, J + 1)
        END DO
        CALL GEN002 (1, OR, V3, V2, DUM)
        CALL GEN002 (-1, RMAT, V2, V3, DUM)
        A(I, 2) = V3(1)
        A(I, 3) = V3(2)
        A(I, 4) = V3(3)
      END DO
      PAR(222) = MAX (PAR(216) + PAR(217), PAR(220) + PAR(221))
      DO 60 I0 = 9, NATP
        IF (A(I0, 1) .GT. 0.0) THEN
          LOGIC  = I0 .GT. NATPS
          IF (LOGIC .AND. IPR(354) .EQ. 0) GO TO 70
          LOGIC = IFIX(A(I0, 1) * 0.1) .EQ.
     1          IFIX(A(I0 - 1, 1) * 0.1) .OR. LOGIC
          L   = 0
          DO J = 9, NATP
            IF (A(J, 1) .GT. 0.0) THEN
              IF (J .NE. I0) THEN
                D(L + 1, 1) = FLOAT(J)
                DEL         = 0
                DO K = 2, 4
                  D(L + 1, K) = A(I0, K) - A(J, K)
                  DEL = DEL + D(L + 1, K)**2
                END DO
                D(L + 1, 5) = SQRT(DEL)
                IF (D(L + 1, 5) .LE. PAR(222)) L = L + 1
              END IF
            END IF
          END DO
          DO I1 = 1, L - 1
            K1  = 0
            B24 = D(I1, 5)
            DO J1 = I1 + 1, L
              IF (B24 .GE. D(J1, 5)) THEN
                B24 = D(J1, 5)
                K1  = J1
              END IF
            END DO
            IF (K1 .GT. 0) THEN
              DO J1 = 1, 5
                CALL GEN018 (D(I1, J1), D(K1, J1))
              END DO
            END IF
          END DO
          II = L
          DO 40 J = 1, L - 1
            IF (D(J, 5) .LE. PAR(222)) THEN
              DO K = J + 1, L
                IF (D(K, 5) .GT. PAR(222)) GO TO 40
                II       = II + 1
                IF (II .GT. 300) CALL GEN127 ('II')
                D(II, 1) = D(J, 1)
                D(II, 2) = D(K, 1)
                IF (ABS(D(J, 5) * D(K, 5)) .GE. 1E-8) THEN
                  ARCO = (D(J, 2) * D(K, 2) + D(J, 3) * D(K, 3)
     1                 + D(J, 4) * D(K, 4)) / (D(J, 5) * D(K, 5))
                ELSE
                  ARCO = 1.0
                END IF
                IF (ABS(ARCO) .GT. 1.0) ARCO = SIGN (1.0, ARCO)
                D(II, 3) = ACOS(ARCO) * RGBL(6)
                D(II, 4) = D(J, 5)
                D(II, 5) = D(K, 5)
              END DO
            END IF
   40     CONTINUE
          DO IG0 = 1, 2
            IG1 = 9 - IG0 * 2
            DO J = 1, 4
              IF (IG0 .EQ. 1) THEN
                CY(J) = PAR(217 + J)
              ELSE
                CY(J) = PAR(213 + J)
              END IF
            END DO
            CY(5) = 1.414 * (PAR(220) + PAR(221))
            IF (NPOLY .GE. NP27) THEN
              WRITE (LU7, 99996, IOSTAT = IOST) NP27
              IER = 1
              GO TO 80
            END IF
            IG4              = 1
            IP(NPOLY + 1, 1) = I0
            IP(NPOLY + 1, 6) = 0
            IP(NPOLY + 1, 7) = 0
            X1               = 0.0
            X2               = A(I0, 2)
            X3               = A(I0, 3)
            DO II0 = L + 1, II
              IF (ABS(D(II0, 3) - CY(1)) .LE. CY(2)) THEN
                IF (ABS(D(II0, 4) - CY(3)) .LE. CY(4)) THEN
                  IF (ABS(D(II0, 5) - CY(3)) .LE. CY(4)) THEN
                    DO 50 M = 1, 2
                      IF (IG4 .GT. 1) THEN
                        DO K = 2, IG4
                          IF (NINT(D(II0, M)) .EQ. IP(NPOLY + 1, K))
     1                      GO TO 50
                        END DO
                      END IF
                      IG4 = IG4 + 1
                      IP(NPOLY + 1, IG4) = NINT(D(II0, M))
                      X4 = A(IP(NPOLY + 1, IG4), 2)
                      X5 = A(IP(NPOLY + 1, IG4), 3)
                      X1 = MAX (X1, SQRT((X2 - X4)**2
     1                   + (X3 - X5)**2))
   50               CONTINUE
                  END IF
                END IF
              END IF
            END DO
            IP(NPOLY + 1, 8) = IFIX(X1 * 1000)
            IP(NPOLY + 1, 9) = IG1
            IF (IG4 .EQ. IG1) THEN
              NPOLY = NPOLY + 1
              IF (IG1 .EQ. 7) THEN
                DO I = 2, 3
                  DO JJ = 1, 3
                    XPV(JJ) = A(IP(NPOLY, I), JJ + 1)
                  END DO
                  CY(6) = 0.0
                  DO J = I + 1, 9 - I
                    DO JJ = 1, 3
                      XPV(JJ + 3)  = A(IP(NPOLY, J), JJ + 1)
                    END DO
                    CY(5) = SQRT((XPV(4) - XPV(1))**2
     1                    + (XPV(5) - XPV(2))**2 + (XPV(6) - XPV(3))**2)
                    IF (CY(5) .GT. CY(6)) THEN
                      CY(6) = CY(5)
                      IG4   = J
                    END IF
                  END DO
                  CALL GEN014 (IP(NPOLY, IG4), IP(NPOLY, 9 - I))
                END DO
              END IF
              GO TO 60
            END IF
          END DO
          IF (IPR(359) .EQ. 1) THEN
            NCIRC     = NCIRC + 1
            IO(NCIRC) = I0
          END IF
        END IF
   60 CONTINUE
      IF (IABS(NCIRC) .GT. 0) THEN
        DO I = 1, NCIRC - 1
          K   = 0
          CY1 = A(IO(I), 4)
          DO J = I + 1, NCIRC
            IF (CY1 .LE. A(IO(J), 4)) THEN
              CY1 = A(IO(J), 4)
              K   = J
            END IF
          END DO
          IF (K .GT. 0) THEN
            CALL GEN014 (IO(I), IO(K))
          END IF
        END DO
      END IF
   70 CALL PLA104 (IER)
   80 IF (IER .NE. 0) WRITE (LU7, 99999, IOSTAT = IOST) IER
      CALL PLA013 (0, 1)
      CALL GEN072 (IGGT, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
      SELECT CASE (IFL(1)(1:4))
        CASE ('EXIT')
          GO TO 100
        CASE ('END ')
          IGGT     = ' '
          IGBL(6) = 10
          GO TO 100
        CASE ('XR  ', 'XROT')
          CALL PLA226 (-1, - FN(1) / RGBL(6))
          GO TO 10
        CASE ('YR  ', 'YROT')
          CALL PLA226 (-2, - FN(1) / RGBL(6))
          GO TO 10
        CASE ('ZR  ', 'ZROT')
          CALL PLA226 (-3, - FN(1) / RGBL(6))
          GO TO 10
      END SELECT
      IF (LRET .EQ. 1) THEN
        GO TO 100
      ELSE IF (LRET .EQ. 3) THEN
        GO TO 10
      ELSE
        GO TO 100
      END IF
   90 WRITE (LU6, 99997, IOSTAT = IOST) NP26
  100 CALL GGIP (0.0, 0.0, 0.0, -1)
      RETURN
99999 FORMAT (':: Error Nr.', I3, ' in POLY')
99998 FORMAT (///, 'Range for Generating Atoms is X:',
     1 F8.4, ' TO', F7.4, ' (', I3, ' -', I3, ')',/, 30X, 'Y:',
     2 F8.4, ' TO', F7.4, ' (', I3, ' -', I3, ')' /, 30X, 'Z:',
     3 F8.4, ' TO', F7.4, ' (', I3, ' -', I3, ')')
99997 FORMAT ('Maximum Number of Atoms', I5, ' has been reached')
99996 FORMAT ('Maximum Number of Polyhedra', I5, ' has been Exceeded')
      END SUBROUTINE PLA103
      SUBROUTINE PLA104 (IER)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP23=28000,NP25=99,NP26=6000,NP27=1000,NP28=3024,NP29=63,
     3 NP38=150, NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON // JNSC(2, NP23),
     1 VOID(NVD - 5 * NP26 - 9 * NP27 - NP28 - 1560), B(24),
     2 A(NP26, 5), IP(NP27, 9), IO(NP28), IG1(100), IG2(100),
     3 R(400, 3), IF1(6), NF(68), D(62)
      COMMON /ALL/ NN(12, 3), LO(12, 2), IE(12, 2)
      COMMON /PL103/ NATP, NCIRC, NPOLY
      V1(1) =  1E5
      V1(2) = -1E5
      V1(3) =  1E5
      V1(4) = -1E5
      DO I = 1, NATP
        IF (IPR(355) .GT. 0) THEN
          B14 = 60.0 / (60.0 - A(I, 4))
          A(I, 2) = A(I, 2) * B14
          A(I, 3) = A(I, 3) * B14
        END IF
        IF (A(I, 1) .GT. 0) THEN
          V1(1) = MIN (V1(1), A(I, 2))
          V1(2) = MAX (V1(2), A(I, 2))
          V1(3) = MIN (V1(3), A(I, 3))
          V1(4) = MAX (V1(4), A(I, 3))
        END IF
      END DO
      B14 = ABS(V1(1) - V1(2))
      B15 = ABS(V1(3) - V1(4))
      PAR(224) = MIN (PAR(38) * PAR(50) / B14, PAR(38) / B15)
      B14 = (V1(1) + V1(2)) / 2
      B15 = (V1(3) + V1(4)) / 2
      DO I = 1, NATP
        A(I, 2) = A(I, 2) - B14
        A(I, 3) = A(I, 3) - B15
      END DO
      XGGIP = PAR(38) * PAR(50)
      YGGIP = PAR(38)
      CALL GGIP (XGGIP, YGGIP, 0.0, 1)
      CALL GGIP (0.0, 1.0, 0.0, 0)
      CALL PLA110 (XGGIP, YGGIP, 0)
      XGGIP = XGGIP / 2.0
      YGGIP = YGGIP / 2.0
      CALL GGIP (XGGIP, YGGIP, 0.0, -3)
      DD = PAR(224) * 0.9
      CALL GGIP (0.0, DD, 0.0, 7)
      NF(1) = 0
      NF(2) = 0
      D(23) = 0.0
      D(24) = 0.0
      C1    = 0.012 / DD
      IF (IPR(357) .GT. 0) THEN
        NF(10) = 1
        DO I = 1, 12
          V1(1) = A(LO(I, 1), 2)
          V1(2) = A(LO(I, 1), 3)
          V1(3) = A(LO(I, 2), 2)
          V1(4) = A(LO(I, 2), 3)
          CALL GGIP (V1(1), V1(2), 0.0, 3)
          CALL GGIP (V1(3), V1(4), 0.0, 2)
          D(23) = V1(3)
          D(24) = V1(4)
        END DO
      END IF
   10 IF (NF(1) .LT. NPOLY) THEN
        IF (NF(2) .GE. NCIRC .OR. (NF(2) .LT. NCIRC .AND.
     1     A(IP(NF(1) + 1, 1), 4) .GT. A(IO(NF(2) + 1), 4))) THEN
          NF(1) = NF(1) + 1
          IF (IPR(353) .EQ. 0) GO TO 10
          DO I = 1, 11
            IE(I, 1) = -1
            IE(I, 2) = -1
          END DO
          CALL GEN097 (IF1, 1, 6, -1)
          IF (IP(NF(1), 7) .LE. 0) THEN
            NF(12) = 9
            NF(13) = 12
          ELSE
            NF(12) = 1
            NF(13) = 8
          END IF
          K = 0
          L = 0
          DO I = 1, 3
            B(I) = A(IP(NF(1), 1), I + 1)
          END DO
          DO I = NF(12), NF(13)
            DO J = 1, 3
              NF(6 + J) = IP(NF(1), NN(I, J))
            END DO
            DO J = 1, 3
              B(4  + J) = A(NF(8), 1 + J) - A(NF(7), 1 + J)
              B(7  + J) = A(NF(9), 1 + J) - A(NF(7), 1 + J)
              B(13 + J) = B(J) - A(NF(7), 1 + J)
            END DO
            CALL GEN008 (B(5), B(8), B(11), 0)
            IF (GEN009 (B(11), B(14)) .GE. 0.0) B(13) = - B(13)
            IF (B(13) .GT. 0 .AND. K .LT. 6) THEN
              K = K + 1
              IF1(K) = I
              DO 20 J0 = 1, 3
                J1 = 1 + J0 / 3
                J2 = 2 + (J0 + 1) / 3
                IF (L .GT. J0 - 1) THEN
                  DO J = 1, L
                    IF (NN(I, J1) .EQ. IE(J, 1) .AND.
     1                  NN(I, J2) .EQ. IE(J, 2)) GO TO 20
                    IF (NN(I, J2) .EQ. IE(J, 1) .AND.
     1                  NN(I, J1) .EQ. IE(J, 2)) GO TO 20
                  END DO
                END IF
                L = L + 1
                IE(L, 1) = NN(I, J1)
                IE(L, 2) = NN(I, J2)
   20         CONTINUE
            END IF
          END DO
          DO J = 1, L
            DO K = 1, 2
              IE(J, K) = IP(NF(1), IE(J, K))
            END DO
          END DO
          NF(4) = 0
          NF(5) = 0
          IF (NF(1) .LT. 1) THEN
            GO TO 10
          ELSE IF (NF(1) .GT. 1) THEN
            B(6) = FLOAT(IP(NF(1), 8)) * 1E-3
            DO I = 1, NF(1) - 1
              B(7) = FLOAT(IP(I, 8)) * 1E-3
              B(4) = A(IP(I, 1), 2)
              B(5) = A(IP(I, 1), 3)
              B(8) = SQRT((B(1) - B(4))**2 + (B(2) - B(5))**2)
              IF (B(8) - B(6) - B(7) .LT. 0.0) THEN
                NF(4)      = NF(4) + 1
                IG1(NF(4)) = I
              END IF
            END DO
          END IF
          IF (NF(2) .GT. 0) THEN
            DO I = 1, NF(2)
              B(4) = A(IO(I), 2)
              B(5) = A(IO(I), 3)
              B(7) = A(IO(I), 5)
              B(8) = SQRT((B(1) - B(4))**2 + (B(2) - B(5))**2)
              IF (B(8) - B(6) - B(7) .LT. 0) THEN
                NF(5)      = NF(5) + 1
                IG2(NF(5)) = I
              END IF
            END DO
          END IF
          K = 17
          DO I = 1, 10
            IF (IE(I + 1, 1) .LE. 0) GO TO 30
          END DO
          I = 11
   30     NF(10) = 3
          DO J = 1, I
            B(9)  = A(IE(J, 1), 2)
            B(10) = A(IE(J, 1), 3)
            B(11) = A(IE(J, 2), 2)
            B(12) = A(IE(J, 2), 3)
            D(13) = B(1)
            D(14) = B(2)
            D(15) = 0.5 * (B(9) + B(11))
            D(16) = 0.5 * (B(10) + B(12))
            D(21) = (D(13) - D(15))**2 + (D(14) - D(16))**2
            DO L = 1, I
              IF (J .NE. L) THEN
                D(17) = A(IE(L, 1), 2)
                D(18) = A(IE(L, 1), 3)
                D(19) = A(IE(L, 2), 2)
                D(20) = A(IE(L, 2), 3)
                D(9)  = D(15) - D(13)
                D(10) = D(16) - D(14)
                D(11) = D(19) - D(17)
                D(12) = D(20) - D(18)
                DEN   = D(9) * D(12) - D(10) * D(11)
                IF (ABS(DEN) .LE. 1E-8) THEN
                  D(5) = 10.0
                ELSE
                  D(5) = (D(10) * (D(17) - D(13))
     1                  - D(9)  * (D(18) - D(14))) / DEN
                  D(6) = (D(12) * (D(17) - D(13))
     1                   -D(11) * (D(18) - D(14))) / DEN
                  D(1) = D(17) + D(5) * D(11)
                  D(2) = D(18) + D(5) * D(12)
                END IF
                IF (ABS(D(5) - 0.5) .LE. 0.5) THEN
                  IF (D(6) .GE. 0.0) THEN
                    D(22) = (D(13) - D(1))**2 + (D(14) - D(2))**2
                    IF (D(22) .GT. D(21)) GO TO 40
                  END IF
                END IF
              END IF
            END DO
            K     = K + 1
            NF(K) = J
   40       CALL PLA105
          END DO
          IF (IPR(358) .GT. 0) THEN
            NF(10) = 1
            DO I = 1, 6
              IF (IF1(I) .LE. 0) GO TO 50
              DO J = 1, 3
                NF(6 + J) = NN(IF1(I), J)
              END DO
              DO JX = 8, 9
                IF (A(IP(NF(1), NF(7)), 4)
     1            - A(IP(NF(1), NF(JX)), 4) .LE. 0) THEN
                  CALL GEN014 (NF(7), NF(JX))
                END IF
              END DO
              DO J = 1, 9
                DO J0 = 9, 12
                  J1    = MOD(J0 + 1, 2) + 2
                  J2    = 8 + (J0 - 8) / 3
                  B(J0) = ((10 - J) * A(IP(NF(1), NF(7)),  J1)
     1                         + J  * A(IP(NF(1), NF(J2)), J1)) / 10.0
                END DO
                IF (IPR(346) .NE. 0) THEN
                  IF (IP(NF(1), 9) .EQ. 5) THEN
                    CALL GGIP (0.0, 2.0, 0.0, 0)
                  ELSE
                    CALL GGIP (0.0, 3.0, 0.0, 0)
                  END IF
                END IF
                CALL PLA105
                CALL GGIP (0.0, 1.0, 0.0, 0)
              END DO
            END DO
          END IF
   50     L            = 3
          IP(NF(1), 2) = IE(NF(18), 1)
          IP(NF(1), 3) = IE(NF(18), 2)
   60     DO 70 I = 19, K
            IF (NF(I) .GT. 0) THEN
              IF (IE(NF(I), 1) .EQ. IP(NF(1), L)) THEN
                L = L + 1
                IP(NF(1), L) = IE(NF(I), 2)
              ELSE
                IF (IE(NF(I), 2) .NE. IP(NF(1), L)) GO TO 70
                L = L + 1
                IP(NF(1), L) = IE(NF(I), 1)
              END IF
              NF(I) = -1
              IF (L .GT. 7) THEN
                IER = 2
                GO TO 140
              ELSE IF (L .LT. 7) THEN
                GO TO 60
              ELSE
                IF (IP(NF(1), 2) .EQ. IP(NF(1), L)) IP(NF(1), L) = -1
                GO TO 130
              END IF
            END IF
   70     CONTINUE
          IP(NF(1), L) = -1
          GO TO 130
        END IF
      END IF
      IF (NF(2) .LT. NCIRC) THEN
        NF(2) = NF(2) + 1
        B(1)  = A(IO(NF(2)), 2)
        B(2)  = A(IO(NF(2)), 3)
        B(3)  = A(IO(NF(2)), 5)
        NF(4) = 0
        IF (IPR(353) .NE. 0 .AND. NF(1) .GT. 0) THEN
          DO I = 1, NF(1)
            B(8)  = FLOAT(IP(I, 8)) * 0.001
            IF (SQRT((B(1) - A(IP(I, 1), 2))**2
     1        + (B(2) - A(IP(I, 1), 3))**2) .LT. B(3) + B(8)) THEN
              NF(4)      = NF(4) + 1
              IG1(NF(4)) = I
            END IF
          END DO
        END IF
        NF(5) = 0
        IF (NF(2) .GT. 1) THEN
          DO 80 I = 1, NF(2) - 1
            B(8)  = A(IO(I), 5)
            B(5)  = A(IO(I), 2)
            B(6)  = A(IO(I), 3)
            D(40) = SQRT((B(1) - B(5))**2 + (B(2) - B(6))**2)
            IF (D(40) - B(3) - B(8) .LT. 0.0) THEN
              IF (D(40) .LE. 1E-3) THEN
                IF (D(40) + ABS(B(3) - B(8)) .LE. 1E-3) THEN
                  GO TO 130
                ELSE
                  GO TO 80
                END IF
              END IF
              NF(5)      = NF(5) + 1
              IG2(NF(5)) = I
            END IF
   80     CONTINUE
        END IF
        NF(15)  = 2
        R(1, 1) = B(1)
        R(1, 2) = B(2) + B(3)
        R(1, 3) = 0.0
        R(2, 1) = R(1, 1)
        R(2, 2) = R(1, 2)
        R(2, 3) = 360.0
        IF (IPR(353) .NE. 0 .AND. NF(4) .GT. 0) THEN
          B(19) = B(1)
          B(20) = B(2)
          DO 90 I = 1, NF(4)
            NF(16) = IP(IG1(I), 9) - 1
            DO J = 2, NF(16) + 1
              IF (IP(IG1(I), J) .LT. 1) GO TO 90
              IF (IP(IG1(I), J + 1) .LE. 0) NF(16) = J - 1
              B(9)   = A(IP(IG1(I), J), 2)
              B(10)  = A(IP(IG1(I), J), 3)
              NF(13) = J - 1
              NF(14) = MOD(NF(13), NF(16)) + 2
              B(11)  = A(IP(IG1(I), NF(14)), 2)
              B(12)  = A(IP(IG1(I), NF(14)), 3)
              D(5)   = -1.0
              D(6)   = -1.0
              D(7)   = B(9)  - B(19)
              D(8)   = B(10) - B(20)
              D(9)   = B(11) - B(9)
              D(10)  = B(12) - B(10)
              D(11)  = D(9)**2 + D(10)**2
              D(12)  = D(7) * D(9) + D(8) * D(10)
              D(13)  = D(12)**2
     1               - D(11) * (D(7)**2 + D(8)**2 - B(3)**2)
              IF (D(13) .GE. 0) THEN
                D(14) = - D(12) / D(11)
                D(13) = SQRT(D(13)) / D(11)
                D(5)  = D(14) + D(13)
                D(1)  = B(9) + D(5) * D(9)
                D(2)  = B(10) + D(5) * D(10)
                IF (D(13) .GT. 1E-4) THEN
                  D(6) = D(14) - D(13)
                  D(3) = B(9) + D(6) * D(9)
                  D(4) = B(10) + D(6) * D(10)
                END IF
              END IF
              IF (ABS(D(5) - 0.5) .LE. 0.5) THEN
                NF(15)       = NF(15) + 1
                R(NF(15), 1) = D(1)
                R(NF(15), 2) = D(2)
                D(25)        = D(1) - B(1)
                D(26)        = D(2) - B(2)
                R(NF(15), 3) = ACOS((D(26) /
     1                         SQRT(D(25)**2 + D(26)**2))) * RGBL(6)
                IF (D(25) .LE. 0.0) R(NF(15), 3) = 360.0 - R(NF(15), 3)
              END IF
              IF (ABS(D(6) - 0.5) .LE. 0.5) THEN
                NF(15)       = NF(15) + 1
                R(NF(15), 1) = D(3)
                R(NF(15), 2) = D(4)
                D(25)        = D(3) - B(1)
                D(26)        = D(4) - B(2)
                R(NF(15), 3) = ACOS((D(26) /
     1                         SQRT(D(25)**2 + D(26)**2))) * RGBL(6)
                IF (D(25) .LE. 0.0) R(NF(15), 3) = 360.0 - R(NF(15), 3)
              END IF
            END DO
   90     CONTINUE
        END IF
        IF (NF(5) .GT. 0) THEN
          DO I = 1, NF(5)
            B(5) = A(IO(IG2(I)), 2)
            B(6) = A(IO(IG2(I)), 3)
            B(8) = A(IO(IG2(I)), 5)
            D(9)   = B(5) - B(1)
            D(10)  = B(6) - B(2)
            D(11)  = D(9)**2 + D(10)**2
            D(12)  = B(1) * D(9) + B(2) * D(10)
            D(13)  = (B(5)**2 + B(6)**2 - B(1)**2
     1             - B(2)**2 + B(3)**2 - B(8)**2) / 2.0
            D(14)  = (D(13) - D(12)) / D(11)
            D(15)  = SQRT(B(3)**2 * D(11) - (D(13) - D(12))**2) / D(11)
            D(1)   = B(1) + D(14) * D(9)  - D(15) * D(10)
            D(2)   = B(2) + D(14) * D(10) + D(15) * D(9)
            D(3)   = B(1) + D(14) * D(9)  + D(15) * D(10)
            D(4)   = B(2) + D(14) * D(10) - D(15) * D(9)
            NF(15) = NF(15) + 1
            R(NF(15), 1) = D(1)
            R(NF(15), 2) = D(2)
            D(25) = D(1) - B(1)
            D(26) = D(2) - B(2)
            R(NF(15), 3) = ACOS((D(26) /
     1                     SQRT(D(25)**2 + D(26)**2))) * RGBL(6)
            IF (D(25) .LE. 0.0) R(NF(15), 3) = 360.0 - R(NF(15), 3)
            NF(15) = NF(15) + 1
            R(NF(15), 1) = D(3)
            R(NF(15), 2) = D(4)
            D(25) = D(3) - B(1)
            D(26) = D(4) - B(2)
            R(NF(15), 3) = ACOS((D(26) /
     1                     SQRT(D(25)**2 + D(26)**2))) * RGBL(6)
            IF (D(25) .LE. 0.0) R(NF(15),3) = 360.0 - R(NF(15),3)
          END DO
        END IF
        DO I2 = 1, NF(15) - 1
          K2 = 0
          B(13) = R(I2, 3)
          DO J2 = I2 + 1, NF(15)
            IF (B(13) .GE. R(J2, 3)) THEN
              B(13) = R(J2, 3)
              K2    = J2
            END IF
          END DO
          IF (K2 .GT. 0) THEN
            DO J2 = 1, 3
              CALL GEN018 (R(I2, J2), R(K2, J2))
            END DO
          END IF
        END DO
        IF (IPR(346) .NE. 0) CALL GGIP (0.0, 5.0, 0.0, 0)
        DO 120 I = 2, NF(15)
          B(11) = R(I, 3) - R(I - 1, 3)
          B(12) = R(I, 3) - B(11) * 0.5
          B(23) = B(3) * SIN(B(12) / RGBL(6)) + B(1)
          B(24) = B(3) * COS(B(12) / RGBL(6)) + B(2)
          IF (IPR(353) .NE. 0) THEN
            IF (NF(4) .GT. 0) THEN
              DO J = 1, NF(4)
                NF(3) = IG1(J)
                DO I0 = 3, 6
                  IF (IP(NF(3), I0 + 2) .LE. 0) GO TO 100
                END DO
                I0 = 6
  100           K0 = I0 + MOD(I0, 2) - 1
                DO J0 = 1, K0, 2
                  NF(12) = MOD(J0, I0) + 2
                  NF(13) = MOD(J0 + 1, I0) + 2
                  NF(14) = MOD(J0 - 1, I0) + 2
                  DO J1 = 13, 16
                    J2 = MOD(J1 + 1, 2) + 2
                    J3 = 13 + (J1 - 12) / 3
                    B(J1) = A(IP(NF(3), NF(J3)), J2)
     1                    - A(IP(NF(3), NF(12)), J2)
                  END DO
                  D(11) = B(23) - A(IP(NF(3), NF(12)), 2)
                  D(12) = B(24) - A(IP(NF(3), NF(12)), 3)
                  D(5)  = (D(11) * B(14) - D(12) * B(13)) /
     1                    (B(15) * B(14) - B(16) * B(13))
                  D(6)  = (D(11) * B(16) - D(12) * B(15)) /
     1                    (B(13) * B(16) - B(14) * B(15))
                  D(10) = MIN (D(5), D(6))
                  IF (D(10) .LE. 0.0) GO TO 110
                END DO
  110           IF (IFIX (SIGN (1.0, D(10))) .GE. 0) GO TO 120
              END DO
            END IF
          END IF
          IF (NF(5) .GT. 0) THEN
            DO J = 1, NF(5)
              IF (SQRT((B(23) - A(IO(IG2(J)), 2))**2
     1               + (B(24) - A(IO(IG2(J)), 3))**2)
     2      - A(IO(IG2(J)), 5) .LE. 0) GO TO 120
            END DO
          END IF
          CALL GGIP (R(I - 1, 1), R(I - 1, 2), 0.0, 3)
          NF24 = NINT(B(11) * B(3) / (3 * C1 * RGBL(6)))
          IF (NF24 .LE. 1) GO TO 120
          D(30) = B(11) / FLOAT(NF24)
          D(31) = R(I - 1, 3)
          DO K = 1, NF24
            D(31) = D(31) + D(30)
            D(32) = B(3) * SIN(D(31) / RGBL(6)) + B(1)
            D(33) = B(3) * COS(D(31) / RGBL(6)) + B(2)
            CALL GGIP (D(32), D(33), 0.0, 2)
          END DO
  120   CONTINUE
      END IF
  130 CALL GGIP (0.0, 1.0, 0.0, 0)
      IF (NF(1) .LT. NPOLY .OR. NF(2) .LT. NCIRC) GO TO 10
  140 RETURN
      END SUBROUTINE PLA104
      SUBROUTINE PLA105
      PARAMETER (NVD=100000000,NP23=28000,NP26 = 6000,NP27 = 1000,
     4 NP28=3024)
      COMMON // JNSC(2, NP23),
     1 VOID(NVD - 5 * NP26 - 9 * NP27 - NP28 - 1560), B(24),
     1 A(NP26, 5), IP(NP27, 9), IO(NP28), IG1(100), IG2(100),
     2 R(400, 3), IF1(6), NF(68), D(62)
      R(1, 1) = B(9)
      R(1, 2) = B(10)
      R(1, 3) = 0.0
      R(2, 1) = B(11)
      R(2, 2) = B(12)
      R(2, 3) = SQRT((B(9) - B(11))**2 + (B(10) - B(12))**2)
      NF(15)  = 2
      IF (NF(4) .GT. 0) THEN
        DO I = 9, 12
          D(I + 4) = B(I)
        END DO
        DO 30 I = 1, NF(4)
          NF(16) = IP(IG1(I), 9) - 1
          DO 20 J = 2, NF(16) + 1
            IF (IP(IG1(I), J) .LT. 1) GO TO 30
            IF (IP(IG1(I), J + 1) .LE. 0) NF(16) = J - 1
            D(17)  = A(IP(IG1(I), J), 2)
            D(18)  = A(IP(IG1(I), J), 3)
            NF(13) = J - 1
            NF(14) = MOD(NF(13), NF(16)) + 2
            D(19)  = A(IP(IG1(I), NF(14)), 2)
            D(20)  = A(IP(IG1(I), NF(14)), 3)
            D(9)   = D(15) - D(13)
            D(10)  = D(16) - D(14)
            D(11)  = D(19) - D(17)
            D(12)  = D(20) - D(18)
            DEN    = D(9) * D(12) - D(10) * D(11)
            IF (ABS(DEN) .LE. 1E-8) THEN
              D(5) = 10.0
            ELSE
              D(5) = (D(10) * (D(17) - D(13))
     1             -  D(9)  * (D(18) - D(14))) / DEN
              D(6) = (D(12) * (D(17) - D(13))
     1             -  D(11) * (D(18) - D(14))) / DEN
              D(1) =  D(17) + D(5) * D(11)
              D(2) =  D(18) + D(5) * D(12)
            END IF
            IF (ABS(D(5) - 0.5) .LE. 0.5) THEN
              IF (ABS(D(6) - 0.5) .LE. 0.5) THEN
                B(8) = SQRT((B(9) - D(1))**2 + (B(10) - D(2))**2)
                IF (B(8) .GT. 1E-3) THEN
                  DO K = 1, NF(15)
                    IF (ABS(B(8) - R(K, 3)) .LE. 1E-5) GO TO 20
                  END DO
                  NF(15)       = NF(15) + 1
                  R(NF(15), 1) = D(1)
                  R(NF(15), 2) = D(2)
                  R(NF(15), 3) = B(8)
                END IF
              END IF
            END IF
   20     CONTINUE
   30   CONTINUE
      END IF
      IF (NF(5) .GT. 0) THEN
        DO I = 1, NF(5)
          B(3)  = A(IO(IG2(I)), 5)
          B(19) = A(IO(IG2(I)), 2)
          B(20) = A(IO(IG2(I)), 3)
          D(5)  = -1.0
          D(6)  = -1.0
          D(7)  = B(9)  - B(19)
          D(8)  = B(10) - B(20)
          D(9)  = B(11) - B(9)
          D(10) = B(12) - B(10)
          D(11) = D(9)**2 + D(10)**2
          D(12) = D(7) * D(9) + D(8) * D(10)
          D(13) = D(12)**2 - D(11) * (D(7)**2 + D(8)**2 - B(3)**2)
          IF (D(13) .GE. 0) THEN
            D(14) = - D(12) / D(11)
            D(13) = SQRT(D(13)) / D(11)
            D(5)  = D(14) + D(13)
            D(1)  = B(9)  + D(5) * D(9)
            D(2)  = B(10) + D(5) * D(10)
            IF (D(13) .GT. 1E-4) THEN
              D(6) = D(14) - D(13)
              D(3) = B(9)  + D(6) * D(9)
              D(4) = B(10) + D(6) * D(10)
            END IF
          END IF
          IF (ABS(D(5) - 0.5) .LE. 0.5) THEN
            NF(15)       = NF(15) + 1
            R(NF(15), 1) = D(1)
            R(NF(15), 2) = D(2)
            R(NF(15), 3) = SQRT((B(9) - D(1))**2 + (B(10) - D(2))**2)
          END IF
          IF (ABS(D(6) - 0.5) .LE. 0.5) THEN
            NF(15)       = NF(15) + 1
            R(NF(15), 1) = D(3)
            R(NF(15), 2) = D(4)
            R(NF(15), 3) = SQRT((B(9) - D(3))**2 + (B(10) - D(4))**2)
          END IF
        END DO
        IF (NF(15) .LE. 0) GO TO 40
      END IF
      DO I2 = 1, NF(15) - 1
        K2 = 0
        B(13) = R(I2, 3)
        DO J2 = I2 + 1, NF(15)
          IF (B(13) .GE. R(J2, 3)) THEN
            B(13) = R(J2, 3)
            K2    = J2
          END IF
        END DO
        IF (K2 .GT. 0) THEN
          DO J2 = 1, 3
            CALL GEN018 (R(I2, J2), R(K2, J2))
          END DO
        END IF
      END DO
   40 DO 60 I = 1, NF(15) - 1
        B(9)  = R(I, 1)
        B(10) = R(I, 2)
        B(11) = R(I + 1, 1)
        B(12) = R(I + 1, 2)
        B(23) = (B(9)  + B(11)) * 0.5
        B(24) = (B(10) + B(12)) * 0.5
        IF (NF(1) .NE. 1 .AND. NF(4) .NE. 0) THEN
          DO J = 1, NF(4)
            NF(3) = IG1(J)
            DO I0 = 3, 6
              IF (IP(NF(3), I0 + 2) .LE. 0) GO TO 50
            END DO
            I0 = 6
   50       K0 = I0 + MOD(I0, 2) - 1
            DO J0 = 1, K0, 2
              NF(12) = MOD(J0, I0) + 2
              NF(13) = MOD(J0 + 1, I0) + 2
              NF(14) = MOD(J0 - 1, I0) + 2
              DO J1 = 13, 16
                J2 = MOD(J1 + 1, 2) + 2
                J3 = 13 + (J1 - 12) / 3
                B(J1) = A(IP(NF(3), NF(J3)), J2)
     1                - A(IP(NF(3), NF(12)), J2)
              END DO
              D(11)  = B(23) - A(IP(NF(3), NF(12)), 2)
              D(12)  = B(24) - A(IP(NF(3), NF(12)), 3)
              D(5)   = (D(11) * B(14) - D(12) * B(13)) /
     1                 (B(15) * B(14) - B(16) * B(13))
              D(6)   = (D(11) * B(16) - D(12) * B(15)) /
     1                 (B(13) * B(16) - B(14) * B(15))
              D(10)  = MIN (D(5), D(6))
              IF (D(10) .LE. 0.0) EXIT
            END DO
            IF (IFIX (SIGN (1.0, D(10))) .GE. 0) GO TO 60
          END DO
        END IF
        IF (NF(2) .NE. 0 .AND. NF(5) .NE. 0) THEN
          DO J = 1, NF(5)
            B(8)  = A(IO(IG2(J)), 5)
            B(19) = A(IO(IG2(J)), 2)
            B(20) = A(IO(IG2(J)), 3)
            IF (SQRT((B(23) - B(19))**2 + (B(24) - B(20))**2)
     1        .LE. B(8)) GO TO 60
          END DO
        END IF
        IF ((D(23) - B(9))**2 + (D(24) - B(10))**2 .GT. 1E-4) THEN
          D(23) = B(9)
          D(24) = B(10)
          CALL GGIP (D(23), D(24), 0.0, 3)
        END IF
        IF (NF(10) .LE. 1) THEN
          CALL GGIP (B(11), B(12), 0.0, 2)
        ELSE
          D(10) = D(23) - B(12)
          D(11) = B(11) - D(24)
          D(12) = 0.012 / SQRT(D(10)**2 + D(11)**2)
          D(10) = D(10) * D(12)
          D(11) = D(11) * D(12)
          CALL GGIP (B(11), B(12), 0.0, 2)
          CALL GGIP (B(11) + D(10), B(12) + D(11), 0.0, 2)
          CALL GGIP (D(23) + D(10), D(24) + D(11), 0.0, 2)
          CALL GGIP (D(23) - D(10), D(24) - D(11), 0.0, 2)
          CALL GGIP (B(11) - D(10), B(12) - D(11), 0.0, 2)
        END IF
        D(23) = B(11)
        D(24) = B(12)
   60 CONTINUE
      RETURN
      END SUBROUTINE PLA105
      SUBROUTINE PLA106
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP15=20,NP17=99,NP19=31,
     2 NVD=100000000,NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,
     3 NP39=30,NP41=200,NP45=2048,NP47=9,NP52=200,NP56=30,
     4 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /GGT/  MEDIUM
      DIMENSION TMAT(3, 3)
      COMMON /CTRLC/ CC
      LOGICAL CC
      DIMENSION DETER(2), QA(3, 3, 2), QC(3, 3, 2), V12(3, 2), YMIN(2),
     1 YMAX(2), QCC(3, 3), QD(3, 3), B(3, 3), S(3, 3), Y1(2), Y2(2),
     2 W(4, 2), FL(4, 4), QUA(3, 4), AAREV(3, 3)
      DIMENSION PROBA(9), LPOS(8, 2), POSL(6), YUNK(3, 3)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      DATA LPOS / 2, 2, 2, 5, 1, 1, 1, 5, 3, 6, 4, 4, 4, 6, 3, 3 /
      DATA PROBA /
     1      0.7644, 1.0026, 1.1932, 1.3672, 1.5382, 1.7164, 1.9144,
     2      2.1544, 2.5003/
C*********************************************************************C
C*********************************************************************C
      IWIN = IGBL(25) * IGBL(32)
      NCD   = 0
      NQD   = 0
      NBND  = 0
      IDASH = 0
      ID1   = 0
      DIST  = 0.0
      KKK   = 0
      NPOS  = 0
      PVER  = 0.0
      PHOR  = 0.0
      IPOS  = 0
      NB    = 0
      NP    = 0
   10 NCB      = IPR(131)
      NATOM    = IPR(39)
      NSUP     = IPR(64)
      NASUP    = NATOM + NSUP
      IPR(174) = NASUP + MAX (NASUP, NCB)
      IF (IPR(174) + NP15 .GT. NP1) THEN
        IPR(2) = 22
        GO TO 340
      END IF
      IF (IGBL(6) .NE. 8 .AND.
     1    IGBL(6) .NE. 9 .AND.
     1    IGBL(6) .NE. 22) IGBL(6) = 1
   20 IPR(477) = 0
      K        = 0
      DO I = 1, NASUP
        DO J = 1, 3
          XXO(I, J) = VOID(K + J + 3)
        END DO
        K       = K + NP4 + 15
        IATP(I) = I + NP1
        CALL GEN048 (-1, IFG(1, I), 7, IHAT)
        CALL GEN048 (-1, IFG(2, I), 12, INH)
        IF (IGBL(59) .NE. 0) THEN
          CALL GEN048 (-7, IFG(2, I), 1, IPP)
          NPOP = IPPR(IPP + 1, 1)
          IF (NPOP .LT. 1000) THEN
            IF (IGBL(88) .EQ. 0) THEN
              IF (IPPR(IPP + 1, 1) .LT. 500) CYCLE
            ELSE
              IF (IPPR(IPP + 1, 1) .GT. 500) CYCLE
            END IF
          END IF
        END IF
        IF (IHAT     .NE. 1 .OR.
     1      INH      .NE. 0 .OR.
     2      IPR(212) .NE. 0) THEN
          IF (IPR(140) .GT. 0) THEN
            CALL GEN048 (-6, IFG(1, I), 9, IRES)
            IF (IRES .NE. IPR(140)) CYCLE
          END IF
          IPR(477) = IPR(477) + 1
          IATP(I)  = I
        END IF
      END DO
      IF (IGBL(87) .EQ. 0) IGBL(87) = 1
      CALL GEN021 (RMAT, IGBL(87))
      PAR(389) = 0
      IPR(479) = 1
      IF (IGBL(67) .EQ. 0) THEN
        CALL PLA054 (0)
        DO I = 1, 3
          DUMI       =  DUMV(I, 1)
          DUMV(I, 1) = -DUMV(I, 3)
          DUMV(I, 3) =  DUMI
        END DO
        CALL GEN004 (DUMV, RMAT, YUNK)
        CALL GEN052 (YUNK, RMAT)
        IGBL(67) = 1
      ELSE
        DO L = 1, 3
          X = - RGBL(27 + L) / RGBL(6)
          LLL = L
          CALL GEN051 (0, RMAT, X, LLL)
        END DO
      END IF
      NLOOP = 2
   40 IPR(478) = 0
   50 IPR(478) = IPR(478) + 1
      IF (CC) GO TO 300
      PAR(46) = PROBA(IPR(45))
      IF (IPR(108) .NE. 0) THEN
        OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'.rst',
     1                          STATUS = 'UNKNOWN')
        WRITE (LU65, 99996, IOSTAT = IOST) JID(1:50)
        CALL GEN005 (RMAT, TMAT)
      END IF
      IF (IPR(116) .EQ. 1) PAR(389) = PAR(389) -9.0 + 6.0 * IPR(478)
      IF (NLOOP .GE. 1) THEN
        DUMMY = - PAR(389) / RGBL(6)
        CALL GEN051 (0, RMAT, DUMMY, IPR(479))
      END IF
      IF (LRET .NE. 6) PAR(389) = 0.0
      CALL GEN003 (OR, ROR, DET, 0)
      CALL GEN004 (ROR, RMAT, RORO)
      CALL GEN004 (AA, RORO, AAREV)
      CALL GEN005 (RMAT, DUMV)
      CALL GEN096 (DUMV, IROTX, IROTY, IROTZ, IDET, V6, YANK, RORO)
      RGBL(28)   = IROTX
      RGBL(29)   = IROTY
      RGBL(30)   = IROTZ
      IGBL(87) = IDET
        DO I = 1, 3
          VIEWV(I) = RORO(I, 3)
        END DO
        CALL GEN007 (AA, VIEWV, VIEWV, -1)
      PAR(37) = PAR(38) * PAR(50)
      CALL GEN074 (PAR, 58, 60, -1.E5)
      CALL GEN074 (PAR, 55, 57,  1.E5)
      IPR(477) = 0
      IREF = IPR(297)
      DO I = 1, NASUP
        DO J = 1, 9
          CON(I, J) = VOID(IREF + J)
        END DO
        IREF = IREF + 21
        DO J = 1, 3
          IF (I .GT. NATOM) THEN
            XSD(I, J) = VOID(IREF + J - 12) / 2.0
          ELSE
            XSD(I, J) = VOID(IREF + J - 12)
          END IF
        END DO
        IF (IATP(I) .LE. NP1) THEN
          DO J = 1, 3
            V1(J) = VOID((I - 1) * (NP4 + 15) + J)
          END DO
          CALL GEN002 (-1, AAREV, V1, V7, XLNG)
          IPR(477)       = IPR(477) + 1
          IATC(IPR(477)) = I
          DATC(IPR(477)) = V7(3)
          CALL GEN048 (-1, IFG(2, I), 27, ISKP)
          IF (ISKP .EQ. 0) THEN
            DO J = 1, 3
              PAR(57 + J) = MAX (PAR(57 + J), V7(J))
              PAR(54 + J) = MIN (PAR(54 + J), V7(J))
            END DO
          END IF
        END IF
      END DO
C * AUTOMATIC SCALE AND POSITION DETERMINATION SECTION
      PAR(45) = (PAR(37) - PAR(40) * 2.0) /
     1          (PAR(58) - PAR(55) + 2.0 * PAR(41))
      PAR(45) = MIN (PAR(45), (PAR(38) - PAR(40) * 2.0) /
     1          (PAR(59) - PAR(56) + 2.0 * PAR(41)))
      PAR(47) = PAR(45) * PAR(46)
      DO J = 1, 2
        V2(J) = (PAR(36 + J) - PAR(45) *
     1          (PAR(57 + J) + PAR(54 + J))) / 2.0
      END DO
      V2(3) = 0.0
      CALL GEN013 (DATC, IATC, 1, IPR(477))
      DO 60 IA = 1, IPR(477)
        NIA = NASUP + IA
        IIA = IATC(IA)
        IF (IIA .NE. 0) THEN
          CALL GEN048 (-1, IFG(2, IIA), 27, ISKP)
          IF (ISKP .EQ. 0) THEN
            DO J = 1, 3
              V1(J) = VOID((IIA - 1) * (NP4 + 15) + J)
              IF (XSD(IIA, J) .LT. 0.001) XSD(IIA,J) = 0.001
              V6(J) = 1.0 / XSD(IIA, J)**2
            END DO
            CALL GEN002 (-1, AAREV, V1, V7, XLNG)
            IF (IPR(108) .NE. 0) THEN
              CALL PLA047 (LABA(IIA), NQ2, IDUM, JDUM, 0,
     1          IGBL(55), 1, 0)
                WRITE (LU65, 99998, IOSTAT = IOST)
     1            IIA, NQ2, 0, (V7(J), J = 1, 3), 1.0, 0.0
                L    = 0
                IANI = 1
                CALL GEN048 (-1, IFG(1, IIA), 7, IHAT)
                IF (IHAT .EQ. 1) THEN
                  CALL GEN048 (-1, IFG(1, IIA), 4, IANI)
                END IF
                DO J = 1, 3
                  DO K = 1, 3
                    L = L + 1
                    UIJC(J, K) = VOID(IPR(297) + IIA * 21 + L - 9)
     1                         * 10000.0
                    IF ((IANI .EQ. 0 .OR. NQ2(1:2) .EQ. 'CG')
     1                .AND. J .EQ. K) UIJC(J, K) = 25
                  END DO
                END DO
                CALL GEN001 (1, TMAT, UIJC, UIJC)
                WRITE (LU65, 99997, IOSTAT = IOST)
     1            IIA, NQ2, 0, (NINT(UIJC(J, J)), J = 1, 3),
     2            NINT(UIJC(1, 2)), NINT(UIJC(1, 3)), NINT(UIJC(2, 3))
            END IF
            DO J = 1, 3
              XXO(IA, J) = V7(J) * PAR(45) + V2(J)
            END DO
            DO I = 1, 9
              J = MOD (I - 1, 3) + 1
              K = ((I - 1) / 3)  + 1
              PAT(J, K) = CON(IIA, I)
            END DO
            CALL GEN005 (AAREV, QD)
            CALL GEN004 (QD, PAT, PAC)
            CALL GEN099 (PAC, V6, QD)
            DO J = 1, 2
              DO K = 1, 2
                QD(J, K) = QD(J, K) - QD(J, 3) * QD(K, 3) / QD(3, 3)
              END DO
            END DO
            DO J = 1, 2
              QD(J, 3) = 0.0
              QD(3, J) = 0.0
              V6(J)    = XXO(IA, J)
            END DO
            QD(3, 3) = - PAR(47)**2
            CALL GEN003 (QD, QCC, DUMMY, 1)
            TD2 = QD(3, 3)
            NDG = 0
            DO J = 1, 2
              T1 = QCC(3, J)**2 - QCC(J, J)
              IF (T1 .LE. 0.0) THEN
                NDG   = 1
                V5(J) = 0.001 + PAR(44)
              ELSE
                V5(J) = SQRT(T1) + PAR(44)
                V6(J) = V6(J) + QCC(3, J)
                TD2   = TD2 + QD(3, J) * QCC(3, J)
              END IF
              XXO(NIA, 2 * J - 1) = V6(J) - V5(J)
              XXO(NIA, 2 * J)     = V6(J) + V5(J)
            END DO
            IF (NDG .EQ. 0) THEN
              IF (TD2 .LT. 0.0) THEN
                TD3 = - (1.0 - 2.0 * PAR(44) / (V5(1) + V5(2)))**2
     1              / TD2
                XSD(NIA, 1) = QD(1, 1) * TD3
                XSD(NIA, 2) = QD(1, 2) * TD3
                XSD(NIA, 3) = QD(2, 2) * TD3
                GO TO 60
              END IF
            END IF
            XSD(NIA, 1) = 4.0 / (XXO(NIA, 2) - XXO(NIA, 1))**2
            XSD(NIA, 2) = 0.0
            XSD(NIA, 3) = 4.0 / (XXO(NIA, 4) - XXO(NIA, 3))**2
          END IF
        END IF
   60 CONTINUE
      K   = NASUP + 1
      NCD = 0
      DO I = 1, NCB
        XSD(K, 4) = VOID(IPR(298) + I * 3 - 2)
        XSD(K, 5) = VOID(IPR(298) + I * 3 - 1)
        XBND      = VOID(IPR(298) + I * 3)
        XB        = PAR(84 + NINT(ABS(XBND)))
        IF (XB .LT. 0) THEN
          XB   = - XB
          XBND = - ABS(XBND)
        END IF
        XSD(K, 6) = SIGN (128 / 2**XB, XBND)
        XXO(K, 5) = PAR(85 + NINT(ABS(XBND)))
        IF (IATP(NINT(XSD(K, 4))) .LT. NP1) THEN
          NCD = NCD + 1
          K   = K + 1
        END IF
      END DO
      IF (IPR(108) .NE. 0) THEN
        CLOSE (UNIT = LU65)
        IF (IPR(477) .GT. 1) CALL PLA209
        IPR(108) = 0
        GO TO 50
      END IF
   70 CALL GEN074 (SCIR, 1, 390, 0.0)
      CALL GEN074 (DP,   1, 260, 0.0)
C * GRAPHICS OUTPUT SECTION
      PVER    = PAR(349)
      IF (IPR(478) .LE. 1 .AND. NLOOP .GE. 1) THEN
        BCD(1:12) = 'P.L.A.T.O.N'//CHAR(0)
        CALL GGIP (PAR(37), PAR(38), 0.0, 1)
      END IF
      IF (IWIN .EQ. 1 .AND. LRET .EQ. 6) THEN
        BCD = 'Click on Window to STOP Rotation'//CHAR(0)
        CALL GGIP (-999.0, 2.0, 33.0, 111)
      END IF
      IF (IPR(116) .EQ. 0) THEN
        CALL GGIP (0.0, 1.0, 0.0, 0)
      ELSE
        CALL GGIP (0.0, FLOAT(IPR(143 + IPR(478) - 1)), 0.0, 0)
      END IF
      CALL PLA110 (PAR(37), PAR(38), 1)
      IF (NCD .GT. 0 .OR. IPR(201) .EQ. 0) THEN
        NQD   = 0
        V8(1) = 0.0
        V8(2) = 0.0
        V8(3) = 1.0
        IF (NCD .EQ. 0) THEN
          MILP = 3
        ELSE
          MILP = 1
        END IF
        IF (IGBL(75) .NE. 0 .AND.
     1      IPR(201) .EQ. 0) THEN
          MLP = 3
        ELSE
          MLP = 2
        END IF
        DO MLOOP = MILP, MLP
          IF (MLOOP .LT. 3) THEN
            MNB = NCD
          ELSE
            MNB = IPR(477)
          END IF
          DO 210 NBLP = 1, MNB
            IF (CC) GO TO 300
            NSHIFT = 1
   80       IF (MLOOP .LT. 3) THEN
              NBND = NINT(XSD(NASUP + NBLP, 6))
              IF (NBND .GT. 0) THEN
                IDASH = 0
              ELSE
                IDASH = 1
                NBND  = IABS(NBND)
              END IF
              KD1     = NINT(XSD(NASUP + NBLP, 4))
              KD2     = NINT(XSD(NASUP + NBLP, 5))
              W(1, 1) = KD1
              W(1, 2) = KD2
              NA1     = 0
              NA2     = 0
              DO 90 K = 1, IPR(477)
                III = IATC(K)
                IF (III .EQ. 0) GO TO 90
                I   = 0
                IF (III .EQ. KD1) THEN
                  NA1 = K
                  I   = 1
                  CALL GEN048 (-1, IFG(2, III), 27, ISKP)
                  IF (ISKP .EQ. 1) GO TO 210
                ELSE IF (III .EQ. KD2) THEN
                  NA2 = K
                  I   = 2
                  CALL GEN048 (-1, IFG(2, III), 27, ISKP)
                  IF (ISKP .EQ. 1) GO TO 210
                END IF
                IF (I .NE. 0) THEN
                  DO J = 2, 4
                    W(J, I) = XXO(K, J - 1)
                  END DO
                  IF (NA1 .GT. 0 .AND. NA2 .GT. 0) THEN
                    IF (W(4, 1) .LT. W(4, 2)) THEN
                      DO J = 1, 4
                        CALL GEN018 (W(J, 1), W(J, 2))
                      END DO
                      CALL GEN014 (NA1, NA2)
                    END IF
                    ID1 = NA1 * (NP1 + 1) + NA2
                    GO TO 100
                  END IF
                END IF
   90         CONTINUE
              GO TO 210
  100         DO I = 1, 3
                DAM(I, 3) = W(1 + I, 2) - W(1 + I, 1)
              END DO
              CALL GEN007 (AA, DAM(1, 3), V3, 1)
              IF (MLOOP .EQ. 2) DIST = SQRT(DAM(1, 3)**2 + DAM(2, 3)**2
     1           + DAM(3, 3)**2) / PAR(45)
              CALL GEN002 (-1, RORO, AAREV(1, 3), V2, XLNG)
              CALL GEN007 (AA, V2, V2, 1)
              T6 = ABS(GEN009 (V3, V2))
              IF (0.9994 .LE. T6) GO TO 210
              CALL GEN019 (AA, BB, V3, V2, B, 1)
              TX = XXO(NASUP + NBLP, 5) / PAR(46)
              DO J = 1, 3
                T1           = - B(J, 2) * TX
                SCIR(J, 1)   =   T1
                SCIR(J, 129) =   T1
                SCIR(J, 65)  = - T1
                T1           = - B(J, 3) * TX
                SCIR(J, 33)  =   T1
                SCIR(J, 97)  = - T1
              END DO
              DO K = 1, 3
                T1    = SQRT(1.0 /
     1              (2.0 * (1.0 + COS(RGBL(5) / (2**(K + 1))))))
                KDEL  = 2**(6 - K)
                KDEL1 = KDEL + 1
                KDEL2 = KDEL / 2
                DO L = KDEL1, 65, KDEL
                  J = L - KDEL
                  M = L - KDEL2
                  DO N = 1, 3
                    T2 = (SCIR(N, L) + SCIR(N, J)) * T1
                    SCIR(N, M)      =  T2
                    SCIR(N, M + 64) = -T2
                  END DO
                END DO
              END DO
              DO 110 II = 1, 2
                III = NINT(W(1, II))
                DO I = 1, 9
                  J = MOD (I - 1, 3) + 1
                  K = ((I - 1) / 3)  + 1
                  PAT(J, K) = CON(III, I)
                END DO
                CALL GEN005 (AAREV, QM)
                CALL GEN004 (QM, PAT, PAC)
                DO J = 1, 3
                  IF (XSD(III, J) .NE. 0.0) THEN
                    V6(J) = 1.0 / XSD(III, J)**2
                  ELSE
                    V6(J) = 1.0
                  END IF
                END DO
                CALL GEN099 (PAC, V6, QM)
                T1 = 3 - II * 2
                DO J = 1, 3
                  V3(J) = V3(J) * T1
                END DO
                IF (GEN006 (V3, QM, V8) .LT. 0.0) THEN
                  IBND = 0
                  T1 = - 1.0 / QM(3, 3)
                  DO J = 1, 2
                    DO K = 1, 2
                      S(K, J) = QM(K, J) + QM(K, 3) * QM(J, 3) * T1
                    END DO
                    S(3, J) = 0.0
                    S(J, 3) = 0.0
                  END DO
                  S(3, 3) = 0.0
                ELSE
                  DO J = 1, 3
                    DO K = 1, 3
                      S(J, K) = QM(J, K)
                    END DO
                  END DO
                  IBND = II
                END IF
                T5 = 1.0
                IF (II .LT. 2) THEN
                  RADIUS = 1.0 + T6 * PAR(48)
                ELSE
                  RADIUS = 1.0 - T6 * PAR(48)
                END IF
                CALL GEN002 (1, S, V3, V4, XLNG)
                T2 = GEN009 (V3, V4)
                KL = 5 - 2 * II
                IF (MLOOP .EQ. 2) THEN
                  KSTP = 4
                ELSE
                  KSTP = 32
                END IF
                DO K = 1, 65, KSTP
                  DO J = 1, 3
                    V6(J) = SCIR(J, K) * RADIUS
                    V5(J) = V6(J)
                  END DO
                  T3 = GEN009 (V5, V4)
                  T4 = T3 * T3 - T2 * (GEN006(V5, S, V5) - T5)
                  IF (T4 .LT. 0.0000001) GO TO 210
                  T4 = SQRT(T4)
                  T1 = ( T4 - T3) / T2
                  T3 = (-T4 - T3) / T2
                  L  = K + KL - 1
                  DO J = 1, 3
                    SCIR(J, L)     = ( V6(J) + T1 * V3(J)) * PAR(47)
                    SCIR(J, L + 1) = (-V6(J) - T3 * V3(J)) * PAR(47)
                  END DO
                END DO
                IF (IBND + MLOOP .EQ. 2) THEN
                  T4 = T2 * T5
                  IF (T4 .LT. 0.0) GO TO 210
                  T1 = SQRT(T4)  / T2
                  DO J = 1, 3
                    T4 = (T1 * V3(J) * PAR(47) - 0.5 * (SCIR(J, KL)
     1                 + SCIR(J, KL + 64))) * 1.001
                    SCIR(J, KL)      = SCIR(J, KL) + T4
                    SCIR(J, KL + 64) = SCIR(J, KL + 64) + T4
                  END DO
                END IF
                DO I = 1, 65, KSTP
                  DP(1, II - 1 + I) = SCIR(1, KL - 1 + I) + W(2, II)
                  DP(2, II - 1 + I) = SCIR(2, KL - 1 + I) + W(3, II)
                END DO
                IF (IBND .EQ. 1) THEN
                  DO I = 68, 128, KSTP
                    DP(1, II + I) = SCIR(1, KL - 63 + I) + W(2, II)
                    DP(2, II + I) = SCIR(2, KL - 63 + I) + W(3, II)
                  END DO
                  GO TO 110
                END IF
                DO K = 4, 64, 4
                  L = K + II
                  M = L + 64
                  N = 66 - L
                  IF (N .LE. 0) GO TO 110
                  DP(1, M) = DP(1, N)
                  DP(2, M) = DP(2, N)
                END DO
  110         CONTINUE
              DO K = 1, 65, 32
                T1 = 0.0
                T2 = 0.0
                DO J = 1, 2
                  T1 = T1 + (DP(J, K)     - W(J + 1, 1))**2
                  T2 = T2 + (DP(J, K + 1) - W(J + 1, 1))**2
                END DO
                IF (T2 .LE. T1) GO TO 210
              END DO
            ELSE
              NTOM = NASUP + NBLP
              KKK  = IATC(NBLP)
              IF (KKK .EQ. 0) GO TO 210
              IF (KKK .GT. NATOM) THEN
                IF (IPR(506) .EQ. 0) GO TO 210
              END IF
              CALL GEN048 (-4, IFG(1, KKK), 15, NO1)
              CALL GEN048 (-1, IFG(2, KKK), 12, INH)
              CALL GEN048 (-1, IFG(1, KKK), 7, IHAT)
              NO1 = NO1 + 1
              IF ((IHAT .NE. 1 .AND. IEN(NO1) .NE. 2 * IPR(618)) .OR.
     1          (MAX (IPR(212), INH) * IPR(232) .EQ. 1 .AND.
     2           IPR(618) .EQ. 0)) THEN
                NPOS = 0
                CALL PLA047 (LABA(KKK), NQ1, IDUM, JDUM,
     1            IPR(350) * 2 - 1, IGBL(55), 0, 1 - IGBL(55))
                CALL GEN039 (1, NQ1, 1, 6, NB, NP)
                NSHIFT  = NSHIFT + 2
                PAR71   = NSHIFT * PAR(71)
                XSFT    = (XXO(NTOM, 2) - XXO(NTOM, 1)) / 7.0
                YSFT    = (XXO(NTOM, 4) - XXO(NTOM, 3)) / 7.0
                PHOR    = PVER * NP * 6.0 / 7.0
                POSL(1) = XXO(NTOM, 1) - PHOR - PAR71
                POSL(2) = XXO(NTOM, 2) + PAR71
                POSL(3) = XXO(NTOM, 3) - PVER - PAR71
                POSL(4) = XXO(NTOM, 4) + PAR71
                POSL(5) = (POSL(1) + POSL(2)) / 2.0
                POSL(6) = (POSL(3) + POSL(4)) / 2.0
                IF (POSL(5) .GT. PAR(37) / 2.0) THEN
                  IF (POSL(6) .GT. PAR(38) / 2.0) THEN
                    IPOS = 2
                  ELSE
                    IPOS = 0
                  END IF
                ELSE
                  IF (POSL(6) .GT. PAR(37) / 2.0) THEN
                    IPOS = 4
                  ELSE
                    IPOS = 6
                  END IF
                END IF
              ELSE
                GO TO 210
              END IF
            END IF
            IF (MLOOP .EQ. 1) THEN
              NQD = NQD + 1
              T1 = 0.0
              T2 = 0.0
              DO J = 1, 2
                Y1(J) = DP(J, 1) - DP(J, 65)
                Y2(J) = DP(J, 2) - DP(J, 66)
                T1    = T1 + Y1(J)**2
                T2    = T2 + Y2(J)**2
              END DO
              IF (T1 * T2 .LE. 0.0) THEN
                T1 = 0.0
                T2 = 0.0
              ELSE
                T1 = PAR(44) / SQRT(T1)
                T2 = PAR(44) / SQRT(T2)
              END IF
              NREF = NASUP + NQD
              DO J = 1, 2
                Y1(J)            = Y1(J) * T1
                Y2(J)            = Y2(J) * T2
                CON(NREF, J)     = DP(J, 1)  + Y1(J)
                CON(NREF, J + 2) = DP(J, 2)  + Y2(J)
                CON(NREF, J + 4) = DP(J, 66) - Y2(J)
                CON(NREF, J + 6) = DP(J, 65) - Y1(J)
              END DO
              CON(NREF, 9) = ID1
            ELSE
  120         IF (MLOOP .EQ. 3) THEN
  130           IPOS = MOD(IPOS, 8) + 1
                NPOS = NPOS + 1
                KKKA = KKK * (NP4 + 15)
                IF (NPOS .GT. 8) THEN
                  IF (NSHIFT .LT. 10) GO TO 80
                  IF (LRET .NE. 6) WRITE (LU6, 99999, IOSTAT = IOST) NQ1
                  IF (IGBL(105) .EQ. 0) THEN
                    VOID(KKKA - 2) = 0.0
                    VOID(KKKA - 1) = 0.0
                    VOID(KKKA    ) = 0.0
                  ELSE
                    VOID(KKKA - 2) = POSL(LPOS(8, 1))
                    VOID(KKKA - 1) = POSL(LPOS(8, 2))
                    VOID(KKKA    ) = PHOR
                  END IF
                  GO TO 210
                END IF
                LPOS1  = LPOS(IPOS, 1)
                LPOS2  = LPOS(IPOS, 2)
                LPOS12 = LPOS1 * 10 + LPOS2
                SELECT CASE (LPOS12)
                  CASE (23)
                    XSHFT = - XSFT
                    YSHFT =   YSFT
                  CASE (24)
                    XSHFT = - XSFT
                    YSHFT = - YSFT
                  CASE (14)
                    XSHFT =   XSFT
                    YSHFT = - YSFT
                  CASE (13)
                    XSHFT =   XSFT
                    YSHFT =   YSFT
                  CASE DEFAULT
                    XSHFT  = 0.0
                    YSHFT  = 0.0
                END SELECT
                VOID(KKKA - 2) = POSL(LPOS1) + XSHFT
                VOID(KKKA - 1) = POSL(LPOS2) + YSHFT
                VOID(KKKA    ) = PHOR
                DP(1, 1)       = VOID(KKKA - 2)
                DP(2, 1)       = VOID(KKKA - 1)
                DP(1, 2)       = DP(1, 1)
                DP(2, 2)       = DP(2, 1) + PVER
                DP(1, 65)      = DP(1, 1) + PHOR
                DP(2, 65)      = DP(2, 1)
                DP(1, 66)      = DP(1, 65)
                DP(2, 66)      = DP(2, 2)
                IF (DP(1, 1) .LT. 0.0 .OR. DP(1, 65) .GT. PAR(37) .OR.
     1              DP(2, 1) .LT. 0.0 .OR. DP(2, 65) .GT. PAR(38))
     2              GO TO 130
                ID1 = 0
                NA1 = 0
                NA2 = 0
                IF (NBLP .GT. 1) THEN
                  NBM1 = NBLP - 1
                  DO J = 1, NBM1
                    JJJ = IATC(J)
                    IF (JJJ .NE. 0) THEN
                      CALL GEN048 (-1, IFG(2, JJJ), 27, ISKP)
                      IF (ISKP .EQ. 0) THEN
                        IF (IPR(232) .EQ. 0) THEN
                          CALL GEN048 (-1, IFG(1, JJJ), 7, JHAT)
                          ISKP = JHAT
                        END IF
                        IF (ISKP .EQ. 0) THEN
                          KKKK = KKK * (NP4 + 15)
                          JJJJ = JJJ * (NP4 + 15)
                          DSX  = ABS(VOID(KKKK - 2) - VOID(JJJJ - 2))
                          DSY  = ABS(VOID(KKKK - 1) - VOID(JJJJ - 1))
                          IF (DSY .LT. 1.1 * PAR(349)) THEN
                            IF (DSX .LT. MAX (PHOR, VOID(JJJJ)))
     1                          GO TO 130
                          END IF
                        END IF
                      END IF
                    END IF
                  END DO
                END IF
                IF (IGBL(74) .NE. 0) THEN
                  CALL GGIP (DP(1, 1),  DP(2, 1),  0.0, 3)
                  CALL GGIP (DP(1, 65), DP(2, 65), 0.0, 2)
                  CALL GGIP (DP(1, 66), DP(2, 66), 0.0, 2)
                  CALL GGIP (DP(1, 2),  DP(2, 2),  0.0, 2)
                  CALL GGIP (DP(1, 1),  DP(2, 1),  0.0, 2)
                  CALL GGIP09 (0.0, CHAR(48 + IPOS), 1, 0.3, 2, 1,
     1               DP(1,1),DP(2,1))
                END IF
              END IF
              IPR(151) = 0
              IPR(152) = 0
              IQ       = NQD + 1
              IQN      = IQ + NASUP
              DO J = 1, 2
                YMIN(J) = MIN(DP(J, 1), DP(J, 2), DP(J, 66), DP(J, 65))
                YMAX(J) = MAX(DP(J, 1), DP(J, 2), DP(J, 66), DP(J, 65))
                CON(IQN, J)     = DP(J, 1)
                CON(IQN, J + 2) = DP(J, 2)
                CON(IQN, J + 4) = DP(J, 66)
                CON(IQN, J + 6) = DP(J, 65)
              END DO
              CON(IQN, 9) = ID1
              CALL PLA107 (0, 0, 0, DUMP)
              NA1P1 = NA1 + 1
              DO 140 IA = NA1P1, IPR(477)
                IATCIA = IATC(IA)
                IF (IATCIA .NE. 0) THEN
                  IF (IA .NE. NA2 .AND. IATCIA .LE. NATOM) THEN
                    NIA = NASUP + IA
                    CALL GEN048 (-1, IFG(2, IATCIA), 27, ISKP)
                    IF (ISKP .NE. 1) THEN
                      DO J = 1, 2
                        IF (YMAX(J) .LE. XXO(NIA, 2 * J - 1)) GO TO 140
                        IF (YMIN(J) .GE. XXO(NIA, 2 * J    )) GO TO 140
                      END DO
                      CALL PLA107 (IQ, IA, 1, DUMP)
                      IF (DUMP .GT. 0.0) THEN
                        IF (IPR(151) .GE. NP15) GO TO 150
                      ELSE IF (DUMP .LT. 0.0) THEN
                        GO TO 210
                      END IF
                    END IF
                  END IF
                END IF
  140         CONTINUE
  150         IF (NQD .GT. 0) THEN
                IF (MLOOP .LT. 3) THEN
                  DO III = 1, 3
                    V1(III)  = XXO(NA2, III) - XXO(NA1, III)
                  END DO
                  CALL GEN007 (AA, V1, V1, 1)
                END IF
                DO 190 IB = 1, NQD
                  NIB = NASUP + IB
                  ID2 = NINT(CON(NIB, 9))
                  IF (ID1 .EQ. ID2) GO TO 190
                  NB2 = MOD(ID2, NP1 + 1)
                  NB1 = ID2 / (NP1 + 1)
                  IF (NA2 .GT. NB1) GO TO 190
                  DO J = 1, 2
                    IF (YMAX(J) .LE. MIN (CON(NIB, J), CON(NIB, J + 2),
     1                CON(NIB, J + 4), CON(NIB, J + 6))) GO TO 190
                    IF (YMIN(J) .GE. MAX (CON(NIB, J), CON(NIB, J + 2),
     1                CON(NIB, J + 4), CON(NIB, J + 6))) GO TO 190
                  END DO
                  DO L = 1, 4
                    K         = 2 * L
                    K1        = MOD(K, 8) + 2
                    QUA(1, L) = CON(NIB, K)      - CON(NIB, K1)
                    QUA(2, L) = CON(NIB, K1 - 1) - CON(NIB, K - 1)
                    QUA(3, L) = CON(NIB, K - 1)  * CON(NIB, K1)
     1                        - CON(NIB, K)      * CON(NIB, K1 - 1)
                    T1 = SQRT(QUA(1, L)**2 + QUA(2, L)**2)
                    IF (T1 .LE. 0.0) GO TO 190
                    DO J = 1, 3
                      QUA(J, L) = QUA(J, L) / T1
                    END DO
                  END DO
                  T3    = 3.0
                  NASIQ = NASUP + IQ
                  SCONX = 0.0
                  SCONY = 0.0
                  DO K = 1, 4
                    T2 = 3.0
                    J  = K * 2
                    XCONK = CON(NASIQ, J - 1)
                    YCONK = CON(NASIQ, J)
                    SCONX = SCONX + XCONK
                    SCONY = SCONY + YCONK
                    DO L = 1, 4
                      T1 = XCONK * QUA(1, L)
     1                   + YCONK * QUA(2, L) + QUA(3, L)
                      IF (T1 .LT. 0.0) T2 = T2 - 1.0
                      FL(L, K) = T1
                    END DO
                    IF (T2 .LT. 0.0) T3 = T3 - 1.0
                  END DO
                  IF (MLOOP .EQ. 3) THEN
                    XCONK = SCONX / 4.0
                    YCONK = SCONY / 4.0
                    T2    = 3.0
                    DO L = 1, 4
                      T1 = XCONK * QUA(1, L)
     1                   + YCONK * QUA(2, L) + QUA(3, L)
                      IF (T1 .LT. 0.0) T2 = T2 - 1.0
                    END DO
                    IF (T2 .LT. 0.0) GO TO 120
                  END IF
                  IF (T3 .LT. 0.0) THEN
                    ITYPE = -1
                  ELSE IF (T3 .LT. 3.0) THEN
                    ITYPE = 0
                  ELSE
                    NASIQ = NASUP + IQ
                    DO L = 1, 4
                      L1 = MOD(L, 4) + 1
                      Y1(1) = CON(NASIQ, L  * 2 - 1)
                      Y1(2) = CON(NASIQ, L  * 2)
                      Y2(1) = CON(NASIQ, L1 * 2 - 1)
                      Y2(2) = CON(NASIQ, L1 * 2)
                      DO K = 1, 4
                        T1 = FL(K, L)
                        T2 = FL(K, L1)
                        T3 = T1 - T2
                        IF (T1 * T2 .LE. 0.0) THEN
                          IF (ABS(T3) .GT. PAR(54)) THEN
                            T4 = (T1 * Y2(1) - T2 * Y1(1)) / T3
                            T5 = (T1 * Y2(2) - T2 * Y1(2)) / T3
                            K0 = 2 * K
                            K1 = 2 * (MOD(K, 4) + 1)
                            IF ((T4 - CON(NIB, K0 - 1)) *
     1                         (CON(NIB, K1 - 1) - T4)
     2                        + (T5 - CON(NIB, K0)) *
     3                         (CON(NIB, K1) - T5)
     4                       .GT. -1.E-4) GO TO 160
                          END IF
                        END IF
                      END DO
                    END DO
                    GO TO 190
  160               ITYPE = 1
                  END IF
                  IF (MLOOP .LT. 3) THEN
                    IF (NA1 .EQ. NB1 .OR.
     1                  NA1 .EQ. NB2 .OR.
     2                  NA2 .EQ. NB2 .OR.
     3                  NA2 .EQ. NB1) THEN
                      IF ((NA1 + NA2) .LT. (NB1 + NB2)) THEN
                        GO TO 180
                      ELSE
                        GO TO 190
                      END IF
                    END IF
                    DO J = 1, 3
                      V2(J) = XXO(NB2, J) - XXO(NB1, J)
                      V4(J) = XXO(NB1, J) - XXO(NA1, J)
                    END DO
                    CALL GEN007 (AA, V2, V2, 1)
                    CALL GEN007 (AA, V4, V4, 1)
                    CALL GEN011 (BB, V1, V2, V3, 1)
                    IF (GEN009 (V3, V3) .LE. PAR(54)) THEN
                      CALL GEN011 (BB, V1, V4, V5, 1)
                      CALL GEN011 (BB, V5, V1, V3, 1)
                      YUNK1 = GEN009 (V3, V3) - PAR(54)
                      IF (YUNK1 .GT. 0.0) THEN
                        GO TO 170
                      ELSE
                        GO TO 180
                      END IF
                    END IF
                    IF (GEN009 (V3, V4) .LT. - PAR(54)) THEN
                      DO J = 1, 3
                        V3(J) = - V3(J)
                      END DO
                    END IF
  170               IF (V3(3) .LE. 0.0) GO TO 190
                  END IF
  180             IF (ITYPE .LT. 0) GO TO 210
                  IF (IPR(152) .GE. NP7) GO TO 200
                  IPR(152) = IPR(152) + 1
                  DO K = 1, 4
                    DO J = 1, 3
                      XDIR(IPR(152), J, K) = QUA(J, K)
                    END DO
                  END DO
                  IDIR(IPR(152)) = IB
  190           CONTINUE
              END IF
  200         IF (MLOOP .LT. 3) THEN
                CALL PLA108 (1, 4, 129, 3)
                CALL PLA108 (2, 4, 66,  3)
                BDIR = - 0.5
                DO K = 1, 65, NBND
                  BDIR = - BDIR
                  DO J = 1, 2
                    DP(J, 130 + NINT(1.5 - BDIR)) = DP(J, K)
                    DP(J, 130 + NINT(1.5 + BDIR)) = DP(J, K + 1)
                  END DO
                  IF (IDASH .EQ. 1) THEN
                    NSTEP = NINT(DIST / 0.4) * 2 + 1
                  ELSE
                    NSTEP = 1
                  END IF
                  DELX  = (DP(1, 132) - DP(1, 131)) / NSTEP
                  DELY  = (DP(2, 132) - DP(2, 131)) / NSTEP
                  DO J = 1, NSTEP, 2
                    DP(1, 132) = DP(1, 131) + DELX
                    DP(2, 132) = DP(2, 131) + DELY
                    CALL PLA108 (131, 1, 132, 3)
                    DP(1, 131) = DP(1, 131) + 2 * DELX
                    DP(2, 131) = DP(2, 131) + 2 * DELY
                  END DO
                END DO
              ELSE
                IF (IPR(151) .GT. 0 .OR. IPR(152) .GT. 0) GO TO 120
              END IF
            END IF
  210     CONTINUE
        END DO
      END IF
C * LOOP THROUGH ATOM LIST TO DRAW ELLIPSOIDS
      DO 290 ITOM = 1, IPR(477)
        IF (CC) GO TO 300
        NTOM = NASUP + ITOM
        KKK = IATC(ITOM)
        IF (KKK .EQ. 0) GO TO 290
        IF (KKK .GT. NATOM) THEN
          IF (IPR(506) .EQ. 0) GO TO 290
        END IF
        CALL GEN048 (-1, IFG(2, KKK), 27, ISKP)
        IF (ISKP .EQ. 1) GO TO 290
        DO J = 1, 2
          YMIN(J) = XXO(NTOM, 2 * J - 1)
          YMAX(J) = XXO(NTOM, 2 * J    )
        END DO
        CALL GEN048 (-4, IFG(1, KKK), 15, NO1)
        NO1 = NO1 + 1
        IF (IEN(NO1) .EQ. 2) THEN
          NFRST = IPR(175)
          LINES = IPR(176)
        ELSE IF (IEN(NO1) .EQ. 1 .OR. IEN(NO1) .EQ. 33 .OR.
     1           IEN(NO1) .EQ. 113) THEN
          NFRST = IPR(177)
          LINES = IPR(178)
        ELSE
          NFRST = IPR(179)
          LINES = IPR(180)
        END IF
        IF (IPR(211) .EQ. 1) THEN
          NFRST = 0
        ELSE IF (IPR(211) .EQ. 2) THEN
          CALL GEN048 (-1, IFG(1, KKK), 7, IVAL)
          IF (IVAL .EQ. 0) THEN
            NFRST = 1
          ELSE
            NFRST = IPR(177)
          END IF
          LINES = IPR(180)
        END IF
        DO J = 1, 3
          V1(J) = VOID((KKK -1) * (NP4 + 15) + J)
          V7(J) = XXO(ITOM, J)
        END DO
        CALL PLA047 (LABA(KKK), NQ1, IDUM, JDUM, IPR(350) * 2 - 1,
     1               IGBL(55), 0, 1 - IGBL(55))
        IF (IGBL(75) .GT. 0) THEN
          CALL GEN048 (-1, IFG(2, KKK), 11, IVAL)
          CALL GEN048 (-1, IFG(2, KKK), 12, INH)
          CALL GEN048 (-1, IFG(1, KKK),  7, IHAT)
          IF ((IHAT .NE. 1 .AND. IEN(NO1) .GT.  IPR(618) * 2) .OR.
     1      (MAX (IPR(212), INH) * IPR(232) .GT. 0 .AND.
     2       IPR(618) .EQ.0)) THEN
            IF (IPR(116) .EQ. 0) THEN
              IF (IPR(328) .EQ. 0) THEN
                COLX = FLOAT(IVAL)
              ELSE
                COLX = FLOAT (2 - IVAL)
              END IF
              CALL GGIP (0.0, COLX, 0.0, 0)
            END IF
            XLPOS = VOID(KKK * (NP4 + 15) - 2)
            YLPOS = VOID(KKK * (NP4 + 15) - 1)
            IF ((XLPOS .GT. 1.0 .OR. YLPOS .GT. 1.0)
     1          .AND. COLX .NE. 0.0) CALL GGIP09
     1         (0.0, NQ1, 6, PAR(349), -1, 1, XLPOS, YLPOS)
            IF (IPR(116) .EQ. 0) CALL GGIP (0.0, 1.0, 0.0, 0)
          END IF
        END IF
        IF (KKK .GT. NATOM) GO TO 290
        IF (IPR(116) .EQ. 0 .AND. IPR(346) .EQ. 1) THEN
          CALL GEN048 (-4, IFG(1, KKK), 15, NRI)
          CALL GGIP (0.0, FLOAT(IACL(NRI + 1)) , 0.0, 0)
        END IF
        IPR(151) = 0
        IPR(152) = 0
        IF (IPR(477) .GT. ITOM) THEN
          L = 0
          DO 250 IA = ITOM, IPR(477)
            IATCIA = IATC(IA)
            IF (IATCIA .EQ. 0) GO TO 250
            IF (IATCIA .GT. NATOM) GO TO 250
            CALL GEN048 (-1, IFG(2, IATCIA), 27, ISKP)
            IF (ISKP .EQ. 1) GO TO 250
            NIA = NASUP + IA
            IF (IA .GT. ITOM) THEN
              DO J = 1, 2
                IF (YMAX(J) .LE. XXO(NIA, 2 * J - 1)) GO TO 250
                IF (YMIN(J) .GE. XXO(NIA, 2 * J    )) GO TO 250
              END DO
            END IF
            IF (L .LT. 2) L = L + 1
            IF (L .EQ. 2) THEN
              OVMR = 0.0
            ELSE
              OVMR = PAR(44)
            END IF
            V12(1, L)   = (XXO(NIA, 1) + XXO(NIA, 2)) * 0.5
            V12(2, L)   = (XXO(NIA, 3) + XXO(NIA, 4)) * 0.5
            V12(3, L)   = 1.0
            QA(1, 1, L) = XSD(NIA, 1)
            QA(1, 2, L) = XSD(NIA, 2)
            QA(2, 1, L) = XSD(NIA, 2)
            QA(2, 2, L) = XSD(NIA, 3)
            TX = XXO(NIA, 2) - XXO(NIA, 1) + XXO(NIA, 4) - XXO(NIA, 3)
            QA(3, 3, L) = -(1.0 - 4.0 * OVMR / TX)**2
            DO K = 1, 2
              QA(K, 3, L) = 0.0
              DO J = 1, 2
                QA(K, 3, L) = QA(K, 3, L) - V12(J, L) * QA(J, K, L)
              END DO
              QA(3, K, L) = QA(K, 3, L)
              QA(3, 3, L) = QA(3, 3, L) - QA(3, K, L) * V12(K, L)
            END DO
            CALL GEN003 (QA(1, 1, L), QC(1, 1, L), DET, -1)
            DETER(L) = DET * 3.0
            IF (L .LT. 2) GO TO 250
            AOV3 = 0.0
            BOV3 = 0.0
            DO J = 1, 3
              DO K = 1, 3
                AOV3 = AOV3 + QC(J, K, 2) * QA(J, K, 1)
                BOV3 = BOV3 + QC(J, K, 1) * QA(J, K, 2)
              END DO
            END DO
            AOV3   = AOV3 / DETER(2)
            AOV3SQ = AOV3**2
            BOV3   = BOV3 / DETER(2)
            POV3   = BOV3 - AOV3SQ
            QOV2   = AOV3 * (AOV3SQ - BOV3 * 1.5) + DETER(1) /
     1               (DETER(2) * 2.0)
            POV3CU = POV3**3
            QOV2SQ = QOV2**2
            PQTEST = POV3CU + QOV2SQ
            IF (PQTEST .GT. 0.0) THEN
              IF (PQTEST + POV3CU * 0.00001 .GT. 0.0) THEN
                GO TO 240
              END IF
            ELSE IF (PQTEST .LT. 0.0) THEN
              IF (PQTEST + QOV2SQ * 0.00001 .LT. 0.0) THEN
                IF (AOV3 .LT. 0.0) THEN
                  IF (BOV3 .LT. 0.0) GO TO 250
                END IF
                IF (QOV2 .EQ. 0.0) THEN
                  PHI = RGBL(5) / 4.0
                ELSE
                  PHI = ATAN(- SQRT( - PQTEST) / QOV2)
                  IF (PHI .LT. 0.0) PHI = PHI + RGBL(5) / 2.0
                END IF
                ROOT = 2.0 * SQRT( - POV3) * COS(PHI / 3.0) - AOV3
                GO TO 220
              END IF
            END IF
            IF (AOV3 .LT. 0.0 .AND. BOV3 .LT. 0.0) GO TO 250
            ROOT = SIGN (SQRT( - POV3), QOV2) - AOV3
  220       DO J = 1, 3
              DO K = 1, 3
                DAM(J, K) = QA(J, K, 1) + ROOT * QA(J, K, 2)
              END DO
            END DO
            T6 = DAM(1, 1) * DAM(2, 2)
            T7 = DAM(1, 2)**2
            IF (T6 .GT. 1.0001 * T7) THEN
              GO TO 230
            ELSE IF (T6 .LT.  0.9999 * T7) THEN
              GO TO 240
            ELSE
              T8 = DAM(3, 3) * (DAM(1, 1) + DAM(2, 2))
              T9 = DAM(1, 3)**2 + DAM(2, 3)**2
              IF (T8 * 1.0001 .LT. T9) GO TO 240
            END IF
  230       IF (QC(3, 3, 1) .LT. QC(3, 3, 2)) THEN
              KA = 2
              KB = 1
            ELSE
              KA = 1
              KB = 2
            END IF
            T1 = 0.0
            DO J = 1, 3
              T2 = QA(J, 3, KB)
              DO K = 1, 2
                T2 = T2 + QA(J, K, KB) * V12(K, KA)
              END DO
              T1 = T1 + V12(J, KA) * T2
            END DO
            IF (T1 .GT. 0.0) GO TO 250
            IF (KA .EQ. 1) GO TO 290
  240       IF (IPR(151) .LT.  NP15) IPR(151) = IPR(151) + 1
            IJ = 1
            DO I = 1, 3
              DO J = I, 3
                XXO(IPR(174) + IPR(151), IJ) = QA(I, J, 2)
                IJ = IJ + 1
              END DO
            END DO
  250     CONTINUE
          IF (NQD .GT. 0) THEN
            CALL PLA107 (0, 0, 0, DUMP)
            DO 260 IQ = 1, NQD
              NIQ = NASUP + IQ
              ID  = NINT(CON(NIQ, 9))
              NA1 = ID / (NP1 + 1)
              NA2 = MOD(ID, NP1 + 1)
              IF (ITOM .LE. NA2) THEN
                DO J = 1, 2
                  IF (YMAX(J) .LE. MIN (CON(NIQ, J),
     1              CON(NIQ, J + 2), CON(NIQ, J + 4),
     2              CON(NIQ, J + 6))) GO TO 260
                  IF (YMIN(J) .GE. MAX (CON(NIQ, J),
     1              CON(NIQ, J + 2), CON(NIQ, J + 4),
     2              CON(NIQ, J + 6))) GO TO 260
                END DO
                CALL PLA107 (IQ, ITOM, -1, YUNK1)
                IF (YUNK1 .LT. 0.0) GO TO 290
                IF (IPR(152) .GE. NP7) GO TO 270
              END IF
  260       CONTINUE
          END IF
        END IF
  270   DO I = 1, 9
          J = MOD (I - 1, 3) + 1
          K = ((I - 1) / 3)  + 1
          PAT(J, K) = CON(KKK, I)
        END DO
        CALL GEN005 (AAREV, QM)
        CALL GEN004 (QM, PAT, PAC)
        DO J = 1, 3
          T1     = XSD(KKK, J)
          IF (T1 .NE. 0.0) THEN
            V6(J)  = 1.0 / (T1**2)
          ELSE
            V6(J)  = 1.0
          END IF
          RMS(J) = T1
        END DO
        CALL GEN099 (PAC, V6, QM)
        CALL GEN002 (-1, AA, VIEWV, V2, XLNG)
        DO I = 1, 3
          IF (GEN009 (V2, PAT(1, I)) .LT. 0.0) THEN
            DO J = 1, 3
              PAC(J, I) = - PAC(J, I)
              PAT(J, I) = - PAT(J, I)
            END DO
          END IF
        END DO
        DO J = 1, 3
          PAC(J, 4) = PAC(J, 1)
          PAC(J, 5) = PAC(J, 2)
        END DO
        CALL GEN002 (-1, AAREV, VIEWV, V6, XLNG)
        CALL GEN007 (AA, V6, V6, 1)
        CALL GEN002 (1, QM, V6, V4, XLNG)
        CALL GEN007 (AA, V4, V4, 1)
        T3     = RMS(3) * PAR(47)
        NRESOL = 1
        NBIS   = 5
        DO J = 1, 3
          IF (T3 .LT. PAR(50 + J)) THEN
            NBIS   = NBIS - 1
            NRESOL = NRESOL * 2
          ELSE
            GO TO 280
          END IF
        END DO
  280   NRES1 = NRESOL + 1
        NFIRST = 4 - 3 * NFRST
        DO II = NFIRST, 4
          II0 = MOD(II + 2, 3) + 1
          II1 = MOD(II, 3) + 1
          II2 = MOD(II + 1, 3) + 1
          IF (0.99938 .LE. ABS(GEN009(V4, PAC(1, II2)))) THEN
            T1 = RMS(II0) * PAR(47)
            T2 = RMS(II1) * PAR(47)
            DO J = 1, 3
              DAM(J, 1) = PAC(J, II0) * T1
              DAM(J, 2) = PAC(J, II1) * T2
            END DO
          ELSE
            CALL GEN011 (BB, PAC(1, II0), PAC(1, II1), V1, 1)
            CALL GEN011 (BB, V1, V4, V2, 1)
            CALL GEN007 (AA, V2, V2, 1)
            CALL GEN002 (1, QM, V2, V3, XLNG)
            IF (II .LT. 4) THEN
              CALL GEN011 (BB, V3, V1, V5, 1)
            ELSE
              CALL GEN011 (BB, V3, V4, V5, 1)
            END IF
            CALL GEN007 (AA, V5, V5, 1)
            T1 = MAX (1.0E-10, GEN006 (V2, QM, V2))
            T2 = MAX (1.0E-10, GEN006 (V5, QM, V5))
            DO J = 1, 3
              DAM(J, 1) = V2(J) * PAR(47) / SQRT(T1)
              DAM(J, 2) = V5(J) * PAR(47) / SQRT(T2)
            END DO
          END IF
          DO J = 1, 3
            T1           = DAM(J, 1)
            SCIR(J, 1)   = T1
            SCIR(J, 129) = T1
            SCIR(J, 65)  = -T1
            T1           = DAM(J, 2)
            SCIR(J, 33)  = T1
            SCIR(J, 97)  = -T1
          END DO
          DO K = 1, NBIS
            T1    =
     1        SQRT(1.0 / (2.0 * (1.0 + COS(RGBL(5) / 2**(K + 1)))))
            KDEL  = 2**(6 - K)
            KDEL1 = KDEL + 1
            KDEL2 = KDEL / 2
            DO L = KDEL1, 65, KDEL
              J = L - KDEL
              M = L - KDEL2
              DO N = 1, 3
                T2 = (SCIR(N, L) + SCIR(N, J)) * T1
                SCIR(N, M)      =   T2
                SCIR(N, M + 64) = - T2
              END DO
            END DO
          END DO
          IF (II .LT. 4) THEN
            JEND = 65
          ELSE
            JEND = 129
          END IF
          DO J = 1, JEND, NRESOL
            DP(1, J) = SCIR(1, J) + V7(1)
            DP(2, J) = SCIR(2, J) + V7(2)
          END DO
          CALL PLA108 (1, 1, 1, 3)
          CALL PLA108 (NRES1, NRESOL, JEND, 2)
          IF (II .LT. 4) THEN
            DO J = 1, 3
              T1 = PAC(J, II0) * RMS(II0) * PAR(47)
              DAM(J, 1) = T1
              DAM(J, 2) = PAC(J, II1) * RMS(II1) * PAR(47)
              DAM(J, 3) = 0.0
            END DO
            IF (LINES .GT. 0) THEN
              DO I = 1, 3, 1
                DP(1, I) = DAM(1, I) + V7(1)
                DP(2, I) = DAM(2, I) + V7(2)
              END DO
              CALL PLA108 (1, 2, 3, 3)
              L = LINES - 1
              IF (L .GT. 0) THEN
                DO I = 1, L
                  T1 = FLOAT(I) / LINES
                  T3 = SQRT(1.0 - T1**2)
                  IF (MOD(I, 2) .NE. 0) THEN
                    M = I * 2
                    N = M - 1
                  ELSE
                    N = I * 2
                    M = N - 1
                  END IF
                  DO J = 1, 3
                    T4 = DAM(J, 1) * T1
                    SCIR(J, M) = T4
                    SCIR(J, N) = DAM(J, 2) * T3 + T4
                  END DO
                END DO
                L = L * 2
                DO I = 1, L
                  DP(1, I) = SCIR(1, I) + V7(1)
                  DP(2, I) = SCIR(2, I) + V7(2)
                END DO
                CALL PLA108 (1, 1, L, -3)
              END IF
            END IF
          END IF
        END DO
  290 CONTINUE
      CALL PLA109 (2, 0, 0.0, 0.0, 0)
      IF (IGBL(75) .GT. 0) IPR(201) = 1
      IF (IPR(478) .GT. 0 .AND. IPR(478) .EQ. IPR(116)) GO TO 50
      IF (LRET .EQ. 6) GO TO 310
  300 IF (IGBL(6) .EQ. 22) THEN
        CALL GGIP09 (0.0, 'CONTOUR-MAP', 11, 0.8, 5 + IGBL(68), 3,
     1               10.0, 0.2)
        GO TO 340
      END IF
      NLOOP = 2
      CALL PLA013 (0, 1)
      IF (IGBL(3) .EQ. 28) LRET = 7
      SELECT CASE (LRET)
        CASE (1)
          GO TO 320
        CASE (2)
          GO TO 50
        CASE (3)
          GO TO 70
        CASE (4)
          GO TO 20
        CASE (5)
          CALL PLA109 (1, 0, 0.0, 0.0, 0)
          GO TO 300
        CASE (6)
          GO TO 310
        CASE (7)
          GO TO 330
        CASE (8)
          GO TO 10
      END SELECT
  310 IF (LRET .EQ. 6 .AND. IWIN .EQ. 1) THEN
        XG = 0.0
        YG = 0.0
        ZG = 0.0
        IG = 9
        CALL GGIP (XG, YG, ZG, IG)
        IF (IG .EQ. 1) CC = .TRUE.
      END IF
      IPR(201) = 0
      IF (IPR(116) .EQ. 0) NLOOP = MOD(NLOOP + 1, 2)
      GO TO 40
  320 CALL PLA006 (0, IS)
      IF (IS .EQ. 1) THEN
        WRITE (LU6, 99995, IOSTAT = IOST)
        CALL PLA015 (0, 10)
        GO TO 320
      END IF
      IF (IFL(1)(1:3) .EQ. 'REM') THEN
        IGBL(6)  = 10
        IPR(351) = 0
        GO TO 330
      ELSE IF (IFL(1)(1:3) .EQ. 'END' .OR.
     1         IFL(1)(1:4) .EQ. 'EXIT') THEN
        IF (IFL(1)(1:3) .EQ. 'END') REWIND LU2
        IF (IGBL(3) .EQ. 3) THEN
          IGBL(45) = -1
        END IF
        GO TO 330
      ELSE IF (IS .EQ. 185) THEN
        IYUNK = NINT(FN(1))
        IF (IYUNK .GE. 0 .AND. IYUNK .LE. IPR(75)) THEN
          WRITE (ICL, 99994, IOSTAT = IOST) NINT(FN(1))
          CALL PLA280 (ICL)
        GOTO 330
        END IF
      END IF
      SELECT CASE (IFL(1)(1:4))
        CASE ('DIST', 'ANGL', 'TORS')
          IPR(81) = IPR(220)
          CALL PLA035 (1)
          GO TO 300
        CASE ('SET ')
          IF (IFL(2)(1:3) .EQ. 'REV') THEN
            IGBL(68) = MOD(IGBL(68) + 1, 2)
            CALL GGIP (-999.0, FLOAT(IGBL(68)), IGBL(62) * 0.25, 9)
            CALL GGIP (0.0, 0.0, 0.0, 6)
            IGGT = 'MENU ON'
            WRITE (LU6,*, IOSTAT = IOST)'ENTER RETURN'
            READ (LU5, *)
            GO TO 300
          ELSE
            ISW = 1
          END IF
        CASE ('LIST')
          ISW = -1
          SELECT CASE (IFL(2)(1:5))
            CASE ('ARU  ')
              ISW = 0
              CALL PLA043 (0, -2, LU6, 0)
              CALL PLA013 (1, 1)
              IGBL(6) = 9
              GO TO 20
            CASE ('UIJ  ')
              ISW = 0
              IGBL(6) = 9
            CASE ('ATOM ', 'ATOMS')
              ISW = 0
              IGBL(6) = 9
            CASE ('FLAG ')
              ISW = 0
              IGBL(6) = 9
            CASE ('RADII')
              ISW = 0
              IGBL(6) = 9
          END SELECT
        CASE ('CALC')
          ISW = 0
          IF (IFL(2)(1:4) .EQ. 'COOR') THEN
            IF (IFL(3)(1:6) .EQ. '******') GO TO 320
          END IF
        CASE DEFAULT
          ISW = 0
      END SELECT
      IF (ISW .NE. 0 .AND. IPR(220) .GT. 1) THEN
C * SET META TYPE
        IF (IFL(2)(1:3) .EQ. 'MET') THEN
          MEDIUM = 2
          IF (IPR(220) .GT. 2) CALL GGIP (-999.0, 0.0, 0.0, 6)
        ELSE
          CALL PLA206 (ISW, IFL(2)(1:3))
        END IF
        ISW = 0
        GO TO 300
      END IF
      IF (IFL(1)(1:6) .EQ. 'PLUTON') THEN
        CALL PLA280 (IFL(1)(1:7))
      ELSE
        CALL PLA280 (ICL)
      END IF
  330 CALL PLA034 (-1, NASUP)
  340 IF (IGBL(3) .EQ. 3) IGBL(3) = 0
      RETURN
99999 FORMAT (':: Label Positioning Problem for ', A)
99998 FORMAT ('ATOM  ', I5, 1X, A, 2X, I5, 4X, 3F8.3, 2F6.2)
99997 FORMAT ('ANISOU', I5, 1X, A, 2X, I5, 2X, 6I7)
99996 FORMAT ('HEADER ', A)
99995 FORMAT ('>> UNKNOWN INSTRUCTION - IGNORED', /)
99994 FORMAT ('PLOT ADP RESD ', I5)
      END SUBROUTINE PLA106
      SUBROUTINE PLA107 (IQ, IA, MODE, PCQ)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP15=20,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      DIMENSION BF(4), CONX(3, 3), QF(5), QUA(3, 4)
      ITY = 0
      NATOM = IPR(39)
      NSUP  = IPR(64)
      NASUP = NATOM + NSUP
      NIA   = NASUP + IA
      NIQ   = NASUP + IQ
      ID    = NINT(CON(NIQ, 9))
      NA1   = ID / (NP1 + 1)
      NA2   = MOD(ID, NP1 + 1)
      PCQ = 0.0
      IF (MODE .NE. 0) THEN
        ITY = ITY + MODE
        IF (ITY .GT. 0) THEN
          OVMG = 0.0
        ELSE
          OVMG = PAR(44)
        END IF
        IF (ITY .GT. -2) THEN
          V1(1)      = (XXO(NIA, 1) + XXO(NIA, 2)) * 0.5
          V1(2)      = (XXO(NIA, 3) + XXO(NIA, 4)) * 0.5
          V1(3)      = 1.0
          CONX(1, 1) = XSD(NIA, 1)
          CONX(1, 2) = XSD(NIA, 2)
          CONX(2, 1) = XSD(NIA, 2)
          CONX(2, 2) = XSD(NIA, 3)
          TX = XXO(NIA, 2) - XXO(NIA, 1) + XXO(NIA, 4) - XXO(NIA, 3)
          CONX(3, 3) = - (1.0 - 4.0 * OVMG / TX)**2
          DO K = 1, 2
            CONX(K, 3) = 0.0
            DO J = 1, 2
              CONX(K, 3) = CONX(K, 3) - V1(J) * CONX(J, K)
            END DO
            CONX(3, K) = CONX(K, 3)
            CONX(3, 3) = CONX(3, 3) - CONX(3, K) * V1(K)
          END DO
        END IF
        IF (ITY .LT. 2) THEN
          DO L = 1, 4
            K         = 2 * L
            K1        = MOD(K, 8) + 2
            QUA(1, L) = CON(NIQ, K)      - CON(NIQ, K1)
            QUA(2, L) = CON(NIQ, K1 - 1) - CON(NIQ, K - 1)
            QUA(3, L) = CON(NIQ, K - 1)  * CON(NIQ, K1) -
     1                  CON(NIQ, K)      * CON(NIQ, K1 - 1)
            T1 = SQRT(QUA(1, L)**2 + QUA(2, L)**2)
            IF (T1 .LE. 0.0) THEN
              ITY = 0
              GO TO 40
            END IF
            DO J = 1, 3
              QUA(J, L) = QUA(J, L) / T1
            END DO
          END DO
        END IF
        V2(3) = 1.0
        V3(3) = 1.0
        T2    = 3.0
        DO L = 1, 4
          L1    = (MOD(L, 4) + 1) * 2
          V2(1) = CON(NIQ, 2 * L - 1)
          V2(2) = CON(NIQ, 2 * L)
          V3(1) = CON(NIQ, L1 - 1)
          V3(2) = CON(NIQ, L1)
          QF(L) = 0.0
          BF(L) = 0.0
          DO K = 1, 3
            T1 = CONX(3, K)
            DO J = 1, 2
              T1 = T1 + V2(J) * CONX(J, K)
            END DO
            QF(L) = QF(L) + T1 * V2(K)
            BF(L) = BF(L) + T1 * V3(K)
          END DO
          IF (QF(L) .EQ. 0.0)  THEN
            T2 = T2 - 0.8
          ELSE IF (QF(L) .LT. 0.0) THEN
            T2 = T2 - 1.0
          END IF
        END DO
        QF(5) = QF(1)
        IF (T2 .LT. 0.0) THEN
          ITYPE = -1
        END IF
        IF (T2 .GE. 2.2)  THEN
          DO K = 1, 4
            T1 = BF(K)**2 - QF(K) * QF(K + 1)
            IF (T1 .GT. 0.0) THEN
              T1 = SQRT(T1)
              T3 = QF(K) - BF(K)
              T4 = T3 + QF(K + 1) - BF(K)
              IF (ABS(T4) .GT. PAR(54)) THEN
                T5 = (T3 - T1) / T4
                IF (T5 .GE. 0.0 .AND. T5 .LT. 1.0) THEN
                  ITYPE = 0
                  IF (NA2 .EQ. IA) THEN
                    GO TO 20
                  ELSE IF (NA2 .GT. IA) THEN
                    IF (NA1 .GE. IA) THEN
                      GO TO 20
                    ELSE
                      GO TO 10
                    END IF
                  ELSE
                    GO TO 10
                  END IF
                END IF
              END IF
            END IF
          END DO
          T3 = 3.0
          DO K = 1, 4
            T1 = QUA(3, K)
            DO J = 1, 2
              T1 = T1 + V1(J) * QUA(J, K)
            END DO
            IF (T1 .LT. 0.0) T3 = T3 - 1.0
          END DO
          IF (T3 .GE. 0.0) GO TO 40
          ITYPE = 1
          IF (IA .GE. NA2 .OR. IA .LE. NA1) GO TO 20
        ELSE
          ITYPE = 0
          IF (NA2 .EQ. IA .OR. (NA2 .GT. IA .AND. NA1 .GE. IA))
     1        GO TO 20
        END IF
   10   IF (ID .EQ. 0) GO TO 30
        DO III = 1, 3
          V2(III) = XXO(NA2, III) - XXO(NA1, III)
          V3(III) = XXO(IA,  III) - XXO(NA1, III)
        END DO
        CALL GEN007 (AA, V2, V2, 1)
        CALL GEN007 (AA, V3, V3, 1)
        CALL GEN011 (BB, V2, V3, V4, 1)
        IF (GEN009 (V4, V4) .LE. PAR(54)) THEN
          IF (ITY .GT. 0) THEN
            GO TO 30
          ELSE
            GO TO 40
          END IF
        END IF
        CALL GEN011 (BB, V4, V2, V5, 1)
        T1 = - V5(3)
        IF (T1 * FLOAT(ITY) .GT. 0.0) GO TO 40
   20   IF (ITYPE * ITY .LT. 0) THEN
          PCQ = -1.0
          GO TO 40
        END IF
   30   PCQ = 1.0
        IF (ITY .LT. 0) THEN
          IF (IPR(152) .LT. NP7) THEN
            IPR(152) = IPR(152) + 1
            DO K = 1, 4
              DO J = 1, 3
                XDIR(IPR(152), J, K) = QUA(J, K)
              END DO
            END DO
            IDIR(IPR(152)) = IQ
          END IF
        ELSE
          IF (IPR(151) .LT. NP15) THEN
            IPR(151) = IPR(151) + 1
            IJ = 1
            DO I = 1, 3
              DO J = I, 3
                XXO(IPR(174) + IPR(151), IJ) = CONX(I, J)
                IJ                           = IJ + 1
              END DO
            END DO
          END IF
        END IF
      ELSE
        ITY = 0
      END IF
   40 RETURN
      END SUBROUTINE PLA107
      SUBROUTINE PLA108 (IND1, IND2, IND3, NPEN)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /PL108/ SEG(2), Y(3), YN(2), YO(2), Z(3)
      NASUP = IPR(39) + IPR(64)
      NCOVR = IPR(151)
      NQOVR = IPR(152)
      NCQ   = NCOVR + NQOVR
      NCO   = IPR(174)
      ZGGIP = 0.0
      LPEN  = IABS(NPEN)
      DO INDX = IND1, IND3, IND2
        Y(1) = DP(1, INDX)
        Y(2) = DP(2, INDX)
        DO J = 1, 2
          Y(J) = MAX (0.0, MIN (Y(J), PAR(36 + J)))
        END DO
        IF (NCQ .EQ. 0) THEN
          CALL GGIP (Y(1), Y(2), ZGGIP, LPEN)
        ELSE
          IF (LPEN .EQ. 2) THEN
            YO(1) = YN(1)
            YO(2) = YN(2)
            DO K = 1, NCQ
              XSD(NCO + K, 1) = XSD(NCO + K, 2)
            END DO
            IF (NQOVR .GT. 0) THEN
              DO K = 1, NQOVR
                DO J = 1, 4
                  CON(NCO + K, J) = CON(NCO + K, J + 4)
                END DO
              END DO
            END IF
          END IF
          YN(1) = Y(1)
          YN(2) = Y(2)
          IF (NCOVR .GT. 0) THEN
            KBG  = NCO + 1
            KEND = NCO + NCOVR
            DO K = KBG, KEND
              Z(1) = YN(1) * XXO(K, 1) + YN(2) * XXO(K, 2) + XXO(K, 3)
              Z(2) = YN(1) * XXO(K, 2) + YN(2) * XXO(K, 4) + XXO(K, 5)
              Z(3) = YN(1) * XXO(K, 3) + YN(2) * XXO(K, 5) + XXO(K, 6)
              XSD(K, 2) = Z(1) * YN(1) + Z(2) * YN(2) + Z(3)
              IF (LPEN .EQ. 2) THEN
                XSD(K, 5) = Z(1) * YO(1) + Z(2) * YO(2) + Z(3)
              END IF
            END DO
          END IF
          IF (NQOVR .GT. 0) THEN
            KCQ = NCO + NCOVR
            DO K = 1, NQOVR
              T2 = 3.0
              DO J = 1, 4
                T1 = YN(1) * XDIR(K, 1, J) + YN(2) * XDIR(K, 2, J)
     1             + XDIR(K, 3, J)
                IF (T1 .LT. 0) T2 = T2 - 1.0
                CON(NCO + K, J + 4) = T1
              END DO
              KCQ = KCQ + 1
              XSD(KCQ, 2) = T2
            END DO
          END IF
          IF (LPEN .EQ. 3) GO TO 110
          DO K = 1, NCQ
            IF (XSD(NCO + K, 1) .LT. 0.0 .AND.
     1          XSD(NCO + K, 2) .LT. 0.0) GO TO 110
          END DO
          MINT = 0
          IF (NCOVR .GT. 0) THEN
            DO K = 1, NCOVR
              NCOK = NCO + K
              T1 = XSD(NCOK, 5)**2 - XSD(NCOK, 1) * XSD(NCOK, 2)
              IF (T1 .GT. 0.0) THEN
                T1 = SQRT(T1)
                T2 = XSD(NCOK, 1) - XSD(NCOK, 5)
                T3 = T2 + XSD(NCOK, 2) - XSD(NCOK, 5)
                IF (ABS(T3) .GT. PAR(54)) THEN
                  T4 = (T2 - T1) / T3
                  T5 = (T2 + T1) / T3
                  IF (T4 .LT. 1.0 .AND. T5 .GT. 0.0) THEN
                    MINT               = MINT + 1
                    XSD(NCO + MINT, 3) = T4
                    XSD(NCO + MINT, 4) = T5
                  END IF
                END IF
              END IF
            END DO
          END IF
          IF (NQOVR .GT. 0) THEN
            DO 20 K = 1, NQOVR
              I12 = 0
              KCQ = NCO + NCOVR + K
              SEG(1) = XSD(KCQ, 1)
              IF (SEG(1) .GE. 0.0) THEN
                SEG(1) = 1.0 - XSD(KCQ, 2)
                IF (SEG(1) .LE. 1.0) GO TO 10
              END IF
              I12 = 1
   10         DO J = 1, 4
                T1 = CON(NCO + K, J)
                T2 = CON(NCO + K, J + 4)
                T3 = T1 - T2
                IF (T1 * T2 .LE. 0.0) THEN
                  IF (ABS(T3) .LE. PAR(54)) GO TO 20
                  T4 = (T1 * YN(1) - T2 * YO(1)) / T3
                  T5 = (T1 * YN(2) - T2 * YO(2)) / T3
                  J1 = 2 * (MOD(J, 4) + 1)
                  NIQ = NASUP + IDIR(K)
                  T6 = (T4 - CON(NIQ, 2 * J - 1)) *
     1               (CON(NIQ, J1 - 1) - T4) +
     2               (T5 - CON(NIQ, 2 * J)) * (CON(NIQ, J1) - T5)
                  IF (T6 .GT. -1.E-4) THEN
                    T1 = T1 / T3
                    IF (I12 .LT. 1) THEN
                      I12 = 1
                      SEG(1) = T1
                    ELSE IF (I12 .EQ. 1) THEN
                      I12 = 2
                      IF (T1 .GE. SEG(1)) THEN
                        SEG(2) = T1
                      ELSE
                        SEG(2) = SEG(1)
                        SEG(1) = T1
                      END IF
                    ELSE
                      IF (T1 .LT. SEG(1)) THEN
                        SEG(1) = T1
                      ELSE IF (T1 .GT. SEG(1)) THEN
                        IF (T1 .GT. SEG(2)) SEG(2) = T1
                      END IF
                    END IF
                  END IF
                END IF
              END DO
              IF (I12 .GT. 1) THEN
                MINT               = MINT + 1
                XSD(NCO + MINT, 3) = SEG(1)
                XSD(NCO + MINT, 4) = SEG(2)
              END IF
   20       CONTINUE
          END IF
          IF (MINT .EQ. 0) THEN
            CALL GGIP (YN(1), YN(2), ZGGIP, 2)
            GO TO 120
          ELSE
            M  = MINT
   30       M  = M / 2
            IF (M .EQ. 0) GO TO 70
            K  = MINT - M
            J  = 1
   40       I  = J
   50       IM = I + M
            IF (XSD(NCO + I, 3) .LT. 0.0) THEN
              IF (XSD(NCO + IM, 3) .GT. 0.0) GO TO 60
              IF (XSD(NCO + I, 4) .LE. XSD(NCO + IM, 4)) GO TO 60
            ELSE
              IF (XSD(NCO + I, 3) .LE. XSD(NCO + IM, 3)) GO TO 60
            END IF
            CALL GEN018 (XSD(NCO + I, 3), XSD(NCO + IM, 3))
            CALL GEN018 (XSD(NCO + I, 4), XSD(NCO + IM, 4))
            I = I - M
            IF (I .GT. 0) GO TO 50
   60       J = J + 1
            IF (J .GT. K) THEN
              GO TO 30
            ELSE
              GO TO 40
            END IF
          END IF
   70     P0 = 0.0
          K  = 0
   80     K  = K + 1
          IF (K .GT. MINT) THEN
            P1 = 1.0
            GO TO 100
          END IF
          P1 = XSD(NCO + K, 3)
          IF (P1 .GE. 0.0 .AND. P1 .GT. P0)  GO TO 100
   90     P0 = MAX (P0, XSD(NCO + K, 4))
          IF (P0 .LT. 1.0) GO TO 80
          P0 = 1.0
  100     IF (P0 .GT. 0.0) THEN
            Z(1) = YO(1) * (1.0 - P0) + YN(1) * P0
            Z(2) = YO(2) * (1.0 - P0) + YN(2) * P0
            CALL GGIP (Z(1), Z(2), ZGGIP, 3)
            IF (P0 .GE. 1.0) GO TO 120
          END IF
          Z(1) = YO(1) * (1.0 - P1) + YN(1) * P1
          Z(2) = YO(2) * (1.0 - P1) + YN(2) * P1
          CALL GGIP (Z(1), Z(2), ZGGIP, 2)
          IF (P1 .LT. 1.0) GO TO 90
          GO TO 120
  110     CALL GGIP (YN(1), YN(2), ZGGIP, 3)
        END IF
  120   IF (NPEN .GT. 0) THEN
          LPEN = 2
        ELSE
          IF (LPEN .EQ. 3) THEN
            LPEN = 2
          ELSE
            LPEN = 3
          END IF
        END IF
      END DO
      RETURN
      END SUBROUTINE PLA108
      SUBROUTINE PLA109 (MODE, NTYP, X, Y, LMOD)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP52=200,NP56=30,
     2 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /TPOS/ XTK(250, 3), NTK(25), KMX, IMIN
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      I    = 0
      IASU = 0
      XMAX = 0.0
      YMAX = 0.0
      IF (NTYP .EQ. 0) THEN
        XMAX = PAR(37)
        YMAX = PAR(38)
      ELSE IF (NTYP .EQ. 1) THEN
        XMAX = - PAR(61)
        YMAX = - PAR(62)
      END IF
   10 IF (MODE .EQ. 1) THEN
        IF (IWIN .EQ. 1) THEN
          I = IPR(447) + 1
          WRITE (SBCD, 99999) PAR(350), CHAR(0)
          CALL GEN038 (IGGT, 1, 80)
          CALL PLA013 (0, 0)
          TKST(I) = IGGT(1:10)
          LINE    = IGGT
          CALL GEN038 (ICL,  1, 80)
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          CALL GEN125 (0, LU6, 'Give Text:')
          READ  (LU5, '(A)') LINE
        END IF
        IF (LINE(1:1) .EQ. '!'    .OR. LINE(1:4) .EQ. 'TEXT' .OR.
     1      LINE(1:4) .EQ. 'PLOT' .OR. LINE(1:3) .EQ. 'END'  .OR.
     2      LINE(1:3) .EQ. 'REM'  .OR. LINE(1:4) .EQ. 'EXIT') THEN
          IPR(453)  = 0
          IPR(448)  = 0
          LINE      = '!'
          IF (NTYP .EQ. 1) THEN
            IGBL(6) = 3
          ELSE
            IGBL(6) = 8
          END IF
          GO TO 60
        END IF
        IF (I .EQ. 1) THEN
          KMX = 0
        END IF
        IF (KMX .GT. 0) THEN
          DO J = 1, KMX
            IF (NTK(J) .EQ. 0) THEN
              K = J
              GO TO 30
            END IF
          END DO
        END IF
        KMX       = KMX + 1
        K         = KMX
   30   XTK(I, 1) = XMAX - 5.0
        XTK(I, 2) = YMAX - K
        NTK(K)    = 1
        XTK(I, 3) = PAR(350)
        IPR(447)  = I
        CALL GGIP09 (0.0, TKST(I), 10, XTK(I, 3), -1, 1,
     1               XTK(I, 1), XTK(I, 2))
        GO TO 10
      ELSE IF (MODE .EQ. 2) THEN
        IF (IPR(173) * IPR(447) .GT. 0) THEN
          DO I = 1, IPR(447)
            CALL GGIP09 (0.0, TKST(I), 10, XTK(I, 3), 1, 1, XTK(I, 1),
     1                    XTK(I, 2))
          END DO
        END IF
      ELSE IF (MODE .EQ. 3) THEN
        IASU = 0
        CALL PLA014 (3, NTYP, X, Y, ITEM, IASU)
        IF (ITEM .NE. 0) THEN
          CALL GGIP09 (0.0, TKST(ITEM), 10, XTK(ITEM, 3), 0, 1,
     1                  XTK(ITEM, 1), XTK(ITEM, 2))
          CALL GGIP (0.0, 1.0, 0.0, 0)
          IF (IPR(447) .GT. 1) THEN
            DO I = 1, 3
              XTK(ITEM, I) = XTK(IPR(447), I)
            END DO
            TKST(ITEM) = TKST(IPR(447))
          END IF
          IPR(447) = IPR(447) - 1
        END IF
      ELSE IF (MODE .EQ. 4) THEN
        CALL PLA014 (3, NTYP, X, Y, ITEM, IASU)
        IF (ITEM .NE. 0) THEN
          CALL GGIP09 (0.0, TKST(ITEM), 10, XTK(ITEM, 3), 0, 1,
     1                 XTK(ITEM, 1), XTK(ITEM, 2))
          XTK(ITEM, 3) = PAR(350)
          CALL GGIP09 (0.0, TKST(ITEM), 10, XTK(ITEM, 3), 1, 1,
     1                   XTK(ITEM, 1), XTK(ITEM, 2))
        END IF
      ELSE IF (MODE .EQ. 5) THEN
        IF (IPR(448) .NE. 0) THEN
          IF (IPR(447) .GT. 0) THEN
            IF (LMOD .EQ. 0) THEN
              CALL PLA014 (3, NTYP, X, Y, IMIN, IASU)
              XX = XTK(IMIN, 1)
              YY = XTK(IMIN, 2)
              LMOD = 1
              XN = - XTK(IMIN, 2) + YMAX
              N  =  NINT(-XTK(IMIN, 2) + YMAX)
              IF (ABS(XN - N) .LT. 0.05) THEN
                NTK(N) = 0
              END IF
            ELSE
              XX = - (NTYP * XMAX) + X
              YY =   YMAX - Y
              XTK(IMIN, 1) =  XX
              XTK(IMIN, 2) =  YY
              LMOD = 0
            END IF
            YGGIP = FLOAT(1 - LMOD)
            CALL GGIP09 (0.0, TKST(IMIN), 10, XTK(IMIN, 3),
     1                        NINT(YGGIP), 1, XX, YY)
          END IF
        END IF
      END IF
   60 RETURN
99999 FORMAT ('Give Text[size =', F5.2, ']', A)
      END SUBROUTINE PLA109
      SUBROUTINE PLA110 (HORS, VERT, MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /LITREF/ LREF
      CHARACTER LREF(25)*80
      IF (IGBL(103) .NE. 0) THEN
        CALL GGIP (0.0,  0.0,  0.0, 3)
        CALL GGIP (HORS, 0.0,  0.0, 2)
        CALL GGIP (HORS, VERT, 0.0, 2)
        CALL GGIP (0.0,  VERT, 0.0, 2)
        CALL GGIP (0.0,  0.0,  0.0, 2)
        P14 = 0.4
        IF (MODE .GE. 0) THEN
          IF (IPR(116) .EQ. 0 .AND. IABS(IGBL(6)) .NE. 25) THEN
            IF (IGBL(30) .EQ. 1) THEN
              IF (IGBL(136) .EQ. 1) THEN
                CALL GGIP09 (0.0, 'NOMOVE AND NO EXPAND FORCED', 27,
     1            P14, 3, 1, HORS - 45 * P14, VERT - 0.15 - P14)
              ELSE
                CALL GGIP09 (0.0, 'NOMOVE FORCED', 13, P14, 3, 1,
     1                     HORS - 31 * P14, VERT - 0.15 - P14)
              END IF
            ELSE
              IF (IGBL(60) .GT. 0) THEN
                CALL GGIP09 (0.0, 'INPUT ATOMS MOVED', 17, P14, 2, 1,
     1                       HORS - 35 * P14, VERT - 0.15 - P14)
              END IF
            END IF
          END IF
          IF (MODE .EQ. 1 .AND. IGBL(104) .EQ. 1 .AND.
     1                          IPR(116) .EQ. 0) THEN
            VRT = VERT - 1.0
            DO I = 1, 2 + IPR(565)
              VRT = VRT - 0.4
              CALL GGIP09 (0.0, LREF(I), 79, 0.25, 5, 1, 1.0, VRT)
            END DO
          END IF
          IROTX = NINT(RGBL(28))
          IROTY = NINT(RGBL(29))
          IROTZ = NINT(RGBL(30))
          IDET  = IGBL(87)
          IF (IDET .EQ. -1 .AND. IPR(116) .EQ. 0)
     1        CALL GGIP09 (0.0, 'INVERT', 6, P14, 3, 1,
     2        HORS - 16 * P14, VERT - 0.15 - P14)
          CALL GEN040 (IROTX, NQ1, IP)
          NQ1(IP + 1:IP + 2) = ' X'
          IP                 = IP + 2
          CALL GGIP09 (0.0, NQ1, IP, P14, -1, 1, HORS - IP * P14, 0.15)
          CALL GEN040 (IROTY, NQ2, IP)
          NQ2(IP + 1:IP + 2) = ' Y'
          IP                 = IP + 2
          CALL GGIP09 (90.0, NQ2, IP, P14, -1, 1, P14 + 0.15, VERT
     1                  - IP * P14)
          NQ3(1:1) = 'Z'
          CALL GGIP09 (0.0, NQ3, 1, P14, -1, 1, 0.15, 0.15)
          CALL GEN040 (IROTZ, NQ3, IP)
          CALL GGIP09 (0.0, NQ3, IP, P14, -1, 1, 0.15 + 2 * P14, 0.15)
          IF (MODE .EQ. 1) THEN
            CALL GGIP09 (0.0, 'Prob = ', 6, P14, -1, 1, HORS - 9 * P14,
     1                  VERT - 0.15 - P14)
            IPRB = IPR(45) * 10
            CALL GEN040 (IPRB, NQ1, IP)
            CALL GGIP09 (0.0, NQ1, IP, P14, -1, 1, HORS - 2 * P14,
     1                   VERT - 0.15 - P14)
            IF (IABS(IGBL(8)) .EQ. 3 .AND. IPR(310) .GT. 0) THEN
              CALL GGIP09 (0.0, 'Temp = ', 6, P14, -1, 1,
     1          HORS - 9 * P14, VERT - 0.25 - 2 * P14)
              CALL GEN040 (IPR(310), NQ1, IP)
              CALL GGIP09 (0.0, NQ1, IP, P14, -1, 1, HORS - 3 * P14,
     1                   VERT - 0.25 - 2 * P14)
            END IF
          END IF
          IF (IABS(IGBL(6)) .NE. 25) THEN
            NQ1 = 'RES=   '
            CALL GGIP09 (0.0, NQ1, 4, P14, -1, 1, HORS - 14 * P14,
     1                   0.15)
            CALL GEN040 (IPR(140), NQ1, IP)
            CALL GGIP09 (0.0, NQ1, 2, P14, -1, 1, HORS - 8 * P14,
     1                   0.15)
          END IF
        END IF
        NJID = MAX (74, NINT(HORS / 0.4) - 12)
        CALL GGIP09 (0.0,  JID, NJID, 0.4, -1, 1, 3.0, 0.15)
        CALL GEN040 (IGBL(4), NQ2, IP)
        IF (MODE .LT. 0) THEN
          VR = 0.5
        ELSE
          VR = 1.5
        END IF
        CALL GGIP09 (90.0, PROGNM//' - ('//NQ2(1:IP)//')',
     1               IP + 33, 0.4, -1, 1, 0.6,  VR)
      END IF
      RETURN
      END SUBROUTINE PLA110
      SUBROUTINE PLA111 (MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP45=2048,
     2 NP52=200,NP56=30,NP57=35,NP60=100,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5),ICALT, NSEL
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER IFL*7, ICL*(NP45)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PL132/ TRMX(3, 3), STHKM, ISKIP, ITSKP, IOBS, ICALC,
     1 NDEC, SHXMP
      INTEGER HMAX
C * ANALYSIS OF VARIANCE + ANALYSIS FOR TWINNING + BIJVOET PAIR ANALYSIS
C * MODE = -2 : Bijvoet Pair Analysis          - PLA120 (Validation Mode)
C *      = -1 : Bijvoet Pair Analysis          - PLA120 (Standard   Mode))
C *      =  0 : Analysis-of-Variance           - PLA112
C *      =  1 : TwinRotMat                     - PLA114
C *      =  2 : TwinRotMat (Non-Graphics Mode) - PLA114
      IF (IGBL(9) .EQ. 14) THEN
        IGGT = ' '
        WRITE (LU6, 99991, IOSTAT = IOST)
        RETURN
      ENDIF
      IF (PAR(497) .LT. 0.0) THEN
        IGGT = ' '
        WRITE (LU6, 99990, IOSTAT = IOST)
        RETURN
      END IF
      IWIN = IGBL(25) * IGBL(32)
      IH   = 0
      IK   = 0
      IL   = 0
C * PREPARE FOR THE CALCULATION OF FCALC (IGBL(9) = 0 => HKLF 4)
      IF (IGBL(9) .EQ. 0 .AND. MODE .LT. 0) THEN
        IPR(408) = 0
        IPR(392) = 0
        IPR(220) = 1
        CALL PLA145 (0)
        LU16 = LU17
        REWIND LU16
      ELSE
        CALL PLA080
        CALL PLA042 (2)
        CALL PLA293 (PAR(17))
      END IF
      IF (MODE .LT. 2) THEN
C * MODE = -1 : BIJVOET PAIR ANALYSIS CASE
        IF (MODE .EQ. -1) THEN
          IF (IPR(220) .GT. 1 .AND. IFL(2)(1:3) .EQ. 'FCF') IPR(594) = 0
          IPR(193) = 0
          IPR(513) = 0
          NFEXP = IPR(560)
          IF (NFEXP .LE. 0) THEN
            IF (PAR(168) .LT. 0.0) THEN
              WRITE (LU6, 99995, IOSTAT = IOST)
              THETAMAX = 0.0
              IEND     = -1
              DO WHILE (IEND .NE. 1)
                CALL PLA136 (IHO, IKO, ILO, FOK, SIG, SIGIW, CALI, FCK,
     1                       ACALS, BCALS, ACOR, IEND)
                IF (IEND .NE. 1 .AND.
     1            (IHO .NE. 0 .OR. IKO .NE. 0 .OR. ILO .NE. 0)) THEN
                  IF (GEN050 (TRMX, IHO, IKO, ILO, IH, IK, IL) .EQ. -1)
     1              CYCLE
                  STL = SQRT(GEN095 (PAR(191), IH, IK, IL))
                  ST  = STL * PAR(17)
                  IF (ST .LT. 1.0) THEN
                    THETAMAX = MAX (THETAMAX, ASIN (ST) * RGBL(6))
                  END IF
                END IF
              END DO
              PAR(168) = THETAMAX
              WRITE (LU6, 99994, IOSTAT = IOST) THETAMAX
            END IF
            IF (PAR(168) .GT. 0.0) THEN
              CALL PLA145 (1)
              IPR(408) = 0
            END IF
          END IF
          IF (IGBL(3) .NE. 1) THEN
            CALL PLA287 (1, 1, 0)
          END IF
          PAGET = 'BIJVOET'
          CALL PLA262 (0)
          IPR(2) = -1
C * MODE = 1 : TWINROTMAT CASE
        ELSE IF (MODE .EQ. 1) THEN
          IF (IGBL(9) .LT. 1 .OR. IGBL(9) .GT. 12) THEN
            WRITE (LU6, 99993, IOSTAT = IOST)
            IGGT = ' '
            RETURN
          END IF
          IF (IGBL(3) .EQ. 30) THEN
            IPR(594) = 0
          ELSE
            IF (ABS(IGBL(8)) .NE. 3) THEN
              WRITE (LU6, 99993, IOSTAT = IOST)
              IGGT = ' '
              RETURN
            END IF
            IPR(594) = 1
            CALL PLA287 (1, 1, 0)
          END IF
          PAGET    = 'TWINROTM'
          IGBL(6) = 25
          CALL PLA262 (0)
          WRITE (LU7, 99998, IOSTAT = IOST)
C * MODE = 0 : ANALYSIS OF VARIANCE CASE
        ELSE IF (MODE .EQ. 0) THEN
          PAGET    = 'ANALVAR'
          IPR(594) = 0
          IF (IGBL(9) .LE. 0) CALL PLA287 (1, 1, 0)
          CALL PLA262 (0)
          IPR(2) = -1
        END IF
        IF (PAR(497) .GE. 0.0)
     1    WRITE (LU6, 99997, IOSTAT = IOST) PAR(497), PAR(498)
        WRITE (LU7, 99996, IOSTAT = IOST) RLWS(1)
      END IF
      IPR(132) = -1
      IEND     = -1
      NADR     = 0
      FOKM     = 0.0
      IND1     = 1
      IND2     = 2
      IND3     = 3
      NSYM     = IPR(48)
      NSYMH    = IPR(255)
      ICNTR    = IPR(257)
      HMAX     = -999
      KMAX     = -999
      LMAX     = -999
      SUMFOK   = 0.0
      SUMFCK   = 0.0
      SIGK     = 0.0
      ACAL     = 0.0
      BCAL     = 0.0
      ACALA    = 0.0
      BCALA    = 0.0
      ACALAF   = 0.0
      BCALAF   = 0.0
      IF (IPR(259) .EQ. 5 .OR. IPR(259) .EQ. 6) THEN
        IHEXL = 1
      ELSE
        IHEXL = 0
      END IF
      DO WHILE (IEND .NE. 1)
        CALL PLA136 (IHO, IKO, ILO, FOK, SIGI, SIGIW, CALI, FCKP, ACALS,
     1               BCALS, ACOR, IEND)
        IF (IEND .NE. 1 .AND.
     1    (IHO .NE. 0 .OR. IKO .NE. 0 .OR. ILO .NE. 0)) THEN
          IF (GEN050 (TRMX, IHO, IKO, ILO, IH, IK, IL) .LT. 0.0) CYCLE
          IF (IGBL(9) .LE. 0 .OR. IPR(594) .NE. 0) THEN
            CALL PLA135 (IH, IK, IL, ACAL, BCAL, ACALA, BCALA,
     1        ACALAF, BCALAF, YUNK)
            FCK = (ACAL + ACALA) ** 2 + (BCAL + BCALA) ** 2
          END IF
          STL = SQRT(GEN095 (PAR(191), IH, IK, IL))
          ST  = STL * PAR(17)
          IF (ST .LT. 1.0) THEN
            TH = ASIN (ST) * RGBL(6)
            VOID(NADR + 1)  = IH
            VOID(NADR + 2)  = IK
            VOID(NADR + 3)  = IL
            VOID(NADR + 4)  = FOK
            VOID(NADR + 5)  = FCK
            VOID(NADR + 6)  = MAX (SIGI, 0.0)
            VOID(NADR + 7)  = TH
            VOID(NADR + 8)  = 0.0
            VOID(NADR + 9)  = 0.0
            VOID(NADR + 10) = 0.0
            VOID(NADR + 11) = MAX (0.0, FCKP)
            VOID(NADR + 12) = SIGIW
            SUMFOK          = SUMFOK + FOK
            SUMFCK          = SUMFCK + FCK
            NADR            = NADR   + NREC
            HMAX = MAX (HMAX, IABS(IH))
            KMAX = MAX (KMAX, IABS(IK))
            IF (IHEXL .EQ. 1) THEN
              HMAX = MAX (KMAX, HMAX, IABS(IH + IK))
              KMAX = HMAX
            END IF
            LMAX = MAX (LMAX, IABS(IL))
          END IF
        END IF
      END DO
      IF (NADR .GT. 0) THEN
        NREF = NADR / NREC
        IF (IGBL(9) .LE. 0) THEN
          SCALE = SUMFCK / SUMFOK
        ELSE
          SCALE = 1.0
        END IF
        NADR = 0
        DO I = 1, NREF
          FOK  = VOID (NADR + 4) * SCALE
          FOKM = MAX (FOKM, FOK)
          FCK  = VOID (NADR + 5)
          SIG  = VOID (NADR + 6) * SCALE
          SIGK = VOID (NADR + 12)**2
          FCKP = VOID (NADR + 11)
          IF (SIG .GT. 0.0) THEN
            VOID(NADR + 8) = MAX ((FOK - FCKP) / SIG, 0.0)
            VOID(NADR + 9) = (FOK - FCKP) / SQRT(SIGK)
          END IF
          VOID (NADR + 4) = FOK
          VOID (NADR + 6) = SIG
          NADR            = NADR + NREC
        END DO
        IF (IPR(259) .EQ. 4) THEN
          HMAX = MAX (HMAX, KMAX)
          KMAX = HMAX
        ELSE IF (IPR(259) .EQ. 7) THEN
          HMAX = MAX (HMAX, KMAX, LMAX)
          KMAX = HMAX
          LMAX = HMAX
        END IF
        SCL = 10 ** (INT(ALOG (10000000 / FOKM) / ALOG (10.0)))
C * INCLUDE ANALYSIS OF VARIANCE
        CALL PLA112 (MODE)
        IF (MODE .NE. 0) THEN
C * ANALYSE FOR TWINNING (+ BIJVOET PAIRS)
          IF (MODE .GT. 0) THEN
            IF (MODE .EQ. 1) THEN
              IPR(608) = 1
              CALL PLA114 (1)
            ELSE
              IPR(608) = 1
              CALL PLA114 (2)
              IF (IGBL(9) .GT. 0 .AND. IGBL(9) .LT. 13) THEN
                IPR(608) = 0
                CALL PLA114 (2)
              END IF
              IPR(594) = 1
              CALL PLA120 (-2)
            END IF
C * ANALYSIS OF BIJVOET-PAIRS
          ELSE IF (MODE .EQ. -1) THEN
            IF (IGBL(9) .GT. 0 .AND. IGBL(9) .LT. 13) THEN
              CALL PLA120 (-1)
            ELSE
              WRITE (LU6, 99992, IOSTAT = IOST)
            END IF
          END IF
        END IF
      ELSE
        WRITE (LU6, 99999, IOSTAT = IOST)
      END IF
      IGGT = ' '
      RETURN
99999 FORMAT (/, ':: No Reflections found')
99998 FORMAT (/, 'TwinRotMat: Analysis of the Fo/Fc CIF for Unaccounted'
     1        ,' (Non)Merohedral Twinning', /, 79('='), /)
99997 FORMAT (':: W1, W2 =', 2F10.4)
99996 FORMAT (/, A, /)
99995 FORMAT (/, ':: Determine Theta(max) Dataset')
99994 FORMAT (/, ':: Theta(max) =', F6.2)
99993 FORMAT (/, ':: Sorry: CIF & FCF (LIST 4) style data required ',
     1        'for running TwinRotMat', /)
99992 FORMAT (/,
     1   ':: Bijvoet/Hooft Analysis with SHELXL/FCF(hklf4) Only !', /)
99991 FORMAT (/, ':: Sorry, No Analysis for JANA(F) data.', /)
99990 FORMAT (/, ':: Sorry, No Analysis when Weight Parameter A ',
     1        'Negative', /)
      END SUBROUTINE PLA111
      SUBROUTINE PLA112  (MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP45=2048,
     2 NP52=200,NP56=30,NP57=35,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5),ICALT, NSEL
      COMMON /CGRAPH/ GRAPH(44)
      CHARACTER GRAPH*125
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER IFL*7, ICL*(NP45)
      DIMENSION STAT(20, 12), VSTATA(11, 5), VSTATB(11, 5),
     1 VSTATC(11, 5), NSTATH(14, 3), NSTATK(14, 3), NSTATL(14, 3)
      INTEGER HMAX
C * ANALYSIS OF VARIANCE
      NFCAL  = 11
      IHEAD  = 0
      NOBS   = 0
      NTOT   = 0
      NADRM  = NREF * NREC
      STOT   = 0.0
      STON   = 0.0
      R1TELL = 0.0
      R1NOEM = 0.0
      R2TELL = 0.0
      R2NOEM = 0.0
      R2TELN = 0.0
      R2NOEN = 0.0
      IF (IGBL(22) .LT. 0) THEN
        JB = 3
        JE = 3
      ELSE
        JB = 1
        JE = 2
      END IF
      FACTOR = 10 / (0.65**3 + 0.0001)
      DO I = 1, 20
        DO J = 1, 12
          STAT(I, J) = 0.0
        END DO
      END DO
      DO I = 1, 11
        DO J = 1, 5
          VSTATA (I, J) = 0.0
          VSTATB (I, J) = 0.0
          VSTATC (I, J) = 0.0
        END DO
      END DO
      DO I = 1, 14
        DO J = 1, 3
          NSTATH(I, J) = 0
          NSTATK(I, J) = 0
          NSTATL(I, J) = 0
        END DO
      END DO
      NADR = 0
      DO I = 1, NREF
        VOID(NADRM + I) = SQRT (VOID(NADR + NFCAL))
        NADR = NADR + NREC
      END DO
      CALL GEN034 (VOID, NADRM + 1, NADRM + NREF)
      FCMAX         = VOID (NADRM + 1)
      VSTATA(1,  1) = 0.0
      VSTATA(11, 1) = 1.0
      DO I = 1, 9
        N = NINT(FLOAT(I * NREF) / 10.0) + NADRM
        VSTATA(11 - I, 1) = VOID(N) / FCMAX
      END DO
      NADR = 0
      DO I = 1, NREF
        IH    = NINT(VOID(NADR + 1))
        IK    = NINT(VOID(NADR + 2))
        IL    = NINT(VOID(NADR + 3))
        STL   = SQRT(GEN095 (PAR(191), IH, IK, IL))
        VOID(NADRM + I) = 0.5 / STL
        NADR = NADR + NREC
      END DO
      CALL GEN034 (VOID, NADRM + 1, NADRM + NREF)
      VSTATB(1,  1) = VOID (NADRM + NREF)
      VSTATB(11, 1) = VOID (NADRM + 1)
      VSTATC(1,  1) = VOID (NADRM + NREF)
      VSTATC(11, 1) = VOID (NADRM + 1)
      DO I = 1, 9
        N = NINT(FLOAT(I * NREF) / 10.0) + NADRM
        VSTATB(11 - I, 1) = VOID(N)
        VSTATC(11 - I, 1) = VOID(N)
      END DO
      NADR = 0
      DO I = 1, NREF
        JH    = ABS(NINT(VOID(NADR + 1)))
        JK    = ABS(NINT(VOID(NADR + 2)))
        JL    = ABS(NINT(VOID(NADR + 3)))
        FOK   = VOID (NADR + 4)
        FCK   = VOID (NADR + NFCAL)
        SIG   = VOID (NADR + 6)
        IF (JH .LT. 14) THEN
          NSTATH(JH + 1, 1) = NSTATH(JH + 1, 1) + 1
          IF (FOK .GT. 3.0 * SIG) THEN
            NSTATH(JH + 1, 2) = NSTATH(JH + 1, 2) + 1
          END IF
          IF (FCK .GT. 3.0 * SIG) THEN
            NSTATH(JH + 1, 3) = NSTATH(JH + 1, 3) + 1
          END IF
        END IF
        IF (JK .LT. 14) THEN
          NSTATK(JK + 1, 1) = NSTATK(JK + 1, 1) + 1
          IF (FOK .GT. 3.0 * SIG) THEN
            NSTATK(JK + 1, 2) = NSTATK(JK + 1, 2) + 1
          END IF
          IF (FCK .GT. 3.0 * SIG) THEN
            NSTATK(JK + 1, 3) = NSTATK(JK + 1, 3) + 1
          END IF
        END IF
        IF (JL .LT. 14) THEN
          NSTATL(JL + 1, 1) = NSTATL(JL + 1, 1) + 1
          IF (FOK .GT. 3.0 * SIG) THEN
            NSTATL(JL + 1, 2) = NSTATL(JL + 1, 2) + 1
          END IF
          IF (FCK .GT. 3.0 * SIG) THEN
            NSTATL(JL + 1, 3) = NSTATL(JL + 1, 3) + 1
          END IF
        END IF
        SIGN  = SIG**2
        SIGK  = VOID (NADR + 12)**2
        STL   = SIN((VOID (NADR + 7) / RGBL(6))) / PAR(17)
        N          = MIN (20,  1 + INT(STL**3 * FACTOR))
        STAT(N, 1) = STAT(N, 1) + ABS(FOK)
        STAT(N, 2) = STAT(N, 2) + ABS(FCK)
        STAT(N, 3) = STAT(N, 3) + 1.0
        IF (FOK .GT. 2 * SIG) THEN
          STAT(N, 10) = STAT(N, 10) + 1.0
          STAT(N, 4)  = STAT(N, 4) + SQRT(ABS(FOK))
          STAT(N, 5)  = STAT(N, 5)
     1                + ABS(SQRT(ABS(FOK)) - SQRT(ABS(FCK)))
        END IF
        IF (SIGK .NE. 0.0) THEN
          STAT(N,  6) = STAT(N,  6) + (FOK - FCK) ** 2 / SIGK
          STAT(N,  7) = STAT(N,  7) + FOK ** 2 / SIGK
        END IF
        IF (SIGN .NE. 0.0) THEN
          STAT(N, 11) = STAT(N, 11) + (FOK - FCK) ** 2 / SIGN
          STAT(N, 12) = STAT(N, 12) + FOK ** 2 / SIGN
        END IF
        NADR        = NADR + NREC
        FCOFCM      = SQRT(FCK) / FCMAX
        DO J = 2, 11
          IF (FCOFCM .LE. VSTATA(J, 1)) THEN
            VSTATA(J, 2) = VSTATA(J, 2) + 1.0
            IF (SIGK .NE. 0.0) THEN
              VSTATA(J, 3) = VSTATA(J, 3) + (FOK - FCK)**2 / SIGK
            END IF
            VSTATA(J, 4) = VSTATA(J, 4) + FOK
            VSTATA(J, 5) = VSTATA(J, 5) + FCK
            IF (J .LE. 3) THEN
              RESOL = 0.5 / STL
              DO K = 2, 11
                IF (RESOL .LE. VSTATC(K, 1)) THEN
                  VSTATC(K, 2) = VSTATC(K, 2) + 1.0
                  IF (SIGK .NE. 0.0) THEN
                    VSTATC(K, 3) = VSTATC(K, 3) + (FOK - FCK)**2 / SIGK
                  END IF
                  VSTATC(K, 4) = VSTATC(K, 4) + FOK
                  VSTATC(K, 5) = VSTATC(K, 5) + FCK
                  EXIT
                END IF
              END DO
            END IF
            EXIT
          END IF
        END DO
        RESOL = 0.5 / STL
        DO J = 2, 11
          IF (RESOL .LE. VSTATB(J, 1)) THEN
            VSTATB(J, 2) = VSTATB(J, 2) + 1.0
            IF (SIGK .NE. 0.0) THEN
              VSTATB(J, 3) = VSTATB(J, 3) + (FOK - FCK)**2 / SIGK
            END IF
            VSTATB(J, 4) = VSTATB(J, 4) + FOK
            VSTATB(J, 5) = VSTATB(J, 5) + FCK
            EXIT
          END IF
        END DO
      END DO
      DO I = 2, 11
        YUNK = VSTATA(I, 2) - IPR(266) / 10.0
        IF (YUNK .GT. 0.0) THEN
          VSTATA(I, 3) = SQRT(VSTATA(I, 3) / YUNK)
        ELSE
          VSTATA(I, 3) = 0.0
        END IF
        IF (VSTATA(I, 2) .GT. 0.0) THEN
          VSTATA(I, 4) = VSTATA(I, 4) / VSTATA(I, 5)
        ELSE
          VSTATA(I, 4) = 0.0
        END IF
        IF (VSTATA(I, 4) .GT. 2.0) THEN
          CALL PLA231 (906, 3, 0.5, VSTATA(I, 4), ' ', ' ')
        ELSE IF (VSTATA(I, 4) .LT. 0.0) THEN
          CALL PLA231 (905, 3, 0.5, VSTATA(I, 4), ' ', ' ')
        END IF
        YUNK = VSTATB(I, 2) - IPR(266) / 10.0
        IF (YUNK .GT. 0.0) THEN
          VSTATB(I, 3) = SQRT(VSTATB(I, 3) / YUNK)
        ELSE
          VSTATB(I, 3) = 0.0
        END IF
        IF (VSTATB(I, 2) .GT. 0.0) THEN
          VSTATB(I, 4) = VSTATB(I, 4) / VSTATB(I, 5)
        ELSE
          VSTATB(I, 4) = 0.0
        END IF
        IF (VSTATB(I, 4) .GT. 2.0) THEN
          CALL PLA231 (906, 3, 0.5, VSTATB(I, 4), ' ', ' ')
        ELSE IF (VSTATB(I, 4) .LT. 0.0) THEN
          CALL PLA231 (905, 3, 0.5, VSTATB(I, 4), ' ', ' ')
        END IF
        YUNK = VSTATC(I, 2) - IPR(266) / 100.0
        IF (YUNK .GT. 0.0) THEN
          VSTATC(I, 3) = SQRT(VSTATC(I, 3) / YUNK)
        ELSE
          VSTATC(I, 3) = 0.0
        END IF
        IF (VSTATC(I, 2) .GT. 0.0) THEN
          VSTATC(I, 4) = VSTATC(I, 4) / VSTATC(I, 5)
        ELSE
          VSTATC(I, 4) = 0.0
        END IF
      END DO
      DO I = 1, 14
        IF (NSTATH(I, 1) .NE. 0) THEN
          NSTATH(I, 2) = NINT (100.0 * NSTATH(I, 2) / NSTATH(I, 1))
          NSTATH(I, 3) = NINT (100.0 * NSTATH(I, 3) / NSTATH(I, 1))
        END IF
        IF (NSTATK(I, 1) .GT. 0) THEN
          NSTATK(I, 2) = NINT (100.0 * NSTATK(I, 2) / NSTATK(I, 1))
          NSTATK(I, 3) = NINT (100.0 * NSTATK(I, 3) / NSTATK(I, 1))
        END IF
        IF (NSTATL(I, 1) .GT. 0) THEN
          NSTATL(I, 2) = NINT (100.0 * NSTATL(I, 2) / NSTATL(I, 1))
          NSTATL(I, 3) = NINT (100.0 * NSTATL(I, 3) / NSTATL(I, 1))
        END IF
      END DO
      DO J = JB, JE
        IF (J .EQ. 1) THEN
          LU = LU6
        ELSE IF (J .EQ. 2) THEN
          LU = LU7
        ELSE
          LU = LU13
        END IF
        WRITE (LU, 99993, IOSTAT = IOST) HMAX, KMAX, LMAX
        IF (J .EQ. 2) CALL PLA262 (2)
        CALL PLA113 (LU, HMAX, KMAX, LMAX, VSTATA, VSTATB, VSTATC,
     1               NSTATH, NSTATK, NSTATL)
      END DO
      IF (IGBL(22) .GE. 0 .OR. IABS(IGBL(36)) .EQ. 1) THEN
        DO I = 1, 20
          IF (STAT(I, 3) .NE. 0.0 .AND. STAT(I, 7) .NE. 0.0 .AND.
     1        STAT(I, 4) .NE. 0.0) THEN
            R1TELL = R1TELL + STAT(I,  5)
            R1NOEM = R1NOEM + STAT(I,  4)
            R2TELL = R2TELL + STAT(I,  6)
            R2NOEM = R2NOEM + STAT(I,  7)
            R2TELN = R2TELN + STAT(I, 11)
            R2NOEN = R2NOEN + STAT(I, 12)
            R1   = STAT(I, 5) / STAT(I, 4)
            R2   = SQRT(STAT(I, 6) / STAT(I, 7))
            S    = SQRT(STAT(I, 6) /
     1             (STAT(I, 3) - IPR(266) * STAT(I, 3) / NREF))
            STOT = STOT + STAT(I, 6)
            STON = STON + STAT(I, 11)
            NTOT = NTOT + NINT (STAT(I, 3))
            NOBS = NOBS + NINT (STAT(I, 10))
            IF (IHEAD .EQ. 0) THEN
              WRITE (LU6, 99998, IOSTAT = IOST)
              WRITE (LU7, 99998, IOSTAT = IOST)
              IHEAD = 1
            END IF
            SINTHL   = (I / FACTOR) ** 0.333333
            NOBSFRAC = INT (STAT(I, 10) * 39.0 / STAT(I, 3)) + 1
            DO J = 1, 40
              IF (J .GT. NOBSFRAC) THEN
                IDM(40 + J: 40 + J) = '.'
              ELSE
                IDM(40 + J: 40 + J) = '*'
              END IF
            END DO
            WRITE (IDM(1:40), 99994, IOSTAT = IOST) SINTHL,
     1        0.5 / SINTHL,
     2        NINT(STAT(I, 3)), NINT(STAT(I, 10)), R1, R2, S
            WRITE (LU6, 99999, IOSTAT = IOST) IDM
            WRITE (LU7, 99999, IOSTAT = IOST) IDM
          END IF
        END DO
        WRITE (LU6, 99992, IOSTAT = IOST)
        WRITE (LU7, 99992, IOSTAT = IOST)
        STOT = SQRT(STOT / (NTOT - MAX (0, IPR(266))))
        STON = SQRT(STON / (NTOT - MAX (0, IPR(266))))
        R1   = R1TELL / R1NOEM
        R2   = SQRT (R2TELL / R2NOEM)
        R2X  = SQRT (R2TELN / R2NOEN)
        IF (STOT .LT. 99.999) THEN
          WRITE (LU6, 99997, IOSTAT = IOST)
     1      R1, R2, STOT, NTOT, NOBS, MAX (0, IPR(266))
          WRITE (LU7, 99997, IOSTAT = IOST)
     1      R1, R2, STOT, NTOT, NOBS, MAX (0, IPR(266))
        ELSE
          WRITE (LU6, 99990, IOSTAT = IOST)
     1      R1, R2, MIN (999.99, STOT), NTOT, NOBS, MAX (0, IPR(266))
          WRITE (LU7, 99990, IOSTAT = IOST)
     1      R1, R2, MIN (999.99, STOT), NTOT, NOBS, MAX (0, IPR(266))
        END IF
        IF (STON .LT. 99.999) THEN
          WRITE (LU6, 99991, IOSTAT = IOST) R2X, STON
        ELSE
          WRITE (LU6, 99989, IOSTAT = IOST) R2X, MIN (999.99, STON)
        ENDIF
C * NORMAL PROBABILITY PLOT
        IF (IABS(IGBL(36)) .EQ. 1) THEN
          LUX = LU
          WRITE (LU, 99995)
        ELSE
          LUX = LU7
          CALL PLA262 (0)
        END IF
        DO I = 1, NREF
          VOID(NADR + I) = VOID((I - 1) * NREC + 9)
        END DO
        CALL GEN116 (2, VOID(NADR + 1), VOID(NADR + NREF + 1), NREF,
     1     GRAPH, 0)
        GRAPH(5)(52:96) =
     1    'NPP for (Fobs**2 - Fcalc**2) / Sigma(Fobs**2)'
        IF (PAR(497) .GE. 0.0)
     1    WRITE (GRAPH(7)(52:100), 99996, IOSTAT = IOST)
     2    PAR(497), PAR(498)
        WRITE (LUX, 99999) (GRAPH(I), I = 1, 44)
        NOPT = -1
        NPLT = 0
   10   IF (MODE .EQ. 0) THEN
          IF (NOPT .EQ. 0) THEN
            CALL PLA204
          ELSE IF (NOPT .EQ. 1) THEN
            SCALE = 1.0
            CALL PLA119 (0, SCALE, IGBL(9), 0, LU6)
          ELSE IF (NOPT .EQ. 2) THEN
            CALL PLA124 (NOPT, NREF)
          ELSE IF (NOPT .EQ. 3) THEN
            CALL PLA124 (NOPT, NREF)
          ELSE IF (NOPT .EQ. 4) THEN
            CALL PLA124 (NOPT, NREF)
          ELSE IF (NOPT .EQ. 5) THEN
            CALL PLA124 (NOPT, NREF)
          ELSE IF (NOPT .EQ. -1) THEN
            CALL PLA113 (0, HMAX, KMAX, LMAX, VSTATA, VSTATB, VSTATC,
     1                 NSTATH, NSTATK, NSTATL)
          END IF
          DO
            CALL PLA013 (0, 1)
            CALL GEN020 (1, IGGT, 1, 10)
            IF (LRET .EQ. 2) THEN
              IF (NPLT .EQ. 1) THEN
                IGGT(1:4) = 'NPP '
              ELSE IF (NPLT .EQ. 2) THEN
                IGGT(1:4) = 'LINE'
              ELSE IF (NPLT .EQ. 3) THEN
                IGGT(1:4) = 'LOGL'
              END IF
              LRET = 0
            END IF
            CALL GEN072 (IGGT, IFL, FN, IPR(220), IPR(221), 0, LU6,
     1        1, 1, 80, 7, NP17)
            SELECT CASE (IFL(1)(1:4))
              CASE ('END ')
                RETURN
              CASE ('EXIT')
                RETURN
              CASE ('PLOT')
                GO TO 10
              CASE ('!   ')
                GO TO 10
              CASE ('NPP ')
                NPLT = 1
                NOPT = 0
                GOTO 10
              CASE ('SCAT')
                IPR(633) = 0
                NPLT = 2
                NOPT = 1
                GOTO 10
              CASE ('LOGL')
                IPR(633) = 1
                NPLT     = 3
                NOPT     = 1
                GOTO 10
              CASE ('LINE')
                IPR(633) = 0
                NPLT     = 2
                NOPT     = 1
                GOTO 10
              CASE ('IOSL')
                NOPT = 2
                GO TO 10
              CASE ('IOSW')
                NOPT = 3
                GO TO 10
              CASE ('SIGL')
                NOPT = 4
                GO TO 10
              CASE ('LSLI')
                NOPT = 5
                GO TO 10
              CASE ('STAN')
                GO TO 10
              CASE ('SET')
                IF (IFL(2)(1:3) .EQ. 'PAR') THEN
                  IF (IPR(221) .GT. 0) PAR(485) = FN(1)
                END IF
                GO TO 10
              CASE ('VARI')
                NOPT = -1
                GO TO 10
            END SELECT
          END DO
        END IF
      END IF
      RETURN
99999 FORMAT (A)
99998 FORMAT (/, 'ST/L    d     #  Nobs    R1   wR2     S',
     1        ' 0  Percent Distr. for I .gt. 2*s(I)  100', /, 80('='))
99997 FORMAT (/, ':: R1 =', F6.3, ', wR2 =', F6.3, ', S =', F6.3,
     1        ', Nref =', I7, ', Nobs =', I7, ', Npar =', I5)
99996 FORMAT ('Sigma Includes SHELXL WGHT Par.', 2F9.4)
99995 FORMAT (//)
99994 FORMAT (F4.2, F5.2, 2I6, 3F6.3, 1X, A)
99993 FORMAT (/, ':: Hmax =', I5, ', Kmax =', I5, ', Lmax =', I5)
99992 FORMAT (39X, 'I', 19X, 'I', 19X, 'I', /,
     1        19X, 'Percent Observed:   0',18X, '50', 17X, '100')
99991 FORMAT ('::',13X, 'wR2 =', F6.3, ', S =', F6.3,
     1        ' (Non Optimized Weights)')
99990 FORMAT (/, ':: R1 =', F6.3, ', wR2 =', F6.3, ', S =', F6.2,
     1        ', Nref =', I7, ', Nobs =', I7, ', Npar =', I5)
99989 FORMAT ('::',13X, 'wR2 =', F6.3, ', S =', F6.2,
     1        ' (Non Optimized Weights)')
      END SUBROUTINE PLA112
      SUBROUTINE PLA113 (LU, HMAX, KMAX, LMAX, VSTATA, VSTATB, VSTATC,
     1                   NSTATH, NSTATK, NSTATL)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DIMENSION VSTATA(11, 5), VSTATB(11, 5), VSTATC(11, 5),
     1 NSTATH(14, 3), NSTATK(14, 3), NSTATL(14, 3)
      INTEGER HM, HMAX
      CHARACTER LINE*80
C * ANALYSIS OF VARIANCE LISTINGS
      IF (LU .EQ. 0) THEN
        CALL GGIP (HORS, VERT, 0.0, 1)
        LINE = 'Analysis of Variance'
        CALL GGIP09 (0.0, LINE, 20, 0.45, 5 + IGBL(68), 2, 9.0,
     1  VERT - 0.9)
        VRT = VERT - 1.0
      END IF
      IF (PAR(497) .GE. 0.0) THEN
        WRITE (LINE, 99999, IOSTAT = IOST)
        IF (IOST .EQ. -999) RETURN
        CALL PLA296 (LU, LINE)
        WRITE (LINE, 99998, IOSTAT = IOST) PAR(497), PAR(498)
        CALL PLA296 (LU, LINE)
      END IF
      WRITE (LINE, 99999, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99991, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99999, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99997, IOSTAT = IOST) (VSTATA(I, 1), I = 1, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99996, IOSTAT = IOST) (NINT(VSTATA(I, 2)), I = 2, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99995, IOSTAT = IOST) (VSTATA(I, 3), I = 2, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99994, IOSTAT = IOST)
     1  MAX (-99.999, MIN (VSTATA(2, 4), 99.999)),
     2  (MAX(-9.999, MIN(9.999, VSTATA(I, 4))), I = 3, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99999, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99993, IOSTAT = IOST) (VSTATB(I, 1), I = 1, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99996, IOSTAT = IOST) (NINT(VSTATB(I, 2)), I = 2, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99995, IOSTAT = IOST) (VSTATB(I, 3), I = 2, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99994, IOSTAT = IOST)
     1  MAX (-99.999, MIN (VSTATB(2, 4), 99.999)),
     2  (MAX(-9.999, MIN(9.999, VSTATB(I, 4))), I = 3, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99999, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99992, IOSTAT = IOST) VSTATA(3, 1)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99993, IOSTAT = IOST) (VSTATC(I, 1), I = 1, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99996, IOSTAT = IOST) (NINT(VSTATC(I, 2)), I = 2, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99995, IOSTAT = IOST) (VSTATC(I, 3), I = 2, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99994, IOSTAT = IOST)
     1  MAX (-99.999, MIN (VSTATC(2, 4), 99.999)),
     2  (MAX(-9.999, MIN(9.999, VSTATC(I, 4))), I = 3, 11)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99999, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      HM = MIN(HMAX + 1, 14)
      WRITE (LINE, 99990, IOSTAT = IOST) 'H', (I - 1, I = 1, HM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99989, IOSTAT = IOST) (NSTATH(I, 1), I = 1, HM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99988, IOSTAT = IOST) (NSTATH(I, 2), I = 1, HM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99987, IOSTAT = IOST) (NSTATH(I, 3), I = 1, HM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99999, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      KM = MIN(KMAX + 1, 14)
      WRITE (LINE, 99990, IOSTAT = IOST) 'K', (I - 1, I = 1, KM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99989, IOSTAT = IOST) (NSTATK(I, 1), I = 1, KM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99988, IOSTAT = IOST) (NSTATK(I, 2), I = 1, KM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99987, IOSTAT = IOST) (NSTATK(I, 3), I = 1, KM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99999, IOSTAT = IOST)
      CALL PLA296 (LU, LINE)
      LM = MIN(LMAX + 1, 14)
      WRITE (LINE, 99990, IOSTAT = IOST) 'L', (I - 1, I = 1, LM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99989, IOSTAT = IOST) (NSTATL(I, 1), I = 1, LM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99988, IOSTAT = IOST) (NSTATL(I, 2), I = 1, LM)
      CALL PLA296 (LU, LINE)
      WRITE (LINE, 99987, IOSTAT = IOST) (NSTATL(I, 3), I = 1, LM)
      CALL PLA296 (LU, LINE)
      IF (LU .EQ. 0) THEN
        CALL GGIP (0.0, 0.0, 0.0, -1)
      END IF
      RETURN
99999 FORMAT (1X)
99998 FORMAT (':: Sigma Includes SHELXL WGHT Par.', 2F9.4)
99997 FORMAT ('Fc/Fc(max)', 4X, 11F6.3)
99996 FORMAT ('Number in Group ', 10I6)
99995 FORMAT ('           GooF ', 10F6.3)
99994 FORMAT ('              K', F7.3, 9F6.3)
99993 FORMAT ('Resolution(A)', 1X, 11F6.2)
99992 FORMAT ('Resolution Dependence for Fc/Fc(max) .LT.', F7.3)
99991 FORMAT (':: K = Mean[Fo^2]/Mean[Fc^2] for Group - ',
     1        '(Fo^2, Fc^2 from FCF)')
99990 FORMAT ('Abs(', A, ')', 4X, 14I5)
99989 FORMAT ('Number    ', 14I5)
99988 FORMAT ('PerObs Fo2', 14I5)
99987 FORMAT ('PerObs Fc2', 14I5)
      END SUBROUTINE PLA113
      SUBROUTINE PLA114 (MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP45=2048,
     2 NP52=200,NP56=30,NP57=35,NP60=100,NREC=12,NSMAX=500)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /LEPAG/ AXES(15, 23), TM(3, 3), CL(3, 5), TP(3, 3),
     1 TG(3, 3), TPQ(3, 3), TPS(3, 3), G(3, 3), OR(3, 3), ROTQ(3, 3),
     2 TRMXT (3, 3), T(3), H(3), TC(6), CELL(7), OCELL(7), RCELL(7),
     3 IDET, NVEC
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      COMMON // JNSC(2, NP23), VOID(NVD)
      DIMENSION IHKL(3), ORT(3, 3), V(3), TAU(3), VTAU(3), YUNK(3, 3),
     1 XX(12), SDAT(NSMAX), ISDAT(NSMAX)
      INTEGER HMAX
C * TWINROTMAT - ANALYSE REFLECTION DATA FOR TWINNING BY REFLECTION OVERLAP
C * MODE = 1 - GRAPHICS MODE
C * MODE = 2 - NON-GRAPHICS MODE
C * IPR(608) = 0 - FCF FCALC DATA SOURCE
C * IPR(608) = 1 - CIF FCALC DATA SOURCE
C * INDEX TO REFLECTION RECORD (SIZE NREC)
C * VOID(NADR +  1) = H
C * VOID(NADR +  2) = K
C * VOID(NADR +  3) = L
C * VOID(NADR +  4) = FOK
C * VOID(NADR +  5) = FCK (FROM CIF PARAMETERS)
C * VOID(NADR +  6) = SIG
C * VOID(NADR +  7) = THETA
C * VOID(NADR +  8) = (FOK - FCK) / SIG
C * VOID(NADR +  9) =
C * VOID(NADR + 10) =
C * VOID(NADR + 11) = FCK (FROM FCF DATA)
C * VOID(NADR + 12) = SIGIW
      NX = NP23 / 2
      CALL GEN074 (XX, 1, 12, 0.0)
      CALL GEN044 (PAR(101), OR, 1)
      CALL GEN005 (OR, ORT)
      CALL GEN003 (ORT, ROTQ, DET, 0)
   10 IF (IGBL(3) .EQ. 30) IPR(608) = 0
      ICALT = 11 - IPR(608) * 6
      IEXT  = 0
      IASM  = 0
      NSEL  = 0
      NVCX  = 0
      NADR  = NREF * NREC
      NSYMR = NSYMH * ICNTR
      IBRV  = IPR(241)
      IF (IBRV .EQ. 7) THEN
        IBLP = 2
      ELSE
        IBLP = 1
      END IF
      IF (IPR(259) .EQ. 2) THEN
        IPR(394) = 2
      ELSE
        IPR(394) = 3
      END IF
      LINV = 3 - ICNTR
      MPH   = 2 * HMAX + 1
      MPK   = 2 * KMAX + 1
      MPL   = 2 * LMAX + 1
      MHK   = MPH * MPK
      MHKL  = MPL * MHK
      MHKLH = (MHKL - 1) / 2
      IADR  = NVD - MHKLH
      IADR1 = NVD - MHKL
      DO I = 1, MHKL
        IH   = I - 1
        IL   = IH / MHK
        IH   = IH - IL * MHK
        IL   = IL - LMAX
        IK   = IH / MPH
        IH   = IH - IK * MPH - HMAX
        IK   = IK - KMAX
        IEXT = 0
        IF (IBRV .GT. 1) THEN
          IF (GEN049 (LAT(IBRV), IH, IK, IL) .LT. 0.0) IEXT = 1
        END IF
        IF (IEXT .EQ. 0) CALL PLA138 (1, IH, IK, IL, IEXT, IASM)
        VOID(IADR1 + I) = - FLOAT (IEXT)
      END DO
      DO K = 1, LINV
        IMM = - NREC
        DO I = 1, NREF
          IMM = IMM + NREC
          DO J = 1, 3
            XX(J) = VOID(IMM + J)
          END DO
          DO NS = 1, NSYMR
            CALL SGSM (LINE, NS, XX, LU7, 5, IER)
            IHKLP = NINT(XX(9)) * MHK + NINT(XX(8)) * MPH + NINT(XX(7))
            IF (K .EQ. 1) THEN
              IF (VOID(IADR + IHKLP) .EQ. 0.0) VOID (IADR + IHKLP) = I
            ELSE
              IF (VOID(IADR - IHKLP) .EQ. 0.0) VOID (IADR - IHKLP) = I
            END IF
          END DO
        END DO
      END DO
   20 ISHOW = 0
      RATIO = 32.0
      NSEL  = 0
      DO WHILE (NSEL .LT. IPR(550) .AND. RATIO .GE. PAR(413))
        NSEL = 0
        J = - NREC
        DO I = 1, NREF
          J = J + NREC
          IF (VOID(J + 7) .GT. 0.0) THEN
            SIGI = VOID(J + 6)
            IF (SIGI .GT. 0.0) THEN
              FOKI   = VOID(J + 4)
              FCKI   = VOID(J + ICALT)
              DELSIG = (FOKI - FCKI) / SIGI
              IF (DELSIG .GT. RATIO) THEN
                IF (NSEL .LT. NSMAX) THEN
                  NSEL        = NSEL + 1
                  SDAT(NSEL)  = 100000.0 - DELSIG
                  ISDAT(NSEL) = I
                END IF
              END IF
            END IF
          END IF
        END DO
        RATIO = RATIO / 2.0
      END DO
      IF (NSEL .GE. 25) THEN
        CALL GEN013 (SDAT, ISDAT, 1, NSEL)
        NSEL = MIN (NSEL, IPR(550))
        IF (MODE .EQ. 1) THEN
          IF (IWIN .EQ. 1) THEN
            CALL GGIP (HORS, VERT, 0.0, 1)
            CALL GGIP09 (0.0, 'WorkinG', 7, 3.0, 2, 10, 5.0, 8.0)
            CALL GGIP (0.0, 0.0, 0.0, 6)
          END IF
          WRITE (LU6, 99998, IOSTAT = IOST)
          CALL PLA262 (0)
          IF (IPR(469) .NE. 0) THEN
            WRITE (LU7, 99994, IOSTAT = IOST)
            CALL PLA262 (2)
          END IF
          WRITE (LU7, 99999, IOSTAT = IOST)
          CALL PLA262 (3)
        END IF
        NVC = 0
        DO I = 1, NSEL
          IMM  = (ISDAT(I) - 1) * NREC
          THI  = VOID(IMM + 7)
          IHI  = NINT(VOID(IMM + 1))
          IKI  = NINT(VOID(IMM + 2))
          ILI  = NINT(VOID(IMM + 3))
          FOKI = VOID(IMM + 4)
          FCKI = VOID(IMM + ICALT)
          SIGI = VOID(IMM + 6)
          DELI = FOKI - FCKI
          DELS = DELI / SIGI
          IF (MODE .EQ. 1) THEN
            WRITE (LU6, 99996, IOSTAT = IOST)
     1        IHI, IKI, ILI, FOKI, FCKI, SIGI, DELS, THI
            IF (IPR(469) .NE. 0) THEN
              CALL PLA262 (3)
              WRITE (LU7, 99997, IOSTAT = IOST)
            ELSE
              CALL PLA262 (1)
            END IF
            WRITE (LU7, 99996, IOSTAT = IOST)
     1        IHI, IKI, ILI, FOKI, FCKI, SIGI, DELS, THI
            IF (IPR(469) .NE. 0) WRITE (LU7, 99995, IOSTAT = IOST)
          END IF
          JMM = - NREC
          DO J = 1, NREF
            JMM = JMM + NREC
            THJ = VOID(JMM + 7)
            IF (THJ .GT. 0.0) THEN
              DTH = THI - THJ
              IF (ABS(DTH) .LT. PAR(414)) THEN
                DO K = 1, 3
                  XX(K) = VOID(JMM + K)
                END DO
                XX(4) = 0.0
                FOKJ  = VOID(JMM + 4)
                FCKJ  = VOID(JMM + ICALT)
                SIGJ  = VOID(JMM + 6)
                IF (SIGJ .GT. 0.0) THEN
                  DELSJ = (FOKJ - FCKJ) / SIGJ
                  DO NS = 1, NSYMR
                    CALL SGSM (LINE, NS, XX, LU7, 5, IER)
                    DO 40 ILP = 1, IBLP
                      IF (ILP .EQ. 1) THEN
                        IHJ = NINT(XX(7))
                        IKJ = NINT(XX(8))
                        ILJ = NINT(XX(9))
                      ELSE
                        IHJ = - NINT(XX(8))
                        IKJ =   NINT(XX(7)) + NINT(XX(8))
                        ILJ =   NINT(XX(9))
                        IF (MOD(-IHJ + IKJ + ILJ, 3) .EQ. 0) GO TO 40
                      END IF
                      DO LIV = 1, LINV
                        IF (LIV .EQ. 2) THEN
                          IHJ = - IHJ
                          IKJ = - IKJ
                          ILJ = - ILJ
                        END IF
                        IHKL(1) = IHI + IHJ
                        IHKL(2) = IKI + IKJ
                        IHKL(3) = ILI + ILJ
                        IF (IHKL(1) .LT. 0) THEN
                          IHKL(1) = - IHKL(1)
                          IHKL(2) = - IHKL(2)
                          IHKL(3) = - IHKL(3)
                        ELSE IF (IHKL(1) .EQ. 0) THEN
                          IF (IHKL(2) .LT. 0) THEN
                            IHKL(2) = - IHKL(2)
                            IHKL(3) = - IHKL(3)
                          ELSE IF (IHKL(2) .EQ. 0) THEN
                            IHKL(3) = IABS(IHKL(3))
                          END IF
                        END IF
                        CALL GEN107 (IHKL, 3, IYUNK)
                        IHKLP = IHKL(1)
     1                        + 200 * (IHKL(2) + 200 * IHKL(3))
                        IF (IHKLP .NE. 0) THEN
                          IF (NVC .GT. 0) THEN
                            DO N = 1, NVC
                              ISN = 1
                              DO K = 1, LINV
                                IF (IHKLP .EQ. ISN * JNSC(2, NX + N))
     1                            GO TO 30
                                ISN = -1
                              END DO
                            END DO
                          END IF
                          IF (NVC .LT. NX - 1) THEN
                            NVC               = NVC + 1
                            N                 = NVC
                            JNSC(1, NVC)      = 10000
                            JNSC(2, NVC)      = NVC
                            JNSC(1, NX + NVC) = 0
                            JNSC(2, NX + NVC) = IHKLP
                          END IF
   30                     JNSC(1, N) = JNSC(1, N) - 1
                          DELJ = FCKJ - FCKI
                          IF (DELJ .NE. 0.0) THEN
                            ALFA = MIN (DELI / DELJ, 1.0)
                          ELSE
                            ALFA = 1.0
                          END IF
                          IF (ALFA .GE. PAR(416)) THEN
                            IF (IPR(469) .NE. 0) THEN
                              CALL PLA262 (1)
                              WRITE (LU7, 99996, IOSTAT = IOST)
     1                          IHJ, IKJ, ILJ, FOKJ, FCKJ, SIGJ, DELSJ,
     2                          THJ, DTH, ALFA, IHKL(1), IHKL(2),
     3                          IHKL(3)
                            END IF
                            JNSC(1, NX + N) = JNSC(1, NX + N)
     1                                      + NINT (ALFA * 100.0)
                          END IF
                        END IF
                      END DO
   40               CONTINUE
                  END DO
                END IF
              END IF
            END IF
          END DO
        END DO
        NVCX  = 0
        IF (NVC .GT. 0) THEN
          IPR(543) = 0
          CALL GEN037 (JNSC, 1, NVC)
          NMIN  = NSEL / 4
          NTWIN = 0
          CALL GEN097 (NTW, 1, 5, 0)
          NVCM = MIN (IPR(607), NVC)
          DO I = 1, NVCM
            NFRQ(5) = 10000 - JNSC(1, I)
            IF (NFRQ(5) .GT. NMIN) THEN
              XHKL = JNSC(2, JNSC(2, I) + NX)
              CALL GEN046 (XHKL, H(1), H(2), H(3))
              IHKLSUM = 0
              DO J = 1, 3
                IHKLR(J, 5) = NINT(H(J))
                IHKLSUM     = IHKLSUM + NINT(H(J))
              END DO
              CALL GEN002 (2, ROTQ, H, TAU, XLNG)
              COSA = 0.0
              N1 = IPR(567)
              N2 = 2 * N1 + 1
              DO K = 1, N2
                V(1) = K - N1 - 1
                DO L = 1, N2
                  V(2) = L - N1 - 1
                  DO M = 1, N2
                    V(3) = M - N1 - 1
                    IF (ABS(V(1)) + ABS(V(2)) + ABS(V(3)) .GT. 0.5) THEN
                      CALL GEN002 (2, OR, V, T, XLNG)
                      IF (XLNG .NE. 0) THEN
                        SPRD = GEN009 (T, TAU)
                        IF (SPRD .GT. COSA) THEN
                          COSA = SPRD
                          DO J = 1, 3
                            IHKL(J) = NINT(V(J))
                            VTAU(J) = T(J)
                          END DO
                        END IF
                      END IF
                    END IF
                  END DO
                END DO
              END DO
              ALPHA(5) = ACOS(MIN(1.0, COSA)) * RGBL(6)
              CALL GEN107 (IHKL, 3, IYUNK)
              DO K = 1, 3
                IHKLD(K, 5) = IHKL(K)
              END DO
              IF (ALPHA(5) .GT. PAR(473)) THEN
                IIMAX = 2
              ELSE
                IIMAX = 1
              END IF
              DO 60 II = 1, IIMAX
                IF (II .EQ. 2) CALL GEN113 (VTAU, TAU, 3)
                IF (ABS(TAU(1)) + ABS(TAU(2)) .LT. 0.0001) THEN
                  OME = 0.0
                  CHI = 90.0 / RGBL(6)
                ELSE
                  OME = ATAN2 (TAU(2), TAU(1))
                  CHI = ATAN2 (TAU(3), SQRT(TAU(1)**2 + TAU(2)**2))
                END IF
                CALL GEN043 (3, TP, OME)
                CALL GEN043 (2, TG, - CHI)
                CALL GEN004 (TG, TP, TM)
                PHI = 180.0 / RGBL(6)
                CALL GEN043 (1, G, PHI)
                CALL GEN004 (G, TM, TPS)
                CALL GEN005 (TM, YUNK)
                CALL GEN052 (YUNK, TM)
                CALL GEN004 (TM, TPS, TPQ)
                CALL GEN004 (TPQ, ROTQ, TPS)
                CALL GEN004 (ORT, TPS, TWM(1, 1, 5))
                IF (NSYMH .GT. 1) THEN
                  DO J = 1, 3
                    DO K = 1, 3
                      TM(J, K) = TWM(J, K, 5)
                    END DO
                  END DO
                  DO J = 2, NSYMR
                    NS = J
                    CALL SGSM (LINE, NS, XX, LU6, 6, IER)
                    DO K = 1, 9
                      N = INT ((K - 1) / 3) + 1
                      M = MOD (K - 1 , 3) + 1
                      TPS(M, N) = XX(K)
                    END DO
                    CALL GEN004 (TPS, TM, TPQ)
                    IS = 1
                    DO LL = 1, LINV
                      IF (LL .EQ. 2) IS = -1
                      DO 50 K = 1, NVCX + 1
                        DO N = 1, 3
                          DO M = 1, 3
                            IF (K .LE. NVCX) THEN
                              IF (ABS(TWM(N, M, K) - IS * TPQ(N, M))
     1                          .GT. 0.05) GO TO 50
                            ELSE
                              IF (ABS(TWM(N, M, K) - IS * TPS(N, M))
     1                          .GT. 0.05) GO TO 50
                            END IF
                          END DO
                        END DO
                        GO TO 60
   50                 CONTINUE
                    END DO
                  END DO
                END IF
                IF (MODE .EQ. 1) THEN
                  CALL PLA262 (1)
                  WRITE (LU7, 99997, IOSTAT = IOST)
                END IF
                CALL PLA115 (5)
                IF (DRVAL(5) .LT. -0.003) THEN
                  NEQL = 0
                  IF (NVCX .GT. 0) THEN
                    DO N = 1, NVCX
                      NEQL = 0
                      DO M = 1, 3
                        IF (IHKLR(M, N) .EQ. IHKLR(M, 5))
     1                    NEQL = NEQL + 1
                        IF (IHKLD(M, N) .EQ. IHKLD(M, 5))
     1                    NEQL = NEQL + 1
                      END DO
                      IF (NEQL .EQ. 6) THEN
                        IF (DRVAL(5) .LT. DRVAL(N)) THEN
                          KSMAL = N
                          RDROP = DRVAL(N)
                          EXIT
                        ELSE
                          GO TO 60
                        END IF
                      END IF
                    END DO
                  END IF
                  IF (NEQL .LT. 6) THEN
                    IF (NVCX .LT. 4) THEN
                      NVCX  = NVCX + 1
                      KSMAL = NVCX
                      RDROP = 999.0
                    ELSE
                      RDROP = -999.0
                      KSMAL = 0
                      DO K = 1, 4
                        IF (DRVAL(K) .GT. RDROP) THEN
                          RDROP = DRVAL(K)
                          KSMAL = K
                        END IF
                      END DO
                    END IF
                  END IF
                  IF (DRVAL(5) .LE. RDROP) THEN
                    IF (II .EQ. 1) THEN
                      NFRQ(KSMAL)  = NFRQ(5)
                    ELSE
                      NFRQ(KSMAL)  = - NFRQ(5)
                    END IF
                    NTW(KSMAL)   = NTW(5)
                    DRVAL(KSMAL) = DRVAL(5)
                    BASFM(KSMAL) = BASFM(5)
                    ALPHA(KSMAL) = ALPHA(5)
                    MTWIN(KSMAL * 2 - 1) = MTWIN(9)
                    MTWIN(KSMAL * 2)     = KSMAL
                    DO K = 1, 3
                      IHKLR(K, KSMAL) = IHKLR(K, 5)
                      IHKLD(K, KSMAL) = IHKLD(K, 5)
                      DO L = 1, 3
                        TWM (K, L, KSMAL) = TWM(K, L, 5)
                      END DO
                    END DO
                  END IF
                END IF
                NTW(5) = 0
   60         CONTINUE
            END IF
          END DO
C * SORT TWIN LAWS
          CALL GEN124 (MTWIN, 1, NVCX * 2)
        END IF
C * SHOW RESULTS
        ISHOW = 1
      END IF
   70 CALL PLA116 (ISHOW, MODE, NVCX)
      IF (MODE .EQ. 1) THEN
C * INSTRUCTION CYCLE
        DO
          IF (IGBL(3) .NE. 37) THEN
            CALL PLA013 (0, 1)
            IF (IGGT(1:1) .EQ. '!' .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 70
            CALL PLA006 (0, IS)
C * CALC TWIN LAWS
            IF (IS .EQ. 18) THEN
              GO TO 20
C * CALC HKLF (GENERATE HKLF 5 FILE)
            ELSE IF (IS .EQ. 70) THEN
              CALL PLA117
              RETURN
C * ICALC FROM CIF/FCF TOGGLE
            ELSE IF (IS .EQ. 177) THEN
              GO TO 10
C * END (RETURN)
            ELSE IF (IS .EQ. 19) THEN
              RETURN
C * LIST (IPR/PAR/IGBL/RGBL)
            ELSE IF (IS .EQ. 29) THEN
              CALL PLA206 (-1, IFL(2)(1:3))
              CYCLE
C * SET (IPR/PAR/IGBL/RGBL)
            ELSE IF (IS .EQ. 46) THEN
              CALL PLA206 (1, IFL(2)(1:3))
              CYCLE
C * EXIT
            ELSE IF (IS .EQ. 53) THEN
              RETURN
C * TWIN PLOT
            ELSE IF (IS .EQ. 99) THEN
              IF (IWIN .EQ. 1) THEN
                CALL PLA118
              END IF
              GO TO 70
            ELSE
              CYCLE
            END IF
          ELSE
C * GENERATE HKLF 5 FILE
            IF (NVCX .GT. 0) THEN
              CALL PLA117
            END IF
            RETURN
          END IF
        END DO
      END IF
      RETURN
99999 FORMAT ('  H  K  L         Iobs        Icalc     SigI',
     1        ' Delt/Sig  Theta', ' DTheta  Alpha     Rot Axis', /,
     2        89('='))
99998 FORMAT (/, 'Sorted List of Twin Overlap Candidates', /, 60('='),
     1        /, '  H  K  L         Iobs        Icalc     SigI',
     2        ' Delt/Sig  Theta', /, 60('='))
99997 FORMAT (1X)
99996 FORMAT (3I3, 2F13.2, 2F9.2, 3F7.2, 3I5)
99995 FORMAT (60('='))
99994 FORMAT (/, 'Alpha = (Iobs - Icalc) / (Jcalc - Icalc)', /)
      END SUBROUTINE PLA114
      SUBROUTINE PLA115 (NRTWIN)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,NP60=100,NREC=12,NALM=100)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /LEPAG/ AXES(15, 23), TM(3, 3), CL(3, 5), TP(3, 3),
     1 TG(3, 3), TPQ(3, 3), TPS(3, 3), G(3, 3), OR(3, 3), ROTQ(3, 3),
     2 TRMXT (3, 3), T(3), H(3), TC(6), CELL(7), OCELL(7), RCELL(7),
     3 IDET, NVEC
      COMMON // JNSC(2, NP23), VOID(NVD)
      DIMENSION IHKL(3), SUMT(NALM), SUMN(NALM), SCLA(NALM), SUMFC(NALM)
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      INTEGER HMAX
C * ANALYSE EFFECT ON R (FUNCTION OF BASF)
      I = - NREC
      DO K = 1, NREF
        I = I + NREC
        DO J = 1, 3
          IHKL(J) = NINT(VOID(I + J))
          H(J)    = IHKL(J)
        END DO
        FOK = VOID(I + 4)
        FCK = VOID(I + ICALT)
        TH  = VOID(I + 7)
        CALL GEN002 (1, TWM(1, 1, NRTWIN), H, T, XDUM)
        IHT = NINT(T(1))
        IKT = NINT(T(2))
        ILT = NINT(T(3))
        FCKT  = 0.0
        IF (ABS(T(1) - IHT) .LT. PAR(415)) THEN
          IF (ABS(T(2) - IKT) .LT. PAR(415)) THEN
            IF (ABS(T(3) - ILT) .LT. PAR(415)) THEN
              IHKLTP = ILT * MHK + IKT * MPH + IHT
              JJJ = IADR + IHKLTP
              IF (JJJ .GT. NVD) GO TO 10
              J  = NINT(VOID(JJJ))
              IF (J .LE. 0) THEN
                GO TO 10
              ELSE IF (J .GT. 0) THEN
                FCKT0 = VOID((J - 1) * NREC + ICALT)
              END IF
              ST  = SQRT(GEN095 (PAR(191), IHT, IKT, ILT)) * PAR(17)
              IF (ST .LT. 1.0) THEN
                THT = ASIN (ST) * RGBL(6)
              ELSE
                THT = 0.0
              END IF
              IF (ABS(TH - THT) .LE. PAR(420)) THEN
                IF (ABS(IHT) .LE. HMAX .AND. ABS(IKT) .LE. KMAX .AND.
     1              ABS(ILT) .LE. LMAX) THEN
                  NTW(NRTWIN) = NTW(NRTWIN) + 1
                  FCKT        = FCKT0
                END IF
              END IF
            END IF
          END IF
        END IF
   10   VOID (I + 10) = FCKT
      END DO
      SUMFO = 0.0
      STAL  = 1.0 / NALM
      CALL GEN074 (SUMFC, 1, NALM, 0.0)
      J = - NREC
      DO K = 1, NREF
        J     = J + NREC
        FOK   = VOID(J + 4)
        FCKT  = VOID(J + 10)
        FCK   = VOID(J + ICALT)
        SUMFO = SUMFO + FOK
        DO I = 1, NALM
          ALF = (I - 1) * STAL
          TERM1 = (1.0 - ALF) * FCK
          IF (FCKT .GT. 0.0) THEN
            TERM2 = ALF * FCKT
          ELSE
            TERM2 = 0.0
          END IF
          SUMFC(I) = SUMFC(I) + TERM1 + TERM2
        END DO
      END DO
      DO I = 1, NALM
        SCLA(I) = SUMFC(I) / SUMFO
        SUMT(I) = 0.0
        SUMN(I) = 0.0
      END DO
      DO K = 1, NREF
        KMM  = (K - 1) * NREC
        FOK  = VOID(KMM + 4)
        SIG  = VOID(KMM + 6)
        IF (FOK .GT. 2.0 * SIG) THEN
          FCKT = VOID(KMM + 10)
          FCK  = VOID(KMM + ICALT)
          DO I = 1, NALM
            ALF  = (I - 1) * STAL
            FCKS = SQRT((1.0 - ALF) * FCK + ALF * FCKT)
            FOKS = SQRT(SCLA(I) * FOK)
            SUMT(I) = SUMT(I) + ABS(FOKS - FCKS)
            SUMN(I) = SUMN(I) + FOKS
          END DO
        END IF
      END DO
      BASF = 0.0
      IF (SUMN(1) .GT. 0) THEN
        RVAL = SUMT(1) / SUMN(1)
        DRVAL(NRTWIN) = - RVAL
        DO I = 2, NALM
          YUNK = SUMT(I) /SUMN(I)
          IF (YUNK .LT. RVAL) THEN
            BASF = (I - 1) * STAL
            RVAL = YUNK
          END IF
        END DO
      ELSE
        RVAL = 0.0
      END IF
      DRVAL(NRTWIN)         = DRVAL(NRTWIN) + RVAL
      BASFM(NRTWIN)         = BASF
      MTWIN(NRTWIN * 2 - 1) = NINT (DRVAL(NRTWIN) * 1000.0)
      MTWIN(NRTWIN * 2    ) = NRTWIN
      RETURN
      END SUBROUTINE PLA115
      SUBROUTINE PLA116 (ISHOW, MODE, NVCX)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1           NP22=287,NP38=150,NP39=30,NP52=200,NP56=30,
     2 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      INTEGER HMAX
C * SHOW TWINROTMAT RESULTS
C * ISHOW - 0 = Report 'No Twinning Detected'
C *         1 = Show Twinning Laws
C * MODE  - 1 - GRAPHICS MODE
C *         2 - NON-GRAPHICS MODE
C * NVCX  - Number of Twinning Laws for Display
      IF (ISHOW .EQ. 0) THEN
        IF (MODE .EQ. 2) THEN
          LOUT = LU13
        ELSE
          LOUT = LU6
          IF (IWIN .EQ. 1) THEN
            CALL GGIP (HORS, VERT, 0.0, 1)
            CALL GGIP09 (0.0,
     1 'Too few Fobs .GT. Fcalc Reflections for TwinRotMat Analysis',
     2   59, 0.45, 2, 2, 1.0, 8.0)
          END IF
        END IF
        WRITE (LOUT, 99984, IOSTAT = IOST) NSEL
        IF (ICALT .EQ. 5) THEN
          WRITE (LOUT, 99988, IOSTAT = IOST)
        ELSE
          WRITE (LOUT, 99986, IOSTAT = IOST)
        END IF
        WRITE (LOUT, 99982, IOSTAT = IOST)
      ELSE
        NLIST = 0
        IF (MODE .EQ. 1) THEN
          IF (IWIN .EQ. 1) THEN
            CALL GGIP (HORS, VERT, 0.0, 1)
            CALL PLA110 (HORS, VERT, -1)
            IF (ICALT .EQ. 5) THEN
              BCD = 'Fc from Coordinates'
            ELSE
              BCD = 'Fc from Fo/Fc File '
            END IF
            CALL GGIP09 (90.0, BCD, 19, 0.35, 1, 1, 1.5, 0.5)
            BCD = 'TwinRotMat'//CHAR(0)
            CALL GGIP09 (0.0,  BCD, 10, 1.4, 4, 8, 7.0, VERT - 1.8)
            CALL GGIP09 (0.0,  BCD, 10, 1.4, 2, 8, 6.8, VERT - 1.9)
            WRITE (BCD, 99996, IOSTAT = IOST) JID(1:6)
            VRT = VERT - 3.0
            CALL GGIP09 (0.0,  BCD, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
            WRITE (BCD, 99991, IOSTAT = IOST)
     1        PAR(17), (PAR(100 + I), I = 1, 6), SPGRNM(1)(1:11)
            VRT = VRT - 1.0
            CALL GGIP09 (0.0,  BCD, 80, 0.35, 1, 2, 1.0, VRT)
          END IF
        ELSE
          WRITE (LU13, 99984, IOSTAT = IOST) NSEL
          IF (ICALT .EQ. 5) THEN
            WRITE (LU13, 99988, IOSTAT = IOST)
          ELSE
            WRITE (LU13, 99986, IOSTAT = IOST)
          END IF
        END IF
        IF (MODE .EQ. 1) NLIST = NLIST + 1
        WRITE (BCD, 99990, IOSTAT = IOST) PAR(413), PAR(414), IPR(550)
        IF (NLIST .EQ. 1) THEN
          CALL PLA262 (0)
          CALL PLA262 (9)
          WRITE (LU6, 99997, IOSTAT = IOST)
          WRITE (LU7, 99997, IOSTAT = IOST)
          WRITE (LU6, 99998, IOSTAT = IOST) BCD
          WRITE (LU7, 99998, IOSTAT = IOST) BCD
        END IF
        IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0,  BCD, 80, 0.35, 1, 2, 1.0, VRT)
        END IF
        WRITE (BCD, 99983, IOSTAT = IOST)
     1    NREF, NSEL, IPR(567), PAR(415), PAR(420)
        IF (NLIST .EQ. 1) THEN
          WRITE (LU6, 99997, IOSTAT = IOST)
          WRITE (LU7, 99997, IOSTAT = IOST)
          WRITE (LU7, 99987, IOSTAT = IOST) PAR(17)
          WRITE (LU6, 99998, IOSTAT = IOST) BCD
          WRITE (LU7, 99998, IOSTAT = IOST) BCD
          WRITE (LU6, 99997, IOSTAT = IOST)
          WRITE (LU7, 99997, IOSTAT = IOST)
        END IF
        IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0,  BCD, 80, 0.35, 1, 2, 1.0, VRT)
          CALL GGIP (0.0, 0.0, 0.0, 6)
        END IF
        IF (NSEL .EQ. 0) THEN
          IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
            CALL GGIP09 (0.0, 'No Refl Selected', 16, 1.2, 2, 10, 4.0,
     1                   8.0)
          END IF
          IF (MODE .EQ. 2) WRITE (LU13, 99985, IOSTAT = IOST)
          GO TO 10
        END IF
        NRTWL = 0
        IF (NVCX .GT. 0) THEN
          IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
            CALL GGIP (0.0,        VRT - 0.5, 0.0, 3)
            CALL GGIP (HORS,       VRT - 0.5, 0.0, 2)
            CALL GGIP (1.8,        VRT - 0.5, 0.0, 3)
            CALL GGIP (1.8,        0.0,       0.0, 2)
            CALL GGIP (HORS - 4.1, VRT - 0.5, 0.0, 3)
            CALL GGIP (HORS - 4.1, 0.0      , 0.0, 2)
          END IF
          DO J = 1, NVCX
            I = MTWIN(J * 2)
            IF (BASFM(I) .GT. 0.0 .AND. DRVAL(I) .LE. -0.01 .AND.
     1        NTW(I) .GT. 0.5 * NTW(1)) THEN
                NCOL         = 3
                IPR(570 + J) = 1
            ELSE
              NCOL = 4
            END IF
            WRITE (BCD, 99999, IOSTAT = IOST)
     1        (IHKLR(K, I), K = 1, 3), (IHKLD(K, I), K = 1, 3),
     2        ALPHA(I), IABS(NFRQ(I))
            IF (NFRQ(I) .GT. 0) THEN
              WRITE (PRBUF, 99981, IOSTAT = IOST)
            ELSE
              WRITE (PRBUF, 99980, IOSTAT = IOST)
            END IF
            IF (NLIST .EQ. 1) THEN
              CALL PLA262 (2)
              WRITE (LU6, 99997, IOSTAT = IOST)
              WRITE (LU7, 99997, IOSTAT = IOST)
              WRITE (LU6, 99998, IOSTAT = IOST) BCD
              WRITE (LU7, 99998, IOSTAT = IOST) BCD
            END IF
            IF (NCOL .EQ. 3) THEN
              IF (MODE .EQ. 2) THEN
                WRITE (LU13, 99997, IOSTAT = IOST)
                WRITE (LU13, 99998, IOSTAT = IOST) BCD
                WRITE (LU13, 99998, IOSTAT = IOST) PRBUF(1:37)
                WRITE (LU13, 99997, IOSTAT = IOST)
              END IF
              WRITE (NQ1, 99989, IOSTAT = IOST) (IHKLR(K, I), K = 1, 3)
              WRITE (NQ2, 99989, IOSTAT = IOST) (IHKLD(K, I), K = 1, 3)
C * ALERT _930
              IF (ICALT .EQ. 11) THEN
                IPR(619) = 1
                CALL PLA231 (930, 2, BASFM(I), BASFM(I), NQ1, NQ2)
C * ALERT _870
                IF (NRTWL .EQ. 0)
     1            CALL PLA231 (870, 0, -999.0, 0.0, ' ', ' ')
              ELSE
                IF (NFRQ(I) .GT. 0) THEN
                  NQ2 = ' '
                ELSE
                  NQ1 = ' '
                END IF
C * ALERT _931
                CALL PLA231 (931, 2, -999.0, BASFM(I), NQ1, NQ2)
                IPR(619) = 1
C * ALERT _870
                IF (NRTWL .EQ. 0)
     1            CALL PLA231 (870, 0, -999.0, 0.0, ' ', ' ')
              END IF
              NRTWL = NRTWL + 1
            END IF
            IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
              VRT = VRT - 1.0
              BCD(80:80) = CHAR(0)
              CALL GGIP09 (0.0,  BCD, 80, 0.3, NCOL, 2, 2.0, VRT)
              VRT = VRT - 0.4
              CALL GGIP09 (0.0,  PRBUF, 37, 0.3, NCOL, 2, 2.0, VRT)
            END IF
            IF (NLIST .EQ. 1) THEN
              CALL PLA262 (4)
              WRITE (LU6, 99998, IOSTAT = IOST) PRBUF(1:37)
              WRITE (LU7, 99998, IOSTAT = IOST) PRBUF(1:37)
            END IF
            WRITE (BCD, 99994, IOSTAT = IOST)
     1        (TWM(1, II, I), II = 1, 3), NTW(I)
            IF (NLIST .EQ. 1) THEN
              WRITE (LU6, 99998, IOSTAT = IOST) BCD
              WRITE (LU7, 99998, IOSTAT = IOST) BCD
            END IF
            IF (NCOL .EQ. 3 .AND. MODE .EQ. 2)
     1        WRITE (LU13, 99998, IOSTAT = IOST) BCD
            IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
              VRT = VRT - 0.6
              CALL GGIP09 (0.0,  BCD, 80, 0.3, NCOL, 2, 2.0, VRT)
            END IF
            WRITE (BCD, 99993, IOSTAT = IOST)
     1        (TWM(2, II, I), II = 1, 3), BASFM(I)
            IF (NLIST .EQ. 1) THEN
              WRITE (LU6, 99998, IOSTAT = IOST) BCD
              WRITE (LU7, 99998, IOSTAT = IOST) BCD
            END IF
            IF (NCOL .EQ. 3 .AND. MODE .EQ. 2)
     1        WRITE (LU13, 99998, IOSTAT = IOST) BCD
            IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
              VRT = VRT - 0.6
              CALL GGIP09 (0.0,  BCD, 80, 0.3, NCOL, 2, 2.0, VRT)
              WRITE (NQ1, 99995, IOSTAT = IOST) J
              CALL GGIP09 (0.0, NQ1, 1, 1.5, 1, 2 , HORS - 2.5, VRT)
            END IF
            WRITE (BCD, 99992, IOSTAT = IOST)
     1        (TWM(3, II, I), II = 1, 3), DRVAL(I)
            IF (NLIST .EQ. 1) THEN
              WRITE (LU6, 99998, IOSTAT = IOST) BCD
              WRITE (LU7, 99998, IOSTAT = IOST) BCD
            END IF
            IF (NCOL .EQ. 3 .AND. MODE .EQ. 2)
     1        WRITE (LU13, 99998, IOSTAT = IOST) BCD
            IF (IWIN .EQ. 1 .AND. MODE .EQ. 1) THEN
              VRT = VRT - 0.6
              CALL GGIP09 (0.0,  BCD, 80, 0.3, NCOL, 2, 2.0, VRT)
              CALL GGIP (1.8,  VRT - 0.4, 0.0, 3)
              CALL GGIP (HORS, VRT - 0.4, 0.0, 2)
            END IF
          END DO
          IF (NLIST .EQ. 1) THEN
            WRITE (LU6, 99979, IOSTAT = IOST)
            WRITE (LU7, 99979, IOSTAT = IOST)
          ENDIF
        ELSE
          IF (MODE .EQ. 1) THEN
            IF (IWIN .EQ. 1) THEN
              CALL GGIP09 (0.0, 'No Twin Law Detected', 20, 1.2, 2, 10,
     1                     3.0, 8.0)
            END IF
          END IF
        END IF
        IF (MODE .EQ. 2) THEN
          IF (NRTWL .EQ. 0 .AND. MODE .EQ. 2)
     1      WRITE (LU13, 99985, IOSTAT = IOST)
          WRITE (LU13, 99997, IOSTAT = IOST)
        END IF
      END IF
   10 RETURN
99999 FORMAT ('2-axis (', 3I4, ' ) [',3I4, ' ]',
     1        ', Angle () [] =', F6.2, ' Deg, Freq =', I6)
99998 FORMAT (A)
99997 FORMAT (1X)
99996 FORMAT ('Analysis of Fo/Fc Data for Unaccounted (Non)Merohedral',
     1        ' Twinning for: ', A)
99995 FORMAT (I1)
99994 FORMAT ('(', F6.3, 2F9.3, ')   (h1)   (h2)', 19X,
     1         'Nr Overlap =', I6)
99993 FORMAT ('(', F6.3, 2F9.3, ') * (k1) = (k2)', 25X,
     1         'BASF =', F6.2)
99992 FORMAT ('(', F6.3, 2F9.3, ')   (l1)   (l2)', 24X,
     1         'DEL-R =', F6.3)
99991 FORMAT ('Cell:', F8.5, 3F7.3, 3F7.2, 2X, 'Spgr: ', A)
99990 FORMAT ('Criteria: DeltaI/SigmaI .GT.', F5.1, ', DeltaTheta',
     1        F5.2, ' Deg., NselMin =', I4)
99989 FORMAT (2I2, I3)
99988 FORMAT ('Note: This Analysis is Based on Fc calculated from',
     1        ' Coordinates in the CIF.', /
     1        79('='))
99987 FORMAT ('Wavelength Used in this Analysis', F10.5, ' Ang.', /)
99986 FORMAT ('Note: This Analysis is Based on Fc Taken from Fo/Fc',
     1        ' File', /, 79('='))
99985 FORMAT (/,
     1  'No Applicable Twin Law(s) Detected from Fo/Fc Analysis',
     2  '-or Already Accounted for', /)
99984 FORMAT (/, 'Section 8', /, 79('='), /,
     1 'Check for Unaccounted Twinning with the TwinRotMat Algorithm',
     2  ' - N(selec) =', I6, /, 79('='))
99983 FORMAT ('N(refl) =', I7, ', N(selected) =', I5, ', IndMax =',
     1        I3, ', CritI =', F4.1, ', CritT =', F5.2)
99982 FORMAT (/, ':: Too few Fobs >> Fcalc Reflections for',
     1        ' TwinRotMat Analysis', /)
99981 FORMAT (8X,  13('*'))
99980 FORMAT (24X, 13('*'))
99979 FORMAT (/, 'Note: Symmetry Equivalent Twin Laws are not Listed !',
     1        /)
      END SUBROUTINE PLA116
      SUBROUTINE PLA117
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,
     1           NP23=28000,NP38=150,NP39=30,NP60=100,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /LEPAG/ AXES(15, 23), TM(3, 3), CL(3, 5), TP(3, 3),
     1 TG(3, 3), TPQ(3, 3), TPS(3, 3), G(3, 3), OR(3, 3), ROTQ(3, 3),
     2 TRMXT (3, 3), T(3), H(3), TC(6), CELL(7), OCELL(7), RCELL(7),
     3 IDET, NVEC
      COMMON // JNSC(2, NP23), VOID(NVD)
      DIMENSION IHKL(3)
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      INTEGER HMAX, MTW(5)
C * GENERATE HKLF5 FILE
      NTX = 0
      IRT = (2 - ICNTR) * IPR(575) + 1
      CALL PLA262 (0)
      CALL PLA262 (2)
      WRITE (LU7, 99999, IOSTAT = IOST)
      NTWIN = 0
      DO K = 1, 4
        IF (IPR(570 + K) .EQ. 1) THEN
          NTWIN       = NTWIN + 1
          MTW(NTWIN)  = MTWIN(K * 2)
          NTW0(NTWIN) = K
        END IF
      END DO
      IPR(2) = -11
      DO K = 1, NREF
        KMM = (K - 1) * NREC
        DO J = 1, 3
          IHKL(J) = NINT(VOID(KMM + J))
          H(J)    = IHKL(J)
        END DO
        FOK  = VOID(KMM + 4)
        FCK  = VOID(KMM + ICALT)
        SIG  = VOID(KMM + 6)
        TH   = VOID(KMM + 7)
        IFOK = NINT(FOK * SCL)
        ISIG = NINT(SIG * SCL)
        NTY  = 0
        DO NRTW = 1, NTWIN
          NRTWIN = MTW(NRTW)
          CALL GEN002 (1, TWM(1, 1, NRTWIN), H, T, XDUM)
          IHT  = NINT(T(1))
          IKT  = NINT(T(2))
          ILT  = NINT(T(3))
          FCKT = 0.0
          IPRN = 0
          IF (ABS(T(1) - IHT) .LT. PAR(415)) THEN
            IF (ABS(T(2) - IKT) .LT. PAR(415)) THEN
              IF (ABS(T(3) - ILT) .LT. PAR(415)) THEN
                IHKLTP = ILT * MHK + IKT * MPH + IHT
                J      = NINT(VOID(IADR + IHKLTP))
                IF (J .LT. 0) THEN
                  GO TO 10
                ELSE IF (J .GT. 0) THEN
                  FCKT0 = VOID((J - 1) * NREC + 5)
                ELSE
                  WRITE (LU6, 99993, IOSTAT = IOST)
     1              (IHKL(J), J = 1, 3), (NINT(T(J)), J = 1, 3)
                END IF
                ST = SQRT(GEN095 (PAR(191), IHT, IKT, ILT)) * PAR(17)
                IF (ST .LT. 1.0) THEN
                  THT = ASIN (ST) * RGBL(6)
                ELSE
                  THT = 0.0
                END IF
                IF (ABS(TH - THT) .LE. PAR(420)) THEN
                  IF (ABS(IHT) .LE. HMAX .AND. ABS(IKT) .LE. KMAX .AND.
     1                ABS(ILT) .LE. LMAX) THEN
                    NTY  = 1
                    FCKT = FCKT0
                    NTC  = - (NRTW + 1) * IRT
                    IF (IPR(575) .EQ. 1) THEN
                      WRITE (LU17, 99998, IOSTAT = IOST)
     1                  -IHT, -IKT, -ILT, IFOK, ISIG, NTC
                    END IF
                    WRITE (LU17, 99998, IOSTAT = IOST)
     1                IHT,  IKT,  ILT, IFOK, ISIG, NTC + (IRT - 1)
                    IPRN = 1
                  END IF
                END IF
              END IF
            END IF
          END IF
   10     CONTINUE
        END DO
        IF (IPR(575) .EQ. 1) THEN
          WRITE (LU17, 99998, IOSTAT = IOST)
     1      ( -NINT(H(J)), J = 1, 3), IFOK, ISIG, -2
        END IF
        WRITE (LU17, 99998, IOSTAT = IOST)
     1   (NINT(H(J)), J = 1, 3), IFOK, ISIG, 1
        NTX = NTX + NTY
        IF (IPR(469) .NE. 0) THEN
          CALL PLA262 (1)
          IF (IPRN .NE. 0) THEN
            WRITE (LU7, 99997, IOSTAT = IOST)
     1        NTX, (NINT(H(J)), J = 1, 3), FOK, FCK, SIG, IHT, IKT,
     2        ILT, FCKT, TH, THT, TH - THT
          ELSE
            WRITE (LU7, 99996, IOSTAT = IOST)
     1        (NINT(H(J)), J = 1, 3), FOK, FCK, SIG
          END IF
        END IF
        VOID (KMM + 10) = FCKT
      END DO
      WRITE (LU6, 99995, IOSTAT = IOST) (NTW0(K), K = 1, NTWIN)
      CALL PLA262 (0)
      WRITE (LU7, 99995, IOSTAT = IOST) (NTW0(K), K = 1, NTWIN)
      IF (IRT .EQ. 1) THEN
        WRITE (LU6, 99994, IOSTAT = IOST) NREF, NTX, (BASFM(MTW(I)),
     1                     I = 1, NTWIN)
        WRITE (LU7, 99994, IOSTAT = IOST) NREF, NTX, (BASFM(MTW(I)),
     1                     I = 1, NTWIN)
      ELSE
        WRITE (LU6, 99994, IOSTAT = IOST) NREF, NTX,
     1                     (BASFM(MTW(NTWIN + 1 - I)) / 2.0,
     2                      BASFM(MTW(NTWIN + 1 - I)) / 2.0,
     3                     I = 1, NTWIN)
        WRITE (LU7, 99994, IOSTAT = IOST) NREF, NTX,
     1                     (BASFM(MTW(NTWIN + 1 - I)) / 2.0,
     2                      BASFM(MTW(NTWIN + 1 - I)) / 2.0,
     3                     I = 1, NTWIN)
      END IF
      RETURN
99999 FORMAT (3X, 'nr', 6X, 'H   K   L', 7X, 'FOK', 7X, 'FCK', 7X,
     1        'SIG', 5X, 'HT  KT  LT', 6X, 'FCKT',
     2        8X, 'TH', 7X, 'THT', 4X, 'DEL-TH', /, 105('='))
99998 FORMAT (3I4, 2I8, I4)
99997 FORMAT (I5, I7, 2I4, 3F10.2, I7, 2I4, 4F10.2)
99996 FORMAT (5X, I7, 2I4, 3F10.2)
99995 FORMAT (/, ':: TwinRotMatrix #', 4I5)
99994 FORMAT (':: Total Number of Reflections in HKLF 5 file   =', I6,
     2  /, '::       Number of which with Twin Contribution =', I6,
     3  /, '::                          Estimated BASF Line =', 8F6.2)
99993 FORMAT (':: Unobserved Partner for ', 3I5, ' : ', 3I5)
      END SUBROUTINE PLA117
      SUBROUTINE PLA118
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP45=2048,
     2 NP52=200,NP56=30,NP57=35,NP60=100,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      COMMON /LEPAG/ AXES(15, 23), TM(3, 3), CL(3, 5), TP(3, 3),
     1 TG(3, 3), TPQ(3, 3), TPS(3, 3), G(3, 3), OR(3, 3), ROTQ(3, 3),
     2 TRMXT (3, 3), T(3), H(3), TC(6), CELL(7), OCELL(7), RCELL(7),
     3 IDET, NVEC
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      DIMENSION IMX(3), JMX(3), XYZ(3), TAU(3), ROT(3, 3), IAS(8),
     1          AS(3, 8), YUNK(3, 3)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      INTEGER HMAX
      HH    = HORS / 2.0
      VH    = VERT / 2.0
      RD    = 0.9 * VH
      IBRV  = IPR(241)
   10 NTPLT = MTWIN(IPR(543) * 2)
      STL   = PAR(449)
      RADM  = RD
      DO I = 1, 3
        IMX(I) = INT (2 * STL * PAR(100 + I))
        JMX(I) = 2 * IMX(I) + 1
        RADM   = MIN (RADM, RD / IMX(I))
      END DO
      RADM = RADM * 0.45
      NV   = NADR
      FCMX = 0.0
      DO I = 1, JMX(1)
        II = I - IMX(1) - 1
        DO J = 1, JMX(2)
          JJ = J - IMX(2) - 1
          DO K = 1, JMX(3)
            KK = K - IMX(3) - 1
            H(1) = II
            H(2) = JJ
            H(3) = KK
            YUNK1 = 0
            IF (IBRV .GT. 1) THEN
              IF (GEN049 (LAT(IBRV), II, JJ, KK) .LT. 0.0) YUNK1 = -1.0
            END IF
            ITP  = -1
            IF (II .EQ. 0 .AND. JJ .EQ. 0 .AND. KK .EQ. 0) ITP = 0
            IF (II .EQ. 1 .AND. JJ .EQ. 0 .AND. KK .EQ. 0) ITP = 1
            IF (II .EQ. 0 .AND. JJ .EQ. 1 .AND. KK .EQ. 0) ITP = 2
            IF (II .EQ. 0 .AND. JJ .EQ. 0 .AND. KK .EQ. 1) ITP = 3
            IF (II .EQ. 1 .AND. JJ .EQ. 1 .AND. KK .EQ. 0) ITP = 4
            IF (II .EQ. 1 .AND. JJ .EQ. 0 .AND. KK .EQ. 1) ITP = 5
            IF (II .EQ. 0 .AND. JJ .EQ. 1 .AND. KK .EQ. 1) ITP = 6
            DO L = 1, 2
              IF (L .EQ. 1) THEN
                T(1) = H(1)
                T(2) = H(2)
                T(3) = H(3)
                FCK  = 0.0
                IF (IABS(NINT(T(1))) .LE. HMAX .AND.
     1              IABS(NINT(T(2))) .LE. KMAX .AND.
     2              IABS(NINT(T(3))) .LE. LMAX) THEN
                  IHKLP = NINT(T(3)) * MHK + NINT(T(2)) * MPH
     1                  + NINT(T(1))
                  N     = NINT(VOID(IADR + IHKLP))
                  IF (N .GT. 0) FCK = VOID((N - 1) * NREC + 5)
                END IF
                IF (FCK .GT. 0) THEN
                  FCX = LOG(FCK)
                ELSE
                  FCX = 0.0
                END IF
                FCMX = MAX (FCMX, FCX)
              ELSE
                CALL GEN002 (1, TWM(1, 1, NTPLT), H, T, XDUM)
              END IF
              CALL GEN002 (1, ROTQ, T, XYZ, XDUM)
              IF (SQRT(GEN009 (XYZ, XYZ)) .LT. 2 * STL) THEN
                VOID(NV + 1)  = L
                VOID(NV + 2)  = H(1)
                VOID(NV + 3)  = H(2)
                VOID(NV + 4)  = H(3)
                VOID(NV + 5)  = XYZ(1)
                VOID(NV + 6)  = XYZ(2)
                VOID(NV + 7)  = XYZ(3)
                VOID(NV + 8)  = ITP
                VOID(NV + 9)  = YUNK1
                VOID(NV + 10) = FCX
                NV            = NV + 10
              END IF
            END DO
          END DO
        END DO
      END DO
   20 CALL GEN097 (IAS, 1, 8, 0)
   30 DO I = 1, 3
        TAU(I) = OR(I, IPR(394))
      END DO
      XTAU = SQRT(GEN009 (TAU, TAU))
      DO I = 1, 3
        TAU(I) = TAU(I) / XTAU
      END DO
      IF (ABS(TAU(1)) + ABS(TAU(2)) .LT. 0.0001) THEN
        OME = 0.0
        CHI = 90.0 / RGBL(6)
      ELSE
        OME = ATAN2 (TAU(2), TAU(1))
        CHI = ATAN2 (TAU(3), SQRT(TAU(1)**2 + TAU(2)**2))
      END IF
      CALL GEN043 (3, TP, OME)
      CALL GEN043 (2, TG, 90.0 / RGBL(6) - CHI)
      CALL GEN004 (TG, TP, ROT)
      IF (IPR(394) .EQ. 2 .OR. IPR(394) .EQ. 3) THEN
        CALL GEN043 (3, TG, 180.0 / RGBL(6))
      ELSE
        CALL GEN043 (3, TG, 90.0 / RGBL(6))
      END IF
      CALL GEN004 (TG, ROT, YUNK)
      CALL GEN052 (YUNK, ROT)
      BCD = 'PlotTwinLat'//CHAR(0)
      CALL GGIP (HORS, VERT, 0.0, 1)
      CALL GGIP09 (90.0,  BCD, 11, 1.2, 2, 8, 2.3, 2.5)
      CALL PLA110 (HORS, VERT, -1)
      VRT = VERT - 0.4
      CALL GGIP09 (0.0, 'Twin Matrix', 11, 0.25, 5, 1, 2.0, VRT)
      VRT = VRT - 0.2
      DO I = 1, 3
        WRITE (LINE, 99999, IOSTAT = IOST) (TWM(I, J, NTPLT), J = 1, 3)
          IF (IOST .EQ. -999) RETURN
        VRT = VRT - 0.4
        CALL GGIP09 (0.0, LINE, 21, 0.25, 1, 1, 0.5, VRT)
      END DO
      VRT = VRT - 0.7
      WRITE (LINE, 99996, IOSTAT = IOST) (IHKLD(I, NTPLT), I = 1, 3)
      CALL GGIP09 (0.0, LINE, 17, 0.30, 1, 1, 1.0, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99998, IOSTAT = IOST) (IHKLR(I, NTPLT), I = 1, 3)
      CALL GGIP09 (0.0, LINE, 17, 0.30, 1, 1, 1.0, VRT)
      IF (IPR(394) .EQ. 1) THEN
        LINE = 'Zone - H ='
      ELSE IF (IPR(394) .EQ. 2) THEN
        LINE = 'Zone - K ='
      ELSE
        LINE = 'Zone - L ='
      END IF
      WRITE (LINE(11:13), 99997, IOSTAT = IOST) IPR(576)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 13, 0.35, 5, 1, 1.0, VRT)
      WRITE (LINE, '(''Resol = '', F5.1)', IOSTAT = IOST) PAR(449)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.0, VRT)
      WRITE (LINE, '('' BASF ='', F6.2)', IOSTAT = IOST) BASFM(NTPLT)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.0, VRT)
      WRITE (LINE, '(''DRVAL ='', F6.3)', IOSTAT = IOST) DRVAL(NTPLT)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.0, VRT)
      VRT = VERT
      WRITE (LINE, '(''SpGr '', A)', IOSTAT = IOST) SPGRNM(1)(1:7)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
      WRITE (LINE, '(''a    '', F7.2)', IOSTAT = IOST) PAR(101)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
      WRITE (LINE, '(''b    '', F7.2)', IOSTAT = IOST) PAR(102)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
      WRITE (LINE, '(''c    '', F7.2)', IOSTAT = IOST) PAR(103)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
      WRITE (LINE, '(''alpha'', F7.2)', IOSTAT = IOST) PAR(104)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
      WRITE (LINE, '(''beta '', F7.2)', IOSTAT = IOST) PAR(105)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
      WRITE (LINE, '(''gamma'', F7.2)', IOSTAT = IOST) PAR(106)
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LINE, 14, 0.35, 1, 1, HORS - 4.0, VRT)
      CALL GGIP (HH, VH, 0.0, -3)
      CALL PLA289 (0.0, 0.0, RD, 36)
      SCF  = RD / (2 * STL)
      BAS2 = BASFM(NTPLT)
      BAS1 = 1.0 - BAS2
      SCPR0 = IPR(576) / XTAU
      DO N = NADR, NV, 10
        SCPR = GEN009 (TAU, VOID(N + 5))
        IF (ABS(SCPR0 - SCPR) .LT. 0.01) THEN
          IPEN = NINT (VOID(N + 1))
          ITP  = NINT (VOID(N + 8))
          IPLT = NINT (VOID(N + 9))
          DO I = 1, 3
            T(I) = VOID (N + I + 4) * SCF
          END DO
          IF (IPEN .EQ. 1) THEN
            NADD = 0
          ELSE
            NADD = 4
          END IF
          IF (IPR(394) .EQ. 1) THEN
            IF (ITP .EQ. 2) IAS(1 + NADD) = N
            IF (ITP .EQ. 0) IAS(2 + NADD) = N
            IF (ITP .EQ. 3) IAS(3 + NADD) = N
            IF (ITP .EQ. 6) IAS(4 + NADD) = N
          ELSE IF (IPR(394) .EQ. 2) THEN
            IF (ITP .EQ. 1) IAS(1 + NADD) = N
            IF (ITP .EQ. 0) IAS(2 + NADD) = N
            IF (ITP .EQ. 3) IAS(3 + NADD) = N
           IF (ITP .EQ. 5) IAS(4 + NADD) = N
          ELSE IF (IPR(394) .EQ. 3) THEN
            IF (ITP .EQ. 1) IAS(1 + NADD) = N
            IF (ITP .EQ. 0) IAS(2 + NADD) = N
            IF (ITP .EQ. 2) IAS(3 + NADD) = N
            IF (ITP .EQ. 4) IAS(4 + NADD) = N
          END IF
          CALL GEN002 (1, ROT, T, XYZ, XLNG)
          IF (IPLT .EQ. 0) THEN
            RADIUS = RADM * VOID(N + 10) / FCMX
            IF (IPEN .EQ. 1) THEN
              RADIUS = MAX (RADIUS, 0.02)
              NSTEP = 12
            ELSE
              RADIUS = MAX (RADIUS * BAS2 / BAS1, 0.02)
              NSTEP = 3
            END IF
            CALL GGIP (0.0, FLOAT(IPEN), 0.0, 0)
            CALL PLA289 (XYZ(1), XYZ(2), RADIUS, NSTEP)
          END IF
        END IF
      END DO
      IF (IPR(576) .EQ. 0) THEN
        DO J = 1, 8
          DO I = 1, 3
            IASJ = IAS(J)
            IF (IASJ .EQ. 0) IASJ = IAS(2)
            T(I) = VOID (IASJ + I + 4) * SCF
          END DO
          CALL GEN002 (1, ROT, T, AS(1, J), XLNG)
        END DO
        DO I = 1, 2
          NADD = (2 - I) * 4
          CALL GGIP (0.0, FLOAT(3 - I), 0.0, 0)
          CALL GGIP (AS(1, 1 + NADD), AS(2, 1 + NADD), 0.0, 3)
          CALL GGIP (AS(1, 2 + NADD), AS(2, 2 + NADD), 0.0, 2)
          CALL GGIP (AS(1, 3 + NADD), AS(2, 3 + NADD), 0.0, 2)
          CALL GGIP (AS(1, 4 + NADD), AS(2, 4 + NADD), 0.0, 2)
          CALL GGIP (AS(1, 1 + NADD), AS(2, 1 + NADD), 0.0, 2)
        END DO
        CALL GGIP09 (0.0, 'O', 1, 0.25, 1, 2, AS(1, 2) -0.3,
     1                 AS(2, 2) - 0.3)
        IF (IPR(394) .EQ. 1) THEN
          CALL GGIP09 (0.0, 'K', 1, 0.25, 1, 2, AS(1, 1),
     1                 AS(2, 1) + 0.1)
          CALL GGIP09 (0.0, 'L', 1, 0.25, 1, 2, AS(1, 3) + 0.1,
     1                 AS(2, 3))
        ELSE IF (IPR(394) .EQ. 2) THEN
          CALL GGIP09 (0.0, 'H', 1, 0.25, 1, 2, AS(1, 1),
     1                 AS(2, 1) + 0.1)
          CALL GGIP09 (0.0, 'L', 1, 0.25, 1, 2, AS(1, 3) + 0.1,
     1                 AS(2, 3))
        ELSE IF (IPR(394) .EQ. 3) THEN
          CALL GGIP09 (0.0, 'H', 1, 0.25, 1, 2, AS(1, 1),
     1                 AS(2, 1) + 0.1)
          CALL GGIP09 (0.0, 'K', 1, 0.25, 1, 2, AS(1, 3) + 0.1,
     1                 AS(2, 3))
        END IF
      END IF
      CALL PLA013 (0, 1)
      SELECT CASE (IGGT(1:4))
        CASE ('!   ')
          GO TO 20
C * TWIN
        CASE ('TWIN')
          GO TO 10
C * NEXT
        CASE ('NEXT')
          IPR(576) = MAX (-IMX(IPR(394)), MIN (IMX(IPR(394)),
     1               IPR(576) + IPR(389)))
          GO TO 30
C * ZONE
        CASE ('ZONE')
          GO TO 20
C * RESOLUTION
        CASE ('RESO')
          GO TO 10
C * LIST (IPR/PAR/IGBL/RGBL)
        CASE ('LIST')
          CALL PLA206 (-1, IFL(2)(1:3))
          GO TO 10
C * SET (IPR/PAR/IGBL/RGBL)
        CASE ('SET ')
          CALL PLA206 (1, IFL(2)(1:3))
          GO TO 10
        CASE DEFAULT
          IPR(543) = 0
      END SELECT
      RETURN
99999 FORMAT (3F7.3)
99998 FORMAT ('(', I3, 2I5, ' )')
99997 FORMAT (I3)
99996 FORMAT ('[', I3, 2I5, ' ]')
	      END SUBROUTINE PLA118
      SUBROUTINE PLA119 (MODE, SCAL, IDTYP1, IDTYP2, LU)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,
     1           NP23=28000,NP38=150,NP39=30,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      CHARACTER LINE*80, THOR*12, TVER*12
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /COMPCELL/ CELLA(7), CELLB(7), RCELLA(7), RCELLB(7),
     1 TRNSA(3, 3), TRNSB(3, 3), NSYMHA, NSYMHB, NREF1, NREF2
      COMMON /COMPSPGR/ SPGRA, SPGRB
      CHARACTER SPGRA*11, SPGRB*11
      COMMON /NPPLOT/ YCC, YINT, YSLOPE
      N = IDTYP1 + IDTYP2
      IF (MODE .EQ. 0) THEN
        IF (IPR(633) .EQ. 0) THEN
          THOR = 'I(calc)'
          TVER = 'I(obs)'
        ELSE
          THOR = 'log[I(calc)]'
          TVER = 'log[I(obs)]'
        END IF
      ELSE
        IF (SPGRA .NE. SPGRB) THEN
          WRITE (LU, 99999, IOSTAT = IOST) SPGRA, SPGRB
          IF (IOST .EQ. -999) RETURN
        END IF
        IF (IPR(633) .EQ. 0) THEN
          THOR = 'I(obs)1'
          TVER = 'I(obs)2'
        ELSE
          THOR = 'log[I(obs)1]'
          TVER = 'log[I(obs)2]'
        END IF
      ENDIF
      HORS = 25.0
      VERT = 25.0
      XOR  = 1.0
      YOR  = 1.0
      CALL GGIP (HORS, VERT, 0.0, 1)
      CALL PLA110 (HORS, VERT, -1)
      CALL GGIP (0.0, 1.0, 0.0, 0)
      CALL PLA110 (HORS, VERT, -1)
      LINE = 'SCATTER PLOT'
      CALL GGIP09 (0.0, LINE, 12, 0.35, 5 + IGBL(68), 2, 10.0,
     1  VERT - 0.6)
      IF (IPR(633) .EQ. 0) THEN
        CALL GGIP09 (0.0,  THOR, 8, 0.35, 1, 1, HORS - 2.3, 0.4)
        CALL GGIP09 (90.0, TVER, 8, 0.35, 1, 1, 0.6, VERT - 2.0)
      ELSE IF (IPR(633) .EQ. 1) THEN
        CALL GGIP09 (0.0,  THOR, 12, 0.35, 1, 1, HORS - 4.1,
     1               0.4)
        CALL GGIP09 (90.0, TVER, 12, 0.35, 1, 1, 0.6, VERT - 3.8)
      END IF
      CALL GGIP (XOR, YOR, 0.0, -3)
      CALL GGIP (0.0, VERT - YOR, 0.0, 2)
      CALL GGIP (0.0, 0.0, 0.0, 3)
      CALL GGIP (HORS - XOR, 0.0, 0.0, 2)
      DSH  = 0.03
      NADR = 0
      FOKM = 0.0
      FCKM = 0.0
      DO I = 1, NREF
        FOK  = VOID (NADR + 4)
        IF (MODE .EQ. 1) THEN
          FCK  = VOID (NADR + 5)
        ELSE
          FCK  = VOID (NADR + 11)
        END IF
        FOKM = MAX (FOKM, FOK)
        FCKM = MAX (FCKM, FCK)
        NADR = NADR + NREC
      END DO
      IF (IPR(633) .EQ. 0) THEN
        SCALOBS = (VERT - YOR) / FOKM
        SCALCAL = (HORS - XOR) / FCKM
      ELSE IF (IPR(633) .EQ. 1) THEN
        SCALOBS = (VERT - YOR) / (LOG10(FOKM) + 1)
        SCALCAL = (HORS - XOR) / (LOG10(FCKM) + 1)
      ENDIF
      SCALE = MIN (SCALOBS, SCALCAL)
      IF (IPR(633) .EQ. 1) THEN
        TICK = 0.0
        DO WHILE ((TICK + 1.0) * SCALE .LT. HORS - XOR)
          N    = 10 ** (NINT (TICK))
          TICK = TICK + 1.0
          X    = TICK * SCALE
          WRITE (LINE(1:8), 99996, IOSTAT = IOST) N
          CALL GGIP (X, 0.0, 0.0, 3)
          CALL GGIP (X, 0.3, 0.0, 2)
          CALL GGIP (0.0, X, 0.0, 3)
          CALL GGIP (0.3, X, 0.0, 2)
          CALL GGIP09 (0.0,  LINE, 8, 0.3, 1, 1, X - 2.2, 0.1)
          CALL GGIP09 (90.0, LINE, 8, 0.3, 1, 1, 0.4, X - 2.2)
        END DO
      END IF
      CALL GGIP (0.0, 2.0, 0.0, 0)
      CALL GGIP (0.0, 0.0, 0.0, 3)
      CALL GGIP (HORS - XOR, VERT - YOR, 0.0, 2)
      CALL GGIP (0.0, 1.0, 0.0, 0)
      NADR = 0
      DO I = 1, NREF
        VAL4 = VOID (NADR + 4)
        IF (MODE .EQ. 1) THEN
          VAL5 = VOID (NADR + 5)
        ELSE
          VAL5 = VOID (NADR + 11)
        END IF
        IF (IPR(634) .EQ. 1) THEN
          VAL6 = VOID (NADR + 6)
        ELSE
          VAL6 = 0.0
        END IF
        IF (IPR(633) .EQ. 0) THEN
          X  =            VAL5         * SCALE
          Y  = MAX (0.0,  VAL4         * SCALE)
          YP = MAX (0.0, (VAL4 + VAL6) * SCALE)
          YM = MAX (0.0, (VAL4 - VAL6) * SCALE)
        ELSE IF (IPR(633) .EQ. 1) THEN
          IF (VAL4 .GT. 0.0 .AND. VAL4 - VAL6 .GT. 0.0 .AND.
     1        VAL5 .GT. 0.0) THEN
            X  =           (1.0 + LOG10(VAL5))        * SCALE
            Y  = MAX (0.5, (1.0 + LOG10(VAL4))        * SCALE)
            YP = MAX (0.5, (1.0 + LOG10(VAL4 + VAL6)) * SCALE)
            YM = MAX (0.5, (1.0 + LOG10(VAL4 - VAL6)) * SCALE)
          ELSE
            X  = 0.0
            Y  = 0.0
            YP = 0.0
            YM = 0.0
          END IF
        ENDIF
        IF (X .GT. 0.0 .AND. Y .GT. 0.0) THEN
          IF (IPR(634) .EQ. 1) THEN
            CALL GGIP (X, YP, 0.0, 3)
            CALL GGIP (X, YM, 0.0, 2)
          END IF
          PEN = FLOAT(5 + IGBL(68))
          CALL GGIP (0.0, PEN, 0.0, 0)
          CALL GGIP (X,       Y + DSH, 0.0, 3)
          CALL GGIP (X + DSH, Y,       0.0, 2)
          CALL GGIP (X,       Y - DSH, 0.0, 2)
          CALL GGIP (X - DSH, Y,       0.0, 2)
          CALL GGIP (X,       Y + DSH, 0.0, 2)
          CALL GGIP (0.0, 1.0, 0.0, 0)
        END IF
        NADR = NADR + NREC
      END DO
      VRT = VERT
      CALL GGIP (-XOR, -YOR, 0.0, -3)
      VRT = VRT - 0.75
      CALL GGIP09 (0.0, FILENAMES(1)(1:25), 25, 0.35, 1, 1, VERT + 0.2,
     1             VRT)
      IF (MODE .EQ. 1) THEN
        VRT = VRT - 0.75
        CALL GGIP09 (0.0, FILENAMES(2)(1:25), 25, 0.35, 1, 1,
     1               VERT + 0.2, VRT)
      END IF
      VRT = VRT - 0.75
      IF (IPR(633) .EQ. 0) THEN
        WRITE (LINE, 99995, IOSTAT = IOST) THOR(1:8), FCKM
        CALL GGIP09 (0.0, LINE(1:21), 21, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, 99995, IOSTAT = IOST) TVER(1:8), FOKM
        CALL GGIP09 (0.0, LINE(1:21), 21, 0.35, 1, 1, VERT + 0.2, VRT)
      ELSE IF (IPR(633) .EQ. 1) THEN
        WRITE (LINE, 99994, IOSTAT = IOST) THOR(1:12), LOG10(FCKM)
        CALL GGIP09 (0.0, LINE(1:21), 21, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, 99994, IOSTAT = IOST) TVER(1:12), LOG10(FOKM)
        CALL GGIP09 (0.0, LINE(1:21), 21, 0.35, 1, 1, VERT + 0.2, VRT)
      END IF
      VRT = VRT - 0.75
      IF (MODE .EQ. 0) THEN
        N = 16
        DO I = 1, 6
          CELLA(I) = PAR(100 + I)
        END DO
        CELLA(7) = PAR(98)
        NREF1    = NREF
        SCAL     = 1.0
      ELSE
        N = 24
      END IF
      WRITE (LINE, '(''N(refl) '',   2I8)', IOSTAT = IOST) NREF1, NREF2
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''N(plot) '',   I8)', IOSTAT = IOST) NREF
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''Scale'', 12X, F8.4)', IOSTAT = IOST) SCAL
      CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 1.00
      WRITE (LINE, '(''NP-Plot-CC'', 7X, F8.4)', IOSTAT = IOST) YCC
      IF (MODE .NE. 0) WRITE (6, 99998, IOSTAT = IOST) LINE(1:75)
      CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''NP-Plot-INTERCEPT'', F8.4)', IOSTAT = IOST) YINT
      IF (MODE .NE. 0) WRITE (6, 99998, IOSTAT = IOST) LINE(1:75)
      CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, 99993, IOSTAT = IOST) YSLOPE
      IF (MODE .NE. 0) WRITE (6, 99998) LINE(1:75)
      CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 1.00
      WRITE (LINE, '(''A       '', 2F8.4)', IOSTAT = IOST)
     1   CELLA(1), CELLB(1)
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''B       '', 2F8.4)', IOSTAT = IOST)
     1  CELLA(2), CELLB(2)
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''C       '', 2F8.4)', IOSTAT = IOST)
     1  CELLA(3), CELLB(3)
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''Alpha   '', 2F8.2)', IOSTAT = IOST)
     1  CELLA(4), CELLB(4)
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''Beta    '', 2F8.2)', IOSTAT = IOST)
     1  CELLA(5), CELLB(5)
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''Gamma   '', 2F8.2)', IOSTAT = IOST)
     1  CELLA(6), CELLB(6)
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      VRT = VRT - 0.75
      WRITE (LINE, '(''Volume  '', 2F8.1)', IOSTAT = IOST)
     1  CELLA(7), CELLB(7)
      CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
      IF (MODE .EQ. 0) THEN
        VRT = VRT - 1.00
        WRITE (LINE, '(''R1  (CIF)'', F7.4)', IOSTAT = IOST) PAR(173)
        CALL GGIP09 (0.0, LINE(1:26), 16, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''wR2 (CIF)'', F7.4)', IOSTAT = IOST) PAR(174)
        CALL GGIP09 (0.0, LINE(1:26), 16, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''S   (CIF)'', F7.4)', IOSTAT = IOST) PAR(299)
        CALL GGIP09 (0.0, LINE(1:26), 16, 0.35, 1, 1, VERT + 0.2, VRT)
        IF (PAR(197) .GE. 0.0) THEN
          VRT = VRT - 0.75
          WRITE (LINE, '(''R(int)   '', F7.4)', IOSTAT = IOST) PAR(197)
          CALL GGIP09 (0.0, LINE(1:16), 16, 0.35, 1, 1, VERT + 0.2, VRT)
        END IF
      ELSE
        VRT = VRT - 0.75
        WRITE (LINE, '(''SPGR1   '', A)', IOSTAT = IOST) SPGRA
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''SPGR2   '', A)', IOSTAT = IOST) SPGRB
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 1.00
        WRITE (LINE, '(''R_A     '', 2F8.4)', IOSTAT = IOST)
     1    RCELLA(1), RCELLB(1)
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''R_B     '', 2F8.4)', IOSTAT = IOST)
     1    RCELLA(2), RCELLB(2)
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''R_C     '', 2F8.4)', IOSTAT = IOST)
     1    RCELLA(3), RCELLB(3)
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''R_Alpha '', 2F8.2)', IOSTAT = IOST)
     1    RCELLA(4), RCELLB(4)
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''R_Beta  '', 2F8.2)', IOSTAT = IOST)
     1    RCELLA(5), RCELLB(5)
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''R_Gamma '', 2F8.2)', IOSTAT = IOST)
     1    RCELLA(6), RCELLB(6)
        CALL GGIP09 (0.0, LINE(1:N), N, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 1.0
        WRITE (LINE, '(''('', 3F7.3, '')'')', IOSTAT = IOST)
     1    (TRNSA(1, J), J = 1, 3)
        CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''('', 3F7.3, '') A'')', IOSTAT = IOST)
     1    (TRNSA(2, J), J = 1, 3)
        CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''('', 3F7.3, '')'')', IOSTAT = IOST)
     1    (TRNSA(3, J), J = 1, 3)
        CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 1.0
        WRITE (LINE, '(''('', 3F7.3, '')'')', IOSTAT = IOST)
     1    (TRNSB(1, J), J = 1, 3)
        CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''('', 3F7.3, '') B'')', IOSTAT = IOST)
     1    (TRNSB(2, J), J = 1, 3)
        CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
        VRT = VRT - 0.75
        WRITE (LINE, '(''('', 3F7.3, '')'')', IOSTAT = IOST)
     1    (TRNSB(3, J), J = 1, 3)
        CALL GGIP09 (0.0, LINE(1:25), 25, 0.35, 1, 1, VERT + 0.2, VRT)
      END IF
      CALL GGIP (0.0, 0.0, 0.0, -1)
      RETURN
99999 FORMAT (/, ':: Space Groups Differ: ', A, ' & ', A, /)
99998 FORMAT (':: ', A)
99996 FORMAT (I8)
99995 FORMAT (A, '-Max', 3X, F10.2)
99994 FORMAT (A, '-Max', F8.4)
99993 FORMAT ('NP-Plot-SLOPE', 4X, F8.4)
      END SUBROUTINE PLA119
      SUBROUTINE PLA120 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,
     3 NP47=9,NP52=200,NP56=30,NP57=35,NP60=100,NVD=100000000,NREC=12,
     4 NFPK=100000)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /PL122/ NF, NF0, BIJVOETMAX, FODIFMAX, NPLS, NMIN, SUM,
     1 IPR615, IPR616, PAR435, PAR436, NFR, RCO, NFH
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /NPPLOT/ YCC, YINT, YSLOPE
      CHARACTER FORMA*48, FORMB*48
      INTEGER HMAX
      COMMON /PL120/ XPLLL, XMNLL, XPLL2, XTWLL, XSMLL, DPDATM, DPVALUE,
     1 XG, XG0, XG1, XG2, DDIF
      DOUBLE PRECISION XPLLL, XMNLL, XPLL2, XTWLL, XSMLL,
     1 DPDATM, DPVALUE, XG, XG0, XG1, XG2, DDIF
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IBPR
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: DPDAT
      ISTATUS = 0
      ALLOCATE (IBPR(3, NFPK), DPDAT(410), STAT = ISTATUS)
      IF (ISTATUS .NE. 0) STOP 'Memory Allocate Problem in PLA120'
      FORMA = '(//,''Hooft y Parameter Value .'',F9.3,''('',I2,'')'')'
      FORMB = '(/,''Flack Parameter Value ....'',F8.3,''('',I2,'')'')'
C * Analysis of Bijvoet (Friedel) Pair Differences
C * NO BIJVOET ANALYSIS FOR NEUTRON DATA
      IF (IPR(493) .GT. 5) THEN
        WRITE (LU6, 99976, IOSTAT = IOST)
C * NO ANALYSIS FOR CENTROSYMMETRIC STRUCTURE
      ELSE IF (IPR(275) .EQ. 2) THEN
        IF (MODE .EQ. -2 .AND. IPR(594) .EQ. 1)
     1    WRITE (LU6, 99999, IOSTAT = IOST)
C * NO ANALYSIS FOR TOO MANY REFLECTIONS
      ELSE IF (NREF .GT. NFPK) THEN
        WRITE (LU6, 99990, IOSTAT = IOST) NFPK
      ELSE
        IPR(634) = 1
        IPR(636) = 1
   10   ICALT = 11 - IPR(594) * 6
        IF (MODE .EQ. -2) THEN
          LU = LU13
        ELSE
          LU = LU6
        END IF
        PAR(510) = 999999.0
        PAR(512) = 0.0
        NADR     = NREF * NREC
        MPH   = 2 * HMAX + 1
        MPK   = 2 * KMAX + 1
        MPL   = 2 * LMAX + 1
        MHK   = MPH * MPK
        MHKL  = MPL * MHK
        MHKLH = (MHKL - 1) / 2
        IADR  = NVD - MHKLH
        IADR1 = NVD - MHKL
        CALL GEN074 (VOID, IADR1 + 1, NVD, 0.0)
        DO I = 1, NREF
          J = (I - 1) * NREC
          DO K = 1, 3
            XJS(K) = VOID(J + K)
          END DO
          DO NS = 1, NSYMH
            CALL SGSM (LINE, NS, XJS, LU6, 5, IER)
            K  = NINT(XJS(9)) * MHK + NINT(XJS(8)) * MPH + NINT(XJS(7))
            VOID (IADR + K) = I
          END DO
        END DO
        BIJVOETMAX = 0.0
        PARSONSMAX = 0.0
        DO I = 1, NREF
          J  = (I - 1) * NREC
          IH = NINT(VOID(J + 1))
          IK = NINT(VOID(J + 2))
          IL = NINT(VOID(J + 3))
          K  = IL * MHK + IK * MPH + IH
          N  = NINT(VOID(IADR - K))
          IF (N .GT. I) THEN
            M    = (N - 1) * NREC
            BDIF = ABS(VOID(J + ICALT) - VOID(M + ICALT))
            BSUM = VOID(J + ICALT) + VOID(M + ICALT)
            BIJVOETMAX = MAX(BDIF, BIJVOETMAX)
            IF (BSUM .NE. 0.0) THEN
              PARSONSMAX = MAX(BDIF / BSUM, PARSONSMAX)
            END IF
          END IF
        END DO
        NOUTLIST = 0
   20   NF0  = 0
        NFP  = 0
        NF   = 0
        NFR  = 0
        NFH  = 0
        NPLS = 0
        NMIN = 0
        STEP = 0.025
        NSP1 = NINT (1.0 / STEP)
        NSTP = 10 * NSP1 + 1
        NSPT = 5  * NSP1 + 1
        NSPM = NSPT - NSP1
        NSPP = NSPT + NSP1
        DO I = 1, 410
          DPDAT(I) = 0.0D+0
        END DO
        CALL PLA262 (0)
        IF (IPR(611) .EQ. 0) THEN
          FODIFMAX = 99999.99
        ELSE
          FODIFMAX = IPR(611) * BIJVOETMAX
        END IF
        IF (IPR(613) .EQ. 1) THEN
          XNU = PAR(487)
        ELSE
          XNU = -1.0
        END IF
        NROUTL  = 0
        RASN    = 0.0
        RASD    = 0.0
        RDFN    = 0.0
        RDFD    = 0.0
        CHIT    = 0.0
        CHIN    = 0.0
        NCHI    = 0
        PSUMW   = 0.0
        PSUMWXY = 0.0
        PSUMWX  = 0.0
        PSUMWY  = 0.0
        PSUMWXK = 0.0
        DO I = 1, NREF
          IMM   = (I - 1) * NREC
          IH    = NINT(VOID(IMM + 1))
          IK    = NINT(VOID(IMM + 2))
          IL    = NINT(VOID(IMM + 3))
          FOK1  = VOID(IMM + 4)
          FCK1  = VOID(IMM + ICALT)
          SIG1  = VOID(IMM + 6)
          TH    = VOID(IMM + 7)
          IHKLP = IL * MHK + IK * MPH + IH
          N = NINT(VOID(IADR - IHKLP))
          IF (N .GT. I) THEN
            ICENTRO = 0
            IF (NSYMH .GT. 1) THEN
              DO J = 1, 3
                XJS(J) = - VOID(IMM + J)
              END DO
              DO NS = 2, NSYMH
                CALL SGSM (LINE, NS, XJS, LU6, 5, IER)
                JHKLP =
     1            NINT(XJS(9)) * MHK + NINT(XJS(8)) * MPH + NINT(XJS(7))
                IF (IHKLP .EQ. JHKLP) ICENTRO = 1
              END DO
            END IF
            IF (ICENTRO .EQ. 0) THEN
              NF0 = NF0 + 1
              IF (NF0 .EQ. 1) THEN
                IF (IPR(594) .EQ. 1) THEN
                  WRITE (LU, 99975, IOSTAT = IOST)
                  WRITE (LU, 99989, IOSTAT = IOST) 'CIF'
                ELSE
                  WRITE (LU, 99989, IOSTAT = IOST) 'FCF'
                END IF
              END IF
              M     = (N - 1) * NREC
              FOK2  = VOID(M + 4)
              FCK2  = VOID(M + ICALT)
              SIG2  = VOID(M + 6)
              FOKD  = FOK1 - FOK2
              FCKD  = FCK1 - FCK2
              FOKS  = FOK1 + FOK2
              FCKS  = FCK1 + FCK2
              SIG1K = SIG1**2
              SIG2K = SIG2**2
              SIGM  = SQRT(SIG1K + SIG2K)
              RDFN  = RDFN + ABS (FOKD - FCKD)
              RDFD  = RDFD + ABS (FOKD)
              RASN  = RASN + ABS (FOKS - FCKS)
              RASD  = RASD + ABS (FOKS)
              CHIT  = CHIT + ABS (FOKD) ** 2
              CHIN  = CHIN + ABS (FOKS) / 2.0
              NCHI  = NCHI + 1
C * COLLECT DATA FOR PARSONS Z
              IF (FOKS .NE. 0.0 .AND. FCKS .NE. 0.0) THEN
                IF (FOK1 .GT. 3.0 * SIG1 .AND. FOK2 .GT. 3.0 * SIG2)
     1            THEN
                  NFP     = NFP     + 1
                  FOKP    = FOKD / FOKS
                  FCKP    = FCKD / FCKS
                  WP      = 1.0 / ((2.0 * FOK2 * SIG1 / FOKS**2)**2 +
     1                             (2.0 * FOK1 * SIG2 / FOKS**2)**2)
                  PSUMW   = PSUMW   + WP
                  PSUMWX  = PSUMWX  + WP * FCKP
                  PSUMWY  = PSUMWY  + WP * FOKP
                  PSUMWXY = PSUMWXY + WP * FOKP * FCKP
                  PSUMWXK = PSUMWXK + WP * FCKP**2
                END IF
              END IF
              IF (ABS(FOKD) .GT. FODIFMAX) THEN
                IF (NOUTLIST .EQ. 0) THEN
                  NROUTL = NROUTL + 1
                  IF (NROUTL .EQ. 1) THEN
                    WRITE (LU, 99992, IOSTAT = IOST) FODIFMAX
                    IF (MODE .EQ. -1) THEN
                      WRITE (LU7, 99992, IOSTAT = IOST) FODIFMAX
                      CALL PLA262 (5)
                    END IF
                  END IF
                  IF (NROUTL .LT. 51) THEN
                    WRITE (LU, 99979, IOSTAT = IOST)
     1                NROUTL, IH, IK, IL, FOKD, FCKD, SIGM
                    IF (MODE .EQ. -1) THEN
                      WRITE (LU7, 99979, IOSTAT = IOST)
     1                  NROUTL, IH, IK, IL, FOKD, FCKD, SIGM
                      CALL PLA262 (1)
                    END IF
                  ELSE IF (NROUTL .EQ. 51) THEN
                    WRITE (LU, 99977, IOSTAT = IOST)
                    IF (MODE .EQ. -1) THEN
                      WRITE (LU7, 99977, IOSTAT = IOST)
                      CALL PLA262 (3)
                    END IF
                  END IF
                END IF
                ICRIT1 = 0
              ELSE
                ICRIT1 = 1
                IF (ABS(FCK1 - FCK2) .GT. PAR(452) * SIGM) THEN
                  IF (NF .LT. NP23) THEN
                    NF          = NF + 1
                    SIGM        = MAX (SIGM, 0.01)
                    IBPR(1, NF) = 100000000
     1                          - NINT(100.0 * ABS(FCK1 - FCK2) / SIGM)
                    IBPR(2, NF) = I
                    IBPR(3, NF) = N
                  END IF
                END IF
              END IF
              IF (TH .GE. PAR(509)) THEN
                PAR(510) = MIN (TH, PAR(510))
                PAR(512) = MAX (TH, PAR(512))
                NFH      = NFH + 1
                DO J = 1, NSTP
                  YK = (J - NSPT) * STEP
                  DIFFS = ((YK * FCKD - FOKD) / SIGM)**2
                  IF (XNU .LT. 0.0) THEN
                    IF (ICRIT1 .EQ. 0) THEN
                      DPVALUE = 0.0D+0
                    ELSE
                      DPVALUE = - DBLE(DIFFS / 2.0)
                    END IF
                  ELSE
                    DPVALUE = - DLOG (DBLE(1.0 + DIFFS / XNU))
     1                        * DBLE(((XNU + 1.0) / 2.0))
                  END IF
                  DPDAT(J) = DPDAT(J) + DPVALUE
                END DO
              END IF
            ENDIF
          END IF
        END DO
        IF (IPR(594) .EQ. 1 .OR. IABS(IGBL(8)) .EQ. 2) THEN
          IF (NFP .GT. 0) THEN
            PTOP     = PSUMW * PSUMWXY - PSUMWX * PSUMWY
            PBOT     = PSUMW * PSUMWXK - PSUMWX**2
            PAR(503) = (1.0 - (PTOP / PBOT)) / 2.0
            PAR(504) = SQRT(PSUMW / PBOT) * 0.5
            CALL GEN041 (PAR(503), PAR(504), IPR(669), 3, IPR(670),
     1                   IPR(68))
          END IF
          IPR(667) = NFP
        END IF
        IPR(668) = NF0
        IF (NCHI .GT. 0 .AND. CHIN .GT. 0.0) THEN
          PAR(491) = 10000.0 * SQRT (CHIT / NCHI) / (CHIN / NCHI)
        END IF
        IF (NF .LT. 3) THEN
          IF (PAR(452) .GT. 0.0) THEN
            PAR(452) = 0.0
            NOUTLIST = 1
            GO TO 20
          END IF
        END IF
        SUM    = 0.0
        SUMW   = 0.0
        XMAX   = 0.0
        YMAX   = 0.0
        THMX   = 0.0
        XMXP   = 0.0
        XMXP   = 0.0
        YMXP   = 0.0
        YMXP   = 0.0
        RCT    = 0.0
        RCN    = 0.0
        FCKSLM = 0.0
        DDP    = -999999.0
        DDM    =  999999.0
        IF (NF .GT. 0 .AND. RDFD .NE. 0.0 .AND. RASD .NE. 0) THEN
          PAR(489) = RASN / RASD
          PAR(490) = RDFN / RDFD
          IGBL(6) = 29
          CALL GEN147 (IBPR, 3, 1, NF)
          DO N = 1, NF
            I    = IBPR(2, N)
            J    = IBPR(3, N)
            IMM  = (I - 1) * NREC
            JMM  = (J - 1) * NREC
            IH1  = NINT(VOID(IMM + 1))
            IK1  = NINT(VOID(IMM + 2))
            IL1  = NINT(VOID(IMM + 3))
            FOK1 = VOID(IMM + 4)
            FCK1 = VOID(IMM + ICALT)
            SIG1 = VOID(IMM + 6)
            TH   = VOID(IMM + 7)
            IH2  = NINT(VOID(JMM + 1))
            IK2  = NINT(VOID(JMM + 2))
            IL2  = NINT(VOID(JMM + 3))
            FOK2 = VOID(JMM + 4)
            FCK2 = VOID(JMM + ICALT)
            SIG2 = VOID(JMM + 6)
            FOKD = FOK1 - FOK2
            FCKD = FCK1 - FCK2
            FOKS = FOK1 + FOK2
            FCKS = FCK1 + FCK2
            SIGM = SIG1**2 + SIG2**2
            RCT  = RCT + FOKD * FCKD / SIGM
            RCN  = RCN + FCKD**2 / SIGM
            SIGM = SQRT(SIGM)
            IF (FOKD * FCKD .GT. 0.0) THEN
              NPLS = NPLS + 1
            ELSE
              NMIN = NMIN + 1
            END IF
            IF (ABS(FOKD) .LT. 3.0 * ABS(FCKD)) THEN
              XMAX   = MAX (XMAX, ABS(FCKD))
              YMAX   = MAX (YMAX, ABS(FOKD))
              THMX   = MAX (THMX, TH)
              FCKSLM = MAX (FCKSLM, LOG(FCKS))
              IF (FCKS .NE. 0.0) THEN
                XMXP = MAX (XMXP, ABS(FCKD / FCKS))
              END IF
              IF (FOKS .NE. 0.0) THEN
                YMXP = MAX (YMXP, ABS(FOKD / FOKS))
              END IF
            END IF
            IF (FCKD .NE. 0.0) THEN
              RATIO  = FOKD / FCKD
              RATIO1 = ABS(FCKD) / FCKS
              DCDOS  = (FCKD - FOKD) / SIGM
              DDP    = MAX (DDP, DCDOS)
              DDM    = MIN (DDM, DCDOS)
              IF (SIGM .GT. 0.0) THEN
                WGHT = ABS(FCKD) / SIGM
                SUM  = SUM  + WGHT * RATIO
                SUMW = SUMW + WGHT
              END IF
              IF (RATIO .LT. -99.99) THEN
                RATIO = -99.99
              ELSE IF (RATIO .GT. 999.99) THEN
                RATIO = 999.99
              END IF
            END IF
            IF (N .EQ. 1 .AND. MODE .EQ. -1) THEN
              WRITE (LU7, 99997, IOSTAT = IOST) PAR(452)
              CALL PLA262 (5)
            END IF
            IF (N .LE. IPR(596)) THEN
              IF (N .EQ. 1) THEN
                IF (PAR(433) .NE. 999999.0 .AND. PAR(434) .NE. 999999.0)
     1            THEN
                  IF (IPR(280) .GT. 0) THEN
                    FORMB(36:36) = CHAR (ICHAR('0') + IPR(280))
                    WRITE (LU, FORMB, IOSTAT = IOST) PAR(433), IPR(279)
                  ELSE
                    WRITE (LU, 99994, IOSTAT = IOST) PAR(433), PAR(434)
                  END IF
                END IF
                WRITE (LU, 99983, IOSTAT = IOST) NF0, IPR(560)
                IF (IPR(560) .GT. 0) THEN
                  PAR(464) = NF0 * 100.0 / IPR(560)
                  WRITE (LU, 99984, IOSTAT = IOST) NINT(PAR(464))
C * ALERT _915 - CHECK FOR LOW FRIEDEL PAIR COVERAGE
                  IF (IPR(594) .EQ. 1 .AND. IPR(619) .EQ. 0) THEN
                    CALL PLA231 (915, 2, 100.0 - PAR(464),
     1                                   PAR(464), ' ', ' ')
                  END IF
                END IF
                IF (PAR(425) .GT. 0.0) THEN
                  WRITE (LU, 99986, IOSTAT = IOST)
     1              PAR(425), NINT(PAR(474) * 10000.0)
                END IF
                WRITE (LU, 99993, IOSTAT = IOST)
              END IF
              IF (FOK1 .GT. 99999.9 .OR. FOK2 .GT. 99999.9  .OR.
     1            SIGM .GT. 999.9) THEN
                WRITE (LU, 99982, IOSTAT = IOST)
     1            IH1, IK1, IL1, NINT(FOK1), IH2, IK2, IL2, NINT(FOK2),
     2          NINT(FOKD), NINT(FCKD), NINT(SIGM), WGHT, RATIO, RATIO1
              ELSE
                WRITE (LU, 99995, IOSTAT = IOST)
     1            IH1, IK1, IL1, FOK1, IH2, IK2, IL2,
     2            FOK2,  FOKD, FCKD, SIGM, WGHT, RATIO, RATIO1
              END IF
            END IF
            IF (MODE .EQ. -1) THEN
              CALL PLA262 (1)
              WRITE (LU7, 99998, IOSTAT = IOST)
     1          IH1, IK1, IL1, FOK1, FCK1, SIG1, IH2, IK2, IL2, FOK2,
     2          FCK2, SIG2, FOKD, FCKD, SIGM, WGHT, RATIO, DCDOS, RATIO1
            END IF
          END DO
          SUM = SUM / SUMW
          IF (IPR(593) .NE. 0) THEN
            DO J = 1, NSTP
              DPDAT(J) = DPDAT(J) / DBLE(YSLOPE)**2
            END DO
          END IF
          DPDATM = DPDAT(1)
          DO J = 2, NSTP
            IF (DPDAT(J) .GT. DPDATM) DPDATM = DPDAT(J)
          END DO
          XG0 = 0.0D+0
          XG1 = 0.0D+0
          XG2 = 0.0D+0
          DO J = 1, NSTP
            YK  = (J - NSPT) * STEP
            DDIF = DPDAT(J) - DPDATM
            IF (DDIF .GT. -500.0D+0) THEN
              XG1 = XG1 + DBLE(YK) * DEXP (DDIF)
              XG0 = XG0 +            DEXP (DDIF)
            END IF
          END DO
          XG  = XG1 / XG0
          DO J = 1, NSTP
            YK  = (J - NSPT) * STEP
            DDIF = DPDAT(J) - DPDATM
            IF (DDIF .GT. -500.0D+0) THEN
              XG2 = XG2 + (DBLE(YK) - DBLE(XG))**2 * DEXP (DDIF)
            END IF
          END DO
          PAR435 = (1.0 - SNGL(XG)) / 2.0
          PAR436 = SNGL(DSQRT (XG2 / XG0) / 2.0D+0)
          CALL GEN041 (PAR435, PAR436, IPR615, 3, IPR616, IPR(68))
          IF (IPR(594) .EQ. 1 .OR. IABS(IGBL(8)) .EQ. 2) THEN
            PAR(435) = PAR435
            PAR(436) = PAR436
            IPR(615) = IPR615
            IPR(616) = IPR616
          END IF
          IF (IPR(619) .EQ. 0 .AND. PAR(464) .GT. PAR(476)) THEN
            IF (IPR616 .GT. 0) THEN
              FORMA(36:36) = CHAR (ICHAR('0') + IPR616)
              WRITE (LU, FORMA, IOSTAT = IOST) PAR435, IPR615
            ELSE
              WRITE (LU, 99991, IOSTAT = IOST) PAR435, PAR436
            END IF
            IF (IPR(594) .EQ. 0) THEN
              IF (PAR(435) .GT. 5.0 * PAR(436)) THEN
                IF (PAR435 .GT. 5.0 * PAR436 .AND.
     1             ABS(PAR(435) - PAR435) .LE. 2.0 * PAR(436)) THEN
                  WRITE (LU, 99981, IOSTAT = IOST)
C * ALERT _917
                  CALL PLA231 (917, 2, -999.0, 0.0, ' ', ' ')
                ELSE
                  WRITE (LU, 99985, IOSTAT = IOST)
                  WRITE (LU, 99980, IOSTAT = IOST)
                END IF
              END IF
            END IF
            IF (PAR(433) .LT. 999999.0) THEN
              YUNK = ABS(PAR(433) - PAR(435))
C * ALERT _916
              IF (IPR(594) .EQ. 1 .AND. YUNK .GT. 0.10) THEN
                CALL PLA231 (916, 2, -999.0, YUNK, ' ', ' ')
              END IF
            END IF
          ELSE
            WRITE (LU, 99978, IOSTAT = IOST)
          END IF
          XPLLL = DPDAT(NSPP) - DPDATM
          XMNLL = DPDAT(NSPM) - DPDATM
          IF (XPLLL .GT. -500.0D+0) THEN
            XPLLL = DEXP(XPLLL)
          ELSE
            XPLLL = 0.0D+0
          END IF
          IF (XMNLL .GT. -500.0D+0) THEN
            XMNLL = DEXP(XMNLL)
          ELSE
            XMNLL = 0.0D+0
          END IF
          IF (XPLLL .GT. 1.0D-99) THEN
            XPLL2 = 1.0D+0 / (1.0D+0 + XMNLL / XPLLL)
          ELSE
            XPLL2 = -1.0D+0
          END IF
          IF (IPR(594) .EQ. 1) THEN
            IF (XPLL2 .GT. -1.0D+0) THEN
              PAR(506) = SNGL (MAX(1.0D-35, XPLL2))
            ELSE
              PAR(506) = -1.0
            END IF
          END IF
          XTWLL = DPDAT(NSPT) - DPDATM
          IF (XTWLL .GT. -500.0D+0) THEN
            XTWLL = DEXP(XTWLL)
          ELSE
            XTWLL = 0.0D+0
          END IF
          XSMLL = XPLLL + XTWLL + XMNLL
          IF (XSMLL .GT. 1.0D-99) THEN
            XPLLL = XPLLL / XSMLL
            XMNLL = XMNLL / XSMLL
            XTWLL = XTWLL / XSMLL
          ELSE
            XPLLL = -1.0D+0
            XTWLL = -1.0D+0
            XSMLL = -1.0D+0
          END IF
          IF (IPR(594) .EQ. 1) THEN
            IF (XPLLL .GT. -1.0D+0) THEN
              PAR(507) = SNGL (MAX(1.0D-35, XPLLL))
            ELSE
              PAR(507) = -1.0
            END IF
            IF (XTWLL .GT. -1.0D+0) THEN
              PAR(508) = SNGL (MAX(1.0D-35, XTWLL))
            ELSE
              PAR(508) = -1.0
            END IF
          END IF
          IF (ABS(ABS(PAR435 - 0.5) - 0.5) .GT.
     1      MAX (0.1, 3 * PAR436) .AND. XTWLL .GT. 0.1D+0)
     2           XPLL2 = -1.0D+0
          IF (RCN .NE. 0) THEN
            RCO = RCT / RCN
          ELSE
            RCO = 0.0
          END IF
          IF (MODE .EQ. -1) THEN
            WRITE (LU6, 99996, IOSTAT = IOST) SUM, NF, NF0, DDM, DDP
            CALL PLA262 (3)
            WRITE (LU7, 99996, IOSTAT = IOST) SUM, NF, NF0, DDM, DDP
          END IF
        ELSE
          IF (IPR(594) .EQ. 1) THEN
            CALL PLA015 (0, 58)
            WRITE (LU, 99988, IOSTAT = IOST)
C * ALERT _914
            IF (PAR(433) .LT. 99999.0)
     1        CALL PLA231 (914, 0, 1.0, 1.0, ' ', ' ')
          ELSE
            WRITE (LU, 99987, IOSTAT = IOST)
          END IF
          DEALLOCATE (IBPR, DPDAT)
          RETURN
        END IF
        CALL PLA123 (MODE, NREF, IADR, NADR, ICALT)
        IF (IPR(617) .EQ. 2) GO TO 20
C * SCATTER PLOT DISPLAY
        IF (NF .GT. 0 .AND. MODE .EQ. -1) THEN
   30     IF (IPR(666) .EQ. 0) THEN
           IF (XMAX .NE. 0.0 .AND. YMAX .NE. 0.0)
     1      CALL PLA121 (ICALT, NF, IBPR, RCO, XMAX, YMAX, THMX, FCKSLM)
          ELSE
           IF (XMXP .NE. 0.0 .AND. YMXP .NE. 0.0)
     1      CALL PLA121 (ICALT, NF, IBPR, RCO, XMXP, YMXP, THMX, FCKSLM)
          END IF
   40     IF (IGBL(3) .NE. 46) THEN
            CALL PLA013 (0, 1)
            CALL GEN072 (IGGT, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7,
     1                   NP17)
            SELECT CASE (IFL(1)(1:6))
              CASE ('END   ', 'EXIT  ')
                DEALLOCATE (IBPR, DPDAT)
                RETURN
              CASE ('SELECT')
                GO TO 20
              CASE ('NUVAL ', 'NUVALU')
                IPR(617) = 0
                IF (KN .GT. 0) PAR(488) = FN(1)
                GO TO 20
              CASE ('SIGMA ')
                GO TO 20
              CASE ('SLOPE ')
                GO TO 20
              CASE ('FROM  ')
                GO TO 10
              CASE ('WGHT  ')
                IPR(621) = 0
                GO TO 20
              CASE ('SWITCH')
                IPR(617) = 1
                GO TO 20
              CASE ('NPP   ')
                CALL PLA204
                IF (IPR(621) .EQ. 0) IPR(621) = 1
                GO TO 40
              CASE ('SET   ')
                IF (IFL(2)(1:3) .EQ. 'IPR') THEN
                  IPR(656) = NINT(FN(2))
                  CALL GGIP (0.0, 0.0, 0.0, -1)
                  GO TO 30
                END IF
              CASE DEFAULT
                IPR(656) = 0
                GO TO 30
            END SELECT
          END IF
        END IF
      END IF
      DEALLOCATE (IBPR, DPDAT)
      RETURN
99999 FORMAT (/, ':: No Bijvoet Pair Analysis for Centrosymmetric',
     1        ' Structure')
99998 FORMAT (2(3I3, 2F10.2, F8.2), 2F8.2, F9.2, 2F8.2, F8.3, F9.5)
99997 FORMAT ('Analyses of Bijvoet-Pair (Friedel-Pair) Differences',
     1        ' for abs(Fcalcl**2 - Fcalc2**2))/Sigma .GT. ', F6.2, /,
     2        101('='), 24X, '|I+-I-|', /, 125X, 7('-'), /,
     3        ' H1 K1 L1    FO1**2    FC1**2  SIGMA1',
     4        ' H2 K2 L2    FO2**2    FC2**2  SIGMA2  DELOBS ',
     5        'DELCALC SIG(DEL) DLC/SIG DLO/DLC DC-DO/S  I+ + I-', /,
     6        132('='))
99996 FORMAT (/, 'Average Weighted Ratio =', F6.2, ' for', I5,
     1        ' Bijvoet Pairs (out of', I7, ')', /,
     2        ' MIN, MAX = ', 2F8.3, /)
99995 FORMAT (2(3I3, F8.1, 1X), 2F8.1, F7.2, 2F6.2, F8.5)
99994 FORMAT (/, 'Flack Parameter Value ....', F8.3, '(', F6.3, ')')
99993 FORMAT (/, 62X, 'DLC   DLO |I+-I-|', /, 41X, 'DEL', 5X,
     1        'DEL    SIG   ---   --- -------', /,
     2        ' H1 K1 L1 I1(obs)  H2 K2 L2 I2(obs)      OBS',
     3        '    CALC    DEL   SIG   DLC I+ + I-', /, 79('='))
99992 FORMAT (/, 'Excluded Outliers with Observed Bijvoet Difference',
     1        ' .GT.', F10.2, /, 79('='), /,
     2        'Nr     H    K    L      FOKD      FCKD      SIGD',
     3        /, 79('='))
99991 FORMAT (//, 'Hooft y Parameter Value .', F9.5, '(', F7.5, ')')
99990 FORMAT (':: No Bijvoet Pair Analyses: More than', I6,
     1        'Reflections (use Merged Data)')
99989 FORMAT (79('='), /, 'Bijvoet Pair Analysis - F(calc) from ',
     1        A, /, 79('='))
99988 FORMAT (/, ':: No Bijvoet Pairs Found', /)
99987 FORMAT (/, ':: No Bijvoet Pairs with Significant Fcalc ',
     1 'Differences in FCF Found', /)
99986 FORMAT ('Res.Scat..................', F8.4, /,
     1        'Friedif ..................', I8)
99985 FORMAT (/, '*** Warning *** :', /,
     1           'This y value is invalid when an FCF',
     2        ' based on a BASF/TWIN Refinement is used.')
99984 FORMAT ('Friedel Pair Coverage ....', I8, '%')
99983 FORMAT ('Number of Bijvoet Pairs ..', I8, '[', I6, ']')
99982 FORMAT (2(3I3, I8, 1X), 2I8, I7, 2F6.2, F8.5)
99981 FORMAT (/, 'Note: The supplied FCF is likely NOT based on a',
     1           ' TWIN/BASF Refinement')
99980 FORMAT (/, 'Note: The Supplied FCF is likely based on a',
     1           ' TWIN/BASF Refinement')
99979 FORMAT (I3, 3I5, 3F10.2)
99978 FORMAT (/, 'Low Friedel Pair Coverage: No Hooft y Parameter',
     1           ' Reported in Validation', /)
99977 FORMAT (/, 20X, 'etc.', /)
99976 FORMAT (/, 'No BIJVOET/HOOFT Analysis for Neutron data')
99975 FORMAT ('Section 9')
      END SUBROUTINE PLA120
      SUBROUTINE PLA121 (ICALT, NF, IBPR, RCO, XMAX, YMAX, THMX, FCKSLM)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP23=28000,NP38=150,NP39=30,NP52=200,NP56=30,
     2 NP57=35,NVD=100000000,NREC=12)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER CDUM*(NP52)
      DIMENSION IBPR(3, *)
      CHARACTER FORM*10
C * SCATTER PLOT
      IF (IPR(656) .EQ. 0) THEN
        SCLX = 0.90 * VERT / (2.0 * XMAX)
        SCLY = 0.90 * VERT / (2.0 * YMAX)
        XOR  = VERT / 2.0
        YOR  = VERT / 2.0
      ELSE IF (ABS(IPR(656)) .EQ. 1) THEN
        SCLX = 0.90 * VERT / THMX
        SCLY = 0.90 * VERT / (2.0 * MAX(XMAX, YMAX))
        XOR  = 0.05 * VERT
        YOR  = VERT / 2.0
      ELSE IF (ABS(IPR(656)) .EQ. 2) THEN
        SCLX = 0.90 * VERT / FCKSLM
        SCLY = 0.90 * VERT / (2.0 * MAX(XMAX, YMAX))
        XOR  = 0.05 * VERT
        YOR  = VERT / 2.0
      END IF
      IF (IGBL(3) .EQ. 46) CALL GGIP (-999.0, 0.0, 0.0, -2)
      CALL GGIP (HORS, VERT, 0.0, 1)
      CALL PLA110 (VERT, VERT, -1)
      CALL PLA262 (0)
      IF (IPR(656) .EQ. 0) THEN
        IF (IPR(666) .EQ. 0) THEN
          LINE = 'BIJVOET-PAIR BIJVOET-DIFFERENCE SCATTER PLOT'
        ELSE
          LINE = 'BIJVOET-PAIR PARSONS-DIFFERENCE SCATTER PLOT'
        END IF
      ELSE IF (IPR(656) .EQ. 1) THEN
        LINE = 'BIJVOET-PAIR DIFFERENCE VERSUS THETA SCATTER PLOT'
      ELSE IF (IPR(656) .EQ. -1) THEN
        LINE = 'BIJVOET-PAIR DIF-DIF/SIG VERSUS THETA SCATTER PLOT'
      ELSE IF (IPR(656) .EQ. 2) THEN
        LINE = 'BIJVOET-PAIR DIFFERENCE VERSUS LOG(FC2) SCATTER PLOT'
      ELSE IF (IPR(656) .EQ. -2) THEN
        LINE = 'BIJVOET-PAIR DIF-DIF/SIG VERSUS LOG(FC2) SCATTER PLOT'
      END IF
      VRT = VERT - 0.6
      CALL GGIP09 (0.0, LINE, 53, 0.35, 5 + IGBL(68), 2, 2.6, VRT)
      IF (IPR(656) .NE. 0) THEN
        VRT = VRT - 0.5
        LINE = 'RED = Difference Signs Disagree'
        CALL GGIP09 (0.0, LINE, 31, 0.30, 1, 2, 1.1, VRT)
        VRT = VRT - 0.5
        LINE = 'OBS = Marked'
        CALL GGIP09 (0.0, LINE, 12, 0.30, 1, 2, 1.1, VRT)
      END IF
      IF (IPR(656) .EQ. 0) THEN
        IF (IPR(594) .EQ. 0) THEN
          LINE = 'Fcalc from Fcalc Data in FCF'
        ELSE
          LINE = 'Fcalc from Model Data in '//DTYPE(IABS(IGBL(8)))
        END IF
        VRT = VRT - 0.6
        CALL GGIP09 (0.0, LINE, 29, 0.25, 5 + IGBL(68), 2, 1.0, VRT)
        CALL PLA283 (2, IPR(260), N, CDUM)
        JUNK = NP52 - N + 1
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, CDUM(N:NP52), JUNK, 0.25,
     1          5 + IGBL(68), 2, 1.0, VRT)
        CALL GEN146 (FORM, PAR(503), IPR(669), IPR(670))
        WRITE (LINE, 99993, IOSTAT = IOST) FORM, IPR(667)
        IF (IOST .EQ. -999) RETURN
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, LINE, 37, 0.25, 5 + IGBL(68), 2, 1.0, VRT)
        WRITE (LINE, 99996, IOSTAT = IOST) NINT (PAR(425) * 10000.0)
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, LINE, 30, 0.25, 5 + IGBL(68), 2, 1.0, VRT)
        IF (PAR(434) .LT. 999999.0) THEN
          FRIEDIF = PAR(474) * 10000.0
          IF (FRIEDIF .GT. 10.0) THEN
            WRITE (LINE, 99997, IOSTAT = IOST)
     1        NINT (FRIEDIF), NINT (PAR(491))
          ELSE
            WRITE (LINE, 99992, IOSTAT = IOST)
     1        FRIEDIF, NINT (PAR(491))
          END IF
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 34, 0.25, 5 + IGBL(68), 2, 1.0, VRT)
          WRITE (LINE, 99994, IOSTAT = IOST)
     1      PAR(474) * PAR(434) * 10000.0
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 26, 0.25, 5 + IGBL(68), 2, 1.0, VRT)
        ENDIF
        WRITE (LINE, 99995, IOSTAT = IOST) PAR(489), PAR(490)
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, LINE, 22, 0.25, 5 + IGBL(68), 2, 1.0, VRT)
        IF (IPR(593) .NE. 0) THEN
            VRT = VRT - 0.5
          CALL GGIP09 (0.0, 'Probability Plot Slope Applied', 30, 0.25,
     1                       5 + IGBL(68), 2, 1.0, VRT)
        END IF
        IF (IPR(666) .EQ. 0) THEN
          LINE = '      Diff(Fobs**2)'
        ELSE
          LINE = 'Dif(Iobs)/Sum(Iobs)'
        END IF
        CALL GGIP09 (90.0, LINE, 19, 0.30, 1, 2, 0.6, VERT - 5.0)
        IF (IPR(666) .EQ. 0) THEN
          LINE = '     Diff(Fcalc**2)'
        ELSE
          LINE = 'Dif(Ical)/Sum(Ical)'
        END IF
        CALL GGIP09 (0.0, LINE, 19, 0.30, 1, 2, VERT - 5.0, 0.2)
      END IF
      CALL PLA122
      CALL GGIP (XOR, YOR, 0.0, -3)
      CALL GGIP (0.0, FLOAT(5 + IGBL(68)), 0.0, 0)
      IF (IPR(656) .EQ. 0) THEN
        DX = 0.45 * VERT
        CALL GGIP (0.0, - DX, 0.0, 3)
        CALL GGIP (0.0, + DX, 0.0, 2)
        CALL GGIP (- DX, 0.0, 0.0, 3)
        CALL GGIP (DX,   0.0, 0.0, 2)
        CALL GGIP (0.0,  0.0, 0.0, 3)
        DY = XMAX * RCO / YMAX
        IF (DY .LT. 1.0) THEN
          DX0 = - DX
          DY0 = - DX * DY
        ELSE
          DX0 = - DX / DY
          DY0 = - DX
        END IF
        CALL GGIP (0.0, 3.0, 0.0, 0)
        CALL GGIP (DX0, DY0, 0.0, 2)
        CALL GGIP (0.0,  0.0, 0.0, 3)
        WRITE (LINE, 99999, IOSTAT = IOST) XMAX
        CALL GGIP09 (90.0, LINE, 9, 0.3, 1, 2, DX + 0.4, -1.2)
        WRITE (LINE, 99999, IOSTAT = IOST) YMAX
        CALL GGIP09 (0.0, LINE, 9, 0.3, 1, 2, -2.8, DX - 0.3)
      ELSE IF (ABS(IPR(656)) .EQ. 1 .OR. ABS(IPR(656)) .EQ. 2) THEN
        DX = 0.90 * VERT
        DY = 0.45 * VERT
        CALL GGIP (0.0, 0.0, 0.0, 3)
        CALL GGIP (DX , 0.0, 0.0, 2)
        CALL GGIP (0.0, DY , 0.0, 3)
        CALL GGIP (0.0, -DY, 0.0, 2)
        CALL GGIP (0.0, 0.0, 0.0, 3)
      END IF
      DSH  = 0.05
      DSH1 = 0.075
      DO N = 1, NF
        I     = IBPR(2, N)
        J     = IBPR(3, N)
        IMM   = (I - 1) * NREC
        JMM   = (J - 1) * NREC
        FOK1  = VOID(IMM + 4)
        FCK1  = VOID(IMM + ICALT)
        SIG1  = VOID(IMM + 6)
        TH    = VOID(IMM + 7)
        FOK2  = VOID(JMM + 4)
        FCK2  = VOID(JMM + ICALT)
        SIG2  = VOID(JMM + 6)
        FOKDF = FOK1 - FOK2
        FCKDF = FCK1 - FCK2
        FOKSM = FOK1 + FOK2
        FCKSM = FCK1 + FCK2
        IF (IPR(656) .EQ. 0) THEN
          IF (IPR(666) .EQ. 0) THEN
            FOKD = SCLY * FOKDF
            FCKD = SCLX * FCKDF
            SIG  = SCLY * SQRT(SIG1**2 + SIG2**2)
          ELSE
            IF (FOK1 + FOK2 .NE. 0.0) THEN
              FOKD = SCLY * FOKDF / FOKSM
              FCKD = SCLX * FCKDF / FCKSM
              SIG  = SCLY * SQRT((2.0 * FOK2 * SIG1 / FOKSM**2)**2 +
     1                           (2.0 * FOK1 * SIG2 / FOKSM**2)**2)
            END IF
          END IF
        ELSE IF (ABS(IPR(656)) .EQ. 1) THEN
          FOKD = SCLY * FOKDF
          FCKD = SCLY * FCKDF
          XHOR = SCLX * TH
          SIG  = SCLY * SQRT(SIG1**2 + SIG2**2)
        ELSE IF (ABS(IPR(656)) .EQ. 2) THEN
          FOKD = SCLY * FOKDF
          FCKD = SCLY * FCKDF
          XHOR = SCLX * LOG(FCKSM)
          SIG  = SCLY * SQRT(SIG1**2 + SIG2**2)
        END IF
        IF (IPR(656) .EQ. 0) THEN
          IF (ABS(FOKD) .LE. 0.45 * VERT) THEN
            DO M = 1, 3, 2
              IF (FOKD * FCKD .GE. 0.0) THEN
                COLR = 1.0
              ELSE
                COLR = 2.0
              END IF
              CALL GGIP (0.0, COLR, 0.0, 0)
              X = (M - 2) * FCKD
              Y = (M - 2) * FOKD
              CALL GGIP (X,       Y + DSH, 0.0, 3)
              CALL GGIP (X + DSH, Y,       0.0, 2)
              CALL GGIP (X,       Y - DSH, 0.0, 2)
              CALL GGIP (X - DSH, Y,       0.0, 2)
              CALL GGIP (X,       Y + DSH, 0.0, 2)
              IF (X .GT. 0.0) THEN
                IF (IPR(634) .EQ. 1) THEN
                  YPSIG = MIN( 0.45 * VERT, Y + SIG)
                  YMSIG = MAX(-0.45 * VERT, Y - SIG)
                  CALL GGIP (X, YPSIG, 0.0, 3)
                  CALL GGIP (X, YMSIG, 0.0, 2)
                END IF
                IF (IPR(636) .EQ. 1) THEN
                  IF (X .GT. DX / 2.0 .OR. Y .LT. -DX / 2.0) THEN
                    IH = NINT(VOID(IMM + 1))
                    IK = NINT(VOID(IMM + 2))
                    IL = NINT(VOID(IMM + 3))
                    WRITE (LINE, 99998, IOSTAT = IOST) IH, IK, IL
                    IF (MOD(N, 2) .EQ. 1) THEN
                      ADD =  0.1
                    ELSE
                      ADD = -1.1
                    END IF
                    CALL GGIP09 (-45.0, LINE, 9, 0.16, 5 + IGBL(68),
     1                                 1, X + ADD , Y - ADD)
                  END IF
                END IF
              END IF
            END DO
          END IF
        ELSE IF (ABS(IPR(656)) .EQ. 1 .OR. ABS(IPR(656)) .EQ. 2) THEN
          IF (FCKD * FOKD .GT. 0.0) THEN
            COLR = 3.0
          ELSE
            COLR = 2.0
          END IF
          IF (IPR(656) .LT. 0) THEN
            Y = FCKD + (FOKD - FCKD) / SIG
          ELSE
            Y = FOKD
          END IF
          CALL GGIP (0.0, COLR, 0.0, 0)
          CALL GGIP (XHOR,        FCKD,     0.0, 3)
          CALL GGIP (XHOR,        Y,        0.0, 2)
          CALL GGIP (XHOR,        Y + DSH1, 0.0, 3)
          CALL GGIP (XHOR + DSH1, Y,        0.0, 2)
          CALL GGIP (XHOR,        Y - DSH1, 0.0, 2)
          CALL GGIP (XHOR - DSH1, Y,        0.0, 2)
          CALL GGIP (XHOR,        Y + DSH1, 0.0, 2)
        END IF
      END DO
      RETURN
99999 FORMAT (F9.2)
99998 FORMAT (3I3)
99997 FORMAT ('Friedif   =', I6, ' stat [', I5, ' obs]')
99996 FORMAT ('Res.Scat. =', I6, ' * 0.0001')
99995 FORMAT ('RA =', F6.3, ', RD =', F6.3)
99994 FORMAT ('Friedif * Flack(su) =', F5.1)
99993 FORMAT ('Parsons z =', A, ',', I5, ' Pairs')
99992 FORMAT ('Friedif   =', F6.1, ' stat [', I5, ' obs]')
      END SUBROUTINE PLA121
      SUBROUTINE PLA122
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /PL120/ XPLLL, XMNLL, XPLL2, XTWLL, XSMLL, DPDATM, DPVALUE,
     1 XG, XG0, XG1, XG2, DDIF
      DOUBLE PRECISION XPLLL, XMNLL, XPLL2, XTWLL, XSMLL,
     1 DPDATM, DPVALUE, XG, XG0, XG1, XG2, DDIF
      COMMON /PL122/ NF, NF0, BIJVOETMAX, FODIFMAX, NPLS, NMIN, SUM,
     1 IPR615, IPR616, PAR435, PAR436, NFR, RCO, NFH
      COMMON /NPPLOT/ YCC, YINT, YSLOPE
      CHARACTER FORM*10
      VRT = VERT - 0.5
      NB = 1
      NE = 7
      CALL GEN039 (1, SPGRNM(1)(1:7), 1, 7, NB, NE)
      LINE = 'Space Group'
      WRITE (LINE(22-NE:), 99984, IOSTAT = IOST) SPGRNM(1)(1:7)
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99993, IOSTAT = IOST) PAR(17)
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      IF (PAR(433) .LT. 999999.0) THEN
        CALL GEN146 (FORM, PAR(433), IPR(279), IPR(280))
        WRITE (LINE, 99992, IOSTAT = IOST) FORM
        WRITE (LU6,  99968, IOSTAT = IOST) LINE
        WRITE (LU7,  99968, IOSTAT = IOST) LINE
        CALL GGIP09 (0.0, LINE, 22, 0.335, 1, 2, VERT + 0.2, VRT)
      END IF
      VRT = VRT - 0.6
      IF (PAR(434) .LT. 999999.0) THEN
        CALL GEN146 (FORM, PAR(503), IPR(669), IPR(670))
        WRITE (LINE, 99980, IOSTAT = IOST) FORM
        WRITE (LU6,  99968, IOSTAT = IOST) LINE
        WRITE (LU7,  99968, IOSTAT = IOST) LINE
        CALL GGIP09 (0.0, LINE, 22, 0.335, 1, 2, VERT + 0.2, VRT)
      END IF
      VRT = VRT - 0.8
      WRITE (LU6,  99967, IOSTAT = IOST)
      WRITE (LU7,  99967, IOSTAT = IOST)
      WRITE (LINE, 99990, IOSTAT = IOST) NF0
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      CALL GGIP09 (0.0, LINE, 14, 0.35, 5 + IGBL(68), 2,
     1                  VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99959, IOSTAT = IOST) NINT(PAR(464))
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99994, IOSTAT = IOST) BIJVOETMAX
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99983, IOSTAT = IOST) FODIFMAX
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.8
      WRITE (LINE, 99969, IOSTAT = IOST)
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 12, 0.35, 5 + IGBL(68), 2,
     1                  VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99987, IOSTAT = IOST) PAR(452)
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99989, IOSTAT = IOST) NF
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99986, IOSTAT = IOST) NPLS
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99985, IOSTAT = IOST) NMIN
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99970, IOSTAT = IOST) RCO
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.8
      WRITE (LU6,  99967, IOSTAT = IOST)
      WRITE (LU7,  99967, IOSTAT = IOST)
      IF (IPR(613) .EQ. 0) THEN
        WRITE (LINE, 99966, IOSTAT = IOST)
      ELSE
        WRITE (LINE, 99999, IOSTAT = IOST)
      END IF
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 5 + IGBL(68), 2,
     1           VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99981, IOSTAT = IOST) NFR
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99965, IOSTAT = IOST) YCC
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      IF (YCC .LT. 0.9) THEN
        WRITE (LINE, 99995, IOSTAT = IOST) YCC
        CALL GGIP09 (0.0, LINE, 21, 0.35, 2, 2, VERT + 0.2, VRT)
      END IF
      VRT = VRT - 0.6
      WRITE (LINE, 99964, IOSTAT = IOST) YINT
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99963, IOSTAT = IOST) YSLOPE
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.8
      WRITE (LU6,  99967, IOSTAT = IOST)
      WRITE (LU7,  99967, IOSTAT = IOST)
      WRITE (LINE, 99974, IOSTAT = IOST)
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 5 + IGBL(68), 2,
     1                  VERT + 0.2, VRT)
      VRT = VRT - 0.6
      IF (IPR(613) .GT. 0) THEN
        WRITE (LINE, 99982, IOSTAT = IOST) NINT(PAR(487))
      ELSE
        WRITE (LINE, 99988, IOSTAT = IOST)
      END IF
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99973, IOSTAT = IOST) NFH
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99956, IOSTAT = IOST) MAX(PAR(509), PAR(510))
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99955, IOSTAT = IOST) MAX(PAR(509), PAR(512))
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      IF (XPLL2 .GT. 0.001D+0) THEN
        WRITE (FORM, 99961, IOSTAT = IOST) XPLL2
      ELSE IF (XPLL2 .LT. 0.0D+0) THEN
        WRITE (FORM, 99957, IOSTAT = IOST)
        CALL GGIP09 (0.0, 'Not Enantiopure', 15, 0.35, 1, 2,
     1                   VERT - 4.6, VRT)
      ELSE
        WRITE (FORM, 99962, IOSTAT = IOST) XPLL2
      END IF
      WRITE (LINE, 99958, IOSTAT = IOST) FORM
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      IF (XPLLL .GT. 0.001D+0) THEN
        WRITE (FORM, 99961, IOSTAT = IOST) XPLLL
      ELSE IF (XPLLL .LT. 0.0D+0) THEN
        WRITE (FORM, 99957, IOSTAT = IOST)
      ELSE
        WRITE (FORM, 99962, IOSTAT = IOST) XPLLL
      END IF
      WRITE (LINE, 99979, IOSTAT = IOST) FORM
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      IF (XTWLL .GT. 0.001D+0) THEN
        WRITE (FORM, 99961, IOSTAT = IOST) XTWLL
      ELSE IF (XTWLL .LT. 0.0D+0) THEN
        WRITE (FORM, 99957, IOSTAT = IOST)
      ELSE
        WRITE (FORM, 99962, IOSTAT = IOST) XTWLL
      END IF
      WRITE (LINE, 99977, IOSTAT = IOST) FORM
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      IF (XMNLL .GT. 0.001D+0) THEN
        WRITE (FORM, 99961, IOSTAT = IOST) XMNLL
      ELSE IF (XMNLL .LT. 0.0D+0 .OR. XPLLL .LT. 0.0D+0) THEN
        WRITE (FORM, 99957, IOSTAT = IOST)
      ELSE
        WRITE (FORM, 99962, IOSTAT = IOST) XMNLL
      END IF
      WRITE (LINE, 99978, IOSTAT = IOST) FORM
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      WRITE (LINE, 99972, IOSTAT = IOST) XG
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      YUNK = SNGL(DSQRT (XG2 / XG0))
      IF (YUNK .GT. 0.0001) THEN
        WRITE (FORM, 99960, IOSTAT = IOST) YUNK
      ELSE
        WRITE (FORM, 99962, IOSTAT = IOST) YUNK
      END IF
      WRITE (LINE, 99971, IOSTAT = IOST) FORM
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 21, 0.35, 1, 2, VERT + 0.2, VRT)
      VRT = VRT - 0.6
      CALL GEN146 (FORM, PAR435, IPR615, IPR616)
      WRITE (LINE, 99976, IOSTAT = IOST) FORM
      WRITE (LU6,  99968, IOSTAT = IOST) LINE
      WRITE (LU7,  99968, IOSTAT = IOST) LINE
      CALL GGIP09 (0.0, LINE, 22, 0.35, 1, 2, VERT + 0.2, VRT)
      IF (PAR(435) . LT. 999999.0) THEN
        IF (ABS (PAR(435) - PAR435) .GT. 2.0 * PAR(436)) THEN
          LINE (1:12) = ' '
          CALL GGIP09 (0.0, LINE, 21, 0.35, 2, 2, VERT + 0.2, VRT)
        END IF
      END IF
      VRT = VRT - 0.6
      RETURN
99999 FORMAT ('Student-T Prob. Plot')
99995 FORMAT ('            ', F9.3)
99994 FORMAT ('DiffCalcMax.', F9.2)
99993 FORMAT ('Wavelength ', F10.5)
99992 FORMAT ('Flack x ....', A)
99990 FORMAT ('Bijvoet Pairs', I8)
99989 FORMAT ('Select Pairs', I9)
99988 FORMAT ('Distribution Gaussian')
99987 FORMAT ('Sigma Crit..', F9.2)
99986 FORMAT ('Number Plus ', I9)
99985 FORMAT ('Number Minus', I9)
99984 FORMAT (A)
99983 FORMAT ('Outlier Crit', F9.2)
99982 FORMAT ('Student_T Nu', I9)
99981 FORMAT ('Sample Size.', I9)
99980 FORMAT ('Parsons z ..', A)
99979 FORMAT ('P3(true)....', A)
99978 FORMAT ('P3(false) ..', A)
99977 FORMAT ('P3(rac-twin)', A)
99976 FORMAT ('Hooft y ...', A)
99974 FORMAT ('Bayesian Statistics')
99973 FORMAT ('Select Pairs', I9)
99972 FORMAT ('G ..........', F9.4)
99971 FORMAT ('G (su) .....', A)
99970 FORMAT ('Slope ......', F9.3)
99969 FORMAT ('Scatter Plot')
99968 FORMAT (A)
99967 FORMAT (/)
99966 FORMAT ('Normal Prob. Plot')
99965 FORMAT ('Corr. Coeff.', F9.3)
99964 FORMAT ('Intercept ..', F9.3)
99963 FORMAT ('Slope ......', F9.3)
99962 FORMAT (E9.1)
99961 FORMAT (F9.3)
99960 FORMAT (F9.4)
99959 FORMAT ('Coverage ...', I9)
99958 FORMAT ('P2(true)....', A)
99957 FORMAT (6X, 'n/a')
99956 FORMAT ('Theta_Min ..', F9.2)
99955 FORMAT ('Theta_Max ..', F9.2)
      END SUBROUTINE PLA122
      SUBROUTINE PLA123 (MODE, NREF, IADR, NADR, ICALT)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP23=28000,NP38=150,NP39=30,
     1 NP60=100,NVD=100000000,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PL120/ XPLLL, XMNLL, XPLL2, XTWLL, XSMLL, DPDATM, DPVALUE,
     1 XG, XG0, XG1, XG2, DDIF
      DOUBLE PRECISION XPLLL, XMNLL, XPLL2, XTWLL, XSMLL,
     1 DPDATM, DPVALUE, XG, XG0, XG1, XG2, DDIF
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /CGRAPH/ GRAPH(44)
      CHARACTER GRAPH*125
      COMMON /PL122/ NF, NF0, BIJVOETMAX, FODIFMAX, NPLS, NMIN, SUM,
     1 IPR615, IPR616, PAR435, PAR436, NFR, RCO, NFH
      DIMENSION XJS(12)
      CHARACTER LINE*80
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CALL GEN074 (XJS, 1, 12, 0.0)
        IER = 0
        NFR = 0
        IF (PAR(497) * IPR(629) .GT. 0.0) THEN
          IADD = 12
        ELSE
          IADD = 6
        END IF
        DO I = 1, NREF
          IMM   = (I - 1) * NREC
          IH    = NINT(VOID(IMM + 1))
          IK    = NINT(VOID(IMM + 2))
          IL    = NINT(VOID(IMM + 3))
          FOK1  = VOID(IMM + 4)
          FCK1  = VOID(IMM + ICALT)
          SIG1K = VOID(IMM + IADD)**2
          IHKLP = IL * MHK + IK * MPH + IH
          N = NINT(VOID(IADR - IHKLP))
          IF (N .GT. I) THEN
            ICENTRO = 0
            IF (NSYMH .GT. 1) THEN
              DO J = 1, 3
                XJS(J) = - VOID(IMM + J)
              END DO
              DO NS = 2, NSYMH
                CALL SGSM (LINE, NS, XJS, LU6, 5, IER)
                JHKLP =
     1            NINT(XJS(9)) * MHK + NINT(XJS(8)) * MPH + NINT(XJS(7))
                IF (IHKLP .EQ. JHKLP) ICENTRO = 1
              END DO
            END IF
            IF (ICENTRO .EQ. 0) THEN
              M     = (N - 1) * NREC
              FOK2  = VOID(M + 4)
              FCK2  = VOID(M + ICALT)
              SIG2K = VOID(M + IADD)**2
              FOKD  = FOK1 - FOK2
              FCKD  = FCK1 - FCK2
              SIGM = SQRT(SIG1K + SIG2K)
              IF (ABS(FOKD) .LE. FODIFMAX .OR. IPR(613) .EQ. 1) THEN
                NFR  = NFR + 1
                VOID (NADR + NFR) = (SNGL(XG) * FCKD - FOKD) / SIGM
              END IF
            END IF
          END IF
        END DO
        IF (IABS(IGBL(36)) .EQ. 1) THEN
          LUX = LU13
        ELSE
          LUX = LU7
        END IF
C * NORMAL OR STUDENT-T PROBABILITY PLOT
        IF (NFR .GT. 0 .AND. MODE .LT. 0) THEN
          IF (LUX .EQ. LU7) CALL PLA262 (0)
          IF (IPR(613) .EQ. 0) THEN
            IF (IPR(652) .EQ. 1) THEN
              OPEN (UNIT = 62, FILE = NAMEFIL(1:KNMFIL)//'.npp',
     1              STATUS = 'UNKNOWN')
            END IF
            CALL GEN116 (2, VOID(NADR + 1), VOID(NADR + NREF + 1), NFR,
     1                   GRAPH, 0)
          ELSE
            IF (IPR(652) .EQ. 1) THEN
              OPEN (UNIT = 62, FILE = NAMEFIL(1:KNMFIL)//'.tpp',
     1              STATUS = 'UNKNOWN')
            END IF
            PAR(487) = PAR(488)
            CALL GEN142 (VOID(NADR + 1), VOID(NADR + NREF + 1),
     1        PAR(487), NFR, GRAPH, 0)
            IPR(617) = IPR(617) + 1
            IF (IPR(617) .EQ. 2) THEN
              IPR(593) = 1
              RETURN
            END IF
          END IF
          IF (IPR(652) .EQ. 1) THEN
            DO I = 1, NFR
              WRITE (LU62, 99995, IOSTAT = IOST)
     1          VOID(NADR + I), VOID(NADR + NREF + I)
            END DO
            CLOSE (UNIT = 62)
          END IF
          GRAPH(5)(52:103) =
     1      'PP for (delta(G * Fcalc**2) - delta(Fobs**2))/Sigma'
          GRAPH(6)(52:98) =
     1      'Sigma = sqrt(sigma(Fobs1**2) + sigma(Fobs2**2))'
          IF (PAR(497) * IPR(629) .GT. 0.0)
     1       WRITE (GRAPH(7)(52:100), 99997, IOSTAT = IOST)
     2         PAR(497), PAR(498)
          IF (IPR(613) .EQ. 0) THEN
            WRITE (GRAPH(8)(52:), 99998, IOSTAT = IOST) XG
          ELSE
            WRITE (GRAPH(8)(52:), 99996, IOSTAT = IOST) XG, PAR(487)
          END IF
          WRITE (LUX, 99999, IOSTAT = IOST) (GRAPH(I), I = 1, 44)
          IF (LUX .EQ. LU7) CALL PLA262 (0)
        END IF
      RETURN
99999 FORMAT (A)
99998 FORMAT ('G =', F9.4)
99997 FORMAT ('Sigma Includes SHELXL WGHT Par.', 2F9.4)
99996 FORMAT ('G =', F9.4, ' - nu =', F6.2)
99995 FORMAT (2G12.5)
      END SUBROUTINE PLA123
      SUBROUTINE PLA124 (MODE, NREF)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,
     3 NP52=200,NP56=30,NP57=35,NVD=100000000,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
C * PLOT I/SIGMA(I) versus I etc.
      HORS = 25.0
      VERT = 25.0
      XOR  = 1.0
      YOR  = 1.0
      DSH  = 0.03
      CALL GGIP (HORS, VERT, 0.0, 1)
      CALL PLA110 (HORS, VERT, -1)
      CALL GGIP (0.0, 1.0, 0.0, 0)
      CALL PLA110 (HORS, VERT, -1)
      IF (MODE .EQ. 2) THEN
        LINE = 'I/SIGMA versus LOG10(I) PLOT - (Diederichs Plot)'
      ELSE IF (MODE .EQ. 3) THEN
        LINE = 'I/SIGMAW versus LOG10(I) PLOT - (Diederichs Plot)'
      ELSE IF (MODE .EQ. 4) THEN
        LINE = 'SIGMA versus LOG10(I) PLOT'
      ELSE IF (MODE .EQ. 5) THEN
        LINE = 'LOG10(SIGMA) versus LOG10(I) PLOT'
      ENDIF
      CALL GGIP09 (0.0, LINE, 49, 0.35, 5 + IGBL(68), 2, 4.5,
     1  VERT - 0.6)
      VRT = VERT - 0.2
      IF (PAR(497) .GE. 0.0) THEN
        WRITE (LINE, 99996, IOSTAT = IOST) PAR(497)
        IF (IOST .EQ. -999) RETURN
        VRT = VRT - 0.45
        CALL GGIP09 (0.0, LINE, 25, 0.35, 1, 1, HORS + 0.1, VRT)
      END IF
      IF (PAR(498) .GE. 0.0) THEN
        WRITE (LINE, 99995, IOSTAT = IOST) PAR(498)
        VRT = VRT - 0.45
        CALL GGIP09 (0.0, LINE, 25, 0.35, 1, 1, HORS + 0.1, VRT)
      END IF
      CALL GGIP (XOR, YOR, 0.0, -3)
      CALL GGIP (0.0, VERT - YOR, 0.0, 2)
      CALL GGIP (0.0, 0.0, 0.0, 3)
      CALL GGIP (HORS - XOR, 0.0, 0.0, 2)
      VRT = VERT - YOR - 1.5
      IF (MODE .NE. 4 .AND. MODE .NE. 5) THEN
        LINE = 'See K. Diederichs (2010). Acta Cryst., D66, 733-740'
        CALL GGIP09 (0.0, LINE, 51, 0.30, 1, 1, 0.75, VRT)
        VRT = VRT - 1.0
      END IF
      LINE = 'Data ............... '//FNLU16(1:KNM16)
      CALL GGIP09 (0.0, LINE, KNM16 + 21, 0.30, 1, 1, 0.75, VRT)
      VRT  = VRT - 0.5
      LINE = 'Device Type ........ '//CCIF(18)
      CALL GGIP09 (0.0, LINE, NCIF(18) + 21, 0.30, 1, 1, 0.75, VRT)
      VRT  = VRT - 0.5
      LINE = 'Data Collection .... '//CCIF(20)
      CALL GGIP09 (0.0, LINE, NCIF(20) + 21, 0.30, 1, 1, 0.75, VRT)
      VRT  = VRT - 0.5
      LINE = 'Data Reduction ..... '//CCIF(21)
      CALL GGIP09 (0.0, LINE, NCIF(21) + 21, 0.30, 1, 1, 0.75, VRT)
      VRT  = VRT - 0.5
      LINE = 'Absorb Details ..... '//CCIF(19)
      CALL GGIP09 (0.0, LINE, NCIF(19) + 21, 0.30, 1, 1, 0.75, VRT)
      VRT  = VRT - 0.5
      LINE = 'Structure Refinement '//CCIF(22)
      CALL GGIP09 (0.0, LINE, NCIF(22) + 21, 0.30, 1, 1, 0.75, VRT)
      IF (MODE .EQ. 4 .OR. MODE .EQ. 5) THEN
        VRT  = VRT - 1.0
        LINE = 'Yellow Dots      = Sigma(I)'
        CALL GGIP09 (0.0, LINE, 27, 0.30, 1, 1, 0.75, VRT)
        CALL GGIP09 (0.0, LINE, 11, 0.30, 5, 1, 0.75, VRT)
        VRT  = VRT - 0.5
        LINE = 'White/Black Dots = SigmaW(I)'
        CALL GGIP09 (0.0, LINE, 28, 0.30, 1, 1, 0.75, VRT)
      END IF
      NADR  = 0
      FOKM  = 0.0
      XIOSM = 0.0
      SIGMX = 0.0
      VRT   = VRT - 0.5
      N     = 0
      DO I = 1, NREF
        FOK = VOID (NADR + 4)
        SIG = 0.0
        IF (MODE .EQ. 2) THEN
          SIG = VOID (NADR + 6)
        ELSE IF (MODE .EQ. 3) THEN
          SIG = VOID (NADR + 12)
        ELSE IF (MODE .EQ. 4) THEN
          SIG = VOID (NADR + 12)
        ELSE IF (MODE .EQ. 5) THEN
          SIG = VOID (NADR + 12)
        END IF
        IF (SIG .GT. 0.0) THEN
          IF (MODE .EQ. 4) THEN
            SIGMX = MAX (SIGMX, SIG)
            FOKM  = MAX (FOKM, FOK)
          ELSE IF (MODE .EQ. 5) THEN
            SIGMX = MAX (SIGMX, SIG)
            FOKM  = MAX (FOKM, FOK)
          ELSE
            IF (FOK / SIG .LT. PAR(485)) THEN
              XIOSM = MAX (XIOSM, FOK / SIG)
              FOKM  = MAX (FOKM, FOK)
            ELSE
              N = N + 1
              IF (N .EQ. 1) THEN
                WRITE (LINE, 99994, IOSTAT = IOST)
                VRT = VRT - 0.32
                CALL GGIP09 (0.0, LINE, 37, 0.25, 5, 1, 0.75, VRT)
              END IF
              IF (N .LE. 50) THEN
                IF (N .EQ. 50) THEN
                  WRITE (LINE, 99997, IOSTAT = IOST)
                ELSE
                  IH = NINT(VOID (NADR + 1))
                  IK = NINT(VOID (NADR + 2))
                  IL = NINT(VOID (NADR + 3))
                  WRITE (LINE, 99998, IOSTAT = IOST)
     1              IH, IK, IL, FOK, SIG, FOK / SIG
                END IF
                VRT = VRT - 0.32
                CALL GGIP09 (0.0, LINE, 37, 0.25, 1, 1, 0.75, VRT)
              END IF
            END IF
          END IF
        END IF
        NADR = NADR + NREC
      END DO
      SCALHOR = (HORS - XOR) / (FLOAT(INT(LOG10(FOKM) + 1)))
      IF (MODE .NE. 4 .AND. MODE .NE. 5) THEN
        SCALVER = (VERT - YOR - 1.0) /
     1             MIN ((INT(XIOSM / 10.0) + 1) * 10.0, PAR(485))
      ELSE IF (MODE .EQ. 4) THEN
        SCALVER = 1.25 * (VERT - YOR - 1.0) / SIGMX
      ELSE IF (MODE .EQ. 5) THEN
        SCALVER = (VERT - YOR - 1.0) / (LOG10(SIGMX) + 1.0)
      END IF
      TICK = 0.0
      DO WHILE (TICK * SCALHOR .LT. HORS - XOR + 0.001)
        N    = 10 ** (NINT (TICK))
        X    = TICK * SCALHOR
        TICK = TICK + 1.0
        WRITE (LINE(1:8), 99999, IOSTAT = IOST) N
        CALL GGIP (X,  0.0, 0.0, 3)
        CALL GGIP (X, -0.3, 0.0, 2)
        CALL GGIP09 (0.0,  LINE, 8, 0.25, 1, 1, X - 1.8, -0.3)
      END DO
      IF (MODE .NE. 4) THEN
        TICK = 0.0
        DO WHILE ((TICK + 10.0) * SCALVER .LT. VERT - YOR)
          TICK = TICK + 10.0
          N    = NINT (TICK)
          X    = TICK * SCALVER
          WRITE (LINE(1:8), 99999, IOSTAT = IOST) N
          CALL GGIP (0.0, X, 0.0, 3)
          CALL GGIP (0.3, X, 0.0, 2)
          CALL GGIP09 (90.0,  LINE, 8, 0.25, 1, 1, 0.4, X - 1.8)
        END DO
      END IF
      PEN = FLOAT(5 + IGBL(68))
      NADR = 0
      DO I = 1, NREF
        FOK = VOID(NADR + 4)
        SIGA = VOID(NADR + 6)
        SIGB = VOID(NADR + 12)
        IF (MODE .EQ. 2) THEN
          SIG = SIGA
        ELSE IF (MODE .EQ. 3) THEN
          SIG = SIGB
        ELSE IF (MODE .EQ. 4) THEN
          SIG = SIGA
        END IF
        IF (FOK .GE. 1.0 .AND. SIG .GT. 0.0) THEN
          IF (MODE .NE. 4 .AND. MODE .NE. 5) THEN
            X = LOG10(FOK) * SCALHOR
            IF (X .GE. 0.0) THEN
              Y = FOK / SIG
              IF (Y .LT. PAR(485)) THEN
                Y = Y * SCALVER
                CALL GGIP (0.0, PEN, 0.0, 0)
                CALL GGIP (X,       Y + DSH, 0.0, 3)
                CALL GGIP (X + DSH, Y,       0.0, 2)
                CALL GGIP (X,       Y - DSH, 0.0, 2)
                CALL GGIP (X - DSH, Y,       0.0, 2)
                CALL GGIP (X,       Y + DSH, 0.0, 2)
              END IF
            END IF
          ELSE
            X = LOG10(FOK) * SCALHOR
            IF (X .GE. 0.0) THEN
              IF (MODE .EQ. 4) THEN
                YA = SIGA * SCALVER
                YB = SIGB * SCALVER
              ELSE
                YA = (LOG10(SIGA) + 1.0) * SCALVER
                YB = (LOG10(SIGB) + 1.0) * SCALVER
              ENDIF
              PEN = FLOAT(5 + IGBL(68))
              CALL GGIP (0.0, PEN, 0.0, 0)
              CALL GGIP (X,       YA + DSH, 0.0, 3)
              CALL GGIP (X + DSH, YA,       0.0, 2)
              CALL GGIP (X,       YA - DSH, 0.0, 2)
              CALL GGIP (X - DSH, YA,       0.0, 2)
              CALL GGIP (X,       YA + DSH, 0.0, 2)
              CALL GGIP (0.0, 1.0, 0.0, 0)
              CALL GGIP (X,       YB + DSH, 0.0, 3)
              CALL GGIP (X + DSH, YB,       0.0, 2)
              CALL GGIP (X,       YB - DSH, 0.0, 2)
              CALL GGIP (X - DSH, YB,       0.0, 2)
              CALL GGIP (X,       YB + DSH, 0.0, 2)
            END IF
          END IF
        END IF
        NADR = NADR + NREC
      END DO
      CALL GGIP (0.0, 0.0, 0.0, -1)
      RETURN
99999 FORMAT (I8)
99998 FORMAT (3I4, F9.1, 2F8.1)
99997 FORMAT (5X, '... etc ...')
99996 FORMAT ('SHELXL-weight-a', F10.3)
99995 FORMAT ('SHELXL-weight-b', F10.3)
99994 FORMAT ('   H   K   L     Iobs SigIobs  I/SigI')
      END SUBROUTINE PLA124
      SUBROUTINE PLA125
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2 * NP23), VOID(NVD)
      COMMON /VSCR/ NXYZ(3), NXYZ0(3), IGR(3), JGR(3), KGR(3), MGR(3),
     1              IJGR(3), OR11, OR12, OR13, OR22, OR23, OR33
      DIMENSION DUMW(3, 3), EW(3), NGPV(3), NGNX(3), NJG(4, 2),
     1 EV(3, 3), I123(4, 3)
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER FNLU15*80, PLPATH*255
      INTEGER FINDEXE
      LOGICAL OPEND
C * VOID/SOLV ROUTINE
C * IPR(189) = 1 - VOID SEARCH + PACKING INDEX
C * IPR(189) = 2 - SOLV(ent accessible void) SEARCH
      FNLU15 = NAMEFIL(1:KNMFIL)//'.sar'
      INQUIRE (FILE = FNLU15, OPENED = OPEND)
      IF (OPEND) THEN
        REWIND LU15
      ELSE
        OPEN (UNIT = LU15, FILE = FNLU15, STATUS = 'UNKNOWN',
     1    FORM = 'UNFORMATTED')
      END IF
      CALL GEN097 (I123, 1, 12, 0)
      NSYM       = IPR(48)
      IGBL(6)    = 24
      NGB        = 0
      NGE        = 0
      NADD       = 0
      CSLA       = 0.0
      I123(2, 1) = 1
      I123(3, 2) = 1
      I123(4, 3) = 1
      NGRTR      = ICHAR('>')
      NDOT       = ICHAR('.')
      OR11       = OR(1, 1)
      OR12       = OR(1, 2)
      OR13       = OR(1, 3)
      OR22       = OR(2, 2)
      OR23       = OR(2, 3)
      OR33       = OR(3, 3)
   10 ISAR       = IPR(39) + 1
      IF (ISAR .GE. NP1) THEN
        IF (IGBL(3) .NE. 1) IPR(2) = 25
        GO TO 120
      END IF
      IAT       = NP1
      LABA(IAT) = IPR(464)
      IPR(58)   = 0
      IPR(61)   = IPR(75) + 1
      IPR(98)   = 0
      IPR(104)  = IPR(61)
      IPR(119)  = 0
      IPR(188)  = 0
      IPR(190)  = 0
      IPR(198)  = 0
      IF (IPR(491) .EQ. 0) THEN
        IF (IGBL(3) .EQ. 0) THEN
          IPR(491) = 40000
        ELSE
          IPR(491) = 5000
        END IF
      END IF
      MAXSGRID = IPR(491) * NSYM
      IPR(199) = 0
      IF (IPR(214) .GT. 0) PAR(80)  = PAR(84) / IPR(214)
      PAR(19) = PAR(84)
      IF (IPR(189) .EQ. 1) THEN
        PAR(20) = PAR(19)
      ELSE
        PAR(20) = 0.0
      END IF
      IF (NINT(PAR(100 + IPR(187)) / PAR(80)) .GT. 130) THEN
        CALL GEN014 (IPR(186), IPR(187))
        IF (NINT(PAR(100 + IPR(187)) / PAR(80)) .GT. 130) THEN
          CALL GEN014 (IPR(185), IPR(187))
        END IF
      END IF
      DO K = 1, 3
        KK           = IPR(184 + K)
        NGRID        = NINT(PAR(100 + KK) / (PAR(80) * 12)) * 12
        PAR(80  + K) = 1.0 / NGRID
        IPR(193 + K) = NGRID
        MGR(K)       = IFIX(NGRID * PAR(84) * PAR(112 + KK)) + 1
      END DO
      DO K = 1, 3
        IPR(394 + IPR(184 + K)) = IPR(193 + K)
      END DO
      N1     = IPR(194)
      N2     = IPR(195)
      N3     = IPR(196)
      N23    = N2 * N3
      NTGRD  = N1 * N23
      KGR(1) = N23
      KGR(2) = N3
      KGR(3) = 1
      N      = N1 * N2 * N3
      WRITE (LU6, 99986, IOSTAT = IOST)
     1  PAR(80), NTGRD * 100.0 / NVD
      IF (NTGRD .GT. NVD) THEN
        IPR(214) = IPR(214) - 1
        IF (IPR(214) .GT. 0) THEN
          IF (PAR(84) / IPR(214) .LT. 0.41) THEN
            GO TO 10
          END IF
        END IF
C * ALERT _603
        IF (IGBL(3) .EQ. 1) THEN
          CALL PLA231 (603, 0, -999.0, 1.0, ' ', ' ')
        ELSE
          IPR(2) = 19
        END IF
        GO TO 120
      END IF
      WRITE (PRBUF, 99999, IOSTAT = IOST) PAR(80), PAR(84)
C * START GRAPHICS WINDOW FOR SOLV/VOID
      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IPR(121) .EQ. 0 .AND.
     1    IGBL(3) .NE. 5) THEN
        IWIN = 1
        CALL GGIP (HORS, VERT, 0.0, 1)
        VRT = VERT - 0.6
        CALL GGIP09 (0.0, PRBUF, 68, 0.4, 5 + IGBL(68), 2, 1.0, VRT)
        IF (IPR(483) .GT. 0 .AND. IPR(484) .EQ. 0) THEN
          WRITE (PRBUF, 99968, IOSTAT = IOST)
          WRITE (LU6, 99971, IOSTAT = IOST) PRBUF(1:80)
          CALL GGIP09 (0.0, PRBUF, 60, 0.5, 2, 2, 3.0, 1.0)
        END IF
        CALL GGIP09 (0.0, 'WorkinG', 7, 3.0, 2, 10, 5.0, 8.0)
        WRITE (PRBUF, 99990, IOSTAT = IOST) PAR(84), IPR(198)
        CALL GGIP09 (0.0, PRBUF, 68, 0.35, 1, 2, 0.5, 5.0)
        CALL GGIP09 (0.0, PRBUF(69:76), 8, 0.35, 1, 2, 21.0, 5.0)
        CALL GGIP (0.0, 0.0, 0.0, 6)
        VRT = VRT - 0.2
      END IF
      IF (IGBL(63) .GT. 2) THEN
        PAGET = 'VOIDS'
        CALL PLA262 (0)
        CALL PLA262 (14)
        IF (LMT(IENS(IAN), 1) .EQ. 'Cg') THEN
          IAN0 = IAN - 1
        ELSE
          IAN0 = IAN
        END IF
        WRITE (PRBUF, 99999, IOSTAT = IOST) PAR(80), PAR(84), IPR(214)
        WRITE (LU7, 99969, IOSTAT = IOST) PRBUF
        WRITE (LU6, 99959, IOSTAT = IOST)
        WRITE (LU6, 99975, IOSTAT = IOST) (LMT(IENS(I), 1), I = 1, IAN0)
        WRITE (LU7, 99975, IOSTAT = IOST) (LMT(IENS(I), 1), I = 1, IAN0)
        WRITE (LU6, 99974, IOSTAT = IOST)
     1    (RADR(IENS(I), 4), I = 1, IAN0)
        WRITE (LU7, 99974, IOSTAT = IOST)
     1    (RADR(IENS(I), 4), I = 1, IAN0)
        WRITE (LU7, 99989, IOSTAT = IOST)
     1    (CHAR(IPR(184 + K) + ICHAR('W')), PAR(80 + K), IPR(193 + K),
     2    PAR(100 + IPR(184 + K)) / IPR(193 + K), K = 1, 3)
        IF (IPR(197) .EQ. 1) THEN
          WRITE (LU7, 99997, IOSTAT = IOST)
          DO K = 1, IAN
            JX1 = IEL(IEN(K))
            J1  = JX1 / 100
            J2  = MOD(JX1, 100)
            NQ1(1 : 1) = CHAR(ICHAR('A') + J1 - 1)
            IF ( J2 .NE. 0) THEN
              NQ1(2 : 2) = CHAR(ICHAR('a') + J2 - 1)
            ELSE
              NQ1(2 : 2) = ' '
            END IF
            WRITE (LU7, 99996, IOSTAT = IOST) K, NQ1(1:2)
          END DO
        END IF
      END IF
      CALL GEN074 (VOID, 1, NTGRD, 0.0)
      NJG(1, 1) = - 1
      NJG(1, 2) = 25
      L         = 0
      DO
        L      =   L      + 1
        JGR(L) = - MGR(L) - 1
   20   JGR(L) =   JGR(L) + 1
        IF (JGR(L) .GT. MGR(L)) THEN
          L = L - 1
          IF (L .EQ. 0) THEN
            NJGR = NJG(1, 2)
            DO N = 2, 4
              NJG(N, 1) = NJG(N - 1, 2) - 1
              NJG(N, 2) = NJG(N - 1, 2) + 8
              DO 30 I = 1, NJGR
                I1 = JNSC(I * 3 - 2)
                I2 = JNSC(I * 3 - 1)
                I3 = JNSC(I * 3)
                IF (ABS(I1) .LT. 2 .AND. ABS(I2) .LT. 2 .AND.
     1              ABS(I3) .LT. 2) THEN
                  IF (JNSC(I * 3 - 4 + N) .EQ. 1) THEN
                    NJG(N, 1) = NJG(N, 1) + 1
                    INDX      = NJG(N, 1)
                  ELSE
                    GO TO 30
                  END IF
                ELSE
                  J3  = 0
                  I1N = I1 + I123(N, 1)
                  I2N = I2 + I123(N, 2)
                  I3N = I3 + I123(N, 3)
                  DO J = 1, NJGR
                    IF (ABS(JNSC(J3 + 1) - I1N) +
     1                  ABS(JNSC(J3 + 2) - I2N) +
     2                  ABS(JNSC(J3 + 3) - I3N) .EQ. 0) GO TO 30
                    J3 = J3 + 3
                  END DO
                  NJG(N, 2) = NJG(N, 2) + 1
                  INDX      = NJG(N, 2)
                END IF
                INDX3 = INDX * 3
                IF (INDX3 + 3 .GT. 2 * NP23) THEN
                  WRITE (LU6, 99979, IOSTAT = IOST)
                  GO TO 120
                END IF
                DO K = 1, 3
                  JNSC(INDX3 + K) = JNSC(I * 3 - 3 + K)
                END DO
   30         CONTINUE
            END DO
            GO TO 40
          END IF
          GO TO 20
        ELSE
          IF (L .GE. 3) THEN
            IF (ABS(JGR(1)) .LT. 2 .AND. ABS(JGR(2)) .LT. 2 .AND.
     1          ABS(JGR(3)) .LT. 2) THEN
              IF (ABS(JGR(1)) + ABS(JGR(2)) + ABS(JGR(3)) .EQ. 0)
     1          GO TO 20
              NJG(1, 1) = NJG(1, 1) + 1
              INDX  = NJG(1, 1)
            ELSE
              DO K = 1, 3
                V6(IPR(184 + K)) = PAR(80 + K) * JGR(K)
              END DO
              IF (SQRT(GEN006(V6, AA, V6)) .GT. PAR(84)) GO TO 20
              NJG(1, 2) = NJG(1, 2) + 1
              INDX      = NJG(1, 2)
            END IF
            INDX3 = INDX * 3
            IF (INDX3 + 3 .GT. 2 * NP23) THEN
              WRITE (LU6, 99979, IOSTAT = IOST)
              GO TO 120
            END IF
            DO K = 1, 3
              JNSC(INDX3 + K) = JGR(K)
            END DO
            GO TO 20
          END IF
        END IF
      END DO
   40 NHV    = 0
      IVOIDX = -1
      DO
        IVOIDX = IVOIDX + 1
        IF (IVOIDX .EQ. N1) THEN
          IF (IPR(189) .EQ. 1) THEN
            IF (IPR(43) .EQ. 0) THEN
              PERC = 100.0 * (1 - IPR(190) / FLOAT(NTGRD))
              WRITE (PRBUF, 99992, IOSTAT = IOST) IPR(198), PERC
            ELSE
              WRITE (PRBUF, 99976, IOSTAT = IOST)
            END IF
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 0.8
              CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
            END IF
            WRITE (LU6, 99993, IOSTAT = IOST) PRBUF(1:80)
            IF (IGBL(63) .GT. 1) THEN
              CALL PLA262 (5)
              WRITE (LU7, 99993, IOSTAT = IOST) PRBUF(1:80)
              WRITE (LU7, 99985, IOSTAT = IOST)
            END IF
          END IF
          NGPV(1)  = -1000
          NGPV(2)  = -1000
          NGPV(3)  = -1000
          ISLA     = ISAR
          IPR(530) = 0
          DO N = 1, NTGRD
            IF (NINT(VOID(N)) .EQ. NGRTR) THEN
              NGRD = N
              IF (IPR(189) .GT. 0) THEN
                NGB      = NTGRD
                NGE      = NTGRD
                ISLA     = ISLA + 1
                IPR(530) = IPR(530) + 1
                IF (ISLA .GT. NP1 - IPR(75)) THEN
                  IF (IGBL(3) .NE. 1) IPR(2) = 25
                  GO TO 120
                END IF
                IF (ISLA - ISAR .GT. 26) THEN
                  IF (ISLA - ISAR .GT. NP41) THEN
                    WRITE (LU6, '(''Too Many Voids'')', IOSTAT = IOST)
C * ALERT _604
                    CALL PLA231 (604, 2, -999.0, 1.0, ' ', ' ')
                    GO TO 120
                  END IF
                  CSLA = ICHAR('Z')
                ELSE
                  CSLA = ICHAR('A') + IPR(530) - 1
                END IF
                IATC(ISLA) = 0
                JATC(ISLA) = 0
                DO K = 1, 3
                  XXO(ISLA, K) = 0.0
                  NXYZ0(K)     = 0
                END DO
                DO K = 1, 9
                  SXYZ(K, IPR(530)) = 0.0
                END DO
                VOID(NGRD) = CSLA
              END IF
   50         NGRD0  = NGRD - 1
              IGR(1) = NGRD0 / N23
              IGR(3) = NGRD0 - IGR(1) * N23
              IGR(2) = IGR(3) / N3
              IGR(3) = IGR(3) - IGR(2) * N3
              CALL PLA126 (NXYZ0, IGR, 2)
              DO L = 1, 3
                NGNX(L) = NXYZ0(L) + IGR(L)
              END DO
              NJI = 1
              IF (NGPV(3) + 1 .EQ. NGNX(3)) THEN
                IF (NGPV(2) .EQ. NGNX(2)) THEN
                  IF (NGPV(1) .EQ. NGNX(1)) NJI = 4
                END IF
              ELSE IF (NGPV(2) + 1 .EQ. NGNX(2)) THEN
                IF (NGPV(1) .EQ. NGNX(1)) THEN
                  IF (NGPV(3) .EQ. NGNX(3)) NJI = 3
                END IF
              ELSE IF (NGPV(1) + 1 .EQ. NGNX(1)) THEN
                IF (NGPV(2) .EQ. NGNX(2)) THEN
                  IF (NGPV(3) .EQ. NGNX(3)) NJI = 2
                END IF
              END IF
              IF (NJI .EQ. 1) THEN
                NJ3    = - 3
                NJB    = 1
                NJE    = NJGR
              ELSE
                NJ3 = NJG(NJI - 1, 2) * 3 - 3
                NJB = NJG(NJI - 1, 2) + 1
                NJE = NJG(NJI    , 2)
              END IF
              DO L = 1, 3
                NGPV(L) = NGNX(L)
              END DO
              DO NJ = NJB, NJE
                NJ3 = NJ3 + 3
                M   = 1
                DO L = 1, 3
                  I193L   = IPR(193 + L)
                  NXYZ(L) = NXYZ0(L)
                  IJGRL   = IGR(L) + JNSC(NJ3 + L)
   60             IF (IJGRL .LT. 0) THEN
                    IJGRL   = IJGRL   + I193L
                    NXYZ(L) = NXYZ(L) - I193L
                    GO TO 60
                  ELSE
   70               IF (IJGRL .GE. I193L) THEN
                      IJGRL   = IJGRL   - I193L
                      NXYZ(L) = NXYZ(L) + I193L
                      GO TO 70
                    END IF
                  END IF
                  M       = M + IJGRL * KGR(L)
                  IJGR(L) = IJGRL
                END DO
                IVOIDM = NINT(VOID(M))
                IF (IVOIDM .LT. NGRTR) THEN
                  IF (IVOIDM .NE. NDOT) THEN
                    IF (IPR(189) .EQ. 1) THEN
                      VOID(M) = NDOT
                    ELSE
                      VOID(M) = CSLA
                    END IF
                    CALL PLA126 (NXYZ, IJGR, 1)
                  END IF
                ELSE IF (IVOIDM .EQ. NGRTR) THEN
                  IF (IPR(189) .GT. 0) THEN
                      IF (NGE + 2 .GT. NVD) THEN
                        IF (NGB .GT. NTGRD) THEN
                          I = NTGRD
                          J = NGB
                          DO WHILE (J .LT. NGE)
                            I           = I + 2
                            VOID(I - 1) = VOID(J + 1)
                            VOID(I)     = VOID(J + 2)
                            J           = J + 2
                          END DO
                          NGB = NTGRD
                          NGE = I
                        END IF
                        IPR(214) = IPR(214) - 1
                        GO TO 10
                      END IF
                      NGE = NGE + 2
                      NXYZP = 555
                      NXYZM = 100
                      DO I = 1, 3
                        NXYZP = NXYZP
     1                        + NXYZ(I) * NXYZM / IPR(193 + I)
                        NXYZM = NXYZM / 10
                      END DO
                      VOID(NGE - 1) = NXYZP
                      VOID(NGE)     = M
                      VOID(M)       = CSLA
                  END IF
                END IF
              END DO
              IF (IPR(189) .GT. 0) THEN
                IF (NGE .GT. NGB) THEN
                  NGB   = NGB + 2
                  NXYZP = NINT(VOID(NGB - 1))
                  NXYZM = 100
                  DO I = 1, 3
                    NXYZI    = NXYZP / NXYZM
                    NXYZ0(I) = (NXYZI - 5) * IPR(193 + I)
                    NXYZP    = NXYZP - NXYZI * NXYZM
                    NXYZM    = NXYZM / 10
                  END DO
                  NGRD = NINT(VOID(NGB))
                  GO TO 50
                END IF
              END IF
            END IF
          END DO
          J1 = 0
          DO WHILE (J1 .LT. IPR(194))
            IF (IPR(197) .EQ. 1 .AND. IGBL(63) .GT. 2) THEN
              CALL PLA262 (-2)
              WRITE (LU7, 99998, IOSTAT = IOST)
     1          CHAR(IPR(185) + ICHAR('W')), J1,
     2          IPR(194) - 1, CHAR(IPR(186) + ICHAR('W')),
     3          CHAR(IPR(187) + ICHAR('W'))
            END IF
            J2 = 0
            DO WHILE (J2 .LT. IPR(195))
              KK0 = J1 * N23 + J2 * N3
              KKM = KK0 + N3
              KK0 = KK0 + 1
              IF (IPR(197) .EQ. 1 .AND. IGBL(63) .GT. 2) THEN
                CALL PLA262 (1)
                WRITE (LU7, 99995, IOSTAT = IOST)
     1            (CHAR(NINT(VOID(KK))), KK = KK0, KKM)
              END IF
              J2 = J2 + 1
            END DO
            J1 = J1 + 1
          END DO
          PAR(79)  = PAR(98) / NTGRD
          PAR(150) = IPR(188) * PAR(79)
          IF (IWIN .EQ. 1) THEN
            WRITE (PRBUF, 99990, IOSTAT = IOST) PAR(84), IPR(198)
            CALL GGIP09 (0.0, PRBUF, 76, 0.35, 0, 2, 0.5, 5.0)
            CALL GGIP09 (0.0, PRBUF(69:76), 8, 0.35, 0, 2, 21.0, 5.0)
            CALL GGIP09 (0.0, 'WorkinG', 7, 3.0, 0, 10, 5.0, 8.0)
            CALL GGIP09 (0.0, 'Collect S.A.R.', 14, 0.35, 0, 2, 11.0,
     1                   3.0)
            IF (IPR(483) .GT. 0 .AND. IPR(484) .EQ. 0) THEN
              WRITE (PRBUF, 99968, IOSTAT = IOST)
              CALL GGIP09 (0.0, PRBUF, 60, 0.5, 0, 2, 3.0, 1.0)
            END IF
            CALL GGIP (0.0, 0.0, 0.0, 6)
          END IF
          IF (PAR(150) .GT. 0.0) THEN
            IF (IGBL(63) .GT. 1) THEN
              IF (IPR(197) .EQ. 1) CALL PLA262 (0)
              CALL PLA262 (3)
              PCT = PAR(150) * 100.0 / PAR(98)
              WRITE (LU6, 99994, IOSTAT = IOST) PAR(150), PAR(98), PCT
              WRITE (LU7, 99994, IOSTAT = IOST) PAR(150), PAR(98), PCT
              IF (IPR(189) .GT. 0) THEN
                WRITE (LU6, 99981, IOSTAT = IOST)
                CALL PLA262 (6)
                WRITE (LU7, 99981, IOSTAT = IOST)
                IF (IPR(210) .LE. 0) THEN
                  CALL PLA262 (4)
                  WRITE (LU7, 99980, IOSTAT = IOST)
                  WRITE (LU6, 99980, IOSTAT = IOST)
                END IF
                WRITE (PRBUF, 99984, IOSTAT = IOST)
                WRITE (LU6, 99970, IOSTAT = IOST) PRBUF(1:80)
                CALL PLA262 (3)
                WRITE (LU7, 99970, IOSTAT = IOST) PRBUF(1:80)
                IF (IWIN .EQ. 1) THEN
                  IF (ISLA - ISAR .GT. 15)
     1              PRBUF(55:) = ' Sqrt(Eigenvalues) (Ang.)'
                  VRT = VRT - 0.8
                  CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68),
     1                               2, 1.0, VRT)
                  VRT = VRT - 0.2
                END IF
              END IF
            END IF
            DO K = ISAR + 1, ISLA
              KISAR  = K - ISAR
              APERC  = JATC(K) * 100.0 / NTGRD
              AVOL   = APERC * PAR(98) / 100.0
              PAR(289) = MAX (PAR(289), AVOL)
              DO L = 1, 3
                XXO(K, L) = XXO(K, L) / JATC(K)
                SXYZ(9 + L, KISAR) = XXO(K, L)
              END DO
              DUMW(1, 1) = SXYZ(4, KISAR) - SXYZ(1, KISAR)**2 / JATC(K)
              DUMW(1, 2) = SXYZ(7, KISAR)
     1                   - SXYZ(1, KISAR) * SXYZ(2, KISAR) / JATC(K)
              DUMW(1, 3) = SXYZ(8, KISAR)
     1                   - SXYZ(1, KISAR) * SXYZ(3, KISAR) / JATC(K)
              DUMW(2, 2) = SXYZ(5, KISAR)
     1                   - SXYZ(2, KISAR)**2 / JATC(K)
              DUMW(2, 3) = SXYZ(9, KISAR)
     1                 - SXYZ(2, KISAR) * SXYZ(3, KISAR) / JATC(K)
              DUMW(3, 3) = SXYZ(6, KISAR)
     1                   - SXYZ(3, KISAR)**2 / JATC(K)
              CALL GEN024 (DUMW, EV, EW, DUMV)
              CALL GEN004 (ROR, DUMV, DUMW)
              DO I = 1, 3
                VMAX = 0.0
                DO J = 1, 3
                  VMAX = MAX (VMAX, ABS(DUMW(J, I)))
                  SXYZ ((I - 1) * 3 + J, KISAR) = DUMV(J, I)
                END DO
                OHASHI = IATC(K) * AVOL / JATC(K)
                IATCK  = MIN (999999, IATC(K))
                OHASH  = MIN (9999.9, OHASHI)
                WRITE (PRBUF, 99987, IOSTAT = IOST)
     1            K - ISAR, JATC(K), IATCK, NINT(APERC), NINT(AVOL),
     2            OHASH, (XXO(K, L), L = 1, 3), I,
     3            (DUMW(J, I) / VMAX, J = 1, 3), SQRT(EW(I) / JATC(K))
                IF (I .NE. 1) CALL GEN038 (PRBUF, 1, 53)
                IF (IGBL(63) .GT. 1) THEN
                  WRITE (LU6, 99972, IOSTAT = IOST) PRBUF(1:80)
                  CALL PLA262 (1)
                  WRITE (LU7, 99972, IOSTAT = IOST) PRBUF(1:80)
                END IF
                IF (IWIN .EQ. 1) THEN
                  IF (ISLA - ISAR .GT. 15) THEN
                    IF (I .EQ. 3) THEN
                      WRITE (PRBUF, 99967, IOSTAT = IOST)
     1                  K - ISAR, JATC(K), IATCK, NINT(APERC),
     2                  NINT(AVOL), OHASH, (XXO(K, L), L = 1, 3),
     3                  (SQRT(EW(L) / JATC(K)), L = 1, 3)
                      VRT = VRT - 0.4
                      CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
                    END IF
                  ELSE
                    VRT = VRT - 0.4
                    CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 1.0, VRT)
                  END IF
                END IF
              END DO
            END DO
            N1 = ISAR + 1
            CALL PLA143 (2, 4.5, N1, ISLA, IDUM)
          ELSE
            WRITE (PRBUF, 99988, IOSTAT = IOST)
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 5.0
              CALL GGIP09 (0.0, PRBUF, 60, 0.45, 3, 2, 1.0, VRT)
            END IF
            IF (IGBL(63) .GT. 1) THEN
              WRITE (LU6, 99971, IOSTAT = IOST) PRBUF
              WRITE (LU7, 99971, IOSTAT = IOST) PRBUF
            END IF
            IPR(210) = 0
          END IF
          IF (IPR(200) .EQ. 2) THEN
            IF (IGBL(63) .GT. 0) THEN
              WRITE (LU6, 99978, IOSTAT = IOST)
              CALL PLA262 (3)
              WRITE (LU7, 99978, IOSTAT = IOST)
            END IF
            IF (PAR(437) .EQ. 0.0 .AND. IPR(651) .EQ. 0) THEN
C * ALERT _601
              CALL PLA231 (601, 0, PAR(289), PAR(289), ' ', ' ')
            ELSE
C * ALERT _605
              CALL PLA231 (605, 0, -999.0, PAR(289), ' ', ' ')
            END IF
            IF (PAR(289) .GT. 20.0) THEN
              CALL PLA015 (0, 4)
            ELSE
              CALL PLA015 (0, 3)
            END IF
          END IF
          GO TO 80
        END IF
        IF (IVOIDX + 1 .EQ. N1) THEN
          IF (IPR(198) .GT. 0) THEN
            IF (IGBL(25) * IGBL(32) .EQ. 1 .AND.
     1          IPR(121) .EQ. 0 .AND. IGBL(3) .NE. 5) THEN
              CALL GGIP09 (0.0, PRBUF(69:76), 8, 0.35, 0, 2, 21.0, 5.0)
              WRITE (PRBUF, 99990, IOSTAT = IOST)
     1          PAR(84), IPR(198)
              CALL GGIP09 (0.0, PRBUF(69:76), 8, 0.35, 1, 2, 21.0, 5.0)
              WRITE (LU6, 99972, IOSTAT = IOST) PRBUF(1:80)
              CALL GGIP09 (0.0, 'Collect S.A.R.', 14, 0.35, 3, 2, 11.0,
     1                     3.0)
              CALL GGIP (0.0, 0.0, 0.0, 6)
            END IF
          END IF
        END IF
        XXO(IAT, IPR(185)) = IVOIDX * PAR(81)
        IVOIDY             = 0
        DO WHILE (IVOIDY .LT. N2)
          XXO(IAT, IPR(186)) = IVOIDY * PAR(82)
          IVOIDZ             = 0
          DO WHILE (IVOIDZ .LT. N3)
            XXO(IAT, IPR(187)) = IVOIDZ * PAR(83)
            NHV                = NHV + 1
            IF (NINT(VOID(NHV)) .EQ. 0) THEN
              DO IO = 1, 3
                JO = 4 - IO
                KO = JO + 3
                XXO(IAT, KO) = 0.0
                DO LO = JO, 3
                  XXO(IAT, KO) =
     1              XXO(IAT, KO) + XXO(IAT, LO) * OR(JO, LO)
                END DO
              END DO
              IPR(199) = 0
              CALL PLA067 (IAT, KAT)
              IF (IPR(2) .NE. 0) THEN
                IF (IGBL(3) .EQ. 1) IPR(2) = 0
                GO TO 80
              END IF
              IF (IPR(199) .LT. 0) THEN
                IPR(190)  = IPR(190) + 1
                VOID(NHV) = ICHAR(' ')
              ELSE IF (IPR(199) .EQ. 0) THEN
                DO JS = 1, NSYM
                  DO I9 = 1, 3
                    XJX(I9 + 3) = 0.0
                    XJX(I9) = XXO(IAT, I9)
                  END DO
                  CALL SGSM (ICL, JS, XJX, LU6, 3, IERR)
                  IVDX = MOD(NINT(XJX(6 + IPR(185)) / PAR(81)) + N1, N1)
                  IVDY = MOD(NINT(XJX(6 + IPR(186)) / PAR(82)) + N2, N2)
                  IVDZ = MOD(NINT(XJX(6 + IPR(187)) / PAR(83)) + N3, N3)
                  NHVL = IVDX * N23 + IVDY * N3 + IVDZ + 1
                  IF (NINT(VOID(NHVL)) .EQ. 0) THEN
                    IPR(190) = IPR(190) + 1
                    IPR(198) = IPR(198) + 1
                    IF (IPR(198) .EQ. 1 .AND. IGBL(63) .GT. 0)
     1                WRITE (LU6, 99991, IOSTAT = IOST)
                    IF (MOD(IPR(198), 10000) .EQ. 0) THEN
                      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND.
     1                    IGBL(3) .NE. 5 .AND. IPR(121) .EQ. 0) THEN
                        CALL GGIP09 (0.0, PRBUF(69:76), 8, 0.35, 0, 2,
     1                               21.0, 5.0)
                        WRITE (PRBUF, 99990, IOSTAT = IOST)
     1                    PAR(84), IPR(198)
                        CALL GGIP09 (0.0, PRBUF(69:76), 8, 0.35, 1, 2,
     1                               21.0, 5.0)
                        CALL GGIP (0.0, 0.0, 0.0, 6)
                      END IF
                    END IF
                    IF (IPR(198) .GT. MAXSGRID) THEN
                      IF (IGBL(3) .EQ. 1) THEN
                        IF (PAR(437) .EQ. 0.0 .AND. IPR(651) .EQ. 0)
     1                    THEN
C * ALERT _602 - VOID TOO LARGE
                          CALL PLA231 (602, 0,  1.0, 1.0, ' ', ' ')
                        ELSE
C * ALERT _606 - VERY LARGE VOID
                          CALL PLA231 (606, 0, -999.0, 1.0, ' ', ' ')
                        END IF
                        GO TO 120
                      END IF
                    END IF
                    VOID(NHVL) = ICHAR('>')
                  END IF
                END DO
              ELSE
                CRIT  = PAR(23) - PAR(20)
                CRIT2 = CRIT**2
                LSKX  = INT(CRIT / (PAR(81) * PAR(100 + IPR(185)))) + 1
                LSKY  = INT(CRIT / (PAR(82) * PAR(100 + IPR(186)))) + 1
                LSKZ  = INT(CRIT / (PAR(83) * PAR(100 + IPR(187)))) + 1
                IVD   = IPR(59) + 1
                IF (IVD .LT. 10) THEN
                  ICHR = ICHAR('0') + IVD
                ELSE
                  ICHR = ICHAR('*')
                END IF
                DO JS = 1, NSYM
                  DO I = 1, 3
                    XJX(I + 3) = 0.0
                    XJX(I) = XXO(KAT, I)
                  END DO
                  CALL SGSM (ICL, JS, XJX, LU6, 3, IERR)
                  XXOM5  = XJX(6 + IPR(185))
                  XXOM6  = XJX(6 + IPR(186))
                  XXOM7  = XJX(6 + IPR(187))
                  LVKX   = NINT (XXOM5 / PAR(81))
                  LVKY   = NINT (XXOM6 / PAR(82))
                  LVKZ   = NINT (XXOM7 / PAR(83))
                  LXMIN  = MAX (LVKX - LSKX, IVOIDX)
                  LYMIN  = MAX (LVKY - LSKY, 0)
                  LZMIN  = MAX (LVKZ - LSKZ, 0)
                  LXMAX  = MIN (LVKX + LSKX, N1 - 1)
                  LYMAX  = MIN (LVKY + LSKY, N2 - 1)
                  LZMAX  = MIN (LVKZ + LSKZ, N3 - 1)
                  LVOIDX = LXMIN
                  DO WHILE (LVOIDX .LE. LXMAX)
                    XJX(IPR(185)) = LVOIDX * PAR(81) - XXOM5
                    LVOIDY = LYMIN
                    DO WHILE (LVOIDY .LE. LYMAX)
                      XJX(IPR(186)) = LVOIDY * PAR(82) - XXOM6
                      NHVL   = LVOIDX * N23 + LVOIDY * N3 + LZMIN
                      LVOIDZ = LZMIN
                      DO WHILE (LVOIDZ .LE. LZMAX)
                        NHVL = NHVL + 1
                        IF (NINT(VOID(NHVL)) .EQ. 0) THEN
                          XJX(IPR(187)) = LVOIDZ * PAR(83) - XXOM7
                          IF ((OR11 * XJX(1) + OR12 * XJX(2)
     1                                       + OR13 * XJX(3))**2
     2                      + (OR22 * XJX(2) + OR23 * XJX(3))**2
     3                      + (OR33 * XJX(3))**2 .LT. CRIT2)
     4                      VOID(NHVL) = ICHR
                        END IF
                        LVOIDZ = LVOIDZ + 1
                      END DO
                      LVOIDY = LVOIDY + 1
                    END DO
                    LVOIDX = LVOIDX + 1
                  END DO
                END DO
                IPR(199) = 0
              END IF
            END IF
            IVOIDZ = IVOIDZ + 1
          END DO
          IVOIDY = IVOIDY + 1
        END DO
      END DO
   80 IF (IPR(188) .GT. 0) THEN
        IF (IPR(189) .GT. 0 .AND. IGBL(63) .GT. 1) THEN
          ISLL = 0
          LAST = 0
          CMIN = 0.95
          REWIND LU15
          DO
            READ (LU15, IOSTAT = IOST) IX, IY, IZ, ISL, NADD, V3
            IF (IOST .EQ. 0) THEN
              IF (ISL .NE. ISLL) THEN
                GO TO 90
              ELSE
                GO TO 100
              END IF
            END IF
            LAST = 1
   90       IF (ISLL .NE. 0) THEN
              CALL PLA262 (1)
              WRITE (LU6, 99961, IOSTAT = IOST)
     1          ISLL, (VECN(K), K = 1, 7)
              WRITE (LU7, 99961, IOSTAT = IOST)
     1          ISLL, (VECN(K), K = 1, 7)
              DO I = 1, 3
                SXYZ(12 + I, ISLL) = VECN(2 * I)
              END DO
            ELSE
              CALL PLA262 (5)
              WRITE (LU6, 99960, IOSTAT = IOST)
              WRITE (LU7, 99960, IOSTAT = IOST)
            END IF
            CALL GEN074 (VECN, 1, 7, 0.0)
            ISLL = ISLL + 1
            IF (LAST .EQ. 0) THEN
              DO I = 1, 3
                V4(I) = SXYZ(9 + I, ISLL)
                V5(I) = SXYZ(I,     ISLL)
                V6(I) = SXYZ(3 + I, ISLL)
                V8(I) = SXYZ(6 + I, ISLL)
              END DO
              CALL GEN002 (1, OR, V4, V2, XLNG)
              GO TO 100
            END IF
            GO TO 110
  100       DO I = 1, 3
              V4(I) = V3(I) - V2(I)
            END DO
            DIST = SQRT (GEN009 (V4, V4))
            IF (DIST .GT. VECN(7)) VECN(7) = DIST
            ANG = GEN009 (V5, V4) / DIST
            IF (ANG .GT. CMIN) THEN
              IF (DIST .GT. VECN(2)) VECN(2) = DIST
            ELSE IF (ANG .LT. - CMIN) THEN
              IF (DIST .GT. ABS(VECN(1))) VECN(1) = - DIST
            ELSE
              ANG = GEN009 (V6, V4) / DIST
              IF (ANG .GT. CMIN) THEN
                IF (DIST .GT. VECN(4)) VECN(4) = DIST
              ELSE IF (ANG .LT. - CMIN) THEN
                IF (DIST .GT. ABS(VECN(3))) VECN(3) = - DIST
              ELSE
                ANG = GEN009 (V8, V4) / DIST
                IF (ANG .GT. CMIN) THEN
                  IF (DIST .GT. VECN(6)) VECN(6) = DIST
                ELSE IF (ANG .LT. - CMIN) THEN
                  IF (DIST .GT. ABS(VECN(5))) VECN(5) = - DIST
                END IF
              END IF
            END IF
          END DO
        END IF
  110   IF (IPR(326) .EQ. 2) THEN
          IF (IWIN .EQ. 1) CALL PLA127
        ELSE IF (IPR(326) .EQ. 3) THEN
          IPR(580) = 2
C * GENERATE F3D STYLE INPUT FOR SOLV-MAP
          OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'.slv',
     1          STATUS = 'UNKNOWN')
          WRITE (LU65, 99966, IOSTAT = IOST) JID(1:50),
     1          ((OR(I, J), J = 1, 3), I = 1, 3),
     2          (PAR(I), I = 101, 106), (IPR(I), I = 395, 397)
          NX   = IPR(395)
          NY   = IPR(396)
          NZ   = IPR(397)
          MXYZ = NX * NY * NZ
          NXY  = NX * NY
          CALL GEN074 (VOID, 1, MXYZ, 0.0)
          REWIND LU15
          DO
            READ (LU15, IOSTAT = IOST) IX, IY, IZ
            IF (IOST .NE. 0) EXIT
            IF (IX .LT. 0)  IX = IX + NX
            IF (IY .LT. 0)  IY = IY + NY
            IF (IZ .LT. 0)  IZ = IZ + NZ
            IF (IX .GE. NX) IX = IX - NX
            IF (IY .GE. NY) IY = IY - NY
            IF (IZ .GE. NZ) IZ = IZ - NZ
            VOID (IZ * NXY + IY * NX + IX + 1) = 1.0
          END DO
          DO K = 1, NZ
            M = (K - 1) * NXY
            WRITE (LU65, 99965, IOSTAT = IOST) K - 1
            DO J = 1, NY
              N = M + (J - 1) * NX
              WRITE (LU65, 99964, IOSTAT = IOST)
     1          (NINT(VOID(N + I)), I = 1, NX)
            END DO
          END DO
          WRITE (LU65, 99963, IOSTAT = IOST) IPR(39)
          DO I = 1, IPR(39)
            CALL GEN048 (-4, IFG(1, I), 15, IVAL)
            NQ1 = LMT(IVAL + 1, 1)
            CALL GEN020 (1, NQ1, 2, 2)
            N = 0
            IF (NQ1(1:1) .EQ. ' ') N = 1
            WRITE (LU65, 99962, IOSTAT = IOST)
     1        NQ1(1+N:4+N), (XXO(I, J), J = 1, 3)
          END DO
          CLOSE (UNIT = LU65)
C * F3D
          PLPATH = ' '
          NE = FINDEXE ('F3DEXE', PLPATH, 'f3d')
          IF (NE .GT. 0) THEN
            PLPATH(NE + 1:) = ' '//NAMEFIL(1:KNMFIL)//'.slv &'
            KERR = 0
            CALL SPAWN (PLPATH, KERR)
          END IF
          IPR(580) = -2
          IPR(2)   = -1
        END IF
      END IF
      GO TO 150
  120 IPR(210) = 0
      WRITE (LU6, '(/, ''Problem, IPR(210) set to zero'')',
     1  IOSTAT = IOST)
  150 IGBL(6) = 10
      IVAL = NADD
      RETURN
99999 FORMAT ('Search for and Analysis of Solvent Accessible Voids',
     1        ' in the Structure - Grid =', F5.2,
     2        ' Ang., Probe Radius =', F6.2, ' Ang., NStep =', I2)
99998 FORMAT (A, '-Section : ', I5, ' - (Max =', I5, ') --- ',
     1        A, '-Vertical and ', A, '-Horizontal', /)
99997 FORMAT (//, 'SOLV-Map Gridpoint Entries: ', //,
     1            '- Numerical  : Atom Type Number', /,
     2            '- ''*''        : Atom Type Number > 9', /,
     3            '- Alphabetic : Independent Solvent Accessible Void',
     4        /)
99996 FORMAT (/, 'Atom Type Number ', I3, ' = Label ', A)
99995 FORMAT (130A)
99994 FORMAT (':: Total Potential Solvent Area Vol', F9.1, ' Ang^3', /,
     1        18X, 'per Unit Cell Vol', F9.1, ' Ang^3 [',F4.1,'%]', /)
99993 FORMAT (/, A, /)
99992 FORMAT (':: Nr of VOID Grid-points =', I8,
     1       ', Percent Filled Space', F5.1, ' (= Packing Index)')
99991 FORMAT (':: Note: VOID/SOLV/SQUEEZE is relatively',
     1       ' compute intense and experimental', /)
99990 FORMAT (':: Nr of gridpoints at least', F5.2, ' Ang.',
     1        ' from nearest vdWaals Surface=', I8)
99989 FORMAT (3(/, ':: Grid: ', A, '-Axis Step =', F7.4,
     1        ' = Points', I4, ', Angstrom Step =', F5.2), //)
99988 FORMAT (':: Unit cell Contains NO Residual Solvent',
     1       ' Accessible Void.')
99987 FORMAT (I2, I7, '[', I6, ']', I3, I6, '[', F6.1, ']', 1X, 3F6.3,
     1        I2, 1X, 3F6.3, F6.2)
99986 FORMAT (/, ':: VOID/SOLV Gridstep (Angstrom) (re)set to', F5.2,
     1       ', Percent Memory =', F5.1)
99985 FORMAT ('(See A.I. Kitajgorodskij, Molecular Crystals and',
     1        ' Molecules, New-York, Academic Press, 1973.)', /)
99984 FORMAT ('Area #GridPoint VolPerc.  Vol(A^3)', 2X,
     1        'X(av) Y(av) Z(av) Eigenvector(frac) Sig(Ang)')
99981 FORMAT ('Note: Expected volumes for solvent molecules are:',
     1       /, 6X, 'A hydrogen bonded H2O-molecule      40 Ang^3',
     2       /, 6X, 'Small molecules (e.g. Toluene) 100-300 Ang^3',
     3      //, 6X, 'Values below for gridpoints and volumes in [] '
     4       /, 6X, 'refer to areas where atom centers may reside.')
99980 FORMAT (/, ':: Use the CALC SQUEEZE instruction to calculate '
     1 , 'and optionally correct for', /,
     2 ':: Density identified in solvent accessible areas',
     3 ' (Reflection data required)')
99979 FORMAT (/, ':: Internal Problem: Request Aborted')
99978 FORMAT (' :: Note: use CALC VOID (not CALC SOLV) for',
     1       ' Packing Index. ', /)
99976 FORMAT ('No Packing Index - Disordered Structure')
99975 FORMAT ('van der Waals (or ion) Radii used in the Analysis',
     1        /, 80('='), /, 16(3X, A))
99974 FORMAT (80('-'), /, 16F5.2)
99972 FORMAT (A)
99971 FORMAT (/, A, /)
99970 FORMAT (/, A, /, 80('-'))
99969 FORMAT (A, /, 132('='), /)
99968 FORMAT ('Warning: No Hydrogen Atoms in VOID/SQUEEZE Model')
99967 FORMAT (I2, I7, '[', I6, ']', I3, I6, '[', F6.1, ']', 1X, 3F6.3,
     1        3F8.3)
99966 FORMAT ('TITL ', A, /, 'TRAN ', 3F9.4, F8.4, 2F9.4, 2F8.4, F9.4,
     1  /, 'CELL ', 6F9.4, /, 'SIZE', 3I8)
99965 FORMAT ('SECTION', I8)
99964 FORMAT (250I1)
99963 FORMAT ('ATOMS',  I8)
99962 FORMAT (A, 3F10.4)
99961 FORMAT (I3, 7F7.2)
99960 FORMAT (5X, 'Report the Distance from VOID-CG to Boundary in ',
     1        'EV-Directions', //, ' Nr', 1X, 'MinEV1', 1X, 'MaxEV1',
     2        1X, 'MinEV2', 1X, 'MaxEV2', 1X, 'MinEV3', 1X, 'MaxEV3',
     3        1X, 'MaxDist (Ang)', /, 80('='))
99959 FORMAT (1X)
      END SUBROUTINE PLA125
      SUBROUTINE PLA126 (NXYZ, IJGR, NADD)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION NXYZ(3), IJGR(3), VO(3), IJGRD(3)
      IPR(188) = IPR(188) + 1
      IF (IPR(189) .GT. 0) THEN
        ISL        = IPR(530)
        ISLA       = IPR(39) + ISL + 1
        JATC(ISLA) = JATC(ISLA) + 1
        IF (NADD .EQ. 2) IATC(ISLA) = IATC(ISLA) + 1
        IATP(ISLA) = IATP(ISLA) + 1
        DO I = 1, 3
          J            = IPR(184 + I)
          K            = NXYZ(I) + IJGR(I)
          V6(J)        = PAR(80 + I)  * K
          XXO(ISLA, J) = XXO(ISLA, J) + V6(J)
          IF (IPR(326) .EQ. 1) THEN
            IJG = MOD(K, IPR(193 + I))
            IF (IJG .LT. 0) IJG = IJG + IPR(193 + I)
            IJGRD(J) = IJG
          ELSE
            IJGRD(J) = K
          END IF
        END DO
        VO(1) = OR(1, 1) * V6(1) + OR(1, 2) * V6(2) + OR(1, 3) * V6(3)
        VO(2) =                    OR(2, 2) * V6(2) + OR(2, 3) * V6(3)
        VO(3) =                                       OR(3, 3) * V6(3)
        SXYZ(1, ISL) = SXYZ(1, ISL) + VO(1)
        SXYZ(2, ISL) = SXYZ(2, ISL) + VO(2)
        SXYZ(3, ISL) = SXYZ(3, ISL) + VO(3)
        SXYZ(4, ISL) = SXYZ(4, ISL) + VO(1)**2
        SXYZ(5, ISL) = SXYZ(5, ISL) + VO(2)**2
        SXYZ(6, ISL) = SXYZ(6, ISL) + VO(3)**2
        SXYZ(7, ISL) = SXYZ(7, ISL) + VO(1) * VO(2)
        SXYZ(8, ISL) = SXYZ(8, ISL) + VO(1) * VO(3)
        SXYZ(9, ISL) = SXYZ(9, ISL) + VO(2) * VO(3)
        IF (IPR(326) .NE. 0) WRITE (LU15) IJGRD, ISL, NADD, VO
      END IF
      RETURN
      END SUBROUTINE PLA126
      SUBROUTINE PLA127
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /VSCR/ NXYZ(3), NXYZ0(3), IGR(3), JGR(3), KGR(3), MGR(3),
     1              IJGR(3), OR11, OR12, OR13, OR22, OR23, OR33
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DIMENSION IGMN(3), IGMX(3), ISH(3), IMX(3),
     1  XMN(3), XMX(3), V0(3)
      COMMON /UNITC/ IUNCL(2, 12)
C * VOID PLOT
C * DEFAULT SETTINGS
      IPR(116) = 1
      IPR(140) = 0
      IPR(526) = 0
      IND3     = 3
      IND2     = 2
      IND1     = 1
      IPR(527) = 1
      IPR(528) = 1
      IPR(529) = 0
      IPR(533) = 1
      IPR(534) = 1
      IGBL(75) = 0
      NAT      = IPR(39)
      NSYM     = IPR(48)
      NRES     = IPR(75)
      DO
        CALL PLA013 (1, 1)
        IF (IGGT(1:3) .EQ. 'REV') THEN
          IGBL(68) = MOD (IGBL(68) + 1, 2)
          CALL GGIP (-999.0, FLOAT(IGBL(68)), IGBL(62) * 0.25, 9)
        END IF
        IF (IGGT(1:4) .EQ. 'EXIT') LRET = 2
        IF (IGGT(1:1) .EQ. 'N')    LRET = 2
        IF (LRET .EQ. 1) THEN
          GO TO 20
        ELSE IF (LRET .EQ. 2) THEN
          RETURN
        ELSE IF (LRET .EQ. 3) THEN
          GO TO 10
        ELSE IF (LRET .EQ. 4) THEN
          GO TO 40
        END IF
   10   IPR(526) = -1
   20   IF (IPR(526) .EQ. -1) THEN
          DUMMY = PAR(389) / RGBL(6)
          CALL GEN051 (1, RMAT, DUMMY, IPR(479))
          IPR(526) = 0
        ELSE IF (IPR(526) .EQ. 0) THEN
          CALL GEN021 (RMAT, 1)
          DO I = 1, 3
            X = - RGBL(27 + I) / RGBL(6)
            L = I
            CALL GEN051 (0, RMAT, X, L)
          END DO
        ELSE IF (IPR(526) .EQ. 1) THEN
          CALL GEN043 (2, RMAT,  90.0 / RGBL(6))
          IND3 = 1
          IND2 = 2
          IND1 = 3
        ELSE IF (IPR(526) .EQ. 2) THEN
          CALL GEN043 (1, RMAT, -90.0 / RGBL(6))
          IND3 = 2
          IND2 = 1
          IND1 = 3
        ELSE IF (IPR(526) .EQ. 3) THEN
          CALL GEN043 (1, RMAT,   0.0 / RGBL(6))
          IND3 = 3
          IND2 = 2
          IND1 = 1
        ELSE
          GO TO 30
        END IF
        CALL GEN096 (RMAT, IROTX, IROTY, IROTZ, IDET, V6, YANK, QM)
        RGBL(28)   = IROTX
        RGBL(29)   = IROTY
        RGBL(30)   = IROTZ
        IPR(526) = 4
   30   ANG = IPR(116) * 3.0 / RGBL(6)
        CALL GEN043 (2, ROTM1, - ANG)
        CALL GEN043 (2, ROTM2, + ANG)
   40   CALL GGIP (HORS, VERT, 0.0, 1)
        ISTER = IPR(533)
        HRS   = HORS / ISTER
        CALL PLA110 (HORS, VERT, 0)
        DO I = 1, 3
          IGMN(I) =  999
          IGMX(I) = -999
          XMN(I)  =  999.0
          XMX(I)  = -999.0
        END DO
        NOFF  = 0
        NBOND = 0
        NP    = 0
        IF (IPR(527) .EQ. 1) THEN
          DO I = 1, 2
            V3(1) = I - 1
            DO J = 1, 2
              V3(2) = J - 1
              DO K = 1, 2
                V3(3) = K - 1
                CALL GEN002 (1, OR, V3, V2, XLNG)
                VOID(NOFF + 1) = - (V3(1) * 4 + V3(2) * 2 + V3(3))
                DO M = 1, 3
                  XMN(M) = MIN (XMN(M), V2(M))
                  XMX(M) = MAX (XMX(M), V2(M))
                  VOID (NOFF + 1 + M) = V2(M)
                END DO
                NP   = NP + 1
                NOFF = NOFF + 7
              END DO
            END DO
          END DO
          DO I = 1, 2
            DO J = 1, 12
              JNSC(I, J) = IUNCL(I, J)
            END DO
          END DO
          NBOND = 12
        END IF
        IF (IPR(528) .EQ. 1) THEN
          DO K = 1, NRES
            IF (IPR(140) .EQ. 0 .OR. K .EQ. IPR(140)) THEN
              CALL GEN074 (V5, 1, 3, 0.0)
              N = 0
              DO I = 1, NAT
                CALL GEN048 (-6, IFG(1, I), 9, IRESI)
                IF (IRESI .EQ. K) THEN
                  N = N + 1
                  DO J = 1, 3
                    V5(J) = V5(J) + XXO(I, J)
                  END DO
                END IF
              END DO
              DO J = 1, 3
                V5(J) = V5(J) / N
              END DO
              IF (IPR(537) .EQ. 1) THEN
                NS = NSYM
              ELSE
                NS = 1
              END IF
              DO N = 1, NS
                DO I = 1, 3
                  XJX(I + 3) = 0.0
                  XJX(I)     = V5(I)
                END DO
                CALL SGSM (IDM, N, XJX, LU6, 3, IERR)
                DO I = 1, 3
                  XJX(I + 3) =  - (INT(XJX(6 + I) + 5.0) - 5)
                END DO
                DO I = 1, NAT
                  CALL GEN048 (-6, IFG(1, I), 9, IRESI)
                  IF (IRESI .EQ. K) THEN
                    DO J = 1, 3
                      XJX(J) = XXO(I, J)
                    END DO
                    CALL SGSM (IDM, N, XJX, LU6, 3, IERR)
                    DO J = 1, 3
                      V2(1) = OR(1, 1) * XJX(7) + OR(1, 2) * XJX(8)
     1                      + OR(1, 3) * XJX(9)
                      V2(2) = OR(2, 2) * XJX(8) + OR(2, 3) * XJX(9)
                    V2(3) = OR(3, 3) * XJX(9)
                    END DO
                    DO J = 1, 3
                      XMN(J) = MIN (XMN(J), V2(J))
                      XMX(J) = MAX (XMX(J), V2(J))
                      VOID (NOFF + 1 + J) = V2(J)
                    END DO
                    VOID (NOFF + 1) = I
                    NP              = NP   + 1
                    NOFF            = NOFF + 7
                  END IF
                END DO
              END DO
            END IF
          END DO
          NOF = IPR(527) * 8
          DO I = NOF + 1, NP
            NI = NINT (VOID(I * 7 - 6))
            DO K = 1, 3
              V2(K) = VOID(I * 7 - 6 + K)
            END DO
            CALL GEN048 (-4, IFG(1, NI), 15, NO1)
            DISTI = REL(IEN(NO1 + 1)) + 0.4
            DO J = NOF + 1, NP
              NJ = NINT (VOID(J * 7 - 6))
              DO K = 1, 3
                V3(K) = VOID(J * 7 - 6 + K)
              END DO
              CALL GEN048 (-4, IFG(1, NJ), 15, NO2)
              DISTMX = DISTI + REL(IEN(NO2 + 1))
              DIST   = 0
              DO K = 1, 3
                DIST = DIST + (V2(K) - V3(K))**2
              END DO
              IF (SQRT(DIST) .LT. DISTMX) THEN
                IF (NBOND .LT. NP23) THEN
                  NBOND          = NBOND + 1
                  JNSC(1, NBOND) = I
                  JNSC(2, NBOND) = J
                ELSE
                  GO TO 70
                END IF
              END IF
            END DO
          END DO
        END IF
C * DISPLAY CG & EIGENVECTORS
        IF (IPR(598) .NE. 0) THEN
          CALL GEN021 (QQ, 1)
          IF (IPR(531) .EQ. 0) THEN
            IB = 1
            IE = IPR(530)
          ELSE
            IB = IPR(531)
            IE = IPR(531)
          END IF
          DO I = IB, IE
            DO J = 1, 3
              V4(J) = SXYZ(9 + J, I)
              V5(J) = SXYZ(J    , I)
              V6(J) = SXYZ(3 + J, I)
              V8(J) = SXYZ(6 + J, I)
            END DO
            CALL GEN002 (1, OR, V4, V4, XLNG)
            CALL GEN002 (2, QQ, V5, V5, XLNG)
            CALL GEN002 (2, QQ, V6, V6, XLNG)
            CALL GEN002 (2, QQ, V8, V8, XLNG)
            DO J = 1, 3
              VOID (NOFF +  1 + J) = V4(J)
              VOID (NOFF +  8 + J) = V4(J) + V5(J) * SXYZ(13, I)
              VOID (NOFF + 15 + J) = V4(J) + V6(J) * SXYZ(14, I)
              VOID (NOFF + 22 + J) = V4(J) + V8(J) * SXYZ(15, I)
            END DO
            NOFF = NOFF + 28
            IF (NBOND - 2 .LT. NP23) THEN
              DO J = 1, 3
                NBOND          = NBOND + 1
                JNSC(1, NBOND) = NP + 1
                JNSC(2, NBOND) = NP + J + 1
              END DO
            ELSE
              GO TO 70
            END IF
            NP = NP   + 4
          END DO
        END IF
        NVL  = IPR(531)
        NF   = NOFF
        REWIND LU15
        DO
          READ (LU15, IOSTAT = IOST) IGR, NV, NADD
          IF (IOST .NE. 0) EXIT
          IF (NVL .EQ. 0 .OR. NV .EQ. NVL) THEN
            IF (IPR(529) .EQ. 0 .OR. NADD .EQ. 2) THEN
              DO I = 1, 3
                IF (IPR(535) .NE. 0) THEN
                  IF (IGR(I) .LT. 0) IGR(I) = IGR(I) + IPR(394 + I)
                END IF
                V3(I) = FLOAT(IGR(I)) / IPR(394 + I)
              END DO
              V2(1) = OR11 * V3(1) + OR12 * V3(2) + OR13 * V3(3)
              V2(2) =                OR22 * V3(2) + OR23 * V3(3)
              V2(3) =                               OR33 * V3(3)
              NP    = NP + 1
              NOFF  = NOFF + 7
              IF (NOFF .GT. NVD) GO TO 60
              DO I = 1, 3
                IGMN(I)            = MIN (IGMN(I), IGR(I))
                IGMX(I)            = MAX (IGMX(I), IGR(I))
                XMN(I)             = MIN (XMN(I),  V2(I))
                XMX(I)             = MAX (XMX(I),  V2(I))
                VOID(NOFF - 6 + I) = V2(I)
                VOID(NOFF - 3 + I) = IGR(I)
              END DO
            END IF
          END IF
        END DO
        DO I = 1, 3
          ISH(I) = - IGMN(I) + 1
          IMX(I) =   IGMX(I) + ISH(I) + 1
          V0(I)  =   (XMN(I) + XMX(I)) / 2.0
        END DO
        CALL GEN074 (XMN, 1, 3,  999.0)
        CALL GEN074 (XMX, 1, 3, -999.0)
        DO I = 1, NP
          N = (I - 1) * 7
          DO M = 1, 3
            V4(M) = VOID(N + 1 + M) - V0(M)
          END DO
          CALL GEN002 (1, RMAT, V4, V5, XLNG)
          DO M = 1, 3
            XMN(M) = MIN (XMN(M),  V5(M))
            XMX(M) = MAX (XMX(M),  V5(M))
            VOID(N + 1 + M) = V5(M)
            VOID(N + 4 + M) = VOID(N + 4 + M) + ISH(M)
          END DO
        END DO
        SHX   = HORS / ((XMX(1) - XMN(1)) * ISTER)
        SHY   = VERT / (XMX(2) - XMN(2))
        SCALE = MIN (SHX, SHY) * 0.80
        DO I = 1, NP
          N = (I - 1) * 7 + 1
          DO M = 1, 2
            VOID (N + M) = SCALE * VOID(N + M)
          END DO
          VOID(N + 3) = SCALE * (VOID(N + 3) - XMX(3))
        END DO
        IP1 =  IMX(IND1) + 1
        IP2 = (IMX(IND2) + 1) * IP1
        IP3 = (IMX(IND3) + 1) * IP2
        IB  = NOFF + 1
        IE  = NOFF + IP3 * 4
        IF (IE .GT. NVD) GO TO 60
        CALL GEN074 (VOID, IB, IE, 0.0)
        NF0 = NF + 7
        DO WHILE (NF0 .LE. NOFF)
          DO I = 1, 3
            V2(I)  = VOID (NF0 - 6 + I)
            IGR(I) = NINT(VOID(NF0 - 3 + I))
          END DO
          IADR = (IGR(IND3) * IP2 + IGR(IND2) * IP1 + IGR(IND1)) * 4
     1         + NOFF
          VOID(IADR + 1) = 99.0
          VOID(IADR + 2) = V2(1)
          VOID(IADR + 3) = V2(2)
          VOID(IADR + 4) = V2(3)
          NF0            = NF0 + 7
        END DO
        DO K = 1, IMX(IND3) + 1
          NBK = (K - 1) * IP2
          DO J = 1, IMX(IND2) + 1
            NBJ = (J - 1) * IP1
            DO I = 1, IMX(IND1) + 1
              NB = (NBK + NBJ + I - 1) * 4 + 1 + NOFF
              N  = - 1
              IF (VOID(NB) .GT. 0.0) THEN
                  MBK = (K  - 1) * IP2
                  DO J0 = 1, 3
                    MBJ = (J + J0 - 3) * IP1
                    DO I0 = 1, 3
                      MB = (MBK + MBJ + I + I0 - 3) * 4 + 1 + NOFF
                      IF (VOID(MB) .NE. 0.0) THEN
                        N = N + 1
                      END IF
                    END DO
                  END DO
                VOID(NB) =  N
              END IF
            END DO
          END DO
        END DO
        HRSH = HORS / (2.0 * ISTER)
        VRTH = VERT / 2.0
        IF (ISTER .EQ. 1) THEN
          COL1 = 1.0 + IPR(116)
          COL2 = 3.0
        ELSE
          COL1 = 1.0
          COL2 = 1.0
        END IF
        IF ((IPR(116) .EQ. 0 .OR. IPR(533) .EQ. 2) .AND.
     1       IPR(346) .EQ. 1) THEN
          IF (IPR(529) .EQ. 1) THEN
            CL1 = 2
            CL2 = 2
          ELSE
            CL1 = 3
            CL2 = 3
          END IF
        ELSE
          CL1 = COL1
          CL2 = COL2
        END IF
        N0 = 8
        IF (IPR(534) .EQ. 2) THEN
          N1 = 1
          N3 = 3
          N4 = 1
        ELSE
          N1 = 2
          N3 = 2
          N4 = 0
        END IF
        CALL GGIP (HRSH, VRTH, 0.0, -3)
        DO K = 1, IMX(IND3) + 1
          NBK = (K - 1) * IP2
          DO J = 1, IMX(IND2) + 1
            NBJ = (J - 1) * IP1
            DO I = 1, IMX(IND1) + 1
              NB = (NBK + NBJ + I - 1) * 4 + NOFF
              N = NINT(VOID(NB + 1))
              IF (N .GT. 0) THEN
                IF (N .LT. N0) THEN
                  DO L = 1, 3
                    V2(L) = VOID(NB + 1 + L)
                  END DO
                  CALL GEN002 (1, ROTM1, V2, V4, XLNG)
                  DO J0 = N1, N3
                    DO I0 = N1, N3
                      IF (ABS(J0 -2) + ABS(I0 -2) .EQ. N4) THEN
                        MB = NB + ((J0 - 2) * IP1 + I0 - 2) * 4
                        M = NINT (VOID(MB + 1))
                        IF (M .GT. 0 .AND. M .LT. N0) THEN
                          DO L = 1, 3
                            V3(L) = VOID(MB + 1 + L)
                          END DO
                          CALL GEN002 (1, ROTM1, V3, V5, XLNG)
                          CALL GGIP (0.0, CL1, 0.0, 0)
                          CALL GGIP (V4(1), V4(2), 0.0, 3)
                          CALL GGIP (V5(1), V5(2), 0.0, 2)
                          IF (IPR(116) .EQ. 1) THEN
                            CALL GEN002 (1, ROTM2, V2, V6, XLNG)
                            CALL GEN002 (1, ROTM2, V3, V8, XLNG)
                            CALL GGIP (0.0, CL2, 0.0, 0)
                            IF (ISTER .EQ. 2) THEN
                              V61 = V6(1) + HRS
                              V81 = V8(1) + HRS
                            ELSE
                              V61 = V6(1)
                              V81 = V8(1)
                            END IF
                            CALL GGIP (V61, V6(2), 0.0, 3)
                            CALL GGIP (V81, V8(2), 0.0, 2)
                          END IF
                        END IF
                      END IF
                    END DO
                  END DO
                END IF
              END IF
            END DO
          END DO
        END DO
        CALL GGIP (0.0, -2.0, 0.0, 0)
        IF (NBOND .GT. 0) THEN
          DO I = 1, NBOND
            DO J = 1, 3
              V3(J) = VOID((JNSC(1, I) - 1) * 7 + 1 + J)
              V4(J) = VOID((JNSC(2, I) - 1) * 7 + 1 + J)
            END DO
            CALL GEN002 (1, ROTM1, V3, V5, XLNG)
            CALL GEN002 (1, ROTM1, V4, V6, XLNG)
            CALL GGIP (0.0, COL1, 0.0, 0)
            CALL GGIP (V5(1), V5(2), 0.0, 3)
            CALL GGIP (V6(1), V6(2), 0.0, 2)
            IF (IPR(116) .EQ. 1) THEN
              CALL GEN002 (1, ROTM2, V3, V5, XLNG)
              CALL GEN002 (1, ROTM2, V4, V6, XLNG)
              IF (ISTER .EQ. 2) THEN
                V5(1) = V5(1) + HRS
                V6(1) = V6(1) + HRS
              ELSE
                CALL GGIP (0.0, COL2, 0.0, 0)
              END IF
              CALL GGIP (V5(1), V5(2), 0.0, 3)
              CALL GGIP (V6(1), V6(2), 0.0, 2)
            END IF
          END DO
          NLAB = IPR(527) * 8 + IGBL(75) * NAT
          IF (NLAB .GT. 0) THEN
            DO I = 1, NLAB
              NQ1 = ' '
              NL = NINT (VOID((I - 1) * 7 + 1))
              DO J = 1, 3
                V2(J) = VOID((I - 1) * 7 + J + 1)
              END DO
              CALL GEN002 (1, ROTM1, V2, V3, XLNG)
              CALL GEN002 (1, ROTM2, V2, V4, XLNG)
              IENR = 0
              IF (NL .LE. 0) THEN
                IF (IPR(532) .NE. 0) THEN
                  IF (NL .EQ. 0) THEN
                    NQ1 = 'O'
                  ELSE IF (NL .EQ. -4) THEN
                    NQ1 = 'a'
                  ELSE IF (NL .EQ. -2) THEN
                    NQ1 = 'b'
                  ELSE IF (NL .EQ. -1) THEN
                    NQ1 = 'c'
                  END IF
                END IF
              ELSE
                CALL PLA047 (LABA(NL), NQ1, MN, IENR, 0, IGBL(55),
     1                       0, 0)
              END IF
              IF (IENR .NE. 1 .OR. IPR(232) .EQ. 1) THEN
              CALL GGIP09 (0.0, NQ1, 5, PAR(349), NINT(COL1), 2,
     1                V3(1) + 0.4, V3(2) - 0.4)
                IF (IPR(116) .EQ. 1) THEN
                  IF (ISTER .EQ. 2) V4(1) = V4(1) + HRS
                  CALL GGIP09 (0.0, NQ1, 5, PAR(349), NINT(COL2), 2,
     1                V4(1) + 0.4, V4(2) - 0.4)
                END IF
              END IF
            END DO
          END IF
        END IF
      END DO
   60 CALL GEN127
     1 ('VOID Array too small; raise NVD for larger version')
   70 CALL GEN127 ('Bond Overflow: NBOND .GE. NP23')
      END SUBROUTINE PLA127
      SUBROUTINE PLA128 (HMAX, KMAX, LMAX)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,
     2 NP23=28000,NP38=150,NP39=30)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // JNSC(2, NP23), VOID(NVD)
      DIMENSION IV(8)
      INTEGER HMAX
      N1   = IPR(395)
      N2   = IPR(396)
      N3   = IPR(397)
      N23  = N2 * N3
      N123 = N1 * N23
      CALL GEN074 (VOID, 1, N123,   0.0)
      DO 10 I = 1, 3
        DO J = 4, 8
          IPR(394 + I) = 2**J
          IF (PAR(100 + I) * 3.0 .LT. IPR(394 + I)) GO TO 10
        END DO
   10 CONTINUE
      IF (IPR(395) .LT. 2 * HMAX + 1) IPR(395) = IPR(395) * 2
      IF (IPR(396) .LT. 2 * KMAX + 1) IPR(396) = IPR(396) * 2
      IF (IPR(397) .LT. 2 * LMAX + 1) IPR(397) = IPR(397) * 2
      M1      = IPR(395)
      M2      = IPR(396)
      M3      = IPR(397)
      NGRID   = M1 * M2 * M3
      PAR(79) = PAR(98) / NGRID
      NLOCI   = 0
      NLOCO   = 0
      CALL GEN108 (LU15, 0)
      DO
        READ (LU15, IOSTAT = IOST)  IX, IY, IZ, NSAR
        IF (IOST .NE. 0) EXIT
        VOID(IX * N23 + IY * N3 + IZ + 1) = NSAR
        NLOCI                             = NLOCI + 1
      END DO
      CALL GEN108 (LU15, 0)
      DO I = 0, M1 - 1
        JX0 = INT(FLOAT(I) * N1 / M1)
        JX1 = MOD(JX0 + 1, N1) * N23
        JX0 = JX0 * N23
        DO J = 0, M2 - 1
          JY0 = INT(FLOAT(J) * N2 / M2)
          JY1 = MOD(JY0 + 1, N2) * N3
          JY0 = JY0 * N3
          DO K = 0, M3 - 1
            JZ0   = INT(FLOAT(K) * N3 / M3)
            JZ1   = MOD(JZ0 + 1, N3)
            IV(1) = NINT(VOID(JX0 + JY0 + JZ0 + 1))
            IV(2) = NINT(VOID(JX0 + JY0 + JZ1 + 1))
            IV(3) = NINT(VOID(JX0 + JY1 + JZ0 + 1))
            IV(4) = NINT(VOID(JX0 + JY1 + JZ1 + 1))
            IV(5) = NINT(VOID(JX1 + JY0 + JZ0 + 1))
            IV(6) = NINT(VOID(JX1 + JY0 + JZ1 + 1))
            IV(7) = NINT(VOID(JX1 + JY1 + JZ0 + 1))
            IV(8) = NINT(VOID(JX1 + JY1 + JZ1 + 1))
            N     = 0
            DO L = 1, 8
              IF (IV(L) .NE. 0) THEN
                N = N + 1
                IF (N .GT. 4) THEN
                  LOC = 2 * ((K * M2 + J) * M1 + I + 1)
                  WRITE (LU15) LOC, IV(L)
                  NLOCO = NLOCO + 1
                  EXIT
                END IF
              END IF
            END DO
          END DO
        END DO
      END DO
      WRITE (LU6, 99999, IOSTAT = IOST)
     1  (PAR(100 + I), I = 1, 3), N1, N2, N3, NLOCI, M1, M2, M3, NLOCO,
     2  PAR(101) / M1, PAR(102) / M2, PAR(103) / M3
      CALL PLA262 (5)
      WRITE (LU7, 99999, IOSTAT = IOST)
     1  (PAR(100 + I), I = 1, 3), N1, N2, N3, NLOCI, M1, M2, M3, NLOCO,
     2  PAR(101) / M1, PAR(102) / M2, PAR(103) / M3
      RETURN
99999 FORMAT (/, ':: A,  B,  C  (Angstrom) = ', 3F8.3, /,
     1 ':: NX, NY, NZ (SOLV-MAP) = ', 3I8, ' - SAR-GridPoints =', I8,/,
     2 ':: NX, NY, NZ (FFT-MAP)  = ', 3I8, ' - SAR-GridPoints =', I8,/,
     3 ':: Resolution (FFT-MAP)  = ', 3F8.2, ' Angstrom')
      END SUBROUTINE PLA128
      SUBROUTINE PLA129
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287, NP23=28000,NP25=99,NP29=63,NP34=647,NP38=150,NP39=30,
     3 NP41=200,NP47=9,NP52=200,NP56=30,NP57=35,NP60=100,NKW=49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CIF/ CIFDIR
      CHARACTER CIFDIR(NP34)*(NKW)
      DIMENSION STAT(20, 9)
      INTEGER HMAX
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER TXT1(3)*62
      LOGICAL EXST
C * SQUEEZE: HANDLE (DISORDERED) SOLVENT CONTRIBUTION TO STRUCTURE FACTORS
C * GET CONNECTED COORDINATE SET
      CALL PLA024
C * SQUEEZE LISTING HEADER
      PAGET = 'SQUEEZE'
      CALL PLA262 (-2)
      WRITE (LU7, 99999, IOSTAT = IOST)
C * SQUEEZE GRAPHICS HEADER
      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IGBL(3) .NE. 5) THEN
        IWIN = 1
        CALL GGIP (HORS, VERT, 0.0, 1)
        VRT = VERT - 0.8
        WRITE (BCD, 99965, IOSTAT = IOST)
        CALL GGIP09 (0.0, BCD, 80, 0.50, 5 + IGBL(68), 2, 1.0, VRT)
        WRITE (BCD, 99976, IOSTAT = IOST)
        VRT = VRT - 1.0
        CALL GGIP09 (0.0, BCD, 80, 0.40, 5 + IGBL(68), 2, 0.1, VRT)
        CALL GGIP (0.0, 0.0, 0.0, 6)
        VRT = VRT - 0.2
      ELSE
        IWIN = 0
      END IF
C * LOAD AND EXPAND COORDINATE DATA TO UNIT CELL CONTENTS
C * (BUT EXCLUDING BRAVAIS CENTERING)
      CALL PLA023 (0)
      IF (IPR(589) .LT. 0) THEN
        IPR(1) = 1
        RETURN
      END IF
      IGBL(31) = 10
      CALL PLA292
      NSYM  = IPR(48)
      NSYMH = IPR(255)
      ICNTR = IPR(257)
      IND1  = 1
      IND2  = 2
      IND3  = 3
      HMAX  = -999
      KMAX  = -999
      LMAX  = -999
      NREF  = 0
      NREFA = 0
      NREFB = 0
C * GET NR OF REFLECTIONS (SHELX(L) HKLF4 FORMAT OR FCF & HMAX, KMAX, LMAX
      CALL PLA139 (NREF, HMAX, KMAX, LMAX)
      IF (IPR(2) .GT. 0) RETURN
C * TRANSFORM SOLV GRID POINTS TO FFT SOLV GRID POINTS
      CALL PLA128 (HMAX, KMAX, LMAX)
      M1    = IPR(395)
      M2    = IPR(396)
      M3    = IPR(397)
      NGRID = M1 * M2 * M3
C * GET/STORE REFLECTION DATA (INCLUDING '3D' POINTER ARRAY TO DATA)
      CALL PLA133 (HMAX, KMAX, LMAX, NREF, IADR, NREFA, NREFB)
      IF (NREFB .LT. 0) THEN
        WRITE (LU6, 99997, IOSTAT = IOST)
        RETURN
      END IF
C * LOOP TO CONVERGENCE
      NLPMX = IPR(142)
      NLOPM = NLPMX
      FS000 = 0.0
      FSOLD = 0.0
      RFSOD = 999.0
      DO NLOOP = 1, NLPMX
        SUMFO = 0.0
        SUMFC = 0.0
        SMFO  = 0.0
        N15   = 0
        IF (NLOOP .EQ. 1) THEN
          EPS = 0.0
        ELSE IF (NLOOP .EQ. 2) THEN
          EPS = 3.0 - IPR(257)
        ELSE
          EPS = 1.0
        END IF
        DO N = 1, NREFB
          ST = VOID(N15 + 14)
          IF (ST .GT. PAR(290)) THEN
            FO    = VOID(N15 + 1)
            ACAL  = VOID(N15 + 3)
            BCAL  = VOID(N15 + 4)
            IF (EPS .GT. 0.0) THEN
              ACAL  = ACAL + EPS * VOID(N15 + 5)
              BCAL  = BCAL + EPS * VOID(N15 + 6)
            END IF
            FC    = SQRT(ACAL**2 + BCAL**2)
            SUMFO = SUMFO + FO
            SUMFC = SUMFC + FC
          END IF
          N15 = N15 + 15
        END DO
        SCF = SUMFC / SUMFO
        WRITE (LU6, 99991, IOSTAT = IOST) SCF, PAR(290)
        CALL PLA262 (3)
        WRITE (LU7, 99991, IOSTAT = IOST) SCF, PAR(290)
        SUMFO = SUMFO * SCF
        SUMDL = 0.0
        SMFO  = 0.0
        SMDL  = 0.0
        N15   = 0
        N112  = 0
        IF (IPR(681) .EQ. 1) THEN
          NREF = NREFA
        ELSE
          NREF = NREFB
        END IF
        WRITE (LU6, 99956) NREFB, NREFA, NREF
        NM = 0
        DO N = 1, NREF
          FO   = VOID(N15 + 1) * SCF
          SIGF = MAX (VOID(N15 + 2) * SCF, 0.0001)
          ACAL = VOID(N15 + 3)
          BCAL = VOID(N15 + 4)
          AVA  = VOID(N15 + 5)
          AVB  = VOID(N15 + 6)
          IF (NLOOP .GT. 1) THEN
            IF (N .GT. NREFB) THEN
              IF (VOID(N15 + 14) .LE. PAR(486)) THEN
                IF (VOID(N15 + 15) .GT. 0) THEN
                  NM = NM + 1
                  IF (NM .EQ. 1) THEN
                    WRITE (LU6, 99954) PAR(486)
                    WRITE (LU7, 99954) PAR(486)
                  END IF
                  IH = NINT(VOID(N15 +  9))
                  IK = NINT(VOID(N15 + 10))
                  IL = NINT(VOID(N15 + 11))
                  WRITE(LU6, 99953) IH, IK, IL, AVA, AVB
                  WRITE(LU7, 99953) IH, IK, IL, AVA, AVB
                END IF
              END IF
            END IF
          END IF
          ACALS = ACAL
          BCALS = BCAL
          IF (EPS .GT. 0.0) THEN
            ACALS = ACALS + EPS * AVA
            BCALS = BCALS + EPS * AVB
          END IF
          IF (N .LE. NREFB) THEN
            FCS   = SQRT(ACALS**2 + BCALS**2)
            DELTA = ABS(FO - FCS)
            VOID(N15 + 7) = FO * ACALS / FCS - ACAL
            VOID(N15 + 8) = FO * BCALS / FCS - BCAL
          ELSE
            VOID(N15 + 7) = AVA
            VOID(N15 + 8) = AVB
          END IF
          IF (NLOOP .LT. NLOPM) THEN
            VOID(N15 + 5) = 0.0
            VOID(N15 + 6) = 0.0
          END IF
          IF (N .LE. NREFB) THEN
            SUMDL = SUMDL + DELTA
            IF (FO .GT. 4.0 * SIGF) THEN
              SMFO = SMFO + FO
              SMDL = SMDL + DELTA
              N112 = N112 + 1
            END IF
          END IF
          N15 = N15 + 15
        END DO
        RF  = SUMDL / SUMFO
        RFS = SMDL  / SMFO
        WRITE (BCD, 99993, IOSTAT = IOST) NLOOP, RF, NREF, RFS, N112
        WRITE (LU6, 99970, IOSTAT = IOST) BCD
        CALL PLA262 (5)
        WRITE (LU7, 99970, IOSTAT = IOST) BCD
        IF (IWIN .EQ. 1) THEN
          WRITE (BCD, 99977, IOSTAT = IOST)
     1      NLOOP, RF, NREF, RFS, N112, NINT(FS000)
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, BCD, 80, 0.35, 1, 2, 0.1, VRT)
          CALL GGIP (0.0, 0.0, 0.0, 6)
        END IF
        IF (NLOOP .LT. NLOPM) THEN
          CALL GEN108 (LU15, 0)
          DO I = 1, 2
            DO J = 1, NP41
              SXYZ(I, J) = 0.0
            END DO
          END DO
          NV = 0
          IBOT = NREFA * 15
          ITOP = IBOT + NGRID * 2
          IF (ITOP + 3 * (M1 + 2) * (M2 + 2) .GT. IADR) THEN
            WRITE (LU6, 99996, IOSTAT = IOST) 2, CHAR(IPR(223))
            WRITE (LU7, 99996, IOSTAT = IOST) 2, CHAR(IPR(223))
            RETURN
          END IF
          IF (IPR(304) .EQ. 0) THEN
            CALL PLA142 (-1, VOID(1), VOID(IBOT + 1), VOID(ITOP + 1),
     1           NREF, FS000)
          ELSE
            CALL PLA142 (-1, VOID(1), VOID(IBOT + 1), VOID(ITOP + 1),
     1           NREF, 0.000)
          END IF
          CALL GEN108 (LU9, 0)
          DO
            READ (LU15, IOSTAT = IOST) ILOC, NVOID
            IF (IOST .NE. 0) EXIT
            LOC    = IBOT + ILOC
            DELRHO = VOID(LOC - 1) / NGRID
            WRITE (LU9) LOC, DELRHO
            SXYZ(1, NVOID) = SXYZ(1, NVOID) + 1
            SXYZ(2, NVOID) = SXYZ(2, NVOID) + DELRHO
            NV = MAX (NV, NVOID)
          END DO
          FS000 = 0
          WRITE (PRBUF, 99995, IOSTAT = IOST)
          WRITE (LU6, 99974, IOSTAT = IOST) PRBUF(1:80)
          CALL PLA262 (3)
          WRITE (LU7, 99974, IOSTAT = IOST) PRBUF(1:80)
          DO I = 1, NV
            VVOL = SXYZ(1, I) * PAR(79)
            AVOL = 0
            BVOL = 0
            YUNK  = SXYZ(2, I)
            IF (YUNK .GT. 0.0) THEN
              FS000 = FS000 + YUNK
              AVOL  = VVOL  / (YUNK / 8)
              BVOL  = VVOL  / YUNK
            END IF
            WRITE (PRBUF, 99984, IOSTAT = IOST)
     1        I, (SXYZ(J, I), J = 10, 12),
     2        NINT (VVOL), NINT (YUNK), BVOL, NINT(AVOL)
            WRITE (LU6, 99975, IOSTAT = IOST) PRBUF(1:80)
            CALL PLA262 (1)
            WRITE (LU7, 99975, IOSTAT = IOST) PRBUF(1:80)
          END DO
          PAR(149) = FS000
          WRITE (TXT1(1), 99994, IOSTAT = IOST) NINT (FS000)
          WRITE (LU6, 99964, IOSTAT = IOST) TXT1(1)
          CALL PLA262 (2)
          WRITE (LU7, 99964, IOSTAT = IOST) TXT1(1)
          VA = 0
          DO I = IBOT + 1, ITOP, 2
            VA = VA + VOID(I) / NGRID
            VOID(I)     = 0.0
            VOID(I + 1) = 0.0
          END DO
          WRITE (LU6, 99985, IOSTAT = IOST) NINT(VA)
          CALL PLA262 (2)
          WRITE (LU7, 99985, IOSTAT = IOST) NINT(VA)
          CALL GEN108 (LU9, 0)
          DRHOMN =  99999.0
          DRHOMX = -99999.0
          DO
            READ (LU9, IOSTAT = IOST) LOC, DELRHO
            IF (IOST .NE. 0) EXIT
            DRHOMN = MIN (DRHOMN, DELRHO)
            DRHOMX = MAX (DRHOMX, DELRHO)
            IF (DELRHO .GT. PAR(285)) VOID(LOC - 1) = DELRHO
          END DO
          DRHOMX = DRHOMX * NGRID / PAR(98)
          DRHOMN = DRHOMN * NGRID / PAR(98)
          WRITE (LU6, 99983, IOSTAT = IOST) DRHOMN, DRHOMX, PAR(285),
     1      PAR(329), PAR(330), PAR(269)
          CALL PLA262 (3)
          WRITE (LU7, 99983, IOSTAT = IOST) DRHOMN, DRHOMX, PAR(285),
     1      PAR(329), PAR(330), PAR(269)
          CALL GEN028 (VOID(IBOT + 1), IPR(395), 3, 1)
          IF (IPR(304) .NE. 0) THEN
            WRITE (LU6, 99969, IOSTAT = IOST) VOID(IBOT + 1)
            WRITE (LU7, 99969, IOSTAT = IOST) VOID(IBOT + 1)
          END IF
          N15 = 0
          DO I = 1, NREFA
            IH = NINT(VOID(N15 +  9))
            IK = NINT(VOID(N15 + 10))
            IL = NINT(VOID(N15 + 11))
            IF (IH .LT. 0) IH = IH + M1
            IF (IK .LT. 0) IK = IK + M2
            IF (IL .LT. 0) IL = IL + M3
            LOC           = IBOT + 2 * ((IL * M2 + IK) * M1 + IH + 1)
            VOID(N15 + 5) = VOID(LOC - 1)
            IF (ICNTR .EQ. 1) VOID(N15 + 6) = VOID(LOC)
            N15           = N15 + 15
          END DO
          IF (ABS(ABS(FS000) - ABS(FSOLD)) .LT. PAR(250) * NSYM
     1        .AND. FS000 .GT. 1.0 .AND. RFSOD - RFS .LT. 0.005) THEN
            NLOPM = NLOOP + 1
          ELSE
            FSOLD = FS000
            RFSOD = RFS
          END IF
        ELSE
          IF (IPR(663) .EQ. 0) THEN
            OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sqd.sqf',
     1            STATUS = 'UNKNOWN')
          ELSE
            OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sq.sqf',
     1            STATUS = 'UNKNOWN')
          END IF
          WRITE (LU61, 99990, IOSTAT = IOST) (CIFDIR(I), I = 503, 509)
          DO I = 1, NV
            WRITE (LU61, 99967, IOSTAT = IOST)
     1        I, SXYZ(10, I), SXYZ(11, I), SXYZ(12, I),
     2        NINT(SXYZ(1,  I) * PAR(79)), NINT(SXYZ(2, I)), ''' '''
          END DO
          WRITE (LU61, 99957, IOSTAT = IOST) CIFDIR(639), PAR(84)
          WRITE (LU61, 99966, IOSTAT = IOST) CIFDIR(510)
          CLOSE (UNIT = LU61)
          CLOSE (UNIT = LU17, STATUS = 'DELETE')
          IF (IABS(IGBL(8)) .EQ. 3) THEN
            CLOSE (UNIT = LU1)
            IF (IPR(663) .LT. 0) THEN
              REWIND  LU24
              OPEN (LU1, FILE = NAMEFIL(1:KNMFIL)//'.dum',
     1              STATUS = 'UNKNOWN')
              DO
                READ  (LU24, 99975, IOSTAT = IOST) IDM
                IF (IOST .NE. 0) EXIT
                WRITE (LU1,  99975, IOSTAT = IOST) IDM
              END DO
              REWIND LU1
              EXST = .TRUE.
            ELSE
              INQUIRE (FILE = NAMEFIL(1:KNMFIL)//'.res', EXIST = EXST)
              IF (EXST) OPEN (LU1, FILE = NAMEFIL(1:KNMFIL)//'.res',
     1                  STATUS = 'UNKNOWN')
            END IF
          ELSE IF (IABS(IGBL(8)) .EQ. 2) THEN
            EXST = .TRUE.
          ELSE
            EXST = .FALSE.
          END IF
          IF (EXST) THEN
            OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sqd.ins',
     1            STATUS = 'UNKNOWN')
            OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_sq.ins',
     1            STATUS = 'UNKNOWN')
            REWIND LU1
            DO
              READ  (LU1,  99975, IOSTAT = IOST) IDM
              IF (IOST .NE. 0) EXIT
              IF (IDM(1:4) .EQ. 'WGHT') THEN
                WRITE (LU62, 99963, IOSTAT = IOST)
              ELSE IF (IDM(1:4) .EQ. 'ABIN') THEN
                CYCLE
              ELSE IF (IDM(1:4) .EQ. 'LIST') THEN
                CYCLE
              ELSE IF (IDM(1:4) .EQ. 'L.S.') THEN
                NEXTRA = NINT((PAR(149) * 9) / (IPR(48) * 8))
                WRITE (IDM, 99959) NEXTRA
              END IF
              WRITE (LU61, 99975, IOSTAT = IOST) IDM
              WRITE (LU62, 99975, IOSTAT = IOST) IDM
            END DO
            IF (IPR(663) .NE. 0) THEN
              CLOSE (UNIT = LU61, STATUS = 'DELETE')
              CLOSE (UNIT = LU1, STATUS = 'DELETE')
            ELSE
              CLOSE (UNIT = LU61)
            END IF
            CLOSE (UNIT = LU62)
          END IF
          IF (IPR(664) .EQ. 0) THEN
            REWIND LU16
            OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sq.hkl',
     1            STATUS = 'UNKNOWN')
            IF (IGBL(9) .EQ. 1) THEN
              CALL PLA134 (LU6, LU16, LU61, IPR(384))
            ELSE
              DO
                READ  (LU16, 99975, IOSTAT = IOST) IDM
                IF (IOST .NE. 0) EXIT
                WRITE (LU61, 99975, IOSTAT = IOST) IDM
              END DO
            END IF
          ELSE IF (IPR(664) .EQ. -1) THEN
            REWIND LU25
            OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sq.hkl',
     1            STATUS = 'UNKNOWN')
            DO
              READ  (LU25, 99975, IOSTAT = IOST) IDM
              IF (IOST .NE. 0) EXIT
              WRITE (LU61, 99975, IOSTAT = IOST) IDM
            END DO
          END IF
          CLOSE (UNIT = LU61)
C * GENERATE '.hkl' FILE FOR SHELXL97 AND
          OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sqd.hkl',
     1          STATUS = 'UNKNOWN')
          DO I = 1, 20
            DO J = 1, 9
              STAT(I, J) = 0.0
            END DO
          END DO
          X8MAX = 0
          SCLI8 = 1.0
C * DOUBLE LOOP FOR SCALING TO SHELXL FORMAT
          DO K = 1, 2
            IF (K .EQ. 2) THEN
              IF (X8MAX .GT. 0.99999E8) THEN
                SCLI8 = 0.99999E8 / X8MAX
              END IF
            END IF
            NPRT = 0
            IEND = -1
C * TRANSFORM REFLECTIONS FOR SF-CALCULATION (EXCLUDE NON-INTEGRAL H,K,L)
            DO
              CALL PLA137 (IH, IK, IL, IHT, IKT, ILT, XI, SIGI,
     1          SIGIW, DUM1, DUM2, DUM3, DUM4, IEND)
              IF (IEND .EQ. 1) EXIT
              IF (IGBL(9) .EQ. -1) XI = DUM1
              XSIGI = SCLI8 * SIGI
              IHKL  = ILT * MHK + IKT * MPH + IHT
              IF (IHKL .GT. 0) THEN
                ISGN = 1
              ELSE
                ISGN = -1
                IHKL = - IHKL
              END IF
              N15 = 15  * (NINT(VOID(IADR + IHKL)) - 1)
              IF (N15 .GE. 0) THEN
                IF (IGBL(9) .EQ. 1) THEN
                  XI    = XI    * 0.01
                  XSIGI = XSIGI * 0.01
                END IF
                FO    = SQRT(MAX(0.0, XI)) * SCF
                ACALM = VOID(N15 + 3)        + VOID(N15 + 12)
                BCALM = VOID(N15 + 4) * ISGN + VOID(N15 + 13)
                ACALS = VOID(N15 + 5)
                BCALS = VOID(N15 + 6) * ISGN
                ACALT = ACALS + ACALM
                BCALT = BCALS + BCALM
                FCALT = SQRT(ACALT**2 + BCALT**2)
                FOA   = (FO * ACALT / FCALT - ACALS) / SCF
                FOB   = (FO * BCALT / FCALT - BCALS) / SCF
                XXI   = SCLI8 * (FOA**2 + FOB**2)
                XNXI  = SCLI8 * XI
                IF (K .EQ. 1) THEN
                  X8MAX = MAX (X8MAX, XXI)
                  X8MAX = MAX (X8MAX, XSIGI)
                  X8MAX = MAX (X8MAX, XNXI)
                ELSE
                  IXI   = NINT(XXI)
                  ISIGI = NINT (XSIGI)
                  NXI   = NINT (XNXI)
                  IF (IGBL(37) .NE. 0) THEN
                    WRITE (LU61, 99979, IOSTAT = IOST)
     1                IH, IK, IL, IXI, ISIGI,
     2                (V2(I), V3(I), I = 1, 3), NXI, ACALS, BCALS, 1.0
                  ELSE
                    WRITE (LU61, 99978, IOSTAT = IOST)
     1                IH, IK, IL, IXI, ISIGI, NXI, ACALS, BCALS, 1.0
                  END IF
                  ST   = VOID(N15 + 14)
                  FCS  = SQRT(ACALS**2 + BCALS**2)
                  FCM  = SQRT(ACALM**2 + BCALM**2)
                  PFCS = ATAN2(BCALS, ACALS) * RGBL(6)
                  PFCM = ATAN2(BCALM, ACALM) * RGBL(6)
                  PFCT = ATAN2(BCALT, ACALT) * RGBL(6)
                  DEL1  = MOD(PFCM + 360.0 - PFCS, 360.0)
                  IF (DEL1 .GT. 180.0) DEL1 = 360.0 - DEL1
                  DEL2  = MOD(PFCM + 360.0 - PFCT, 360.0)
                  IF (DEL2 .GT. 180.0) DEL2 = 360.0 - DEL2
                  IF (SIGI .GT. 0.0) THEN
                    DELS = ABS(FO**2 - FCALT**2) / (SCF**2 * SIGI)
                    IF (ST .LE. PAR(286) .AND. DELS .GT. PAR(288)) THEN
                      NPRT = NPRT + 1
                      IF (NPRT .EQ. 1) THEN
                        CALL PLA262 (-2)
                        WRITE (LU7, 99992, IOSTAT = IOST)
                      END IF
                      CALL PLA262 (1)
                      WRITE (LU7, 99973, IOSTAT = IOST)
     1                  IH, IK, IL, ST, FO, FCM, FCS,
     2                  FCALT, DELS, XI * SCF**2, SIGI * SCF**2
                    END IF
                  END IF
                  N = MAX (1, MIN (20, INT(ST * 20 + 0.5)))
                  STAT(N, 1) = STAT(N, 1) + FCM
                  STAT(N, 2) = STAT(N, 2) + FCS
                  STAT(N, 3) = STAT(N, 3) + FCALT
                  STAT(N, 4) = STAT(N, 4) + FO
                  STAT(N, 5) = STAT(N, 5) + DEL1
                  STAT(N, 6) = STAT(N, 6) + DEL2
                  STAT(N, 7) = STAT(N, 7) + 1.0
                  STAT(N, 8) = STAT(N, 8) + ABS(FCM - FO)
                  STAT(N, 9) = STAT(N, 9) + ABS(FCALT - FO)
                END IF
              END IF
            END DO
          END DO
          IF (IPR(664) .NE. 0) CLOSE (LU61, STATUS = 'DELETE')
C * GENERATE '.fab' FILE FOR SHELXL20xy: H, K, L, ASOLV, BSOLV
          OPEN (LU65, FILE = NAMEFIL(1:KNMFIL)//'_sq.fab',
     1          STATUS = 'UNKNOWN')
          N15 = 0
          DO I = 1, NREFA
            IF (NINT(VOID(N15 + 15)) .GT. 0) THEN
              IH    = NINT(VOID(N15 +  9))
              IK    = NINT(VOID(N15 + 10))
              IL    = NINT(VOID(N15 + 11))
              ACALS = VOID(N15 + 5)
              IF (ICNTR .EQ. 1) THEN
                BCALS = VOID(N15 + 6)
              ELSE
                 BCALS = 0.0
              END IF
              WRITE (LU65, 99960, IOSTAT = IOST)
     1            IH, IK, IL, ACALS, BCALS
            END IF
            N15 = N15 + 15
          END DO
          WRITE (LU65, 99960, IOSTAT = IOST) 0, 0, 0, 0.0, 0.0
          WRITE (LU65, 99990, IOSTAT = IOST) (CIFDIR(I), I = 503, 509)
          DO I = 1, NV
            WRITE (LU65, 99967, IOSTAT = IOST)
     1        I, SXYZ(10, I), SXYZ(11, I), SXYZ(12, I),
     2        NINT(SXYZ(1,  I) * PAR(79)), NINT(SXYZ(2,  I)), ''' '''
          END DO
          IF (IPR(610) .GT. 0) THEN
            WRITE (LU65, 99998, IOSTAT = IOST) PAR(486),
     1       (CIFDIR(I), I = 642, 645)
            NMIN = MIN(IPR(610), NP60)
            DO I = 1, NMIN
              WRITE (LU65, 99955) (MISSING(J, I), J = 1, 3),
     1          FLOAT(MISSING(4, I)) / 1000.0
            END DO
          END IF
          WRITE (LU65, 99957, IOSTAT = IOST) CIFDIR(639), PAR(84)
          WRITE (LU65, 99962, IOSTAT = IOST) CIFDIR(510)
          REWIND LU2
          DO
            READ (LU2, 99975, IOSTAT = IOST) IDM
            IF (IOST .NE. 0) EXIT
            WRITE (LU65, 99975, IOSTAT = IOST) IDM
          END DO
          WRITE (LU65, 99958)
          CALL PLA130 (STAT, TXT1)
          RETURN
        END IF
      END DO
      RETURN
99999 FORMAT ('SQUEEZE - Procedure (cf. BYPASS-procedure - ',
     1 'P. van der Sluis & A.L. Spek (1990). Acta Cryst. A46, ',
     2 '194-201)', /, 120('='))
99998 FORMAT ('# Missing Reflections Below sin(th)/lambda=', F5.2, /,
     1        'loop_', 4(/, 2X, A))
99997 FORMAT (/, 'F: No Suitable Reflections Found', /)
99996 FORMAT (/, 'F: Scratch Array Overrun Code', I2, ' (Fatal)', /,
     1        '    Use larger program version i.e. larger NVD', A, /)
99995 FORMAT ('Void  X(av) Y(av) Z(av) Volume Ang^3 El-Count (e-)',
     1        ' Vol/Electron Vol/Atom')
99994 FORMAT ('Total (Positive) Electron Count in Voids/Cell =', I9)
99993 FORMAT (':: Cycle =', I3, ', R(F) =', F5.2, ', Nref(Hemi) =',
     1        I6, ', R(F > 4SIGF) =', F5.2, ' Nref =', I6)
99992 FORMAT ('  H  K  L  Sinth/l F(obs)  F(mod) F(solv)  ',
     1        'F(tot) D(F^2)/S       I       Sig(I)', /)
99991 FORMAT (/, ':: Fo-Scale =', E12.6, ' - SinT/L-Min =', F5.2,
     1        ' for Fo/Fc-Scaling', /)
99990 FORMAT ('# SQUEEZE RESULTS ', /,
     1        '# Note: Data are Listed for all Voids in the P1 Unit',
     2        ' Cell', /,
     3        '# i.e. Centre of Gravity, Solvent Accessible Volume,', /,
     4        '# Recovered number of Electrons in the Void and', /,
     5        '# Details about the Squeezed Material', /,
     6        'loop_', 7(/, 2X, A))
99985 FORMAT (/, 'Total (Fo-Fc)map Electron Count in  Unit Cell =', I9)
99984 FORMAT (I4, 1X, 3F6.3, 3X, I10, I9, 8X, F10.1, I9)
99983 FORMAT (/, 'VOID-Fo-Fc-Map:    Rho(min) =', F10.2,
     1        ', Rho(max) =', F10.2, ', RhoCutOff =', F6.2, /,
     2        'PeaksCloseToAtoms: Rho(min) =', F10.2, ', Rho(max) =',
     3        F10.2, ', RhoCutOff =', F6.2)
99979 FORMAT (3I4, 2I8, 4X, 6F8.5, I8, 2F8.2, F8.4)
99978 FORMAT (3I4, 2I8, 52X, I8, 2F8.2, F8.4)
99977 FORMAT (I3, F9.3, 3X, I10, F12.3, I11, I10)
99976 FORMAT ('Cycle  R(F) Nref(Hemi)  R(F)>4*sig(F)  Nref',
     1        '  El(Solv)/Cell')
99975 FORMAT (A)
99974 FORMAT (A, /, 80('='))
99973 FORMAT (3I3, 6F8.2, F12.2, F10.2)
99970 FORMAT (/, A, /)
99969 FORMAT ('FFT-F000 = ', F10.2)
99967 FORMAT (I4, 3(F7.3), 2I10, 1X, A)
99966 FORMAT (A, ' ?')
99965 FORMAT (24X, 'PLATON/SQUEEZE ')
99964 FORMAT (/, A)
99963 FORMAT ('ABIN')
99962 FORMAT (A, /, ';')
99960 FORMAT (3I5, 2F10.2)
99959 FORMAT ('L.S. 5 0', I5)
99958 FORMAT (';')
99957 FORMAT (A, F6.2)
99956 FORMAT (/, ':: NREFB, NREFA, NREF:', 3I10, /)
99955 FORMAT (3I5, F10.3)
99954 FORMAT (':: Missing Reflections with sin(theta)/lambda =', F5.2,
     1  /, 4X, 'H', 4X, 'K', 4X, 'L', 5X,  'ASOLV', 5X, 'BSOLV')
99953 FORMAT (3I5,2F10.2)
      END SUBROUTINE PLA129
      SUBROUTINE PLA130 (STAT, TXT1)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DIMENSION STAT(20, 9)
      CHARACTER TXT(28)*62, TXT1(3)*62
      DATA (TXT(I), I = 1, 28)/
     1 '==============================================================',
     2 'SQUEEZE produces and analyzes a phase enhanced difference map',
     3 'using the files name.res & name.hkl. Density found in solvent',
     4 'accessible voids is back-fourier transformed into A(solv) &',
     5 'B(solv) contributions to F(calc) to be used for subsequent',
     6 'L.S. refinement. No model refinement is done by PLATON/SQUEEZE',
     7 '==============================================================',
     8 'HOW TO PROCEED with L.S. refinement after running SQUEEZE:',
     9 '==============================================================',
     * 'SHELXL20xy: Continue refinement in the presence of the three',
     1 'files name_sq.ins, name_sq.hkl & name_sq.fab',
     2 'Additional info on name_sq.sqf & name_sq.sqz',
     3 '==============================================================',
     4 'SHELXL97 (Deprecated): Refine in the presence of the files',
     5 'name_sqd.ins, name_sqd.hkl, name_sqd.sqz & name_sqd.sqf:',
     6 '-The file name_sqd.hkl contains solvent free reflection data.',
     7 ' (Original I(obs), A(solv) and B(solv) are beyond column 80)',
     8 '-Use this name_sqd.hkl file to continue (SHELXL97) refinement',
     9 ' with the solvent free name_sqd.ins. (A copy of the original',
     * ' name.res file).',
     1 '-After SHELXL(97) L.S.-convergence, run PLATON again with the',
     2 ' instruction ''CALC FCF-SQ'' using the new name_sqd.ins and',
     3 ' name_sqd.hkl files in order to produce a proper final',
     4 ' FoFc-CIF on a file named name_sqd_p.fcf.',
     5 '-The name_sqd.sqf file produced by PLATON (detailing the',
     6 ' SQUEEZE results) is appended to name_sqd.cif (created by',
     7 ' SHELXL(97)) to generate a final name_sqd_p.cif file.',
     8 '-Optionally inspect the improved peak list on name_sqd.sqz.'/
      CALL PLA262 (0)
      WRITE (LU7, 99993, IOSTAT = IOST)
      DO I = 1, 20
        IF (STAT(I, 7) .GT. 0.0) THEN
          IF (STAT(I, 4) .NE. 0.0) THEN
            STAT(I, 8) = STAT(I, 8) / STAT(I, 4)
            STAT(I, 9) = STAT(I, 9) / STAT(I, 4)
          ELSE
            STAT(I, 8) = 0.0
            STAT(I, 9) = 0.0
          END IF
          DO J = 1, 6
            STAT(I, J) = STAT(I, J) / STAT(I, 7)
          END DO
          ST = I / 20.0
          WRITE (LU7, 99992, IOSTAT = IOST) ST, (STAT(I, K), K = 1, 9)
        END IF
      END DO
      WRITE (LU7, 99998, IOSTAT = IOST)
      IF (MAX(-PAR(329), PAR(330)) .GT. 1.0)
     1  WRITE (LU7, 99997, IOSTAT = IOST) PAR(329), PAR(330)
      IF (IPR(489) + IPR(490) .GT. 0)
     1  WRITE (LU7, 99996, IOSTAT = IOST) IPR(489) + IPR(490)
      IF (IGBL(29) .EQ. 1 .OR. IGBL(29) .EQ. 3) THEN
        IB = 7
        IC = 13
      ELSE
        IB = 1
        IC = 28
      END IF
      WRITE (LU6, 99999, IOSTAT = IOST) (TXT(I), I = IB, IC)
      WRITE (LU7, 99999, IOSTAT = IOST) (TXT(I), I = IB, IC)
      IF (IWIN .EQ. 1) THEN
        CALL PLA013 (2, 1)
        CALL GGIP (HORS, VERT, 0.0, 1)
        VRT = VERT - 1.0
        CALL GGIP09 (0.0, 'S U M M A R Y', 13, 0.60, 5 + IGBL(68),
     1               2, 10.0, VRT)
        VRT = VRT - 0.9
        CALL GGIP09 (0.0, TXT1(1), 62, 0.30, 1, 2, 5.0, VRT)
        IF (MAX(-PAR(329), PAR(330)) .GT. 1.0) THEN
          WRITE (TXT1(2), 99995, IOSTAT = IOST) PAR(329), PAR(330)
          VRT = VRT - 0.40
          CALL GGIP09 (0.0, TXT1(2), 62, 0.30, 1, 2, 5.0, VRT)
        END IF
        IF (IPR(610) .GT. 0) THEN
          WRITE (TXT1(3), 99994, IOSTAT = IOST) PAR(486), IPR(610)
          VRT = VRT - 0.40
          CALL GGIP09 (0.0, TXT1(3), 62, 0.30, 2, 2, 5.0, VRT)
          VRT = VRT - 0.40
          CALL GGIP09 (0.0, 'Electron Count Uncertain', 24, 0.30,
     1                       2, 2, 5.0, VRT)
        END IF
        DO I = IB, IC
          VRT = VRT - 0.60
          CALL GGIP09 (0.0, TXT(I), 62, 0.45, 1, 2, 1.0, VRT)
        END DO
        CALL PLA297 (0)
      END IF
      IPR(1) = 1
      RETURN
99999 FORMAT (/, 27(A, /), /)
99998 FORMAT (/, 'Comments on and Analysis of the SQUEEZE run',
     1        /, 80('='))
99997 FORMAT (/, '- Significant Residual Density Excursion(s) in  the',
     1        /, '  Ordered part of the Structure:', 2F6.1)
99996 FORMAT (/, '- Model includes', I4, ' Isotropic Non-H-Atoms', /,
     1           '  Rerun SQUEEZE with Anisotropically Refined Model')
99995 FORMAT ('Significant Residual Model Density Excursions:',
     1        F5.1, ',', F5.1)
99994 FORMAT ('Number of Missing Reflections below sin(th)/L =',
     1         F5.2, ' =', I4)
99993 FORMAT ('SQUEEZE Statistics on the Difference Map Phasing', /,
     1        80('='), //,
     2  'FcMod  = Average contribution to Fc from discrete model', /,
     3  'FcSolv = Average contribution to Fc from solvent region', /,
     4  'FcTot  = Average Fc total ( = model + solvent contrib.)', /,
     5  'DelMS  = Average Phase difference between model and',
     6  ' solvent contrib.', /,
     7  'DelMT  = Average Phase difference between model  and',
     8  ' combined contrib.', /,
     9  'N      = Number of reflections in Sin(Theta)/Lambda range',/,
     *  'R(Mod) = SIGMA(ABS(ABS(FcMod) - Fo)) / SIGMA(Fo)', /,
     1  'R(Tot) = SIGMA(ABS(ABS(FcTot) - Fo)) / SIGMA(Fo)', /,
     2  /, 'SinT/L <FcMod> <FcSolv>  <FcTot>    <Fo> ',
     3        ' <DelMS> <DelMT>    N  R(Mod) R(Tot)', /, 80('='))
99992 FORMAT (F4.2, 4F9.2, 2F8.2, F7.0, 2F7.3)
      END SUBROUTINE PLA130
      SUBROUTINE PLA131 (MLOOP)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP45=2048)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER DUM*80, DUMA*132
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      DIMENSION RESULT(10, 7)
      COMMON /MSWDS/ DOS
      LOGICAL DOS
      DO J = 1, 7
        RESULT(1, J) = 0.0
      END DO
      IF (IPR(221) .GT. 0) IPR(682) = MIN (10, MLOOP)
      IGBL(31) = 10
C * HYBRID: SQUEEZE/SHELXL20xy CYCLE BASED ON SUPPLIED .res/.hkl or .cif
C * CHECK FOR SHELXL20xy CIF OR INS/RES + HKL
      IF (IABS(IGBL(8)) .EQ. 3 .AND. IPR(663) .NE. 0
     1  .AND. IPR(664) .NE. 0) THEN
        CLOSE (UNIT = LU24)
        CLOSE (UNIT = LU25)
        CLOSE (UNIT = LU26)
        CLOSE (UNIT = LU1)
        OPEN (LU1, FILE = NAMEFIL(1:KNMFIL)//'_sx.ins',
     1    STATUS = 'UNKNOWN')
        CLOSE (UNIT = LU16)
        OPEN (LU16, FILE = NAMEFIL(1:KNMFIL)//'_sx.hkl',
     1    STATUS = 'UNKNOWN')
      ELSE IF (IGBL(29) .NE. -1) THEN
        IPR(2) = 71
        IF (IPR(2) .EQ. 0) IPR(2) = -1
        IGBL(1) = 3
        RETURN
      END IF
C * CREATE SCRATCH .INS & .HKL FILES FOR SHELXL REFINEMENT
      LU = LU1
      REWIND LU1
      REWIND LU16
      OPEN (LU62, FILE = 'x_dummy.hkl', STATUS = 'UNKNOWN')
      DO
        READ (LU16, 99999, IOSTAT = IOST) DUM
        IF (IOST .NE. 0) EXIT
        WRITE (LU62, 99999) DUM
      END DO
      IF (IGBL(29) .GT. 0) THEN
        CLOSE (UNIT = LU16, STATUS = 'DELETE')
      ELSE
        CLOSE (UNIT = LU16)
      END IF
      CLOSE (UNIT = LU62)
C * OUTER REFINEMENT LOOP - GET NUMBER OF MAJOR REFINEMENT LOOPS
      NLOOP    = 1
      NLOOPMAX = IPR(682)
      DO
        OPEN (LU62, FILE = 'x_dummy.ins', STATUS = 'UNKNOWN')
        DO
          READ (LU, 99999, IOSTAT = IOST) DUM
          IF (IOST .NE. 0) EXIT
          IF (DUM(1:4) .EQ. 'L.S.') THEN
            WRITE (LU62, 99995) (IPR(619) + 1) * 4
            CALL GEN072 (DUM, IFL, FN, KL, KN, 0, 0, 1, 5, 80, 7, NP17)
            FN(1) = 5
            WRITE (DUM, 99994) 'L.S.', (NINT(FN(I)), I = 1, KN)
            WRITE (6, 99999) 'Substituted:'//DUM(1:65)
          ELSE IF (DUM(1:4) .EQ. 'LIST') THEN
            CYCLE
          ELSE IF (DUM(1:4) .EQ. 'ACTA') THEN
            CYCLE
          ELSE IF (DUM(1:4) .EQ. 'DAMP') THEN
            WRITE (6, 99999) 'Deleted:    '//DUM(1:65)
            CYCLE
          END IF
          WRITE (LU62, 99999) DUM
        END DO
        IF (IPR(663) .NE. 0) THEN
          CLOSE (UNIT = LU, STATUS = 'DELETE')
          IPR(663) = 0
        ELSE
          CLOSE (UNIT = LU)
        END IF
        CLOSE (UNIT = LU62)
C * REFINE AND CREATE .cif AND .fcf IN A SPAWNED SHELXL20xy JOB
        KERR = 0
        CALL SPAWN (SHLPATH(1:IGBL(110))//' x_dummy', KERR)
        OPEN (LU61, FILE = 'x_dummy.cif', STATUS = 'UNKNOWN')
        DO
          READ (LU61, 99999, IOSTAT = IOST) DUM
          IF (IOST .NE. 0) EXIT
          IF (DUM(1:22) .EQ. '_refine_ls_R_factor_gt') THEN
            READ (DUM(34:40), *) RESULT(NLOOP, 1)
          ELSE IF (DUM(1:24) .EQ. '_refine_ls_wR_factor_ref') THEN
            READ (DUM(34:40), *) RESULT(NLOOP, 2)
          ELSE IF (DUM(1:30) .EQ. '_refine_ls_goodness_of_fit_ref') THEN
            READ (DUM(34:40), *) RESULT(NLOOP, 3)
          ELSE IF (DUM(1:24) .EQ. '_refine_diff_density_max') THEN
            READ (DUM(25:33), *) RESULT(NLOOP, 4)
          ELSE IF (DUM(1:24) .EQ. '_refine_diff_density_min') THEN
            READ (DUM(25:33), *) RESULT(NLOOP, 5)
            EXIT
          END IF
        END DO
        CLOSE (UNIT = LU61)
C * RUN PLATON/SQUEEZE
        KERR = 0
        IF (DOS) THEN
        CALL SPAWN (PLAPATH(1:IGBL(80))//
     1    ' -q +0platon.log x_dummy.cif', KERR)
        ELSE
          CALL SPAWN (PLAPATH(1:IGBL(80))//' -q x_dummy.cif', KERR)
        END IF
        OPEN (LU61, FILE = 'x_dummy_sq.sqz', STATUS = 'UNKNOWN')
        DO
          READ (LU61, 99999, IOSTAT = IOST) DUM
          IF (IOST .NE. 0) EXIT
          IF (DUM(1:9) .EQ. '# Solvent') THEN
            READ (DUM(30:39), *) RESULT(NLOOP, 7)
          ELSE IF (DUM(1:11) .EQ. '# Electrons') THEN
            READ (DUM(30:39), *) RESULT(NLOOP, 6)
            EXIT
          END IF
        END DO
        CLOSE (UNIT = LU61)
        IF (NLOOP .GT. 1) THEN
          IF (NINT(RESULT(NLOOP, 6)) .EQ. NINT(RESULT(NLOOP - 1, 6)))
     1      NLOOPMAX = NLOOP
        END IF
        IF (NLOOP .LT. NLOOPMAX) THEN
          NLOOP = NLOOP + 1
C * COPY HKL & RES FILES FOR SCRATCH USE
          OPEN (LU61, FILE = 'x_dummy_sq.fab', STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = 'x_dummy.fab',    STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99999, IOSTAT = IOST) DUM
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99999) DUM
          END DO
          CLOSE (UNIT = LU61)
          CLOSE (UNIT = LU62)
          OPEN (LU61, FILE = 'x_dummy_sq.ins', STATUS = 'UNKNOWN')
          LU = LU61
        ELSE
C * FINAL FILE RENAME TO NAME_sq.ins
          OPEN (LU61, FILE = 'x_dummy_sq.ins', STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_sq.ins',
     1      STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99999, IOSTAT = IOST) DUM
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99999) DUM
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          CLOSE (UNIT = LU62)
C * FINAL FILE RENAME TO NAME_sq.hkl
          OPEN (LU61, FILE = 'x_dummy_sq.hkl', STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_sq.hkl',
     1      STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99999, IOSTAT = IOST) DUM
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99999) DUM
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          CLOSE (UNIT = LU62)
C * FINAL FILE RENAME TO NAME_sq.fab
          OPEN (LU61, FILE = 'x_dummy_sq.fab', STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_sq.fab',
     1      STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99999, IOSTAT = IOST) DUM
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99999) DUM
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          CLOSE (UNIT = LU62)
C * FINAL FILE RENAME TO NAME_sq.sqz
          OPEN (LU61, FILE = 'x_dummy_sq.sqz', STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_sq.sqz',
     1      STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99999, IOSTAT = IOST) DUM
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99999) DUM
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          CLOSE (UNIT = LU62)
C * FINAL FILE RENAME TO NAME_sq.sqf
          OPEN (LU61, FILE = 'x_dummy_sq.sqf', STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_sq.sqf',
     1      STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99999, IOSTAT = IOST) DUM
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99999) DUM
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          CLOSE (UNIT = LU62)
C * FINAL FILE RENAME TO NAME_sq.lis
          OPEN (LU61, FILE = 'x_dummy_sq.lis', STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_sq.lis',
     1      STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99999, IOSTAT = IOST) DUMA
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99999) DUMA
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          CLOSE (UNIT = LU62)
C * REMOVE INTERMEDIATES
          OPEN (LU61, FILE = 'x_dummy.ins', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          OPEN (LU61, FILE = 'x_dummy.res', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          OPEN (LU61, FILE = 'x_dummy.eld', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          OPEN (LU61, FILE = 'x_dummy.fab', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          OPEN (LU61, FILE = 'x_dummy.hkl', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          OPEN (LU61, FILE = 'x_dummy.cif', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          OPEN (LU61, FILE = 'x_dummy.lst', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          OPEN (LU61, FILE = 'x_dummy.fcf', STATUS = 'UNKNOWN')
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          WRITE (LU6, 99998)
          DO I = 1, NLOOPMAX
            WRITE (LU6, 99997) I, (RESULT(I, J), J = 1, 7)
          END DO
          IF (IPR(2) .EQ. 0) IPR(2) = -1
C * ERROR HANDLING
          IGBL(1) = 3
          EXIT
        END IF
      END DO
      RETURN
99999 FORMAT (A)
99998 FORMAT (//,'HYBRID: SQUEEZE/SHELXL LOOP RESULTS',//,
     1 '-------------S.H.E.L.X.L.2.0.1.4--------- -----SQUEEZE----',/,
     1 'CYC      R1     wR2       S RhoMax RhoMin Electrons Volume')
99997 FORMAT (I3, 3F8.4, 2F6.2, 2F8.1)
99995 FORMAT ('ACTA', /, 'LIST', I3)
99994 FORMAT (A, I3, 10I5)
      END SUBROUTINE PLA131
      SUBROUTINE PLA132
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP34=647,NP38=150,NP39=30,
     3 NP41=200,NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NP60=100,
     4 NKW=49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CIF/ CIFDIR
      CHARACTER CIFDIR(NP34)*(NKW)
      LOGICAL EXST
      INTEGER HMAX
C * STRUCTURE FACTOR CALCULATION FOR CALC FCF - IPR(210) = -1
      CALL PLA023 (0)
      NATO = IPR(589)
      IF (NATO .LT. 0) THEN
        IPR(1) = 1
        IPR(2) = 42
        RETURN
      END IF
      NSYMH = IPR(255)
      ICNTR = IPR(257)
      IND1  = 1
      IND2  = 2
      IND3  = 3
      NREF  = 0
      SOMXO = 0.0
      SOMXC = 0.0
      IF (IPR(259) .EQ. 5 .OR. IPR(259) .EQ. 6) THEN
        IHEXL = 1
      ELSE
        IHEXL = 0
      END IF
      CALL GEN108 (LU9, 0)
      HMAX = -999
      KMAX = -999
      LMAX = -999
      IHT  = 0
      IKT  = 0
      ILT  = 0
      IEND = -1
      DO WHILE (IEND .NE. 1)
        CALL PLA137 (IH, IK, IL, IHT, IKT, ILT, XOBS, SIGI,
     1    SIGIW, UCINT, ACALS, BCALS, ABSCOR, IEND)
        IF (IEND .EQ. 1) THEN
          IF (NREF .EQ. 0) THEN
            WRITE (LU6, 99998, IOSTAT = IOST)
            IPR(210) = 0
            RETURN
          ELSE
            PAR(166) = ASIN(SQRT(PAR(166)) * PAR(17)) * RGBL(6)
            IF (IPR(259) .EQ. 4) THEN
              HMAX = MAX (HMAX, KMAX)
              KMAX = HMAX
            ELSE IF (IPR(259) .EQ. 7) THEN
              HMAX = MAX (HMAX, KMAX, LMAX)
              KMAX = HMAX
              LMAX = HMAX
            END IF
          END IF
        ELSE
          HMAX = MAX (HMAX, IABS(IHT))
          KMAX = MAX (KMAX, IABS(IKT))
          LMAX = MAX (LMAX, IABS(ILT))
          IF (IHEXL .EQ. 1) THEN
            HMAX = MAX (KMAX, HMAX, IABS(IHT + IKT))
            KMAX = HMAX
          END IF
          IF (IPR(259) .EQ. 4) THEN
            HMAX = MAX (HMAX, KMAX)
            KMAX = HMAX
          ELSE IF (IPR(259) .EQ. 7) THEN
            HMAX = MAX (HMAX, KMAX, LMAX)
            KMAX = HMAX
            LMAX = HMAX
          END IF
          NREF   = NREF + 1
          ACAL   = 0.0
          BCAL   = 0.0
          ACALA  = 0.0
          BCALA  = 0.0
          ACALAF = 0.0
          BCALAF = 0.0
          IF (IGBL(9) .EQ. -1) THEN
            IF (IPR(210) .EQ. -1) THEN
              ACAL = ACALS
              BCAL = BCALS
              XOBS = UCINT * ABSCOR
            END IF
          END IF
          CALL PLA135 (IHT, IKT, ILT, ACALX, BCALX, ACALA, BCALA,
     1      ACALAF, BCALAF, SNTHA)
          ACAL = ACAL + ACALX + ACALA
          BCAL = BCAL + BCALX + BCALA
          XCAL = ACAL ** 2 + BCAL ** 2
          IF (IPR(193) .EQ. 2) THEN
            IH2 = NINT(PAR(332) * IHT + PAR(333) * IKT + PAR(334) * ILT)
            IK2 = NINT(PAR(335) * IHT + PAR(336) * IKT + PAR(337) * ILT)
            IL2 = NINT(PAR(338) * IHT + PAR(339) * IKT + PAR(340) * ILT)
            ACL = 0.0
            BCL = 0.0
            CALL PLA135 (IH2, IK2, IL2, ACL, BCL, ACLA, BCLA,
     1        ACALAF, BCALAF, SNTHA)
            ACL = ACL + ACLA
            BCL = BCL + BCLA
            XCL = ACL ** 2 + BCL ** 2
            XCAL = (1.0 - PAR(341)) * XCAL + PAR(341) * XCL
          END IF
          IF (IPR(408) .LE. 0) THEN
            IF (PAR(229) .GT. -99999.0 .AND. IGBL(9) .NE. 1) THEN
              SN2TH = 2 * SNTHA * SQRT(1.0 - MIN(SNTHA, 1.0) ** 2)
              XOBS = XOBS *
     1      (1.0 + 0.001 * PAR(229) * XCAL * PAR(17)**3 / SN2TH) ** 0.25
            END IF
          END IF
          IF (XOBS .GT. 2 * SIGI) THEN
            SOMXO = SOMXO + XOBS
            SOMXC = SOMXC + XCAL
          END IF
          IF (ACAL .EQ. 0.0 .AND. BCAL .EQ. 0.0) THEN
            PCAL = 0.0
          ELSE
            PCAL = ATAN2 (BCAL, ACAL) * RGBL(6)
          END IF
          WRITE (LU9) IH, IK, IL, IHT, IKT, ILT, XOBS, XCAL, SIGI,
     1      PCAL, ACAL, BCAL, ACALA, BCALA
        END IF
      END DO
      IF (IGBL(9) .EQ. 1) THEN
        IF (IPR(516) .EQ. 0) THEN
          SCF = 0.01 * PAR(240)
        ELSE
          SCF = SOMXC / (SOMXO * PAR(240))
        END IF
      ELSE
        SCF = SOMXC / (SOMXO * PAR(240))
      END IF
      WRITE (LU6, '('':: SCF ='', F10.6)', IOSTAT = IOST) SCF
      CALL GEN108 (LU9,  0)
      CALL GEN108 (LU17, 0)
      FCLM = 0.0
      NR7  = 0
      DO I = 1, NREF
        READ (LU9) IH, IK, IL, IHT, IKT, ILT, XOBS, XCAL, SIGI,
     1   PCAL, ACAL, BCAL, ACALA, BCALA
        XOBS = MAX (0.0, XOBS) * SCF
        SIGI = SIGI * SCF
        XCAL = XCAL / PAR(240)
        IF (IPR(414) .GT. 0) THEN
          IF (.TRUE.) THEN
            XCALC = XCAL
            BCAL  = BCAL - BCALA
            IF (ACAL .EQ. 0.0 .AND. BCAL .EQ. 0) THEN
              PCAL = 0.0
            ELSE
              PCAL = ATAN2 (BCAL, ACAL) * RGBL(6)
            END IF
            XCAL = ACAL**2 + BCAL**2
            XOBS = XOBS * XCAL / XCALC
          ELSE
          XOBS = (SQRT(XOBS) * ACAL / SQRT(XCAL) - ACALA) ** 2 +
     1           (SQRT(XOBS) * BCAL / SQRT(XCAL) - BCALA) ** 2
          ACAL = ACAL - ACALA
          BCAL = BCAL - BCALA
          IF (ACAL .EQ. 0.0 .AND. BCAL .EQ. 0) THEN
            PCAL = 0.0
          ELSE
            PCAL = ATAN2 (BCAL, ACAL) * RGBL(6)
          END IF
          XCAL = ACAL ** 2 + BCAL ** 2
          END IF
        END IF
        VOID(NR7 + 1) = IHT
        VOID(NR7 + 2) = IKT
        VOID(NR7 + 3) = ILT
        VOID(NR7 + 4) = XOBS * PAR(240)
        VOID(NR7 + 5) = XCAL * PAR(240)
        VOID(NR7 + 6) = SIGI * PAR(240)
        VOID(NR7 + 7) = PCAL
        FCLM          = MAX (FCLM, SQRT(XCAL * PAR(240)))
        NR7           = NR7  + 7
      END DO
      SUM1     = 0.0
      SUM2     = 0.0
      SUM3     = 0.0
      SUM4     = 0.0
      IPR(411) = HMAX
      IPR(412) = KMAX
      IPR(413) = LMAX
      MPH      = 2 * HMAX + 1
      MPK      = 2 * KMAX + 1
      MPL      = 2 * LMAX + 1
      MHK      = MPH * MPK
      MHKL     = MPL * MHK
      MHKLH    = (MHKL - 1) / 2
      IADR     = NVD - MHKLH
      IADR1    = NVD - MHKL
      IF (IADR1 .LT. NR7) THEN
        WRITE (LU6, 99994, IOSTAT = IOST)
        RETURN
      END IF
      DO I = 1, MHKL
        VOID(IADR1 + I) = - 1.0
      END DO
      NR7 = 0
      DO I = 1, NREF
        IHT  = NINT(VOID(NR7 + 1))
        IKT  = NINT(VOID(NR7 + 2))
        ILT  = NINT(VOID(NR7 + 3))
        IHKL = ILT * MHK + IKT * MPH + IHT
        N = NINT (VOID(IADR + IHKL))
        IF (N .LT. 0) THEN
          VOID(IADR + IHKL) = I
        ELSE
          XOBS1 = VOID((N - 1) * 7 + 4)
          SIGI1 = VOID((N - 1) * 7 + 6)
          IF (SIGI1 .GT. 0.0) THEN
            WGTI1 = 1.0 / SIGI1**2
          ELSE
            WGTI1 = 1.0
          END IF
          XOBS2 = VOID(NR7 + 4)
          SIGI2 = VOID(NR7 + 6)
          IF (SIGI2 .GT. 0.0) THEN
            WGTI2 = 1.0 / SIGI2**2
          ELSE
            WGTI2 = 1.0
          END IF
          WGTIS = WGTI1 + WGTI2
          VOID((N - 1) * 7 + 4) =
     1         (WGTI1 * XOBS1 + WGTI2 * XOBS2) / WGTIS
          VOID((N - 1) * 7 + 6) = 1.0 / SQRT(WGTIS)
        END IF
        NR7  = NR7 + 7
      END DO
      NSYMC = NSYMH * ICNTR
      IF (NSYMC .GT. 1) THEN
        DO I = 1, MHKL
          J = MHKL + 1 - I
          K = NINT(VOID(IADR1 + J))
          IF (K .GT. 0) THEN
            VOID(IADR1 + J) = -1
            IHT   = NINT(VOID((K - 1) * 7 + 1))
            IKT   = NINT(VOID((K - 1) * 7 + 2))
            ILT   = NINT(VOID((K - 1) * 7 + 3))
            XOBS  =      VOID((K - 1) * 7 + 4)
            SIGI  =      VOID((K - 1) * 7 + 6)
            PCAL  =      VOID((K - 1) * 7 + 7)
            IHKL0 = ILT * MHK + IKT * MPH  + IHT
            IHKLN = IHKL0
            PCALN = PCAL
            IHTN  = IHT
            IKTN  = IKT
            ILTN  = ILT
            IF (SIGI .NE. 0.0) THEN
              SUMT  = XOBS / SIGI**2
              SUMN  = 1.0  / SIGI**2
            ELSE
              SUMT = XOBS
              SUMN = 1.0
            END IF
            DO L = 2, NSYMC
              XJX(1) = IHT
              XJX(2) = IKT
              XJX(3) = ILT
              XJX(4) = PCAL
              IF (L .GT. NSYMH) THEN
                NS = L - NSYMH
                IS = -1
              ELSE
                NS = L
                IS = 1
              END IF
              CALL SGSM (ICL, NS, XJX, LU7, 5, IERR)
              IH   = NINT(XJX(7))
              IK   = NINT(XJX(8))
              IL   = NINT(XJX(9))
              IHKL = (IL * MHK + IK * MPH  + IH) * IS
              IF (IHKL .GT. IHKLN) THEN
                IHKLN = IHKL
                IHTN  = IH
                IKTN  = IK
                ILTN  = IL
                PCALN = XJX(10)
              END IF
              IF (IHKL .NE. IHKL0) THEN
                NR = NINT(VOID(IADR + IHKL))
                IF (NR .GT. 0) THEN
                  XOBS = VOID((NR - 1) * 7 + 4)
                  SIGI = VOID((NR - 1) * 7 + 6)
                  IF (SIGI .NE. 0.0) THEN
                    WGHT = 1.0 / SIGI**2
                  ELSE
                    WGHT = 1.0
                  END IF
                  SUMT = SUMT + XOBS * WGHT
                  SUMN = SUMN + WGHT
                  VOID(IADR + IHKL) = - 1.0
                END IF
              END IF
            END DO
            VOID(IADR + IHKLN) = K
            NR = (K - 1) * 7
            VOID(NR + 1) = IHTN
            VOID(NR + 2) = IKTN
            VOID(NR + 3) = ILTN
            VOID(NR + 4) = SUMT / SUMN
            VOID(NR + 6) = 1.0  / SQRT(SUMN)
            VOID(NR + 7) = PCALN
          END IF
        END DO
      END IF
C * GENERATE SHELXL.CIF & SHELXL.FCF LOOK-ALIKES
      FCLS = 1.0
      IF (FCLM .LT. 250.0) FCLS = 100.0
C * CIF LOOK-ALIKE
      INQUIRE (FILE = NAMEFIL(1:KNMFIL)//'.cif', EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_p.cif',
     1        STATUS = 'UNKNOWN')
        IF (IABS(IGBL(8)) .EQ. 3) CLOSE (UNIT = LU1)
        OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'.cif',
     1        STATUS = 'UNKNOWN')
        DO WHILE (.TRUE.)
          READ (LU62, 99989, IOSTAT = IOST) IDM
          IF (IOST .NE. 0) EXIT
          IF (INDEX(IDM, 'data_') .NE. 0) THEN
            WRITE (LU61, 99995, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
          ELSE
            WRITE (LU61, 99989, IOSTAT = IOST) IDM
          END IF
        END DO
        CLOSE (UNIT = LU62)
        INQUIRE (FILE = NAMEFIL(1:KNMFIL)//'.sqf', EXIST = EXST)
        IF (EXST) THEN
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'.sqf',
     1          STATUS = 'UNKNOWN')
          DO WHILE (.TRUE.)
            READ (LU62, 99989, IOSTAT = IOST) IDM
            IF (IOST .NE. 0) EXIT
            WRITE (LU61, 99989, IOSTAT = IOST) IDM
          END DO
          CLOSE (UNIT = LU62)
        END IF
        IF (IABS(IGBL(8)) .EQ. 2) THEN
          REWIND LU1
          WRITE (LU61, 99989, IOSTAT = IOST) CIFDIR(513)
          WRITE (LU61, 99988, IOSTAT = IOST)
          DO WHILE (.TRUE.)
            READ (LU1,   99989, IOSTAT = IOST) IDM
            IF (IOST .NE. 0) EXIT
            WRITE (LU61, 99989, IOSTAT = IOST) IDM
          END DO
          WRITE (LU61, 99988, IOSTAT = IOST)
        END IF
        CLOSE (UNIT = LU61)
      END IF
C * GENERATE FCF LOOK-ALIKE
      OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_p.fcf',
     1        STATUS = 'UNKNOWN')
      WRITE (LU61, 99987)
      IF (IPR(408) .EQ. 1) WRITE (LU61, 99986)
      WRITE (LU61, 99985, IOSTAT = IOST)
     1  NAMEFIL(1:KNMFIL), JID(1: 50), FCLM, PAR(157),
     2  1.0 / (2.0 * PAR(287))
      NSYM   = IPR(48)
      XJX(4) = 0.0
      XJX(5) = 0.0
      XJX(6) = 0.0
      DO K = 1, NSYM
        ISYM = K
        CALL SGSM (ICL, ISYM, XJX, 0, 20, IERR)
        CALL GEN020 (-1, ICL, 1, 30)
        N = INDEX(ICL, ' ') -1
        WRITE (LU61, 99991, IOSTAT = IOST) ICL(1:N)
      END DO
      WRITE (LU61, 99997, IOSTAT = IOST)
     1  (PAR(K), K = 101, 106), 1.0 / FCLS
      NRF  = 0
      NRF1 = 0
      CALL GEN108 (LU9, 0)
      DO I = 1, MHKL
        NR0 = NINT(VOID(IADR1 + I))
        IF (NR0 .GT. 0) THEN
          IHT  = NINT(VOID((NR0 - 1) * 7 + 1))
          IKT  = NINT(VOID((NR0 - 1) * 7 + 2))
          ILT  = NINT(VOID((NR0 - 1) * 7 + 3))
          XCAL =      VOID((NR0 - 1) * 7 + 5)
          IF (IPR(408) .LE. 0) THEN
            XOBS =    VOID((NR0 - 1) * 7 + 4)
            SIGI =    VOID((NR0 - 1) * 7 + 6)
          ELSE
            XOBS = XCAL
            SIGI = SQRT (XOBS)
          END IF
          PCAL = VOID((NR0 - 1) * 7 + 7)
          CALL PLA138 (1, IHT, IKT, ILT, IEXT, IASM)
          IF (IEXT .EQ. 0) THEN
            NRF1 = NRF1 + 1
            IF (XOBS .GE. 2 * SIGI) THEN
              SUM1 = SUM1 + ABS(SQRT(XOBS) - SQRT(XCAL))
              SUM2 = SUM2 + SQRT(XOBS)
              NRF  = NRF  + 1
            END IF
            SGIK = SIGI ** 2
            IF (PAR(497) .GE. 0.0) THEN
              PXX   = (MAX(0.0, XOBS) + 2.0 * XCAL) / 3.0
              STHLK = GEN095 (PAR(191), IHT, IKT, ILT)
              IF (PAR(499) .GT. 0.0) THEN
                SGIK = (SGIK + (PAR(497) * PXX)**2 + PAR(498) * PXX) /
     1            EXP (PAR(499) * STHLK)
              ELSE
                SGIK = SGIK + (PAR(497) * PXX)**2 + PAR(498) * PXX
              END IF
            END IF
            SUM3 = SUM3 + ((XOBS - XCAL) ** 2) / SGIK
            SUM4 = SUM4 + (XOBS ** 2) / SGIK
            STHL = SQRT(STHLK)
              WRITE (LU61, 99993, IOSTAT = IOST)
     1          IHT, IKT, ILT, XCAL * FCLS,
     1          XOBS * FCLS, SIGI * FCLS, STHL
          END IF
        END IF
      END DO
      IF (IPR(408) .LE. 0) THEN
        CALL PLA262 (3)
        WRITE (LU6, 99999, IOSTAT = IOST)
        WRITE (LU7, 99999, IOSTAT = IOST)
      END IF
      IF (IPR(414) .LT. 4) THEN
        N = 0
        IF (PAR(497) .GE. 0) THEN
          N = INDEX (RLWS(1)(2:80), '''')
          IF (N .GE. 2) WRITE (LU6, 99992, IOSTAT = IOST) RLWS(1)(2:N)
        END IF
        WRITE (LU6, 99996, IOSTAT = IOST)
     1    SUM1 / SUM2, NRF, SQRT(SUM3 / SUM4), NRF1,
     1    SQRT(SUM3 / (NRF1 - IPR(226)))
        IF (N .GE. 2) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99992, IOSTAT = IOST) RLWS(1)(2:N)
        END IF
        CALL PLA262 (6)
        WRITE (LU7, 99996, IOSTAT = IOST)
     1    SUM1 / SUM2, NRF, SQRT(SUM3 / SUM4), NRF1,
     2    SQRT (SUM3 / (NREF - IPR(226)))
      END IF
      WRITE (LU61, 99990, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU17, STATUS = 'DELETE')
      RETURN
99999 FORMAT (/, ':: Structure Factor Calculation including SQUEEZE',
     1           ' Contribution', /)
99998 FORMAT (/, ':: However, no reflection data found', /)
99997 FORMAT (/, '_cell_length_a', F9.5,/,
     1        '_cell_length_b', F9.4, /,
     2        '_cell_length_c', F9.4, /,
     3        '_cell_angle_alpha', F9.3, /,
     4        '_cell_angle_beta', F9.3, /,
     5        '_cell_angle_gamma', F9.3, //,
     6 '_shelx_F_squared_multiplier', F10.3, //,
     7 'loop_', /,
     8 ' _refln_index_h', /,
     9 ' _refln_index_k', /,
     * ' _refln_index_l', /,
     1 ' _refln_F_squared_calc', /,
     2 ' _refln_F_squared_meas', /,
     3 ' _refln_F_squared_sigma', /,
     4 ' _refln_observed_status', /,
     5 ' _refln_sint/lambda')
99996 FORMAT (':: R1   =', F7.3, ' for', I6,
     1        ' Refl. with I > 2 s(I) and', /,
     2        ':: wR2  =', F7.3, ' for', I6, ' reflections', /,
     3        ':: S    =', F7.3, /)
99995 FORMAT ('data_', A)
99994 FORMAT (/, 'NVD too Small in PLA132', /)
99993 FORMAT (3I4, 2F12.2, F10.2, ' o', F10.5)
99992 FORMAT (/, ':: ', A)
99991 FORMAT (1X, '''', A, '''')
99990 FORMAT (1X)
99989 FORMAT (A)
99988 FORMAT (';')
99987 FORMAT ('#', /, '# h,k,l, Fc-squared, Fo-squared,',
     1 ' sigma(Fo-squared) and status flag', /, '#')
99986 FORMAT ('# !!! FCF Generated for TEST Purposes only, ',
     1 'NOT for FCF Deposition !!!')
99985 FORMAT ('data_', A, /, '_shelx_title '' ', A, ' ''', /,
     3 '_shelx_refln_list_code   4', /,
     4 '_shelx_F_calc_maximum', F10.2, /,
     5 '_exptl_crystal_F_000 ', F10.2, /,
     6 '_reflns_d_resolution_high', F10.4, //,
     6 'loop_', /,
     7 ' _symmetry_equiv_pos_as_xyz')
      END SUBROUTINE PLA132
      SUBROUTINE PLA133 (HMAX, KMAX, LMAX, NREF, IADR, NREFA, NREFB)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,NP60=100)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      INTEGER HMAX
      IRPK  = 400000
      IND1  = 1
      IND2  = 2
      IND3  = 3
   10 N15   = 0
      NREFA = 0
      ICNTR = IPR(257)
      IBVT  = IPR(241)
      MPH   = 2 * HMAX + 1
      MPK   = 2 * KMAX + 1
      MPL   = 2 * LMAX + 1
      MHK   = MPH * MPK
      MHKL  = MPL * MHK
      MHKLH = (MHKL - 1) / 2
      IADR  = NVD - MHKLH
      IF (IADR .LT. 1) THEN
        IF (IGBL(63) .GT. 0)
     1    WRITE (LU6, 99998, IOSTAT = IOST) N15, IADR, NVD
        NREFA = -1
        RETURN
      END IF
C * INIT & LOAD POINTERS TO REFLECTION DATA FOR ALL REFLECTIONS
      CALL GEN074 (VOID, IADR + 1, IADR + MHKLH, 0.0)
      NEXT  = 0
      REWIND (LU27, IOSTAT = IOST)
      IF (IOST .NE. 0) STOP 'REWIND PROBLEM OF LU27'
      IF (IGBL(9) .EQ. 1) THEN
        SCALE    = 1.0 / PAR(230)
        PAR(230) = 1.0
      ELSE
        SCALE = 1.0
      END IF
      NRF    = 0
      NRF1   = 0
      SUM1   = 0.0
      SUM2   = 0.0
      SUM3   = 0.0
      SUM4   = 0.0
      ACAL   = 0.0
      BCAL   = 0.0
      ACALA  = 0.0
      BCALA  = 0.0
      ACALAF = 0.0
      BCALAF = 0.0
      DO NR = 1, NREF
        READ (LU27, IOSTAT = IOST) IHP, IKP, ILP, XI, SGI, SIGIW
        IF (IOST .NE. 0) THEN
          IF (IGBL(63) .NE. 0) WRITE (LU6, 99991, IOSTAT = IOST)
          NREFA = -1
          RETURN
        END IF
        XI  = XI  * SCALE
        SGI = SGI * SCALE
        CALL PLA138 (1, IHP, IKP, ILP, IEXT, IASM)
        IF (IEXT .EQ. 0) THEN
          DO 20 I = 1, NSYMH
            N0    = IADR + IHKLS(4, I)
            FOBS  = SQRT(MAX(0.0, XI))
            SIGXI = 0.7071068 * AMIN1(SQRT(SGI),
     1              SGI / MAX (FOBS, 0.0001))
            ISN  = IHKLS(5, I)
            IHQ  = IHKLS(1, I) * ISN
            IKQ  = IHKLS(2, I) * ISN
            ILQ  = IHKLS(3, I) * ISN
            CALL PLA135 (IHQ, IKQ, ILQ, ACAL, BCAL, ACALA, BCALA,
     1        ACALAF, BCALAF, SNTHA)
            IF (IPR(493) .LT. 6) THEN
              ACALT = ACAL + ACALA
              BCALT = BCAL + BCALA
              XCAL  = ACALT ** 2 + BCALT ** 2
              IF (PAR(433) .LT. 999999.0) THEN
                ZCAL  = (ACAL + ACALAF)**2 + (-BCAL + BCALAF)**2
                XFCAL = MAX (0.0,
     1                  (1.0 - PAR(433)) * XCAL + PAR(433) * ZCAL)
              ELSE
                XFCAL = XCAL
              END IF
              FCALT = SQRT (ACALT ** 2 + BCALT ** 2)
              FOBSX = SQRT ((FOBS * ACALT / FCALT - ACALA) ** 2 +
     1                      (FOBS * BCALT / FCALT - BCALA) ** 2)
            ELSE
              XFCAL = ACAL ** 2 + BCAL ** 2
              FOBSX = FOBS
            END IF
            IF (I .EQ. 1) THEN
              NRF1  = NRF1 + 1
              IF (XI .GT. PAR(484) * SGI) THEN
                SUM1 = SUM1 + ABS(FOBS - SQRT(XFCAL))
                SUM2 = SUM2 + FOBS
                NRF  = NRF  + 1
              END IF
              SGIK = SIGIW ** 2
              IF (SGIK .GT. 0.0001) THEN
                SUM3 = SUM3 + ((XI - XFCAL) ** 2) / SGIK
                SUM4 = SUM4 + (XI ** 2) / SGIK
              END IF
            END IF
            IF (NINT(VOID(N0)) .EQ. 0) THEN
              IH = IHKLS(1, I)
              IK = IHKLS(2, I)
              IL = IHKLS(3, I)
              VOID(N15 + 1)  = FOBSX
              VOID(N15 + 2)  = SIGXI
              VOID(N15 + 3)  = ACAL
              VOID(N15 + 4)  = BCAL * ISN
              VOID(N15 + 5)  = 0.0
              VOID(N15 + 6)  = 0.0
              VOID(N15 + 7)  = 0.0
              VOID(N15 + 8)  = 0.0
              VOID(N15 + 9)  = IH
              VOID(N15 + 10) = IK
              VOID(N15 + 11) = IL
              VOID(N15 + 12) = ACALA
              VOID(N15 + 13) = BCALA
              VOID(N15 + 14) = SQRT(GEN095 (PAR(191), IH, IK, IL))
              CALL PLA138 (0, IH, IK, IL, IEXT, IASM)
              VOID(N15 + 15) = 2 * IASM - 1
              NREFA          = NREFA + 1
              N15            = N15  + 15
              IF (NREFA .GE. IRPK) THEN
                IRPK  = IRPK  + 100000
                IF (IRPK .GT. 1000000) THEN
                  IF (IGBL(63) .GT. 0) WRITE (LU6, 99997, IOSTAT = IOST)
                  NREFA = -1
                  RETURN
                ELSE
                  IF (IGBL(63) .GT. 0)
     1              WRITE (LU6, 99990, IOSTAT = IOST) IRPK
                  GO TO 10
                END IF
              END IF
              VOID(N0) = NREFA + IRPK
              IF (N15 .GT. IADR) THEN
                IF (IGBL(63) .GT. 0) THEN
                  WRITE (LU6, 99998, IOSTAT = IOST)
     1              N15, IADR, NVD, CHAR(IPR(223))
                  WRITE (LU7, 99998, IOSTAT = IOST)
     1              N15, IADR, NVD, CHAR(IPR(223))
                END IF
                NREFA = -1
                RETURN
              END IF
            ELSE
              N    = (MOD(NINT(VOID(N0)), IRPK) - 1) * 15 + 1
              YANK = VOID(N0) + IRPK
              IF (YANK .GT. 8300000) THEN
                GO TO 20
              ELSE
                VOID(N0) = YANK
              END IF
              IF (VOID(N0) .GT. NVD - IRPK) THEN
                IF (IGBL(63) .GT. 0) THEN
                  WRITE (LU6, 99995, IOSTAT = IOST)
                  WRITE (LU7, 99995, IOSTAT = IOST)
                END IF
                NREFA = -1
                RETURN
              END IF
              VOID(N) = VOID(N) + FOBSX
            END IF
   20     CONTINUE
        ELSE
          NEXT = NEXT + 1
        END IF
      END DO
      IF (NRF1 .LT. IPR(266)) THEN
        NREFA = -1
        RETURN
      END IF
      PAR(480) = SUM1 / SUM2
      PAR(481) = SQRT (SUM3 / SUM4)
      PAR(482) = SQRT (SUM3 / (NRF1 - IPR(266)))
      IPR(625) = NRF
      IPR(626) = NRF1
      IF (IGBL(63) .GT. 0) THEN
        WRITE (LU6, 99992, IOSTAT = IOST)
     1    PAR(480), NRF, PAR(481), NRF1, PAR(482)
        CALL PLA262 (5)
        WRITE (LU7, 99992, IOSTAT = IOST)
     1    PAR(480), NRF, PAR(481), NRF1, PAR(482)
      END IF
      IF (PAR(497) .GE. 0.0 .AND. IPR(619) .EQ. 0) THEN
        IF (IPR(493) .LT. 6) THEN
          IF (IPR(632) .NE. 2 .OR. PAR(229) .LE. 0.0) THEN
            IF (IPR(651) .EQ. 0 .AND. ABS(PAR(481)) .GT. 0.001) THEN
              YUNK = PAR(173) - PAR(480)
C * ALERT _926 - COMPARE REPORTED AND CALCULATED R-VALUE DIFFERENCE
              IF (ABS(YUNK) .GT. 0.001)
     1          CALL PLA231 (926, 4, ABS(YUNK), YUNK, ' ', ' ')
              YUNK = PAR(174) - PAR(481)
C * ALERT _927 - COMPARE REPORTED AND CALCULATED wR2-VALUE DIFFERENCE
              IF (ABS(YUNK) .GT. 0.001)
     1          CALL PLA231 (927, 4, ABS(YUNK), YUNK, ' ', ' ')
              YUNK = PAR(299) - PAR(482)
C * ALERT _928 - COMPARE REPORTED AND CALCULATED S-VALUE DIFFERENCE
              IF (ABS(YUNK) .GT. 0.005)
     1          CALL PLA231 (928, 3, ABS(YUNK), YUNK, ' ', ' ')
            END IF
          END IF
        END IF
      END IF
      NREFB = NREFA
      IADD  = LMAX * MHK + KMAX * MPH + HMAX
      DO I = 1, MHKLH
        K = NINT(VOID(IADR + I))
        IF (K .NE. 0) THEN
          K0 = MOD(K, IRPK)
          VOID(IADR + I) = K0
          K0 = (K0 - 1) * 15
          K1 = K / IRPK
          VOID(K0 + 1) = VOID(K0 + 1) / K1
        ELSE
          IH = I  + IADD
          IL = IH / MHK
          IH = IH - IL * MHK
          IL = IL - LMAX
          IK = IH / MPH
          IH = IH - IK * MPH - HMAX
          IK = IK - KMAX
          IF (IBVT .GT. 1) THEN
            IF (GEN049 (LAT(IBVT), IH, IK, IL) .LT. 0) CYCLE
          END IF
          CALL PLA138 (1, IH, IK, IL, IEXT, IASM)
          IF (IEXT .NE. 0) CYCLE
          STL = SQRT(GEN095 (PAR(191), IH, IK, IL))
          IF (STL .LT. (PAR(287) + PAR(442))) THEN
          IF (IPR(210) .EQ. 1) THEN
            VOID(N15 + 1)  = 0.0
            VOID(N15 + 2)  = 0.0
            VOID(N15 + 3)  = 0.0
            VOID(N15 + 4)  = 0.0
            VOID(N15 + 5)  = 0.0
            VOID(N15 + 6)  = 0.0
            VOID(N15 + 7)  = 0.0
            VOID(N15 + 8)  = 0.0
            VOID(N15 + 9)  = IH
            VOID(N15 + 10) = IK
            VOID(N15 + 11) = IL
            VOID(N15 + 14) = STL
            VOID(N15 + 15) = FLOAT(IASM) * 2 - 1
            NREFA          = NREFA + 1
            N15            = N15  + 15
            VOID(IADR + I) = NREFA
            IF (IASM .NE. 0) THEN
              IPR(609) = IPR(609) + 1
              IF (STL .LE. PAR(486)) THEN
                TH = ASIN (STL * PAR(17)) * RGBL(6)
                IPR(610) = IPR(610) + 1
                IF (IPR(610) .LE. NP60) THEN
                  MISSING(1, IPR(610)) = IH
                  MISSING(2, IPR(610)) = IK
                  MISSING(3, IPR(610)) = IL
                  MISSING(4, IPR(610)) = NINT(TH * 1000)
                END IF
                IF (IPR(610) .EQ. 1) THEN
                  CALL PLA262 (4)
                  WRITE (LU6, 99993, IOSTAT = IOST) PAR(486)
                  WRITE (LU7, 99993, IOSTAT = IOST) PAR(486)
                END IF
                CALL PLA262 (1)
                WRITE (LU6, 99994, IOSTAT = IOST)
     1            IPR(610), IH, IK, IL, TH
                WRITE (LU7, 99994, IOSTAT = IOST)
     1            IPR(610), IH, IK, IL, TH
                END IF
              END IF
            END IF
          END IF
        END IF
      END DO
      IF (IGBL(63) .GT. 0) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
     1    NEXT, NREF - NEXT, IPR(609), IPR(610)
        CALL PLA262 (5)
        WRITE (LU7, 99999, IOSTAT = IOST)
     1    NEXT, NREF - NEXT, IPR(609), IPR(610)
      END IF
      RETURN
99999 FORMAT (/,
     1        ':: Number of Removed Systematic Extinctions = ', I7, /,
     2        ':: Number of Non-extinction     Reflections = ', I7, /,
     3        ':: Number of Missing            Reflections = ', I7, /,
     4        ':: Number of Missing Low Order  Reflections = ', I7)
99998 FORMAT (/, 'F: Scratch Array Overrun (NXX,IADR,NVD =)', 3I6, /,
     1        3X, 'Use larger program version i.e. recompile with ',
     2        'larger NVD', A, /)
99997 FORMAT (/, 'F: 1000000 Reflection Number in Hemisphere Exceeded')
99995 FORMAT (/, 'F: Scratch Array Overrun', /,
     1        3X, 'Use larger program version i.e. recompile with ',
     2        'larger NVD', /)
99994 FORMAT (I4, 3I5,F10.2)
99993 FORMAT (/, 'Missing Reflections below sin(theta)/lambda=', F5.2,
     1        /, 47('='), /,
     2        '   N    H    K    L     Theta', /, 29('='))
99992 FORMAT (/, ':: R1   =', F7.3, ' for', I6,
     1        ' Refl. with I > 2 s(I) and', /,
     2        ':: wR2  =', F7.3, ' for', I6, ' reflections', /,
     3        ':: S    =', F7.3, /)
99991 FORMAT (/, ':: Problem Reading .hkp File in PLA133.', /)
99990 FORMAT ('NEW-IRPK =', I10)
      END SUBROUTINE PLA133
      SUBROUTINE PLA134 (LUN0, LUN1, LUN2, NREF)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP52=200,NP54=42,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /MOLEN/ FMOL
      CHARACTER FMOL*19
      CHARACTER STATUS*1
      COMMON /REFLCELL/ RCELL(6)
      COMMON /SPGRNAME/ SPGRNAM
      CHARACTER SPGRNAM*11
      DIMENSION X(12)
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CENTRY*75
      IDTYP = IENTRY(IGBL(54), 3)
      CALL GEN074 (RCELL, 1, 6, 0.0)
      IF (IDTYP .NE. 0) THEN
        IFTYPE = 0
        SCF    = 0.0
        FKMX   = 0.0
        NREF   = 0
        NSKIP  = 0
        IF (IABS(IDTYP) .EQ. 7) THEN
          FMOL = '(3I4,3F8.0)'
        ELSE
          FMOL = '(I4,2I3,2F7.0,F6.0)'
        END IF
C * REFLECTION FILE TYPES ARE IDENTIFIED IN PLA010
C * IDTYP =  1 - FCF (SHELXL LIST 4)
C * IDTYP =  2 - XTAL-F
C * IDTYP =  3 - NRCVAX
C * IDTYP =  4 - MOLEN
C * IDTYP =  5 - CRYSTALS(F)
C * IDTYP =  6 - TEXSAN1
C * IDTYP =  7 - MOLEN1 VARIANT
C * IDTYP =  8 - CRYSTALS(I)
C * IDTYP =  9 - JANA2 (F**2)
C * IDTYP = 10 - TEXSAN2
C * IDTYP = 11 - XD
C * IDTYP = 12 - REALS
C * IDTYP = 13 - TEXSAN3
C * IDTYP = 14 - JANA1 (F)
C * IDTYP = 15 - RIGAKU
C * IDTYP = 21 - SHELXL - LIST 3
C * IDTYP = 22 - SHELXL - LIST 5
C * IDTYP = 23 - SHELXL - LIST 6
C * IDTYP = 24 - SHELXL - LIST 7
C * IDTYP = 25 - SHELXL - LIST 8
C * IDTYP = 26 - REALS - FCF
        IF (IDTYP .GT. 0 .AND. IABS(IGBL(8)) .EQ. 3) THEN
          NSKIP = IENTRY(IGBL(54), 4)
          IF (NSKIP .GT. 0) THEN
            GO TO 10
          ELSE
            GO TO 60
          END IF
        ELSE
          IDTYP = IABS (IDTYP)
        END IF
   10   DO 50 I = 1, 2
          REWIND LUN1
          REWIND LUN2
          DO J = 1, NSKIP
            READ (LUN1, 99996) LINE
          END DO
          IF (I .EQ. 2) THEN
            IF (FKMX .LT. 999999.0) THEN
              SCF = 100.0
            ELSE
              SCF = FLOAT(90000000) / FKMX
            END IF
          END IF
   20     READ (LUN1, 99996, END = 50) LINE
          NL = INDEX (LINE, CHAR(13))
          IF (NL .NE. 0) LINE(NL:NL) = CHAR(32)
          SELECT CASE (IDTYP)
C * SHELXL FCF
            CASE (1)
              IFTYPE = 0
              ISTATE = 0
              IDM = 'LATT P A'
              CALL SGSM (IDM, 0, X, 0, 0, IERR)
              DO
                READ (LUN1, 99996, END = 50) LINE
                NL = INDEX (LINE, CHAR(13))
                IF (NL .NE. 0) LINE(NL:NL) = CHAR(32)
                IF (I .EQ. 1) THEN
                  IF (ISTATE .EQ. 0) THEN
                    J = INDEX (LINE, '_space_group_symop_operation_xyz')
                    IF (J .EQ. 0) THEN
                      J = INDEX (LINE, '_symmetry_equiv_pos_as_xyz')
                    END IF
                    IF (J .GT. 0) ISTATE = 1
                  ELSE IF (ISTATE .EQ. 1) THEN
                    J = INDEX (LINE, '_cell_length_a')
                    IF (J .GT. 0) THEN
                      JE = INDEX (LINE(J+14:80), '(')
                      IF (JE .NE. 0) THEN
                        JE = J + JE + 12
                      ELSE
                        JE = 80
                      END IF
                      READ (LINE(J+14:JE), *) RCELL(1)
                      ISTATE = 2
                      CALL SGSM (IDM, 0, X, LU6, 18, IERR)
                      SPGRNAM  = IDM(15:25)
                      IPR(241) = NINT(X(7))
                      IPR(255) = NINT(X(4))
                    ELSE
                      J  = INDEX (LINE, '''')
                      IF (J .NE. 0) THEN
                        K = INDEX (LINE(J+1:80), '''')
                        IF (K .NE. 0) THEN
                          IDM = 'SYMM '//LINE(J+1:K +J -1)
                          CALL SGSM (IDM, 0, X, 0, 0, IERR)
                        END IF
                      END IF
                    END IF
                  ELSE IF (ISTATE .EQ. 2) THEN
                    J = INDEX (LINE, '_cell_length_b')
                    IF (J .GT. 0) THEN
                      JE = INDEX (LINE(J+14:80), '(')
                      IF (JE .NE. 0) THEN
                        JE = J + JE + 12
                      ELSE
                        JE = 80
                      END IF
                      READ (LINE(J+14:JE), *) RCELL(2)
                    ELSE
                      J = INDEX (LINE, '_cell_length_c')
                      IF (J .GT. 0) THEN
                        JE = INDEX (LINE(J+14:80), '(')
                        IF (JE .NE. 0) THEN
                          JE = J + JE + 12
                        ELSE
                          JE = 80
                        END IF
                        READ (LINE(J+14:JE), *) RCELL(3)
                      ELSE
                        J = INDEX (LINE, '_cell_angle_alpha')
                        IF (J .GT. 0) THEN
                          JE = INDEX (LINE(J+17:80), '(')
                          IF (JE .NE. 0) THEN
                            JE = J + JE + 15
                          ELSE
                            JE = 80
                          END IF
                          READ (LINE(J+17:JE), *) RCELL(4)
                        ELSE
                          J = INDEX (LINE, '_cell_angle_beta')
                          IF (J .GT. 0) THEN
                            JE = INDEX (LINE(J+16:80), '(')
                            IF (JE .NE. 0) THEN
                              JE = J + JE + 14
                            ELSE
                              JE = 80
                            END IF
                            READ (LINE(J+16:JE), *) RCELL(5)
                          ELSE
                            J = INDEX (LINE, '_cell_angle_gamma')
                            IF (J .GT. 0) THEN
                              JE = INDEX (LINE(J+17:80), '(')
                              IF (JE .NE. 0) THEN
                                JE = J + JE + 15
                              ELSE
                               JE = 80
                              END IF
                               READ (LINE(J+17:JE), *) RCELL(6)
                               ISTATE = 3
                            END IF
                          END IF
                        END IF
                      END IF
                    END IF
                  END IF
                END IF
                IF (INDEX(LINE,  '_refln_F_squared_calc') .NE. 0) THEN
                  IFTYPE = IFTYPE * 10 + 2
                ELSE IF (INDEX(LINE, '_refln_F_squared_meas') .NE. 0)
     1            THEN
                  IFTYPE = IFTYPE * 10 + 1
                END IF
                IF (INDEX(LINE, '_refln_observed_status') .NE. 0) THEN
                  READ (LUN1, 99996, END = 50) LINE
                  IF (INDEX(LINE, '_refln_sint/lambda') .EQ. 0)
     1               BACKSPACE (LUN1)
                  GO TO 40
                END IF
              END DO
C * MOLEN
            CASE (4)
              IF (INDEX (LINE, '_refln_10*F_sigm') .EQ. 0 .OR.
     1            INDEX (LINE, '_refln_F_10*sigm') .EQ. 0) GO TO 20
              GO TO 40
C * CRYSTALS(F)
            CASE (5)
              IF (INDEX (LINE, '_refln_F_sigma') .EQ. 0) THEN
                GO TO 20
              ELSE
                READ (LUN1, 99996, END = 50) LINE
                IF (INDEX (LINE, '_refln_observed_status') .EQ. 0) THEN
                  BACKSPACE LUN1
                  GO TO 40
                ELSE
                  GO TO 40
                END IF
              END IF
C * TEXSAN & RIGAKU
            CASE (6, 13, 15)
              IF (INDEX (LINE, '_refln_observed_status') .EQ. 0)
     1          GO TO 20
              GO TO 40
C * MOLEN1
            CASE (7)
              IF (INDEX (LINE, '_refln_observed_status') .EQ. 0)
     1          GO TO 20
              GO TO 40
C * CRYSTALS(I)
            CASE (8)
              IF (INDEX (LINE, '_refln_index') .EQ. 0) THEN
                GO TO 20
              ELSE
                DO
                  READ (LUN1, 99996, END = 50) LINE
                  IF (INDEX (LINE, '_refln_') .EQ. 0) THEN
                    BACKSPACE LUN1
                    GO TO 40
                  END IF
                END DO
              END IF
C * JANA1 & JANA2
            CASE (9, 14)
              IF (INDEX (LINE, '_refln_observed_status') .EQ. 0)
     1          GO TO 20
              GO TO 40
C * XD
            CASE (11)
              IF (INDEX (LINE, '_refln_XD_refine_code') .EQ. 0)
     1          GO TO 20
              GO TO 40
C * SHELXL LIST 3
            CASE (21)
              IF (INDEX (LINE, '_refln_B_calc') .EQ. 0) GO TO 20
              GO TO 40
C * SHELXL LIST 6
            CASE (23)
              IF (INDEX (LINE, '_refln_phase_calc') .EQ. 0) GO TO 20
              GO TO 40
C * SHELXL LIST 7
            CASE (24)
              READ (LINE, *, END = 20, ERR = 20)
     1          IYUNK,IYUNK,IYUNK,YUNK,YUNK,YUNK,YUNK
              YUNK = FLOAT(IYUNK) + YUNK
            CASE (25)
              IF (INDEX (LINE, '_shelx_refinement_sigma') .EQ. 0) THEN
                GO TO 20
              ELSE
                GO TO 40
              END IF
C * REALS
            CASE (26)
              IF (INDEX (LINE, '_refln_F_sigma') .EQ. 0) GO TO 20
              GO TO 40
            CASE DEFAULT
              GO TO 50
          END SELECT
          BACKSPACE LUN1
          GO TO 40
   30     IF (I .EQ. 1) WRITE (LUN0, 99989, IOSTAT = IOST) LINE(1:50)
          IF (IOST .EQ. -999) RETURN
   40     READ (LUN1, 99996, END = 50) LINE
          NL = INDEX (LINE, CHAR(13))
          IF (NL .NE. 0) LINE(NL:NL) = CHAR(32)
          SELECT CASE (IDTYP)
            CASE (1)
              IF (LINE(1:1) .EQ. '#') GO TO 50
              IF (LINE(1:10) .EQ. '          ') GO TO 40
              IF (INDEX (LINE, 'data_') .NE. 0) GO TO 50
              IF (IFTYPE .EQ. 12) THEN
                READ (LINE, *, END = 50, ERR = 30)
     1                IH, IK, IL, FOK, FCK, SFOK
              ELSE IF (IFTYPE .EQ. 21) THEN
                READ (LINE, *, END = 50, ERR = 30)
     1                IH, IK, IL, FCK, FOK, SFOK
              END IF
              IF (PAR(229) .GT. 0.0) THEN
                ST  = SQRT (GEN095 (PAR(191), IH, IK, IL)) * PAR(17)
                TH  = ASIN (ST)
                XT  = (1.0 + (0.001 * PAR(229) * FCK * PAR(17)**3) /
     1                SIN (2.0 * TH)) ** 0.5
                FOK = FOK / XT
                END IF
              FCK = FCK + 0.0
C * MOLEN
            CASE (4, 7)
              READ (LINE, FMOL, END = 50) IH, IK, IL,
     1              XFOBS, XFCAL, XSIGI
              FOK  = SIGN (XFOBS**2, XFOBS) / 100.0
              SFOK = 2.0 * ABS(XFOBS) * XSIGI / 100.0
C * CRYSTALS(F)
            CASE (5)
              READ (LINE, 99998, END = 50) IH, IK, IL, XFOBS, XFCAL,
     1                                     XSIGI, STATUS
              IF (STATUS .EQ. 'x') GO TO 40
              FOK  = SIGN (XFOBS**2, XFOBS)
              SFOK = 2.0 * ABS(XFOBS) * XSIGI
C * CRYSTALS(I)
            CASE (8)
              READ (LINE, 99998, END = 50) IH, IK, IL, FOK, FCK, SFOK,
     1                                     STATUS
              IF (STATUS .EQ. 'x') GO TO 40
C * JANA2
            CASE (9)
              READ (LINE, *, END = 50) IH, IK, IL, FOK, FCK, SFOK
C * JANA1
            CASE (14)
              READ (LINE, *, END = 50) IH, IK, IL, XFOBS, XFCAL, XSIGI
              FOK = XFOBS ** 2
              FCK = XFCAL ** 2
              IF (XFOBS .GT. XSIGI / 2.0) THEN
                SFOK = 2.0 * ABS(XFOBS) * XSIGI
              ELSE
                SFOK = 2.0 * ABS(XFCAL) * XSIGI
              END IF
C * TEXSAN1 FCF
            CASE (6)
              READ (LINE, 99993, END = 50) IH, IK, IL, XFOBS, XSIGI,
     1                                       XFCAL
              FOK  = SIGN (XFOBS**2, XFOBS)
              FCK  = XFCAL ** 2
              IF (XFOBS .GT. XSIGI / 2.0) THEN
                SFOK = 2.0 * ABS(XFOBS) * XSIGI
              ELSE
                SFOK = 2.0 * ABS(XFCAL) * XSIGI
              END IF
C * TEXSAN3/RIGAKU FCF
            CASE (13, 15)
              READ (LINE, *, END = 50) IH, IK, IL, FOK, SFOK, FCK
C * XD FCF (F)
            CASE (11)
              READ (LINE, *, END = 50) IH, IK, IL, FCK, FOK, SFOK,
     1                                 YUNK
C * SHELXL - LIST 3
            CASE (21)
              IF (LINE(1:1) .EQ. '#') GO TO 50
              IF (LINE(1:10) .EQ. '          ') GO TO 40
              IF (INDEX (LINE, 'data_') .NE. 0) GO TO 50
              READ (LINE, 99991, END = 50) IH, IK, IL, XFOBS, XSIGI
              IF (XFOBS .GT. 0.0 .AND. XSIGI .GT. 0) THEN
                 FOK  = XFOBS**2
                SFOK = 2.0 * SQRT(FOK) * XSIGI
              ELSE
                GO TO 40
              END IF
C * SHELXL - LIST 6
            CASE (23)
              READ (LINE, *, END = 50) IH, IK, IL, FOK, SFOK, FC
              FCK = FC**2
C * SHELXL - LIST 7
            CASE (24)
              READ (LINE, *, END = 50) IH, IK, IL, FOK, SFOK, FCK
C * SHELXL - LIST 8
            CASE (25)
              READ (LINE, *, END = 50) IH, IK, IL, FOK, SFOK, FCK
C * REALS FCF F
            CASE (26)
              READ (LINE, 99990, END = 50) IH, IK, IL, XFOBS, XFCAL,
     1          XSIGI
              FOK  = SIGN (XFOBS**2, XFOBS)
              SFOK = 2.0 * ABS(XFOBS) * XSIGI
              IF (SFOK .LT. 0.0001) GO TO 40
          END SELECT
          IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) GO TO 50
          IF (I .EQ. 1) THEN
            IF (FOK  .GT. FKMX) FKMX = FOK
            IF (SFOK .GT. FKMX) FKMX = SFOK
          ELSE
            NREF = NREF + 1
            WRITE (LUN2, 99999, IOSTAT = IOST)
     1        IH, IK, IL, NINT(FOK * SCF), NINT(SFOK * SCF)
          END IF
          GO TO 40
   50   CONTINUE
      ELSE
        CALL GEN127 ('No Recognizable FCF')
      END IF
        IF (IDTYP .EQ. 1 .AND. PAR(229) .GT. 0.0)
     1    WRITE (LUN0, 99988, IOSTAT = IOST) PAR(229)
      IF (NREF .EQ. 0) THEN
        WRITE (LUN0, 99994, IOSTAT = IOST)
      ELSE
        WRITE (LUN2, 99992, IOSTAT = IOST)
      END IF
      RETURN
   60 WRITE (LUN0, 99995, IOSTAT = IOST) NREF
      CALL GEN127 (' ')
99999 FORMAT (3I4, 2I8)
99998 FORMAT (3I4, 3F12.2, 1X, A)
99996 FORMAT (A)
99995 FORMAT (':: STOP: Free Read Problem in FCF-file NREF =', I6)
99994 FORMAT (/, ':: No Suitable Reflections found in FCF-file', /)
99993 FORMAT (I4, 2I5, 3F11.2)
99992 FORMAT (//)
99991 FORMAT (3I4, 4F12.0)
99990 FORMAT (3I4, 2F9.0, F7.0)
99989 FORMAT ('Free Format READ Problem: ', A)
99988 FORMAT (/, ':: Retro Extinction Correction Applied on Fo**2',
     1        ' - EXTI =', F7.4, /)
      END SUBROUTINE PLA134
      SUBROUTINE PLA135 (IH, IK, IL, ACAL, BCAL, ACALA, BCALA,
     1  ACALAF, BCALAF, SNTHA)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
C * STRUCTURE FACTOR CALCULATION ROUTINE
      NATO   = IPR(589)
      IBV    = IPR(256)
      ICENT  = IPR(257)
      ACAL   = 0.0
      BCAL   = 0.0
      ACALA  = 0.0
      BCALA  = 0.0
      ACALAF = 0.0
      BCALAF = 0.0
C * T = exp(-2pi2[h2(a*)2U11+k2(b*)2U22+ ... + 2hka*b*U12])
      DUMA(1) = IH**2   * PAR(191)
      DUMA(2) = IK**2   * PAR(192)
      DUMA(3) = IL**2   * PAR(193)
      DUMA(4) = IK * IL * PAR(114) * PAR(115) * 2.0
      DUMA(5) = IH * IL * PAR(113) * PAR(115) * 2.0
      DUMA(6) = IH * IK * PAR(113) * PAR(114) * 2.0
      STLK  = GEN095 (PAR(191), IH, IK, IL)
      SNTHA = SQRT(STLK) * PAR(17)
      IF (IPR(414) .LT. 4) THEN
        TF1 = - RGBL(8) * STLK
        TF2 = - TF1 * 100.0
C * CALCULATE STRUCTURE FACTOR (ACAL, BCAL, ACALA, BCALA)
        DO I = 1, NATO
          IF (XXO(I, 4) .GT. 0.0) THEN
            IATPI = IATP(I)
            ARG   = RGBL(5) * (IH * XXO(I, 1) + IK * XXO(I, 2)
     1            + IL * XXO(I, 3))
            CARG  = COS(ARG)
            SARG  = SIN(ARG)
            IF (XSD(I, 1) .GT. 99.0) THEN
              TF = EXP(TF1 * XSD(I, 1) + TF2)
            ELSE
              TF = 0.0
              DO J = 1, 6
                TF = TF + XSD(I, J) * DUMA(J)
              END DO
              TF = EXP(- RGBL(7) * TF)
            END IF
            FACT = XXO(I, 4) * IBV * TF
            FSC = CON(I, 9)
            IF (IABS(IPR(493)) .NE. 6) THEN
              DO J = 1, 7, 2
                YUNK = CON(I, J + 1) * STLK
                IF (YUNK .LT. 35) FSC = FSC + CON(I, J) * EXP(- YUNK)
              END DO
            END IF
C * REAL SCATTERING CONTRIBUTION  (ACAL, BCAL)
            FACTR = FACT * FSC
            ACAL  = ACAL + FACTR * CARG
            IF (ICENT .EQ. 1) BCAL = BCAL + FACTR * SARG
C * COMPLEX SCATTERING CONTRIBUTION DUE TO F'' (ACALA, BCALA)
            IF (IPR(493) .NE. 6) THEN
              IF (IATPI .NE. 0) THEN
                FACTD = FACT  * ANOM(IATPI, 1)
                FACTC = FACT  * ANOM(IATPI, 2)
                ACALA = ACALA + FACTD * CARG
                BCALA = BCALA + FACTC * CARG
                ACALAF = ACALAF + FACTD * CARG
                BCALAF = BCALAF + FACTC * CARG
                IF (ICENT .EQ. 1) THEN
                  ACALA = ACALA - FACTC * SARG
                  BCALA = BCALA + FACTD * SARG
                  ACALAF = ACALAF + FACTC * SARG
                  BCALAF = BCALAF - FACTD * SARG
                END IF
              END IF
            END IF
          END IF
        END DO
      END IF
      RETURN
      END
      SUBROUTINE PLA136 (IH, IK, IL, XI, SIGI, SIGIW, CALI, UCINT,
     1 ACALS, BCALS, ACOR, IEND)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /PL132/ TRMX(3, 3), STHKM, ISKIP, ITSKP, IOBS, ICALC,
     1 NDEC, SHXMP
      DIMENSION XINT(2)
      CHARACTER FOFC*4
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /HKL/ IH0, IK0, IL0, HMAX, KMAX, LMAX
      COMMON /MOLEN/ FMOL
      CHARACTER FMOL*19
      CHARACTER STATUS*1
      INTEGER HMAX
      LOGICAL OPEND
      CALI  = 0.0
      UCINT = 0.0
      ACALS = 0.0
      BCALS = 0.0
      ACOR  = 1.0
      IF (IEND .EQ. -1) THEN
        ISKIP    = 0
        ITSKP    = 0
        PAR(166) = 0.0
        SHXMP    = 1.0
        IF (IPR(408) .EQ. 1) THEN
          PAR(287) = PAR(540)
          PAR(165) = ASIN (MIN(1.0, PAR(287) * PAR(17))) * RGBL(6)
        ELSE IF (IPR(408) .EQ. 2 .AND. PAR(168) .GT. 0.0) THEN
          PAR(165) = PAR(168)
        END IF
        STHKM = (SIN(PAR(165) / RGBL(6)) / PAR(17))**2
        IF (IABS(IGBL(8)) .NE. 2) THEN
          CALL GEN052 (TM1, TRMX)
        ELSE
          IF ((IGBL(9) .LE. 0 .OR. IABS(IGBL(8)) .EQ. 2) .AND.
     1        IPR(408) .NE. 2) THEN
            K = 230
            DO I = 1, 3
              DO J = 1, 3
                K = K + 1
                TRMX(I, J) = PAR(K)
              END DO
            END DO
          ELSE
            CALL GEN021 (TRMX, 1)
          END IF
        END IF
        WRITE (LU6, 99981, IOSTAT = IOST)
     1    ((TRMX(I, J), J = 1, 3), I = 1, 3)
        WRITE (LU6, 99979, IOSTAT = IOST) (PAR(I), I = 101, 106)
        CALL GEN074 (V2, 1, 3, 0.0)
        CALL GEN074 (V3, 1, 3, 0.0)
        NDEC = 0
        IF (IPR(408) .LE. 0) THEN
          FOFC = 'FoFc'
          IF (IPR(132) .EQ. 0) THEN
            FOFC = ' OBS'
          ELSE IF (IPR(132) .EQ. 1) THEN
            FOFC = 'CALC'
          ELSE IF (IPR(132) .EQ. 2) THEN
            FOFC = 'DELT'
          ELSE IF (IPR(132) .EQ. 3) THEN
            FOFC = 'DELG'
          END IF
          WRITE (LU6, 99998, IOSTAT = IOST) FNLU16(1:KNM16), FOFC
          IF (IGBL(63) .GT. 0) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99998, IOSTAT = IOST) FNLU16(1:KNM16), FOFC
          END IF
          CALL GEN108 (LU16, 0)
          IF (IGBL(9) .GT. 0) THEN
            DO WHILE (.TRUE.)
              READ (LU16, 99997, IOSTAT = IOST) IDM
              IF (IOST .NE. 0) EXIT
              I = INDEX (IDM, 'data_')
              J = INDEX (IDM, CHAR(13))
              IF (I .NE. 0) THEN
                CALL GEN151 (IDM, I + 5)
                IF (J .EQ. 0) THEN
                  J = I + 12
                ELSE
                  J = J - 1
                END IF
                IF (I .GT. J) EXIT
                IF (IABS(IGBL(8)) .NE. 3) GO TO 20
                IF (IDM(I + 5:J) .EQ. JID(1:8)) GO TO 20
              END IF
            END DO
            IPR(2) = 69
            INQUIRE (FILE = NAMEFIL(1:KNMFIL)//'.ckf',
     1               OPENED = OPEND)
            IF (.NOT. OPEND) THEN
              OPEN (UNIT = LU13, FILE = NAMEFIL(1:KNMFIL) //'.ckf',
     1              STATUS = 'UNKNOWN')
            END IF
            IPR(659) = IPR(659) + 1
            IF (IPR(659) .EQ. 1) THEN
              WRITE (LU13, 99990, IOSTAT = IOST) JID(1:10)
C * ALERT _900
              CALL PLA231 (900, 0, 1.0, 1.0, ' ', ' ')
              CALL PLA015 (0, 51)
            END IF
            GO TO 260
          END IF
   20     SELECT CASE (IGBL(9))
C * FCF TYPE 1 - SHELXL
            CASE (1)
              SHXMP = 1.0
              NDEC  = 2
              ICALC = 0
              IOBS  = 0
              IDIF  = 0
              DO WHILE (.TRUE.)
                READ (LU16, 99997, END = 260, ERR = 260) IDM
                IF (INDEX (IDM, 'cell_') .NE. 0) THEN
                  IF (PAR(101) .GT. 0.0 .AND. IABS(IGBL(8)) .EQ. 3) THEN
                    M = INDEX (IDM, '(')
                    IF (M .NE. 0) IDM(M:) = '        '
                    NB = INDEX (IDM, '_cell_length_a')
                    IF (NB .NE. 0) THEN
                      READ (IDM(NB + 14:), *, ERR = 260) PAR(455)
                      DLDS = MAX (0.01, PAR(107) * 2.0)
                      IF (ABS(PAR(455) - PAR(101)) .GT. DLDS)
     1                  IDIF = IDIF + 1
                    ELSE
                      NB = INDEX (IDM, '_cell_length_b')
                      IF (NB .NE. 0) THEN
                        READ (IDM(NB + 14:), *, ERR = 260) PAR(456)
                        DLDS = MAX (0.01, PAR(108) * 2.0)
                        IF (ABS(PAR(456) - PAR(102)) .GT. DLDS)
     1                    IDIF = IDIF + 1
                      ELSE
                        NB = INDEX (IDM, '_cell_length_c')
                        IF (NB .NE. 0) THEN
                          READ (IDM(NB + 14:), *, ERR = 260) PAR(457)
                          DLDS = MAX (0.01, PAR(109) * 2.0)
                          IF (ABS(PAR(457) - PAR(103)) .GT. DLDS)
     1                      IDIF = IDIF + 1
                        ELSE
                          NB = INDEX (IDM, '_cell_angle_alpha')
                          IF (NB .NE. 0) THEN
                            READ (IDM(NB + 17:), *, ERR = 260)
     1                            PAR(458)
                            DLDS = MAX (0.01, PAR(110) * 2.0)
                            IF (ABS(PAR(458) - PAR(104)) .GT. DLDS)
     1                        IDIF = IDIF + 1
                          ELSE
                            NB = INDEX (IDM, '_cell_angle_beta')
                            IF (NB .NE. 0) THEN
                              READ (IDM(NB + 16:), *, ERR = 260)
     1                              PAR(459)
                              DLDS = MAX (0.01, PAR(111) * 2.0)
                              IF (ABS(PAR(459) - PAR(105)) .GT. DLDS)
     1                          IDIF = IDIF + 1
                            ELSE
                              NB = INDEX (IDM, '_cell_angle_gamma')
                              IF (NB .NE. 0) THEN
                                READ (IDM(NB + 17:), *, ERR = 260)
     1                                PAR(460)
                                DLDS = MAX (0.01, PAR(112) * 2.0)
                                IF (ABS(PAR(460) - PAR(106))
     1                            .GT. DLDS) IDIF = IDIF + 1
                                IF (IDIF .GT. 0) GO TO 250
                              END IF
                            END IF
                          END IF
                        END IF
                      END IF
                    END IF
                  END IF
                ELSE IF (INDEX (IDM, '_refln_F_squared_calc') .NE. 0)
     1                     THEN
                  IF (IOBS .EQ. 1) THEN
                    ICALC = 2
                  ELSE
                    ICALC = 1
                  END IF
                ELSE IF (INDEX (IDM, '_refln_F_squared_meas') .NE. 0)
     1                   THEN
                  IF (ICALC .EQ. 1) THEN
                    IOBS = 2
                  ELSE
                    IOBS = 1
                  END IF
                ELSE IF (INDEX (IDM, '_shelx_F_squared_multiplier')
     1                 .NE. 0) THEN
                  IYUNK = INDEX (IDM, '_shelx_F_squared_multiplier')
                  READ (IDM(IYUNK + 27:80), *, ERR = 260) SHXMP
                ELSE IF (INDEX (IDM, '_refln_observed_status') .NE. 0)
     1                   THEN
   30             READ (LU16, 99997, END = 260) IDM
                  IF (INDEX (IDM, '_refln_sint/lambda') .NE. 0) GO TO 30
                  BACKSPACE LU16
                  EXIT
                END IF
              END DO
              IF (IPR(132) .EQ. 0 .AND. IOBS .EQ. 0 .OR.
     1            IPR(132) .EQ. 1 .AND. ICALC .EQ. 0) GO TO 260
C * FCF TYPE 2 - XTAL Fobs/Fcal
            CASE (2)
   40         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_scale_group_code') .EQ. 0)
     1            GO TO 40
              NDEC = 3
C * FCF TYPE 3 - NRCVAX
            CASE (3)
   50         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_F_squared_sigma') .EQ. 0)
     1            GO TO 50
              IOBS  = 1
              ICALC = 2
              NDEC  = 3
C * FCF TYPE 4 - MOLEN
            CASE (4)
   60         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_10*F_sigm') .EQ. 0 .AND.
     1            INDEX (IDM, '_refln_F_10*sigm') .EQ. 0) GO TO 60
              IOBS  = 1
              ICALC = 2
              NDEC  = 0
              FMOL  = '(I4,2I3,2F7.0,F6.0)'
   70         READ (LU16, 99997, END = 260) IDM
              NB = 1
              NE = 80
              CALL GEN039 (1, IDM, 1, 80, NB, NE)
              IF (NE .EQ. 0) THEN
                GO TO 70
              ELSE IF (NE .EQ. 31) THEN
                FMOL(3:3) = '5'
              END IF
             BACKSPACE LU16
C * FCF TYPE 5 & 8 - CRYSTALS
            CASE (5, 8)
   80         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_') .EQ. 0) GO TO 80
   90         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_') .NE. 0) GO TO 90
              IOBS  = 1
              ICALC = 2
              BACKSPACE LU16
C * FCF TYPE 6, 10, 13 & 15 - TEXSAN1 & TEXSAN2 & TEXSAN3 &  RIGAKU
            CASE (6, 10, 13, 15)
  100         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_observed_status') .EQ. 0)
     1          GO TO 100
C * FCF TYPE 8 - SHELXL201x
            CASE (25)
  105         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_shelx_refinement_sigma') .EQ. 0)
     1          GO TO 105
C * FCF TYPE 7 - MOLEN1
            CASE (7)
  110         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_observed_status') .EQ. 0)
     1          GO TO 110
              IOBS  = 1
              ICALC = 2
              FMOL  = '(3I4,3F8.0)'
              BACKSPACE LU16
            CASE (9, 14)
  120         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_observed_status') .EQ. 0)
     1            GO TO 120
C * FCF TYPE 11 - XD
            CASE (11)
  130         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_XD_refine_code') .EQ. 0)
     1            GO TO 130
C * FCF TYPE 12 - RAELS - Fobs/Fcalc/sigma
            CASE (12)
  140         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_F_sigma') .EQ. 0) GO TO 140
C * HKL TYPE 21 - SHELXL - LIST3
            CASE (21)
  150         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_B_calc') .EQ. 0) GO TO 150
C * HKL TYPE 22 - SHELXL - LIST5
            CASE (22)
  160         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_phase_calc') .EQ. 0) GO TO 160
C * HKL TYPE 23 - SHELXL - LIST6
            CASE (23)
  170         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_refln_phase_calc') .EQ. 0) GO TO 170
C * HKL TYPE 24 - SHELXL - LIST 7
            CASE (24)
  180         READ (LU16, 99997, END = 260) IDM
              READ (IDM, *, END = 180, ERR = 180)
     1          IYUNK, IYUNK, IYUNK, YUNK, YUNK, YUNK, YUNK
C * HKL TYPE 25 - SHELXL - LIST 8
  185         READ (LU16, 99997, END = 260) IDM
              IF (INDEX (IDM, '_shelx_refinement_sigma') .EQ. 0)
     1           GO TO 185
C * HKL TYPE
              YUNK = YUNK + FLOAT(IYUNK)
              BACKSPACE LU16
            CASE DEFAULT
C * HKL TYPE 0 & -1 - SHELX-HKL
              READ (LU16, 99997, END = 260) PRBUF(1:20)
              CALL GEN108 (LU16, 0)
              NDEC = INDEX (PRBUF(13:20), '.')
              IF (NDEC .GT. 0) NDEC = 8 - NDEC
              IF (IGBL(9) .EQ. -1) THEN
                IF (IPR(210) .EQ. -1)
     1            WRITE (LU6, 99999, IOSTAT = IOST)
              END IF
          END SELECT
          PAR(230) = 10**NDEC
        ELSE
          HMAX = INT(2 * PAR(101) * PAR(287)) + 1
          KMAX = INT(2 * PAR(102) * PAR(287)) + 1
          LMAX = INT(2 * PAR(103) * PAR(287)) + 1
          IH0  = - HMAX - 1
          IK0  = - KMAX - 1
          IF ((IPR(408) .EQ. 1 .AND. IPR(257) .EQ. 1) .OR.
     1         IPR(408) .EQ. 2) THEN
            IL0 = - LMAX - 1
          ELSE
            IL0 = -1
          END IF
          XI       = 100
          SIGI     = 10
          SIGIW    = SIGI
          PAR(230) = 1.0
        END IF
      END IF
      IF (IPR(408) .LE. 0) THEN
        GO TO 210
  190   IF (INDEX(PRBUF, '<?') .NE. 0) GO TO 260
        GO TO 210
  200   IF (PRBUF(1:1) .EQ. '#') GO TO 260
        IF (INDEX(PRBUF, 'data_') .NE. 0) GO TO 260
        WRITE (LU6, 99988, IOSTAT = IOST) PRBUF(1:65)
        GO TO 210
  210   READ (LU16, 99997, END = 260) PRBUF
        NCR = INDEX (PRBUF, CHAR(13))
        IF (NCR .NE. 0) PRBUF(NCR:NCR) = ' '
        SELECT CASE (IGBL(9))
C * HKL TYPE 0 - HKLF
          CASE (0)
            IF (IGBL(37) .EQ. 0) THEN
              READ (PRBUF, 99987, ERR = 190)
     1        IH, IK, IL, XI, SIGI, NBAT
            ELSE
              READ (PRBUF, 99987, ERR = 190)
     1        IH, IK, IL, XI, SIGI, NBAT, (V2(I), V3(I), I = 1, 3)
            END IF
            IF (NBAT .GT. 1) THEN
              IF (IPR(513) .GE. NBAT - 1 .AND. IPR(513) .GT. 0) THEN
                XI   = BASF(NBAT - 1) * XI
                SIGI = BASF(NBAT - 1) * SIGI
              END IF
            END IF
            CALI  = XI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * HKL TYPE -1 - HKLF - EXTENDED
          CASE (-1)
            READ (PRBUF, 99996, END = 210) IH, IK, IL, XI, SIGI,
     1        (V2(I), V3(I), I = 1, 3), UCINT, ACALS, BCALS, ACOR
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * FCF TYPE 1 - SHELXL
          CASE (1)
            IF (PRBUF(1:10) .EQ. '          ') GO TO 210
            READ (PRBUF, *, END = 260, ERR = 200) IH, IK, IL,
     1           (XINT(I), I = 1, 2), SIGI, STATUS
            IF (STATUS .EQ. 'x' .OR. STATUS .EQ. '-') GO TO 210
            XI   = XINT(IOBS)  * SHXMP
            YI   = XINT(ICALC) * SHXMP
            CALI = YI
            IF (IPR(132) .EQ. 1) THEN
              XI = YI
            ELSE IF (IPR(132) .EQ. 2) THEN
              XI = ABS (XI - YI)
            ELSE IF (IPR(132) .EQ. 3) THEN
              XI = MAX (XI - YI, 0.0)
            ELSE IF (IPR(132) .EQ. -1) THEN
              UCINT = YI
            END IF
            SIGI = MAX(0.0, SIGI * SHXMP)
            IF (PAR(497) .GE. 0.0 .OR. PAR(498) .GE. 0.0) THEN
              IF (IABS(IPR(632)) .EQ. 1) THEN
                PFOK  = PAR(500) * MAX(XI, 0.0) +
     1                  (1.0 - PAR(500)) * YI
                IF (PAR(499) .GT. 0.0) THEN
                  SIGIW = SQRT ((SIGI**2 +
     1              (PAR(497) * PFOK)**2 + PAR(498) * PFOK) /
     2              EXP (PAR(499) * GEN095 (PAR(191), IH, IK, IL)))
                ELSE
                  SIGIW = SQRT (SIGI**2 +
     1              (PAR(497) * PFOK)**2 + PAR(498) * PFOK)
                END IF
              ELSE IF (IPR(632) .EQ. 2) THEN
                SIGIW = SQRT (SIGI**2 + PAR(497) * XI**2)
              ELSE
                SIGIW = SIGI
              END IF
            ELSE
              SIGIW = SIGI
            END IF
C * FCF TYPE 2 - XTAL-F
          CASE (2)
            READ (PRBUF, 99995, END = 210) IH, IK, IL, XFOBS, XFCAL,
     1                                     XSIGI
            XI    = XFOBS**2
            SIGI  = 2.0 * SQRT(XI) * XSIGI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * FCF TYPE 3 - NRCVAX
          CASE (3)
            READ (PRBUF, 99994, ERR = 210) IH, IK, IL,
     1            (XINT(I), I = 1, 2), SIGI
            XI = XINT(IOBS)  * SHXMP
            YI = XINT(ICALC) * SHXMP
            IF (IPR(132) .EQ. 1) XI = YI
            SIGI  = MAX (0.0, SIGI * SHXMP)
            SIGIW = SIGI
C * FCF TYPE 4 & 7 - MOLEN & MOLEN1 FCF
          CASE (4, 7)
            READ (PRBUF, FMOL, ERR = 200, END = 260) IH, IK, IL,
     1        XFOBS, XFCAL, XSIGI
            IF (IABS(IH) + IABS(IK) + IABS(IL) .EQ. 0) GO TO 210
            XI   = XFOBS**2
            SIGI = 2.0 * SQRT(XI) * XSIGI
            CALI = XFCAL**2
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * FCF TYPE 5 - CRYSTALS FCF(F)
          CASE (5)
            READ (PRBUF, 99993, ERR = 200, END = 260) IH, IK, IL,
     1            XFOBS, XFCAL, XSIGI, STATUS, XSIGIW
            IF (STATUS .EQ. 'x') GO TO 210
            XI   = SIGN (ABS(XFOBS)**2, XFOBS)
            SIGI = 2.0 * ABS(XFOBS) * XSIGI
            SIGIW = 2.0 * ABS(XFOBS) / SQRT(XSIGIW)
            CALI = XFCAL**2
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
C * FCF TYPE 6 - TEXSAN1 FCF
          CASE (6)
            READ (PRBUF, 99992, ERR = 200) IH, IK, IL, XFOBS, XSIGI,
     1                                     XFCAL
            XI = SIGN (XFOBS**2, XFOBS)
            IF (XFOBS .GT. XSIGI / 2.0) THEN
              SIGI = 2.0 * ABS(XFOBS) * XSIGI
            ELSE
              SIGI = 2.0 * ABS(XFCAL) * XSIGI
            END IF
            CALI = XFCAL**2
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * FCF TYPE 8 - CRYSTALS FCF(I)
          CASE (8)
            READ (PRBUF, 99993, ERR = 200, END = 260) IH, IK, IL,
     1            XI, CALI, SIGI, STATUS, SIGIW
            IF (STATUS .EQ. 'x') GO TO 210
            IF (STATUS .EQ. 'h') GO TO 210
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = 1.0 / SQRT(SIGIW)
C * FCF TYPE 9 - JANA
          CASE (9)
            READ (PRBUF, *, ERR = 200, END = 260) IH, IK, IL,
     1            XI, CALI, SIGI
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            IF (PAR(497) .GT. 0.0) THEN
              SIGIW = SQRT(SIGI**2 + PAR(497) * (MAX (XI, 0.0))**2)
            ELSE
              SIGIW = SIGI
            END IF
C * FCF TYPE 10 - TEXSAN2 FCF
          CASE (10)
            READ (PRBUF, 99985, END = 260, ERR = 200)
     1              IH, IK, IL, CALI, XI, SIGI
            UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * FCF TYPE 11 - XD
          CASE (11)
            READ (PRBUF, *, ERR = 200, END = 260) IH, IK, IL,
     1            CALI, XI, SIGI, YUNK
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * FCF TYPE 12 - RAELS FCF
          CASE (12)
            READ (PRBUF, 99982, ERR = 260, END = 260) IH, IK, IL,
     1            XFOBS, XFCAL, XSIGI
            XI   = SIGN (ABS(XFOBS)**2, XFOBS)
            SIGI = 2.0 * ABS(XFOBS) * XSIGI
            CALI = XFCAL**2
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * FCF TYPE 13,15 - TEXSAN3/RIGAKU FCF
          CASE (13, 15)
            READ (PRBUF, *, END = 260, ERR = 200)
     1              IH, IK, IL, XI, SIGI, CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * JANA1 FCF
          CASE (14)
            READ (PRBUF, 99978, ERR = 260, END = 260) IH, IK, IL,
     1            XFOBS, XFCAL, XSIGI
            XI   = SIGN (ABS(XFOBS)**2, XFOBS)
            SIGI = 2.0 * ABS(XFOBS) * XSIGI
            CALI = XFCAL**2
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * HKL TYPE 21 - SHELXL - LIST3
          CASE (21)
            READ (PRBUF, *, END = 260, ERR = 260)
     1            IH, IK, IL, XFOBS, XSIGI, ACAL, BCAL
            XI   = XFOBS**2
            SIGI = 2.0 * SQRT(XI) * XSIGI
            YI   = ACAL**2 + BCAL**2
            CALI = YI
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * HKL TYPE 22 - SHELXL - LIST5
          CASE (22)
            READ (PRBUF, 99983, END = 260, ERR = 260)
     1            IH, IK, IL, XFOBS, XFCAL
C * HKL TYPE 23 - SHELXL - LIST6
          CASE (23)
            IH   = 0
            IK   = 0
            IL   = 0
            READ (PRBUF, *, END = 260, ERR = 260)
     1            IH, IK, IL, XI, SIGI, FC
            YI   = FC ** 2
            CALI = YI
            IF (IPR(132) .EQ. -1) UCINT = CALI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * HKL TYPE 24 - SHELXL - LIST 7
          CASE (24)
            READ (PRBUF, *, END = 260, ERR = 260)
     1      IH, IK, IL, XI, SIGI, YI1, YI2
            YI = 0.0
            IF (YI1 .GT. 0.0) YI = YI1
            IF (YI2 .GT. 0.0) YI = YI + YI2
            CALI  = YI
            UCINT = YI
            SIGI  = MAX (0.0, SIGI)
            SIGIW = SIGI
C * HKL TYPE 25 - SHELXL - LIST 8
          CASE (25)
            READ (PRBUF, *, END = 260, ERR = 260)
     1      IH, IK, IL, XI, SIGI, YI, YUNK, YUNK, SIGIW
            CALI = YI
            IF (IPR(132) .EQ. -1) UCINT = CALI
        END SELECT
        M = IPR(620)
        IF (M .NE. 0) THEN
          DO I = 1, M
            IF (IH .EQ. IHKLOMIT(1, I) .AND. IK .EQ. IHKLOMIT(2, I)
     1        .AND. IL .EQ. IHKLOMIT(3, I)) GO TO 210
          END DO
        END IF
      ELSE
        IF (IEND .EQ. 0) GOTO 240
  220   IL0 = IL0 + 1
        IF (IL0 .GT. LMAX) GO TO 260
        IK0 = - KMAX - 1
  230   IK0 = IK0 + 1
        IF (IK0 .GT. KMAX) GO TO 220
        IH0 = - HMAX - 1
  240   IH0 = IH0 + 1
        IF (IH0 .GT. HMAX) GO TO 230
        IF (IH0 .EQ. 0 .AND. IK0 .EQ. 0 .AND. IL0 .EQ. 0) GO TO 240
        IF (SQRT(GEN095 (PAR(191), IH0, IK0, IL0)) .GT. PAR(287))
     1    GO TO 240
        IH = IH0
        IK = IK0
        IL = IL0
      END IF
      IEND = 0
      RETURN
  250 WRITE (LU6,  99986, IOSTAT = IOST)
C * ALERT _901
      IPR(674) = IPR(674) + 1
      IPR(676) = 0
      IF (IPR(674) .EQ. 1)
     1  CALL PLA231 (901, 0, 1.0, 1.0, ' ', ' ')
      IF (IGBL(22) .EQ. -1) THEN
        WRITE (LU13, 99984, IOSTAT = IOST) (PAR(M), M = 455, 460)
        WRITE (LU13, 99986, IOSTAT = IOST)
      END IF
  260 IEND = 1
      RETURN
99999 FORMAT (':: Expanded HKLF Data Record found',
     1        ' (SQUEEZE contribution added - if any)')
99998 FORMAT (':: Reflection Data are READ from File : ', A,
     1        ' - (', A, '-Data)')
99997 FORMAT (A)
99996 FORMAT (3I4, 2F8.0, 4X, 6F8.5, F8.0, 2F8.0, F8.4)
99995 FORMAT (I5, 2I4, 3F8.0)
99994 FORMAT (I4, 2I5, 3F10.3)
99993 FORMAT (3I4, 3F12.2, 1X, A, E13.4)
99992 FORMAT (I4, 2I5, 3F11.2)
99990 FORMAT (/, ':: No Matching Reflection Data Entry found for ', A)
99988 FORMAT (/, 'ERROR/SKIPPED: ', A)
99987 FORMAT (3I4, 2F8.0, I4, 6F8.5)
99986 FORMAT (/, ':: CIF & FCF CELL DIMENSIONS Inconsistent (ABORT!)')
99985 FORMAT (3I4, 2F12.2, F10.2)
99984 FORMAT ('Unit Cell (FCF)  : ', 3F9.4, 3F9.3)
99983 FORMAT (3I4, 2F10.0, F7.0)
99982 FORMAT (3I4, 2F9.0, F7.0)
99981 FORMAT (/, ':: TRMX = ', 9F7.2)
99979 FORMAT (':: CELL', 6F10.3)
99978 FORMAT (3I4, 3F10.0)
      END SUBROUTINE PLA136
      SUBROUTINE PLA137 (IH, IK, IL, IHT, IKT, ILT, XI, SIGI,
     1  SIGIW, UCINT, ACALS, BCALS, ACOR, IEND)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PL132/ TRMX(3, 3), STHKM, ISKIP, ITSKP, IOBS, ICALC,
     1 NDEC, SHXMP
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      DO
        CALL PLA136 (IH, IK, IL, XI, SIGI, SIGIW, CALI, UCINT, ACALS,
     1               BCALS, ACOR, IEND)
        IF (IEND .LE. 0) THEN
          IF (IH .NE. 0 .OR. IK .NE. 0 .OR. IL .NE. 0) THEN
            IF (GEN050 (TRMX, IH, IK, IL, IHT, IKT, ILT) .GT. 0.0) THEN
              IF (IPR(241) .GT. 1) THEN
                IF (GEN049 (LAT(IPR(241)), IHT, IKT, ILT) .LE. 0.0) THEN
                  ISKIP = ISKIP + 1
                  CYCLE
                END IF
              END IF
            ELSE
              ISKIP = ISKIP + 1
              CYCLE
            END IF
            STHK  = GEN095 (PAR(191), IHT, IKT, ILT)
            IF (IGBL(30) .EQ. 0) THEN
              IF (STHK .GT. STHKM) THEN
                ITSKP = ITSKP + 1
                CYCLE
              END IF
            END IF
            PAR(166) = MAX (PAR(166), STHK)
            XI       = XI   * PAR(230)
            SIGI     = SIGI * PAR(230)
          END IF
          EXIT
        ELSE
          IEND = 1
          IF (ISKIP .GT. 0 .AND. IPR(408) .LE. 0) THEN
            WRITE (LU6, 99999, IOSTAT = IOST) ISKIP
            CALL PLA262 (3)
            WRITE (LU7, 99999, IOSTAT = IOST) ISKIP
          END IF
          ISKIP = 0
          IF (ITSKP .GT. 0 .AND. IPR(408) .LE. 0) THEN
            WRITE (LU6, 99998, IOSTAT = IOST) PAR(165), ITSKP
            CALL PLA262 (3)
            WRITE (LU7, 99998, IOSTAT = IOST) PAR(165), ITSKP
          END IF
          ITSKP = 0
          EXIT
        END IF
      END DO
      RETURN
99999 FORMAT (/, ':: Nr. of Eliminated Reflections (Latt Ext. etc.)',
     1 ' =', I5, /)
99998 FORMAT (/, ':: Nr. of Eliminated Reflections (Theta Limit = ',
     1 F5.1, ' Deg) =', I10, /)
      END SUBROUTINE PLA137
      SUBROUTINE PLA138 (MODE, IHP, IKP, ILP, IEXT, IASM)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP45=2048,
     1 NP60=100)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      DIMENSION XJX(12), IND(3)
      IHKL0 = 0
      IHKLM = 0
      IEXT = 0
      IASM = 1
      DO I = 1, NSYMH
        XJX(1) = IHP
        XJX(2) = IKP
        XJX(3) = ILP
        XJX(4) = 0.0
        NS     = I
        CALL SGSM (ICL, NS, XJX, 0, 5, IERR)
        IND(1) = NINT(XJX(IND1 + 6))
        IND(2) = NINT(XJX(IND2 + 6))
        IND(3) = NINT(XJX(IND3 + 6))
        IHKL = IND(3) * MHK + IND(2) * MPH + IND(1)
        IF (IHKL .LT. 0) THEN
          DO J = 1, 3
            IND(J) = - IND(J)
          END DO
          IHKL  = - IHKL
          ISHKL = - 1
        ELSE
          ISHKL =   1
        END IF
        IF (IHKL .GT. IHKLM) THEN
          IHKLM = IHKL
          IF (I .GT. 1) IASM = 0
        END IF
        IHKLM = MAX (IHKLM, IHKL)
        IF (MODE .EQ. 1) THEN
          DO J = 1, 3
            IHKLS(J, I) = IND(J)
          END DO
          IHKLS(4, I) = IHKL
          IHKLS(5, I) = ISHKL
          PHIS(I)     = XJX(10) / RGBL(6)
          IF (ICNTR .EQ. 2) THEN
            IHKLI = IABS(IHKL)
          ELSE
            IHKLI = IHKL * ISHKL
          END IF
          IF (I .GT. 1) THEN
            IF (IHKL0 .EQ. IHKLI) THEN
              IF (NINT(XJX(4) / RGBL(6)) .NE. NINT(XJX(10) / RGBL(5)))
     1         THEN
                IEXT = 1
                RETURN
              END IF
            END IF
          ELSE
            IHKL0 = IHKLI
          END IF
        END IF
      END DO
      RETURN
      END SUBROUTINE PLA138
      SUBROUTINE PLA139 (NREF, HMAX, KMAX, LMAX)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      INTEGER HMAX
      LOGICAL OPEND
      IF (IPR(259) .EQ. 5 .OR. IPR(259) .EQ. 6) THEN
        IHEXL = 1
      ELSE
        IHEXL = 0
      END IF
      NREF = 0
      IHT  = 0
      IKT  = 0
      ILT  = 0
      HMAX = -999
      KMAX = -999
      LMAX = -999
      INQUIRE (UNIT = LU27, OPENED = OPEND)
      IF (OPEND) CLOSE (UNIT = LU27)
      OPEN (UNIT = LU27, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1   IOSTAT = IOST)
      IF (IOST .NE. 0) STOP 'PROBLEM OF LU27'
      IEND = -1
      DO
        CALL PLA137 (IH, IK, IL, IHT, IKT, ILT, XI, SIGI,
     1    SIGIW, UCINT, ACALS, BCALS, ACOR, IEND)
        IF (IEND .EQ. 1) EXIT
        HMAX = MAX (HMAX, IABS(IHT))
        KMAX = MAX (KMAX, IABS(IKT))
        IF (IHEXL .EQ. 1) THEN
          HMAX = MAX (KMAX, HMAX, IABS(IHT + IKT))
          KMAX = HMAX
        END IF
        LMAX = MAX (LMAX, IABS(ILT))
        NREF = NREF + 1
        IF (IGBL(9) .EQ. -1) THEN
          YUNK = UCINT
        ELSE
          YUNK = XI
        END IF
        WRITE (LU27, IOSTAT = IOST) IHT, IKT, ILT, YUNK, SIGI, SIGIW
      END DO
      IF (IPR(259) .EQ. 4) THEN
        HMAX = MAX (HMAX, KMAX)
        KMAX = HMAX
      ELSE IF (IPR(259) .EQ. 7) THEN
        HMAX = MAX (HMAX, KMAX, LMAX)
        KMAX = HMAX
        LMAX = HMAX
      END IF
      IF (NREF .EQ. 0) THEN
        IPR(1) = 1
        IF (IPR(2) .EQ. 0) IPR(2) = 39
        RETURN
      END IF
      WRITE (LU6, 99999, IOSTAT = IOST) NREF, HMAX, KMAX, LMAX
      CALL PLA262 (3)
      WRITE (LU7, 99999, IOSTAT = IOST) NREF, HMAX, KMAX, LMAX
      RETURN
99999 FORMAT (/, ':: # Accepted Reflns     Hmax Kmax Lmax', /,
     1           '::', 12X, I6, 3X, 3I5)
      END SUBROUTINE PLA139
      SUBROUTINE PLA140 (FFT, R3D, NATO, RHOMIN, MODE, NPK, IPOSNEG,
     1 NSYM)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      DIMENSION FFT(*), R3D(*), XS(3), X1(3), IDF(19), B(19), DXMAX(3)
      IF (MODE .NE. 0) THEN
        ISW  = 3
      ELSE
        ISW  = -3
      END IF
      KUSER = NP1 - NATO
      DM    = 0.50
      NNX   = IPR(395)
      NNY   = IPR(396)
      NNZ   = IPR(397)
      NNXP2 = NNX + 2
      NXY   = NNXP2 * (NNY + 2)
      NXY3  = 3 * NXY
      DX    = 1.0 / FLOAT(NNX)
      DY    = 1.0 / FLOAT(NNY)
      DZ    = 1.0 / FLOAT(NNZ)
      NAT   = KUSER - 20
      NPIC  = KUSER - 20
      DO I = 1, 3
        DXMAX(I) = DM * PAR(112 + I)
      END DO
      DM = DM ** 2
      XLEVEL  = RHOMIN
      LIMIT   = MIN (KUSER, 2 * NAT)
      IDF(1)  = - NXY   - 1
      IDF(2)  = - NXY   - NNXP2
      IDF(3)  = - NXY
      IDF(4)  = - NXY   + NNXP2
      IDF(5)  = - NXY   + 1
      IDF(6)  = - NNXP2 - 1
      IDF(7)  = - 1
      IDF(8)  =   NNXP2 - 1
      IDF(9)  = - NNXP2
      IDF(10) = 0
      DO I = 1, 9
        IDF(20 - I) = - IDF(I)
      END DO
      NO = 0
      IZ = -1
      NZ = 0
   10 N  = -1
      IF (IZ + 2 .NE. NNZ) THEN
        MAX = NXY
        N   = NNZ - 1
        CALL PLA141 (FFT, R3D, MAX, NNX, NNY, NXY3, N, IPOSNEG)
        N   = 0
        CALL PLA141 (FFT, R3D, MAX, NNX, NNY, NXY3, N, IPOSNEG)
      END IF
   20 MX  = MAX - NXY + NNX + 1
      N   = N + 1
      CALL PLA141 (FFT, R3D, MAX, NNX, NNY, NXY3, N, IPOSNEG)
      IZ = IZ + 1
      NZ = MOD(NZ + 2, 3) - 1
      KK = ISIGN (NXY3, NZ)
      IF (NZ .LE. 0) THEN
        DO I = 1, 5
          IDF(I) = IDF(I) - KK
        END DO
        IF (NZ .EQ. 0) GO TO 30
      END IF
      DO I = 15, 19
        IDF(I) = IDF(I) - KK
      END DO
   30 DO IY = 1, NNY
        MN = MX + 3
        MX = MX + NNXP2
        DO 70 IX = MN, MX
          IF (R3D(IX) .GE. XLEVEL) THEN
            DO I = 1, 9
              J = IDF(I) + IX
              IF (R3D(IX) .LE. R3D(J)) GO TO 70
            END DO
            DO I = 11, 19
              J = IDF(I) + IX
              IF (R3D(IX) .LT. R3D(J)) GO TO 70
            END DO
            DO I = 1, 19
              B(I) = R3D(IDF(I) + IX)
            END DO
            B1 = B(3)  + B(7)  + B(9)  + B(11) + B(13) + B(17)
            B2 = B(1)  + B(2)  + B(4)  + B(5)  + B(6)  + B(8) + B(12)
     1         + B(14) + B(15) + B(16) + B(18) + B(19)
            F = (30.0 * B(10) + 11.0 * B1 - 8.0 * B2) / 63.0
            C = (B(5) + B(12) + B(13) + B(14) + B(19) - B(1) - B(6)
     1        - B(7) - B(8) - B(15)) / 10.0
            DELTAX = C / F
            IF (ABS(DELTAX) .LE. 1.0) THEN
              D = (B(15) + B(16) + B(17) + B(18) + B(19) - B(1) - B(2)
     1          - B(3) - B(4) - B(5)) / 10.0
              DELTAY = D / F
              IF (ABS(DELTAY) .LE. 1.0) THEN
                E  = (B(4) + B(8) + B(11) + B(14) + B(18) - B(2) - B(6)
     1             - B(9) - B(12) - B(16)) / 10.0
                DELTAZ = E / F
                IF (ABS(DELTAZ) .LE. 1.0) GO TO 40
              END IF
            END IF
            DELTAX = 0.0
            DELTAY = 0.0
            DELTAZ = 0.0
   40       XX = (FLOAT(IX - MN + 1) + DELTAX) * DX
            YY = (FLOAT(IY)          + DELTAY) * DY
            ZZ = (FLOAT(IZ)          + DELTAZ) * DZ
            NOP1                = NO + 1
            XXO(NATO + NOP1, 1) = XX
            XXO(NATO + NOP1, 2) = YY
            XXO(NATO + NOP1, 3) = ZZ
            XXO(NATO + NOP1, 4) = B(10)
            XXO(NATO + NOP1, 5) = F
            IF (NO .GT. 0) THEN
              IR = 0
              DO K = 1, 3
                XJX(K)     = XXO(NATO + NOP1, K)
                XJX(K + 3) = 0.0
              END DO
              DO K = 1, NSYM
                KSYM = K
                CALL SGSM (ICL, KSYM, XJX, 6, ISW, IERR)
                XS(1) = XJX(7)
                XS(2) = XJX(8)
                XS(3) = XJX(9)
                DO 60 I = 1, NO
                  DO L = 1, 3
                    X1(L) = XXO(NATO + I, L) - XS(L)
   50               IF (ABS(X1(L)) .LE. 0.5) THEN
                      IF (ABS(X1(L)) .GT. DXMAX(L)) THEN
                        GO TO 60
                      ELSE
                        CYCLE
                      END IF
                    END IF
                    X1(L) = X1(L) - SIGN (1.0, X1(L))
                    IF (.TRUE.) GO TO 50
                  END DO
                  IF (GEN006 (X1, AA, X1) .LE. DM) THEN
                    IF (B(10) .LE. XXO(NATO + I, 4)) GO TO 70
                    IF (IR .GT. 0) XXO(NATO + IR, 4) =  -1.0
                    IR               = 0
                    XXO(NATO + I, 1) = XX
                    XXO(NATO + I, 2) = YY
                    XXO(NATO + I, 3) = ZZ
                    XXO(NATO + I, 4) = B(10)
                    XXO(NATO + I, 5) = F
                    IR               = I
                  END IF
   60           CONTINUE
              END DO
              IF (IR .GT. 0) GO TO 70
            END IF
            NO = NOP1
            IF (NO .GE. LIMIT) THEN
              CALL GEN091 (XXO, DUMA, NP1, 6, NATO, NO, 4)
              NO     = NPIC
              XLEVEL = XXO(NATO + NPIC, 4)
            END IF
          END IF
   70   CONTINUE
      END DO
      IF (IZ .LT. NNZ) THEN
        IF (IZ .EQ. (NNZ - 2)) THEN
          GO TO 10
        ELSE
          GO TO 20
        END IF
      END IF
      CALL GEN091 (XXO, DUMA, NP1, 6, NATO, NO, 4)
      NPK = NO
      IF (MODE .LT. 0) THEN
        N1 = NATO + 1
        N2 = NATO + NPK
        IF (NPK .GT. 0) THEN
          IF (MODE .EQ. -3) THEN
            N2 = MIN (N2, N1 + 24)
            CALL PLA143 ( -1, 3.2, N1, N2, IPOSNEG)
            CALL PLA361 (1.2, N1, N2, IPOSNEG)
          ELSE
            CALL PLA143 (1, 3.2, N1, N2, IPOSNEG)
          END IF
        ELSE
          IF (IGBL(63) .GT. 0) THEN
            IF (IPOSNEG .GT. 0) THEN
              WRITE (LU6, 99999, IOSTAT = IOST)
            ELSE
              WRITE (LU6, 99998, IOSTAT = IOST)
            END IF
          END IF
        END IF
      END IF
99999 FORMAT (':: No Positive Density Peaks')
99998 FORMAT (':: No negative Density Peaks')
      RETURN
      END SUBROUTINE PLA140
      SUBROUTINE PLA141 (FFT, R3D, MAX, NNX, NNY, NXY3, NZ, IPOSNEG)
      DIMENSION FFT(*), R3D(*)
      IF (MAX .GE. NXY3) MAX = 0
      MX  = MAX
      MAX = MAX - 2
      LOC = NNX * NNY * NZ
      DO IY = 1, NNY
        MIN = MAX + 3
        MAX = MAX + NNX + 2
        DO I = MIN, MAX
          LOC    = LOC + 1
          R3D(I) = AMAX1 (0.0, FFT(2 * LOC - 1) * IPOSNEG)
        END DO
        R3D(MAX + 1) = R3D(MIN)
        R3D(MAX + 2) = R3D(MIN + 1)
      END DO
      MIN = MAX + 3
      MAX = MAX + 2 * NNX + 6
      DO IX = MIN, MAX
        MX      = MX + 1
        R3D(IX) = R3D(MX)
      END DO
      RETURN
      END SUBROUTINE PLA141
      SUBROUTINE PLA142 (MODE, VOID, FFT, R3D, NREF, FS000)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      DIMENSION VOID(*), FFT(*), R3D(*)
      NATO  = IPR(589)
      M1    = IPR(395)
      M2    = IPR(396)
      M3    = IPR(397)
      NGRD2 = 2 * M1 * M2 * M3
      CALL GEN074 (FFT, 1, NGRD2, 0.0)
      FFT(1) = FS000
      N15    = 0
      DO I = 1, NREF
        ISN = 1
        AC  = VOID(N15 + 7)
        BC  = VOID(N15 + 8)
        DO J = 1, 2
          IF (J .EQ. 2) ISN = -1
          IH = ISN * NINT(VOID(N15 + 9))
          IK = ISN * NINT(VOID(N15 + 10))
          IL = ISN * NINT(VOID(N15 + 11))
          IF (IH .LT. 0) IH = IH + M1
          IF (IK .LT. 0) IK = IK + M2
          IF (IL .LT. 0) IL = IL + M3
          LOC = 2 * ((IL * M2 + IK) * M1 + IH + 1)
          FFT(LOC - 1) = AC
          FFT(LOC)     = BC * ISN
        END DO
        N15 = N15 + 15
      END DO
      CALL GEN028 (FFT, IPR(395), 3, -1)
      IF (IGBL(129) .NE. 0) CALL PLA362 (FFT, NGRD2, PAR(98))
      RHOMIN = PAR(269) * PAR(98)
      CALL PLA140 (FFT, R3D, NATO, RHOMIN, MODE, NPK,  1, IPR(48))
      CALL PLA140 (FFT, R3D, NATO, RHOMIN, MODE, NPK, -1, IPR(48))
      RETURN
      END SUBROUTINE PLA142
      SUBROUTINE PLA143 (MODE, DMX, N1, N2, IPOSNEG)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER TYP*1, AREA*2, TYPE*4, MAXMIN*6, ENHANCED*10
      NSYM = IPR(48)
      NAT  = IPR(37)
      NPKV = 0
      IF (MODE .EQ. 1) THEN
        ENHANCED = ' Enhanced '
      ELSE
        ENHANCED = ' '
      END IF
      V2(1) = DMX / (PAR(101) * SIN(PAR(105) / RGBL(6)) * PAR(121))
      V2(2) = DMX / (PAR(102) * SIN(PAR(106) / RGBL(6)) * PAR(119))
      V2(3) = DMX / (PAR(103) * SIN(PAR(104) / RGBL(6)) * PAR(120))
      IF (N2 .GE. N1) THEN
        IF (ABS(MODE) .EQ. 1) THEN
          IF (IPOSNEG .GT. 0) THEN
            MAXMIN   = 'Maxima'
            PAR(330) = 0.0
            IF (MODE .EQ. -1) PAR(330) = XXO(N1, 4) / PAR(98)
            IF (MODE .EQ. 1) THEN
              REWIND (UNIT = LU2, IOSTAT = IOST)
              IF (IOST .NE. 0) CALL GEN148 (LU2, 1)
              WRITE (LU2, 99994, IOSTAT = IOST)
     1          JID(1:74), (PAR(100 + I), I = 1, 6)
              IF (SPGRNM(1)(1:3) .EQ. '   ') THEN
                WRITE (LU2, 99990, IOSTAT = IOST)
     1            SPGRNM(1)(13:13), SPGRNM(1)(14:14)
                ISW = 2
                DO I = 2, IPR(255)
                  CALL SGSM (ICL, I, XJX, 0, ISW, IERR)
                  WRITE (LU2, 99989, IOSTAT = IOST) ICL(1:60)
                END DO
              ELSE
                IF (SPGRNM(1)(8:11) .EQ. '    ') THEN
                  I = ICHAR(' ')
                ELSE
                  I = ICHAR('.')
                END IF
                WRITE (LU2, 99988, IOSTAT = IOST)
     1            SPGRNM(1)(1:7), CHAR(I),
     1                             SPGRNM(1)(8:11)
              END IF
              WRITE (LU2, 99991, IOSTAT = IOST) PAR(150), PAR(149)
            END IF
          ELSE
            MAXMIN   = 'Minima'
            PAR(329) = 0.0
            IF (MODE .EQ. -1) PAR(329) = XXO(N1, 4) / PAR(98)
          END IF
          IF (IGBL(129) .NE. 0) THEN
            WRITE (LU13, 99998, IOSTAT = IOST)
            WRITE (LU13, 99999, IOSTAT = IOST) MAXMIN, ENHANCED,
     1        MAX (0.10, PAR(269)) * IPOSNEG, DMX
          END IF
          IF (IGBL(63) .GT. 0) THEN
            CALL PLA262 (0)
            WRITE (LU6, 99999, IOSTAT = IOST) MAXMIN, ENHANCED,
     1        MAX (0.10, PAR(269)) * IPOSNEG, DMX
            CALL PLA262 (5)
            WRITE (LU7, 99999, IOSTAT = IOST) MAXMIN, ENHANCED,
     1        MAX (0.10, PAR(269)) * IPOSNEG, DMX
          END IF
        ELSE
          WRITE (PRBUF, 99996, IOSTAT = IOST) DMX
          IF (IGBL(63) .GT. 0) THEN
            WRITE (LU6, 99987, IOSTAT = IOST) PRBUF
            CALL PLA262 (3)
            WRITE (LU7, 99987, IOSTAT = IOST) PRBUF
          END IF
        END IF
        DO I = N1, N2
          NPK = 0
          DO J = 1, NAT
            CALL GEN048 (-1, IFG(1, J), 7, IHAT)
            IF (IHAT .EQ. 0) THEN
              DO 40 N = 1, NSYM
                DO K = 1, 3
                  XJX(K)     = XXO(J, K)
                  XJX(K + 3) = 0.0
                END DO
                NS = N
                CALL SGSM (LINE, NS, XJX, LU6, 3, IERR)
                K = 1
                GO TO 20
   10           XJX(6 + K) = XJX(6 + K) - 1.0
   20           IF ((XXO(I, K) - XJX(6 + K)) .LE. V2(K)) GO TO 10
   30           XJX(6 + K) = XJX(6 + K) + 1.0
                IF ((XXO(I, K)  - XJX(6 + K)) .LT. - V2(K)) THEN
                  K = K - 1
                  IF (K .EQ. 0) GO TO 40
                  GO TO 30
                END IF
                IF (ABS(XXO(I, K)  - XJX(6 + K)) .LE. V2(K)) THEN
                  K = K + 1
                  IF (K .GT. 3) THEN
                    DO L = 1, 3
                      V3(L) = XXO(I, L) - XJX(6 + L)
                    END DO
                    CALL GEN002 (2, OR, V3, V4, DIST)
                    IF (DIST .LT. DMX) THEN
                      IF (NPK .EQ. 0) THEN
                        JTEST = 0
                      ELSE
                        JTEST = IATC(NPK)
                      END IF
                      IF (J .NE. JTEST) THEN
                        NPK = NPK + 1
                        DATC(NPK) = DIST
                        IATC(NPK) = J
                      ELSE
                        IF (DIST .LT. DATC(NPK)) DATC(NPK) = DIST
                      END IF
                    END IF
                    K = K - 1
                    GO TO 30
                  END IF
                  GO TO 20
                END IF
                GO TO 30
   40         CONTINUE
            END IF
          END DO
          CALL GEN013 (DATC, IATC, 1, NPK)
          NPKM1 = MIN (NPK, MIN (9, NP4))
          IF (NPKM1 .GT. 0) THEN
            DO J = 1, NPKM1
              IXL = - LABA(IATC(J))
              CALL PLA047 (IXL, NQ1, MN, IENR, 0, IGBL(55), 0,
     1          1 - IGBL(55))
              NAMS(J, 1) = NQ1
              IF (J .EQ. 1) IENR1 = IENR
              IF (IPR(155) .EQ. 1) THEN
                IF (DATC(J) .LT. 1.2) THEN
                  CALL GEN048 (-1, IFG(1, IATC(J)), 19, JMET)
                  IF (JMET .EQ. 1) THEN
                    IF (DATC(J) .LT. 0.2) THEN
                      IF (MODE .EQ. -1) THEN
                        XDENS = IPOSNEG * XXO(I, 4) / PAR(98)
                        IF (ABS(XDENS) .GT. 0.75) THEN
                          IF (IPR(619) .EQ. 0) THEN
                            IF (IPOSNEG .GT. 0) THEN
C * ALERT _973 - LARGE POSITIVE DENSITY ON METAL
                              CALL PLA231 (973, 2,   XDENS, XDENS,
     1                          NQ1, ' ')
                            ELSE
C * ALERT _974 - LARGE NEGATIVE DENSITY ON METAL
                              CALL PLA231 (974, 2, - XDENS, XDENS,
     1                          NQ1, ' ')
                            END IF
                          END IF
                        END IF
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END DO
          END IF
          NPKM = MIN (NPK, 4)
          TYPE = '    '
          IF (MODE .EQ. 2) THEN
            WRITE (AREA, 99992, IOSTAT = IOST) I + 1 - N1
          ELSE IF (ABS(MODE) .EQ. 1) THEN
            XDENS = IPOSNEG * XXO(I, 4) / PAR(98)
            IF (ABS(XDENS) .LT. 0.1) THEN
              N2 = I
              GO TO 60
            END IF
            NPKV = NPKV + 1
            IF (MODE .EQ. 1) TYPE  = 'void'
            IF (NPKM .GT. 0) THEN
              IF (DATC(1) .LT. 2.6) TYPE = '    '
              IF (DATC(1) .LT. 2.0) THEN
                IF (IPOSNEG .GT. 0) THEN
                  PAR(330) = MAX (PAR(330), XDENS)
                ELSE
                  PAR(329) = MIN (PAR(329), XDENS)
                END IF
              END IF
            END IF
          END IF
          IF (IGBL(63) .GT. 0) CALL PLA262 (1)
          IF (ABS(MODE) .EQ. 1) THEN
            IF (IGBL(129) .NE. 0) THEN
              IF (ABS(XDENS) .GT. 0.75) THEN
                IF (IPR(619) .EQ. 0 .AND. IPR(651) .EQ. 0) THEN
                  CALL GEN048 (-1, IFG(1, IATC(1)), 19, JMET)
                  IF (JMET .EQ. 0 .OR. DATC(1) .GE. 0.2) THEN
                    WRITE (NQ2, 99986, IOSTAT = IOST) DATC(1)
                    IF (IPOSNEG .GT. 0) THEN
C * ALERT  _971
                      CALL PLA231 (971, 2,   XDENS, XDENS,
     1                  NAMS(1, 1), NQ2)
                    ELSE
C * ALERT  _972
                      CALL PLA231 (972, 2, - XDENS, XDENS,
     1                  NAMS(1, 1), NQ2)
                    END IF
                  END IF
                END IF
              END IF
              IF (IPR(619) .EQ. 0) THEN
                ALERT = 0.0
                TYPE  = '    '
                IF (ABS (XDENS) .GT. 0.4) THEN
                  IF (ABS(DATC(1) - 0.75) .LT. 0.35) THEN
                    WRITE (NQ2, 99986, IOSTAT = IOST) DATC(1)
                    IF (NPKM .GT. 1) THEN
                      IF (DATC(2) .GT. 1.75) THEN
                        IF (IENR1 .EQ. 3 .OR. IENR1 .EQ. 4) THEN
                          ALERT = XDENS
                        END IF
                      END IF
                    ELSE
                      IF (IENR1 .EQ. 3) ALERT = XDENS
                    ENDIF
                    IF (ALERT .GT. 0.0) THEN
C * ALERT _975 - POSITIVE DENSITY NEAR N OR O
                      CALL PLA231 (975, 2,   ALERT, ALERT,
     1                             NAMS(1, 1)(1:5), NQ2)
                      TYPE = '+H?'
                    ELSE IF (ALERT .LT. 0.0) THEN
C * ALERT _976 - NEGATIVE DENSITY NEAR N OR O
                      CALL PLA231 (976, 2, - ALERT, ALERT,
     1                             NAMS(1, 1)(1:5), NQ2)
                      TYPE = '-H?'
                    ENDIF
                  END IF
                END IF
              END IF
              WRITE (LU13, 99997, IOSTAT = IOST)
     1          NPKV, (XXO(I, J), J = 1, 3), XDENS, TYPE,
     2          (NAMS(J, 1)(1:5), DATC(J), J = 1, NPKM)
            END IF
            IF (IGBL(63) .GT. 0) THEN
              WRITE (LU6, 99997, IOSTAT = IOST)
     1          NPKV, (XXO(I, J), J = 1, 3), XDENS, TYPE,
     2          (NAMS(J, 1)(1:5), DATC(J), J = 1, NPKM)
              WRITE (LU7, 99997, IOSTAT = IOST)
     1          NPKV, (XXO(I, J), J = 1, 3), XDENS, TYPE,
     2          (NAMS(J, 1)(1:5), DATC(J), J = 1, NPKM1)
            END IF
            IF (IPOSNEG .GT. 0) THEN
              IF (MODE .EQ. 1 .AND. NPKV .LT. 100) THEN
                IF (TYPE .EQ. 'void') THEN
                  TYP = 'C'
                ELSE
                  TYP = 'Q'
                END IF
                WRITE (LU2, 99993, IOSTAT = IOST)  TYP, 100 + NPKV,
     1            (XXO(I, J), J = 1, 3), XXO(I, 4) / PAR(98)
              END IF
            END IF
          ELSE
            IF (IGBL(63) .GT. 0) THEN
              WRITE (LU6, 99995, IOSTAT = IOST)
     1          AREA, (XXO(I, J), J = 1, 3), TYPE,
     2          (NAMS(J, 1)(1:5), DATC(J), J = 1, NPKM)
              WRITE (LU7, 99995, IOSTAT = IOST)
     1          AREA, (XXO(I, J), J = 1, 3), TYPE,
     2          (NAMS(J, 1)(1:5), DATC(J), J = 1, NPKM1)
            END IF
          END IF
        END DO
   60   WRITE (LU6, 99998, IOSTAT = IOST)
        IF (IGBL(63) .GT. 0) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99998, IOSTAT = IOST)
        END IF
      END IF
      RETURN
99999 FORMAT (79('='), /, 'Unique Density ', A, ' in', A, 'Difference ',
     1 'Map (CutOff level =', F9.2, ' eA-3)', /, 79('='), /, 3X, '#',
     2 3X, 'x', 5X, 'y', 5X, 'z  (e/A^3)', 5X,
     3 'Shortest Contacts within', F4.1, ' Ang. (Excl. H)', /, 79('='))
99998 FORMAT (' ')
99997 FORMAT (I4, 3F6.3, F6.2, 1X, A, 1X, 9(A, F4.2, '; '))
99996 FORMAT (7X, 'x', 5X, 'y', 5X, 'z', 14X, 'Shortest ',
     1 'Contacts within', F4.1, ' Ang. (Excl. H)')
99995 FORMAT (1X, A, 1X, 3F6.3, 7X, A, 1X, 9(A, F4.2, '; '))
99994 FORMAT ('TITL ', A, /, 'CELL', 3F10.4, 3F10.2)
99993 FORMAT (A, I3, 3F6.3, ' ! ', F10.2, ' eA-3')
99992 FORMAT (I2)
99991 FORMAT ('# Solvent Accessible Volume =', F10.1, /,
     1        '# Electrons Found in S.A.V. =', F10.1, /,
     2        '# Note: Atoms in Void as Cxxx and Qxxx all others')
99990 FORMAT ('LATT ', A, 2X, A)
99989 FORMAT ('SYMM ', A)
99988 FORMAT ('SPGR ', 3A)
99987 FORMAT (/, A, /, 80('='))
99986 FORMAT (F6.2, 'A')
      END SUBROUTINE PLA143
      SUBROUTINE PLA144 (MODE, IAT)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /PL65/ NBOND, NPNT, NPNTM
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      CHARACTER CDUM*(NP52)
      IF (MODE .EQ. 0) THEN
        NBOND = 0
        NPNT  = NINT (PAR(262) * 100.0)
        NPNTM = 2 * NPNT
        CALL GEN074 (DATC, NPNT + 1, NPNTM, 0.0)
      ELSE IF (MODE .GT. 0) THEN
        NC = IPR(79)
        IF (NC .GT. 0) THEN
          CALL PLA047 (LABA(IAT), NQ3, MNX, IENI, 0, IGBL(55), 0,
     1                                             1 - IGBL(55))
          CALL GEN048 (-7, IFG(2, IAT), 1, IPP)
          MULTI = IPR(48) / IPPR(IPP + 1, 3)
          CALL PLA036 (IAT, 1, 1, IDUM1, MNI, IDUM3, IPR(71),
     1         IGBL(55))
          NCI = 0
          NDB = 0
          DO J = 1, NC
            KAT  = IATC(J)
            MKAT = MOD (KAT, NP1)
            IDUB = 0
            IF (J .GT. 1) THEN
              DO K = 2, J
                IF (MKAT .EQ. MOD(IATC(K - 1), NP1)) THEN
                  IDUB = 2
                  NDB  = NDB + 1
                END IF
              END DO
            END IF
            CALL GEN048 (-1, IFG(1, MKAT), 7, IHA)
            PADD = (IDUB + IHA + 1) * PAR(23)
            IF (KAT .LE. NP1) THEN
              CALL PLA040 (-1, IAT, JJ, KAT)
              IF (JJ .GT. 0) THEN
                NCI  = NCI + 1
                PADD = 0
              END IF
            END IF
            DATC(J) = PADD + DATC(J)
          END DO
          CALL GEN013 (DATC, IATC, 1, NC)
          NC = NC - NDB
          DO J = 1, NC
            KAT     = IATC(J)
            IPR(20) = 0
            IF (KAT .GT. NP1) THEN
              KAT     = KAT - NP1
              IATC(J) = KAT
              IPR(20) = 1
            END IF
            CALL GEN048 (-6, IFG(1, KAT), 9, IRESJ)
            CALL PLA036 (KAT, 1, 2, IDUM1, MNJ, IDUM3, IPR(71),
     1           IGBL(55))
            ILABX = - LABA(KAT)
            CALL PLA047 (ILABX, NQ4, MNY, IENK, IPR(71), IGBL(55),
     1        0, 1 - IGBL(55))
            CALL PLA046 (2, NQ4, IDUM, LBB, LBC, LBD, ILMP, JNQNR, KATP)
            CALL PLA047 (LABA(KAT), NQ3, MNY, IENK, IPR(71),
     1        IGBL(55), 0, 1 - IGBL(55))
            CALL PLA053 (IAT, KAT, 0, 0, DIJ, SDIJ, ISDIJ, NDEC, IER)
            NBOND     = NBOND + 1
            NI        = IATNR(IENI)
            NK        = IATNR(IENK)
            NIJ       = INT(DIJ * 100.0) + NPNT + 1
            DATC(NIJ) = DATC(NIJ) + FLOAT(NI * NK) / FLOAT(MULTI)
          END DO
        END IF
      ELSE
   10   CALL GEN074 (DATC, 1, NPNT, 0.0)
        DO I = 1, NPNT
          IF (IPR(581) .EQ. 0) THEN
            A = DATC(I + NPNT)
          ELSE
            A = DATC(I + NPNT) / I
          END IF
          IF (A .GT. 0.0) THEN
            DATC(I) = DATC(I) + A
            DO J = 1, 199
              FACT = A * EXP (- (J / PAR(451)) ** 2)
              IF (I + J .LE. NPNT) DATC(I + J) = DATC(I + J) + FACT
              IF (I - J .GT. 0)    DATC(I - J) = DATC(I - J) + FACT
            END DO
          END IF
        END DO
        AMX = 0.0
        DO I = 1, NPNT
          AMX = MAX (AMX, DATC(I))
        END DO
        DO
          IGBL(6) = 28
          BCD(1:30) = 'Simulated Radial Distribution'//CHAR(0)
          CALL GGIP (HORS, VERT, 0.0, 1)
          CALL GGIP09 (0.0,  BCD, 29, 1.0, 4, 8, 0.6, VERT - 1.6)
          CALL GGIP09 (0.0,  BCD, 29, 1.0, 2, 8, 0.5, VERT - 1.7)
          CALL PLA110 (HORS, VERT, -1)
          VRT = VERT - 3.0
          CALL PLA283 (0, 1, N, CDUM)
          WRITE (LINE, 99989, IOSTAT = IOST) CDUM(N:NP52)
          CALL GGIP09 (0.0, LINE, 60, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99999,IOSTAT = IOST) SPGRNM(1)(1:7)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 17, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99998, IOSTAT = IOST) PAR(101)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99997, IOSTAT = IOST) PAR(102)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99996, IOSTAT = IOST) PAR(103)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99995, IOSTAT = IOST) PAR(104)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99994, IOSTAT = IOST) PAR(105)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99993, IOSTAT = IOST) PAR(106)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.5, VRT)
          WRITE (LINE, 99990, IOSTAT = IOST) PAR(98)
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, LINE, 13, 0.35, 1, 1, 1.5, VRT)
          XSTEP = (HORS - 2.0) / NPNT
          SCF   = (VERT - 4.0) / AMX
          CALL GGIP (1.0, 2.0, 0.0, 3)
          XP = 1.0
          DO I = 1, NPNT
            XP = XP + XSTEP
            YP = 2.0 + SCF * DATC(I)
            CALL GGIP (XP, YP, 0.0, 2)
          END DO
          CALL GGIP (0.0, 0.0, 0.0, 3)
          XP = 1.0
          N  = 0
          NM = NPNT / 50
          XST = XSTEP * 50
          DO WHILE (N .LE. NM)
            CALL GGIP (XP, 1.0, 0.0, 3)
            CALL GGIP (XP, 1.4, 0.0, 2)
            IF (N .LT. 20) THEN
              WRITE (NQ1, 99992, IOSTAT = IOST) N * 0.5
            ELSE
              WRITE (NQ1, 99991, IOSTAT = IOST) N * 0.5
            END IF
            CALL GGIP09 (0.0, NQ1, 4, 0.2, 2, 2, XP + 0.1, 1.2)
            XP = XP + XST
            N  = N  + 1
          END DO
          CALL GGIP09 (0.0, 'Angstrom', 8, 0.3, 2,2, HORS - 2.4, 0.2)
          CALL PLA013 (0, 1)
          CALL GEN072 (IGGT, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
          IF (IFL(1)(1:4) .EQ. 'EXIT') THEN
            RETURN
          ELSE IF (IFL(1)(1:4) .EQ. 'CALC') THEN
            RETURN
          ELSE IF (IFL(1)(1:3) .EQ. 'END') THEN
            IGGT = ' '
            IGBL(6) = 10
            RETURN
          ELSE IF (LRET .EQ. 2) THEN
            GO TO 10
          END IF
        END DO
      END IF
      RETURN
99999 FORMAT ('SpGroup ', A)
99998 FORMAT ('a    ', F8.2)
99997 FORMAT ('b    ', F8.2)
99996 FORMAT ('c    ', F8.2)
99995 FORMAT ('alpha', F8.2)
99994 FORMAT ('beta ', F8.2)
99993 FORMAT ('gamma', F8.2)
99992 FORMAT (F3.1)
99991 FORMAT (F4.1)
99990 FORMAT ('Volume', F7.1)
99989 FORMAT ('Formula ', A)
      END SUBROUTINE PLA144
      SUBROUTINE PLA145 (MODE)
C *********************************************************************
C * ASYM - PROGRAM FOR THE DISPLAY AND EXTRACTION OF A UNIQUE SET OF  *
C *        REFLECTIONS OUT OF A REDUNDANT SET + AB-INITIO GENERATION. *
C *        A.L.SPEK, Utrecht University, The Netherlands (1975-2014)  *
C *********************************************************************
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP44=512,
     2 NP45=2048,NP52=200,NP54=42,NP56=30,NP57=35,NP60=100,
     3 NPY=NVD+2*NP23-1185)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      CHARACTER AR(104)*60, CID*(NP44), ZONE(3)*1
      COMMON /CHAR0/ AR, CID, ZONE
      COMMON // IHM(6), IPL, ATHM, ATHMN, CALIM, ICNT(20, 2),
     1 XX(12), SM(2, 3), RA(50, 2), RB(50, 2), IRC(50, 2), IRD(50, 2),
     2 IT(200), IRAB(2, 2), IKS(3), IHKL(3), IHKLE(3), ID(252),
     3 STAT(20, 12), FULL(12), IAR(NPY)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1 ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /PL132/ TRMX(3, 3), STHKM, ISKIP, ITSKP, IOBS, ICALC,
     1 NDEC, SHXMP
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      CHARACTER ICRD*80, AA*80, IUU*1, XAR*60
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CENTRY*75
      CHARACTER FNLU18*80
      LOGICAL EXST, OPEND
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER LIJN*80
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      CHARACTER QMRK*1
C * MODE     =  0 - DEFAULT ASYM
C * MODE     =  1 - EXPECT NUMBER OF REFLECTIONS
C * MODE     =  2 - VALIDATION MODE (AVF)
C * MODE     =  3 - VALIDATION
C * IPR(408) = -1 - EXPAND (IOBS)
C *          =  0 - NORMAL-MODE
C *          =  1 - GENERATE
C *          =  2 - EXPECT
C * IPR(392) =  0 - LISTING OF SYMMETRY EXTINCT REFLECTIONS ONLY
C *          =  1 - LISTING OF REFLECTIONS ONLY
C *          =  2 - LISTING OF RECIPROCAL LATTICE ONLY
C *          =  3 - FULL LISTING OPTION
      PAGET = 'ASYM'
      CALL PLA293 (PAR(17))
      IPR(221) = 0
      IF (MODE .EQ. 0) THEN
      ELSE IF (MODE .EQ. 1) THEN
        IFL(2)   = 'EXPECT'
        IPR(220) = 2
      ELSE IF (MODE .EQ. 2) THEN
        IFL(2)   = 'AVF'
        IFL(3)   = 'VALID'
        IPR(220) = 3
      ELSE IF (MODE .EQ. 3) THEN
        IFL(2)   = 'VALID'
        IPR(220) = 2
      END IF
      N = 0
      IF (IPR(220) .GT. 1) THEN
        DO I = 2, IPR(220)
          SELECT CASE (IFL(I)(1:6))
            CASE ('EXPAND')
              IPR(408) = -1
            CASE ('GENERA')
              IF (IPR(37) .GT. 0) THEN
                IPR(408) = 1
                IPR(700) = NINT(FN(1))
                CLOSE (UNIT = LU17, STATUS = 'DELETE', IOSTAT = IOST)
                OPEN (UNIT = LU17,
     1             FILE = NAMEFIL(1:KNMFIL)//'_gener.hkl',
     1            STATUS = 'UNKNOWN', IOSTAT = IOST)
              ELSE
                IPR(2) = 42
                GO TO 170
              END IF
            CASE ('EXPECT')
              PAR(165)  = PAR(168)
              IPR(408)  = 2
              PAGET     = 'EXPECT'
              IPR(392)  = 0
              IPR(393)  = 0
              WRITE (LU6, 99940, IOSTAT = IOST)
            CASE ('VALID ')
              IF (IGBL(9) .EQ. 21) THEN
                CALL PLA231 (998, 0, 1.0, 1.0, ' ', ' ')
              ELSE IF (IGBL(9) .EQ. 23) THEN
                CALL PLA231 (999, 0, 1.0, 1.0, ' ', ' ')
              ELSE IF (IGBL(133) .GT. 0 .AND. IGBL(133) .LT. 3) THEN
                IF (IGBL(9) .NE. 1 .AND. IGBL(9) .NE. 25) THEN
                  CALL PLA231 (997, 0, 1.0, 1.0, ' ', ' ')
                END IF
              END IF
              PAR(165)  = PAR(168)
              IPR(408)  = 0
              IGBL(22)  = -1
              IGBL(129) = 1
              IPR(392)  = 3
              INQUIRE (FILE = NAMEFIL(1:KNMFIL)//'.ckf',
     1                 OPENED = OPEND)
              IF (.NOT. OPEND) THEN
                OPEN (UNIT = LU13, FILE = NAMEFIL(1:KNMFIL) //'.ckf',
     1                STATUS = 'UNKNOWN')
              END IF
            CASE ('AVF   ')
              IPR(393) = 1
            CASE ('VIEW  ')
              IGBL(22) = 1
            CASE ('ZONEH ')
              IPR(394) = 1
            CASE ('ZONEK ')
              IPR(394) = 2
            CASE ('ZONEL ')
              IPR(394) = 3
            CASE ('LIST  ')
              N        = N + 1
              IPR(392) = NINT(FN(N))
            CASE ('THM   ')
              N        = N + 1
              PAR(165) = FN(N)
          END SELECT
        END DO
      END IF
      IF (IPR(408) .EQ. 1) THEN
        PAR(165) = ASIN (MIN(1.0, PAR(287) * PAR(17))) * RGBL(6)
        CALL PLA287 (1, 1, 0)
        IDUM = -1
        YUNK = GEN036 (IDUM)
      ELSE
        IF (IPR(39) .EQ. 0) THEN
          CALL PLA080
          CALL PLA042 (1)
        END IF
      END IF
      CALL PLA262 (0)
      IF (IGBL(63) .GT. 0 .AND. IPR(408) .EQ. 2) THEN
        WRITE (LU7, 99978, IOSTAT = IOST)
        CALL PLA262 (2)
      END IF
      ZONE(1)  = 'H'
      ZONE(2)  = 'K'
      ZONE(3)  = 'L'
      IPR(387) = 1
      IPR(388) = 1
      IPR(406) = 1
      PAR(284) = 2.0
      LUP17    = LU17
      LUP18    = LU18
      NOUTL    = 0
      SMOBS    = 0.0
      SMCAL    = 0.0
      NSMAL    = 0
      IF (IENTRY(IGBL(54), 4) .EQ. 0) THEN
        CALL PLA258
        IF (IGBL(110) .GT. 0) CALL PLA346
      END IF
      FNLU18 = NAMEFIL(1:KNMFIL) //'.hks'
      OPEN (UNIT = LU18, FILE = FNLU18, STATUS = 'UNKNOWN')
      IF (IGBL(22) .EQ. -1) THEN
        IF (IPR(37) .NE. 0) CALL PLA287 (1, 0, 0)
        INQUIRE (FILE = FNLU16(1:KNM16), EXIST = EXST)
        IF (.NOT. EXST) THEN
          WRITE (6, 99963, IOSTAT = IOST)
     1      FNLU16(1:KNM16-3)//'hkl or fcf'
          WRITE (LU13, 99963, IOSTAT = IOST)
     1      FNLU16(1:KNM16-3)//'hkl or fcf'
          GO TO 160
        END IF
        IGBL(63) = 0
        IPR(676) = 1
        WRITE (LU13, 99971, IOSTAT = IOST)
     1    IGBL(4), MODE, JID(1:10), HTTPSERVER(1:IGBL(135)),
     2    NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT), FNLU16(1:KNM16),
     3    RDTYPE, SPGRNM(1)(1:7), PAR(17), (PAR(100 + M), M = 1, 6)
        IF (PAR(497) .GE. 0.0) THEN
          IF (IABS(IPR(632)) .EQ. 1) THEN
            WRITE (LU13, 99952, IOSTAT = IOST) PAR(497), PAR(498)
          ELSE IF (IPR(632) .EQ. 2) THEN
            WRITE (LU13, 99936, IOSTAT = IOST) PAR(497)
          ELSE IF (IABS(IPR(632)) .EQ. 3) THEN
            WRITE (LU13, 99952, IOSTAT = IOST) PAR(497), PAR(498)
          ENDIF
        ENDIF
        IF (PAR(229) .GT. -999999.0)
     1    WRITE (LU13, 99951, IOSTAT = IOST) PAR(229)
      END IF
      IF (PAR(101) .LT. 1.001) THEN
        IF (IGBL(22) .EQ. -1) THEN
          WRITE (LU13, 99954, IOSTAT = IOST)
        ELSE
          WRITE (6, 99954, IOSTAT = IOST)
        END IF
        GO TO 160
      END IF
      IF (IGBL(22) .NE. 0) THEN
        LUP17 = 0
        LUP18 = 0
      END IF
   10 NLEV = -2
      NID  = 0
      GO TO 50
   20 CALL PLA013 (0, 1)
      SELECT CASE (LRET)
        CASE (2)
          GO TO 160
        CASE (3)
          GO TO 10
        CASE (4)
          IF (NLEV .EQ. -2) GO TO 50
      END SELECT
   30 IF (IPR(392) .NE. 3) GO TO 160
      NLEV = MAX (0, NLEV + IPR(389))
      IF (NLEV .GT. -1) THEN
        NHEAD = 0
   40   CALL PLA147 (NLEV, NHEAD)
        IF (IGBL(22) .LT. 0) THEN
          IF (IKS(IND3) .GT. NLEV) THEN
            GO TO 120
          ELSE
            NLEV = NLEV + 1
            GO TO 40
          END IF
        ELSE
          GO TO 20
        END IF
      END IF
   50 IND3 = IPR(394)
      IF (IPR(394) .EQ. 2) THEN
        IND1 = 1
        IND2 = 3
      ELSE IF (IPR(394) .EQ. 1) THEN
        IND1 = 2
        IND2 = 3
      ELSE
        IND1 = 1
        IND2 = 2
      END IF
      IPR(362) = 0
      CALL GEN097 (IHM, 1, 6, 0)
      CALL GEN097 (IPR, 370, 386, 0)
      CALL GEN097 (ICNT, 1, 40, 0)
      CALL GEN097 (IT, 1, 200, 0)
      THM   = PAR(165)
      STHKM = (SIN(THM / RGBL(6)) / PAR(17))**2
      ITEL   = 0
      NLEV   = -1
      IHT    = 0
      IKT    = 0
      ILT    = 0
      XINTM  = 0.0
      XSIGM  = 0.0
      ATHM   = 0.0
      ATHMN  = 999.0
      DOSAV  = 0.0
      DOSAW  = 0.0
      CALIM  = 0.0
      SMEXT  = 0.0
      SMEXB  = 0.0
      NSYMH  = IPR(255)
      ICNTR  = IPR(257)
      IBVT   = IPR(241)
      IMAX   = NSYMH * 6 + 3
      FACTOR = 10.0 / (0.65**3 + 0.0001)
      IF (IPR(408) .EQ. 1) THEN
        PSCFA = 100.0
        PSCFB =  10.0
      ELSE
        PSCFA = 1.0
        PSCFB = 1.0
      END IF
      CALL GEN108 (LU8, 0)
      NFUL1 = 0
      DO I = 1, 20
        DO J = 1, 12
          STAT(I, J) = 0.0
        END DO
      END DO
      IPR(637) = 0
      IPR(638) = 0
      KIAR     = 0
      CALL PLA169 (0, 0.0, 0.0, 0.0, 0)
      IEND = -1
   60 DO WHILE (IEND .NE. 1)
        CALL PLA136 (IH, IK, IL, XI, SIGI, SIGIW, CALI, UCINT,
     1               ACALS, BCALS, ACOR, IEND)
        IF (IEND .NE. 1 .AND.
     1      (IH .NE. 0 .OR. IK .NE. 0 .OR. IL .NE. 0)) THEN
          IF (GEN050 (TRMX, IH, IK, IL, IHT, IKT, ILT) .LT. 0.0)
     1      THEN
            IPR(371) = IPR(371) + 1
            IF (XI .GT. 5.0 * SIGI) THEN
              ITEL = ITEL + 1
              IF (IGBL(22) .NE. -1) THEN
                IF (ITEL .EQ. 1) WRITE (LU7, 99992, IOSTAT = IOST)
                WRITE (LU7, 99991, IOSTAT = IOST) IH, IK, IL, XI, SIGI
              END IF
            END IF
            GO TO 60
          END IF
          IF (IBVT .GT. 1) THEN
            IF (GEN049 (LAT(IBVT), IHT, IKT, ILT) .LT. 0) THEN
              IF (IPR(408) .LE. 0) THEN
                IPR(370) = IPR(370) + 1
                IF (XI .GT. 5.0 * SIGI) THEN
                  ITEL = ITEL + 1
                  IF (IGBL(22) .NE. -1) THEN
                    IF (ITEL .EQ. 1) WRITE (LU7, 99992, IOSTAT = IOST)
                    WRITE (LU7, 99994, IOSTAT = IOST)
     1                IHT, IKT, ILT, XI, SIGI
                  END IF
                END IF
              END IF
              GO TO 60
            END IF
          END IF
          STHK = GEN095 (PAR(191), IHT, IKT, ILT)
          CALL PLA169 (1, XI * 100.0,
     1                 SIGI * 100.0, SQRT(STHK), 0)
          IF (STHK .GT. STHKM) THEN
            IF (IPR(408) .LE. 0) IPR(372) = IPR(372) + 1
            IF (IPR(408) .EQ. 2 .OR. IGBL(129) .LE. 0) GO TO 60
            IPR(379) = IPR(379) + 1
          END IF
          TH = ASIN (SQRT (STHK) * PAR(17)) * RGBL(6)
          IF (STHK .LT. ATHMN) THEN
            ATHMN = STHK
            PAR(445) = ASIN(MIN(1.0, SQRT(ATHMN) * PAR(17))) * RGBL(6)
          END IF
          IF (STHK .GT. ATHM) THEN
            ATHM = STHK
          END IF
          IF (MODE .GT. 1) THEN
            IF (XI .LT. 0.0) THEN
              IPR(627) = IPR(627) + 1
              IF (XI .LT. - 2.0 * SIGI) IPR(628) = IPR(628) + 1
            END IF
            IF (IGBL(9) .NE. 21 .AND. IGBL(9) .NE. 23) THEN
              IF (SIGI .EQ. 0.0) THEN
                IPR(631) = IPR(631) + 1
              END IF
            END IF
          END IF
          IPR(373) = IPR(373) + 1
          IF (IGBL(22) .LT. 0) THEN
            CALIM = MAX (CALIM, CALI)
            SIGS  = SIGI**2
            SIGK  = SIGIW**2
            IF (CALI .GT. 0 .AND. XI .GT. 0) THEN
              IF (SIGI .GT. 0.0) THEN
                WEIGHT = 1.0
                SMEXT = SMEXT + WEIGHT * (LOG (XI / CALI)) * CALI
                SMEXB = SMEXB + WEIGHT * CALI**2
              END IF
            END IF
            IF (CALI .GT. 0.0) THEN
              IF (CALI .LT. 2 * SIGI) THEN
                SMOBS = SMOBS + XI
                SMCAL = SMCAL + CALI
                NSMAL = NSMAL + 1
              END IF
              IF (SIGI .GT. 0.0) THEN
                DOS = (XI - CALI) / SIGI
                IF (DOS .LT. -100.0) THEN
                  QMRK = '?'
                  IPR(641) = IPR(641) + 1
                ELSE
                  QMRK = ' '
                END IF
                IF (IPR(632) .NE. 0) THEN
                  DOSW = (XI - CALI) / SIGIW
                  IF (DOSW .LT. -10.0) THEN
                    IF (TH .LT. 3.0) THEN
                      TH = - TH
                      IPR(588) = IPR(588) + 1
                    END IF
                  END IF
                  CRIT  = 3.0
                  CRITO = 10.0
                  IF (ABS(DOSW) .GT. CRIT .OR. QMRK .EQ. '?') THEN
                    IF (ABS(DOSW) .GT. CRITO) IPR(642) = IPR(642) + 1
                    NOUTL = NOUTL + 1
                    DOSAW = DOSAW + DOSW
                    DOSAV = DOSAV + DOS
                    IF (NOUTL .EQ. 1) WRITE (LU13, 99967, IOSTAT = IOST)
     1                'SigW(I)', CRIT, 'SigW(I) RatioW'
                    WRITE (LU13, 99966, IOSTAT = IOST)
     1                NOUTL, IH, IK, IL, TH, XI, CALI, SIGI,
     2                MAX (-9999.99, DOS), QMRK, MIN (99999.99, SIGIW),
     3                DOSW
                  END IF
                ELSE
                  IF (DOS .LT. -10.0 .AND. TH .LT. 3.0) THEN
                    TH = - TH
                    IPR(588) = IPR(588) + 1
                  END IF
                  CRIT = 5.0
                  IF (ABS (DOS) .GT. CRIT .OR. QMRK .EQ. '?') THEN
                    NOUTL = NOUTL + 1
                    DOSAV = DOSAV + DOS
                    IF (NOUTL .EQ. 1) WRITE (LU13, 99967, IOSTAT = IOST)
     1                'Sigma(I)', CRIT, ' '
                    WRITE (LU13, 99966, IOSTAT = IOST)
     1                NOUTL, IH, IK, IL, TH, XI, CALI, SIGI,
     2                MAX (-9999.99, DOS), QMRK
                  END IF
                END IF
              END IF
            END IF
            IPR(585)   = MAX (IPR(585), IABS(IH))
            IPR(586)   = MAX (IPR(586), IABS(IK))
            IPR(587)   = MAX (IPR(587), IABS(IL))
            N          = MAX (1, MIN (20, 1 + INT(STHK ** 1.5 *
     1                   FACTOR)))
            STAT(N, 1) = STAT(N, 1) + XI
            STAT(N, 2) = STAT(N, 2) + MAX(0.0, CALI)
            STAT(N, 3) = STAT(N, 3) + SIGI
            STAT(N, 9) = STAT(N, 9) + 1.0
            IF (XI .GT. PAR(484) * SIGI) THEN
              NFUL1      = NFUL1 + 1
              STAT(N, 4) = STAT(N, 4) + SQRT(XI)
              STAT(N, 5) = STAT(N, 5) +
     1                    ABS(SQRT(XI) - SQRT(MAX(0.0, CALI)))
            END IF
            IF (SIGI. GT. 0.0) THEN
              IF (SIGK .NE. 0.0) THEN
                STAT(N, 6)  = STAT(N, 6)
     1                      + (XI - MAX(0.0, CALI)) ** 2 / SIGK
                STAT(N, 7)  = STAT(N, 7)  + XI ** 2 / SIGK
                STAT(N, 11)  = STAT(N, 11)
     1                      + (XI - MAX(0.0, CALI)) ** 2 / SIGS
                STAT(N, 12)  = STAT(N, 12) + XI ** 2 / SIGS
              END IF
              STAT(N, 8)  = STAT(N, 8)  + XI / SIGIW
              STAT(N, 10) = STAT(N, 10) + SIGIW
            END IF
          END IF
          IF (IPR(408) .EQ. 1) THEN
            ACAL   = 0
            BCAL   = 0
            ACALA  = 0.0
            BCALA  = 0.0
            ACALAF = 0.0
            BCALAF = 0.0
            CALL PLA135 (IHT, IKT, ILT, ACAL, BCAL, ACALA, BCALA,
     1        ACALAF, BCALAF, SNTHA)
            ACAL = ACAL + ACALA
            BCAL = BCAL + BCALA
            XI   = (ACAL ** 2 + BCAL ** 2)
            SIGI = SQRT (XI) + 0.02 * XI
            IF (IPR(647) .EQ. 1) THEN
              XI = XI + (2.0 * GEN036 (IDUM) - 1.0) * SIGI
            END IF
          ELSE IF (IPR(408) .EQ. 2) THEN
            XI   = 100000.0
            SIGI = 1.0
          ELSE
            IF (IPR(373) .EQ. 1) THEN
              IF (FLOAT(NINT(SIGI)) .NE. SIGI) THEN
                  PSCFA = 100.0
                IF (IPR(408) .EQ. 1) THEN
                  PSCFB = 10.0
                ELSE
                  PSCFB = 100.0
                END IF
              END IF
            END IF
          END IF
          XX(1) = IHT
          XX(2) = IKT
          XX(3) = ILT
          XX(4) = 0.0
          IF (KIAR + IMAX .GT. NPY) THEN
            WRITE (LU6, 99990, IOSTAT = IOST)
C * ALERT _810
            CALL PLA231 (810, 0, -999.0, 1.0, ' ', ' ')
            GO TO 160
          END IF
          DO J = 1, NSYMH
            CALL SGSM (ICRD, J, XX, LU7, 5, IERR)
            DO I = 1, 3
              L             = NINT(XX(I + 6))
              IAR(KIAR + I) = L
              IHM(I)        = MAX (IHM(I), IABS(L))
            END DO
            IAR(KIAR + 4) = NINT(XX(10))
            KIAR = KIAR + 6
          END DO
          XIII = XI * PSCFA
          IF (XIII .GT. 1.0E+7) THEN
            XIII  = XIII / 100.0
            IXIII = NINT(XIII) * 100
          ELSE
            IXIII = NINT(XIII)
          END IF
          IAR(KIAR + 1) = IXIII
          IAR(KIAR + 2) = NINT(SIGI * PSCFB)
          IAR(KIAR + 3) = 10000
          KIAR          = KIAR + 3
        END IF
      END DO
      IDR = 0
      IF (MODE .GT. 1) THEN
        IF (NOUTL .GT. 0) THEN
          IF (PAR(497) .GE. 0.0) THEN
            WRITE (LU13, 99949, IOSTAT = IOST)
     1        DOSAV / NOUTL, DOSAW / NOUTL
          ELSE
            WRITE (LU13, 99962, IOSTAT = IOST) DOSAV / NOUTL
          END IF
        END IF
        IF (IPR(632) .NE. 0) THEN
          WRITE (LU13, 99931, IOSTAT = IOST)
        END IF
        IF (NSMAL .GT. 0) THEN
          WRITE (LU13, 99960, IOSTAT = IOST)
     1      SMOBS / NSMAL, SMCAL / NSMAL
        END IF
        IF (IPR(588) .GT. 0) WRITE (LU13, 99935, IOSTAT = IOST)
        IF (MODE .GT. 1 .AND. IPR(373) .GT. 0) THEN
C * ALERT _935
        END IF
      ENDIF
      IF (IPR(392) .GT. 1) THEN
        IF (IHM(IND1) .GT. IHM(IND2)) THEN
          CALL GEN014 (IND1, IND2)
        END IF
        IPR(394) = IND3
      END IF
      IHM(4)   =  2 * IHM(IND1) + 1
      IHM(5)   = (2 * IHM(IND2) + 1) * IHM(4)
      IHM(6)   = IHM(IND3) * IHM(5) + IHM(IND2) * IHM(4) + IHM(IND1)
      NPZ      = IHM(6) + 1
      MPH      = IHM(4)
      MHK      = IHM(5)
      IPR(305) = IHM(1)
      IPR(306) = IHM(2)
      IPR(307) = IHM(3)
      IF (IGBL(22) .NE. -1) THEN
        WRITE (LU6, 99996, IOSTAT = IOST)
     1    (IHM(MM), MM = 1, 3), ZONE(IND1), ZONE(IND2), ZONE(IND3)
        IF (IGBL(63) .GT. 0) WRITE (LU7, 99996, IOSTAT = IOST)
     1    (IHM(MM), MM = 1, 3), ZONE(IND1), ZONE(IND2), ZONE(IND3)
      END IF
      IF (IPR(373) .EQ. 0) THEN
        IF (IGBL(22) .NE. -1) THEN
          WRITE (LU6, 99995, IOSTAT = IOST) JID(1:10)
          WRITE (LU7, 99995, IOSTAT = IOST) JID(1:10)
        END IF
        IF (IGBL(22) .NE. 0)
     1    WRITE (LU13, 99995, IOSTAT = IOST) JID(1:10)
C * ALERT _902
        IF (IPR(659) .EQ. 0 .AND. IPR(674) .EQ. 0) THEN
          IPR(676) = 0
          CALL PLA231 (902, 0, 1.0, 1.0, ' ', ' ')
        END IF
        GO TO 160
      ELSE IF (IPR(373) .LT. IPR(266)) THEN
        IF (IGBL(22) .NE. -1) THEN
          WRITE (LU6, 99956, IOSTAT = IOST) JID(1:10)
          WRITE (LU7, 99956, IOSTAT = IOST) JID(1:10)
        END IF
        WRITE (LU13, 99956, IOSTAT = IOST) JID(1:10)
C * ALERT _904
        CALL PLA231 (904, 0, FLOAT(IPR(373)), FLOAT(IPR(373)),
     1               ' ', ' ')
        GO TO 160
      END IF
      I0 = - IMAX
      DO N = 1, IPR(373)
        NORI = 0
        I0 = I0 + IMAX
        M  = I0
        K  = I0 - 6
        DO 70 J = 1, NSYMH
          K          = K + 6
          IAR(K + 5) = 1
          IAR(K + 6) = IHM(5) * IAR(K + IND3)
     1               + IHM(4) * IAR(K + IND2) + IAR(K + IND1)
          IF (IABS(IAR(K + 6)) .GE. NPZ) THEN
            WRITE (LU6, 99999, IOSTAT = IOST)
     1        N, IAR(K + IND1), IAR(K + IND2),
     2        IAR(K + IND3), IAR(K + 6), IHM(4), IHM(5), IHM(6), NPZ
            GO TO 160
          END IF
          JUNK = IABS(IAR(K + 6)) - IABS(IAR(M + 6))
          IF (JUNK .GE. 0) THEN
            IF (JUNK .EQ. 0) THEN
              IF (IAR(K + 6) .LE. 0) GO TO 70
            END IF
            M = K
          END IF
   70   CONTINUE
        IOB4 = IAR(I0 + 6)
        DO J = 1, 6
          CALL GEN014 (IAR(I0 + J), IAR(J + M))
        END DO
        L0 = IAR(I0 + 4)
        K  = I0 - 6
        DO J = 1, NSYMH
          K = K + 6
          IAR(K + 4) = MOD(IAR(K + 4) - IAR(K + 5) * L0, 360)
          IF (IAR(K + 4) .LT. 0) IAR(K + 4) = 360 + IAR(K + 4)
        END DO
        J = 1
        K = I0
   80   J = J + 1
        IF (J .LE. NSYMH) THEN
          K   = K + 6
          IT1 = IAR(K + 6)
          IT2 = IAR(I0 + 6)
          IF (IPR(275) .EQ. 2) THEN
            IT1 = IABS(IT1)
            IT2 = IABS(IT2)
          END IF
          IF (IT1 .NE. IT2) GO TO 80
          IF (IAR(K + 4) .EQ. IAR(I0 + 4)) GO TO 80
          NORI = 1
        END IF
        IF (IAR(I0 + 6) .NE. 0) THEN
          DO 90 II = 1, NSYMH
            IOB1 = IAR(I0 + IND3 + II * 6 - 6)
            IOB2 = IAR(I0 + II * 6)
            IOB3 = 0
            IF (II .EQ. 1) IOB3 = IOB4
            IF (NORI .NE. 0) THEN
              IF (IOB3 .EQ. 0) GO TO 90
              IPR(381) = IPR(381) + 1
              IOBUF1   = -1
            ELSE
              IOBUF1   = IABS(IOB1)
            END IF
            IA    = IAR(I0 + IMAX - 2)
            IASIG = IAR(I0 + IMAX - 1)
            XINTM = MAX (XINTM, FLOAT(IA))
            XSIGM = MAX (XSIGM, FLOAT(IASIG))
            NID         = NID + 1
            ID(IDR + 1) = IOBUF1
            ID(IDR + 2) = IOB2
            ID(IDR + 3) = IOB3
            ID(IDR + 4) = IA
            ID(IDR + 5) = IASIG
            ID(IDR + 6) = IAR(I0 + IMAX)
            IDR         = IDR + 6
            IF (IDR .GE. 252) THEN
              WRITE (LU8) ID
              IDR = 0
            END IF
   90     CONTINUE
        END IF
      END DO
      WRITE (LU8) ID
      CALL GEN108 (LU8, 0)
      SCFHKL   = 9999999 / XINTM
      IF (SCFHKL .GT. 1.0)    SCFHKL = 1.0
      IF (IGBL(63) .GT. 0 .AND. IPR(408) .NE. 2) THEN
        IF (IGBL(22) .NE. -1) THEN
          WRITE (LU6, 99998, IOSTAT = IOST) PSCFA, PSCFB, SCFHKL
          WRITE (LU7, 99998, IOSTAT = IOST) PSCFA, PSCFB, SCFHKL
          IF (PAR(426) .GT. 0.0) THEN
            WRITE (LU6, 99939, IOSTAT = IOST)
     1        PSCFA * SCFHKL * PAR(426)**2
            WRITE (LU7, 99939, IOSTAT = IOST)
     1        PSCFA * SCFHKL * PAR(426)**2
          END IF
          WRITE (LU7, 99993, IOSTAT = IOST) PAR(284)
        END IF
      END IF
      IF (IPR(393) .EQ. 1 .AND. IGBL(22) .NE. -1)
     1  WRITE (LU7, 99997, IOSTAT = IOST)
      PAR(446) = ASIN(MIN(1.0, SQRT(ATHM) * PAR(17))) * RGBL(6)
      WRITE (LU6, 99989) PAR(446), PAR(165)
      IF (IGBL(63) .GT. 0 .AND. IGBL(22) .NE. -1) THEN
        WRITE (LU7, 99989, IOSTAT = IOST) PAR(446), THM
        CALL SGSM (ICRD, 0, XX, LU7, 4, IERR)
      END IF
      CALL GEN108 (LU14, 0)
      IPL = 1
      CR1 = 0.0
      CR2 = 0.0
      CR3 = 0.0
      CALL GEN074 (SM, 1, 6, 0.0)
      IKS(IND3) = -1
      IF (IPR(381) .GT. 0) IKS(IND3) = - 2
  100 CALL GEN108 (LU8, 0)
      IKS(IND3) = IKS(IND3) + 1
      IF (IKS(IND3) .LE. IHM(IND3)) THEN
        N   = 0
        KKK = 0
        IDR = 252
        DO I = 1, NID
          IDR = IDR + 6
          IF (IDR .GE. 252) THEN
            IDR = 0
            READ (LU8) ID
          END IF
          IF (ID(IDR + 1) .EQ. IKS(IND3)) THEN
            IKK = NPY - KKK * 6
            IF (ID(IDR + 3) .EQ. 0) THEN
              IOB2 = 0
            ELSE
              KKK  = KKK  + 1
              IOB2 = KKK
              IKK          = NPY - KKK * 6
              IAR(IKK + 1) = ID(IDR + 2)
              IAR(IKK + 2) = MAX (0, ID(IDR + 4))
              IAR(IKK + 3) = ID(IDR + 6)
              IAR(IKK + 4) = ID(IDR + 3)
              IAR(IKK + 5) = ID(IDR + 5)
              IAR(IKK + 6) = I
            END IF
            N2 = N + N
            IF (N2 + 2 .GT. IKK) THEN
              WRITE (LU7, 99979, IOSTAT = IOST)
              GO TO 160
            END IF
            IAR(N2 + 1) = IABS(ID(IDR + 2))
            IAR(N2 + 2) = IOB2
            N = N + 1
          END IF
        END DO
        IF (N .GT. 0 .OR. IGBL(22) .NE. 0) THEN
          IF (N .GT. 1) THEN
            N2 = N * 2
            CALL GEN124 (IAR, 1, N2)
            NB = 2
            CALL GEN014 (IAR(1), IAR(2))
            DO I = 4, N2, 2
              CALL GEN014 (IAR(I - 1), IAR(I))
              IF (IAR(I) .NE. IAR(NB)) THEN
                CALL GEN124 (IAR, NB - 1, I - 2)
                NB = I
              END IF
            END DO
            CALL GEN124 (IAR, NB - 1, N2)
            N01 = IAR(2)
            N02 = IAR(1)
            J   = 0
            DO I = 2, N
              N11 = IAR((I - 1) * 2 + 2)
              N12 = IAR((I - 1) * 2 + 1)
              IF (N11 .NE. N01 .OR. N12 .NE. N02) THEN
                IF (N11 .EQ. N01 .AND. N02 .EQ. 0) THEN
                  N02 = N12
                ELSE
                  IAR(J * 2 + 1) = N01
                  IAR(J * 2 + 2) = N02
                  J              = J + 1
                  N01            = N11
                  N02            = N12
                END IF
              END IF
            END DO
            IAR(J * 2 + 1) = N01
            IAR(J * 2 + 2) = N02
            N              = J + 1
          END IF
          IKS(IND2) = - IHM(IND2)
          CALL PLA148
          IJKM = IHM(IND1) + 1
          DO IJK = 1, IJKM
            IUU      = CHAR(ICHAR('0') + MOD(IJK - 1, 10))
            I        = 2 * (IHM(IND1) + IJK)
            IF (I .LE. NP44) CID(I:I) = IUU
            J        = 2 * (IHM(IND1) - IJK + 2)
            IF (J .LE. NP44) CID(J:J) = IUU
          END DO
          IF (IPR(392) .GT. 1 .AND. IKS(IND3) .NE. -1) THEN
           WRITE (LU14, 99977, IOSTAT = IOST)
     1       ZONE(IND3), IKS(IND3), ZONE(IND1), CID(1:150), ZONE(IND2)
          END IF
          CALL PLA148
          IF (IABS(IPR(392) - 2) .EQ. 1 .OR. IKS(IND3) .EQ. -1) THEN
            IF (IPL .GT. 98) THEN
              IF (IPL .LE. 102) THEN
                DO I = IPL, 102
                  CALL GEN038 (AR(I), 1, 60)
                END DO
              END IF
              IPL   = 1
              IF (IGBL(22) .NE. -1) THEN
                CALL PLA262 (0)
                WRITE (LU7, 99973, IOSTAT = IOST)
                DO I = 1, 51
                  WRITE (LU7, 99972, IOSTAT = IOST) AR(I), AR(I + 51)
                END DO
              END IF
            END IF
            DO I = 1, 3
              CALL GEN038 (AR(IPL + I - 1), 1, 60)
            END DO
            IF (IPR(408) .NE. 2) THEN
              IF (IKS(IND3) .EQ. -1) THEN
                WRITE (XAR, 99975, IOSTAT = IOST)
              ELSE
                WRITE (XAR, 99976, IOSTAT = IOST) ZONE(IND3), IKS(IND3)
              END IF
            END IF
            AR(IPL + 1) = XAR
            IPL         = IPL + 3
          END IF
          JP             = 0
          JM             = 0
          IHKA           = - NPZ
          IAR(N * 2 + 1) = 2100000000
          IAR(N * 2 + 2) = 0
          NN             = N + 1
          DO III = 1, NN
            IHKB = IAR((III - 1) * 2 + 1)
            I    = IAR((III - 1) * 2 + 2)
            I6   = NPY - I * 6
            IF (I .GT. 0) IHKB = IAR(I6 + 1)
            IF (IABS(IHKB) .NE. IABS(IHKA)) THEN
              IF (IHKA  .GT. - NPZ) THEN
                IHK = IABS(IHKA)
                IND        = IHK + IHM(6)
                IL         = IND / IHM(5)
                IS         = IND - IHM(5) * IL
                IK         = IS  / IHM(4)
                IH         = IS  - IHM(4) * IK - IHM(IND1)
                IK         = IK  - IHM(IND2)
                IL         = IL  - IHM(IND3)
                IHKL(IND1) = IH
                IHKL(IND2) = IK
                IHKL(IND3) = IL
                DO MM = 1, 3
                  IHKLE(MM) = IHKL(MM)
                END DO
                IF (IKS(IND3) .NE. -1) THEN
                  IF (IPR(392) .GT. 1) THEN
                    DO WHILE (IHKL(IND2) .GT. IKS(IND2))
                      WRITE (LU14, 99974, IOSTAT = IOST) IKS(IND2),
     1                  CID(1:(4 * IHM(IND1) + 2))
                      IKS(IND2) = IKS(IND2) + 1
                      CALL PLA148
                    END DO
                  END IF
                END IF
                CALL PLA146 (JP, 1, LUP17, IRM1)
                IF (IPR(275) .NE. 2 .AND. IPR(393) .NE. 1) THEN
                  IF (IPR(408) .NE. 2) IGBL(18) = 1
                  CALL PLA146 (JM, 2, LUP18, IRM2)
                  IF ( JP .NE. 0 .AND. JM .NE. 0) THEN
                    SM(1, 3) = ABS(IRM1 - IRM2) + SM(1, 3)
                    SM(2, 3) = SM(2, 3) + IRM1 + IRM2
                    IF (IKS(IND3) .NE. -1) IPR(380) = IPR(380) + 1
                  END IF
                END IF
                JP  = 0
                JM  = 0
                IF (IPR(275) .EQ. 2) THEN
                  IHKA = IABS(IHKB)
                ELSE
                  IHKA = IHKB
                END IF
              ELSE
                IF (IPR(275) .EQ. 2) IHKB = IABS(IHKB)
                IHKA = IHKB
              END IF
            END IF
            IF (I .GT. 0 .AND. I .LT. NN) THEN
              REFA   = IAR(I6 + 2) * SCFHKL
              REFB   = IAR(I6 + 5) * SCFHKL
              IF (REFB .LE. 0) REFB = 0.001
              IVGNR  = IAR(I6 + 6)
              IHKL2  = IAR(I6 + 4)
              IF (IPR(275) .NE. 2 .AND. IPR(393) .NE. 1 .AND.
     1           IHKB .LT. 0) THEN
                IF (JM .LT. 49) JM = JM + 1
                RA(JM,  2) = REFA
                RB(JM,  2) = REFB
                IRC(JM, 2) = IVGNR
                IRD(JM, 2) = IHKL2
              ELSE
                IF (JP .LT. 49) JP = JP + 1
                RA(JP,  1) = REFA
                RB(JP,  1) = REFB
                IRC(JP, 1) = IVGNR
                IRD(JP, 1) = IHKL2
              END IF
            END IF
          END DO
          IF (IPR(392) .GT. 1 .AND. IKS(IND3) .GT. -1) THEN
            DO WHILE (IKS(IND2) .LE. IHM(IND2))
              WRITE (LU14, 99974, IOSTAT = IOST)
     1          IKS(IND2), CID(1:(4 * IHM(IND1) + 2))
            IKS(IND2) = IKS(IND2) + 1
            CALL PLA148
            END DO
          END IF
        END IF
        GO TO 100
      END IF
      IF (IPL .GT. 1 .AND. IPR(408) .NE. 2) THEN
        IF (IPL .LE. 102) THEN
          DO I = IPL, 102
            CALL GEN038 (AR(I), 1, 60)
          END DO
        END IF
        IPL   = 1
        IF (IGBL(22) .NE. -1) THEN
          CALL PLA262 (0)
          WRITE (LU7, 99973, IOSTAT = IOST)
          DO I = 1, 51
            WRITE (LU7, 99972, IOSTAT = IOST) AR(I), AR(I + 51)
          END DO
        END IF
      END IF
      IF (IPR(392) .GT. 1 .AND. IGBL(22) .NE. -1) THEN
        CALL GEN108 (LU14, 0)
        DO WHILE (.TRUE.)
          READ (LU14, 99959, IOSTAT = IOST) PRBUF
          IF (IOST .NE. 0) EXIT
          IF (PRBUF(8:8) .EQ. ZONE(IND3)) THEN
            CALL PLA262 (0)
          END IF
          WRITE (LU7, 99959, IOSTAT = IOST) PRBUF
        END DO
      END IF
      IF (IGBL(22) .NE. -1) THEN
        IF (IPR(408) .NE. 2) THEN
          CALL PLA262 (0)
        ELSE
          CALL PLA262 (2)
        END IF
        IF (IPR(408) .LE. 0) THEN
          WRITE (LU6, 99982, IOSTAT = IOST)
     1      IPR(372), IPR(371), IPR(370)
          WRITE (LU7, 99982, IOSTAT = IOST)
     1      IPR(372), IPR(371), IPR(370)
        END IF
        IF (IPR(408) .LT. 2) THEN
          WRITE (LU6, 99984, IOSTAT = IOST) IPR(373), IPR(375)
          WRITE (LU7, 99984, IOSTAT = IOST) IPR(373), IPR(375)
          IF (IPR(376) .GT. 0 .AND. IPR(408) .LT. 1) THEN
            WRITE (LU6, 99983, IOSTAT = IOST) IPR(376)
            WRITE (LU7, 99983, IOSTAT = IOST) IPR(376)
          END IF
        END IF
      END IF
      IF ((IPR(408) .EQ. 0 .AND. IGBL(22) .EQ. 0) .OR.
     1    (IPR(408) .EQ. 1 .AND. IPR(393) .EQ. 0)) THEN
        IF (IPR(378) .GT. 0) THEN
          CALL GEN108 (LUP18 , 1)
          DO I = 1, IPR(378)
            READ  (LUP18, 99959) AA
            WRITE (LUP17, 99959, IOSTAT = IOST) AA
          END DO
        END IF
        IF (IPR(408) .EQ. 1) THEN
          WRITE (LUP17, 99930) 0, 0, 0, 0, 0, IPR(377)
        ELSE
          WRITE (LUP17, 99958, IOSTAT = IOST)
        END IF
      END IF
      IF (IGBL(22) .NE. -1) THEN
        WRITE (LU6, 99988, IOSTAT = IOST) IPR(377)
        IF (IGBL(63) .GT. 0) WRITE (LU7, 99988, IOSTAT = IOST) IPR(377)
        IF (IPR(378) .GT. 0 .AND. IPR(408) .NE. 1) THEN
          WRITE (LU6, 99987, IOSTAT = IOST) IPR(378)
          IF (IGBL(63) .GT. 0) THEN
            WRITE (LU7, 99987, IOSTAT = IOST) IPR(378)
          END IF
        END IF
        IF (IPR(380) .GT. 0) THEN
          IF (IPR(408) .LT. 1) THEN
            WRITE (LU6, 99985, IOSTAT = IOST) IPR(380)
            IF (IGBL(63) .GT. 0)
     1        WRITE (LU7, 99985, IOSTAT = IOST) IPR(380)
          END IF
        END IF
      END IF
      IF (SM(2, 1) .GT. 0.0) THEN
        CR1 = SQRT(ABS(SM(1, 1) / SM(2, 1))) * 100.0
      END IF
      IF (SM(2, 2) .GT. 0.0) THEN
        CR2 = SQRT(ABS(SM(1, 2) / SM(2, 2))) * 100.0
        IF (IPR(380) .GT. 0) CR3 = 200.0 * SM(1, 3) / SM(2, 3)
      END IF
      IF (IPR(408) .LT. 1) THEN
        IF (IGBL(22) .NE. -1) THEN
          WRITE (LU6, 99981, IOSTAT = IOST) CR1
          WRITE (LU7, 99981, IOSTAT = IOST) CR1
          IF (IPR(378) .GT. 0) THEN
            WRITE (LU6, 99980, IOSTAT = IOST) CR2, CR3
            WRITE (LU7, 99980, IOSTAT = IOST) CR2, CR3
          END IF
        END IF
      END IF
      IF (IGBL(22) .NE. 0) GO TO 30
  120 IF (IGBL(22) .LT. 0) THEN
        WRITE (LU13, 99970, IOSTAT = IOST)
        STLMX = SIN(PAR(446) / RGBL(6)) / PAR(17)
        JMAX  = MIN (29, INT(STLMX / 0.05) + 1)
        STL   = 0.45
        DO I = 10, JMAX
          STL = STL + 0.05
          STH = MIN (1.0, STL * PAR(17), STLMX * PAR(17))
          IF (STH .LE. 1.0) THEN
            TH  = ASIN (STH) * RGBL(6)
            IF (ICNT(I - 9, 1) .NE. 0) THEN
              YDUM = FLOAT(ICNT(I - 9, 2)) / ICNT(I - 9, 1)
            ELSE
              YDUM = 0.0
            END IF
            WRITE (LU13, 99969, IOSTAT = IOST)
     1        TH, STH / PAR(17), YDUM, (ICNT(I - 9, J), J = 1, 2),
     2        ICNT(I - 9, 1) - ICNT(I - 9, 2)
            IF (I .EQ. 12) WRITE (LU13, 99957, IOSTAT = IOST)
          END IF
        END DO
        WRITE (LU13, 99938, IOSTAT = IOST)
        IF (PAR(497) .GE. 0.0) THEN
          WRITE (LU13, 99948, IOSTAT = IOST)
        ELSE
          WRITE (LU13, 99965, IOSTAT = IOST)
        END IF
        CALL GEN074 (FULL, 1, 12, 0.0)
        NFULL  = 0
        DO I = 1, 20
          DO J = 1, 12
            FULL(J) = FULL(J)  + STAT(I, J)
          END DO
          N     = NINT(STAT(I, 9))
          IF (N .GT. 0) THEN
            NFULL = NFULL + N
            R1    = 0.0
            R2    = 0.0
            IF (NINT(STAT(I, 4)) .NE. 0) R1 = STAT(I, 5) / STAT(I, 4)
            IF (STAT(I, 7) .GT. 0.0) R2 = SQRT(STAT(I, 6) / STAT(I, 7))
            S   = SQRT(STAT(I, 6) / N)
            R   = STAT(I, 8)  / N
            AI  = STAT(I, 1)  / N
            SA  = STAT(I, 10) / N
            IF (STAT(I, 1) .NE. 0.0) THEN
              RS = STAT(I, 3)  / STAT(I, 1)
            ELSE
              RS = 0.0
            ENDIF
            SINTHL = (I / FACTOR) ** 0.333333
            IF (I .LT. 20) THEN
              STH = MIN (1.0, SINTHL * PAR(17), STLMX * PAR(17))
            ELSE
              STH = MIN (1.0, STLMX * PAR(17))
            END IF
            TH  = ASIN(STH) * RGBL(6)
            WRITE (LU13, 99964, IOSTAT = IOST)
     1        TH, STH / PAR(17), N, R1, R2, S, RS, R, AI, SA
          END IF
        END DO
        PAR(477) = FULL(5) / FULL(4)
        PAR(478) = SQRT (FULL(6) / FULL(7))
        PAR(479) = SQRT (FULL(6) / (NFULL - MAX (0, IPR(266))))
        WR2      = SQRT (FULL(11) / FULL(12))
        GOF      = SQRT (FULL(11) / (NFULL - MAX (0, IPR(266))))
        RSIG     = FULL(3) / FULL(1)
        IPR(623) = NFUL1
        IPR(624) = NFULL
        WRITE (LU13, 99932, IOSTAT = IOST) RSIG
        WRITE (LU13, 99942, IOSTAT = IOST)
     1    PAR(477), NFUL1, PAR(478), NFULL, PAR(479)
        IF (PAR(173) .GT. 0.0 .AND. PAR(174) .GT. 0.0) THEN
          WRITE (LU13, 99941, IOSTAT = IOST)
     1      PAR(173), IPR(264), PAR(174), IPR(265), PAR(299),
     2      MAX (0, IPR(266))
          IF (PAR(497) .GE. 0.0) THEN
            IF (IPR(651) .EQ. 0) THEN
              IF (ABS(PAR(478)) .LT. 0.001) THEN
C * ALERT _903 - Fobs = Fcalc in FCF
                CALL PLA231 (903, 0, 1.0, 1.0, ' ', ' ')
              ELSE
                YUNK = PAR(173) - PAR(477)
C * ALERT _921 - COMPARE REPORTED AND CALCULATED R-VALUE DIFFERENCE
                IF (ABS(YUNK) .GT. 0.001)
     1             CALL PLA231 (921, 4, ABS(YUNK), YUNK, ' ', ' ')
                  YUNK = PAR(174) - PAR(478)
C * ALERT _922 - COMPARE REPORTED AND CALCULATED wR2-VALUE DIFFERENCE
                IF (ABS(YUNK) .GT. 0.001)
     1            CALL PLA231 (922, 4, ABS(YUNK), YUNK, ' ', ' ')
                YUNK = PAR(299) - PAR(479)
C * ALERT _923 - COMPARE REPORTED AND CALCULATED S-VALUE DIFFERENCE
                IF (ABS(YUNK) .GT. 0.005)
     1            CALL PLA231 (923, 3, ABS(YUNK), YUNK, ' ', ' ')
              END IF
            END IF
C * ALERT _929 - TEST FOR NO WEIGHT PARAMETERS
          ELSE
            CALL PLA231 (929, 0, -999.0, 0.0, ' ', ' ')
          END IF
        END IF
        WRITE (LU13, 99934, IOSTAT = IOST) WR2, GOF
C * ALERT _939 - High GOF
        IF (GOF .GT. 5.0 .AND. IPR(651) .EQ. 0)
     1    CALL PLA231 (939, 2, GOF, GOF, ' ', ' ')
C * CHECK FOR HKL-RANGE REPORTED IN THE CIF WITH THAT FOUND IN THE FCF
        IF (IPR(672) .EQ. 6) THEN
          IF (IPR(258) .LT. 4) THEN
C * ALERT _953
            DIFH = ABS(IPR(585) - MAX (0, -IPR(267), IPR(268)))
            IF (DIFH .NE. 0.0)
     1        CALL PLA231 (953, 0, -999.0, DIFH, ' ', ' ')
C * ALERT _954
            DIFK = ABS(IPR(586) - MAX (0, -IPR(269), IPR(270)))
            IF (DIFK .NE. 0.0)
     1        CALL PLA231 (954, 0, -999.0, DIFK, ' ', ' ')
          END IF
C * ALERT _955
          DIFL = ABS(IPR(587) - MAX (0, -IPR(271), IPR(272)))
          IF (DIFL .NE. 0.0)
     1      CALL PLA231 (955, 0, -999.0, DIFL, ' ', ' ')
        END IF
C * CHECK CALCULATED H,K,L RANGE VERSUS H,K,L RANGE IN FCF
        IF (IPR(258) .LT. 4) THEN
C * ALERT _956
          DIFH = ABS(IPR(585) - IPR(561))
          IF (DIFH .GT. 1.0)
     1      CALL PLA231 (956, 0, -999.0, DIFH, ' ', ' ')
C * ALERT _957
          DIFK = ABS(IPR(586) - IPR(562))
          IF (DIFK .GT. 1.0)
     1      CALL PLA231 (957, 0, -999.0, DIFK, ' ', ' ')
        END IF
C * ALERT _958
        DIFL = ABS(IPR(587) - IPR(563))
        IF (DIFL .GT. 1.0)
     1    CALL PLA231 (958, 0, -999.0, DIFL, ' ', ' ')
        YUNK = MIN (STLMX, 0.6)
        IF (IPR(393) .EQ. 1 .OR. IPR(275) .EQ. 2) THEN
          WRITE (LU13, 99947, IOSTAT = IOST)
        ELSE
          WRITE (LU13, 99946, IOSTAT = IOST)
        END IF
        MH = MAX (0, -IPR(267), IPR(268))
        MK = MAX (0, -IPR(269), IPR(270))
        ML = MAX (0, -IPR(271), IPR(272))
        WRITE (LU13, 99968, IOSTAT = IOST)
     1    IPR(373), (MIN(999, IPR(M)), M = 585, 587), IPR(379),
     2    PAR(446), (MIN(999, IHM(M)), M = 1, 3), MAX(0.0, PAR(168)),
     3    MH, MK, ML, PAR(445), MAX(0.0, PAR(167))
        IF (IPR(393) .EQ. 1 .OR. IPR(275) .EQ. 2) THEN
          WRITE (LU13, 99944, IOSTAT = IOST)
     1      IPR(559), IPR(377), IPR(383), IPR(375), IPR(627), IPR(628)
C * ALERT _960
          IF (IPR(628) .GT. 0) THEN
            CALL PLA231 (960, 0, -999.0, FLOAT(IPR(628)), ' ', ' ')
          END IF
C * ALERT _961 - REPORT NO NEGATIVE INTENSITIES
          IF (IPR(627) .EQ. 0) THEN
            CALL PLA231 (961, 0, -999.0, 0.0, ' ', ' ')
          END IF
C * ALERT _962 - REPORT # OF REFLECTIONS WITH SIGMA = 0.0
            CALL PLA231 (962, 0, FLOAT(IPR(631)), FLOAT(IPR(631)),
     1                   ' ', ' ')
        ELSE
          WRITE (LU13, 99945, IOSTAT = IOST)
     1      IPR(559) + IPR(560), IPR(559), IPR(560),
     2      IPR(377) + IPR(378), IPR(377), IPR(378),
     3      IPR(383) + IPR(362), IPR(383), IPR(362),
     4      IPR(375) + IPR(376), IPR(375), IPR(376),
     5      IPR(559) - IPR(377) + IPR(560) - IPR(378),
     6      IPR(559) - IPR(377) , IPR(560) - IPR(378)
        END IF
        WRITE (LU13, 99943, IOSTAT = IOST)
     1    IPR(386), IPR(553), YUNK, IPR(555), YUNK,
     2    IPR(557), IPR(584), IPR(588), IPR(385)
        CALL PLA169 (-1, 0.0, 0.0, 0.0, 0)
        CALL PLA169 (-3, 0.0, 0.0, 0.0, LU13)
C * ALERT _910
        IF (IPR(553) .LT. 5) THEN
          YUNK = -999.0
        ELSE
          YUNK = FLOAT(IPR(553))
        END IF
        IF (IPR(553) .GT. 0) CALL PLA231 (910, 0, YUNK,
     1    FLOAT(IPR(553)), ' ', ' ')
        YUNK = MIN(SIN(PAR(446) / RGBL(6)) / PAR(17), 0.6)
        WRITE (LIJN(1:7), 99953, IOSTAT = IOST) YUNK
        IF (IPR(559) .GT. 0) THEN
C * ALERT _911 - TEST for missing refl between th-min and sth/l=0.6
          IF (IPR(555) .GT. 1) CALL PLA231 (911, 0,
     1      (FLOAT(IPR(555)) * 100.0) / IPR(559), FLOAT(IPR(555)),
     2      LIJN(1:7), ' ')
C * ALERT _912
          IF (IPR(557) .GT. 1 .AND. STLMX .GT. 0.6) CALL PLA231
     1      (912, 0, -999.0, FLOAT(IPR(557)), ' ', ' ')
        END IF
C * ALERT _913
        IF (IPR(584) .GT. 0) CALL PLA231 (913, 0, FLOAT(IPR(584)),
     1    FLOAT(IPR(584)), ' ', ' ')
C * ALERT _919
        IF (IPR(588) .GT. 0) CALL PLA231 (919, 0, FLOAT(IPR(588)),
     1    FLOAT(IPR(588)), ' ', ' ')
C * ALERT _918 - REPORT ON # I(obs) << I(calc)
        IF (IPR(641) .GT. 0) CALL PLA231 (918, 0, FLOAT(IPR(641)),
     1    FLOAT(IPR(641)), ' ', ' ')
C * ALERT _934 - REPORT ON # OF OUTLIERS > 10 (SKIPPED FOR HKLF 5)
        IF (IPR(619) .EQ. 0) THEN
          IF (IPR(642) .GT. 0) CALL PLA231 (934, 0, FLOAT(IPR(642)),
     1      FLOAT(IPR(642)), ' ', ' ')
        END IF
        IF (IPR(380) .GT. 0) WRITE (LU13, 99961, IOSTAT = IOST) IPR(380)
        DIFF = ABS(PAR(446) - PAR(168))
C * ALERT _920
        IF (ABS(DIFF) .GT. 0.01)
     1    CALL PLA231 (920, 2, ABS(DIFF), DIFF, ' ', ' ')
        CALL PLA111 (2)
        IF (IPR(123) .EQ. 0 .AND. IGBL(3) .NE. 1 .AND. IGBL(3) .NE. 33
     1      .AND. IGBL(3) .NE. 34) THEN
          CALL GEN108 (LU13, 1)
          N   = 0
          IGBL6SAVE = IGBL(6)
          IGBL(6)   = 0
  130     VRT       = 19.4
          BCD       = 'FCF-VALIDATION'//CHAR(0)
          CALL GGIP (HORS, VERT, 0.0, 1)
          N   = N + 1
          IF (N .EQ. 1) THEN
            LIJN = 'VALIDATION REPORT FOR CURRENT FCF'
            CALL GGIP09 (0.0, LIJN, 33, 0.375, 5 + IGBL(68), 2, 7.0,
     1                   VRT - 0.6)
            VRT = VRT - 1.1
          END IF
          DO WHILE (VRT .GT. 0.6)
            READ (LU13, 99959, END = 150) LIJN
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, LIJN, 80, 0.35, 1, 2, 1.0, VRT)
          END DO
  140     CALL PLA013 (1, 1)
          IF (IGGT(1:4) .EQ. 'PLOT') GO TO 140
          IF (IGGT(1:4) .EQ. 'CALC' .OR. IGGT(1:1) .EQ. 'Y') GO TO 130
          IF (IGGT(1:4) .EQ. 'EXIT') GO TO 160
          IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
            IF (IGGT(1:1) .EQ. 'N') GO TO 160
            IF (LRET .EQ. 2) THEN
              CALL GEN108 (LU13, 0)
              GO TO 130
            END IF
            LINE = IGGT
            CALL GEN038 (IGGT, 1, 80)
          END IF
          GO TO 130
  150     CALL PLA297 (0)
        END IF
      END IF
  160 IGBL(6) = IGBL6SAVE
      IF (IPR(408) .EQ. 2) THEN
        IPR(559) = IPR(377)
        IPR(560) = IPR(378)
        IPR(561) = IPR(305)
        IPR(562) = IPR(306)
        IPR(563) = IPR(307)
C * REPORT DIFFERENCES BETWEEN CALCULATED AND REPORTED INDEX MAXIMA
        DIFH     = IPR(561) - MAX (0, -IPR(267), IPR(268))
        IF (IPR(105) .EQ. 0 .AND. IPR(672) .EQ. 6) THEN
C * ALERT _950 - DIFF (HMAX-CALC & HMAX-REPORTED)
          IF (ABS(DIFH) .GT. 1.0)
     1      CALL PLA231 (950, 0, -999.0, DIFH, ' ', ' ')
          DIFK = IPR(562) - MAX (0, -IPR(269), IPR(270))
C * ALERT _951 - DIFF (KMAX-CALC & HMAX-REPORTED)
          IF (ABS(DIFK) .GT. 1.0)
     1      CALL PLA231 (951, 0, -999.0, DIFK, ' ', ' ')
          DIFL = IPR(563) - MAX (0, -IPR(271), IPR(272))
C * ALERT _952 - DIFF (LMAX-CALC & LMAX-REPORTED)
          IF (ABS(DIFL) .GT. 1.0)
     1      CALL PLA231 (952, 0, -999.0, DIFL, ' ', ' ')
        END IF
      END IF
      IF (IGBL(18) .EQ. 0 .OR.  IGBL(22) .EQ. -1 .OR.
     1   (IGBL(18) .EQ. 1 .AND. IPR(408) .GT. 0) .OR.
     2   (IGBL(22) .EQ. 0 .AND. IPR(408) .LT. 1)) THEN
        CLOSE (UNIT = LU18, STATUS = 'DELETE', ERR = 170)
        IGBL(18) = 0
      ELSE
        CLOSE (UNIT = LU18, ERR = 170)
      END IF
  170 RETURN
99999 FORMAT (/, ':: Packing Problem (NPZ)', 9I10)
99998 FORMAT (/, ':: Pre-Scale Factors Applied to I and Sig(I):', 2F10.1
     1      , /, ':: Post-Scale Factor Applied to I and Sig(I):', F10.5)
99997 FORMAT (/, ':: Friedel Related Reflections are Averaged')
99996 FORMAT (/, ':: Hmax =', I3, ' Kmax =', I3, ' Lmax=', I3,
     1 ' ,  Sorting Order : Fast ', A, ',  Medium ', A, ', Slow ', A)
99995 FORMAT (/, ':: No Recognizable Reflections Encountered for ', A,
     1 /)
99994 FORMAT (':: Deleted (Bravais) : ', 3I5, 2F10.0)
99993 FORMAT (/, ':: ILT Criterium', 10X, ': I < ', F5.1, ' SIG(I)')
99992 FORMAT ('Deleted Reflections (Bravais or Non-Int. I > 5 sig(I))'
     1         , /, 1X, 80('='), /)
99991 FORMAT (':: Deleted : IHO =', I5, ', IKO =', I5, ', ILO =',
     1 I5, '  I = ', F10.2, 2X, 'SIGI =', F10.2)
99990 FORMAT (/, ':: Data Set TOO Large (Raise NVD of array VOID)', /)
99989 FORMAT (/, ':: Actual Theta-Max:', F7.3, ' Deg.',
     1        ' ( Applied Theta Limit:', F7.3, ' Deg.)', /)
99988 FORMAT (/,
     1 ':: Number of Independent   Type  H, K, L Reflections =', I7)
99987 FORMAT (
     1 ':: Number of Independent   Type -H,-K,-L Reflections =', I7)
99985 FORMAT (':: Number of Bijvoet Pairs', 27X, '=', I7)
99984 FORMAT (/,':: Total Number of Reflections Encountered on INPUT',
     1 2X, '=', I7, //, ':: Number of Less-Thans of Type  H, K, L', 13X,
     2 '=', I7)
99983 FORMAT (':: Number of Less-Thans of Type -H,-K,-L', 13X, '=', I7)
99982 FORMAT (':: Number of Deleted > TH(Max) Reflections =', I7, /,
     1        ':: Number of Deleted Non-Int.  Reflections =', I7, /,
     2        ':: Number of Deleted Bravais   Reflections =', I7, /)
99981 FORMAT (//, ':: Consistency +HKL:', F11.2, ' PERCENT')
99980 FORMAT (':: Consistency -HKL:', F11.2,
     1     /, ':: Friedel Consist.:', F11.2)
99979 FORMAT (':: Too Many Reflections in this Zone', /,
     1 'Try Again with Zones Perp to the Longest Axis', //)
99978 FORMAT (/, 'Report Expected Number of Independent Reflections',
     1        ' for given Symmetry and Resolution.')
99977 FORMAT ('ZONE - ', A, ' =', I5, 63X,
     1 ': + = +HKL, - = -HKL, L = ILT = 2, N = I/SIG(I)+.5  ',
     2 /, 131('-'), /, 4X, A, '--->', A, /, 3X, A, /)
99976 FORMAT (20('*'), ' ZONE  ', A, ' = ', I4, 1X, 24('*'))
99975 FORMAT (20('*'), ' Spacegroup Extinctions ', 16('*'))
99974 FORMAT (I4, 5X, A)
99973 FORMAT (
     12('   H  K  L     <I>   <SIG> ILT     I  &  SIG       I  &  SIG',
     2 10X), /, 130('-'))
99972 FORMAT (A, 10X, A)
99971 FORMAT (79('='), /, 'PLATON-(Version', I8, ')-Mode=', I1,
     1 ' FCF-File Validation for:', A, /, 79('='), /,
     2 'For Documentation: http://', A, 'FCF-VALIDATION.pdf', //,
     3 'Section 1', /, 79('='), /, 'General Data', /, 79('='), /,
     4 'Crystal Data From: ', A, /,
     5 'Fo/Fc   Data From: ', A, 1X, 'FCF-TYPE=', A, /,
     6 'Space Group      : ', A, /,
     7 'Wavelength (Ang) : ', F9.5, /,
     8 'Unit Cell (CIF)  : ', 3F9.4, 3F9.3)
99970 FORMAT (/, 'Section 4:', /, 79('='), /,
     1 'Resolution & Completeness Statistics',
     2 ' (Cumulative and Friedel Pairs Averaged)', /, 79('='),
     3 /, 'Theta sin(th)/Lambda Complete  Expected Measured  Missing',
     4 /, 79('-'))
99969 FORMAT (F6.2, 2F10.3, 4X, 3I9)
99968 FORMAT (79('='), /, 'Total # of Reflections in FCF.', I7, 2X,
     1 '(Hmax =', I3, ', Kmax =', I3, ', Lmax =', I3, ') Obs', /,
     2                    'Number above Rep. Theta(Max) .', I7, /,
     3 'Actual   Theta(Max) (Deg.) ...', F7.3, 2X,
     4 '(Hmax =', I3, ', Kmax =', I3, ', Lmax =', I3, ') Exp', /,
     5 'Reported Theta(Max) (Deg.) ...', F7.3, 2X,
     6 '(Hmax =', I3, ', Kmax =', I3, ', Lmax =', I3, ') Rep', /,
     7 'Actual   Theta(Min) (Deg.) ...', F7.3, /,
     8 'Reported Theta(Min) (Deg.) ...', F7.3, /)
99967 FORMAT (/, 'Section 2', /, 79('='), /, 'Reflections with',
     1 ' abs((I(obs) - I(calc)) / ', A, ' .GT.', F5.1, /, 79('='),
     2 /, '   Nr   H   K   L  Theta', 5X,
     3 'I(obs)', 4X, 'I(calc) Sigma(I)   Ratio', 2X, A, /, 79('-'))
99966 FORMAT (I5, 3I4, F7.2, 2F11.2, F9.2, F8.2, A, F8.2, F7.2)
99965 FORMAT (/, 79('='), /,
     1 'R-Value Statistics as a Function of Resolution',
     2 ' (in Resolution Shell)', /, 79('='), /,
     3 'Theta sin(Th)/L    #     R1    wR2      S  Rsig av(I/Sigma)',
     4 3X, 'av(I)', 3X, 'av(Sigma)', /, 79('-'))
99964 FORMAT (F6.2, F7.3, I7, 4F7.3, F7.2, 2F12.2)
99963 FORMAT ('Requested FCF-FILE not Found:', A)
99962 FORMAT (55X, 8('-'), /, 45X, 'Average =', F9.2)
99961 FORMAT ('Number of Bijvoet Pairs ......', I7)
99960 FORMAT (/, 'For I(calc) < 2 Sigma(I): <I(obs)> = ', F10.2,
     1        ' and <I(calc)> = ', F10.2)
99959 FORMAT (A)
99958 FORMAT (1X)
99957 FORMAT (60('-'), ' ACTA Min. Res. ---')
99956 FORMAT (/, ':: # of Refls in fcf less than # of Parameters for ',
     1        A, /)
99954 FORMAT (/, '>> No CELL DATA Found !! - Abort')
99953 FORMAT (F7.3)
99952 FORMAT ('SHELX WGHT Pars. : ', 2F9.4)
99951 FORMAT ('Extinction Par.  : ',  F9.4)
99949 FORMAT (55X, 8('-'), 8X, 8('-'),/, 45X,
     1        'Average =', F9.2, 8X, F8.2)
99948 FORMAT (/, 'Section 5', /, 79('='), /,
     1 'R-Value Statistics as a Function of Resolution',
     2 ' (in Resolution Shell)', /, 79('='), /,
     3 'Theta sin(Th)/L    #     R1    wR2      S     Rs av(I/SigW)',
     4 3X, 'av(I)    av(SigW)', /, 79('-'))
99947 FORMAT (/, 'Section 6', /, 79('='), /,
     1 'Summary of Reflection Data in FCF',
     2 ' - Note: Friedel Pairs Averaged')
99946 FORMAT (/, 79('='), /,
     1 'Section 6: Summary of Reflection Data in FCF',
     2 ' - Note: Friedel Pairs NOT Averaged')
99945 FORMAT (
     1 'Unique (Expected) ............', I7, 2X,
     2 '(HKL', I6, ', -H-K-L', I6, ')', /,
     3 'Unique (in FCF) ..............', I7, 2X,
     4 '(HKL', I6, ', -H-K-L', I6, ')', /,
     5 'Observed [I .gt. 2 Sig(I)] ...', I7, 2X,
     6 '(HKL', I6, ', -H-K-L', I6, ')', /,
     7 'Less-Thans ...................', I7, 2X,
     8 '(HKL', I6, ', -H-K-L', I6, ')', /,
     9 'Missing (Total) ..............', I7, 2X,
     * '(HKL', I6, ', -H-K-L', I6, ')', /)
99944 FORMAT (
     1 'Unique (Expected) ............', I7, /,
     2 'Unique (in FCF) ..............', I7, /,
     3 'Observed [I .gt. 2 Sig(I)] ...', I7, /,
     4 'Less-Thans ...................', I7, /,
     5 'Negative Intensities .........', I7, /,
     6 'Negative Intensities < - 2 SIG', I7, /)
99943 FORMAT (
     1 'Missing (Total) ..............', I7, /,
     2 'Missing Below Th(Min) ........', I7, /,
     3 'Missing Th(Min) to STh/L=', F5.3, I7, /,
     4 'Missing STh/L=', F5.3, ' to Th(Max)', I7, /,
     5 'Missing Very Strong Refl. ....', I7, /,
     6 'Beamstop Effected Reflections ', I7, //,
     7 'Space Group Extinctions ......', I7)
99942 FORMAT (/, 79('-'), /,
     1        'From FCF: R1 =', F7.4, '(', I7, '), wR2 =', F7.4,
     2        '(', I7, '), S =', F8.3)
99941 FORMAT ('From CIF: R1 =', F7.4, '(', I7, '), wR2 =', F7.4,
     2        '(', I7, '), S =', F8.3, ', Npar =', I5)
99940 FORMAT (/, ':: ASYM - EXPECT GENERATE MODE')
99939 FORMAT (':: Scaled F(000)**2 =', 19X, F15.1, /)
99938 FORMAT (/, 'Note: The Reported Completeness refers to the Actual',
     1 ' H,K,L Index Range', /)
99936 FORMAT ('JANA  WGHT Par.  : ', F9.4)
99935 FORMAT (/, 'Note: Negative Theta Values Mark Likely Beamstop ',
     1           'Effected Reflections')
99934 FORMAT (/, 'No (SHELXL) Optimized Weights:  ',
     1        'wR2 =', F7.4, 9X, ', S =', F8.3)
99932 FORMAT (/, 'R(sig) = sum(sig(I)) / sum(I) =', F8.4)
99931 FORMAT (/, 'Note: SigW(I) is the SHELXL optimized weight')
99930 FORMAT (3I4, 2I8, /,
     1       '_platon_generate_hkl', I10)
      END SUBROUTINE PLA145
      SUBROUTINE PLA146 (JP, IND, LPUN, IRM)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,NP44=512,NP60=100,NPY = NVD + 2 * NP23 - 1185)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      CHARACTER AR(104)*60, CID*(NP44), ZONE(3)*1
      COMMON /CHAR0/ AR, CID, ZONE
      CHARACTER XAR*60, ICRD*80
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1 ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON // IHM(6), IPL, ATHM, ATHMN, CALIM, ICNT(20, 2),
     1 XX(12), SM(2, 3), RA(50, 2), RB(50, 2), IRC(50, 2), IRD(50, 2),
     2 IT(200), IRAB(2, 2), IKS(3), IHKL(3), IHKLE(3), ID(252),
     3 STAT(20, 12), FULL(12), IAR(NPY)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER IDSM*1
      NSYMH = IPR(255)
      IHU  = 2 * (IHKL(IND1) + IHM(IND1) + 1) + 1 - IND
      IF (IND .EQ. 1) THEN
        IDSM = '+'
      ELSE
        IDSM = '-'
      END IF
      IF (JP .EQ. 1) THEN
        IPR(637) = IPR(637) + 1
      ELSE IF (JP .GT. 1) THEN
        IPR(638) = IPR(638) + 1
      ENDIF
      IF (JP .GT. 0) THEN
        SA = 0.0
        SB = 0.0
        DO K = 1, JP
          SY = RB(K, IND)
          SZ = 1.0 / (SY**2)
          SA = SA + RA(K, IND) * SZ
          SB = SB + SZ
        END DO
        RM  = SA  / SB
        IRM = NINT(RM)
        IF (IPR(408) .NE. 1) THEN
          SM0 = 1.0 / SQRT(SB)
        ELSE
          SM0 = SQRT (RM)
        END IF
        ISM = NINT(SM0)
        SMA = 0.0
        SMB = 0.0
        DO K = 1, JP
          DEL = ABS(RA(K, IND)) - ABS(RM)
          IF (JP .NE. 1 .AND. DEL .LE. 0.0) DEL = ABS(DEL)
          SMA = SMA + (DEL        / RB(K, IND))**2
          SMB = SMB + (RA(K, IND) / RB(K, IND))**2
        END DO
        SM(1, IND) = SM(1, IND) + SMA * JP
        SM(2, IND) = SM(2, IND) + SMB * (JP - 1)
        IF (IND .NE. 1) THEN
          DO MM = 1, 3
            IHKLE(MM) = - IHKL(MM)
          END DO
        END IF
        ILT = 1
        IF (RM .LT. PAR(284) * SM0) ILT = 2
        IF (IKS(IND3) .NE. -1) THEN
          IDSM = '*'
          IF (IPR(468) .EQ. 0) THEN
            IF (SM0 .NE. 0.0) THEN
              NDC = NINT(RM / SM0)
            ELSE
              NDC = 10
            END IF
          ELSE
            NDC = JP
          END IF
          IF (NDC .LT. 10) IDSM = CHAR(ICHAR('0') + NDC)
          IF (ILT .EQ. 2) THEN
            IF (IPR(468) .EQ. 0) IDSM = 'L'
            IPR(374 + IND) = IPR(374 + IND) + 1
          END IF
        END IF
        JPA = - 1
        IF (IABS(IPR(392) - 2) .EQ. 1 .OR. IKS(IND3) .EQ. -1) THEN
   10     JPA = JPA + 2
          IF (JPA .LE. JP) THEN
            JPB = JPA + 1
            IF (JPB .GT. JP) JPB = JP
            LPAB = 0
            DO K = JPA, JPB
              LPAB = LPAB + 1
              IRAB(LPAB, 1) = NINT(RA(K, IND))
              IRAB(LPAB, 2) = NINT(RB(K, IND))
            END DO
            IF (IPR(408) .NE. 2) THEN
              WRITE (XAR, 99999, IOSTAT = IOST)
     1          (IRAB(K, 1), IRAB(K, 2), K = 1, LPAB)
              AR(IPL) = XAR
              IF (JPA .EQ. 1) WRITE (XAR, 99997, IOSTAT = IOST)
     1          (IHKLE(MM), MM = 1, 3), IRM, ISM, ILT
              AR(IPL)(1:30) = XAR(1:30)
              IPL = IPL + 1
              IF (IPL .GT. 102) THEN
                IPL   = 1
                IF (IGBL(22) .NE. -1) THEN
                  CALL PLA262 (0)
                  WRITE (LU7, 99998, IOSTAT = IOST)
                  DO I = 1, 51
                    WRITE (LU7, 99995, IOSTAT = IOST) AR(I), AR(I + 51)
                  END DO
                END IF
              END IF
            END IF
            GO TO 10
          END IF
        END IF
        IF (IKS(IND3) .NE. -1) THEN
          IPR(376 + IND) = IPR(376 + IND) + 1
          IF (ILT .EQ. 1) THEN
            IF (IND .EQ. 1) THEN
              IPR(383) = IPR(383) + 1
            ELSE
              IPR(362) = IPR(362) + 1
            END IF
          END IF
          IF (IPR(408) .LT. 2) THEN
            IF (IPR(408) .EQ. 1 .AND. IRM .EQ. 0) ISM = 1
            IF (LPUN .GT. 0) THEN
              IH = IHKLE(1)
              IK = IHKLE(2)
              IL = IHKLE(3)
              IF (IPR(700) .EQ. 0) THEN
                WRITE (LPUN, 99996, IOSTAT = IOST) IH, IK, IL, IRM, ISM
              ELSE
                ACAL   = 0
                BCAL   = 0
                ACALA  = 0.0
                BCALA  = 0.0
                ACALAF = 0.0
                BCALAF = 0.0
                CALL PLA135 (IH, IK, IL, ACAL, BCAL, ACALA,
     1            BCALA, ACALAF, BCALAF, SNTHA)
                WRITE (LPUN, 99994, IOSTAT = IOST)
     1                  IH, IK, IL, ACAL, BCAL
              END IF
            END IF
            IF (IPR(408) .LT. 0) THEN
              IF (NSYMH .GT. 1) THEN
                DO I = 1, 3
                  XX(I)       = IHKLE(I)
                  IHKLS(I, 1) = IHKLE(I)
                END DO
                XX(4) = 0.0
                N     = 1
                DO 20 I = 2, NSYMH
                  CALL SGSM (ICRD, I, XX, LU7, 5, IERR)
                  DO J = 1, 3
                    IHKLS(J, N + 1) = NINT(XX(J + 6))
                  END DO
                  DO K = 1, N
                    IF (IHKLS(1, K) .EQ. IHKLS(1, N + 1)) THEN
                      IF (IHKLS(2, K) .EQ. IHKLS(2, N + 1)) THEN
                        IF (IHKLS(3, K) .EQ. IHKLS(3, N + 1)) GO TO 20
                      END IF
                    END IF
                    IF (IHKLS(1, K) .EQ. - IHKLS(1, N + 1)) THEN
                      IF (IHKLS(2, K) .EQ. - IHKLS(2, N + 1)) THEN
                        IF (IHKLS(3, K) .EQ. - IHKLS(3, N + 1))
     1                    GO TO 20
                      END IF
                    END IF
                  END DO
                  N = N + 1
                  IF (LPUN .GT. 0) THEN
                    IH = IHKLS(1, N)
                    IK = IHKLS(2, N)
                    IL = IHKLS(3, N)
                    WRITE (LPUN, 99996, IOSTAT = IOST)
     1                IH, IK, IL, IRM, ISM
                  END IF
   20           CONTINUE
              END IF
            END IF
          END IF
        END IF
      END IF
      IF (IHU .GT. 0 .AND. IHU .LE. NP44) THEN
        CID(IHU:IHU) = IDSM
        IF (IDSM .NE. '+' .AND. IDSM .NE. '-') THEN
          STHK = GEN095 (PAR(191), IHKLE(1), IHKLE(2), IHKLE(3))
          IF (STHK .LT. 0.09) IPR(512) = IPR(512) - 1
        END IF
      END IF
      RETURN
99999 FORMAT (28X, 2(I10, I6))
99998 FORMAT (
     12('   H  K  L     <I>   <SIG> ILT     I  &  SIG       I  &  SIG',
     2 10X), /, 130('-'))
99997 FORMAT (1X, 3I3, 1X, I9, I6, I2)
99996 FORMAT (3I4, 2I8)
99995 FORMAT (A, 10X, A)
99994 FORMAT (3I4, 2F10.2)
      END SUBROUTINE PLA146
      SUBROUTINE PLA147 (LEV, NHEAD)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP44=512,
     2 NP52=200,NP56=30,NP57=35,NP60=100,NPY=NVD+2*NP23-1185)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // IHM(6), IPL, ATHM, ATHMN, CALIM, ICNT(20, 2),
     1 XX(12), SM(2, 3), RA(50, 2), RB(50, 2), IRC(50, 2), IRD(50, 2),
     2 IT(200), IRAB(2, 2), IKS(3), IHKL(3), IHKLE(3), ID(252),
     3 STAT(20, 12), FULL(12), IAR(NPY)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1 ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER AR(104)*60, CID*(NP44), ZONE(3)*1
      COMMON /CHAR0/ AR, CID, ZONE
      CHARACTER THFL*1
      SHOR = 0.0
      STEP = 0.0
      STPA = 0.0
      STPB = 0.0
      SVER = 0.0
      CHOR = 0.0
      SCAL = 0.0
      JMAX = 0
      IF (IGBL(22) .GT. 0) THEN
        IGBL(6) = 14
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL GGIP (0.0, 1.0, 0.0, 0)
        CALL PLA110 (HORS, VERT, -1)
        IF (IPR(406) .EQ. 1) THEN
          KNMXT = KNMFIL + KXT + 1
          WRITE (PRBUF, 99989, IOSTAT = IOST)
     1      FNLU1(1:KNMXT), DTYPE(IABS(IGBL(8)))
          CALL GGIP09 (0.0,  PRBUF, KNMXT + 8, 0.3, -1, 2, 17.0, 1.0)
          IF (IPR(408) .LE. 0) THEN
            WRITE (PRBUF, 99989, IOSTAT = IOST) FNLU16(1:KNM16), RDTYPE
            CALL GGIP09 (0.0,  PRBUF, KNM16 + 8, 0.3, -1, 2, 17.0, 0.2)
          ELSE
            WRITE (PRBUF, 99988, IOSTAT = IOST)
            CALL GGIP09 (0.0, PRBUF, 14, 0.3, -1, 2, 17.0, 0.2)
          END IF
          THOR = VERT + 2.5
          IF (IPR(275) .EQ. 1) THEN
            IF (IPR(393) .EQ. 1) THEN
              WRITE (PRBUF, 99991, IOSTAT = IOST)
            ELSE
              WRITE (PRBUF, 99990, IOSTAT = IOST)
            END IF
            CALL GGIP09 (0.0, PRBUF, 18, 0.3, 2, 2, VERT + 1.9,
     1                   VERT - 0.8)
          END IF
          WRITE (PRBUF, 99987, IOSTAT = IOST) 'SpaceGr ', SPGRNM(1)(1:7)
          CALL GGIP09 (0.0, PRBUF, 15, 0.3, 1, 2, THOR, VERT - 1.5)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'a      ', PAR(101)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 2.1)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'b      ', PAR(102)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 2.7)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'c      ', PAR(103)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 3.3)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'alpha  ', PAR(104)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 3.9)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'beta   ', PAR(105)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 4.5)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'gamma  ', PAR(106)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 5.1)
          WRITE (PRBUF, 99984, IOSTAT = IOST) 'lambda ', PAR(17)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 5.7)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'Th(max)', PAR(446)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 6.3)
          WRITE (PRBUF, 99996, IOSTAT = IOST) 'SigOmit', PAR(284)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 6.9)
          WRITE (PRBUF, 99995, IOSTAT = IOST)   'Total  ', IPR(373)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 7.5)
          WRITE (PRBUF, 99995, IOSTAT = IOST)   'Unique ', IPR(377)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 8.1)
          WRITE (PRBUF, 99995, IOSTAT = IOST)   'Obsd   ', IPR(383)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, VERT - 8.7)
        END IF
        ANG1 = ACOS(PAR(115 + IND1))
        ANG2 = ACOS(PAR(115 + IND2))
        ANG3 = ACOS(PAR(115 + IND3))
        SHOR = PAR(112 + IND1)
        STEP = 1.0 / PAR(100 + IND3)
        STPA = PAR(112 + IND3) * COS(ANG2)
        STPB = PAR(112 + IND3) * (COS(ANG1) - COS(ANG2) * COS(ANG3)) /
     1                            SIN(ANG3)
        SVER = PAR(112 + IND2) * SIN(ANG3)
        CHOR = PAR(112 + IND2) * COS(ANG3)
        SHFT = 0.8
        SCA1 = (VERT - 1.0) /
     1         (PAR(112 + IND2) * SIN (ANG3) * (IHM(IND2) * 2 + 4))
        SCA2 = (VERT - SHFT) /
     1         (PAR(112 + IND1) * (IHM(IND1) * 2 + 1))
        SCAL = MIN (SCA1, SCA2)
        SVER = SVER * SCAL
        SHOR = SHOR * SCAL
        CHOR = CHOR * SCAL
        STEP = STEP * SCAL
        STPA = STPA * SCAL
        STPB = STPB * SCAL
      END IF
      CALL GEN108 (LU14, 0)
   10 READ (LU14, 99997, END = 30) CID
      IF (CID(1:4) .NE. 'ZONE') GO TO 10
      READ (CID(11:15), 99994) NL
      IF (NL .NE. LEV) GO TO 10
      IKS(IND3) = NL
      IPR(382)  = MAX (IPR(382), NL)
      WRITE (CID(16:29), 99993, IOSTAT = IOST) IHM(IND3)
      IF (IGBL(22) .GE. 0) THEN
        HRT = SHFT
        VRT = VERT - 0.4
        CALL GGIP09 (0.0, CID, 29, 0.2, -1, 1, HRT, VRT)
      END IF
      READ (LU14, 99997, END = 30) CID
      NS = - IHM(IND2)
      READ (LU14, 99997, END = 30) CID
      IF (IGBL(22) .GE. 0) THEN
        VRT = VRT - SVER
        CALL GGIP09 (0.0, CID(1:5), 5, 0.2, -1, 1, HRT, VRT)
        HRT = HRT + 1.45 + SHOR + NS * CHOR
        DO I = 11, NP44, 2
          IF (HRT .GT. (SHFT + 1.0)) THEN
            CALL GGIP09 (0.0, CID(I:I), 1, 0.2, -1, 1, HRT, VRT)
          END IF
          HRT = HRT + SHOR
        END DO
      END IF
      READ (LU14, 99997, END = 30) CID
      IF (IGBL(22) .GE. 0) THEN
        VRT = VRT - SVER
        CALL GGIP09 (0.0, CID, 15, 0.2, -1, 2, SHFT, VRT)
        CX  = SHFT + 1.5 +
     1        (IHM(IND1) + 1) * SHOR + (NS + IHM(IND2) + 1) * CHOR
        CY  = VRT - (IHM(IND2) + 1) * SVER
        IF (IPR(387) .EQ. 1) THEN
          CXS = CX - LEV * STPA
          CYS = CY + LEV * STPB
          JMAX = NINT(SIN(PAR(446) / RGBL(6)) / (PAR(17) * 0.05))
          DO J = 10, JMAX
            STL = J * 0.05
            IF (J .EQ. 12) THEN
              CALL GGIP (0.0, 2.0, 0.0, 0)
            ELSE
              CALL GGIP (0.0, 1.0, 0.0, 0)
            END IF
            CR = SCAL * 2.0 * STL
            CR = SQRT (MAX(0.0, CR**2 - (NL * STEP)**2))
            CALL PLA289 (CXS, CYS, CR, 120)
          END DO
        END IF
        IF (IPR(388) .EQ. 1) THEN
          CALL GGIP (0.0, 5.0 + IGBL(68), 0.0, 0)
          CXV  = CX + IHM(IND2) * CHOR
          CYV  = CY - IHM(IND2) * SVER
          CXH  = CX + IHM(IND1) * SHOR
          CALL GGIP (CXV, CYV, 0.0, 3)
          CALL GGIP (CX,  CY,  0.0, 2)
          CALL GGIP (CXH, CY,  0.0, 2)
          CALL GGIP (CX,  CY,  0.0, 3)
          CALL GGIP (0.0, 1.0, 0.0, 0)
          CXV  = CX - IHM(IND2) * CHOR
          CYV  = CY + IHM(IND2) * SVER
          CXH  = CX - IHM(IND1) * SHOR
          CALL GGIP (CXV, CYV, 0.0, 3)
          CALL GGIP (CX,  CY,  0.0, 2)
          CALL GGIP (CXH, CY,  0.0, 2)
          CALL GGIP (CX,  CY,  0.0, 3)
        END IF
      END IF
      READ (LU14, 99997, END = 30) CID
   20 READ (LU14, 99997, END = 30) CID
      IF (CID(1:4) .NE. 'ZONE') THEN
        NS = NS + 1
        IF (IGBL(22) .GE. 0) THEN
          VRT = VRT - SVER
          CALL GGIP (0.0, 1.0, 0.0, 0)
        END IF
        READ (CID(1:4), 99992) NK
        IKS(IND2) = NK
        IF (IGBL(22) .GE. 0) THEN
          CALL GGIP09 (0.0, CID(1:5), 5 + IGBL(68), 0.2, -1, 1, SHFT,
     1                 VRT)
          HRT = SHFT + 1.5 + SHOR + NS * CHOR
        END IF
        IKS(IND1) = - IHM(IND1) - 1
        DO I = 11, NP44, 2
          IF (IT(NL + 1) .EQ. 0) THEN
            IKS(IND1) = IKS(IND1) + 1
            IF (CID(I:I) .EQ. 'E') THEN
              CID(I:I) = ' '
              IPR(385) = IPR(385) + 1
            END IF
            IF (CID(I+1:I+1) .NE. ' ' .AND. CID(I+1:I+1) .NE. '-'
     1          .AND. CID(I+1:I+1) .NE. '#') THEN
              IPR(390) = IPR(390) + 1
              IF (CID(I+1:I+1) .EQ. '?') THEN
                IPR(391) = IPR(391) + 1
              END IF
            END IF
            IF (CID(I:I) .NE. ' ' .AND. CID(I:I) .NE. '+'
     1          .AND. CID(I:I) .NE. '#') THEN
              STHK = GEN095 (PAR(191), IKS(1), IKS(2), IKS(3))
              STHL = SQRT (STHK)
              IF (CID(I:I) .EQ. '?') THEN
                IPR(386) = IPR(386) + 1
                IF (IGBL(22) .NE. -1) THEN
                  IF (IPR(386) .EQ. 1) THEN
                    CALL PLA262 (0)
                    WRITE (LU7, 99999, IOSTAT = IOST)
                    CALL PLA262 (3)
                  END IF
                  CALL PLA262 (1)
                  WRITE (LU7, 99998, IOSTAT = IOST)
     1              IPR(386), IKS(1), IKS(2), IKS(3), STHL
                END IF
                TH   = ASIN (STHL * PAR(17)) * RGBL(6)
                TH25 = MIN (ASIN  (0.6 * PAR(17)) * RGBL(6), PAR(446))
                IF (TH .LT. PAR(445)) THEN
                  IPR(553) = IPR(553) + 1
                ELSE IF (TH .GT. TH25) THEN
                  IPR(557) = IPR(557) + 1
                ELSE
                  IPR(555) = IPR(555) + 1
                END IF
                IF (STHL .LE. 0.5) THEN
                  ACAL   = 0.0
                  BCAL   = 0.0
                  ACALA  = 0.0
                  BCALA  = 0.0
                  ACALAF = 0.0
                  BCALAF = 0.0
                  CALL PLA135 (IKS(1), IKS(2), IKS(3), ACAL, BCAL,
     1              ACALA, BCALA, ACALAF, BCALAF, SNTHA)
                  CALC = (ACAL + ACALA) ** 2 + (BCAL + BCALA) ** 2
                  IF (IGBL(22) .LT. 0) THEN
                  NHEAD = NHEAD + 1
                  IF (NHEAD .EQ. 1) WRITE (LU13, 99999, IOSTAT = IOST)
                  IF (TH .LT. PAR(445)) THEN
                    THFL = '*'
                  ELSE
                    THFL = ' '
                  END IF
                  IF (CALC / CALIM .GT. 1.0) IPR(584) = IPR(584) + 1
                  WRITE (LU13, 99998, IOSTAT = IOST)
     1              NHEAD, IKS(1), IKS(2), IKS(3), STHL, TH, THFL,
     2              CALC, CALC / CALIM
                  END IF
                END IF
              END IF
              IPR(384) = IPR(384) + 1
              ISTH     = INT(STHL * 20.0) - 8
              DO J = 1, 20
                IF (ISTH .LE. J) THEN
                  ICNT(J, 1) = ICNT(J, 1) + 1
                  IF (CID(I:I) .NE. '?') ICNT(J, 2) = ICNT(J, 2) + 1
                END IF
              END DO
            END IF
          END IF
          IF (IGBL(22) .GE. 0) THEN
            IF (CID(I:I) .EQ. '*') THEN
              NCOL = 2
            ELSE IF (CID(I:I) .EQ. 'L') THEN
              NCOL = 4
            ELSE IF (CID(I:I) .EQ. 'E') THEN
              NCOL = 4
            ELSE IF (CID(I:I) .EQ. '+') THEN
              NCOL = 1
            ELSE IF (CID(I:I) .EQ. '?') THEN
              NCOL = 5 + IGBL(68)
            ELSE IF (CID(I:I) .EQ. '#') THEN
              NCOL = 5 + IGBL(68)
            ELSE
              IF (IPR(468) .EQ. 0 .OR. CID(I:I) .EQ. '1') THEN
                NCOL = 3
              ELSE
                NCOL = 2
              END IF
            END IF
            IF (IPR(369) .NE. 0) THEN
              IF (CID(I:I) .NE. '?' .AND. CID(I:I) .NE. '#'
     1            .AND. CID(I:I) .NE. ' ') THEN
                NCOL = 4
                CID(I:I) = '.'
              END IF
            END IF
            CALL GGIP09 (0.0, CID(I:I), 1, 0.2, NCOL, 1, HRT - 0.1,
     1                   VRT - 0.1)
            HRT = HRT + SHOR
          END IF
        END DO
        GO TO 20
      END IF
      GO TO 40
   30 IF (NHEAD .GT. 0) THEN
        WRITE (LU13, 99983, IOSTAT = IOST) MAX (0.0, PAR(445))
        IF (PAR(167) .GT. 0.0)
     1    WRITE (LU13, 99982, IOSTAT = IOST) PAR(167)
      END IF
      CALL GEN108 (LU14, 0)
      LEV = -1
   40 IT (NL + 1) = 1
      IF (IPR(406) .EQ. 1) THEN
        IF (IGBL(22) .GE. 0) THEN
          PRBUF = 'Resol Perc'
          CALL GGIP09 (0.0, PRBUF(1:10), 10, 0.3, 2, 2, THOR, 0.1)
        END IF
        DO I = 10, JMAX
          IF (I .LT. 20) THEN
            IF (I .EQ. 12) THEN
              NCOL = 2
            ELSE
              NCOL = 1
            END IF
            IF (ICNT(I - 9, 1) .NE. 0) THEN
              YDUM = ICNT(I - 9, 2) * 100.0 / ICNT(I - 9, 1)
            ELSE
              YDUM = 0.0
            END IF
            IF (IGBL(22) .GE. 0) THEN
              WRITE (PRBUF, 99986, IOSTAT = IOST) I * 0.05, YDUM
              CALL GGIP09 (0.0, PRBUF(1:10), 10, 0.3, NCOL, 2, THOR,
     1                    (I - 9) * 0.5)
            END IF
          END IF
        END DO
        IF (IGBL(22) .GE. 0) THEN
          JMX = MIN (JMAX, 20) + 1
          WRITE (PRBUF, 99985, IOSTAT = IOST) 'Layer 0 -', IPR(382)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 2, 2, THOR, (JMX - 3) * 0.5)
          WRITE (PRBUF, 99995, IOSTAT = IOST) 'SpGrExt', IPR(385)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 4, 2, THOR, (JMX - 4) * 0.5)
          WRITE (PRBUF, 99995, IOSTAT = IOST) 'MaxUniq', IPR(384)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, (JMX - 5) * 0.5)
          WRITE (PRBUF, 99995, IOSTAT = IOST) 'Missing', IPR(386)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 5 + IGBL(68), 2, THOR,
     1                 (JMX - 6) * 0.5)
          WRITE (PRBUF, 99995, IOSTAT = IOST) 'N eq 1 ', IPR(637)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, (JMX - 7) * 0.5)
          WRITE (PRBUF, 99995, IOSTAT = IOST) 'N gt 1 ', IPR(638)
          CALL GGIP09 (0.0, PRBUF, 13, 0.3, 1, 2, THOR, (JMX - 8) * 0.5)
          CALL GGIP (0.0, 1.0, 0.0, 0)
        END IF
      END IF
      RETURN
99999 FORMAT (/, 'Section 3', /, 79('='), /,
     1 'Missing Reflections (Asym. Refl. Unit)',
     2 ' below sin(th)/lambda = 0.5', /, 79('='), /,
     3 '   Nr       H    K    L    sin(th)/lambda', 3X,
     4 'Theta', 6X, 'I(calc)', 2X, 'I(calc)/I(max)', /, 79('-'))
99998 FORMAT (I5, 3X, 3I5, 3X, F10.3, 6X, F7.2, A, F12.2, F13.5)
99997 FORMAT (A)
99996 FORMAT (A, F6.2)
99995 FORMAT (A, I6)
99994 FORMAT (I5)
99993 FORMAT (3X, '(Max =', I4, ')')
99992 FORMAT (I4)
99991 FORMAT ('Friedels Averaged ')
99990 FORMAT ('No Friedel Average')
99989 FORMAT (A, '-', A)
99988 FORMAT ('Generated Data')
99987 FORMAT (2A)
99986 FORMAT (F4.2, F6.1)
99985 FORMAT (A, I4)
99984 FORMAT (A, F6.4)
99983 FORMAT (/, '  ** Note: I(max) is the maximum I(obs) ',
     1        'encountered in the fcf-file **', //, 6X,
     2 'Starred Reflections have a Theta below Theta(Min) =', F6.2, /)
99982 FORMAT (35X, 'From CIF: Theta(Min) =', F6.2, /)
      END SUBROUTINE PLA147
      SUBROUTINE PLA148
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,NP44=512,NP60=100,NPY = NVD + 2 * NP23 - 1185)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // IHM(6), IPL, ATHM, ATHMN, CALIM, ICNT(20, 2),
     1 XX(12), SM(2, 3), RA(50, 2), RB(50, 2), IRC(50, 2), IRD(50, 2),
     2 IT(200), IRAB(2, 2), IKS(3), IHKL(3), IHKLE(3), ID(252),
     3 STAT(20, 12), FULL(12), IAR(NPY)
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      CHARACTER AR(104)*60, CID*(NP44), ZONE(3)*1
      COMMON /CHAR0/ AR, CID, ZONE
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1 ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      CALL GEN038 (CID, 1, NP44)
      LTNR = IPR(241)
      IMX  = 2 * IHM(IND1) + 1
      J    = -1
      DO 10 I = 1, IMX
        IKS(IND1) = - IHM(IND1) - 1 + I
        J = J + 2
        IF (IKS(IND3) .EQ. 0) THEN
          IF (IKS(IND2) .LT. 0) THEN
            GO TO 10
          ELSE IF (IKS(IND2) .EQ. 0) THEN
            IF (IKS(IND1) .LE. 0) GO TO 10
          END IF
        END IF
        STHK = GEN095 (PAR(191), IKS(1), IKS(2), IKS(3))
        IF (STHK .LT. ATHM) THEN
          IF (LTNR .GT. 1) THEN
            IF (GEN049 (LAT(LTNR), IKS(1), IKS(2), IKS(3)) .LT. 0.0)
     1        GO TO 10
          END IF
          CALL PLA138 (1, IKS(1), IKS(2), IKS(3), IEXT, IASM)
          IF (J .GT. 0 .AND. J .LT. NP44) THEN
            IF (IEXT .EQ. 0) THEN
              IF (IASM .EQ. 1) THEN
                CID(J:) = ' ?'
                IF (STHK .LT. 0.09) IPR(512) = IPR(512) + 1
              ELSE
                CID(J:) = ' #'
              END IF
            ELSE
              IF (IASM .EQ. 1) THEN
                IF (IPR(275) .EQ. 2 .OR. IPR(393) .EQ. 1) THEN
                  CID(J:) = ' E'
                ELSE
                  CID(J:) = 'EE'
                END IF
              END IF
            END IF
          END IF
        END IF
   10 CONTINUE
      RETURN
      END SUBROUTINE PLA148
      SUBROUTINE PLA149
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP45=2048,
     2 NP52=200,NP56=30,NP57=35)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      INTEGER HMAX
      COMMON /TODAY/ DATIJD
      COMMON /GGT/  MEDIUM
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER DATIJD*25
      CHARACTER FNLU18*80
      CHARACTER CDUM*(NP52)
      IGBL(1)  = 2
      IGBL(6)  = 21
      IGBL(17) = 0
      IF (IGBL(25) .EQ. 0 .AND. IGBL(3) .EQ. 31) IPR(650) = 1
      IWIN = IGBL(25) * IGBL(32)
      IF (IWIN .EQ. 0) THEN
        MEDIUM      = 1
        IGGT(16:22) = 'OFF    '
        CALL GGIP (-999.0, 0.0, 0.0, 6)
      END IF
      IF (IPR(30) .EQ. 0) THEN
        IPR(500) = NINT (FN(1))
        CALL PLA293 (PAR(17))
        IF (IPR(511) .EQ. 1) THEN
          CALL PLA145 (0)
        ELSE
          IF (IPR(37) .EQ. 0) GO TO 50
          CALL PLA287 (1, 1, 0)
        END IF
        FNLU18 = NAMEFIL(1:KNMFIL)//'.cpi'
        OPEN (UNIT = LU18, FILE = FNLU18, STATUS = 'UNKNOWN')
        IGBL(18) = 2
   10   IF (IPR(500) .LE. 0 .OR. IPR(500) .GT. 6) THEN
          IF (PAR(17) .GT. 1.0) THEN
            IPR(500) = 2
            PAR(371) = 0.1
          ELSE
            IPR(500) = 1
            PAR(371) = 1
          END IF
        END IF
        STHKM = PAR(287)**2
        NREFL = 0
        AMX   = 0.0
        IF (IPR(511) .EQ. 0) THEN
C * GENERATE REFLECTIONS + SF
          HMAX = INT(2 * PAR(101) * PAR(287)) + 1
          KMAX = INT(2 * PAR(102) * PAR(287)) + 1
          LMAX = INT(2 * PAR(103) * PAR(287)) + 1
          IBVT = IPR(241)
          IL   =  - 1
          DO WHILE (IL .LT. LMAX)
            IL   = IL + 1
            IF (IL .GT. 0) THEN
              IK = - KMAX - 1
            ELSE
              IK = -1
            END IF
            DO WHILE (IK .LT. KMAX)
              IK = IK + 1
              IF (IL .EQ. 0 .AND. IK .EQ. 0) THEN
                IH = 0
              ELSE
                IH = - HMAX - 1
              END IF
              DO WHILE (IH .LT. HMAX)
                IH = IH + 1
                IF (IH .NE. 0 .OR. IK .NE. 0 .OR. IL .NE. 0) THEN
                  ISKIP = 0
                  IF (IBVT .GT. 1) THEN
                    IF (GEN049 (LAT(IBVT), IH, IK, IL) .LT. 0) ISKIP = 1
                  END IF
                  IF (ISKIP .EQ. 0) THEN
                    STHK = GEN095 (PAR(191), IH, IK, IL)
                    IF (STHK .LE. STHKM) THEN
                      ACAL   = 0.0
                      BCAL   = 0.0
                      ACALA  = 0.0
                      BCALA  = 0.0
                      ACALAF = 0.0
                      BCALAF = 0.0
                      CALL PLA135 (IH, IK, IL, ACAL, BCAL, ACALA, BCALA,
     1                  ACALAF, BCALAF, SNTHA)
                      A    = (ACAL + ACALA) ** 2 + (BCAL + BCALA) ** 2
                      IF (SNTHA .LT. 1.0) THEN
                        TH = ASIN(SNTHA)
                      A  = A * (1.0 + COS(2 * TH) ** 2) /
     1                       (SIN(TH) **2 * COS(TH))
                        NREFL = NREFL + 1
                        VOID(18000 + NREFL * 5 - 4) = IH
                        VOID(18000 + NREFL * 5 - 3) = IK
                        VOID(18000 + NREFL * 5 - 2) = IL
                        VOID(18000 + NREFL * 5 - 1) = TH
                        VOID(18000 + NREFL * 5)     = A
                        AMX                         = MAX (AMX, A)
                      END IF
                    END IF
                  END IF
                END IF
              END DO
            END DO
          END DO
        ELSE
C * READ REFLECTIONS FOR I(OBS)
          CALL GEN108 (LU17, 0)
          DO WHILE (.TRUE.)
            READ (LU17, 99993, END = 20) IH, IK, IL, A
            IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) EXIT
            STHK = GEN095 (PAR(191), IH, IK, IL)
            IF (STHK .LE. STHKM) THEN
              TH    = ASIN(SQRT(STHK) * PAR(17))
              A     = A * (1.0 + COS(2 * TH) ** 2) /
     1                (SIN(TH) **2 * COS(TH))
              NREFL = NREFL + 1
              VOID(18000 + NREFL * 5 - 4) = IH
              VOID(18000 + NREFL * 5 - 3) = IK
              VOID(18000 + NREFL * 5 - 2) = IL
              VOID(18000 + NREFL * 5 - 1) = TH
              VOID(18000 + NREFL * 5)     = A
              AMX                         = MAX (AMX, A)
            END IF
          END DO
        END IF
   20   CALL GEN074 (VOID, 1, 18000, 0.0)
        AMN = AMX / 2500.0
        IF (RGBL(23) .EQ. 0.0) THEN
          IF (IPR(500) .EQ. 6) THEN
            FIN = 180.0
          ELSE
            FIN = 20.0 * IPR(500)
          END IF
        ELSE
          FIN      = RGBL(23)
          IPR(500) = 6
        END IF
        IFN = NINT (FIN / PAR(411))
        SRT = PAR(411)
        AL  = PAR(371)
        SCL = PAR(372)
        N   = 0
        NP  = 0
        DO WHILE (N .LT. NREFL)
          N  = N + 1
          TH = VOID(18000 + N * 5 - 1)
          A  = VOID(18000 + N * 5)
          IP = NINT (2.0 * TH * RGBL(6) / PAR(411))
          IF (IP .LE. IFN) THEN
            VOID(IP) = VOID(IP) + A
            NP       = NP + 1
            I        = 0
            FACT     = A
            DO WHILE (FACT .GT. AMN)
              I  = I + 1
              FACT = A / (1 + AL * I * I)
              IF (IP + I .LE. IFN) VOID(IP + I) = VOID(IP + I) + FACT
              IF ((IP - I) .GT. 0) VOID(IP - I) = VOID(IP - I) + FACT
            END DO
          END IF
        END DO
        VM = 0.0
        DO I = 1, IFN
          VM = MAX (VOID(I), VM)
        END DO
        VM = VM / (VERT - 4.0)
   30   BCD(1:25) = 'Simulated Powder Pattern'//CHAR(0)
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL GGIP09 (0.0,  BCD, 25, 1.2, 4, 8, 0.6, VERT - 1.8)
        CALL GGIP09 (0.0,  BCD, 25, 1.2, 2, 8, 0.5, VERT - 1.9)
        VRT = VERT - 3.0
        CALL PLA283 (2, IPR(260), N, CDUM)
        JUNK = NP52 - N + 1
        CALL GGIP09 (0.0, CDUM(N:NP52), JUNK, 0.30,
     1        5 + IGBL(68), 2, 2.5, VRT)
        WRITE (LINE, 99989, IOSTAT = IOST) PAR(17)
        CALL GGIP09 (0.0, LINE, 17, 0.35, 1, 1, HORS - 5.0, VRT)
        VRT = VRT - 0.7
        IF (IPR(261) .GT. 0) THEN
          WRITE (LINE, 99985, IOSTAT = IOST) IPR(261)
          CALL GGIP09 (0.0, LINE, 10, 0.35, 1, 1, HORS - 5.0, VRT)
          VRT = VRT - 0.7
        END IF
        WRITE (LINE, 99990, IOSTAT = IOST) SPGRNM(1)(1:7)
        CALL GGIP09 (0.0, LINE, 17, 0.35, 1, 1, HORS - 5.0, VRT)
        WRITE (LINE, 99986, IOSTAT = IOST) 'a    ', PAR(101)
        VRT = VRT - 0.7
        CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
        WRITE (LINE, 99986, IOSTAT = IOST) 'b    ', PAR(102)
        VRT = VRT - 0.7
        CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
        WRITE (LINE, 99986, IOSTAT = IOST) 'c    ', PAR(103)
        VRT = VRT - 0.7
        CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
        WRITE (LINE, 99986, IOSTAT = IOST) 'alpha', PAR(104)
        VRT = VRT - 0.7
        CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
        WRITE (LINE, 99986, IOSTAT = IOST) 'beta ', PAR(105)
        VRT = VRT - 0.7
        CALL GGIP09 (0.0, LINE, 12, 0.35, 1, 1, HORS - 4.0, VRT)
        WRITE (LINE, 99986, IOSTAT = IOST) 'gamma', PAR(106)
        VRT = VRT - 0.7
        CALL GGIP09 (0.0, LINE, 14, 0.35, 1, 1, HORS - 4.0, VRT)
        IF (IPR(511) * IPR(512) .NE. 0) THEN
          WRITE (LINE, 99991, IOSTAT = IOST) IPR(512)
          CALL GGIP09 (90.0, LINE, 35, 0.45, 2, 2, 3.0, 2.5)
        END IF
        IF (IPR(511) .EQ. 0) THEN
          LINE = 'I(cal)'
        ELSE
          LINE = 'I(obs)'
        END IF
        CALL GGIP09 (90.0, LINE, 6, 0.5, 1, 2, 1.75, VERT - 5.0)
        CALL PLA110 (HORS, VERT, -1)
        IF (IPR(55) .NE. -1) CALL GGIP09
     1       (0.0, JID(75:80), 6, 0.45, 1, 2, 10.5, 24.25)
        CALL GGIP (0.0, 0.0, 0.0, 6)
        XSTEP = (HORS - 2.0) / IFN
        IF (NP .GT. 0) THEN
          CALL GEN108 (LU18, 0)
          WRITE (LU18, 99999, IOSTAT = IOST)
          WRITE (LINE, 99998, IOSTAT = IOST) SRT
          CALL GEN039 (-1, LINE, 1, 10, NB, NE)
          WRITE (LU18, 99997, IOSTAT = IOST) LINE(NB:NE)
          WRITE (LINE, 99998, IOSTAT = IOST) FIN
          CALL GEN039 (-1, LINE, 1, 10, NB, NE)
          WRITE (LU18, 99997, IOSTAT = IOST) LINE(NB:NE)
          WRITE (LINE, 99998, IOSTAT = IOST) PAR(411)
          CALL GEN039 (-1, LINE, 1, 10, NB, NE)
          WRITE (LU18, 99997, IOSTAT = IOST) LINE(NB:NE)
          WRITE (LU18, 99995, IOSTAT = IOST)
     1      KRAD(1:2), PAR(17), DATIJD(5:24)
          CALL GEN039 (-1, JID, 1, 50, NB, NE)
          WRITE (LU18, 99997, IOSTAT = IOST) JID(NB:50)
          WRITE (LU18, 99994, IOSTAT = IOST)
          XP = 1.0
          NB = 1
          NE = 1
          CALL GGIP (XP, 1.5, 0.0, 3)
          DO I = 1, IFN
            XP = XP + XSTEP
            YP = MIN (VERT - 4.0, 1.5 + VOID(I) * SCL / VM)
            CALL GGIP (XP, YP, 0.0, 2)
            IF (IPR(569) + IPR(570) + IPR(649) .GT. 0) THEN
              IF (I .GT. 1 .AND. I .LT. IFN .AND. YP .GT. 3.0) THEN
                IF (VOID(I - 1) .LT. VOID(I) .AND.
     1              VOID(I + 1) .LT. VOID(I)) THEN
                  THETA = I * PAR(411) / 2
                  D = PAR(17) / (2.0 * SIN(THETA / RGBL(6)))
                  Q = RGBL(5) / D
                  IF (IPR(569) .EQ. 1) THEN
                    WRITE (NQ1, 99996, IOSTAT = IOST) D
                  ELSE IF (IPR(570) .EQ. 1) THEN
                    WRITE (NQ1, 99996, IOSTAT = IOST) 2 * THETA
                  ELSE IF (IPR(649) .EQ. 1) THEN
                    WRITE (NQ1, 99984, IOSTAT = IOST) Q
                  END IF
                  XPP = XP + 0.0875
                  YPP = YP
                  CALL GGIP09 (90.0, NQ1, 7, 0.175, 2, 1, XPP, YPP)
                  CALL GGIP (XP, YP, 0.0, 3)
                END IF
              END IF
            END IF
            WRITE (LINE, 99992, IOSTAT = IOST)
     1        NINT(VOID(I) * 10000.0 / VM)
            CALL GEN039 (-1, LINE, 1, 10, NB, NE)
            WRITE (LU18, 99997, IOSTAT = IOST) LINE(NB:NE)
          END DO
        END IF
        IF (FIN .GT. 40.0) THEN
          IS = 5
        ELSE
          IS = 1
        END IF
        XP  = 1.0
        XST = IS * XSTEP / PAR(411)
        N   = 0
        DO WHILE (N .LE. NINT(FIN))
          CALL GGIP (XP, 0.8, 0.0, 3)
          CALL GGIP (XP, 1.2, 0.0, 2)
          CALL GEN040 (N, NQ1, IP)
          CALL GGIP09 (0.0, NQ1, IP, 0.2, 1, 1, XP + 0.1, 1.1)
          IF (N .GT. 0 .AND. (IPR(569) + IPR(649) .NE. 0)) THEN
            XNN = 0.5 * PAR(17) / SIN(N / (RGBL(6) * 2.0))
            IF (IPR(569) .EQ. 1) THEN
              NN = NINT (100.0 * XNN)
            ELSE IF (IPR(649) .EQ. 1) THEN
              NN = NINT (1000.0 * RGBL(5) / XNN)
            END IF
            CALL GEN040 (NN, NQ1, IP)
            CALL GGIP09 (0.0, NQ1, IP, 0.175, 2, 1, XP + 0.01, 0.6)
          END IF
          XP = XP + XST
          N  = N  + IS
        END DO
        IF (IPR(649) .EQ. 0) THEN
          CALL GGIP09 (0.0, '2-Theta Deg. / d * 100 Ang.',
     1         12 + 15 * IPR(569), 0.35, 1, 1, HORS - 8.0, 0.1)
        ELSE
          CALL GGIP09 (0.0, '2-Theta Deg. / d * 1000 A-1',
     1         27, 0.35, 1, 1, HORS - 8.0, 0.1)
        END IF
   40   CONTINUE
          IGBL(6) = 21
          CALL PLA013 (0, 1)
        CALL GEN072 (IGGT, IFL, FN, KL, KN, 0, LU6, 1,
     1                   1, 80, 7, NP17)
        IF (IFL(1)(1:4) .EQ. 'RADN') THEN
          CALL PLA293 (FN(1))
          IPR(549) = 0
          GO TO 10
        ELSE IF (IFL(1)(1:4) .EQ. 'LIST') THEN
          IF (KN .NE. 0) THEN
            THM = FN(1) / 2.0
          ELSE
            THM = FIN / 2.0
          END IF
          NREFS = 0
          DO I = 1, NREFL
            TH = VOID(18000 + I * 5 - 1) * RGBL(6)
            IF (TH .LT. THM) THEN
              NREFS          = NREFS + 1
              JNSC(1, NREFS) = NINT(TH * 1000.0)
              JNSC(2, NREFS) = I
            END IF
          END DO
          CALL PLA015 (0, 39)
          CALL GEN037 (JNSC, 1, NREFS)
          CALL PLA262 (0)
          WRITE (LU7, 99987, IOSTAT = IOST)
          CALL PLA262(5)
          DO I = 1, NREFS
            TTH = 0.002 * JNSC(1, I)
            J   = JNSC(2, I)
            IH  = NINT(VOID(18000 + J * 5 - 4))
            IK  = NINT(VOID(18000 + J * 5 - 3))
            IL  = NINT(VOID(18000 + J * 5 - 2))
            IR  = NINT(10000000 * VOID(18000 + J * 5) / AMX)
            CALL PLA262 (1)
            D = PAR(17) / (2.0 * SIN (TTH / (2.0 * RGBL(6))))
            WRITE (LU7, 99988, IOSTAT = IOST) IH, IK, IL, TTH, IR, D
          END DO
          GO TO 40
        ELSE IF (IFL(1)(1:4) .NE. 'EXIT') THEN
          SELECT CASE (LRET)
            CASE (1)
              GO TO 30
            CASE (2)
              GO TO 50
            CASE (3)
              GO TO 20
            CASE (4)
              GO TO 10
          END SELECT
        END IF
   50   IF (IPR(650) .EQ. 1) THEN
          CLOSE (UNIT = LU18, ERR = 60)
        ELSE
          CLOSE (UNIT = LU18, STATUS = 'DELETE', ERR = 60)
          IGBL(18) = 0
        END IF
      END IF
   60 RETURN
99999 FORMAT ('SIETRONICS XRD SCAN')
99998 FORMAT (F10.3)
99997 FORMAT (A)
99996 FORMAT (F6.2)
99995 FORMAT (A, /, F7.5, /, A, /, '1')
99994 FORMAT ('SCANDATA')
99993 FORMAT (3I4, F8.0)
99992 FORMAT (I10)
99991 FORMAT ('Missing Low Order Reflections =', I4)
99990 FORMAT ('SpGroup ', A)
99989 FORMAT ('Lambda ', F8.5)
99988 FORMAT (3I5, F8.2, I15, F10.3)
99987 FORMAT ('2-Theta Sorted Reflection Listing', /, 80('='), //, 4X,
     1        'H    K    L 2-Theta', 6X, 'Intensity',5X, 'd Ang',
     1        /, 80('='))
99986 FORMAT (A, F7.2)
99985 FORMAT ('Temp', I5, 'K')
99984 FORMAT (F6.3)
      END SUBROUTINE PLA149
      SUBROUTINE PLA150 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,MP3=1000,
     4 MP1=NVD + 2 * NP23 - 1836 - 87 * MP3)
      COMMON // SFC(1616), F(84), PEAK(MP3, 46), ICON(MP3, 40),
     1          NCON(MP3), G(52), E(84), C(MP1)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER LABI*4, ATTP*2
      DIMENSION DA(NP10), IA(NP10)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PL132/ TRMX(3, 3), STHKM, ISKIP, ITSKP, IOBS, ICALC,
     1 NDEC, SHXMP
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER STAR*50
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      DIMENSION MCONT(NP10)
      IWIN  = 0
      S     = 0
      NSYM  = IPR(48)
      NSYMH = IPR(255)
      CENT  = 2 - IPR(257)
      IBVT  = IPR(241)
      LATTS = IPR(256) * IPR(257)
      ISW   = 5
      KEEP  = 1
      IGBL(63) = 0
      IF (IPR(220) .GT. 1) THEN
        IF (IFL(2)(1:4) .EQ. 'AUTO') IGBL(25) = 0
      END IF
      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IGBL(50) .EQ. 0) IWIN = 1
C * SETUP-MODE PARAMETERS
      IF (MODE .EQ. 0) THEN
        IPR(525) = 0
        IF (IPR(220) .GT. 1) THEN
          DO I = 2, IPR(220)
            IF (IFL(I)(1:4) .EQ. 'PATT') THEN
              IPR(525) = 1
            ELSE IF (IFL(I)(1:4) .EQ. 'PATR') THEN
              IPR(525) = -1
            END IF
          END DO
        END IF
        IF (FN(1) .NE. 0) IPR(548) = 1
      ELSE IF (MODE .EQ. -1) THEN
        IPR(525) =  0
        CENT     =  0
        ISW      = -5
      ELSE
        IF (IPR(37) .GT. MP3) CALL GEN127 ('MEMORY (MP3) PROBLEM')
C * EXOR-MODE PARAMETERS
        IF (FN(1) .GT. 0.0) PAR(284) = FN(1)
        IF (FN(2) .GE. 0.0) PAR(281) = FN(2)
        IF (FN(3) .GT. 0.0) PAR(282) = FN(3)
        IF (FN(4) .GT. 0.0) PAR(283) = FN(4)
        IF (FN(5) .GT. 0.0) IPR(482) = NINT(FN(5))
        IF (FN(6) .NE. 0.0) IPR(467) = NINT(FN(6))
        IGBL(31) = 6
        IF (FN(7) .NE. 0.0) IPR(548) = 1
        KEEP     = NINT (FN(8))
        CALL PLA292
      END IF
      IF (IWIN .EQ. 1) THEN
        IGBL(6)    = 27
        IGGT(2:21) = NAMEFIL(1:20)
        PAR1       = -999.0
        PAR2       = FLOAT(-KNMFIL)
        CALL GGIP (PAR1, PAR2, 0.0, 5)
        IF (MODE .EQ. 0) THEN
          IF (IPR(525) .NE. 0) THEN
            IF (IPR(548) .EQ. 1) BCD = 'S.Y.S.T.E.M - S'//CHAR(0)
            CALL GGIP (HORS, VERT, 0.0, 1)
            BCD = 'FO**2 - PATTERSON'//CHAR(0)
            CALL GGIP09 (0.0,  BCD, 18, 1.0, 4, 6,  6.1, VERT - 1.5)
            CALL GGIP09 (0.0,  BCD, 18, 1.0, 2, 6,  5.9, VERT - 1.6)
            CALL GGIP (0.0, 0.0, 0.0, 6)
            VRT = VERT - 1.8
          END IF
        ELSE IF (MODE .EQ. 1) THEN
          IF (IPR(548) .EQ. 1) BCD = 'S.Y.S.T.E.M - S'//CHAR(0)
          CALL GGIP (HORS, VERT, 0.0, 1)
          BCD = 'E.X.O.R'//CHAR(0)
          CALL GGIP09 (0.0,  BCD, 7, 1.8, 4, 15, 1.7, VERT - 2.3)
          CALL GGIP09 (0.0,  BCD, 7, 1.8, 2, 15, 1.5, VERT - 2.4)
        END IF
      END IF
      IGBL(70) = 0
      CALL PLA080
      ICNT3 = 3
      IF (IABS(IGBL(8)) .NE. 2 .AND. IPR(30) .EQ. 0) THEN
        CALL PLA066
        IF (IPR(2) .NE. 0) RETURN
        CALL PLA072 (-1, 1)
        ICNT3   = 2
      END IF
      Z = 0.004 / PAR(17)**2
      L = 1
      DO I = 1, IAN
        N = IEN(I)
        L = L - 1
        W = 0.0
        DO N0 = 1, 51
          X = 0.0
          Y = 0.0
          DO K = 1, 6
            M = L + K
            SFC(M) = SFAC((N - 1) * 17 + 9)
            DO J = 1, 7, 2
              V = - SFAC((N - 1) * 17 + J + 1) * (W + X)
              IF (ABS(V) .LT. 87.0) THEN
                SFC(M) = SFC(M) + SFAC((N - 1) * 17 + J) * EXP(V)
              END IF
            END DO
            X = X + Z
            Y = Y + SFC(M)
          END DO
          SFC(L + 2) = 1.25 * Y - 3.75 * (SFC(L + 1) + SFC(L + 6))
          L          = L + 2
          W          = W + 5.0 * Z
        END DO
      END DO
      IF (IGBL(16) .EQ. 0) THEN
        CALL GEN108 (LU19, 0)
        MF = 1
        DO J = 1, 51
          G(J) = 0.0
          F(J) = 0.0
          M = 2 * J - 1
          DO K = 1, IAN
            Y    = SFC(M) * SFC(M) * CONT(K, ICNT3)
            G(J) = G(J) + Y
            F(J) = F(J) + Y * SFC(M)
            M    = M + 101
          END DO
        END DO
        WRITE (LU6, 99967, IOSTAT = IOST) PAR(17)
        CALL GEN074 (C, 4, 6,  999.0)
        CALL GEN074 (C, 7, 9, -999.0)
        IPR(602) = 0
        IHMIN    =  999
        IKMIN    =  999
        ILMIN    =  999
        IHMAX    = -999
        IKMAX    = -999
        ILMAX    = -999
        THMAX    =  0.0
        THMIN    =  1.0
        IEND     = -1
        MR       = 0
        IH       = 0
        IK       = 0
        IL       = 0
   10   CALL PLA136 (NI, NJ, NK, T, W, SIGIW, CALI, UCINT,
     1             ACALS, BCALS, ACOR, IEND)
        IF (IGBL(9) .EQ. -1) T = UCINT
        K = 0
        IF (IEND .EQ. 0 .AND. ABS(NI) + ABS(NJ) + ABS(NK) .NE. 0) THEN
          IF (W .LE. 0.0) THEN
            IF (T .LE. 0.0) GO TO 10
            W = SQRT (ABS(T))
          END IF
          IPR(602) = IPR(602) + 1
          IF (GEN050 (TRMX, NI, NJ, NK, IH, IK, IL) .LT. 0.0) GO TO 20
          IF (IBVT .GT. 1) THEN
            IF (GEN049 (LAT(IBVT), IH, IK, IL) .LT. 0) GO TO 20
          END IF
          U      = -9999999.0
          U1     = U
          P      = 0.0
          R      = 0.0
          XJX(1) = IH
          XJX(2) = IK
          XJX(3) = IL
          XJX(4) = 0.0
          DO N = 1, NSYMH
            CALL SGSM (LINE, N, XJX, 0, ISW, IERR)
            IF (MAX (ABS (XJX(7)), ABS (XJX(8))) .GE. 99.5) GO TO 20
            Q1 = XJX(7) + 200.0 * (XJX(8) + 200.0 * XJX(9))
            Q  = ABS (Q1)
            IF (CENT .EQ. 0) Q1 = Q
            IF (NINT (Q1) .GE. NINT(U1)) THEN
              TEMP = XJX(10) / RGBL(6)
              TEMP = COS (TEMP) + 21.42 * SIN (TEMP) * CENT
              R = R + TEMP
              IF (NINT (Q1) .GT. NINT (U1)) THEN
                R  = TEMP
                U1 = Q1
              END IF
            END IF
            IF (NINT (Q) .GE. NINT (U)) THEN
              P = P + 1.0
              IF (NINT (Q) .GT. NINT (U)) THEN
                P = 1.0
                U = Q
              END IF
            END IF
          END DO
          IF (ABS(R) .GE. 0.1) GO TO 30
   20     MR = MR + 1
          IF (MR .EQ. 1) WRITE (LU6, 99983, IOSTAT = IOST)
          IF (K .GT. 50) THEN
            WRITE (LU6, 99980, IOSTAT = IOST) NI, NJ, NK, T, W, S
          ELSE
            WRITE (LU6, 99980, IOSTAT = IOST) NI, NJ, NK, T, W
          END IF
          GO TO 10
   30     QS = GEN095 (PAR(191), IH, IK, IL)
          IF (QS .GT. 0.422) GO TO 10
          CALL GEN046 (U, X1, Y1, Z1)
          IHMAX = MAX (IHMAX, IH)
          IKMAX = MAX (IKMAX, IK)
          ILMAX = MAX (ILMAX, IL)
          IHMIN = MIN (IHMIN, IH)
          IKMIN = MIN (IKMIN, IK)
          ILMIN = MIN (ILMIN, IL)
          C(7)  = MAX (C(7), X1)
          C(8)  = MAX (C(8), Y1)
          C(9)  = MAX (C(9), Z1)
          C(4)  = MIN (C(4), X1)
          C(5)  = MIN (C(5), Y1)
          C(6)  = MIN (C(6), Z1)
          S     = QS * PAR(17)**2
          TEMP  = S * 50.0
          K     = INT(TEMP)
          IF (K .GT. 50) GO TO 20
          THMAX = MAX (THMAX, S)
          THMIN = MIN (THMIN, S)
          TEMP  = MOD (TEMP, 1.0)
          EE    = SQRT ((TEMP * (G(K + 2) - G(K + 1)) + G(K + 1)) * P)
          IF (EE. NE. 0.0) EE = EXP (3.94784 * QS) / EE
          V = T * 100.0
          W = W * 100.0
          IF (V .LT. W) V = 0.5 * W
          V = SQRT(V)
          W = W / (2.0 * V)
          F(MF)     = U
          F(MF + 1) = V
          IF (ABS(W) .GT. 0.00001) THEN
            F(MF + 2) = W**2
          ELSE
            F(MF + 2) = 1.E-10
          END IF
          F(MF + 3) = RGBL(8) * QS
          F(MF + 4) = MIN (EE * V, 900.0)
          F(MF + 5) = 0.0
          MF        = MF + 6
          IF (MF .GT. 79) THEN
            WRITE (LU19) F
            MF = 1
          END IF
          GO TO 10
        END IF
        WRITE (LU6, 99994, IOSTAT = IOST) IPR(602), MR
        IF (IPR(602) .EQ. 0) GO TO 260
        THMIN = NINT(ASIN(SQRT(THMIN)) * 572.9578) / 10.0
        IF (THMAX .GT. 1.0) THEN
          THMAX = 90.0
        ELSE
          THMAX = NINT(ASIN(SQRT(THMAX)) * 572.9578) / 10.0
        END IF
        WRITE (LU6, 99991, IOSTAT = IOST)
     1    IHMIN, IHMAX, IKMIN, IKMAX, ILMIN, ILMAX,
     1   THMIN, THMAX
        IPR(267) = IHMIN
        IPR(268) = IHMAX
        IPR(269) = IKMIN
        IPR(270) = IKMAX
        IPR(271) = ILMIN
        IPR(272) = ILMAX
        F(MF)    = 0.0
        WRITE (LU19) F
        CALL GEN108 (LU19, 1)
        HB = C(7) - C(4) + 1.0
        GD = C(8) - C(5) + 1.0
        GA = 1.0  - C(4) - HB * (C(5) + GD * C(6))
        NE = -5
        R  = 0.0
        S  = 0.0
        NM = 0
        CALL GEN074 (C, 1, MP1, 0.0)
        NT  = 0
        MPM = MP1 - 8
        M   = MPM
   40   READ (LU19) F
        DO I = 1, 79, 6
          IF (0.5 .GT. ABS(F(I))) THEN
            CALL GEN108 (LU19, 0)
            IF (M .EQ. MPM) THEN
              DO K = 1, NT
                IF (K + 10 .GT. M) EXIT
                IF (C(K) .GE. 1.0) THEN
                  M    = M - 8
                  C(K) = M + 1
                END IF
              END DO
              CALL GEN074 (C, NT + 1, MPM, 0.0)
              M = NT
              GO TO 40
            END IF
            GO TO 60
          END IF
          CALL GEN046 (F(I), X, Y, Z)
          N = NINT(GA + X + HB * (Y + GD * Z))
          IF (N .GT. 0 .AND. N .LE. M) THEN
            IF (M .NE. MPM) THEN
              N        = NINT(C(N))
              V        = F(I + 1)
              W        = 1.0 / F(I + 2)
              C(N + 1) = C(N + 1) + V * W
              C(N + 2) = C(N + 2) + W
              C(N + 3) = F(I + 3)
              C(N + 4) = C(N + 4) + F(I + 4) * W
              C(N + 6) = C(N + 6) + V * V * W
              C(N + 7) = F(I)
            ELSE
              NT = MAX (N, NT)
            END IF
            C(N) = C(N) + 1.0
          END IF
        END DO
        GO TO 40
   60   DO J = 1, NT
          M = NINT(C(J))
          IF (M .NE. 0) THEN
            NE        = NE + 6
            E(NE)     = C(M + 7)
            W         = 1.0 / C(M + 2)
            E(NE + 1) = C(M + 1) * W
            E(NE + 2) = W
            E(NE + 3) = C(M + 3)
            E(NE + 4) = MIN (900.0, C(M + 4) * W)
            E(NE + 5) = 0.0
            IF (NE .GE. 79) THEN
              WRITE (LU9) E
              NE = - 5
            END IF
            NM = NM + 1
            IF (C(M) .GT. 1.0 .AND. C(M + 1) .GE. 1.E-8) THEN
              X = C(M + 2) * C(M + 6)
              Y = C(M + 1) **2
              S = S + W * X * (C(M) - 1.0)
              R = R + W * C(M) * (X - Y)
              IF (1.04 * Y .LE. X) THEN
                U = 1.0 / (SQRT(W) * C(M + 1))
                W = SQRT(ABS(X / Y - 1.0))
                N = NINT(C(M))
                CALL GEN046 (C(M + 7), X, Y, Z)
              END IF
            END IF
          END IF
        END DO
        E(NE + 6) = 0.0
        WRITE (LU9) E
        T = 0.0
        IF (S .NE. 0.0) T = SQRT(ABS(R / S))
        WRITE (LU6, 99985, IOSTAT = IOST) NM, T
        CALL GEN108 (LU9, 1)
        L = 0
        CALL GEN074 (C, 1, 64, 0.0)
        CALL GEN074 (E, 1, 64, 0.0)
        DO M = 1, 2
   70     READ (LU9) F
          I = -5
   80     I = I + 6
          IF (0.5 .LE. ABS(F(I))) THEN
            X = 1.0 + SQRT(2.584724 * F(I + 3))
            K = MIN (14, INT(X))
            T = MIN (X - FLOAT(K), 1.0)
            W = F(I + 4)
            P = 1.0 - T
            IF (M .EQ. 1) THEN
              C(K)      = C(K)      + P * W**2
              C(K + 1)  = C(K + 1)  + T * W**2
              C(K + 15) = C(K + 15) + P
              C(K + 16) = C(K + 16) + T
            ELSE
              W        = W * (P * C(K + 30) + T * C(K + 31))
              F(I + 4) = MIN (W, 9.0)
              F(I + 1) = F(I + 1) * Q
              F(I + 2) = F(I + 2) * Q**2
              V        = ABS(1.0 - W**2)
              C(K)     = C(K) + P * V / MAX (C(K + 15), 0.01)
              C(K + 1) = C(K + 1) + T * V / MAX (C(K + 16), 0.01)
              CALL GEN046 (F(I), X, Y, Z)
              IF (L .GE. 4) L = 0
              L = L + 1
              C(L + 45) = F(I + 1)
              C(L + 49) = SQRT(F(I + 2))
            END IF
            IF (I .LT. 79) GO TO 80
            IF (M .EQ. 2) WRITE (LU19) F
            GO TO 70
          END IF
          IF (M .EQ. 1) THEN
            Q = 1.0
            U = 0.0
            DO J = 1, 10
              CALL GEN074 (E, 1, 8, 0.0)
              DO I = 1, 15
                X    = E(8)**2
                P    = EXP(X * U) * C(I)
                V    = P / MAX (1.E-5, C(I + 15))
                W    = P * Q
                Z    = C(I + 15) - W
                E(1) = E(1) + V * P
                W    = W * X
                E(2) = E(2) + V * W
                P    = Q * X
                E(3) = E(3) + V * W * P
                E(4) = E(4) + Z * V
                E(5) = E(5) + Z * V * P
                E(6) = E(6) + C(I)
                E(7) = E(7) + C(I + 15)
                E(8) = E(8) + 0.622004
              END DO
              X = 1.0 / (0.1 + E(1))
              W = - X * E(2)
              Z = 1.0 / (0.1 + E(3) + W * E(2))
              Y = Z * W
              X = X + W * Y
              U = U + E(4) * Y + E(5) * Z
              IF (ABS(U) .GE. 0.1) THEN
                U = SIGN (0.09999, U)
                X = 0.0
                Y = 1.0 / (0.1 + E(3))
              END IF
              Q = Q + E(4) * X + E(5) * Y
            END DO
            IF (Q .LE. 0.0) Q = 1.0
            Q = SQRT(MAX(Q, 0.0)) * SQRT(FLOAT(LATTS)) * 0.96
            U = 0.05 - 0.5 * U
            DO I = 1, 15
              C(I + 30) = SQRT((C(I + 15) + 0.01 * E(7))
     1                  / (C(I) + 0.01 * E(6)))
            END DO
          END IF
          CALL GEN108 (LU9, 0)
        END DO
        WRITE  (LU19) F
        WRITE (LU6, 99984, IOSTAT = IOST) Q, U
        PAR(465) = U
        IF (IPR(525) .LE. 0 .AND. IPR(409) .EQ. 0) THEN
          CALL GEN108 (LU19, 1)
          CALL GEN108 (LU17, 0)
          EKW = 0.0
          NEK = 0
          DO WHILE (.TRUE.)
            READ (LU19) F
            DO I = 1, 79, 6
              IF (0.5 .GT. ABS(F(I))) GO TO 100
              CALL GEN046 (F(I), C(1), C(2), C(3))
              V = F(I + 1) * 100.0
              W = SQRT(F(I + 2)) * 100.0
              WRITE (LU17, 99982, IOSTAT = IOST)
     1          NINT(C(1)), NINT(C(2)), NINT(C(3)), NINT(V), NINT(W)
              EKW = EKW + ABS(F(I + 4)**2 - 1.0)
              NEK = NEK + 1
            END DO
          END DO
  100     WRITE (LU17, 99981, IOSTAT = IOST)
          WRITE (LU6, 99979, IOSTAT = IOST) EKW / NEK
          IGBL(16) = 1
        END IF
      END IF
C * EXOR (MODE > 0)
      IF (MODE .GT. 0) THEN
        KNOWN = 0
        DO I = 2, IAN
          IF (LMT(I, 1) .NE. ' Q') THEN
            IF (CONT(I, 3) .NE. CONT(1, 3)) KNOWN = 1
          END IF
        END DO
        UT = 2.0 * (RGBL(5) / PAR(17))**2
        SS = PAR(284)**2
        N  = 0
        M  = 0
        CALL GEN108 (LU19, 0)
        CALL GEN108 (LU4, 0)
        IF (SS .LE. 1.E9) THEN
          DO
            READ  (LU19) F
            WRITE (LU4)  F
            DO I = 1, 79, 6
              IF (NINT(F(I)) .EQ. 0) THEN
                CALL GEN108 (LU19, 0)
                CALL GEN108 (LU4, 1)
                DO
                  READ (LU4) F
                  DO J = 1, 79, 6
                    IF (NINT(F(J)) .EQ. 0) THEN
                      WRITE (LU19) F
                      CALL GEN108 (LU19, 1)
                      CALL GEN108 (LU4, 0)
                      WRITE (LU6, 99999, IOSTAT = IOST) SQRT(SS), M, N
                      GO TO 130
                    END IF
                    X = 0.0
                    IF (SS * F(J + 2) .GT. F(J + 1)**2) THEN
                      X = 1.0
                      M = M + 1
                    END IF
                    F(J + 3) = MOD(F(J + 3), UT) + UT * X
                  END DO
                  WRITE (LU19) F
                END DO
              END IF
              N = N + 1
            END DO
          END DO
        END IF
  130   EXPMX  = PAR(98) / (12.0 * NSYM)
        CRIT0  = 0.33
        PICKUP = 1.0
        IAN0 = IAN
        IF (LMT(IAN, 1) .EQ. ' Q') IAN0 = IAN - 1
        DO I = 1, IAN0
          DA(I) = 1000.0 - IATNR(IEN(I))
          IA(I) = I
        END DO
        CALL GEN013 (DA, IA, 1, IAN0)
        IRMIN = IAN0
        DO I = 1, IAN0
          DA(I) = 1000.0 - DA(I)
          IF (NINT(DA(I)) .LE. 1) IRMIN = IRMIN - 1
        END DO
        RATIO = DA(1) / DA(IRMIN)
        CRIT = CRIT0 / RATIO
        DO I = 1, 3
          V2(I) = 2.0 * PAR(112 + I)
        END DO
        NPK  = 0
        LOOP = 0
        VRT  = VERT - 3.0
  140   LOOP = LOOP + 1
        NAT  = MIN (MP3, IPR(37) + NPK)
        IF (LOOP .EQ. 1) THEN
          DO J = 1, NAT
            DO I = 1, 3
              XJX(I)     = CON(J, I + 2)
              PEAK(J, I) = XJX(I)
            END DO
            PEAK(J, 5) = 100.0
            XJX(10)    = 0.0
            CALL SGSM (LINE, 0, XJX, LU6, 19, IERR)
            PEAK(J, 6) = XJX(10)
            ATTP = LMT(NINT (CON(J, NP4 - 1)), 1)
            DO I = 1, IAN0
              IF (ATTP .EQ. LMT(IA(I), 1)) GO TO 150
            END DO
  150       PEAK(J, 4) = XJX(10) * DA(I) / DA(1)
          END DO
        ELSE
          DO I = 1, NAT
            IF (I .LE. IPR(37)) THEN
              DO J = 1, 3
                XJX(J)     = CON(I, J + 2)
                PEAK(I, J) = XJX(J)
              END DO
              PEAK(I, 4) = CON(I, NP4)
              PEAK(I, 5) = 0.0
            ELSE
              DO J = 1, 3
                XJX(J)     = XXO(I - IPR(37), J)
                PEAK(I, J) = XJX(J)
              ENDDO
              PEAK(I, 4) = PEAK(I, 6) * CRIT
              PEAK(I, 5) = XXO(I - IPR(37), 4) / PAR(98)
              IF (PEAK(I, 5) .LT. PICKUP) PEAK(I, 4) = 0.0
            END IF
            XJX(10) = 0.0
            CALL SGSM (LINE, 0, XJX, 6, 19, IERR)
            PEAK(I, 6) = XJX(10)
          END DO
        END IF
        CALL GEN097 (NCON, 1, NAT, 0)
        DO I = 1, NAT
          DO J = I, NAT
            DO 220 N = 1, NSYM
              IF (J .NE. I .OR. N .NE. 1) THEN
                DO K = 1, 3
                  XJX(K)     = PEAK(J, K)
                  XJX(K + 3) = 0.0
                END DO
                NS = N
                CALL SGSM (LINE, NS, XJX, LU6, 3, IERR)
                K = 1
                GO TO 170
  160           XJX(6 + K) = XJX(6 + K) - 1.0
  170           IF ((PEAK(I, K) - XJX(6 + K)) .LE. V2(K)) GO TO 160
                GO TO 190
  180           IF (ABS(PEAK(I, K)  - XJX(6 + K)) .LE. V2(K)) GO TO 200
  190           XJX(6 + K) = XJX(6 + K) + 1.0
                IF ((PEAK(I, K)  - XJX(6 + K)) .GE. - V2(K)) GO TO 180
                K = K - 1
                IF (K .EQ. 0) GO TO 220
                GO TO 190
  200           K = K + 1
                IF (K .GT. 3) THEN
                  DO L = 1, 3
                    V3(L) = PEAK(I, L) - XJX(6 + L)
                  END DO
                  CALL GEN002 (2, OR, V3, V4, DIST)
                  IF (DIST .LT. 2.0) THEN
                    IF (I .NE. J .OR. DIST .GT. 0.05) THEN
                      IF (NCON(I) .LT. 40) THEN
                        NCON(I)              = NCON(I) + 1
                        PEAK(I, 6 + NCON(I)) = DIST
                        ICON(I, NCON(I))     = J
                      END IF
                      IF (NCON(J) .LT. 40) THEN
                        NCON(J)              = NCON(J) + 1
                        PEAK(J, 6 + NCON(J)) = DIST
                        ICON(J, NCON(J))     = I
                      END IF
                    END IF
                  END IF
                  GO TO 210
                END IF
                GO TO 170
  210           K = K - 1
                GO TO 190
              END IF
  220       CONTINUE
          END DO
        END DO
        NRNEW = 0
        NRSH = 0
        RSHN = 0.0
        DO 230 I = 1, NAT
          IF (PEAK(I, 4) / PEAK(I, 6) .GE. CRIT) THEN
            JMAX = NCON(I)
            DO J = 1, JMAX
              BONDIJ = PEAK(I, J + 6)
              IF (BONDIJ .LT. 1.3) THEN
                K = ICON(I, J)
                IF (BONDIJ .LT. 0.9 .OR.
     1            PEAK(I, 4) .GT. PEAK(K, 4) * 3) THEN
                  PEAK(K, 4) = 0.0
                END IF
              END IF
              IF (PEAK(I, 5) .GT. 0.0 .AND. PEAK(I, 5) .LT. 2.0) THEN
                IF (BONDIJ .GT. 1.6) GO TO 230
              END IF
              IF (LOOP .EQ. 1) THEN
                PHMIN = 2.0
              ELSE
                PHMIN = 1.0
              END IF
              IF (BONDIJ .LT. 1.8 .AND. PEAK(I, 5) .GT. 0.0
     1           .AND. PEAK(I, 5) .LT. PHMIN) GO TO 230
            END DO
            IF (RSHN .LT. EXPMX) THEN
              NRSH  = NRSH + 1
              RSHN  = RSHN + PEAK(I, 6)
              DO J = 1, 3
                CON(NRSH, J + 2) = PEAK(I, J)
              END DO
              CON(NRSH, NP4 - 1) = IA(1)
              CON(NRSH, NP4)     = PEAK(I, 4)
              IF (PEAK(I, 5) .GT. 0.0) NRNEW = NRNEW + 1
              DATC(NRSH) = 1000.0 - PEAK(I, 4) / PEAK(I, 6)
              IATC(NRSH) = I
            END IF
          END IF
  230   CONTINUE
        IF (NRSH .EQ. 0) WRITE(LU6, 99969, IOSTAT = IOST)
        IPR(37) = NRSH
        IF (NRNEW .NE. 0 .OR. LOOP .LE. 2) THEN
          IF (LOOP .LT. IABS(IPR(467))) THEN
            CALL PLA151 (LOOP)
            IF (IPR(2) .EQ. 0) CALL PLA152 (-2, NPK)
            GO TO 140
          END IF
        END IF
        REWIND (UNIT = LU2, IOSTAT = IOST)
        IF (IOST .NE. 0) CALL GEN148 (LU2, 1)
        HRT = 0.57 * HORS
        VRT = VERT - 3.4
        WRITE (LU2, 99990, IOSTAT = IOST)
     q    JID(1:6), PAR(17), (PAR(100  + I), I = 1, 12)
        WRITE (LU2, 99989, IOSTAT = IOST) IPR(242)
        DO I = 2, IPR(255)
          NUMS = I
          CALL SGSM (LINE, NUMS, XJX, 0, 17, IERR)
          WRITE (LU2, 99988, IOSTAT = IOST) LINE(1:60)
        END DO
        WRITE (LU2, 99987, IOSTAT = IOST) (LMT(I, 1), I = 1, IAN0)
        WRITE (LU2, 99986, IOSTAT = IOST)
     1    (NINT(CONT(I, 3)), I = 1, IAN0)
        WRITE (LU2, 99995, IOSTAT = IOST) PAR(74)
        FACT  = 0.5
        XPEAK = 999.0
        N     = 0
        DELTA = 1.0
        CALL GEN097 (MCONT, 1, NP10, 0)
        CALL GEN013 (DATC, IATC, 1, NRSH)
        DO I = 1, NRSH
          DATC(I) = (1000.0 - DATC(I)) * DA(1)
          IF (XPEAK - DATC(I) .GT. DELTA) THEN
            IF (N .LT. IRMIN) THEN
              N = N + 1
              IF (N .LT. IRMIN) THEN
                DELT = DA(N) - DA(N + 1)
              ELSE
                DELT = 999.0
              END IF
            END IF
          END IF
          XPEAK    = DATC(I)
          DELTA    = DELT * FACT * XPEAK / DA(N)
          MCONT(N) = MCONT(N) + 1
        END DO
        N    = 0
        NEL0 = 1
        L    = 0
        NATR = 0
        HGHT = DATC(1)
        DO I = 1, NRSH
          K    = IATC(I)
          NATR = NATR + 1
          N    = N + 1
          L    = L + NINT(NSYM * PEAK(K, 6))
          IF (NEL0 .LT. IAN0 .AND. NINT(DA(NEL0 + 1)) .NE. 1) THEN
            IF (KNOWN .EQ. 0) THEN
              IF (N .LE. MCONT(NEL0)) GO TO 240
            ELSE IF (KNOWN .EQ. 1) THEN
              IF (DA(NEL0) .gt. 15 .AND.
     1            (DA(NEL0) - DA(NEL0 + 1)) .GT. 5) THEN
                IF ((HGHT - DATC(I)) / HGHT .LT. 0.20) GO TO 240
              ELSE
                IF (L .LE. NINT(CONT(IA(NEL0), 3))) GO TO 240
              END IF
            END IF
            L    = NINT(NSYM * PEAK(K, 6))
            NEL0 = NEL0 + 1
            N    = 1
          END IF
  240     HGHT = DATC(I)
          LABI(1:4) = LMT(IA(NEL0), 1)(1:2)//'  '
          IF (LABI(1:1) .NE. ' ') THEN
            L0 = 1
            NO = 50 + N
          ELSE
            LABI(1:4) = LMT(IA(NEL0), 1)(2:2)//'   '
            L0 = 0
            NO = 500 + N
          END IF
          IF (NO .LT. 100) THEN
            WRITE (LABI(2 + L0 : 3 + L0), 99971, IOSTAT = IOST) NO
          ELSE
            WRITE (LABI(2:4), 99972, IOSTAT = IOST) NO
          END IF
          WRITE (LU2, 99993, IOSTAT = IOST)
     1      LABI, IA(NEL0), (PEAK(K, J), J = 1, 3), 10 + PEAK(K, 6),
     2      RP(2)
          IF (IWIN .EQ. 1) THEN
            IF (I .EQ. 1) THEN
              WRITE (IDM, 99975, IOSTAT = IOST)
              VRT = VERT - 0.5
              CALL GGIP09 (0.0, IDM, 38, 0.3, 5 + IGBL(68), 2, HRT, VRT)
            END IF
            IF (I .LE. 42) THEN
              WRITE (IDM, 99976, IOSTAT = IOST)
     1          I, LABI, (PEAK(K, J), J = 1, 3), DATC(I)
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, IDM, 38, 0.3, 1, 2, HRT, VRT)
            END IF
          END IF
        END DO
        WRITE (LU2, 99996, IOSTAT = IOST) (PAR(I), I = 231, 239)
        WRITE (IDM, 99992, IOSTAT = IOST) PAR(281), PAR(282), NATR
        WRITE (LU6, 99970, IOSTAT = IOST) IDM
        IF (IWIN .EQ. 1)
     1      CALL GGIP09 (0.0, IDM, 56, 0.3, 5 + IGBL(68), 2, 0.2, 0.2)
      ELSE
        IF (IABS(IPR(525)) .EQ. 1) THEN
          NPK  = 30
          MDIP = 0
          CALL PLA152 (0, NPK)
          IF (XXO(1, 4) .GT. 0.0) THEN
            PMAX = 999.0 / XXO(1, 4)
          ELSE
            PMAX = 1.0
          END IF
          DO I = 1, NPK
            DO J = 1, 3
              XXO(I, J) = MOD (XXO(I, J), 1.0)
            END DO
            XXO(I, 4) = XXO(I, 4) * PMAX
          END DO
          NPKM = MIN (35, NPK)
          NPRV = 50
          WRITE (LU6, 99966, IOSTAT = IOST)
          VRT = VERT - 1.8
          DO I = 1, NPKM
            NSTAR = NINT(XXO(I, 4) * 50 / 999.0)
            STAR  = ' '
            IF (NSTAR .GT. 0) THEN
              DO J = 1, NSTAR
                STAR(J:J) = '*'
              END DO
            END IF
            NDIF = NPRV - NSTAR
            NPRV = NSTAR
            IF (NDIF .GT. 0) THEN
              IF (I .GT. 2) MDIP = MAX (MDIP, NDIF)
              DO J = 1, NDIF
                STAR(51-J:51-J) = '<'
              END DO
            END IF
            WRITE (LINE, 99998, IOSTAT = IOST)
     1        I, (XXO(I, J), J = 1, 4), STAR
            WRITE (LU6, 99968, IOSTAT = IOST) LINE
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 0.5
              CALL GGIP09 (0.0, LINE, 80, 0.3, 1, 2, 2.2, VRT)
            END IF
          END DO
          WRITE (LU6, 99974, IOSTAT = IOST) MDIP, IGBL(89)
          IF (MDIP .LT. IGBL(89)) THEN
            LINE = 'EQUAL ATOM TYPE PATTERSON'
          ELSE
            LINE = 'HEAVY ATOM TYPE PATTERSON'
          END IF
          WRITE (LU6, 99970, IOSTAT = IOST) LINE
          CALL GGIP09 (0.0, LINE, 80, 0.4, 5 + IGBL(68), 2, 12.0, 2.0)
        END IF
      END IF
      IF (IWIN .EQ. 1) THEN
        IF (MODE .GT. 0 .OR. IPR(525) .NE. 0) THEN
  250     IF (IPR(467) .GT. 0) THEN
            WRITE (SBCD, 99997, IOSTAT = IOST) CHAR(0)
          ELSE
            WRITE (SBCD, 99973, IOSTAT = IOST) CHAR(0)
          END IF
          CALL PLA013 (0, 1)
          IF (IGGT(1:4) .EQ. 'PLOT') GO TO 250
          OPEN (LU61, FILE = 'NEXT', STATUS = 'UNKNOWN')
          WRITE (LU61, 99968, IOSTAT = IOST) IGGT
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
        END IF
      END IF
  260 IF (MODE .EQ. 0 .AND. IPR(2) .EQ. 0) IPR(2) = -13
      IGBL(16) = KEEP
      RETURN
99999 FORMAT (':: Omit = ', F5.1, ' => ', I6,
     1' Reflections Suppressed out of', I6, /)
99998 FORMAT (I3, 3F6.3, F6.0, 2X, A)
99997 FORMAT ('[END]', A)
99996 FORMAT ('HKLF 4 1', 9F8.4, /, 'END')
99995 FORMAT ('FVAR', F10.3)
99994 FORMAT (/, I7,' Reflections Read, of Which', I5, ' Rejected', /)
99993 FORMAT (A, I4, 5F10.4)
99992 FORMAT ('Sin(Th)/Lam =', F5.2, '-', F4.2,
     1        ' - Number of Remaining Atoms:', I3)
99991 FORMAT ('IHMIN, IHMAX =', 2I5, /,
     1        'IKMIN, IKMAX =', 2I5, /,
     2        'ILMIN, ILMAX =', 2I5, /,
     3        'THMIN, THMAX =', 2F5.1)
99990 FORMAT ('TITL ', A, ' - EXOR', /,
     1        'CELL ', F7.5, 6F10.4, /,
     2        'ZERR 1', 6X, 6F10.4)
99989 FORMAT ('LATT ', I3)
99988 FORMAT ('SYMM ', A)
99987 FORMAT ('SFAC ', 16(1X, A))
99986 FORMAT ('UNIT ', 2I5, 14I4)
99985 FORMAT (I5, ' Unique Reflections R =', F8.4)
99984 FORMAT ('Overall Scale', F12.5, /, 'Estimated U =', F6.3)
99983 FORMAT (/, 'Excluded Reflections')
99982 FORMAT (3I4, 2I8)
99981 FORMAT (1X)
99980 FORMAT (3I4, 2F12.2, F10.2)
99979 FORMAT ('Aver ABS(E**2-1) =', F5.2)
99976 FORMAT (I2, 1X, A, 3F7.3, F6.1)
99975 FORMAT ('Nr Label     x      y      z    PP')
99974 FORMAT (/, 'PATT DIP', I3, ', [TEST CRIT = >', I3, ']')
99973 FORMAT ('[REF-XYZU]', A)
99972 FORMAT (I3)
99971 FORMAT (I2)
99970 FORMAT (/, A, /)
99969 FORMAT ('No Atoms')
99968 FORMAT (A)
99967 FORMAT (':: Wavelength     =', F12.5, /)
99966 FORMAT (/, 'PATTERSON', /)
      END SUBROUTINE PLA150
      SUBROUTINE PLA151 (LOOP)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP52=200,NP56=30,NP57=35,MP2=1700,MP5=MP2*5,
     4 MP6=2000,MP3=1000,MP1=NVD+2*NP23-MP2-87*MP3-3*MP5-2*MP6-1700)
      COMMON // SFC(1616), F(84), PEAK(MP3, 46), ICON(MP3, 40),
     1 NCON(MP3), CT(MP5), D1(MP5), D2(MP5), IN(MP2), A(MP6), E(MP6),
     3 B(MP1)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /COM3/ NGRID, STHM, ITOP
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      DIMENSION ENB(16)
      N = 0
      NSYMH = IPR(255)
      CENT  = 2 - IPR(257)
      LATTS = IPR(256) * IPR(257)
      NAT   = IPR(37)
      NV    = IPR(482)
      TPI   = RGBL(5)
      STHMN = RGBL(8) * PAR(281)**2
      STHM  = RGBL(8) * PAR(282)**2
      VMAX  = 0.0
      VMEAN = 0.0
      IF (LOOP .GT. 1) THEN
        CT(1) = MIN (0.08, MAX (0.03, RP(2)))
      ELSE
        CT(1) = 0.05
      END IF
      L = 1
      DO I = 1, NAT
        IN(I) = NINT(CON(I, NP4 - 1))
        DO J = 1, 3
          CT(L + J) = CON(I, J + 2)
        END DO
        CT(L + 4) = CON(I, NP4)
        CT(L + 5) = CT(1)
        L         = L + 5
      END DO
      WRITE (IDM, 99999, IOSTAT = IOST)
      WRITE (LU6, 99997, IOSTAT = IOST) IDM
      IF (IWIN .EQ. 1) THEN
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, IDM, 80, 0.3, 5 + IGBL(68), 2, 0.2, VRT)
      END IF
      NC    = 0
      NISO  = 0
      DO
        NC    = NC + 1
        IF (NC .GT. 1) NISO = 1
        R  = 0.0
        NN = NISO + NAT
        K  = 1
        DO I = 1, NAT
          IF (NV .EQ. 0) THEN
            CON(I, NP4) = CT(K + 4)
            RP(2)       = CT(1)
          END IF
          K = K + 5
          CT(K) = CT(1)
        END DO
        IF (NV .LT. 0) THEN
          GO TO 20
        ELSE IF (NV .GT. 0) THEN
          I = ((NN * (NN + 3)) / 2) + 10
          CALL GEN074 (B, 1, I, 0.0)
        END IF
        NR = 0
        CALL GEN074 (A,  1, MP6, 0.0)
        CALL GEN074 (E,  1, MP6, 0.0)
        CALL GEN074 (D1, 1, MP5, 0.0)
        CALL GEN074 (D2, 1, MP5, 0.0)
        CR1 = 0.0
        CR2 = 0.0
        CR3 = 0.0
        CR4 = 0.0
        XVL = 100.0 * (PAR(17)**2) / RGBL(8)
        DO
          READ (LU19) F
          DO I = 1, 79, 6
            IF (NINT(F(I)) .EQ. 0) GO TO 10
            IF (F(I + 3) .LE. STHM) THEN
              NR = NR + 1
              V  = XVL * F(I + 3)
              U  = MOD (V, 2.0)
              M  = INT (V - U) - 100
              U  = 0.5 * U
              DO K = 1, IAN
                M = M + 101
                ENB(K) = SFC(M) + U * (SFC(M + 2)
     1                 - SFC(M) + SFC(M + 1) - U * SFC(M + 1))
              END DO
              CALL GEN046 (F(I), XJX(1), XJX(2), XJX(3))
              U = 0.0
              V = 0.0
              J = 1
              DO K = 1, NAT
                J    = J + 5
                E(K) = EXP( - CT(J) * F(I + 3)) * ENB(IN(K)) * LATTS
              END DO
              DO NSM = 1, NSYMH
                XJX(4) = 0.0
                CALL SGSM (LINE, NSM, XJX, LU6, 5, IERR)
                XJX10 = XJX(10) / 360.0
                K  = 1
                N  = 0
                DO NI = 1, NAT
                  W  = CT(K + 4)
                  R  = E(NI) * W
                  S  = TPI * (CT(K + 1) * XJX(7) + CT(K + 2) * XJX(8)
     1               + CT(K + 3) * XJX(9) + XJX10)
                  P  = R * COS(S)
                  R  = R * SIN(S)
                  U  = U + P
                  V  = V + R * CENT
                  K  = K + 5
                  IF (NV .GT. 0) THEN
                    IF (F(I + 3) .GT. STHMN) THEN
                      E5    = 1.0 / MAX (W, 0.0001)
                      N     = N + 1
                      D1(N) = D1(N) + E5 * P
                      D2(N) = D2(N) + E5 * R
                      N     = N + 1
                      D1(N) = D1(N) - F(I + 3) * P
                      D2(N) = D2(N) - F(I + 3) * R
                    END IF
                  END IF
                END DO
              END DO
              F(I + 4) = U
              F(I + 5) = V
              FCK    = U ** 2 + V ** 2
              FC     = SQRT(FCK)
              FO     = F(I + 1)
              FOK    = FO ** 2
              DELTA  = FO - FC
              DELTA2 = FOK - FCK
              W      = 1.0 / (F(I + 2) * (4.0 * FOK)
     1               + (0.01 * FOK) ** 2)
              CR3    = CR3 + W * DELTA2**2
              CR4    = CR4 + W * FOK**2
              W      = SQRT(W)
              CR1    = CR1 + ABS(DELTA)
              CR2    = CR2 + FO
              IF (NV .GT. 0) THEN
                IF (F(I + 3) .GT. STHMN) THEN
                  Y = DELTA2
                  Q = W
                  CALL GEN074 (E, 1, NN, 0.0)
                  U = U * Q
                  V = V * Q
                  DO J = 2, N, 2
                    K = J / 2 + NISO
                    E(K) = E(K) + 2 * (U * D1(J - 1) + V * D2(J - 1))
                    IF (NISO .EQ. 1) THEN
                      E(1) = E(1) + 2 * (U * D1(J) + V * D2(J))
                    END IF
                    D1(J - 1) = 0.0
                    D2(J - 1) = 0.0
                    D1(J)     = 0.0
                    D2(J)     = 0.0
                  END DO
                  W = W * Y
                  M = NN + 1
                  DO N = 1, NN
                    Y = E(N)
                    L = M
                    M = L + NN - N + 1
                    IF (Y .NE. 0.0) THEN
                      A(N) = W * Y + A(N)
                      B(N) = B(N) + Y ** 2
                      DO K = N, NN
                        B(L) = Y * E(K) + B(L)
                        L    = L + 1
                      END DO
                    END IF
                  END DO
                END IF
              END IF
            END IF
          END DO
          WRITE (LU4) F
        END DO
   10   R = CR3 / FLOAT (NR - NN)
        WRITE (LU4) F
        CALL GEN108 (LU4, 1)
        CALL GEN108 (LU19, 0)
        U   = CR1 / CR2
        W   = SQRT(CR3 / CR4)
        RNC = LOOP + FLOAT (NC) / 10.0
        WRITE (IDM, 99998, IOSTAT = IOST)
     1    RNC, U, W, NR, NN, VMEAN, VMAX, CT(1)
        WRITE (LU6, 99995, IOSTAT = IOST) IDM
        IF (IWIN .EQ. 1) THEN
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, IDM, 80, 0.3, 1, 2, 0.2, VRT)
          CALL GGIP (0.0, 0.0, 0.0, 6)
        END IF
        IF (NV .EQ. 0) THEN
          OPEN (LU65, FILE = NAMEFIL(1:KNMFIL)//'_log',
     1          STATUS = 'UNKNOWN')
          WRITE (LU65, 99996, IOSTAT = IOST) U, W, NR, NN
          CLOSE (UNIT = LU65)
        END IF
        NV = NV - 1
        IF (NV .GE. 0) THEN
          CALL GEN012 (B, A, NN, 0.0, 0.0, R)
          IF (NISO .EQ. 1) CT(1) = MAX (CT(1) + B(1), 0.02)
          VMAX  = 0.0
          VMEAN = 0.0
          K     = 0
          DO N = 1 + NISO, NN
            K     = K + 5
            CT(K) = CT(K) + B(N)
            V     = B(N)  / A(N)
            VMEAN = VMEAN + ABS(V)
            VMAX  = MAX (VMAX, ABS(V))
          END DO
          IF (NN .GT. 0) VMEAN = VMEAN / NN
          IF (VMEAN .LT. PAR(283)) NV = 0
        END IF
      END DO
   20 RETURN
99999 FORMAT ('Cyc      R    wR2  Nref Npar',
     1        1X, 'Mean(s/u) Max(s/u) U(iso)')
99998 FORMAT (F3.1, 2F7.3, I6, I5, F8.4, F9.4, F7.2)
99997 FORMAT (/, A, /)
99996 FORMAT (':: RVAL=', 2F10.3, 2I10)
99995 FORMAT (A)
      END SUBROUTINE PLA151
      SUBROUTINE PLA152 (MODE, NPK)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,MP3=1000,MP1=NVD+2*NP23-1700-87*MP3)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /COM3/ NGRID, STHM, ITOP
      COMMON // SFC(1616), F(84), PEAK(MP3, 46), ICON(MP3, 40),
     1 NCON(MP3), VOID(MP1)
      DO 10 I = 1, 3
        DO J = 4, 8
          IPR(I + 394) = 2**J
          IF (PAR(I + 100) * 3.0 .LT. IPR(I + 394)) GO TO 10
        END DO
   10 CONTINUE
      M1    = IPR(395)
      M2    = IPR(396)
      M3    = IPR(397)
      NGRID = M1 * M2 * M3
      ITOP  = NGRID * 2
      ITOP2 = ITOP + 3 * (M1 + 2) * (M2 + 2)
      IF (ITOP2 .GT. MP1) THEN
        IPR(2) = 49
      ELSE
        CALL PLA153 (MODE, VOID(1), VOID(ITOP + 1), NPK)
      END IF
      RETURN
      END SUBROUTINE PLA152
      SUBROUTINE PLA153 (MODE, FFT, R3D, NPK)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /COM3/ NGRID, STHM, ITOP
      DIMENSION F(84), FFT(*), R3D(*)
      CHARACTER LINE*80
      ACAL  = 0.0
      BCAL  = 0.0
      FCAL  = 0.0
      PCAL  = 0.0
      NSYMH = IPR(255)
      IF (MODE .EQ. 0) THEN
        LU  = LU19
        ISW = -5
      ELSE
        LU  = LU4
        ISW = 5
      END IF
      CALL GEN108 (LU, 0)
      M1    = IPR(395)
      M2    = IPR(396)
      M3    = IPR(397)
      FS000 = 0.0
      CALL GEN074 (FFT, 1, ITOP, 0.0)
      FFT(1) = FS000
      DO
        READ (LU) F
        DO 10 I = 1, 79, 6
          IF (NINT(F(I)) .EQ. 0) GO TO 20
          CALL GEN046 (F(I), C2, C3, C4)
          IF (MODE .EQ. 0) THEN
            ACAL = F(I + 1) ** 2
            BCAL = 0.0
          ELSE
            IF (F(I + 3) .GT. STHM) GO TO 10
            FC = SQRT(F(I + 4)**2 + F(I + 5)**2) + 1.E-8
            IF (MODE .LT. 0) THEN
              FRAC = F(I + 1) / FC - 1.0
            ELSE
              FRAC = F(I + 1) / FC
            END IF
            AC   = F(I + 4) * FRAC
            BC   = F(I + 5) * FRAC
            FCAL = FRAC * FC
            IF (BC .NE. 0.0 .OR. AC .NE. 0.0) THEN
              PCAL = ATAN2(BC, AC) * RGBL(6)
            ELSE
              PCAL = 0.0
            END IF
          END IF
          DO N = 1, NSYMH
            XJX(1) = C2
            XJX(2) = C3
            XJX(3) = C4
            XJX(4) = PCAL
            CALL SGSM (LINE, N, XJX, LU6, ISW, IERR)
            IHT = NINT(XJX(7))
            IKT = NINT(XJX(8))
            ILT = NINT(XJX(9))
            IF (MODE .NE. 0) THEN
              PHAS = XJX(10) / RGBL(6)
              ACAL = FCAL * COS(PHAS)
              BCAL = FCAL * SIN(PHAS)
            END IF
            ISN = 1
            DO J = 1, 2
              IF (J .EQ. 2) ISN = -1
              IH = ISN * IHT
              IK = ISN * IKT
              IL = ISN * ILT
              IF (IH .LT. 0) IH = IH + M1
              IF (IK .LT. 0) IK = IK + M2
              IF (IL .LT. 0) IL = IL + M3
              LOC = 2 * ((IL * M2 + IK) * M1 + IH + 1)
              FFT(LOC -1) = ACAL
              FFT(LOC)    = BCAL * ISN
            END DO
          END DO
   10   CONTINUE
      END DO
   20 CALL GEN028 (FFT, IPR(395), 3, -1)
      RHOMIN = PAR(268) * PAR(98)
      CALL PLA140 (FFT, R3D, 0, RHOMIN, MODE, NPK, 1, IPR(48))
      RETURN
      END SUBROUTINE PLA153
      SUBROUTINE PLA155 (TNP)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NPP=NVD+2*NP23,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /SHX/ F(126), G(126), LR, LG, LH, LI, LP, LF, LA, LB,
     1 LY, LL, LQ, LE, LV, LX, LD, LZ, LJ, HKLF(11)
      COMMON // A(NPP)
      COMMON /WORDD/ IR
      CHARACTER IH(20)*1, IR*80, KEY*4
      DATA IH /
     1 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '.', '-', '+',
     2 'X', 'Y', 'Z', ',', '=', '/', ' '/
      IGBL(1) = 4
      LR = 1
      LU = LR
      OPEN (LR, FILE = 'shelxs.ins', STATUS = 'OLD',     ERR = 80)
      LH = 3
      LU = LH
      OPEN (LH, FILE = 'shelxs.hkl', STATUS = 'OLD',     ERR = 80)
      LI = 10
      LU = LI
      OPEN (LI, FILE = 'shelxs.lis', STATUS = 'UNKNOWN', ERR = 80)
      LP = 60
      LU = LP
      OPEN (LP, FILE = 'shelxs.res', STATUS = 'UNKNOWN', ERR = 80)
      LA = 2
      LU = LA
      OPEN (LA, STATUS = 'SCRATCH', FORM = 'UNFORMATTED', ERR = 80)
      LB = 4
      LU = LB
      OPEN (LB, STATUS = 'SCRATCH', FORM = 'UNFORMATTED', ERR = 80)
      LF = 8
      LU = LF
      OPEN (LF, STATUS = 'SCRATCH', FORM = 'UNFORMATTED', ERR = 80)
      LG = 9
      LU = LG
      OPEN (LG, STATUS = 'SCRATCH', FORM = 'UNFORMATTED', ERR = 80)
      WRITE (LI, 99998, IOSTAT = IOST)
      CALL GEN074 (F, 121, 123,  1.0)
      CALL GEN074 (F, 124, 126,  0.0)
      CALL GEN074 (A,   1,  76,  0.0)
      CALL GEN074 (A,  33,  35, -2.0)
      CALL GEN074 (A,  36,  38,  2.0)
      A(14) = 1.0
      A(16) = 1.0
      A(19) = 1.0
      A(26) = 1.2
      A(27) = 5.0
      A(28) = 0.005
      A(29) = 0.7
      A(32) = 1.5
      A(39) = TNP
      A(43) = 4.0
      A(52) = 2.0
      A(53) = 1.0
      A(56) = 28.0
      A(58) = 0.5
      A(59) = 1.5
      A(64) = 1.0
      A(65) = 1.0
      A(69) = 1.0
      A(73) = 1.0
      IER   = 0
      LX    = 25
      LL    = 1
      LZ    = 0
      LQ    = 0
      LY    = 65
      LJ    = 0
      NB    = 4
      JR    = 4
      HS    = 0.0
      X     = 0.0
      DO
        READ (LR, 99996) IR
        KEY = IR(1:4)
        CALL GEN039 (1, IR, 4, 80, NB, JR)
        WRITE (LI, 99996, IOSTAT = IOST) IR(1:JR)
        IF (KEY .NE. 'TITL') THEN
          IF (KEY .EQ. 'SYMM') CALL GEN074 (A, LY + 12, LY + 23, 0.0)
          CALL GEN074 (G, 1, 126, 0.0)
          W  = 1.0
          NA = 0
          JD = 0
          NJ = LY + 7
          L  = LY + 21
          N  = 4
   10     V  = 0.0
          NB = 0
          Y  = 1.0
          U  = 10.0
          Z  = 1.0
   20     N  = N + 1
          K  = 10
          IF (N .LE. JR) THEN
            X = 0.0
            DO KK = 1, 19
              IF (IR(N:N) .EQ. IH(KK)) THEN
                IF (KK .LT. 11) THEN
                  Z  = Y * Z
                  V  = U * ABS(V) + Z * X
                  NB = 1
                  IF (V .NE. 0.0) THEN
                    V = SIGN (V, W)
                    W = V
                  END IF
                  GO TO 20
                END IF
                K = KK - 9
                GO TO 30
              END IF
              X = X + 1.0
            END DO
            K = 1
          END IF
   30     IF (KEY .NE. 'SYMM') THEN
            IF (K  .EQ. 2) THEN
              U = 1.0
              Y = 0.1
              GO TO 20
            ENDIF
            IF (NB .EQ. 0) THEN
              IF (K .EQ. 1) K = 6
              IF (IABS(K - 6) .GT. 1)  GO TO 40
              IF (IR(N:N) .EQ. IH(20)) GO TO 40
              JD = JD + 1
              DO K = 1, 4
                IF (N .GT. JR) GO TO 60
                IF (IR(N:N) .EQ. IH(17)) THEN
                  W = 1.0
                  GO TO 10
                ENDIF
                IF (IR(N:N) .EQ. IH(18)) THEN
                  WRITE (LP, 99996, IOSTAT = IOST) IR(1: JR)
                  GO TO 50
                END IF
                IF (IR(N:N) .EQ. IH(19)) GO TO 60
                IF (IR(N:N) .EQ. IH(20)) THEN
                  W = 1.0
                  GO TO 10
                ENDIF
                N = N + 1
              END DO
              W = 1.0
              GO TO 10
            END IF
            NA    = NA + 1
            G(NA) = V
   40       IF (K .LT. 9) THEN
              IF (K .NE. 3) THEN
                W =  1.0
              ELSE
                W = -1.0
              ENDIF
              GO TO 10
            ELSE IF (K .EQ. 9) THEN
              WRITE (LP, 99996, IOSTAT = IOST) IR(1: JR)
              GO TO 50
            ELSE
              GO TO 60
            END IF
          ELSE
            SELECT CASE (K)
              CASE (1)
                GO TO 20
              CASE (2)
                U = 1.0
                Y = 0.1
                GO TO 20
              CASE (3)
                A(L) = AINT(24.5 * V) / 24.0
                W = -1.0
                GO TO 10
              CASE (4)
                A(L) = AINT(24.5 * V) / 24.0
                W = 1.0
                GO TO 10
              CASE (5, 6, 7)
                K    = K + NJ
                A(K) = W
                W    = 1.0
                GO TO 10
              CASE (8, 10)
                A(L) = A(L) + AINT(24.5 * V) / 24.0
                L  = L + 1
                NJ = NJ + 3
                IF (NJ + 8 .LT. L) THEN
                  W = 1.0
                  GO TO 10
                END IF
                LY = LY + 12
                GO TO 70
              CASE (9)
                GO TO 50
            END SELECT
            U = 1.0
            Y = 0.1
            GO TO 20
          END IF
   50     READ (LR, 99996) IR
          NB = 4
          JR = 4
          CALL GEN039 (1, IR, 4, 80, NB, JR)
          WRITE (LI, 99996, IOSTAT = IOST) IR(1: JR)
          N = 4
          W = 1.0
          GO TO 10
   60     IF (KEY .EQ. 'CELL') THEN
            DO J = 1, 7
              A(J) = G(J)
            END DO
            U = 2.0 * A(2) * A(3) * A(4)
            DO J = 2, 4
              X        = A(J + 3) / RGBL(6)
              G(J)     = COS(X)
              G(J + 3) = SIN(X)
              A(J + 9) = U * G(J) / A(J)
              A(J + 6) = A(J) * A(J)
            END DO
            X     = (G(2) * G(3) - G(4)) / (G(5) * G(6))
            Y     = SQRT(ABS(1.0 - X * X))
            A(46) = 1.0 / (A(2) * G(6) * Y)
            A(48) = 1.0 / (A(3) * G(5))
            A(47) = X * A(48) / Y
            A(49) = (-G(6) * G(2) * X - G(5) * G(3)) /
     1              (A(4) * G(5) * G(6) * Y)
            A(51) = 1.0 / A(4)
            A(50) = -G(2) * A(51) / G(5)
            A(60) = 1.0 / (A(46) * A(48) * A(51))
          ELSE IF (KEY .EQ. 'LATT') THEN
            IF (G(1) .LT. 0.0) A(23) = 1.0
            LL = NINT(ABS(G(1)))
          ELSE IF (KEY .EQ. 'SFAC')  THEN
            IF (LL .LE. 65) THEN
              N = 3 * LL
              L = INT(4.1 - 2.0 * A(23))
              CALL GEN074 (F, 1, 12, 0.5)
              CALL GEN074 (F, 1,  3, 0.0)
              IF (N .EQ. 12) THEN
                F(4)  = 0.0
                F(8)  = 0.0
                F(12) = 0.0
              ELSE IF (N .EQ. 9) THEN
                F(4) = 0.6666667
                F(5) = 0.3333333
                F(6) = 0.3333333
                F(7) = 0.3333333
                F(8) = 0.6666667
                F(9) = 0.6666667
              ELSE IF (N .GT. 12) THEN
                F(LL - 1) = 0.0
                N         = 4
              END IF
              LL = LY + 8
              DO K = 2, L, 2
                DO J = 1, N, 3
                  LL = LL + 4
                  A(LL)     = 3.0 - FLOAT(K)
                  A(LL + 1) = F(J)     + 99.5
                  A(LL + 2) = F(J + 1) + 99.5
                  A(LL + 3) = F(J + 2) + 99.5
                END DO
              END DO
              LQ   = LL - 1
              F(1) = 1.1
            END IF
            LQ        = LQ + 5
            A(LQ)     = AINT (0.5 + G(1) + G(3) + G(5) + G(7) + G(9))
            A(LQ + 1) = G(13)
            LZ        = LZ + 1
            A(LQ + 3) = G(12)
            A(LQ + 4) = G(14)
          ELSE IF (KEY .EQ. 'UNIT') THEN
            J  = LL + 4
            LE = LQ + 3
            LX = LQ + 5
            U  = 0.0
            V  = 0.0
            P  = 0.0
            Q  = 0.0
            R  = 0.0
            HS = 0.0
            Z  = 0.0
            Y  = 0.0
            DO I = 1, NA
              IF (A(J) .GT. 1.5) Z = Z + G(I)
              W = A(J) * G(I)
              P = P + W
              Q = Q + A(J + 4) * G(I)
              A(J + 4) = G(I)
              R = R + A(J + 3) * G(I)
              HS = MAX (HS, A(J) * A(J))
              U = U + W * A(J)
              V = V + W * A(J) * A(J)
              Y = Y + W * SQRT(A(J))
              J = J + 5
            END DO
            T  = Q * 1.66052 / A(60)
            Z  = A(60) / Z
            X  = FLOAT(LL - LY - 8)
            WRITE (LI, 99995, IOSTAT = IOST) A(60), Z, P, Q, T
            A(24) = SQRT(0.25 * X / U)
            T     = (2.0 - A(23)) / X
            A(45) = V / (U * SQRT(T * U))
            Y     = Y**2 / (T * P**3)
            X     = 15.0 * (250.0 + A(60) / X) / FLOAT(LY - 53)
            FF    = AINT (MIN (X, 150.0 + 0.5 * X, 300.0 + 0.25 * X))
            A(44) = - MIN (20.0 + ABS(FF) * 0.5, 160.1 + 40.0 * A(23))
            A(40) = FF
            L     = 0
            M     = 0
            N     = 0
            T     = 30.0
            DO K = 65, LY, 12
              IF (A(K)     .LT. - 0.5) L = 1
              IF (A(K + 4) .LT. - 0.5) M = 1
              IF (A(K + 8) .LT. - 0.5) N = 1
              IF (ABS(A(K + 9)) + ABS(A(K + 10))
     1                          + ABS(A(K + 11)) .GT. 0.1) T = 20.0
            END DO
            A(42) = MAX (-1.1 + 0.3 * A(23),
     1              MIN (-0.2, -T * Y * (2.0 - A(23))))
            IF (T .LE. 25.0) THEN
              IF (A(23) .LT. 0.5) L = 3
              IF (L + M + N .GT. 2) A(44) = ABS(A(44))
            END IF
          ELSE IF (KEY .EQ. 'OMIT') THEN
            IF (NA .EQ. 3) THEN
              IF (F(1) .GT. 119.5) THEN
                WRITE (6, 99997, IOSTAT = IOST)
                GO TO 90
              END IF
              F(1) = F(1) + 1.0
              I    = INT(F(1))
              F(I) = G(1) + 200.0 * (G(2) + 200.0 * G(3))
            ELSE
              A(52) = 0.5 * ABS(G(1))
              IF (NA .EQ. 2) A(53) = (SIN(8.726646E-3 * G(2)))**2
            END IF
          ELSE IF (KEY .EQ. 'HKLF')  THEN
            A(41) = -4.0 -3.0 * A(23)
            IF (ABS(A(41)) .LT. 0.99) THEN
              WRITE (6, 99997, IOSTAT = IOST)
              GO TO 90
            END IF
            A(41) = SIGN (AINT (ABS (A(41))) + 0.1, A(41))
            A(60) = ABS(A(60))
            CLOSE (UNIT = LR, STATUS = 'KEEP')
            IF (G(2) .EQ. 0.0) THEN
              G(2)  = 1.0
              G(3)  = 1.0
              G(7)  = 1.0
              G(11) = 1.0
            END IF
            DO  I = 1, 11
              HKLF(I) = G(I)
            END DO
            A(54) = 7.0
            IF (HS .GT. 290.0) A(54) = 4.0
            U = 195.0
            IF (A(20) .LT. -8.E9) U = 45.0
            U     = 0.28 * (2.0 - A(23)) * A(60) / FLOAT(LL - LY - 8)
            U     = U * 12.0 / (FLOAT(LY - 53) * (2.0 - A(23)))
            A(57) = 5.0 + AINT(U)
            LV    = LE - 6
            LX    = LX - 8
            WRITE (LG) F
            CALL GEN108 (LG, 0)
            U = 2.0 * A(2) * A(3) * A(4)
            DO J = 2, 4
              F(J) = U * COS(1.74533E-2 * A(J + 3)) / A(J)
              F(J + 3) = F(J) * F(J)
            END DO
            V = U * U
            U = 0.5 * A(1) * A(1) / (V - A(8) * F(5) - A(9) * F(6)
     1                         - A(10) * F(7)+ F(2) * F(3) * F(4))
            DO J = 8, 10
              A(J + 6) = 0.5 * U * ((V / A(J)) - F(J - 3))
              A(J + 9) = -2.0 * U * A(J) * A(J + 3)
            END DO
            A(17) = A(17) + U * A(12) * A(13)
            A(18) = A(18) + U * A(11) * A(13)
            A(19) = A(19) + U * A(11) * A(12)
            LD = LX
            CALL PLA156 (IER)
            IF (IER .NE. 0) THEN
              WRITE (6, 99997, IOSTAT = IOST)
            ELSE
              CALL PLA157 (IER)
              IF (IER .NE. 0) THEN
                WRITE (6, 99997, IOSTAT = IOST)
              ELSE
                CALL PLA158
                CALL PLA159
              END IF
            END IF
            GO TO 90
          ELSE
            CYCLE
          ENDIF
        END IF
   70   WRITE (LP, 99996, IOSTAT = IOST) IR(1:JR)
      END DO
   80 WRITE (6, 99999, IOSTAT = IOST) LU
   90 CLOSE (UNIT = LP)
      CLOSE (UNIT = LI)
      CLOSE (UNIT = LA)
      CLOSE (UNIT = LB)
      CLOSE (UNIT = LF)
      CLOSE (UNIT = LG)
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, ':: Cannot OPEN File Number', I5, /)
99998 FORMAT (
     1 'Crystal Structure Solution - Stripped Version of SHELXS-86', /)
99997 FORMAT (':: Problem in SHX86')
99996 FORMAT (A)
99995 FORMAT (/, 'V =', F10.2, 5X, 'At Vol =', F6.1, 5X, 'F(000) =',
     1 F8.1, //, '    Cell Wt =', F10.2, '    Rho =', F7.3, /)
      END SUBROUTINE PLA155
      SUBROUTINE PLA156 (IER)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NPP=NVD+2*NP23,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /SHX/ F(126), G(126), LR, LG, LH, LI, LP, LF, LA, LB,
     1 LY, LL, LQ, LE, LV, LX, LD, LZ, LJ, HKLF(11)
      COMMON // A(NPP)
      DIMENSION E(87), RS(13), SO(14), SU(14), IP(20), AA(4)
      DATA RS /5.0, 3.5, 2.5, 2.0, 1.7, 1.5, 1.4, 1.3, 1.2, 1.1,
     1         1.0, 0.9, 0.8/
      LZ = LX + 7
      CALL GEN074 (SO, 1, 14, 0.0)
      CALL GEN074 (SU, 1, 14, 0.0)
      ML = LY + 12
      DO I = ML, LL, 4
        DO J = 1, 3
          A(I + J) = A(I + J) - 99.5
        END DO
      END DO
      CALL GEN074 (A, 61, 64, 0.0)
      CALL GEN074 (E, 52, 87, 0.0)
      SB = 1.0
      N  = 1
      NR = 0
      ND = 0
      NU = 0
      NX = 0
      M  = IABS(INT(G(1))) + 1
      G(1) = 0.5
      NERROR = -1
   10 NERROR = NERROR + 1
      IF (NERROR .LE. 100) THEN
        DO
          READ (LH, 99999, ERR = 10, END = 80) J, K, L, T, S
          T = T * G(2)
          S = S * G(2)
          IF (S .LT. 1.E-4) S = 0.1
          IF (T .LT. 0.5 * S) T = MIN (0.25 * S, 0.5 * SB)
          SB = 0.8 * SB + 0.2 * S
          IF (IABS(J) + IABS(K) + IABS(L) .EQ. 0) GO TO 80
          X        = FLOAT(J)
          Y        = FLOAT(K)
          Z        = FLOAT(L)
          F(N + 1) = T
          F(N + 2) = S
          IF (T .LT. 1.E-6) GO TO 60
          U = X * G(3) + Y * G(4)  + Z * G(5)
          V = X * G(6) + Y * G(7)  + Z * G(8)
          W = X * G(9) + Y * G(10) + Z * G(11)
          IF (ABS(AMOD(U + 999.5, 1.0) - 0.5)
     1      + ABS(AMOD(V + 999.5, 1.0) - 0.5)
     2      + ABS(AMOD(W + 999.5, 1.0) - 0.5) .GT. 0.01) GO TO 40
          J = ML
   20     J = J + 4
          IF (J .LE. LL) THEN
            IF (ABS(AMOD(U * A(J + 1) + V * A(J + 2) +
     1          W * A(J + 3) + 999.5, 1.0) - 0.5) .LT. 0.01) THEN
              GO TO 20
            ELSE
              GO TO 40
            END IF
          END IF
          F(N) = 0.0
          DO K = 65, LY, 12
            X = U * A(K)     + V * A(K + 3) + W * A(K + 6)
            Y = U * A(K + 1) + V * A(K + 4) + W * A(K + 7)
            Z = U * A(K + 2) + V * A(K + 5) + W * A(K + 8)
            IF (MAX(ABS(X), ABS(Y), ABS(Z)) .GT. 99.5) GO TO 60
            X = AINT(1.001 * X)
            Y = AINT(1.001 * Y)
            Z = AINT(1.001 * Z)
            F(N)  = MAX (F(N), ABS(X + 200.0 * (Y + 200.0 * Z)))
            A(61) = MAX (A(61), ABS(X))
            A(62) = MAX (A(62), ABS(Y))
            A(63) = MAX (A(63), ABS(Z))
          END DO
          CALL GEN046 (F(N), X, Y, Z)
          IF (E(52) .GT. X) E(52) = X
          IF (E(53) .LT. X) E(53) = X
          IF (E(54) .GT. Y) E(54) = Y
          IF (E(55) .LT. Y) E(55) = Y
          IF (E(56) .GT. Z) E(56) = Z
          IF (E(57) .LT. Z) E(57) = Z
          K = 65
   30     K = K + 12
          IF (K .LE. LY) THEN
            Q = AINT(1.001 * (X * A(K) + Y * A(K + 3) + Z * A(K + 6))) +
     1          200.0 * (AINT(1.001 * (X * A(K + 1) + Y * A(K + 4) +
     2          Z * A(K + 7))) + 200.0 * AINT(1.001 * (X * A(K + 2) +
     3          Y * A(K + 5) + Z * A(K + 8))))
            IF (A(23) .LT. 0.5) Q = ABS(Q)
            IF (Q + 0.5 .LT. F(N)) GO TO 30
            IF (ABS(AMOD(0.5 + ABS(X * A(K + 9) + Y * A(K + 10) +
     1          Z * A(K + 11)), 1.0) - 0.5) - 0.01 .LT. 0.0) THEN
              GO TO 30
            ELSE
              GO TO 40
            END IF
          END IF
          Q = X * X * A(14) + Y * Y * A(15) + Z * Z * A(16) +
     1        Y * Z * A(17) + X * Z * A(18) + X * Y * A(19)
          IF (Q .GT. A(64)) A(64) = Q
          IF (Q .GE. 1.0) GO TO 50
          N = N + 3
          IF (N .GE. 126) THEN
            WRITE (LA) F
            N = 1
          END IF
          GO TO 70
   40     IF (F(N + 1) .LT. A(52) * F(N + 2)) GO TO 60
   50     NU = NU + 1
   60     NR = NR + 1
   70     ND = ND + 1
        END DO
      ELSE
        IER = 1
        RETURN
      END IF
   80 F(N) = 0.0
      WRITE (LA) F
      CALL GEN108 (LA, 0)
      CLOSE (UNIT = LH, STATUS = 'KEEP')
      IF (A(64) .GT. 1.0) A(64) = 1.0
      X = 2.0 * RGBL(6) * ATAN2(SQRT(A(64)), SQRT(1.0 - A(64)))
      WRITE (LI, 99998, IOSTAT = IOST) ND, NR, A(61), A(62), A(63), X
      IF (A(20) .LT. - 8.E9) A(22) = MIN (A(22) * A(22), A(64))
      NU = 0
      NR = 0
      L  = 1
      QH = E(53) - E(52) + 1.0
      QK = E(55) - E(54) + 1.0
      QL = FLOAT(LX) + 7.3
      QC = QL + 0.8 - E(52) - QH * (E(54) - QK * E(56))
      RA = 0.0
      RB = 0.0001
      RC = 0.0
      RD = 0.0001
   90 QM = FLOAT(NPP) + 0.3
      JF = 0
      N  = INT(MIN(QC + E(53) + QH * (E(55) + QK * E(57)), QM))
      NF = 0
      M  = LX + 8
  100 CALL GEN074 (A, M, N, 0.0)
      IF (LZ .LT. N) LZ = N
  110 READ (LA) F
      I = - 2
  120 I = I + 3
      IF (I .GT. 126) GO TO 110
      IF (F(I) .GE. 0.5) THEN
        CALL GEN046 (F(I), X, Y, Z)
        Q = QC + QH * (Y + QK * Z) + X
        IF (Q .GE. QL) THEN
          IF (Q .LE. QM) THEN
            J = INT(Q)
            IF (NF .EQ. 0) THEN
              A(J) = 1.0
            ELSE IF (NF .EQ. 1) THEN
              K        = INT(A(J))
              W        = MAX (F(I + 1) / F(I + 2), 3.0) / F(I + 2)
              A(K)     = F(I)
              A(K + 1) = A(K + 1) + W
              A(K + 2) = A(K + 2) + W * F(I + 1)
              A(K + 3) = A(K + 3) + 1.0
              A(K + 4) = A(K + 4) + F(I + 1)
            ELSE
              K        = INT(A(J))
              A(K + 1) = A(K + 1) + ABS(F(I + 1) - A(K + 2))
              A(K + 4) = A(K + 4) + 1.0 / F(I + 2)**2
            END IF
          END IF
        END IF
        GO TO 120
      END IF
      CALL GEN108 (LA, 0)
      IF (NF .EQ. 0) THEN
        NF = 1
        Q  = 0.3
        DO I = M, N
          IF (A(I) .GE. 0.5) THEN
            A(I) = Q
            Q    = Q + 5.0
            IF (I + INT(Q) .GT. NPP) GO TO 130
            K = I
          END IF
        END DO
        JF = 1
        Q  = Q + 5.0
        K  = N
  130   I  = K
        QM = FLOAT(I) + 1.0
        DO J = M, I
          A(J) = A(J) + QM
        END DO
        M  = I + 1
        QM = QM - 0.7
        N  = I + INT(Q - 5.0)
        GO TO 100
      END IF
      I  = M - 5
      IF (NF .LT. 2) THEN
        DO
          I = I + 5
          IF (I .GT. N) THEN
            NF = 2
            GO TO 110
          END IF
          A(I + 2) = A(I + 2) / A(I + 1)
          A(I + 1) = 0.0
          IF (A(I + 3) .GT. 1.5) RB = RB + A(I + 4)
          A(I + 4) = 0.0
        END DO
      END IF
      READ (LG) F
      CALL GEN108 (LG, 0)
      JU = INT(F(1))
  150 I  = I + 5
      IF (I .LE. N) THEN
        NR = NR + 1
        G(L) = A(I)
        V    = A(I + 2)
        G(L + 1) = SQRT(MAX (1.E-8, V))
        W = 1.0 / SQRT(A(I + 4))
        CALL GEN046 (G(L), X, Y, Z)
        J  = INT(X)
        K  = INT(Y)
        NI = INT(Z)
        IF (A(I + 3) .GE. 1.5) THEN
          RA = RA + A(I + 1)
          P  = A(I + 1) / (A(I + 3) * SQRT(A(I + 3) - 1.0))
          IF (P .GE. 5.0 * W) THEN
            NX = NX + 1
          END IF
          W = MAX (P, W)
        END IF
        P = 0.0
        T = 0.0
        DO K = 65, LY, 12
          Q = AINT(1.001 * (X * A(K) + Y * A(K + 3) + Z * A(K + 6))) +
     1    200.0 * (AINT(1.001 * (X * A(K + 1) + Y * A(K + 4)
     2    + Z * A(K + 7))) + 200.0 * AINT(1.001 * (X * A(K + 2)
     3    + Y * A(K + 5) + Z * A(K + 8))))
          S = SIGN (1.0, Q) * (X * A(K + 9) + Y * A(K + 10)
     1      + Z * A(K + 11))
          IF (A(23) .LT. 0.5) Q = ABS(Q)
          IF (Q + 0.5 .GE. G(L)) P = P + 1.0
          IF (0.5 - Q .GE. G(L))
     1      T = 10.0 * AINT(12.0 * AMOD(400.01 - S, 1.0) + 12.0)
        END DO
        Q = X * X * A(14) + Y * Y * A(15) + Z * Z * A(16)
     1    + Y * Z * A(17) + X * Z * A(18) + X * Y * A(19)
        G(L + 2) = Q + AINT(AMOD(X + 998.01, 2.0) +
     1   AMOD(Y + 998.01, 2.0) * 2.0 + AMOD(Z + 998.01, 2.0) * 4.0)
        G(L + 3) = T + (1.0 / P)
        J = 58 + INT(MIN(14.1, 33.3333 * Q / (A(1) * A(1))))
        E(J) = E(J) + 1.0
        E(J + 15) = E(J + 15) + V / P
        S = 0.5 * A(1) / SQRT(Q)
        K = 13
  160   IF (RS(K) .LE. S) THEN
          K = K - 1
          IF (K .GT. 0) GO TO 160
        END IF
        K = K + 1
        SU(K) = SU(K) + 1.0
        IF (Q .LE. A(53)) THEN
          J = 1
  170     J = J + 1
          IF (JU .GE. J) THEN
            IF (ABS(G(L) - F(J)) .GE. 0.5) GO TO 170
          ELSE
            IF (V .GT. W * A(52)) GO TO 180
          END IF
        END IF
        G(L + 1) = - G(L + 1)
        SO(K) = SO(K) + 1.0
        NU = NU + 1
  180   RC = RC + W
        RD = RD + V
        L  = L  + 4
        IF (L .GE. 124) THEN
          WRITE (LB) G
          L = 1
        END IF
        GO TO 150
      END IF
      QC = QC - QM + QL
      IF (JF .EQ. 0) GO TO 90
      G(L) = 0.0
      WRITE (LB) G
      CALL GEN108 (LB, 0)
      NU = NR - NU
      RA = RA / RB
      RC = RC / RD
      WRITE (LI, 99991, IOSTAT = IOST) NR, NU, RA, RC
      I = 0
      X = 0.0
      NQ = 1
      DO I = 1, 13
        IF (SU(I) .GT. 0.5) NQ = I
      END DO
      DO I = 2, 4
        X        = AINT(A(I) / RS(NQ))
        J        = I + I + 18
        G(J - 1) = - X
        G(J)     = X + 0.5
      END DO
      DO I = 1, NQ
        P = 0.5 * A(1) / RS(I)
        G(I + 30) = P * P
        G(I + 50) =
     1    2.0 * RGBL(6) * ATAN2(P, SQRT(MAX (0.0, 1.0 - G(I + 30))))
        SO(I) = SU(I) - SO(I)
        G(I) = 0.0
      END DO
      G(14) = 0.0
      Z     = 0.0
      IF (LY .NE. 77) THEN
        IF (LY .LT. 90) THEN
          GO TO 210
        ELSE
          GO TO 200
        END IF
      END IF
      IF (A(81) * A(85) .LT. 0.0) GO TO 200
  190 G(21) = 0.0
      GO TO 210
  200 G(23) = 0.0
      IF (LY .EQ. 101) THEN
        IF (ABS(A(78)) + ABS(A(90)) .LT. 0.1) GO TO 190
      END IF
  210 Y = G(23)
  220 X = G(21)
  230 J = ML
  240 J = J + 4
      IF (J .LE. LL) THEN
        IF (ABS(AMOD(X * A(J + 1) + Y * A(J + 2) + Z * A(J + 3)
     1     + 999.5, 1.0) - 0.5) - 0.01 .LT. 0.0) THEN
          GO TO 240
        ELSE
          GO TO 270
        END IF
      END IF
      W = X + 200.0 * (Y + 200.0 * Z) + 0.5
      K = 65
  250 K = K + 12
      IF (K .LE. LY) THEN
        Q = AINT(1.001 * (X * A(K) + Y * A(K + 3) + Z * A(K + 6)))
     1    + 200.0 * (AINT(1.001 * (X * A(K + 1) + Y * A(K + 4)
     2    + Z * A(K + 7))) + 200.0 * AINT(1.001 * (X * A(K + 2)
     3    + Y * A(K + 5) + Z * A(K + 8))))
        IF (ABS(Q) .GT. W) GO TO 270
        IF (A(23) .LT. 0.5) Q = ABS(Q)
        IF (Q + 1.0 .LT. W) GO TO 250
        IF (ABS(AMOD(0.5 + ABS(X * A(K + 9) + Y * A(K + 10)
     1    + Z * A(K + 11)), 1.0) - 0.5) -  0.01 .LT. 0.0) THEN
          GO TO 250
        ELSE
          GO TO 270
        END IF
      END IF
      Q = X * X * A(14) + Y * Y * A(15) + Z * Z * A(16)
     1  + Y * Z * A(17) + X * Z * A(18) + X * Y * A(19)
      IF (Q .GE. 0.0001) THEN
        K = 30 + NQ
  260   IF (G(K) .GE. Q) THEN
          K = K - 1
          IF (K .GT. 30) GO TO 260
        END IF
        K = K - 29
        G(K) = G(K) + 1.0
      END IF
  270 X = X + 1.0
      IF (X .LT. G(22)) GO TO 230
      Y = Y + 1.0
      IF (Y .LT. G(24)) GO TO 220
      Z = Z + 1.0
      IF (Z .LT. G(26)) GO TO 210
      WRITE (LI, 99990, IOSTAT = IOST) (RS(I),     I = 1, NQ)
      WRITE (LI, 99989, IOSTAT = IOST) (SO(I),     I = 1, NQ)
      WRITE (LI, 99988, IOSTAT = IOST) (SU(I),     I = 1, NQ)
      WRITE (LI, 99987, IOSTAT = IOST) (G(I),      I = 1, NQ)
      WRITE (LI, 99986, IOSTAT = IOST) (G(I + 50), I = 1, NQ)
      CALL GEN074 (G, 1, 5, 0.0)
      Q = 0.015
      DO I = 58, 72
        IF (E(I) .GE. 9.5) THEN
          P    = ALOG(E(I + 15) / E(I))
          G(1) = G(1) + 1.0
          G(2) = G(2) + Q
          G(3) = G(3) + Q * Q
          G(4) = G(4) + P
          G(5) = G(5) + P * Q
        END IF
        Q = Q + 0.03
      END DO
      P = 20.0
      IF (G(1) .GE. 0.5) THEN
        Q = G(1) * G(3) - G(2) * G(2)
        IF (Q .GE. 1.E-6) P = (G(2) * G(4) - G(1) * G(5)) / Q
      END IF
      P = P / (A(1) * A(1))
      T  = 10.0 / (A(64) + 0.001)
      NR = 1
      ND = LX + 39
      LH = ND
      I  = INT(A(29) * 0.1)
      IF (I .GT. 0) LH = LH + 2 * INT(1.5 + A(I + 60))
      LD = LH - 2
      W = 1.0 / (A(27) * A(27))
      W = W * W
      U = RGBL(8) * A(28) / (A(1) * A(1))
      DO 320 M = 1, 4
        IF (M .EQ. 1) CALL GEN074 (G, 1, 38, 0.0)
        IF (M .EQ. 2) THEN
          J = LX + 27
          DO K = J, LH, 2
            A(K)     = 0.0
            A(K + 1) = 0.0
          END DO
          R = 0.0
          Q = 0.0
          DO K = 12, 19
            R = R + G(K)
            Q = Q + G(K + 19)
          END DO
          R = R / MAX (Q, 0.01)
          DO K = 31, 38
            G(K) = G(K) * R
          END DO
          J = LX + 8
          DO K = 1, 19
            A(J) = G(K) / MAX (G(K + 19), 0.01)
            J = J + 1
          END DO
          DO K = 12, 19
            A(J) = AMOD(A(29), 10.0) * (A(J) - 1.0) + 1.0
          END DO
          IF (A(29) .LT. 5.0) GO TO 320
        END IF
        IF (M .EQ. 3) THEN
          IF (A(29) .GE. 5.0) THEN
            DO K = ND, LH, 2
              A(K) = AMOD(A(29), 10.0) * (A(K) / MAX (A(K + 1), 0.01)
     1             - 1.0) + 1.0
            END DO
          END IF
        END IF
        IF (M .EQ. 4) THEN
          J = LX + 27
          L = J + 3
          DO K = J, L
            A(K + 4) = A(K) / MAX (A(K + 4), 0.01)
          END DO
        END IF
        DO
          READ (LB) F
          DO 300 I = 1, 124, 4
            IF (F(I) .LT. 0.5) GO TO 310
            QC = AMOD(F(I + 2), 1.0)
            R  = F(I + 1)**2 * EXP(P * QC) * AMOD(F(I + 3), 10.0)
            Q  = QC * T
            N  = INT(Q)
            Q  = Q - FLOAT(N)
            N  = N + 1
            S  = 1.0 - Q
            L  = INT(12.0 + F(I + 2))
            IF (M .EQ. 1) THEN
              G(L)      = G(L)+ 1.0
              G(L + 19) = G(L + 19) + R
              G(N)      = G(N)      + S
              G(N + 1)  = G(N +  1) + Q
              G(N + 19) = G(N + 19) + R * S
              G(N + 20) = G(N + 20) + R * Q
              GO TO 300
            END IF
            K = N + LX + 7
            L = L + LX + 7
            R = R * A(L) * (A(K) * S + A(K + 1) * Q)
            CALL GEN046 (F(I), XX, YY, ZZ)
            E(1) = ABS(XX)
            E(2) = ABS(YY)
            E(3) = ABS(ZZ)
            IF (A(29) .GE. 5.0) THEN
              J = INT(A(29) * 0.1)
              J = INT(0.5 + 2.0 * E(J)) + LX + 39
              IF (M .EQ. 2) THEN
                A(J)     = A(J)     + 1.0
                A(J + 1) = A(J + 1) + R
                GO TO 300
              END IF
              R = R * A(J)
            END IF
            IF (IABS(N - 5) .LE. 2) THEN
              IF (E(1) .LE. 0.5) THEN
                IF (MIN(E(2), E(3)) .LT. 0.5) GO TO 290
                J = LX + 27
                GO TO 280
              END IF
              IF (E(2) .LE. 0.5) THEN
                IF (E(3) .LT. 0.5) GO TO 290
                J = LX + 28
                GO TO 280
              END IF
              J = LX + 29
              IF (E(3) .GT. 0.5) J = J + 1
  280         IF (M .EQ. 3) THEN
                A(J) = A(J) + 1.0
                A(J + 4) = A(J + 4) + R
                GO TO 290
              END IF
              A(J + 8) = A(J + 8) + ABS(1.0 - R * A(J + 4))
            END IF
  290       IF (M .EQ. 4) THEN
              IF (R .GT. 0.001) R = SQRT(SQRT(1.0 /
     1                           ((1.0 / (R * R)) + W))) * EXP(U * QC)
              G(NR)     = F(I)
              L         = 4
              E(4)      = F(I)
              G(NR + 1) = F(I + 1)
              G(NR + 2) = R
              NR        = NR + 3
              IF (NR .GE. 126) THEN
                WRITE (LA) G
                NR = 1
              END IF
              IF (R .GE. ABS(A(26))) THEN
                IF (F(I + 1) .GE. 0.0) THEN
                  DO K = 4, L
                    LD = LD + 4
                    A(LD) = E(K)
                    IF (LD .GT. NPP - 2000) THEN
                      IER = 1
                      RETURN
                    END IF
                    A(LD + 1) = MIN (R, 9.0)
                    A(LD + 2) = 0.0
                    A(LD + 3) = 1.0
                    IF (A(26) .GT. 0.0) THEN
                      A(LD + 2) = AINT(F(I + 3) * 0.1) * 10.0
                      A(LD + 3) = 1.0 / AMOD(F(I + 3), 10.0)
                    END IF
                  END DO
                END IF
              END IF
            END IF
  300     CONTINUE
        END DO
  310   CALL GEN108 (LB, 0)
  320 CONTINUE
      G(NR) = 0.0
      WRITE (LA) G
      CALL GEN108 (LA, 0)
      NA = LX + 4
      AP = 0.0
      M  = LY + 12
      DO I = M, LL, 4
        A(I + 1) = A(I + 1) + 99.5
        A(I + 2) = A(I + 2) + 99.5
        A(I + 3) = A(I + 3) + 99.5
      END DO
      JJ = IABS(INT(A(54)))
      M  = 0
      K  = 0
      I  = 0
      DO J = 65, LY, 12
        IF (ABS(A(J + 1)) .GT. 0.5) I = 1
        IF (ABS(A(J + 2)) .GT. 0.5) K = 1
        IF (ABS(A(J + 5)) .GT. 0.5) M = 1
      END DO
      J = LX + 27
      IF (I + K + M .EQ. 3) THEN
        DO M = 1, 2
          K = J + 2
          X = A(J) + A(J + 1) + A(K)
          CALL GEN074 (A, J, K, X)
          J = J + 8
        END DO
        GO TO 340
      END IF
      IF (I .NE. 0) THEN
        I = LX + 28
        GO TO 330
      END IF
      IF (K .NE. 0) THEN
        I = LX + 29
        GO TO 330
      END IF
      IF (M .EQ. 0) GO TO 340
      J = LX + 28
      I = LX + 29
  330 M = J + 8
      DO K = J, M, 8
        X    = A(K) + A(I)
        A(K) = X
        A(I) = X
        I    = I + 8
      END DO
  340 J = LX + 27
      DO I = 1, 4
        G(I) = A(J + 8) / MAX (A(J), 0.01)
        J    = J + 1
      END DO
      IF (LZ .LT. LD + 3) LZ = LD + 3
      T = ABS(A(26))
      S = T
      DO I = 5, 14
        IP(I) = 0
        G(I)  = T
        T     = T + 0.1
      END DO
      I = LX + 4
      K = LH - 2
      IF (LD .LE. LH) THEN
        WRITE (LI, 99982, IOSTAT = IOST) S
        IER = 1
        RETURN
      END IF
  350 M = 1
  360 K = K + 4
      IF (K .LE. LD) THEN
        Q = A(K + 1)
        DO L = 5, 14
          IF (Q .GT. G(L)) IP(L) = IP(L) + 1
        END DO
        I        = I + 4
        A(I)     = A(K)
        F(M)     = A(K)
        F(M + 1) = A(K + 2) + Q
        F(M + 2) = A(K + 3)
        A(I + 1) = F(M + 1)
        M        = M + 3
        A(I + 2) = -1.0
        A(I + 3) = A(K + 3)
        IF (M .LT. 126) GO TO 360
        WRITE (LF) F
        GO TO 350
      END IF
      LD   = I
      F(M) = 0.0
      WRITE (LF) F
      CALL GEN108 (LF, 0)
      WRITE (LI, 99983, IOSTAT = IOST)
     1  (G(I), I = 5, 14), (IP(I), I = 5, 14)
      WRITE (LI, 99984, IOSTAT = IOST) (G(I), I = 1, 4)
      WRITE (LI, 99981, IOSTAT = IOST)
      P = 2.0 * A(52)
      Q = 114.59 * ATAN2(SQRT(A(53)), SQRT(ABS(1.0 - A(53))))
      J = INT(AINT(A(29) * 0.1))
      U = A(29) - 10.0 * FLOAT(J)
      WRITE (LI, 99980, IOSTAT = IOST) A(26), A(27), A(28), U, J, P, Q
      IF (ABS(A(39)) .GE. 0.5) THEN
        J = INT(A(40))
        K = INT(A(41))
        Q = AMOD(ABS(A(41)), 1.0)
        WRITE (LI, 99978, IOSTAT = IOST) A(39), J, K, Q, A(42)
        L = INT(A(43))
        M = INT(A(44))
        WRITE (LI, 99977, IOSTAT = IOST) L, M
      END IF
      I = INT(A(54))
      IF (I .EQ. 2) I = 6
      J = INT(A(57))
      WRITE (LI, 99975, IOSTAT = IOST) I, J, A(58), A(59)
      L = LX + 4
      DO WHILE (L .LE. LD - 4)
        L        = L  + 4
        A(L)     = ABS(A(L))
        A(L + 3) = 0.0
      END DO
      LJ = LL - 1
      IF (IABS(JJ - 1) .GE. 2) THEN
        IF (LX .NE. LV) THEN
          M = 0
          CALL GEN074 (F, 1, 3, 0.0)
          I = LX + 4
          DO WHILE (I .LE. LD - 4)
            I = I + 4
            R = AMOD(A(I + 1), 10.0)
            CALL GEN046 (A(I), X, Y, Z)
            X = X * RGBL(5)
            Y = Y * RGBL(5)
            Z = Z * RGBL(5)
            O = 0.0
            P = 0.0
            J = LV
            DO WHILE (J .LE. LX - 8)
              J = J + 8
              K = INT(0.001 * A(J + 1)) * 5 + LJ
              Q = A(K) * A(J + 5)
              DO K = 65, LY, 12
                U = X * A(K) + Y * A(K + 3) + Z * A(K + 6)
                V = X * A(K + 1) + Y * A(K + 4) + Z * A(K + 7)
                W = X * A(K + 2) + Y * A(K + 5) + Z * A(K + 8)
                T = U * A(J + 2) + V * A(J + 3) + W * A(J + 4)
     1            + X * A(K + 9) + Y * A(K + 10) + Z * A(K + 11)
                O = O + Q * SIN(T)
                P = P + Q * COS(T)
              END DO
            END DO
            O = O * A(23)
            Q = SQRT(O * O + P * P)
            IF (Q .GE. 1.E-6) THEN
              A(I + 2) = RGBL(6) * ATAN2(O, P)
              IF (A(I + 2) .LT. 0.0) A(I + 2) = A(I + 2) + 360.0
              IF (R .GE. A(32)) THEN
                F(1)     = F(1) + R * R
                F(2)     = F(2) + R * Q
                F(3)     = F(3) + Q * Q
                M        = M + 1
                A(I + 3) = Q / R
              END IF
            END IF
          END DO
          J = (LX - LV) / 8
          R = SQRT(ABS(1.0 - F(2) * F(2) / (F(1) * F(3))))
          WRITE (LI, 99974, IOSTAT = IOST) R, J, M, A(32)
        END IF
        IF (ABS(A(39)) .GT. 0.5 .OR. AP .GT. 0.5 .OR. LE .GE. LQ + 4)
     1    THEN
          I = LX + 4
          DO WHILE (I .LE. LD - 4)
            I = I  + 4
            A(I + 3) = AMOD(A(I + 1), 10.0)
          END DO
          N = (LD - NA) / 4
          M = 1
  370     M = 3 * M + 1
          IF (M .LT. N) GO TO 370
  380     M = M / 3
          N = 4 * M
          NJ = NA + N
          NI = NJ + 4
          DO I = NI, LD, 4
            CALL GEN113 (A(I), AA, 4)
            J = I
  390       K = J - N
            IF (A(K + 3) .LE. T) THEN
              CALL GEN113 (A(K), A(J), 4)
              J = K
              IF (J .GT. NJ) GO TO 390
            END IF
            CALL GEN113 (AA, A(J), 4)
          END DO
          IF (M .GT. 2) GO TO 380
        END IF
      END IF
      LZ = NA
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (3I4, 2F8.2)
99998 FORMAT (//, I8, 2X, 'Reflections Read, of Which', I6, ' Rejected'
     1        //, 3X, 'Maximum H, K, L and 2-Ttheta=', 3F6.0, F8.2)
99991 FORMAT (/I8, ' Unique Reflections, of Which', I7, 2X,
     1        'Observed', //, 3X, 'R(int) =', F7.4, 5X,
     2        'R(sigma) =', F7.4, 6X, 'Friedel Opposites Merged')
99990 FORMAT (///, 'Number of Unique Data as a Function of Resolution ',
     1        'in Angstroms', //, ' Resolution  inf', 13F8.2)
99989 FORMAT (/, 'N(observed) ', 13F8.0)
99988 FORMAT (/, 'N(measured) ', 13F8.0)
99987 FORMAT (/, 'N(theory)   ', 13F8.0)
99986 FORMAT (/, 'Two-Ttheta  0.0', 13F8.1)
99984 FORMAT (//, 19X, 'Centric Acentric    0KL      H0L      HK0',
     1        6X, 'Rest', //, 'Mean abs(E*E-1)    0.968    0.736',
     2        4F9.3)
99983 FORMAT (///, 'Observed E  .gt. ', 10F6.3, //, ' Number',
     1        8X, 10I6)
99982 FORMAT (/, '** No Observed E Above', F7.3)
99981 FORMAT (/, 6X, 'Summary of Parameters', /)
99980 FORMAT ('ESEL  EMIN', F7.3, 3X, 'EMAX', F7.3, 3X, 'DELU', F6.3,
     1        3X, 'RENORM', F6.3, 3X, 'AXIS', I2, /,
     2        'OMIT  S', F6.2, 3X, '2THETA(MAX)', F7.1)
99978 FORMAT ('TREF  NP', F10.0, 3X, 'NE', I6, 3X, 'NTAN', I4,
     1        '   TW', F7.3, 3X, 'WN', F7.3)
99977 FORMAT ('SUBS  TYPE', I4, 3X, 'NS', I5)
99975 FORMAT ('FMAP  CODE', I3, /, 'PLAN  NPEAKS', I5,
     1        3X, 'DEL1', F6.3, 3X, 'DEL2', F6.3)
99974 FORMAT (///, 'RE =', F7.4, ' for', I4, ' Atoms and',
     1        I5, ' E Greater Than', F7.3)
      END SUBROUTINE PLA156
      SUBROUTINE PLA157 (IER)
      PARAMETER (NVD=100000000,NP23=28000,NPP=NVD+2*NP23)
      COMMON /SHX/ F(126), G(126), LR, LG, LH, LI, LP, LF, LA, LB,
     1 LY, LL, LQ, LE, LV, LX, LD, LZ, LJ, HKLF(11)
      COMMON // A(NPP)
      DIMENSION IP(27), AA(4)
      NA = LZ
      IF (ABS(A(39)) .LT. 0.5 .OR. ABS(ABS(A(54)) - 1.5) .LT. 0.8) THEN
        LE = NA
        RETURN
      END IF
      CALL GEN097 (IP, 1, 27, 0)
      NQ    = 0
      NC    = 0
      NT    = 0
      A(22) = A(43)
      A(28) = 0.0
      PA    = 0.1
      PS    = 0.1
      PF    = 0.1
      NF    = 1
      NB    = NA
      NY    = INT (MAX (ABS(A(40)), 10.0))
      NZ    = MIN (LD, INT(0.5 * (ABS(A(44)) + FLOAT(NY)) + 1.1) * 4
     1      + LX)
      MT = INT(A(43))
      I  = NA
      J  = NA
      IF (MT .GT. 0 .AND. MT .LT. 6 .AND. MT .NE. 4) THEN
        DO WHILE (I .LE. LD - 4)
          I = I + 4
          CALL GEN046 (A(I), F(1), F(2), F(3))
          F(5) = AMOD(ABS(F(1)) + 0.1, 2.0) + AMOD(ABS(F(2)) + 0.1, 2.0)
     1         + AMOD(ABS(F(3)) + 0.1, 2.0)
          IF (ABS(F(MT)) .LE. 0.5) THEN
            K = I + 3
            DO L = I, K
              CALL GEN018 (A(L), A(J + 4))
              J = J + 1
            END DO
          END IF
        END DO
        NZ = MIN (NZ, J)
      END IF
      MA = LX + 4
      NS = 0
      ME = LD + 4
      IF (MT .GE. 0) GO TO 260
      N = MIN (LX + 4 - 4 * MT, NZ)
      I = NA
      J = MIN (NZ - 4 * MT, LD)
      DO WHILE (I .LE. N - 4)
        I = I + 4
        K = I + 3
        DO L = I, K
          CALL GEN018 (A(L), A(J))
          J = J + 1
        END DO
        J = J - 8
        IF (J .LE. NZ) THEN
          NZ = NZ - 4
          N  = MIN (N, NZ)
        END IF
      END DO
   10 L  = NA
      MB = NT + ((NZ - LX) / 4) - 3
   20 L  = L + 4
      IF (L .GT. NZ) GO TO 160
      R  = AMOD(A(L + 1), 10.0) * A(45)
      NQ = MB
      IZ = (L - LX - 4) / 4
      W  = A(L) - 0.5
   30 PQ = 0.0001
      RR = 0.0001
      Q  = 1.0
      PI = 0.0
      NN = NT + 2
      I  = ME
      K  = I
      MZ = NT
   40 J  = MZ
   50 MZ = K + 2 * ((J - K) / 4)
      IF (A(MZ) .GT. W) GO TO 40
      K  = MZ
      IF (J .GT. K + 2) GO TO 50
      W = W + 1.0
   60 I = I + 2
   70 IF (I .GE. J) GO TO 100
      X = W - A(I) - A(J)
      IF (X .GT. 1.0) GO TO 60
      IF (X .LE. 0.0) THEN
        J = J - 2
        GO TO 70
      END IF
   80 NI = INT(A(I + 1) * Q)
      NJ = INT(A(J + 1))
      IF (IABS(NJ) .LE. IABS(NI)) THEN
        K  = NI
        NI = NJ
        NJ = K
      END IF
      IF (A(23) .LE. 0.5) THEN
        NJ = - IABS(NJ)
        NI = IABS(NI)
      END IF
      IF (NI + NJ .NE. 0) THEN
        N = IABS(NJ)
        M = IABS(NI)
        IF (M .NE. IZ) THEN
          IF (N .NE. IZ) THEN
            IF (NS .NE. 2) THEN
              IF (NS .NE. 4) THEN
                K  = N * 4 + LX + 5
                NK = M * 4 + LX + 5
                P  =(AMOD(A(K), 10.0) * AMOD(A(NK), 10.0))**2
                PQ = PQ + P
                IF (NS .EQ. 1) THEN
                  N    = N + NT + 1
                  A(N) = A(N) + P
                  M    = M + NT + 1
                  A(M) = A(M) + P
                END IF
                GO TO 90
              END IF
            END IF
            IF (NQ + 3 .GT. NPP) THEN
              IER = 1
              RETURN
            END IF
            NQ    = NQ + 2
            A(NQ) = FLOAT(NI)
            Y     = AMOD(ABS(A(I + 1)), 1.0)
            IF (Q .LT. 0.0) Y = AMOD(1.008 - Y, 1.0)
            A(NQ + 1) = SIGN (FLOAT (N) + AMOD(ABS(A(J + 1)) + Y, 1.0),
     1                  FLOAT(NJ))
          END IF
        END IF
      END IF
   90 IF (Q .LT. 0) THEN
        GO TO 110
      ELSE
        GO TO 60
      END IF
  100 Q = - 1.0
      I = ME
      J = MZ
  110 I = I + 2
  120 X = W + A(I) - A(J)
      IF (X .LT. 0.0) GO TO 110
      IF (X .LT. 1.0) GO TO 80
      J = J + 2
      IF (J .LT. NN) GO TO 120
      IF (NS .EQ. 3 .OR. NS .LE. 0) THEN
        A(L + 3) = R * SQRT(PQ)
        GO TO 20
      END IF
      IF (NS .EQ. 1) GO TO 180
      I = MB
  130 I = I + 2
      IF (I .LE. NQ) THEN
        Q  = 1.0
        N  = IABS(INT(A(I)))
        NI = 4 * N + LX + 5
        M  = IABS(INT(A(I + 1)))
        NJ = 4 * M + LX + 5
        J  = I
  140   J  = J + 2
  150   IF (J .LE. NQ) THEN
          IF (IABS(INT(A(J))) .NE. N) GO TO 140
          IF (IABS(INT(A(J + 1))) .NE. M) GO TO 140
          Q        = Q + 1.0
          T        = A(J)
          V        = A(J + 1)
          A(J)     = A(NQ)
          A(J + 1) = A(NQ + 1)
          NQ       = NQ - 2
          IF (A(L + 1) .LT. 10.0) GO TO 140
          K = 720 + INT(12.0 * AMOD(ABS(A(I + 1)), 1.0))
     1      - INT(12.0 * AMOD(ABS(V), 1.0))
          IF (A(I) * T .LE. 0.0) THEN
            IF (A(NI) .LT. 10.0) GO TO 150
            K = K + INT (SIGN (0.1 * A(NI), A(I)))
          END IF
          IF (A(I + 1) * V .LE. 0.0) THEN
            IF (A(NJ) .LT. 10.0) GO TO 150
            K = K + INT (SIGN (0.1 * A(NJ), A(I + 1)))
          END IF
          IF (MOD(K, 12) .NE. 0) Q = -9.E5
          GO TO 150
        END IF
        IF (Q .LT. 0.0) GO TO 130
        IF (NS .EQ. 4) THEN
          IF (M .LE. IZ) THEN
            PA = PA + 1.0
            IF (L .LE. NC) PS = PS + 1.0
          END IF
        END IF
        Q = SQRT(Q)
        X = AMOD(A(NJ), 10.0) * AMOD(A(NI), 10.0)
        IF (NJ .EQ. NI) Q = Q * (X - 1.0) / X
        RR   = RR + (X * Q)**2
        A(I) = SIGN (ABS (A(I)) + Q * 0.1, A(I))
        X  = X * Q * R
        Y  = X * SQRT(2.0 - A(23))
        Y  = MIN (Y * (0.5658 + Y * (Y * 0.0106 - 0.1304)),
     1       Y / (0.56 + Y))
        PQ = PQ + X * (X + 2.0 * Y * PI)
        PI = PI + X * Y
        GO TO 130
      END IF
      A(L + 3) = SQRT(PQ)
      IF (NS .NE. 2) THEN
        NQ = NQ + 2
        A(NQ) = 0.0
        A(NQ + 1) = FLOAT(IZ)
        I = MB
        DO WHILE (I .LE. NQ - 2)
          I         = I + 2
          F(NF)     = A(I)
          F(NF + 1) = A(I + 1)
          NF        = NF + 2
          IF (NF .GE. 126) THEN
            WRITE (LB) F
            NF = 1
          END IF
        END DO
        IF (PA .GT. 2.0 * PS + 0.5) GO TO 320
        GO TO 20
      END IF
      A(28) = A(28) + A(L + 3)**2
      I = MB
      DO WHILE (I .LE. NQ - 2)
        I = I + 2
        IF (L .LE. NB) THEN
          IF (INT(ABS(A(I + 1))) .LT. IZ) PF = PF + 1.0
        END IF
        MB        = MB + 2
        A(MB)     = A(I)
        A(MB + 1) = A(I + 1)
      END DO
      MB = MB + 2
      IF (MB .GT. NPP - 2000) THEN
        IER = 1
        RETURN
      END IF
      A(MB)     = 0.0
      MB        = MB + 1
      A(MB)     = FLOAT(IZ)
      MB        = MB + 1
      A(MB)     = A(L + 3)
      A(MB + 1) = 125.0 / RR
      GO TO 20
  160 IF (NS .NE. 0) GO TO 190
      NS = 1
      IF (IABS(MT - 2) .NE. 2) GO TO 190
      IZ = 0
      I  = NT + 2
      CALL GEN074 (A, I, MB, 1.0)
  170 READ (LA) F
      NF = - 2
  180 NF = NF + 3
      IF (NF .GT. 124) GO TO 170
      IF (0.5 .LE. F(NF)) THEN
        CALL GEN046 (F(NF), X, Y, Z)
        R = X * X * A(14) + Y * Y * A(15) + Z * Z * A(16)
     1    + Y * Z * A(17) + X * Z * A(18) + X * Y * A(19)
        IF (0.005 .GT. R) GO TO 180
        IF (EXP(2.0 * R / A(1)**2) * F(NF + 2) .GT. 0.65 + 0.05 * A(23))
     1    GO TO 180
        W = F(NF) - 0.5
        GO TO 30
      END IF
      I = LX + 4
      CALL GEN108 (LA, 0)
      J = NT + 1
      DO WHILE (I .LE. NZ - 4)
        I        = I + 4
        J        = J + 1
        A(I + 3) = A(I + 3) * A(J)
      END DO
  190 IF (NS .EQ. 1) THEN
        IF (MT .GT. 6) THEN
          T = FLOAT(6 - MT) / A(1)**2
          I = NA
          DO WHILE (I .LE. NZ - 4)
            I = I + 4
            CALL GEN046 (A(I), X, Y, Z)
            A(I + 3) = A(I + 3) * EXP(T * (X * X * A(14)
     1               + Y * Y * A(15) + Z * Z * A(16) + Y * Z * A(17)
     2               + X * Z * A(18) + X * Y * A(19)))
          END DO
        END IF
        NB = NA
        NC = LX + 4 * INT(ABS(A(44)) + 1.1)
  200   Q = 0.01
        I = NB
        DO WHILE ( I .LE. NZ - 4)
          I = I + 4
          IF (Q .LE. A(I + 3)) THEN
            Q = A(I + 3)
            M = I
          END IF
        END DO
        IF (Q .GE. 0.1) THEN
          K = M + 3
          DO I = M, K
            P         = A(I)
            A(I)      = A(NB + 4)
            A(NB + 4) = P
            NB        = NB + 1
          END DO
          IF (NB .LT. NC) GO TO 200
        END IF
        I  = NB
        NZ = MIN (NZ, NC)
        DO WHILE (I .LE. LD - 4)
          I        = I + 4
          A(I + 3) = AMOD(A(I + 1), 10.0)
        END DO
        N = (LD - NB) / 4
        M = 1
  210   M = 3 * M + 1
        IF (M .LT. N) GO TO 210
  220   M = M / 3
        N = 4 * M
        NJ = NB + N
        NI = NJ + 4
        DO I = NI, LD, 4
          CALL GEN113 (A(I), AA, 4)
          J = I
  230     K = J - N
          IF (A(K + 3) .LE. T) THEN
            CALL GEN113 (A(K), A(J), 4)
            J = K
            IF (J .GT. NJ) GO TO 230
          END IF
          CALL GEN113 (AA, A(J), 4)
        END DO
        IF (M .GT. 2) GO TO 220
        NS = 2
        NZ = NB
        MB = NT
        IF (MT .NE. 0) GO TO 260
      END IF
      IF (NS .EQ. 2) THEN
        K = MB + 3
        A(K - 1) = 0.0
        A(K) = 0.0
        J    = NT + 2
        DO I = J, K
          A(ME) = A(I)
          ME    = ME + 1
        END DO
        NS = 3
        NC = MIN (LD, LX + 4 + 4 * NY)
        GO TO 250
      END IF
      IF (NS .NE. 3) GO TO 320
      NF = 1
      NC = NB
  240 Q  = 0.01
      I  = NC
      DO WHILE (I .LE. NZ - 4)
        I  = I + 4
        IF (Q .LE. A(I + 3)) THEN
          Q  = A(I + 3)
          M  = I
        END IF
      END DO
      IF (Q .GE. 0.1) THEN
        K  = M + 3
        DO I = M, K
          P    = A(I)
          A(I) = A(NC + 4)
          A(NC + 4) = P
          NC = NC + 1
        END DO
        IF (NC .LT. LX + 4 + 4 * NY) GO TO 240
      END IF
      NS = 4
  250 NZ = NC
  260 L  = MA
      NT = ME
      A(NT) = 0.0
      P  = 0.0
      DO WHILE (L .LT. NZ - 4)
        L  = L + 4
        NG = NT
        P  = P + 1.0
        CALL GEN046 (A(L), X, Y, Z)
        DO 280 M = 65, LY, 12
          W = AINT(1.001 * (X * A(M) + Y * A(M + 3) + Z * A(M + 6)))
     1      + 200.0 * (AINT(1.001 * (X * A(M + 1) + Y * A(M + 4)
     2      + Z * A(M + 7))) + 200.0 * AINT (1.001 * (X * A(M + 2)
     3      + Y * A(M + 5) + Z * A(M + 8))))
          Q = 1.0 - A(23) * (1.0 - SIGN (1.0, W))
          W = ABS(W)
          J = NG
  270     J = J + 2
          IF (J .LE. NT) THEN
            IF (ABS(W - A(J)) .GT. 0.5) THEN
              GO TO 270
            ELSE
              GO TO 280
            END IF
          END IF
          NT    = NT + 2
          A(NT) = W
          A(NT + 1) = Q * (P + AMOD (900.004 - Q * (X * A(M + 9)
     1              + Y * A(M + 10) + Z * A(M + 11)), 1.0))
  280   CONTINUE
        IF (NT .GT. NPP - 3000) THEN
          IER = 1
          RETURN
        END IF
      END DO
      N = (NT - ME) / 2
      M = 1
  290 M = 3 * M + 1
      IF (M .LT. N) GO TO 290
  300 M = M / 3
      N = M * 2
      NJ = ME + N
      NI = NJ + 2
      DO I = NI, NT, 2
        Q = A(I)
        T = A(I + 1)
        J = I
  310   K = J - N
        IF (A(K) .GE. Q) THEN
          A(J)     = A(K)
          A(J + 1) = A(K + 1)
          J        = K
          IF (J .GT. NJ) GO TO 310
        END IF
        A(J) = Q
        A(J + 1) = T
      END DO
      IF (M  .GT. 2) GO TO 300
      IF (NS .EQ. 0) GO TO 10
      L  = NA
      MB = NT
      IF (NS .GT. 2) THEN
        NZ = MIN (LD, NC + 2 * NY)
        IF (NS .EQ. 4) THEN
          L  = MA
          NZ = NC
          IF (A(41) .LT. 0.0) NZ = LD
          A(41) = ABS(A(41))
        END IF
      END IF
      GO TO 20
  320 F(NF)     = 0.0
      F(NF + 1) = 0.0
      WRITE (LB) F
      CALL GEN108 (LB, 0)
      J = (NB - LX - 4) / 4
      WRITE (LI, 99998, IOSTAT = IOST) J, PF
      J = (NC - LX - 4) / 4
      WRITE (LI, 99999, IOSTAT = IOST) J, PS, IZ, PA
      NY = NT + 4
      M  = LD - 1
      NQ = M
      IF (A(42) .GE. 0.9999) THEN
        IF (A(44) .GT. 0.0) GO TO 580
      END IF
      R         = 0.75 + 0.05 * A(23)
      A(NT + 2) = 9.E9
      NQ        = NT + 3
      A(NQ)     = -1.0
      MZ = INT(MIN(0.3 * FLOAT(NPP) + 0.7 * FLOAT(NQ), FLOAT(NQ)
     1   + 10000.0))
  330 READ (LA) F
      I = -2
  340 I = I + 3
      IF (I .GT. 124) GO TO 330
      IF (0.5 .LE. F(I)) THEN
        CALL GEN046 (F(I), X, Y, Z)
        P = X * X * A(14) + Y * Y * A(15) + Z * Z * A(16)
     1    + Y * Z * A(17) + X * Z * A(18) + X * Y * A(19)
        IF (0.005 .GT. P) GO TO 340
        P = EXP(2.0 * P / A(1)**2) * F(I + 2)
        IF (P .GT. R) GO TO 340
        M = NQ
        DO 360 N = 65, LY, 12
          Q = ABS(AINT(1.001 * (X * A(N) + Y * A(N + 3)
     1      + Z * A(N + 6))) + 200.0 * (AINT(1.001 * (X * A(N + 1)
     2      + Y * A(N + 4) + Z * A(N + 7))) + 200.0 * AINT(1.001 *
     3      (X * A(N + 2) + Y * A(N + 5) + Z * A(N + 8)))))
          J = M
  350     J = J + 2
          IF (J .LE. NQ) THEN
            IF (ABS(Q - A(J)) .LT. 0.5) THEN
              GO TO 360
            ELSE
              GO TO 350
            END IF
          END IF
          NQ        = NQ + 2
          A(NQ)     = Q
          A(NQ + 1) = P
  360   CONTINUE
  370   IF (NQ .LT. MZ) GO TO 340
        R  = R - 0.01
        J  = NT + 3
        K  = NQ
        NQ = J
        DO WHILE (J .LE. K - 2)
          J  = J + 2
          IF (A(J + 1) .LE. R) THEN
            NQ        = NQ + 2
            A(NQ)     = A(J)
            A(NQ + 1) = A(J + 1)
          END IF
        END DO
        GO TO 370
      END IF
      CALL GEN108 (LA, 0)
      NY = NQ + 1
      N = (NQ - NT - 3) / 2
      M = 1
  380 M = 3 * M + 1
      IF (M .LT. N) GO TO 380
  390 M  = M / 3
      N  = M + M
      NJ = NT + 3 + N
      NI = NJ + 2
      DO I = NI, NQ, 2
        Q = A(I)
        T = A(I + 1)
        J = I
  400   K = J - N
        IF (A(K) .GE. Q) THEN
          A(J)     = A(K)
          A(J + 1) = A(K + 1)
          J        = K
          IF (J .GT. NJ) GO TO 400
        END IF
        A(J)     = Q
        A(J + 1) = T
      END DO
      IF (M .GT. 2) GO TO 390
      A(NQ + 2) = 9.E9
      MZ = 5 * MIN ((NPP - NQ - 111) / 13, 1000) + NQ + 10
      NY = MAX (MZ + 1, NY)
      PZ = 0.0
      M  = NQ + 2
      MP = M + 5
      KZ = 0
      NI = NT + 2
      JN = NI + 1
      NL = 0
      L  = LX + 4
  410 L  = L + 4
      IF (L .GT. NC) THEN
        I = (M - NQ) / 5
        A(43) = 64.0 * A(45) / SQRT(FLOAT(I) + 24.0)
        IF (I .EQ. 0) A(43) = 0.0
        WRITE (LI, 99997, IOSTAT = IOST) KZ, I
        GO TO 580
      END IF
      NL = NL + 1
      I  = NQ + 2
      N  = MZ
      NU = -1
      S  = 1.0
      Q  = -1.0
      R  = A(L)
      X  = A(NQ) - R + 0.5
      J  = ME + 2
      IF (X .GE. A(J)) THEN
        NM = NT
  420   K  = NM
  430   NM = J + 2 * ((K - J) / 4)
        IF (A(NM) .GT. X) GO TO 420
        J = NM
        IF (K .GT. J + 2) GO TO 430
      END IF
  440 I = I - 2
  450 X = A(J) - A(I) + R
      IF (X .LT. -0.5) GO TO 440
      IF (X .LT.  0.5) GO TO 560
      J = J - 2
      IF (J .GT. ME) GO TO 450
      S  = -1.0
      NU = 0
  460 J  = J + 2
  470 X  = R - A(I) - A(J)
      IF (X .GT.  0.5) GO TO 460
      IF (X .GT. -0.5) GO TO 560
      I = I - 2
      IF (I .GT. JN) GO TO 470
      Q  = 1.0
      NU = 1
  480 I  = I + 2
  490 X  = R + A(I) - A(J)
      IF (X .LT. -0.5) GO TO 480
      IF (X .LT.  0.5) GO TO 560
      J = J + 2
      IF (J .LT. NI) GO TO 490
  500 J = MZ
  510 J = J + 3
      IF (J .GT. N) GO TO 410
      S = A(J) + R
      I = J + 3
      K = N + 3
  520 K = K - 3
  530 IF (K .LE. I) GO TO 510
      X = S + A(I) + A(K)
      IF (X .LT. -0.5) GO TO 520
      IF (X .LT.  0.5) GO TO 540
      I = I + 3
      GO TO 530
  540 G(1) = FLOAT(NL) + AMOD(ABS(A(I + 1)) + ABS(A(J + 1))
     1     + ABS(A(K + 1)), 1.0)
      G(2) = A(J + 1)
      G(3) = A(I + 1)
      G(4) = A(K + 1)
      KZ   = KZ + 1
      P    = 2.0 - A(I + 2) - A(J + 2) - A(K + 2)
      DO NJ = 1, 4
        NM = INT(ABS(G(NJ))) * 4 + LX + 5
        P  = P * AMOD(A(NM), 10.0)
      END DO
      IF (P .LT. PZ) GO TO 520
      IF (M .LT. MP) M = MP
      A(MP)     = P
      A(MP + 1) = G(1)
      A(MP + 2) = G(2)
      A(MP + 3) = G(3)
      A(MP + 4) = G(4)
      IF (M .GE. MZ - 8) THEN
        PZ = P
        NJ = NQ + 2
  550   NJ = NJ + 5
        IF (NJ .GT. M) GO TO 520
        IF (A(NJ) .LE. PZ) THEN
          PZ = A(NJ)
          MP = NJ
        END IF
        GO TO 550
      END IF
      MP = MP + 5
      GO TO 520
  560 NM = INT(ABS(A(J + 1)))
      IF (NM .LT. NL) THEN
        K = MZ
        DO WHILE (K .LE. N - 3)
          K = K + 3
          IF (NM .EQ. INT(ABS(A(K + 1)))) GO TO 570
        END DO
        IF (N .GT. NPP - 5) GO TO 500
        N = N + 3
        IF (NY .LT. N + 2) NY = N + 2
        A(N) = A(J) * S
        X = AMOD(ABS(A(J + 1)), 1.0)
        IF (S .LT. 0.0) X = AMOD(1.008 - X, 1.0)
        A(N + 1) = SIGN (AINT (ABS (A(J + 1))) + X, A(J + 1) * S)
        A(N + 2) = A(I + 1)**2
      END IF
  570 IF (NU .LT. 0) THEN
        GO TO 440
      ELSE IF (NU .EQ. 0) THEN
        GO TO 460
      ELSE
        GO TO 480
      END IF
  580 LZ = M
      LQ = NQ + 2
      N  = ((M - LQ) / 5) * 8 + M + 5
      IF (N .GT. NY) NY = N
      A(27) = PF
      A(29) = FLOAT(ME)
      LR    = NB
      LH    = NC
      LE    = NA
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, I6, ' Large E-Values Refined Using', F9.0,
     1        ' Unique TPR', /, I6, ' Reflections and', F9.0,
     2        ' Unique TPR for R(alpha)')
99998 FORMAT (//, I6, ' Subset Reflections and',
     1        F8.0, ' Unique TPR for Filter')
99997 FORMAT (/, I8, ' Negative Quartets Found,', I5, ' Used')
      END SUBROUTINE PLA157
      SUBROUTINE PLA158
      PARAMETER (NVD=100000000,NP23=28000,NPP=NVD+2*NP23)
C * TANGENT REFINEMENT
      COMMON /SHX/ F(126), G(126), LR, LG, LH, LI, LP, LF, LA, LB,
     1 LY, LL, LQ, LE, LV, LX, LD, LZ, LJ, HKLF(11)
      COMMON // A(NPP)
      COMMON /WORDD/ IR
      DIMENSION IP(20), ID(31), SN(15), B(64), C(64), D(126),
     1 E(126), FB(64), FC(64), FD(64), FE(64), PM(64), PR(64)
      CHARACTER IR*80
      NG = 0
      RR = 1.E8
      W  = 0.0
      S  = 0.0
      NA = LE
      IF (ABS(A(39)) .LT. 0.5) THEN
        LE = NA
        RETURN
      END IF
      TW = AMOD(A(41), 1.0)
      MB = -1
      IF (A(27) .LT. 0.5) MB = 0
      IF (MB .NE. 0) TW = 5.0 * TW
      ME = INT(A(29))
      NB = LR
      NC = LH
      NI = ME + 1
      NJ = (NC - LX - 4) / 4 + ME
      CALL GEN074 (A, NI, NJ, 0.1)
      MP = LZ + 5
      NE = MP
      A(NE) = 0.0
      J = LQ
   10 J = J + 5
      IF (J .LE. LZ) THEN
        K = J + 3
        DO L = J, K
          M         = INT(ABS(A(L + 1)))
          NE        = NE + 2
          A(NE)     = - FLOAT(M)
          A(NE + 1) = FLOAT(J)
          M         = M + ME
          A(M)      = A(M) + 2.0
        END DO
        GO TO 10
      END IF
      ML = MP
      DO I = NI, NJ
        J    = INT(A(I))
        A(I) = FLOAT(ML)
        ML   = ML + J
      END DO
      I = MP
   20 I = I + 2
      IF (I .LE. NE) THEN
   30   IF (A(I) .GT. 0.0) GO TO 20
        M    = INT(0.1 - A(I)) + ME
        A(M) = A(M) + 2.0
        M    = INT(A(M))
        Q    = A(M)
        A(M) = - A(I)
        IF (I .EQ. M) GO TO 20
        A(I)     = Q
        Q        = A(M + 1)
        A(M + 1) = A(I + 1)
        A(I + 1) = Q
        GO TO 30
      END IF
      L  = 0
      NF = 1
      K  = LX + 4
   40 K  = K + 4
      IF (K .LE. NC) THEN
        L  = L + 1
        NJ = L + ME
        NJ = INT(A(NJ))
   50   IF (INT(A(NJ)) .LT. L) GO TO 40
        J  = INT(A(NJ + 1))
        NJ = NJ - 2
        T  = AMOD(A(J + 1), 1.0)
        W  = AINT(A(J + 1))
        X  = AINT(A(J + 2))
        Y  = AINT(A(J + 3))
        Z  = AINT(A(J + 4))
   60   IF (INT(ABS(W)) .EQ. L) THEN
          S = SIGN (1.0, W)
          G(NF)     = T + FLOAT (L)
          G(NF + 1) = S * X
          G(NF + 2) = S * Y
          G(NF + 3) = S * Z
          NF        = NF + 4
          IF (NF .GE. 122) THEN
            WRITE (LG) G
            NF = 1
          END IF
          GO TO 50
        END IF
        S = W
        W = X
        X = Y
        Y = Z
        Z = S
        GO TO 60
      END IF
      G(NF) = 0.0
      WRITE (LG) G
      CALL GEN108 (LG, 0)
      WF = 0.0
      MS = ME - 3
      IF (MB .NE. 0) THEN
        IF (A(44) .LE. 0.0) THEN
          M  = (NB - LX - 4) / 4
          N  = LZ
          LZ = LQ
          I  = LQ
          DO WHILE (I .LE. N - 5)
            I  = I + 5
            IF (INT(A(I + 1)) .LE. M) THEN
              LZ        = LZ + 5
              A(LZ)     = A(I)
              A(LZ + 1) = A(I + 1)
              A(LZ + 2) = A(I + 2)
              A(LZ + 3) = A(I + 3)
              A(LZ + 4) = A(I + 4)
            END IF
          END DO
   70     Q = - 1.0
          N = 0
          I = LQ
   80     I = I + 5
          IF (I .LE. LZ) THEN
            IF (A(I) .GE. Q) THEN
              N = I
              Q = A(I)
            END IF
            GO TO 80
          END IF
          IF (N .NE. 0) THEN
            ME        = ME + 4
            A(ME - 3) = A(N + 1)
            A(ME - 2) = A(N + 2)
            A(ME - 1) = A(N + 3)
            A(ME)     = A(N + 4)
            Q         = 1.0
            K         = ME - 3
            DO I = K, ME
              J = INT(ABS(A(I))) * 4 + LX + 5
              Q = Q * AMOD(A(J), 10.0)
            END DO
            WF       = WF + Q
            LQ       = LQ + 5
            A(N)     = A(LQ)
            A(N + 1) = A(LQ + 1)
            A(N + 2) = A(LQ + 2)
            A(N + 3) = A(LQ + 3)
            A(N + 4) = A(LQ + 4)
            IF (ME .LT. MS + 400) GO TO 70
          END IF
        END IF
      END IF
      I = (ME - MS) / 4
      WRITE (LI, 99999, IOSTAT = IOST) I
      TS = 0.0
      TZ = 0.0
      NS = ME
      I  = LX + 4
   90 I  = I + 4
      IF (I .LE. LD) THEN
        TS = TS + A(I + 3)
        TZ = TZ + A(I + 3)**2 / (A(I + 3) + 5.0)
        IF (I .LE. NC) THEN
          IF (A(23) .GE. 0.5) THEN
            IF (A(I + 1) .LT. 120.0) GO TO 90
            IF (A(I + 1) .GT. 130.0) GO TO 90
          END IF
          IF (NS - ME .LE. 64) THEN
            CALL GEN046 (A(I), X, Y, Z)
            IF (AMOD(900.1 + Z, 2.0) + AMOD(98.1 + Y, 2.0) +
     1          AMOD(98.1 + X, 2.0) .LE. 0.5) THEN
              NS    = NS + 1
              A(NS) = FLOAT((I - LX - 4) / 4)
              J     = INT(X)
              K     = INT(Y)
              L     = INT(Z)
              T     = AMOD(A(I + 1), 10.0)
            END IF
          END IF
        END IF
        GO TO 90
      END IF
      NQ = 1
      MQ = 1
      IF (A(39) .GE. 0.0) THEN
        X  = 2.0 * FLOAT(NPP - NS)
        I  = INT(A(39) - 0.5)
        NQ = MIN (64, I + 1, INT(X / FLOAT(NC - LX - 4)))
        K  = I + NQ
        NQ = I / (K / NQ) + 1
        MQ = MIN (126, INT(X / FLOAT(NB - LX - 4)), (1 - MB) * NQ)
      END IF
      ML = NS + MAX (((NC - LX - 4) / 2) * NQ,
     1     ((NB - LX - 4) / 2) * MQ)
      I  = - MQ * MB
      MT = INT(A(41))
      NE = NS + 1
      NM = 2 * NQ
      NL = NE - NM
      MH = 2 * MQ
      ML = NE - MH
      RN = 2097152.0 * AMOD(SQRT(0.4321 * ABS(A(40))), 1.0)
      PQ = 9.E9
      TN = 0.3
      PS = 0.0
      DO NJ = 1, 15
        SN(NJ) = SIN(FLOAT(NJ - 1) * 0.523598)
      END DO
      CALL GEN097 (ID, 1, 31,      0)
  100 CALL GEN074 (FB, 1, NQ,    0.0)
      CALL GEN074 (FC, 1, NQ, 0.0001)
      CALL GEN074 (FD, 1, NQ,    0.0)
      CALL GEN074 (FE, 1, NQ,    0.0)
      CALL GEN074 (B , 1, NQ,    0.0)
      CALL GEN074 (C , 1, NQ,    0.0)
      CALL GEN074 (PM, 1, NQ,   9.E9)
      CALL GEN074 (D,  1, MQ, -1.E-6)
      CALL GEN074 (E,  1, MQ,    0.0)
      NZ = MB
      MM = MQ
      PN = 0.1
  110 DO I = 1, MQ
        RN = AMOD((1.0 + 2.0 * AINT(RN / 2.0 + 0.3)) * 5.0, 2097152.0)
        F(I) = 0.0
        IF (MB .EQ. 0) THEN
          PM(I) = 0.0
          PR(I) = RN
        END IF
        G(I) = RN
      END DO
      IF (A(39) .LT. 0.0) G(1) = - A(39)
  120 N = NE
      M = NB
      IF (NZ .EQ. 0) M = NC
      DO I = 1, MM
        R = G(I)
        R = AMOD(7169.0 * SQRT(R / 2097152.0), 1.0)
        K = N
        L = LX + 4
        DO WHILE (L .LE. M - 4)
          L = L + 4
          P = AMOD(A(L + 1), 10.0)
          IF (MB .NE. 0) P = P * 0.2
          IF (L .GT. NB) P = P * TW
          R = AMOD((1.0 + 2.0 * AINT(1048576.0 * R + 0.3)) * 5.0,
     1        2097152.0) / 2097152.0
          Q = R
          IF (L .LE. NA) Q = A(L + 2) / 360.0
          IF (A(23) .LE. 0.5) THEN
            Q        = SIGN (1.0, AMOD(Q + 0.75, 1.0) - 0.5)
            A(K)     = P * Q
            A(K + 1) = - A(K)
          ELSE
            IF (A(L + 1) .GT. 10.0)
     1        Q = AMOD(AINT(0.1 * A(L + 1)) / 24.0 + 9.25 - Q, 0.5)
     2          - 0.25 + Q
            Q        = Q * 6.28319
            A(K)     = P * COS(Q)
            A(K + 1) = P * SIN(Q)
          END IF
          K = K + MM * 2
        END DO
        N = N + 2
      END DO
      MU = 1
      IF (MB .EQ. 0) GO TO 140
      M  = LD + 2
      IZ = 5
      IF (A(22) .GE. 3.5) THEN
        DO K = 65, LY, 12
          IF (ABS(A(K + 9)) + ABS(A(K + 10)) + ABS(A(K + 11)) .GT. 0.1)
     1        IZ = MIN (IZ + 1, 8)
        END DO
      END IF
      GO TO 250
  130 CALL GEN108 (LB, 0)
      CALL GEN108 (LG, 0)
  140 MU = NZ
      NZ = NZ + 1
      IF (NZ .GT. MT) GO TO 400
      READ (LG) G
      NG = 1
      MP = 0
  150 READ (LB) F
      M = -1
  160 M = M + 2
      IF (M .GT. 125) GO TO 150
      P  = F(M)
      T  = ABS(P)
      XQ = F(M + 1)
      Z  = ABS(XQ)
  170 I  = INT(T) * NM + NL
      J  = INT(Z) * NM + NL
      IF (I .EQ. NL) GO TO 260
      IF (MU .EQ. 0) GO TO 160
  180 KI = INT(T) * 4 + LX + 5
      KJ = INT(Z) * 4 + LX + 5
      T  = 10.0 * AMOD(T, 1.0)
      Z  = AMOD(Z, 1.0)
      IF (A(23) .GT. 0.5) GO TO 200
      IF (Z .GT. 0.25) J = J + 1
      IF (ABS(T - 1.0) .LE. 0.001) THEN
        DO K = 1, MM
          D(K) = D(K) + A(I) * A(J)
          I = I + 2
          J = J + 2
        END DO
        GO TO 240
      END IF
  190 DO K = 1, MM
        D(K) = D(K) + T * A(I) * A(J)
        I    = I + 2
        J    = J + 2
      END DO
      GO TO 240
  200 R = SIGN (1.0, P)
      S = SIGN (1.0, XQ)
      K = INT(12.0 * Z)
      V = SN(K + 1) * T
      U = SN(K + 4) * T
      KJ = INT(0.1 * A(KJ))
      IF (KJ .LT. 12) GO TO 230
      IF (ABS(V) .GT. 0.001) GO TO 230
      KI = INT(0.1 * A(KI))
      IF (KI .NE. 12) GO TO 220
      T = U
      IF (KJ .EQ. 12) GO TO 190
      IF (KJ .NE. 18) GO TO 230
      T = T * S
      J = J + 1
  210 DO K = 1, MM
        E(K) = E(K) + T * A(I) * A(J)
        I    = I + 2
        J    = J + 2
      END DO
      GO TO 240
  220 IF (KI .EQ. 18) THEN
        T = U * R
        I = I + 1
        IF (KJ .EQ. 12) GO TO 210
        T = -T * S
        J = J + 1
        IF (KJ .EQ. 18) GO TO 190
        J = J - 1
        I = I - 1
      END IF
  230 DO K = 1, MM
        Y    = R * A(I + 1)
        X    = U * A(I) - V * Y
        Y    = U * Y + V * A(I)
        Q    = S * A(J + 1)
        D(K) = D(K) + X * A(J) - Y * Q
        E(K) = E(K) + X * Q + Y * A(J)
        I    = I + 2
        J    = J + 2
      END DO
  240 IF (NZ .GT. 0) GO TO 160
  250 M  = M + 2
      P  = A(M)
      XQ = A(M + 1)
      T  = ABS(P)
      Z  = ABS(XQ)
      IF (NZ .EQ. 0) GO TO 170
      I = INT(T) * MH + ML
      J = INT(Z) * MH + ML
      IF (I .GT. ML) GO TO 180
      IF (J .GT. ML) THEN
        GO TO 280
      ELSE
        GO TO 360
      END IF
  260 IF (J  .EQ. NL) GO TO 360
      IF (NZ .EQ. 0)  GO TO 280
      IF (MU .EQ. 0)  GO TO 290
      MP = MP + 1
      IF (NZ .EQ. MT) GO TO 270
      IF (A(43) .LT. 1.E-6) GO TO 290
  270 IF (MP .NE. INT(G(NG))) GO TO 290
      N = INT(ABS(G(NG + 1))) * NM + NL
      K = INT(ABS(G(NG + 2))) * NM + NL
      L = INT(ABS(G(NG + 3))) * NM + NL
      IF (A(23) .LE. 0.5) THEN
        IF (AMOD(G(NG), 1.0) .GT. 0.25) N = N + 1
        DO I = 1, NQ
          B(I) = B(I) + A(N) * A(K) * A(L)
          N = N + 2
          K = K + 2
          L = L + 2
        END DO
      ELSE
        I = INT(12.0 * AMOD(G(NG), 1.0))
        Q = SN(I + 1)
        P = SN(I + 4)
        R = SIGN (1.0, G(NG + 1))
        S = SIGN (1.0, G(NG + 2))
        T = SIGN (1.0, G(NG + 3))
        DO I = 1, NQ
          U = A(N) * A(K) - A(N + 1) * A(K + 1) * R * S
          V = A(N) * A(K + 1) * S + A(N + 1) * A(K) * R
          X = U * A(L) - V * A(L + 1) * T
          Y = U * A(L + 1) * T + V * A(L)
          B(I) = B(I) + P * X + Q * Y
          C(I) = C(I) - P * Y + Q * X
          N = N + 2
          K = K + 2
          L = L + 2
        END DO
      END IF
      NG = NG + 4
      IF (NG .GE. 122) THEN
        READ (LG) G
        NG = 1
      END IF
      GO TO 270
  280 M  = M + 2
      Z  = A(M)
      RR = A(M + 1)
  290 L  = 4 * INT(XQ) + LX + 4
      K  = MU
      IF (L .GE. NB) MU = 1
      IF (K .EQ. 0) GO TO 160
      P = AMOD(A(L + 1), 10.0)
      IF (A(L + 1) .GE. 10.0) THEN
        Q = 0.261799 * AINT(0.1 * A(L + 1))
        U = COS(Q)
        V = SIN(Q)
        IF (NZ .LE. 0) THEN
          DO K = 1, MM
            X    = D(K) * U + E(K) * V
            E(K) = X * V
            D(K) = X * U
          END DO
        ELSE
          DO K = 1, NQ
            X    = B(K) * U + C(K) * V
            Y    = D(K) * U + E(K) * V
            C(K) = X * V
            E(K) = Y * V
            B(K) = X * U
            D(K) = Y * U
          END DO
        END IF
      END IF
      T = P * A(45)
      IF (NZ .GT. 0) Z = A(L + 3)
      ZG = 1.0 / (Z + 5.0)
      IF (NZ .EQ. 0) THEN
        GO TO 320
      ELSE IF (NZ .GT. 0) THEN
        GO TO 340
      END IF
      IF (IZ .GT. 0) GO TO 320
      IF (A(23) .GT. 0.5) GO TO 310
      DO K = 1, MQ
        F(K) = F(K) + (Z - T * ABS(D(K)))**2
        D(K) = -1.E-6
      END DO
      GO TO 250
  300 DO K = 1, MM
        W        = SIGN (P, D(K)) * MIN (1.0, D(K)**2 * RR)
        D(K)     = -1.E-6
        A(J + 1) = -W
        A(J)     = W
        J        = J + 2
      END DO
      GO TO 330
  310 DO K = 1, MQ
        F(K) = F(K) + (Z - T * SQRT(D(K)**2 + E(K)**2))**2
        E(K) = 0.0
        D(K) = -1.E-6
      END DO
      GO TO 250
  320 IF (A(23) .LT. 0.5) GO TO 300
      DO K = 1, MM
        W        = D(K)**2 + E(K)**2
        W        = P * MIN (1.0, W * RR) / SQRT(W)
        A(J + 1) = W * E(K)
        E(K)     = 0.0
        A(J)     = W * D(K)
        D(K)     = - 1.E-6
        J        = J + 2
      END DO
  330 IF (L .LT. NB) GO TO 250
      GO TO 360
  340 ZZ = (Z / T)**2
      ZT = ZZ
      IF (A(L + 1) .GT. 10.0) ZT = 9.E9
      IF (NZ .GE. MT) THEN
        IF (A(23) .LE. 0.5) THEN
          DO K = 1, NQ
            W     = B(K) * D(K)
            FB(K) = FB(K) + W
            FC(K) = FC(K) + ABS(W)
            W     = T * ABS(D(K))
            FD(K) = FD(K) + ZG * (Z - W)**2
            FE(K) = FE(K) + W
          END DO
        ELSE
          DO K = 1, NQ
            FB(K) = FB(K) + B(K) * D(K) + C(K) * E(K)
            W     = SQRT(D(K)**2 + E(K)**2)
            FC(K) = FC(K) + W * SQRT(B(K)**2 + C(K)**2)
            FD(K) = FD(K) + ZG * (Z - W * T)**2
            FE(K) = FE(K) + W * T
          END DO
        END IF
        IF (L .GT. NC) GO TO 350
      END IF
      IF (L .GT. NA) THEN
        IF (A(23) .GE. 0.5) THEN
          DO K = 1, NQ
            U = D(K) - A(43) * B(K)
            V = E(K) - A(43) * C(K)
            W = U**2 + V**2
            X = D(K)**2 + E(K)**2
            IF (X .GE. ZT) THEN
              X = ZZ / X
              Y = SIGN (SQRT (ABS(1.0 -X)), B(K) * E(K) - D(K) * C(K))
              X = SQRT(X)
              U = D(K) * X - E(K) * Y
              V = E(K) * X + D(K) * Y
            END IF
            W = P / SQRT(W)
            A(J + 1) = W * V
            A(J) = W * U
            J = J + 2
          END DO
        ELSE
          DO K = 1, NQ
            W        = SIGN (P, D(K) - A(43) * B(K))
            A(J + 1) = -W
            A(J)     =  W
            J        = J + 2
          END DO
        END IF
      END IF
  350 DO K = 1, NQ
        B(K) = 0.0
        C(K) = 0.0
        D(K) = -1.E-6
        E(K) = 0.0
      END DO
      IF (NZ .EQ. MT) GO TO 160
      IF (L .LT. NC)  GO TO 240
  360 IF (NZ .GT. 0) GO TO 130
      M  = LD + 2
      IZ = IZ - 1
      IF (IZ .GT. NZ) GO TO 250
      IF (NZ .EQ. 0)  GO TO 140
      J = MS
  370 J = J + 4
      IF (J .LE. ME) THEN
        K = INT(A(J)) * MH + ML
        L = INT(ABS(A(J + 1))) * MH + ML
        M = INT(ABS(A(J + 2))) * MH + ML
        N = INT(ABS(A(J + 3))) * MH + ML
        IF (A(23) .LE. 0.5) THEN
          IF (AMOD(A(J), 1.0) .GT. 0.25) K = K + 1
          DO I = 1, MQ
            E(I) = E(I) + A(K) * A(L) * A(M) * A(N)
            K    = K + 2
            L    = L + 2
            M    = M + 2
            N    = N + 2
          END DO
          GO TO 370
        END IF
        I = INT(12.0 * AMOD(A(J), 1.0))
        Q = SN(I + 1)
        P = SN(I + 4)
        R = SIGN (1.0, A(J + 1))
        S = SIGN (1.0, A(J + 2))
        T = SIGN (1.0, A(J + 3))
        DO I = 1, MQ
          U = A(K) * A(L) - A(K + 1) * A(L + 1) * R
          V = A(K) * A(L + 1) * R + A(K + 1) * A(L)
          X = U*A(M) - V * A(M + 1) * S
          Y = U*A(M + 1) * S + V * A(M)
          E(I) = E(I) + P * (X * A(N) - V * A(N + 1) * T)
     1         - Q * (Y * A(N + 1) * T + X * A(N))
          K = K + 2
          L = L + 2
          M = M + 2
          N = N + 2
        END DO
        GO TO 370
      END IF
      J = 0
      Q = -9.E9
  380 DO I = 1, NQ
        IF (PM(I) .GE. Q) THEN
          Q = PM(I)
          M = I
        END IF
      END DO
  390 J = J + 1
      IF (J .LE. MQ) THEN
        P = F(J) / A(28)
        IF (WF .GT. 0.1) P = P + MAX (0.0, E(J) / WF + 0.25)**2
        F(J) = 0.0
        E(J) = 0.0
        IF (P .GT. Q) GO TO 390
        PM(M) = P
        PR(M) = G(J)
        Q     = P
        GO TO 380
      END IF
      PN = PN + 1.0
      IF (A(39) .GE. 0.0) THEN
        IF (Q .GE. 0.125) THEN
          IF (PN .LT. 5.0) GO TO 110
        END IF
      END IF
      MM = NQ
      DO I = 1, NQ
        G(I) = PR(I)
      END DO
      NZ = 0
      GO TO 120
  400 Q = 9.E9
      R = 0.0
      V = 0.0
      T = 0.0
      M = 0
      DO K = 1, NQ
        D(K) = FB(K) / FC(K)
        E(K) = FE(K) / TS
        C(K) = FD(K) / TZ
        P    = C(K)
        IF (ABS(FC(K)) .GT. 0.001) P = P + MAX (0.0, D(K) - A(42))**2
        I = INT(MIN(31.5, 1.0 + 50.0 * P))
        ID(I) = ID(I) + 1
        IF (P .LE. Q) THEN
          Q = P
          R = C(K)
          S = D(K)
          W = PR(K)
          V = PM(K)
          T = E(K)
          M = K
        END IF
        B(K) = P
      END DO
      IF (TN .LT. 0.8 .OR. A(40) .LE. 0.0) THEN
        DO K = 1, NQ
          J       = 1
          IR(1:1) = ' '
          IF (K .EQ. M) IR(1:1) = '*'
          L = K + K - 2 + NL
          N = ME
  410     N = N + 1
          IF (N .LE. NS) THEN
            I = INT(A(N)) * NM + L
            J       = J + 1
            IR(J:J) = '+'
            IF (A(I) .LT. 0.0) IR(J:J) = '-'
            GO TO 410
          END IF
        END DO
      END IF
      M = M + M - 2 + NL
      K = 0
      J = 1
      IR(1:1) = ' '
      N = ME
      DO WHILE (N .LE. NS - 1)
        N       = N + 1
        I       = INT(A(N)) * NM + M
        J       = J + 1
        IR(J:J) = '+'
        IF (A(I) .LT. 0.0) IR(J:J) = '-'
      END DO
      IF (PQ .GE. Q) THEN
        I = LX + 4
        DO WHILE (I .LE. NC - 4)
          I = I + 4
          M = M + NM
          U = -9.E9
          IF (ABS(A(M)) + ABS(A(M + 1)) .GT. 0.01)
     1      U = 57.29578 * ATAN2(A(M + 1) * A(23), A(M))
          IF (U .LT. 0.0) U = U + 360.0
          A(I + 2) = U
        END DO
        PQ = Q
        PS = W
      END IF
      TN = TN + FLOAT(NQ)
      IF (TN .LT. A(39)) GO TO 100
      DO I = 1, 31
        F(I) = FLOAT(I - 1) * 0.02
      END DO
      F(32) = 9.999
      WRITE (LI, 99997, IOSTAT = IOST)
     1  (F(I), F(I + 1), ID(I), I = 1, 31)
      IF (TN .LT. 1.1) TN = 1.1
      WRITE (LI, 99998, IOSTAT = IOST) TN, PS, PQ
      K = 0
      I = NA
  420 M = 0
  430 I = I + 4
      IF (I .LE. NC) THEN
        K    = K + 1
        A(I) = ABS(A(I))
        IF (A(I + 2) .LT. - 8.E9) GO TO 430
        NA        = NA + 4
        P         = A(NA)
        A(NA)     = A(I)
        A(I)      = P
        P         = A(NA + 1)
        A(NA + 1) = A(I + 1)
        A(I  + 1) = P
        P         = A(NA + 2)
        A(NA + 2) = A(I + 2)
        A(I + 2)  = P
        CALL GEN046 (A(NA), X, Y, Z)
        M          = M + 1
        IP(M)      = K
        IP(M + 4)  = INT(X)
        IP(M + 8)  = INT(Y)
        IP(M + 12) = INT(Z)
        IP(M + 16) = INT(A(NA + 2) + 0.5)
        F(M)       = AMOD(A(NA + 1), 10.0)
        Q          = 0.0174533 * A(NA + 2)
        P          = F(M) * COS(Q)
        Q          = F(M) * SIN(Q)
        GO TO 420
      END IF
      IF (M .GT. 0) WRITE (LI, 99996, IOSTAT = IOST) (IP(J), IP(J + 4),
     1 IP(J + 8), IP(J + 12), F(J), IP(J + 16), J = 1, M)
      M  = 0
      P  = 0.0
      LE = NA
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (//, I4, ' NQR Included in Filter')
99998 FORMAT (//, F10.0, ' Phase Sets Refined - Best Solution is Code',
     1        F10.0, '  With CFOM =', F8.4)
99997 FORMAT (//, 'CFOM Range   Frequency', /,
     1        31(/F6.3, ' - ', F5.3, I7))
99996 FORMAT (4(I7, '.', 3I4, F6.3, I4))
      END SUBROUTINE PLA158
      SUBROUTINE PLA159
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NPP=NVD+2*NP23,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /SHX/ F(126), G(126), LR, LG, LH, LI, LP, LF, LA, LB,
     1 LY, LL, LQ, LE, LV, LX, LD, LZ, LJ, HKLF(11)
      COMMON // A(NPP)
      W  = 0.0
   10 NA = LE
      NZ = INT(A(54))
      IF (NZ .LT. 4) GO TO 240
      IF (NZ .EQ. 5) GO TO 240
      IF (NA .LE. LX - 4) GO TO 240
      NT    = LD + 4
      A(NT) = 0.0
      PQ    = 10.0
      NB    = LX + 4
      I     = NB
   20 I     = I + 4
      P     = AMOD (A(I + 1), 10.0)
      Q     = 1.74533E-2 * A(I + 2)
      A(I + 2) = P * COS(Q)
      A(I + 3) = P * SIN(Q)
      IF (I .LT. NA) GO TO 20
   30 IF (NT .LE. NPP - 6) THEN
        NQ = NT
        I  = NB
   40   I  = I + 4
        IF (I .LE. NA) THEN
          CALL GEN046 (A(I), X, Y, Z)
          DO 60 J = 65, LY, 12
            P = 6.283185 * (X * A(J + 9) + Y * A(J + 10)
     1        + Z * A(J + 11))
            U = COS(P)
            V = SIN(P)
            P = U * A(I + 2) + V * A(I + 3)
            Q = U * A(I + 3) - V * A(I + 2)
            W = AINT(1.001 * (X * A(J) + Y * A(J + 3) + Z * A(J + 6)))
     1        + 200.0 * (AINT(1.001 * (X * A(J + 1) + Y * A(J + 4)
     2        + Z * A(J + 7))) + 200.0 * AINT(1.001 * (X * A(J + 2)
     3        + Y * A(J + 5) + Z * A(J + 8))))
            IF (W .LT. 0.0) Q = - Q
            W = ABS(W)
            K = NQ
   50       K = K + 3
            IF (K .LE. NT) THEN
              IF (ABS(W - A(K)) .LT. 0.5) THEN
                GO TO 60
              ELSE
                GO TO 50
              END IF
            END IF
            NT    = NT + 3
            A(NT) = W
            A(NT + 1) = P
            A(NT + 2) = Q * A(23)
            IF (NT .GT. NPP - 6) GO TO 70
   60     CONTINUE
          NQ = NT
          GO TO 40
        END IF
   70   LZ    = NT + 3
        A(LZ) = 9.E9
        M     = (LZ - LD) / 3
   80   M     = M / 2
        IF (M .GT. 0) THEN
          N = M * 3
          K = LZ - N
          J = LD + 4
   90     I = J
  100     L = I + N
          IF (A(I) .GE. A(L)) THEN
            Q    = A(L)
            A(L) = A(I)
            A(I) = Q
            Q    = A(L + 1)
            A(L + 1) = A(I + 1)
            A(I + 1) = Q
            Q        = A(L + 2)
            A(L + 2) = A(I + 2)
            A(I + 2) = Q
            I = I - N
            IF (I .GT. LD + 4) GO TO 100
          END IF
          J = J + 3
          IF (J .GT. K) THEN
            GO TO 80
          ELSE
            GO TO 90
          END IF
        END IF
      END IF
  110 NB = NA
      S  = 0.0
      L  = NB
  120 L  = L + 4
      IF (L .LE. LD) THEN
        P = AMOD(A(L + 1), 10.0)
        U = 0.0
        V = 0.0
        Z = A(L) - 0.5
        Q = 1.0
        I = LD + 4
        K = I
        M = NT
  130   J = M
  140   M = K + 3 * ((J - K) / 6)
        IF (A(M) .GT. Z) GO TO 130
        K = M
        IF (J .GT. K + 3) GO TO 140
        Z = Z + 0.5
  150   I = I + 3
  160   IF (I .GT. J) GO TO 180
        X = Z - A(I) - A(J)
        IF (X .GT.   0.5) GO TO 150
        IF (X .LE. - 0.5) THEN
          J = J - 3
          GO TO 160
        END IF
  170   U = U + A(I + 1) * A(J + 1) - A(I + 2) * A(J + 2) * Q
        V = V + A(I + 1) * A(J + 2) + A(I + 2) * A(J + 1) * Q
        IF (Q .LT. 0.0) THEN
          GO TO 190
        ELSE
          GO TO 150
        END IF
  180   I = LD + 4
        J = M
        Q = -1.0
  190   I = I + 3
  200   X = Z + A(I) - A(J)
        IF (X .LT. -0.5) GO TO 190
        IF (X .LT.  0.5) GO TO 170
        J = J + 3
        IF (J .LT. LZ) GO TO 200
        IF (A(L + 1) .GE. 10.0) THEN
          W = 0.261799 * AINT(0.1 * A(L + 1))
          X = COS(W)
          W = SIN(W)
          V = X * U + W * V
          U = X * V
          V = W * V
        END IF
        W = SQRT(U * U + V * V)
        X = P * W * A(45)
        IF (S .LT. X) S = X
        IF (X .LT. PQ) GO TO 120
        NA = NA + 4
        Q = A(L)
        T = A(L + 1)
        J = L
  210   J = J - 4
        IF (J .GE. NA) THEN
          A(J + 4) = A(J)
          A(J + 5) = A(J + 1)
          GO TO 210
        END IF
        A(NA) = Q
        A(NA + 1) = T
        A(NA + 2) = P * U / W
        A(NA + 3) = P * V * A(23) / W
        IF (NA - NB .LT. 400) GO TO 120
      END IF
      PQ = PQ * 0.8
      IF (S .GE. 0.1) THEN
        IF (NA .NE. LD) THEN
          IF (NA .GT. NB) GO TO 30
          PQ = 0.8 * S
          GO TO 110
        END IF
      END IF
      I = (NA - LX - 4) / 4
      J = (LD - LX - 4) / 4
      P = ABS(A(26))
      I = LX + 4
  220 N = - 2
  230 I = I + 4
      IF (I .LE. NA) THEN
        N        = N + 3
        F(N)     = A(I)
        F(N + 1) = A(I + 2)
        F(N + 2) = A(I + 3)
        IF (N .LT. 124) GO TO 230
        WRITE (LA) F
        GO TO 220
      END IF
      N    = N + 3
      F(N) = 0.0
      WRITE (LA) F
      CALL GEN108 (LA, 0)
      LE = - 1
  240 IF (NZ .EQ. 0) GO TO 370
      IF (ABS(A(55)) .LE. 0.5) THEN
        WP = 1.0
        IF (NZ .LT. 4) WP = 0.0
        XJ = A(2)
        YJ = A(3)
        ZJ = A(4)
        IX = 0
        IY = 0
        IZ = 0
        KP = 1
        IF (A(23) .GE. 0.5) THEN
          IF (NZ .LT. 4) KP = 2
        END IF
        ML = LY + 12
        DO I = 1, 3
          J = I + 30
          DO K = I, J, 6
            F(K)     = 9.E9
            F(K + 3) = 1.0
          END DO
        END DO
        DO L = ML, LL, 4
          DO N = 65, LY, 12
            W = A(L)
            DO K = 1, KP
              WWP = W * WP
              X = AMOD(A(N +  9) * WWP + A(L + 1) + 0.501, 1.0) - 0.001
              Y = AMOD(A(N + 10) * WWP + A(L + 2) + 0.501, 1.0) - 0.001
              Z = AMOD(A(N + 11) * WWP + A(L + 3) + 0.501, 1.0) - 0.001
              IX = 9
              IF (MAX (ABS(A(N + 1)), ABS(A(N + 2))) .LE. 0.01) THEN
                IX = 1
                IF (ABS(X) .LE. 0.01) THEN
                  IF (A(N) * W .GE. 0.5) IX = 0
                END IF
              END IF
              IY = 9
              IF (MAX (ABS(A(N + 3)), ABS(A(N + 5))) .LE. 0.01) THEN
                IY = 1
                IF (ABS(Y) .LE. 0.01) THEN
                  IF (A(N + 4) * W .GE. 0.5) IY = 0
                END IF
              END IF
              IZ = 9
              IF (MAX (ABS(A(N + 6)), ABS(A(N + 7))) .LE. 0.01) THEN
                IZ = 1
                IF (ABS(Z) .LE. 0.01) THEN
                  IF (A(N + 8) * W .GE. 0.5) IZ = 0
                END IF
                IF (A(N + 8) * W .GE. 0.0) THEN
                  IF (IZ .NE. 0) THEN
                    IF (IX + IY .LT. 1) F(6) = MIN (F(6),  Z)
                    IF (IX .LT. 1) F(12)     = MIN (F(12), Z)
                    IF (IY .LT. 1) F(18)     = MIN (F(18), Z)
                    IF (F(30) .GT. Z) F(30)  = Z
                  END IF
                  GO TO 250
                END IF
                IF (IX + IY .LT. 1) F(3) = MIN (F(3),  Z)
                IF (IX .LT. 1) F(9)      = MIN (F(9),  Z)
                IF (IY .LT. 1) F(15)     = MIN (F(15), Z)
                IF (F(27) .GT. Z) F(27)  = Z
              END IF
  250         IF (IY .LT. 2) THEN
                IF (A(N + 4) * W .GE. 0.0) THEN
                  IF (IY .NE. 0) THEN
                    IF (IX + IZ .LT. 1) F(11) = MIN (F(11), Y)
                    IF (IX .LT. 1)      F(5)  = MIN (F(5),  Y)
                    IF (IZ .LT. 1)      F(35) = MIN (F(35), Y)
                    IF (F(17) .GT. Y)   F(17) = Y
                  END IF
                  GO TO 260
                END IF
                IF (IX + IZ .LT. 1) F(8)  = MIN (F(8),  Y)
                IF (IX .LT. 1)      F(2)  = MIN (F(2),  Y)
                IF (IZ .LT. 1)      F(32) = MIN (F(32), Y)
                IF (F(14) .GT. Y)   F(14) = Y
              END IF
  260         IF (IX .LT. 2) THEN
                IF (A(N) * W .GE. 0.0) THEN
                  IF (IX .NE. 0) THEN
                    IF (IY + IZ .LT. 1) F(16) = MIN (F(16), X)
                    IF (IY .LT. 1)      F(22) = MIN (F(22), X)
                    IF (IZ .LT. 1)      F(28) = MIN (F(28), X)
                    IF (F(4) .GT. X) F(4) = X
                  END IF
                ELSE
                  IF (IY + IZ .LT. 1) F(13) = MIN (F(13), X)
                  IF (IY .LT. 1)      F(19) = MIN (F(19), X)
                  IF (IZ .LT. 1)      F(25) = MIN (F(25), X)
                  IF (F(1) .GT. X)    F(1)  = X
                END IF
              END IF
              W = - W
            END DO
          END DO
        END DO
        DO I = 1, 27, 13
          F(I + 6) = F(I)
          F(I + 9) = F(I + 3)
        END DO
        DO I = 3, 13, 5
          F(I + 18) = F(I)
          F(I + 21) = F(I + 3)
        END DO
        DO I = 1, 31, 6
          J = I + 2
          DO K = I, J
            F(K) = 0.5 * F(K)
            IF (F(K) .LT. 1.0) F(K + 3) = 0.5 * F(K + 3)
            IF (F(K) .GT. 1.0) F(K) = 0.0
          END DO
        END DO
        RE = 19.6 * A(1) / SQRT(A(64))
        U  = 9.E9
        DO M = 1, 31, 6
          DO N = 1, 3
            L = N
  270       K = 1
            IF (0.501 .LE. F(M + 5)) K = 2
            J = 1
            IF (0.501 .LE. F(M + 4)) J = 2
            V = FLOAT(J * K) * F(M + 3)
            IF (V .LE. U) THEN
              IF (U .GT. V + 0.01) W = 9.E9
              U = V + 0.001
              X = YJ * FLOAT(J) - RE
              Y = ZJ * FLOAT(K) - RE
              Z = X * X + Y * Y
              IF (Z .LE. W) THEN
                W = Z
                A(55) = FLOAT(L)
                IX = INT(100.01 * F(M + 1)) - J
                IY = INT(100.01 * F(M + 2)) - K
                IZ = J
                KP = K
                A(56) = INT(3.5 + 100.0 * F(M + 3) * XJ / RE)
                A(36) = F(M + 3) * 100.0 / (A(56) - 3.0)
                A(33) = 100.0 * F(M) - A(36)
              END IF
            END IF
            CALL GEN018 (YJ, ZJ)
            CALL GEN018 (F(M + 1), F(M + 2))
            CALL GEN018 (F(M + 4), F(M + 5))
            L = -L
            IF (L .LT. 0) GO TO 270
            X  = XJ
            XJ = YJ
            YJ = ZJ
            ZJ = X
            X  = F(M)
            F(M)     = F(M + 1)
            F(M + 1) = F(M + 2)
            F(M + 2) = X
            X        = F(M + 3)
            F(M + 3) = F(M + 4)
            F(M + 4) = F(M + 5)
            F(M + 5) = X
          END DO
        END DO
        J = INT(A(55))
        K = INT(A(56))
        L = NZ
        IF (NZ .EQ. 2) L = 6
        A(34) = IX
        A(35) = IY
        A(37) = IZ
        A(38) = KP
      END IF
      IF (NZ .LT. 7) GO TO 370
      IF (LE .LT. 0) GO TO 370
      A(54) = A(54) - 1.0
      LZ = LD + 8
      MB = LZ + 1251
      NB = MB - 9
      RC = 0.0
      HM = 0.0
      S  = 27.0 * (A(57) - 5.0)
      R  = S
      T  = 0.0
      I  = LV
      DO WHILE (I .LE. LD - 8)
        I  = I + 8
        J        = INT(A(I + 1) * 0.001) * 5 + LJ
        A(I + 6) = A(J)
        IF (I .LE. LX) THEN
          IF (HM .LT. A(J)) HM = A(J)
          R = R + A(I + 5) * A(J) * A(J)
        END IF
      END DO
      DO
        READ (LF) F
        DO I = 1, 124, 3
          IF (F(I) .LT. 0.5) GO TO 310
          IF (F(I + 1) .GE. 0.0) THEN
            P = AMOD(F(I + 1), 10.0)
            IF (ABS(P**2 - 0.8) .GE. T) THEN
  280         IF (NB + 16 .GE. NPP) THEN
                T = T + 0.05
                J = MB
  290           J = J + 9
  300           IF (J .GT. NB) GO TO 280
                IF (ABS(A(NB + 5)**2 - 0.8) .GT. T) GO TO 290
                A(J + 4) = A(NB + 4)
                A(J + 5) = A(NB + 5)
                A(J + 6) = A(NB + 6)
                NB = NB - 9
                GO TO 300
              END IF
              NB        = NB + 9
              A(NB + 6) = F(I)
              A(NB + 5) = P
              A(NB + 4) = F(I + 2)
            END IF
          END IF
        END DO
      END DO
  310 CALL GEN108 (LF, 0)
      DO I = MB, NB, 9
        CALL GEN046 (A(I + 6), X, Y, Z)
        A(I)     = X
        A(I + 1) = Y
        A(I + 2) = Z
        Q = SQRT(X * X * A(14) + Y * Y * A(15) + Z * Z * A(16)
     1    + Y * Z * A(17) + X * Z * A(18) + X * Y * A(19)) / A(1)
        A(I + 7) = 47.0 * Q * SQRT(Q)
        T        = S * (3.834 / (3.834 + A(I + 7)))**2
        J        = LV
        DO WHILE (J .LE. LX - 8)
          J = J + 8
          K = INT(A(J + 1) * 0.001) * 5 + LJ
          W = SQRT(A(K) * SQRT(A(K)))
          T = T + A(J + 5) * (W * A(K) / (W + A(I + 7)))**2
        END DO
        P        = A(I + 5)
        A(I + 8) = SQRT(R / T)
        P        = P / A(I + 8)
        A(I + 3) = P
        RC       = RC + P * P
        A(I + 5) = 0.0
        A(I + 6) = 0.0
      END DO
      J = LZ
      DO I = 1, 1251
        A(J) = SIN(6.283185E-3 * FLOAT(I - 1))
        J    = J + 1
      END DO
      IX = (LD - LX) / 16
      IZ = LV + 1
      NA = LD + 8
      KP = (LD - LV) / 8
      SM = 0.0
      IY = 0
  320 I  = NA
  330 I  = I - 8
      IF (I .LT. IZ) GO TO 360
      IF (A(I + 5) .EQ. 0.0) GO TO 330
      NK = -2
      DO J = 65, LY, 12
        NK = NK + 3
        G(NK) = 1000.0 * (A(I + 2) * A(J) + A(I + 3) * A(J + 1)
     1        +  A(I + 4) * A(J + 2) + A(J + 9))
        G(NK + 1) = 1000.0 * (A(I + 2) * A(J + 3)
     1            + A(I + 3) * A(J + 4)
     2            + A(I + 4) * A(J + 5) + A(J + 10))
        G(NK + 2) = 1000.0 * (A(I + 2) * A(J + 6)
     1            + A(I + 3) * A(J + 7)
     2            + A(I + 4) * A(J + 8) + A(J + 11))
      END DO
  340 RA = 0.0
      RB = 0.0
      X = G(1)
      Y = G(2)
      Z = G(3)
      W = SQRT(A(I + 6) * SQRT(A(I + 6)))
      T = W * A(I + 6) * A(I + 5) * A(24)
      IF (LY .EQ. 65) THEN
        DO J = MB, NB, 9
          KZ = LZ + INT(AMOD(1000000.5 + A(J) * X + A(J + 1) * Y
     1       + A(J + 2) * Z, 1000.0))
          O  = T / (W + A(J + 7))
          U  = A(J + 5) - A(KZ + 250) * O
          V  = A(J + 6) - A(KZ) * O * A(23)
          S  = (V * V + U * U) / A(J + 4)
          RA = RA + S
          IF (IX .GE. IY) THEN
            A(J + 6) = V
            A(J + 5) = U
          END IF
          RB = RB + A(J + 3) * SQRT(S)
        END DO
      ELSE
        XJ = G(4)
        YJ = G(5)
        ZJ = G(6)
        IF (LY .EQ. 77) THEN
          DO J = MB, NB, 9
            KZ = LZ + INT(AMOD(1000000.5 + A(J) * X + A(J + 1) * Y
     1         + A(J + 2) * Z, 1000.0))
            KY = LZ + INT(AMOD(1000000.5 + A(J) * XJ + A(J + 1) * YJ
     1         + A(J + 2) * ZJ, 1000.0))
            O  = T / (W + A(J + 7))
            U  = A(J + 5) - O * (A(KZ + 250) + A(KY + 250))
            V  = A(J + 6) - A(23) * O * (A(KZ) + A(KY))
            S  = (V * V + U * U) / A(J + 4)
            RA = RA + S
            IF (IX .GE. IY) THEN
              A(J + 6) = V
              A(J + 5) = U
            END IF
            RB = RB + SQRT(S) * A(J + 3)
          END DO
        ELSE IF (LY .EQ. 101) THEN
          XK = G(7)
          YK = G(8)
          ZK = G(9)
          XL = G(10)
          YL = G(11)
          ZL = G(12)
          DO J = MB, NB, 9
            KZ = LZ + INT(AMOD(1000000.5 + A(J) * X  + A(J + 1) * Y
     1         + A(J + 2) * Z, 1000.0))
            KY = LZ + INT(AMOD(1000000.5 + A(J) * XJ + A(J + 1) * YJ
     1         + A(J + 2) * ZJ, 1000.0))
            KX = LZ + INT(AMOD(1000000.5 + A(J) * XK + A(J + 1) * YK
     1         + A(J + 2) * ZK, 1000.0))
            KW = LZ + INT(AMOD(1000000.5 + A(J) * XL + A(J + 1) * YL
     1         + A(J + 2) * ZL, 1000.0))
            O  = T / (W + A(J + 7))
            U  = A(J + 5) - O * (A(KZ + 250) + A(KY + 250)
     1         + A(KX + 250) + A(KW + 250))
            V  = A(J + 6) - A(23) * O * (A(KZ) + A(KY) + A(KX) + A(KW))
            S  = (V * V + U * U) / A(J + 4)
            RA = RA + S
            IF (IX .GE. IY) THEN
              A(J + 6) = V
              A(J + 5) = U
            END IF
            RB = RB + SQRT(S) * A(J + 3)
          END DO
        ELSE
          DO J = MB, NB, 9
            X = 0.0
            Y = 0.0
            DO K = 1, NK, 3
              KZ = LZ + INT(AMOD(1000000.5 + A(J) * G(K)
     1           + A(J + 1) * G(K + 1) + A(J + 2) * G(K + 2), 1000.0))
              X  = X + A(KZ + 250)
              Y  = Y + A(KZ)
            END DO
            O  = T / (W + A(J + 7))
            V  = A(J + 6) - Y * A(23) * O
            U  = A(J + 5) - X * O
            S  = (U * U + V * V) / A(J + 4)
            RA = RA + S
            IF (IX .GE. IY) THEN
              A(J + 6) = V
              A(J + 5) = U
            END IF
            RB = RB + SQRT(S) * A(J + 3)
          END DO
        END IF
      END IF
      W = RB * RB / (RA * RC)
      IF (IY .LT. 0) THEN
        GO TO 350
      ELSE IF (IY .EQ. 0) THEN
        GO TO 330
      END IF
      IF (W .LT. SM) GO TO 330
      IY = -IY
      GO TO 340
  350 A(I + 5) = 0.0
      KP       = KP - 1
      IX       = IX - 1
      IY       = - IY
      SM       = W
  360 IF (IY .NE. IX + 1) THEN
        IF (IY .EQ. 0) THEN
          SM = W
          IZ = LX + 1
          DO J = MB, NB, 9
            A(J + 5) = - A(J + 5)
            A(J + 6) = - A(J + 6)
          END DO
        END IF
        IF (IX .GT. 0) THEN
          IF (I .GT. IZ - 1) GO TO 330
          IY = IX + 1
          GO TO 320
        END IF
      END IF
      I    = 1
      G(1) = -0.5
      G(2) = 0.8
      G(3) = -0.02
      G(4) = -0.5
      G(5) = 1.9
      G(6) = -0.02
      G(7) = 1.0
      G(8) = 2.4
      G(9) = -0.01
      X    = 0.0
      Y    = 0.0
      DO J = MB, NB, 9
        X = X + A(J + 5) * A(J + 5) + A(J + 6) * A(J + 6)
        Y = Y + A(J + 3) * A(J + 3)
      END DO
      X = SQRT(Y / X)
      DO J = MB, NB, 9
        F(I) = A(J) + 200.0 * (A(J + 1) + 200.0 * A(J + 2))
        W = 1.0
        IF (HM .LE. 18.5) THEN
          U = A(14) * A(J) * A(J) + A(15) * A(J + 1) * A(J + 1) + A(16)
     1      * A(J + 2) * A(J + 2) + A(17) * A(J + 1) * A(J + 2)
     2      + A(18) * A(J) * A(J + 2) + A(19) * A(J) * A(J + 1)
          U = U * RGBL(8) / (A(1) * A(1))
          S = SQRT(U + U)
          DO K = 1, 7, 3
            V = G(K + 1) * S
            W = W + G(K) * SIN(V) * EXP(U * G(K+2)) / V
          END DO
          W = SQRT(W)
        END IF
        U = X * A(J + 5)
        V = X * A(J + 6)
        S = SQRT(U * U + V * V)
        O = SQRT(1.0 / A(J + 4))
        T = 100.0 * W * (2.0 * A(J + 3) * TANH(S * O * A(J + 3)
     1    * A(J + 8)**2) / S - O)
        IF (A(54) .GT. 6.5) T = T * A(J + 8)
        F(I + 1) = U * T
        F(I + 2) = V * T
        IF (I .GE. 124) THEN
          WRITE (LA) F
          I = -2
        END IF
        I = I + 3
      END DO
      F(I) = 0.0
      WRITE (LA) F
      CALL GEN108 (LA, 0)
      S = SQRT(1.0 - SM)
      J = (NB - MB + 9) / 9
      I = NB + 8
      M  = 0
      P  = 0.0
  370 LE = 0
      I  = LV
      DO WHILE (I .LE. LX - 8)
        I  = I + 8
        J = INT(0.001 * A(I + 1)) * 5 + LJ
        A(I + 7) = (0.1 + A(J + 1))**2
      END DO
      IF (A(57) .LT. 0.0) LX = LV
      RR = 0.1
      IF (MAX (A(5), A(6), A(7)) .GT. 110.0) RR = 0.3
      NZ = INT(A(54))
      IF (NZ .EQ. 6) NZ = 4
      IF (NZ .GT. 6) NZ = 6
      LX = MIN (LX, LV)
      RR = 0.5
      LD = LX
      IF (NZ .EQ. 0) GO TO 500
      IF (ABS(A(57)) .LT. 0.5) GO TO 500
      TP        = A(LX + 6)
      A(LX + 6) = 9.E9
      MP        = (INT(ABS(A(57))) * 8) + LX
      A(MP + 6) = MAX (0.0, 0.7 * A(20))
      ML        = LY + 12
      NX = INT(A(56))
      LZ = MP + 16
      IF (LZ + 8600 .GT. NPP) GO TO 500
      NL = 0
      NH = LZ + 8134
      CALL GEN074 (A, LZ, NH, 0.0)
      MA = MAX (MIN (INT(ABS(A(55))), 3), 1)
      NS = LZ + 8427
      NA = NH - 3
      SS = 0.0
      ZZ = A(33)
      KP = 1
      NF = 1
      NG = 1
      WP = 1.0
  380 READ (LA) F
      I = - 2
  390 I = I + 3
      IF (I .GT. 124) GO TO 380
      IF (ABS(F(I)) .GE. 0.5) THEN
        S = F(I + 1) * F(I + 1) + F(I + 2) * F(I + 2)
        IF (S .LT. 1.E-10) GO TO 390
        U = SQRT(S)
        CALL GEN046 (F(I), X, Y, Z)
        EZ = 0.0
        L  = NA
        DO 410 K = 65, LY, 12
          P = AINT(1.001 * (X * A(K)+ Y * A(K + 3) + Z * A(K + 6)))
          Q = AINT(1.001 * (X * A(K + 1) + Y * A(K + 4) + Z * A(K + 7)))
          R = AINT(1.001 * (X * A(K + 2) + Y * A(K + 5) + Z * A(K + 8)))
          W = P + 200.0 * (Q + 200.0 * R)
          A(L + 7) = ABS(W)
          IF (ABS(W - F(I)) .LT. 0.5) EZ = EZ + 1.0
          IF (ABS(W + F(I)) .LT. 0.5 - A(23)) EZ = EZ + 1.0
          J = NA
  400     J = J + 4
          IF (J .LE. L) THEN
            IF (ABS(A(J + 3) - A(L + 7)) .LT. 0.5) THEN
              GO TO 410
            ELSE
              GO TO 400
            END IF
          END IF
          DO J = 1, MA
            A(L + 4) = P
            P = Q
            Q = R
            R = A(L + 4)
          END DO
          IF (A(55) .GE. 0.0) THEN
            T = P
            P = Q
            Q = T
          END IF
          IF (ABS(Q) .LE. 63.5) THEN
            T = 127.0 * P + Q
            IF (ABS(T) .LE. 8134.5) THEN
              M = INT(ABS(T) + 0.001) + LZ
              L = L + 4
              IF (NF .LE. 1) THEN
                A(M) = 1.1
                GO TO 410
              END IF
              A(L + 2) = 100.0 * (X * A(K + 9) + Y * A(K + 10)
     1                 + Z * A(K + 11))
              A(L + 1) = T
            END IF
          END IF
  410   CONTINUE
        IF (NF .EQ. 1) GO TO 390
        R = 0.0
        P = F(I + 1)
        K = NA
        T = SQRT(EZ)
        Q = F(I + 2)
        Q = Q * T
        P = P * T
  420   K = K + 4
        IF (K .GT. L) GO TO 390
        Y = SIGN (1.0, A(K + 1) + 0.1)
        X = Y * A(K)
        Z = Q * Y
        SS = SS + SQRT(P * P + Q * Q)
        T = ABS(A(K + 1)) + 0.001
        M = INT(T)+LZ
        N = INT(A(M))
        R = Y * A(K + 2)
        N = N * NH + NS
        A(N) = T
        S = 0.0628319 * (X * ZZ + R)
        O = SIN(S)
        S = COS(S)
        T = P * S + Z * O
        S = P * O - Z * S
        Z = 0.0628319 * X * A(36)
        W = COS(Z)
        Z = SIN(Z)
        M = N + 1
        DO N = 3, NH, 2
          A(M) = A(M) + T
          A(M + 1) = A(M + 1) + S
          O = T * W - S * Z
          S = T * Z + S * W
          T = O
          M = M + 2
        END DO
        GO TO 420
      END IF
      CALL GEN108 (LA, 0)
      IF (NF .EQ. 1) THEN
        NF = 2
        M  = 0
        DO I = LZ, NH
          M = M + INT(A(I))
        END DO
        IF (M .LE. 0) THEN
          WRITE (LI, 99999, IOSTAT = IOST)
        ELSE
          NH = MIN (NX, ((NPP - NS) / M - 1) / 2)
          IF (NH .GE. NX) THEN
            NH = NH + NH + 1
            IF (NH .GT. 2) GO TO 430
          END IF
        END IF
        GO TO 500
  430   NL = NS + (NH * M)
        CALL GEN074 (A, NS, NL, 0.0)
        K = 0
        L = LZ + 8134
        DO I = LZ, L
          IF (A(I) .GE. 0.5) THEN
            A(I) = FLOAT(K)
            K    = K + 1
          END IF
        END DO
        GO TO 380
      END IF
      NC    = -1
      NB    = -1
      NA    = LZ
      G(NG) = -1.0
      NG    = 0
      EZ    = 9999.0
      A(44) = 0.0
      YM    = AMOD(A(34) + 1000.1, 100.0) - 0.1
      ZM    = AMOD(A(35) + 1000.1, 100.0) - 0.1
      A(NL) = 1000000.0
      SS    = 999.1 / SS
      DO I = 1, 126
        G(I) = SIN(6.283185E-2 * FLOAT(I - 1))
      END DO
      MS = NS + 1
  440 Z  = 0.0
      W  = 63.5
      NK = NA + 2808
      CALL GEN074 (A, NA,  NK, 0.0)
      CALL GEN074 (F,  1, 106, 0.0)
      NK = MS
      DO I = NS, NL, NH
        IF (W .LE. A(I)) THEN
          K = INT(AMOD(Z * A(38), 100.0))
          L = INT(AMOD(Z * ZM, 100.0))
          N = NA
          DO J = 1, 53
            L = MOD(L, 100)
            W = G(L + 1)
            Z = G(L + 26)
            DO M = 1, 53
              A(N) = A(N) + F(M) * Z + F(M + 53) * W
              N = N + 1
            END DO
            L = L + K
          END DO
          IF (I .EQ. NL) GO TO 450
          Z = AINT(A(I) / 127.0 + 0.5) + 0.0001
          W = 127.0 * Z + 63.5
          CALL GEN074 (F, 1, 106, 0.0)
        END IF
        U = AMOD(A(I) + 63.0, 127.0) + 37.0
        K = INT(AMOD (U * A(37), 100.0))
        L = INT(AMOD (U * YM, 100.0))
        U = A(NK) * SS
        V = A(NK + 1) * SS
        DO J = 1, 53
          L = MOD(L, 100)
          F(J) = F(J) + U * G(L + 26) - V * G(L + 1)
          F(J + 53) = F(J + 53) - V * G(L + 26) - U * G(L + 1)
          L = L + K
        END DO
  450   NK = NK + NH
      END DO
      IF (NC .GE. 0) THEN
        Z = A(35)
        DO I = 53, 2703, 53
          Z = Z + A(38)
          Y = A(34)
          DO 490 K = 1, 51
            Y = Y + A(37)
            NK = I + K
            M = NK + NB
            IF (EZ .GT. A(M)) EZ = A(M)
            P = A(M)
            IF (P * 1.2 .LT. A(MP + 6)) GO TO 490
            IF (A(M - 1) .GT. P) GO TO 490
            IF (A(M + 1) .GT. P) GO TO 490
            IF (MAX (A(M - 54), A(M - 53), A(M - 52)) .GT. P) GO TO 490
            IF (MAX (A(M + 52), A(M + 53), A(M + 54)) .GT. P) GO TO 490
            L = NK + NC
            IF (MAX (A(L - 53), A(L - 1), A(L), A(L + 1),
     1          A(L + 53)) .GT. P) GO TO 490
            N = NK + NA
            IF (MAX (A(N - 53), A(N - 1), A(N), A(N + 1),
     1          A(N + 53)) .GT. P) GO TO 490
            Q = P + P
            U = A(L) - A(N)
            V = A(M - 1) - A(M + 1)
            W = A(M - 53) - A(M + 53)
            R = U / (A(N) + A(L) - Q)
            S = V / (A(M - 1) + A(M + 1) - Q)
            T = W / (A(M - 53) + A(M + 53) - Q)
            H = P - (U * R + V * S + W * T) * 0.0416667
            IF (H .GT. A(44)) A(44) = H
            IF (H .LT. A(20)) GO TO 490
            W = 0.01 * ZZ + A(36) * (0.005 * R - 0.01)
            V = 0.005 * (Y + Y + A(37) * S)
            U = 0.005 * (Z + Z + A(38) * T)
            IF (A(55) .GE. 0.0) THEN
              T = U
              U = V
              V = T
            END IF
            DO  NK = 1, MA
              T = W
              W = V
              V = U
              U = T
            END DO
            SK = 0.0
            XS = 0.0
            YS = 0.0
            ZS = 0.0
            CS = 1.0
            DO NK = 1, KP
              DO L = 65, LY, 12
                XA = U * A(L) + V * A(L + 1) + W * A(L + 2)
     1             + WP * A(L + 9)
                YA = U * A(L + 3) + V * A(L + 4) + W * A(L + 5)
     1             + WP * A(L + 10)
                ZA = U * A(L + 6) + V * A(L + 7) + W * A(L + 8)
     1             + WP * A(L + 11)
                DO M = ML, LL, 4
                  O = CS * A(M) * XA + A(M + 1)
                  P = CS * A(M) * YA + A(M + 2)
                  Q = CS * A(M) * ZA + A(M + 3)
                  N = LV
                  R = AMOD(O - U, 1.0) - 0.5
                  S = AMOD(P - V, 1.0) - 0.5
                  T = AMOD(Q - W, 1.0) - 0.5
                  IF (R * R * A(8) + S * S * A(9) + T * T * A(10)
     1              + S * T * A(11) + R * T * A(12)
     2              + R * S * A(13) .LE. RR) THEN
                    XS = XS + R + U
                    YS = YS + S + V
                    ZS = ZS + T + W
                    SK = SK + 1.0
                  END IF
  460             N  = N + 8
                  IF (N .LE. LD) THEN
                    R = AMOD(O - A(N + 2), 1.0) - 0.5
                    S = AMOD(P - A(N + 3), 1.0) - 0.5
                    T = AMOD(Q - A(N + 4), 1.0) - 0.5
                    YUNK = R * R * A(8) + S * S * A(9) + T * T * A(10)
     1                   + S * T * A(11) + R * T * A(12)
     2                   + R * S * A(13) - A(N + 7)
                    IF (YUNK .LT. 0.0) THEN
                      GO TO 490
                    ELSE
                      GO TO 460
                    END IF
                  END IF
                END DO
              END DO
              CS = -1.0
            END DO
            J  = LD + 8
            NK = J
  470       J  = J - 8
            IF (A(J + 6) .LT. H) GO TO 470
  480       NK = NK - 8
            IF (J .LT. NK) THEN
              N = NK + 7
              DO L = NK, N
                A(L + 8) = A(L)
              END DO
              GO TO 480
            END IF
            A(J + 8)  = 0.0
            A(J + 9)  = 1000.1
            SK        = 1.0 / SK
            A(J + 10) = XS * SK
            A(J + 11) = YS * SK
            A(J + 12) = ZS * SK
            A(J + 13) = SK
            A(J + 14) = H
            A(J + 15) = RR
            LD = MIN (LD + 8, MP)
  490     CONTINUE
        END DO
      END IF
      NC = NB
      NB = NA
      NA = NA + 2809
      IF (NA .GT. LZ + 8426) NA = LZ
      MS = MS + 2
      NG = NG + 1
      ZZ = ZZ + A(36)
      IF (NX .NE. NG) GO TO 440
      A(LX + 6) = TP
  500 IF (A(54) .GT. 6.5) GO TO 10
      I = LV
      DO WHILE (I .LE. LD - 8)
        I = I + 8
        WRITE (LP, 99997, IOSTAT = IOST) A(I + 2), A(I + 3), A(I + 4)
      END DO
      WRITE (LP, 99998, IOSTAT = IOST) (HKLF(I), I = 1, 11)
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, ':: No Data for Fourier', ///)
99998 FORMAT ('HKLF ', 2F6.2, 9F7.3, /, 'END ', //)
99997 FORMAT ('Q000 1', 3F8.4)
      END SUBROUTINE PLA159
      SUBROUTINE PLA160 (MODE, TM1)
C *******************************************************************
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP18=50,NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,
     2 NP52=200,NP56=30,NP57=35,NP60=100,NCS=52,NZM=200000,
     3 NRS= NVD - 10 * NZM)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // XYZDUM(2, NP23), RS(NRS), TNZ(NZM, 10)
      COMMON /FSPGR/ CRI(11), PNZ(13, 10), STLS(20)
      COMMON /DFSPGR/ SUM(NCS, 5), NUM(NCS, 5), XMFS(NCS), XTL(12),
     1 XNM(12), NNZ(13), ANZ(13), IR(3), IN(24), XN(48), FMN(12),
     2 ITL(12), AVNZ(3), NREF, IPERC, TRMX(3, 3), LU, ISPGRC, ISPGRA,
     3 ISPGRH, IPCNTC, IPCNTA, IPCNTH, IFRQC, IFRQA, IFRQH, RAVERC,
     4 RAVERA, RAVERH
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1 ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /CFSPGR/ EXT, ILAT0, ILAT1, LAUE
      CHARACTER EXT(NCS)*1, ILAT0*1, ILAT1*1, LAUE*5
      INTEGER HMAX
      DIMENSION TM1(3, 3), TM2(3, 3), YPAR(107)
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /DATASPGR/ EXTYPE, NLAUE
      CHARACTER EXTYPE(NCS)*16, NLAUE(13)*5
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      CHARACTER GEXT*1
      LOGICAL OPEND
      DIMENSION YUNK(3, 3)
      IWIN = IGBL(25) * IGBL(32)
      JH      = 0
      JK      = 0
      JL      = 0
      IND1    = 1
      IND2    = 2
      IND3    = 3
      HMAX    = 0
      STLM    = 0.0
      LTNR    = 0
      KMAX    = 0
      LMAX    = 0
      IUNIT   = 0
      IPCNTC  = 0
      IPCNTA  = 0
      IPCNTH  = 0
      IFRQC   = 0
      IFRQA   = 0
      IFRQH   = 0
      ISPGRC  = 0
      ISPGRA  = 0
      ISPGRH  = 0
      RAVERC  = 100.0
      RAVERA  = 100.0
      RAVERH  = 100.0
      CRI(11) = PAR(141)
C * FSPGR - DETERMINE SPACEGROUP FROM OBSERVED DATA
      IF (MODE .EQ. 1) THEN
        IPR(193) = 0
        IPR(513) = 0
        IPR(48)  = 0
        IPR(255) = 0
        IPR(257) = 1
        RMAX  = PAR(430)
        PAGET = 'SPGRfrEx'
        CALL PLA262 (-2)
        STLM = SIN (PAR(419) / RGBL(6)) / PAR(17)
        WRITE (LU7, 99985, IOSTAT = IOST) JID(1:9)
        WRITE (LU6, 99985, IOSTAT = IOST) JID(1:9)
C * NEWSYM : FIND SPACEGROUP (POSSIBLE HIGHER SYMMETRY) FROM FCALC
      ELSE IF (MODE .EQ. 2) THEN
        RMAX = PAR(429)
        IF (IWIN .EQ. 1) THEN
          BCD  = 'NewSym'//CHAR(0)
          CALL GGIP (HORS, VERT, 0.0, 1)
          CALL GGIP09 (0.0,  BCD, 7, 1.4, 4, 8, 9.6, VERT - 1.8)
          CALL GGIP09 (0.0,  BCD, 7, 1.4, 2, 8, 9.4, VERT - 1.9)
          PRBUF = 'Calculate Structure Factors from Model Data'
          CALL GGIP09 (0.0, PRBUF, 43, 0.5, 1, 1, 4.0, VERT - 4.0)
          CALL GGIP (0.0, 0.0, 0.0, 6)
          VRT = VERT - 8.5
          CALL GEN038 (PRBUF, 1, 80)
        END IF
        PAGET = 'NEWSYM'
        CALL PLA262 (0)
        STLM = 0.0
        WRITE (LU7, 99986, IOSTAT = IOST) PAR(248), JID(1:9)
        WRITE (LU6, 99986, IOSTAT = IOST) PAR(248), JID(1:9)
        LTNR  = IPR(241)
        NSYM  = IPR(48)
        NSYMH = IPR(255)
        ICNTR = IPR(257)
        CALL PLA023 (0)
        NATO = IPR(589)
        IF (NATO .LT. 0) THEN
          WRITE (LU6, 99998, IOSTAT = IOST)
          GO TO 140
        END IF
        HMAX = INT(4 * PAR(101) / 3)
        KMAX = INT(4 * PAR(102) / 3)
        LMAX = INT(4 * PAR(103) / 3)
        MPH  = 2 * HMAX + 1
        MPK  = 2 * KMAX + 1
        MHK  = MPH * MPK
      END IF
      IMODE = IPR(365)
      IF (IMODE .EQ. 0) IMODE = 3
      IF (IMODE .NE. 2) THEN
        CALL PLA169 (0, 0.0, 0.0, 0.0, LU6)
        CALL PLA162 (0, 0, 0, 0, 0, 0.0, 0.0, IDUM)
      END IF
      IF (IMODE .GT. 1) THEN
        DO I = 1, 12
          NNZ(I) = 0
          ANZ(I) = 0.0
          DO J = 1, 10
            IF (I .EQ. 12) THEN
              VAL = (1.0 - EXP(- J * 0.1)) * 100.0
            ELSE
              VAL = 0.0
            END IF
            PNZ(I, J) = VAL
          END DO
        END DO
      END IF
      NREF = 0
      INQUIRE (UNIT = LU8, OPENED = OPEND)
      IF (.NOT. OPEND) THEN
        OPEN (UNIT = LU8, STATUS = 'SCRATCH', FORM = 'UNFORMATTED')
      ELSE
        REWIND LU8
      END IF
      IF (MODE .EQ. 2) GO TO 40
      CALL GEN112 (TM2, PAR(231), 1)
      CALL GEN004 (TM1, TM2, YUNK)
      CALL GEN052 (YUNK, TM2)
      SCALE = 100.0
      IEND = -1
   10 CALL PLA136 (JH, JK, JL, RINT, RSIG, SIGIW, CALI, UCINT, ACALS,
     1             BCALS, ACOR, IEND)
      IF (IEND .EQ. 1) GO TO 20
      IF (RINT .LT. 999999.0) GO TO 10
      SCALE = 1.0
   20 IUNIT = NINT(GEN135(TM2))
      IEND = -1
   30 CALL PLA136 (JH, JK, JL, RINT, RSIG, SIGIW, CALI, UCINT, ACALS,
     1             BCALS, ACOR, IEND)
      IF (IEND .EQ. 1) GO TO 100
      IF (IUNIT .NE. 1) THEN
        IH = JH
        IK = JK
        IL = JL
        IF (GEN050 (TM2, IH, IK, IL, JH, JK, JL) .LT. 0.0) GO TO 30
      END IF
      IF (JH .EQ. 0 .AND. JK .EQ. 0 .AND. JL .EQ. 0) GO TO 100
      IX = NINT(MAX(0.0, RINT * SCALE))
      IF (RSIG .LE. 0.0) RSIG = 0.5
      IS = NINT(RSIG * SCALE)
      GO TO 80
   40 JH = - HMAX -1
   50 JH = JH + 1
      IF (JH .GT. HMAX) THEN
        IF (IWIN .EQ. 1)
     1    CALL GGIP09 (0.0, PRBUF, 20, 0.8, 0, 2, 7.0, VRT)
        GO TO 100
      END IF
      JK = - KMAX - 1
   60 JK = JK + 1
      IF (JK .GT. KMAX) GO TO 50
      JL = - 1
   70 JL = JL + 1
      IF (JL .GT. LMAX) GO TO 60
      IF (JH .EQ. 0 .AND. JK .EQ. 0 .AND. JL .EQ. 0) GO TO 70
      IF (LTNR .GT. 1) THEN
        IF (GEN049 (LAT(LTNR), JH, JK, JL) .LT. 0.0) GO TO 70
      END IF
      CALL PLA138 (1, JH, JK, JL, IEXT, IASM)
      IF (IEXT .NE. 0) GO TO 70
   80 STLK = GEN095 (PAR(191), JH, JK, JL)
      STL  = SQRT(STLK)
      FSC = 1.0
      IF (MODE .EQ. 2) THEN
        IF (STL .LT. PAR(248)) THEN
          ACAL   = 0.0
          BCAL   = 0.0
          ACALA  = 0.0
          BCALA  = 0.0
          ACALAF = 0.0
          BCALAF = 0.0
          CALL PLA135 (JH, JK, JL, ACAL, BCAL, ACALA, BCALA,
     1      ACALAF, BCALAF, DUM)
          IX   = MIN (999999999, NINT(100.0 * (ACAL**2 + BCAL**2)))
          IS   = MAX (1, NINT(SQRT(FLOAT(IX))))
        ELSE
          GO TO 70
        END IF
      END IF
      IF (IMODE .NE. 2) CALL PLA169 (1, FLOAT(IX), FLOAT(IS), STL, LU6)
      IF (STL .GT. STLM) THEN
        XI = IX
        SI = IS
        WRITE (LU8) JH, JK, JL, XI, SI, FSC, STL
        NREF = NREF + 1
        IF (IMODE .GT. 1) THEN
          IF (JH .NE. 0 .AND. JK .NE. 0 .AND. JL .NE. 0) THEN
            DO I = 1, 10
              IF (STL .LE. STLS(I)) THEN
                NNZ(I)         = NNZ(I) + 1
                IF (NNZ(I) .LE. NZM) THEN
                  TNZ(NNZ(I), I) = XI
                  ANZ(I)         = ANZ(I) + XI
                  NNZ(11)        = NNZ(11) + 1
                ELSE IF (NNZ(I) .EQ. NZM) THEN
                  WRITE (LU6, 99987, IOSTAT = IOST)
                  CALL GEN127 (' ')
                END IF
                GO TO 90
              END IF
            END DO
          END IF
        END IF
   90   IF (IMODE .NE. 2) THEN
          IF (SI .GT. 0.0) THEN
            XISI = XI / SI
          ELSE
            XISI = 0.0
          END IF
          CALL PLA161 (0, JH, JK, JL, XISI, FSC)
        END IF
      END IF
      IF (MODE .EQ. 1) THEN
        GO TO 30
      ELSE
        IF (IWIN .EQ. 1) THEN
          IF (MOD(NREF, 1000) .EQ. 0) THEN
            CALL GGIP09 (0.0, PRBUF, 20, 0.8, 0, 2, 7.0, VRT)
            WRITE (PRBUF, 99983, IOSTAT = IOST) NREF
            CALL GGIP09 (0.0, PRBUF, 20, 0.8, 1, 2, 7.0, VRT)
            CALL GGIP (0.0, 0.0, 0.0, 6)
          END IF
        END IF
        GO TO 70
      END IF
  100 IF (IMODE .NE. 2) THEN
        CALL PLA169 (-1, 0.0, 0.0, 0.0, LU6)
        IF (IPR(210) .NE. -2) CALL PLA169 (-2, 0.0, 0.0, 0.0, 0)
        CALL PLA162 (-1, 0, 0, 0, 0, 0.0, 0.0, NR)
        IF (NR .GT. 0) THEN
          NXCT = 0
          GEXT = ' '
        ELSE
          NXCT = 1
          NR   = - NR
          IF (NR .GT. 10) THEN
            NR = NR - 10
            GEXT = '?'
          ELSE
            GEXT = ' '
          END IF
        END IF
        IF (NR .EQ. 8) THEN
          NR = 7
          DO I = 1, 3
            DO J = 1, 2
              TM1(I, J) = - TM1(I, J)
              TM2(I, J) = - TM2(I, J)
            END DO
          END DO
        END IF
        IPR(94) = 2
        IAPPEND = 0
        IF (IMODE .EQ. 1 .AND. NR .NE. 1 .AND. NXCT .NE. 0) THEN
          CALL PLA164 (IMODE, 0, LAT(1), TM1, PAR(383), ' ')
          IAPPEND = 1
        END IF
        CALL PLA164 (IMODE, IAPPEND, LAT(NR), TM1, PAR(383), GEXT)
        LRET0  = 0
        ISPR47 = 0
        REWIND LU2
        IF (IPR(548) .EQ. 0 .AND. IWIN .EQ. 1) THEN
          CALL PLA262 (0)
          CALL PLA171 (LRET0, TM1, LU2, LU7, ISPR47, YPAR, 0)
        END IF
      ELSE
        CALL GEN021 (TRMX, 1)
        WRITE (LU2, 99999, IOSTAT = IOST)
     1    ((TM1(I, J), J = 1, 3), I = 1, 3), ILAT0
        CALL PLA167
      END IF
      IF (IMODE .GT. 1) THEN
        CALL GEN074 (AVNZ, 1, 3, 0.0)
        NZMX = 10
        ANZM = 0.0
        DO I = 1, NZMX
          IF (NNZ(I) .GT. 0) THEN
            ANZ(I) = ANZ(I) / NNZ(I)
            ANZM   = MAX (ANZ(I), ANZM)
          ELSE
            NZMX   = I - 1
            GO TO 110
          END IF
        END DO
  110   DO I = 1, NZMX
          DO J = 1, 10
            XANZ = J * 0.1 * ANZ(I)
            NZ   = 0
            DO K = 1, NNZ(I)
              IF (K .GT. NZM) THEN
                WRITE (LU6, 99987, IOSTAT = IOST)
                CALL GEN127 (' ')
              END IF
              IF (TNZ(K, I) .LE. XANZ) NZ = NZ + 1
            END DO
            PNZ(I, J) = FLOAT(NZ) * 100.0 / FLOAT(NNZ(I))
          END DO
        END DO
        IAE = MIN (6, NZMX)
        IAB = MIN (3, IAE)
        IAT = IAE - IAB + 1
        DO J = 1, 10
          AVER = 0
          IF (IAB .GT. 0) THEN
            DO I = IAB, IAE
              AVER = AVER + PNZ(I, J)
            END DO
          END IF
          PNZ(11, J) = AVER / IAT
        END DO
        CALL PLA262 (0)
        WRITE (LU7, 99994, IOSTAT = IOST)
        IF (ANZM .NE. 0.0) THEN
          DO I = 1, 10
            WRITE (LU7, 99993, IOSTAT = IOST)
     1        I, (PNZ(I, J), J = 1, 10), NNZ(I), ANZ(I) * 1000.0 / ANZM
          END DO
        END IF
        WRITE (LU7, 99992, IOSTAT = IOST)
     1    (0.1 * J, J = 1, 10), IAB, IAE, (PNZ(11, J), J = 1, 10),
     2    (PNZ(12, J), J = 1, 10), (PNZ(13, J), J = 1, 10)
        DO I = 11, 13
          DO J = 1, 10
            PNZ(I, J) = PNZ(I, J) - 0.1 * J * PNZ(I, 10)
          END DO
        END DO
        DO I = 11, 13
          DO J = 1, 10
            PNZ(I, J) = PNZ(I, J) - PNZ(12, J)
            AVNZ(I - 10) = AVNZ(I - 10) + PNZ(I, J)
          END DO
        END DO
        IPERC = NINT(100.0 * AVNZ(1) / AVNZ(3))
        WRITE (LU7, 99991, IOSTAT = IOST) IPERC
        WRITE (LU7, 99992, IOSTAT = IOST)
     1    (0.1 * J, J = 1, 10), IAB, IAE, (PNZ(11, J), J = 1, 10),
     2    (PNZ(12, J), J = 1, 10), (PNZ(13, J), J = 1, 10)
      END IF
      IF (IMODE .GT. 1) THEN
        CALL PLA162 (0, 0, 0, 0, 0, 0.0, 0.0, IDUM)
        IF (IMODE .EQ. 3) THEN
          K = 0
          DO I = 1, 3
            DO J = 1, 3
              K = K + 1
              TRMX (I, J) = TLATT (K, NRLT)
            END DO
          END DO
          LAUE = NLAUE(LLAUE(NRLT))
          ILAT0 = CLATT(NRLT)
          ILAT1 = BLATT(NRLT)
        END IF
        CALL GEN108 (LU8, 0)
        CALL GEN004 (TM1, TRMX, YUNK)
        CALL GEN052 (YUNK, TRMX)
        DO NRF = 1, NREF
          READ (LU8) KH, KK, KL, XI, SI, FSC, STL
          IF (GEN050 (TRMX, KH, KK, KL, IH, IK, IL) .GE. 0.0) THEN
            CALL GEN145 (IH, IK, IL)
            IF (SI .GT. 0.0) THEN
              XISI = XI / SI
            ELSE
              XISI = 0.0
            END IF
            CALL PLA161 (1, IH, IK, IL, XISI, FSC)
          END IF
        END DO
        CALL PLA162 (-2, 0, 0, 0, 0, 0.0, 0.0, LATT)
        IF (IPR(548) .EQ. 0) THEN
          M = 2 + IWIN
        ELSE
          M = 2
        END IF
        DO 130 N = 1, M
          IF (N .EQ. 1) THEN
            LU = LU6
          ELSE IF (N .EQ. 2) THEN
            LU = LU7
          ELSE
            LU = 0
          END IF
  120     WRITE (PRBUF, 99990, IOSTAT = IOST)
     1      ((TRMX(I, J), J = 1, 3), I = 1, 3)
          IF (LU .GT. 0) THEN
            IF (LU .EQ. LU7) CALL PLA262 (0)
            WRITE (LU, 99997, IOSTAT = IOST)
            WRITE (LU, 99995, IOSTAT = IOST)
            WRITE (LU, 99989, IOSTAT = IOST) PRBUF(1:80)
          ELSE
            CALL GGIP (HORS, VERT, 0.0, 1)
            VRT = VERT - 1.0
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 1, 2, 0.1, VRT)
          END IF
          WRITE (PRBUF, 99988, IOSTAT = IOST)
          IF (LU .GT. 0) THEN
            WRITE (LU, 99984, IOSTAT = IOST) PRBUF(1:80)
          ELSE
            VRT = VRT - 1.0
            CALL GGIP09 (0.0, PRBUF, 80, 0.35, 5 + IGBL(68), 2, 0.1,
     1                   VRT)
          END IF
          CALL PLA168
          IF (LU .EQ. LU7) WRITE (LU2, 99982, IOSTAT = IOST)
     1      ISPGRC, ISPGRA, ISPGRH, IPCNTC, IPCNTA, IPCNTH
          IF (LU .EQ. 0) THEN
            CALL PLA015 (0, 39)
            CALL PLA013 (2, 1)
            IF (IGGT(1:4) .EQ. 'PLOT') GO TO 120
          END IF
  130   CONTINUE
      END IF
  140 IF (IPR(2) .EQ. 0) IPR(2) = -1
      CLOSE (UNIT = LU8)
      RETURN
99999 FORMAT ('TRMX ', 9F7.3, 1X, A)
99998 FORMAT (/, ':: No Atoms Found on Input. Abort', /)
99997 FORMAT (/, 'Tentative Space Group Assignment - ',
     1 '(Please Check Carefully)', /, 80('='), /)
99995 FORMAT (':: NOTE: Space Group Determination Pitfalls:', /,
     1  9X, 'Twinning, Pseudo-Symmetry, Mult.Refl.')
99994 FORMAT (/, 'N(z)-Test Statistics',
     1  ' (see: Howells et al. (1950) Acta Cryst. 3, 210)', /, 80('='))
99993 FORMAT ('Shell', I2, 10F6.2, I6, F7.1)
99992 FORMAT (/, '   z ->', 10F6.1, /, 'Av', I1, ':', I2, 1X, 10F6.2,
     1  /, 'NonCent', 10F6.2, /, 'CentroS', 10F6.2)
99991 FORMAT (/, 'Normalized N(z) curves (', I3, ' Percent Centric)',
     1  /, 80('='))
99990 FORMAT ('Candidate Space Groups in (',
     1  3F5.2, '/', 3F5.2, '/', 3F5.2, ') Cell')
99989 FORMAT (/, A, /, 80('='), /)
99988 FORMAT ('Name      #  AbsFreq',
     1  ' StandSet.     R(av)Perc. N  A/C-Prob')
99987 FORMAT (':: Increase NZM in FSPGR', //)
99986 FORMAT ('NEWSYM - Determine Symmetry from F(calc) data',
     1 '(Resol = ', F5.2, ') for: ', A, /, 80('='))
99985 FORMAT ('SPGR - Determine SpaceGroup from Observed ',
     1 'Extinctions for: ', A, /, 80('='))
99984 FORMAT (A, /, 80('-'))
99983 FORMAT ('REFL No =', I8)
99982 FORMAT ('SGNR', 6I5)
      END SUBROUTINE PLA160
      SUBROUTINE PLA161 (MODE, IH, IK, IL, XISI, FSC)
      CALL PLA162 (1, IH, IK, IL, MOD(IH + IK, 2), XISI, FSC, IDUM)
      CALL PLA162 (2, IH, IK, IL, MOD(IH + IL, 2), XISI, FSC, IDUM)
      CALL PLA162 (3, IH, IK, IL, MOD(IK + IL, 2), XISI, FSC, IDUM)
      CALL PLA162 (4, IH, IK, IL, MOD(IH + IK + IL, 2), XISI, FSC,
     1                IDUM)
      CALL PLA162 (5, IH, IK, IL, MOD(- IH + IK + IL, 3), XISI,
     1                FSC, IDUM)
      CALL PLA162 (6, IH, IK, IL, MOD(IH - IK + IL, 3), XISI,
     1                FSC, IDUM)
      CALL PLA162 (41, IH, IK, IL, MOD(IH, 2), XISI, FSC, IDUM)
      CALL PLA162 (42, IH, IK, IL, MOD(IK, 2), XISI, FSC, IDUM)
      CALL PLA162 (43, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
      CALL PLA162 (44, IH, IK, IL, MOD(IH, 3), XISI, FSC, IDUM)
      CALL PLA162 (45, IH, IK, IL, MOD(IK, 3), XISI, FSC, IDUM)
      CALL PLA162 (46, IH, IK, IL, MOD(IL, 3), XISI, FSC, IDUM)
      IF (MOD(-IH + IK + IL, 3) .EQ. 0 .OR.
     1    MOD( IH - IK + IL, 3) .EQ. 0) THEN
        MODRTWIN = 0
      ELSE
        MODRTWIN = 1
      END IF
      CALL PLA162 (47, IH, IK, IL, MODRTWIN  , XISI, FSC, IDUM)
      IF (MOD (IK, 2) .EQ. 0 .AND. MOD (IK + IL, 4) .EQ. 2) THEN
        MODRTWIN = 1
      ELSE
        MODRTWIN = 0
      END IF
      CALL PLA162 (48, IH, IK, IL, MODRTWIN  , XISI, FSC, IDUM)
      IF (MOD (IH, 2) .EQ. 0 .AND. MOD (IH + IL, 4) .EQ. 2) THEN
        MODRTWIN = 1
      ELSE
        MODRTWIN = 0
      END IF
      CALL PLA162 (49, IH, IK, IL, MODRTWIN  , XISI, FSC, IDUM)
      IF (MOD (IH, 2) .EQ. 0 .AND. MOD (IH + IK, 4) .EQ. 2) THEN
        MODRTWIN = 1
      ELSE
        MODRTWIN = 0
      END IF
      CALL PLA162 (50, IH, IK, IL, MODRTWIN  , XISI, FSC, IDUM)
      CALL PLA162 (51, IH, IK, IL, MOD (IH + 2 * IL, 3), XISI,
     1  FSC, IDUM)
      CALL PLA162 (52, IH, IK, IL, MOD (IH + IK + IL, 3), XISI,
     1  FSC, IDUM)
      IF (MODE .NE. 0) THEN
        IF (IH .EQ. 0) THEN
          CALL PLA162 (7, IH, IK, IL, MOD(IK, 2), XISI, FSC, IDUM)
          CALL PLA162 (8, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
          CALL PLA162 (9, IH, IK, IL, MOD(IK + IL, 2), XISI, FSC,
     1                  IDUM)
          CALL PLA162 (19, IH, IK, IL, MOD(IK + IL, 4), XISI, FSC,
     1                  IDUM)
          IF (IK .EQ. 0) THEN
            CALL PLA162 (10, IH, IK, IL, 0, XISI, FSC, IDUM)
            CALL PLA162 (11, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
            CALL PLA162 (12, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
            CALL PLA162 (18, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
            CALL PLA162 (20, IH, IK, IL, MOD(IL, 4), XISI, FSC, IDUM)
            CALL PLA162 (24, IH, IK, IL, MOD(IL, 4), XISI, FSC, IDUM)
            CALL PLA162 (31, IH, IK, IL, MOD(IL, 6), XISI, FSC, IDUM)
            CALL PLA162 (39, IH, IK, IL, MOD(IL, 3), XISI, FSC, IDUM)
          ELSE IF (IL .EQ. 0) THEN
            CALL PLA162 (14, IH, IK, IL, MOD(IK, 2), XISI, FSC, IDUM)
            CALL PLA162 (15, IH, IK, IL, MOD(IK, 2), XISI, FSC, IDUM)
            CALL PLA162 (17, IH, IK, IL, MOD(IK, 2), XISI, FSC, IDUM)
            CALL PLA162 (21, IH, IK, IL, MOD(IK, 4), XISI, FSC, IDUM)
            CALL PLA162 (23, IH, IK, IL, MOD(IK, 4), XISI, FSC, IDUM)
          END IF
        ELSE IF (IK .EQ. 0) THEN
          CALL PLA162 (10, IH, IK, IL, MOD(IH, 2), XISI, FSC, IDUM)
          CALL PLA162 (11, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
          CALL PLA162 (12, IH, IK, IL, MOD(IH + IL, 2), XISI, FSC,
     1                  IDUM)
          CALL PLA162 (20, IH, IK, IL, MOD(IH + IL, 4), XISI, FSC,
     1                  IDUM)
          IF (IL .EQ. 0) THEN
            CALL PLA162 (14, IH, IH, IL, 0, XISI, FSC, IDUM)
            CALL PLA162 (16, IH, IK, IL, MOD(IH, 2), XISI, FSC, IDUM)
            CALL PLA162 (22, IH, IK, IL, MOD(IH, 4), XISI, FSC, IDUM)
          END IF
        ELSE IF (IL .EQ. 0) THEN
          CALL PLA162 (13, IH, IK, IL, MOD(IH, 2), XISI, FSC, IDUM)
          CALL PLA162 (14, IH, IK, IL, MOD(IK, 2), XISI, FSC, IDUM)
          CALL PLA162 (15, IH, IK, IL, MOD(IH + IK, 2), XISI, FSC,
     1                  IDUM)
          CALL PLA162 (21, IH, IK, IL, MOD(IH + IK, 4), XISI, FSC,
     1                  IDUM)
          IF (IH .EQ. IK) THEN
            CALL PLA162 (32, IH, IK, IL, MOD(IH, 2), XISI, FSC, IDUM)
          END IF
        ELSE IF (IH .EQ. IK) THEN
          CALL PLA162 (25, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
          CALL PLA162 (26, IH, IK, IL, MOD(IH, 2), XISI, FSC, IDUM)
          CALL PLA162 (27, IH, IK, IL, MOD(IH + IL, 2), XISI, FSC,
     1                  IDUM)
          CALL PLA162 (28, IH, IK, IL, MOD(2 * IH + IL, 4), XISI,
     1                  FSC, IDUM)
          CALL PLA162 (34, IH, IK, IL, MOD(IL, 3), XISI, FSC, IDUM)
        ELSE IF (IH .EQ. -IK .AND. IH .NE. 0) THEN
          CALL PLA162 (29, IH, IK, IL, MOD(IH + IL, 3), XISI, FSC,
     1                  IDUM)
          CALL PLA162 (30, IH, IK, IL, MOD(- IH + IL, 3), XISI,
     1                  FSC, IDUM)
          CALL PLA162 (33, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
          CALL PLA162 (40, IH, IK, IL, MOD(IH, 2), XISI, FSC, IDUM)
        ELSE IF (IK .EQ. -2 * IH .AND. IH .NE. 0) THEN
          CALL PLA162 (35, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
          CALL PLA162 (37, IH, IK, IL, MOD(IL, 3), XISI, FSC, IDUM)
        ELSE IF (IH .EQ. - 2 * IK .AND. IH .NE. 0) THEN
          CALL PLA162 (36, IH, IK, IL, MOD(IL, 2), XISI, FSC, IDUM)
          CALL PLA162 (38, IH, IK, IL, MOD(IL, 3), XISI, FSC, IDUM)
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA161
      SUBROUTINE PLA162 (NEX, IH, IK, IL, MHKL, XISI, FSC, LATT)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NCS=52)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /FSPGR/ CRI(11), PNZ(13, 10), STLS(20)
      COMMON /DFSPGR/ SUM(NCS, 5), NUM(NCS, 5), XMFS(NCS), XTL(12),
     1 XNM(12), NNZ(13), ANZ(13), IR(3), IN(24), XN(48), FMN(12),
     2 ITL(12), AVNZ(3), NREF, IPERC, TRMX(3, 3), LU, ISPGRC, ISPGRA,
     3 ISPGRH, IPCNTC, IPCNTA, IPCNTH, IFRQC, IFRQA, IFRQH, RAVERC,
     4 RAVERA, RAVERH
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /LFSPGR/ EX
      COMMON /DATASPGR/ EXTYPE, NLAUE
      CHARACTER EXTYPE(NCS)*16, NLAUE(13)*5
      COMMON /CFSPGR/ EXT, ILAT0, ILAT1, LAUE
      CHARACTER EXT(NCS)*1, ILAT0*1, ILAT1, LAUE*5
      LOGICAL EX(NCS)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER PRBUF*132, TYP0*3
C ******************************************************************C
C*******************************************************************C
      IF (NEX .GT. 0) THEN
        IF (MHKL .EQ. 0) THEN
          SUM(NEX, 1) = SUM(NEX, 1) + FSC * XISI
          SUM(NEX, 4) = SUM(NEX, 4) + FSC
          NUM(NEX, 1) = NUM(NEX, 1) + 1
        ELSE
          SUM(NEX, 2) = SUM(NEX, 2) + FSC * XISI
          SUM(NEX, 5) = SUM(NEX, 5) + FSC
          NUM(NEX, 2) = NUM(NEX, 2) + 1
          IF (XISI .GT. XMFS(NEX)) THEN
            IF (IH .NE. 5 .AND. IK .NE. 5 .AND. IL .NE. 5) THEN
              XMFS(NEX)   = XISI
              NUM(NEX, 3) = IH
              NUM(NEX, 4) = IK
              NUM(NEX, 5) = IL
            END IF
          END IF
        END IF
      ELSE IF (NEX .EQ. 0) THEN
        DO I = 1, NCS
          XMFS(I) = 0.0
          DO J = 1, 5
            SUM(I, J) = 0.0
            NUM(I, J) = 0
          END DO
        END DO
        IPR(481) = 0
      ELSE IF (NEX .LT. 0) THEN
        DO I = 1, NCS
          IF (NUM(I, 1) .GT. 0) SUM(I, 1) = SUM(I, 1) / SUM(I, 4)
          IF (NUM(I, 2) .GT. 0) SUM(I, 2) = SUM(I, 2) / SUM(I, 5)
          IF (SUM(I, 2) .GT. 0.0) THEN
            SUM(I, 3) = SUM(I, 1) / SUM(I, 2)
          ELSE
            IF (SUM(I, 1) .GT. 1.0) THEN
              SUM(I, 3) = 99.00
            ELSE
              SUM(I, 3) = 0.0
            END IF
          END IF
          IF    ((SUM(I, 2) .LT. CRI(1) .AND. SUM(I, 3) .GT. CRI(2))
     1      .OR. (SUM(I, 2) .LT. CRI(3) .AND. SUM(I, 3) .GT. CRI(4))
     2      .OR. (SUM(I, 2) .LT. CRI(5) .AND. SUM(I, 3) .GT. CRI(6))
     3      .OR. (SUM(I, 2) .LT. CRI(7) .AND. SUM(I, 3) .GT. CRI(8))
     4      .OR. (SUM(I, 2) .LT. CRI(9) .AND. SUM(I, 3) .GT. CRI(10))
     5      .OR.  SUM(I, 3) .GT. CRI(11)) THEN
            IF (XMFS(I) .GT. 5.0) THEN
              EXT(I) = '?'
            ELSE
              EXT(I) = 'E'
            END IF
            EX(I)  = .TRUE.
          ELSE
            IF (SUM(I, 2) .GT. 0.0 .AND. SUM(I, 2) .LT. 1.5
     1        .AND. XMFS(I) .LT. 3.0) THEN
              EXT(I) = '?'
              EX(I)  = .TRUE.
            ELSE
              IF (SUM(I, 3) .GT. 2.0) THEN
                EXT(I) = '>'
              ELSE
                EXT(I) = ' '
              END IF
              EX(I)  = .FALSE.
            END IF
          END IF
        END DO
        IF (EX(1) .AND. EX(2) .AND. EX(3)) THEN
          LATT = 5
          NXCT = NUM(1, 2) + NUM(2, 2) + NUM(3, 2)
          IF (EXT(1) .NE. 'E' .OR. EXT(2) .NE. 'E'
     1                        .OR. EXT(3) .NE. 'E') NXCT = - NXCT
        ELSE IF (EX(5)) THEN
          LATT = 7
          NXCT = NUM(5, 2)
          IF (EXT(5) .NE. 'E') NXCT = - NXCT
        ELSE IF (EX(6)) THEN
          LATT = 8
          NXCT = NUM(6, 2)
          IF (EXT(6) .NE. 'E') NXCT = - NXCT
        ELSE IF (EX(4)) THEN
          LATT = 6
          NXCT = NUM(4, 2)
          IF (EXT(4) .NE. 'E') NXCT = - NXCT
        ELSE IF (EX(1)) THEN
          LATT = 4
          NXCT = NUM(1, 2)
          IF (EXT(1) .NE. 'E') NXCT = - NXCT
        ELSE IF (EX(2)) THEN
          LATT = 3
          NXCT = NUM(2, 2)
          IF (EXT(2) .NE. 'E') NXCT = - NXCT
        ELSE IF (EX(3)) THEN
          LATT = 2
          NXCT = NUM(3, 2)
          IF (EXT(3) .NE. 'E') NXCT = - NXCT
        ELSE
          LATT = 1
          NXCT = 0
        END IF
        IF (NXCT .GT. 0) THEN
          LATT = - LATT
        ELSE IF (NXCT .LT. 0) THEN
          LATT = - LATT - 10
        END IF
        IF (IPR(548) .EQ. 0) THEN
          M = 2 + IWIN
        ELSE
          M = 2
        END IF
        DO N = 1, M
          NRSC = 0
          IF (N .EQ. 1) THEN
            LU = LU6
          ELSE IF (N .EQ. 2) THEN
            LU = LU7
          ELSE
            LU = 0
          END IF
   10     IF (LU .EQ. 0) THEN
            CALL GGIP (HORS, VERT, 0.0, 1)
            VRT = VERT
          END IF
          IF (NEX .EQ. -1) THEN
            WRITE (PRBUF, 99994, IOSTAT = IOST)
            IF (LU .GT. 0) THEN
              WRITE (LU, 99988, IOSTAT = IOST) PRBUF(1:80)
            ELSE
              VRT = VRT - 0.7
              CALL GGIP09 (0.0, PRBUF, 80, 0.25, 1, 2, 1.0, VRT)
              VRT = VRT - 0.35
            END IF
          ELSE IF (NEX .EQ. -2) THEN
            WRITE (PRBUF, 99990, IOSTAT = IOST)
            IF (LU .GT. 0) THEN
              IF (LU .EQ. LU7) CALL PLA262 (0)
              WRITE (LU, 99989, IOSTAT = IOST) PRBUF(1:80)
              IF (LU .EQ. LU7) CALL PLA262 (6)
            END IF
          END IF
          PAR(428) = (SUM(1, 1) * NUM(1, 1) + SUM(1, 2) * NUM(1, 2))
     1             / (NUM(1, 1) + NUM(1, 2))
          DO I = 1, NCS
            IF (NEX .EQ. -1) THEN
              IF (I .GT. 6 .AND. I .LE. 40) CYCLE
              IF (I .EQ. 47) THEN
                IF (EXT(5) .EQ. 'E' .OR. EXT(6) .EQ. 'E') CYCLE
              END IF
            ELSE IF (NEX .EQ. -2) THEN
              IF (I .GT. 52) CYCLE
            END IF
            IF (EXT(I) .NE. ' ') THEN
              TYP0 = EXTYPE(I)(14:16)
              NRSC = 1
            ELSE
              TYP0 = ' '
            END IF
            WRITE (PRBUF, 99999, IOSTAT = IOST)
            IF (I .EQ. 1) THEN
              IF (LU .GT. 0) THEN
                WRITE (LU, 99987, IOSTAT = IOST) PRBUF(1:80)
                WRITE (LU, 99998, IOSTAT = IOST)
                WRITE (LU, 99997, IOSTAT = IOST)
              ELSE
                VRT = VRT - 0.45
                CALL GGIP09 (0.0, PRBUF, 80, 0.25, 5 + IGBL(68), 2,
     1                       1.0, VRT)
                VRT = VRT - 0.35
                WRITE (PRBUF, 99998, IOSTAT = IOST)
                CALL GGIP09 (0.0, PRBUF, 80, 0.25, 5 + IGBL(68), 2,
     1                       1.0, VRT)
              END IF
            END IF
            WRITE (PRBUF, 99996, IOSTAT = IOST)
     1        I, EXT(I), TYP0, EXTYPE(I)(1:13), SUM(I, 1), SUM(I, 2),
     2        NUM(I, 1), NUM(I, 2), XMFS(I), (NUM(I, J), J = 3, 5),
     3        SUM(I, 3)
            IF (LU .GT. 0) THEN
              IF (LU .EQ. LU6) THEN
                IF (TYP0 .NE. ' ' .OR. (I .GE. 16 .AND. I .LE. 18)) THEN
                  IPR(481) = IPR(481) + 1
                  WRITE (LU6, 99987, IOSTAT = IOST) PRBUF(1:80)
                  WRITE (LU2, 99995, IOSTAT = IOST)
     1              EXT(I), TYP0, EXTYPE(I)(1:13), SUM(I, 1), SUM(I, 2),
     2              NUM(I, 1), NUM(I, 2), XMFS(I),
     3              (NUM(I, J), J = 3, 5), SUM(I, 3)
                END IF
              ELSE IF (LU .EQ. LU7) THEN
                CALL PLA262 (1)
                WRITE (LU7, 99987, IOSTAT = IOST) PRBUF(1:80)
              END IF
            ELSE
              VRT = VRT - 0.35
              CALL GGIP09 (0.0, PRBUF, 80, 0.25, 1, 2, 1.0, VRT)
            END IF
          END DO
          IF (LU .GT. 0) THEN
            IF (NRSC .EQ. 0) WRITE (LU, 99993, IOSTAT = IOST)
            IF (NEX .EQ. -2) THEN
              IF (LU .EQ. LU7) CALL PLA262 (10)
              WRITE (LU, 99991, IOSTAT = IOST) (CRI(J), J = 1, 10)
            END IF
          ELSE
            CALL PLA013 (2, 1)
            IF (IGGT(1:4) .EQ. 'PLOT') GO TO 10
          END IF
        END DO
      END IF
      RETURN
99999 FORMAT ('Nr     Ex. Condition    Aver(I/sig(I)) ',
     1 'Number of Refl', 2X, 'I/sigI', 12X, '.T/F.')
99998 FORMAT (24X, '.True. .False. .True. .False.   Max.F',
     1 '    H  K  L Ratio')
99997 FORMAT (78('='))
99996 FORMAT (I2, 1X, A, 1X, A, 1X, A, 2F8.2, 2I7, F9.2, 2X, 3I3,
     1        F6.1)
99995 FORMAT ('EXTI ', A, 1X, A, 1X, A, 2F7.2, 2I7, F9.2, 2X, 3I3,
     1        F8.2)
99994 FORMAT ('Analysis of General Reflections for Bravais ',
     1         'Centering')
99993 FORMAT (':: No Extinction Conditions Found')
99991 FORMAT (/, 'NOTE: Reflections obscured by Beamstop Excluded',
     1 ' from Statistics', /,
     2 '      5 0 0 etc. not included in Exception list (Fe?)', //,
     3 'Extinction Conditions have been Marked with E when', /,
     4 '     <I/Sig>(.F.) <',F5.1,' .and. Ratio(.T./.F.) >', F5.1, /,
     5 '.or. <I/Sig>(.F.) <',F5.1,' .and. Ratio(.T./.F.) >', F5.1, /,
     6 '.or. <I/Sig>(.F.) <',F5.1,' .and. Ratio(.T./.F.) >', F5.1, /,
     7 '.or. <I/Sig>(.F.) <',F5.1,' .and. Ratio(.T./.F.) >', F5.1, /,
     8 '.or. <I/Sig>(.F.) <',F5.1,' .and. Ratio(.T./.F.) >', F5.1, /)
99990 FORMAT ('Analysis of Systematic Absences')
99989 FORMAT (/, A, /, 31('='))
99988 FORMAT (/, A, /)
99987 FORMAT (A)
      END SUBROUTINE PLA162
      SUBROUTINE PLA163 (NAME)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP18=50,NP22=287,NP38=150,NP39=30,NP52=200,NP56=30,
     2 NP57=35,NCS=52)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DFSPGR/ SUM(NCS, 5), NUM(NCS, 5), XMFS(NCS), XTL(12),
     1 XNM(12), NNZ(13), ANZ(13), IR(3), IN(24), XN(48), FMN(12),
     2 ITL(12), AVNZ(3), NREF, IPERC, TRMX(3, 3), LU, ISPGRC, ISPGRA,
     3 ISPGRH, IPCNTC, IPCNTA, IPCNTH, IFRQC, IFRQA, IFRQH, RAVERC,
     4 RAVERA, RAVERH
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      CHARACTER NAME*7, NAME1*7, NAME2*5
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      LINE = 'SPGR '//NAME
      CALL GEN038 (LINE, 13, 80)
      CALL SGSM (LINE, 0, FN, 0,  0, IERR)
      CALL SGSM (LINE, 0, FN, 0, 18, IERR)
      IF (NAME .EQ. 'Pa     ') THEN
        NAME1 = 'Pc'
        NAME2 = 'C-BA'
      ELSE IF (NAME .EQ. 'P2/a   ') THEN
        NAME1 = 'P2/c'
        NAME2 = 'C-BA'
      ELSE IF (NAME .EQ. 'P21/a  ') THEN
        NAME1 = 'P21/c'
        NAME2 = 'C-BA'
      ELSE IF (NAME .EQ. 'Pn     ') THEN
        NAME1 = 'Pc'
        NAME2 = 'A-B-N'
      ELSE IF (NAME .EQ. 'P2/n   ') THEN
        NAME1 = 'P2/c'
        NAME2 = 'A-B-N'
      ELSE IF (NAME .EQ. 'P21/n  ') THEN
        NAME1 = 'P21/c'
        NAME2 = 'A-B-N'
      ELSE IF (NAME .EQ. 'Pb-3   ') THEN
        NAME1 = 'Pa-3'
        NAME2 = 'BA-C'
      ELSE
        NAME1 = LINE(1:7)
        NAME2 = LINE(8:11)
      END IF
      IF (NAME2(1:3) .EQ. '   ') NAME2 = 'ABC  '
      CALL GEN020 (1, NAME2, 1, 5)
      IL  = NINT(FN(3))
      ID2 = NINT(FN(5))
      ID3 = 1
      IF (ID2 .EQ. 2) THEN
        NZP = IPERC
      ELSE
        NZP = 100 - IPERC
      END IF
      IF (LINE(71:72) .EQ. ' C') THEN
        LINE(71:77) = ' Chiral'
      ELSE
        LINE(71:77) = '       '
      END IF
      RAVER = RVL(IL, 1)
      ISGNR = NINT(FN(1))
      READ (LINE(66:70), 99997) IFRQ
      WRITE (PRBUF, 99999, IOSTAT = IOST) IL, ID2, ID3, NAME, ISGNR,
     1  IFRQ, NAME1, NAME2, RAVER, NTL(IL, 3) ,
     2  NZP, LINE(71:77), LINE(14:14)
      IF (LU .EQ. 0) THEN
        VRT = VRT - 0.7
        IF (RVL(IL, 1) .GT. RMAX) THEN
          NCOL = 2
        ELSE
          NCOL = 1
        END IF
        CALL GGIP09 (0.0, PRBUF(13:80), 68, 0.35, NCOL, 2, 0.1, VRT)
      ELSE
        WRITE (LU, 99998, IOSTAT = IOST) PRBUF(13:80)
        IF (LU .EQ. LU7) THEN
          WRITE (LU2, 99998, IOSTAT = IOST) PRBUF(1:80)
          IF (LINE(14:14) .EQ. 'C') THEN
            IF (RAVER .LT. RAVERC) THEN
              IF (NZP .GT. IPCNTC) THEN
                IF (IFRQ .GT. IFRQC) THEN
                  ISPGRC = ISGNR
                  IFRQC  = IFRQ
                  RAVERC = RVL(IL, 1)
                  IPCNTC = NZP
                END IF
              END IF
            END IF
          ELSE
            IF (RAVER .LT. RAVERA) THEN
              IF (NZP .GT. IPCNTA) THEN
                IF (IFRQ .GT. IFRQA) THEN
                  ISPGRA = ISGNR
                  IFRQA  = IFRQ
                  RAVERA = RVL(IL, 1)
                  IPCNTA = NZP
                END IF
              END IF
            END IF
            IF (LINE(71:72) .EQ. ' C') THEN
              IF (RAVER .LT. RAVERH) THEN
                IF (NZP .GT. IPCNTH) THEN
                  IF (IFRQ .GT. IFRQH) THEN
                    ISPGRH = ISGNR
                    IFRQH  = IFRQ
                    RAVERH = RVL(IL, 1)
                    IPCNTH = NZP
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT ('SPGR ', 3I2, 1X, A, I4, I6, 2X, A, ' :', A, F8.2,
     1         I6, I4, A, 1X, A)
99998 FORMAT (A)
99997 FORMAT (I5)
      END SUBROUTINE PLA163
      SUBROUTINE PLA164 (IMODE, IAPPEND, OLATT, TM1, AXCRIT, GEXT)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP18=50,NVD=100000000,
     1  NP23=28000, NP38=150,NP39=30,NCS=52,NSCR=2*NP23-1501*14)
C **********************************************************************
C **********************************************************************
C **********************************************************************
      INTEGER DOT
      DIMENSION MS(10, 55)
      REAL MAXD, V(3), ORT(3, 3), TAU(3)
      LOGICAL CHANGE
      DIMENSION TM1(3, 3)
      CHARACTER OLATT*1, LAT0*1, LATT*1
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /CHARS/ LAT0, LATT(3)
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      COMMON // DHX(3, 1501), TT(1501, 11), ISCR(NSCR), VOID(NVD)
      COMMON /LEPAG/ AXES(15, 23), TM(3, 3), CL(3, 5), TP(3, 3),
     1 TG(3, 3), TPQ(3, 3), TPS(3, 3), G(3, 3), OR(3, 3), ROTQ(3, 3),
     2 TRMXT(3, 3), T(3), H(3), TC(6), CELL(7), OCELL(7), RCELL(7),
     3 IDET, NVEC
      COMMON /DFSPGR/ SUM(NCS, 5), NUM(NCS, 5), XMFS(NCS), XTL(12),
     1 XNM(12), NNZ(13), ANZ(13), IR(3), IN(24), XN(48), FMN(12),
     2 ITL(12), AVNZ(3), NREF, IPERC, TRMX(3, 3), LU, ISPGRC, ISPGRA,
     3 ISPGRH, IPCNTC, IPCNTA, IPCNTH, IFRQC, IFRQA, IFRQH, RAVERC,
     4 RAVERA, RAVERH
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CFSPGR/ EXT, ILAT0, ILAT1, LAUE
      CHARACTER EXT(NCS)*1, ILAT0*1, ILAT1*1, LAUE*5
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER GEXT*1
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      IWIN = IGBL(25) * IGBL(32)
      K1   = 1
      IF (IMODE .EQ. 0) THEN
        LUIM = 2 + IWIN
      ELSE IF (IMODE .GT. 0) THEN
        IF (IAPPEND .EQ. 0) THEN
          NRLT0 = 1
          NRLT  = 1
        ELSE
          NRLT0 = NRLT0 + 1
          IF (GEXT .NE. '?') NRLT  = NRLT  + 1
        END IF
        LUIM = 2
        DO I = 1, 6
          XCELL(I, NRLT0) = PAR(100 + I)
        END DO
        XCELL(7, NRLT0) = GEN045 (PAR(101))
        DO I = 1, 9
          TLATT(I, NRLT0) = 0.0
        END DO
        TLATT (1, NRLT0) = 1.0
        TLATT (5, NRLT0) = 1.0
        TLATT (9, NRLT0) = 1.0
        BLATT(NRLT0)     = OLATT
        CLATT(NRLT0)     = 'a'
        ELATT(NRLT0)     = GEXT
        LLAUE(NRLT0)     = 1
        RVAL(NRLT0, 1)   = 0.0
        RVAL(NRLT0, 2)   = 0.0
        RVAL(NRLT0, 3)   = 0.0
      END IF
      NLPB = 0
      NLPE = 0
      IPR(117) = 4
   10 IPR117   = IPR(117)
      IF (IPR(117) .EQ. 1) THEN
        NLPB  = 72
        NLPE  = 127
      ELSE IF (IPR(117) .EQ. 2) THEN
        NLPB  = 72
        NLPE  = 92
      ELSE IF (IPR(117) .EQ. 3) THEN
        NLPB  = 72
        NLPE  = 79
      ELSE IF (IPR(117) .EQ. 4) THEN
        NLPB  = 16
        NLPE  = 16
      ELSE IF (IPR(117) .EQ. 5) THEN
        NLPB  = 16
        NLPE  = 23
      ELSE IF (IPR(117) .EQ. 6) THEN
        NLPB  = 16
        NLPE  = 36
      ELSE IF (IPR(117) .EQ. 7) THEN
        NLPB  = 16
        NLPE  = 71
      END IF
      DO NLPI = NLPB, NLPE
        NLP = NLPI
   20   CALL GEN101 (IPR(94), NVEC, DHX)
        CALL GEN074 (AXES, 1, 345, 0.0)
        CALL GEN074 (TT, 1, NVEC * 11, 0.0)
        IDET = 1
        DO I = 1, 6
          OCELL(I) = PAR(100 + I)
        END DO
        OCELL(7) = GEN045 (OCELL)
        LATT(1)  = OLATT
        L        = 0
        DO I = 1, 7
          IF (LAT(I) .EQ. OLATT) THEN
            L = I
            EXIT
          END IF
        END DO
        DO J = 1, 3
          DO K = 1, 3
            TPS(J, K) = TRNSX(J, K, L)
            TPQ(J, K) = TRNSX(J, K, NLP)
          END DO
        END DO
        CALL GEN004 (TPQ, TPS, TP)
        CALL GEN026 (1, G, OCELL)
        CALL GEN001 (1, TP, G, G)
        CALL PLA203 (G, TP, PAR(440))
        CALL GEN026 (-1, G, RCELL)
        RCELL(7) = GEN045 (RCELL)
        K = 0
        L = 0
        DO I = 1, 3
          DO J = 1, 3
            TPS(I, J) = TP(I, J)
            K = K + 1
            TLATT(K, NRLT0 + 1) = TP(I, J)
            IF (NRLT0 .NE. 0) THEN
              IF (TLATT(K, NRLT0 + 1) .NE. TLATT(K, NRLT0)) L = 1
            ELSE
              L = 1
            END IF
          END DO
        END DO
        BLATT(NRLT0 + 1)     = 'P'
        CLATT(NRLT0 + 1)     = 'a'
        ELATT(NRLT0 + 1)     = GEXT
        LLAUE(NRLT0 + 1)     = 1
        RVAL(NRLT0 + 1, 1)   = 0.0
        RVAL(NRLT0 + 1, 2)   = 0.0
        RVAL(NRLT0 + 1, 3)   = 0.0
        DO K = 1, 7
          XCELL(K, NRLT0 + 1) = RCELL(K)
        END DO
        IF (NRLT0 .NE. 0) THEN
          IF (BLATT(NRLT0 + 1) .NE. BLATT(NRLT0)) L = 1
        ELSE
          L = 1
        END IF
        NRLT0        = NRLT0 + L
        IF (GEXT .NE. '?') NRLT = NRLT0
        CALL GEN044 (RCELL, OR, 1)
        CALL GEN005 (OR, ORT)
        CALL GEN003 (ORT, ROTQ, DET, 0)
        DO K = 1, NVEC
          DO I = 1, 3
            V(I) = DHX(I, K)
          END DO
          CALL GEN002 (1, OR, V, T, XLNG)
          DKW = 0.0
          DO J = 1, 3
            TT(K, J)     = T(J)
            TT(K, J + 3) = T(J) * T(J)
            DKW          = DKW  + TT(K, J + 3)
          END DO
          TT(K, 7)       = T(1) * T(2)
          TT(K, 8)       = T(1) * T(3)
          TT(K, 9)       = T(2) * T(3)
          TT(K, 10)      = SQRT(ABS(DKW))
          TT(K, 11)      = K
        END DO
   30   CHANGE = .FALSE.
        DO K = 1, NVEC - 1
          IF (TT(NINT(TT(K, 11)), 10) .GT. TT(NINT(TT(K + 1, 11)), 10))
     1      THEN
            CALL GEN018 (TT(K, 11), TT(K + 1, 11))
            CHANGE = .TRUE.
          END IF
        END DO
        IF (CHANGE) GO TO 30
        IF (IMODE .EQ. 0) THEN
          CALL PLA262 (0)
          WRITE (LU6, 99994, IOSTAT = IOST) (RCELL(J), J = 1, 6),
     1      RCELL(7)
          WRITE (LU7, 99994, IOSTAT = IOST) (RCELL(J), J = 1, 6),
     1      RCELL(7)
          DO K0 = 1, 37
            K = NINT(TT(K0, 11))
            WRITE (LU6, 99995, IOSTAT = IOST)
     1        K0, (NINT(DHX(J, K)), J = 1, 3), TT(K,10)
            WRITE (LU7, 99995, IOSTAT = IOST)
     1        K0, (NINT(DHX(J, K)), J = 1, 3), TT(K,10)
          END DO
        END IF
        I = NVEC
        ITEL = 0
        MAXD = 0.0
        DO J = 1, NVEC
          DO I = 1, 3
            V(I) = DHX(I, J)
          END DO
          CALL GEN002 (1, ROTQ, V, TAU, XLNG)
          TC(1) = TAU(2) * TAU(2) + TAU(3) * TAU(3)
          TC(2) = TAU(1) * TAU(1) + TAU(3) * TAU(3)
          TC(3) = TAU(1) * TAU(1) + TAU(2) * TAU(2)
          TC(4) = -2 * TAU(1) * TAU(2)
          TC(5) = -2 * TAU(1) * TAU(3)
          TC(6) = -2 * TAU(2) * TAU(3)
          DO K = 1, NVEC
            DOT = 0
            DO N = 1, 3
              DOT = DOT + ABS(NINT(DHX(N, J) * DHX(N, K)))
            END DO
            IF (DOT .LE. IPR(94) .AND. DOT .GT. 0) THEN
              TAND = TT(K, 4) * TC(1) + TT(K, 5) * TC(2)
     1             + TT(K, 6) * TC(3) + TT(K, 7) * TC(4)
     2             + TT(K, 8) * TC(5) + TT(K, 9) * TC(6)
              TAND = ATAN(SQRT(ABS(TAND)) / DOT) * RGBL(6)
              IF (TAND .LE. AXCRIT) THEN
                IF (ITEL .EQ. 15) THEN
                  CALL GEN122 (AXES, 8, ITEL)
                  CALL GEN122 (AXES, 7, ITEL)
                  ITEL = 8
                END IF
                ITEL = ITEL + 1
                DO I = 1, 3
                  AXES(ITEL, I)     = DHX(I, K)
                  AXES(ITEL, I + 3) = DHX(I, J)
                  AXES(ITEL, I + 9) = TT(K, I) / TT(K, 10)
                END DO
                AXES(ITEL, 7) = TAND
                AXES(ITEL, 8) = TT(K, 10)
                AXES(ITEL, 9) = DOT
                IF (TAND .GT. MAXD) MAXD = TAND
              END IF
            END IF
          END DO
        END DO
        IF (ITEL .GT. IPR(514)) THEN
          CALL GEN122 (AXES, 7, ITEL)
          ITEL = IPR(514)
        END IF
        METRIC = 0
        NTEL   = ITEL
        IBEG   = 1
        IEND   = 0
        ISOL   = 0
          CALL GEN122 (AXES, 7, ITEL)
        GO TO 50
   40   CALL GEN122 (AXES, 7, ITEL)
        IF (ITEL .EQ. 7) THEN
          ITEL = ITEL - 4
        ELSE
          ITEL = ITEL - 2
        END IF
   50   IF (LUIM .EQ. 3) THEN
          BCD = 'LePage'//CHAR(0)
          CALL GGIP (HORS, VERT, 0.0, 1)
          CALL GGIP09 (0.0,  BCD, 7, 1.4, 4, 8, 10.6, VERT - 1.8)
          CALL GGIP09 (0.0,  BCD, 7, 1.4, 2, 8, 10.4, VERT - 1.9)
          IF (NLPE .GT. NLPB) THEN
            WRITE (BCD, 99996, IOSTAT = IOST) NLP - NLPB + 1,
     1        ((TPQ(I, J), J = 1, 3), I = 1, 3), GEN084 (TRNSX, NLP)
            CALL GGIP09 (0.0, BCD, 80, 0.35, 3, 2, 0.1, 6.0)
          END IF
        END IF
   60   DO I = 1, 3
          DO J = 1, 3
            TP(I, J) = TPS(I, J)
          END DO
        END DO
        IF (ITEL .EQ. -1) THEN
          ITEL = 0
        ELSE IF (ITEL .EQ. -2) THEN
          GO TO 110
        ELSE
          CALL GEN122 (AXES, 8, ITEL)
        END IF
        IF (ITEL .GT. 1 .AND. MOD(ITEL, 2) .EQ. 0) ITEL = ITEL - 1
        CALL PLA165 (ITEL, MAXD, AXCRIT, ISOL, LUIM)
        ISOL = 1
        IF (MAXD .LE. PAR(441) .AND. METRIC .EQ. 0 .AND. ISOL .EQ. 1)
     1     THEN
          METRIC = 1
          NTEL   = ITEL
          DO I = 1, 9
            AXES(I, 23) = I
          END DO
        END IF
        IF (ITEL .GT. 0 .AND. (METRIC .EQ. 0 .OR. ISOL .EQ. 0))
     1    GO TO 100
        ILAT0 = LAT0
        CALL GEN052 (TP, TRMX)
        CALL GEN004 (TRMX, TM1, TRMXT)
        ILAT1 = LATT(3)
        CALL PLA167
        SELECT CASE (ILAT0)
          CASE ('a')
            I1 = 1
            I2 = 1
          CASE ('m')
            I1 = 2
            I2 = 2
          CASE ('o')
            I1 = 3
            I2 = 3
          CASE ('t')
            I1 = 4
            I2 = 5
          CASE ('h')
            IF (ILAT1 .EQ. 'R') THEN
              I1 = 6
              I2 = 7
            ELSE
              I1 = 6
              I2 = 10
            END IF
          CASE DEFAULT
            I1 = 11
            I2 = 12
        END SELECT
        IF (IMODE .EQ. 3) THEN
          RVLX = 100.0
        ELSE
          RVLX = 0.0
        END IF
        DO 70 I0 = I2, I1, - 1
          RVLX = MIN (RVLX, RVL(I0, 1))
          IF (IMODE .NE. 0) THEN
            YUNK = ABS(CELL(4) - 90.0) + ABS(CELL(5) - 90.0) +
     1             ABS(CELL(6) - 90.0)
            IF (YUNK .LT. 0.001) THEN
              YUNK = 0.0
              DO I = 1, 3
                DO J = 1, 3
                  IF (I .NE. J) THEN
                    YUNK = YUNK + ABS(TRMXT(I, J))
                  END IF
                END DO
              END DO
              IF (YUNK .LT. 0.001) THEN
                DO I = 1, 3
                  TRMXT(I, I) = ABS(TRMXT(I, I))
                END DO
              END IF
            END IF
            WRITE (LU2, 99999, IOSTAT = IOST)
     1        ((TRMXT(I, J), J = 1, 3), I = 1, 3), ILAT0, ILAT1, I0,
     2        (RVL(I0, K), K = 1, 3), (NTL(I0, K), K = 1, 3),
     3        (CELL(I), I = 1, 7), GEXT
            IF (RVL(I0, 1) .LE. PAR(431)) THEN
              CLATT(NRLT0 + 1) = ILAT0
              BLATT(NRLT0 + 1) = ILAT1
              ELATT(NRLT0 + 1) = GEXT
              CALL GEN020 (-1, CLATT(NRLT0 + 1), 1, 1)
              CALL GEN020 ( 1, BLATT(NRLT0 + 1), 1, 1)
              LLAUE(NRLT0 + 1) = I0
              DO I = 1, 3
                RVAL(NRLT0 + 1, I) = RVL(I0, I)
              END DO
              DO I = 1, 7
                XCELL(I, NRLT0 + 1) = CELL(I)
              END DO
              M = 0
              DO K = 1, 3
                DO J = 1, 3
                  M = M + 1
                  TLATT(M, NRLT0 + 1) = TRMXT(K, J)
                END DO
              END DO
              DO I = 1, NRLT0
                DIFF = 0.0
                DO M = 1, 9
                  DIFF = DIFF + ABS(TLATT(M, I) - TLATT(M, NRLT0 + 1))
                END DO
                IF (DIFF .LT. 0.001) THEN
                  IF (CLATT(NRLT0 + 1) .EQ. CLATT(I)) THEN
                    IF (BLATT(NRLT0 + 1) .EQ. BLATT(I)) THEN
                      IF (LLAUE(NRLT0 + 1) .EQ. LLAUE(I)) THEN
                        IF (I .EQ. 1) THEN
                          DO J = 1, 3
                            RVAL(1, J) = RVAL(NRLT0 + 1, J)
                          END DO
                          GO TO 70
                        ELSE
                          IF (RVAL(NRLT0 + 1, 1) .EQ. RVAL(I, 1)) THEN
                            DIFF = 0.0
                            DO J = 1, 7
                              DIFF = DIFF +
     1                        ABS(XCELL(J, I) - XCELL(J, NRLT0 + 1))
                            END DO
                            IF (DIFF .LT. 0.01) GO TO 70
                          END IF
                        END IF
                      END IF
                    END IF
                  END IF
                END IF
              END DO
              NRLT0 = NRLT0 + 1
              IF (RVAL(NRLT0, 1) .LT. RMAX) THEN
                IF (K1 .EQ. 1) THEN
                  IF (BLATT(NRLT0) .EQ. 'P' .AND.
     1                CLATT(NRLT0) .EQ. 'a') THEN
                    IF (ELATT(NRLT0) .NE. '?')  NRLT = NRLT0
                  END IF
                END IF
                IF (LLAUE(NRLT0) .GT. K1) THEN
                  IF (ELATT(NRLT0) .NE. '?')  THEN
                    NRLT = NRLT0
                    K1   = LLAUE(NRLT0)
                  END IF
                END IF
              END IF
            END IF
          END IF
   70   CONTINUE
        IF (IMODE .EQ. 0) THEN
          RMAXM = RMAX
        ELSE
          RMAXM = -1.0
        END IF
        IF ((IMODE .EQ. 1 .OR. RVLX .GT. RMAXM) .AND. ITEL .GT. 0) THEN
          IF (IMODE .EQ. 1 .AND. (IEND .LT. IBEG .AND. ITEL .EQ. 1))
     1      THEN
            ITEL = 0
            GO TO 40
          END IF
          DO I = 1, NTEL
            AXES(I, 23) = MOD(AXES(I, 23), 1000.0)
          END DO
          CALL GEN122 (AXES, 23, NTEL)
          IF (IEND .EQ. 0) THEN
            IF (NTEL .GT. 1) THEN
              DO I = 1, NTEL
                IEND = IEND + 1
                MS(10, IEND) = 1
                DO J = 1, 9
                  IF (J .EQ. I) THEN
                    MS(J, IEND) = 1
                  ELSE
                    MS(J, IEND) = 0
                  END IF
                END DO
              END DO
            END IF
            IEND = IEND + 1
            DO J = 1, 10
              MS(J, IEND) = 0
            END DO
          END IF
          IF (ILAT0 .EQ. 'c') THEN
            DO J = 1, 3
              IEND         = IEND + 1
              MS(10, IEND) = 5
              DO I = 1, 9
                IF (ABS(ABS(AXES(J, 13 + I)) - 90.0) .LT. AXCRIT) THEN
                  MS(I, IEND) = 1
                ELSE
                  MS(I, IEND) = 0
                END IF
              END DO
              MS(J,  IEND) = 1
            END DO
            V(1) = 1.0
            DO I = 1, 4
              IF (I .GT. 2) THEN
                V(2) = -1.0
              ELSE
                V(2) = 1.0
              END IF
              IF (MOD(I, 2) .EQ. 0) THEN
                V(3) = -1.0
              ELSE
                V(3) = 1.0
              END IF
              IEND = IEND + 1
              MS(10, IEND) = 3
              DO J = 1, 9
                DOT = 0
                DO K = 1, 3
                  DOT = DOT + NINT(AXES(J, K) * V(K))
                END DO
                IF (DOT .EQ. 0) THEN
                  MS(J, IEND) = 1
                ELSE
                  MS(J, IEND) = 0
                END IF
              END DO
            END DO
          ELSE IF (ILAT0 .EQ. 'h') THEN
            IF (ILAT1 .EQ. 'P') THEN
              DO J = 1, 7
                IF (NINT(AXES(J, 13)) .EQ. 2) THEN
                  IEND         = IEND + 1
                  MS(10, IEND) = 3
                  DO I = 1, 7
                    IF (ABS(ABS(AXES(J, 13 + I)) - 90.0) .LT. AXCRIT)
     1               THEN
                      MS(I, IEND) = 1
                    ELSE
                      MS(I, IEND) = 0
                    END IF
                  END DO
                  MS(J, IEND) = 1
                END IF
              END DO
            END IF
          ELSE IF (ILAT0 .EQ. 't') THEN
            IEND = IEND + 1
            MS(10, IEND) = 3
            DO I = 1, 9
              IF (NINT(AXES(I, 13)) .EQ. 4) THEN
                MS(I, IEND) = 1
                J = I
              ELSE
                MS(I, IEND) = 0
              END IF
            END DO
            N = 1
            DO I = 1, 5
              IF (ABS(ABS(AXES(J, 13 + I)) - 90.0) .LT. AXCRIT) THEN
                N = N + 1
                MS(I, IEND) = 1
                IF (N .EQ. 3) GO TO 80
              END IF
            END DO
          END IF
        END IF
   80   IF (IEND .GE. IBEG) THEN
          IF (IBEG .GT. 1) THEN
            DO 90 I = 1, IBEG - 1
              DO J = 1, 10
                IF (MS(J, IBEG) .NE. MS(J, I)) GO TO 90
              END DO
              IBEG = IBEG + 1
              GO TO 110
   90       CONTINUE
          END IF
          DO I = 1, NTEL
            AXES(I, 23) = MOD(AXES(I, 23), 1000.0)
          END DO
          DO I = 1, NTEL
            IF (MS(I, IBEG) .EQ. 0) AXES(I, 23) = AXES(I, 23) + 1000.0
          END DO
          CALL GEN122 (AXES, 23, NTEL)
          ITEL = MS(10, IBEG)
          IBEG = IBEG + 1
          GO TO 60
        END IF
        IF (IEND .GT. 0) ITEL = 1
  100   IF (IWIN .EQ. 1 .AND. IMODE .EQ. 0) THEN
          IF (METRIC .EQ. 0 .OR. NLP .LT. NLPE) THEN
            WRITE (SBCD, 99997, IOSTAT = IOST) CHAR(0)
          ELSE
            WRITE (SBCD, 99998, IOSTAT = IOST) CHAR(0)
          END IF
          CALL PLA015 (0, 39)
          CALL PLA013 (0, 1)
          IF (IPR(117)  .NE. IPR117) GO TO 10
          IF (IGGT(1:4) .EQ. 'REST' .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 20
          IF (IGGT(1:4) .EQ. 'EXIT') GO TO 110
          IF (IGGT(1:3) .NE. 'END')  THEN
            IF (IGGT(1:1) .EQ. '!' .OR. IGGT(1:4) .EQ. 'NEXT') THEN
              IF (METRIC .EQ. 0) GO TO 40
            END IF
          END IF
        END IF
      END DO
  110 IF (IMODE .GT. 0) THEN
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'.trm',
     1    STATUS = 'UNKNOWN', FORM = 'UNFORMATTED')
        NREXT = IPR(481)
        AVIOS = PAR(428)
        WRITE (LU61) NRLT0, NRLT, NREXT, AVIOS, RMAX,
     1   RVL, NTL, TLATT, XCELL, LLAUE, RVAL, CLATT, BLATT, ELATT
        CLOSE (UNIT = LU61)
      END IF
      CALL GEN038 (IGGT, 1, 80)
      IGBL(6) = 10
      RETURN
99999 FORMAT ('TRMX ', 9F7.3, 1X, A, A, I3, ' =', /, 5X, 3F6.1, 3I8,
     1        ' = ', /, 5X, 3F10.4, 3F8.3, F10.2, 1X, A)
99998 FORMAT ('[END]',  A)
99997 FORMAT ('[NEXT]', A)
99996 FORMAT ('TRANS:', I2, ' (', 3F6.2, ' /', 3F6.2, ' /',
     1         3F6.2, ') Det =', F5.2)
99995 FORMAT (I3, 3I5, F10.4)
99994 FORMAT ('REDUCED CELL:', 3F8.4, 3F8.3, F10.2, /)
      END SUBROUTINE PLA164
      SUBROUTINE PLA165 (ITEL, MAXD, AXCRIT, ISOL, LUIM)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1           NP38=150,NP39=30,NSCR=2*NP23-1501*14)
      REAL MAXD, BB(3, 3)
      CHARACTER LATT*1, LAT0*1
      CHARACTER SYST0*10, SYST*12, LINE*80
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /CHARS/ LAT0, LATT(3)
      COMMON // DHX(3, 1501), TT(1501, 11), ISCR(NSCR), VOID(NVD)
      COMMON /LEPAG/ AXES(15, 23), TM(3, 3), CL(3, 5), TP(3, 3),
     1 TG(3, 3), TPQ(3, 3), TPS(3, 3), G(3, 3), OR(3, 3), ROTQ(3, 3),
     2 TRMXT(3, 3), T(3), H(3), TC(6), CELL(7), OCELL(7), RCELL(7),
     3 IDET, NVEC
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION DUM4(3, 3), YUNK(3, 3)
      LATT(3) = 'P'
      MAXD    = 0.0
      ANGM    = 0.0
      ANGMN   = 0.0
      IF (ITEL .GT. 0) THEN
        ANGM  = 0.0
        ANGMN = 180.0
        DO I = 1, ITEL
          IF (AXES(I, 7) .GT. MAXD) MAXD = AXES(I, 7)
          AXES(I, 13) = 0.0
          DO J = 1, ITEL
            ANG = 0.0
            AXES(I, J + 13) = 0.0
            IF (I .NE. J) THEN
              ANG = AXES(I, 10) * AXES(J, 10)
     1            + AXES(I, 11) * AXES(J, 11)
     2            + AXES(I, 12) * AXES(J, 12)
              IF (ABS(ANG) .LT. 0.00001) THEN
                ANG = 90.0
              ELSE IF (ANG .GE. 1.0) THEN
                ANG = 0
              ELSE
                ANG = ACOS(ANG) * RGBL(6)
                IF (ANG .LT. 0.0)  ANG = ANG + 180.0
                IF (ANG .LT. 90.0) ANG = 180.0 - ANG
              END IF
              IF (ANG .GT. ANGM)   ANGM = ANG
              IF (ANG .LT. ANGMN) ANGMN = ANG
              AXES(I, J + 13) = ANG
              IF (ANG + AXCRIT .GT. 90.0 .AND.
     1            ANG - AXCRIT .LT. 90.0)
     1          AXES(I, 13) = AXES(I, 13) + 1
            END IF
          END DO
        END DO
      END IF
      IF (ITEL .EQ. 0) THEN
        SYST = 'Anorthic'
        CALL GEN021 (TM, 1)
      ELSE IF (ITEL .EQ. 1) THEN
        SYST = 'Monoclinic'
        DO N = 1, 3
          TM(2, N) = AXES(ITEL, N)
        END DO
        YDUM = COS((90.0 - AXCRIT) / RGBL(6))
        D1   = 999.0
        D2   = 0.0
        DO 60 K = 1, NVEC
          DUM = (TT(K, 1) * AXES(ITEL, 10)
     1        +  TT(K, 2) * AXES(ITEL, 11)
     2        +  TT(K, 3) * AXES(ITEL, 12)) / TT(K,10)
          IF (ABS(DUM) .GT. YDUM) GO TO 60
          IF (TT(K, 10) .GE. D1) THEN
            IF (TT(K, 10) .GT. D2) GO TO 60
            I  = 3
            D2 = TT(K, 10)
          ELSE
            D2 = D1
            DO N = 1, 3
              TM(3, N) = TM(1, N)
              CL(3, N) = CL(1, N)
            END DO
            I  = 1
            D1 = TT(K, 10)
          END IF
          DO N = 1, 3
            TM(I, N) = DHX(N, K)
            CL(I, N) = TT(K, N)
          END DO
   60   CONTINUE
        DUM = CL(1, 1) * CL(3, 1) + CL(1, 2) * CL(3, 2)
     1      + CL(1, 3) * CL(3, 3)
        IF (DUM .GT. 0.0) THEN
          DO N = 1, 3
            TM(3, N) = - TM(3, N)
          END DO
        END IF
        CALL GEN003 (TM, BB, DET, 0)
        IF (DET .LE. 0) THEN
          DO N = 1, 3
            TM(2, N) = - TM(2, N)
          END DO
        END IF
      ELSE IF (ITEL .EQ. 3) THEN
        SYST = 'Hexagonal   '
        IF (ANGM  .GT. 120.0 + AXCRIT .OR.
     1      ANGMN .LT. 120.0 - AXCRIT) THEN
          SYST = 'Orthorhombic'
          ZANG = 90
          GO TO 170
        END IF
        DOT  = 0.0
        K    = 0
        DO I3 = 1, 3, 2
          K = K + 1
          DO J3 = 1, 3
            TM(K, J3) = AXES(I3, J3)
            CL(K, J3) = AXES(I3, J3 + 9)
            IF (K .EQ. 2) DOT = DOT + CL(1, J3) * CL(2, J3)
          END DO
        END DO
        IF (DOT .GT. 0) THEN
          DO J3 = 1, 3
            TM(2, J3) = - TM(2, J3)
            CL(2, J3) = - CL(2, J3)
          END DO
        END IF
        CRS1     = CL(1, 2) * CL(2, 3) - CL(1, 3) * CL(2, 2)
        CRS2     = CL(1, 3) * CL(2, 1) - CL(1, 1) * CL(2, 3)
        CRS3     = CL(1, 1) * CL(2, 2) - CL(1, 2) * CL(2, 1)
        TM(3, 1) = CRS1 * ROTQ(1, 1) + CRS2 * ROTQ(2, 1)
     1           + CRS3 * ROTQ(3, 1)
        TM(3, 2) = CRS1 * ROTQ(1, 2) + CRS2 * ROTQ(2, 2)
     2           + CRS3 * ROTQ(3, 2)
        TM(3, 3) = CRS1 * ROTQ(1, 3) + CRS2 * ROTQ(2, 3)
     3           + CRS3 * ROTQ(3, 3)
        CALL GEN003 (TM, BB, DET, 0)
        DO N = 1, 3
          TMDUM    = TM(3, N) * 3 / DET
          TM(3, N) = NINT(TMDUM)
        END DO
        DO LOOP = 1, 2
          MODL = 3
          H(1) = 2
          H(2) = 1
          H(3) = 1
          CALL GEN092 (MODL, H, TM, NUM)
          IF (NUM .EQ. 0) GO TO 230
          DO N = 1, 3
            TM(1, N) = - TM(1, N)
            TM(2, N) = - TM(2, N)
          END DO
        END DO
        GO TO 310
      ELSE IF (ITEL .EQ. 5) THEN
        SYST = 'Tetragonal'
        ZANG = 90.0
        GO TO 170
      ELSE IF (ITEL .EQ. 7) THEN
        SYST = 'Hexagonal'
        ZANG = 120.0
        GO TO 170
      ELSE IF (ITEL .EQ. 9) THEN
        SYST = 'Cubic'
        K3   = 0
        N90  = 4
        DO I3 = 1, 9
          IF (NINT(AXES(I3, 13)) .EQ. N90) THEN
            K3 = K3 + 1
            IF (K3 .LE. 3) THEN
              DO J3 = 1, 3
                TM(K3, J3) = AXES(I3, J3)
              END DO
            END IF
          END IF
        END DO
        IF (K3 .NE. 3) GO TO 310
      ELSE
        GO TO 320
      END IF
      GO TO 230
  170 N90 = ITEL - 1
      IOK = 0
      DO I = 1, ITEL
        IF (NINT(AXES(I, 13)) .EQ. N90) IOK = 1
      END DO
      IF (IOK .EQ. 0) GO TO 310
      YDUM1 = COS((ZANG - AXCRIT) / RGBL(6))
      YDUM2 = COS((ZANG + AXCRIT) / RGBL(6))
      K = 0
      DO I3 = 1, ITEL
        IF (NINT(AXES(I3, 13)) .LT. 2) GO TO 310
        IF (ITEL .LE. 3) THEN
          K3 = I3
          GO TO 190
        END IF
        IF (NINT(AXES(I3, 13)) .EQ. N90) THEN
          K3 = 3
          GO TO 190
        END IF
        K = K + 1
        IF (K .GT. 2) THEN
          K3 = 0
        ELSE
          K3 = K
        END IF
  190   IF (K3 .GT. 0) THEN
          DO J3 = 1, 3
            TM(K3, J3) = AXES(I3, J3)
            CL(K3, J3) = AXES(I3, J3 + 9)
          END DO
        END IF
      END DO
      DUM = CL(1, 1) * CL(2, 1) + CL(1, 2) * CL(2, 2)
     1    + CL(1, 3) * CL(2, 3)
      IF (DUM .GT. 0.0) THEN
        DO N = 1, 3
          TM(2, N) = - TM(2, N)
        END DO
        DUM = - DUM
      END IF
      IF ((DUM .GT. YDUM1) .OR. (DUM .LT. YDUM2)) GO TO 310
  230 LAT0 = SYST(1:1)
      CALL GEN020 (-1, LAT0, 1, 1)
      CALL GEN003 (TM, BB, DET, 0)
      IF (DET .LT. 0) THEN
        DO N = 1, 3
          TM(3, N) = - TM(3, N)
        END DO
      END IF
      IDET = NINT(ABS(DET))
      IF (IDET .NE. 2) THEN
        IF (IDET .EQ. 3) LATT(3) = 'R'
        IF (IDET .EQ. 4) LATT(3) = 'F'
      ELSE
        MODL = 2
        LATT(3) = 'A'
        H(1) = 0
        H(2) = 1
        H(3) = 1
        CALL GEN092 (MODL, H, TM, NUM)
        IF (NUM .EQ. 0) GO TO 250
        LATT(3) = 'B'
        H(1) = 1
        H(2) = 0
        H(3) = 1
        CALL GEN092 (MODL, H, TM, NUM)
        IF (NUM .EQ. 0) GO TO 250
        LATT(3) = 'C'
        H(1)    = 1
        H(2)    = 1
        H(3)    = 0
        CALL GEN092 (MODL, H, TM, NUM)
        IF (NUM .EQ. 0) GO TO 250
        LATT(3) = 'I'
        H(1)    = 1
        H(2)    = 1
        H(3)    = 1
        CALL GEN092 (MODL, H, TM, NUM)
        IF ((NUM .NE. 0) .OR. (IDET .GT. 4)) THEN
          WRITE (LU6, 99988, IOSTAT = IOST)
          WRITE (LU7, 99988, IOSTAT = IOST)
          CALL GEN127 ('WRONG DETERMINANT!')
        END IF
      END IF
  250 IF ((ITEL .LT. 3) .AND. (LATT(3) .EQ. 'A')) THEN
        DO N = 1, 3
          CALL GEN018 (TM(1, N), TM(3, N))
          TM(2, N) = - TM(2, N)
        END DO
        LATT(3) = 'C'
      END IF
      IF ((ITEL .EQ. 3) .AND. ((LATT(3) .EQ. 'A') .OR.
     1   (LATT(3) .EQ. 'B'))) THEN
        IF (LATT(3) .EQ. 'A') THEN
          DO N = 1, 3
            CALL GEN018 (TM(1, N), TM(3, N))
            CALL GEN018 (TM(1, N), TM(2, N))
          END DO
        ELSE
          DO N = 1, 3
            CALL GEN018 (TM(2, N), TM(3, N))
            TM(1, N) = - TM(1, N)
          END DO
        END IF
        LATT(3) = 'C'
      END IF
      CALL PLA166 (ITEL, LATT(1), AXCRIT, PAR(441), LUIM)
      CALL GEN004 (TM(1, 1), TP, YUNK)
      CALL GEN052 (YUNK, TP)
      IF (LAT0 .EQ. 'm') THEN
        IF (LATT(3) .EQ. 'A') THEN
          TG(1, 1) =   TP(1, 1)
          TG(1, 2) =   TP(1, 2)
          TG(1, 3) =   TP(1, 3)
          TP(1, 1) =   TP(3, 1)
          TP(1, 2) =   TP(3, 2)
          TP(1, 3) =   TP(3, 3)
          TP(2, 1) = - TP(2, 1)
          TP(2, 2) = - TP(2, 2)
          TP(2, 3) = - TP(2, 3)
          TP(3, 1) =   TG(1, 1)
          TP(3, 2) =   TG(1, 2)
          TP(3, 3) =   TG(1, 3)
          LATT(3) = 'C'
        ELSE IF (LATT(3) .EQ. 'I') THEN
          TG(1, 1) =  TP(1, 1)
          TG(1, 2) =  TP(1, 2)
          TG(1, 3) =  TP(1, 3)
          TG(3, 1) =  TP(3, 1)
          TG(3, 2) =  TP(3, 2)
          TG(3, 3) =  TP(3, 3)
          TP(1, 1) = -TG(1, 1) - TG(3, 1)
          TP(1, 2) = -TG(1, 2) - TG(3, 2)
          TP(1, 3) = -TG(1, 3) - TG(3, 3)
          TP(3, 1) =  TG(1, 1)
          TP(3, 2) =  TG(1, 2)
          TP(3, 3) =  TG(1, 3)
          LATT(3) = 'C'
        END IF
      END IF
      IF (LAT0 .EQ. 'c') THEN
        LAT1 = 7
      ELSE IF (LAT0 .EQ. 'h') THEN
        IF (LATT(3) .EQ. 'R') THEN
          LAT1 = 5
        ELSE
          LAT1 = 6
        END IF
      ELSE IF (LAT0 .EQ. 't') THEN
        LAT1 = 4
      ELSE IF (LAT0 .EQ. 'o') THEN
        LAT1 = 3
      ELSE IF (LAT0 .EQ. 'm') THEN
        LAT1 = 2
      ELSE
        LAT1 = 1
      END IF
      CALL GEN021 (DUM4, 1)
      CALL GEN104 (LAT1, TP, DUM4)
      CALL GEN003 (TP, TG, DETM, 0)
      SYST0 = 'Metrically'
      IF (MAXD .GT. PAR(441)) SYST0 = 'Pseudo'
      DO LUI = 1, LUIM
        IF (LUI .EQ. 1) THEN
          LU = LU6
        ELSE IF (LUI .EQ. 2) THEN
          LU = LU7
        ELSE
          LU = 0
        END IF
        WRITE (LINE, 99999, IOSTAT = IOST)
        IF (LU .NE. 0) THEN
          WRITE (LU, 99989, IOSTAT = IOST)
          WRITE (LU, 99995, IOSTAT = IOST) LINE
          WRITE (LU, 99990, IOSTAT = IOST)
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 5 + IGBL(68), 2, 0.1, 5.0)
        END IF
        WRITE (LINE, 99998, IOSTAT = IOST)
     1    (TP(1, J), J = 1, 3), (TG(J, 1), J = 1, 3), SYST0
        IF (LU .NE. 0) THEN
          WRITE (LU, 99995, IOSTAT = IOST) LINE
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 1, 2, 0.1, 4.5)
        END IF
        WRITE (LINE, 99997, IOSTAT = IOST)
     1    (TP(2, J), J = 1, 3), (TG(J, 2), J = 1, 3), SYST
        IF (LU .NE. 0) THEN
          WRITE (LU, 99995, IOSTAT = IOST) LINE
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 1, 2, 0.1, 4.0)
        END IF
        WRITE (LINE, 99996, IOSTAT = IOST)
     1    (TP(3, J), J = 1, 3), (TG(J, 3), J = 1, 3), MAXD
        IF (LU .NE. 0) THEN
          WRITE (LU, 99995, IOSTAT = IOST) LINE
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 1, 2, 0.1, 3.5)
        END IF
      END DO
      CALL GEN026 (1, G, OCELL)
      CALL GEN001 (1, TP, G, G)
      CALL GEN026 (-1, G, CELL)
      CELL(7) = GEN045 (CELL)
      DO LUI = 1, LUIM
        IF (LUI .EQ. 1) THEN
          LU = LU6
        ELSE IF (LUI .EQ. 2) THEN
          LU = LU7
        ELSE
          LU = 0
        END IF
        WRITE (LINE, 99994, IOSTAT = IOST)
        IF (LU .NE. 0) THEN
          WRITE (LU, 99989, IOSTAT = IOST)
          WRITE (LU, 99995, IOSTAT = IOST) LINE
          WRITE (LU, 99990, IOSTAT = IOST)
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 5 + IGBL(68), 2, 0.1, 2.5)
        END IF
        WRITE (LINE, 99993, IOSTAT = IOST)
     1    LATT(1), (OCELL(J), J = 1, 7)
        IF (LU .NE. 0) THEN
          WRITE (LU, 99995, IOSTAT = IOST) LINE
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 1, 2, 0.1, 2.0)
        END IF
        WRITE (LINE, 99992, IOSTAT = IOST) (RCELL(I), I = 1, 7)
        IF (LU .NE. 0) THEN
          WRITE (LU, 99995, IOSTAT = IOST) LINE
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 1, 2, 0.1, 1.5)
        END IF
        IF (IPR(94) .NE. 2) LATT(3) = ' '
        WRITE (LINE, 99991, IOSTAT = IOST)
     1    LAT0, LATT(3), (CELL(J), J = 1, 7)
        IF (LU .NE. 0) THEN
          WRITE (LU, 99995, IOSTAT = IOST) LINE
        ELSE
          CALL GGIP09 (0.0, LINE, 79, 0.35, 1, 2, 0.1, 1.0)
        END IF
      END DO
      RETURN
  310 CALL PLA166 (ITEL, LATT(1), AXCRIT, PAR(441), LUIM)
      ISOL = 0
      RETURN
  320 WRITE (LU6, 99987, IOSTAT = IOST) ITEL
      CALL GEN127 (' WRONG "ITEL" NUMBER ')
99999 FORMAT ('==== Transformation Matrix: Input (a,b,c) to ',
     1 'Conventional Cell(a'', b'', c'') ==== ')
99998 FORMAT ('(a'')   (', 3(F6.3), ') (a)   (x'')   (', 3(F6.3),
     1 ') (x)  ', A)
99997 FORMAT ('(b'') = (', 3(F6.3), ') (b).  (y'') = (', 3(F6.3),
     1 ') (y)  ', A)
99996 FORMAT ('(c'')   (', 3(F6.3), ') (c)   (z'')   (', 3(F6.3),
     1 ') (z)  FOM:', F7.3)
99995 FORMAT (A)
99994 FORMAT (16X, 'Latt', 5X, 'a', 7X, 'b', 7X, 'c',
     1 5X, 'Alpha', 3X, 'Beta', 2X, 'Gamma', 6X, 'Volume')
99993 FORMAT ('Input Cell', 8X, A, 2X, 3(1X, F7.3), 3(F7.2), F12.2)
99992 FORMAT ('Reduc Cell', 8X, 'P', 2X, 3(1X, F7.3), 3(F7.2), F12.2)
99991 FORMAT ('Conv. Cell', 7X, 2A, 2X, 3(1X, F7.3), 3(F7.2), F12.2)
99990 FORMAT (80('-'))
99989 FORMAT (1X)
99988 FORMAT (//, 'THERE IS SOMETHING WRONG IN LATT TYPE ANALYSIS')
99987 FORMAT ('Wrong ITEL =', I5)
      END SUBROUTINE PLA165
      SUBROUTINE PLA166 (ITEL, LATT, P2, P3, LUIM)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /LEPAG/ AXES(15, 23), TM(3, 3), CL(3, 5), TP(3, 3),
     1 TG(3, 3), TPQ(3, 3), TPS(3, 3), G(3, 3), OR(3, 3), ROTQ(3, 3),
     2 TRMXT(3, 3), T(3), H(3), TC(6), CELL(7), OCELL(7), RCELL(7),
     3 IDET, NVEC
      CHARACTER LATT*1, LINE*80
      VERT = RGBL(1)
      DO L = 1, LUIM
        IF (L .EQ. 1) THEN
          LU = LU6
        ELSE IF (L .EQ. 2) THEN
          CALL PLA262 (0)
          LU = LU7
        ELSE
          LU = 0
        END IF
        WRITE (LINE, 99993, IOSTAT = IOST) IPR(94)
        IF (LU .EQ. 0) THEN
          CALL GGIP09 (0.0, LINE, 18, 0.35, 1, 2, 0.1, VERT - 2.5)
        END IF
        WRITE (LINE, 99999, IOSTAT = IOST) P2, P3, LATT
        IF (LU .NE. 0) THEN
          WRITE (LU, 99996, IOSTAT = IOST)
          WRITE (LU, 99992, IOSTAT = IOST) LINE
          WRITE (LU, 99995, IOSTAT = IOST)
        ELSE
          CALL GGIP09 (0.0, LINE, 76, 0.4, 1, 2, 0.1, VERT - 3.5)
        END IF
        IF (ITEL .GT. 0) THEN
          WRITE (LINE, 99998, IOSTAT = IOST)
          IF (LU .NE. 0) THEN
            WRITE (LU, 99992, IOSTAT = IOST) LINE
          ELSE
            CALL GGIP09 (0.0, LINE, 79, 0.35, 5 + IGBL(68), 2,
     1                   0.1, VERT - 4.5)
          END IF
          WRITE (LINE, 99994, IOSTAT = IOST) (I, I = 1, 9)
          IF (LU .NE. 0) THEN
            WRITE (LU, 99992, IOSTAT = IOST) LINE
            WRITE (LU, 99995, IOSTAT = IOST)
          ELSE
            CALL GGIP09 (0.0, LINE, 80, 0.35, 5 + IGBL(68), 2, 0.1,
     1                   VERT - 5.0)
          END IF
          DO I = 1, ITEL
            WRITE (LINE, 99997, IOSTAT = IOST)
     1        I, AXES(I, 8), NINT(AXES(I, 13)),
     1            (NINT(AXES(I, K)), K = 1, 6), NINT(AXES(I, 9)),
     2            AXES(I, 7), (NINT(AXES(I, 13 + J)), J = 1, ITEL)
            IF (LU .NE. 0) THEN
              WRITE (LU, 99992, IOSTAT = IOST) LINE
            ELSE
              CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 0.1,
     1                     VERT - 5.1 - I * 0.5)
            END IF
          END DO
        END IF
      END DO
      RETURN
99999 FORMAT ('Possible 2-Fold Axes - 2-Axis Crit =', F5.2,
     1 ', Exp. Error =', F5.2, ' Deg., LATT = ', A)
99998 FORMAT (17X, 'Rows', 6X, 'Products', 7X, 'Angle Between Two ',
     1 'Direct Axes ')
99997 FORMAT (I2, F7.3, I2, 2(1X, 3I2), I3, F6.3, 1X, 9(I5))
99996 FORMAT (1X)
99995 FORMAT (80('-'))
99994 FORMAT ('Nr', 3X, 'D', 4X, 'N', 1X, 'Direct', 2X,
     2 'Recip Dot Delta ', 9(I4, 1X))
99993 FORMAT ('Max. Dot Prod =', I3)
99992 FORMAT (A)
      END SUBROUTINE PLA166
      SUBROUTINE PLA167
      PARAMETER (NP12=700,NP13=550,NP17=99,NP18=50,NVD=100000000,
     1 NP23=28000,NP38=150,NP39=30,NCS=52, NZM = 200000,
     2 NRS = NVD-10*NZM)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // XYZDUM(2, NP23), RS(NRS), TNZ(NZM, 10)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DFSPGR/ SUM(NCS, 5), NUM(NCS, 5), XMFS(NCS), XTL(12),
     1 XNM(12), NNZ(13), ANZ(13), IR(3), IN(24), XN(48), FMN(12),
     2 ITL(12), AVNZ(3), NREF, IPERC, TRMX(3, 3), LU, ISPGRC, ISPGRA,
     3 ISPGRH, IPCNTC, IPCNTA, IPCNTH, IFRQC, IFRQA, IFRQH, RAVERC,
     4 RAVERA, RAVERH
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /CFSPGR/ EXT, ILAT0, ILAT1, LAUE
      CHARACTER EXT(NCS)*1, ILAT0*1, ILAT1*1, LAUE*5
      DIMENSION DUMV(3, 3), AA(3, 3), BB(3, 3), V(6)
      COMMON /HKLMX/ HMAX, KMAX, LMAX, IHM, IHKM, IHKP
      INTEGER HMAX
      LH  = 0
      LK  = 0
      LL  = 0
      IH  = 0
      IK  = 0
      IL  = 0
      NLB = 0
      NLE = 0
      DO I = 1, 12
        XTL(I) = 0.0
        XNM(I) = 0.0
        DO J = 1, 3
          RVL(I, J) = 0.0
          NTL(I, J) = 0
        END DO
      END DO
      STLMX = 0.0
      HMAX = 0
      KMAX = 0
      LMAX = 0
      CALL GEN108 (LU8, 0)
      DO I = 1, NREF
        READ (LU8) KH, KK, KL, XI, SI, STL, STL
        IF (GEN050 (TRMX, KH, KK, KL, LH, LK, LL) .GE. 0.0) THEN
          HMAX  = MAX (HMAX, IABS(LH))
          KMAX  = MAX (KMAX, IABS(LK))
          LMAX  = MAX (LMAX, IABS(LL))
          STLMX = MAX (STLMX, STL)
          IF (ILAT0 .EQ. 'h') THEN
            HMAX = MAX (HMAX, KMAX, IABS(LH + LK))
            KMAX = HMAX
          END IF
        END IF
      END DO
      IF (ILAT0 .EQ. 't') THEN
        HMAX = MAX (HMAX, KMAX)
        KMAX = HMAX
      ELSE IF (ILAT0 .EQ. 'c') THEN
        HMAX = MAX (HMAX, KMAX, LMAX)
        KMAX = HMAX
        LMAX = HMAX
      END IF
      IHM   =  2 * HMAX + 1
      IHKM  = (2 * KMAX + 1) * IHM
      IHKLM = (2 * LMAX + 1) * IHKM
      IHKP  = (IHKLM + 1) / 2
      IF (IHKLM .GT. NVD) THEN
        WRITE (LU6, 99989, IOSTAT = IOST) HMAX, KMAX, LMAX, IHKLM, NVD
        CALL GEN127 ('FORCED ...')
      END IF
      CALL GEN026 (1, AA, PAR(101))
      CALL GEN001 (1, TRMX, AA, DUMV)
      CALL GEN003 (DUMV, BB, DET, 0)
      CALL GEN025 (BB, V, 1)
      IF (ILAT0 .EQ. 'a') THEN
        NLB = 1
        NLE = 1
      ELSE IF (ILAT0 .EQ. 'm') THEN
        NLB = 2
        NLE = 2
      ELSE IF (ILAT0 .EQ. 'o') THEN
        NLB = 3
        NLE = 3
      ELSE IF (ILAT0 .EQ. 't') THEN
        NLB = 4
        NLE = 5
      ELSE IF (ILAT0 .EQ. 'h') THEN
        NLB = 6
        NLE = 10
      ELSE IF (ILAT0 .EQ. 'c') THEN
        NLB = 11
        NLE = 12
      END IF
      DO NL = NLB, NLE
        DO I = 1, IHKLM
          RS(I) = - 2.0
          J  = I - 1
          JL = J / IHKM
          JH = J - JL * IHKM
          JL = JL - LMAX
          JK = JH / IHM
          JH = JH - JK * IHM - HMAX
          JK = JK - KMAX
          IF (JH .NE. 0 .AND. JK .NE. 0 .AND. JL .NE. 0) THEN
            IF (GEN049 (ILAT1, JH, JK, JL) .GT. 0.0) THEN
              STLK = GEN095 (V, JH, JK, JL)
              STL  = SQRT(STLK)
              IF (STL .LE. STLMX) RS(I) = - 1.0
            END IF
          END IF
        END DO
        CALL GEN108 (LU8, 0)
        DO NRF = 1, NREF
          READ (LU8) KH, KK, KL, XI, SI, STL, STL
          IF (GEN050 (TRMX, KH, KK, KL, IH, IK, IL) .GT. 0.0) THEN
              IND = IL * IHKM + IK * IHM + IH + IHKP
              IF (XI .GT. 2.5 * SI) THEN
                IF (RS(IND) .GT. - 0.5) THEN
                  RS(IND) = (RS(IND) + XI) / 2.0
                ELSE
                  RS(IND) = XI
                END IF
              ELSE
                RS(IND) = 0.0
              END IF
          END IF
        END DO
        DO I = 1, IHKLM
          IF (RS(I) .GT. -1.5) THEN
            IN(1) = I
            I0    = I - 1
            IR(3) = I0 / IHKM
            IR(1) = I0 - IR(3) * IHKM
            IR(3) = IR(3) - LMAX
            IR(2) = IR(1) / IHM
            IR(1) = IR(1) - IR(2) * IHM - HMAX
            IR(2) = IR(2) - KMAX
            ISET  = IR(3) * IHKM + IHKP
            IR1M  = IR(1) * IHM
            IR2M  = IR(2) * IHM
            IF (ILAT0 .EQ. 'a') THEN
              CALL PLA170 (NL, 1, 1)
            ELSE IF (ILAT0 .EQ. 'm') THEN
              IN(2) = ISET  - IR2M + IR(1)
              CALL PLA170 (NL, 1, 2)
            ELSE IF (ILAT0 .EQ. 'o') THEN
              IN(2) = ISET - IR2M + IR(1)
              IN(3) = ISET + IR2M - IR(1)
              IN(4) = ISET - IR2M - IR(1)
              CALL PLA170 (NL, 1, 4)
            ELSE IF (ILAT0 .EQ. 't') THEN
              IN(2) = ISET + IR1M - IR(2)
              IN(3) = ISET - IR2M - IR(1)
              IN(4) = ISET - IR1M + IR(2)
              IF (NL .EQ. 5) THEN
                IN(5) = ISET + IR2M - IR(1)
                IN(6) = ISET + IR1M + IR(2)
                IN(7) = ISET - IR2M + IR(1)
                IN(8) = ISET - IR1M - IR(2)
                CALL PLA170 (NL, 1, 8)
              ELSE
                CALL PLA170 (NL, 1, 4)
              END IF
            ELSE IF (ILAT0 .EQ. 'h') THEN
              IHPK = IR(1) + IR(2)
              IRPM = IHPK * IHM
              IF (NL .LT. 9) THEN
                IN(2)  = ISET - IRPM + IR(2)
                IN(3)  = ISET + IR1M - IHPK
                IF (NL .EQ. 7) THEN
                  IN(4)  = ISET - IR1M - IR(2)
                  IN(5)  = ISET - IR2M + IHPK
                  IN(6)  = ISET + IRPM - IR(1)
                  CALL PLA170 (7, 1, 6)
                ELSE IF (NL .EQ. 8) THEN
                  IN(4)  = ISET + IR1M + IR(2)
                  IN(5)  = ISET + IR2M - IHPK
                  IN(6)  = ISET - IRPM + IR(1)
                  CALL PLA170 (8, 1, 6)
                ELSE
                  CALL PLA170 (6, 1, 3)
                END IF
              ELSE
                IN(2) = ISET + IRPM - IR(2)
                IN(3) = ISET + IR1M - IHPK
                IN(4) = ISET - IR2M - IR(1)
                IN(5) = ISET - IRPM + IR(2)
                IN(6) = ISET - IR1M + IHPK
                IF (NL .EQ. 10) THEN
                  IN(7)  = ISET + IR1M + IR(2)
                  IN(8)  = ISET - IR2M + IHPK
                  IN(9)  = ISET - IRPM + IR(1)
                  IN(10) = ISET - IR1M - IR(2)
                  IN(11) = ISET + IR2M - IHPK
                  IN(12) = ISET + IRPM - IR(1)
                  CALL PLA170 (NL, 1, 12)
                ELSE
                  CALL PLA170 (NL, 1, 6)
                END IF
              END IF
            ELSE IF (ILAT0 .EQ. 'c') THEN
              IST1 = IR(1) * IHKM + IHKP
              IST2 = IR(2) * IHKM + IHKP
              IR3M = IR(3) * IHM
              IN(2)  = ISET - IR2M + IR(1)
              IN(3)  = ISET + IR2M - IR(1)
              IN(4)  = ISET - IR2M - IR(1)
              IN(5)  = IST1 + IR3M + IR(2)
              IN(6)  = IST2 + IR1M + IR(3)
              IN(7)  = IST1 - IR3M - IR(2)
              IN(8)  = IST2 - IR1M - IR(3)
              IN(9)  = IST2 + IR1M - IR(3)
              IN(10) = IST1 - IR3M + IR(2)
              IN(11) = IST1 + IR3M - IR(2)
              IN(12) = IST2 - IR1M + IR(3)
              IF (NL .EQ. 12) THEN
                IN(13) = ISET + IR1M + IR(2)
                IN(14) = ISET + IR1M - IR(2)
                IN(15) = ISET - IR1M + IR(2)
                IN(16) = ISET - IR1M - IR(2)
                IN(17) = IST1 + IR2M + IR(3)
                IN(18) = IST2 + IR3M + IR(1)
                IN(19) = IST1 - IR2M - IR(3)
                IN(20) = IST2 - IR3M - IR(1)
                IN(21) = IST2 - IR3M + IR(1)
                IN(22) = IST1 + IR2M - IR(3)
                IN(23) = IST1 - IR2M + IR(3)
                IN(24) = IST2 + IR3M - IR(1)
                CALL PLA170 (NL, 1, 24)
              ELSE
                CALL PLA170 (NL, 1, 12)
              END IF
            END IF
          END IF
        END DO
      END DO
      DO J = 1, 12
        IF (XNM(J) .GT. 0.0) THEN
          RVL(J, 1) = XTL(J) * 100.0 / XNM(J)
        END IF
        IF (NTL(J, 1) .GT. 0) THEN
          RVL(J, 2) = 100.0 * NTL(J, 2) / NTL(J, 1)
        END IF
        IF (NTL(J, 2) .GT. 0) THEN
          RVL(J, 3) = 100.0 * NTL(J, 3) / NTL(J, 2)
        END IF
      END DO
      RETURN
99989 FORMAT (':: Increase NVD: hm, km, lm =', 3I5, /,
     1        ':: NVD(needed/current)', 2I10)
      END SUBROUTINE PLA167
      SUBROUTINE PLA168
      PARAMETER (NP18=50,NCS=52)
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /DATASPGR/ EXTYPE, NLAUE
      CHARACTER EXTYPE(NCS)*16, NLAUE(13)*5
      COMMON /LFSPGR/ EX
      COMMON /CFSPGR/ EXT, ILAT0, ILAT1, LAUE
      CHARACTER EXT(NCS)*1, ILAT0*1, ILAT1*1, LAUE*5
      LOGICAL EX(NCS)
      IF (LAUE .EQ. NLAUE(13)) THEN
        IVAL  = 13
        IF (ILAT1 .EQ. 'R') THEN
          NB = 6
          NE = 7
        ELSE
          NB = 1
          NE = 12
        END IF
        DO I = NB, NE
          IF (RVL(I, 1) .GT. 0.0) THEN
            IF (IVAL .EQ. 13) THEN
              IVAL  = I
            ELSE IF (RVL(I, 1) .LT. RMAX) THEN
              IVAL = I
            END IF
          END IF
        END DO
        LAUE = NLAUE(IVAL)
      END IF
C*********************************************************************
C * TRICLINIC : LAUE CLASS -1                                        *
C*********************************************************************
      IF (ILAT0 .EQ. 'a') THEN
        IF (ILAT1 .EQ. 'P') THEN
          CALL PLA163 ('P1     ')
          CALL PLA163 ('P-1    ')
        ELSE IF (ILAT1 .EQ. 'A') THEN
          CALL PLA163 ('A1     ')
          CALL PLA163 ('A-1    ')
        ELSE IF (ILAT1 .EQ. 'B') THEN
          CALL PLA163 ('B1     ')
          CALL PLA163 ('B-1    ')
        ELSE IF (ILAT1 .EQ. 'C') THEN
          CALL PLA163 ('C1     ')
          CALL PLA163 ('C-1    ')
        ELSE IF (ILAT1 .EQ. 'I') THEN
          CALL PLA163 ('I1     ')
          CALL PLA163 ('I-1    ')
        ELSE IF (ILAT1 .EQ. 'F') THEN
          CALL PLA163 ('F1     ')
          CALL PLA163 ('F-1    ')
        ELSE IF (ILAT1 .EQ. 'R') THEN
          CALL PLA163 ('R1     ')
          CALL PLA163 ('R-1    ')
        END IF
C*********************************************************************
C * MONOCLINIC : B-UNIQUE  LAUE CLASS 1 2/M 1                        *
C*********************************************************************
      ELSE IF (ILAT0 .EQ. 'm') THEN
        IF (ILAT1 .EQ. 'I') THEN
          IF (EX(10) .AND. EX(11)) THEN
            CALL PLA163 ('Ia     ')
            CALL PLA163 ('I2/a   ')
          ELSE
            CALL PLA163 ('I2     ')
            CALL PLA163 ('Im     ')
            CALL PLA163 ('I2/m   ')
          END IF
        ELSE IF (ILAT1 .EQ. 'A') THEN
          IF (EX(10)) THEN
            CALL PLA163 ('Aa     ')
            CALL PLA163 ('A2/a   ')
          ELSE
            CALL PLA163 ('A2     ')
            CALL PLA163 ('Am     ')
            CALL PLA163 ('A2/m   ')
          END IF
        ELSE IF (ILAT1 .EQ. 'C') THEN
          IF (EX(11)) THEN
            CALL PLA163 ('Cc     ')
            CALL PLA163 ('C2/c   ')
          ELSE
            CALL PLA163 ('C2     ')
            CALL PLA163 ('Cm     ')
            CALL PLA163 ('C2/m   ')
          END IF
        ELSE
          IF (EX(12)) THEN
            IF (EX(17)) THEN
              CALL PLA163 ('P21/n  ')
              IF (EXT(12) .EQ. '?') CALL PLA163 ('P21    ')
              IF (EXT(17) .EQ. '?') CALL PLA163 ('Pn     ')
            ELSE
              CALL PLA163 ('Pn     ')
              CALL PLA163 ('P2/n   ')
            END IF
            IF (EX(10)) THEN
              IF (EX(17)) THEN
                CALL PLA163 ('P21/a  ')
                CALL PLA163 ('Pa     ')
              ELSE
                CALL PLA163 ('Pa     ')
                CALL PLA163 ('P2/a   ')
              END IF
            END IF
            IF (EX(11)) THEN
              IF (EX(17)) THEN
                CALL PLA163 ('P21/c  ')
                CALL PLA163 ('Pc     ')
              ELSE
                CALL PLA163 ('Pc     ')
                CALL PLA163 ('P2/c   ')
              END IF
            END IF
          ELSE IF (EX(10)) THEN
            IF (EX(17)) THEN
              CALL PLA163 ('P21/a  ')
              IF (EXT(10) .EQ. '?') CALL PLA163 ('P21    ')
              IF (EXT(17) .EQ. '?') CALL PLA163 ('Pa     ')
            ELSE
              CALL PLA163 ('Pa     ')
              CALL PLA163 ('P2/a   ')
            END IF
          ELSE IF (EX(11)) THEN
            IF (EX(17)) THEN
              CALL PLA163 ('P21/c  ')
              IF (EXT(11) .EQ. '?') CALL PLA163 ('P21    ')
              IF (EXT(17) .EQ. '?') CALL PLA163 ('Pc     ')
            ELSE
              CALL PLA163 ('Pc     ')
              CALL PLA163 ('P2/c   ')
            END IF
          ELSE
            IF (EX(17)) THEN
              CALL PLA163 ('P21    ')
              CALL PLA163 ('P21/m  ')
            ELSE
              CALL PLA163 ('P2     ')
              CALL PLA163 ('Pm     ')
              CALL PLA163 ('P2/m   ')
            END IF
          END IF
        END IF
C*******************************************************************
C * ORTHORHOMBIC LAUE CLASS 3 = 2/m 2/m 2/m                        *
C*******************************************************************
      ELSE IF (ILAT0 .EQ. 'o') THEN
        IF (ILAT1 .EQ. 'F') THEN
          IF (EX(19) .AND. EX(20) .AND. EX(21)) THEN
            CALL PLA163 ('Fddd   ')
            IF (EXT(21) .EQ. '?') CALL PLA163 ('Fdd2   ')
            IF (EXT(20) .EQ. '?') CALL PLA163 ('Fd2d   ')
            IF (EXT(19) .EQ. '?') CALL PLA163 ('F2dd   ')
          ELSE IF (EX(19) .AND. EX(20)) THEN
            CALL PLA163 ('Fdd2   ')
          ELSE IF (EX(19) .AND. EX(21)) THEN
            CALL PLA163 ('Fd2d   ')
          ELSE IF (EX(20) .AND. EX(21)) THEN
            CALL PLA163 ('F2dd   ')
          ELSE
            CALL PLA163 ('Fmm2   ')
            CALL PLA163 ('Fm2m   ')
            CALL PLA163 ('F2mm   ')
            CALL PLA163 ('F222   ')
            CALL PLA163 ('Fmmm   ')
          END IF
        ELSE IF (ILAT1 .EQ. 'I') THEN
          IF (EX(7) .AND. EX(8)) THEN
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Ibca   ')
              ELSE
                CALL PLA163 ('Iba2   ')
                CALL PLA163 ('Ibam   ')
              END IF
            ELSE IF (EX(12)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Ic2a   ')
                CALL PLA163 ('Icma   ')
              ELSE
                CALL PLA163 ('Ibm2   ')
                CALL PLA163 ('Ic2m   ')
                CALL PLA163 ('Ibmm   ')
                CALL PLA163 ('Icmm   ')
              END IF
            END IF
          ELSE IF (EX(9)) THEN
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('I2cb   ')
                CALL PLA163 ('Imcb   ')
              ELSE IF (EX(15)) THEN
                CALL PLA163 ('Ima2   ')
                CALL PLA163 ('I2cm   ')
                CALL PLA163 ('Imam   ')
                CALL PLA163 ('Imcm   ')
              END IF
            ELSE IF (EX(12)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Im2a   ')
                CALL PLA163 ('I2mb   ')
                CALL PLA163 ('Imma   ')
                CALL PLA163 ('Immb   ')
              ELSE IF (EX(15)) THEN
                CALL PLA163 ('I222   ')
                CALL PLA163 ('Imm2   ')
                CALL PLA163 ('Im2m   ')
                CALL PLA163 ('I2mm   ')
                CALL PLA163 ('I212121')
                CALL PLA163 ('Immm   ')
              END IF
            END IF
          END IF
        ELSE IF (ILAT1 .EQ. 'A') THEN
          IF (EX(7) .AND. EX(8)) THEN
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Abaa   ')
                CALL PLA163 ('Acaa   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Aba2   ')
                CALL PLA163 ('Acam   ')
              END IF
            ELSE IF (EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Ac2a   ')
                CALL PLA163 ('Abma   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Abm2   ')
                CALL PLA163 ('Ac2m   ')
                CALL PLA163 ('Abmm   ')
                CALL PLA163 ('Acmm   ')
              END IF
            END IF
          ELSE IF (EX(9)) THEN
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('A2aa   ')
                CALL PLA163 ('Amaa   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('A21am  ')
                CALL PLA163 ('Ama2   ')
                CALL PLA163 ('Amam   ')
              END IF
            ELSE IF (EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('A21ma  ')
                CALL PLA163 ('Am2a   ')
                CALL PLA163 ('Amma   ')
              ELSE IF (EX(14) .AND. EX(16)) THEN
                CALL PLA163 ('A2122  ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('A222   ')
                CALL PLA163 ('Amm2   ')
                CALL PLA163 ('Am2m   ')
                CALL PLA163 ('A2mm   ')
                CALL PLA163 ('Ammm   ')
              END IF
            END IF
          END IF
        ELSE IF (ILAT1 .EQ. 'B') THEN
          IF (EX(7) .AND. EX(8)) THEN
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Bbab   ')
                CALL PLA163 ('Bbcb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Bba2   ')
                CALL PLA163 ('Bbcm   ')
              END IF
            ELSE IF (EX(12)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Bb2b   ')
                CALL PLA163 ('Bbmb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Bb21m  ')
                CALL PLA163 ('Bbm2   ')
                CALL PLA163 ('Bbmm   ')
              END IF
            END IF
          ELSE IF (EX(8)) THEN
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('B2cb   ')
                CALL PLA163 ('Bmab   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Bma2   ')
                CALL PLA163 ('B2cm   ')
                CALL PLA163 ('Bmam   ')
                CALL PLA163 ('Bmcm   ')
              END IF
            ELSE IF (EX(12)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Bm21b  ')
                CALL PLA163 ('Bmmb   ')
                CALL PLA163 ('B2mb   ')
              ELSE
                IF (EX(17)) THEN
                  CALL PLA163 ('B2212  ')
                ELSE
                  CALL PLA163 ('B222   ')
                  CALL PLA163 ('Bmm2   ')
                  CALL PLA163 ('B2mm   ')
                  CALL PLA163 ('Bm2m   ')
                  CALL PLA163 ('Bmmm   ')
                END IF
              END IF
            END IF
          END IF
        ELSE IF (ILAT1 .EQ. 'C') THEN
          IF (EX(7) .AND. EX(8)) THEN
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Ccca   ')
                CALL PLA163 ('Cccb   ')
              ELSE
                CALL PLA163 ('Ccc2   ')
                CALL PLA163 ('Cccm   ')
              END IF
            ELSE
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Cc2a   ')
                CALL PLA163 ('Ccmb   ')
              ELSE
                CALL PLA163 ('Ccm21  ')
                CALL PLA163 ('Cc2m   ')
                CALL PLA163 ('Ccmm   ')
              END IF
            END IF
          ELSE
            IF (EX(10) .AND. EX(11)) THEN
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('C2cb   ')
                CALL PLA163 ('Cmca   ')
              ELSE
                CALL PLA163 ('Cmc21  ')
                CALL PLA163 ('C2cm   ')
                CALL PLA163 ('Cmcm   ')
              END IF
            ELSE
              IF (EX(13) .AND. EX(14)) THEN
                CALL PLA163 ('Cm2a   ')
                CALL PLA163 ('C2mb   ')
                CALL PLA163 ('Cmma   ')
                CALL PLA163 ('Cmmb   ')
              ELSE
                IF (EX(18)) THEN
                  CALL PLA163 ('C2221  ')
                ELSE
                  CALL PLA163 ('C222   ')
                  CALL PLA163 ('Cm2m   ')
                  CALL PLA163 ('C2mm   ')
                  CALL PLA163 ('Cmm2   ')
                  CALL PLA163 ('Cmmm   ')
                END IF
              END IF
            END IF
          END IF
        ELSE IF (ILAT1 .EQ. 'P') THEN
          IF (EX(9)) THEN
            IF (EX(12)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pnnn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pnnb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pnna   ')
              ELSE
                CALL PLA163 ('Pnn2   ')
                CALL PLA163 ('Pnnm   ')
              END IF
            END IF
            IF (EX(11)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pncn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pncb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pnca   ')
              ELSE
                CALL PLA163 ('Pnc2   ')
                CALL PLA163 ('Pncm   ')
              END IF
            END IF
            IF (EX(10)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pnan   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pnab   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pnaa   ')
              ELSE
                CALL PLA163 ('Pna21  ')
                CALL PLA163 ('Pnam   ')
              END IF
            END IF
            IF (.NOT. EX(10) .AND. .NOT. EX(11) .AND. .NOT. EX(12)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pn2n   ')
                CALL PLA163 ('Pnmn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pn2b   ')
                CALL PLA163 ('Pnmb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pn21a  ')
                CALL PLA163 ('Pnma   ')
              ELSE
                CALL PLA163 ('Pnm21  ')
                CALL PLA163 ('Pn21m  ')
                CALL PLA163 ('Pnmm   ')
              END IF
            END IF
          ELSE IF (EX(8)) THEN
            IF (EX(12)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pcnn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pcnb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pcna   ')
              ELSE
                CALL PLA163 ('Pcn2   ')
                CALL PLA163 ('Pcnm   ')
              END IF
            END IF
            IF (EX(11)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pccn   ')
                IF (EXT(11) .EQ. '?') CALL PLA163 ('Pc21n  ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pccb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pcca   ')
              ELSE
                CALL PLA163 ('Pcc2   ')
                CALL PLA163 ('Pccm   ')
              END IF
            END IF
            IF (EX(10)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pcan   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pcab   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pcaa   ')
              ELSE
                CALL PLA163 ('Pca21  ')
                CALL PLA163 ('Pcam   ')
              END IF
            END IF
            IF (.NOT. EX(10) .AND. .NOT. EX(11) .AND. .NOT. EX(12)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pc21n  ')
                CALL PLA163 ('Pcmn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pc21b  ')
                CALL PLA163 ('Pcmb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pc2a   ')
                CALL PLA163 ('Pcma   ')
              ELSE
                CALL PLA163 ('Pcm21  ')
                CALL PLA163 ('Pc2m   ')
                CALL PLA163 ('Pcmm   ')
              END IF
            END IF
          ELSE IF (EX(7)) THEN
            IF (EX(12)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pbnn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pbnb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pbna   ')
              ELSE
                CALL PLA163 ('Pbn21  ')
                CALL PLA163 ('Pbnm   ')
              END IF
            END IF
            IF (EX(11)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pbcn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pbcb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pbca   ')
              ELSE
                CALL PLA163 ('Pbc21  ')
                CALL PLA163 ('Pbcm   ')
              END IF
            END IF
            IF (EX(10)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pban   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pbab   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pbaa   ')
              ELSE
                CALL PLA163 ('Pba2   ')
                CALL PLA163 ('Pbam   ')
              END IF
            END IF
            IF (.NOT. EX(10) .AND. .NOT. EX(11) .AND. .NOT. EX(12)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('Pb2n   ')
                CALL PLA163 ('Pbmn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('Pb2b   ')
                CALL PLA163 ('Pbmb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('Pb21a  ')
                CALL PLA163 ('Pbma   ')
              ELSE
                CALL PLA163 ('Pb21m  ')
                CALL PLA163 ('Pbm2   ')
                CALL PLA163 ('Pbmm   ')
              END IF
            END IF
          ELSE
            IF (EX(12)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('P2nn   ')
                CALL PLA163 ('Pmnn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('P21nb  ')
                CALL PLA163 ('Pmnb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('P2na   ')
                CALL PLA163 ('Pmna   ')
              ELSE
                CALL PLA163 ('Pmn21  ')
                CALL PLA163 ('P21nm  ')
                CALL PLA163 ('Pmnm   ')
              END IF
            ELSE IF (EX(11)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('P21cn  ')
                CALL PLA163 ('Pmcn   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('P2cb   ')
                CALL PLA163 ('Pmcb   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('P21ca  ')
                CALL PLA163 ('Pmca   ')
              ELSE
                CALL PLA163 ('Pmc21  ')
                CALL PLA163 ('P2cm   ')
                CALL PLA163 ('Pmcm   ')
              END IF
            ELSE IF (EX(10)) THEN
              IF (EX(15)) THEN
                CALL PLA163 ('P2an   ')
                CALL PLA163 ('Pman   ')
              ELSE IF (EX(14)) THEN
                CALL PLA163 ('P21ab  ')
                CALL PLA163 ('Pmab   ')
              ELSE IF (EX(13)) THEN
                CALL PLA163 ('P2aa   ')
                CALL PLA163 ('Pmaa   ')
              ELSE
                CALL PLA163 ('P21am  ')
                CALL PLA163 ('Pma2   ')
                CALL PLA163 ('Pmam   ')
              END IF
            ELSE
              IF (EX(15)) THEN
                IF (.NOT. EX(18)) THEN
                  CALL PLA163 ('Pm21n  ')
                  CALL PLA163 ('P21mn  ')
                  CALL PLA163 ('Pmmn   ')
                END IF
              ELSE IF (EX(14)) THEN
                IF (.NOT. EX(18)) THEN
                  CALL PLA163 ('Pm21b  ')
                  CALL PLA163 ('P2mb   ')
                  CALL PLA163 ('Pmmb   ')
                END IF
              ELSE IF (EX(13)) THEN
                IF (.NOT. EX(18)) THEN
                  CALL PLA163 ('P21ma  ')
                  CALL PLA163 ('Pm2a   ')
                  CALL PLA163 ('Pmma   ')
                END IF
              ELSE
                IF (EX(16)) THEN
                  IF (EX(17)) THEN
                    IF (EX(18)) THEN
                      CALL PLA163 ('P212121')
                      IF (EXT(16) .EQ. '?') CALL PLA163 ('P22121 ')
                      IF (EXT(17) .EQ. '?') CALL PLA163 ('P21221 ')
                      IF (EXT(18) .EQ. '?') CALL PLA163 ('P21212 ')
                      IF (EXT(16) .EQ. '?' .AND. EXT(17) .EQ. '?')
     1                    CALL PLA163 ('P2221  ')
                      IF (EXT(16) .EQ. '?' .AND. EXT(18) .EQ. '?')
     1                    CALL PLA163 ('P2212  ')
                      IF (EXT(17) .EQ. '?' .AND. EXT(18) .EQ. '?')
     1                    CALL PLA163 ('P2122  ')
                    ELSE
                      CALL PLA163 ('P21212 ')
                    END IF
                  ELSE
                    IF (EX(18)) THEN
                      CALL PLA163 ('P21221 ')
                    ELSE
                      CALL PLA163 ('P2122  ')
                    END IF
                  END IF
                ELSE
                  IF (EX(17)) THEN
                    IF (EX(18)) THEN
                      CALL PLA163 ('P22121 ')
                    ELSE
                      CALL PLA163 ('P2212  ')
                    END IF
                  ELSE
                    IF (EX(18)) THEN
                      CALL PLA163 ('P2221  ')
                    ELSE
                      CALL PLA163 ('P222   ')
                      CALL PLA163 ('Pmm2   ')
                      CALL PLA163 ('Pm2m   ')
                      CALL PLA163 ('P2mm   ')
                      CALL PLA163 ('Pmmm   ')
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
C**********************************************************************
C * TETRAGONAL : LAUE CLASSES 4 = 4/M AND 5 = 4/M 2/M 2/M             *
C**********************************************************************
      ELSE IF (ILAT0 .EQ. 't') THEN
        IF (ILAT1 .EQ. 'I') THEN
          IF (LAUE .EQ. '  4/m') THEN
            IF (EX(13) .AND. EX(14)) THEN
              CALL PLA163 ('I41/a  ')
            ELSE
              IF (EX(24)) THEN
                CALL PLA163 ('I41    ')
              ELSE
                CALL PLA163 ('I-4    ')
                CALL PLA163 ('I4     ')
                CALL PLA163 ('I4/m   ')
              END IF
            END IF
          ELSE IF (LAUE .EQ. '4/mmm') THEN
            IF (EX(13) .AND. EX(14)) THEN
              IF (EX(7) .AND. EX(8)) THEN
                CALL PLA163 ('I41/acd')
              ELSE
                IF (EX(28)) THEN
                  CALL PLA163 ('I41/amd')
                END IF
              END IF
            ELSE
              IF (EX(7) .AND. EX(8)) THEN
                IF (EX(28)) THEN
                  CALL PLA163 ('I41cd  ')
                ELSE
                  CALL PLA163 ('I4cm   ')
                  CALL PLA163 ('I-4c2  ')
                  CALL PLA163 ('I4/mcm ')
                END IF
              ELSE
                IF (EX(28)) THEN
                  CALL PLA163 ('I41md  ')
                  CALL PLA163 ('I-42d  ')
                ELSE
                  IF (EX(24)) THEN
                    CALL PLA163 ('I4122  ')
                  ELSE
                    CALL PLA163 ('I-42m  ')
                    CALL PLA163 ('I-4m2  ')
                    CALL PLA163 ('I4mm   ')
                    CALL PLA163 ('I422   ')
                    CALL PLA163 ('I4/mmm ')
                  END IF
                END IF
              END IF
            END IF
          END IF
        ELSE IF (ILAT1 .EQ. 'P') THEN
          IF (LAUE .EQ. '  4/m') THEN
            IF (EX(15)) THEN
              IF (EX(18)) THEN
                CALL PLA163 ('P42/n  ')
              ELSE
                CALL PLA163 ('P4/n   ')
              END IF
            ELSE
              IF (EX(24)) THEN
                CALL PLA163 ('P41    ')
                CALL PLA163 ('P43    ')
              ELSE IF (EX(18)) THEN
                CALL PLA163 ('P42    ')
                CALL PLA163 ('P42/m  ')
              ELSE
                CALL PLA163 ('P-4    ')
                CALL PLA163 ('P4     ')
                CALL PLA163 ('P4/m   ')
              END IF
            END IF
          ELSE IF (LAUE .EQ. '4/mmm') THEN
            IF (EX(15)) THEN
              IF (EX(9)) THEN
                IF (EX(25) .OR. EX(33)) THEN
                  CALL PLA163 ('P4/nnc ')
                ELSE
                  CALL PLA163 ('P42/nnm')
                END IF
              ELSE IF (EX(8)) THEN
                IF (EX(25) .OR. EX(33)) THEN
                  CALL PLA163 ('P4/ncc ')
                ELSE
                  CALL PLA163 ('P42/ncm')
                END IF
              ELSE IF (EX(7)) THEN
                IF (EX(25) .OR. EX(33)) THEN
                  CALL PLA163 ('P42/nbc')
                ELSE
                  CALL PLA163 ('P4/nbm ')
                END IF
              ELSE
                IF (EX(25) .OR. EX(33)) THEN
                  CALL PLA163 ('P42/nmc')
                ELSE
                  CALL PLA163 ('P4/nmm ')
                END IF
              END IF
            ELSE
              IF (EX(9)) THEN
                IF (EX(25) .OR. EX(33)) THEN
                  CALL PLA163 ('P4nc   ')
                  CALL PLA163 ('P4/mnc ')
                ELSE
                  CALL PLA163 ('P-4n2  ')
                  CALL PLA163 ('P42nm  ')
                  CALL PLA163 ('P42/mnm')
                END IF
              ELSE IF (EX(8)) THEN
                IF (EX(25) .OR. EX(33)) THEN
                  CALL PLA163 ('P4cc   ')
                  CALL PLA163 ('P4/mcc ')
                ELSE
                  CALL PLA163 ('P-4c2  ')
                  CALL PLA163 ('P42cm  ')
                  CALL PLA163 ('P42/mcm')
                END IF
              ELSE IF (EX(7)) THEN
                IF (EX(25) .OR. EX(33)) THEN
                  CALL PLA163 ('P42bc  ')
                  CALL PLA163 ('P42/mbc')
                ELSE
                  CALL PLA163 ('P-4b2  ')
                  CALL PLA163 ('P4bm   ')
                  CALL PLA163 ('P4/mbm ')
                END IF
              ELSE
                IF (EX(25) .OR. EX(33)) THEN
                  IF (EX(17)) THEN
                    CALL PLA163 ('P-421c ')
                  ELSE
                    CALL PLA163 ('P42mc  ')
                    CALL PLA163 ('P-42c  ')
                    CALL PLA163 ('P42/mmc')
                  END IF
                ELSE
                  IF (EX(24)) THEN
                    IF (EX(17)) THEN
                      CALL PLA163 ('P41212 ')
                      CALL PLA163 ('P43212 ')
                    ELSE
                      CALL PLA163 ('P4122  ')
                      CALL PLA163 ('P4322  ')
                    END IF
                  ELSE IF (EX(18)) THEN
                    IF (EX(17)) THEN
                      CALL PLA163 ('P42212 ')
                    ELSE
                      CALL PLA163 ('P4222  ')
                    END IF
                  ELSE
                    IF (EX(17)) THEN
                      CALL PLA163 ('P4212  ')
                      CALL PLA163 ('P-421m ')
                    ELSE
                      CALL PLA163 ('P-42m  ')
                      CALL PLA163 ('P422   ')
                      CALL PLA163 ('P-4m2  ')
                      CALL PLA163 ('P4mm   ')
                      CALL PLA163 ('P4/mmm ')
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
C***********************************************************************
C * TRI/HEXAGONAL LAUE CLASSES 6=-3, 7=-3m1, 8=-31m, 9=6/m, 10=6/mmm   *
C***********************************************************************
      ELSE IF (ILAT0 .EQ. 'h') THEN
        IF (LAUE .EQ. '  6/m') THEN
          IF (EX(31)) THEN
            CALL PLA163 ('P61    ')
            CALL PLA163 ('P65    ')
          ELSE IF (EX(39)) THEN
            CALL PLA163 ('P62    ')
            CALL PLA163 ('P64    ')
          ELSE IF (EX(18)) THEN
            CALL PLA163 ('P63    ')
            CALL PLA163 ('P63/m  ')
          ELSE
            CALL PLA163 ('P-6    ')
            CALL PLA163 ('P6     ')
            CALL PLA163 ('P6/m   ')
          END IF
        ELSE IF (LAUE .EQ. '6/mmm') THEN
          IF (EX(33) .OR. EX(11) .OR. EX(8)) THEN
            IF (EX(25) .OR. EX(35) .OR. EX(36)) THEN
              CALL PLA163 ('P6cc   ')
              CALL PLA163 ('P6/mcc ')
            ELSE
              CALL PLA163 ('P63cm  ')
              CALL PLA163 ('P-6c2  ')
              CALL PLA163 ('P63/mcm')
            END IF
          ELSE
            IF (EX(25) .OR. EX(35) .OR. EX(36)) THEN
              CALL PLA163 ('P63mc  ')
              CALL PLA163 ('P-62c  ')
              CALL PLA163 ('P63/mmc')
            ELSE
              IF (EX(31)) THEN
                CALL PLA163 ('P6122  ')
                CALL PLA163 ('P6522  ')
              ELSE IF (EX(39)) THEN
                CALL PLA163 ('P6222  ')
                CALL PLA163 ('P6422  ')
              ELSE IF (EX(18)) THEN
                CALL PLA163 ('P6322  ')
              ELSE
                CALL PLA163 ('P-62m  ')
                CALL PLA163 ('P6mm   ')
                CALL PLA163 ('P622   ')
                CALL PLA163 ('P-6m2  ')
                CALL PLA163 ('P6/mmm ')
              END IF
            END IF
          END IF
        ELSE
          IF (ILAT1 .EQ. 'R') THEN
            IF (LAUE .EQ. '   -3') THEN
              CALL PLA163 ('R3     ')
              CALL PLA163 ('R-3    ')
            ELSE IF (LAUE .EQ. ' -3m1') THEN
              IF (EX(33) .OR. EX(11) .OR. EX(8)) THEN
                CALL PLA163 ('R3c    ')
                CALL PLA163 ('R-3c   ')
              ELSE
                CALL PLA163 ('R3m    ')
                CALL PLA163 ('R32    ')
                CALL PLA163 ('R-3m   ')
              END IF
            END IF
          ELSE IF (ILAT1 .EQ. 'P') THEN
            IF (LAUE .EQ. '   -3') THEN
              IF (EX(39)) THEN
                CALL PLA163 ('P31    ')
                CALL PLA163 ('P32    ')
                IF (EXT(5) .EQ. '>') THEN
                  CALL PLA163 ('P-3    ')
                  CALL PLA163 ('R-3    ')
                END IF
              ELSE
                CALL PLA163 ('P3     ')
                CALL PLA163 ('P-3    ')
              END IF
            ELSE IF (LAUE .EQ. ' -3m1') THEN
              IF (EX(33) .OR. EX(8) .OR. EX(11)) THEN
                CALL PLA163 ('P3c1   ')
                CALL PLA163 ('P-3c1  ')
              ELSE
                IF (EX(39)) THEN
                  CALL PLA163 ('P3121  ')
                  CALL PLA163 ('P3221  ')
                  IF (EXT(47) .NE. '  ') THEN
                    CALL PLA163 ('R-3    ')
                  END IF
                ELSE
                  CALL PLA163 ('P321   ')
                  CALL PLA163 ('P3m1   ')
                  CALL PLA163 ('P-3m1  ')
                END IF
              END IF
            ELSE IF (LAUE .EQ. ' -31m') THEN
              IF (EX(25) .OR. EX(35) .OR. EX(36)) THEN
                CALL PLA163 ('P31c   ')
                CALL PLA163 ('P-31c  ')
              ELSE
                IF (EX(39)) THEN
                  CALL PLA163 ('P3112  ')
                  CALL PLA163 ('P3212  ')
                  IF (EXT(47) .NE. '  ') THEN
                    CALL PLA163 ('R-3    ')
                  END IF
                ELSE
                  CALL PLA163 ('P312   ')
                  CALL PLA163 ('P31m   ')
                  CALL PLA163 ('P-31m  ')
                END IF
              END IF
            END IF
          END IF
        END IF
C***********************************************************************
C * CUBIC   LAUE CLASS 11 : m-3 , 12 : m-3m                            *
C***********************************************************************
      ELSE IF (ILAT0 .EQ. 'c') THEN
        IF (ILAT1 .EQ. 'F') THEN
          IF (EX(19)) THEN
            IF ((EX(25) .OR. EX(33)) .AND. (EX(26) .OR. EX(43))) THEN
              CALL PLA163 ('Fd-3c  ')
            ELSE
              IF (LAUE .EQ. ' m-3m') THEN
                CALL PLA163 ('Fd-3m  ')
              ELSE
                CALL PLA163 ('Fd-3   ')
              END IF
            END IF
          ELSE
            IF ((EX(25) .OR. EX(33)) .AND. (EX(26) .OR. EX(43))) THEN
              CALL PLA163 ('F-43c  ')
              CALL PLA163 ('Fm-3c  ')
            ELSE
              IF (EX(24)) THEN
                CALL PLA163 ('F4132  ')
              ELSE
                IF (LAUE .EQ. ' m-3m') THEN
                  CALL PLA163 ('F-43m  ')
                  CALL PLA163 ('F432   ')
                  CALL PLA163 ('Fm-3m  ')
                ELSE
                  CALL PLA163 ('F23    ')
                  CALL PLA163 ('Fm-3   ')
                END IF
              END IF
            END IF
          END IF
        ELSE IF (ILAT1 .EQ. 'I') THEN
          IF (EX(7) .AND. EX(8)) THEN
            IF (EX(25) .AND. EX(28)) THEN
              CALL PLA163 ('Ia-3d  ')
            ELSE
              CALL PLA163 ('Ia-3   ')
            END IF
          ELSE
            IF (EX(25) .AND. EX(28)) THEN
              CALL PLA163 ('I-43d  ')
            ELSE
              IF (EX(24)) THEN
                CALL PLA163 ('I4132  ')
              ELSE
                IF (LAUE .EQ. ' m-3m') THEN
                  CALL PLA163 ('I-43m  ')
                  CALL PLA163 ('I432   ')
                  CALL PLA163 ('Im-3m  ')
                ELSE
                  CALL PLA163 ('I23    ')
                  CALL PLA163 ('I213   ')
                  CALL PLA163 ('Im-3   ')
                END IF
              END IF
            END IF
          END IF
        ELSE IF (ILAT1 .EQ. 'P') THEN
          IF (EX(9)) THEN
            IF (LAUE .EQ. ' m-3m') THEN
              IF (EX(25) .OR. EX(33)) THEN
                CALL PLA163 ('Pn-3n  ')
              ELSE
                CALL PLA163 ('Pn-3m  ')
              END IF
            ELSE
              CALL PLA163 ('Pn-3   ')
            END IF
          ELSE IF (EX(7) .OR. EX(11) .OR. EX(13)) THEN
            CALL PLA163 ('Pa-3   ')
          ELSE IF (EX(8) .OR. EX(10) .OR. EX(14)) THEN
            CALL PLA163 ('Pb-3   ')
          ELSE
            IF (EX(25) .OR. EX(33)) THEN
              CALL PLA163 ('P-43n  ')
              CALL PLA163 ('Pm-3n  ')
            ELSE
              IF (LAUE .EQ. '  m-3') THEN
                IF (EX(18)) THEN
                  CALL PLA163 ('P213   ')
                ELSE
                  CALL PLA163 ('P23    ')
                  CALL PLA163 ('Pm-3   ')
                END IF
              ELSE
                IF (EX(24)) THEN
                  CALL PLA163 ('P4132  ')
                  CALL PLA163 ('P4332  ')
                ELSE IF (EX(18)) THEN
                  CALL PLA163 ('P4232  ')
                ELSE
                  CALL PLA163 ('P432   ')
                  CALL PLA163 ('P-43m  ')
                  CALL PLA163 ('Pm-3m  ')
                END IF
              END IF
            END IF
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA168
      SUBROUTINE PLA169 (MODE, RII, RISIG, SINTL, LU)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /STAT9/ ST(20, 3), NSTAT(20, 3), NSTOT(20), PERCMAX
      CHARACTER BALK*40
      COMMON /FSPGR/ CRI(11), PNZ(13, 10), STLS(20)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER PRBUF*80
      IF (MODE .EQ. 0) THEN
        CALL GEN097 (NSTOT, 1, 20, 0)
        CALL GEN097 (NSTAT, 1, 60, 0)
        CALL GEN074 (ST,    1, 60, 0.0)
        PERCMAX = 0.0
      ELSE IF (MODE .EQ. 1) THEN
        DO I = 1, 20
          IF (SINTL .LT. STLS(I)) THEN
            NSTOT(I) = NSTOT(I) + 1
            RSIG     = RISIG
            RI       = RII
            IF (RI .LE. 0.0) RI = 1.0
            IF (RSIG .LE. 0.0) RSIG = SQRT(RI)
            XIDSI = RI / RSIG
            IF (XIDSI .GE. 0.25) THEN
              NSTAT(I, 1) = NSTAT(I, 1) + 1
              IF (XIDSI .GT. 1.0) THEN
                NSTAT(I, 2) = NSTAT(I, 2) + 1
                IF (XIDSI .GE. 2.0) THEN
                  NSTAT(I, 3) = NSTAT(I, 3) + 1
                END IF
              END IF
            END IF
            EXIT
          END IF
        END DO
      ELSE IF (MODE .EQ. -1) THEN
        DO I = 1, 20
          IF (NSTOT(I) .GT. 0) THEN
            DO J = 1, 3
              ST(I, J) = 100.0 * NSTAT(I, J) / NSTOT(I)
            END DO
          END IF
          IF (ST(I, 3) .GT. PERCMAX) PERCMAX = ST(I, 3)
        END DO
C * OUTPUT STATISTICS
      ELSE IF (MODE .LE. -2) THEN
        IF (LU .EQ. 0) THEN
          IF (IPR(548) .EQ. 0) THEN
            M = 2 + IWIN
          ELSE
            M = 2
          ENDIF
        ELSE
          M = 1
        END IF
        DO N = 1, M
          IF (N .EQ. 1) THEN
            IF (M .EQ. 1) THEN
              LUX = LU
            ELSE
              LUX = LU6
            END IF
          ELSE IF (N .EQ. 2) THEN
            LUX = LU7
            WRITE (LUX, 99999, IOSTAT = IOST)
          ELSE
            LUX = 0
          ENDIF
   10     IF (LUX .EQ. 0) THEN
            CALL GGIP (HORS, VERT, 0.0, 1)
            VRT = VERT
          END IF
          WRITE (PRBUF, 99998, IOSTAT = IOST)
          IF (LUX .NE. 0) THEN
            WRITE (LUX, 99990, IOSTAT = IOST)
            WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
          ELSE
            VRT = VRT - 0.8
            CALL GGIP09 (0.0, PRBUF, 80, 0.37, 5, 2, 0.3, VRT)
          END IF
          WRITE (PRBUF, 99997, IOSTAT = IOST)
          IF (LUX .NE. 0) THEN
            WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
          ELSE
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.37, 5, 2, 0.3, VRT)
          END IF
          WRITE (PRBUF, 99996, IOSTAT = IOST)
          IF (LUX .NE. 0) THEN
            WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
          ELSE
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.37, 5, 2, 0.3, VRT)
          END IF
          WRITE (PRBUF, 99997, IOSTAT = IOST)
          IF (LUX .NE. 0) THEN
            WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
          ELSE
            VRT = VRT - 0.7
            CALL GGIP09 (0.0, PRBUF, 80, 0.37, 5, 2, 0.3, VRT)
          END IF
          MSHEL = 0
          DO I = 1, 20
            IF (NSTOT(I) .GT. 0) THEN
              MSHEL = I
              L = NINT (ST(I, 3) * 0.4)
              DO K = 1, 40
                IF (K .GT. L) THEN
                  BALK(K:K) = '.'
                ELSE
                  BALK(K:K) = '*'
                END IF
              END DO
              WRITE (PRBUF, 99995, IOSTAT = IOST)
     1          I, STLS(I), 1 / (2 * STLS(I)), NSTOT(I),
     2          (ST(I, J), J = 1, 3), BALK
              IF (LUX .NE. 0) THEN
                WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
              ELSE
                VRT = VRT - 0.7
                CALL GGIP09 (0.0, PRBUF, 80, 0.37, 1, 2, 0.3, VRT)
              END IF
            END IF
          END DO
          WRITE (PRBUF, 99994, IOSTAT = IOST)
          IF (LUX .NE. 0) THEN
            WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
          ELSE
            VRT = VRT - 0.7
            CALL GGIP09 (0.0, PRBUF, 80, 0.37, 5, 2, 0.3, VRT)
          END IF
          WRITE (PRBUF, 99993, IOSTAT = IOST)
          IF (LUX .NE. 0) THEN
            WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
          ELSE
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, PRBUF, 80, 0.37, 5, 2, 0.3, VRT)
          END IF
          WRITE (PRBUF, 99992, IOSTAT = IOST) NINT(PERCMAX)
          IF (LUX .NE. 0) THEN
            WRITE (LUX, 99990, IOSTAT = IOST)
            WRITE (LUX, 99991, IOSTAT = IOST) PRBUF
          ELSE
            VRT = VRT - 1.0
            CALL GGIP09 (0.0, PRBUF, 80, 0.37, 1, 2, 0.3, VRT)
            CALL PLA013 (2, 1)
            IF (IGGT(1:4) .EQ. 'PLOT') GO TO 10
          END IF
        END DO
        IF (MODE .EQ. -3) THEN
          WRITE (LU, 99999, IOSTAT = IOST)
C * ALERT _908
          IF (PERCMAX .LT. 75.0) THEN
            CALL PLA231 (908, 2, -999.0, PERCMAX, ' ', ' ')
          END IF
          IF (MSHEL .LE. 8) THEN
            YUNK = ST(MSHEL, 3)
C * ALERT _909
            IF (YUNK .GT. 30.0) THEN
              CALL PLA231 (909, 2, -999.0, YUNK, ' ', ' ')
            END IF
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (/, 'Section 7', /, 79('='),
     1        /, 'Analysis of Variance (F(obs) and F(calc) from FCF)',
     2        /, 79('='))
99998 FORMAT ('Intensity Distribution',
     1 ' [Decay of I/Sigma(I) versus sin(theta)/lambda]')
99997 FORMAT (79('='))
99996 FORMAT ('sh  st/l   Ang     #  0.25   1.0   2.0', 2X,
     3        'Percent  Distr. for I .gt. 2.0 * sig(I)')
99995 FORMAT (I2, 2F6.3, I6, 3F6.1, 1X, A)
99994 FORMAT (38X, 'I', 19X, 'I', 19X, 'I')
99993 FORMAT (18X, 'Percent Observed:   0',18X, '50', 17X, '100')
99992 FORMAT ('Maximum Percentage of Reflections with I .gt. 2*s(I)',
     3        ' in any Resolution Shell', I3)
99991 FORMAT (A)
99990 FORMAT (/)
      END SUBROUTINE PLA169
      SUBROUTINE PLA170 (N, M0, M)
      PARAMETER (NVD=100000000,NP18=50,NP23=28000,NCS=52,NZM = 200000,
     1           NRS = NVD - 10 * NZM)
      COMMON // XYZDUM(2, NP23), RS(NRS), TNZ(NZM, 10)
      COMMON /DFSPGR/ SUM(NCS, 5), NUM(NCS, 5), XMFS(NCS), XTL(12),
     1 XNM(12), NNZ(13), ANZ(13), IR(3), IN(24), XN(48), FMN(12),
     2 ITL(12), AVNZ(3), NREF, IPERC, TRMX(3, 3), LU, ISPGRC, ISPGRA,
     3 ISPGRH, IPCNTC, IPCNTA, IPCNTH, IFRQC, IFRQA, IFRQH, RAVERC,
     4 RAVERA, RAVERH
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /HKLMX/ HMAX, KMAX, LMAX, IHM, IHKM, IHKP
      INTEGER HMAX
      FMN(N) = 0.0
      ITL(N) = 0
      NCNT   = 0
      IF (RS(IN(M0)) .GT. -1.5) NTL(N, 1) = NTL(N, 1) + 1
      DO J = M0, M
        DO K = 1, 2
          IF (K .EQ. 1) THEN
            INJ = IN(J)
            L   = J
          ELSE
            INJ = - IN(J) + 2 * IHKP
            L   = J + 24
          END IF
          XN(L)   = RS(INJ)
          RS(INJ) = -2.0
          IF (XN(L) .GT. - 0.5) THEN
            NCNT = 1
            IF (XN(L) .GT. 0.0) THEN
              FMN(N) = FMN(N) + XN(L)
              ITL(N) = ITL(N) + 1
            END IF
          END IF
        END DO
      END DO
      NTL(N, 2) = NTL(N, 2) + NCNT
      IF (ITL(N) .GT. 1) THEN
        FMN(N)    = FMN(N) / ITL(N)
        NTL(N, 3) = NTL(N, 3) + 1
        DO J = M0, M
          DO K = 1, 2
            IF (K .EQ. 1) THEN
            INJ = IN(J)
              L   = J
            ELSE
            INJ = - IN(J) + 2 * IHKP
            L   = J + 24
            END IF
            IF (XN(L) .GT. 0.0) THEN
              XTL(N) = XTL(N) + ABS(XN(L) - FMN(N))
              XNM(N) = XNM(N) + XN(L)
            END IF
          END DO
        END DO
      END IF
      RETURN
      END SUBROUTINE PLA170
      SUBROUTINE PLA171 (LRET0, TM, LU, LIS, ISPR47, YPAR, KNN)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP18=50,NP38=150,NP39=30,
     1 NP45=2048,NSITE=70)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /SLAUE/ NLAUE, XSYST, IBVL, SITE
      CHARACTER NLAUE(14)*5, XSYST(8)*12, IBVL(8)*1, SITE(NSITE)*5
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LINE*80, LIJN*80, ICH*1
      DIMENSION YPAR(*), TM(3, 3), FNN(9), DUM(3, 3),
     1  AA(3, 3), BB(3, 3)
      CHARACTER NSYS*1
      LOGICAL EXST
      EXST = .FALSE.
      IF (KNN .EQ. 9) THEN
        DO I = 1, 9
          FNN(I) = FN(I)
        END DO
      END IF
   10 IF (IGBL(50) .EQ. 0) THEN
        IF (IPR(548) .EQ. 1) BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
        CALL GGIP (HORS, VERT, 0.0, 1)
        VRT = VERT - 0.7
        IF (NREXT .GT. 0) THEN
          LIJN = '(Pseudo)Extinctions Found in Input Reflection file'
          CALL GGIP09 (0.0, LIJN, 80, 0.375, 2, 2, 0.1, VRT)
          VRT = VRT - 0.2
          CALL GGIP (0.0,  VRT, 0.0, 3)
          CALL GGIP (HORS, VRT, 0.0, 2)
          VRT = VRT - 0.45
          LIJN = '    Ex. Condition    av[I/sig(I)]  Number of Refl '//
     1           'I/sigI             .T./.F.'
          CALL GGIP09 (0.0, LIJN, 80, 0.35, 5 + IGBL(68), 2, 0.1, VRT)
          VRT = VRT - 0.45
          LIJN = '                    .True. .False. .True. .False.'//
     1           '  Max.F    H  K  L   Ratio'
          CALL GGIP09 (0.0, LIJN, 80, 0.35, 5 + IGBL(68), 2, 0.1, VRT)
          VRT = VRT - 0.2
          CALL GGIP (0.0,  VRT, 0.0, 3)
          CALL GGIP (HORS, VRT, 0.0, 2)
          VRT = VRT - 0.5
          REWIND LU
          DO
            READ (LU, 99988, IOSTAT = IOST) LINE
            IF (IOST .NE. 0) EXIT
            IF (LINE(1:4) .EQ. 'EXTI') THEN
              CALL GGIP09 (0.0, LINE(6:80), 75, 0.35, 1, 2, 0.1, VRT)
              VRT = VRT - 0.45
            END IF
          END DO
          BACKSPACE LU
          VRT = VRT + 0.3
          CALL GGIP (0.0,  VRT, 0.0, 3)
          CALL GGIP (HORS, VRT, 0.0, 2)
          VRT = VRT - 0.5
        END IF
        LIJN = 'Cell Transformations to Optional Crystal System, '//
     1         'Lattice Type and Laue Class'
        WRITE (LU6, 99986, IOSTAT = IOST) LIJN
        WRITE (LIS, 99986, IOSTAT = IOST) LIJN
        WRITE (LU6, 99984, IOSTAT = IOST)
        WRITE (LIS, 99984, IOSTAT = IOST)
        CALL GGIP09 (0.0, LIJN, 80, 0.375, 2, 2, 0.1, VRT)
        VRT = VRT - 0.3
        CALL GGIP (0.0,  VRT, 0.0, 3)
        CALL GGIP (HORS, VRT, 0.0, 2)
        LIJN = ' # Latt Laue Rav %Ct %Nav       '//
     1   'Transformation Matrix / Cell + Volume'
        WRITE (LU6, 99986, IOSTAT = IOST) LIJN
        WRITE (LIS, 99986, IOSTAT = IOST) LIJN
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, LIJN, 80, 0.375, 5 + IGBL(68), 2, 0.1, VRT)
        VRT = VRT - 0.2
        CALL GGIP (0.0,  VRT, 0.0, 3)
        CALL GGIP (HORS, VRT, 0.0, 2)
        VRT = VRT - 0.2
        PAR(360) = VRT
        PAR(361) = 0.75
        DO K = 1, NRLT0
          VRT = VRT - 0.5
          IF (RVAL(K, 1) .LT. RMAX .AND. (RVAL(K, 2) .GT. PAR(432) .OR.
     1        RVAL(K, 1) .LT. 0.0001)) THEN
            ICOL = 3
          ELSE
            ICOL = 2
          END IF
          WRITE (LIJN, 99998, IOSTAT = IOST)
     1      K, ELATT(K), CLATT(K), BLATT(K), NLAUE(LLAUE(K)),
     2      (NINT(RVAL(K, J)), J = 1, 3), (TLATT(J, K), J = 1, 9)
          WRITE (LU6, 99988, IOSTAT = IOST) LIJN
          WRITE (LIS, 99988, IOSTAT = IOST) LIJN
          CALL GEN065 (0, LIJN, 80, 5)
          CALL GGIP09 (0.0, LIJN, 80, 0.35, ICOL, 2, 0.1, VRT)
          WRITE (LIJN, 99997, IOSTAT = IOST) (XCELL(J, K), J = 1, 7)
          WRITE (LU6, 99985, IOSTAT = IOST) LIJN(1:53)
          WRITE (LIS, 99985, IOSTAT = IOST) LIJN(1:53)
          VRT = VRT - 0.25
          CALL GGIP09 (0.0, LIJN, 80, 0.20, 1, 1, 9.0, VRT)
        END DO
        ISPR47 = 0
        IF (KNN .EQ. 9) THEN
          DO I = 1, 9
            FN(I) = FNN(I)
          END DO
          KNN = 0
          KN  = 9
          KL  = 0
        END IF
        IF (KN .EQ. 9) GO TO 50
        INQUIRE (FILE = '.newsym.ntr', EXIST = EXST)
        IF (EXST) THEN
          OPEN (LU61, FILE = '.newsym.ntr', STATUS = 'UNKNOWN')
          READ (LU61, 99988) LINE
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          ISPR47 = 1
          GO TO 40
        END IF
   30   WRITE (SBCD, 99996, IOSTAT = IOST) NRLT, CHAR(0)
        IGBL(28) = 1
        CALL PLA013 (0, 1)
        IGBL(28) = 0
        IF (IGGT(1:4) .EQ. 'PLOT') GO TO 10
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 130
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          WRITE (LINE, 99987, IOSTAT = IOST) NRLT
        END IF
   40   CALL GEN072 (LINE, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
   50   IF (KN .EQ. 1 .AND. FN(1) .GT. 0 .AND. FN(1) .LE. NRLT0)  THEN
          NRLT = NINT(FN(1))
        ELSE IF (KN .EQ. 0 .AND. KL .EQ. 0) THEN
          GO TO 70
        ELSE IF (KN .GE. 9) THEN
          CALL GEN003 (FN(1), DUM, DET, 0)
          IF (ABS(DET) .LT. 0.01) THEN
            WRITE (LU6, 99994, IOSTAT = IOST)
            GO TO 30
          END IF
          DO I = 1, 9
            TLATT(I, NP18) = FN(I)
            K = (I - 1) / 3 + 1
            J = MOD (I - 1, 3) + 1
            TM(K, J) = FN(I)
          END DO
          CLATT(NP18) = ' '
          BLATT(NP18) = ' '
          ELATT(NP18) = ' '
          LLAUE(NP18)  = 13
          RVAL(NP18, 1)  = 0.0
          RVAL(NP18, 2)  = 0.0
          RVAL(NP18, 3)  = 0.0
          IF (KL .GT. 0 .AND. IFL(KL)(1:4) .NE. 'TRMX') THEN
            CLATT(NP18) = IFL(KL)(1:1)
            BLATT(NP18) = IFL(KL)(2:2)
            ELATT(NP18) = ' '
            CALL GEN020 (-1, CLATT(NP18), 1, 1)
            CALL GEN020 (1,  BLATT(NP18), 1, 1)
          END IF
          DO 60 K = 1, NRLT0
            DO I = 1, 9
              IF (TLATT(I, K) .NE. TLATT(I, NP18)) GO TO 60
            END DO
            IF (BLATT(K) .NE. BLATT(NP18)) GO TO 60
            IF (CLATT(K) .NE. CLATT(NP18)) GO TO 60
            NRLT = K
            GO TO 30
   60     CONTINUE
          NRLT0 = NRLT0 + 1
          CALL GEN026 (1, AA, YPAR(81))
          CALL GEN003 (AA, BB, DET, 0)
          YPAR(95)  = BB(1, 1)
          YPAR(96)  = BB(2, 2)
          YPAR(97)  = BB(3, 3)
          YPAR(98)  = BB(2, 3)
          YPAR(99)  = BB(1, 3)
          YPAR(100) = BB(1, 2)
          CALL GEN001 (1, TM, AA, BB)
          CALL GEN026 (-1, BB, YPAR(101))
          CALL GEN003 (BB, AA, DET, 0)
          YPAR(107) = SQRT(DET)
          DO I = 1, 9
            TLATT(I, NRLT0) = TLATT(I, NP18)
          END DO
          DO I = 1, 7
            XCELL(I, NRLT0) = YPAR(100 + I)
          END DO
          CLATT(NRLT0) = CLATT(NP18)
          BLATT(NRLT0) = BLATT(NP18)
          ELATT(NRLT0) = ELATT(NP18)
          LLAUE(NRLT0) = 13
          NRLT  = NRLT0
          IF (ISPR47 .EQ. 0) GO TO 10
        ELSE
          CALL PLA015 (0, 24)
          GO TO 30
        END IF
      END IF
   70 IF (CLATT(NRLT) .EQ. ' ') THEN
        IF (ISPR47 .EQ. 1) THEN
          IFL(1) = IFL(2)
          GO TO 90
        END IF
   80   WRITE (BCD, 99993, IOSTAT = IOST) CHAR(0)
        CALL GGIP (-999.0, 3.0, 80.0, 112)
        NALF = 0
        NBET = 0
        NGAM = 0
        NA12 = 0
        NA13 = 0
        NA23 = 0
        NSYS = 'a'
        IF (ABS(XCELL(4, NRLT) - 90.0)  .LT. 0.05) NALF = 1
        IF (ABS(XCELL(5, NRLT) - 90.0)  .LT. 0.05) NBET = 1
        IF (ABS(XCELL(6, NRLT) - 90.0)  .LT. 0.05) NGAM = 1
        IF (ABS(XCELL(6, NRLT) - 120.0) .LT. 0.05) NGAM = 2
        IF (ABS(XCELL(1, NRLT) - XCELL(2, NRLT)) .LT. 0.01) NA12 = 1
        IF (ABS(XCELL(1, NRLT) - XCELL(3, NRLT)) .LT. 0.01) NA13 = 1
        IF (ABS(XCELL(2, NRLT) - XCELL(3, NRLT)) .LT. 0.01) NA23 = 1
        IF (NALF + NBET + NGAM .EQ. 1) THEN
          NSYS = 'm'
        ELSE IF (NALF .EQ. 1 .AND. NBET .EQ. 1 .AND. NGAM .EQ. 2) THEN
          IF (NA12 .EQ. 1) THEN
            NSYS = 'h'
          ELSE
            NSYS = 'm'
          END IF
        ELSE IF (NALF .EQ. 1 .AND. NBET .EQ. 1 .AND. NGAM .EQ. 1) THEN
          IF (NA12 .EQ. 1 .AND. NA13 .EQ. 1 .AND. NA23 .EQ. 1) THEN
            NSYS = 'c'
          ELSE IF (NA12 .EQ. 1) THEN
            NSYS = 't'
          ELSE
            NSYS = 'o'
          END IF
        END IF
        WRITE (SBCD, 99987, IOSTAT = IOST) NRLT, NSYS, CHAR(0)
        CALL PLA013 (0, 1)
        IF (IGGT(1:4) .EQ. 'PLOT') GO TO 80
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 130
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          LINE = NSYS
        END IF
        CALL GEN072 (LINE, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
   90   CLATT(NRLT) = IFL(1)(1:1)
        BLATT(NRLT) = IFL(1)(2:2)
        CALL GEN020 (-1, CLATT(NRLT), 1, 1)
        CALL GEN020 ( 1, BLATT(NRLT), 1, 1)
        GO TO 70
      END IF
      IF (BLATT(NRLT) .EQ. ' ') THEN
  100   WRITE (BCD, 99990, IOSTAT = IOST) CHAR(0)
        CALL GGIP (-999.0, 3.0, 80.0, 112)
        WRITE (SBCD, 99992, IOSTAT = IOST) NRLT, CHAR(0)
        CALL PLA013 (0, 1)
        IF (IGGT(1:4) .EQ. 'PLOT') GO TO 100
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 130
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          LINE = 'P '
        END IF
        CALL GEN072 (LINE, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
        BLATT(NRLT) = IFL(1)(1:1)
        CALL GEN020 (1, BLATT(NRLT), 1, 1)
      END IF
      IF (LLAUE(NRLT) .EQ. 13) THEN
        IF (ISPR47 .EQ. 1) THEN
          FN(1) = FN(10)
          GO TO 120
        END IF
  110   WRITE (BCD, 99989, IOSTAT = IOST) CHAR(0)
        CALL GGIP (-999.0, 3.0, 80.0, 112)
        ICH = CLATT(NRLT)
        SELECT CASE (ICH)
          CASE ('a')
            IVAL = 1
          CASE ('m')
            IVAL = 2
          CASE ('o')
            IVAL = 3
          CASE ('t')
            IVAL = 4
          CASE ('h')
            IF (BLATT(NRLT) .EQ. 'R') THEN
              IVAL = 6
            ELSE
              IVAL = 9
            END IF
          CASE ('c')
            IVAL = 11
        END SELECT
        WRITE (SBCD, 99991, IOSTAT = IOST) NRLT, IVAL, CHAR(0)
        CALL PLA013 (0, 1)
        IF (IGGT(1:4) .EQ. 'PLOT') GO TO 110
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 130
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          WRITE (LINE, 99999, IOSTAT = IOST) IVAL
        END IF
        CALL GEN072 (LINE, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
        IF (KN .EQ. 0) FN(1) = 1.0
        IF (NINT(FN(1)) .LT. 1 .OR. NINT(FN(1)) .GT. 12) FN(1) = 1.0
  120   LLAUE(NRLT) = NINT(FN(1))
        DO I = 1, 3
          RVAL(NRLT, I) = RVL(LLAUE(NRLT), I)
        END DO
        IF (ISPR47 .EQ. 0) GO TO 10
      END IF
      RETURN
  130 LRET0 = 1
      RETURN
99999 FORMAT (I3)
99998 FORMAT (I2, A,'= ', A, A, 1X, A, 3I4, 1X, 9F6.3)
99997 FORMAT (3F7.3, 3F7.2, F10.0)
99996 FORMAT ('Enter TRMX Matrix or Click on / Select TRMX #[', I2, ']',
     1         A)
99994 FORMAT (':: Error - Determinant TRMX = 0.0', /)
99993 FORMAT ('a=Anorthic, m=Monoclinic, o=Orthorhombic, ',
     1        't=Tetragonal, h=hexagonal, c=cubic', A)
99992 FORMAT ('Enter Lattice Centering Type for TRMX #', I3, '[P]', A)
99991 FORMAT ('Enter Laue Class for TRMX #', I3, '[', I2, ']', A)
99990 FORMAT ('Options:  P, A, B, C, F, I, R :', A)
99989 FORMAT ('1=-1,2=2/m,3=mmm,4=4/m,5=4/mmm,6=-3,',
     1        '7=-3m1,8=-31m,9=6/m,10=6/mmm,11=m-3,12=m-3m',A)
99988 FORMAT (A)
99987 FORMAT ('Enter Crystal System for TRMX #', I3, '[', A, ']', A)
99986 FORMAT (/, A)
99985 FORMAT (25X, A)
99984 FORMAT (/, 'Note: %Ct  = percentage of Completeness', /,
     1           '      %Nav = Percentage of Symmetry Averaged ',
     2           'Reflections', /)
      END SUBROUTINE PLA171
      SUBROUTINE PLA172
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NP59=100000)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /LABC/LABB(NP59)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER N113*3
      DIMENSION LV(6), NV1(4)
C * TABLE LIST FUNCTION & CIF GENERATION
C***********************************************************************
C***********************************************************************
C***********************************************************************
      NRES  = 0
      K     = 0
      JSORT = 0
      LVK   = 0
      J0    = 0
      ISL   = 0
      NLBX  = 0
      REWIND (UNIT = LU2, IOSTAT = IOST)
      IF (IOST .NE. 0) CALL GEN148 (LU2, 1)
      IF (IPR(431) .EQ. 1) THEN
        OPEN (UNIT = LU60, FILE = NAMEFIL(1:KNMFIL)//'.sup',
     1        STATUS = 'UNKNOWN')
      ELSE IF (IPR(431) .EQ. -1) THEN
        OPEN (UNIT = LU60, FILE = NAMEFIL(1:KNMFIL)//'_acc.cif',
     1        STATUS = 'UNKNOWN')
      END IF
      IPR(239) = 0
      IPR(245) = IPR(37)  * 12
      IPR(246) = IPR(245) * 2
      IPR(247) = IPR(246) + IPR(251) * 4
      IPR(248) = IPR(247) + IPR(252) * 5
      IPR(249) = IPR(248) + IPR(253) * 6
      IPR(250) = IPR(249) + IPR(254) * 4
      IPR(233) = IPR(37) * 2
      IPR(234) = IPR(233) + IPR(251) * 2
      IPR(235) = IPR(234) + IPR(252) * 2
      IPR(236) = IPR(235) + IPR(253) * 2
      IF (IPR(236) .GT. NP23) THEN
        IPR(236) = IPR(235)
        IPR(237) = IPR(235)
        IPR(238) = IPR(235)
        IPR(253) = 0
        IPR(254) = 0
        IPR(452) = 0
        WRITE (LU6, 99998, IOSTAT = IOST)
        WRITE (LU6, 99997, IOSTAT = IOST)
        WRITE (LU6, 99996, IOSTAT = IOST)
      ELSE
        IPR(237) = IPR(236) + IPR(254) * 2
        IF (IPR(237) .GT. NP23) THEN
          IPR(237) = IPR(236)
          IPR(238) = IPR(236)
          IPR(254) = 0
          IPR(452) = 0
          WRITE (LU6, 99997, IOSTAT = IOST)
          WRITE (LU6, 99996, IOSTAT = IOST)
        ELSE
          IPR(238) = IPR(237) + IPR(452) * 2
          IF (IPR(238) .GT. NP23) THEN
            IPR(238) = IPR(237)
            IPR(452) = 0
            WRITE (LU6, 99996, IOSTAT = IOST)
          END IF
        END IF
      END IF
      IPR(226) = 0
      IPR(227) = IPR(233)
      IPR(228) = IPR(234)
      IPR(229) = IPR(235)
      IPR(230) = IPR(236)
      IPR(231) = IPR(237)
      LV(1)    = 1
      LV(2)    = IPR(246) + 1
      LV(3)    = IPR(247) + 1
      LV(4)    = IPR(248) + 1
      LV(5)    = IPR(249) + 1
      LV(6)    = IPR(250) + 1
      K0       = 0
   10 IPR53S   = IGBL(5)
      IGBL(5)  = LU2
      CALL PLA006 (0, IS)
      IF (IS .GE. 0) THEN
        IGBL(5) = IPR53S
        N113    = IFL(1)(1:3)
        IF (N113 .EQ. 'RES') THEN
          NRES = NINT(FN(1))
          GO TO 10
        ELSE IF (IS .GT. 24 .AND. IS .LT. 29) THEN
          K0 = 1
          K  = 1
        ELSE IF (N113 .EQ. 'BON') THEN
          K0 = 2
          K  = 2
        ELSE IF (N113 .EQ. 'ANG') THEN
          K0 = 3
          K  = 3
        ELSE IF (N113 .EQ. 'TOR') THEN
          K0 = 4
          K  = 4
        ELSE IF (N113 .EQ. 'NON') THEN
          K0 = 5
          K  = 2
        ELSE IF (N113 .EQ. 'HBO') THEN
          K0 = 6
          K  = 3
        END IF
        IF (K0 .GT. 0) THEN
          NQH = 0
          DO I = 1, K
            NQ1 = IFL(I + 1)
            CALL PLA046 (1, NQ1, IENM, LBB, LBC, LBD, INQNR, JNQNR,
     1        NIEN)
            NLBX                 = NLBX + 1
            VOID(LV(K0) + I - 1) = NLBX
            LABB(NLBX)           = INQNR
            NV1(I)               = JNQNR
            IF (NIEN .GE. 0) THEN
              NIEN = IEN(NIEN + 1)
              IF (NIEN .EQ. 1 .OR. NIEN .EQ. 33 .OR.
     1            NIEN .EQ. 113) THEN
                IF (IPR(454) .EQ. 0) GO TO 10
                NQH = IPR(465)
              END IF
            ELSE
              WRITE (LU6, 99999, IOSTAT = IOST) IFL(I + 1), NIEN, NQ1
              GO TO 10
            END IF
          END DO
          IF (K0 .EQ. 1) THEN
            IF (IS .EQ. 28) THEN
C * ATOM
              JSORT = NV1(1)
              LVK = LV(K0) * 16 + 5
              XJX(1)  = FN(1)
              XJX(2)  = FN(2)
              XJX(3)  = FN(3)
              XJX(10) = 0.0
              CALL SGSM (IDM, 0, XJX, LU6, 19, IERR)
              FN(4)  = FN(4) / XJX(10)
              FN(8)  = FN(8) / XJX(10)
              J0     = 4
              GO TO 20
            ELSE IF (IS .EQ. 25) THEN
C * UIJ
              JNSC(2, IPR(225 + K0)) = LVK + 7
              ISL = LV(K0)
              DO J = 1, 7
                VOID(LV(K0)) = FN(J)
                LV(K0) = LV(K0) + 1
              END DO
            ELSE IF (IS .EQ. 26) THEN
C * SUIJ
              DO J = 1, 7
                VOID(ISL + IPR(245)) = FN(J)
                ISL = ISL + 1
              END DO
            ELSE IF (IS .EQ. 27) THEN
C * U
              JNSC(2, IPR(225 + K0))  = LVK + 1
              VOID(LV(K0))            = FN(1)
              VOID(LV(K0) + IPR(245)) = FN(2)
              LV(K0)                  = LV(K0) + 1
            END IF
            GO TO 10
          ELSE IF (K0 .EQ. 2) THEN
            IF (NV1(1) .GT. NV1(2)) THEN
              CALL GEN014 (NV1(1), NV1(2))
              CALL GEN018 (VOID(LV(K0)), VOID(LV(K0) + 1))
            END IF
            JSORT = NV1(1)
            J0 = 2
          ELSE IF (K0 .EQ. 3) THEN
            IF (NV1(1) .GT. NV1(3)) THEN
              CALL GEN014 (NV1(1), NV1(3))
              CALL GEN018 (VOID(LV(K0)), VOID(LV(K0) + 2))
            END IF
            JSORT = NV1(2)
            J0 = 2
          ELSE IF (K0 .EQ. 4) THEN
            IF (NV1(2) .GT. NV1(3)) THEN
              CALL GEN014 (NV1(2), NV1(3))
              CALL GEN014 (NV1(1), NV1(4))
              CALL GEN018 (VOID(LV(K0) + 1), VOID(LV(K0) + 2))
              CALL GEN018 (VOID(LV(K0)), VOID(LV(K0) + 3))
            END IF
            JSORT = NV1(2)
            J0    = 2
          ELSE IF (K0 .EQ. 5) THEN
            J0    = 2
            JSORT = NV1(1)
          ELSE IF (K0 .EQ. 6) THEN
            J0    = 8
            JSORT = NV1(1)
            LABB(NLBX) = NINT(FN(9))
          END IF
          LVK = LV(K0)
   20     IF (IPR(225 + K0) .LT. IPR(232 + K0)) THEN
            IPR(225 + K0)          = IPR(225 + K0) + 1
            JNSC(1, IPR(225 + K0)) = JSORT
     1                             + NQH + IPR(240) * IPR(466) * NRES
            JNSC(2, IPR(225 + K0)) = LVK
            DO J = 1, J0
              VOID(LV(K0) + K + J - 1) = FN(J)
              IF (IS .EQ. 28)
     1            VOID(LV(K0) + K + J + IPR(245) - 1) = FN(J + 4)
            END DO
            LV(K0) = LV(K0) + K + J0
          END IF
        END IF
        GO TO 10
C * END OF FILE
      END IF
      CLOSE (UNIT = LU2, STATUS = 'DELETE')
      IF (IPR(226) .GT. 0) THEN
      CALL GEN037 (JNSC, 1, IPR(226))
      CALL GEN037 (JNSC, IPR(233) + 1, IPR(227))
      CALL GEN037 (JNSC, IPR(234) + 1, IPR(228))
      IF (IPR(253) .GT. 0) CALL GEN037 (JNSC, IPR(235) + 1, IPR(229))
      IF (IPR(254) .GT. 0) CALL GEN037 (JNSC, IPR(236) + 1, IPR(230))
C * LIST SECTION
C * TITLE PAGE SUPPLEMENTARY MATERIAL / CIF HEADER
      CALL PLA173 (-1, 0, 0)
C * CRYSTAL DATA
      CALL PLA173 ( 0, 1, 0)
C * ATOMS
      IF (IPR(431) .EQ. 1) THEN
        CALL PLA173 ( 1,  0, 0)
      ELSE
        CALL PLA173 ( 1,  1, 0)
      ENDIF
C * H -ATOMS
      IF (IPR(484) .GT. 0) CALL PLA173 (2, 1, 0)
C * ANISOTROPIC DISPLACEMENT PARAMETERS SUP
        IF (IPR(32) .EQ. 2) CALL PLA173 (3, 0, 0)
        IF (IPR(251) .GT. 0) THEN
C * BOND DISTANCES
          IF (IPR(431) .EQ. 1) THEN
            CALL PLA173 (4, 1, 2)
          ELSE
            CALL PLA173 (4, 1, 1)
          END IF
        END IF
        IF (IPR(252) .GT. 0) THEN
C * BOND ANGLES
          IF (IPR(431) .EQ. 1) THEN
            CALL PLA173 (5, 1, 2)
          ELSE
            CALL PLA173 (5, 1, 1)
          END IF
        END IF
C * TORSION ANGLES
        IF (IPR(253) .GT. 0) CALL PLA173 (6, 1, 1)
C * CONTACT-DISTANCES
        IF (IPR(254) .GT. 0 .AND. IPR(431) .EQ. 1)
     1    CALL PLA173 (7, 1, 2)
C * HBONDS
        IF (IPR(452) .GT. 0) CALL PLA173 (8, 0, 1)
C * FINISH
        CALL PLA173 (9, 0, 0)
      END IF
      CLOSE (UNIT = LU60)
      RETURN
99999 FORMAT ('Ignored Label Problem in PLA172 for :', A, I10, 1X, A)
99998 FORMAT (':: Too Many Torsions    -> Skipped')
99997 FORMAT (':: Too Many Non-Bonding -> Skipped')
99996 FORMAT (':: Too Many H-Bonds     -> Skipped')
      END SUBROUTINE PLA172
      SUBROUTINE PLA173 (MODE, INCLH, NCOL)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP34=647,NP38=150,NP39=30,
     3 NP41=200,NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NP59=100000,
     4 NKW=49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /LABC/LABB(NP59)
      CHARACTER FORMA*79, FORMB*67, FORMC*120, FORMT*100, FORMHA*75,
     1 FORMHB*75, FORMHT*75, FORMNB*77, FORMBH*79 , CTAB*1, FPARSU*18,
     2 FBOND*82, FANGL*88, FORMAN*88, FORMHC*120, FORMNH*151, FVOLU*40,
     3 FORMCD*104, FORHBF*88, DCHAR*3
      CHARACTER DISOR*1, UTYPE*5, SCTYP*3, ASCF*11
      COMMON /CIF/ CIFDIR
      CHARACTER CIFDIR(NP34)*(NKW)
      CHARACTER CIFTYPE*3
      COMMON /TODAY/ DATIJD
      CHARACTER DATIJD*25
      COMMON /XVLAG/ CVLAG
      CHARACTER CVLAG(7)*1
      CHARACTER CDUM*(NP52)
C * PRINT TABLES
C * MODE = -1 - HEADER
C * MODE =  0 - CRYSTAL DATA ETC
C * MODE =  1 - NON-H COORDINATES
C * MODE =  2 - H-ATOM COORDINATES
C * MODE =  3 - DISPLACEMENT PARAMETERS
C * MODE =  4 - BONDS
C * MODE =  5 - ANGLES
C * MODE =  6 - TORSIONS
C * MODE =  7 - INTER CONTACTS
C * MODE =  8 - HBONDS
C * MODE =  9 - FINISH
C * LU2  = OME-FILE
C * LU7  = LIS-FILE
C * LU60 = SUP/CIF-FILE
      IF (IPR(431) .EQ. 0) THEN
        LU = LU7
      ELSE
        LU = LU60
      ENDIF
      DCHAR = '   '
      N     = 1
      IF (IPR(493) .EQ. 0) IPR(493) = -2
      IF (PAR(170) .LT. 0) THEN
        IF (KRAD(1:2) .EQ. 'Mo') THEN
          PAR(170) = 0.35
        ELSE IF (KRAD(1:2) .EQ. 'Cu') THEN
          PAR(170) = 0.14
        ELSE
          PAR(170) = 0.0
        END IF
      END IF
C * SETUP FORMATS
      FBOND(  1: 28) = '(8X,''a, b, c [Angstrom]'', 9X'
      FBOND( 29: 45) = ', F9.4,''('',I2,'')'''
      FBOND( 46: 82) = FBOND(29:45)//FBOND(29:45)//',A)'
      FANGL(  1: 34) = '(8X,''alpha, beta, gamma [deg]'', 3X'
      FANGL( 35: 88) = FBOND(29:82)
      FVOLU(  1: 40) = '(8X,''V [Ang**3]'',42X,F10.1,''('',I2,'')'',A)'
C * SETUP FORMAT COORDINATES
      FORMC(  1:  7) = '(1X,2A '
      FORMC(  8: 23) = ',F9.0,''('',I2,'')'''
      FORMC( 24: 55) = FORMC(8:23)//FORMC(8:23)
      FORMC( 56:120) = FORMC(24:55)//FORMC(24:55)//')'
C * SETUP FORMAT BONDS
      FORMB(1  :  3) = '(1X'
      FORMB(4  : 33) = ', A ,  A  , A ,F8.4,''('',I2,'')'''
      FORMB(34 : 67) = ',5X'//FORMB(4:33)//')'
C * SETUP FORMAT BOND ANGLES
      FORMA(1  :  3) = '(1X'
      FORMA(4  : 39) = ', A ,  A, A , A , A ,F8.4,''('',I2,'')'''
      FORMA(40 : 79) = ',3X'//FORMA(4:39)//')'
C * SETUP FORMAT TORSION ANGLES
      FORMT(1  :  3) = '(1X'
      FORMT(4  : 38) = ', A ,  A  , A ,  A  , A ,  A  , A ,'
      FORMT(39 : 54) = 'F8.4,''('',I2,'')'')'
C * SETUP FORMAT TABLE HEADERS
      FORMHB(1 : 41) = '  (8X,''Table '',A,I1,'' - Bond Distances '','
      FORMHB(42: 75) = '''(Angstrom) '',A,/,19X,''for: '',A,/)'
      FORMHA(1 : 41) = '  (4X,''Table '',A,I1,'' - Bond Angles    '','
      FORMHA(42: 75) = '''(Degrees)  '',A,/,15X,''for: '',A,/)'
      FORMHT(1 : 41) = '  (9X,''Table '',A,I1,'' - Torsion Angles '','
      FORMHT(42: 75) = '''(Degrees)  '',A,/,20X,''for: '',A,/)'
      FORMNB(1 : 43) = '  (8X,''Table '',A,I1,'' - Contact Distances'','
      FORMNB(44: 77) = '''(Angstrom) '',A,/,19X,''for: '',A,/)'
      FORMBH(1 : 41) = '  (8X,''Table '',A,I1,'' - Hydrogen Bonds '','
      FORMBH(42: 79) = '''(Angstrom, Deg)'',A,/,19X,''for: '',A,/)'
      FORMAN( 1: 40) = '  (4X,''Table '',A,I1,'' - (An)isotropic '','
      FORMAN(41: 72) = ''' Displacement Parameters '',A,/,'
      FORMAN(73: 88) = '15X,''for: '',A,/)'
      FORMHC( 1: 40) = '  (8X,''Table '',A,I1,'' - Hydrogen Atom '','
      FORMHC(41: 85) = '''Positions and Isotropic Displacement'',/,19X,'
      FORMHC(86:104) = '''Parameters  '',A,/,'
      FORMHC(105:120)= '19X,''for: '',A,/)'
      FORMNH( 1: 43) = '  (8X,''Table '',A,I1,'' - Final Coordinates'','
      FORMNH(44: 88) = ''' and Equivalent Isotropic Displacement'',/,19'
      FORMNH(89:133) = 'X,''Parameters of the non-Hydrogen atoms  '',A,'
      FORMNH(134:151)= '/,19X,''for: '',A,/)'
      FORMCD( 1: 43) = '  (8X,''Table '',A,I1,'' - Crystal Data and '','
      FORMCD(44: 88) = '''Details of the Structure Determination'',A,/,'
      FORMCD(89:104) = '19X,''for: '',A,/)'
      FORHBF( 1:38) = '(A,1X,A,1X,A,F7.4,''('',I2,'')'',F7.4,''('','
      FORHBF(39:73) = 'I2,'')'',F7.4,''('',I2,'')'',F7.1,''('',I2,'
      FORHBF(74:88) = ''')'',1X,A,''   '')'
      FPARSU(1:18)  = '(F10.0,''('',I2,'')'')'
      IF (IPR(431) .GE. 0) THEN
        IF (MODE .LT. 4) THEN
          LSTART = 8
        ELSE
          LSTART = 4
        END IF
        IF (IPR(431) .EQ. 1) THEN
          IF (MODE .NE. -1) IGBL(84) = IGBL(84) + 1
          NTAB     = IGBL(84)
          CTAB     = 'S'
          IDOUBL   = IPR(274)
        ELSE IF (IPR(431) .EQ. 0) THEN
          IDOUBL   = 1
          NTAB     = 0
          CTAB     = ' '
        END IF
        MXLIN  = IPR(243) / IDOUBL
        LSTART = LSTART   / IDOUBL
        IF (IDOUBL .EQ. 1) THEN
          DCHAR = '   '
        ELSE
          DCHAR = '  '//CHAR(10)
        END IF
      ELSE
        MXLIN  = 99999
        LSTART = 1
        IDOUBL = 1
      END IF
      IF (MODE .EQ. -1) THEN
C * COVER PAGE SUPPLEMENTARY MATERIAL
        IF (IPR(431) .EQ. 1) THEN
          IF (IPR(431) .EQ. 1) THEN
            IGBL(85) = IGBL(85) + 1
            WRITE (LU, 99982, IOSTAT = IOST) CHAR(12), IGBL(85)
          END IF
          WRITE (LU, 99999, IOSTAT = IOST) JID(1:40), DATIJD(5:24)
          NTB = IGBL(84)
          CALL PLA176 (0, LU, CTAB, NTB, FORMCD, JID)
          CALL PLA176 (0, LU, CTAB, NTB, FORMNH, JID)
          IF (IPR(484) .GT. 0)
     1      CALL PLA176 (0, LU, CTAB, NTB, FORMHC, JID)
          IF (IPR(32) .GT. 0) THEN
            FORMAN( 4 :  4) = '8'
            FORMAN(73 : 74) = '19'
            CALL PLA176 (0, LU, CTAB, NTB, FORMAN, JID)
            FORMAN( 4 :  4) = '4'
            FORMAN(73 : 74) = '15'
          END IF
          IF (IPR(251) .GT. 0)
     1        CALL PLA176 (0, LU, CTAB, NTB, FORMHB, JID)
          IF (IPR(252) .GT. 0) THEN
            FORMHA( 4 :  4) = '8'
            FORMHA(60 : 61) = '19'
            CALL PLA176 (0, LU, CTAB, NTB, FORMHA, JID)
            FORMHA( 4 :  4) = '4'
            FORMHA(60 : 61) = '15'
          END IF
          IF (IPR(253) .GT. 0 .AND. IPR(431) .EQ. 1) THEN
            FORMHT( 4 :  4) = '8'
            FORMHT(60 : 61) = '19'
            CALL PLA176 (0, LU, CTAB, NTB, FORMHT, JID)
            FORMHT( 4 : 4)  = '9'
            FORMHT(60 : 61) = '20'
          END IF
          IF (IPR(254) .GT. 0)
     1      CALL PLA176 (0, LU, CTAB, NTB, FORMNB, JID)
          IF (IPR(452) .GT. 0)
     1      CALL PLA176 (0, LU, CTAB, NTB, FORMBH, JID)
        ELSE
C * CIF - FILE - HEADER
          WRITE (LU, 99300, IOSTAT = IOST) JID(1:40)
          WRITE (LU, 99299, IOSTAT = IOST)
          WRITE (LU, 99298, IOSTAT = IOST) 'global'
          CIFTYPE = 'ACC'
          WRITE (LU, 99299, IOSTAT = IOST)
          WRITE (LU, 99297, IOSTAT = IOST)
          WRITE (LU, 99296, IOSTAT = IOST)
     1      CIFDIR(71), DATIJD(5:24), CIFDIR(72), CIFTYPE, CIFDIR(73)
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99294, IOSTAT = IOST)
          IF (IPR(399) .EQ. 0) THEN
            WRITE (LU, 99293, IOSTAT = IOST) CIFDIR(437), CIFDIR(438)
            WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(325), '?'
            WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(326), '?'
            WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(327), '?'
          ELSE
            WRITE (LU, 99278, IOSTAT = IOST) CIFDIR(437), CIFDIR(438)
            WRITE (LU, 99277, IOSTAT = IOST)
            WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(325),
     1                        '''a.l.spek@uu.nl'''
            WRITE (LU, 99292, IOSTAT = IOST)
     1       CIFDIR(326), '''+31 30 2533940'''
            WRITE (LU, 99292, IOSTAT = IOST)
     1        CIFDIR(327), '''+31 30 2532538'''
          END IF
          WRITE (LU, 99291, IOSTAT = IOST)
          WRITE (LU, 99290, IOSTAT = IOST) CIFDIR(336), CIFDIR(436)
          WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(335), '?'
          WRITE (LU, 99291, IOSTAT = IOST)
          WRITE (LU, 99289, IOSTAT = IOST) CIFDIR(328)
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99288, IOSTAT = IOST)
          WRITE (LU, 99287, IOSTAT = IOST)
     1      CIFDIR(305), CIFDIR(299), CIFDIR(298), CIFDIR(297),
     2      CIFDIR(301), CIFDIR(300), CIFDIR(303), CIFDIR(302),
     3      CIFDIR(294), CIFDIR(291), CIFDIR(295), CIFDIR(314),
     4      CIFDIR(318), CIFDIR(288), CIFDIR(308), CIFDIR(321),
     5      CIFDIR(320), CIFDIR(307), CIFDIR(309), CIFDIR(310),
     6      CIFDIR(311), CIFDIR(312)
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99286, IOSTAT = IOST)
          WRITE (LU, 99285, IOSTAT = IOST) CIFDIR(337), CIFDIR(439)
          WRITE (LU, 99284, IOSTAT = IOST)
          WRITE (LU, 99283, IOSTAT = IOST) CIFDIR(323), CIFDIR(469),
     1      CIFDIR(322)
          IF (IPR(399) .EQ. 1) THEN
            WRITE (LU, 99279, IOSTAT = IOST)
            WRITE (LU, 99277, IOSTAT = IOST)
          END IF
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99282, IOSTAT = IOST)
          WRITE (LU, 99248, IOSTAT = IOST) CIFDIR(440), CIFDIR(338)
          WRITE (LU, 99252, IOSTAT = IOST)
          WRITE (LU, 99281, IOSTAT = IOST) CIFDIR(339)
          WRITE (LU, 99250, IOSTAT = IOST) CIFDIR(424), CIFDIR(425)
          WRITE (LU, 99251, IOSTAT = IOST)
          WRITE (LU, 99259, IOSTAT = IOST)
     1      CIFDIR(344), CHAR(92), CHAR(39)
          WRITE (LU, 99258, IOSTAT = IOST)
          WRITE (LU, 99257, IOSTAT = IOST)
          IF (IPR(399) .EQ. 0) THEN
            WRITE (LU, 99265, IOSTAT = IOST) CIFDIR(343)
          ELSE
            WRITE (LU, 99274, IOSTAT = IOST) CIFDIR(343)
          END IF
          WRITE (LU, 99245, IOSTAT = IOST) CIFDIR(345)
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99298, IOSTAT = IOST) DATANM
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99280, IOSTAT = IOST)
        END IF
      ELSE IF (MODE .EQ. 0) THEN
        IF (IPR(215) .EQ. 0) THEN
          CALL PLA283 (0, 1, N, CDUM)
          CALL PLA283 (2, IPR(260), N1, ICL(1:NP52))
        ELSE
          CALL GEN038 (CDUM, 1, NP52)
          CALL GEN038 (ICL,  1, NP52)
          CDUM(NP52:NP52) = '?'
          ICL (NP52:NP52) = '?'
          N  = NP52
          N1 = NP52
        END IF
        DO I = 1, 3
          IFB = 17 + 17 * I
          FBOND(IFB : IFB) = CHAR(ICHAR('0') + IPR(286 + I))
          IFA = 23 + 17 * I
          FANGL(IFA : IFA) = CHAR(ICHAR('0') + IPR(289 + I))
        END DO
        FVOLU(26 : 26) = CHAR(ICHAR('0') + IPR(294))
C * CIF-FILE
        IF (IPR(431) .EQ. -1) THEN
          WRITE (LU, 99281, IOSTAT = IOST) CIFDIR(116)
          WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(113), '?'
          WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(112), '?'
          IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
            WRITE (LU, 99197, IOSTAT = IOST) CIFDIR(107), RLWS(4)(1:79)
          ELSE
            WRITE (LU, 99397, IOSTAT = IOST) CIFDIR(107), CDUM(N:NP52)
          END IF
          WRITE (LU, 99253, IOSTAT = IOST)
          WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(108), '?'
          IF (INDEX (RLWS(5), '?') .EQ. 0) THEN
            WRITE (LU, 99197, IOSTAT = IOST) CIFDIR(109), RLWS(5)(1:79)
          ELSE
            N1 = MAX (5, N1)
            WRITE (LU, 99397, IOSTAT = IOST) CIFDIR(109), CDUM(N1:NP52)
          END IF
          WRITE (LU, 99292, IOSTAT = IOST) CIFDIR(482), '?'
          IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
            WRITE (LU, 99396, IOSTAT = IOST) CIFDIR(110), PAR(308)
          ELSE
            WRITE (LU, 99396, IOSTAT = IOST)
     1        CIFDIR(110), PAR(163) / IPR(260)
          END IF
          WRITE (LU, 99399, IOSTAT = IOST) CIFDIR(94)
          WRITE (LU, 99270, IOSTAT = IOST)
     1      CIFDIR(70), CIFDIR(52), CIFDIR(67), CIFDIR(66), CIFDIR(68)
          IF (IABS(IPR(493)) .LT. 6) THEN
            DO I = 1, IAN
              K = IENS(I)
              IF (NINT(CONT(K, 2) / IPR(260)) .GT. 0) THEN
                WRITE (LU, 99261, IOSTAT = IOST)
     1            LMT(K, 1)(1:2), LMT(K, 1)(1:2),
     2            (ANOM(K, L), L = 1, 2)
                IF (IABS(IPR(493)) .LT. 5) THEN
                  WRITE (LU, 99060, IOSTAT = IOST)
                ELSE
                  WRITE (LU, 99061, IOSTAT = IOST)
                END IF
              END IF
            END DO
          END IF
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99269, IOSTAT = IOST)
          WRITE (LU, 99376, IOSTAT = IOST) CIFDIR(418), KRSYST(2)
          CALL GEN039 (0, SPGRNM(3),  1, 17, K03, K3)
          IF (K03 .GE. K3) THEN
            SPGRNM(3)(1:1) = '?'
            K03 = 1
            K3  = 1
          END IF
          CALL GEN039 (1, SPGRNM(1), 15, 26, K01, K1)
          IF (K01 .GE. K1) SPGRNM(1)(K01:K01) = '?'
          WRITE (LU, 99375, IOSTAT = IOST)
     1      CIFDIR(421), SPGRNM(3)(K03:K3), CIFDIR(422),
     2      SPGRNM(1)(K01:K1), CIFDIR(420), IPR(202)
          WRITE (LU, 99373, IOSTAT = IOST) CIFDIR(480), CIFDIR(419)
          NSYM   = IPR(48)
          XJX(4) = 0.0
          XJX(5) = 0.0
          XJX(6) = 0.0
          DO I = 1, NSYM
            ISYM = I
            CALL SGSM (ICL, ISYM, XJX, 0, 20, IERR)
            CALL GEN020 (-1, ICL, 1, 30)
            WRITE (LU, 99984, IOSTAT = IOST) ISYM, ICL(1:30)
          END DO
          WRITE (LU, 99291, IOSTAT = IOST)
          WRITE (PRBUF, FBOND, IOSTAT = IOST)
     1      PAR(101), IPR(281), PAR(102), IPR(282), PAR(103), IPR(283),
     2      DCHAR
          CALL GEN065 (0, PRBUF, 80, 1)
          WRITE (LU, 99388, IOSTAT = IOST)
     1      CIFDIR(78), PRBUF(36:48), CIFDIR(79), PRBUF(49:61),
     2      CIFDIR(80), PRBUF(62:74)
          WRITE (PRBUF, FANGL, IOSTAT = IOST)
     1      PAR(104), IPR(284), PAR(105), IPR(285), PAR(106), IPR(286),
     2      DCHAR
          CALL GEN065 (0, PRBUF, 80, 3)
          WRITE (LU, 99388, IOSTAT = IOST)
     1      CIFDIR(74), PRBUF(36:48), CIFDIR(75), PRBUF(49:61),
     2      CIFDIR(76), PRBUF(62:74)
          WRITE (PRBUF, FVOLU, IOSTAT = IOST) PAR(98), IPR(293), DCHAR
          CALL GEN065 (0, PRBUF, 80, 1)
          WRITE (LU, 99382, IOSTAT = IOST) CIFDIR(93), PRBUF(62:74)
          IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
            CALL PLA175 (2, LU,  77, '(A, I6)', IPR(276), 0.0)
          ELSE
            CALL PLA175 (2, LU,  77, '(A, I6)', IPR(260), 0.0)
          END IF
          CALL PLA175 (2, LU,  88, '(A, I6)', IPR(261), 0.0)
          IF (IPR(601) .EQ. 0) IPR(601) = 999999
          CALL PLA175 (2, LU,  87, '(A, I6)', IPR(601), 0.0)
          IF (PAR(469) .EQ. 0.0) PAR(469) = 999999.0
          CALL PLA175 (3, LU,  90, '(A, F10.2)', 0, PAR(469))
          IF (PAR(470) .EQ. 0.0) PAR(470) = 999999.0
          CALL PLA175 (3, LU,  89, '(A, F10.2)', 0, PAR(470))
          IF (IPR(399) .EQ. 1) THEN
            WRITE (LU, 99255, IOSTAT = IOST) CIFDIR(92)
          ELSE
            WRITE (LU, 99268, IOSTAT = IOST) CIFDIR(92)
          END IF
          WRITE (LU, 99291, IOSTAT = IOST)
          WRITE (LU, 99243, IOSTAT = IOST)
     1      CIFDIR(239), CCIF(5)(1:NCIF(5)), CIFDIR(234),
     2      CCIF(14)(1:NCIF(14))
          CALL PLA175 (3, LU, 251, '(A, F10.3)', 0, PAR(302))
          CALL PLA175 (3, LU, 252, '(A, F10.3)', 0, PAR(303))
          CALL PLA175 (3, LU, 253, '(A, F10.3)', 0, PAR(304))
          CALL PLA175 (1, LU, 254, ' ?', 0, 0.0)
          CALL PLA175 (3, LU, 236, '(A, F10.3)', 0, PAR(158))
          IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
            CALL PLA175 (3, LU, 235, '(A, F10.3)', 0, PAR(267))
          ELSE
            CALL PLA175 (3, LU, 235, '(A, F10.3)', 0, PAR(160))
          END IF
          CALL PLA175 (1, LU, 238, '''Not Measured''', 0, 0.0)
          CALL PLA175 (2, LU, 240, '(A, I10)', NINT(PAR(157)), 0.0)
          IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
            CALL PLA175 (3, LU, 229, '(A, F10.3)', 0, PAR(301))
          ELSE
            XMUM = PAR(162)
            IF (XMUM .EQ. 0.0) XMUM = -999999.0
            CALL PLA175 (3, LU, 229, '(A, F10.3)', 0, XMUM)
          END IF
          CALL PLA175 (1, LU, 237, ' ?', 0, 0.0)
          IF (IPR(485) .EQ. 4) THEN
            WRITE (LU, 99247, IOSTAT = IOST) CIFDIR(232), CIFDIR(233)
          ELSE
            WRITE (LU, 99244, IOSTAT = IOST)
            WRITE (LU, 99246, IOSTAT = IOST)
     1        CIFDIR(232), CCIF(15)(1:NCIF(15)), CIFDIR(233)
          END IF
          CALL PLA175 (3, LU, 231, '(A, F10.3)', 0, PAR(307))
          CALL PLA175 (3, LU, 230, '(A, F10.3)', 0, PAR(306))
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99266, IOSTAT = IOST)
          WRITE (LU, 99265, IOSTAT = IOST) CIFDIR(256)
          CALL PLA175 (2, LU, 133, '(A, I6)', IPR(310), 0.0)
          CALL PLA175 (3, LU, 164, '(A, F10.5)', 0, PAR(17))
          IF (IABS(IPR(493)) .LT. 6) THEN
            WRITE (LU, 99362, IOSTAT = IOST) CIFDIR(481), 'x-ray'
            IF (IABS(IPR(493)) .LT. 5) THEN
              WRITE (LU, 99362, IOSTAT = IOST)
     1          CIFDIR(163), KRAD(1:3)//CHAR(92)//'a'
            ELSE
              WRITE (LU, 99362, IOSTAT = IOST) CIFDIR(163), '?'
            END IF
          ELSE
            WRITE (LU, 99362, IOSTAT = IOST) CIFDIR(481), 'neutron'
          END IF
          IF (IPR(399) .EQ. 0) THEN
            CALL PLA175 (1, LU, 162, ' ?', 0, 0.0)
            CALL PLA175 (1, LU, 159, ' ?', 0, 0.0)
          ELSE
            WRITE (LU, 99392, IOSTAT = IOST) CIFDIR(162), CIFDIR(159)
          END IF
          WRITE (LU, 99291, IOSTAT = IOST)
          CALL PLA175 (1, LU, 441, ' ?', 0, 0.0)
          CALL PLA175 (1, LU, 137, ' ?', 0, 0.0)
          IF (IPR(399) .EQ. 1) THEN
            CALL PLA175 (3, LU, 463, '(A, F10.1)', 0, 18.4)
          ELSE
            CALL PLA175 (1, LU, 463, ' ?', 0, 0.0)
          END IF
          WRITE (LU, 99291, IOSTAT = IOST)
          WRITE (LU, 99355, IOSTAT = IOST)
          CALL PLA175 (2, LU, 204, '(A, I6)', IPR(262), 0.0)
          CALL PLA175 (3, LU, 196, '(A, F8.4)', 0, PAR(197))
          CALL PLA175 (3, LU, 497, '(A, F8.4)', 0, PAR(198))
          CALL PLA175 (2, LU, 199, '(A, I6)', IPR(267), 0.0)
          CALL PLA175 (2, LU, 198, '(A, I6)', IPR(268), 0.0)
          CALL PLA175 (2, LU, 201, '(A, I6)', IPR(269), 0.0)
          CALL PLA175 (2, LU, 200, '(A, I6)', IPR(270), 0.0)
          CALL PLA175 (2, LU, 203, '(A, I6)', IPR(271), 0.0)
          CALL PLA175 (2, LU, 202, '(A, I6)', IPR(272), 0.0)
          CALL PLA175 (3, LU, 207, '(A, F6.2)', 0, PAR(167))
          CALL PLA175 (3, LU, 206, '(A, F6.2)', 0, PAR(168))
          CALL PLA175 (3, LU, 444, '(A, F6.2)', 0, PAR(312))
          CALL PLA175 (3, LU, 458, '(A, F6.3)', 0, PAR(313))
          CALL PLA175 (3, LU, 459, '(A, F6.3)', 0, PAR(314))
          WRITE (LU, 99351, IOSTAT = IOST) CIFDIR(205)
          WRITE (LU, 99324, IOSTAT = IOST)
          CALL PLA175 (2, LU, 410, '(A, I8)', IPR(263), 0.0)
          WRITE (LU, 99323, IOSTAT = IOST)
          CALL PLA175 (2, LU, 442, '(A, I8)', IPR(264), 0.0)
          IF (CCIF(1)(1:5) .EQ. 'i > 2' .OR.
     1    CCIF(1)(2:3) .EQ. '2s') CCIF(1) = 'I>2'//CHAR(92)//'s(I)'
          WRITE (LU, 99322, IOSTAT = IOST)
     1      CIFDIR(443), CCIF(1)(1:NCIF(1))
          WRITE (LU, 99291, IOSTAT = IOST)
          IF (IPR(399) .EQ. 1) THEN
            WRITE (LU, 99394, IOSTAT = IOST)
     1        CIFDIR(118), CIFDIR(117), CIFDIR(119)
          ELSE
            WRITE (LU, 99393, IOSTAT = IOST)
     1        CIFDIR(118), CIFDIR(117), CIFDIR(119)
          END IF
          WRITE (LU, 99391, IOSTAT = IOST) CIFDIR(123)
          IF (IGBL(133) .EQ. 1) THEN
            WRITE (LU, 99390, IOSTAT = IOST)
     1        CIFDIR(122), ' ''SHELXL-97 (Sheldrick, 1997)'''
          ELSE IF (IGBL(133) .EQ. 2) THEN
            WRITE (LU, 99390, IOSTAT = IOST)
     1        CIFDIR(122), ' ''SHELXL-2014 (Sheldrick, 2014)'''
          ELSE
            WRITE (LU, 99390, IOSTAT = IOST) CIFDIR(122), ' ?'
          END IF
          WRITE (LU, 99264, IOSTAT = IOST) CIFDIR(120)
          WRITE (LU, 99389, IOSTAT = IOST) CIFDIR(121)
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99263, IOSTAT = IOST)
          IF (IGBL(133) .EQ. 0) THEN
            WRITE (LU, 99332, IOSTAT = IOST) CIFDIR(373)
          ELSE IF (IGBL(133) .EQ. 1 .OR. IGBL(133) .EQ. 2) THEN
            WRITE (LU, 99276, IOSTAT = IOST) CIFDIR(373)
          ELSE IF (IGBL(133) .EQ. 3) THEN
            WRITE (LU, 99332, IOSTAT = IOST) CIFDIR(373)
          ELSE IF (IGBL(133) .EQ. 4) THEN
            WRITE (LU, 99332, IOSTAT = IOST) CIFDIR(373)
          ELSE IF (IGBL(133) .EQ. 5) THEN
            WRITE (LU, 99332, IOSTAT = IOST) CIFDIR(373)
          END IF
          WRITE (LU, 99348, IOSTAT = IOST)
     1      CIFDIR(369), CCIF(2)(1:NCIF(2))
          WRITE (LU, 99347, IOSTAT = IOST)
     1      CIFDIR(358), CCIF(3)(1:NCIF(3))
          WRITE (LU, 99344, IOSTAT = IOST)
     1      CIFDIR(370), CCIF(9)(1:NCIF(9))
          WRITE (LU, 99342, IOSTAT = IOST) CIFDIR(451), RLWS(1)
          IF (IPR(484) .LE. 0) THEN
            CCIF(12) = ' .'
            CCIF(13) = ' .'
            NCIF(12) = 2
            NCIF(13) = 2
          END IF
          WRITE (LU, 99345, IOSTAT = IOST)
     1      CIFDIR(48),  CCIF(10)(1:NCIF(10)), CIFDIR(49),
     2      CCIF(11)(1:NCIF(11)), CIFDIR(50),  CCIF(12)(1:NCIF(12))
          WRITE (LU, 99301, IOSTAT = IOST)
     1      CIFDIR(357), CCIF(13)(1:NCIF(13))
          WRITE (LU, 99344, IOSTAT = IOST)
     1      CIFDIR(354), CCIF(4)(1:NCIF(4))
          IF (CCIF(4)(1:4) .NE. 'none') THEN
            IF (PAR(229) .LT. -999990) THEN
              PRBUF(1:1) = '?'
              CALL GEN038 (PRBUF, 2, 20)
            ELSE
              FPARSU(6:6) = CHAR(ICHAR('0') + IPR(278))
              WRITE (PRBUF, FPARSU, IOSTAT = IOST) PAR(229), IPR(277)
              CALL GEN065 (0, PRBUF, 80, 1)
            END IF
            WRITE (LU, 99981, IOSTAT = IOST) CIFDIR(352), PRBUF(1:20)
            WRITE (LU, 99342, IOSTAT = IOST) CIFDIR(353), RLWS(2)
          END IF
          IF (IPR(275) .EQ. 2) THEN
            WRITE (LU, 99341, IOSTAT = IOST) CIFDIR(349), CIFDIR(350)
          ELSE
            WRITE (LU, 99254, IOSTAT = IOST) CIFDIR(349)
            IF (PAR(433) .LT. 999999.0) THEN
              FPARSU(6:6) = CHAR(ICHAR('0') + IPR(280))
              WRITE (PRBUF, FPARSU, IOSTAT = IOST) PAR(433), IPR(279)
              CALL GEN065 (0, PRBUF, 80, 1)
              WRITE (LU, 99981, IOSTAT = IOST) CIFDIR(350), PRBUF(1:20)
            ELSE
              CALL PLA175 (1, LU, 350, ' ?', 0, 0.0)
            END IF
            WRITE (LU, 99059, IOSTAT = IOST)
     1        CIFDIR(478), CCIF(17)(1:NCIF(17))
          END IF
          CALL PLA175 (2, LU, 361, '(A, I10)', IPR(265), 0.0)
          CALL PLA175 (2, LU, 360, '(A, I10)', IPR(266), 0.0)
          CALL PLA175 (2, LU, 362, '(A, I10)', IPR(273), 0.0)
          CALL PLA175 (1, LU, 359, ' ?', 0, 0.0)
          CALL PLA175 (3, LU, 363, '(A, F10.4)', 0, PAR(309))
          CALL PLA175 (3, LU, 445, '(A, F10.4)', 0, PAR(173))
          CALL PLA175 (3, LU, 446, '(A, F10.4)', 0, PAR(174))
          CALL PLA175 (3, LU, 460, '(A, F10.4)', 0, PAR(310))
          CALL PLA175 (3, LU, 447, '(A, F10.3)', 0, PAR(299))
          CALL PLA175 (3, LU, 365, '(A, F10.3)', 0, PAR(300))
          CALL PLA175 (3, LU, 448, '(A, F10.3)', 0, PAR(178))
          CALL PLA175 (3, LU, 461, '(A, F10.3)', 0, PAR(179))
          CALL PLA175 (3, LU, 347, '(A, F10.3)', 0, PAR(177))
          CALL PLA175 (3, LU, 348, '(A, F10.3)', 0, PAR(176))
          CALL PLA175 (3, LU, 462, '(A, F10.3)', 0, PAR(175))
          WRITE (LU, 99295, IOSTAT = IOST)
          WRITE (LU, 99262, IOSTAT = IOST)
        END IF
C * CRYSTAL DATA TABLE  (INCLH = 0: PARTIAL, = 1 : FULL)
        IF (IPR(431) .GE. 0) THEN
          IF (IPR(431) .EQ. 0) THEN
            CALL PLA262 (0)
          ELSE IF (IPR(431) .EQ. 1) THEN
            IGBL(85) = IGBL(85) + 1
            WRITE (LU, 99982, IOSTAT = IOST) CHAR(12), IGBL(85)
          END IF
          IF (INCLH .EQ. 0) THEN
            WRITE (LU, 99978, IOSTAT = IOST)
     1        CTAB, NTAB, DCHAR, JID(1:40), DCHAR
          ELSE
            CALL PLA176 (-1, LU, CTAB, NTAB, FORMCD, JID)
          END IF
          IF (INCLH .GT. 0) WRITE (LU, 99977, IOSTAT = IOST)
          IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
            N2 = INDEX(RLWS(4), CHAR(39))
            CALL GEN038 (PRBUF, 1, 80)
            IF (N2 .GT. 1 .AND. N2 .LT. 59) THEN
              WRITE (LU, 99976, IOSTAT = IOST)
     1          PRBUF(1:59-N2)//RLWS(4)(1:N2-1), DCHAR
            ELSE
              WRITE (LU, 99976, IOSTAT = IOST) PRBUF(1:57)//'?', DCHAR
            END IF
            WRITE (LU, 99975, IOSTAT = IOST) PAR(308), DCHAR
          ELSE
            WRITE (LU, 99976, IOSTAT = IOST)
     1        CDUM(NP52 - 57: NP52), DCHAR
            WRITE (LU, 99975, IOSTAT = IOST) PAR(163) / IPR(260), DCHAR
          END IF
          IF (INCLH .GT. 0)
     1      WRITE (LU, 99974, IOSTAT = IOST) KRSYST(2), DCHAR
          WRITE (LU, 99973, IOSTAT = IOST)
     1      SPGRNM(1)(1:7), SPGRNM(1)(8:11), IPR(202), DCHAR
          WRITE (PRBUF, FBOND, IOSTAT = IOST)
     1      PAR(101), IPR(281), PAR(102), IPR(282), PAR(103), IPR(283),
     2      DCHAR
          CALL GEN065 (LU, PRBUF, 80, 1)
          WRITE (PRBUF, FANGL, IOSTAT = IOST)
     1      PAR(104), IPR(284), PAR(105), IPR(285), PAR(106), IPR(286),
     2      DCHAR
          IF (INDEX (KRSYST(2), 'tri') .NE. 0 .OR.
     1        INDEX (KRSYST(2), 'mon') .NE. 0) THEN
            CALL GEN065 (LU, PRBUF, 80, 3)
          END IF
          WRITE (PRBUF, FVOLU, IOSTAT = IOST) PAR(98), IPR(293), DCHAR
          CALL GEN065 (LU, PRBUF, 80, 1)
          IF (INDEX (RLWS(4), '?') .EQ. 0) THEN
            WRITE (LU, 99970, IOSTAT = IOST) IPR(276), DCHAR
            IF (PAR(158) .LT. 10000.0) THEN
              WRITE (LU, 99969, IOSTAT = IOST) PAR(158), PAR(267), DCHAR
            ELSE
              WRITE (LU, 99948, IOSTAT = IOST) PAR(160), DCHAR
            END IF
            WRITE (LU, 99967, IOSTAT = IOST) KRAD, PAR(301), DCHAR
          ELSE
            WRITE (LU, 99970, IOSTAT = IOST) IPR(260), DCHAR
            IF (PAR(158) .LT. 10000.0) THEN
              WRITE (LU, 99969, IOSTAT = IOST)
     1          PAR(158), PAR(160), DCHAR
            ELSE
              WRITE (LU, 99948, IOSTAT = IOST) PAR(160), DCHAR
            END IF
            WRITE (LU, 99967, IOSTAT = IOST) KRAD, PAR(162), DCHAR
          END IF
          IF (INCLH .GT. 0)
     1      WRITE (LU, 99968, IOSTAT = IOST) NINT(PAR(157)), DCHAR
          IF (INCLH .GT. 0) THEN
            WRITE (LU, 99966, IOSTAT = IOST)
     1        MAX (0.0, PAR(304)), MAX(0.0, PAR(303)),
     2        MAX (0.0, PAR(302)), DCHAR
            WRITE (LU, 99965, IOSTAT = IOST)
          END IF
          WRITE (LU, 99964, IOSTAT = IOST) IPR(261), DCHAR
          WRITE (LU, 99963, IOSTAT = IOST)
     1      KRAD, MAX (0.0, PAR(17)), DCHAR
          IF (INCLH .GT. 0) THEN
            WRITE (LU, 99962, IOSTAT = IOST)
     1        MAX (0.0, PAR(167)), MAX(0.0, PAR(168)), DCHAR
            WRITE (LU, 99957, IOSTAT = IOST)
     1            (MIN(999, MAX (-99, IPR(I))), I = 267, 272), DCHAR
            WRITE (LU, 99956, IOSTAT = IOST)
     1        MAX (0, IPR(262)), MAX(0, IPR(263)),
     2        MAX (0.0, PAR(197)), DCHAR
            IF (IGBL(133) .EQ. 1 .OR. IGBL(133) .EQ. 2 .OR.
     1        IGBL(133) .EQ. 7) PAR(180) = 2.0
            WRITE (LU, 99955, IOSTAT = IOST)
     1        PAR(180), MAX (0, IPR(264)), DCHAR
            WRITE (LU, 99954, IOSTAT = IOST)
            WRITE (LU, 99953, IOSTAT = IOST)
     1        MAX (0, IPR(265)), MAX (0, IPR(266)), DCHAR
          END IF
          WRITE (LU, 99952, IOSTAT = IOST)
     1      MAX (0.0, PAR(173)), MAX (0.0, PAR(174)),
     2      MAX (0.0, PAR(299)), DCHAR
          IF (INCLH .GT. 0) THEN
            WRITE (LU, 99951, IOSTAT = IOST) RLWS(1)(9:70), DCHAR
            WRITE (LU, 99950, IOSTAT = IOST)
     1        MAX (0.0, PAR(178)), MAX (0.0, PAR(179)), DCHAR
            IF (PAR(433) .LT. 999999.0) THEN
              FPARSU(6:6) = CHAR(ICHAR('0') + IPR(280))
              WRITE (PRBUF, FPARSU, IOSTAT = IOST) PAR(433), IPR(279)
              CALL GEN065 (0, PRBUF, 80, 1)
              WRITE (LU, 99947, IOSTAT = IOST) PRBUF(1:14), DCHAR
            END IF
            WRITE (LU, 99949, IOSTAT = IOST)
     1        MIN (0.0, PAR(176)), MAX (0.0, PAR(177))
          END IF
        END IF
      ELSE IF (MODE .LT. 4) THEN
        IF (IPR(431) .EQ. 1) THEN
          IGBL(85) = IGBL(85) + 1
          WRITE (LU, 99982, IOSTAT = IOST) CHAR(12), IGBL(85)
        END IF
C * MODE = 1  - COORDINATES AND (AN)ISOTROPIC DISPLACEMENT PARAMETERS
        IF (MODE .EQ. 1) THEN
C * CIF - COORDINATES + (AN)ISO
          IF (IPR(431) .EQ. -1) THEN
            WRITE (LU, 99499, IOSTAT = IOST)
     1        CIFDIR(22), CIFDIR(35),  CIFDIR(34), CIFDIR(19),
     2        CIFDIR(20),  CIFDIR(21), CIFDIR(30), CIFDIR(36),
     3        CIFDIR(11),  CIFDIR(31), CIFDIR(450), CIFDIR(18)
          ELSE
            CALL PLA176 (-1, LU, CTAB, NTAB, FORMNH, JID)
            WRITE (LU, 99998, IOSTAT = IOST)
          END IF
C * MODE =  2 - H-ATOM COORDINATES
        ELSE IF (MODE .EQ. 2) THEN
          IF (IPR(431) .EQ. 1) THEN
            CALL PLA176 (-1, LU, CTAB, NTAB, FORMHC, JID)
            WRITE (LU, 99995, IOSTAT = IOST)
          END IF
C * MODE =  3 - DISPLACEMENT PARAMETERS
        ELSE IF (MODE .EQ. 3) THEN
          IF (IPR(431) .EQ. -1) THEN
            WRITE (LU, 99799, IOSTAT = IOST)
     1      CIFDIR(1), CIFDIR(3),  CIFDIR(6), CIFDIR(8),  CIFDIR(7),
     2      CIFDIR(5), CIFDIR(4)
          ELSE
            CALL PLA176 (-1, LU, CTAB, NTAB, FORMAN, JID)
            WRITE (LU, 99997, IOSTAT = IOST)
          END IF
        END IF
        ITEL = LSTART
        NAT  = IPR(226)
        IF (IPR(240) .EQ. 0) THEN
          NRO = 0
        ELSE
          NRO = 1
        END IF
        NDISO = 0
        DO 10 I = 1, NAT
          DISOR = ' '
          NR = JNSC(1, I) / IPR(466)
          N4 = JNSC(2, I)
          N1 = N4 / 16
          N4 = N4 - N1 * 15 - 1
          N1 = N1 + 1
          N2 = N1 + 2
          N3 = N1 + 4
          IF (IPR(431) .EQ. -1) N2 = N2 + 1
          IF (N4 .NE. N3) THEN
            UTYPE = 'Uani '
            IF (MODE .EQ. 3) THEN
              N4 = N4 - 1
            ELSE
              N3 = N4
            END IF
          ELSE
            UTYPE = 'Uiso '
          END IF
          IF (MODE .EQ. 3 .AND. N4 .EQ. N3) GO TO 10
          JLABN = LABB(NINT(VOID(N1 - 1)))
          CALL PLA047 (JLABN, NQ1, IDUM, IENR, IPR(71),
     1                 IGBL(55), 0, 1)
          N = IEL(IENR)
          M = N / 100
          SCTYP = CHAR (ICHAR('A') + M - 1)//'  '
          N = N - M * 100
          IF (N .GT. 0) SCTYP(2 : 2) = CHAR (ICHAR('a') + N - 1)
          IF (IENR .EQ. 1 .OR. IENR .EQ. 33 .OR. IENR .EQ. 113) THEN
            IF (MODE .EQ. 1) GO TO 10
          ELSE
            IF (MODE .EQ. 2) GO TO 10
          END IF
          N   =  0
          IPS = -4
          FORMC(5 : 5) = '2'
          IF (IPR(431) .EQ. -1) THEN
            FORMC(2 : 2) = '1'
          ELSE
            FORMC(2 : 2) = '3'
          END IF
          IF (MODE .LT. 3) THEN
            IF (IPR(431) .EQ. -1) THEN
              FORMC(2 : 2) = '1'
              FORMC(5 : 5) = '3'
            ELSE
              FORMC(2 : 2) = '7'
              FORMC(5 : 5) = '2'
            END IF
            IF (VOID(N2 + 1) .LT. 1.0) THEN
              DISOR = '*'
              NDISO = NDISO + 1
            END IF
            DO M = N1, N2
              N         = N + 1
              IPS   = IPS + 16
              IF (M - N1 .EQ. 3) THEN
                FORMC(IPS - 2 : IPS - 2) = '6'
                MDEC = 3
              ELSE
                FORMC(IPS - 2 : IPS - 2) = '9'
                MDEC = MIN (IPR(183), 5)
              END IF
              STDV = MAX (0.0, VOID(IPR(245) + M))
              CALL GEN041 (VOID(M), STDV, ISDV(N), MDEC, IDEC, IPR(68))
              FORMC(IPS : IPS) = CHAR(ICHAR('0') + IDEC)
              DEV(N)  = VOID(M)
            END DO
          END IF
C * UEQ, U OR UIJ
          DO M = N3, N4
            N    = N + 1
            STDV = MAX (0.0, VOID(IPR(245) + M))
            CALL GEN041 (VOID(M), STDV, ISDV(N), 4, IDEC, IPR(68))
            IPS   = IPS + 16
            IF (MODE .EQ. 3) THEN
              IF (IPR(431) .EQ. -1 .AND. IPS .GE. 60) THEN
                FORMC(IPS - 2 : IPS - 2) = '8'
              ELSE
                FORMC(IPS - 2 : IPS - 2) = '7'
              END IF
            END IF
            FORMC(IPS : IPS) = CHAR(ICHAR('0') + IDEC)
            DEV(N) = VOID(M)
          END DO
          IF (IPR(431) .EQ. 1) THEN
            ITEL = ITEL + 1
            IF (NR .GT. NRO) THEN
              ITEL = ITEL + 1
              NRO  = NR
              WRITE (LU, 99985, IOSTAT = IOST)
              IF (IDOUBL .EQ. 2) WRITE (LU, 99985, IOSTAT = IOST)
            END IF
            IF (ITEL .GT. MXLIN) THEN
              ITEL = LSTART + 1
              IGBL(85) = IGBL(85) + 1
              WRITE (LU, 99982, IOSTAT = IOST) CHAR(12), IGBL(85)
              IF (MODE .EQ. 1) THEN
                CALL PLA176 (1, LU, CTAB, NTAB, FORMNH, JID)
                WRITE (LU, 99998, IOSTAT = IOST)
              ELSE IF (MODE .EQ. 2) THEN
                CALL PLA176 (1, LU, CTAB, NTAB, FORMHC, JID)
                WRITE (LU, 99995, IOSTAT = IOST)
              ELSE IF (MODE .EQ. 3) THEN
                CALL PLA176 (1, LU, CTAB, NTAB, FORMAN, JID)
                WRITE (LU, 99997, IOSTAT = IOST)
              END IF
            END IF
          END IF
          IF (IPR(431) .EQ. -1) THEN
            IF (MODE .EQ. 1 .OR. MODE .EQ. 2) THEN
              ASCF = '. .   . .  '
              NQ4  = NQ1
              CALL PLA046 (2, NQ4, IX, LBB, LBC, LBD, INQNR, JNQNR, NR)
              IF (NR .GT. 0) THEN
                CALL GEN048 (-1, IFG(3, NR), 1, IVL)
                IF (IVL .GT. 0) ASCF(1:1) = 'd'
                CALL GEN048 (-1, IFG(3, NR), 2, IVL)
                IF (IVL .GT. 0) ASCF(1:1) = 'c'
                K = 2
                DO J = 4, 10
                  IF (K .LT. 5) THEN
                    CALL GEN048 (-1, IFG(3, NR), J, IVL)
                    IF (IVL .NE. 0) THEN
                      K = K + 1
                      ASCF(K:K) = CVLAG(J - 3)
                    END IF
                  END IF
                END DO
                CALL GEN048 (-1, IFG(3, NR), 11, IVL)
                IF (IVL .GT. 0) ASCF(7:7) = 'A'
                CALL GEN048 (-1, IFG(3, NR), 12, IVL)
                IF (IVL .GT. 0) ASCF(7:7) = 'B'
                CALL GEN048 (-1, IFG(3, NR), 13, IVL)
                IF (IVL .GT. 0) ASCF(7:7) = 'S'
                CALL GEN048 (-5, IFG(3, NR), 14, IVL)
                IF (IVL .NE. 16) THEN
                  WRITE (ASCF(9:11), '(I3)', IOSTAT = IOST) IVL - 16
                END IF
              END IF
              WRITE (PRBUF, FORMC, IOSTAT = IOST) NQ1, SCTYP, UTYPE,
     1          (DEV(M), ISDV(M), M = 1, N)
              PRBUF(82:) = ASCF
            ELSE IF (MODE .EQ. 3) THEN
              WRITE (PRBUF, FORMC, IOSTAT = IOST) DISOR, NQ1,
     1          (DEV(M), ISDV(M), M = 1, N)
            END IF
            CALL GEN065 (0, PRBUF, 92, 1)
            CALL GEN103 (PRBUF, 92)
            WRITE (LU, 99983, IOSTAT = IOST) PRBUF(1:80)
          ELSE
            WRITE (PRBUF, FORMC, IOSTAT = IOST) DISOR, NQ1,
     1          (DEV(M), ISDV(M), M = 1, N)
            CALL GEN065 (LU, PRBUF, 80, 3)
            IF (IDOUBL .EQ. 2) WRITE (LU, 99985, IOSTAT = IOST)
          END IF
   10   CONTINUE
        IF (IPR(431) .EQ. 1) THEN
          IF (MODE .EQ. 1) THEN
            WRITE (LU, 99993, IOSTAT = IOST)
            IF (NDISO .GT. 0) WRITE (LU, 99996, IOSTAT = IOST)
          ELSE IF (MODE .EQ. 2) THEN
            WRITE (LU, 99989, IOSTAT = IOST)
            WRITE (LU, 99988, IOSTAT = IOST)
            WRITE (LU, 99987, IOSTAT = IOST)
          ELSE IF (MODE .EQ. 3) THEN
            WRITE (LU, 99989, IOSTAT = IOST)
            WRITE (LU, 99988, IOSTAT = IOST)
            WRITE (LU, 99987, IOSTAT = IOST)
            WRITE (LU, 99986, IOSTAT = IOST)
          END IF
        END IF
C * BOND TABLE
      ELSE IF (MODE .EQ. 4) THEN
        CALL PLA174 (MODE, FORMB, FORMHB, LU, CTAB, NTAB, MXLIN,
     1    LSTART, NCOL, INCLH, 33, 11, 4, IDOUBL)
C * ANGLE TABLE
      ELSE IF (MODE .EQ. 5) THEN
        CALL PLA174 (MODE, FORMA, FORMHA, LU, CTAB, NTAB, MXLIN,
     1    LSTART, NCOL, INCLH, 39, 11, 2, IDOUBL)
C * TORSION TABLE
      ELSE IF (MODE .EQ. 6) THEN
        CALL PLA174 (MODE, FORMT, FORMHT, LU, CTAB, NTAB, MXLIN,
     1    LSTART, NCOL, INCLH, 42, 0, 2, IDOUBL)
C * INTER-CONTACTS
      ELSE IF (MODE .EQ. 7 .AND. IPR(431) .EQ. 1) THEN
        CALL PLA174 (MODE, FORMB, FORMNB, LU, CTAB, NTAB, MXLIN,
     1    LSTART, NCOL, INCLH, 33, 11, 4, IDOUBL)
C * H-BONDS
      ELSE IF (MODE .EQ. 8) THEN
        CALL PLA174 (MODE, FORHBF, FORMBH, LU, CTAB, NTAB, MXLIN,
     1    LSTART, NCOL, INCLH, 42, 0, 4, IDOUBL)
C * FINISH
      ELSE IF (MODE .EQ. 9) THEN
        IF (IPR(431) .EQ. 1) THEN
          IGBL(85) = IGBL(85) + 1
          WRITE (LU, 99982, IOSTAT = IOST) CHAR(12), IGBL(85)
          WRITE (LU, 99249, IOSTAT = IOST)
          CALL PLA043 (0, -1, LU, 0)
        END IF
        IF (IPR(431) .EQ. -1) THEN
          WRITE (LU, 99001, IOSTAT = IOST)
          WRITE (LU, 99002, IOSTAT = IOST)
          WRITE (LU, 99003, IOSTAT = IOST)
          WRITE (LU, 99004, IOSTAT = IOST)
          WRITE (LU, 99005, IOSTAT = IOST)
          WRITE (LU, 99006, IOSTAT = IOST)
          WRITE (LU, 99007, IOSTAT = IOST)
          WRITE (LU, 99994, IOSTAT = IOST) CIFDIR(513)
          WRITE (LU, 99260, IOSTAT = IOST)
        END IF
      END IF
      RETURN
99999 FORMAT (
     1 8X,  A, ' : ', A, ////,
     2 17X, 43('='), /,
     3 17X, 'S U P P L E M E N T A R Y   M A T E R I A L', /,
     4 17X, 43('='), //,
     2 17X, 'B E L O N G I N G   TO   T H E   P A P E R', /////////,
     3 35X, 'b y', //////////,
     4 29X, 'C o n t e n t s', /, 29X, 15('='), /)
99998 FORMAT (8X, 'Atom', 10X, 'x', 12X, 'y', 12X, 'z', 6X,
     1 'U(eq) [Ang^2]', /, 8X, '----', 4X, 3(5X, '---', 5X),
     2  11('-'), /)
99997 FORMAT (4X, 'Atom', 4X, 'U(1,1) or U',
     1 2X, 'U(2,2)', 5X, 'U(3,3)', 5X, 'U(2,3)', 5X, 'U(1,3)',
     2 5X, 'U(1,2)', /, 4X, '----',  6X, 6('------',5X))
99996 FORMAT (/, 11X, 'Starred Atom sites have a S.O.F less ',
     1 'than 1.0')
99995 FORMAT (8X, 'Atom', 10X, 'x', 12X, 'y', 12X, 'z', 5X,
     1 'U(iso) [Ang^2]', /, 8X, '----', 4X, 3(5X, '---', 5X), 11('-'))
99994 FORMAT (A, 2(/, ';'))
99993 FORMAT (/, 10X,
     1 'U(eq) = 1/3 of the trace of the orthogonalized U Tensor')
99989 FORMAT (/, 11X, 55('='), /)
99988 FORMAT (9X,'The Temperature Factor has the Form of Exp(-T) Where')
99987 FORMAT (8X,'T = 8*(Pi**2)*U*(Sin(Theta)/Lambda)**2  for Isotr',
     1 'opic Atoms')
99986 FORMAT (8X, 'T = 2*(Pi**2)*Sumij(h(i)*h(j)*U(i,j)*Astar(i)*Astar',
     1 '(j)), for', /, 6X, 'Anisotropic Atoms. Astar(i) are Reciprocal',
     2 ' Axial Lengths and', /, 10X, 'h(i) are the Reflection Indices.')
99985 FORMAT (1X)
99984 FORMAT (I4, 1X, A)
99983 FORMAT (A)
99982 FORMAT (A, 35X, '-', I3, ' -', /)
99981 FORMAT (A, 2X, A)
99978 FORMAT (8X, 'Table ', A, I2, ' - Crystallographic Data', /, A,
     1        19X, 'for: ', A, /, A)
99977 FORMAT (35X, 'Crystal Data', /)
99976 FORMAT (8X, 'Formula', 1X, A, A)
99975 FORMAT (8X, 'Formula Weight', 43X, F9.2, A)
99974 FORMAT (8X, 'Crystal System', 40X, A, A)
99973 FORMAT (8X, 'Space group', 34X, A, 1X, A, ' (No.', I3, ')', A)
99970 FORMAT (8X, 'Z', 60X, I5, A)
99969 FORMAT (8X, 'D(obs), D(calc) [g/cm**3]', 29X, F5.3, ', ', F5.3, A)
99968 FORMAT (8X, 'F(000)', 52X, I8, A)
99967 FORMAT (8X, 'Mu(', A, ') [ /mm ]', 43X, F7.3, A)
99966 FORMAT (8X, 'Crystal Size [mm]', 27X, 2(F6.2, ' x'), F6.2, A)
99965 FORMAT (31X, 'Data Collection', /)
99964 FORMAT (8X, 'Temperature (K)',46X, I5, A)
99963 FORMAT (8X, 'Radiation [Angstrom]', 29X, A, 5X, F8.5, A)
99962 FORMAT (8X, 'Theta Min-Max [Deg]', 35X, F5.1, ',', 1X, F5.1, A)
99957 FORMAT (8X, 'Dataset', 32X, I3, ':', I3, ' ;', I4, ':', I3,
     1            ' ;', I4, ':', I3, A)
99956 FORMAT (8X, 'Tot., Uniq. Data, R(int)', 20X, I6, ', ', I6,
     1        ', ', F6.3, A)
99955 FORMAT (8X, 'Observed Data [I > ', F3.1, ' sigma(I)]', 26X, I8, A)
99954 FORMAT (34X, 'Refinement', /)
99953 FORMAT (8X, 'Nref, Npar', 45X, I5, ',', I5, A)
99952 FORMAT (8X, 'R, wR2, S', 36X, F7.4, ',', F7.4, ',', F5.2, A)
99951 FORMAT (8X, 'w = ', A, A)
99950 FORMAT (8X, 'Max. and Av. Shift/Error', 31X, F5.2, ',', F5.2, A)
99949 FORMAT (8X, 'Min. and Max. Resd. Dens. [e/Ang^3]', 20X,
     1        F5.2, ',', F5.2)
99948 FORMAT (8X, 'D(calc) [g/cm**3]', 44X, F5.3, A)
99947 FORMAT (8X, 'Flack x', 45X, A, A)
99799 FORMAT (/, 'loop_', 7(/, A))
99499 FORMAT (/, 'loop_', 12(/, A))
99399 FORMAT (A, '''see text''')
99397 FORMAT (A, /, '''', A, '''')
99197 FORMAT (A, /, '''', A)
99396 FORMAT (A, F10.2)
99394 FORMAT (A, ' ?', /, A, ' ?', /, A, ' ?')
99393 FORMAT (A, ' ?', /, A, ' ?', /, A, ' ?')
99392 FORMAT (A, ' ?', /, A, ' ?')
99391 FORMAT (A, ' ?')
99390 FORMAT (A, A)
99389 FORMAT (A, ' ''PLATON (Spek, 2003)'' ')
99388 FORMAT (A, 1X, A, /, A, 1X, A, /, A, 1X, A)
99382 FORMAT (A, 1X, A)
99376 FORMAT (A, 1X, A)
99375 FORMAT (A, 1X, '''', A, '''', /, A, 1X, '''', A, '''', /, A, I10)
99373 FORMAT (/, 'loop_', 2(/, A))
99362 FORMAT (A, 1X, '''', A, '''')
99355 FORMAT ('# number of measured reflections (redundant set)')
99351 FORMAT (A, /, ';', /, ';')
99348 FORMAT (A, 1X, A)
99347 FORMAT (A, 1X, A)
99345 FORMAT (3(A, '''', A, '''', /))
99344 FORMAT (A, 1X, '''', A, '''')
99342 FORMAT (A, /, A)
99341 FORMAT (A, ' ?', /, A, '.')
99332 FORMAT (A, ' ?')
99324 FORMAT (/, '# number of unique reflections')
99323 FORMAT ('# number of observed reflections (> n sig(I))')
99322 FORMAT (A, 1X, A)
99300 FORMAT ('# CIF-file generated for ', A, /)
99299 FORMAT ('#', 78('='))
99298 FORMAT ('data_', A)
99297 FORMAT (/, '# 0. AUDIT DETAILS', /)
99296 FORMAT (A, 1X, '''',A, '''', /,
     2        A, ' ''PLATON <TABLE ', A, '> option'' ', /,
     3        A, /, ';', /, ';')
99295 FORMAT (/, '#', 79('='), /)
99294 FORMAT ('# 1. SUBMISSION DETAILS', /)
99293 FORMAT ('# Name of author for correspondence', /, A,
     1        /, ';', / ';', /,
     2        '# address of author for correspondence', /, A,
     3        /, ';', /, ';', /)
99292 FORMAT (A, 1X, A)
99291 FORMAT (1X)
99290 FORMAT (A, ' ''Acta Crystallographica C'' ', /,
     1 '# Publication choise FI, CI or EI for Inorganic', /,
     2 '#                    FM, CM or EM for Metal-organic', /,
     3 '#                    FO, CO or EO for Organic', /, A, ' ?')
99289 FORMAT (A, '# Include date of submission', /, ';', /,
     1 'Date of submission ?', //,
     2 'Please consider this CIF submission for publication as a', /,
     3 'Regular Structural Paper in Acta Crystallographica C. ', /, ';')
99288 FORMAT ('# 2. PROCESSING SUMMARY (JOURNAL OFFICE ONLY)', /)
99287 FORMAT (A, ' ?', //, 3(A, ' ?', /), /, 4(A, ' ?', /), /,
     1        2(A, ' ?', /), A, /, ';', /, ';', //, A, ' ?', /,
     2        A, /, ';', /, ';', //, 7(A, ' ?', /), //,
     3        2(A, ' ?', /))
99286 FORMAT ('# 3. TITLE AND AUTHOR LIST', /)
99285 FORMAT (A, /, ';', /, ';', /,
     1        A, /, ';', /, ';')
99284 FORMAT (/, '# The loop structure below should contain the ',
     1        'names and adresses of all', /, '# authors, in the ',
     2        'required order of publication. Repeat as necessary.', /)
99283 FORMAT (/, 'loop_', 3(/, A), /, '''?'' # author name',
     1        /, ';   # author related footnote', /, ';',
     2        /, ';   # Address of this author', /, ';')
99282 FORMAT ('# 4. TEXT', /)
99281 FORMAT (A, /, ';', /, ';')
99280 FORMAT ('# 5. CHEMICAL DATA', /)
99279 FORMAT ('   ''Spek, Anthony L.''', /,
     1        ';  # author related footnote', /, ';')
99278 FORMAT (A, '# Name  of author for correspondence',
     1        /, ';   Prof. Dr. A.L. Spek', /, ';', /,
     2        A, '# Address of author for correspondence')
99277 FORMAT (';   Bijvoet Center for Biomolecular Research', /,
     1        '    Crystal and Structural Chemistry', /,
     2        '    Utrecht University', /,
     3        '    Padualaan 8', /,
     4        '    3584 CH Utrecht', /,
     5        '    The Netherlands', /, ';')
99276 FORMAT (A, /, ';', /,
     1      ' Refinement on F^2^ for ALL reflections except those', /
     2    , ' flagged by the user for potential systematic errors.',
     3   /, ' Weighted R-factors wR and all goodnesses of fit S', /,
     4      ' are based on F^2^, conventional R-factors R are based',
     5   /, ' on F, with F set to zero for negative F^2^. The', /,
     6      ' observed criterion of F^2^ > 2sigma(F^2^) is used only',
     7   /, ' for calculating -R-factor-obs etc. and is not', /,
     8      ' relevant to the choice of reflections for refinement.'
     9 , /, ' R-factors based on F^2^ are statistically about twice',
     *   /, ' as large as those based on F, and R-factors based on',
     1   /, ' ALL data will be even larger.', /, ';')
99274 FORMAT (A, /, ';', /, 'This work wassupported in part (ALS) ',
     1        'by the Council for the Chemical', /, 'Sciences of the ',
     2        'Netherlands Organization for Scientific Research ',
     3        '(CW-NWO).', /, ';')
99270 FORMAT (/, 'loop_', 5(/, A))
99269 FORMAT ('# 6. CRYSTAL DATA', /)
99268 FORMAT (A, /, ';', /, ';')
99266 FORMAT ('# 7. EXPERIMENTAL DATA', /)
99265 FORMAT (A, /, ';', /, ';')
99264 FORMAT (A, ' ?')
99263 FORMAT ('# 8. REFINEMENT DATA', /)
99262 FORMAT ('# 9. ATOMIC COORDINATES AND DISPLACEMENT PARAMETERS')
99261 FORMAT (A, 2X, A, 2F10.4)
99260 FORMAT (/, '#===END')
99259 FORMAT (A, /, ';', /, ' Allen, F.H. (2002).', /,
     1 '   Acta Cryst. B58, 380-388.', //,
     2 ' Altomare, A., Burla, M.C., Camalli, M., Cascarano, G.L.,',
     3 ' Giacovazzo, C.', /, '   Guagliardi, A., Moliterni, A.G.G.,',
     4 ' Polidori, G. & Spagna, R.', /,
     5 '   (1999) J. Appl. Cryst. 32, 115-119.', //,
     6 ' Beurskens, P.T., Beurskens, G., de Gelder, R.,',
     7 ' Garc', A, A, 'ia-Granda, S.,', /, ' Gould, R.O., Israel, R.',
     8 ' & Smits, J.M.M. (1999) The DIRDIF99 Program System,', /,
     9 '   Technical Report of the Crystallography Laboratory,', /,
     1 '   University of Nijmegen, The Netherlands.', //,
     2 ' Boer, J.L. de & Duisenberg, A.J.M. (1984). Acta Cryst.',
     3 ' A40, C-410.', //,
     4 ' Boeyens, J.C.A. (1978). J.Cryst.Mol.Struct. 8, 317-320.', //,
     5 ' Cremer, D. & Pople, J.A. (1975). J. Am. Chem. Soc. 97,',
     6 ' 1354-1358.', //,
     7 ' Duisenberg, A.J.M. (1992). J. Appl. Cryst. 25, 92-96.', /)
99258 FORMAT (' Duisenberg, A.J.M., Kroon-Batenburg, L.M.J. &',
     1 ' Schreurs, A.M.M. (2003).', /,
     2 '   J. Appl. Cryst. 36, 220-229.', //,
     3 ' Enraf-Nonius (1989). CAD-4 Software. Version 5.',
     4 ' Enraf-Nonius, Delft,', /, '   The Netherlands.', //,
     5 ' Flack, H.D. (1983). Acta Cryst. A39, 876-881.', //,
     6 ' Hooft, R.W.W. (1998). Collect Software, Nonius',
     7 ' B.V., Delft, The Netherlands.', //,
     8 ' LePage, Y. (1987). J. Appl. Cryst. 20, 264-269.', //,
     9 ' Mackay, A.L. (1984). Acta Cryst. A40, 165-166.', //,
     * ' Meulenaer, J. de & Tompa, H. (1965). Acta Cryst. 19,',
     1 ' 1014-1018.', //, ' North, A.C.T.,',
     2 ' Phillips, D.C. & Mathews, F.S. (1968).', /, '  Acta Cryst.',
     3 ' A24, 351-359.', //, ' Otwinowski, Z. & Minor, W. (1997).',
     4 ' Methods in Enzymology, Vol. 276,', /, 3X, 'Macromolecular',
     5 ' Crystallography, Part A, edited by C.W. Carter &', /, 3X,
     6 ' R.M. Sweet, pp. 307-326. London: Academic Press.', //,
     7 ' Sheldrick, G.M. (1986). SHELXS86.',
     8 ' University of G\"ottingen, Germany.', /)
99257 FORMAT (' Sheldrick, G.M. (1993). SHELXL93.',
     1 ' University of G\"ottingen, Germany.', //,
     2 ' Sheldrick, G.M. (1997). SHELXS97.',
     3 ' University of G\"ottingen, Germany.', //,
     4 ' Sheldrick, G.M. (1997). SHELXL97.',
     5 ' University of G\"ottingen, Germany.', //,
     6 ' Sluis, P. van der & Spek, A.L. (1990). Acta Cryst. A46,',
     7 ' 194-201.', //,
     8 ' Spek, A.L. (1987). Acta Cryst. C43, 1233-1235.', //,
     9 ' Spek, A.L. (1988). J. Appl. Cryst. 21, 578-579.', //,
     * ' Spek, A.L. (1994). Am. Crystallogr. Assoc.-Abstracts,',
     1 ' 22, 66.', //,
     2 ' Spek, A.L. (1997). HELENA, Program for Datareduction,',
     3 ' Utrecht', /, '   University, The Netherlands.', //,
     4 ' Spek, A.L. (2003). J. Appl. Cryst. 36, 7-13.', //,
     5 ' Wilson, A.J.C. (1992). Ed. International Tables for',
     6 ' Crystallography,', /, '   Volume C, Kluwer Academic',
     7 ' Publishers, Dordrecht, The Netherlands.',
     8 /, ';')
99255 FORMAT (A, /, ';', /,  ' ', /,  ';')
99254 FORMAT (A, /, ' ''Flack (1983)'' ')
99059 FORMAT (/, '# Permitted for _chemical_absolute_configuration:', /,
     1 '# Absolute configuration details', /,
     2 '# rm   = Det. by chiral ref. mol. with known abs.conf', /,
     3 '# ad   = Det. by anomalous dispersion', /,
     4 '# rmad = Det. by ''rm'' and ''ad'' ', /,
     5 '# syn  = Det. with reference to synthesis', /,
     6 '# unk  = Unknown/Arbitrary', /, A, A, /)
99253 FORMAT ('# Ex: ''C12 H16 N2 O6, H2 O'' and',
     1 ' ''(Cd 2+)3, (C6 N6 Cr 3-)2, 2(H2 O)'' ')
99252 FORMAT (/, '# Insert blank lines between paragraphs', /)
99251 FORMAT (/, '# Insert blank lines between references', /)
99250 FORMAT (A, /, ';', /, ' ?', /, ';', /,
     1        A, /, ';', /, ' ?', /, ';')
99249 FORMAT (/, ' Translation of Symmetry Code to Equiv.Pos', //)
99248 FORMAT (A, /, ';', /, ' ?', /, ';', /,
     1        A, /, ';', /, ' ?', /, ';')
99247 FORMAT (A, ' '' psi-scan'' ', /, A, /,
     1        ' ''(North et al., 1968)'' ')
99246 FORMAT (A, '''', A, '''', /,
     1        '# Example: ''(North et al., 1968)''', /,
     2        A, ' ?')
99245 FORMAT (A, /,
     1 '; View of the title compound with the atom numbering scheme.',
     2 /, 'Displacement ellipsoids for non-H atoms are drawn at the',
     3 ' 50% probability level.', /, ';')
99244 FORMAT (/, '# Permitted for _exptl_absorpt_correction_type :', /,
     1        '# analytical     ''analytical from crystal shape''', /,
     2        '#                Example: de Meulenaer&Tompa: ABST', /,
     3        '# cylinder       ''cylindrical''', /,
     4        '# gaussian       ''Gaussian from crystal shape''', /,
     5        '#                Example: PLATON/ABSG', /,
     6        '# integration    ''integration from crystal shape''', /,
     7        '# multi-scan     ''symmetry-related measurements''', /,
     8        '#                Example: SADABS, MULABS', /,
     9        '# none           ''no absorption corr. applied''', /,
     *        '# numerical      ''numerical from crystal shape''', /,
     1        '# psi-scan       ''psi-scan corrections''', /,
     2        '#                Example: PLATON/ABSP', /,
     3        '# refdelf        ''refined from delta-F''', /,
     4        '#                Example: SHELXA, ', /,
     5        '# sphere         ''spherical''', /,
     6        '#                Example: PLATON/ABSS')
99243 FORMAT (2(A, '''', A, '''', /))
99301 FORMAT (/,
     1 '# Permitted for _refine_ls_hydrogen_treatment :', /,
     2 '# refall            - refined all H-atom parameters', /,
     3 '# refxyz            - refined H-atom coordinates only', /,
     4 '# refU              - refined H-atom U only', /,
     5 '# noref             - no refinement of H-atom parameters', /,
     6 '# constr            - H-atom parameters constrained', /,
     7 '# hetero            - H-atom parameters constrained for H on C,'
     8                        , /,
     9 '#                     all H-atom parameters refined for H on', /
     * '#                     heteroatoms', /,
     1 '# heteroxyz         - H-atom parameters constrained for H on C,'
     2                        , /,
     3 '#                     refined H-atom coordinates only for H', /,
     4 '#                     on heteroatoms', /,
     5 '# heteroU           - H-atom parameters constrained for H on C,'
     6                        , /,
     7 '#                     refined H-atom U''s only for H on', /,
     8 '#                     heteroatoms', /,
     9 '# heteronoref       - H-atom parameters constrained for H on C,'
     *                        , /,
     1 '#                     no refinement of H-atom parameters for', /
     2 '#                     H on heteroatoms', /,
     3 '# hetero-mixed      - H-atom parameters constrained for H on C'
     4                        , /,
     5 '#                     and some heteroatoms, all H-atom', /,
     6 '#                     parameters refined for H on remaining', /,
     7 '#                     heteroatoms.', /,
     8 '# heteroxyz-mixed   - H-atom parameters constrained for H on C'
     9                        , /,
     * '#                     and some heteroatoms, refined H-atom', /,
     1 '#                     coordinates only for H on remaining', /,
     2 '#                     heteroatoms.', /,
     3 '# heteroU-mixed     - H-atom parameters constrained for H on C'
     4                        , /,
     5 '#                     and some heteroatoms, refined H-atom', /,
     6 '#                     U''s only for H on remaining heteroatoms'
     7                        , /,
     8 '# heteronoref-mixed - H-atom parameters constrained for H on C'
     9                        , /,
     * '#                     and some heteroatoms, no refinement of',/
     1 '#                     H-atom parameters for H on remaining', /,
     2 '#                     heteroatoms', /,
     3 '# mixed   - some constrained, some independent', /,
     4 '# undef   - H-atom parameters not defined', /,
     5 A, '''', A, '''', /)
99060 FORMAT (
     1 ''' International Tables Vol C Tables 4.2.6.8 and 6.1.1.4''')
99061 FORMAT (
     1 ' ''S.Brennan & P.L.Cowan (1992).Rev.Sci.Instr.,63,650''')
99001 FORMAT (/, '# Loop Mechanism for Extra Tables(s)', /,
     1        /, '#loop_',
     2        /, '#_publ_manuscript_incl_extra_item',
     3        /, '#''_geom_extra_tableA_col_1''',
     4        /, '#''_geom_extra_tableA_col_2''',
     5        /, '#''_geom_extra_tableA_col_3''',
     6        /, '#''_geom_extra_table_head_A''',
     7        /, '#''_geom_table_footnote_A''',
     8        /, '#''_geom_extra_tableB_col_1''',
     9        /, '#''_geom_extra_tableB_col_2''',
     *        /, '#''_geom_extra_tableB_col_3''',
     1        /, '#''_geom_extra_table_head_B''',
     2        /, '#''_geom_table_footnote_B''', /)
99002 FORMAT (/, '#',
     1        /, '#loop_',
     2        /, '#_geom_extra_tableA_col_1',
     3        /, '#_geom_extra_tableA_col_2',
     4        /, '#_geom_extra_tableA_col_3',
     5        /, '# ? ? ?', /)
99003 FORMAT (/, '#',
     1        /, '#loop_',
     2        /, '#_geom_extra_tableB_col_1',
     3        /, '#_geom_extra_tableB_col_2',
     4        /, '#_geom_extra_tableB_col_3',
     5        /, '# ? ? ?', /)
99004 FORMAT (/, '#',
     1        /, '#_geom_table_footnote_A',
     2        /, '#;', /, '# ?', /, '#;', /)
99005 FORMAT (/, '#',
     1        /, '#_geom_table_footnote_B',
     2        /, '#;', /, '# ?', /, '#;', /)
99006 FORMAT (/, '#',
     1        /, '#_geom_table_footnote_A',
     2        /, '#;', /, '# ?', /, '#;', /)
99007 FORMAT (/, '#',
     1        /, '#_geom_table_footnote_B',
     2        /, '#;', /, '# ?', /, '#;', /)
      END SUBROUTINE PLA173
      SUBROUTINE PLA174 (MODE, FORM, FORMH, LU, CTAB, NTAB, MXLIN,
     1 LSTART, NCOL, INCLH, IPS1, IPS2, IDECM, IDOUBL)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP34=647,NP38=150,NP39=30,
     3 NP41=200,NP47=9,NP52=200,NP56=30,NP57=35,NP59=100000,NKW=49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /CIF/ CIFDIR
      CHARACTER CIFDIR(NP34)*(NKW)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /LABC/LABB(NP59)
      DIMENSION DHA(4), IDHA(4)
      CHARACTER CTAB*1
      CHARACTER FORM*(*), FORMH*(*), DASH*1, GSS(4)*8
      ISPACE = 0
      JMX    = 0
      NHATS  = 0
      NHET   = 0
      IF (MODE .EQ. 4) THEN
        ISPACE = 8
        IF (IPR(431) .EQ. -1) THEN
          WRITE (LU, 99995, IOSTAT = IOST)
          WRITE (LU, 99994, IOSTAT = IOST)
          WRITE (LU, 99993, IOSTAT = IOST) CIFDIR(277)
          WRITE (LU, 99998, IOSTAT = IOST)
     1      CIFDIR(265), CIFDIR(266), CIFDIR(267), CIFDIR(269),
     2      CIFDIR(270), CIFDIR(268)
          ISPACE = 1
        END IF
      ELSE IF (MODE .EQ. 5) THEN
        ISPACE = 4
        IF (IPR(431) .EQ. -1) THEN
          WRITE (LU, 99997, IOSTAT = IOST)
     1      CIFDIR(258), CIFDIR(259), CIFDIR(260), CIFDIR(257),
     2      CIFDIR(262), CIFDIR(263), CIFDIR(264), CIFDIR(261)
          ISPACE = 1
        END IF
      ELSE IF (MODE .EQ. 6) THEN
        ISPACE = 9
        IF (IPR(431) .EQ. -1) THEN
          WRITE (LU, 99996, IOSTAT = IOST)
     1      CIFDIR(279), CIFDIR(280), CIFDIR(281), CIFDIR(282),
     2      CIFDIR(278), CIFDIR(284), CIFDIR(285), CIFDIR(286),
     3      CIFDIR(287), CIFDIR(283)
          ISPACE = 1
        END IF
      ELSE IF (MODE .EQ. 7) THEN
        ISPACE = 8
        IF (IPR(431) .EQ. -1) THEN
          WRITE (LU, 99998, IOSTAT = IOST)
     1      CIFDIR(271), CIFDIR(272), CIFDIR(273), CIFDIR(275),
     2      CIFDIR(276), CIFDIR(274)
          ISPACE = 1
        END IF
c MODE = 8 : H-BONDS
      ELSE IF (MODE .EQ. 8) THEN
        ISPACE = 1
        IF (IPR(431) .EQ. -1) THEN
          WRITE (LU, 99992, IOSTAT = IOST)
     1      CIFDIR(426)(1:29), CIFDIR(427)(1:29), CIFDIR(428)(1:29),
     2      CIFDIR(429)(1:23), CIFDIR(430)(1:23), CIFDIR(431)(1:23),
     3      CIFDIR(432)(1:21), CIFDIR(433)(1:27), CIFDIR(434)(1:21)
            FORM(84:86) = 'yes'
        END IF
      END IF
      IN01 = IPR(229 + MODE) + 1
      IN02 = IPR(223 + MODE)
      IF (MODE .LT. 7) THEN
        JMX  = MODE - 2
      ELSE IF (MODE .EQ. 7) THEN
        JMX = 2
      END IF
      IF (IPR(431) .EQ. 1) THEN
        IGBL(85) = IGBL(85) + 1
        WRITE (LU, 99999, IOSTAT = IOST) CHAR(12), IGBL(85)
      END IF
      DASH = ' '
      IF (IPR(431) .EQ. 1) THEN
        CALL PLA176 (-1, LU, CTAB, NTAB, FORMH, JID)
        IF (MODE .EQ. 7) THEN
          DASH = '.'
        ELSE
          DASH = '-'
        END IF
      END IF
      IF (MODE .EQ. 8) THEN
        DO J = IN01, IN02
          L = JNSC(2, J)
          JLABN = LABB(NINT(VOID(L)))
          CALL PLA047 (JLABN, NQ1, ISOP, IENR, IPR(71),
     1                 IGBL(55), 0, 1)
          JLABN = LABB(NINT(VOID(L + 1)))
          CALL PLA047 (JLABN, NQ2, ISOP, IENR, IPR(71),
     1                 IGBL(55), 0, 1)
          JLABN = -LABB(NINT(VOID(L + 2)))
          CALL PLA047 (JLABN, NQ3, ISOP, IENR, IPR(71),
     1                 IGBL(55), 0, 1)
          IF (IPR(431) .EQ. 1) THEN
            NQ1(6:7) = '--'
            NQ2(6:7) = '..'
          END IF
          IF (ISOP .EQ. 1) THEN
            GSS(3) = '    .   '
          ELSE
            MISOP  = MOL(ISOP) / NINT(PAR(42))
            MISOPH = MISOP / 1000
            MISOPT = MISOP - MISOPH * 1000
            WRITE (GSS(3)(1:8), 99991, IOSTAT = IOST) MISOPH, MISOPT
          END IF
          NDECM = IDECM
          M = 0
          DO K = 1, 7, 2
            M = M + 1
            IF (K .EQ. 7) NDECM = 2
            DHA(M) = VOID(L + K + 2)
            CALL GEN041 (DHA(M), VOID(L + K + 3), IDHA(M), NDECM,
     1           IDEC, IPR(68))
            IPS = 1 + M * 16
            FORM(IPS:IPS) = CHAR(ICHAR('0') + IDEC)
          END DO
          WRITE (PRBUF, FORM, IOSTAT = IOST) NQ1, NQ2, NQ3,
     1           (DHA(M), IDHA(M), M = 1, 4), GSS(3)
          IF (IDOUBL .EQ. 2) WRITE (LU, '(1X)')
          CALL GEN065 (LU, PRBUF, 80, 1)
        END DO
        RETURN
      END IF
      IF (IDOUBL .EQ. 2) WRITE (LU, '(1X)', IOSTAT = IOST)
      FORM(2 : 2) = CHAR(ICHAR('0') + ISPACE)
      NLIN        = MXLIN - LSTART
      ITEL        = LSTART
      IN3         = IPR(231)
      IN1         = IN3 + 1
      IN2         = IN3
      DO J = IN01, IN02
        MJNSC = MOD(JNSC(1, J), IPR(466))
        IF (INCLH .NE. 0 .OR. MJNSC .LE. IPR(465)) THEN
          IN2          = IN2 + 1
          JNSC(1, IN2) = MJNSC
          JNSC(2, IN2) = JNSC(2, J)
        END IF
      END DO
      IC  = NLIN * NCOL
      ICP2 = NCOL
      IN   = IN2 - IN1 + 1
      INP  = (IN + NCOL - 1) / NCOL
      INP  = INP * NCOL
      INM  = INP - IN
      IN2P = IN2 + INM
      DO J = 1, INM
        JNSC(2, J + IN2) = 0
      END DO
      IM = (INP + IC - 1) / IC
      IC3 = INP - (IM - 1) * IC
      DO M = 1, IM
        I = (M - 1) * NLIN * NCOL + IN1 - 1
        IF (M .GE. IM) IC = IC3
        ICS = IC / NCOL
        DO J = 1, NCOL
          DO K = 1, ICS
            IND = I + (J - 1) * ICS + K
            JNSC(1, IND) = (K - 1) * NCOL + J
          END DO
        END DO
        CALL GEN037 (JNSC, I + 1, I + IC)
      END DO
      K = 0
      DO I = IN1, IN2P
        K = K + 1
        L = JNSC(2, I)
        IF (L .LE. 0) THEN
          ICP2 = ICP2 - 1
        ELSE
          NHATS = 0
          NHET  = 0
          DO J = 1, JMX
            JLABN = LABB(NINT(VOID(L + J - 1)))
            IF (IPR(431) .EQ. -1) JLABN = - JLABN
            CALL PLA047 (JLABN, NQ1, ISOP, IENR, IPR(71),
     1        IGBL(55), 0, 1)
            IF (IENR .EQ. 1) NHATS = NHATS + 1
            IF (IENR .GT. 2) NHET  = NHET  + 1
            NAMS(K, J) = NQ1//' '
            IF (IPR(431) .EQ. -1) THEN
              IF (ISOP .EQ. 1) THEN
                GSS(J) = '    .   '
              ELSE
                MISOP  = MOL(ISOP) / NINT(PAR(42))
                MISOPH = MISOP / 1000
                MISOPT = MISOP - MISOPH * 1000
                WRITE (GSS(J), 99991, IOSTAT = IOST) MISOPH, MISOPT
              END IF
            END IF
          END DO
          V2(K) = VOID(L + JMX)
          CALL GEN041 (V2(K), VOID(L + JMX + 1), ISDV(K),
     1                IDECM, IDEC, IPR(68))
          IPS = K * IPS1 - IPS2
          FORM(IPS : IPS) = CHAR(ICHAR('0') + IDEC)
        END IF
        IF (K .GE. NCOL) THEN
          ITEL = ITEL + 1
          IF (ITEL .GT. MXLIN) THEN
            ITEL = LSTART + 1
            IF (IPR(431) .EQ. 1) THEN
              IGBL(85) = IGBL(85) + 1
              WRITE (LU, 99999, IOSTAT = IOST) CHAR(12), IGBL(85)
            END IF
            IF (IPR(431) .EQ. 1) THEN
              CALL PLA176 (1, LU, CTAB, NTAB, FORMH, JID)
            END IF
            IF (IDOUBL .EQ. 2) WRITE (LU, '(1X)', IOSTAT = IOST)
          END IF
          WRITE (PRBUF, FORM, IOSTAT = IOST)
     1      ((NAMS(M, J)(1:7), DASH, J = 1, JMX - 1),
     2      NAMS(M, JMX)(1:7), V2(M), ISDV(M), M = 1, ICP2)
          IF (IPR(431) .EQ. -1) THEN
            DO M = 1, JMX
              J = 38 + M * 8
              PRBUF(J : J + 8) = GSS(M)
            END DO
            IF (MODE .LT. 7 .AND. NHATS .EQ. 0 .AND.
     1        NHET .GT. 0 .AND. JMX .LT. 4) THEN
              PRBUF(78:80) = 'yes'
            ELSE
              PRBUF(78:80) = 'no '
            END IF
          END IF
          CALL GEN065 (LU, PRBUF, 80, 1)
          IF (IPR(431) .EQ. 1) WRITE (LU, '(1X)', IOSTAT = IOST)
          K    = 0
          ICP2 = NCOL
        END IF
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (A, 35X, '-', I3, ' -', /)
99998 FORMAT (/, 'loop_',  6(/, A))
99997 FORMAT (/, 'loop_',  8(/, A))
99996 FORMAT (/, 'loop_', 10(/, A))
99995 FORMAT (/, '#', 79('='), /)
99994 FORMAT ('# 10. MOLECULAR GEOMETRY', /)
99993 FORMAT (A, /, ';', /,
     1 ' Bond distances, angles etc. have been calculated using the',
     2 /,
     3 ' rounded fractional coordinates. All su''s are estimated', /,
     4 ' from the variances of the (full) variance-covariance matrix'
     5 , '.', /, ' The cell esds are taken into account in the',
     6 ' estimation of', /,
     7 ' distances, angles and torsion angles', /,
     7 ';')
99992 FORMAT (/, 'loop_', 9(/, A), /, '#', /,
     1 '#D   H   A   D - H  H...A   D...A    D - H...A  symm(A)', /,
     2 '#')
99991 FORMAT (I3, '_', I3, 1X)
      END SUBROUTINE PLA174
      SUBROUTINE PLA175 (MODE, LU, NCIFDIR, STR, IVAR, VAR)
      PARAMETER (NP34=647,NKW=49)
      COMMON /CIF/ CIFDIR
      CHARACTER CIFDIR(NP34)*(NKW), STR*(*)
      IF (MODE .EQ. 1) THEN
        WRITE (LU, 99999, IOSTAT = IOST) CIFDIR(NCIFDIR), STR
      ELSE IF (MODE .EQ. 2) THEN
        IF (IABS(IVAR) .LT. 999999) THEN
          WRITE (LU, STR, IOSTAT = IOST) CIFDIR(NCIFDIR), IVAR
        ELSE
          WRITE (LU, 99999, IOSTAT = IOST) CIFDIR(NCIFDIR), ' ?'
        END IF
      ELSE IF (MODE .EQ. 3) THEN
        IF (ABS(VAR) .LT. 10000.0) THEN
          WRITE (LU, STR, IOSTAT = IOST) CIFDIR(NCIFDIR), VAR
        ELSE
          WRITE (LU, 99999, IOSTAT = IOST) CIFDIR(NCIFDIR), ' ?'
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (2A)
      END SUBROUTINE PLA175
      SUBROUTINE PLA176 (MODE, LU, CTAB, NTB, FORM, JID)
      CHARACTER CTAB*1, FORM*(*), JID*(*), CHCON*11
      IF (MODE .LE. 0) THEN
        N     = 1
        CHCON = ' '
      ELSE
        N     = 11
        CHCON = '(continued)'
      END IF
      IF (MODE .EQ. 0) NTB = NTB + 1
      IF (NTB .GT. 9) FORM(19:19) = '2'
      WRITE (LU, FORM, IOSTAT = IOST) CTAB, NTB, CHCON(1:N), JID(1:40)
      IF (IOST .NE. 0) RETURN
      RETURN
      END SUBROUTINE PLA176
      SUBROUTINE PLA184
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,MR=300000,MZ=NVD+2*NP23-9*MR-7656)
      DOUBLE PRECISION B(3570), C(84), E(84), F(84), DD, DT, TT
      COMMON // B, C, E, F, D(12), FF(MR), FC(MR), SG(MR), XI(MR),
     1 XD(MR), YI(MR), YD(MR), ZI(MR), ZD(MR), DUMMY(MZ)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      DIMENSION TRMX(3, 3)
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      IF (IGBL(37) .NE. 1) THEN
        IPR(2) = 56
        GO TO 1000
      END IF
      TH  = PAR(417)
      DU  = PAR(418)
      ME  = IPR(523)
      MO  = IPR(524)
      IHT = 0
      IKT = 0
      ILT = 0
      CALL PLA293 (PAR(17))
      IF (IPR(37) .EQ. 0) GO TO 1000
      CALL PLA287 (1, 1, 0)
      PAGET = 'SHXABS'
      CALL PLA262 (0)
      WRITE (LU6, 99999, IOSTAT = IOST)
     1   PAR(417), PAR(418), IPR(523), IPR(524)
      WRITE (LU7, 99999, IOSTAT = IOST)
     1   PAR(417), PAR(418), IPR(523), IPR(524)
      K = 230
      DO I = 1, 3
        DO J = 1, 3
          K = K + 1
          TRMX(I, J) = PAR(K)
        END DO
      END DO
      NR     = 0
      U      = 0.0
      V      = 0.0
      NERROR = -1
   5  NERROR = NERROR + 1
      IF (NERROR .LT. 100) THEN
  10    READ (LU16, 99998, ERR = 5, END = 20) IH, IK, IL, OBS, Q, J,
     1        XINR, XDNR, YINR, YDNR, ZINR, ZDNR
        IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) GO TO 20
        IF (OBS .LT. TH * Q) GO TO 10
        IF (Q .LE. 0.0) GO TO 10
        ACAL = 0.0
        BCAL = 0.0
        IF (GEN050 (TRMX, IH, IK, IL, IHT, IKT, ILT) .GT. 0.0) THEN
          CALL PLA135 (IHT, IKT, ILT, ACAL, BCAL, ACALA, BCALA,
     1      ACALAF, BCALAF, SNTHA)
          NR     = NR + 1
          CALC   = (ACAL + ACALA) ** 2 + (BCAL + BCALA) ** 2
          FF(NR) = OBS
          FC(NR) = CALC
          SG(NR) = Q
          U      = U + OBS
          V      = V + CALC
          XI(NR) = XINR
          YI(NR) = YINR
          ZI(NR) = ZINR
          XD(NR) = XDNR
          YD(NR) = YDNR
          ZD(NR) = ZDNR
          IF (NR .EQ. MR) GO TO 1001
        END IF
        GO TO 10
      END IF
  20  N  = NR
      IF (N .EQ. 0) GO TO 1000
      NR = 0
      SC = V / U
      DO I = 1, 6
        C(I) = 0.D0
      END DO
      DO I = 1, 21
        B(I) = 0.D0
      END DO
      DO I = 1, N
        OBS = FF(I) * SC
        SIG = SG(I) * SC
        IF (AMIN1 (OBS, FC(I)) .GT. TH * SIG) THEN
          NR     = NR + 1
          FF(NR) = OBS
          FC(NR) = FC(I)
          SG(NR) = SIG
          XI(NR) = XI(I)
          YI(NR) = YI(I)
          ZI(NR) = ZI(I)
          XD(NR) = XD(I)
          YD(NR) = YD(I)
          ZD(NR) = ZD(I)
          F(1)   = DBLE(XI(I))**2
          F(2)   = DBLE(YI(I))**2
          F(3)   = DBLE(ZI(I))**2
          F(4)   = DBLE(YI(I) * ZI(I))
          F(5)   = DBLE(XI(I) * ZI(I))
          F(6)   = DBLE(XI(I) * YI(I))
          F(7)   = DBLE(XD(I))**2
          F(8)   = DBLE(YD(I))**2
          F(9)   = DBLE(ZD(I))**2
          F(10)  = DBLE(YD(I) * ZD(I))
          F(11)  = DBLE(XD(I) * ZD(I))
          F(12)  = DBLE(XD(I) * YD(I))
          L      = 0
          DO J = 1, 6
            C(J) = C(J) + F(J) + F(J + 6)
            DO K = 1, J
              L    = L + 1
              B(L) = B(L) + F(J) * F(K) + F(J + 6) * F(K + 6)
            END DO
          END DO
        END IF
      END DO
      CALL GEN110 (6, 21, C, B)
      DO I = 1, 6
        D(I + 6) = SNGL(C(I))
      END DO
      D(1) = SQRT (D(7))
      D(2) = 0.5 * D(12) / D(1)
      D(3) = 0.5 * D(11) / D(1)
      D(4) = SQRT (D(8) - D(2)**2)
      D(5) = (0.5 * D(10) - D(2) * D(3)) / D(4)
      D(6) = SQRT (D(9) - D(3)**2 - D(5)**2)
      T = 0.0
      S = 0.0
      R = 0.0
      U = 0.0
      V = 0.0
      DO I = 1, NR
        U     = U + FF(I)
        V     = V + FC(I)
        XI(I) = XI(I) * D(1) + YI(I) * D(2) + ZI(I) * D(3)
        YI(I) = YI(I) * D(4) + ZI(I) * D(5)
        ZI(I) = ZI(I) * D(6)
        XD(I) = XD(I) * D(1) + YD(I) * D(2) + ZD(I) * D(3)
        YD(I) = YD(I) * D(4) + ZD(I) * D(5)
        ZD(I) = ZD(I) * D(6)
        P     = ABS (1.0 - XI(I)**2 - YI(I)**2 - ZI(I)**2)
        Q     = ABS (1.0 - XD(I)**2 - YD(I)**2 - ZD(I)**2)
        R     = R + P + Q
        T     = AMAX1 (T, P, Q)
        S     = AMAX1 (S, 0.5 * (XI(I) * XD(I) + YI(I) * YD(I)
     1        + ZI(I) * ZD(I) + 1.0))
      END DO
      R = 0.5 * R / REAL(NR)
      S = 114.59156 * ATAN2 (SQRT (S), SQRT (1.0 - S))
      WRITE (LU6, 99995, IOSTAT = IOST) R, T, S
      WRITE (LU7, 99995, IOSTAT = IOST) R, T, S
      CALL GEN109 (MO, ME, XI(1), YI(1), ZI(1), F, I)
      NP = I + 4
      T  = V / U
      U  = 0.0
      V  = 0.0
      DO I = 1, NR
        P = SQRT (T * FF(I))
        Q = SQRT (FC(I))
        U = U + ABS (P - Q)
        V = V + Q
      END DO
      WRITE (LU6, 99997, IOSTAT = IOST) NR, NP, U / V
      WRITE (LU7, 99997, IOSTAT = IOST) NR, NP, U / V
      NN = (NP * (NP + 1)) / 2
      DO I = 1, NN
        B(I) = 0.D0
      END DO
      DO I = 1, NP
        C(I) = 0.D0
      END DO
      DO I = 1, NR
        CALL GEN109 (MO, ME, XI(I), YI(I), ZI(I), E, L)
        CALL GEN109 (MO, ME, XD(I), YD(I), ZD(I), F, L)
        S = 0.5 * (XI(I) * XD(I) + YI(I) * YD(I) + ZI(I) * ZD(I) + 1.0)
        DO J = 1, L
          F(J) = F(J) + E(J)
        END DO
        F(L + 1) = DBLE(S)
        F(L + 2) = 1.0D0
        F(L + 3) = 1.0D0 / DBLE(S)
        F(L + 4) = 1.0D0 / DBLE(S)**2
        DD       = DBLE(ALOG (FC(I) / FF(I)))
        M = 0
        DO J = 1, NP
          C(J) = C(J) + DD * F(J)
          DT = F(J)
          DO K = 1, J
            M = M + 1
            B(M) = B(M) + DT * F(K)
          END DO
        END DO
      END DO
      CALL GEN110 (NP, NN, C, B)
      TM = -9.E9
      TZ = 9.E9
      U  = 0.0
      V  = 0.0
      DO I = 1, NR
        CALL GEN109 (MO, ME, XI(I), YI(I), ZI(I), E, L)
        CALL GEN109 (MO, ME, XD(I), YD(I), ZD(I), F, L)
        S = 0.5 * (XI(I) * XD(I) + YI(I) * YD(I) + ZI(I) * ZD(I) + 1.0)
        DO J = 1, L
          F(J) = F(J) + E(J)
        END DO
        F(L + 1) = DBLE(S)
        F(L + 2) = 1.0D0
        F(L + 3) = 1.0D0 / DBLE(S)
        F(L + 4) = 1.0D0 / DBLE(S)**2
        TT       = 0.0D0
        DO K = 1, NP
          TT = TT + C(K) * F(K)
        END DO
        T  = SNGL(TT)
        T  = AMIN1 (T, 15.0)
        TM = AMAX1 (TM, T)
        TZ = AMIN1 (TZ, T)
        S  = SQRT (FC(I))
        U  = U + ABS (SQRT (FF(I) * EXP(T)) - S)
        V  = V + S
      END DO
      WRITE (LU6, 99996, IOSTAT = IOST) U / V
      WRITE (LU7, 99996, IOSTAT = IOST) U / V
      O  = 1.0
      TA = -9.E9
      TB = 9.E9
 200  REWIND LU16
      N  = 0
      NERROR = -1
 205  NERROR = NERROR + 1
      IF (NERROR .LE. 100) THEN
 210    READ (LU16, 99998, ERR = 205, END = 270) IH, IK, IL,
     1                          T, S, M, U, P, V, Q, W, R
        IF (IABS(IH) + IABS(IK) + IABS(IL) .EQ. 0) GO TO 210
        U = U * D(1) + V * D(2) + W * D(3)
        V = V * D(4) + W * D(5)
        W = W * D(6)
        P = P * D(1) + Q * D(2) + R * D(3)
        Q = Q * D(4) + R * D(5)
        R = R * D(6)
        N = N +1
        CALL GEN109 (MO, ME, U, V, W, E, L)
        CALL GEN109 (MO, ME, P, Q, R, F, L)
        Q = 0.5 * (U * P + V * Q + W * R + 1.0)
        DO J = 1, L
          F(J) = F(J) + E(J)
        END DO
        F(L + 1) = DBLE(Q)
        F(L + 2) = 1.0D0
        F(L + 3) = 1.0D0 / DBLE(Q)
        F(L + 4) = 1.0D0 / DBLE(Q)**2
        P        = -157.9137 * Q * DU
        DO K = 1, NP
          P = P + SNGL(C(K) * F(K))
        END DO
        P  = EXP (AMAX1 (TZ, AMIN1 (P, TM)))
        TA = AMAX1 (TA, P)
        TB = AMIN1 (TB, P)
        Q  = O * P
        T  = T * Q
        S  = S * Q
        IF (T .GT. 99999.99) GO TO 240
        IF (S .GT. 99999.99) GO TO 240
        IF (T .LT. -9999.99) GO TO 240
        IF (S .LT. -9999.99) GO TO 240
        WRITE (LU17, 99994, IOSTAT = IOST) IH, IK, IL, T, S, M
        GO TO 210
 240    IF (T .GT. 9999999.0) GO TO 250
        IF (S .GT. 9999999.0) GO TO 250
        IF (T .LT. -999999.0) GO TO 250
        IF (S .GT. -999999.0) GO TO 260
 250    REWIND LU17
        O = O * 0.1
        GO TO 200
 260    WRITE (LU17, 99993, IOSTAT = IOST) IH, IK, IL, T, S, M
        GO TO 210
      END IF
 270  I = 0
      T = 0.0
      WRITE (LU17, 99994, IOSTAT = IOST) I, I, I, T, T, I
      T = (TB / TA)**0.3333
      WRITE (LU6, 99992, IOSTAT = IOST) N, T * TB / TA, T
      WRITE (LU7, 99992, IOSTAT = IOST) N, T * TB / TA, T
      IPR(2) = -10
 1000 RETURN
 1001 WRITE (LU6, 99991, IOSTAT = IOST)
      WRITE (LU7, 99991, IOSTAT = IOST)
      RETURN
99999 FORMAT (/, ' SHXABS', 2F8.2, 2I5, /)
99998 FORMAT (3I4, 2F8.2, I4, 6F8.5)
99997 FORMAT (/, I8, ' Reflections used to determine', I3,' Parameters'
     1 //' R1 =',F9.4,'  Before Parameter Refinement')
99996 FORMAT (' R1 =',F9.4,'  After  Parameter Refinement'/)
99995 FORMAT (/, 'Mean and Maximum Errors in Direction Cosine Check ',
     1 'Function =', 2F7.3, /, 'The mean error should not exceed,',
     2 ' 0.005. Maximum 2-theta =', F8.2, ' degrees', /)
99994 FORMAT (3I4, 2F8.2, I4)
99993 FORMAT (3I4, 2F8.0, I4)
99992 FORMAT (I8,' Corrected reflections written to file ', //,
     1 ' Minimum and Maximum Virtual Transmission =', 2F12.6, /)
99991 FORMAT (' ** Too many .raw data - use higher I/sigma ',
     1 //, 'or larger version  **')
      END SUBROUTINE PLA184
      SUBROUTINE PLA185 (MODE, SCL, NR, NOCLS)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35,NXT1=100,NXT2=200,NXT3=100,NXT4=200)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /P190/ NVRR, PMILL(NXT1, 5), XTLV(7, NXT2), IDG(NXT4, 4),
     1 XYZPL(3, NXT2), CFACE(5, NXT2), IEDGE(NXT3), NFACES, NEDGE, NVER
      COMMON /ABSPSI/ PSIS(38, 4, 10), OP(3, 3, 11), IHKLPS(4, 10),
     1 NPSI
      CHARACTER NRV*6
      VERT = 25.0
      IDM  = '  H  K  L  DIST(mm)'
      CALL GGIP09 (0.0, IDM, 19, 0.5, 5, 2, VERT + 0.1, VERT - 3.0)
      DO I = 1, NFACES
        WRITE (IDM, 99999, IOSTAT = IOST)
     1   (NINT(PMILL(I, J)), J = 1, 3), PMILL(I, 5)
        CALL GGIP09 (0.0, IDM, 18, 0.5, -1, 2, VERT + 0.1,
     1       VERT - 3.5 - I * 0.8)
      END DO
      CALL GGIP (13.0, 12.0, 0.0, -3)
      IF (NVER .GT. NXT2) THEN
        CALL GGIP09 (0.0, 'Too Many Vertices ', 18, 0.75,
     1                         2, 2, 1.0, -6.5)
        GO TO 190
      ELSE IF (NFACES + NVRR - 2 .NE. NEDGE) THEN
        WRITE (PRBUF, 99994, IOSTAT = IOST)
        WRITE (LU6, 99998, IOSTAT = IOST) PRBUF
        WRITE (LU7, 99998, IOSTAT = IOST) PRBUF
        CALL GGIP09 (0.0, PRBUF, 18, 0.75, 2, 2, 1.0, -8.0)
        GO TO 190
      END IF
      CALL GEN052 (OP(1, 1, NR), DUMV)
      CALL GEN003 (OP(1, 1, NR), PAT, DET, 0)
      CALL GEN007 (RAA, DUMV(1, 1), V3, 1)
      CALL GEN007 (RAA, DUMV(1, 2), V4, 1)
      CALL GEN007 (RAA, DUMV(1, 3), V5, 1)
      DO I = 1, 2
        V3(I)     = V3(I) * SCL * 0.5
        V4(I)     = V4(I) * SCL * 0.5
        V5(I)     = V5(I) * SCL * 0.5
        V1(I)     =   1000000.0
        V1(I + 2) = - 1000000.0
      END DO
      IF (NVER .GT. 0) THEN
        CALL GEN074 (V2, 1, 3, 0.0)
        DO I = 1, NVER
          CALL GEN002 (MODE, DUMV, XTLV(1, I), XYZPL(1, I), XG)
          V1(1) = MIN (V1(1), XYZPL(1, I))
          V1(2) = MIN (V1(2), XYZPL(2, I))
          V1(3) = MAX (V1(3), XYZPL(1, I))
          V1(4) = MAX (V1(4), XYZPL(2, I))
          V2(1) = V2(1) + XYZPL(1, I)
          V2(2) = V2(2) + XYZPL(2, I)
          V2(3) = V2(3) + XYZPL(3, I)
        END DO
        V2(1) = V2(1) / NVER
        V2(2) = V2(2) / NVER
        V2(3) = V2(3) / NVER
        DO I = 1, NVER
          XYZPL(1, I) = XYZPL(1, I) - V2(1)
          XYZPL(2, I) = XYZPL(2, I) - V2(2)
          XYZPL(3, I) = XYZPL(3, I) - V2(3)
        END DO
        DIS = 0.0
        DO I = 1, NVER
          DIS = MAX (DIS, SQRT (GEN009 (XYZPL(1, I), XYZPL(1, I))))
        END DO
        SCAL = PAR(325) * SCL / DIS
        DO I = 1, NFACES
          ANGLE = 0
          DO J = 1, 3
            ANGLE       = ANGLE + PAT(J, 3) * PMILL(I, J)
            CFACE(J, I) = 0.0
          END DO
          CFACE(4, I) = 0
          CFACE(5, I) = ANGLE
          DO K = 1, NVER
            DO J = 4, 6
              N = IABS(NINT(XTLV(J, K)))
              IF (N .EQ. I) THEN
                IF (ANGLE .LT. 0.0) N = - N
                XTLV(J, K) = N
                CFACE(1, I) = CFACE(1, I) + XYZPL(1, K)
                CFACE(2, I) = CFACE(2, I) + XYZPL(2, K)
                CFACE(3, I) = CFACE(3, I) + XYZPL(3, K)
                CFACE(4, I) = CFACE(4, I) + 1.0
              END IF
            END DO
          END DO
        END DO
        IF (NOCLS .GE. 0) THEN
          COLR = 1.0
        ELSE
          COLR = 0.0
        END IF
        CALL GGIP (0.0, COLR, 0.0, 0)
        DO I = 1, NVER
          DO K = 1, 3
            XYZPL(K, I) = SCAL * XYZPL(K, I)
          END DO
          IF (IGBL(75) .EQ. 1) THEN
            IF (NVER .LT. 100) THEN
              NV = 2
              WRITE (NRV, 99997, IOSTAT = IOST) NINT(XTLV(7, I))
            ELSE
              NV = 3
              WRITE (NRV, 99996, IOSTAT = IOST) NINT(XTLV(7, I))
            END IF
            CALL GGIP09 (0.0, NRV, NV, 0.3, -1, 2,
     1                   XYZPL(1, I), XYZPL(2, I))
          END IF
        END DO
        DO I = 1, NFACES
          DO K = 1, 3
            CFACE(K, I) = SCAL * (CFACE(K, I) / CFACE(4, I))
          END DO
          IF (IGBL(75) .EQ. 1) THEN
            IF (CFACE(5, I) .GT. 0.0) THEN
              COLR = 1.0
              SHT = 0.15
            ELSE
              COLR = 4.0
              SHT = -0.15
            END IF
            IF (NOCLS .LT. 0) THEN
              COLR = 0.0
            END IF
            CALL GGIP (0.0, COLR, 0.0, 0)
            WRITE (NRV, 99995, IOSTAT = IOST)
     1        (NINT(PMILL(I, K)), K = 1, 3)
            CALL GGIP09 (0.0, NRV, 6, 0.25, -1, 2,
     1                   CFACE(1, I) - 0.5, CFACE(2, I) + SHT)
          END IF
        END DO
      END IF
      DO 180 I0 = 1, NEDGE
        I  = IDG(I0, 3)
        J0 = IDG(I0, 4)
        MC   = 0
        IVIS = 0
        IF (NOCLS .LT. 0) THEN
          COLR = 0.0
        ELSE
          COLR = 1.0
        END IF
        CALL GGIP (0.0, COLR, 0.0, 0)
        DO K = 1, 3
          DO L = 1, 3
            IF (ABS(XTLV(K + 3, I)) .EQ. ABS(XTLV(L + 3, J0))) THEN
              MC = MC + 1
              IF (XTLV(K + 3, I) .GT. 0.0) IVIS = IVIS + 1
              IF (MC .EQ. 2) THEN
                IF (IVIS .LT. 1) THEN
                  XB = XYZPL(1, I)
                  YB = XYZPL(2, I)
                  DIST = SQRT ((XYZPL(1, J0) - XB)**2
     1                 +       (XYZPL(2, J0) - YB)**2)
                  NSTEP = NINT(DIST / 0.3)
                  IF (NSTEP .GT. 0) THEN
                    STEPX = (XYZPL(1, J0) - XB) / NSTEP
                    STEPY = (XYZPL(2, J0) - YB) / NSTEP
                    DO II = 1, NSTEP, 2
                      CALL GGIP (XB, YB, 0.0, 3)
                      XB = XB + STEPX
                      YB = YB + STEPY
                      CALL GGIP (XB, YB, 0.0, 2)
                      XB = XB + STEPX
                      YB = YB + STEPY
                    END DO
                  END IF
                ELSE
                  IF (NOCLS .LT. 0) THEN
                    COLR = 0.0
                  ELSE
                    COLR = 1.0
                  END IF
                  CALL GGIP (0.0, COLR, 0.0, 0)
                  DELX = XYZPL(1, J0) - XYZPL(1, I)
                  DELY = XYZPL(2, J0) - XYZPL(2, I)
                  IF (DELX .EQ. 0) THEN
                    DX = 0.025
                    DY = 0.0
                  ELSE IF (DELY .EQ. 0) THEN
                    DX = 0.0
                    DY = 0.025
                  ELSE
                    DY = - (DELX / DELY)
                    DX = SQRT (0.000625 / (1 + DY**2))
                    DY = DX * DY
                  END IF
                  XB = XYZPL(1, I)  - DX
                  YB = XYZPL(2, I)  - DY
                  XE = XYZPL(1, J0) - DX
                  YE = XYZPL(2, J0) - DY
                  DO II = 1, 2
                    CALL GGIP (XB, YB, 0.0, 3)
                    CALL GGIP (XE, YE, 0.0, 2)
                    XB = XB + 2 * DX
                    YB = YB + 2 * DY
                    XE = XE + 2 * DX
                    YE = YE + 2 * DY
                  END DO
                END IF
                GO TO 180
              END IF
            END IF
          END DO
        END DO
  180 CONTINUE
      IF (IPR(388) .EQ. 1) THEN
        IF (NOCLS .LT. 0) THEN
          COLR = 0.0
        ELSE
          COLR = 2.0
        END IF
        CALL GGIP (0.0, COLR, 0.0, 0)
        CALL GGIP (0.0,   0.0,   0.0, 3)
        CALL GGIP (V3(1), V3(2), 0.0, 2)
        CALL GGIP09 (0.0, 'a', 1, 0.35,  -1, 2, V3(1) + 0.2, V3(2))
        CALL GGIP (0.0,   0.0,   0.0, 3)
        CALL GGIP (V4(1), V4(2), 0.0, 2)
        CALL GGIP09 (0.0, 'b', 1, 0.35,  -1, 2, V4(1) + 0.2, V4(2))
        CALL GGIP (0.0,   0.0,   0.0, 3)
        CALL GGIP (V5(1), V5(2), 0.0, 2)
        CALL GGIP09 (0.0, 'c', 1, 0.35,  -1, 2, V5(1) + 0.2, V5(2))
      END IF
  190 CALL GGIP (-13.0, -12.0, 0.0, -3)
      CALL GGIP (0.0, 0.0, 0.0, 0)
      RETURN
99999 FORMAT (3I3, F8.3)
99998 FORMAT (':: ', A)
99997 FORMAT (I2)
99996 FORMAT (I3)
99995 FORMAT (3I2)
99994 FORMAT ('Crystal not Finite')
      END SUBROUTINE PLA185
      SUBROUTINE PLA187
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NMX=1000,
     4 NMAX=(NVD+2*NP23-14*NMX-45600)/2)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // AZ(80, 80), BZ(80), UZ(80), VZ(80, 80), VA(80, 80),
     1 YI(NMX), SIGYI(NMX), U0(3, NMX), U1(3, NMX), AII(NMX), SAA(NMX),
     2 WI(NMX), IHH(NMX), IKK(NMX), ILL(NMX), SIGALM(80), ALM(80),
     3 YLM0(80), YLM1(80), QI(80), XI(80), CORR(80, 80), DATA(NMAX),
     4 INDEX(NMAX)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      DIMENSION S0(3), S1(3), FMUR(12), AMUR(12)
      DOUBLE PRECISION AZ, BZ, UZ, VZ, VA, TYUNK
      CHARACTER N0*1, N1*1, N2*1
      DATA FMUR /
     1 0, 0.5, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10/
      DATA AMUR /
     1 1.0, 0.48181, 0.24249, 0.07142, 0.02606, 0.01156,
     2 0.005983, 0.00347, 0.002186, 0.001465, 0.001029, 0.00075/
C * CALCULATES AN EMPIRICAL CORRECTION FOR ABSORPTION ANISOTROPY BASED
C * ON A LEAST-SQUARES FIT OF REAL SPHERICAL HARMONIC FUNCTIONS TO THE
C * EMPIRICAL TRANSMISSION SURFACE AS SAMPLED BY MULTIPLE SYMMETRY-
C * EQUIVALENT AND/OR AZIMUTH ROTATION-EQUIVALENT REFLECTION
C * MEASUREMENTS. (C.F. BLESSING, ACTA CRYST (1995), A51, 33-38)
C * CHECK FOR RECORD LENGTH (I.E. WORD OR BYTE-COUNT)
      LURA  = 29
      LURB  = 30
      NSIZE = 1
      DO I = 1, 2
        NRZ = 14 * NSIZE
        OPEN (UNIT = LURA, STATUS = 'SCRATCH',
     1    FORM = 'UNFORMATTED', ACCESS = 'DIRECT', RECL = NRZ)
        WRITE (LURA, REC = 1, ERR = 10) (FN(II), II = 1, 14)
        GO TO 20
   10   NSIZE = 4
        CLOSE (UNIT = LURA, STATUS = 'DELETE')
      END DO
      CALL GEN127 ('CANNOT FIGURE OUT DIRECT ACCESS RECORD LENGTH')
   20 NRZ = 11 * NSIZE
          OPEN (UNIT = LURB, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1        ACCESS = 'DIRECT', RECL = NRZ)
      IHM      = - 9999
      IKM      = - 9999
      ILM      = - 9999
      SMIN     = 9.0
      SMAX     = 0.0
      PAR(301) = FN(1)
      PAR(305) = FN(2)
      PAR(304) = FN(3)
      PAR(306) = FN(4)
      IPR(373) = NINT(FN(5))
      IPR(374) = NINT(FN(6))
      PAR(321) = PAR(301) * PAR(305)
      IF (PAR(321) .EQ. 0.0) THEN
        IGBL(6) = 16
        NAUTO    = IGBL(25)
      ELSE
        NAUTO = 0
      END IF
      CALL PLA262 (-3)
      WRITE (LU7, 99999, IOSTAT = IOST)
      IF (PAR(17) .LE. 0) THEN
        WRITE (LU6, 99974, IOSTAT = IOST)
        WRITE (LU7, 99974, IOSTAT = IOST)
        GO TO 180
      END IF
      SINA  = SIN(PAR(244) / RGBL(6))
      COSA  = COS(PAR(244) / RGBL(6))
      COSBS = COS(PAR(139) / RGBL(6))
      COSGS = COS(PAR(140) / RGBL(6))
      SINBS = SIN(PAR(139) / RGBL(6))
      SINGS = SIN(PAR(140) / RGBL(6))
      DELTA = 0.0
      DO I = 1, 6
        DELTA = DELTA + ABS(PAR(100 + I) - PAR(240 + I))
      END DO
      IF (DELTA .GT. 0.01) THEN
        CALL GEN112 (QQ, PAR(231), 1)
        CALL GEN003 (QQ, DUMV, DET, 0)
        CALL GEN112 (DUMV, XJX(1), -1)
        XJX(10)  = 0.0
        XJX(11)  = 0.0
        XJX(12)  = 0.0
        LINE = 'SPGR '//SPGRNM(1)(1:11)
        CALL SGSM (LINE, NRSM, XJX, LU6, 16, IERR)
        CALL SGSM (LINE, NSM, XJX, LU6, 2, IERR)
        CALL SGSM (LINE, 0,   XJX, LU6, 18, IERR)
        IPR(255) = NINT(XJX(4))
        IPR(257) = NINT(XJX(5))
      END IF
      FSQMIN = 1.0
      FSQMAX = 1E10
      STLMIN = 0.0
      STLMAX = 9.0
      SMIN1  = 0
      SMAX1  = 9
      IF (NAUTO .EQ. 1) THEN
        CALL PLA200 (6, 1, 0, 0)
        CALL GGIP (0.0, 0.0, 0.0, 6)
      END IF
      N3REJ    = 0
      N6REJ    = 0
      N7REJ    = 0
      IPR(371) = 0
      IPR(372) = 0
      CALL PLA290 (0)
      CALL GEN108 (LU16, 0)
      NINP = 0
   30 READ (LU16, 99998, END = 40) IH, IK, IL, Y, SIGY,
     1    (V1(K), V2(K), K = 1, 3)
      IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) GO TO 40
      NINP  = NINP + 1
      V3(1) = IH
      V3(2) = IK
      V3(3) = IL
      STH = SQRT(GEN095 (PAR(391), IH, IK, IL)) * PAR(17)
      DO K = 1, 3
        V4(K) = PAR(134 + K) * V1(K)
        V5(K) = PAR(134 + K) * V2(K)
      END DO
      TPRIM = GEN009 (V3, V4)
      TDIFF = GEN009 (V3, V5)
      DUMMY = GEN006 (V4, RAA, V5) /
     1            SQRT(GEN006 (V4, RAA, V4) * GEN006 (V5, RAA, V5))
      IF (ABS(DUMMY) .GT. 1.0) DUMMY = SIGN (1.0, DUMMY)
      IF (ABS(STH) .GT. 0.99999999)
     1    WRITE (LU6, 99973, IOSTAT = IOST) IH, IK, IL, STH
      TH1    = ASIN(STH) * RGBL(6)
      TH2    = 90.0 - ACOS(DUMMY) * RGBL(6) / 2.0
      CALL PLA291 (TPRIM, TDIFF, TH1, TH2, ITEST)
      IF (ITEST .NE. 0) GO TO 40
      S0(1)    = V1(1)
      S1(1)    = V2(1)
      S0(2)    = (V1(2) - V1(1) * COSGS) / SINGS
      S1(2)    = (V2(2) - V2(1) * COSGS) / SINGS
      S0(3)    = (V1(3) - V1(1) * COSBS + S0(2) * SINBS * COSA) /
     1           (SINBS * SINA)
      S1(3)    = (V2(3) - V2(1) * COSBS + S1(2) * SINBS * COSA) /
     1           (SINBS * SINA)
      IPR(371) = IPR(371) + 1
      S = GEN056 (IH, IK, IL, RBB)
      IF (S .LT. SMIN1 .OR. S .GT. SMAX1) THEN
        N3REJ = N3REJ + 1
        GO TO 30
      END IF
      IF (SIGY .LE. 0) THEN
        N6REJ = N6REJ + 1
        GO TO 30
      END IF
      IF (Y .LT. -4 * SIGY) THEN
        N7REJ = N7REJ + 1
        GO TO 30
      END IF
      SMIN = MIN (SMIN, S)
      SMAX = MAX (SMAX, S)
      NSYMH = IPR(255)
      ICNTR = IPR(257)
      IHKLM = -99999
      DO I = 1, NSYMH
        XJX(1) = IH
        XJX(2) = IK
        XJX(3) = IL
        XJX(4) = 0.0
        NS     = I
        CALL SGSM (ICL, NS, XJX, 0, 5, IERR)
        IH0  = NINT(XJX(7))
        IK0  = NINT(XJX(8))
        IL0  = NINT(XJX(9))
        IHKL = IL0 * 250000 + IK0 * 500 + IH0
        IF (IHKL .LT. 0 .AND. ICNTR .EQ. 2) THEN
          IH0  = - IH0
          IK0  = - IK0
          IL0  = - IL0
          IHKL = - IHKL
        END IF
        IF (IABS(IHKL) .GT. IHKLM) THEN
          IHKLM = IABS(IHKL)
          J     = IH0
          K     = IK0
          L     = IL0
        END IF
      END DO
      IHM = MAX (IHM, IABS(J))
      IKM = MAX (IKM, IABS(K))
      ILM = MAX (ILM, IABS(L))
      IF (IPR(372) .LT. NMAX) IPR(372) = IPR(372) + 1
      IF (NAUTO .EQ. 1) THEN
        IF (MOD(IPR(372), 5000) .EQ. 0) CALL PLA200 (6, 1, 0, 1)
      END IF
      WRITE (LURA, REC = IPR(372))
     1       J, K, L, IH, IK, IL, Y, SIGY, S0, S1
      GO TO 30
   40 WRITE (LU7, 99972, IOSTAT = IOST) IPR(371)
      IF (ITEST .NE. 0) THEN
        IPR(210) = 0
        GO TO 180
      END IF
      WRITE (LU7, 99971, IOSTAT = IOST) IPR(372)
      CALL PLA290 (-1)
      CALL PLA262 (6)
   50 IF (IPR(373) .EQ. 0) IPR(373) = 8
      IF (IPR(374) .GT. 7) IPR(374) = 7
      AIMIN  = 0.5
      AIMAX  = 1.5
      IF (AIMIN .EQ. 0 .AND. AIMAX .EQ. 0) THEN
        IF (PAR(301) .GT. 0 .AND. PAR(304) .GT. 0
     1                      .AND. PAR(306) .GT. PAR(304)) THEN
          AIMIN = EXP(- PAR(301) * PAR(306))
          AIMAX = EXP(- PAR(301) * PAR(304))
        ELSE
          AIMIN = 0.5
          AIMAX = 1.5
        END IF
      END IF
      IF (AIMIN .GE. 0 .AND. AIMAX .GT. AIMIN) THEN
        AMEAN = 0.5 * (AIMIN + AIMAX)
        AIMIN = AIMIN / AMEAN
        AIMAX = AIMAX / AMEAN
      END IF
      IF (AIMIN .LT. 0) AIMIN = 0
      IF (AIMAX .LT. 0) AIMAX = 1E10
      CALL PLA262 (16)
      WRITE (LU7, 99997, IOSTAT = IOST)
     1  IPR(373), IPR(374), PAR(301), PAR(305), PAR(304), PAR(306),
     2  PAR(326)
      WRITE (LU7, 99982, IOSTAT = IOST)
     1  FSQMIN, FSQMAX, STLMIN, STLMAX, AIMIN, AIMAX
      IF (PAR(301) .EQ. 0) THEN
        CALL PLA262 (2)
        WRITE (LU7, 99981, IOSTAT = IOST)
      ELSE IF (PAR(305) .EQ. 0 .AND. PAR(304) .EQ. 0) THEN
        CALL PLA262 (2)
        WRITE (LU7, 99980, IOSTAT = IOST)
      ELSE IF (PAR(305) .EQ. 0 .AND. PAR(304) .GT. 0) THEN
        CALL PLA262 (2)
        WRITE (LU7, 99979, IOSTAT = IOST)
      END IF
      IF (NAUTO .EQ. 1) THEN
   60   CALL PLA200 (6, 1, 0, 0)
        CALL PLA013 (0, 1)
        CALL PLA006 (0, IS)
        SELECT CASE (IFL(1)(1:4))
          CASE ('MU  ')
            PAR(301) = FN(1)
            PAR(321) = PAR(301) * PAR(305)
            IPR(441) = 0
          CASE ('RADI')
            PAR(305) = FN(1)
            PAR(321) = PAR(301) * PAR(305)
            IPR(442) = 0
          CASE ('TMIN')
            PAR(304)   = FN(1)
          CASE ('TMAX')
            PAR(306)   = FN(1)
          CASE ('L0MA')
            IPR(373)   = NINT(FN(1))
          CASE ('L1MA')
            IPR(374)   = NINT(FN(1))
          CASE ('NEXT')
            CALL GGIP09 (0.0, 'Click on NEXT-STEP to PROCEED', 29,
     1                   0.60, 0, 2, 18.0, 1.5)
            CALL GGIP (0.0, 0.0, 0.0, 6)
            GO TO 70
          CASE ('END ')
            GO TO 180
          CASE ('EXIT')
            GO TO 180
          CASE DEFAULT
            GO TO 60
        END SELECT
        CALL GGIP (0.0, 0.0, 0.0, 6)
        GO TO 50
      END IF
   70 CALL PLA262 (7)
      WRITE (LU7, 99983, IOSTAT = IOST)
     1  N3REJ, SMIN1, SMAX1, N6REJ, N7REJ
      WRITE (LU7, 99986, IOSTAT = IOST) SMIN, SMAX
      NL  = 2 * ILM + 1
      NK  = 2 * IKM + 1
      NKL = NK * NL
      DO I = 1, IPR(372)
        READ (LURA, REC = I) J, K, L
        DATA(I) = (J + IHM) * NKL + (K + IKM) * NL + (L + ILM)
      END DO
      CALL GEN053 (IPR(372), DATA, INDEX)
      DO I = 1, IPR(372)
        READ  (LURA, REC = INDEX(I)) J, K, L,
     1                               IH, IK, IL, Y, SIGY, S0, S1
        WRITE (LURB, REC = I)        IH, IK, IL, Y, SIGY, S0, S1
      END DO
      CALL GEN108 (LU8, 0)
      IHKL  = NINT(DATA(INDEX(1)))
      NMEAS = 1
      INDEX(IPR(372) + 1) = IPR(372) + 1
      DATA(IPR(372) + 1)  = -999999.0
      DO I = 2, IPR(372) + 1
        IF (DATA(INDEX(I)) .EQ. IHKL) THEN
          NMEAS = NMEAS + 1
        ELSE
          IH = IHKL / NKL
          IK = (IHKL - IH * NKL) / NL
          IL = IHKL - IH * NKL - IK * NL
          IH = IH - IHM
          IK = IK - IKM
          IL = IL - ILM
          WRITE (LU8) NMEAS, IH, IK, IL
          DO J = 1, NMEAS
            IREC = I - J
            READ  (LURB, REC = IREC) IH, IK, IL, Y, SIGY, S0, S1
            WRITE (LU8)              IH, IK, IL, Y, SIGY, S0, S1
          END DO
          IHKL  = NINT(DATA(INDEX(I)))
          NMEAS = 1
        END IF
      END DO
      IPR(376) = 0
      IPR(375) = 0
      CHISQ    = 0
      SUMSQ    = 0
      CALL GEN108 (LU8, 1)
      CALL GEN108 (LU9, 0)
   80 READ (LU8, END = 90) N
      DO J = 1, N
        READ (LU8) IH, IK, IL, YJ, SIGYJ, S0, S1
        YI(J)    = YJ
        SIGYI(J) = SIGYJ
        DO K = 1, 3
          U0(K, J) = - S0(K)
          U1(K, J) =   S1(K)
        END DO
      END DO
      IF (N .LT. 2) GO TO 80
      S =  GEN056 (IH, IK, IL, RBB)
      IF (S .LT. STLMIN .OR. S .GT. STLMAX) GO TO 80
      DO I = 1, N
        IF (YI(I) / SIGYI(I) .LT. FSQMIN .OR. YI(I) .GT. FSQMAX)
     1      GO TO 80
      END DO
      CALL GEN053 (N, YI, INDEX)
      M = N / 2
      IF (MOD(N, 2) .EQ. 0) THEN
        YMEDIAN = 0.5 * (YI(INDEX(M)) + YI(INDEX(M + 1)))
      ELSE
        YMEDIAN = YI(INDEX(M + 1))
      END IF
      NDATA = 0
      SUMW  = 0
      DO I = 1, N
        AI = YI(I) / YMEDIAN
        IF (AI .LT. AIMIN .OR. AI .GT. AIMAX) THEN
          WI(I) = 0.0
        ELSE
          WI(I) = 1.0 / (SIGYI(I)**2)
          SUMW  = SUMW  + WI(I)
          NDATA = NDATA + 1
        END IF
      END DO
      IF (NDATA .LT. 2) GO TO 80
      IPR(376) = IPR(376) + 1
      IPR(375) = IPR(375) + NDATA
      WRITE (LU9) NDATA, SUMW
      DO I = 1, N
        IF (WI(I) .GT. 0) WRITE (LU9)
     1     (U0(III, I), III = 1, 3),
     2     (U1(III, I), III = 1, 3), WI(I), YI(I)
        DI = 0
        DO J = 1, N
          YJ = - WI(J) * YI(J) / SUMW
          IF (J .EQ. I) YJ = YJ + YI(J)
          DI = DI + YJ
        END DO
        CHISQ = CHISQ + WI(I) * DI**2
        SUMSQ = SUMSQ + WI(I) * YI(I)**2
      END DO
      GO TO 80
   90 CALL PLA262 (16)
      WRITE (LU7, 99984, IOSTAT = IOST)
     1   STLMIN, STLMAX, FSQMIN, FSQMAX, AIMIN, AIMAX,
     1 IPR(375), IPR(376)
      PAR(322) = SQRT(CHISQ / SUMSQ)
      Z1 = SQRT(CHISQ / (IPR(375) - IPR(376)))
      WQ = 1.0 / PAR(322)**2
      IPR(377) = 0
      LMAX = MAX (IPR(373), IPR(374))
      DO L = 1, LMAX
        IF ((MOD(L, 2) .EQ. 0 .AND. L .LE. IPR(373)) .OR.
     1      (MOD(L, 2) .EQ. 1 .AND. L .LE. IPR(374)))
     2       IPR(377) = IPR(377) + 2 * L + 1
      END DO
  100 IF (IPR(375) / IPR(377) .LT. 10) THEN
        IPR(377) = IPR(377) - (2 * LMAX + 1)
        IF (IPR(377) .LE. 0) THEN
          WRITE (PRBUF, 99975, IOSTAT = IOST)
          WRITE (LU6, 99976, IOSTAT = IOST) PRBUF
          WRITE (LU7, 99976, IOSTAT = IOST) PRBUF
          GO TO 180
        END IF
        LMAX = LMAX - 1
        IF (IPR(373) .GT. LMAX) IPR(373) = IPR(373) - 2
        IF (IPR(374) .GT. LMAX) IPR(374) = IPR(374) - 2
        GO TO 100
      END IF
      DO I = 1, 80
        BZ(I) = 0
        DO J = I, 80
          AZ(I, J) = 0
        END DO
      END DO
      CALL GEN108 (LU9, 1)
      DO
        READ (LU9, END = 110) N, SUMW
        DO I = 1, N
          READ (LU9) (U0(J, I), J = 1, 3), (U1(J, I), J = 1, 3),
     1                WI(I), YI(I)
        END DO
        DO I = 1, N
          CALL GEN055 (YLM0, U0(1, I), IPR(373), IPR(374))
          CALL GEN055 (YLM1, U1(1, I), IPR(373), IPR(374))
          DO K = 1, IPR(377)
            QI(K) = 0.5 * (YLM0(K) + YLM1(K))
            XI(K) = 0.0
          END DO
          YII = 0
          DO J = 1, N
            YJ = - WI(J) * YI(J) / SUMW
            IF (J .EQ. I) YJ = YJ + YI(J)
            YII = YII + YJ
            CALL GEN055 (YLM0, U0(1, J), IPR(373), IPR(374))
            CALL GEN055 (YLM1, U1(1, J), IPR(373), IPR(374))
            DO K = 1, IPR(377)
              XI(K) = XI(K) + YJ * 0.5 * (YLM0(K) + YLM1(K))
            END DO
          END DO
          DO K = 1, IPR(377)
            BZ(K) = BZ(K) - DBLE (WI(I) * YII * XI(K))
            DO L = K, IPR(377)
              AZ(K, L) = AZ(K, L) + DBLE (WQ * QI(K) * QI(L))
     1                            + DBLE (WI(I) * XI(K) * XI(L))
            END DO
          END DO
        END DO
      END DO
  110 DO I = 1, IPR(377) - 1
        DO J = I + 1, IPR(377)
          AZ(J, I) = AZ(I, J)
        END DO
      END DO
      CALL GEN054 (IPR(377), 80, AZ, UZ, VZ)
      UMAX = 0
      DO I = 1, IPR(377)
        UMAX = MAX (UMAX, ABS(SNGL(UZ(I))))
      END DO
      NZERO = 0
      T = PAR(326) * UMAX
      DO I = 1, IPR(377)
        IF (ABS(UZ(I)) .LT. DBLE(T)) THEN
          UZ(I) = 0
          NZERO = NZERO + 1
        ELSE
          UZ(I) = 1 / UZ(I)
        END IF
      END DO
      DO I = 1, IPR(377)
        DO J = 1, IPR(377)
          AZ(I, J) = 0
        END DO
        AZ(I, I) = UZ(I)
      END DO
      DO I = 1, IPR(377)
        DO J = 1, IPR(377)
          VA(I, J) = 0
          DO K = 1, IPR(377)
            VA(I, J) = VA(I, J) + VZ(I, K) * AZ(K, J)
          END DO
        END DO
      END DO
      DO I = 1, IPR(377) - 1
        DO J = I + 1, IPR(377)
          TYUNK    = VZ(I, J)
          VZ(I, J) = VZ(J, I)
          VZ(J, I) = TYUNK
        END DO
      END DO
      DO I = 1, IPR(377)
        DO J = 1, IPR(377)
          AZ(I, J) = 0
          DO K = 1, IPR(377)
            AZ(I, J) = AZ(I, J) + VA(I, K) * VZ(K, J)
          END DO
        END DO
      END DO
      DO I = 1, IPR(377)
        ALM(I) = 0.0
        DO J = 1, IPR(377)
          ALM(I) = ALM(I) + REAL(AZ(I, J) * BZ(J))
        END DO
      END DO
      CHISQ  = 0
      SUMSQ  = 0
      AIMIN  = 1E10
      AIMAX  = 0
      SUMA   = 0
      SUMASQ = 0
      CHISQA = 0
      CALL GEN108 (LU9, 0)
      DO
        READ (LU9, END = 120) N, SUMW
        DO I = 1, N
          READ (LU9) (U0(J, I), J = 1, 3),
     1               (U1(J, I), J = 1, 3), WI(I), YI(I)
          CALL GEN055 (YLM0, U0(1, I), IPR(373), IPR(374))
          CALL GEN055 (YLM1, U1(1, I), IPR(373), IPR(374))
          AI = 1
          DO K = 1, IPR(377)
            AI = AI + ALM(K) * 0.5 * (YLM0(K) + YLM1(K))
          END DO
          YI(I)  = YI(I) * AI
          AIMIN  = MIN (AIMIN, AI)
          AIMAX  = MAX (AIMAX, AI)
          SUMA   = SUMA + AI
          SUMASQ = SUMASQ + AI**2
          CHISQA = CHISQA + (AI - 1)**2
        END DO
        DO I = 1, N
          DI = 0
          DO J = 1, N
            YJ = - WI(J) * YI(J) / SUMW
            IF (J .EQ. I) YJ = YJ + YI(J)
            DI = DI + YJ
          END DO
          CHISQ = CHISQ + WI(I) * DI**2
          SUMSQ = SUMSQ + WI(I) * YI(I)**2
        END DO
      END DO
  120 AMEAN    = SUMA / IPR(375)
      RMSDA    = SQRT(SUMASQ / IPR(375) - AMEAN**2)
      ZY       = SQRT(CHISQ / (IPR(375) - IPR(376) - IPR(377)))
      PAR(323) = SQRT(CHISQ / SUMSQ)
      ZA       = SQRT(WQ * CHISQA / (IPR(375) - IPR(376)))
      RA       = SQRT(CHISQA / SUMASQ)
      DO I = 1, IPR(377)
        SIGALM(I) = REAL(DBLE(ZY) * SQRT(AZ(I, I)))
      END DO
      DO I = 1, IPR(377)
        DO J = I, IPR(377)
          IF (AZ(I, I) * AZ(J, J) .GT. 0) THEN
            IF (I .EQ. J) THEN
              T = 1
            ELSE
              T = SNGL(AZ(I, J) / SQRT(AZ(I, I) * AZ(J, J)))
            END IF
          ELSE
            T = 0
          END IF
          CORR(I, J) = T
          CORR(J, I) = T
        END DO
      END DO
      IF (IPR(377) .LT. 80) THEN
        DO I = IPR(377) + 1, 80
          ALM(I)    = 0.0
          SIGALM(I) = 0.0
          DO J = 1, 80
            CORR(I, J) = 0.0
            CORR(J, I) = 0.0
          END DO
        END DO
      END IF
      CALL PLA262 (-18)
      WRITE (LU7, 99996, IOSTAT = IOST)
      NPAR = 0
      N0   = '0'
      N01  = 0
      N02  = 0
      N03  = 0
      SUMA = 0
      DO L = 1, MAX (IPR(373), IPR(374))
        N0 = CHAR(ICHAR('0') + L)
        N1 = ' '
        N2 = '0'
        J  = 1
        DO M = -L, L
          IF ((MOD(L, 2) .EQ. 0 .AND. L .LE. IPR(373)) .OR.
     1        (MOD(L, 2) .EQ. 1 .AND. L .LE. IPR(374))) THEN
            NPAR = NPAR + 1
            ALX = ABS(ALM(NPAR)) / SIGALM(NPAR)
            CALL PLA262 (1)
            WRITE (LU7, 99995, IOSTAT = IOST)
     1        NPAR, N0, N1//N2, ALM(NPAR), ALX
            IF (ALX .GE. 1) N01 = N01 + 1
            IF (ALX .GE. 2) N02 = N02 + 1
            IF (ALX .GE. 3) N03 = N03 + 1
            SUMA = SUMA + ALX
            J = J + 1
            N2 = CHAR(ICHAR('0') + J / 2)
            IF (MOD(J, 2) .EQ. 1) THEN
              N1 = '-'
            ELSE
              N1 = '+'
            END IF
            N0 = ' '
          END IF
        END DO
      END DO
      IPR(377) = NPAR
      WRITE (LU7, 99989, IOSTAT = IOST)
     1  N01, N02, N03, SUMA / IPR(377), NZERO, PAR(326)
      CALL PLA262 (0)
      WRITE (LU7, 99988, IOSTAT = IOST)
      WRITE (LU7, 99987, IOSTAT = IOST)
      WRITE (LU6, 99985, IOSTAT = IOST)
     1  IPR(375), IPR(376), IPR(377), Z1, PAR(322), ZY, PAR(323),
     2  ZA, RA
      WRITE (LU7, 99985, IOSTAT = IOST)
     1  IPR(375), IPR(376), IPR(377), Z1, PAR(322), ZY, PAR(323),
     2  ZA, RA
      WRITE (LU7, 99992, IOSTAT = IOST) AIMIN, AIMAX, AMEAN, RMSDA
      IF (PAR(305) .EQ. 0) THEN
        AMAX = 1.0 / AIMIN
        IF (PAR(304) .LE. 0 .OR. AMAX .LE. 0) GO TO 140
        ASPHERE = EXP(- PAR(301) * PAR(304)) / AMAX
        IF (ASPHERE .GE. 1) GO TO 140
        IF (ASPHERE .LT. AMUR(12)) ASPHERE = AMUR(12)
        DO J = 2, 12
          IF (ASPHERE .GE. AMUR(J)) GO TO 130
        END DO
  130   X = (LOG(AMUR(J)) - LOG(ASPHERE)) /
     1      (LOG(AMUR(J)) - LOG(AMUR(J - 1)))
        PAR(305) = (FMUR(J) - X * (FMUR(J) - FMUR(J - 1))) / PAR(301)
      END IF
      GO TO 150
  140 PAR(301) = 0.0
  150 CALL PLA191 (1, PAR(301) * PAR(305), YUNK)
      IPR(432) = 0
      IF (NAUTO .EQ. 1) THEN
        CALL PLA200 (6, 1, 0, 0)
        CALL GGIP (0.0, 0.0, 0.0, 6)
      END IF
      PAR(315) = 999.0
      PAR(317) = 0.0
      PAR(319) = 999.0
      PAR(320) = 0.0
      SUMN     = 0
      SUMA     = 0
      SUMASQ   = 0
      SUMV     = 0
      IPRINT   = 101
      XIMAX    = 0.0
      CALL GEN108 (LU8, 0)
      CALL GEN108 (LU9, 0)
      CALL PLA262 (-2)
      WRITE (LU7, 99994, IOSTAT = IOST)
      DO
        READ  (LU8, END = 160) N, JH, JK, JL
        IPRINT = IPRINT - 1
        THETA  = GEN056 (JH, JK, JL, RBB) * PAR(17)
        IF (ABS(THETA) .GT. 1.0) THEN
           WRITE(LU6, 99977, IOSTAT = IOST) N, JH, JK, JL, THETA
           CALL GEN127 ('ASIN() PROBLEM IN MULABS')
        END IF
        THETA = ASIN(THETA)
        DO I0 = 1, N
          READ (LU8) JH, JK, JL, YJ, SIGYJ, S0, S1
          CALL GEN055 (YLM0, S0, IPR(373), IPR(374))
          CALL GEN055 (YLM1, S1, IPR(373), IPR(374))
          A = 1
          V = 0
          DO J = 1, IPR(377)
            A    = A + ALM(J) * 0.5 * (YLM0(J) + YLM1(J))
            YLMJ = 0.5 * (YLM0(J) + YLM1(J)) * SIGALM(J)
            DO K = 1, IPR(377)
              YLMK = 0.5 * (YLM0(K) + YLM1(K)) * SIGALM(K)
              V    = V + CORR(J, K) * YLMJ * YLMK
            END DO
          END DO
          A = MAX (A, AIMIN)
          A = MIN (A, AIMAX)
          PAR(319) = MIN (PAR(319), 1.0 / A)
          PAR(320) = MAX (PAR(320), 1.0 / A)
          CALL PLA191 (0, THETA, A0)
          V    = (A0 / A)**2 * (V / A**2)
          SIGA = SQRT(V)
          A    = A0 / A
          YJ   = YJ / A
          SGYJ = SQRT(SIGYJ**2 + YJ**2 * V) / A
          WRITE (LU9) JH, JK, JL, YJ, SGYJ
          XIMAX    = MAX (XIMAX, YJ)
          PAR(315) = MIN (PAR(315), A)
          PAR(317) = MAX (PAR(317), A)
          SUMN     = SUMN   + 1
          SUMA     = SUMA   + A
          SUMASQ   = SUMASQ + A**2
          SUMV     = SUMV   + V
          IF (IPRINT .GT. 0) THEN
            IHH(I0)   = JH
            IKK(I0)   = JK
            ILL(I0)   = JL
            YI(I0)    = YJ*A
            SIGYI(I0) = SGYJ
            AII(I0)   = A
            SAA(I0)   = SIGA
            DO J = 1, 3
              U0(J, I0) = S0(J)
              U1(J, I0) = S1(J)
            END DO
          END IF
        END DO
        IF (IPRINT .GT. 0) THEN
          IF (N .GE. 2) THEN
            CALL GEN053 (N, YI, INDEX)
          ELSE
            INDEX(1) = 1
          END IF
          CALL PLA262 (N + 1)
          WRITE (LU7, 99978, IOSTAT = IOST)
          DO I = 1, N
            J = INDEX(I)
            WRITE (LU7, 99993, IOSTAT = IOST) IHH(J), IKK(J), ILL(J),
     1      YI(J), YI(J) / AII(J), SIGYI(J), AII(J), SAA(J),
     2      (U0(K, J), K = 1, 3), (U1(K, J), K = 1, 3)
          END DO
        END IF
      END DO
  160 CALL GEN108 (LU9, 1)
      CALL GEN108 (LU17, 0)
      IF (XIMAX .GT. 99999.0) THEN
        SCF = 99999.0 / XIMAX
      ELSE
        SCF = 1.0
      END IF
      NOUT = 0
      DO
        READ (LU9, END = 170) JH, JK, JL, YJ, SGYJ
        YJ   = YJ   * SCF
        SGYJ = SGYJ * SCF
        NOUT = NOUT + 1
        WRITE (LU17, 99990, IOSTAT = IOST) JH, JK, JL, YJ, SGYJ
      END DO
  170 WRITE (LU17, 99978, IOSTAT = IOST)
      WRITE (LU6, 99991, IOSTAT = IOST) PAR(315), PAR(317), NINP, NOUT
      CALL PLA262 (4)
      WRITE (LU7, 99991, IOSTAT = IOST) PAR(315), PAR(317), NINP, NOUT
      IF (NAUTO .EQ. 1) GO TO 50
  180 CLOSE (UNIT = LURA, STATUS = 'DELETE')
      CLOSE (UNIT = LURB, STATUS = 'DELETE')
      RETURN
99999 FORMAT ('MULABS - Empirical Correction for Absorption ',
     1 'Anisotropy. [c.f. R.H. Blessing, Acta Cryst. (1995), A51,',
     2 ' 33-38]', /, 132('='), /)
99998 FORMAT (3I4, 2F8.0, 4X, 6F8.5)
99997 FORMAT (/, 'Absorption Correction Variables:', /, 132('-'),
     1 /, 'L0max  = ',I2, 23X,
     2 'Even Order Limit of Spherical Harmonic Expansion', 5X,
     3 'Y(l,m); l = 0, Lmax; m = -l, +l', /, 'L1max  = ', I2, 23X,
     4 'Odd Order Limit ', /, 'mu     =', F11.3, ' mm**-1', 8X,
     5 'Linear Absorption Coefficient', /, 'Radius = ', F10.3, ' mm',
     6 12X, 'Estimated Radius of "Equivalent" Spherical Crystal', /,
     7 'Tmin   = ', F10.3,' mm', 12X,
     8 'Estimated Minimum Crystal Thickness', /, 'Tmax   = ', F10.3,
     9 ' mm', 12X, 'Estimated Maximum Crystal Thickness', /,
     * 'Umin   = ', E10.3, 15X, 'Eigenvalue Filtering Factor')
99996 FORMAT ('Fitted Absorption Anisotropy Expansion ',
     1 'Coefficients A(l, m)', /, 59('-'), //,
     2 'FSQ(Corr) = FSQ(Meas) / A', //, 'A = A(0)/(1 + SUM(L=1,Lmax)',
     3 ' Sum(M=-L,L) A(L, M)*[0.5*[Y(L, M)(-U0) + Y(L,M)(U1)]])', //,
     4 'A(0) = A(Sphere)(mu*R, Theta)', //,
     5 'Y(l,m)(U) = Y(l,m)(X, Y, Z)', //,
     5 'Where X, Y, and Z are Components of Unit Vectors Along the',
     6 ' Reverse Incident Beam,', /,
     7 ' -U0, or the Diffracted Beam, U1, Referred to Crystal',
     8 ' Fixed Cartesian (i.e., Orthonormal) Axes.', /,
     9 ' In Other Words X, Y, and, Z are Direction Cosines of the ',
     * 'Beam Direction Vectors.', //,
     1 ' I    L  M   A(l,m)     Abs(A)/Sigma(A)', /,
     2 ' -    -  -   ------     ---------------', /,
     3 ' 0    0  0   1.0')
99995 FORMAT (I2, 4X, A, 1X, A, 2X, E10.3, F10.3)
99994 FORMAT ('  H  K  L      I(Obs)    I(obs)/A Sig[I(obs)/A]',
     1 '     A  Sig(A)   K0 and K1 Direction Cosines (Cartesian)', /,
     2 132('-'))
99993 FORMAT (3I3, 3F12.2, 2F8.4, 2(1X, 3F8.4))
99992 FORMAT (//,
     1 'Statistics of Fitted Anisotropy Correction Factors, AHI:', /,
     2 'Amin                          = ', F10.4, /,
     3 'Amax                          = ', F10.4, /,
     4 'Amean                         = ', F10.3, /,
     5 'Rmsda = <(A - Amean)**2>**1/2 = ', F10.4)
99991 FORMAT (/,
     1 ':: MIN  Transmission =', F9.5, /,
     2 ':: MAX  Transmission =', F9.5, //,
     3 '::', I8, ' Reflections on Input', /,
     4 '::', I8, ' Reflections on Output', /)
99990 FORMAT (3I4, 2F8.2)
99989 FORMAT (//,
     1 'N1   = ', I3, '  A(l,m) with abs(A)/Sigma(A) .GE. 1', /,
     2 'N2   = ', I3, '    "      "        "         .GE. 2', /,
     3 'N3   = ', I3, '    "      "        "         .GE. 3', //,
     4 '<abs(A) / Sigma(A)> = ', E9.2, //,
     5 'N0   = ', I3, 10X, 'Zeroed Pseudo-Parameters From EigenValue',
     6 ' Filtering', /,
     7 'Umin = ', E11.3, 2X, 'Minimum Permitted EigenValue Magnitude',
     8 ' Expressed as Fraction of the Maximum EigenValue Magnitude')
99988 FORMAT (
     1 'Statistics-of-Fit for the A(l,m) Expansion Coefficients:', /,
     2 56('-'), //, 'Total Residual', 8X, 'CHISQ    = CHISQ(Y) + ',
     3 'CHISQ(A)', //, 'Fit Residual', 10X, 'CHISQ(Y) = Sum(H) ',
     4 'Sum(I=1,N) WHI*(YHI*AHI - <YHI*AHI>)**2', /, 31X,
     5 '= Sum(H) Sum(I=1,N) ',
     6 'WHI*(YHI*AHI - Sum(J=1,N) WHJ*YHJ*AHJ/Sum(J=1,N) WHJ)**2', //,
     7 'Restraint Residual    CHISQ(A) = Sum(H) Sum(I=1,N) W*(AHI - 1)'
     8 , '**2', //, 'Where here the AHI are Absorption Anisotropy ',
     9 'Correction Factors, i.e., Reciprocal Transmission Factors,', /,
     * '    FSQ(Corr) = FSQ(Meas)*A', /, '    A = 0.5*(A(-U0) + A(U1))'
     1 , /,'    A(U) = 1 + Sum(L=1,Lmax) Sum(M=-L,L) A(L,M)*Y(L,M)(U)'
     2 , // , 'The Terms in THE Fit Residual are Weighted by', /,
     3 '    WHI = 1/Sigma(YHI)**2,', //,
     4 'And the Restraint Residual has a Constant Weighting Factor', /,
     5 '    W = 1.0/(<WHI*(YHI - <YHI>)**2>/<WHI*YHI**2>),', //,
     6 'Which Serves to Adjust the Restraint Residual to a Scale',
     7 ' Comparable to the Fit Residual.', /)
99987 FORMAT ('Standardized Root-MeanSquare Error-of-Fit', 9X,
     1 'Z  = Sqrt(CHISQ(Y)/(NOBS - NHKL - NPAR))', //,
     2 'Normalized Root-Mean-Square Error-of-Fit', 10X, 'RW =',
     3 ' Sqrt(CHISQ(Y)/Sum(WHI*(YHI*AHI)**2))', //,
     4 'Standardized Root-Mean-Square Restraint Residual  ZA = ',
     5 'Sqrt(CHISQ(A)/(NOBS - NHKL))', //,
     6 'Normalized Root-Mean-Square Restraint Residual',
     7 '    RA = Sqrt(Sum((AHI - 1)**2)/Sum(AHI**2))')
99986 FORMAT (/, 'Sin(Theta)/Lambda Limits of the Unique Data:', /,
     1 'Smin = ', F7.3, ',  Smax = ', F7.3, ' A(-1)', /)
99985 FORMAT (/, 'Numerical Statistics-of-Fit:', //, 'N(obs) = ', I6,
     2' Measurements', /, 'N(hkl) = ', I6, ' Unique Reflections', /,
     3'N(par) = ', I6, ' Coefficients A(l,m)', //, 'Z  = ',F6.3,
     4'    RW = ', F7.4, '    For All AHI = 1 (N(par) = 0)', //,
     5'Z  = ', F6.3, '    RW = ', F7.4,
     6'    For the AHI From the Fitted A(L,M)', /, 'ZA = ', F6.3,
     7'    RA = ',F7.4)
99984 FORMAT (//, 'Reflection Data Selected for Empirical Absorption',
     1 ' Fitting:', /, 59('-'), //,
     2 'Minimum Permitted sin(Theta/Lambda', 10X, '=', F11.3,
     3 ' Ang**-1', /, 'Maximum Permitted sin(Theta)/Lambda)', 8X,
     4 '=', F11.3,' Ang**-1', //, 'Minimum Permitted FSQ/Sigma(FSQ)',
     5 12X, '= ', E10.3, /, 'Maximum Permitted FSQ', 23X, '= ', E10.3,
     6 //, 'Minimum Permitted FSQ(I)/FSQ(Sample Median) = ', E10.3, /,
     7 'Maximum Permitted FSQ(I)/FSQ(Ssmple Median) = ', E10.3, //,
     8 'Nobs = ', I10, ' Reflection Measurements Selected', /,
     9 'Nhkl = ', I10, ' Unique Reflections Represented')
99983 FORMAT (/, 'N3 = ', I5, 6X,
     1 '"           "          "       "    Sin(TH)/L',
     2 ' .LT. SMIN1 = ',F5.3,' OR .GT. SMAX1 = ', F5.3, /, 'N6 =',
     3 I6, 6X, '"           "          "       "    Sigma(Ymeas',
     4 ') .LE. 0', /, 'N7 =',
     5 I6, 6X, '"           "          "       "    Ymeas .LT.',
     6 ' -4*Sigma(Ymeas)')
99982 FORMAT ('FSQMIN = ', F5.2, 20X, 'Minimum FSQ/Sigma(FSQ) ',
     1 'for Measurements Used for YLM Fit', /,
     2 'FSQMAX = ', E10.3,
     3 15X, 'Maximum FSQ for Measurements Used for YLM Fit', /,
     4 'STLMIN = ', F5.2, ' Ang**-1', 12X, 'Min Sin(Theta)/Lambda ',
     5 'For Reflections Used for YLM Fit', /,
     6 'STLMAX = ', F5.2,
     7 ' Ang**-1', 12X, 'Max Sin(Theta)/Lambda for Reflections Used',
     8 ' for YLM Fit', /,
     9 'Amin   = ', E10.3, 15X,
     * 'Minimum Expected Relative Transmission Factor', /,
     1 'Amax   = ', E10.3, 15X,
     2 'Maximum Expected Relative Transmission Factor')
99981 FORMAT (/, 4X, 'Mu = 0.0  Only Transmission Anisotropy Factors,',
     1 ' 0 < A < Amax, Amean Approximately 1, will be Calculated.')
99980 FORMAT (//,'    Radius = 0 and TMIN = 0.  only Transmission ',
     1 'Anisotropy Factors, 1 - X < A < 1 + X, <A> = 1,  will be ',
     2 'Calculated.')
99979 FORMAT (4X, 'If Radius .EQ. 0, and Tmin .GT. 0, Radius will ',
     1 'be Estimated From', /, 5X, 'A(Sphere) = A(LIMIT)/A(MAX),', /,
     2 5X, 'Where A(Limit) = Exp(-Mu*Tmin),', /,
     3 5X, 'and A(MAX) is the Maximum Transmission Anisotropy ',
     4 'Factor From the YLM Fitting.')
99978 FORMAT (1X)
99977 FORMAT (4I5, F10.3)
99976 FORMAT (A)
99975 FORMAT (':: Too Few Data to Fit Transmission Surface')
99974 FORMAT ('WAVELENGTH NOT GIVEN')
99973 FORMAT ('|SIN(THETA)| > 1.0 ?', 3I5, F10.5, /)
99972 FORMAT ('Read   =', I7, ' Measurements')
99971 FORMAT ('Accept =', I7, ' Measurements')
      END SUBROUTINE PLA187
      SUBROUTINE PLA188 (MODE, JB, JE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP52=200,NP56=30,
     2 NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ABSPSI/ PSIS(38, 4, 10), OP(3, 3, 11), IHKLPS(4, 10),
     1 NPSI
      CHARACTER TXT(3)*3
      TXT(1) = 'Obs'
      TXT(2) = 'Cal'
      TXT(3) = 'Cor'
      DO J = JB, JE
   10   CALL PLA200 (MODE, 1, 0, 0)
        CALL GGIP (13.0, 12.0, 0.0, -3)
        CALL GGIP09 (0.0, 'Psi-Scan', 8,  0.6, 1, 2, 15.3, -11.5)
        CALL GGIP09 (0.0, '0',        1, 0.25, 1, 2, 12.0,  -0.1)
        CALL GGIP09 (0.0, '270',      3, 0.25, 1, 2, -0.2, -11.3)
        CALL GGIP09 (0.0, '180',      3, 0.25, 1, 2,-12.1,   0.3)
        CALL GGIP09 (0.0, '90',       2, 0.25, 1, 2, -0.2,  11.4)
        DO K = 1, 4
          CALL GGIP (0.0, FLOAT(K), 0.0, 0)
          IF (K .GT. 1) THEN
            TEMP1 = 9999999.0
            DO I = 1, 36
              IF (PSIS(I, K, J) .GE. 0.01)
     1          TEMP1 = MIN (TEMP1, PSIS(I, K, J))
            END DO
            IPERC = NINT(TEMP1 * 100.0)
            IPX = 0
            YPL = 10.5 + 1.5 - K * 0.75
            CALL GGIP09 (0.0, TXT(K - 1), 3, 0.5, -1, 2, 8.4, YPL)
            CALL GEN040 (IPERC, NQ1, IPX)
            CALL GGIP09 (0.0, NQ1, IPX, 0.5, -1, 2, 11.0, YPL)
          END IF
          DO 60 I = 1, 36
            PSI = PSIS(I, 1, J) / RGBL(6)
            XPL =  COS(PSI)
            YPL =  SIN(PSI)
            XP  = 6.0
            YP  = 6.0
            DS  = 0.1 * (K - 1)
            IF (K .GT. 1) THEN
              PSS = PSIS(I, K, J)
              IF (PSS .LT. 0.0) PSS = 0.0
              XP = PSS * XP
              YP = PSS * YP
            END IF
            XPL = XPL * (XP + 5.0)
            YPL = YPL * (YP + 5.0)
            IF (K .GT. 1) THEN
              IF (I .EQ. 1) THEN
                XP0 = XPL
                YP0 = YPL
                GO TO 30
              END IF
              CALL GGIP (XPL, YPL, 0.0, 2)
            END IF
   30       YPL = YPL - DS
            CALL GGIP (XPL, YPL, 0.0, 3)
            IF (K .LE. 1) THEN
              XPL = XPL * (5.0 / 11.5)
              YPL = YPL * (5.0 / 11.5)
              CALL GGIP (XPL, YPL, 0.0, 2)
            GO TO 60
            END IF
            DO L = 1, 3, 2
              DY = DS * (2 - L)
              DO M = 1, 3, 2
                DX  = DS * (2 - M) * (2 - L)
                XPL = XPL + DX
                YPL = YPL + DY
                CALL GGIP (XPL, YPL, 0.0, 2)
              END DO
            END DO
            YPL = YPL + DS
            CALL GGIP (XPL, YPL, 0.0, 3)
   60     CONTINUE
          IF (K .NE. 1) THEN
            CALL GGIP (XP0, YP0, 0.0, 2)
            CALL GGIP (0.0, 0.0, 0.0, 3)
          END IF
        END DO
        CALL GGIP (0.0, 1.0, 0.0, 0)
        DO JJ = 1, 3
          XPL = 5 + JJ * 2
          CALL GEN040 (IHKLPS(JJ, J), NQ1, IPX)
          CALL GGIP09 (0.0, NQ1, IPX, 0.5, -1, 2, XPL, -11.5)
        END DO
        CALL GGIP (0.0, 0.0, 0.0, 3)
        CALL GGIP (0.0, 0.0,   0.0, -1)
        CALL PLA013 (0, 1)
        CALL PLA006 (0, IS)
        SELECT CASE (IFL(1)(1:4))
          CASE ('PLOT')
            GOTO 10
          CASE ('EXIT')
            GO TO 100
        END SELECT
      END DO
  100 RETURN
      END SUBROUTINE PLA188
      SUBROUTINE PLA189
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,
     3 NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /ISCR/ IHLP(21)
      COMMON /ABSPSI/ PSIS(38, 4, 10), OP(3, 3, 11), IHKLPS(4, 10),
     1 NPSI
      IHO   = 0
      IKO   = 0
      ILO   = 0
      NPSI  = 0
      MPSI  = 0
      KAS   = 0
      I1    = IHLP(IHLP(1) + 1) - 13
   10 I1    = I1 + 14
      V6(1) = VOID(I1)
      V6(2) = VOID(I1 + 1)
      V6(3) = VOID(I1 + 2)
      V2(1) = VOID(I1 + 5)  * PAR(135)
      V3(1) = VOID(I1 + 6)  * PAR(135)
      V2(2) = VOID(I1 + 7)  * PAR(136)
      V3(2) = VOID(I1 + 8)  * PAR(136)
      V2(3) = VOID(I1 + 9)  * PAR(137)
      V3(3) = VOID(I1 + 10) * PAR(137)
      IH = NINT(V6(1))
      IK = NINT(V6(2))
      IL = NINT(V6(3))
      IF (IH .LT. - 999.0) GO TO 30
      CALL GEN002 (-2, ROR, V6, V8, XLNG)
      IF (IH .NE. IHO .OR. IK .NE. IKO .OR. IL .NE. ILO) THEN
        IF (NPSI .GT. 0) THEN
          IF (IHKLPS(4, NPSI) .LT. 37) THEN
            WRITE (LU6, 99999, IOSTAT = IOST) IHO, IKO, ILO
            NPSI = NPSI - 1
            IF (IHKLPS(4, NPSI + 1) .EQ. 2) GO TO 130
          END IF
        END IF
        IHO  = IH
        IKO  = IK
        ILO  = IL
        MPSI = 1
        IF (NPSI .EQ. 10) THEN
          WRITE (LU6, 99998, IOSTAT = IOST)
          GO TO 30
        END IF
        NPSI = NPSI + 1
        IHKLPS(1, NPSI) = IH
        IHKLPS(2, NPSI) = IK
        IHKLPS(3, NPSI) = IL
        DO J = 1, 3
          QM(J, 3) = V8(J)
          QM(J, 2) = 0.0
        END DO
        YUNKM = 2.0
        IF (NPSI .EQ. 1) THEN
          DO J = 1, 3
            YUNK = GEN009(OR(1, J), V8) /
     1             SQRT(GEN009(OR(1, J), OR(1, J)))
            IF (ABS(YUNK) .LT. YUNKM) THEN
              YUNKM = ABS(YUNK)
              KAS = J
            END IF
          END DO
        END IF
        QM(KAS, 2) = 1.0
        CALL GEN008 (QM(1, 2), QM(1, 3), QM(1, 1), 1)
        CALL GEN008 (QM(1, 3), QM(1, 1), QM(1, 2), 1)
        CALL GEN005 (QM, DUMV)
        CALL GEN004 (DUMV, OR, OP(1, 1, NPSI))
      END IF
      CALL GEN002 (2, OP(1, 1, NPSI), V2, V4, XLNG)
      CALL GEN002 (2, OP(1, 1, NPSI), V3, V5, XLNG)
      IF (V5(3) .LT. 0.99999) THEN
        PHI = ATAN2(V5(2), V5(1)) * RGBL(6)
      ELSE
        PHI = 0.0
      END IF
      MPSI                = MPSI + 1
      PSIS(MPSI, 1, NPSI) = MOD(360.0 + PHI, 360.0)
      PSIS(MPSI, 2, NPSI) = VOID(I1 + 3)
      PSIS(MPSI, 3, NPSI) = VOID(I1 + 11)
      IHKLPS(4, NPSI)     = MPSI
      GO TO 10
   30 IF (NPSI .GT. 0) THEN
        DO K = 1, NPSI
          MPSI = IHKLPS(4, K)
   40     ICHANGE = 0
          DO J = 2, MPSI - 1
            IF (PSIS(J, 1, K) .GT. PSIS(J + 1, 1, K)) THEN
              DO I = 1, 3
                CALL GEN018 (PSIS(J, I, K), PSIS(J + 1, I, K))
              END DO
              ICHANGE = 1
            END IF
          END DO
          IF (ICHANGE .NE. 0) GO TO 40
          L = 2
          PSISL = PSIS(L, 1, K)
          DO J = 3, MPSI
            PSISJ = PSIS(J, 1, K)
            IF (ABS(PSISJ - PSISL) .GT. 0.05) THEN
              L = L + 1
              DO I = 1, 3
                PSIS(L, I, K) = PSIS(J, I, K)
              END DO
              PSISL = PSIS(L, 1, K)
            END IF
          END DO
          IHKLPS(4, NPSI) = L
          PSIS(1, 1, K)   = PSIS(37, 1, K) - 360.0
          PSIS(1, 2, K)   = PSIS(37, 2, K)
          PSIS(1, 3, K)   = PSIS(37, 3, K)
          DO I = 1, 36
            PHI = (I - 1) * 10.0
            PH1 = 2 - I + PSIS(I, 1, K) / 10.0
            PH2 = I     - PSIS(I + 1, 1, K) / 10.0
            T1  = PSIS(I,     2, K)
            T2  = PSIS(I + 1, 2, K)
            T3  = PSIS(I,     3, K)
            T4  = PSIS(I + 1, 3, K)
            PSIS(I, 1, K) = PHI
            PSIS(I, 2, K) = (PH1 * T1 + PH2 * T2) / (PH1 + PH2)
            PSIS(I, 3, K) = (PH1 * T3 + PH2 * T4) / (PH1 + PH2)
            IF (PSIS(I, 3, K) .GT. 0.0) THEN
              PSIS(I, 4, K) = PSIS(I, 2, K) / PSIS(I, 3, K)
            ELSE
              PSIS(I, 4, K) = 0.0
            END IF
          END DO
          PSIS(37, 1, K) = 360.0
          PSIS(37, 2, K) = PSIS(1, 2, K)
          PSIS(37, 3, K) = PSIS(1, 3, K)
          PSIS(37, 4, K) = PSIS(1, 4, K)
          PMAX2 = 0.0
          PMAX3 = 0.0
          PMAX4 = 0.0
          DO I = 1, MPSI
            PMAX2 = MAX (PMAX2, PSIS(I, 2, K))
            PMAX3 = MAX (PMAX3, PSIS(I, 3, K))
            PMAX4 = MAX (PMAX4, PSIS(I, 4, K))
          END DO
          DO I = 1, MPSI
            PSIS(I, 2, K) = PSIS(I, 2, K) / PMAX2
            PSIS(I, 3, K) = PSIS(I, 3, K) / PMAX3
            PSIS(I, 4, K) = PSIS(I, 4, K) / PMAX4
          END DO
        END DO
      END IF
  130 RETURN
99999 FORMAT ('E: PSI-SCAN FOR', 3I4,
     1 ' SKIPPED (CONTAINS NOT EXACTLY 36*10 DEG. STEPS)')
99998 FORMAT ('E: TOO MANY PSI-SCANS - (ADDITIONAL ONES IGNORED)')
      END SUBROUTINE PLA189
      SUBROUTINE PLA190
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NXT1=100,
     4 NXT2=200,NXT3=100,NXT4=200)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /ISCR/ IHLP(21)
      COMMON /P190/ NVRR, PMILL(NXT1, 5), XTLV(7, NXT2), IDG(NXT4, 4),
     1 XYZPL(3, NXT2), CFACE(5, NXT2), IEDGE(NXT3), NFACES, NEDGE, NVER
      COMMON /ABSPSI/ PSIS(38, 4, 10), OP(3, 3, 11), IHKLPS(4, 10),
     1 NPSI
      DIMENSION IHMIN(3), IHMAX(3)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      I2       = 0
      MODE     = IPR(78)
      TIM1     = CPUTIM()
      NRF      = 0
      PAR(301) = PAR(162)
      IPR(388) = 1
      IGBL(75) = 1
      IGBL(6)  = 16
      IF (IPR(220) .GT. 1) THEN
        IF (IFL(2)(1:4) .EQ. 'DIRC') IPR(445) = 1
      END IF
      IF (MODE .EQ. -1 .OR. MODE .EQ. 4) PAR(321) = FN(1)
      IF (PAR(301) .EQ. 0.0 .OR.
     1   (MODE .EQ. -1 .AND. PAR(321) .EQ. 0.0)) THEN
        NAUTO = IGBL(25)
      ELSE
        NAUTO = 0
      END IF
      CALL PLA080
      CALL GEN052 (OR, OP(1, 1, 11))
      CALL PLA042 (0)
   10 IF (NFACES .GT. 0 .AND. MODE .NE. -1) THEN
        CALL PLA262 (0)
        WRITE (LU7, 99995, IOSTAT = IOST)
        DO J = 1, NFACES
          DO I = 1, 3
            V1(I) = PMILL(J, I)
          END DO
          WRITE (LU7, 99994, IOSTAT = IOST)
     1      J, (V1(I), I = 1, 3), PMILL(J, 5)
          PMILL(J, 4) = PMILL(J, 5) * SQRT (GEN006 (V1, RBB, V1))
        END DO
        WRITE (LU7, 99991, IOSTAT = IOST)
        CALL GEN097 (IEDGE, 1, NXT3, 0)
        NVER = 0
        NVRR = 0
        N1   = NFACES - 1
        N2   = N1 - 1
        DO K = 1, N2
          DO I = 1, 3
            PAT(1, I) = PMILL(K, I)
          END DO
          V1(1) = PMILL(K, 4)
          K1 = K + 1
          DO L = K1, N1
            DO I = 1, 3
              PAT(2, I) = PMILL(L, I)
            END DO
            V1(2) = PMILL(L, 4)
            L1 = L + 1
            DO 130 M = L1, NFACES
              DO I = 1, 3
                PAT(3, I) = PMILL(M, I)
              END DO
              V1(3) = PMILL(M, 4)
              CALL GEN003 (PAT, QM, DET, 0)
              IF (DET .NE. 0.0) THEN
                CALL GEN002 (1, QM, V1, V2, XLNG)
                DO J0 = 1, NFACES
                  CHECK = 0.0
                  DO I0 = 1, 3
                    CHECK = CHECK + PMILL(J0, I0) * V2(I0)
                  END DO
                  IF (PMILL(J0, 4) .LT. CHECK - 0.00001) GO TO 130
                END DO
                NVER          = NVER + 1
                IF (NVER .GT. NXT2) GO TO 230
                XTLV(4, NVER) = K
                XTLV(5, NVER) = L
                XTLV(6, NVER) = M
                XTLV(7, NVER) = NVER
                IEDGE(K) = 1
                IEDGE(L) = 1
                IEDGE(M) = 1
                ICHK = 1
                DO K0 = 1, NVER - 1
                  IF (ABS(XTLV(1, K0) - V2(1)) +
     1                ABS(XTLV(2, K0) - V2(2)) +
     2                ABS(XTLV(3, K0) - V2(3)) .LT. 0.00001) THEN
                      ICHK = 0
                      XTLV(7, NVER) = K0
                    GO TO 110
                  END IF
                END DO
  110           NVRR = NVRR + ICHK
                WRITE (LU7, 99990, IOSTAT = IOST)
     1                 NVER, NINT(XTLV(7, NVER)), V2, K, L, M
                DO IPLOT = 1, 3
                  XTLV(IPLOT, NVER) = V2(IPLOT)
                END DO
              END IF
  130       CONTINUE
          END DO
        END DO
        WRITE (LU7, 99988, IOSTAT = IOST)
        DO I = 1, NFACES
          IF (IEDGE(I) .NE. 1) THEN
            WRITE (LU7, 99989, IOSTAT = IOST) I
            WRITE (LU6, 99989, IOSTAT = IOST) I
            IF (NAUTO .EQ. 0) GO TO 450
          END IF
        END DO
        WRITE (LU7, 99993, IOSTAT = IOST)
        NEDGE = 0
        NF    = NVER - 1
        DO I = 1, NF
          I1 = I + 1
          DO 210 J = I1, NVER
            IO = NINT(XTLV(7, I))
            JO = NINT(XTLV(7, J))
            IF (JO .EQ. IO) GO TO 210
            IF (IO .GT. JO) CALL GEN014 (IO, JO)
            MC = 0
            DO K = 1, 3
              DO L = 1, 3
                IF (XTLV(K + 3, I) .EQ. XTLV(L + 3, J)) THEN
                  MC = MC + 1
                  IF (MC .EQ. 2) THEN
                    DO M = 1, NEDGE
                      IF (IDG(M, 1) .EQ. IO) THEN
                        IF (IDG(M, 2) .EQ. JO) GO TO 210
                      END IF
                    END DO
                    DO N = 1, 3
                      V1(N)  = XTLV(N, I) - XTLV(N, J)
                    END DO
                    EDGE = SQRT(GEN006 (V1, RAA, V1))
                    NEDGE = NEDGE + 1
                    WRITE (LU7, 99992, IOSTAT = IOST)
     1                NEDGE, IO, JO, EDGE
                    IDG(NEDGE, 1) = IO
                    IDG(NEDGE, 2) = JO
                    IDG(NEDGE, 3) = I
                    IDG(NEDGE, 4) = J
                    GO TO 210
                  END IF
                END IF
              END DO
            END DO
  210     CONTINUE
        END DO
      END IF
  230 IF (NAUTO .EQ. 1) THEN
        INEXT   = 0
        IGBL(6) = 16
        IF (MODE .EQ. -1 .OR. MODE .EQ. 0  .OR. MODE .EQ. 1
     1        .OR. MODE .EQ. 2 .OR.
     1      MODE .EQ. 3 .OR.  MODE .EQ. 4) THEN
          ICRT  = 0
          ANGLE = 0
          NOCLS = 0
  240     CALL PLA200 (MODE, INEXT, NOCLS, 0)
          IF (ICRT .GT. 0) THEN
            BCD = 'Click on Window to STOP Rotation'//CHAR(0)
            CALL GGIP (-999.0, 2.0, 33.0, 111)
            XG = 0.0
            YG = 0.0
            ZG = 0.0
            IG = 9
            CALL GGIP (XG, YG, ZG, IG)
            IF (IG .GT. 0) THEN
              ICRT  = 0
              NOCLS = 0
            ELSE
              NOCLS = -1
              CALL PLA200 (MODE, INEXT, NOCLS, 0)
              NOCLS =  1
              CALL GEN051 (1, OP(1, 1, 11), ANGLE, ICRT)
              GO TO 240
            END IF
          END IF
          CALL PLA013 (0, 1)
          CALL PLA006 (0, IS)
          SELECT CASE (IFL(1)(1:5))
            CASE ('MU   ')
              PAR(301) = FN(1)
              IPR(441) = 0
            CASE ('MUR  ')
              PAR(321) = FN(1)
              IPR(443) = 0
            CASE ('FACE ')
              IF (IPR(221) .EQ. 4) THEN
                IF (NFACES .GT. 0) THEN
                  DO 260 I = 1, NFACES
                    DO J = 1, 3
                      IF (ABS(PMILL(I, J) - FN(J)) .GT. 0.001) GO TO 260
                    END DO
                    GO TO 270
  260             CONTINUE
                END IF
                NFACES = NFACES + 1
                I      = NFACES
  270           DO J = 1, 4
                  PMILL(I, J) = FN(J)
                END DO
                PMILL(I, 5) = FN(4)
                IPR(451) = 0
                GO TO 10
              END IF
            CASE ('DELF ')
              IF (IPR(221) .EQ. 3) THEN
                DO I = 1, NFACES
                  IF (PMILL(I, 1) .EQ. FN(1) .AND.
     1                PMILL(I, 2) .EQ. FN(2) .AND.
     2                PMILL(I, 3) .EQ. FN(3)) THEN
                    IF (I .LT. NFACES) THEN
                      DO J = 1, 5
                        PMILL(I, J) = PMILL(NFACES, J)
                      END DO
                    END IF
                    NFACES = NFACES - 1
                    GO TO 10
                  END IF
                END DO
              END IF
            CASE ('GRID ')
              IF (IPR(221) .EQ. 3) THEN
                IPR(421) = NINT(FN(1))
                IPR(422) = NINT(FN(2))
                IPR(423) = NINT(FN(3))
                IPR(444) = 0
              END IF
            CASE ('NEXT ', 'CALC ')
              IF (IPR(432) .GT. 0) GO TO 440
              IF (PAR(301) .EQ. 0.0) THEN
                IF (MODE .NE. -1 .AND. MODE .NE. 4) THEN
                  CALL PLA015 (0, 46)
                  GO TO 240
                END IF
              END IF
              INEXT = INEXT + 1
              GO TO 310
            CASE ('XROT ')
              CALL GEN051 (1, OP(1, 1, 11), FN(1) / RGBL(6), 1)
            CASE ('YROT ')
              CALL GEN051 (1, OP(1, 1, 11), FN(1) / RGBL(6), 2)
            CASE ('ZROT ')
              CALL GEN051 (1, OP(1, 1, 11), FN(1) / RGBL(6), 3)
            CASE ('CROTX')
              ANGLE = FN(1) / RGBL(6)
              CALL GEN051 (1, OP(1, 1, 11), ANGLE, 1)
              ICRT = 1
            CASE ('CROTY')
              ANGLE = FN(1) / RGBL(6)
              CALL GEN051 (1, OP(1, 1, 11), ANGLE, 2)
              ICRT = 2
            CASE ('CROTZ')
              ANGLE = FN(1) / RGBL(6)
              CALL GEN051 (1, OP(1, 1, 11), ANGLE, 3)
              ICRT = 3
            CASE ('PLOT ')
              GO TO 240
            CASE ('END  ')
              GO TO 440
            CASE ('EXIT ')
              GO TO 440
          END SELECT
          GO TO 240
        END IF
      END IF
  310 IF (IPR(39) .GT. 0) THEN
        CALL PLA023 (0)
        NATO = IPR(589)
        IF (NATO .LT. 0) CALL GEN127 ('PLA190')
      END IF
      IF (MODE .EQ. -1) THEN
        CALL PLA191 (1, PAR(321), YUNK)
        IPR(363) = 0
      END IF
      IHLP(1) = 0
      IHLP(2) = 10000
      I1      = IHLP(2) + 1
      I2      = IHLP(2) + 11
      NREF    = 0
      WRITE (LU6, 99998, IOSTAT = IOST) NAMEFIL(1:KNMFIL)//'.hkl'
      IF (IGBL(37) .EQ. 0 .AND. IPR(78) .NE. -1) THEN
        IPR(2) = 37
        GO TO 440
      ELSE IF (IGBL(37) .EQ. 1) THEN
        WRITE (LU6, 99987, IOSTAT = IOST)
        I2 = IHLP(2) + 11
      ELSE IF (IGBL(37) .EQ. 2) THEN
        WRITE (LU6, 99986, IOSTAT = IOST)
        I2 = IHLP(2) + 6
      END IF
      CALL GEN108 (LU16, 0)
      CALL PLA290 (0)
      GO TO 330
  320 READ (LU16, 99985, END = 360) PRBUF
      IF (INDEX(PRBUF, '<?') .NE. 0) GO TO 360
      BACKSPACE LU16
  330 IF (IGBL(37) .EQ. 1 .OR. MODE .EQ. -1) THEN
        IF (IGBL(9) .EQ. 0) THEN
          READ (LU16, 99981, END = 360) (VOID(I), I = I1, I1 + 4),
     1        VOID(I1 + 13), (VOID(I), I = I1 + 5, I2)
        ELSE
          IPR(2) = 65
          GO TO 440
        END IF
      ELSE
        READ (LU16, 99980, END = 360) (VOID(I), I = I1, I2)
      END IF
      VOID(I1 + 11) = 1.0
      VOID(I1 + 12) = 0.0
      IF (NINT(VOID(I1 + 13)) .EQ. 0) VOID(I1 + 13) = 1.0
      IH = NINT(VOID(I1))
      IK = NINT(VOID(I1 + 1))
      IL = NINT(VOID(I1 + 2))
      IF (ABS(IH) + ABS(IK) + ABS(IL) .GT. 0.1) THEN
        STH = SQRT(GEN095 (PAR(391), IH, IK, IL)) * PAR(17)
        IF (IPR(363) .NE. 0) THEN
          IF (IGBL(37) .NE. 2) THEN
            L = 3
            DO K = 1, 3
              L = L + 2
              V4(K) = PAR(134 + K) * VOID(I1 + L)
              V5(K) = PAR(134 + K) * VOID(I1 + L + 1)
            END DO
            TPRIM = GEN009 (VOID(I1), V4)
            TDIFF = GEN009 (VOID(I1), V5)
            DUMMY = GEN006 (V4, RAA, V5) /
     1              SQRT(GEN006 (V4, RAA, V4) * GEN006 (V5, RAA, V5))
            IF (ABS(DUMMY) .GT. 1.0) DUMMY = SIGN (1.0, DUMMY)
            IF (ABS(STH) .GT. 0.99999999)
     1        WRITE (LU6, 99984, IOSTAT = IOST) IH, IK, IL, STH
            TH1 = ASIN(STH) * RGBL(6)
            TH2 = 90.0 - ACOS(DUMMY) * RGBL(6) / 2.0
            CALL PLA291 (TPRIM, TDIFF, TH1, TH2, ITEST)
            IF (ITEST .EQ. 1) GO TO 360
          ELSE
            CALL GEN106 (VOID(I1), STH, VOID(I1 + 5) / RGBL(6),
     1                   RAA, RBB, V6, V8, PAR(135))
            L = 3
            DO K = 1, 3
              L                = L + 2
              VOID(I1 + L)     = V6(K)
              VOID(I1 + L + 1) = V8(K)
            END DO
          END IF
        END IF
        NREF = NREF + 1
        IF (MODE .EQ. -1) THEN
          CALL PLA191 (0, STH, ASTAR)
          VOID (I2 + 1) = ASTAR
        END IF
        IF (IPR(39) .GT. 0) THEN
          ACAL = 0
          BCAL = 0
          CALL PLA135 (IH, IK, IL, ACAL, BCAL, ACALA, BCALA,
     1      ACALAF, BCALAF,  DUM)
          ACAL = ACAL + ACALA
          BCAL = BCAL + BCALA
          VOID(I2 + 2) = ACAL**2 + BCAL**2
        END IF
        I1 = I1 + 14
        IF (IGBL(37) .EQ. 1 .OR. MODE .EQ. -1) THEN
          I2 = I1 + 10
        ELSE
          I2 = I1 + 5
        END IF
      ELSE
        IF (VOID(I1 - 1) .GT. -1000.0) THEN
          VOID (I1)         = - 1000.0
          IHLP(1)           = IHLP(1) + 1
          IHLP(IHLP(1) + 2) = I1
          I1                = I1 + 1
          I2                = I1 + 10
        END IF
      END IF
      GO TO 320
  360 IF (NREF .EQ. 0) THEN
        IPR(2) = 39
        GO TO 440
      END IF
      IPR(383) = NREF
      IF (IGBL(37) .EQ. 1) CALL PLA290 (-1)
      IF (VOID(I1 - 1) .GT. -1000.0) THEN
        VOID (I1) = - 1000.0
        IHLP(1)   = IHLP(1) + 1
      END IF
      IF (MODE .EQ. 1) THEN
        CALL PLA193 (IHLP(1) + 1)
        CALL PLA189
        IF (NPSI .LE. 0) THEN
          IPR(2) = 38
        ELSE
          CALL PLA188 (MODE, 1, NPSI)
        END IF
        IF (NAUTO .EQ. 1) GO TO 230
        GO TO 440
      ELSE IF (MODE .EQ. 2) THEN
        IF (IGBL(25) .EQ. 0 .AND. PAR(301) .EQ. 0.0) THEN
          IPR(2) = 35
          GO TO 440
        END IF
        CALL PLA192 (2)
      ELSE IF (MODE .EQ. 3) THEN
        IF (IGBL(25) .EQ. 0 .AND. PAR(301) .EQ. 0.0) THEN
          IPR(2) = 35
          GO TO 440
        END IF
        CALL PLA193 (2)
      ELSE IF (MODE .EQ. 4) THEN
        IF (IHLP(1) .LE. 1) THEN
          IPR(2) = 38
          GO TO 440
        END IF
        CALL PLA191 (1, PAR(321), YUNK)
        CALL PLA189
        IF (NPSI .LE. 0) THEN
          IPR(2) = 38
          GO TO 440
        END IF
        CALL PLA262 (0)
        WRITE (LU7, 99997, IOSTAT = IOST) NPSI
        ILP  = 1
        I1   = IHLP(2) - 13
  370   I1   = I1 + 14
        IH   = NINT(VOID(I1))
        IK   = NINT(VOID(I1 + 1))
        IL   = NINT(VOID(I1 + 2))
        XINT = VOID(I1 + 3)
        SINT = VOID(I1 + 4)
        IF (IH .LT. - 999) THEN
          ILP = ILP + 1
          IF (ILP .GT. IHLP(1)) THEN
            GO TO 390
          ELSE
            I1 = I1 - 13
            GO TO 370
          END IF
        END IF
        THETA = ASIN(GEN056 (IH, IK, IL, RBB) * PAR(17))
        V2(1) = VOID(I1 + 5)  * PAR(135)
        V3(1) = VOID(I1 + 6)  * PAR(135)
        V2(2) = VOID(I1 + 7)  * PAR(136)
        V3(2) = VOID(I1 + 8)  * PAR(136)
        V2(3) = VOID(I1 + 9)  * PAR(137)
        V3(3) = VOID(I1 + 10) * PAR(137)
        TT    = 0.0
        DO K = 1, NPSI
          CALL GEN002 (2, OP(1, 1, K), V2, V4, XLNG)
          CALL GEN002 (2, OP(1, 1, K), V3, V5, XLNG)
          IF (V4(3) .LT. 0.99999) THEN
            PHI1 = MOD(ATAN2 (V4(2), V4(1)) * RGBL(6) + 360.0, 360.0)
          ELSE
            PHI1 = 0.0
          END IF
          IPH1 = INT(PHI1 / 10.0)
          IF (V5(3) .LT. 0.99999) THEN
            PHI2 = MOD(ATAN2 (V5(2), V5(1)) * RGBL(6) + 360.0, 360.0)
          ELSE
            PHI2 = 0.0
          END IF
          IPH2 = INT(PHI2 / 10.0)
          DBUF(K) = (PSIS(IPH1 + 1, 2, K) + PSIS(IPH1 + 2, 2, K) +
     1               PSIS(IPH2 + 1, 2, K) + PSIS(IPH2 + 2, 2, K)) / 4
          TT   = TT + DBUF(K)
        END DO
        TT = TT / NPSI
        CALL PLA191 (0, THETA, ACOR)
        VOID(I1 + 11) = TT * ACOR
        WRITE (LU7, 99996, IOSTAT = IOST)
     1   IH, IK, IL, XINT, SINT, TT, XINT / TT, (DBUF(J), J = 1, NPSI)
        GO TO 370
  390   CALL PLA189
        CALL PLA188 (MODE, 1, NPSI)
      ELSE IF (MODE .EQ. 5) THEN
      END IF
      FMAX = 0.0
      SUMT = 0.0
      TMAX = 0.0
      TMIN = 1.0
      ITEL = 0
      I    = IHLP(2) - 13
  400 I    = I + 14
      ITEL = ITEL + 1
      IH   = NINT(VOID(I))
      IF (IH .NE. -1000) THEN
        TT   = VOID(I + 11)
        FMAX = MAX (FMAX, VOID(I + 3) / TT)
        SUMT = SUMT + TT
        IF (TT .GT. TMAX) THEN
          TMAX = TT
          DO J = 1, 3
            IHMAX(J) = NINT(VOID(I + J - 1))
          END DO
        END IF
        IF (TT .LT. TMIN) THEN
          TMIN = TT
          DO J = 1, 3
            IHMIN(J) = NINT(VOID(I + J - 1))
          END DO
        END IF
        GO TO 400
      END IF
      FSCAL = 1.0
      DO WHILE (FMAX * FSCAL .GT. 99998.0)
        FSCAL = FSCAL * 0.1
      END DO
      WRITE (LU6, 99979, IOSTAT = IOST) FSCAL
      WRITE (LU7, 99979, IOSTAT = IOST) FSCAL
      CALL GEN108 (LU17, 0)
      I  = IHLP(2) - 13
  430 I  = I + 14
      IH = NINT(VOID(I))
      IF (IH .NE. -1000) THEN
        NRF  = NRF + 1
        IK   = NINT(VOID(I + 1))
        IL   = NINT(VOID(I + 2))
        RELI = FSCAL * VOID(I + 3) / VOID(I + 11)
        SIGI = FSCAL * VOID(I + 4) / VOID(I + 11)
        IF (RELI .LE. 99999.0) THEN
          LINE = '(3I4,2F8.2,I4,6F8.5)'
        ELSE IF (RELI .LE. 999999.0) THEN
          LINE = '(3I4,2F8.1,I4,6F8.5)'
        ELSE
          LINE = '(3I4,2F8.0,I4,6F8.5)'
        END IF
        IF (MODE .EQ. 5 .OR. IPR(445) .EQ. 1) THEN
          WRITE (LU17, LINE(1:20), IOSTAT = IOST)
     1     IH, IK, IL, RELI, SIGI, NINT(VOID(I + 13)),
     2     (VOID(I + K), K = 5, 10)
        ELSE
          WRITE (LU17, LINE(1:20), IOSTAT = IOST)
     1      IH, IK, IL, RELI, SIGI, NINT(VOID(I + 13))
        END IF
        GO TO 430
      END IF
      WRITE (LU17, 99983, IOSTAT = IOST)
      IF (NRF .GT. 0) THEN
        REANAS = SUMT / FLOAT(NRF)
        TIMAV  = (CPUTIM() - TIM1) / NRF
        IF (MODE .EQ. 4) THEN
          WRITE (LU6, 99982, IOSTAT = IOST) NPSI
          WRITE (LU7, 99982, IOSTAT = IOST) NPSI
        END IF
        PAR(315) = TMIN
        PAR(317) = TMAX
        IPR(432) = NRF
        WRITE (LU6, 99999, IOSTAT = IOST)
     1    IPR(383), IPR(432), TMIN, IHMIN, TMAX, IHMAX, REANAS, TIMAV
        WRITE (LU7, 99999, IOSTAT = IOST)
     1   IPR(383), IPR(432), TMIN, IHMIN, TMAX,  IHMAX, REANAS, TIMAV
      END IF
      IF (NAUTO .EQ. 1) GO TO 230
  440 IPR(432) = NRF
  450 RETURN
99999 FORMAT (/,
     1 '::', I8, ' Reflections on Input', /,
     2 '::', I8, ' Reflections Processed', //,
     3 ':: MIN  Transmission =', F9.5, ' for the ', 2(I3, ','), I3, /,
     4 ':: MAX  Transmission =', F9.5, ' for the ', 2(I3, ','), I3, /,
     5 ':: MEAN Transmission =', F9.5, //, ':: Average Time per',
     6 ' Reflection =', F8.5, ' Seconds', /)
99998 FORMAT (/, ':: Reflection Data are Expected/READ on/from File: ',
     1         A)
99997 FORMAT ('Absorption correction based on', I3, ' Psi-Scan(s)',
     1 ' following:', /,
     2 ' North, A.C.T, Phillips, D.C. & Scott Mathews, F., (1968)',
     3 ' Acta Cryst. A24, 351-359', //,
     4 '   H   K   L      INT       SIG     T   INT(COR)  T(s)',
     1 /, 80('='))
99996 FORMAT (3I4, 2F10.0, F6.3, F10.0, 10F6.3)
99995 FORMAT ('Crystal Face Defining Data', /, 26('='), //,
     1 '   Nr      h       k       l',
     2  10X, 'Distance(mm)', /, 80('-'))
99994 FORMAT (I5, 1X, 3F8.2, F15.3)
99993 FORMAT (/, '   NR      EDGE   LENGTH (mm)', /, 30('='), /)
99992 FORMAT (3I5, F10.3)
99991 FORMAT (/, 'Points of Intersection of Planes', /, 32('='), //,
     1 19X, 'Crystal System', 9X,
     2 'Inters. of Planes', /, 80('-'), /, 4X, 'Vertex', 6X,
     3 'x         y         z', 8X, 'Face  No.', /, 80('-'))
99990 FORMAT (I4, ' =', I4, 3F10.5, 2X, 3I4)
99989 FORMAT (//, ':: Note >> FACE', I3, '  has NO Intersection', /)
99988 FORMAT (1X)
99987 FORMAT ('N: H K L I SIG(I) Direction Cosine Data Assumed', /)
99986 FORMAT ('N: H K L I SIG(I) Psi-Data Assumed', /)
99985 FORMAT (A)
99984 FORMAT ('|SIN(THETA)| > 1.0 ?', 3I5, F10.5, /)
99983 FORMAT (1X)
99982 FORMAT (/, ':: Correction Based on', I3, ' Psi-scans', /)
99981 FORMAT (3F4.0, 2F8.0, F4.0, 6F8.0)
99980 FORMAT (3F4.0, 2F8.0, F9.0)
99979 FORMAT (/, ':: Multiplicative Output Scaling Factor:', F10.4, /)
      END SUBROUTINE PLA190
      SUBROUTINE PLA191 (MODE, VALUE, ASTER)
      COMMON /SABS/ TMC(7), RMF(5, 7), X(6)
      DIMENSION A(6, 6), D(6)
      RAD = ATAN(1.0) / 45.0
      IF (MODE .EQ. 1) THEN
        DO J = 1, 7
          Y = 0.0
          DO I = 1, 5
            Y = Y + RMF(I, J) * VALUE ** I
          END DO
          TMC(J) = EXP(-Y)
        END DO
        DO K = 1, 6
          STH  = SIN(K * 15.0 * RAD)
          D(K) = TMC(K + 1) - TMC(1)
          DO I = 1, 6
            A(K, I) = STH**(2 * I)
          END DO
        END DO
        CALL GEN057 (A, X, D, 6)
      ELSE
        ASTER = TMC(1)
        DO J = 1, 6
          K = 2 * J
          ASTER = ASTER + X(J) * VALUE ** K
        END DO
      END IF
      RETURN
      END SUBROUTINE PLA191
      SUBROUTINE PLA192 (NBEG)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,NXT1=100,NXT2=200,NXT3=100,NXT4=200)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /P190/ NVRR, PMILL(NXT1, 5), XTLV(7, NXT2), IDG(NXT4, 4),
     1 XYZPL(3, NXT2), CFACE(5, NXT2), IEDGE(NXT3), NFACES, NEDGE, NVER
      DIMENSION COSIN(NXT1), COSOUT(NXT1), NIN(NXT1), NOUTT(NXT1),
     1 SD(3), SOD(3), BBOUND(2, 2), DBOUND(2, 2), XYZ(3), HKL(3),
     2 GRD(4), TEMP(3)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /ISCR/ IHLP(21)
      DIMENSION IGA(3), GAUSS(500, 2)
      XMU    = PAR(301)
      NIA    = IPR(421)
      NIB    = IPR(422)
      NIC    = IPR(423)
      NPOINT = 0
      VOLUME = 0.0
      XMAX   = XTLV(1, 1)
      YMAX   = XTLV(2, 1)
      ZMAX   = XTLV(3, 1)
      XMIN   = XTLV(1, 1)
      YMIN   = XTLV(2, 1)
      ZMIN   = XTLV(3, 1)
      DO I = 2, NVER
        XMAX = MAX (XMAX, XTLV(1, I))
        YMAX = MAX (YMAX, XTLV(2, I))
        ZMAX = MAX (ZMAX, XTLV(3, I))
        XMIN = MIN (XMIN, XTLV(1, I))
        YMIN = MIN (YMIN, XTLV(2, I))
        ZMIN = MIN (ZMIN, XTLV(3, I))
      END DO
      JGRD  = NVD
      VOID(JGRD)     = XMIN
      VOID(JGRD - 1) = XMAX
      JGRD           = JGRD - 1
      IF (NIA .EQ. 0) THEN
        NIA = MAX (8, NINT(4.0 * XMU * (XMAX - XMIN) * PAR(241)))
        NIB = MAX (8, NINT(4.0 * XMU * (YMAX - YMIN) * PAR(241)))
        NIC = MAX (8, NINT(4.0 * XMU * (ZMAX - ZMIN) * PAR(241)))
        IPR(421) = NIA
        IPR(422) = NIB
        IPR(423) = NIC
      END IF
      NIA    = 2 * MAX (1, (NIA + 1) / 2)
      IGA(1) = 0
      CALL GEN115 (GAUSS(1, 1), GAUSS(1, 2), NIA)
      NIB    = 2 * MAX (1, (NIB + 1) / 2)
      IGA(2) = NIA
      CALL GEN115 (GAUSS(IGA(2) + 1, 1), GAUSS(IGA(2) + 1, 2), NIB)
      NIC    = 2 * MAX (1, (NIC + 1) / 2)
      IGA(3) = NIA + NIB
      CALL GEN115 (GAUSS(IGA(3) + 1, 1), GAUSS(IGA(3) + 1, 2), NIC)
      DO NPA = 1, NIA
         LL = IGA(1) + NPA
         XYZ(1) = XMIN + (XMAX - XMIN) * GAUSS(LL, 1)
         R1 = GAUSS(LL, 2) * (XMAX - XMIN)
         YMIN =  99999.0
         YMAX = -99999.0
         N1   = NFACES - 1
         DO K = 1, N1
           BBOUND(1, 1) = PMILL(K, 2)
           BBOUND(1, 2) = PMILL(K, 3)
           TEMP(1) = PMILL(K, 4) - PMILL(K, 1) * XYZ(1)
           K1 = K + 1
           DO 40 L = K1, NFACES
             BBOUND(2, 1) = PMILL(L, 2)
             BBOUND(2, 2) = PMILL(L, 3)
             DET = BBOUND(1, 1) * BBOUND(2, 2)
     1           - BBOUND(1, 2) * BBOUND(2, 1)
             IF (DET .NE. 0) THEN
               DBOUND(1, 1) =  BBOUND(2, 2) / DET
               DBOUND(1, 2) = -BBOUND(1, 2) / DET
               DBOUND(2, 1) = -BBOUND(2, 1) / DET
               DBOUND(2, 2) =  BBOUND(1, 1) / DET
               TEMP(2) = PMILL(L, 4) - PMILL(L, 1) * XYZ(1)
               XYZ(2) = DBOUND(1, 1) * TEMP(1)
     1                + DBOUND(1, 2) * TEMP(2)
               XYZ(3) = DBOUND(2, 1) * TEMP(1)
     1                + DBOUND(2, 2) * TEMP(2)
               DO J0 = 1, NFACES
                 CHECK = 0.0
                 DO I0 = 1, 3
                   CHECK = CHECK + PMILL(J0, I0) * XYZ(I0)
                 END DO
                 IF (PMILL(J0, 4) .LT. CHECK - 0.0000001) GO TO 40
               END DO
               YMAX = MAX (YMAX, XYZ(2))
               YMIN = MIN (YMIN, XYZ(2))
             END IF
   40      CONTINUE
         END DO
         VOID(JGRD - 1) = YMIN
         VOID(JGRD - 2) = YMAX
         JGRD           = JGRD - 2
         DO NPB = 1, NIB
            KK = IGA(2) + NPB
            XYZ(2) = YMIN + (YMAX - YMIN) * GAUSS(KK, 1)
            R2 = GAUSS(KK, 2) * R1 * (YMAX - YMIN)
            ZMAX = - 99999.0
            ZMIN =   99999.0
            DO 80 I = 1, NFACES
               IF (PMILL(I, 3) .NE. 0) THEN
                 XYZ(3) = (PMILL(I, 4) - XYZ(1) * PMILL(I, 1)
     1                  - XYZ(2) * PMILL(I, 2)) / PMILL(I, 3)
                 DO J0 = 1, NFACES
                   CHECK = 0.0
                   DO I0 = 1, 3
                     CHECK = CHECK + PMILL(J0, I0) * XYZ(I0)
                   END DO
                   IF (PMILL(J0, 4) .LT. CHECK - 0.0000001) GO TO 80
                 END DO
                 ZMAX = MAX (ZMAX, XYZ(3))
                 ZMIN = MIN (ZMIN, XYZ(3))
               END IF
   80       CONTINUE
            VOID(JGRD - 1) = ZMIN
            VOID(JGRD - 2) = ZMAX
            JGRD           = JGRD - 2
            DELTAZ = ZMAX - ZMIN
            DO NPC = 1, NIC
              NPOINT = NPOINT + 1
              JJ = IGA(3) + NPC
              VOLUME = VOLUME + GAUSS(JJ, 2) * R2 * DELTAZ
            END DO
         END DO
      END DO
      WRITE (LU7, 99997, IOSTAT = IOST)
     1  PAR(301), NIA, NIB, NIC, NPOINT, VOLUME * PAR(98)
      NCOR = 0
      I1     = IHLP(NBEG) - 13
  120 I1     = I1 + 14
      HKL(1) = VOID(I1)
      HKL(2) = VOID(I1 + 1)
      HKL(3) = VOID(I1 + 2)
      RINTN  = VOID(I1 + 3)
      SIGMA  = VOID(I1 + 4)
      SOD(1) = VOID(I1 + 5)
      SD(1)  = VOID(I1 + 6)
      SOD(2) = VOID(I1 + 7)
      SD(2)  = VOID(I1 + 8)
      SOD(3) = VOID(I1 + 9)
      SD(3)  = VOID(I1 + 10)
      IF (HKL(1) .LT. - 999.0) GO TO 230
      INTN   = NINT(RINTN)
      DO I = 1, 3
        SOD(I) = SOD(I) * PAR(134 + I)
        SD(I)  = SD(I)  * PAR(134 + I)
      END DO
      NCOR = NCOR + 1
      IF (NCOR .EQ. 1) THEN
        CALL PLA262 (0)
        CALL PLA262 (2)
        WRITE (LU7, 99999, IOSTAT = IOST)
      END IF
      TRANSM = 0.0
      TBAR   = 0
      MO     = 1
      LO     = 1
      DO K = 1, NFACES
        COSIN(MO)  = 0.0
        COSOUT(LO) = 0.0
        DO I = 1, 3
          COSIN(MO)  = COSIN(MO)  + SOD(I) * PMILL(K, I)
          COSOUT(LO) = COSOUT(LO) + SD(I)  * PMILL(K, I)
        END DO
        IF (COSIN(MO) .GT. 0.0) THEN
          NIN(MO) = K
          MO      = MO + 1
        END IF
        IF (COSOUT(LO) .GT. 0.0) THEN
          NOUTT(LO) = K
          LO        = LO + 1
        END IF
      END DO
      MO = MO - 1
      LO = LO - 1
      JGRD = NVD
      XMIN = VOID(JGRD)
      XMAX = VOID(JGRD - 1)
      JGRD = JGRD - 1
      DO NPA = 1, NIA
        LL     = IGA(1) + NPA
        GRD(1) = XMIN + (XMAX - XMIN) * GAUSS(LL, 1)
        R1     = GAUSS(LL, 2) * (XMAX - XMIN)
        YMIN   = VOID(JGRD - 1)
        YMAX   = VOID(JGRD - 2)
        JGRD   = JGRD - 2
        DO NPB = 1, NIB
          KK     = IGA(2) + NPB
          GRD(2) = YMIN + (YMAX - YMIN) * GAUSS(KK, 1)
          R2     = GAUSS(KK, 2) * R1 * (YMAX - YMIN)
          ZMIN   = VOID(JGRD - 1)
          ZMAX   = VOID(JGRD - 2)
          JGRD   = JGRD - 2
          DELTAZ = ZMAX - ZMIN
          DO NPC = 1, NIC
            JJ     = IGA(3) + NPC
            GRD(3) = ZMIN + DELTAZ * GAUSS(JJ, 1)
            GRD(4) = GAUSS(JJ, 2) * R2 * DELTAZ
            GK     = 100000.0
            HK     = 100000.0
            DO K = 1, MO
              RDOTN = 0.0
              NMO   = NIN(K)
              DO I = 1, 3
                RDOTN = RDOTN + GRD(I) * PMILL(NMO, I)
              END DO
              GAB = (PMILL(NMO, 4) - RDOTN) / COSIN(K)
              GK = MIN (GK, GAB)
            END DO
            DO K = 1, LO
              RDOTN = 0.0
              NLO = NOUTT(K)
              DO I = 1, 3
                RDOTN = RDOTN + GRD(I) * PMILL(NLO, I)
              END DO
              HAB = (PMILL(NLO, 4) - RDOTN) / COSOUT(K)
              HK = MIN (HK, HAB)
            END DO
            PXTL   = GK + HK
            AXTL   = EXP (-XMU * PXTL)
            TXTL   = PXTL * AXTL
            TBAR   = TBAR   + GRD(4) * TXTL
            TRANSM = TRANSM + GRD(4) * AXTL
          END DO
        END DO
      END DO
      ASTAR = VOLUME / TRANSM
      TBAR  = TBAR   / VOLUME
      TBMU  = ALOG(ASTAR)
      ICOR   = NINT(RINTN * ASTAR)
      TRANSM = 1.0 / ASTAR
      ISIGMA = NINT(SIGMA * ASTAR)
      VOID(I1 + 11) = TRANSM
      IF (IGBL(57) .GT. 0) THEN
        CALL PLA262 (1)
        WRITE (LU7, 99998, IOSTAT = IOST)
     1    (NINT(HKL(I)), I = 1, 3), TRANSM, TBMU, INTN, NINT(SIGMA),
     2    ICOR, ISIGMA, TBAR
      END IF
      GO TO 120
  230 RETURN
99999 FORMAT ('  H  K  L  Transm    Mu*T   Intensity  Sigma    I(cor) ',
     1  ' Sig(cor)    Tbar', /, 80('='), /)
99998 FORMAT (3I3, F8.5, F9.4, I10, I7, I10, I7, F12.6)
99997 FORMAT (//, 'Mu = ', F10.2, ' mm-1', /,
     1        'A Grid of ', 2(I2, ' X '), I2, ' =', I6,
     2 ' Sampling Points.', //,
     3 'Crystal Volume =', 8X, F13.8, ' MM**3.')
      END SUBROUTINE PLA192
      SUBROUTINE PLA193 (NBEG)
C * DE MEULENAER & TOMPA ABSORPTION CORRECTION (ADAPTED FROM ALCOCK VERSION)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000, NP23=28000,
     1 NP38=150,NP39=30,NTMP=4000,NXT1=100,NXT2=200,NXT3=100,NXT4=200)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XYDATA/ RSTK(NTMP), ISTK(NTMP), AMU, TT, VT, CX(2), CY(2),
     1 CZ(2), D(12), DEV(2), VMUL, IL, NC, ND, NF, NG, IB(4), IE(2),
     2 JI(2), JT(2), IENPL, ISTNV, IENNV, ISTED, IENED, ISTVT, IENVT,
     3 IENPT, ISTNP, IENNP, ISTTR, IENTR, MAXUTL, JNK, JNK1, JNK3,
     4 IEX, ISK, ISK2
      COMMON /P190/ NVRR, PMILL(NXT1, 5), XTLV(7, NXT2), IDG(NXT4, 4),
     1 XYZPL(3, NXT2), CFACE(5, NXT2), IEDGE(NXT3), NFACES, NEDGE, NVER
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /ISCR/ IHLP(21)
      REAL VOID, PAR, FN, RGBL, XYZPL, CFACE, PMILL, XTLV
      CHARACTER ITX*8
      NMEM   = 0
      RAD    = DBLE(RGBL(6))
      MAXUTL = 0
      AMU    = DBLE(PAR(301))
      CALL PLA262 (0)
      WRITE (LU7, 99999, IOSTAT = IOST)
      WRITE (LU6, 99999, IOSTAT = IOST)
      WRITE (LU7, 99998, IOSTAT = IOST) AMU
      WRITE (LU6, 99998, IOSTAT = IOST) AMU
      SINA  = SIN(DBLE(PAR(244)) / RAD)
      COSA  = COS(DBLE(PAR(244)) / RAD)
      COSAS = COS(DBLE(PAR(138)) / RAD)
      COSBS = COS(DBLE(PAR(139)) / RAD)
      COSGS = COS(DBLE(PAR(140)) / RAD)
      SINBS = SIN(DBLE(PAR(139)) / RAD)
      SINGS = SIN(DBLE(PAR(140)) / RAD)
      BCCAS = DBLE(PAR(136)) * DBLE(PAR(137)) * COSAS
      CACBS = DBLE(PAR(137)) * DBLE(PAR(135)) * COSBS
      ABCGS = DBLE(PAR(135)) * DBLE(PAR(136)) * COSGS
      IENPL = - 5
      DO IN = 1, NFACES
        IENPL = IENPL + 6
        XH    = DBLE(PMILL(IN, 1))
        XK    = DBLE(PMILL(IN, 2))
        XL    = DBLE(PMILL(IN, 3))
        DA    = DBLE(PMILL(IN, 5))
        QHKL  =  SQRT(
     1   (XH * DBLE(PAR(135)))**2 + (XK * DBLE(PAR(136)))**2
     2 + (XL * DBLE(PAR(137)))**2
     3       + 2 * XK * XL * BCCAS + 2 * XL * XH * CACBS
     4       + 2 * XH * XK * ABCGS)
        CPZ  = XL / (DBLE(PAR(243)) * QHKL)
        CPX  = (XH * DBLE(PAR(135))**2 + XL * CACBS + XK * ABCGS) /
     1          (QHKL * DBLE(PAR(135)))
        CPBS = (XK * DBLE(PAR(136))**2 + XL * BCCAS + XH * ABCGS) /
     1          (QHKL * DBLE(PAR(136)))
        SINPBS = SQRT(ABS(1 - CPBS**2 ))
        IF (ABS(SINPBS) .LT. 1.0D-6) THEN
          CPY = CPBS * SINGS
        ELSE
          CPD = (CPX - COSGS * CPBS) / (SINPBS * SINGS)
          CPY = CPBS * SINGS - SINPBS * COSGS * CPD
        END IF
        RSTK(IENPL    ) = CPX
        RSTK(IENPL + 1) = CPY
        RSTK(IENPL + 2) = CPZ
        RSTK(IENPL + 3) = DA
      END DO
      NPP   = NTMP
      ISTNV = IENPL + 6
      INV   = ISTNV - 10
      NFMX  = IENPL
      NFMX1 = IENPL - 6
      NFMX2 = NFMX1 - 6
      DO I = 1, NFMX2, 6
        AI  = RSTK(I)
        BI  = RSTK(I + 1)
        CI  = RSTK(I + 2)
        DI  = RSTK(I + 3)
        IP1 = I + 6
        DO J = IP1, NFMX1, 6
          AJ  = RSTK(J)
          BJ  = RSTK(J + 1)
          CJ  = RSTK(J + 2)
          DJ  = RSTK(J + 3)
          AIJ = BI * CJ - BJ * CI
          BIJ = CI * AJ - CJ * AI
          CIJ = AI * BJ - AJ * BI
          DEN = AIJ * AIJ + BIJ * BIJ + CIJ * CIJ
          IF (DEN .NE. 0) THEN
            DA  = DI * AJ - DJ * AI
            DB  = DI * BJ - DJ * BI
            DC  = DI * CJ - DJ * CI
            XAR = (DB * CIJ - DC * BIJ) / DEN
            YAR = (DC * AIJ - DA * CIJ) / DEN
            ZAR = (DA * BIJ - DB * AIJ) / DEN
            JP1 = J + 6
            DO 50 K = JP1, NFMX, 6
              DEN = RSTK(K) * AIJ + RSTK(K + 1) * BIJ
     1            + RSTK(K + 2) * CIJ
              IF (DEN .NE. 0) THEN
                SH = (RSTK(K + 3) - RSTK(K) * XAR - RSTK(K + 1) * YAR
     1             - RSTK(K + 2) * ZAR) / DEN
                XP = XAR + SH * AIJ
                YP = YAR + SH * BIJ
                ZP = ZAR + SH * CIJ
                NF = 2
                DO 40 NU = 1, NFMX, 6
                  IF (NU .NE. I .AND. NU .NE. J .AND. NU .NE. K) THEN
                    DIST = RSTK(NU + 3) - RSTK(NU) * XP
     1                   - RSTK(NU + 1) * YP - RSTK(NU + 2) * ZP
                    IF (DIST .GT. 1.0D-7) THEN
                      GO TO 40
                    ELSE IF (DIST .EQ. 1.0D-7) THEN
                      GO TO 30
                    END IF
                    IF (DIST .LT. -1.0D-7) GO TO 50
   30               IF (NU .LE. K) GO TO 50
                    NF = NF + 1
                    ISTK(NPP - NF) = NU
                  END IF
   40           CONTINUE
                ISTK(NPP)     = I
                ISTK(NPP - 1) = J
                ISTK(NPP - 2) = K
                INV           = INV + 10
                RSTK(INV)     = XP
                RSTK(INV + 1) = YP
                RSTK(INV + 2) = ZP
                ISTK(INV + 4) = ISTNV + NTMP - NPP
                ISTK(INV + 5) = ISTK(INV + 4) + NF
                NPP           = NPP - NF - 1
              END IF
   50       CONTINUE
          END IF
        END DO
      END DO
      IENNV = ISTNV + NTMP - NPP - 1
      ISTED = IENNV + 1
      JNK   = (IENPL + 5) / 6
      JNK1  = (INV   + 10 - ISTNV) / 10
      IENED = JNK + JNK1 - 2
      IENED = ISTED + (IENED - 1) * 6
      ISTVT = IENED + 6
      IENVT = ISTVT + (JNK1 - 1) * 10
      I     = IENVT + 9
      J     = INV   + 9
   80 I = I - 10
      J = J - 10
      IF (I - ISTVT .GE. -1) THEN
        DO K = 1, 3
          RSTK(I + K) = RSTK(J + K)
        END DO
        ISTK(I + 5) = ISTK(J + 5)
        ISTK(I + 6) = ISTK(J + 6)
        GO TO 80
      END IF
      J = NTMP
      DO I = ISTNV, IENNV
        ISTK(I) = ISTK(J)
        J       = J - 1
      END DO
      INED = ISTED - 6
      NFMX = IENVT - 10
      II = 0
      DO I = ISTVT, NFMX, 10
        II = II + 1
        NFMX1 = ISTK(I + 4)
        NFMX2 = ISTK(I + 5)
        JNK   = I + 10
        JJ    = II
        DO 130 J = JNK, IENVT, 10
          JJ  = JJ + 1
          NPP = ISTK(J + 4)
          NF  = ISTK(J + 5)
          M   = 0
          DO K = NFMX1, NFMX2
            JUN1 = ISTK(K)
            DO L = NPP, NF
              JUN11 = ISTK(L)
              IF (JUN1 .EQ. JUN11) THEN
                IF (M .LE. 0) THEN
                  M = 1
                  NMEM = JUN11
                ELSE
                  INED           = INED + 6
                  ISTK(INED)     = NMEM
                  ISTK(INED + 1) = JUN1
                  ISTK(INED + 2) = I
                  ISTK(INED + 3) = J
                  NMEM = 1 + (NMEM - 1) / 6
                  JUN1 = 1 + (JUN1 - 1) / 6
                  GO TO 130
                END IF
              END IF
            END DO
          END DO
  130   CONTINUE
      END DO
      IF (INED .NE. IENED) THEN
        WRITE (LU6, 99997, IOSTAT = IOST)
        WRITE (LU7, 99997, IOSTAT = IOST)
        IENPL = 0
      END IF
      IF (IENPL .GT. 0) THEN
        VM = 0.0D+0
        RM = 0.0D+0
        DO I = 1, 3
          D(I + 3) = 0.0D+0
          D(I)     = 0.0D+0
        END DO
        DO I = ISTVT, IENVT, 10
          DO J = 1, 3
            VT = RSTK(I + J - 1)
            IF (D(J) .GT. VT) THEN
              D(J) = VT
            ELSE IF (D(3 + J) .LT. VT) THEN
              D(3 + J) = VT
            END IF
          END DO
        END DO
        DO I = 1, 3
          VT = D(3 + I) - D(I)
          IF (RM .LT.  VT)       RM =  VT
          IF (VM .LT.  D(3 + I)) VM =  D(3 + I)
          IF (VM .LT. -D(I))     VM = -D(I)
        END DO
        VMUL = 1.0D+0 / VM
        DO I = 1, IENPL, 6
          RSTK(I + 3) = RSTK(I + 3) * VMUL
        END DO
        JNK = ISTVT - 1
        DO I = JNK, IENVT, 10
          DO J = 1, 3
            RSTK(I + J) = RSTK(I + J) * VMUL
          END DO
        END DO
        VOLM = 1.0D+0 / (6.0D+0 * VMUL * VMUL * VMUL)
        CALL PLA194 (1)
        VT = VT * VOLM
        TT = 1.0D+0
        WRITE (LU7, 99993, IOSTAT = IOST) VT
        VA  = 0.1D-2 * VT
        VV1 = VT - VA
        VV2 = VT + VA
        AMU = AMU / VMUL
        CALL PLA262 (0)
        IF (IGBL(57) .GT. 0) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99995, IOSTAT = IOST)
        END IF
        I1   = IHLP(NBEG) - 13
  220   I1   = I1 + 14
        JA   = NINT(VOID(I1))
        KA   = NINT(VOID(I1 + 1))
        LA   = NINT(VOID(I1 + 2))
        FREL = DBLE(VOID(I1 + 3))
        SIGF = DBLE(VOID(I1 + 4))
        C1   = DBLE(VOID(I1 + 5))
        C2   = DBLE(VOID(I1 + 6))
        C3   = DBLE(VOID(I1 + 7))
        C4   = DBLE(VOID(I1 + 8))
        C5   = DBLE(VOID(I1 + 9))
        C6   = DBLE(VOID(I1 + 10))
        IF (JA .EQ. - 1000) GO TO 260
        CX(1) = - C1
        CX(2) = - C2
        C3    =  (C3 - C1 * COSGS) / SINGS
        C4    =  (C4 - C2 * COSGS) / SINGS
        CY(1) = - C3
        CY(2) = - C4
        CZ(1) = -(C5 - C1 * COSBS + C3 * SINBS * COSA) / (SINBS * SINA)
        CZ(2) = -(C6 - C2 * COSBS + C4 * SINBS * COSA) / (SINBS * SINA)
        IERR  = 2
        CALL PLA194 (2)
        VT = VT * VOLM
        IF (TT .GT. 0.9995D0) THEN
          TT = 1.0D+0
          IF (TT .LT. 1.0D0) THEN
            IF (TT .GT. 0) THEN
              IF (VT .LE. VV2) THEN
                IF (VV1 .LE. VT) GO TO 230
              END IF
              IF (TT .GT. 0.999D0) THEN
                TT = 1.0D+0
                IERR = 2
              ELSE
                IERR = 1
                ITX = 'VOLUME  '
                GO TO 230
              END IF
            END IF
          END IF
          IF (TT .GT. 0.999D0) THEN
            TT = 1.0D+0
            IERR = 2
          ELSE
            ITX = 'TRANS.'
            TT  = ABS(TT)
            IF (TT .LT. 0.01D0) TT = 0.1D-1
            IERR = 1
          END IF
        END IF
  230   IF (IERR .EQ. 1) THEN
          GO TO 240
        ELSE IF (IERR .EQ. 2) THEN
          GO TO 250
        END IF
  240   CALL PLA262 (1)
        WRITE (LU7, 99992, IOSTAT = IOST) JA, KA, LA, TT, VT, ITX
  250   FREL = FREL / TT
        SIGF = SIGF / TT
        VOID (I1 + 11) = SNGL(TT)
        IF (IGBL(57) .GT. 0) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99994, IOSTAT = IOST)
     1      JA, KA, LA, FREL, SIGF, TT, VT
        END IF
        GO TO 220
  260   WRITE (LU7, 99996, IOSTAT = IOST) MAXUTL
      END IF
      RETURN
99999 FORMAT ('Analytical Absorption Correction Program', /, 80('-'),
     1  /, '(see. N.W. Alcock (1970). Cryst. Computing, p271)', /)
99998 FORMAT (/, ':: Mu = ', F8.3, ' mm(-1)', /)
99997 FORMAT (':: Crystal not Finite - Additional Bounding Planes ',
     1        'Needed')
99996 FORMAT (/, ':: Array Size Needed = ', I5)
99995 FORMAT (3X, 'H   K   L', 7X, 'F**2', 5X, 'Sig(F**2)',
     1        5X, 'Transmission', 6X, 'Volume (mm3)', /,
     2        '   -   -   -', 7X, '----', 5X, 9('-'), 5X,
     3        12('-'), 6X, 12('-'))
99994 FORMAT (3I4, 2F12.2, 4X, F12.5, 7X, F14.11)
99993 FORMAT (/, 'Crystal Volume =', 2X, F14.11, ' mm3', //)
99992 FORMAT (3I4, ' Transm ', E12.5, ' Volume ', F12.6, 1X, A,
     1        ' in Error')
      END SUBROUTINE PLA193
      SUBROUTINE PLA194 (IZ)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NTMP=4000)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XYDATA/ RSTK(NTMP), ISTK(NTMP), AMU, TT, VT, CX(2), CY(2),
     1 CZ(2), D(12), DEV(2), VMUL, IL, NC, ND, NF, NG, IB(4), IE(2),
     2 JI(2), JT(2), IENPL, ISTNV, IENNV, ISTED, IENED, ISTVT, IENVT,
     3 IENPT, ISTNP, IENNP, ISTTR, IENTR, MAXUTL, JNK, JNK1, JNK3,
     4 IEX, ISK, ISK2
      DIMENSION NE(6)
      COMMON /SAV/ VZ,FLIM
C * THIS PROGRAM REALLY MUST BE READ WITH TOMPA'S MANUAL
C * OR WITH HIS PAPER OR WITH THE SUMMARY IN' CRYSTALLOGRAPHIC COMPUTING'
      JSK = 0
      DE2 = 0
      J   = 0
C * HERE JUST TO FIND VOLUME.  NB. THESE FORM PART OF THE PRELIM ASSIGNS
      IF (IZ .EQ. 1) THEN
        IEX   = 1
        ISK   = 1
        ISK2  = 1
        VT    = 0.0D+0
        IENPT = IENVT
        ISTNP = IENVT + 10
        IENNP = ISTNP - 1
        DO I = ISTVT, IENVT, 10
          IENNP       = IENNP + 1
          ISTK(IENNP) = I
        END DO
        GO TO 390
      END IF
      DO I = 1, 6
        NE(I) = 0
      END DO
      DE2    = 0
      DEV(2) = 0
      VT     = 0.0D+0
      TT     = 0
      IL     = 1
      IENPT  = IENVT
      DO IP = 1, 2
        DO I = 1, IENPL, 6
          DEN = RSTK(I) * CX(IP) + RSTK(I + 1) * CY(IP)
     1        + RSTK(I + 2) * CZ(IP)
          IF (DEN .LT. 0.0D0) THEN
            ISTK(I + IP + 3) = 1
          ELSE
            ISTK(I + IP + 3) = -1
          END IF
        END DO
        DO I = ISTED, IENED, 6
          JA  = ISTK(I)
          JB  = ISTK(I + 1)
          IND = ISTK(JA + IP + 3) + ISTK(JB + IP + 3)
          IF (IND .LT. 0) THEN
            ISTK(I + IP + 3) = -1
          ELSE IF (IND .EQ. 0) THEN
            ISTK(I + IP + 3) = 0
          ELSE
            ISTK(I + IP + 3) = 1
          END IF
        END DO
      END DO
      IENPT = IENVT
      DO 90 IP = 1, 2
        JNK1 = IP
        IQ   = 3 - IP
        DO 80 J = ISTVT, IENVT, 10
          JNK = J
          ISTK(J + IP + 5) = 0
          ISTK(J + IP + 7) = 0
          IF (IP .EQ. 1) RSTK(J + 3) = 0.0D+0
          M  = ISTK(J + 4)
          LA = ISTK(J + 5)
          LB = ISTK(M)
          NC = ISTK(LB + IP + 3)
          M = M + 1
          DO J5 = M, LA
            LB = ISTK(J5)
            IF (NC .NE. ISTK(LB + IP + 3)) GO TO 80
          END DO
          IF (NC .LT. 0) THEN
            ND = 1
            CALL PLA195 (DEN)
            RSTK(J + 3) = RSTK(J + 3) + DEN * AMU
            ISTK(J + IP + 7) = NC
          ELSE IF (NC .EQ. 0) THEN
            GO TO 90
          ELSE
            ND = -1
            CALL PLA195 (DEN)
            NE(IL) = NE(IL) + 1
            IENPT  = IENPT + 10
            ISTK(J + IP + 5) = IENPT
            ISTK(IENPT + 4) = NC
            ISTK(IENPT + 6) = IL
            ISTK(IENPT + 5) = 0
            ISTK(IENPT + 7) = 0
            ISTK(IENPT + 8) = 0
            ISTK(IENPT + 9) = 0
            RSTK(IENPT)     = RSTK(J)     + DEN * CX(IP)
            RSTK(IENPT + 1) = RSTK(J + 1) + DEN * CY(IP)
            RSTK(IENPT + 2) = RSTK(J + 2) + DEN * CZ(IP)
            FRP = DEN
            RSTK(IENPT + 3) = DEN * AMU
            IF (ISTK(NC + IQ + 3) .EQ. -1) THEN
              ND   = 1
              JNK  = IENPT
              JNK1 = IQ
              CALL PLA195 (DEN)
              JNK1 = IP
              JNK  = J
              ISTK(IENPT + 5) = NC
              RSTK(IENPT + 3) = (FRP + DEN) * AMU
            END IF
            IL = IL + 2
            DO K = ISTED, IENED, 6
              IF (ISTK(K + IQ + 3) .EQ. 1) THEN
                IB(1) = J
                IB(2) = J
                IB(3) = ISTK(K + 2)
                IB(4) = ISTK(K + 3)
                CALL PLA196
                D(10) = - D(3)
                D(11) = - D(6)
                D(12) = - D(9)
                D(7)  = - D(2)
                D(9)  = - D(8)
                D(8)  = - D(5)
                D(1)  =   CX(IP)
                D(2)  =   CY(IP)
                D(3)  =   CZ(IP)
                D(4)  = - CX(IQ)
                D(5)  = - CY(IQ)
                D(6)  = - CZ(IQ)
                CALL PLA198 (D, 3)
                NC = 1
                IF (ABS(D(4)) .GT. 1.D-9) THEN
                  DEN = D(3) / D(4)
                  IF (DEN .GE. - 0.00001D0) THEN
                    IF (1.00001D0 .GE. DEN) THEN
                      NC = 0
                      IF (D(1) .NE. 0) THEN
                        DEN = D(1) / D(4)
                        IF (DEN .GT. 0) THEN
                          IF (DEN .LE. FRP) THEN
                            NE(IL)          = NE(IL) + 1
                            IENPT           = IENPT  + 10
                            RSTK(IENPT)     = RSTK(J)     + DEN * CX(IP)
                            RSTK(IENPT + 1) = RSTK(J + 1) + DEN * CY(IP)
                            RSTK(IENPT + 2) = RSTK(J + 2) + DEN * CZ(IP)
                            TX              = D(2) / D(4)
                            RSTK(IENPT + 3) = (DEN + TX) * AMU
                            ISTK(IENPT + 4) = K
                            ISTK(IENPT + 5) = 0
                            ISTK(IENPT + 6) = IL
                            ISTK(IENPT + 7) = 0
                            ISTK(IENPT + 8) = 0
                            ISTK(IENPT + 9) = 0
                          END IF
                        END IF
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END DO
            IL = IL - 2
          END IF
  80    CONTINUE
        IL = IL + 1
  90  CONTINUE
      ND = 1
      IL = IL + 2
      DO IP = 1, 2
        JI(IP) = IENPT + 10
        IQ     = 3 - IP
        JNK1   = IQ
        DO K = ISTED, IENED, 6
          IF (ISTK(K + IP + 3) .EQ. 1) THEN
            DO K5 = ISTED, IENED, 6
              IF (ISTK(K5 + IP + 3) .EQ. -1) THEN
                IB(1) = ISTK(K  + 2)
                IB(2) = ISTK(K  + 3)
                IB(3) = ISTK(K5 + 2)
                IB(4) = ISTK(K5 + 3)
                CALL PLA196
                D(10) = D(3)
                D(11) = D(6)
                D(12) = D(9)
                D(3)  = D(7)
                D(6)  = D(8)
                TX    = D(2)
                D(2)  = D(4)
                D(4)  = TX
                D(7)  = - CX(IP)
                D(8)  = - CY(IP)
                D(9)  = - CZ(IP)
                CALL PLA198 (D, 3)
                NC = 1
                IF (ABS(D(4)) .GT. 1.D-9) THEN
                  DEN = D(1) / D(4)
                  IF (DEN .GE. - 0.00001D0) THEN
                    IF (1.00001D0 .GE. DEN) NC = 0
                  END IF
                END IF
                IF (NC .EQ. 0) THEN
                  NC = 1
                  IF (ABS(D(4)) .GT. 1.D-9) THEN
                    TX = D(2) / D(4)
                    IF (TX .GE. - 0.00001D0) THEN
                      IF (1.00001D0 .GE. TX) NC = 0
                    END IF
                  END IF
                  IF (NC .EQ. 0) THEN
                    IENPT = IENPT + 10
                    RSTK(IENPT    ) = RSTK(IB(4)    )
     1                + TX * (RSTK(IB(3)    ) - RSTK(IB(4)    ))
                    RSTK(IENPT + 1) = RSTK(IB(4) + 1)
     1                + TX * (RSTK(IB(3) + 1) - RSTK(IB(4) + 1))
                    RSTK(IENPT + 2) = RSTK(IB(4) + 2)
     1                + TX * (RSTK(IB(3) + 2) - RSTK(IB(4) + 2))
                    TX = D(3) / D(4)
                    RSTK(IENPT + 3) = TX * AMU
                    ISTK(IENPT + 4) = K
                    ISTK(IENPT + 5) = K5
                    ISTK(IENPT + 6) = 0
                    ISTK(IENPT + 7) = 0
                    ISTK(IENPT + 8) = 0
                    ISTK(IENPT + 9) = IL
                    IF (ISTK(K5 + IQ + 3) .EQ. -1) THEN
                      JNK = IENPT
                      CALL PLA195 (TX)
                      RSTK(IENPT + 3) = RSTK(IENPT + 3) + TX * AMU
                      ISTK(IENPT + 7) = NC
                    END IF
                  END IF
                END IF
              END IF
            END DO
          END IF
        END DO
        JT(IP) = IENPT
        IL     = IL + 1
      END DO
      DO 240 I = 1, IENPL, 6
        IF (ISTK(I + 4) + ISTK(I + 5) .EQ. -2) THEN
          IP  = 1
          IPC = 0
          K      = ISTED
  130     IE(IP) = 2
          JPC    = 0
          IF(ISTK(K + IP + 3) .NE. 1) GO TO 190
          J = JI(IP)
  140     IF (J .LE. JT(IP)) THEN
            IF (ISTK(J + 4) .EQ. K) THEN
              IT = ISTK(J + 5)
              IF (I .NE. ISTK(IT)) THEN
                IF (I .NE. ISTK(IT + 1)) GO TO 150
              END IF
              IF (JPC .LE. 0) THEN
                JPC         = 1
                ND          = J
                IB(IPC + 1) = J
                GO TO 150
              END IF
              NF          = J
              IB(IPC + 2) = J
              NC = 1
              IF (ABS(RSTK(ND) - RSTK(NF)) .LE. 0.3D-4) THEN
                IF (ABS(RSTK(ND + 1) - RSTK(NF + 1)) .LE. 0.3D-4) THEN
                  IF (ABS(RSTK(ND + 2) - RSTK(NF + 2)) .LE. 0.3D-4)
     1               NC = 0
                END IF
              END IF
              IF (NC .GT. 0) GO TO 200
            END IF
  150       J = J + 10
            GO TO 140
          END IF
          DO M = 2, 3
            J   = ISTK(K + M)
            IND = ISTK(J + 4)
            IT  = ISTK(J + 5)
            DO IT2 = IND, IT
              IF (ISTK(IT2) .EQ. I) THEN
                IF (JPC .LE. 0) THEN
                  JPC         = 1
                  ND          = J
                  IB(IPC + 1) = J
                  GO TO 170
                END IF
                NF          = J
                IB(IPC + 2) = J
                IF (ABS(RSTK(ND) - RSTK(NF)) .LE. 0.3D-4) THEN
                  IF (ABS(RSTK(ND + 1) - RSTK(NF + 1)) .LE. 0.3D-4)
     1               THEN
                    IF (ABS(RSTK(ND + 2) - RSTK(NF + 2)) .LE. 0.3D-4)
     1                GO TO 170
                  END IF
                END IF
                GO TO 200
              END IF
            END DO
  170       IT = ISTK(J + IP + 5)
            IF (IT .GT. 0) THEN
              IF (ISTK(IT + 4) .EQ. I) THEN
                IF (JPC .GT. 0) THEN
                  NF          = IT
                  IB(IPC + 2) = IT
                  NC = 1
                  IF (ABS(RSTK(ND) - RSTK(NF)) .LE. 0.3D-4) THEN
                    IF (ABS(RSTK(ND + 1) - RSTK(NF + 1)) .LE. 0.3D-4)
     1                THEN
                      IF (ABS(RSTK(ND + 2) - RSTK(NF + 2)) .LE. 0.3D-4)
     1                   NC = 0
                    END IF
                  END IF
                  IF (NC .GT. 0) GO TO 200
                ELSE
                  JPC         = 1
                  ND          = IT
                  IB(IPC + 1) = IT
                END IF
              END IF
            END IF
          END DO
          IF (JPC .GT. 0) THEN
            IE(IP) = 1
            GO TO 200
          END IF
  190     K = K + 6
          IF (K .LE. IENED) GO TO 130
          IF (IP .NE. 2) GO TO 240
          IP  = 1
          IPC = 0
          K   = JSK
          GO TO 190
  200     IF (IP .LE. 1) THEN
            JSK = K
            K   = ISTED
            IP  = 2
            IPC = 2
            GO TO 130
          END IF
          IF (K .EQ. JSK) GO TO 190
          IF (IE(1) .EQ. 2) THEN
            IF (IE(2) .EQ. 2) THEN
              CALL PLA196
              D(10) = D(1) * D(1) + D(4) * D(4) + D(7) * D(7)
              D(11) = D(1) * D(2) + D(4) * D(5) + D(7) * D(8)
              D(12) = D(1) * D(3) + D(4) * D(6) + D(7) * D(9)
              D(1)  = D(10)
              D(10) = D(2) * D(3) + D(5) * D(6) + D(8) * D(9)
              FRP   = D(2) * D(2) + D(5) * D(5) + D(8) * D(8)
              D(2)  = D(11)
              D(3)  = D(11)
              D(4)  = FRP
              D(5)  = D(12)
              D(6)  = D(10)
              CALL PLA198 (D, 2)
              NC = 1
              IF (ABS(D(3)) .GT. 1.D-9) THEN
                DEN = D(1) / D(3)
                IF (DEN .GE. - 0.1D-4) THEN
                  IF (1.00001D0 .GE. DEN) NC = 0
                END IF
              END IF
              IF (NC .NE. 0) GO TO 190
              NC = 1
              IF (ABS(D(3)) .GT. 1.D-9) THEN
                DEN = D(2) / D(3)
                IF (DEN .GE. - 0.1D-4) THEN
                  IF (1.00001D0 .GE. DEN) NC = 0
                END IF
              END IF
              IF (NC .NE. 0) GO TO 190
              IENPT = IENPT + 10
              RSTK(IENPT)     = RSTK(IB(4))     + DEN * (RSTK(IB(3))
     1                        - RSTK(IB(4)))
              RSTK(IENPT + 1) = RSTK(IB(4) + 1) + DEN * (RSTK(IB(3) + 1)
     1                        - RSTK(IB(4) + 1))
              RSTK(IENPT + 2) = RSTK(IB(4) + 2) + DEN * (RSTK(IB(3) + 2)
     1                        - RSTK(IB(4) + 2))
              GO TO 230
            END IF
          END IF
          JNK = IE(1)
          DO JA = 1, JNK
            ND = IB(JA)
            JNK1 = IE(2)
            DO JB = 1, JNK1
              NF = IB(2 + JB)
              IF (ABS(RSTK(ND) - RSTK(NF)) .LE. 0.3D-4) THEN
                IF (ABS(RSTK(ND + 1) - RSTK(NF + 1)) .LE. 0.3D-4) THEN
                  IF (ABS(RSTK(ND + 2) - RSTK(NF + 2)) .LE. 0.3D-4)
     1              THEN
                    IENPT           = IENPT + 10
                    RSTK(IENPT)     = RSTK(ND)
                    RSTK(IENPT + 1) = RSTK(ND + 1)
                    RSTK(IENPT + 2) = RSTK(ND + 2)
                    GO TO 230
                  END IF
                END IF
              END IF
            END DO
          End DO
          GO TO 190
  230     ND   = 1
          JNK  = IENPT
          JNK1 = 1
          CALL PLA195 (DEN)
          JNK1 = 2
          CALL PLA195 (TX)
          RSTK(IENPT + 3) = (DEN + TX) * AMU
          ISTK(IENPT + 4) = JSK
          ISTK(IENPT + 5) = K
          ISTK(IENPT + 6) = 0
          ISTK(IENPT + 7) = 0
          ISTK(IENPT + 8) = 0
          ISTK(IENPT + 9) = IL
          GO TO 190
        END IF
  240 CONTINUE
      I     = 1
      ISTNP = IENPT + 10
  250 IF (ISTK(I + 4) .NE. 1) GO TO 520
      J     = 1
  260 IB(2) = J
      IB(1) = I
      IF (ISTK(J + 5) .NE. 1) GO TO 510
      IENNP = ISTNP - 1
      DO J5 = ISTVT, IENVT, 10
        IP = 1
  270   IQ = 3 - IP
        IF (ISTK(J5 + IP + 7) .NE. IB(IP)) THEN
          JA = ISTK(J5 + 4)
          JB = ISTK(J5 + 5)
          DO J2 = JA, JB
            IF (ISTK(J2) .EQ. IB(IP)) GO TO 290
          END DO
          IE(IP) = 1
          GO TO 320
  290     IND = ISTK(J5 + IP + 5)
          IF (IND .NE. 0) THEN
            IF (ISTK(IND + 5) .NE. IB(IQ)) THEN
              IF (ISTK(IND + 4) .NE. IB(IQ)) GO TO 300
            END IF
            IENNP = IENNP + 1
            ISTK(IENNP) = IND
  300       JA = ISTK(IND + 6) + 2
  310       IND = IND + 10
            IF (IND .LE. IENPT) THEN
              IF (ISTK(IND + 6) .EQ. JA) THEN
                JB = ISTK(IND + 4)
                IF (ISTK(JB) .NE. IB(IQ)) THEN
                  IF (ISTK(JB + 1) .NE. IB(IQ)) GO TO 310
                END IF
                IENNP = IENNP + 1
                ISTK(IENNP) = IND
                GO TO 310
              END IF
            END IF
          END IF
        END IF
        IE(IP) = 0
  320   IP     = IP + 1
        IF (IP .EQ. 2) GO TO 270
        IF (IE(1) .EQ. 0 .AND. IE(2) .EQ. 0) THEN
          IENNP       = IENNP + 1
          ISTK(IENNP) = J5
        END IF
      END DO
      DO IP = 1, 2
        IQ = 3 - IP
        J6 = JT(IP)
        J5 = JI(IP)
  340   IF (J5 .LE. J6) THEN
          IND = ISTK(J5 + 4)
          IF (ISTK(IND) .NE. IB(IP)) THEN
            IF (ISTK(IND + 1) .NE. IB(IP)) GO TO 350
          END IF
          IF (ISTK(J5 + 7) .NE. IB(IQ)) THEN
            IND = ISTK(J5 + 5)
            IF (ISTK(IND) .NE. IB(IQ)) THEN
              IF (ISTK(IND + 1) .NE. IB(IQ)) GO TO 350
            END IF
          END IF
          IENNP       = IENNP + 1
          ISTK(IENNP) = J5
  350     J5          = J5 + 10
          GO TO 340
        END IF
      END DO
      J5 = JT(2) + 10
  370 IF (J5 .LE. IENPT) THEN
        IND = ISTK(J5 + 4)
        IF (ISTK(IND) .NE. I) THEN
          IF (ISTK(IND + 1) .NE. I) GO TO 380
        END IF
        IND = ISTK(J5 + 5)
        IF (ISTK(IND) .NE. J) THEN
          IF (ISTK(IND + 1) .NE. J) GO TO 380
        END IF
        IENNP       = IENNP + 1
        ISTK(IENNP) = J5
  380   J5          = J5 + 10
        GO TO 370
      END IF
      IF (IENNP - ISTNP .LE. 2) GO TO 510
  390 J3 = IENNP
  400 J4 = J3 - 1
  410 ND = ISTK(J3)
      NF = ISTK(J4)
      NC = 1
      IF (ABS(RSTK(ND) - RSTK(NF)) .LE. 0.3D-4) THEN
        IF (ABS(RSTK(ND + 1) - RSTK(NF + 1)) .LE. 0.3D-4) THEN
          IF (ABS(RSTK(ND + 2) - RSTK(NF + 2)) .LE. 0.3D-4) NC = 0
        END IF
      END IF
      IF (NC .LE. 0) THEN
        J7 = J4
  420   J8 = J7 + 1
        ISTK(J7) = ISTK(J8)
        J7 = J8
        IF (J8 .LT. IENNP) GO TO 420
        J3 = J3 - 1
        IENNP = IENNP - 1
      END IF
      J4 = J4 - 1
      IF (J4 .GE. ISTNP) GO TO 410
      J3 = J3 - 1
      IF (J3 .GT. ISTNP) GO TO 400
      IF (IENNP - ISTNP .LE. 2) GO TO 510
      ISTTR = IENNP + 1
      NPER  = ISTNP + 2
  430 IENTR = ISTTR - 6
      ND = ISTNP
      NF = ISTNP + 1
      NG = ISTNP + 2
      IB(1) = ISTK(ND)
      IB(2) = ISTK(NF)
      IB(3) = ISTK(NF)
      IB(4) = ISTK(NG)
      CALL PLA196
      IENTR           =  IENTR + 6
      IF (IENTR + 6 .GE. NTMP) CALL GEN127 ('INCREASE NTMP')
      ISTK(IENTR + 3) =  ND
      ISTK(IENTR + 4) =  NF
      ISTK(IENTR + 5) =  NG
      RSTK(IENTR    ) =  D(4) * D(9) - D(7) * D(6)
      RSTK(IENTR + 1) = -D(1) * D(9) + D(3) * D(7)
      RSTK(IENTR + 2) =  D(1) * D(6) - D(3) * D(4)
      ND = ISTK(ISTNP + 3)
      NF = ISTK(IENTR + 3)
      NF = ISTK(NF)
      DEN = (RSTK(NF) - RSTK(ND)) * RSTK(IENTR) + (RSTK(NF + 1)
     1    - RSTK(ND + 1)) * RSTK(IENTR + 1) + (RSTK(NF + 2)
     2    - RSTK(ND + 2)) * RSTK(IENTR + 2)
      IF (DEN .GT. 1.0D-5) THEN
        ISTK(ISTNP)     = ISTK(ISTNP + 1)
        ISTK(ISTNP + 1) = IB(1)
        GO TO 430
      END IF
      IF (DEN .GT. - 1.0D-5) THEN
        NPER = NPER + 1
        IF (NPER .GT. IENNP) GO TO 500
        IQ = ISTNP + 1
        DO IP = IQ, IENNP
          ISTK(IP - 1) = ISTK(IP)
        END DO
        ISTK(IENNP) = IB(1)
        GO TO 430
      END IF
      VT  = VT - DEN
      DEN = - DEN
      IF (ISK .EQ. 2) THEN
        DEV(1) = DEN
        JNK    = IENTR
        NC     = ISTNP+3
        CALL PLA197
        TT  = TT  + DEV(1)
        DE2 = DE2 + DEV(2)
      END IF
      IF (IENNP - ISTNP .GT. 3) THEN
        ND = ISTNP + 1
        NF = ISTNP
        NG = ISTNP + 3
        IB(1) = ISTK(ND)
        IB(2) = ISTK(NF)
        IB(3) = ISTK(NF)
        IB(4) = ISTK(NG)
        CALL PLA196
        IENTR           =  IENTR + 6
        IF (IENTR + 6 .GE. NTMP) GO TO 540
        ISTK(IENTR + 3) =  ND
        ISTK(IENTR + 4) =  NF
        ISTK(IENTR + 5) =  NG
        RSTK(IENTR    ) =  D(4) * D(9) - D(7) * D(6)
        RSTK(IENTR + 1) = -D(1) * D(9) + D(3) * D(7)
        RSTK(IENTR + 2) =  D(1) * D(6) - D(3) * D(4)
        NF = ND
        ND = ISTNP + 2
        IB(1) = ISTK(ND)
        IB(2) = ISTK(NF)
        IB(3) = ISTK(NF)
        IB(4) = ISTK(NG)
        CALL PLA196
        IENTR           =  IENTR + 6
        IF (IENTR + 6 .GE. NTMP) GO TO 540
        ISTK(IENTR + 3) =  ND
        ISTK(IENTR + 4) =  NF
        ISTK(IENTR + 5) =  NG
        RSTK(IENTR    ) =  D(4) * D(9) - D(7) * D(6)
        RSTK(IENTR + 1) = -D(1) * D(9) + D(3) * D(7)
        RSTK(IENTR + 2) =  D(1) * D(6) - D(3) * D(4)
        NF = ND
        ND = ISTNP
        IB(1) = ISTK(ND)
        IB(2) = ISTK(NF)
        IB(3) = ISTK(NF)
        IB(4) = ISTK(NG)
        CALL PLA196
        IENTR           =  IENTR + 6
        IF (IENTR + 6 .GE. NTMP) GO TO 540
        ISTK(IENTR + 3) =  ND
        ISTK(IENTR + 4) =  NF
        ISTK(IENTR + 5) =  NG
        RSTK(IENTR    ) =  D(4) * D(9) - D(7) * D(6)
        RSTK(IENTR + 1) = -D(1) * D(9) + D(3) * D(7)
        RSTK(IENTR + 2) =  D(1) * D(6) - D(3) * D(4)
        L = ISTNP + 3
  450   L = L + 1
        IF (IENNP .GE. L) THEN
          NC = L
          M  = IENTR
          IP = ISTTR
  460     IF (ISTK(IP + 5) .GT. 0) THEN
            ND  = ISTK(L)
            NF  = ISTK(IP + 3)
            NF  = ISTK(NF)
            DEN = (RSTK(NF)     - RSTK(ND))     * RSTK(IP)
     1          + (RSTK(NF + 1) - RSTK(ND + 1)) * RSTK(IP + 1)
     2          + (RSTK(NF + 2) - RSTK(ND + 2)) * RSTK(IP + 2)
            IF (DEN .GT. 1.D-9) THEN
              VT = VT + DEN
              IF (ISK2 .EQ. 2) THEN
                DEV(1) = DEN
                IF (DEN .GT. FLIM) THEN
                  JNK = IP
                  CALL PLA197
                  DE2 = DE2 + DEV(2)
                  TT  = TT  + DEV(1)
                END IF
              END IF
              JNK1 = ISTK(IP + 5)
              JNK3 = ISTK(IP + 3)
              ISTK(IP + 5) = 0
              ND    = ISTK(IP + 4)
              NF    = JNK1
              NG    = L
              LRETX = -1
  470         DO I0 = ISTTR, IENTR, 6
                IF (NG .EQ. ISTK(I0 + 5)) THEN
                  IF (ND .EQ. ISTK(I0 + 4)) THEN
                    IF (NF .EQ. ISTK(I0 + 3)) THEN
                      ISTK(I0 + 5) = 0
                      GO TO 490
                    END IF
                  END IF
                END IF
              END DO
              IB(1) = ISTK(ND)
              IB(2) = ISTK(NF)
              IB(3) = ISTK(NF)
              IB(4) = ISTK(NG)
              CALL PLA196
              IENTR           =  IENTR + 6
              IF (IENTR + 6 .GE. NTMP) GO TO 540
              ISTK(IENTR + 3) =  ND
              ISTK(IENTR + 4) =  NF
              ISTK(IENTR + 5) =  NG
              RSTK(IENTR    ) =  D(4) * D(9) - D(7) * D(6)
              RSTK(IENTR + 1) = -D(1) * D(9) + D(3) * D(7)
              RSTK(IENTR + 2) =  D(1) * D(6) - D(3) * D(4)
  490         IF (LRETX .LT. 0) THEN
                NF    = ND
                ND    = JNK3
                LRETX = 0
                GO TO 470
              ELSE IF (LRETX .EQ. 0) THEN
                NF    = ND
                ND    = JNK1
                LRETX = 1
                GO TO 470
              END IF
            END IF
          END IF
          IP = IP + 6
          IF (IP .LE. M) GO TO 460
          GO TO 450
        END IF
      END IF
  500 IF (IEX .EQ. 1) THEN
        IEX  = 2
        ISK  = 2
        ISK2 = 2
        VZ   = 0.001D+0 * VT
        FLIM = VZ  * 0.03D+0
        GO TO 530
      END IF
  510 J = J + 6
      IF (J .LE. IENPL) GO TO 260
  520 I = I + 6
      IF (I .LE. IENPL) GO TO 250
      TT = TT * 6.0D+0 / VT
      DEV(2) = DE2 * 6.0D+0 / VT
  530 J = IENTR + 6
      IF (J .GT. MAXUTL) MAXUTL = J
      IF (MAXUTL .GT. NTMP) GO TO 540
      RETURN
  540 WRITE (LU7, 99999, IOSTAT = IOST) NTMP
      RETURN
99999 FORMAT ('Available Array Size Exceeded. NTMP =', I7)
      END SUBROUTINE PLA194
      SUBROUTINE PLA195 (TX)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NTMP=4000)
      COMMON /XYDATA/ RSTK(NTMP), ISTK(NTMP), AMU, TT, VT, CX(2), CY(2),
     1 CZ(2), D(12), DEV(2), VMUL, IL, NC, ND, NF, NG, IB(4), IE(2),
     2 JI(2), JT(2), IENPL, ISTNV, IENNV, ISTED, IENED, ISTVT, IENVT,
     3 IENPT, ISTNP, IENNP, ISTTR, IENTR, MAXUTL, JNK, JNK1, JNK3,
     4 IEX, ISK, ISK2
      TX = 2000.0D+0
      NC = 0
      DO IT = 1, IENPL, 6
        IF (ND .EQ. ISTK(IT + JNK1 + 3)) THEN
          ANM = RSTK(IT + 3) - RSTK(IT) * RSTK(JNK)
     1        - RSTK(IT + 1) * RSTK(JNK + 1)
     2        - RSTK(IT + 2) * RSTK(JNK + 2)
          DN  = RSTK(IT) * CX(JNK1) + RSTK(IT + 1) * CY(JNK1)
     1        + RSTK(IT + 2) * CZ(JNK1)
          DN  = ABS(DN)
          ANM = ABS(ANM)
          IF (ANM .LT. TX * DN) THEN
            TX = ANM / DN
            NC = IT
          END IF
        END IF
      END DO
      RETURN
      END SUBROUTINE PLA195
      SUBROUTINE PLA196
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NTMP=4000)
      COMMON /XYDATA/ RSTK(NTMP), ISTK(NTMP), AMU, TT, VT, CX(2), CY(2),
     1 CZ(2), D(12), DEV(2), VMUL, IL, NC, ND, NF, NG, IB(4), IE(2),
     2 JI(2), JT(2), IENPL, ISTNV, IENNV, ISTED, IENED, ISTVT, IENVT,
     3 IENPT, ISTNP, IENNP, ISTTR, IENTR, MAXUTL, JNK, JNK1, JNK3,
     4 IEX, ISK, ISK2
      D(1) = RSTK(IB(1))     - RSTK(IB(2))
      D(2) = RSTK(IB(3))     - RSTK(IB(4))
      D(3) = RSTK(IB(1))     - RSTK(IB(4))
      D(4) = RSTK(IB(1) + 1) - RSTK(IB(2) + 1)
      D(5) = RSTK(IB(3) + 1) - RSTK(IB(4) + 1)
      D(6) = RSTK(IB(1) + 1) - RSTK(IB(4) + 1)
      D(7) = RSTK(IB(1) + 2) - RSTK(IB(2) + 2)
      D(8) = RSTK(IB(3) + 2) - RSTK(IB(4) + 2)
      D(9) = RSTK(IB(1) + 2) - RSTK(IB(4) + 2)
      RETURN
      END SUBROUTINE PLA196
      SUBROUTINE PLA197
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NTMP=4000)
      COMMON /XYDATA/ RSTK(NTMP), ISTK(NTMP), AMU, TT, VT, CX(2), CY(2),
     1 CZ(2), D(12), DEV(2), VMUL, IL, NC, ND, NF, NG, IB(4), IE(2),
     2 JI(2), JT(2), IENPL, ISTNV, IENNV, ISTED, IENED, ISTVT, IENVT,
     3 IENPT, ISTNP, IENNP, ISTTR, IENTR, MAXUTL, JNK, JNK1, JNK3,
     4 IEX, ISK, ISK2
      DEN  = DEV(1)
      D(4) = RSTK(ISTK(NC) + 3)
      D(1) = RSTK(ISTK(ISTK(JNK + 3)) + 3)
      D(2) = RSTK(ISTK(ISTK(JNK + 4)) + 3)
      D(3) = RSTK(ISTK(ISTK(JNK + 5)) + 3)
      DO I = 1, 3
        AF = D(I)
        JNK = I + 1
        DO J = JNK, 4
          IF (AF .GT. D(J)) THEN
            BF   = D(J)
            D(J) = AF
            AF   = BF
          END IF
        END DO
        D(I) = AF
      END DO
      D(4) = D(4) - D(3)
      D(3) = D(3) - D(2)
      D(2) = D(2) - D(1)
      D(5) = D(2) + D(3)
      D(6) = D(3) + D(4)
      D(7) = D(6) + D(2)
      IF (D(1) .LT. 15) THEN
        IAL = 1
        IBL = 0
        ICL = 0
        IF (D(2) .GT. 3.D-3) IAL = 5
        IF (D(3) .GT. 3.D-3) IBL = 2
        IF (D(4) .GT. 3.D-3) ICL = 1
        ISW = IAL + IBL + ICL
        I   = 1
        IF (ISW .EQ. 1) THEN
          D(10) = 0.166667D+0 - 0.125D+0 * (D(2) + D(3)) + 0.0416667D+0
     1          * (D(3) - D(4)) + 0.0083333D+0 * (D(2)
     2          * (D(2) + D(2) + D(3)) + D(4) * D(4) +(D(2) + D(3)
     3          + D(4)) * (4.0D+0 * D(2) + 3.0D+0 * D(3)))
          GO TO 50
        ELSE IF (ISW .EQ. 2) THEN
          D(8) = 0.5D+0 - D(2) * (0.33333D+0 - 0.125D+0 * (D(2) + D(3)))
     1         - D(3) * (0.166667D+0 - 0.0416667D+0 * D(3))
          HAB = 1.0D+0 - D(5) * (0.5D+0 - 0.166667D+0 * D(5))
          GO TO 30
        ELSE IF (ISW .EQ. 3 .OR. ISW .EQ. 4) THEN
          HA = 1.0D+0 - D(2) * (0.5D+0 - 0.166667D+0 * D(2))
        ELSE IF (ISW .EQ. 5) THEN
          HA   =  (1.0D+0 - EXP(- D(2))) / D(2)
          HPA  = -HA + (1.0D+0 - HA) / D(2)
          HP2A =  HA - (1.0D+0 + HPA + HPA) / D(2)
          HP3A = -HA + (1.0D+0 - HP2A - HP2A - HP2A) / D(2)
          HP4A =  HA - (1.0D+0 + 4.0D+0 * HP3A) / D(2)
          D(10)  =  0.5D+0 * HP2A + 0.166667D+0 * HP3A * (D(3) + D(3)
     1           + D(4)) + 0.0416667D+0 * HP4A * (3.0D+0 * D(3) * (D(3)
     2           + D(4)) + D(4) * D(4))
          GO TO 50
        ELSE
          HA = (1.0D+0 - EXP(- D(2))) / D(2)
          IF (IBL .LE. 0) THEN
            HPA  = -HA  + (1.0D+0 - HA) / D(2)
            HP2A =  HA  - (1.0D+0 + HPA + HPA) / D(2)
            HP3A = -HA  + (1.0D+0 - HP2A - HP2A - HP2A) / D(2)
            D(8) = -HPA - D(3) * (0.5D+0 * HP2A
     1           + 0.166667D+0 * HP3A * D(3))
            HAB  =  HA  + D(3) * (HPA + 0.5D+0 * D(3) * HP2A)
            GO TO 30
          END IF
        END IF
        HAB  = (1.0D+0  - EXP(- D(5))) / D(5)
        D(8) = (HA - HAB) / D(3)
        IF (ICL .LE. 0) THEN
          HPAB  = -HAB + (1.0D+0 - HAB) / D(5)
          HP2AB =  HAB - (1.0D+0 + HPAB + HPAB) / D(5)
          HP3AB = -HAB + (1.0D+0 - HP2AB - HP2AB - HP2AB) / D(5)
          D(9)  = -HPAB - D(4) * (0.5D+0 * HP2AB
     1          + 0.166667D+0 * D(4) * HP3AB)
          GO TO 40
        END IF
  30    HABC   = (1.0D+0 - EXP(- D(7))) / D(7)
        D(9)   = (HAB - HABC) / D(4)
  40    D(10)  = (D(8) - D(9)) / D(6)
  50    DEV(I) = DEN * D(10) * EXP(-D(1))
      ELSE
        DEV(1) = 0
        DEV(2) = 0
      END IF
      RETURN
      END SUBROUTINE PLA197
      SUBROUTINE PLA198 (D, IZ)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION D(*)
      IF (IZ .EQ. 2) THEN
        AA   =  D(1) * D(6) - D(5) * D(2)
        BB   = -D(3) * D(6) + D(5) * D(4)
        D(3) =  D(1) * D(4) - D(3) * D(2)
        D(1) =  BB
        D(2) =  AA
      ELSE
        AA   =  D(8) * D(12) - D(9) * D(11)
        BB   =  D(7) * D(12) - D(9) * D(10)
        CC   =  D(7) * D(11) - D(8) * D(10)
        DA   =  D(4) * AA    - D(5) * BB + D(6) * CC
        E    = -D(1) * AA    + D(2) * BB - D(3) * CC
        F    =  D(1) * (D(5) * D(9)  - D(6) * D(8))
     1       -  D(2) * (D(4) * D(9)  - D(6) * D(7))
     2       +  D(3) * (D(4) * D(8)  - D(5) * D(7))
        D(3) =  D(1) * (D(5) * D(12) - D(6) * D(11))
     1       -  D(2) * (D(4) * D(12) - D(6) * D(10))
     2       +  D(3) * (D(4) * D(11) - D(5) * D(10))
        D(1) =  DA
        D(2) =  E
        D(4) =  F
      END IF
      RETURN
      END SUBROUTINE PLA198
      SUBROUTINE PLA200 (MODE, INEXT, NOCLS, NREPL)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP52=200,NP56=30,NP57=35,
     2 NXT1=100,NXT2=200,NXT3=100,NXT4=200)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /P190/ NVRR, PMILL(NXT1, 5), XTLV(7, NXT2), IDG(NXT4, 4),
     1 XYZPL(3, NXT2), CFACE(5, NXT2), IEDGE(NXT3), NFACES, NEDGE, NVER
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ABSPSI/ PSIS(38, 4, 10), OP(3, 3, 11), IHKLPS(4, 10),
     1 NPSI
      COMMON /LOCAL/ IPR371, IPR372
      DATA IPR371, IPR372 /0, 0/
      VERT = 25.0
      HORS = PAR(50) * VERT
      IF (NREPL .EQ. 0) THEN
        IF (NOCLS .EQ. 0) CALL GGIP (HORS, VERT, 0.0, 1)
      ELSE
        GO TO 10
      END IF
      CALL GGIP (0.0, 1.0, 0.0, 0)
      CALL PLA110 (HORS, VERT, -1)
      IF (MODE .EQ. -1) THEN
        WRITE (PRBUF, '(A)', IOSTAT = IOST)
     1    'Spherical Absorption Correction '
      ELSE IF (MODE .EQ. 0) THEN
        WRITE (PRBUF, '(A)', IOSTAT = IOST)
     1    'Xtal Habit Display+Manipulation '
      ELSE IF (MODE .EQ. 1) THEN
        WRITE (PRBUF, '(A)', IOSTAT = IOST)
     1    'Analytical Correction of PsiScan'
      ELSE IF (MODE .EQ. 2) THEN
        WRITE (PRBUF, '(A)', IOSTAT = IOST)
     1    'Gaussian Integration Correction '
      ELSE IF (MODE .EQ. 3) THEN
        WRITE (PRBUF, '(A)', IOSTAT = IOST)
     1    'de Meulenaer- Tompa  Correction '
      ELSE IF (MODE .EQ. 4) THEN
        WRITE (PRBUF, '(A)', IOSTAT = IOST)
     1    'Psi-Scan  Absorption Correction '
      ELSE IF (MODE .EQ. 6) THEN
        WRITE (PRBUF, '(A)', IOSTAT = IOST)
     1    'MULtiscan ABSorption Correction '
      END IF
      CALL GGIP09 (0.0, PRBUF, 32, 0.75, 5 + IGBL(68), 2, 3.0,
     1             VERT - 1.0)
      IF (MODE .EQ. -1 .OR. MODE .EQ. 4) THEN
        WRITE (PRBUF, '(''MuR     '', F6.2)', IOSTAT = IOST) PAR(321)
        IF (PAR(321) .EQ. 0.0) THEN
          CALL GGIP (0.0, 2.0, 0.0, 0)
          IF (MODE .EQ. -1) THEN
            CALL GGIP09 (0.0, 'Enter MuR         Datum <<', 26, 0.50,
     1                  -1, 2, 21.0, 2.0)
          ELSE IF (MODE .EQ. 4 .AND. NPSI .EQ. 0) THEN
            CALL GGIP09 (0.0,
     1           'Optionally Enter MuR for Additional Theta Correction',
     2             52, 0.50, -1, 2, 10.0, 4.0)
          END IF
        ELSE
          CALL GGIP (0.0, 3.0, 0.0, 0)
        END IF
        CALL GGIP09 (0.0, PRBUF, 14, 0.5, -1, 2, VERT + 0.1, VERT - 1.0)
        IF (MODE .EQ. 4 .AND. NPSI .GT. 0) THEN
          WRITE (PRBUF, '(A, I3)', IOSTAT = IOST)
     1      'Nr. Psi Scans =', NPSI
          CALL GGIP09 (0.0, PRBUF, 18, 0.5, 1, 2,
     1                 VERT + 0.1, VERT - 3.0)
        END IF
      ELSE IF (MODE .NE. 0 .AND. MODE .NE. 4 .AND. MODE .NE. 7) THEN
        WRITE (PRBUF, '(''Mu      '', F6.2, '' mm-1'')',
     1    IOSTAT = IOST) PAR(301)
        IF (PAR(301) .EQ. 0.0) THEN
          CALL GGIP (0.0, 2.0, 0.0, 0)
          CALL GGIP09 (0.0, 'Enter Mu (mm)     Datum <<', 26, 0.50,
     1                 -1, 2, 21.0, 2.0)
        ELSE
          CALL GGIP (0.0, 3.0, 0.0, 0)
        END IF
        CALL GGIP09 (0.0, PRBUF, 19, 0.5, -1, 2, VERT + 0.1, VERT - 1.0)
      END IF
      IF (MODE .EQ. 2) THEN
        WRITE (PRBUF, '(''Grid   '', 3I4)', IOSTAT = IOST)
     1                  IPR(421), IPR(422), IPR(423)
        CALL GGIP09 (0.0, PRBUF, 19, 0.5, 1, 2, VERT + 0.1, VERT - 2.0)
      END IF
      IF (MODE .EQ. 6) THEN
        WRITE (PRBUF, '(''Radius  '', F6.3, '' mm'')',
     1    IOSTAT = IOST) PAR(305)
        IF (PAR(305) .EQ. 0.0) THEN
          CALL GGIP (0.0, 2.0, 0.0, 0)
          CALL GGIP09 (0.0, 'Enter Radius (mm) Datum', 23, 0.75, -1, 2,
     1                 17.0, 1.0)
        ELSE
          CALL GGIP (0.0, 3.0, 0.0, 0)
        END IF
        CALL GGIP09 (0.0, PRBUF, 18, 0.5, -1, 2, VERT + 0.1,
     1       VERT - 2.0)
        WRITE (PRBUF, '(''Tmin   '', F7.3, '' mm'')',
     1    IOSTAT = IOST) PAR(304)
        CALL GGIP09 (0.0, PRBUF, 17, 0.5, 1, 2, VERT + 0.1,
     1       VERT - 3.0)
        WRITE (PRBUF, '(''Tmax   '', F7.3, '' mm'')',
     1    IOSTAT = IOST) PAR(306)
        CALL GGIP09 (0.0, PRBUF, 17, 0.5, 1, 2, VERT + 0.1,
     1       VERT - 4.0)
        WRITE (PRBUF, '(''Lomax  '', I7)', IOSTAT = IOST) IPR(373)
        CALL GGIP09 (0.0, PRBUF, 14, 0.5, 1, 2, VERT + 0.1,
     1       VERT - 5.0)
        WRITE (PRBUF, '(''L1max  '', I7)', IOSTAT = IOST) IPR(374)
        CALL GGIP09 (0.0, PRBUF, 14, 0.5, 1, 2, VERT + 0.1,
     1       VERT - 6.0)
        WRITE (PRBUF, '(''MuR    '', F7.3)', IOSTAT = IOST) PAR(321)
        CALL GGIP09 (0.0, PRBUF, 17, 0.5, 1, 2, VERT + 0.1,
     1       VERT - 7.0)
      END IF
      IF (MODE .EQ. 2 .OR. MODE .EQ. 3 .OR. MODE .EQ. 4
     1      .OR. MODE .EQ. 6 .OR. MODE .EQ. -1 .OR. MODE .EQ. 0) THEN
        IF (MODE .EQ. 2 .OR. MODE .EQ. 3 .OR. MODE .EQ. 0)
     1      PAR(305) = 0.0001
        IF (PAR(301) * PAR(305) .GT. 0.0 .OR. MODE .EQ. 4
     1      .OR. (MODE .EQ. -1 .AND. PAR(321) .GT. 0.0)) THEN
          CALL GGIP (0.0, 2.0, 0.0, 0)
          IF (PAR(315) .EQ. 0.0) THEN
            IF (IPR(375) .EQ. 0) THEN
              CALL GGIP09 (0.0, 'Click on NEXT-STEP to PROCEED', 29,
     1                 0.60, -1, 2, 18.0, 1.5)
            END IF
          ELSE
            CALL GGIP09 (0.0, 'Click on END to Terminate    ', 29,
     1                 0.75, -1, 2, 15.0, 1.0)
          END IF
        END IF
      END IF
      IF (IPR(331) .EQ. 1) THEN
        WRITE (IDM, '(''a     = '', F8.4)', IOSTAT = IOST) PAR(101)
        CALL GGIP09 (0.0, IDM, 16, 0.35, 1, 2, 0.5, VERT - 2.0)
        WRITE (IDM, '(''b     = '', F8.4)', IOSTAT = IOST) PAR(102)
        CALL GGIP09 (0.0, IDM, 16, 0.35, 1, 2, 0.5, VERT - 2.6)
        WRITE (IDM, '(''c     = '', F8.4)', IOSTAT = IOST) PAR(103)
        CALL GGIP09 (0.0, IDM, 16, 0.35, 1, 2, 0.5, VERT - 3.2)
        WRITE (IDM, '(''alpha = '', F8.3)', IOSTAT = IOST) PAR(104)
        CALL GGIP09 (0.0, IDM, 16, 0.35, 1, 2, 0.5, VERT - 3.8)
        WRITE (IDM, '(''beta  = '', F8.3)', IOSTAT = IOST) PAR(105)
        CALL GGIP09 (0.0, IDM, 16, 0.35, 1, 2, 0.5, VERT - 4.4)
        WRITE (IDM, '(''gamma = '', F8.3)', IOSTAT = IOST) PAR(106)
        CALL GGIP09 (0.0, IDM, 16, 0.35, 1, 2, 0.5, VERT - 5.0)
        IF (NFACES .GT. 0) THEN
          WRITE (PRBUF, '(''Faces    '', I4)', IOSTAT = IOST) NFACES
          CALL GGIP09 (0.0, PRBUF, 13, 0.35, 1, 2, 0.5, VERT - 6.0)
          WRITE (PRBUF, '(''Vertices '', I4)', IOSTAT = IOST) NVRR
          CALL GGIP09 (0.0, PRBUF, 13, 0.35, 1, 2, 0.5, VERT - 6.5)
          WRITE (PRBUF, '(''Edges    '', I4)', IOSTAT = IOST) NEDGE
          CALL GGIP09 (0.0, PRBUF, 13, 0.35, 1, 2, 0.5, VERT - 7.0)
        END IF
      END IF
   10 IF (MODE .EQ. 6) THEN
        WRITE (PRBUF, '(''Read   ='', I7, '' Measurements'')',
     1    IOSTAT = IOST) IPR371
        CALL GGIP09 (0.0, PRBUF, 29, 0.5, 0, 2, 3.0, VERT - 8.0)
        IPR371 = IPR(371)
        WRITE (PRBUF, '(''Read   ='', I7, '' Measurements'')',
     1    IOSTAT = IOST) IPR(371)
        CALL GGIP09 (0.0, PRBUF, 29, 0.5, 5, 2, 3.0, VERT - 8.0)
        WRITE (PRBUF, '(''Accept ='', I7, '' Measurements'')',
     1    IOSTAT = IOST) IPR372
        CALL GGIP09 (0.0, PRBUF, 29, 0.5, 0, 2, 3.0, VERT - 9.0)
        IPR372 = IPR(372)
        WRITE (PRBUF, '(''Accept ='', I7, '' Measurements'')',
     1    IOSTAT = IOST) IPR(372)
        CALL GGIP09 (0.0, PRBUF, 29, 0.5, 5, 2, 3.0, VERT - 9.0)
        IF (NREPL .EQ. 0) THEN
          WRITE (PRBUF, '(''SPGR   =  '', A)', IOSTAT = IOST)
     1      SPGRNM(1)(1:11)
          CALL GGIP09 (0.0, PRBUF, 21, 0.5, 5, 2, 3.0, VERT - 7.0)
          IF (IPR(375) .GT. 0) THEN
            WRITE (PRBUF, '(''N(obs) ='', I7,'' Measurements (Used)'')',
     1        IOSTAT = IOST) IPR(375)
            CALL GGIP09 (0.0, PRBUF, 36, 0.5, 5 + IGBL(68), 2, 3.0,
     1                   VERT - 10.0)
            WRITE (PRBUF, '(''N(hkl) ='', I7, '' Unique Reflections'')',
     1        IOSTAT = IOST)  IPR(376)
            CALL GGIP09 (0.0, PRBUF, 35, 0.5, 5 + IGBL(68), 2, 3.0,
     1                   VERT - 11.0)
            WRITE (PRBUF,
     1        '(''N(par) ='', I7, '' Coefficients A(l,m)'')',
     2        IOSTAT = IOST) IPR(377)
            CALL GGIP09 (0.0, PRBUF, 36, 0.5, 5 + IGBL(68), 2, 3.0,
     1                   VERT - 12.0)
            WRITE (PRBUF,
     1        '(''Rw = '', F10.3, '' For All AHI = 1 (N(par) = 0)'')',
     2        IOSTAT = IOST) PAR(322)
            CALL GGIP09 (0.0, PRBUF, 44, 0.5, 5 + IGBL(68), 2, 3.0,
     1                   VERT - 14.0)
            WRITE (PRBUF,
     1   '(''Rw = '', F10.3, '' For the AHI From the Fitted A(l,m)'')',
     2       IOSTAT = IOST) PAR(323)
            CALL GGIP09 (0.0, PRBUF, 50, 0.5, 5 + IGBL(68), 2, 3.0,
     1                         VERT - 15.0)
            IF (PAR(319) .GT. 0.0) THEN
              WRITE (PRBUF, '(''A(min) ='', F8.4)', IOSTAT = IOST)
     1          PAR(319)
              CALL GGIP09 (0.0, PRBUF, 16, 0.5, 1, 2, 1.0,
     1                     VERT - 21.0)
              WRITE (PRBUF, '(''A(max) ='', F8.4)', IOSTAT = IOST)
     1          PAR(320)
              CALL GGIP09 (0.0, PRBUF, 16, 0.5, 1, 2, 1.0,
     1                     VERT - 22.0)
              END IF
          END IF
        END IF
        CALL GGIP (0.0, 0.0, 0.0, 6)
      END IF
      IF (MODE .NE. 0 .AND. PAR(315) .NE. 0.0) THEN
        IF (MODE .NE. 6) THEN
          WRITE (PRBUF, '(''Refl. Processed'', I7)', IOSTAT = IOST)
     1       IPR(432)
          CALL GGIP09 (0.0, PRBUF, 28, 0.5, 5 + IGBL(68), 2, 1.3,
     1                 VERT - 22.0)
        END IF
        WRITE (PRBUF, '(''T(min) ='', F8.4)', IOSTAT = IOST) PAR(315)
        CALL GGIP09 (0.0, PRBUF, 16, 0.5, 5 + IGBL(68), 2, 1.3,
     1               VERT - 23.0)
        WRITE (PRBUF, '(''T(max) ='', F8.4)', IOSTAT = IOST) PAR(317)
        CALL GGIP09 (0.0, PRBUF, 16, 0.5, 5 + IGBL(68), 2, 1.3,
     1               VERT - 24.0)
      END IF
      IF (INEXT .EQ. 0 .AND. MODE .NE. 4 .AND. MODE .NE. -1 ) THEN
        CALL PLA185 (1, 9.0, 11, NOCLS)
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
      END SUBROUTINE PLA200
      SUBROUTINE PLA201
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER CH*20, PRBUF*100
      DIMENSION YUNK(3, 3)
      OPEN (UNIT = LU61, FILE = NAMEFIL(1:KNMFIL)//'_trans.hkl',
     1    STATUS = 'UNKNOWN')
      CALL GEN003 (QQ, DUMV, DET, 0)
      IF (ABS(DET) .LT. 0.01) THEN
        IPR(2) = 73
        RETURN
      END IF
      IHT = 0
      IKT = 0
      ILT = 0
      CALL GEN005 (QQ, YUNK)
      CALL GEN052 (YUNK, QQ)
      WRITE (LU6, 99996, IOSTAT = IOST) DET
      WRITE (LU6, 99997, IOSTAT = IOST)
     1  ((DUMV(I, J), J = 1, 3), I = 1, 3)
      WRITE (LU6, 99995, IOSTAT = IOST)
      WRITE (LU6, 99997, IOSTAT = IOST) ((QQ(I, J), J = 1, 3), I = 1, 3)
      CALL GEN074 (PAC,  1, 9, 0.0)
      CALL GEN074 (UIJC, 1, 9, 0.0)
      PAC(1, 1)  = PAR(135)
      PAC(2, 2)  = PAR(136)
      PAC(3, 3)  = PAR(137)
      UIJC(1, 1) = 1.0 / PAR(113)
      UIJC(2, 2) = 1.0 / PAR(114)
      UIJC(3, 3) = 1.0 / PAR(115)
      CALL GEN132 (UIJC, QQ, PAC, PAT)
      WRITE (LU6, 99994, IOSTAT = IOST)
      WRITE (LU6, 99997, IOSTAT = IOST)
     1  ((PAT(I, J), J = 1, 3), I = 1, 3)
      IF (IGBL(37) .EQ. 0) WRITE (LU6, 99992, IOSTAT = IOST)
      N = 0
      DO
        READ (LU16, 99999, END = 10) IH, IK, IL, CH,
     1     (V1(K), V2(K), K = 1, 3)
        IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) THEN
          WRITE (LU61, 99990, IOSTAT = IOST)
          READ (LU16, 99998, END = 10) PRBUF
          IF (INDEX(PRBUF, '<?') .NE. 0) GO TO 10
          BACKSPACE LU16
          CYCLE
        END IF
        IF (GEN050 (DUMV, IH, IK, IL, IHT, IKT, ILT) .GT. 0.0) THEN
          N = N + 1
          IF (IGBL(37) .EQ. 1) THEN
            CALL GEN002 (1, PAT,  V1, V4, XLNG)
            CALL GEN002 (1, PAT,  V2, V5, XLNG)
            WRITE (LU61, 99999, IOSTAT = IOST) IHT, IKT, ILT, CH,
     1          (V4(K), V5(K), K = 1, 3)
          ELSE
            WRITE (LU61, 99999, IOSTAT = IOST) IHT, IKT, ILT, CH
          END IF
        END IF
      END DO
   10 WRITE (LU61, 99990, IOSTAT = IOST)
      WRITE (LU6,  99991, IOSTAT = IOST) N
      CLOSE (UNIT = LU61)
      OPEN (UNIT = LU61, FILE = NAMEFIL(1:KNMFIL)//'_trans.ins',
     1    STATUS = 'UNKNOWN')
      REWIND LU1
      DO
        READ (LU1, 99998, END = 20) PRBUF
        IF (PRBUF(1:4) .EQ. 'HKLF') THEN
          READ (PRBUF(5:10), *) N1
          WRITE (PRBUF, 99993) N1
        ELSE IF (PRBUF(1:4) .EQ. 'HKLT') THEN
          CYCLE
        END IF
        N2 = LEN_TRIM(PRBUF)
        WRITE (LU61, 99998) PRBUF(1:N2)
      END DO
   20 CLOSE (UNIT = LU61)
      RETURN
99999 FORMAT (3I4,  A, 6F8.5)
99998 FORMAT (A)
99997 FORMAT (3F10.4)
99996 FORMAT (/, 'Direct Cell axes and HKL Transformation Matrix',
     1           ' (Determinant = ', F5.2, /)
99995 FORMAT (/, 'Coordinate Transformation Matrix', /)
99994 FORMAT (/, 'Transformation Matrix for SHELX Direction Cosines', /)
99993 FORMAT ('HKLF', I2, ' 1')
99992 FORMAT (/, ':: No Direction Cosines on INPUT/OUTPUT', /)
99991 FORMAT (/, ':: Number of Reflections processed = ', I7, /)
99990 FORMAT (1X)
      END SUBROUTINE PLA201
      SUBROUTINE PLA202 (NLTX)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      DIMENSION YUNK(3, 3)
C * CELL REDUCTION, SEE KRIVY & GRUBER, ACTA CRYST (1976), A32, 297-298)
      IF (NLTX .EQ. 1) THEN
        L = IPR(241)
      ELSE
        L = 128
      END IF
      DO J = 1, 3
        DO K = 1, 3
          TRNS(J, K) = TRNSX(J, K, L)
        END DO
      END DO
      CALL GEN001 (1, TRNS, AA, DUMV)
      CALL PLA203 (DUMV, TRNS, PAR(440))
      CALL GEN025 (DUMV, PAR(151), 1)
      CALL GEN026 (-1, DUMV, PAR(123))
      CALL GEN005 (TRNS, YUNK)
      CALL GEN052 (YUNK, TRNS)
      CALL GEN003 (TRNS, TRNSM1, DET, 0)
      PAR(99) = PAR(98) * DET
      CALL GEN044 (PAR(123), ADIR, 1)
      CALL GEN003 (ADIR, AINV, DET, 0)
      RETURN
      END SUBROUTINE PLA202
      SUBROUTINE PLA203 (DUMV, TRNS, SCL)
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      DIMENSION TRNS(3, 3), DUMV(3, 3), YUNK(3, 3)
      LOGICAL LOOP
C * CELL REDUCTION, SEE KRIVY & GRUBER, ACTA CRYST (1976), A32, 297-298)
      IA    = NINT(DUMV(1, 1) * SCL)
      IB    = NINT(DUMV(2, 2) * SCL)
      IC    = NINT(DUMV(3, 3) * SCL)
      IKSI  = NINT(2.0 * SCL * DUMV(2, 3))
      IETA  = NINT(2.0 * SCL * DUMV(1, 3))
      IZETA = NINT(2.0 * SCL * DUMV(1, 2))
      LOOP  = .TRUE.
      DO WHILE (LOOP)
C * REDUCTION STEP 1
        IF ((IA .GT. IB) .OR. ((IA .EQ. IB) .AND.
     1      (IABS(IKSI) .GT. IABS(IETA)))) THEN
          CALL GEN014 (IA, IB)
          CALL GEN014 (IKSI, IETA)
          IETA = - IETA
          IKSI = - IKSI
          CALL GEN004 (TRNSX(1, 1, 8), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
        END IF
C * REDUCTION STEP 2
        IF ((IB .GT. IC) .OR. ((IB .EQ. IC) .AND.
     1     (IABS(IETA) .GT. IABS(IZETA)))) THEN
          CALL GEN014 (IB, IC)
          CALL GEN014 (IETA, IZETA)
          IETA  = - IETA
          IZETA = - IZETA
          CALL GEN004 (TRNSX(1, 1, 9), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
          CYCLE
        END IF
C * REDUCTION STEP 3
        IF (FLOAT (IKSI) * FLOAT (IETA) * FLOAT (IZETA) .GT. 0.0) THEN
          TRNSX(1, 1, 10) = ISIGN (1, IKSI)
          TRNSX(2, 2, 10) = ISIGN (1, IETA)
          TRNSX(3, 3, 10) = ISIGN (1, IZETA)
          IKSI            = IABS(IKSI)
          IETA            = IABS(IETA)
          IZETA           = IABS(IZETA)
          CALL GEN004 (TRNSX(1, 1, 10), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
C * REDUCTION STEP 4
        ELSE
          TRNSX(1, 1, 11) = - ISIGN (1, IKSI)
          TRNSX(2, 2, 11) = - ISIGN (1, IETA)
          TRNSX(3, 3, 11) = - ISIGN (1, IZETA)
          IF (IKSI .EQ. 0)
     1       TRNSX(1, 1, 11) = TRNSX(2, 2, 11) * TRNSX(3, 3, 11)
          IF (IETA .EQ. 0)
     1       TRNSX(2, 2, 11) = TRNSX(1, 1, 11) * TRNSX(3, 3, 11)
          IF (IZETA .EQ. 0)
     1       TRNSX(3, 3, 11) = TRNSX(1, 1, 11) * TRNSX(2, 2, 11)
          IKSI  = - IABS (IKSI)
          IETA  = - IABS (IETA)
          IZETA = - IABS (IZETA)
          CALL GEN004 (TRNSX(1, 1, 11), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
        END IF
C * REDUCTION STEP 5
        IF ((IABS (IKSI) .GT. IB) .OR. ((IKSI .EQ. IB) .AND.
     1    (2 * IETA .LT. IZETA)) .OR. ((IKSI .EQ. -IB) .AND.
     2    (IZETA .LT. 0))) THEN
          TRNSX(3, 2, 12) = - ISIGN (1, IKSI)
          IC   = IB   + IC - IKSI * ISIGN (1, IKSI)
          IETA = IETA - IZETA * ISIGN (1, IKSI)
          IF (IABS(IETA) .EQ. 1) IETA = 0
          IKSI = IKSI - 2 * IB * ISIGN (1, IKSI)
          IF (IABS(IKSI) .EQ. 1) IKSI = 0
          CALL GEN004 (TRNSX(1, 1, 12), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
          CYCLE
        END IF
C * REDUCTION STEP 6
        IF ((IABS(IETA) .GT. IA) .OR. ((IETA .EQ. IA) .AND.
     1    (2 * IKSI .LT. IZETA)) .OR. ((IETA .EQ. -IA) .AND.
     2    (IZETA .LT. 0))) THEN
          TRNSX(3, 1, 13) = - ISIGN (1, IETA)
          IC   = IA + IC - IETA * ISIGN (1, IETA)
          IKSI = IKSI - IZETA * ISIGN (1, IETA)
          IETA = IETA - 2 * IA * ISIGN (1, IETA)
          CALL GEN004 (TRNSX(1, 1, 13), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
          CYCLE
        END IF
C * REDUCTION STEP 7
        IF ((IABS(IZETA) .GT. IA) .OR. ((IZETA .EQ. IA) .AND.
     1    (2 * IKSI .LT. IETA)) .OR. ((IZETA .EQ. -IA) .AND.
     2    (IETA .LT. 0))) THEN
          TRNSX(2, 1, 14) = - ISIGN (1, IZETA)
          IB    = IA + IB - IZETA * ISIGN (1, IZETA)
          IKSI  = IKSI - IETA * ISIGN (1, IZETA)
          IZETA = IZETA - 2 * IA * ISIGN (1, IZETA)
          CALL GEN004 (TRNSX(1, 1, 14), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
          CYCLE
        END IF
C * REDUCTION STEP 8
        IF ((IKSI + IETA + IZETA + IA + IB .LT. 0) .OR.
     1     ((IKSI + IETA + IZETA + IA + IB .EQ. 0) .AND.
     2      (2 * (IA + IETA) + IZETA .GT. 0))) THEN
          IC   = IA + IB + IC + IKSI + IETA + IZETA
          IKSI = 2 * IB + IKSI + IZETA
          IETA = 2 * IA + IETA + IZETA
          CALL GEN004 (TRNSX(1, 1, 15), TRNS, YUNK)
          CALL GEN052 (YUNK, TRNS)
          CYCLE
        END IF
        LOOP = .FALSE.
      END DO
      DUMV(1, 1) = IA / SCL
      DUMV(2, 2) = IB / SCL
      DUMV(3, 3) = IC / SCL
      DUMV(1, 2) = IZETA * 0.5 / SCL
      DUMV(1, 3) = IETA  * 0.5 / SCL
      DUMV(2, 3) = IKSI  * 0.5 / SCL
      DUMV(3, 2) = DUMV(2, 3)
      DUMV(3, 1) = DUMV(1, 3)
      DUMV(2, 1) = DUMV(1, 2)
      RETURN
      END SUBROUTINE PLA203
      SUBROUTINE PLA204
      COMMON /CGRAPH/ GRAPH(44)
      CHARACTER GRAPH*125
      HORS = 26.0
      VERT = 19.5
      CALL GGIP (HORS, VERT, 0.0, 1)
      VRT = VERT - 0.5
      DO I = 1, 44
        VRT = VRT - 0.43
        CALL GGIP09 (0.0, GRAPH(I)(7:125), 119, 0.25, 1, 1, 0.0, VRT)
      END DO
      CALL GGIP (0.0, 0.0, 0.0, 6)
      RETURN
      END SUBROUTINE PLA204
      SUBROUTINE PLA205
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER SHELXL*14
      LOGICAL EXST
C * SHELXT + PLOT
   10 IF (IGBL(138) .EQ. 0 .AND. IABS(IGBL(8)) .EQ. 3) THEN
        CALL PLA345
        IGBL(138) = 1
        IF (IPR(663) .LT. 0) THEN
          CLOSE (UNIT = LU24)
          CLOSE (LU25)
          GO TO 10
        END IF
      ELSE
        SHELXL = ' _sx_a.res'
        IF (IABS(IGBL(8)) .EQ. 3) THEN
          CLOSE (UNIT = LU2)
          I = 2
          J = 8
          K = 2
          L = 14
        ELSE
          I = 1
          J = 1
          K = 9
          L = 14
        END IF
        CALL SPAWN
     1 (SHTPATH(1:IGBL(119))//' '//NAMEFIL(1:KNMFIL)//SHELXL(I:J),
     2    KERR)
        DO N = 1, 5
          SHELXL(10:10) = CHAR(96 + N)
          INQUIRE (FILE = NAMEFIL(1:KNMFIL)//SHELXL(K:L),
     1      EXIST = EXST)
          WRITE(6,'(A)') NAMEFIL(1:KNMFIL)//SHELXL(K:L)
          IF (.NOT. EXST) EXIT
          CALL SPAWN
     1    (PLAPATH(1:IGBL(80))//' -a '//NAMEFIL(1:KNMFIL)//SHELXL(K:L),
     2      KERR)
        END DO
        IF (IPR(2) .EQ. 0) IPR(2) = -1
        IGBL(1) = 3
      END IF
      RETURN
      END SUBROUTINE PLA205
      SUBROUTINE PLA206 (ISW, TYPE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER TYPE*3
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
C * ISW =  1 - SET
C * ISW = -1 - LIST
C * MODE = +-1 - IPR
C * MODE = +-2 - FN
C * MODE = +-3 - IGBL
C * MODE = +-4 - RGBL
      MODE = 0
      IEND = 0
      IGBL(6) = - IABS(IGBL(6))
      SELECT CASE (TYPE)
        CASE ('IPR')
          MODE = ISW
          IEND = NP12
        CASE ('PAR')
          MODE = ISW * 2
          IEND = NP13
        CASE ('IGB')
          MODE = ISW * 3
          IEND = NP38
        CASE ('RGB')
          MODE = ISW * 4
          IEND = NP39
      END SELECT
      IF (MODE .LT. 0) THEN
        IF (IPR(221) .EQ. 0) THEN
          I1 = 1
          I2 = IEND
        ELSE
          I1 = NINT(FN(1))
          IF (IPR(221) .GT. 1) THEN
            I2 = NINT(FN(2))
          ELSE
            I2 = I1
          END IF
          IF (I1 .LT. 1 .OR. I1 .GT. IEND .OR. I2 .LT. I1
     1        .OR. I2 .GT. IEND) GO TO 10
        END IF
        IF (MODE .EQ. -1) THEN
          IF (I2 - I1 .LT. 4) THEN
            WRITE (BCD, 99998, IOSTAT = IOST)
     1         (' ', I, IPR(I), I = I1, I2)
            IF (IWIN .EQ. 1) THEN
              BCD(80:80) = CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
            ELSE
              WRITE (LU6, 99992, IOSTAT = IOST) BCD
            END IF
          ELSE
            WRITE (LU6, 99998, IOSTAT = IOST)
     1        (' ', I, IPR(I), I = I1, I2)
            GO TO 20
          END IF
        ELSE IF (MODE .EQ. -2) THEN
          IF (I2 - I1 .LT. 3) THEN
            WRITE (BCD, 99997, IOSTAT = IOST)
     1        (' ', I, PAR(I), I = I1, I2)
            IF (IWIN .EQ. 1) THEN
              BCD(80:80) = CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
            ELSE
              WRITE (LU6, 99992, IOSTAT = IOST) BCD
            END IF
          ELSE
            WRITE (LU6, 99997, IOSTAT = IOST)
     1        (' ', I, PAR(I), I = I1, I2)
            GO TO 20
          END IF
        ELSE IF (MODE .EQ. -3) THEN
          IF (I2 - I1 .LT. 3) THEN
            WRITE (BCD, 99999, IOSTAT = IOST)
     1        (' ', I, IGBL(I), I = I1, I2)
            IF (IWIN .EQ. 1) THEN
              BCD(80:80) = CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
            ELSE
              WRITE (LU6, 99992, IOSTAT = IOST) BCD
            END IF
          ELSE
            WRITE (LU6, 99999, IOSTAT = IOST)
     1        (' ', I, IGBL(I), I = I1, I2)
            GO TO 20
          END IF
        ELSE IF (MODE .EQ. -4) THEN
          IF (I2 - I1 .LT. 3) THEN
            WRITE (BCD, 99993, IOSTAT = IOST)
     1        (' ', I, RGBL(I), I = I1, I2)
            IF (IWIN .EQ. 1) THEN
              BCD(80:80) = CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 111)
            ELSE
              WRITE (LU6, 99992, IOSTAT = IOST) BCD
            END IF
          ELSE
            WRITE (LU6, 99993, IOSTAT = IOST)
     1        (' ', I, RGBL(I), I = I1, I2)
            GO TO 20
          END IF
        END IF
      ELSE
        INDX = NINT(FN(1))
        IF (INDX .GT. 0 .AND. INDX .LE. IEND) THEN
          IF (MODE .EQ. 1) THEN
            IVAL      = NINT(FN(2))
            IVALO     = IPR(INDX)
            IPR(INDX) = IVAL
            WRITE (BCD, 99991, IOSTAT = IOST) INDX, IVALO, IVAL
            IF (IWIN .EQ. 1) THEN
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 48.0, 111)
            ELSE
              WRITE (LU6, 99994, IOSTAT = IOST) BCD(1:47)
            END IF
          ELSE IF (MODE .EQ. 2) THEN
            VAL       = FN(2)
            VALO      = PAR(INDX)
            PAR(INDX) = VAL
            WRITE (BCD, 99990, IOSTAT = IOST) INDX, VALO, VAL
            IF (IWIN .EQ. 1) THEN
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 48.0, 111)
            ELSE
              WRITE (LU6, 99994, IOSTAT = IOST) BCD(1:47)
            END IF
          ELSE IF (MODE .EQ. 3) THEN
            IVAL       = NINT(FN(2))
            IVALO      = IGBL(INDX)
            IGBL(INDX) = IVAL
            WRITE (BCD, 99989, IOSTAT = IOST) INDX, IVALO, IVAL
            IF (IWIN .EQ. 1) THEN
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 48.0, 111)
            ELSE
              WRITE (LU6, 99994, IOSTAT = IOST) BCD(1:47)
            END IF
          ELSE IF (MODE .EQ. 4) THEN
            VAL        = FN(2)
            VALO       = RGBL(INDX)
            RGBL(INDX) = VAL
            WRITE (BCD, 99988, IOSTAT = IOST) INDX, VALO, VAL
            IF (IWIN .EQ. 1) THEN
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 48.0, 111)
            ELSE
              WRITE (LU6, 99994, IOSTAT = IOST) BCD(1:47)
            END IF
          END IF
        ELSE
          GO TO 10
        END IF
      END IF
      RETURN
   10 WRITE (BCD, 99996, IOSTAT = IOST) CHAR(0)
      IF (IWIN .EQ. 1) THEN
        CALL GGIP (-999.0, 2.0, 33.0, 111)
      ELSE
        WRITE (LU6, 99992, IOSTAT = IOST) BCD(1:32)
      END IF
      RETURN
   20 IF (IWIN .EQ. 1) THEN
        WRITE (BCD, 99995, IOSTAT = IOST) CHAR(0)
        CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 23.0, 111)
      END IF
      RETURN
99999 FORMAT (1('::',3(A, 'IGBL[', I3, '] =', I10, ', ')))
99998 FORMAT (1('::',4(A, 'IPR[', I3, ']', I8, ', ')))
99997 FORMAT (1('::',3(A, 'PAR[', I3, '] =', F10.4, ', ')))
99996 FORMAT ('E: Out of Range Error, Try again', A)
99995 FORMAT ('Output on ASCII window', A)
99994 FORMAT (':: ', A)
99993 FORMAT (1('::',3(A, 'RGBL[', I3, '] =', F10.4, ', ')))
99992 FORMAT (A)
99991 FORMAT ('IPR(',  I3, ') old value =', I10,   ' new =', I10,   A)
99990 FORMAT ('PAR(',  I3, ') old value =', F10.4, ' new =', F10.4, A)
99989 FORMAT ('IGBL(', I3, ') old value =', I10,   ' new =', I10,   A)
99988 FORMAT ('RGBL(', I3, ') old value =', F10.4, ' new =', F10.4, A)
      END SUBROUTINE PLA206
      SUBROUTINE PLA207
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,MP1=5000,
     4 MP2=100,MP3=83,MP4=NVD+2*NP23-MP3*MP3*MP3-5*MP1)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER LABL*4
      COMMON // TJ(MP3, MP3, MP3), XF(5, MP1), AMX(MP4)
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
C * CAVITY SEARCH BASED ON A PROGRAM BY A.MUGNOLI
      IF (IPR(221) .GT. 0) PAR(427) = FN(1)
      IF (IPR(30) .EQ. 0) THEN
        CALL PLA066
        IF (IPR(2) .NE. 0) RETURN
      END IF
      PAGET = 'CAVITY'
      CALL PLA262 (0)
      OPEN (UNIT = LU60, FILE = NAMEFIL(1:KNMFIL)//'_cavity.spf',
     1      STATUS = 'UNKNOWN')
      WRITE (LU60, 99999, IOSTAT = IOST)
     1   JID(1:74), (PAR(100 + I), I = 1, 6)
      IF (SPGRNM(1)(1:3) .NE. '   ') THEN
        WRITE (LU60, 99986, IOSTAT = IOST) SPGRNM(1)(1:7)
      ELSE
        WRITE (LU60, 99985, IOSTAT = IOST)
     1    SPGRNM(1)(13:13), SPGRNM(1)(14:14)
        DO I = 2, IPR(255)
          CALL SGSM (ICL, I, XJX, 0, 2, IERR)
          WRITE (LU60, 99984, IOSTAT = IOST) ICL(1:60)
        END DO
      END IF
      DO I = 1, 3
        IF (PAR(100 + I) .LT. 10.0) THEN
          V2(I) = 0.05
        ELSE IF (PAR(100 + I) .GT. 20.0) THEN
          V2(I) = 0.0125
        ELSE
          V2(I) = 0.025
        END IF
        DEV(I)     = - V2(I)
        DEV(I + 3) = 1.0 + V2(I)
        ITR(I)     = MIN (MP3, 3 + NINT (1.0 / V2(I)))
      END DO
      NSYM = IPR(255) * IPR(256) * IPR(257)
      XMIR = PAR(427)
      NAT  = IPR(37)
      N3   = ITR(3)
      N2   = ITR(2)
      N1   = ITR(1)
      M3   = N3 - 1
      M2   = N2 - 1
      M1   = N1 - 1
      IF (LMT(IENS(IAN), 1) .EQ. 'Cg') THEN
        IAN0 = IAN - 1
      ELSE
        IAN0 = IAN
      END IF
      WRITE (LU6, 99995, IOSTAT = IOST) (LMT(IENS(I), 1),  I = 1, IAN0)
      WRITE (LU7, 99995, IOSTAT = IOST) (LMT(IENS(I), 1),  I = 1, IAN0)
      WRITE (LU6, 99994, IOSTAT = IOST) (RADR(IENS(I), 4), I = 1, IAN0)
      WRITE (LU7, 99994, IOSTAT = IOST) (RADR(IENS(I), 4), I = 1, IAN0)
      WRITE (LU7, 99990, IOSTAT = IOST)
     1  (DEV(I), DEV(I + 3), V2(I), I = 1, 3)
      WRITE (LU6, 99988, IOSTAT = IOST) (ITR(I), I = 1, 3)
      WRITE (LU7, 99988, IOSTAT = IOST) (ITR(I), I = 1, 3)
      NTOT = 0
      DO N = 1, NAT
        CALL GEN048 (-4, IFG(1, N), 15, IVAL)
        CALL PLA047 (LABA(N), NQ1, IDUM, JDUM, IPR(71), IGBL(55),
     1    0, 0)
        RADIUS = 1.5 * RADR(IVAL + 1, 4)
        WRITE (LU60, 99998, IOSTAT = IOST) NQ1, (XXO(N, M), M = 1, 3)
        DO M = 1, NSYM
          DO I = 1, 3
            XJX(I + 3) = 0.0
            XJX(I)     = XXO(N, I)
          END DO
          CALL SGSM (ICL, M, XJX, 6, 3, IER)
          DO I = 7, 9
            XJX(I) = MOD (XJX(I), 1.0)
            IF (XJX(I) .LT. 0.0) XJX(I) = XJX(I) + 1.0
          END DO
          DO L = 1, 3
            V8(3) = XJX(9) + L - 2
            DO K = 1, 3
              V8(2) = XJX(8) + K - 2
              DO 20 J = 1, 3
                V8(1) = XJX(7) + J - 2
                DO I = 1, 3
                  IF (V8(I) .LT.  DEV(I) - RADIUS / PAR(100 + I)
     1                .OR. V8(I) .GT.  DEV(I + 3) +
     2                  RADIUS / PAR(100 + I)) GO TO 20
                  XF(I, NTOT + 1) = V8(I)
                END DO
                IF (NTOT .NE. 0) THEN
                  DO 10 N9 = 1, NTOT
                    DO I = 1, 3
                      V4(I) = ABS(XF(I, N9) - V8(I))
                      IF (V4(I) .GT. V2(I)) GO TO 10
                    END DO
                    GO TO 20
   10             CONTINUE
                END IF
                NTOT = NTOT + 1
                IF (NTOT .GE. MP1) THEN
                  WRITE (LU6, 99989, IOSTAT = IOST) MP1
                  GO TO 60
                END IF
                XF(4, NTOT) =  RADIUS / 1.5
                XF(5, NTOT) = (RADIUS / 1.5 + XMIR) ** 2
   20         CONTINUE
            END DO
          END DO
        END DO
      END DO
      DO IZ = 1, N3
        V5(3) = (IZ - 2) * V2(3)
        DO IY = 1, N2
          V5(2) = (IY - 2) * V2(2)
          DO IX = 1, N1
            V5(1) = (IX - 2) * V2(1)
            DMIN = 99.9
            DO N = 1, NTOT
              DO J = 1, 3
                V6(J) = XF(J, N) - V5(J)
              END DO
              D2 = GEN006 (V6, AA, V6)
              IF (D2 .LE. XF(5, N)) THEN
                DMIN = 0.0
                GO TO 30
              END IF
              TEMP = SQRT(D2) - XF(4, N)
              IF (TEMP .LT. DMIN) DMIN = TEMP
            END DO
   30       TJ(IX, IY, IZ) = DMIN
          END DO
        END DO
      END DO
      WRITE (LU6, 99987, IOSTAT = IOST) XMIR
      WRITE (LU7, 99987, IOSTAT = IOST) XMIR
      INX = 0
      DO K = 2, M3
        DO J = 2, M2
          DO 40 I = 2, M1
            TJIJK = TJ(I, J, K)
            IF (TJIJK .GT. XMIR) THEN
              DO I0 = 1, 3
                DO J0 = 1, 3
                  DO K0 = 1, 3
                    IF (I0 .NE. 2 .OR. J0 .NE. 2 .OR. K0 .NE. 2)
     1                THEN
                      IF (TJIJK .LT. TJ (I + I0 - 2, J + J0 - 2,
     1                    K + K0 - 2)) GO TO 40
                    END IF
                  END DO
                END DO
              END DO
              IF (INX .LT. MP2) THEN
                LL  = INX * 4 + 1
                INX = INX + 1
                AMX(LL)     = TJIJK
                AMX(LL + 1) = V2(1) * (I - 1) + DEV(1)
                AMX(LL + 2) = V2(2) * (J - 1) + DEV(2)
                AMX(LL + 3) = V2(3) * (K - 1) + DEV(3)
              END IF
            END IF
   40     CONTINUE
        END DO
      END DO
      NN = (INX - 1) * 4 + 1
   50 ITEST = 0
      DO I = 1, NN - 4, 4
        IJ = I + 4
        IF (AMX(I) .LT. AMX(IJ)) THEN
          CALL GEN018 (AMX(I),     AMX(IJ))
          CALL GEN018 (AMX(I + 1), AMX(IJ + 1))
          CALL GEN018 (AMX(I + 2), AMX(IJ + 2))
          CALL GEN018 (AMX(I + 3), AMX(IJ + 3))
          ITEST = ITEST + 1
        END IF
      END DO
      IF (ITEST .GT. 0) GO TO 50
      IF (INX .GT. 0) THEN
        WRITE (LU7, 99996, IOSTAT = IOST)
        WRITE (LU7, 99992, IOSTAT = IOST)
        IND = 0
        DO I = 1, NN, 4
        IND = IND + 1
          WRITE (LU7, 99991, IOSTAT = IOST)
     1      IND, (AMX(I + J), J = 1, 3), AMX(I)
          WRITE (LU6, 99991, IOSTAT = IOST)
     1      IND, (AMX(I + J), J = 1, 3), AMX(I)
          IF (IND .GT. 99) THEN
            WRITE (LABL, 99982, IOSTAT = IOST) IND
          ELSE IF (IND .GT. 9) THEN
            WRITE (LABL, 99981, IOSTAT = IOST) IND
          ELSE
            WRITE (LABL, 99980, IOSTAT = IOST) IND
          END IF
          WRITE (LU60, 99998, IOSTAT = IOST)
     1      LABL, (AMX(I + J), J = 1, 3)
          WRITE (LU60, 99983, IOSTAT = IOST) LABL,  AMX(I)
        END DO
        WRITE (LU60, 99997, IOSTAT = IOST)
        CLOSE (UNIT = LU60)
        IF (AMX(1) .LT. 5.0) THEN
          KERR = 0
          CALL SPAWN
     1  (PLAPATH(1:IGBL(80))//' -p '//NAMEFIL(1:KNMFIL)//'_cavity.spf',
     2  KERR)
        END IF
      ELSE
        WRITE (LU6, 99993, IOSTAT = IOST)
        CALL PLA015 (0, 52)
      END IF
   60 RETURN
99999 FORMAT ('TITL ', A, /, 'CELL', 6F12.4)
99998 FORMAT ('ATOM ', A, 3F10.4)
99997 FORMAT ('STRAW COLOR', /, 'UNITCELL', /, 'PACK', /, 'PLOT')
99996 FORMAT (//, 10X, 'Centers of CAVITIES with Their Radius', /)
99995 FORMAT (/, 'van der Waals (or ion) Radii used in the Analysis',
     1        /, 80('='), //, 16(3X, A))
99994 FORMAT (80('-'), /, 16F5.2)
99993 FORMAT (/, ':: No CAVITY''S Found in this Structure', /)
99992 FORMAT (29X, 'X', 7X, 'Y', 7X, 'Z', 7X, 'Radius (Ang)', /)
99991 FORMAT (10X, 'Cavity No.', I3, 3F8.3, 7X, F7.2)
99990 FORMAT (//, 9X, 'Map Intervals and Limits Along X,Y,Z', //,
     1        6X, 3(3X, 3F6.3))
99989 FORMAT (//, 1X, 'The Limit of', I5,
     1        ' Generated ATOMS has been Reached.')
99988 FORMAT (/, 10X, 'Number of Map Points Along X, Y, Z = ', 3I5, /)
99987 FORMAT (/, 10X, 'Minimum CAVITY Radius to be Considered (Ang) =',
     2        F6.2, /)
99986 FORMAT ('SPGR ', A)
99985 FORMAT ('LATT ', A, 2X, A)
99984 FORMAT ('SYMM ', A)
99983 FORMAT ('RADII ATOMS ', A, F10.3)
99982 FORMAT ('X', I3)
99981 FORMAT ('X', I2)
99980 FORMAT ('X', I1)
      END SUBROUTINE PLA207
      SUBROUTINE PLA208
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      DIMENSION NCT(16)
      IPR(495) = 0
      NB       = 1
      NE       = 80
      CALL GEN097 (NCT, 1, 16, 0)
      CALL PLA080
      CALL PLA287 (1, 1, 1)
      NAT  = IPR(37)
      NRES = IPR(75)
      NATO = IPR(589)
      OPEN (UNIT = LU62, FILE = NAMEFIL(1:KNMFIL)//'_exp.ins',
     1                                     STATUS = 'UNKNOWN')
      WRITE (LU62, 99999, IOSTAT = IOST) JID(1:74), PAR(17),
     1       (PAR(100 + I), I = 1, 6), (PAR(106 + I), I = 1, 6)
      IF (LMT(IAN, 1) .EQ. 'Cg') THEN
        DO I = 1, IAN
          IF (IENS(I) .EQ. IAN) THEN
            IF (I .LT. IAN) THEN
              DO J = I + 1, IAN
                IENS(J - 1) = IENS(J)
              END DO
            END IF
            IAN = IAN - 1
            EXIT
          END IF
        END DO
      END IF
      WRITE (LU62, 99998, IOSTAT = IOST) (LMT(IENS(I), 1), I = 1, IAN)
      WRITE (LU62, 99997, IOSTAT = IOST)
     1  (NINT(CONT(IENS(I), 2)), I = 1, IAN)
      DO N = 1, NRES
        NSO = 0
        DO I = 1, NATO
          IF (XXO(I, 4) .NE. 0.0) THEN
            CALL GEN048 (-6, IFG(1, I), 9, NR)
            IF (NR .EQ. N) THEN
              CALL PLA047 (LABA(I), NQ1, MN, IENR, 0, IGBL(55),
     1          0, 0)
              CALL GEN048 (-4, IFG(1, I), 15, NO1)
              NO1 = NO1 + 1
              CALL GEN048 (-1,  IFG(1, I), 4, IANIS)
              NCT(NO1) = NCT(NO1) + 1
              DO L = 1, IAN
                IF (IENS(L) .EQ. NO1) THEN
                  ISCFT = L
                  GO TO 10
                END IF
              END DO
   10         NQ3 = LMT(NO1, 1)
              IF (NQ3(1:1) .EQ. ' ') THEN
                NQ2 = NQ3(2:2)//'      '
              ELSE
                NQ2 = NQ3(1:2)//'     '
              END IF
              CALL GEN040 (NCT(NO1), NQ3, IP)
              IF (NQ2(2:2) .EQ. ' ') THEN
                NQ2(2:) = NQ3(1:IP)
              ELSE
                NQ2(3:) = NQ3(1:IP)
              END IF
              NS = (I - 1) / NAT + 1
              IF (NS .NE. NSO) THEN
                DO K = 1, 3
                  V2(K) = 0.0
   20             IF (XXO(I, K) + V2(K) .LT. 0.0) THEN
                    V2(K) = V2(K) + 1.0
                    GO TO 20
                  END IF
                END DO
                DO K = 1, 3
   30             IF (XXO(I, K) + V2(K) .GE. 1.0) THEN
                    V2(K) = V2(K) - 1.0
                    GO TO 30
                  END IF
                END DO
                NSO = NS
                DO K = 1, 3
                  XJX(K + 3) = V2(K)
                END DO
                CALL SGSM (ICL, NS, XJX, 0, 20, IER)
                CALL GEN047 (ICL, 1, 80)
                CALL GEN039 (1, ICL, 1, 80, NB, NE)
              END IF
              WRITE (LU62, 99993, IOSTAT = IOST) NQ2, NQ1, ICL(1:NE)
              WRITE (LU62, 99995, IOSTAT = IOST)
     1          NQ2, ISCFT, (XXO(I, J) + V2(J), J = 1, 3),
     2          XXO(I, 4) + 10.0
              NANIS = 1 + IANIS * 5
              WRITE (LU62, 99994, IOSTAT = IOST)
     1          (XSD(I, J), J = 1, NANIS)
            END IF
          END IF
        END DO
      END DO
      WRITE (LU62, 99996, IOSTAT = IOST)
      CLOSE (UNIT = LU62)
      IF (IGBL(15) .NE. -1) THEN
        IPR(408) = -1
        CALL PLA145 (0)
        IF (IPR(373) .GT. 0) THEN
          OPEN (UNIT = LU63, FILE = NAMEFIL(1:KNMFIL)//'_exp.hkl',
     1                                       STATUS = 'UNKNOWN')
          REWIND LU17
          DO
            READ  (LU17, 99992, END = 40, ERR = 40) IDM
            WRITE (LU63, 99992, IOSTAT = IOST) IDM(1:28)
          END DO
          CLOSE (UNIT = LU63)
        END IF
      END IF
   40 CLOSE (UNIT = LU17, STATUS = 'DELETE')
      IF (IPR(2) .EQ. 0) IPR(2) = -12
      RETURN
99999 FORMAT ('TITL ', A, /,
     1        'CELL ', F9.5, 3F10.4, 3F10.3, /,
     2        'ZERR 1', 3F10.4, 3F10.3, /,
     3        'LATT -1')
99998 FORMAT ('SFAC ', 16(1X, A))
99997 FORMAT ('UNIT ', 2I5, 14I4)
99996 FORMAT ('END')
99995 FORMAT (A, I3, 4F10.4, ' =')
99994 FORMAT (5X, 6F10.6)
99993 FORMAT (7X, 'new: ', A, ' = old: ', A, '[', A, ']')
99992 FORMAT (A)
      END SUBROUTINE PLA208
      SUBROUTINE PLA209
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      DIMENSION QUADRIC(10), UU(4, 4), UINV(4, 4), EIGENS(4),
     1 EVECS(4, 4), EVECINV(4, 4), EVECIT(4, 4), QQQ(4, 4), QP(4, 4),
     2 TEMP(4, 4)
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /MSWDS/ DOS
      LOGICAL DOS
      CHARACTER REDIR*4, TIFF*5
      INTEGER FINDEXE
      IF (DOS) THEN
        REDIR = ' -i '
      ELSE
        REDIR = '  < '
      END IF
      IF (IGBL(109) .EQ. 0) THEN
        TIFF = 'tiff'
      ELSE
        TIFF = 'png'
      END IF
      CALL GEN021 (EVECINV, 0)
      ASPECT = 1280.0 / 1024.0
      RADIUS = 0.10
      XMARG  = 1.15
      RAD    = PAR(46) / (4.0 * RGBL(5))
      OPEN (UNIT = LU64, FILE = NAMEFIL(1:KNMFIL)//'.rst',
     1                          STATUS = 'UNKNOWN')
      OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'.r3d',
     1                          STATUS = 'UNKNOWN')
      TX = - (PAR(58) + PAR(55)) / 2.0
      TY = - (PAR(59) + PAR(56)) / 2.0
      TZ = - (PAR(60) + PAR(57)) / 2.0
      IF (ASPECT .GE. 1.0) THEN
        XROOM = ASPECT
        YROOM = 1.0
        ZROOM = 2.0
      ELSE
        XROOM = 1.0
        YROOM = ASPECT
        ZROOM = 2.0
      END IF
      SCALE = MAX ((PAR(58) - PAR(55) + 2 * RAD) / XROOM,
     1             (PAR(59) - PAR(56) + 2 * RAD) / YROOM,
     2             (PAR(60) - PAR(57) + 2 * RAD) / ZROOM)
      SCALE = SCALE / 0.90
      WRITE (LU65, 99999, IOSTAT = IOST) TX, TY, TZ, SCALE
      IF (RADIUS .GT. 0.0) THEN
        KNCD = IPR(39) + IPR(64)
        DO 30 NCD = 1, IPR(131)
          KNCD = KNCD + 1
          IAT = NINT(XSD(KNCD, 4))
          JAT = NINT(XSD(KNCD, 5))
          CALL PLA047 (LABA(IAT), NQ1, IDUM, IENR1, 0, IGBL(55),
     1      1, 0)
          CALL PLA047 (LABA(JAT), NQ2, IDUM, IENR2, 0, IGBL(55),
     1      1, 0)
          CALL GEN048 (-4,  IFG(1, IAT), 15, IEN1)
          CALL GEN048 (-4,  IFG(1, JAT), 15, IEN2)
          ICOL = IACL(IEN1 + 1)
          JCOL = IACL(IEN2 + 1)
          CALL GEN108 (LU64, 0)
          NS = 0
   10     READ (LU64, 99988, END = 30) LINE
          IF (LINE(1:4) .NE. 'ATOM')  GO TO 10
          IF (NQ1 .EQ. LINE(13:19)) THEN
            READ (LINE(31:54), 99990) V1(1), V1(2), V1(3)
            NS = NS + 1
          ELSE IF (NQ2 .EQ. LINE(13:19)) THEN
            READ (LINE(31:54), 99990) V2(1), V2(2), V2(3)
            NS = NS + 1
          END IF
          IF (NS .LT. 2) GO TO 10
          WRITE (LU65, 99993, IOSTAT = IOST) NQ1, NQ2
          IF (ICOL .EQ. JCOL) THEN
            WRITE (LU65, 99994, IOSTAT = IOST)
     1       (V1(K), K = 1, 3), RADIUS, (V2(K), K = 1, 3), RADIUS,
     2       RGB(1, ICOL), RGB(2, ICOL), RGB(3, ICOL)
          ELSE
            DO K = 1, 3
              V3(K) = (V1(K) + V2(K)) / 2
            END DO
            WRITE (LU65, 99994, IOSTAT = IOST)
     1        (V1(K), K = 1, 3), RADIUS, (V3(K), K = 1, 3), RADIUS,
     2        RGB(1, ICOL), RGB(2, ICOL), RGB(3, ICOL)
            WRITE (LU65, 99994, IOSTAT = IOST)
     1        (V3(K), K = 1, 3), RADIUS, (V2(K), K = 1, 3), RADIUS,
     2        RGB(1, JCOL), RGB(2, JCOL), RGB(3, JCOL)
          END IF
   30   CONTINUE
      END IF
      IF (IPR(148) .NE. 0) THEN
        NB = 1
        NE = 2
        IF (IPR(148) .EQ. 1) NB = 2
        IF (IPR(148) .EQ. 2) NE = 1
        DO NS = NB, NE
          CALL GEN108 (LU64, 0)
   40     READ (LU64, 99988, END = 110) LINE
          IF (LINE(1:4) .EQ. 'ATOM') THEN
            IF (LINE(13:13) .NE. ' ') CALL GEN020 (-1, LINE, 14, 14)
            IF (LINE(13:14) .NE. 'CG') THEN
              DO I = 1, 16
                IF (LINE(13:14) .EQ. LMT(I, 1)) THEN
                  ICOL = IACL(I)
                  GO TO 60
                END IF
              END DO
              ICOL = 1
            ELSE
              GO TO 40
            END IF
   60       READ (LINE(31:54), 99990) X, Y, Z
            READ (LU64, 99988, END = 110) LINE
            READ (LINE(29:70), 99989) (DUMA(I), I = 1, 6)
            CALL GEN074 (EIGENS, 1,  3, 0.0)
            CALL GEN074 (EVECS,  1, 16, 0.0)
            CALL GEN074 (UU,     1, 16, 0.0)
            CALL GEN074 (UINV,   1, 16, 0.0)
            EIGENS(4)   = 1.0
            EVECS(4, 4) = 1.0
            UU(1, 1) = DUMA(1) / 10000
            UU(2, 2) = DUMA(2) / 10000
            UU(3, 3) = DUMA(3) / 10000
            UU(4, 4) = - (1.0 / PAR(46) ** 2)
            UU(1, 2) = DUMA(4) / 10000
            UU(2, 1) = DUMA(4) / 10000
            UU(2, 3) = DUMA(6) / 10000
            UU(3, 2) = DUMA(6) / 10000
            UU(1, 3) = DUMA(5) / 10000
            UU(3, 1) = DUMA(5) / 10000
            IF (GEN061 (UU, UINV) .EQ. 0.0)
     1        CALL GEN127 ('PLA209')
            QUADRIC(1)  = UINV(1, 1)
            QUADRIC(2)  = UINV(2, 2)
            QUADRIC(3)  = UINV(3, 3)
            QUADRIC(4)  = UINV(1, 2)
            QUADRIC(5)  = UINV(2, 3)
            QUADRIC(6)  = UINV(1, 3)
            QUADRIC(7)  = UINV(1, 4)
            QUADRIC(8)  = UINV(2, 4)
            QUADRIC(9)  = UINV(3, 4)
            QUADRIC(10) = UINV(4, 4)
            CALL GEN064 (UU, 3, 4, EIGENS, EVECS)
            DO I = 1, 3
              IF (EIGENS(I) .GT. 0.0) THEN
                EIGENS(I) = SQRT(EIGENS(I))
              ELSE
                GO TO 40
              END IF
            END DO
            RADLIM = PAR(46) * MAX (EIGENS(1), EIGENS(2), EIGENS(3))
     1             * XMARG
            IF (NS .EQ. 1) THEN
              IF (GEN061 (EVECS, EVECINV) .EQ. 0.0)
     1          CALL GEN127 ('PLA209')
              CALL GEN060 (EVECINV, EVECIT)
              DO K = 1, 3
                DO I = 1, 4
                  DO J = 1, 4
                    QQQ(I, J) = 0.0
                  END DO
                  QQQ(I, I) = 1.0 / EIGENS(I)**2
                END DO
                QQQ(K, K) = 1000.0
                QQQ(4, 4) = - PAR(46) ** 2
                CALL GEN059 (QQQ, EVECINV, TEMP)
                CALL GEN059 (EVECIT, TEMP, QP)
                IF (ICOL .NE. 8) THEN
                  WRITE (LU65, 99996, IOSTAT = IOST)
     1              LINE(13:19), X, Y, Z, RADLIM,
     2              (RGB(L, ICOL), L = 1, 3)
                  WRITE (LU65, 99995, IOSTAT = IOST)
     1              QP(1, 1), QP(2, 2), QP(3, 3), QP(1, 2), QP(2, 3),
     2              QP(1, 3), QP(1, 4), QP(2, 4), QP(3, 4), QP(4, 4)
                END IF
              END DO
            ELSE
              IF (ICOL .NE. 8) THEN
                WRITE (LU65, 99996, IOSTAT = IOST)
     1            LINE(13:19), X, Y, Z, RADLIM,
     2            (RGB(K, ICOL), K = 1, 3)
                WRITE (LU65, 99995, IOSTAT = IOST)
     1           (QUADRIC(I), I = 1, 10)
              END IF
            END IF
          END IF
          GO TO 40
  110     IF (NS .EQ. 1) THEN
            IF (IPR(148) .EQ. 3) THEN
              WRITE (LU65, 99998, IOSTAT = IOST)
            ELSE IF (IPR(148) .EQ. 2) THEN
              GO TO 130
            END IF
          ELSE
            IF (IPR(148) .EQ. 3) WRITE (LU65, 99997, IOSTAT = IOST)
          END IF
        END DO
      END IF
  130 CLOSE (UNIT = LU64)
      CLOSE (UNIT = LU65)
      CALL GEN038 (CGETENV, 1, 255)
      NE = FINDEXE ('R3DEXE', CGETENV, 'render')
      IF (NE .GT. 0) THEN
        CGETENV(NE + 1:)  = REDIR//NAMEFIL(1:KNMFIL)//
     1 '.r3d  -'//TIFF//NAMEFIL(1:KNMFIL)//'.'//TIFF
        KERR = 0
        CALL SPAWN (CGETENV, KERR)
        CALL GEN038 (CGETENV, 1, 255)
        NE = FINDEXE ('XVWEXE', CGETENV, 'display')
        IF (NE .EQ. 0) THEN
          WRITE (LU6, 99992, IOSTAT = IOST)
          NE = FINDEXE ('XVWEXE', CGETENV, 'xv')
        END IF
        IF (NE .EQ. 0) THEN
          WRITE (LU6, 99991, IOSTAT = IOST)
          NE = FINDEXE ('XVWEXE', CGETENV, 'gimp')
        END IF
        IF (NE .GT. 0) THEN
          CGETENV(NE + 1:) = ' '//NAMEFIL(1:KNMFIL)//'.'//TIFF//' &'
          KERR = 0
          CALL SPAWN (CGETENV, KERR)
        END IF
      ELSE
        CALL PLA015 (0, 9)
      END IF
      RETURN
99999 FORMAT ('PLATON-TO-RASTER3D', /,
     1        '80  64    TILES IN X,Y', /,
     2        '12  12    PIXELS (X,Y) PER TILE', /,
     3        '4         3X3 VIRTUAL PIXELS -> 2X2 PIXELS', /,
     4        '0.3 0.6 1.0      BACKGROUND', /,
     5        'F         NO, SHADOWS ARE DORKY', /,
     6        '25        PHONG POWER', /,
     7        '0.15      SECONDARY LIGHT CONTRIBUTION', /,
     8        '0.05      AMBIENT LIGHT CONTRIBUTION', /,
     9        '0.25      SPECULAR REFLECTION COMPONENT', /,
     *        '0.0       NO PERSPECTIVE', /,
     1        '1 1 1     MAIN LIGHT SOURCE POSITION', /,
     2        '1 0 0 0   INPUT CO-ORDINATE + RADIUS TRANSFORMATION', /,
     3        '0 1 0 0', /, '0 0 1 0', /,  4F10.3, /,
     4        '3         MIXED OBJECT TYPES', /,
     5        '*', /, '*', /, '*')
99998 FORMAT ('9 BEGIN TRANSPARENT ELLIPSOIDS', /, '8 ', /,
     1        ' 15.  0.6   1.0 1.0 1.0   0.6   0 0 0 0')
99997 FORMAT ('9 END TRANSPARENT ELLIPSOIDS')
99996 FORMAT ('# ', A, /, '14', /, 7F8.3)
99995 FORMAT (10F12.4)
99994 FORMAT ('3', /, 11F8.3)
99993 FORMAT ('#', 2(1X, A))
99992 FORMAT ('program display not found, try xv')
99991 FORMAT ('program xv not found, try gimp')
99990 FORMAT (3F8.3)
99989 FORMAT (6F7.0)
99988 FORMAT (A)
      END SUBROUTINE PLA209
      SUBROUTINE PLA211 (LU6, LU7, JID, IWEIGHT)
      PARAMETER (NMA=550, NMG=120)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /AT2/ DCM
      COMMON /ORIE/ ORX(3, 3), OT(3, 3), OTI(3, 3), BARC(3), BARO(3),
     1 RIN(3)
      COMMON /SRC/ XO(3, NMA), XS(3, NMA), D(NMA), CO(3, NMA), IV(NMA),
     1 COY(3,NMA), WWW(NMA), NGE(NMA), WGHT(NMA), DC(NMA), TRL(3, NMG),
     2 CF(NMA), MK(NMA, NMG), MN(NMA), MD(NMA, 2), RMSX(3, NMA),
     3 ISU(NMG), IASU(NMA), SIM(3, 3, NMG), DEVX(NMG), CSM(NMG),
     4 MTG(NMG, NMG), IAT(NMA), DA(NMA), MEQ(NMA), AL(3, 3), ALX(3, 3),
     5 AAY(3, 3), DEL(4), DELM(4), ORI(3, 3), CSMT, NMS, RMST
      CHARACTER LINE*80, RIGA*40, OLDPT*7, PT*7, S1*1, S2*1, SN*2,
     1 TOT*4, LBLS(NMG)*3, CWEIGHT*6
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /POINTGR/ PNTGR(32)
      CHARACTER PNTGR*5
      CHARACTER JID*(*), PRBUF*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
C * ADAPTED FROM SYMMOL: T. Pilati & A. Forni, J.Appl.Cryst. (1998), 31,
C *                      503-504 & (2000), 33, 417.
      ICOM = 0
      MOO  = -1
      PAGET = 'MOLSYM'
      IF (IWEIGHT .EQ. 1) THEN
        CWEIGHT = 'ATOMIC'
      ELSE
        CWEIGHT = 'UNIT'
      ENDIF
      IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IPR(495) .EQ. 2 .AND.
     1  IPR(121) .EQ. 0) THEN
        IWIN = 1
        CALL GGIP (HORS, VERT, 0.0, 1)
        VRT = VERT - 0.8
        WRITE (PRBUF, 99982, IOSTAT = IOST) JID(1:20)
        CALL GGIP09 (0.0, PRBUF, 80, 0.50, 5 + IGBL(68), 2, 1.0, VRT)
        VRT = VRT - 0.8
        WRITE (PRBUF, 99981, IOSTAT = IOST) CWEIGHT
        CALL GGIP09 (0.0, PRBUF, 80, 0.40, 5 + IGBL(68), 2, 1.0, VRT)
        CALL GGIP (0.0, 0.0, 0.0, 6)
      ELSE
        IWIN = 0
      END IF
      CALL PLA262 (-8)
      WRITE (LU7, 99998, IOSTAT = IOST) CWEIGHT
      WRITE (LU6, 99983, IOSTAT = IOST) CWEIGHT
      NA = IPR(39)
      DO 310 MO = 1, IPR(75)
        DCM    = PAR(73)
        OLDPT  = ' '
        IPRW   = 0
   10   DLINER = 0.1
        CALL GEN074 (SIM, 1, 9 * NMG, 0.0)
        CALL GEN021 (AL, 1)
        SIM(1, 1, 1) = 1.0
        SIM(2, 2, 1) = 1.0
        SIM(3, 3, 1) = 1.0
        IES          = 0
        N            = 0
        NMS          = 1
        DO I = 1, NA
          CALL GEN048 (-1, IFG(1, I), 7, IHAT)
          IF (IHAT .EQ. 0) THEN
            CALL GEN048 (-6, IFG(1, I), 9, IRES)
            IF (IRES .EQ. MO) THEN
              CALL GEN048 (-7, IFG(2, I), 1, IPP)
              IF (IPPR(IPP + 1, 1) .LT. 1000) THEN
                N = 0
                GO TO 310
              END IF
              N = N + 1
              IF (N .GT. NMA) THEN
                CALL PLA262 (3)
                WRITE (LU6, 99990, IOSTAT = IOST) MO
                WRITE (LU7, 99990, IOSTAT = IOST) MO
                GO TO 320
              END IF
              IASU(I) = 2
              DO K = 1, 3
                XO(K, N) = XXO(I, K + 3)
              END DO
              CALL GEN048 (-4, IFG(1, I), 15, NO1)
              NO1 = NO1 + 1
              IF (IWEIGHT .EQ. 1) THEN
                WGHT(N) = ATWT(IEN(NO1))
              ELSE
                WGHT(N) = 1.0
              END IF
              MN(N)    = NO1
              MK(N, 1) = N
            END IF
          END IF
        END DO
        PORIG = WGHT(1)
        IF (N .GT. 2) THEN
          NLOOP = 0
   20     CALL GEN021 (PAT, 1)
          CALL GEN074 (BARO, 1, 3, 0.0)
          CALL GEN074 (SDV,  1, 6, 0.0)
          SUM = 0.0
          DO I = 1, N
            DO J = 1, 3
              BARO(J) = BARO(J) + WGHT(I) * XO(J, I)
            END DO
            SUM = SUM + WGHT(I)
          END DO
          IF (SUM .EQ. 0.0) RETURN
          DO I = 1, 3
            BARO(I) = BARO(I) / SUM
          END DO
          DO I = 1, N
            DO J = 1, 3
              XO(J, I) = XO(J, I) - BARO(J)
              V2(J)    = XO(J, I) * WGHT(I)
            END DO
            SDV(1) = SDV(1) + V2(1) * XO(1, I)
            SDV(2) = SDV(2) - V2(1) * XO(2, I)
            SDV(3) = SDV(3) - V2(1) * XO(3, I)
            SDV(4) = SDV(4) + V2(2) * XO(2, I)
            SDV(5) = SDV(5) - V2(2) * XO(3, I)
            SDV(6) = SDV(6) + V2(3) * XO(3, I)
          END DO
          DAM(1, 1) = SDV(4) + SDV(6)
          DAM(2, 2) = SDV(1) + SDV(6)
          DAM(3, 3) = SDV(1) + SDV(4)
          DAM(1, 2) = SDV(2)
          DAM(1, 3) = SDV(3)
          DAM(2, 3) = SDV(5)
          CALL GEN024 (DAM, DUMV, RIN, ORX)
          CALL GEN076 (ORX, ORX, ORX, 1, 2, 3)
          CALL GEN081 (ORX, ORX, 1, 1)
          CALL GEN077 (ORX, PAT, OT, 1, 1, 1)
          CALL GEN003 (OT,  OTI, DETER, 0)
          CALL GEN003 (PAT, ORI, DETER, 0)
          CALL GEN078 (ORI, BARO, BARC, 1, 1, 1)
          DO I = 1, N
            CALL GEN078 (ORX, XO, XO, 1, I, I)
          END DO
          DM = 0.0
          DO I = 1, N
            CALL GEN075  (XO, XO, D(I), I, I, 2)
            IF (D(I) .GT. DM) DM = D(I)
          END DO
          MDEG = 0
          RINMX = MAX (RIN(1), RIN(2), RIN(3))
          IF (ABS(RIN(1) - RIN(2)) / RINMX .LE. DLINER) MDEG = 1
          IF (ABS(RIN(2) - RIN(3)) / RINMX .LE. DLINER) MDEG = MDEG + 2
          ND = (MDEG + 1) / 2 + 1
          IF (MDEG .EQ. 1) THEN
            DO I = 1, N
              COM = SQRT(XO(1, I) ** 2 + XO(2, I) ** 2)
              IF (COM .GT. DCM) GO TO 30
            END DO
            CALL GEN074 (CO, 1, 9, 0.0)
            CO(1, 1) = -1.0
            CO(2, 2) = -1.0
            CO(3, 3) =  1.0
            CALL PLA212 (CO, MV, N)
            CO(3, 3) = -1.0
            CALL PLA212 (CO, MV, N)
            MDEG = 5
            GO TO 160
          END IF
          IF (MDEG .EQ. 3) THEN
            GO TO 100
          ELSE IF (MDEG .EQ. 2) THEN
            CALL GEN074 (CO, 1, 9, 0.0)
            MDEG     =  1
            CO(3, 1) =  1.0
            CO(1, 3) =  1.0
            CO(2, 2) = -1.0
            CALL PLA214 (CO, N)
            CALL GEN018 (RIN(1), RIN(3))
          END IF
   30     IU = 3
          IB = 2
          IC = 1
          MORD = 9
          IF (MDEG .EQ. 0) MORD = 3
          NASS = 1
   40     MORD = MORD - 1
          IF (MORD .EQ. 3 .AND. MDEG .EQ. 3) MORD = 2
          IF (MORD .EQ. 1) GO TO 70
   50     COST = 1.0
          CALL GEN074 (CO, 1, 9, 0.0)
          ROT = RGBL(5) / FLOAT(MORD)
          CA  = COS(ROT)
          CB  = SIN(ROT)
   60     CO(IB, IB) =  CA * COST
          CO(IC, IC) =  CO(IB, IB)
          CO(IB, IC) =  CB * COST
          CO(IC, IB) = -CO(IB, IC)
          CO(IU, IU) =  COST
          CALL PLA212 (CO, MV, N)
          IF (MV .NE. 1) THEN
            IF (COST .EQ. -1.0) GO TO 40
            COST = -1.0
            GO TO 60
          END IF
          IF (MORD .EQ. 3 .OR. MORD .EQ. 6) IES = 1
          IF (MDEG .EQ. 1 .AND. MORD .GT. 2) GO TO 80
          IF (MORD .GT. 2) GO TO 40
   70     NASS = NASS + 1
          IF (NASS .EQ. 4) GO TO 140
          MORD = 2
          I    = IU
          IU   = IB
          IB   = IC
          IC   = I
          GO TO 50
   80     CALL GEN074 (CO, 1, 18, 0.0)
          CO(3, 3) = 1.0
          DO I = 1, N
            D(I)     = SQRT(XO(1, I) * XO(1, I) + XO(2, I) * XO(2, I))
            MD(I, 1) = 0
            MD(I, 2) = 0
          END DO
          IAI = 0
          N1 = N - 1
          DO I = 1, N1
            IF (MD(I, 1) .EQ. 0) THEN
              IAI        = IAI + 1
              MD(I, 1)   = IAI
              MD(IAI, 2) = 1
              J          = I + 1
              DO K = J, N
                IF (MN(I) .EQ. MN(K) .AND. K .NE. I
     1                    .AND. MD(K, 1) .EQ. 0) THEN
                  IF (ABS(D(I) - D(K)) .LE. 0.5 * DCM) THEN
                    MD(K, 1)   = IAI
                    MD(IAI, 2) = MD(IAI, 2) + 1
                  END IF
                END IF
              END DO
            END IF
          END DO
          JJ = 10000
          DO I = 1, IAI
            IF (MD(I, 2) .LT. JJ .OR. MD(I, 2) .GT. 2) JJ = MD(I, 2)
          END DO
          DM = 0.0
          DO I = 1, IAI
            IF (MD(I, 2) .EQ. JJ) THEN
              DO K = 1, N
                IF (MD(K, 1) .EQ. I) THEN
                  IF (D(K) .GT. DM) THEN
                    DM = D(K)
                    II = I
                  END IF
                END IF
              END DO
            END IF
          END DO
          CALL GEN074 (AAY, 1, 9, 0.0)
          N1 = N - 1
          DO I1 = 1, N1
            IF (MD(I1, 1) .EQ. II) THEN
              IN1 = I1 + 1
              DO 90 I2 = IN1, N
                IF (MD(I2, 1) .EQ. II) THEN
                  CALL GEN073 (XO, XO, CO, 1.0, 1.0, I1, I2, 1)
                  CALL GEN076 (CO, CO, CO, 3, 1, 2)
                  CAM = CO(1, 2) ** 2 + CO(2, 2) ** 2 + CO(3, 2) ** 2
                  IF (CAM .LE. 0.00001) GO TO 90
                  CALL GEN082 (CO, 2)
                  CALL GEN076 (CO, CO, CO, 2, 3, 1)
                  CALL GEN081 (CO, CO, 1, 1)
                  CALL PLA214 (CO, N)
                  COM = 1.0
                  DO
                    AAY(1, 1) = -1
                    AAY(2, 2) = -1
                    AAY(3, 3) =  COM
                    CALL PLA212 (AAY, MV, N)
                    AAY(1, 1) = -1
                    AAY(2, 2) =  1
                    AAY(3, 3) =  COM
                    CALL PLA212 (AAY, MV, N)
                    AAY(1, 1) =  1
                    AAY(2, 2) = -1
                    AAY(3, 3) =  COM
                    CALL PLA212 (AAY, MV, N)
                    AAY(1, 1) = 0
                    AAY(1, 2) = 1
                    AAY(2, 1) = 1
                    AAY(2, 2) = 0
                    AAY(3, 3) = COM
                    CALL PLA212 (AAY, MV, N)
                    IF (NMS .GE. 3) GO TO 40
                    IF (COM .LE. 0.0) GO TO 90
                    COM = - COM
                    CALL GEN074 (AAY, 1, 9, 0.0)
                  END DO
                END IF
   90         CONTINUE
            END IF
          END DO
          GO TO 140
  100     N1 = N - 1
          N2 = N - 2
          DO I = 1, N
            MD(I, 1) = 0
            MD(I, 2) = 0
            DO J = 2, NMG
              MK(I, J) = 0
            END DO
          END DO
          IAI = 0
          DO I = 1, N1
            IF (MD(I, 1) .EQ. 0) THEN
              IAI        = IAI + 1
              MD(I, 1)   = IAI
              MD(IAI, 2) = 1
              J          = I + 1
              DO K = J, N
                IF (MN(I) .EQ. MN(K) .AND. K .NE. I
     1                    .AND. MD(K, 1) .EQ. 0) THEN
                  IF (ABS(D(I) - D(K)) .LE. 0.5 * DCM) THEN
                    MD(K, 1)   = IAI
                    MD(IAI, 2) = MD(IAI, 2) + 1
                  END IF
                END IF
              END DO
            END IF
          END DO
          CALL GEN074 (CO, 1, 9, 0.0)
          MMD = 1000
          DO I = 1, IAI
            IF (MD(I, 2) .LT. MMD .AND. MD(I, 2) .GT. 1) THEN
              MMD = MD(I, 2)
              II  = I
            END IF
          END DO
          IER = 0
          IF (II .LE. NMA) THEN
            IF (MD(II, 2) .EQ. 12 .OR. MD(II, 2) .EQ. 20 .OR. MD(II, 2)
     1        .EQ. 30 .OR. MD(II, 2) .GT. 48)
     2        CALL PLA213 (N, II, MDEG, IER, LU6)
          ELSE
            IER = 1
          END IF
          IF (IER .NE. 0) GO TO 200
          IF (MDEG .EQ. 1) GO TO 30
          IF (NMS .GE. 5) THEN
            MDEG = 1
            CALL GEN074 (AAY, 1, 9, 0.0)
            DO I = 1, 3
              DO J = 1, 3
                IF (J .EQ. 4 - I) THEN
                  AAY(J, J) = -1
                ELSE
                  AAY(J, J) =  1
                END IF
              END DO
              CALL PLA212 (AAY, MV, N)
            END DO
            GO TO 140
          END IF
          CA = 0.0
          CALL GEN074 (AAY, 1, 9, 0.0)
          AAY(3, 3) = 1.0
          AAY(1, 1) = -0.5
          AAY(2, 2) = -0.5
          AAY(2, 1) = 0.5 * SQRT(3.0)
          AAY(1, 2) = -AAY(2, 1)
          NMS1      = 1
          N2 = N - 2
          N1 = N - 1
          DO I1 = 1, N2
            IF (MD(I1, 1) .EQ. II) THEN
              IN1 = I1 + 1
              DO I2 = IN1, N1
                IF (MD(I2, 1) .EQ. II) THEN
                  CALL GEN073 (XO, XO, CO, 1.0, -1.0, I1, I2, 4)
                  CALL GEN075 (CO, CO, CA, 4, 4, 2)
                  IN2 = I2 + 1
                  DO 110 I3 = IN2, N
                    IF (MD(I3, 1) .EQ. II) THEN
                      CALL GEN073 (XO, XO, CO, 1.0, -1.0, I1, I3, 5)
                      CALL GEN075 (CO, CO, CB, 5, 5, 2)
                      CALL GEN073 (XO, XO, CO, 1.0, -1.0, I2, I3, 6)
                      CALL GEN075 (CO, CO, CC, 6, 6, 2)
                      IF (ABS(CA - CB) .GT. DCM) GO TO 110
                      IF (ABS(CA - CC) .GT. DCM) GO TO 110
                      IF (ABS(CB - CC) .GT. DCM) GO TO 110
                      DO J1 = 1, 3
                        CO(J1, 3) = XO(J1, I1) + XO(J1, I2) + XO(J1, I3)
                      END DO
                      CALL GEN082 (CO, 3)
                      DO J1 = 1, 3
                        CO(J1, 6 + NMS1) = CO(J1, 3)
                      END DO
                      IF (NMS1 .GT. 1) THEN
                        CALL GEN075 (CO, CO, PRO, 7, 8, 1)
                        IF (ABS(PRO) .GT. 0.9) GO TO 110
                        IF (PRO .GT. 0.0) THEN
                          DO J1 = 1, 3
                            CO(J1, 8) = - CO(J1, 8)
                          END DO
                        END IF
                      END IF
                      DO I = 1, 3
                        CALL GEN074 (CO, 1, 3, 0.0)
                        CO(I, 1) = 1.0
                        CALL GEN075 (CO, CO, PRO, 1, 3, 1)
                        IF (ABS(PRO) .GT. 0.5) EXIT
                      END DO
                      CALL GEN076 (CO, CO, CO, 3, 1, 2)
                      CALL GEN082 (CO, 2)
                      CALL GEN076 (CO, CO, CO, 2, 3, 1)
                      CALL GEN081 (CO, CO, 1, 1)
                      CALL PLA214 (CO, N)
                      CALL PLA212 (AAY, MV, N)
                      NMS  = 1
                      NMS1 = NMS1 + MV
                      CALL GEN081 (CO, CO, 1, 1)
                      CALL PLA214 (CO, N)
                      IF (NMS1 .EQ. 3) GO TO 120
                    END IF
  110             CONTINUE
                END IF
              END DO
            END IF
          END DO
          IF (NMS1 .EQ. 1) THEN
            IF (PORIG .NE. WGHT(1)) THEN
              DLINER = DLINER * 0.1
              GO TO 20
            END IF
            IPRW = IPRW + 1
            IF (IPRW .EQ. 1) THEN
              CALL PLA262 (2)
              WRITE (LU7, 99992, IOSTAT = IOST)
            END IF
            DO K = 1, N
              WGHT(K) = WGHT(K) * (D(K) / DM)**4
            END DO
            NLOOP = NLOOP + 1
            IF (NLOOP .LT. 100) GO TO 20
          END IF
          CO(1, 3) = CO(1, 7)
          CO(2, 3) = CO(2, 7)
          CO(3, 3) = CO(3, 7)
          DO I = 1, 3
            CALL GEN074 (CO, 1, 3, 0.0)
            CO(I, 1) = 1.0
            CALL GEN075 (CO, CO, PRO, 1, 3, 1)
            IF (ABS(PRO) .GT. 0.5) EXIT
          END DO
          CALL GEN076 (CO, CO, CO, 3, 1, 2)
          CALL GEN082 (CO, 2)
          CALL GEN076 (CO, CO, CO, 2, 3, 1)
          CALL GEN081 (CO, CO, 1, 1)
          CALL PLA214 (CO, N)
          GO TO 130
  120     CALL GEN073 (CO, CO, CO, 1.0, 1.0, 7, 8, 1)
          CALL GEN082 (CO, 1)
          CALL GEN073 (CO, CO, CO, 1.0, -1.0, 7, 8, 3)
          CALL GEN076 (CO, CO, CO, 3, 1, 2)
          CALL GEN082 (CO, 2)
          CALL GEN076 (CO, CO, CO, 1, 2, 3)
          CALL GEN081 (CO, CO, 1, 1)
          CALL PLA214 (CO, N)
          CALL GEN074 (CO, 1, 9, 0.0)
          CO(1, 1) =  1.0
          CO(2, 2) =  SQRT(0.5)
          CO(3, 3) =  CO(2, 2)
          CO(2, 3) =  CO(2, 2)
          CO(3, 2) = -CO(2, 2)
          CALL PLA214 (CO, N)
          CALL GEN074 (AAY, 1, 9, 0.0)
          AAY(1, 2) = 1.0
          AAY(2, 3) = 1.0
          AAY(3, 1) = 1.0
          CALL PLA212 (AAY, MV, N)
          NASS = 1
          IU   = 1
          IB   = 2
          IC   = 3
          MORD = 4
          CALL GEN074 (CO, 1, 9, 0.0)
          CO(1, 1) = -1.0
          CO(2, 2) = -1.0
          CO(3, 3) =  1.0
          CALL PLA212 (CO, MV, N)
          IF (MV .EQ. 1) GO TO 50
          CALL GEN074 (CO, 1, 9, 0.0)
          COST = SQRT(0.5)
          CO(1, 1) =  COST
          CO(2, 2) =  COST
          CO(1, 2) = -COST
          CO(2, 1) =  COST
          CO(3, 3) =  1.0
          ANG      = 0.5 * ACOS(-1.0 / 3.0)
          CALL GEN043 (1, AAY, - ANG)
          CALL GEN077 (AAY, CO, CO, 1, 1, 1)
          CALL PLA214 (CO, N)
  130     NMS  = 1
          MORD = 6
          MDEG = 1
          IU   = 3
          IB   = 2
          IC   = 1
          WRITE (LU6, 99993, IOSTAT = IOST) DCM
          GO TO 150
  140     II = 2
          CALL GEN021 (CO, -1)
          CALL PLA212 (CO, MV, N)
  150     IF (NMS .EQ. 1) THEN
            IF (DCM .GE. PAR(75)) THEN
              WRITE (PRBUF, 99995, IOSTAT = IOST) MO, DCM
              WRITE (LU6, 99985, IOSTAT = IOST) PRBUF
              CALL PLA262 (3)
              WRITE (LU7, 99985, IOSTAT = IOST) PRBUF
              VRT = VRT - 0.5
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 1.0
                CALL GGIP09 (0.0, PRBUF, 80, 0.37, 1, 2, 0.1, VRT)
                VRT = VRT - 0.6
                WRITE (PRBUF, 99984, IOSTAT = IOST)
     1            (NINT(RIN(I)), I = 1, 3), ND
                CALL GGIP09 (0.0, PRBUF, 80, 0.37, 1, 2, 0.1, VRT)
              END IF
              WRITE (LU6, 99989, IOSTAT = IOST) PRBUF
              WRITE (LU7, 99989, IOSTAT = IOST) PRBUF
              GO TO 310
            ELSE
              DCM = DCM + 0.1
              OLDPT = ' '
              IPRW  = 0
              GO TO 10
            END IF
          END IF
  160     IER = 0
          CALL PLA215 (N, IER)
          IF (IER .NE. 0) GO TO 320
          IF (MDEG .EQ. 5) GO TO 200
          NTEST = 0
          DO I = 1, NMS
            IF (MTG(I, I) .NE. 1) NTEST = 1
          END DO
          IF (NMS .EQ. 2 .OR. NMS .EQ. 4) THEN
            NAX2 = 0
            LAX2 = 0
            DO I = 2, NMS
              ITRAC = NINT(SIM(1, 1, I) + SIM(2, 2, I) + SIM(3, 3, I))
              IABST = NINT(ABS(SIM(1, 1, I)) + ABS(SIM(2, 2, I))
     1              + ABS(SIM(3, 3, I)))
              IF (IABST .NE. 3) GO TO 170
              IF (ITRAC .EQ. -1) THEN
                NAX2 = NAX2 + 1
                LAX2 = I
              END IF
            END DO
            IF (NAX2 .EQ. 0 .OR. NAX2 .EQ. 3) GO TO 200
            IF (NAX2 .EQ. 1) THEN
              DO  L = 1, 3
                IF (NINT(SIM(L, L, LAX2)) .EQ. 1) EXIT
              END DO
              IF (L .EQ. 3) GO TO 200
              CALL GEN074 (CO, 1, 9, 0.0)
              I = 3 - L
              K = 6 - I - L
              CO(K, L) =  1.0
              CO(L, K) = -1.0
              CO(I, I) =  1.0
              CALL PLA214 (CO, N)
              CALL GEN018 (RIN(3), RIN(L))
            END IF
            NMS = 1
            GO TO 30
          END IF
  170     IF (NTEST .NE. 0 .AND. MDEG .NE. 0) THEN
            IF (MDEG .EQ. 1) THEN
              IAXV = 0
              DO 180 I = 2, NMS
                IABSTR = INT(ABS(SIM(1, 1, I)) + ABS(SIM(2, 2, I))
     1                 + ABS(SIM(3, 3, I)) + 0.001)
                IF (IABSTR .EQ. 3) THEN
                  ITRAC =
     1              INT((SIM(1, 1, I) + SIM(2, 2, I) + SIM(3, 3, I))
     2              * 1.001)
                  IAX = ITRAC
                  IF (ITRAC .NE. NINT(SIM(3, 3, I))) GO TO 180
                  IAX = - ITRAC * I
                  DO J = 1, 2
                    IF (ITRAC .NE. NINT(SIM(J, J, I))) ICOM = J
                  END DO
                  IF (IAX .GT. 0) THEN
                    V3(3)        = 0.0
                    V3(ICOM)     = 1.0
                    V3(3 - ICOM) = 0.0
                    IAXV         = IABS(IAX)
                    IF (IAX .EQ. 0) GO TO 200
                    CALL PLA216 (V3, N, IAXV, LU6)
                    COST = 0.0
                    DO J = 1, 3
                      IF (ABS(V3(J)) .GT. COST) THEN
                        COST = ABS(V3(J))
                        ICOM = J
                      END IF
                    END DO
                    COST = 1.0
                    IF (V3(ICOM) .LT. 0.0) COST = -1.0
                    CALL GEN074 (AAY, 1, 9, 0.0)
                    AAY(3, 3)    = 1.0
                    DO J = 1, 3
                      AAY(J, ICOM) = COST * V3(J)
                    END DO
                    IF (ICOM .EQ. 2) THEN
                      CALL GEN076 (AAY, AAY, AAY, 2, 3, 1)
                      CALL GEN076 (AAY, AAY, AAY, 3, 1, 2)
                    ELSE
                      CALL GEN076 (AAY, AAY, AAY, 3, 1, 2)
                      CALL GEN076 (AAY, AAY, AAY, 2, 3, 1)
                    END IF
                    CALL GEN082 (AAY, 1)
                    CALL GEN082 (AAY, 2)
                    GO TO 190
                  END IF
                END IF
  180         CONTINUE
              GO TO 200
            ELSE IF (MDEG .EQ. 3) THEN
              CALL GEN074 (CO, 1, 9, 0.0)
              CO(1, 1) =  1.0
              CO(2, 2) = -1.0
              CO(3, 3) = -1.0
              DO K = 1, NMS
                IF (NINT (GEN086 (SIM, CO, 0.001, K, 1)) .EQ. 1) EXIT
              END DO
              V3(1) = 1.0
              V3(2) = 0.0
              V3(3) = 0.0
              CALL PLA216 (V3, N, K, LU6)
              DO L = 1, 3
                AAY(L, 1) = V3(L)
              END DO
              CO(1, 1)  = -1.0
              CO(2, 2)  =  1.0
              CO(3, 3)  = -1.0
              DO K = 1, NMS
                IF (NINT (GEN086 (SIM, CO, 0.001, K, 1)) .EQ. 1) EXIT
              END DO
              V3(1)     = 0.0
              V3(2)     = 1.0
              V3(3)     = 0.0
              DO L = 1, 3
                AAY(L, 2) = V3(L)
              END DO
              CALL GEN076 (AAY, AAY, AAY, 1, 2, 3)
              CALL GEN082 (AAY, 3)
              CALL GEN076 (AAY, AAY, AAY, 3, 1, 2)
              CALL GEN082 (AAY, 2)
              CALL GEN076 (AAY, AAY, AAY, 2, 3, 1)
              CALL GEN082 (AAY, 1)
            END IF
  190       CALL GEN081 (AAY, AAY, 1, 1)
            CALL PLA214 (AAY, N)
          END IF
  200     CSM(1)  = 0.0
          DEVX(1) = 0.0
          DO I = 2, NMS
            NES      = 1
            ISU(1)   = NES
            K        = I
  210       NES      = NES + 1
            ISU(NES) = K
            L        = MTG(I, K)
            IF (L .NE. 1) THEN
              K = L
              GO TO 210
            END IF
            CALL PLA217 (COMT, NES, N)
            DEVX(I) = DELM(4)
            CSM(I)  = COMT
          END DO
          DO I = 1, NMS
            ISU(I) = I
          END DO
          CALL PLA217 (CSMT, NMS, N)
          N1 = N
          CALL GEN097 (IASU, 1, N1, 2)
          DO 220 I = 1, N1
            IF (IASU(I) .EQ. 2) THEN
              DO J = 1, NMS
                K = MK(I, J)
                IF (K .NE. I) THEN
                  IF (K .EQ. 0) THEN
                    IASU(I) = 0
                    GO TO 220
                  END IF
                  IASU(K) = 1
                END IF
              END DO
            END IF
  220     CONTINUE
          DO I = 1, 4
            DEL(I) = DEL(I) / FLOAT(N)
          END DO
          DO I = 1, N
            DO J = 1, NMS
              K = MK(I, J)
              CALL GEN078 (SIM, XS, V3, J, I, 1)
              DO L = 1, 3
                DIFF = ABS(XS(L, K) - V3(L))
                IF (DIFF .GT. 0.001) THEN
                  GO TO 230
                END IF
              END DO
            END DO
          END DO
  230     IPGR    = 0
          MAXASP  = 0
          MAXASI  = 0
          MPLANE  = 0
          INVERS  = 0
          NPLANE  = 0
          LBLS(1) = 'E'
          IF (MDEG .EQ. 5) THEN
            PT = 'C(inf)v'
            DO I = 1, NMS
              CALL GEN088 (SIM, I, M, MSIGN, INV, LU6)
              IF (INV .EQ. 1) THEN
                PT = 'D(inf)h'
                GO TO 240
              END IF
            END DO
  240       NMS = 1
            GO TO 280
          END IF
          IF (NMS .EQ. 1) THEN
            PT   = 'C1 '
            IPGR = 1
            GO TO 320
          END IF
          DO I = 2, NMS
            TOT = '    '
            S1  = ' '
            S2  = ' '
            SN  = '  '
            CALL GEN088 (SIM, I, M, MSIGN, INV, LU6)
            IF (M .GT. MAXASP .AND. MSIGN .EQ.  1) MAXASP = M
            IF (M .GT. MAXASI .AND. MSIGN .EQ. -1) MAXASI = M
            IF (M .EQ. 2 .AND. MPLANE .EQ. 0) MPLANE = 1
            S1 = 'C'
            IF (M .EQ. 2) THEN
              IF (INV .EQ. 1) THEN
                INVERS = 1
                SN     = 'i '
                GO TO 250
              END IF
              SN = '2 '
              IF (MSIGN .EQ. -1) THEN
                SN     = 's '
                NPLANE = NPLANE + 1
              END IF
              GO TO 250
            END IF
            WRITE (SN, '(I2)', IOSTAT = IOST) M
            IF (MSIGN .EQ. -1) S1 = 'S'
  250       TOT = S1//SN//S2
            CALL GEN085 (TOT, 4, K)
            LBLS(I) = TOT(1:3)
          END DO
          PT = '   '
          IF (NMS .EQ.  48) THEN
            PT = 'Oh '
          ELSE IF (NMS .EQ.  60) THEN
            PT = 'I  '
          ELSE IF (NMS .EQ. 120) THEN
            PT = 'Ih '
          END IF
          IF (PT  .NE. '   ') GO TO 270
          IF (MDEG .EQ. 3) THEN
            IF (NMS .EQ. 12)   PT = 'T23'
            IF (INVERS .EQ. 1) PT = 'Th '
            IF (MAXASI .EQ. 4) PT = 'Td '
            IF (PT .EQ. '   ') PT = 'O  '
            GO TO 270
          END IF
          IF (NMS .EQ. 2) THEN
            PT = LBLS(2)
            GO TO 260
          END IF
          S2 = ' '
          S1 = 'C'
          WRITE (SN, 99986, IOSTAT = IOST) MAXASP
          IF (MOD(NMS, 2) .EQ. 0 .AND. MAXASI .EQ. NMS) THEN
            S1 = 'S'
            WRITE (SN, 99986, IOSTAT = IOST) MAXASI
            IF (NMS .NE. 6) GO TO 260
            PT = 'C3i'
            GO TO 270
          END IF
          IF (NMS .NE. MAXASP) THEN
            IF (NMS .LT. MAXASI) THEN
              WRITE (SN, 99986, IOSTAT = IOST) MAXASI
              S1 = 'S'
            ELSE
              S1 = 'D'
              IF (NMS .EQ. MAXASP * 2) THEN
                IF (NPLANE .NE. 0) THEN
                  S1 = 'C'
                  S2 = 'v'
                  IF (NPLANE .NE. MAXASP) S2 = 'h'
                END IF
              ELSE
                S2 = 'h'
                IF (NPLANE .EQ. MAXASP) S2 = 'd'
              END IF
            END IF
          END IF
  260     TOT = '    '
          TOT = S1//SN//S2
          CALL GEN085 (TOT, 4, K)
          PT = TOT(1:3)
  270     DO M = 1, 32
            IF (PT .EQ. PNTGR(M)) IPGR = M
          END DO
  280     IF (PT .NE. OLDPT .AND. RMST .LT. 0.5) THEN
            CALL PLA262 (6)
            WRITE (PRBUF, 99996, IOSTAT = IOST)
            WRITE (LU7, 99987, IOSTAT = IOST) PRBUF(1:80)
            IF (IWIN .EQ. 1 .AND. MO .GT. MOO) THEN
              MOO = MO
              VRT = VRT - 1.5
              CALL GGIP09 (0.0, PRBUF, 80, 0.37, 5 + IGBL(68), 2,
     1                     0.1, VRT)
            END IF
            WRITE (LU6, 99994, IOSTAT = IOST) MO, PT, CSMT, RMST, DCM
            WRITE (PRBUF, 99997, IOSTAT = IOST)
     1        MO, (NINT(RIN(I)), I = 1, 3), ND, PT, CSMT, RMST, DCM
            WRITE (LU7, 99989, IOSTAT = IOST) PRBUF(1:80)
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 1.0
              CALL GGIP09 (0.0, PRBUF, 80, 0.37, 1, 2, 0.1, VRT)
              CALL GGIP (0.0, 0.0, 0.0, 6)
            END IF
            IF (IPGR .GE. 16 .AND. IPGR .LE. 27) THEN
              IF (IES .EQ. 1) THEN
                AL(2, 2) = SQRT(3.0) * 0.5
                AL(1, 2) = -0.5
                AL(1, 1) = 1.0
                AL(3, 3) = 1.0
                CALL GEN003 (AL, ALX, DETER, 0)
                DO I = 1, NMS
                  CALL GEN077 (ALX, SIM, AAY, 1, I, 1)
                  CALL GEN077 (AAY, AL, SIM, 1, 1, I)
                END DO
                GO TO 290
              END IF
              GO TO 300
            END IF
          ELSE
            GO TO 300
          END IF
  290     CALL GEN074 (TRL, 1, 3 * NMS, 0.0)
          I1 = - 39
          I  = 1
          IF (NMS .GT. 1) I = 2
          CALL PLA262 (3)
          WRITE (LU7, 99988, IOSTAT = IOST)
     1          (' Symmetry element     CSM and Max.Diff. ', K = 1, I)
          WRITE (LU7, '(80(''-''))', IOSTAT = IOST)
          DO M = 1, NMS
            MM = M
            CALL GEN087 (RIGA(1:39), SIM, TRL, MM, 2)
            I1 = I1 + 40
            I2 = I1 + 39
            I3 = I1 + 25
            I4 = I1 + 39
            WRITE (LINE(I1:I2), 99999, IOSTAT = IOST) M, LBLS(M), RIGA
            WRITE (LINE(I3:I4), 99991, IOSTAT = IOST) CSM(M), DEVX(M)
            IF (I1 .EQ. 41) THEN
              CALL PLA262 (1)
              WRITE (LU7, 99989, IOSTAT = IOST) LINE
              CALL GEN038 (LINE, 1, 80)
              I1 = -39
            END IF
          END DO
          IF (I1 .GE. 1) THEN
            CALL PLA262 (1)
            WRITE (LU7, 99989, IOSTAT = IOST) LINE(1 : I1 + 39)
          END IF
  300     DCM = DCM + 0.1
          IF (DCM .LT. PAR(75)) THEN
            OLDPT = PT
            GO TO 10
          END IF
        END IF
  310 CONTINUE
  320 IF (IWIN .EQ. 1) CALL PLA297 (0)
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (I3,' [',A3,']', A30)
99998 FORMAT ('MOLSYM: Search for (additional) Molecular ',
     1 '(Point Group) Symmetry - Hydrogen Atoms Excluded !',
     2 ' - Ordered Residues Only !', /, 132('='), //,
     3 'For Details on the Molecular Symmetry ',
     4 'Determination see: T. Pilati & A. Forni, J.Appl.Cryst. ',
     5 '(1998), 31, 503-504 & (2000), 33, 417.', //,
     6 'For CSM (i.e. Continuous Symmetry Measure),',
     7 ' see: H. Zabrodsky et al. (1993) JACS, 115, 8278-8289', //,
     8 ' ***** Weighting Mode = ', A, ' *****')
99997 FORMAT (I5, 3X, '(', I6, ',', I9, ',', I9, ')', I4, 3X, A, F8.4,
     1        4X, F8.4, F5.2, ' Ang.')
99996 FORMAT ('Resd #', 9X, 'Inertial  Moments',
     1 4X, 'Degree Symbol', 6X, 'CSM', 9X, 'RMS  Tol')
99995 FORMAT (':: Resd #', I3,
     1 ', No Molecular Symmetry Within Tolerance =', F6.2, ' Ang.')
99994 FORMAT (':: Resd #',  I5, 3X, A, ' CSM = ', F8.4,
     1 1X, 'RMS = ', F8.4, 1X, 'Tol =', F5.2)
99993 FORMAT (':: Degeneration Degree=3 but no CUBIC ',
     1'or ICOSAHEDRAL Group Found. (Tol =', F5.2, 'A)')
99992 FORMAT (/, ':: Weights are Changed')
99991 FORMAT (2F7.4)
99990 FORMAT (/, ':: Too Many Atoms in RESD #', I5, /)
99989 FORMAT (A)
99988 FORMAT (/, 2A)
99987 FORMAT (/, 80('-'), /, A, /, 80('-'))
99986 FORMAT (I2)
99985 FORMAT (/, A)
99984 FORMAT (14X, 'Inertial Moments: ', 3I8, ', Degree =', I3)
99983 FORMAT (/, ' ***** Weighting Mode = ', A, ' *****')
99982 FORMAT (15X, 'PLATON/MOLSYM for ', A)
99981 FORMAT (24X, 'Weighting Mode: ', A)
      END SUBROUTINE PLA211
      SUBROUTINE PLA212 (A, MV, N)
      PARAMETER (NMA=550, NMG=120)
      COMMON /AT2/ DCM
      COMMON /SRC/ XO(3, NMA), XS(3, NMA), D(NMA), CO(3, NMA), IV(NMA),
     1 COY(3,NMA), WWW(NMA), NGE(NMA), WGHT(NMA), DC(NMA), TRL(3, NMG),
     2 CF(NMA), MK(NMA, NMG), MN(NMA), MD(NMA, 2), RMSX(3, NMA),
     3 ISU(NMG), IASU(NMA), SIM(3, 3, NMG), DEVX(NMG), CSM(NMG),
     4 MTG(NMG, NMG), IAT(NMA), DA(NMA), MEQ(NMA), AL(3, 3), ALX(3, 3),
     5 AAY(3, 3), DEL(4), DELM(4), ORI(3, 3), CSMT, NMS, RMST
      DIMENSION A(3, 3), V(3), W(3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      MV = 1
      DO I = 1, NMS
        IF (GEN086 (A, SIM, 1.E-2, 1, I) .NE. 0.0) GO TO 40
      END DO
      NMS = NMS + 1
      DO I = 1, N
        MK(I, NMS) = 0
        JJ         = 0
        FMIN       = DCM
        CALL GEN078 (A, XO, V, 1, I, 1)
        DO J = 1, N
          IF (MN(I) .EQ. MN(J)) THEN
            CALL GEN073 (XO, V, W, 1.0, -1.0, J, 1, 1)
            CALL GEN075 (W, W, F, 1, 1, 2)
            IF (F .LE. FMIN) THEN
              FMIN = F
              JJ   = J
            END IF
          END IF
        END DO
        IF (JJ .EQ. 0) GO TO 30
        MK(I, NMS) = JJ
      END DO
      CALL GEN097 (IAT, 1, N, 0)
      DO 20 K = 1, N
        IF (IAT(K) .EQ. 0) THEN
          IAT(K) = 1
          NEQ    = 1
          L      = K
   10     M      = MK(L, NMS)
          IF (M .NE. K) THEN
            IAT(M) = 1
            NEQ    = NEQ + 1
            IF (NEQ .GT. N) GO TO 30
            L = M
            GO TO 10
          END IF
          CALL GEN088 (A, 1, NORD, MSIGN, INV, LU6)
          IF (NEQ .EQ. 1 .OR. NEQ .EQ. 2) GO TO 20
          IF (NEQ .EQ. NORD) GO TO 20
          IF (NEQ .EQ. 2 * NORD) GO TO 20
          GO TO 30
        END IF
   20 CONTINUE
      CALL GEN079 (A, SIM, 1, NMS)
      RETURN
   30 NMS = NMS - 1
   40 MV  = 0
      RETURN
      END SUBROUTINE PLA212
      SUBROUTINE PLA213 (N, II, MDEG, IER, LU6)
      PARAMETER (NMA=550, NMG=120)
      COMMON /AT2/ DCM
      COMMON /SRC/ XO(3, NMA), XS(3, NMA), D(NMA), CO(3, NMA), IV(NMA),
     1 COY(3,NMA), WWW(NMA), NGE(NMA), WGHT(NMA), DC(NMA), TRL(3, NMG),
     2 CF(NMA), MK(NMA, NMG), MN(NMA), MD(NMA, 2), RMSX(3, NMA),
     3 ISU(NMG), IASU(NMA), SIM(3, 3, NMG), DEVX(NMG), CSM(NMG),
     4 MTG(NMG, NMG), IAT(NMA), DA(NMA), MEQ(NMA), AL(3, 3), ALX(3, 3),
     5 AAY(3, 3), DEL(4), DELM(4), ORI(3, 3), CSMT, NMS, RMST
      DIMENSION EQP(4), DP(5), VD(3, 5), MP(5), IO(5), A(3, 3),
     1 B(3, 3), V(3)
      KK  = 0
      RAD = 57.295779
      DO 50 I1 = 1, N - 4
        IF (MD(I1, 1) .NE. II) GO TO 50
        MP(1) = I1
        IO(1) = I1
        IN1 = I1 + 1
        DO 40 I2 = IN1, N - 3
          IF (MD(I1, 1) .NE. II) GO TO 40
          MP(2) = I2
          IN2 = I2 + 1
          DO 30 I3 = IN2, N - 2
            IF (MD(I3, 1) .NE. II) GO TO 30
            MP(3) = I3
            CALL GEN083 (XO(1, I1), XO(1, I2), XO(1, I3), EQP)
            IF (EQP(4) .LT. 0.5) GO TO 30
            IN3 = I3 + 1
            DO 20 I4 = IN3, N - 1
              IF (MD(I4, 1) .NE. II) GO TO 20
              MP(4) = I4
              D2 = EQP(1) * XO(1, I4) + EQP(2) * XO(2, I4)
     1           + EQP(3) * XO(3, I4) + EQP(4)
              IF (ABS(D2) .GT. DCM) GO TO 20
              IN4 = I4 + 1
              DO 10 I5 = IN4, N
                IF (MD(I5, 1) .NE. II) GO TO 10
                MP(5) = I5
                D2 = EQP(1) * XO(1, I5) + EQP(2) * XO(2, I5)
     1             + EQP(3) * XO(3, I5) + EQP(4)
                IF (ABS(D2) .GT. DCM) GO TO 10
                DMIN  = 100.0
                DP(1) = DMIN
                DO I = 2, 5
                  IO(I) = 0
                  DP(I) = 0.0
                  CALL GEN073 (XO, XO, VD, 1.0, -1.0, I1, MP(I), 1)
                  CALL GEN075 (VD, VD, DP(I), 1, 1, 2)
                  IF (DP(I) .LT. DMIN) THEN
                    DMIN = DP(I)
                    JJ = I
                  END IF
                END DO
                IO(2)  = MP(JJ)
                DP(JJ) = 100.0
                DMIN   = 100.0
                DO I = 2, 5
                  IF (DP(I) .LT. DMIN .AND. IO(2) .NE. MP(I)) THEN
                    DMIN = DP(I)
                    KK   = I
                  END IF
                END DO
                IO(5) = MP(KK)
                DO I = 2, 5
                  IF (MP(I) .NE. IO(2) .AND. MP(I) .NE. IO(5)
     1               .AND. IO(3) .EQ. 0) IO(3) = MP(I)
                  IF (MP(I) .NE. IO(2) .AND. MP(I) .NE. IO(5)
     1               .AND. MP(I) .NE. IO(3)) JJ = MP(I)
                END DO
                CALL GEN073 (XO, XO, VD, 1.0, -1.0, IO(2), IO(3), 1)
                CALL GEN075 (VD, VD, D1, 1, 1, 1)
                CALL GEN073 (XO, XO, VD, 1.0, -1.0, IO(2), JJ, 1)
                CALL GEN075 (VD, VD, D2, 1, 1, 1)
                IO(4) = JJ
                IF (D2 .LT. D1) THEN
                  IO(4) = IO(3)
                  IO(3) = JJ
                END IF
                DMED = 0.0
                DO I = 1, 5
                  K = I + 1
                  IF (K .GT. 5) K = K - 5
                  CALL GEN073 (XO, XO, VD, 1.0, -1.0, IO(I), IO(K), I)
                  CALL GEN075 (VD, VD, DP(I), I, I, 2)
                  DMED = DMED + DP(I)
                END DO
                DMED = DMED * 0.2
                CALL GEN074 (A, 1, 9, 0.0)
                DO I = 1, 5
                  IF (ABS(DMED - DP(I)) .GT. DCM * 0.5) GO TO 10
                  A(1, 3) = A(1, 3) + XO(1, IO(I))
                  A(2, 3) = A(2, 3) + XO(2, IO(I))
                  A(3, 3) = A(3, 3) + XO(3, IO(I))
                END DO
                A(1, 1) = XO(1, IO(1)) + XO(1, IO(2)) - XO(1, IO(3))
     1                  - XO(1, IO(4)) + XO(1, IO(5))
                A(2, 1) = XO(2, IO(1)) + XO(2, IO(2)) - XO(2, IO(3))
     1                  - XO(2, IO(4)) + XO(2, IO(5))
                A(3, 1) = XO(3, IO(1)) + XO(3, IO(2)) - XO(3, IO(3))
     1                  - XO(3, IO(4)) + XO(3, IO(5))
                CALL GEN082 (A, 3)
                CALL GEN082 (A, 1)
                CALL GEN076 (A, A, A, 3, 1, 2)
                CALL GEN082 (A, 2)
                CALL GEN076 (A, A, A, 2, 3, 1)
                CALL GEN081 (A, A, 1, 1)
                CALL PLA214 (A, N)
                ROT = 72.0 / RAD
                CALL GEN043 (3, B, ROT)
                CALL PLA212 (B, MV, N)
                IF (MV .EQ. 0) GO TO 10
                CALL PLA216 (V, N, 2, LU6)
                CALL GEN074 (A, 1, 9, 0.0)
                IF (V(3) .LT. 0) THEN
                  V(1) = - V(1)
                  V(2) = - V(2)
                  V(3) = - V(3)
                END IF
                CALL GEN080 (V, A, 1, 3)
                A(1, 1) = XO(1, IO(1)) + XO(1, IO(2)) - XO(1, IO(3))
     1                  - XO(1, IO(4)) + XO(1, IO(5))
                A(2, 1) = XO(2, IO(1)) + XO(2, IO(2)) - XO(2, IO(3))
     1                  - XO(2, IO(4)) + XO(2, IO(5))
                A(3, 1) = XO(3, IO(1)) + XO(3, IO(2)) - XO(3, IO(3))
     1                  - XO(3, IO(4)) + XO(3, IO(5))
                CALL GEN082 (A, 3)
                CALL GEN082 (A, 1)
                CALL GEN076 (A, A, A, 3, 1, 2)
                CALL GEN082 (A, 2)
                CALL GEN076 (A, A, A, 2, 3, 1)
                CALL GEN081 (A, A, 1, 1)
                CALL PLA214 (A, N)
                GO TO 60
   10         CONTINUE
   20       CONTINUE
   30     CONTINUE
   40   CONTINUE
   50 CONTINUE
      IF (NMS .EQ. 1) RETURN
   60 IER = 0
      CALL PLA215 (N, IER)
      DM = 0.0
      DO I = 1, N
        IF (MD(I1, 1) .EQ. II) THEN
          DA(I) = XO(1, I)**2 + XO(2, I)**2
          IF (DM .LE. DA(I)) THEN
            KK = I
            DM = DA(I)
          END IF
        END IF
      END DO
      IO(1) = KK
      DP1   = XO(3, KK)
      DO K = 1, 4
        K1     = K + 1
        IO(K1) = MK(IO(K), 2)
        DP1    = DP1 + XO(3, IO(K1))
      END DO
      DP1 = - 0.2 * DP1
      ME = 0
      DO 70 I = 1, N
        COM = ABS(DP1 - XO(3, I))
        IF (COM .LE. DCM) THEN
          DO K = 1, 5
            IF (I .EQ. IO(K)) GO TO 70
          END DO
          ME      = ME + 1
          MEQ(ME) = I
        END IF
   70 CONTINUE
   80 DO I = 1, ME
        IF (MEQ(I) .NE. 0) GO TO 90
      END DO
      MDEG = 1
      RETURN
   90 MP(1)  = MEQ(I)
      MEQ(I) = 0
      K = 1
      DO K = 1, 4
        K1     = K + 1
        MP(K1) = MK(MP(K), 2)
        DO L = 1, ME
          IF (MP(K1) .EQ. MEQ(L)) MEQ(L) = 0
        END DO
      END DO
      CALL GEN074 (A,  1,  9, 0.0)
      CALL GEN074 (VD, 1, 15, 0.0)
      DO 110 I = 1, 5
        K = IO(I)
        DO L = 1, NMS
          IF (MK(K, L) .EQ. IO(1)) THEN
            CALL GEN078 (SIM, XO, VD, L, K, 3)
            CALL GEN073 (VD, VD, VD, 1.0, 1.0, 3, 1, 1)
            GO TO 100
          END IF
        END DO
  100   K = MP(I)
        DO L = 1, NMS
          IF (MK(K, L) .EQ. MP(1)) THEN
            CALL GEN078 (SIM, XO, VD, L, K, 3)
            CALL GEN073 (VD, VD, VD, 1.0, 1.0, 3, 2, 2)
            GO TO 110
          END IF
        END DO
  110 CONTINUE
      VD(3, 1) = 0.0
      VD(3, 2) = 0.0
      CALL GEN082 (VD, 1)
      CALL GEN082 (VD, 2)
      COST = COS(36.1 / RAD)
      DO I = 1, 5
        CALL GEN078 (SIM, VD, VD, 2, 2, 2)
        CALL GEN075 (VD, VD, COSA, 1, 2, 1)
        IF (COSA .GE. COST) GO TO 120
      END DO
  120 CALL GEN073 (VD, VD, A, 1.0, 1.0, 1, 2, 1)
      CALL GEN082 (A, 1)
      A(3, 3) = 1.0
      CALL GEN076 (A, A, A, 3, 1, 2)
      CALL GEN082 (A, 2)
      CALL GEN076 (A, A, A, 2, 3, 1)
      CALL GEN082 (A, 1)
      CALL GEN081 (A, A, 1, 1)
      CALL PLA214 (A, N)
      CALL GEN074 (B, 1, 9, 0.0)
      B(1, 1) =  1.0
      B(2, 2) = -1.0
      B(3, 3) = -1.0
      CALL PLA212 (B, MV, N)
      IF (MV .NE. 1) THEN
        CALL GEN081 (A, A, 1, 1)
        CALL PLA214 (A, N)
        CALL GEN074 (A, 1, 9, 0.0)
        A(1, 2) = -1.0
        A(2, 1) =  1.0
        A(3, 3) =  1.0
        CALL PLA214 (A, N)
        CALL PLA212 (B, MV, N)
        IF (MV .NE. 1) THEN
          CALL GEN081 (A, A, 1,1)
          CALL PLA214 (A, N)
          GO TO 80
        END IF
      END IF
      CALL GEN021 (B, -1)
      CALL PLA212 (B, MV, N)
      ROT = -63.434949 / RAD
  130 CALL GEN043 (1, A, - ROT)
      ROT18 = -18.0 / RAD
  140 CALL GEN043 (3, B, - ROT18)
      CALL GEN077 (B, A, A, 1, 1, 1)
      CALL GEN077 (SIM, A, B, 2, 1, 1)
      CALL GEN081 (A, A, 1, 1)
      CALL GEN077 (A, B, A, 1, 1, 1)
      CALL PLA212 (A, MV, N)
      IF (MV .NE. 1) THEN
        IF (ROT18 .LT. 0.0) THEN
          ROT18 = - ROT18
          GO TO 140
        END IF
        IF (ROT .GT. 0.0) RETURN
        ROT = - ROT
        GO TO 130
      END IF
      IER = 0
      CALL PLA215 (N, IER)
      IER = 1
      RETURN
      END SUBROUTINE PLA213
      SUBROUTINE PLA214 (COZ, N)
      PARAMETER (NMA=550, NMG=120)
      COMMON /ORIE/ ORX(3, 3), OT(3, 3), OTI(3, 3), BARC(3), BARO(3),
     1 RIN(3)
      COMMON /SRC/ XO(3, NMA), XS(3, NMA), D(NMA), CO(3, NMA), IV(NMA),
     1 COY(3,NMA), WWW(NMA), NGE(NMA), WGHT(NMA), DC(NMA), TRL(3, NMG),
     2 CF(NMA), MK(NMA, NMG), MN(NMA), MD(NMA, 2), RMSX(3, NMA),
     3 ISU(NMG), IASU(NMA), SIM(3, 3, NMG), DEVX(NMG), CSM(NMG),
     4 MTG(NMG, NMG), IAT(NMA), DA(NMA), MEQ(NMA), AL(3, 3), ALX(3, 3),
     5 AAY(3, 3), DEL(4), DELM(4), ORI(3, 3), CSMT, NMS, RMST
      DIMENSION COZ(3, 3)
      DO I = 1, N
        CALL GEN078 (COZ, XO, XO, 1, I, I)
      END DO
      CALL GEN077 (COZ, ORX, ORX, 1, 1, 1)
      CALL GEN077 (COZ, OT, OT, 1, 1, 1)
      CALL GEN003 (OT,  OTI, DETER, 0)
      RETURN
      END SUBROUTINE PLA214
      SUBROUTINE PLA215 (N, IER)
      PARAMETER (NMA=550, NMG=120)
      COMMON /SRC/ XO(3, NMA), XS(3, NMA), D(NMA), CO(3, NMA), IV(NMA),
     1 COY(3,NMA), WWW(NMA), NGE(NMA), WGHT(NMA), DC(NMA), TRL(3, NMG),
     2 CF(NMA), MK(NMA, NMG), MN(NMA), MD(NMA, 2), RMSX(3, NMA),
     3 ISU(NMG), IASU(NMA), SIM(3, 3, NMG), DEVX(NMG), CSM(NMG),
     4 MTG(NMG, NMG), IAT(NMA), DA(NMA), MEQ(NMA), AL(3, 3), ALX(3, 3),
     5 AAY(3, 3), DEL(4), DELM(4), ORI(3, 3), CSMT, NMS, RMST
      DIMENSION COX(3, 3)
   10 NN = NMS
      DO I = 1, NN
        DO J = 1, NN
          CALL GEN077 (SIM, SIM, COX, I, J, 1)
          DO JJ = 1, NN
            L = NINT(GEN086 (COX, SIM, 1.E-2, 1, JJ))
            IF (L .EQ. 1) GO TO 20
          END DO
          GO TO 30
   20     MTG(I, J) = JJ
        END DO
      END DO
      RETURN
   30 NMS = NMS + 1
      IF (NMS .LE. NMG) THEN
        CALL GEN079 (COX, SIM, 1, NMS)
        DO K = 1, N
          K1         = MK(K, J)
          MK(K, NMS) = MK(K1, I)
        END DO
        GO TO 10
      END IF
      IER = 1
      RETURN
      END SUBROUTINE PLA215
      SUBROUTINE PLA216 (V3, N, IAX, LU6)
      PARAMETER (NMA=550, NMG=120)
      COMMON /SRC/ XO(3, NMA), XS(3, NMA), D(NMA), CO(3, NMA), IV(NMA),
     1 COY(3,NMA), WWW(NMA), NGE(NMA), WGHT(NMA), DC(NMA), TRL(3, NMG),
     2 CF(NMA), MK(NMA, NMG), MN(NMA), MD(NMA, 2), RMSX(3, NMA),
     3 ISU(NMG), IASU(NMA), SIM(3, 3, NMG), DEVX(NMG), CSM(NMG),
     4 MTG(NMG, NMG), IAT(NMA), DA(NMA), MEQ(NMA), AL(3, 3), ALX(3, 3),
     5 AAY(3, 3), DEL(4), DELM(4), ORI(3, 3), CSMT, NMS, RMST
      DIMENSION V3(3), VS(3)
      CALL GEN097 (IV, 1, N, 0)
      NG   = 0
      COST = GEN084 (SIM, IAX)
   10 DO I = 1, N
        IF (IV(I) .EQ. 0) GO TO 20
      END DO
      GO TO 30
   20 NG = NG + 1
      IV(I) = NG
      DO J = 1, 3
        COY(J, NG) = XO(J, I)
      END DO
      WWW(NG) = WGHT(I)
      NGE(NG) = 1
      K = I
      DO
        L = MK(K, IAX)
        IF (L .EQ. I) GO TO 10
        IV(L) = NG
        DO J = 1, 3
          COY(J, NG) = COY(J, NG) + COST * XO(J, L)
        END DO
        WWW(NG) = WWW(NG) + WGHT(L)
        NGE(NG) = NGE(NG) + 1
        K = L
      END DO
   30 DO I = 1, NG
        WWW(I) = WWW(I) / NGE(I)
      END DO
      CALL GEN074 (V3, 1, 3, 0.0)
      DISM = 0.0
      DO I = 1, NG
        CALL GEN078 (SIM, COY, VS, IAX, I, 1)
        CALL GEN073 (COY, VS, VS, 1.0, COST, I, 1, 1)
        CALL GEN075 (VS, VS, DIS, 1, 1, 1)
        IF (DIS .GT. DISM) THEN
          DISM = DIS
          IM = I
        END IF
      END DO
      CALL GEN074 (V3, 1, 3, 0.0)
      IF (IM .LE. 0 .OR. IM .GT. NMA) THEN
        WRITE (LU6, 99998, IOSTAT = IOST) IM
      ELSE
        CALL GEN075 (COY, COY, DIM, IM, IM, 2)
        IF (NG .GT. NMA) THEN
          WRITE (LU6, 99999, IOSTAT = IOST) NG
        ELSE
          DO I = 1, NG
            CALL GEN075 (COY, COY, ABCOS, IM, I, 1)
            CALL GEN075 (COY, COY, DI, I, I, 2)
            ABSABCOS = ABS(ABCOS)
            IF (ABSABCOS .GT. 1.E-5) THEN
              COST = WWW(I) * ABCOS / ABSABCOS
              CALL GEN073 (V3, COY, V3, 1.0, COST, 1, I, 1)
            END IF
          END DO
          CALL GEN082 (V3, 1)
          IF (V3(1) .LE. 0.0) THEN
            V3(1) = - V3(1)
            V3(2) = - V3(2)
            V3(3) = - V3(3)
          END IF
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('NG = ', I10)
99998 FORMAT ('IM = ', I10)
      END SUBROUTINE PLA216
      SUBROUTINE PLA217 (XCSM, NES, N)
      PARAMETER (NMA=550, NMG=120)
      COMMON /SRC/ XO(3, NMA), XS(3, NMA), D(NMA), CO(3, NMA), IV(NMA),
     1 COY(3,NMA), WWW(NMA), NGE(NMA), WGHT(NMA), DC(NMA), TRL(3, NMG),
     2 CF(NMA), MK(NMA, NMG), MN(NMA), MD(NMA, 2), RMSX(3, NMA),
     3 ISU(NMG), IASU(NMA), SIM(3, 3, NMG), DEVX(NMG), CSM(NMG),
     4 MTG(NMG, NMG), IAT(NMA), DA(NMA), MEQ(NMA), AL(3, 3), ALX(3, 3),
     5 AAY(3, 3), DEL(4), DELM(4), ORI(3, 3), CSMT, NMS, RMST
      DIMENSION V3(3)
      NAZ = 3 * N
      CALL GEN074 (CO,   1, NAZ, 0.0)
      CALL GEN074 (XS,   1, NAZ, 0.0)
      CALL GEN074 (RMSX, 1, NAZ, 0.0)
      CALL GEN074 (DEL,  1,   4, 0.0)
      CALL GEN074 (DELM, 1,   4, 0.0)
      CALL GEN074 (CF,   1,   N, 0.0)
      DO I = 1, N
        CALL GEN075 (XO, XO, D(I), I, I, 2)
        DO J = 1, NES
          K = MK(I, ISU(J))
          CALL GEN078 (SIM, XO, V3, ISU(J), I, 1)
          CALL GEN073 (XS, V3, XS, 1.0, 1.0, K, 1, K)
        END DO
      END DO
      DO I = 1, N
        DO J = 1, 3
          XS(J, I) = XS(J, I) / FLOAT(NES)
        END DO
        CALL GEN075 (XS, XS, DC(I), I, I, 2)
      END DO
      DO I = 1, N
        DO J = 1, NES
          K = MK(I, ISU(J))
          CF(I) = CF(I) + D(K)
        END DO
        IF (DC(I) .GT. 1.E-04) CF(I) = CF(I) / (DC(I) * NES)
        DO J = 1, 3
          XS(J, I) = XS(J, I) * CF(I)
        END DO
      END DO
      DO I = 1, N
        DO J = 1, 3
          V3(J)  = XO(J, I) - XS(J, I)
          COM    = ABS(V3(J))
          DEL(J) = DEL(J) + COM
          IF (COM .GT. DELM(J)) DELM(J) = COM
        END DO
        CALL GEN075 (V3, V3, COM, 1, 1, 2)
        DEL(4) = DEL(4) + COM
        IF (DELM(4) .LT. COM) DELM(4) = COM
      END DO
      XCSM = 0.0
      DO J = 1, NES
        DO I = 1, N
          K = MK(I, ISU(J))
          CALL GEN078 (SIM, XO, V3, ISU(J), I, 1)
          CALL GEN073 (XS, V3, V3, 1.0, -1.0, K, 1, 1)
          DO L = 1, 3
            RMSX(L, K) = RMSX(L, K) + V3(L) ** 2
          END DO
          CALL GEN075 (V3, V3, COM, 1, 1, 1)
          XCSM = XCSM + COM
        END DO
      END DO
      COST = 1.0 / FLOAT(NES)
      RMST = 0.0
      DO I = 1, N
        DO J = 1, 3
          RMST       = RMST + RMSX(J, I)
          RMSX(J, I) = SQRT(RMSX(J, I) * COST)
        END DO
      END DO
      RMST = SQRT (RMST / FLOAT (NES * N))
      XCSM = XCSM * 100.0 / FLOAT (NES * N)
      RETURN
      END SUBROUTINE PLA217
      SUBROUTINE PLA218 (Q, PHI, AAZ, NR, LU7)
C * THIS PROGRAM-LINK EXPRESSES ANY CONFORMATION AS A LINEAR COMBINATION
C * OF PRIMITIVE FORMS- AS DEFINED BY THE CREMER-POPLE EQUATIONS.
C * THE PROGRAM IS DESIGNED TO HANDLE UP TO 8-MEMBERED RINGS.
      DIMENSION Q(*), PHI(*)
      IF (NR .LE. 18) THEN
        N = (NR - 1) / 2
        CALL PLA262 (3)
        WRITE (LU7, 99999, IOSTAT = IOST)
C * DISTINGUISH BETWEEN ODD AND EVEN MEMBERED RINGS
        IF (NR / 2 .GT. N) THEN
          IC    = NR / 2
          Q(IC) = AAZ
          R     = Q(IC)
          IF (NR .LE. 8) THEN
            CALL PLA219 (Q, PHI, N, NR, R, LU7)
          ELSE
            CALL PLA220 (Q, PHI, N, NR, R, LU7)
          END IF
        ELSE
          CALL PLA221 (Q, PHI, N, NR, LU7)
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT(/, 'Conformational Analysis (G.G. Evans & ',
     1 'J.A. Boeyens, Acta Cryst. (1989), B45, 581-590)', /)
      END SUBROUTINE PLA218
      SUBROUTINE PLA219 (Q, PHI, N, NR, R, LU7)
C * THIS ROUTINE GENERATES THE PRIMITIVE FORMS FOR 6 AND 8 MEMBERED RINGS
      COMMON /PL218/ XA(20), XB(20), XXA(20), XXB(20)
      DIMENSION Q(*), PHI(*), TF1(6), TF2(6), TF3(6), UF1(15),
     1 UF2(15), UF3(15), UF4(15), UF5(15), YXZ(15), QX(8), QXA(8)
      REAL K(50), L(50), KMIN(50), LMIN(50)
      CHARACTER NAME(6), NAMEX(15)*3
      DATA NAME /
     1 'B', 'T', 'C', 'E', 'S', 'H'/
      DATA TF1 /
     1 1.0, 0.0, 0.0, 0.586, 0.0,   0.0/
      DATA TF2 /
     1 0.0, 1.0, 0.0, 0.0,   0.707, 0.551/
      DATA TF3 /
     1 0.0, 0.0, 1.0, 0.414, 0.293, 0.449/
C * DATA FOR THE CLASSICAL FORMS
      DATA NAMEX /
     1 'BB ', 'BB ', 'CR ', 'TC ', 'TC ', 'C  ', 'B  ', 'S  ', 'S  ',
     2 'CC ', 'CC ', 'TCC', 'BC ', 'BC ', 'TBC'/
      DATA UF1 /
     1 1.0, 0.0,   0.0,   0.0, 0.0, 0.0, 0.5, 0.707, 0.293, 0.352,
     2 0.0, 0.234, 0.530, 0.0, 0.229/
      DATA UF2 /
     1 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.293, 0.707, 0.0, 0.352,
     2 0.234, 0.0, 0.530, 0.229/
      DATA UF3 /
     1 0.0, 0.0, 0.0, 1.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
     2 0.298, 0.0, 0.213/
      DATA UF4 /
     1 0.0, 0.0, 0.0, 0.0, 1.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
     2 0.0, 0.298, 0.213/
      DATA UF5 /
     1 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.648, 0.648,
     2 0.533, 0.172, 0.172, 0.116/
      IF (R .LE. 0) THEN
        AA = -1.0
      ELSE
        AA =  1.0
      END IF
      V = ABS(R)
      IF (NR .EQ. 6) THEN
        DO M = 2, N
          CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 7, 4)
        END DO
        CALL PLA222 (Q, KMIN, LMIN, N, NR, PHI, V, VV, LU7)
        WRITE (LU7, 99997, IOSTAT = IOST) NR / 2, VV, AA
        DO I = 1, 6
          YXX = ABS(TF1(I) - XXA(2)) + ABS(TF2(I) - XXB(2))
     1        + ABS(TF3(I) - VV)
          IF (YXX .LE. 0.2 .AND. YXX .GT. 0.1)
     1        WRITE (LU7, 99998, IOSTAT = IOST) NAME(I)
          IF (YXX .LE. 0.1) THEN
            CALL PLA262 (3)
            WRITE (LU7, 99999, IOSTAT = IOST) NAME(I)
          END IF
        END DO
      ELSE
        DO M = 2, N
          IF (M .EQ. 2) THEN
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 3, 16)
          ELSE
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 5, 8)
          END IF
        END DO
        CALL PLA222 (Q, KMIN, LMIN, N, NR, PHI, V, VV, LU7)
        WRITE (LU7, 99997, IOSTAT = IOST) NR / 2, VV, AA
        DO I = 1, 15
          YXZ(I) = ABS(XXA(2) - UF1(I)) + ABS(XXB(2) - UF2(I))
     1           + ABS(XXA(3) - UF3(I)) + ABS(XXB(3) - UF4(I))
     2           + ABS(VV - UF5(I))
        END DO
        DO I = 1, 12
          IF (YXZ(I) .LE. 0.2 .AND. YXZ(I) .GT. 0.1) THEN
            CALL PLA262 (3)
            WRITE (LU7, 99998, IOSTAT = IOST) NAMEX(I)
          END IF
          IF (YXZ(I) .LE. 0.1) THEN
            CALL PLA262 (3)
            WRITE (LU7, 99999, IOSTAT = IOST) NAMEX(I)
          END IF
        END DO
        DO I = 2, N
          RZ = ABS(PHI(I) - 360)
          IF (RZ .LT. 5) PHI(I) = 360 - PHI(I)
        END DO
        IF (YXZ(13) .LE. 0.2 .OR. YXZ(14) .LE. 0.2) THEN
          DO J = 1, 8
            ANG  = FLOAT(      (8 * 180 * (J - 1)) / 16)
            ANGA = FLOAT(180 + (8 * 180 * (J - 1)) / 16)
            ANGL = FLOAT(180 + (4 * 180 * (J - 1)) / 16)
            CALL PLA223 (1, ANG,  PHI, RL,  2)
            CALL PLA223 (1, ANGA, PHI, RLA, 2)
            CALL PLA223 (4, ANGL, PHI, RLL, 3)
            QX(J)  = RL  + RLL
            QXA(J) = RLA + RLL
          END DO
          QXX  = 10.03
          QXXA = 10.03
          DO J = 1, 8
            IF (QX(J)  .LE. 10 .AND. AA .EQ. -1.0) QXX  = QX(J)
            IF (QXA(J) .LE. 10 .AND. AA .EQ.  1.0) QXXA = QXA(J)
          END DO
          IF (QXX .LE. 10) THEN
            IF (YXZ(13) .LE. 0.1 .OR. YXZ(14) .LE. 0.1) THEN
              CALL PLA262 (3)
              WRITE (LU7, 99999, IOSTAT = IOST) NAMEX(13)
            END IF
          END IF
          IF (QXXA .LE. 10) THEN
            IF (YXZ(13) .GT. 0.1 .OR. YXZ(14) .GT. 0.1) THEN
              CALL PLA262 (3)
              WRITE (LU7, 99998, IOSTAT = IOST) NAMEX(13)
            END IF
          END IF
        ELSE IF (YXZ(15) .LE. 0.2) THEN
          DO J = 1, 8
            ANG  = FLOAT(      45 + (8 * 180 * (J - 1)) / 16)
            ANGA = FLOAT(180 + 45 + (8 * 180 * (J - 1)) / 16)
            ANGL = FLOAT(180 + 360 / 16 + (4 * 180 * (J - 1)) / 16)
            CALL PLA223 (1, ANG,  PHI, RL,  2)
            CALL PLA223 (1, ANGA, PHI, RLA, 2)
            CALL PLA223 (4, ANGL, PHI, RLL, 3)
            QX(J)  = RL  + RLL
            QXA(J) = RLA + RLL
          END DO
          QXX  = 10.03
          QXXA = 10.03
          DO J = 1, 8
            IF (QX(J)  .LE. 10 .AND. AA .EQ. -1.0) QXX  = QX(J)
            IF (QXA(J) .LE. 10 .AND. AA .EQ.  1.0) QXXA = QXA(J)
          END DO
          IF (QXX .LE. 10 .OR. QXXA .LE. 10) THEN
            CALL PLA262 (3)
            IF (YXZ(15) .LE. 0.1) THEN
              WRITE (LU7, 99999, IOSTAT = IOST) NAMEX(15)
            ELSE
              WRITE (LU7, 99998, IOSTAT = IOST) NAMEX(15)
            END IF
          END IF
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, ':: Note: This is a ', A, '-Form', /)
99998 FORMAT (/, ':: Note: This is Very Similar to a ', A,'-Form')
99997 FORMAT (10X, I2, 21X, F5.3, 8X, F4.1)
      END SUBROUTINE PLA219
      SUBROUTINE PLA220 (Q, PHI, N, NR, R, LU7)
      DIMENSION Q(*), PHI(*)
      REAL K(50), L(50), KMIN(50), LMIN(50)
      IF (R .LE. 0) THEN
        AA = -1.0
      ELSE
        AA =  1.0
      END IF
      V = ABS(R)
      IF (NR .EQ. 10) THEN
        DO M = 2, N
          CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 11, 4)
        END DO
      ELSE IF (NR .EQ. 12) THEN
        DO M = 2, N
          IF (M .EQ. 3) THEN
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 3, 24)
          ELSE
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 13, 8)
          END IF
        END DO
      ELSE IF (NR .EQ. 14) THEN
        DO M = 2, N
          CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 15, 4)
        END DO
      ELSE IF (NR .EQ. 16) THEN
        DO M = 2, N
          IF (M .EQ. 2 .OR. M .EQ. 6) THEN
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 5, 16)
          ELSE IF (M .EQ. 4) THEN
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 3, 32)
          ELSE
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 9, 8)
          END IF
        END DO
      ELSE
        DO M = 2, N
          IF (M .EQ. 3 .OR. M .EQ. 6) THEN
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 7, 12)
          ELSE
            CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 19, 4)
          END IF
        END DO
      END IF
      CALL PLA222 (Q, KMIN, LMIN, N, NR, PHI, V, VV, LU7)
      WRITE (LU7, 99999, IOSTAT = IOST) NR / 2, VV, AA
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (10X, I2, 21X, F5.3, 8X, F4.1)
      END SUBROUTINE PLA220
      SUBROUTINE PLA221 (Q, PHI, N, NR, LU7)
      COMMON /PL218/ XA(20), XB(20), XXA(20), XXB(20)
      DIMENSION Q(*), PHI(*), SF1(2), SF2(2), XF1(9), XF2(9),
     1 XF3(9), XF4(9), XN1(16), XN2(16), XN3(16), XN4(16), XN5(16),
     2 XN6(16), YZZ(16), QY(14), QX(19), QXA(14),
     3 QYA(14), QX1(18), QX2(18), QX3(18), QX4(18)
      REAL K(50), L(50), KMIN(50), LMIN(50)
      CHARACTER NAME(2), NAMEX(9)*2, NAMX(16)*4
      DATA NAME /'E', 'T'/
      DATA SF1  /1.0, 0.0/
      DATA SF2  /0.0, 1.0/
      DATA NAMEX /
     1 'B ', 'TB', 'C ', 'TC', 'BS', 'S ', 'TS', 'H ', 'T '/
      DATA XF1 /
     1 1.00, 0.0, 0.0, 0.0, 0.783, 0.5, 0.0, 0.417, 0.0/
      DATA XF2 /
     1 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.444, 0.0, 0.46/
      DATA XF3 /
     1 0.0, 0.0, 1.0, 0.0, 0.217, 0.5, 0.0, 0.583, 0.0/
      DATA XF4 /
     1 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.555, 0.0, 0.54/
      DATA NAMX /
     1 'BB  ', 'TBB ', 'BC  ', 'TBC ', 'CC  ', 'TCC ', 'BC" ',
     2 'TBC"', 'B   ', 'CC" ', 'TB  ', 'TCC"', 'C   ', 'CB  ',
     3 'TC  ', 'TCB'/
      DATA XN1 /
     1 1.00, 0.0, 0.0, 0.0, 0.0, 0.0, 0.308, 0.0, 0.582, 0.401, 0.0,
     2 0.0, 0.280, 0.601, 0.0, 0.0/
      DATA XN2 /
     1 0.0, 1.00, 0.0, 0.0, 0.0, 0.0, 0.0, 0.317, 0.0, 0.0, 0.584,
     2 0.397, 0.0, 0.0, 0.340, 0.498/
      DATA XN3 /
     1 0.0, 0.0, 1.0, 0.0, 0.379, 0.0, 0.563, 0.0, 0.168, 0.189,
     2 0.0, 0.0, 0.617, 0.245, 0.0, 0.0/
      DATA XN4 /
     1 0.0, 0.0, 0.0, 1.0, 0.0, 0.379, 0.0, 0.564, 0.0, 0.0, 0.168,
     2 0.192, 0.0, 0.0, 0.515, 0.319/
      DATA XN5 /
     1 0.0, 0.0, 0.0, 0.0, 0.621, 0.0, 0.129, 0.0, 0.250, 0.410, 0.0,
     2 0.0, 0.104, 0.154, 0.0, 0.0/
      DATA XN6 /
     1 0.0, 0.0, 0.0, 0.0, 0.0, 0.621, 0.0, 0.119, 0.0, 0.0, 0.248,
     2 0.411, 0.0, 0.0, 0.145, 0.183/
      DO M = 2, N
        NRR = 2 * NR + 1
        IF (NR .EQ. 9 .AND. M .EQ. 3) THEN
          CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 7, 6)
        ELSE IF (NR .EQ. 15 .AND. M .EQ. 5) THEN
          CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 7, 10)
        ELSE IF (NR .EQ. 15 .AND. M .EQ. 3 .OR. NR .EQ. 15
     1           .AND. M .EQ. 6) THEN
          CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, 11, 6)
        ELSE
          CALL PLA225 (M, K, L, KMIN, LMIN, PHI, NR, NRR, 2)
        END IF
      END DO
      V = 0
      CALL PLA222 (Q, KMIN, LMIN, N, NR, PHI, V, VV, LU7)
      IF (NR .LT. 10) THEN
        IF (NR .EQ. 5) THEN
          DO I = 1, 2
            YX = ABS(SF1(I) - XXA(2)) + ABS(SF2(I) - XXB(2))
            IF (YX .LE. 0.1) WRITE (LU7, 99999, IOSTAT = IOST) NAME(I)
            IF (YX .GT. 0.1 .AND. YX .LE. 0.2)
     1        WRITE (LU7, 99998, IOSTAT = IOST) NAME(I)
          END DO
        ELSE IF (NR .EQ. 7) THEN
          DO I = 1, 9
            YZZ(I) = ABS(XXA(2) - XF1(I)) + ABS(XXB(2) - XF2(I))
     1             + ABS(XXA(3) - XF3(I)) + ABS(XXB(3) - XF4(I))
          END DO
          DO I = 2, N
            RZ = ABS(PHI(I) - 360)
            IF (RZ .LT. 5) PHI(I) = 360 - PHI(I)
          END DO
          IF (YZZ(5) .LE. 0.2) THEN
            DO J = 1, 14
              ANGA = FLOAT(180 + (6 * 180 * (J - 1)) / 14)
              ANGL = FLOAT(      (2 * 180 * (J - 1)) / 14)
              CALL PLA223 (3, ANGA, PHI, RLA, 2)
              RLL   = ABS(PHI(3) - ANGL)
              QX(J) = RLA + RLL
            END DO
            QXX = 10.03
            DO J = 1, 14
              IF (QX(J) .LE. 10) QXX = QX(J)
            END DO
            IF (QXX .LE. 10) THEN
              IF (YZZ(5) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) 'BS'
              ELSE
                WRITE (LU7, 99998, IOSTAT = IOST) 'BS'
              END IF
            END IF
          ELSE IF (YZZ(6) .LE. 0.2 .OR. YZZ(8) .LE. 0.2) THEN
            DO J = 1, 14
              ANG  = FLOAT(      (6 * 180 * (J - 1)) / 14)
              ANGA = FLOAT(180 + (6 * 180 * (J - 1)) / 14)
              ANGL = FLOAT(      (2 * 180 * (J - 1)) / 14)
              CALL PLA223 (1, ANG, PHI, RL, 2)
              CALL PLA223 (3, ANGA, PHI, RLA, 2)
              RLL    = ABS(PHI(3) - ANGL)
              QX(J)  = RL  + RLL
              QXA(J) = RLA + RLL
            END DO
            QXX  = 10.03
            QXXA = 10.03
            DO J = 1, 14
              IF (QX(J)  .LE. 10) QXX  = QX(J)
              IF (QXA(J) .LE. 10) QXXA = QXA(J)
            END DO
            IF (QXX .LE. 10) THEN
              IF (YZZ(6) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) 'S'
              ELSE IF (YZZ(6) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) 'S'
              ENDIF
            END IF
            IF (QXXA .LE. 10) THEN
              IF (YZZ(8) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) 'H'
              ELSE IF (YZZ(8) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) 'H'
              ENDIF
            ENDIF
          ELSE IF (YZZ(7) .LE. 0.2 .OR. YZZ(9) .LE. 0.2) THEN
            DO J = 1, 14
              ANGM  =
     1       FLOAT(      ((3 * 180) / 14) + ((6 * 180 * (J - 1)) / 14))
              ANGMA =
     1       FLOAT(180 + ((3 * 180) / 14) + ((6 * 180 * (J - 1)) / 14))
              ANGLM =
     1       FLOAT(            (180 / 14) + ((2 * 180 * (J - 1)) / 14))
              CALL PLA223 (1, ANGM,  PHI, RM,  2)
              CALL PLA223 (3, ANGMA, PHI, RMA, 2)
              RMM    = ABS(PHI(3) - ANGLM)
              QY(J)  = RM  + RMM
              QYA(J) = RMA + RMM
            END DO
            QYY  = 10.03
            QYYA = 10.03
            DO J = 1, 14
              IF (QY(J)  .LE. 10) QYY  = QY(J)
              IF (QYA(J) .LE. 10) QYYA = QYA(J)
            END DO
            IF (QYY .LE. 10) THEN
              IF (YZZ(7) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) 'TS'
              ELSE IF (YZZ(7) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) 'TS'
              ENDIF
            ENDIF
            IF (QYYA .LE. 10) THEN
              IF (YZZ(9) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) 'T'
              ELSE IF (YZZ(9) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) 'T'
              END IF
            END IF
          ELSE
            DO I = 1, 9
              IF (YZZ(I) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMEX(I)
              ELSE IF (YZZ(I) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) NAMEX(I)
              END IF
            END DO
          END IF
        ELSE
          DO I = 1, 16
            YZZ(I) = ABS(XXA(2) - XN1(I)) + ABS(XXB(2) - XN2(I))
     1             + ABS(XXA(3) - XN3(I)) + ABS(XXB(3) - XN4(I))
     2             + ABS(XXA(4) - XN5(I)) + ABS(XXB(4) - XN6(I))
          END DO
          DO I = 2, N
            RH = ABS(PHI(I) - 360.0)
            IF (RH .LT. 5) PHI(I) = 360.0 - PHI(I)
          END DO
          IF (YZZ(5) .LE. 0.2) THEN
            DO J = 1, 18
              ANG  = FLOAT(180 + (6 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(      (2 * 180 * (J - 1)) / 18)
              CALL PLA223 (3, ANG, PHI, RL, 3)
              RLL   = ABS(PHI(4) - ANGL)
              QX(J) = RL + RLL
            END DO
            QXX = 10.03
            DO J = 1, 18
              IF (QX(J) .LE. 10) QXX = QX(J)
            END DO
            IF (QXX .LE. 10) THEN
              IF (YZZ(5) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(5)
              ELSE IF (YZZ(5) .GT. 0.1) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) NAMX(5)
              END IF
            END IF
          ELSE IF (YZZ(6) .LE. 0.2) THEN
            DO J = 1, 18
              ANG  = FLOAT(180 + 30 + (6 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(      10 + (2 * 180 * (J - 1)) / 18)
              CALL PLA223 (3, ANG, PHI, RL, 3)
              RLL   = ABS(PHI(4) - ANGL)
              QX(J) = RL + RLL
            END DO
            QXX = 10.03
            DO J = 1, 18
              IF (QX(J) .LE. 10) QXX = QX(J)
            END DO
            IF (QXX .LE. 10) THEN
              IF (YZZ(6) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(6)
              ELSE IF (YZZ(6) .GT. 0.1)  THEN
                WRITE (LU7, 99998, IOSTAT = IOST) NAMX(6)
              END IF
            END IF
          ELSE IF (YZZ(7) .LE. 0.2 .OR. YZZ(9) .LE. 0.2 .OR. YZZ(10)
     1      .LE. 0.2 .OR. YZZ(13) .LE. 0.2 .OR. YZZ(14) .LE. 0.2) THEN
            DO J = 1, 18
              ANG  = FLOAT(180 + (10 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(180 +  (6 * 180 * (J - 1)) / 18)
              ANGM = FLOAT(       (2 * 180 * (J - 1)) / 18)
              CALL PLA223 (2, ANG,  PHI, RL,  2)
              CALL PLA223 (3, ANGL, PHI, RLL, 3)
              CALL PLA223 (4, ANGM, PHI, RLM, 4)
              QX(J) = RL + RLL + RLM
            END DO
            QXX = 15.03
            DO J = 1, 18
              IF (QX(J) .LE. 15) QXX = QX(J)
            END DO
            IF (QXX .LE. 15) THEN
              IF (YZZ(7) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(7)
              ELSE IF (YZZ(7) .GT. 0.1) THEN
                IF (YZZ(7) .LE. 0.2) THEN
                  WRITE (LU7, 99998, IOSTAT = IOST) NAMX(7)
                END IF
              END IF
            END IF
            DO J = 1, 18
              ANG  = FLOAT(      (10 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(180 + (6  * 180 * (J - 1)) / 18)
              ANGM = FLOAT(      (2  * 180 * (J - 1)) / 18)
              CALL PLA223 (2, ANG,  PHI, RL,  2)
              CALL PLA223 (3, ANGL, PHI, RLL, 3)
              CALL PLA223 (4, ANGM, PHI, RLM, 4)
              QX1(J) = RL + RLL + RLM
            END DO
            QXX1 = 15.03
            DO J = 1, 18
              IF (QX1(J) .LE. 15) QXX1 = QX1(J)
            END DO
            IF (QXX1 .LE. 15) THEN
              IF (YZZ(9) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(9)
              ELSE IF (YZZ(9) .GT. 0.1) THEN
                IF (YZZ(9) .LE. 0.2) THEN
                  WRITE (LU7, 99998, IOSTAT = IOST) NAMX(9)
                END IF
              END IF
              IF (YZZ(10) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(10)
              ELSE IF (YZZ(10) .GT. 0.1) THEN
                IF (YZZ(10) .LE. 0.2) THEN
                  WRITE (LU7, 99998, IOSTAT = IOST) NAMX(10)
                ENDIF
              END IF
            END IF
            DO J = 1, 18
              ANG  = FLOAT(180 + (10 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(       (6 * 180 * (J - 1)) / 18)
              ANGM = FLOAT(       (2 * 180 * (J - 1)) / 18)
              CALL PLA223 (2, ANG,  PHI, RL,  2)
              CALL PLA223 (3, ANGL, PHI, RLL, 3)
              CALL PLA223 (4, ANGM, PHI, RLM, 4)
              QX2(J) = RL + RLL + RLM
            END DO
            QXX2 = 15.03
            DO J = 1, 18
              IF (QX2(J) .LE. 15) QXX2 = QX2(J)
            END DO
            IF (QXX2 .LE. 15) THEN
              IF (YZZ(13) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(13)
              ELSE IF (YZZ(13) .GT. 0.1) THEN
                IF (YZZ(13) .LE. 0.2) THEN
                  WRITE (LU7, 99998, IOSTAT = IOST) NAMX(13)
                END IF
              END IF
              IF (YZZ(14) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(14)
              ELSE IF (YZZ(14) .GT. 0.1) THEN
                IF (YZZ(14) .LE. 0.2) THEN
                  WRITE (LU7, 99998, IOSTAT = IOST) NAMX(14)
                END IF
              END IF
            END IF
          ELSE IF (YZZ(8) .LE. 0.2 .OR. YZZ(11) .LE. 0.2 .OR. YZZ(12)
     1      .LE. 0.2 .OR. YZZ(15) .LE. 0.2 .OR. YZZ(16) .LE. 0.2) THEN
            DO J = 1, 18
              ANG  = FLOAT(180 + 50 + (10 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(180 + 30 +  (6 * 180 * (J - 1)) / 18)
              ANGM = FLOAT(      10 +  (2 * 180 * (J - 1)) / 18)
              CALL PLA223 (2, ANG,  PHI, RL,  2)
              CALL PLA223 (3, ANGL, PHI, RLL, 3)
              CALL PLA223 (4, ANGM, PHI, RLM, 4)
            END DO
            QXX = 15.03
            DO J = 1, 18
              IF (QX(J) .LE. 15) QXX = QX(J)
            END DO
            IF (QXX .LE. 15) THEN
              IF (YZZ(8) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(8)
              ELSE IF (YZZ(8) .GT. 0.1) THEN
                IF (YZZ(8) .LE. 0.2) THEN
                  WRITE (LU7, 99998, IOSTAT = IOST) NAMX(8)
                END IF
              END IF
            END IF
            DO J = 1, 18
              ANG  = FLOAT(      50 + (10 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(180 + 30 + (6  * 180 * (J - 1)) / 18)
              ANGM = FLOAT(      10 + (2  * 180 * (J - 1)) / 18)
              CALL PLA223 (2, ANG,  PHI, RL,  2)
              CALL PLA223 (3, ANGL, PHI, RLL, 3)
              CALL PLA223 (4, ANGM, PHI, RLM, 4)
              QX3(J) = RL + RLL + RLM
            END DO
            QXX3 = 15.03
            DO J = 1, 18
              IF (QX3(J) .LE. 15) QXX3 = QX3(J)
            END DO
            IF (QXX3 .LE. 15) THEN
              IF (YZZ(11) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(11)
              ELSE IF (YZZ(11) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) NAMX(11)
              ENDIF
              IF (YZZ(12) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(12)
              ELSE IF (YZZ(12) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) NAMX(12)
              END IF
            ENDIF
            DO J = 1, 18
              ANG  = FLOAT(50 + 180 + (10 * 180 * (J - 1)) / 18)
              ANGL = FLOAT(30       +  (6 * 180 * (J - 1)) / 18)
              ANGM = FLOAT(10       +  (2 * 180 * (J - 1)) / 18)
              CALL PLA223 (2, ANG,  PHI, RL,  2)
              CALL PLA223 (3, ANGL, PHI, RLL, 3)
              CALL PLA223 (4, ANGM, PHI, RLM, 4)
              QX4(J) = RL + RLL + RLM
            END DO
            QXX4 = 15.03
            DO J = 1, 18
              IF (QX4(J) .LE. 15) QXX4 = QX4(J)
            END DO
            IF (QXX4 .LE. 15) THEN
              IF (YZZ(15) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(15)
              ELSE IF (YZZ(15) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) NAMX(15)
              END IF
              IF (YZZ(16) .LE. 0.1) THEN
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(16)
              ELSE IF (YZZ(16) .LE. 0.2) THEN
                WRITE (LU7, 99998, IOSTAT = IOST) NAMX(16)
              ENDIF
            END IF
          ELSE
            DO I = 1, 4
              IF (YZZ(I) .LE. 0.2 .AND. YZZ(I) .GT. 0.1) THEN
                CALL PLA262 (3)
                WRITE (LU7, 99998, IOSTAT = IOST) NAMX(I)
              END IF
              IF (YZZ(I) .LE. 0.1) THEN
                CALL PLA262 (3)
                WRITE (LU7, 99999, IOSTAT = IOST) NAMX(I)
              END IF
            END DO
          END IF
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, ':: Note: This is a ', A, '-Form', /)
99998 FORMAT (/, ':: Note: This is Very Similar to a ', A,'-Form', /)
      END SUBROUTINE PLA221
      SUBROUTINE PLA222 (Q, KMIN, LMIN, N, NR, PHI, V, VV, LU7)
      COMMON /PL218/ XA(20), XB(20), XXA(20), XXB(20)
      DIMENSION Q(*), PHI(*), A(20), B(20), W(20), RHI(20)
      REAL KMIN(50), LMIN(50)
      PI   = 4 * ATAN2 (1.0, 1.0)
      FACT = PI / 180.0
      DO M = 2, N
        A(M) = ((KMIN(M) * PI) / (2 * NR))
        B(M) = ((LMIN(M) * PI) / (2 * NR))
        W(M) = (SIN(A(M))) * (COS(B(M))) - (COS(A(M))) * (SIN(B(M)))
        IF (W(M) .NE. 0.0) THEN
          RHI(M) = PHI(M) * FACT
          IF (ABS(KMIN(M)) .GT. 0.001) THEN
            XA(M)  = (1 / W(M)) * ((-Q(M)) * (COS(RHI(M))) * (SIN(B(M)))
     1             + Q(M) * (SIN(RHI(M))) * (COS(B(M))))
          ELSE
            XA(M) = 0.0
          END IF
          IF (ABS(LMIN(M)) .GT. 0.001) THEN
            XB(M)  = (1 / W(M)) * (Q(M) * (COS(RHI(M))) * (SIN(A(M)))
     1             - Q(M) * (SIN(RHI(M))) * (COS(A(M))))
          ELSE
            XB(M) = 0.0
          END IF
        ELSE
          WRITE (LU7, 99996, IOSTAT = IOST)
          GO TO 10
        END IF
      END DO
      TOTL = 0.0
      VV   = 0.0
      DO M = 2, N
        TOTL = TOTL + XA(M) + XB(M)
      END DO
      TOTL = TOTL + V
      IF (TOTL .NE. 0.0) THEN
        CALL PLA262 (2 * N + 4)
        WRITE (LU7, 99999, IOSTAT = IOST)
        DO M = 2, N
          XXA(M) = XA(M) / TOTL
          XXB(M) = XB(M) / TOTL
          WRITE (LU7, 99998, IOSTAT = IOST) M, XA(M), XXA(M), KMIN(M)
          WRITE (LU7, 99997, IOSTAT = IOST)    XB(M), XXB(M), LMIN(M)
        END DO
        VV = V / TOTL
      END IF
      IF (IOST .NE. 0) RETURN
   10 RETURN
99999 FORMAT (11X, 'Coefficients of Primitive and Normalised Forms',
     1      /, 11X, 'M      Primitive  Coefficient ',
     2          'Angular Value ', /, 11X, 43('-'))
99998 FORMAT ('CosForm',  3X, I2, 8X, F5.3, 8X, F5.3, 8X, F4.1)
99997 FORMAT ('SinForm', 13X,         F5.3, 8X, F5.3, 8X, F4.1)
99996 FORMAT ('Special Case: No CosForm/SinForm Reported')
      END SUBROUTINE PLA222
      SUBROUTINE PLA223 (MODE, ANG, PHI, RL, N)
      DIMENSION PHI(*)
      IF (MODE .EQ. 1) THEN
        RL   = ABS(PHI(2) - ANG)
        IF (ANG .GE. 360 .AND. ANG .LT. 720)
     1      RL = ABS(PHI(N) + 360 - ANG)
        IF (ANG .GE. 720) RL = ABS(PHI(N) + 720 - ANG)
      ELSE IF (MODE .EQ. 2) THEN
        RL   = ABS(PHI(N) - ANG)
        IF (ANG .GE.  360 .AND. ANG .LT.  720)
     1      RL = ABS(PHI(N) +  360 - ANG)
        IF (ANG .GE.  720 .AND. ANG .LT. 1080)
     1      RL = ABS(PHI(N) +  720 - ANG)
        IF (ANG .GE. 1080 .AND. ANG .LT. 1440)
     1      RL = ABS(PHI(N) + 1080 - ANG)
        IF (ANG .GE. 1440 .AND. ANG .LT. 1800)
     1      RL = ABS(PHI(N) + 1440 - ANG)
        IF (ANG .GE. 1800) RL = ABS(PHI(N) + 1800 - ANG)
      ELSE IF (MODE .EQ. 3) THEN
        RL = ABS(PHI(N) - ANG)
        IF (ANG .GE.  360 .AND. ANG .LT.  720)
     1      RL = ABS(PHI(N) + 360 - ANG)
        IF (ANG .GE.  720 .AND. ANG .LT. 1080)
     1      RL = ABS(PHI(N) + 720 - ANG)
        IF (ANG .GE. 1080) RL = ABS(PHI(N) + 1080 - ANG)
      ELSE IF (MODE .EQ. 4) THEN
        RL = ABS(PHI(N) - ANG)
        IF (ANG .GE. 360) RL = ABS(PHI(N) + 360 - ANG)
      END IF
      RETURN
      END SUBROUTINE PLA223
      SUBROUTINE PLA224 (N, KK, KM, NR, PHI)
      REAL KK(50), KM
      YM = 380
      DO I = 1, N
        Y = ABS(((KK(I) * 180) / (2 * NR)) - PHI)
        IF (Y .LT. YM) THEN
          YM = Y
          KM = KK(I)
        END IF
      END DO
      RETURN
      END SUBROUTINE PLA224
      SUBROUTINE PLA225 (M, RK, RL, RKMIN, RLMIN, PHI, NR, N, N0)
      DIMENSION RK(*), RL(*), RKMIN(*), RLMIN(*), PHI(*)
      DO I = 1, N
        RK(I) = N0 * (I - 1)
        RL(I) = FLOAT(N0 * (I - 1) + N0 / 2)
      END DO
      CALL PLA224 (N, RK, RKMIN(M), NR, PHI(M))
      CALL PLA224 (N, RL, RLMIN(M), NR, PHI(M))
      RETURN
      END SUBROUTINE PLA225
      SUBROUTINE PLA226 (MTYPE, ANGLE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      IPR(201) = 0
      IGBL(67) = 1
      IF (MTYPE .GE. 0) CALL GEN021 (RMAT, 1)
      IF (MTYPE .NE. 0 .AND. IABS(MTYPE) .LE. 3) THEN
        CALL GEN051 (0, RMAT, ANGLE, IABS(MTYPE))
      ELSE IF (MTYPE .EQ. -4) THEN
        DO L = 1, 3
          DO K = 1, 3
            RMAT(L, K) = - RMAT(L, K)
          END DO
        END DO
      END IF
      CALL GEN005 (RMAT, DUMV)
      CALL GEN096 (DUMV, IROTX, IROTY, IROTZ, IDET, V6, YANK, QM)
      WRITE (LU6, 99999, IOSTAT = IOST) IROTX, IROTY, IROTZ, IDET
      RGBL(28) = IROTX
      RGBL(29) = IROTY
      RGBL(30) = IROTZ
      IGBL(87) = IDET
      IPR(330) = (1 - IDET) / 2
      RETURN
99999 FORMAT (':: NEW Xrot, Yrot, Zrot =', 3I5, ', Idet =', I2)
      END SUBROUTINE PLA226
      SUBROUTINE PLA227 (IAT, JAT, V)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP19=31,NP25=99,NP29=63,NP41=200,NP47=9,NP56=30)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      DIMENSION V(*)
      DO K = 1, 3
        V(K) = XXO(JAT, K + 3) - XXO(IAT, K + 3)
      END DO
      D = GEN017 (V)
      D = D + 0.0
      RETURN
      END SUBROUTINE PLA227
      SUBROUTINE PLA228 (LU)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,
     2 NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      IPR(683) = 0
      NAT      = IPR(37)
      CALL GEN097 (IENLB, 1, NP10, 0)
      DO I = 1, NAT
        CALL GEN048 (2, IFG(1, I), 1, 0)
      END DO
   10 N   = 0
      M   = 0
      NUM = 0
      DO I = 1, NAT
        CALL GEN048 (-1, IFG(1, I), 2, IVAL)
        IF (IVAL .EQ. 0) THEN
          CALL GEN048 (-1, IFG(1, I), 1, IVAL)
          IF (IVAL .EQ. 0) THEN
            CALL GEN048 (-10, IFG(2, I), 14, NBUT)
            IF (NBUT .GT. M) THEN
              M = NBUT
              N = I
            END IF
          END IF
        END IF
      END DO
      IF (N .GT. 0) THEN
        CALL PLA229 (NUM, N, N2, LU)
   20   NC = - NINT(CON(N, NP4))
        IF (NC .LT. 0) NC = NP4
        N1 = 0
        M1 = 0
        DO J = 1, NC
          K = NINT(CON(N, J))
          CALL GEN048 (-1, IFG(1, K), 1, IVAL)
          IF (IVAL .EQ. 0) THEN
            CALL GEN048 (-10, IFG(2, K), 14, NBUT)
            IF (NBUT .GT. M1) THEN
              M1 = NBUT
              N1 = K
            END IF
          END IF
        END DO
        IF (N1 .GT. 0) THEN
          CALL PLA229 (NUM, N1, N2, LU)
          N   = N1
          GO TO 20
        ELSE
          CALL GEN048 (1, IFG(1, N), 2, 1)
          N2 = N2 - 1
          IF (N2 .GT. 0) THEN
            N = JR(N2)
            GO TO 20
          END IF
          GO TO 10
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA228
      SUBROUTINE PLA229 (NUM, NR, N2, LU)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER NQ*2
      NUM     = NUM + 1
      N2      = NUM
      JR(NUM) = NR
      CALL GEN048 ( 1, IFG(1, NR), 1, 1)
      CALL GEN048 (-4, IFG(1, NR), 15, NO)
      NO        = NO + 1
      NQ        = LMT(NO, 1)
      IENLB(NO) = IENLB(NO) + 1
      NUM0      = IENLB(NO)
      IF (NQ(1:1) .EQ. ' ') THEN
        NQ2 = NQ(2:2)
        K0  = 2
      ELSE
        NQ2 = NQ
        K0  = 3
      END IF
      IF (NUM0 .LT. 10) THEN
        WRITE(NQ2(K0:), 99999, IOSTAT = IOST) NUM0
      ELSE IF (NUM0 .LT. 100) THEN
        WRITE(NQ2(K0:), 99998, IOSTAT = IOST) NUM0
      ELSE IF (NUM0 .LT. 1000) THEN
        WRITE(NQ2(K0:), 99997, IOSTAT = IOST) NUM0
      ELSE
        WRITE(NQ2(K0:), 99996, IOSTAT = IOST) NUM0
      END IF
      IF (IOST .EQ. 0) THEN
        CALL PLA047 (LABA(NR), NQ1, IDUM, IENR, IGBL(55), IPR(71),
     1    0, 0)
        IPR(683) = IPR(683) + 1
        CALL PLA282 (IPR(683), NQ2, NQ1, LU)
      END IF
      RETURN
99999 FORMAT (I1, 1X)
99998 FORMAT (I2, 1X)
99997 FORMAT (I3, 1X)
99996 FORMAT (I4, 1X)
      END SUBROUTINE PLA229
      SUBROUTINE PLA230 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2, FPARSU*17
      COMMON /BONDTYPE/ BNDTP(11)
      CHARACTER BNDTP*5
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /VALDOC/ NDOC(999)
      CHARACTER SPLC*11
      CHARACTER WLEVEL(4)*8, MESS*65, CHK*4, ICH*1, WR*5, CNT*2,
     1 TYPE*1, FORM*18, FORMC*106, FORMD*97, FORMV*7, TXT0*5, TXT1*17,
     2 TXT2*21, TXT3*9, TXT4*8, TXT5*24, RADIATION*11
      DIMENSION IATYPE(5), V1820(4), ICOUNT(4), JCOUNT(4), KCOUNT(4)
      COMMON /ALERT/ ATYPE, ALEVEL
      CHARACTER ATYPE(5)*61, ALEVEL(4)*62
      CHARACTER CDUM*(NP52), CTYPE*1, TTYPE*1, VTYPE*4,
     1 TYPE820*1, OTYPE*1, OTYPE820*1, CTYPE820*1, MESS820*80
      DATA ATYPE /
     1 'CIF Construction/Syntax Error, Inconsistent or Missing Data.',
     2 'Indicator that the Structure Model may be Wrong or Deficient.',
     3 'Indicator that the Structure Quality may be Low.',
     4 'Improvement, Methodology, Query or Suggestion.',
     5 'Informative Message, Check.'/
      DATA ALEVEL /
     1  'A = Most Likely a Serious Problem - Resolve or Explain',
     2  'B = A Potentially Serious Problem - Consider Carefully',
     3  'C = Check. Ensure it is Not caused by an Omission or Oversight'
     4 ,'G = General Info/Check that it is not Something Unexpected'/
      FORMC( 1:38)  = '(''# Cell'',F8.4,''('',I2,'')'',F8.4,''('',I2,'
      FORMC(39:74)  = ''')'',F8.4,''('',I2,'')'',F9.3,''('',I2,'')'','
      FORMC(75:106) = 'F9.3,''('',I2,'')'',F8.3,''('',I2,'')'')'
      FORMD(1:36)   = '(''# Wavelength'',F8.5,4X,''Volume'',1X,'
      FORMD(37:67)  = '''Reported'',F10.3,''('',I2,'')'',3X,'
      FORMD(68:97)  = '''Calculated'',F10.3,''('',I2,'')'')'
      FORM          = '(F8.5,''('',I2,'') '')'
      FPARSU        = '(F6.2,''('',I2,'')'')'
      FORMC(14:14)  = CHAR(ICHAR('0') + IPR(287))
      FORMC(30:30)  = CHAR(ICHAR('0') + IPR(288))
      FORMC(46:46)  = CHAR(ICHAR('0') + IPR(289))
      FORMC(62:62)  = CHAR(ICHAR('0') + IPR(290))
      FORMC(78:78)  = CHAR(ICHAR('0') + IPR(291))
      FORMC(94:94)  = CHAR(ICHAR('0') + IPR(292))
      FORMD(52:52)  = CHAR(ICHAR('0') + IPR(314))
      FORMD(85:85)  = CHAR(ICHAR('0') + IPR(294))
      FORMV(1:7) = '(F10.0)'
      TXT0 = '# w=1'
      TXT1 = '/[sigma**2(Fo**2)'
      TXT2 = ', P=(Fo**2+2*Fc**2)/3'
      TXT3 = ', P=Fo**2'
      TXT4 = '# w=exp['
      TXT5 = '*(sin(theta)/lambda)**2]'
      IF (MODE .EQ. 0) THEN
C * LAST MINUTE CHECKS/ALERTS
        CALL PLA232
C * INITIALIZE
        IGBL(6) = 10
        V1(1)  = - 1000.0
        NALERT = 0
        CALL GEN097 (NALV,   1, 5, 0)
        CALL GEN097 (IATYPE, 1, 5, 0)
        CALL GEN097 (ICOUNT, 1, 4, 0)
        CALL GEN097 (JCOUNT, 1, 4, 0)
        CALL GEN097 (KCOUNT, 1, 4, 0)
        CALL GEN108 (LU20, 1)
        IF (IGBL(36) .GT. 0) THEN
          LU = LU10
        ELSE
          LU = LU7
          PAGET = 'CHECKCIF'
          CALL PLA262 (0)
          CALL PLA262 (20)
        END IF
        IF (IGBL(132) .EQ. 1) THEN
          TTYPE = 'I'
          VTYPE = 'Chem'
        ELSE
          TTYPE = ' '
          VTYPE = 'Acta'
        END IF
        IF (IGBL(12) .GT. 0) THEN
          NALOLD = 0
          DO 50 NAL = 1, 4
            CALL GEN108 (LU12, 0)
   10       READ (LU12, 99962, IOSTAT = IOST) ICL(1:80)
            IF (IOST .NE. 0) GO TO 50
            IF (ICL(1:1) .EQ. CHAR(32)) GO TO 10
            IF (ICL(1:1) .NE. '$') THEN
              IF (ICL(1:1) .EQ. '#') THEN
                IF (ICL(3:5) .EQ. '>>>') THEN
                  READ (ICL(2:2), 99959) ISKP
                END IF
                GO TO 10
              END IF
              READ (ICL, 99967, IOSTAT = IOST)
     1              CHK, (V1(L), L = 2, 4), TYPE, CTYPE, OTYPE,
     2              (KCOUNT(L), L = 1, 4)
              IF (IOST .NE. 0) RETURN
              IF (NAL .EQ. 1) THEN
                IF (CHK .EQ. '_820') THEN
                  READ (ICL, 99967, IOSTAT = IOST)
     1              CHK, (V1820(L), L = 2, 4), TYPE820, CTYPE820,
     2              OTYPE820, (KCOUNT(L), L = 1, 4)
                IF (IOST .NE. 0) RETURN
                END IF
                DO L = 1, 4
                  JCOUNT(L) = JCOUNT(L) + KCOUNT(L)
                END DO
              END IF
              IF (CTYPE .EQ. TTYPE .OR.
     1           (OTYPE .EQ. 'O' .AND. IGBL(134) .EQ. 1)) THEN
                READ (LU12, 99962, IOSTAT = IOST) ICL(1:80)
                IF (IOST .NE. 0) GO TO 50
                GO TO 10
              END IF
              READ (TYPE, 99959) ITYPE
              READ (LU12, 99962, IOSTAT = IOST) MESS
              IF (IOST .NE. 0) GO TO 50
              IF (NAL .EQ. 1 .AND. CHK .EQ. '_820') THEN
                MESS820 = MESS
              END IF
              READ (ICL, 99970, IOSTAT = IOST) ICHK
              IF (IOST .NE. 0) RETURN
              IF (ISKP .EQ. 1 .AND. IABS(IGBL(8)) .NE. 3) GO TO 10
              IF (NAL .GT. 1 .AND. ICHK .LE. 1) GO TO 10
              IF (CHK .EQ. '_000') THEN
                READ (MESS, 99966) (WLEVEL(L), L = 1, 4)
                GO TO 10
              ELSE IF (CHK .EQ. '_001') THEN
                WRITE (MESS(17:22), 99951, IOSTAT = IOST) IGBL(4)
                WRITE (LU, 99950, IOSTAT = IOST)
                WRITE (LU, 99979, IOSTAT = IOST) MESS(1:61), JID(1:8)
                N = MAX (1, KNMFIL + KXT + 1)
                LINE(1:N) = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
                WRITE (PRBUF, 99982, IOSTAT = IOST)
     1            LINE(1:N), DTYPE(IABS(IGBL(8)))(1:3)//XLDTP
                WRITE (PRBUF(50:), 99976, IOSTAT = IOST)
     1            BNDTP(1), PAR(318)
                WRITE (LU, 99962, IOSTAT = IOST) PRBUF(1:80)
                WRITE (PRBUF, 99948, IOSTAT = IOST) MAX(0, IPR(310))
                IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                IF (IGBL(9) .GT. 0 .AND. IGBL(9) .LT. 26) THEN
                  WRITE (PRBUF(1:67), 99981, IOSTAT = IOST)
     1              FNLU16(1:KNM16), RDTYPE
                END IF
                WRITE (LU, 99962, IOSTAT = IOST) PRBUF(1:80)
                IF (IPR(493) .LT. 5) THEN
                  RADIATION = 'X-Ray'
                ELSE IF (IPR(493) .EQ. 5) THEN
                  RADIATION = 'Synchrotron'
                ELSE IF (IPR(493) .EQ. 6) THEN
                  RADIATION = 'Neutron'
                END IF
                IF (PAR(197) .GT. 0.0) THEN
                  YUNK = MIN(99.99, MAX (PAR(174), PAR(310))) / PAR(197)
                ELSE
                  YUNK = 0.0
                END IF
                WRITE (LU, 99960, IOSTAT = IOST)
     1            RADIATION, MAX(0.0, PAR(197)), YUNK, PAR(505)
                NALV(5) = NINT (10000.0 * PAR(318))
                WRITE (PRBUF, FORMC, IOSTAT = IOST)
     1            PAR(101), IPR(281), PAR(102), IPR(282), PAR(103),
     2            IPR(283), PAR(104), IPR(284), PAR(105), IPR(285),
     3            PAR(106), IPR(286)
                CALL GEN065 (LU, PRBUF, 80, 3)
                WRITE (PRBUF, FORMD, IOSTAT = IOST)
     1            MAX (PAR(17), 0.0), PAR(164), IPR(313), PAR(98),
     2            IPR(293)
                CALL GEN065 (LU, PRBUF, 80, 3)
                IF (SPGRNM(3)(1:1) .EQ. ' ') THEN
                  N0 = 2
                ELSE
                  N0 = 1
                END IF
                IF (IGBL(140) .EQ. 0) THEN
                  SPLC = SPGRNM(1)(15:25)
                ELSE
                  SPLC = '?'
                END IF
                CALL GEN020 (-1, SPLC, 2, 11)
                IF (SPLC(1:7) .EQ. 'R 3 c r') SPLC(1:7) = 'R 3 c R'
                WRITE (LU, 99980, IOSTAT = IOST)
     1            SPLC, SPGRNM(3)(N0:17), KRSYST(2),
     2            CCIF(6)(1:11), CCIF(16)(1:18-N0), KRSYST(1)
                CALL PLA283 (0, 1, N, CDUM)
                DO N1 = 1, 65
                  IF (RLWS(4)(N1:N1) .EQ. '''') EXIT
                END DO
                IF (N .LE. NP52 .AND. N1 .GT. 1)
     1            WRITE (LU, 99978, IOSTAT = IOST)
     2              CDUM(N:NP52), RLWS(4)(1 : N1 - 1)
                CALL PLA283 (2, IPR(260), N, CDUM)
                DO N1 = 1, 65
                  IF (RLWS(5)(N1:N1) .EQ. '''') EXIT
                END DO
                IF (N .LE. NP52 .AND. N1 .GT. 1)
     1            WRITE (LU, 99977, IOSTAT = IOST)
     2              CDUM(N : NP52), RLWS(5)(1 : N1 - 1)
                WRITE (LU, 99989, IOSTAT = IOST)
     1            PAR(163) / IPR(260), PAR(308)
                WRITE (LU, 99987, IOSTAT = IOST) PAR(160), PAR(267)
                WRITE (LU, 99988, IOSTAT = IOST) IPR(260), IPR(276)
                WRITE (LU, 99998, IOSTAT = IOST) PAR(162), PAR(301)
                WRITE (LU, 99975, IOSTAT = IOST)
     1            PAR(157), PAR(324), PAR(426)
                IF (PAR(306) .LT. 99998.0 .AND.
     1              PAR(307) .LT. 99998.0) THEN
                  IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                  N = INDEX (RLWS(3)(2:15), '''')
                  IF (N .GT. 1) THEN
                    N1 = 2
                    N2 = N
                  ELSE
                    N1 = 1
                    N2 = 2
                  END IF
                  IF (IPR(106) .EQ. 0) WRITE (LU, 99997, IOSTAT = IOST)
     1              PAR(307), PAR(306), RLWS(3)(N1:N2)
                END IF
                IF (PAR(315) .GT. 0.0 .AND. IGBL(94) .EQ. 0 .AND.
     1              IPR(105) .EQ. 0) THEN
                  IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                  IF (IPR(106) .EQ. 0) WRITE (LU, 99999, IOSTAT = IOST)
     1              PAR(315), PAR(316), PAR(317)
                END IF
                MH = MAX (0, -IPR(267), IPR(268))
                MK = MAX (0, -IPR(269), IPR(270))
                ML = MAX (0, -IPR(271), IPR(272))
                IF (IGBL(94) .EQ. 0 .AND. IPR(263) .GT. 0) THEN
                  IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                  WRITE (LU, 99986, IOSTAT = IOST) MH, MK, ML,
     1                   MAX (0, IPR(263)), MAX (0.0, PAR(168))
                END IF
                IF (IPR(559) .NE. 0) THEN
                  RATIO1 = FLOAT(MAX(0, IPR(263))) / IPR(559)
                ELSE
                  RATIO1 = 0.0
                END IF
                IF (IPR(559) + IPR(560) .NE. 0) THEN
                  RATIO2 = FLOAT(MAX(0, IPR(263))) / (IPR(559)
     1                   + IPR(560))
                ELSE
                  RATIO2 = 0.0
                END IF
                IF (IGBL(9) .GT. 0 .AND. IPR(373) .GT. 0) THEN
                  IF (IGBL(9) .LT. 26) THEN
                    IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                    WRITE (LU, 99968, IOSTAT = IOST)
     1                (MIN(999, IPR(584 + I)), I = 1, 3), IPR(373),
     2                IPR(377), PAR(446)
                  END IF
                END IF
                IF (IGBL(94) .EQ. 0 .AND. IPR(559) .GT. 0) THEN
                  IF (IPR(106) .EQ. 0) THEN
                    IF (IPR(257) .EQ. 1) THEN
                      IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                      WRITE (LU, 99985, IOSTAT = IOST) IPR(561),
     1                  IPR(562), IPR(563), IPR(559) + IPR(560),
     2                  IPR(559), RATIO1, RATIO2
                    ELSE
                      WRITE (LU, 99969, IOSTAT = IOST)
     1                  IPR(561), IPR(562), IPR(563), IPR(559), RATIO1
                    END IF
                  END IF
                END IF
                IF (PAR(437) .GT. 0.0) THEN
                  IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                  IF (IABS(IPR(651)) .EQ. 1) THEN
                    PRBUF = '# PLATON/Squeeze:    '
                  ELSE IF (IPR(651) .EQ. 2) THEN
                    PRBUF = '# OLEX2/_smtbx_masks:'
                  ENDIF
                  WRITE (LU, 99957, IOSTAT = IOST)
     1              PRBUF(1:21), PAR(437), PAR(438)
                END IF
                IF (ABS(PAR(173)) .LT. 100.0) THEN
                  IF (IPR(309) .EQ. 2) THEN
                    WR  = ' wR2='
                    WGR = MIN(99.99, PAR(174))
                  ELSE
                    WR  = '  wR='
                    WGR = MIN(99.99, MAX (PAR(174), PAR(310)))
                  END IF
                  FPARSU(5:5) = CHAR(ICHAR('0') + IPR(280))
                  WRITE (PRBUF, FPARSU, IOSTAT = IOST)
     1              PAR(433), IPR(279)
                  CALL GEN065 (0, PRBUF, 10, 1)
                  WRITE (IDM, 99984, IOSTAT = IOST) PAR(173),
     1              MAX (0, IPR(264)), WR, WGR, MAX (0, IPR(265)),
     2              MIN (99.99, PAR(299)), IPR(266), PRBUF(1:10)
                  IF (IGBL(94) .EQ. 0) THEN
                    IF (IGBL(36) .LE. 0) CALL PLA262 (2)
                  WRITE (LU, 99958, IOSTAT = IOST)
     1                   MIN (0.0, PAR(176)), MAX (0.0, PAR(177))
                  IF (IGBL(9) .GT. 0 .AND. IGBL(9) .LT. 26) THEN
                    IF (PAR(330) .GT. 0.0) THEN
                      IF (IPR(619) .EQ. 0
     1                  .AND. IPR(651) .EQ. 0) THEN
                        CALL PLA262 (1)
                        WRITE (LU, 99946, IOSTAT = IOST)
     1                    PAR(329), PAR(330)
                      END IF
                    END IF
                  END IF
                  IF (IPR(632) .GT. 0) THEN
                    IF (IABS(IPR(632)) .EQ. 1 .OR. IPR(632) .EQ. 3) THEN
                      IF (PAR(500) .EQ. 1.0) TXT2 = TXT3
                      IF (PAR(497) .GT. 0.0) THEN
                        IF (PAR(498) .NE. 0.0) THEN
                          IF (PAR(499) .GT. 0.0) THEN
                            WRITE (LU, 99934, IOSTAT = IOST)
     1                        TXT4, PAR(499), TXT5, TXT1, PAR(497),
     2                        PAR(498)
                          ELSE
                            WRITE (LU, 99944, IOSTAT = IOST)
     1                        TXT0, TXT1, PAR(497), PAR(498), TXT2
                          END IF
                        ELSE
                          IF (PAR(499) .GT. 0.0) THEN
                            WRITE (LU, 99933, IOSTAT = IOST)
     1                        TXT4, PAR(499), TXT5, TXT1, PAR(497),
     2                        TXT2
                          ELSE
                            WRITE (LU, 99942, IOSTAT = IOST)
     1                        TXT0, TXT1, PAR(497), TXT2
                          END IF
                        END IF
                      ELSE IF (PAR(497) .EQ. 0.0) THEN
                        IF (PAR(498) .GT. 0.0) THEN
                          WRITE (LU, 99941, IOSTAT = IOST)
     1                      TXT0, TXT1, PAR(498), TXT2
                        ELSE
                          WRITE (LU, 99940, IOSTAT = IOST)
     1                      TXT0, TXT1, TXT2
                        END IF
                      END IF
                    ELSE IF (IPR(632) .EQ. 2) THEN
                      WRITE (LU, 99939, IOSTAT = IOST) PAR(497)
                    ENDIF
                    IF (PAR(477) .NE. 0.0) THEN
                      IF (IPR(619) .EQ. 0  .AND.
     1                  (IGBL(133) .GT. 0 .OR. IGBL(9) .EQ. 1)) THEN
                        IF (IPR(632) .NE. 2 .OR. PAR(229) .LE. 0.0)
     1                    THEN
                          CALL PLA262 (1)
                          IF (IPR(651) .EQ. 0) THEN
                            WRITE (LU, 99945, IOSTAT = IOST)
     1                       PAR(480), IPR(625), MIN(99.9999, PAR(481)),
     2                         IPR(626), MIN (99.999, PAR(482)),
     3                         '(From CIF+FCF data)'
                          END IF
                          IF (IGBL(129) .NE. 0 .AND. IPR(651) .EQ. 0)
     1                      THEN
                            WRITE(LU13, 99950, IOSTAT = IOST)
                            WRITE (LU13, 99945, IOSTAT = IOST)
     1                       PAR(480), IPR(625), MIN(99.9999, PAR(481)),
     2                       IPR(626), MIN (99.999, PAR(482)),
     3                       '(From CIF+FCF data)'
                          END IF
                        END IF
                      END IF
                      CALL PLA262 (1)
                      WRITE (LU, 99945, IOSTAT = IOST)
     1                  PAR(477), IPR(623),
     2                   MIN(99.9999, PAR(478)), IPR(624),
     3                   MIN (99.999, PAR(479)), '(From FCF data only)'
                      IF (IGBL(129) .NE. 0)
     1                  WRITE (LU13, 99945, IOSTAT = IOST)
     2                  PAR(477), IPR(623), MIN(99.9999, PAR(478)),
     3                  IPR(624), MIN (99.999, PAR(479)),
     4                  '(From FCF data only)'
                    END IF
                  END IF
                  IF (PAR(433) .LT. 999999) THEN
                    WRITE (LU, 99962, IOSTAT = IOST) IDM(1:80)
                    IF (IGBL(129) .NE. 0)
     1                WRITE (LU13, 99962, IOSTAT = IOST) IDM(1:80)
                  ELSE
                    WRITE (LU, 99962, IOSTAT = IOST) IDM(1:63)
                    IF (IGBL(129) .NE. 0)
     1                  WRITE (LU13, 99962, IOSTAT = IOST) IDM(1:63)
                    END IF
                  END IF
                END IF
                IF (PAR(503) .LT. 999999.0) THEN
                  FPARSU(5:5) = CHAR(ICHAR('0') + IPR(670))
                  WRITE (PRBUF, FPARSU, IOSTAT = IOST)
     1              PAR(503), IPR(669)
                  CALL GEN065 (0, PRBUF, 10, 1)
                  IF (IPR(619) .EQ. 0 .AND. PAR(464) .GT. PAR(476)) THEN
                    WRITE (LINE, 99936, IOSTAT = IOST)
     1                IPR(668), NINT(PAR(464)), IPR(667),  PRBUF(1:10)
                    WRITE (LU, 99962, IOSTAT = IOST) LINE(1:80)
                    IF (IGBL(129) .NE. 0)
     1                WRITE (LU13, 99962, IOSTAT = IOST) LINE(1:80)
                  END IF
                END IF
                IF (PAR(435) .LT. 999999.0) THEN
                  FPARSU(5:5) = CHAR(ICHAR('0') + IPR(616))
                  WRITE (PRBUF, FPARSU, IOSTAT = IOST)
     1              PAR(435), IPR(615)
                  CALL GEN065 (0, PRBUF, 10, 1)
                  IF (IPR(619) .EQ. 0 .AND. PAR(464) .GT. PAR(476)) THEN
                    WRITE (LINE, 99947, IOSTAT = IOST)
     1                PAR(506), PAR(507), PAR(508), NINT(PAR(487)),
     2                PRBUF(1:10)
                    IF (PAR(506) .LT. 0.0 .OR. PAR(507) .LT. 0.001)
     1                CALL GEN038 (LINE, 2, 15)
                    IF (PAR(507) .LT. 0.0) CALL GEN038 (LINE, 16, 28)
                    WRITE (LU, 99962, IOSTAT = IOST) LINE(1:80)
                    IF (IGBL(129) .NE. 0) THEN
                      WRITE (LU13, 99962, IOSTAT = IOST) LINE(1:80)
                      WRITE (LU13, 99950, IOSTAT = IOST)
                    END IF
                  END IF
                END IF
                WRITE (LU, 99996, IOSTAT = IOST) HTTPSERVER(1:IGBL(135))
              ELSE
C * TEST FOR (IN)COMMENSURATE STRUCTURE CIF
                IF (IGBL(140) .EQ. 1) THEN
                  IF (CHK .NE. '_814') GO TO 10
                END IF
                IF (IPR(106) .EQ. 1) THEN
                  SELECT CASE (CHK)
                    CASE ('_029', '_050', '_091', '_195', '_196')
                      GO TO 10
                    CASE ('_910', '_911', '_920', '_921')
                      GO TO 10
                    CASE ('_940')
                      GO TO 10
                    CASE ('_950', '_951', '_952')
                      GO TO 10
                    CASE ('_971', '_972', '_975', '_976')
                      GO TO 10
                  END SELECT
                END IF
                CALL GEN108 (LU20, 0)
                GO TO 30
   20           IF (NAL .EQ. 4) THEN
                  WRITE (*, 99938, IOSTAT = IOST) ICL(1:77)
C * PSEUDO ALERT _820
                  CHK = ICL(1:4)
                  WRITE (ICL, 99937, IOSTAT = IOST) CHK
                  CHK   = '_820'
                  MESS  = MESS820(1:60)
                  TYPE  = TYPE820
                  CTYPE = CTYPE820
                  OTYPE = OTYPE820
                  DO K = 2, 4
                    V1(K) = V1820(K)
                  END DO
                  MESS = MESS820(1:65)
                  GOTO 40
                END IF
   30           READ (LU20, 99962, END = 10, ERR = 20) ICL(1:80)
   40           IF (ICL(1:4) .EQ. CHK) THEN
                  IF (ICL(15:15) .EQ. '*' .OR.
     1                ICL(25:25) .EQ. '*') GO TO 30
                  IF (CHK .EQ. '_790') THEN
                    IF (IPR(322) .NE. 0) GO TO 30
                  ELSE IF (CHK .EQ. '_940') THEN
                    IF (PAR(313) .GT. 0.989 .OR. PAR(314) .GT. 0.989
     1                .OR. INDEX (CCIF(1), 'i>-') .NE. 0) GO TO 30
                  ELSE IF (CHK .EQ. '_795' .OR. CHK .EQ. '_796' .OR.
     1                     CHK .EQ. '_797') THEN
                    IF (IPR(75) .GT. 1) GO TO 30
                  END IF
                  READ (ICL(5:42), 99949, IOSTAT = IOST)
     1                  NDECX, VALUE, VALUE1, NQ1, NQ2, CNT
                  IF (IOST .NE. 0) GO TO 20
                  IF (CHK .EQ. '_794') THEN
                    CALL GEN121 (NQ1)
                  ELSE IF (CHK .NE. '_126' .AND. CHK .NE. '_127') THEN
                    CALL GEN121 (NQ1)
                    CALL GEN121 (NQ2)
                  END IF
                  NB  = 1
                  NE  = 7
                  NQ4 = ' '
                  CALL GEN039 (1, NQ1, 1, 7, NB, NE)
                  NQ4 (8 - NE : 7) = NQ1(1 : NE)
                  IF (CNT .EQ. ' =')
     1              READ (LU20, 99962, IOSTAT = IOST) ICL(1:80)
                    IF (IOST .NE. 0) GO TO 20
                  DO I = 1, NAL
                    IF (VALUE .GT. V1(5 - I))  THEN
                      IF (I .LT. NAL) GO TO 30
                      IF (I .EQ. 4 .AND. VALUE .GT. -998.0) GO TO 30
                      N = 5 - I
                      IF (NALOLD .NE. NAL) THEN
                        IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                        WRITE (LU, 99950, IOSTAT = IOST)
                      NALOLD = NAL
                      END IF
                      NALV(I) = NALV(I) + 1
                      IF (ITYPE .GT. 0 .AND. ITYPE .LT. 6)
     1                  IATYPE(ITYPE) = IATYPE(ITYPE) + 1
                      IDM(1:14) =
     1                  CHK(2:4)//'_ALERT_'//TYPE//'_'//WLEVEL(N)(7:8)
                      IVAR = 0
                      L    = 14
                      DO K = 1, 65
                        ICH = MESS(K:K)
                        IF (IVAR .EQ. 0) THEN
                          IF (ICH .EQ. '$') THEN
                            IVAR = 1
                          ELSE
                            IF (L .LT. 80) THEN
                              L = L + 1
                              IDM(L:L) = ICH
                            END IF
                          END IF
                        ELSE
                          IF (ICH .EQ. 'A') THEN
                            IF (L .GT. 52 .AND. NQ2 .EQ. '       ' .OR.
     1                          NQ2(7:7) .EQ. 'A') THEN
                              IDM(L + 1:L + 7) = NQ4
                            ELSE
                              IDM(L + 1:L + 7) = NQ1
                            END IF
                            L = L + 7
                          ELSE IF (ICH .EQ. 'B') THEN
                            DO L0 = 1, 7
                              IF (L .LT. 80) THEN
                                L = L + 1
                                IDM(L:L) = NQ2(L0:L0)
                              END IF
                            END DO
                          ELSE IF (ICH .EQ. 'I') THEN
                            WRITE (IDM(L+1:L+10), 99964, IOSTAT = IOST)
     1                        NINT(VALUE1)
                            L = L + 10
                          ELSE IF (ICH .EQ. 'F') THEN
                            FORMV(6:6) = CHAR(ICHAR('0') + NDECX)
                            WRITE (IDM(L+1:L+10), FORMV, IOSTAT = IOST)
     1                        VALUE1
                            L = L + 10
                          ELSE IF (ICH .EQ. 'X' .OR. ICH .EQ. 'Y') THEN
                            IF (CHK .EQ. '_701' .OR. CHK .EQ. '_704'
     1                        .OR.  CHK .EQ. '_705' .OR. CHK .EQ. '_706'
     2                        .OR.  CHK .EQ. '_707' .OR. CHK .EQ. '_721'
     3                        .OR.  CHK .EQ. '_724' .OR. CHK .EQ. '_725'
     4                        .OR.  CHK .EQ. '_726' .OR. CHK .EQ. '_727'
     5                        .OR.  CHK .EQ. '_731' .OR. CHK .EQ. '_734'
     6                        .OR.  CHK .EQ. '_735' .OR. CHK .EQ. '_736'
     7                        .OR.  CHK .EQ. '_737' .OR. CHK .EQ. '_741'
     8                        .OR.  CHK .EQ. '_744' .OR. CHK .EQ. '_745'
     9                        .OR.  CHK .EQ. '_746' .OR. CHK .EQ. '_747'
     *                        .OR.  CHK .EQ. '_751' .OR. CHK .EQ. '_754'
     1                        .OR.  CHK .EQ. '_755' .OR. CHK .EQ. '_756'
     2                        .OR.  CHK .EQ. '_757') THEN
                              NDECM = 5
                            ELSE IF
     1                        (CHK .EQ. '_702' .OR. CHK .EQ. '_708'
     2                        .OR.  CHK .EQ. '_722' .OR. CHK .EQ. '_728'
     3                        .OR.  CHK .EQ. '_732' .OR. CHK .EQ. '_738'
     4                        .OR.  CHK .EQ. '_742' .OR. CHK .EQ. '_748'
     5                        .OR.  CHK .EQ. '_752' .OR. CHK .EQ. '_758'
     6                        ) THEN
                              NDECM = 2
                            ELSE IF
     1                        (CHK .EQ. '_703' .OR. CHK .EQ. '_723'
     1                        .OR.  CHK .EQ. '_733' .OR. CHK .EQ. '_743'
     2                        .OR.  CHK .EQ. '_753')  THEN
                              NDECM = 2
                            END IF
                            IF (ICH .EQ. 'Y') THEN
                              READ (ICL, 99965, IOSTAT = IOST) A1, SA1
                              IF (IOST .NE. 0) GO TO 20
                              CALL GEN038 (ICL, 1, 14)
                            ELSE
                              READ (NQ1, 99965, IOSTAT = IOST) A1
                              IF (IOST .NE. 0) GO TO 20
                              READ (NQ2, 99965, IOSTAT = IOST) SA1
                              IF (IOST .NE. 0) GO TO 20
                            END IF
                            CALL GEN041 (A1, SA1, ISA1, NDECM, NDEC, 2)
                            FORM(5:5) = CHAR(ICHAR('0') + NDEC)
                            WRITE (PRBUF, FORM, IOSTAT = IOST) A1, ISA1
                            CALL GEN065 (0, PRBUF, 13, 1)
                            IDM(L+1:L+12) = PRBUF(1:12)
                            L = L + 12
                          END IF
                          IVAR = 0
                        END IF
                      END DO
                      NALERT = NALERT + 1
                      IF (NALERT .EQ. 1) THEN
                        IF (IGBL(36) .LE. 0) CALL PLA262 (3)
                        WRITE (LU, 99992, IOSTAT = IOST) VTYPE
                        IF (IGBL(36) .LE. 0) CALL PLA262 (2)
                        WRITE (LU, 99943, IOSTAT = IOST)
                      END IF
                      READ (CHK, 99970, IOSTAT = IOST) IDOC
                      IF (IOST .NE. 0) GO TO 20
                      NDOC(IDOC) = 1
                      DO J = 1, 4
                        ICOUNT(J) = ICOUNT(J) + KCOUNT(J)
                      END DO
                      IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                      L = MIN (L, 80)
                      WRITE (LU, 99962, IOSTAT = IOST) IDM(1:L)
                      IF (CNT .EQ. ' =') THEN
                        IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                        WRITE (LU, 99962, IOSTAT = IOST) ICL(1:80)
                      END IF
                      GO TO 30
                    END IF
                  END DO
                END IF
                GO TO 30
              END IF
              GO TO 10
            END IF
   50     CONTINUE
          IF (IGBL(36) .LE. 0) CALL PLA262 (1)
          WRITE (LU, 99950, IOSTAT = IOST)
          IF (NALV(1) + NALV(2) + NALV(3) .EQ. 0) THEN
            IF (IGBL(140) .EQ. 0) WRITE (LU, 99995, IOSTAT = IOST)
          ELSE
            IF (IGBL(36) .LE. 0) CALL PLA262 (5)
            WRITE (LU, 99994, IOSTAT = IOST)
            DO I = 1, 4
              IF (NALV(I) .GT. 0) THEN
                IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                WRITE (LU, 99993, IOSTAT = IOST) NALV(I), ALEVEL(I)
              END IF
            END DO
            WRITE (LU, 99961, IOSTAT = IOST)
            DO I = 1, 5
              IF (IATYPE(I) .GT. 0) THEN
                IF (IGBL(36) .LE. 0) CALL PLA262 (1)
                WRITE (LU, 99971, IOSTAT = IOST) IATYPE(I), I, ATYPE(I)
              END IF
            END DO
            DO I = 1, 4
              KCOUNT(I) =
     1          NINT(100.0 * (JCOUNT(I) - ICOUNT(I)) / JCOUNT(I))
            END DO
            WRITE (LU, 99950, IOSTAT = IOST)
            WRITE (LU, 99935, IOSTAT = IOST)
     1        (ICOUNT(I), JCOUNT(I), KCOUNT(I), I = 1, 4)
          END IF
          IF (IGBL(36) .LE. 0) CALL PLA262 (1)
          WRITE (LU, 99950, IOSTAT = IOST)
          IF (LU .EQ. LU10) THEN
            IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
              WRITE (BCD, 99983, IOSTAT = IOST)
     1          JID(1:9), (NALV(I), I = 1, 3), CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 80.0, 112)
              CALL GGIP (0.0, 0.0, 0.0, 6)
            END IF
            IGBL(53) = IGBL(53) + 1
            IF (IGBL(53) .LT. 11) THEN
              BNDTP(IGBL(53)) = BNDTP(1)
              DO KK = 1, 5
                NALV(IGBL(53) * 5 + KK) = NALV(KK)
              END DO
            END IF
          END IF
        END IF
      ELSE IF (MODE .EQ. 1) THEN
C * ALERT SUMMARY FOR TEXT WINDOW
        NAENTRY = MIN (10, IGBL(53))
        DO J = 1, NAENTRY
          WRITE (LU6, 99972, IOSTAT = IOST)
     1      J, (NALV(J * 5 + I), I = 1, 4),
     2      BNDTP(J), NALV(J * 5 + 5) / 10000.0
        END DO
        IF (IGBL(53) .GT. 10) WRITE (LU6, 99956, IOSTAT = IOST) IGBL(53)
C * VALIDATION-DOC (COMMENT/HINTS) (IGBL(83) .EQ. 1)
        IF (IGBL(83) .NE. 0) THEN
          REWIND LU12
          NEXP = 0
          DO 60 I = 2, 999
            IF (NDOC(I) .GT. 0) THEN
              NEXP = NEXP + 1
              IF (NEXP .EQ. 1) WRITE (LU10, 99974, IOSTAT = IOST)
              IF (I .LT. 10) THEN
                WRITE (CHK, 99955, IOSTAT = IOST) I
              ELSE IF (I .LT. 100) THEN
                WRITE (CHK, 99954, IOSTAT = IOST) I
              ELSE
                WRITE (CHK, 99953, IOSTAT = IOST) I
              END IF
              DO
                READ (LU12, 99962, IOSTAT = IOST) ICL(1:80)
                IF (IOST .NE. 0) GO TO 70
                IF (ICL(1:4) .EQ. CHK) THEN
                  READ (ICL(20:21), 99952) IVALTYPE
                  READ (LU12, 99962) ICL(1:80)
                  READ (LU12, 99962) ICL(1:80)
                  IF (ICL(1:1) .EQ. '#') GO TO 60
                  IF (ICL(1:2) .EQ. '  ') THEN
                    WRITE (LU10, 99973, IOSTAT = IOST)
     1                CHK, IVALTYPE, ATYPE(IVALTYPE)
                    DO
                      READ (LU12, 99962, IOSTAT = IOST) ICL(1:80)
                      IF (IOST .NE. 0) GO TO 70
                      IF (ICL(1:1) .EQ. '#') GO TO 60
                      WRITE (LU10, 99962, IOSTAT = IOST) ICL(1:80)
                    END DO
                  END IF
                END IF
              END DO
            END IF
   60     CONTINUE
        END IF
        RETURN
      END IF
   70 CALL GEN108 (LU20, 0)
      RETURN
99999 FORMAT ('# Calculated T Limits: Tmin=', F5.3,
     1       ' Tmin''=', F5.3, '  Tmax=', F5.3)
99998 FORMAT ('# Mu (mm-1) =', F10.3, '[Calc],', F10.3, '[Rep]')
99997 FORMAT ('# Reported   T Limits: Tmin=', F5.3,
     1       14X, 'Tmax=', F5.3, 2X, 'AbsCorr=', A)
99996 FORMAT ('#', 79('='), /, 'For Documentation:',
     1 ' http://', A, 'CIF-VALIDATION.pdf')
99995 FORMAT (/, '#', 79('='), /, '!! Congratulations !! :', 1X,
     1           'No (A,B,C) ALERT Conditions were Detected')
99994 FORMAT (/, 15X, 'ALERT_Level and ALERT_Type Summary', /,
     1        15X, 34('='))
99993 FORMAT (I3, ' ALERT_Level_', A)
99992 FORMAT (/, '#', 79('='), /, '>>> ',
     1 'The Following Improvement and Query ALERTS were generated ',
     2 '- (', A, '-Mode) <<<', /, '#', 79('='))
99989 FORMAT ('# Mr        =', F10.2, '[Calc],', F10.2, '[Rep]')
99988 FORMAT ('# Z         =', I10  , '[Calc],', I10,   '[Rep]')
99987 FORMAT ('# Dx,gcm-3  =', F10.3, '[Calc],', F10.3, '[Rep]')
99986 FORMAT ('# Reported   Hmax=', I3, ', Kmax=', I3, ', Lmax=', I3,
     1        ', Nref=', I7, 8X, ', Th(max)=', F7.3)
99985 FORMAT ('# Calculated Hmax=', I3, ', Kmax=', I3, ', Lmax=', I3,
     1        ', Nref=', I7, '[', I6, '], Ratio=', F4.2, '/', F4.2)
99984 FORMAT ('# R=', F7.4, '(', I6, '),', A, F7.4, '(', I6, '), S =',
     1        F6.3, ', Npar=', I5, ', Flack', A)
99983 FORMAT ('Entry ', A, ' - ', I3, 'A,', I3, 'B,',
     1        I3, 'C-Alerts', A)
99982 FORMAT ('# Data: ', A, ' - Type: ', A)
99981 FORMAT ('# Refl: ', A, ' - Type: ', A)
99980 FORMAT ('# SpaceGroup from Symmetry ', A, 'Hall: ', A, 3X, A,
     1     /, '#                 Reported ', A, 6X, A, 3X, A)
99979 FORMAT (A, 'for Entry: ', A)
99978 FORMAT ('# MoietyFormula ', A, /, '#      Reported ', A)
99977 FORMAT ('#    SumFormula ', A, /, '#      Reported ', A)
99976 FORMAT ('Bond Precision ', A, ' =', F7.4, ' A')
99975 FORMAT ('# F000      =', F10.1, '[Calc],', F10.1, '[Rep]',
     1        '  or F000'' =', F10.2, '[Calc]')
99974 FORMAT (/, 'Explanation and Advice for the Reported ALERTS',
     1        /, 80('='), /)
99973 FORMAT (80('='), /, 'ALERT', A, ' Type_', I1, 1X, A, /,
     1        80('='), /)
99972 FORMAT (19X, 'Entry #', I3, ' - ', I3, 'A,', I3, 'B,',
     1        I3, 'C,', I3, 'G-Alerts, BP ', A, ' =', F7.4)
99971 FORMAT (I3, 1X, 'ALERT_Type_', I1, 1X, A)
99970 FORMAT (1X, I3)
99969 FORMAT ('# Calculated Hmax=', I3, ', Kmax=', I3, ', Lmax=', I3,
     1        ', Nref=', I7, 8X, ', Ratio  =', F7.3)
99968 FORMAT ('# Obs in FCF Hmax=', I3, ', Kmax=', I3, ', Lmax=', I3,
     1        ', Nref=', I7, '[', I6, '], Th(max)=', F7.3)
99967 FORMAT (A, 3F5.0, 3(1X, A), 4I2)
99966 FORMAT (4A)
99965 FORMAT (2F7.0)
99964 FORMAT (I10)
99962 FORMAT (A)
99961 FORMAT (1X)
99960 FORMAT ('# ', A,  13X, 'R(int) =', F6.3 , ',', 2X, 'wR2/R(int) =',
     1        F5.1, ',', 2X, 'Nref/Npar =', F6.1)
99959 FORMAT (I1)
99958 FORMAT ('# Reported   Rho(min) =', F6.2, ', Rho(max) =', F6.2,
     1        ' e/Ang**3 (From CIF)')
99957 FORMAT (A, F8.1, ' Ang**3, Total El.Count =', F8.1, ' e-')
99956 FORMAT (/, 24X, 'etc..    (', I5, ' Entries Total)')
99955 FORMAT ('_00', I1)
99954 FORMAT ('_0' , I2)
99953 FORMAT ('_'  , I3)
99952 FORMAT (I2)
99951 FORMAT (I6)
99950 FORMAT ('#', 79('='))
99949 FORMAT (I2, 2F10.0, 3A)
99948 FORMAT ('#', 67X, 'Temp =', I4, ' K')
99947 FORMAT ('# P2(tr)', F6.3, ', P3(tr)', F6.3, ', P3(tw)', F6.3,
     1 ', Student-T Nu = ', I3, ',  Hooft', A)
99946 FORMAT ('# Calculated Rho(min) =', F6.2, ', Rho(max) =', F6.2,
     1        ' e/Ang**3 (From CIF+FCF data)')
99945 FORMAT ('# R=', F7.4, '(', I6, '), wR2=', F7.4, '(', I6, '), S =',
     1        F6.3, 6X, A)
99944 FORMAT (2A, '+(', F6.4, 'P)**2+', F8.4,'P]', A)
99943 FORMAT (5X, 'Format: alert-number_ALERT_alert-type_alert-level',
     4        ' text', /)
99942 FORMAT (2A, '+(', F6.4, 'P)**2]', A)
99941 FORMAT (2A, '+', F9.4,'P]', A)
99940 FORMAT (3A)
99939 FORMAT ('# w=1/(sigma**2(I)+', F7.4, 'I**2) - (JANA)')
99938 FORMAT (':: Read Problem in PLA230', /, ':: ' ,A, /)
99937 FORMAT ('_820 2    -999.0       1.0', A)
99936 FORMAT ('# Number Bijvoet Pairs =', I5, ' (', I3, '%),', 5X,
     1 I5, ' Selected for:  Parsons', A)
99935 FORMAT (/, I4, 1X, 'Missing  Experimental  Info Issue(s)',
     1        1X, '(Out of', I4, 1X, 'Tests) -', I5, ' % Satisfied',
     2        /, I4, 1X, 'Experimental  Data  Related Issue(s)',
     3        1X, '(Out of', I4, 1X, 'Tests) -', I5, ' % Satisfied',
     4        /, I4, 1X, 'Structural  Model   Related Issue(s)',
     5        1X, '(Out of', I4, 1X, 'Tests) -', I5, ' % Satisfied',
     6        /, I4, 1X, 'Unresolved or to be Checked Issue(s)',
     7        1X, '(Out of', I4, 1X, 'Tests) -', I5, ' % Satisfied', /)
99934 FORMAT (A, F6.4, 2A, '+(', F6.4, 'P)**2+', F8.4,'P]')
99933 FORMAT (A, F6.4, 2A, '+(', F6.4, 'P)**2]', A)
      END SUBROUTINE PLA230
      SUBROUTINE PLA231 (NR, NDEC, VAL1, VAL2, STR1, STR2)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER FORM*23, STR1*(*), STR2*(*), STRA*7, STRB*7, CNT*2
      IF (IGBL(10) .EQ. 0) THEN
        OPEN (UNIT = LU10, FILE = NAMEFIL(1:KNMFIL)//'.chk',
     1        STATUS = 'UNKNOWN')
        IGBL(10) = 1
      END IF
      FORM = '(''_'',I3.3,I2,2F10.2,3A)'
      NUM  = NR
      IF (NUM .EQ. 0) THEN
        WRITE (LU20, 99999, IOSTAT = IOST) STR1
      ELSE
        STRA = STR1
        STRB = STR2
        IF (NUM .GT. 0) THEN
          CNT = '  '
        ELSE
          NUM  = IABS (NUM)
          CNT = ' ='
        END IF
        IF (NDEC .GT. 0) THEN
          FORM (14:19) = '2F10.'//CHAR(ICHAR('0') + NDEC)
          WRITE (LU20, FORM, IOSTAT = IOST)
     1      NUM, NDEC, VAL1,  VAL2, STRA, STRB, CNT
        ELSE
          IVAL1 = NINT (VAL1)
          IVAL2 = NINT (VAL2)
          FORM (14:19) = '2I10 '
          WRITE (LU20, FORM, IOSTAT = IOST)
     1      NUM, NDEC, IVAL1, IVAL2, STRA, STRB, CNT
        END IF
      END IF
      RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA231
      SUBROUTINE PLA232
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER ICH*1, JCH*1
      DIMENSION TABT(7, 5)
      DATA ((TABT(I, J), I = 1, 7), J = 1, 5)/
     1   1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
     2   1.0, 1.01, 1.04, 1.09, 1.15, 1.25, 1.4,
     3   1.0, 1.05, 1.15, 1.25, 1.5,  1.9,  2.5,
     4   1.0, 1.05, 1.15, 1.25, 1.5,  1.9,  2.5,
     5   1.0, 1.05, 1.15, 1.25, 1.5,  1.9,  2.5/
C * ADD LAST MINUTE ALERTS
      CALL PLA231 (0, 0, 0.0, 0.0, 'data'//DATANM, ' ')
      IF (IPR(193) .LT. 2 .AND. IPR(663) .NE. 0) THEN
        IF (PAR(433) .GT. 2.0 * PAR(434)) THEN
          IF (PAR(513) .GT. 0.3 .OR. PAR(514) .GT. 0.3) THEN
            CALL PLA231 (987, 0, 1.0, 1.0, ' ', ' ')
          END IF
        END IF
      END IF
C * ALERT _040
      IF (IPR(484) .EQ. 0 .AND. IPR(483) .GT. 0) THEN
        CALL PLA231 (40, 0, -999.0, 1.0, ' ', ' ')
      END IF
C * ALERT _002 DISTANCE/ANGLE RESTRAINTS ON ATOM SITE
      IF (IPR(643) .GT. 0)
     1  CALL PLA231 (2, 0, -999.0, FLOAT(IPR(643)), ' ', ' ')
C * ALERT _003 UISO/UIJ RESTRAINTS FOR ATOM SITE
      IF (IPR(644) .GT. 0)
     1  CALL PLA231 (3, 0, -999.0, FLOAT(IPR(644)), ' ', ' ')
C * ALERT _780 - CHECK FOR NON-CONNECTED SET (IPR(124) .NE. 0)
      IF (IPR(124) .NE. 0 .AND. IGBL(97) .EQ. 1) THEN
        IF (IPR(124) .GT. 0) THEN
          CALL PLA231 (780, 0, 1.0, 1.0, ' ', ' ')
        ELSE
          CALL PLA231 (780, 0, -999.0, 1.0, ' ', ' ')
        END IF
      END IF
C * ALERT _171 - REPORT ON EADP RECORD(S)
      IF (IPR(685) .GT. 0)
     1  CALL PLA231 (171, 0, -999.0, FLOAT(IPR(685)), ' ', ' ')
C * ALERT _172 - REPORT ON DFIX RECORDS
      IF (IPR(686) .GT. 0)
     1  CALL PLA231 (172, 0, -999.0, FLOAT(IPR(686)), ' ', ' ')
C * ALERT _173 - REPORT ON DANG RECORD(S)
      IF (IPR(687) .GT. 0)
     1  CALL PLA231 (173, 0, -999.0, FLOAT(IPR(687)), ' ', ' ')
C * ALERT _174 - REPORT ON FLAT RECORD(S)
      IF (IPR(688) .GT. 0)
     1  CALL PLA231 (174, 0, -999.0, FLOAT(IPR(688)), ' ', ' ')
C * ALERT _175 - REPORT ON SAME RECORD(S)
      IF (IPR(689) .GT. 0)
     1  CALL PLA231 (175, 0, -999.0, FLOAT(IPR(689)), ' ', ' ')
C * ALERT _176 - REPORT ON SADI RECORD(S)
      IF (IPR(690) .GT. 0)
     1  CALL PLA231 (176, 0, -999.0, FLOAT(IPR(690)), ' ', ' ')
C * ALERT _177 - REPORT ON DELU RECORD(S)
      IF (IPR(691) .GT. 0)
     1  CALL PLA231 (177, 0, -999.0, FLOAT(IPR(691)), ' ', ' ')
C * ALERT _178 - REPORT ON SIMU RECORD(S)
      IF (IPR(692) .GT. 0)
     1  CALL PLA231 (178, 0, -999.0, FLOAT(IPR(692)), ' ', ' ')
C * ALERT _179 - REPORT ON CHIV RECORD(S)
      IF (IPR(693) .GT. 0)
     1  CALL PLA231 (179, 0, -999.0, FLOAT(IPR(693)), ' ', ' ')
C * ALERT _937 - REPORT EXP TERM IN SHELXL WEIGHT EXPRESSION
      IF (PAR(499) .NE. 0.0)
     1  CALL PLA231 (937, 3, ABS(PAR(499)), PAR(499), ' ', ' ')
C * ALERT _169 - REPORT ON AFIX 1 RECORD(S)
      IF (IPR(694) .GT. 0)
     1  CALL PLA231 (169, 0, -999.0, FLOAT(IPR(694)), ' ', ' ')
C * ALERT _789 - REPORT THE NUMBER OF ATOMS with A NEGATIVE VALUE
C *              OF _atom_site_disorder_group
      IF (IPR(695) .GT. 0)
     1  CALL PLA231 (789, 0, -999.0, FLOAT(IPR(695)), ' ', ' ')
C * GENERAL CHECK FOR MISSING OR UNUSUAL CIF DATA
      IF (IGBL(94) .EQ. 0) THEN
        IF (IPR(105) .EQ. 0 .AND. IPR(672) .EQ. 0) THEN
C * ALERT _194 - Missing _cell_measurement_reflns
          IF (IPR(601) .LE. 0)
     1      CALL PLA231 (194, 0, -999.0, 1.0, ' ', ' ')
C * ALERT _195 - Missing _cell_measurement_theta_max
          IF (PAR(470) .LE. 0)
     1      CALL PLA231 (195, 0, -999.0, 1.0, ' ', ' ')
C * ALERT _196 - Missing _cell_measurement_theta_min
          IF (PAR(469) .LE. 0)
     1      CALL PLA231 (196, 0, -999.0, 1.0, ' ', ' ')
        END IF
C * ALERT _197  - Report Missing _cell_measurement_temperature
        IF (IPR(261) .LE. 0) CALL PLA231 (197, 0, 1.0, 0.0, ' ', ' ')
      END IF
C * ALERT _198  - Report Missing _diffrn_ambient_temperature
      IF (IPR(310) .LE. 0) CALL PLA231 (198, 0, 1.0, 0.0, ' ', ' ')
C * ALERT _199 - Check for SHELXL97 Roomtemperature Default (Cell)
      IF (IGBL(94) .EQ. 0) THEN
        IF (IPR(261) .LT. 2 .OR. IPR(261) .EQ. 293 .OR.
     1      IPR(261) .EQ. 273) THEN
          CALL PLA231 (199, 0, -999.0, FLOAT(IPR(261)), ' ', ' ')
        END IF
      END IF
C * ALERT _200 - Check for SHELXL97 Roomtemperature Default (Datacollection)
      IF (IPR(310) .GT. -999999) THEN
        IF (IPR(310) .LT. 2 .OR. IPR(310) .EQ. 293 .OR.
     1    IPR(310) .EQ. 273) THEN
            CALL PLA231 (200, 0, -999.0, FLOAT(IPR(310)), ' ', ' ')
        END IF
      END IF
C * ALERT _193 - Check Consistency Cell & Datacollection Temperatures
      IF (IPR(261) .GT. 0 .AND. IPR(310) .GT. 0) THEN
        YUNK = ABS(IPR(310) - IPR(261))
          IF (YUNK .GT. 0.0) CALL PLA231 (193, 0, YUNK, YUNK, ' ', ' ')
      END IF
C * ALERT _871 - Report suppression Laue technique related ALERTS
      IF (IPR(106) .EQ. 1)
     1  CALL PLA231 (871, 0, -999.0, 0.0, ' ', ' ')
C * ABSORPTION CORRECTION & FLACK RELATED CHECKS
      IF (KRAD(1:2) .NE. '??') THEN
        IF (IGBL(94) .EQ. 0 .AND. IPR(105) .EQ. 0) THEN
C * ALERT _050 : CHECK FOR NON-ZERO MU
          IF (PAR(301) .EQ. 0.0) THEN
            CALL PLA231 (50, 2, 1.0, 1.0, ' ', ' ')
C * ALERT _051
          ELSE IF (IABS(IPR(493)) .GT. 0 .AND. IABS(IPR(493)) .LT. 6)
     1      THEN
            IF (ABS(PAR(162) - PAR(301)) .GT. 0.03) THEN
              DEVIA = ABS(1.0 - PAR(162) / PAR(301)) * 100.0
              CALL PLA231 (51, 2, DEVIA, DEVIA, ' ', ' ')
            END IF
C * ALERT _052 : CHECK FOR ABS-CORRECTION METHOD
            IF (IPR(485) .LT. 0) THEN
              CALL PLA231 (52, 2, 1.0, 1.0, ' ', ' ')
            ELSE IF (IPR(485) .GT. 0) THEN
C * ALERT _058 : CHECK FOR MAXIMUM TRANSMISSION FACTOR PRESENT
              IF (PAR(306) .EQ. 999999.0)
     1          CALL PLA231 (58, 2, 1.0, 1.0, ' ', ' ')
C * ALERT _059 : CHECK FOR MINIMUM TRANSMISSION FACTOR PRESENT
              IF (PAR(307) .EQ. 999999.0)
     1          CALL PLA231 (59, 2, 1.0, 1.0, ' ', ' ')
C * ALERT _064 : CHECK FOR TMAX .GE. TMIN
              IF (PAR(306) .LT. 999999.0 .AND. PAR(307) .LT. 999999.0
     1           .AND. PAR(307) .GT. PAR(306))
     1          CALL PLA231 (64, 2, 1.0, 1.0, ' ', ' ')
            END IF
C * ALERT _068 : CHECK CALCULATED (F000 or F000') / REPORTED F000
            YUNK1 = ABS(PAR(157) - PAR(324))
            YUNK2 = ABS(PAR(426) - PAR(324))
            IF (YUNK1 .GT. 0.1 .AND. YUNK2 .GT. 0.1)
     1        CALL PLA231 (68, 2, 1.0, 1.0, ' ', ' ')
C * ALERT _056 : SPHERE OR CYLINDER
            IF (IPR(485) .EQ. 7 .AND. PAR(305) .LE. 0.0) THEN
              CALL PLA231 (56, 2, 1.0, 1.0, ' ', ' ')
            END IF
            IF ((IPR(485) .EQ. 7 .AND. PAR(305) .GT. 0.0) .OR.
     1           IPR(486) .EQ. 8) THEN
              V1(1) = 2 * PAR(305)
              V1(2) = V1(1)
              V1(3) = V1(1)
              IF (IPR(493) .NE. 6) THEN
C * ALERT _063 - Large Crystal
                IF (V1(3) .GT. 1.0)
     1            CALL PLA231 (63, 2, -999.0, V1(3), ' ', ' ')
              END IF
            ELSE
              IF (PAR(305) .LE. 0.0 .OR. IPR(485) .NE. 7) THEN
                NERR  = 0
                V1(1) = PAR(304)
                V1(2) = PAR(303)
                V1(3) = PAR(302)
C * ALERT _067
                IF (V1(1) .GT. 0.0 .AND. V1(3) .GT. 0.0) THEN
                   IF (V1(1) .GT. V1(3)) THEN
                     CALL PLA231 (67, 2, 1.0, 1.0, ' ', ' ')
                       NERR = 1
                   END IF
                END IF
C * ALERT _053
                IF (V1(1) .LE. 0.0 .AND. PAR(305) .LE. 0.0) THEN
                  CALL PLA231 (53, 2, 1.0, 1.0, ' ', ' ')
                  NERR = 1
                END IF
C * ALERT _054
                IF (V1(2) .LE. 0.0 .AND. PAR(305) .LE. 0.0) THEN
                  CALL PLA231 (54, 2, 1.0, 1.0, ' ', ' ')
                  NERR = 1
                END IF
C * ALERT _055
                IF (V1(3) .LE. 0.0 .AND. PAR(305) .LE. 0.0) THEN
                  CALL PLA231 (55, 2, 1.0, 1.0, ' ', ' ')
                  NERR = 1
                ELSE
C * ALERT _063
                  IF (V1(3) .GT. 0.6)
     1              CALL PLA231 (63, 2, -999.0, V1(3), ' ', ' ')
                END IF
              END IF
            END IF
            IF (NERR .EQ. 0 .AND. V1(1) * V1(2) * V1(3) .GT. 0.0) THEN
              IF (IABS(IPR(493)) .GT. 0 .AND. IABS(IPR(493)) .LT. 6)
     1          THEN
                TMIDMU   = V1(2) * PAR(301)
                J        = MAX (1, IABS(IPR(493)))
                I        = MIN (7, 1 + INT((TMIDMU + 0.25) * 2))
                V1(4)    = MAX (V1(2), MIN (1.2 * V1(2), V1(3)))
                PAR(317) = EXP(-V1(1) * PAR(301))
                PAR(315) = EXP(-V1(4) * PAR(301)) * TABT(I, J)
                PAR(316) = EXP(-V1(3) * PAR(301)) / TABT(I, J)
                V3(1)    = 1.0
                V3(2)    = PAR(317) / PAR(315)
                V3(3)    = PAR(317) / PAR(316)
C * ALERT _057
                IF (IPR(485) .LT. 1)
     1            CALL PLA231 (57, 2, V3(2), V3(2), ' ', ' ')
                VERS  = ABS(PAR(317) - PAR(306)) + ABS(PAR(316)
     1                - PAR(307))
                VERS1 = ABS(PAR(317) - PAR(306)) + ABS(PAR(315)
     1                - PAR(307))
C * ALERT _066
                IF (VERS .LT. 0.011 .OR. VERS1 .LT. 0.011)
     1            CALL PLA231 (66, 2, -999.0, 1.0, ' ', ' ')
                IF (IPR(485) .LT. 1 .OR. IPR(485) .GT. 3) THEN
C * ALERT _065
                  IF (TMIDMU .GT. 1.0)
     1              CALL PLA231 (65, 2, TMIDMU, TMIDMU, ' ', ' ')
                END IF
                IF (IPR(485) .GE. 0) THEN
                  IF (IPR(485) .GT. 3) THEN
                    IF (PAR(306) * PAR(307) .NE. 0.0 .AND. PAR(306)
     1                 .LT. 99999 .AND. PAR(307) .LT. 99999) THEN
                      V3(1) = PAR(306) / PAR(307)
                      RR    = V3(2) / V3(1)
                      RRP   = MIN(99999.0, V3(3) / V3(1))
C * ALERT _060
                      CALL PLA231 (60, 3, RR, RR, ' ', ' ')
C * ALERT _061
                      CALL PLA231 (61, 3, 1.0 - RRP, RRP, ' ', ' ')
C * ALERT _062
                      IF (ABS(PAR(317) - PAR(306)) .GT. 0.01)
     1                  CALL PLA231 (
     2                     62, 3, -999.0, PAR(317) / PAR(306), ' ', ' ')
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
      END IF
C * 4 SERIES
C * ALERT _077
      IF (IPR(215) .GT. 0) CALL PLA231 (77, 2, 0.5, 0.5, ' ', ' ')
      IF (IPR(484) .LE. 0) THEN
C * ALERT _078
        IF (CCIF(12)(1:NCIF(12)) .EQ. 'geom')
     1    CALL PLA231 (78, 0, 1.0, 1.0, '   geom', ' ')
C * ALERT _079
        IF (CCIF(13)(1:NCIF(13)) .EQ. 'mixed')
     1    CALL PLA231 (79, 0, 1.0, 1.0, '  mixed', ' ')
      ELSE
C * ALERT _007 - REPORT ON NUMBER OF UN-REFINED D-H ATOMS
        IF (IPR(658) .GT. 0) THEN
          CALL PLA231 (7, 0, -999.0, FLOAT(IPR(658)), ' ', ' ')
        END IF
        IF (IPR(564) .EQ. 0) THEN
C * ALERT _093
          IF (CCIF(13)(1:NCIF(13)) .EQ. 'mixed')
     1      CALL PLA231 (93, 0, -999.0, 1.0, '  mixed', ' ')
        ELSE
C * ALERT _073
          IF (CCIF(13)(1:NCIF(13)) .EQ. 'constr')
     1      CALL PLA231 (73, 0, 1.0, 1.0, ' constr', ' ')
        END IF
      END IF
C * VALIDATE REFINEMENT PARAMETERS
C * NO Hall SPACEGROUP SPECIFIED
      IF (IGBL(94) .EQ. 0) THEN
C * ALERT _125
        IF (CCIF(16)(1:1) .EQ. '?' .OR. CCIF(16)(1:1) .EQ. ' ') THEN
          CALL PLA231 (125, 0, 1.0, 1.0, ' ', ' ')
        ELSE
          IF (SPGRNM(3)(1:1) .EQ. CHAR(32)) THEN
            I = 1
          ELSE
            I = 0
          END IF
C * ALERT _127
          IF (SPGRNM(3)(I+1:I+1) .EQ. ' ') THEN
            CALL PLA231 (127, 2, 1.0, 1.0,
     1         CCIF(16)(1:7), CCIF(16)(8:14))
            GO TO 30
          END IF
          J   = 0
   10     I   = I + 1
          IF (I .GT. 17) GO TO 30
          ICH = SPGRNM(3)(I:I)
          IF (ICH .EQ. '_' .OR. ICH .EQ. CHAR(32)) GO TO 10
   20     J   = J + 1
          IF (J .LT. 18) THEN
            JCH = CCIF(16)(J:J)
            IF (JCH .EQ. '_' .OR. JCH .EQ. CHAR(32)) GO TO 20
            IF (ICH .EQ. JCH) GO TO 10
          END IF
C * ALERT _127
          IF (IPR(673) .EQ. 0) CALL PLA231 (127, 2, 1.0, 1.0,
     1      CCIF(16)(1:7), CCIF(16)(8:14))
        END IF
      END IF
   30 IF (IGBL(94) .EQ. 0) THEN
C * ALERT _080
        IF (PAR(178) .GT. -999999.0) THEN
          CALL PLA231 (80, 2, ABS(PAR(178)), ABS(PAR(178)) , ' ', ' ')
        ELSE
C * ALERT _081
          CALL PLA231 (81, 2, 1.0, 1.0, ' ', ' ')
        END IF
      END IF
C * ALERT _082 : TEST R1 & wR2 VALUES
      CALL PLA231 (82, 2, PAR(173), PAR(173), ' ', ' ')
C * ALERT _084
      CALL PLA231 (84, 2, PAR(174), PAR(174), ' ', ' ')
      IF (IPR(309) .EQ. 2) THEN
C * ALERT _940
        IF (IPR(265) .EQ. IPR(264)) THEN
          IF (PAR(314) .LT. 0.95) THEN
            CALL PLA231 (940, 0, 1.0, 1.0, ' ', ' ')
          ELSE
            CALL PLA231 (940, 0, -999.0, 1.0, ' ', ' ')
          END IF
        END IF
      END IF
C * ALERT _808
      IF (PAR(497) .LT. 0.0 .AND. PAR(498) .EQ. 0.0 .AND.
     1  IGBL(94) .EQ. 0 .AND. IPR(105) .EQ. 0) THEN
          CALL PLA231 (808, 0, -999.0, 0.0, ' ', ' ')
      END IF
      IF (IPR(266) .GT. 0 .AND. IPR(105) .EQ. 0) THEN
        IF (IPR(377) .GT. 0) THEN
          PAR(505) = FLOAT(IPR(377)) / FLOAT(IPR(266))
        ELSE
          PAR(505) = (FLOAT(IPR(559)) * PAR(168)) / FLOAT(IPR(266))
        END IF
        IF (PAR(505) .GT. 0.001) THEN
          IF (IPR(275) .EQ. 2) THEN
C * ALERT _088
            CALL PLA231 (88, 2, 100 / PAR(505), PAR(505), ' ', ' ')
          ELSE
C * ALERT _089 & _090
            IF (IPR(22) .LE. 18) THEN
              CALL PLA231 (89, 2, 100 / PAR(505), PAR(505), ' ', ' ')
            ELSE
              CALL PLA231 (90, 2, 100 / PAR(505), PAR(505), ' ', ' ')
            END IF
          END IF
        END IF
      END IF
      IF (IGBL(94) .EQ. 0) THEN
        IF (PAR(299) .LT. 0.99) THEN
C * ALERT _086
          CALL PLA231 (86, 2, 1.0 - PAR(299),
     1      MAX (0.0, PAR(299)), ' ', ' ')
        ELSE IF (PAR(299) .GT. 1.01 .AND. IPR(632) .EQ. 1) THEN
C * ALERT _087
          CALL PLA231 (87, 2, PAR(299), PAR(299), ' ', ' ')
        END IF
      END IF
C * RESIDUAL DENSITY TESTS (SUPPRESSED FOR POWDER STUDY)
      IF (IGBL(94) .EQ. 0 .AND. IPR(105) .EQ. 0) THEN
        IF (PAR(177) .LT. -1000.0) THEN
C * ALERT _095
          CALL PLA231 (95, 2, 1.0, 1.0, ' ', ' ')
        ELSE
C * ALERT _097
          IF (IPR(22) .NE. 0 .AND. IPR(493) .NE. 6) THEN
            CALL PLA231 (97, 2, 10 * PAR(177) / IPR(22),
     1        PAR(177), ' ', ' ')
          END IF
C * ALERT _094
          IF (PAR(176) .NE. 0.0 .AND. PAR(177) .GT. 0.40) THEN
            RMXMI = PAR(177) /  ABS(PAR(176))
            CALL PLA231 (94, 2, RMXMI, RMXMI, ' ', ' ')
          END IF
        END IF
C * ALERT _096
        IF (PAR(176) .GT. 1000.0) THEN
          CALL PLA231 (96, 2, 1.0, 1.0, ' ', ' ')
        ELSE IF (PAR(176) .LT. -0.1) THEN
C * ALERT _098
          IF (IPR(22) .NE. 0 .AND. IPR(493) .NE. 6) THEN
            CALL PLA231 (98, 2, - 10 * PAR(176) / IPR(22),
     1        PAR(176), ' ', ' ')
          END IF
        ELSE IF (PAR(176) .GE. 0.0) THEN
C * ALERT _099
          CALL PLA231 (99, 2, 1.0, PAR(176), ' ', ' ')
        END IF
      END IF
C * ALERT _005 - REPORT ABSENSE OF '_iucr_refine_instructions_details'
C *                             OR '_shelx_res_file'
      IF (IPR(663) .EQ. 0) THEN
        IF (IPR(653) .LT. 5 .AND. IGBL(94) .EQ. 0 .AND.
     1      IPR(105) .EQ. 0) CALL PLA231 (5, 0, -999.0, 0.0, ' ', ' ')
C * ALERT _012
      ELSE
        IF (IPR(677) .LT. 0 .AND. IGBL(133) .NE. 7)
     1    CALL PLA231 (12, 0, 1.0, 1.0, ' ', ' ')
      END IF
C * ALERT _010 - No Structure Factors[IPR(676), No CSD-CIF [IGBL(94)],
C *              No Powder [IPR(105)]
      IF (IPR(676) .EQ. 0 .AND. IGBL(94) .EQ. 0
     1    .AND. IPR(105) .EQ. 0) THEN
        CALL PLA231 (10, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _013
      ELSE
        IF (IPR(678) .LT. 0 .AND. IGBL(133) .NE. 7)
     1    CALL PLA231 (13, 0, 1.0, 1.0, ' ', ' ')
      END IF
C * ALERT _008 - REPORT ABSENSE OF '_iucr_refine_reflections_details
C * ALERT _015                          OR '_shelx_hkl_file
      IF (IPR(664) .EQ. 0) THEN
        IF (IPR(660) .LT. 5 .AND. IGBL(94) .EQ. 0 .AND.
     1      IPR(105) .EQ. 0) THEN
          IF (IGBL(133) .EQ. 2) THEN
            CALL PLA231 (15, 0, 1.0, 1.0, ' ', ' ')
          ELSE
            CALL PLA231 (8, 0, -999.0, 0.0, ' ', ' ')
          END IF
        END IF
      END IF
C * ALERT _014 - Missing FAB CheckSum
      IF (IPR(665) .NE. 0 .AND. IPR(679) .LT. 0)
     1  CALL PLA231 (14, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _016 - REPORT ABSENSE OF '_shelx_fab_file
      IF (IPR(665) .EQ. 0 .AND. IPR(651) .EQ. -1)
     1  CALL PLA231 (16, 0, 1.0, 1.0, ' ', ' ')
C * CHECK FOR CONSISTENCY of radiation_wavelength and radiation_type
      IF (IPR(493) .GT. 0 .AND. IPR(493) .LT. 5) THEN
        IF (IPR(493) .NE. IPR(671)) THEN
          CALL PLA231 (9, 0, 1.0, 1.0, ' ', ' ')
        END IF
      END IF
      IF (KRSYST(1) .NE. KRSYST(2))
     1  CALL PLA231 (104, 0, -999.0, 0.0, ZSPG, ' ')
      IF (IPR(600) .GT. 0) THEN
C * ALERT _804
        CALL PLA231 (804, 0,  -999.0, FLOAT(IPR(600)), ' ', ' ')
      END IF
C * ALERT _868 & _869 - REPORT SUPPRESSION OF ALERTS RELATED TO THE USE
      IF (IPR(651) .NE. 0) THEN
        IF (IABS(IPR(651)) .EQ. 1) THEN
          CALL PLA231 (869, 0, -999.0, 0.0, ' ', ' ')
        ELSE
          CALL PLA231 (868, 0, -999.0, 0.0, ' ', ' ')
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA232
      SUBROUTINE PLA233
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
C * MERR = 2 SERIES
      P313   = MAX (0.0, PAR(313))
      P314   = MAX (0.0, PAR(314))
      P168   = MAX (0.0, PAR(168))
      P312   = MAX (0.0, PAR(312))
      RESOL  = SIN (P168 / RGBL(6)) / PAR(17)
      RESOL1 = SIN (P312 / RGBL(6)) / PAR(17)
C * ALERT _030 - TEST FOR UNIQUE # REFL > TOTAL MEASURED
      IF (IPR(263) .GT. IPR(262) .AND. IPR(105) .EQ. 0)
     1  CALL PLA231 (30, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _018 COMPARE _fraction_full with _fraction_max
      IF (P314 .GT. 0.0 .AND. P313 .GT. 0.0) THEN
        IF (ABS(P168 - P312) .LT. 0.005 .AND.
     1      ABS(P314 - P313) .GT. 0.002) THEN
          CALL PLA231 (18, 3, 1.0, 1.0, ' ', ' ')
C * ALERT _019
        ELSE IF (P314 - P313 .LT. -0.002) THEN
          CALL PLA231 (19, 3, (P313 - P314), P314 / P313, ' ', ' ')
        END IF
      END IF
C * ALERT _020 - Check R(int) for R1 .GT. 0.07)
      IF (PAR(173) .GT. 0.07)
     1  CALL PLA231 (20, 3, PAR(197), PAR(197), ' ', ' ')
      IF (P168 .GT. 0.0) THEN
        IF (IPR(559) .NE. 0) THEN
          RATIO  = FLOAT (MAX (0, IPR(263))) / FLOAT(IPR(559))
          RATMAX = 3.0 - IPR(275)
          IF (RATIO .GT. RATMAX) THEN
C * ALERT _021
            RATIOTEST = (RATIO - RATMAX) / RATMAX
            IF (IPR(619) .EQ. 1) RATIOTEST = -999.0
            CALL PLA231 (21, 3, RATIOTEST, RATIO, ' ', ' ')
          ELSE IF (RATIO .LT. 1.0) THEN
            RTEST = 1.0 - P313
            IF (RESOL .GE. 0.594) THEN
              IF (RESOL1 .GE. 0.594) THEN
                IF (P314 .GT. 0.98 .AND. RTEST .GT. 0.05)
     1              RTEST = -999.0
              END IF
            END IF
C * ALERT _022
            END IF
          END IF
C * ALERT _024
          IF (IPR(263) .NE. 0) THEN
            IRATIO = NINT (MAX(0, IPR(264)) / FLOAT(IPR(263)) * 100.0)
          ELSE
            IRATIO = 0
          END IF
C * ALERT _026
          IF (IPR(105) .EQ. 0) THEN
            CALL PLA231 (26, 2, FLOAT(100 - IRATIO), FLOAT(IRATIO),
     1                 ' ', ' ')
          ENDIF
        END IF
C * CHECK RESOLUTION
        IF (IGBL(94) .EQ. 0 .AND. IPR(105) .EQ. 0) THEN
C * ALERT _023 : CHECK THETA-MAX (RESOL)
          CALL PLA231 (23, 2, 0.6 - RESOL, P168, ' ', ' ')
C * ALERT _038 : CHECK FRACT-THETA-MAX
          IF (P313 .EQ. 0.0) CALL PLA231 (38, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _037 : CHECK FOR THETA-FULL
          IF (P312 .EQ. 0.0) CALL PLA231 (37, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _039 : CHECK FOR FRACT-THETA-FULL
          IF (P314 .EQ. 0.0) CALL PLA231 (39, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _029 : DETERMINE WHETHER TO USE P313 OR P314
          IF (IPR(106) .EQ. 0) THEN
            IF (P314 .GE. P313) THEN
              CALL PLA231 (29, 3, 1.0 - P314, P314, ' ', ' ')
C * ALERT _027
            IF (RESOL1 .LT. RESOL) THEN
              YUNK = (0.6 - RESOL1) * 10.0
              CALL PLA231 (27, 2, YUNK, P312, ' ', ' ')
            END IF
          ELSE
C * ALERT _028
            CALL PLA231 (28, 3, 1.0 - P313, P313, ' ', ' ')
          END IF
        END IF
C * ALERT _025 : CHECK FOR Hmin..Lmax
        DO I = 267, 272
          IF (IABS(IPR(I)) .EQ. 999999) THEN
            CALL PLA231 (25, 3, 1.0, 1.0, ' ', ' ')
            EXIT
          END IF
        END DO
        IF (((IGBL(133) .GT. 0 .AND. IGBL(133) .LT. 5)
     1      .OR. IGBL(9) .EQ. 1) .AND. IGBL(9) .EQ. 1) THEN
C * ALERT _924
          IF (IPR(493) .NE. 6) THEN
            IF (PAR(176) .LT. 0.0 .AND. IPR(619) .EQ. 0) THEN
              YUNK = ABS (PAR(176) - PAR(329))
            IF (YUNK .GT. 0.5)
     1          CALL PLA231 (924, 2, YUNK, YUNK, ' ', ' ')
            END IF
C * ALERT _925
            IF (PAR(177) .GT. 0.0 .AND. IPR(619) .EQ. 0 .AND.
     1          IPR(651) .EQ. 0) THEN
              YUNK = ABS (PAR(177) - PAR(330))
              IF (YUNK .GT. 0.5)
     1          CALL PLA231 (925, 2, YUNK, YUNK, ' ', ' ')
            END IF
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA233
      SUBROUTINE PLA240
C **********************************************************************
C *                                                                    *
C * * * * * * * * P R O G R A M    H E L E N A * * * * * * * * * * * * *
C *                                                                    *
C **********************************************************************
C *                                                                    *
C *      PROGRAM FOR THE HANDLING OF CAD4-DIFFRACTOMETER OUTPUT        *
C * AN SHELX(S/L) OR  XTAL-SYSTEM STYLE OF HKL-CARD FILE IS PREPARED   *
C *       ALONG WITH A DOCUMENT ON THE DATA COLLECTION                 *
C *                         A.L. SPEK,                                 *
C *                     UTRECHT UNIVERSITY,                            *
C *          BIJVOET CENTER FOR BIOMOLECULAR RESEARCH,                 *
C *            VAKGROEP KRISTAL- EN STRUCTUURCHEMIE,                   *
C *       PADUALAAN 8, 3584 CH UTRECHT, THE NETHERLANDS.               *
C *                                                                    *
C *--------------------------------------------------------------------*
C **********************************************************************
C **********************************************************************
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP45=2048,NP52=200,
     2 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     3 -(7*IP5+11)*(IP2*IP3)-149,NP38=150,NP39=30,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /PROT/ IRADIUS, SLIT, APMIN, APMAX, ISCANT, NPIPRE,
     1 NFRIDL, ICHKT, SIGMI, FADING, NORCHK, DANG, CON1, CON2, DTHMIN,
     2 DTHMAX, DOMA, DOMB, APTA, APTB, SIGPRE, SIGMA, ITMAX,NBALF,NEQFL,
     3 NRPSI, PSIST, DELPSI, DVECT(3), NFMS, IZZH, IHMIN, IHMAX, IZZK,
     4 KMIN, KMAX, IZZL, LMIN, LMAX, FLAM1, FLAM2, BETA,
     5 IORF, WL21,WL11,CILT, PERF, RLPMN,
     6 RLPMX, XIMX, SIMX, SCFOVFL, CELL(12)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /XCHAR/ COMPID, TEXT, XNPSIFL, DATC, XSEQ, RDMP, ICAD,
     1 HTAOIS
      CHARACTER TEXT*36, COMPID*6, XNPSIFL*6, DATC*6,
     1 NFMS*4, XSEQ*6, RDMP(26)*62, ICAD*4, HTAOIS(25)*6
      COMMON /GGT/ MEDIUM
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER FLNAM*25
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER VERSION*10
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      PAGET = 'HELENA'
      CALL GEN038 (JID, 1, 80)
C * NUMBER OF LINES/PAGE (LINE PRINTER)
      IPR(83)   = 0
      IGBL(1)   = 4
      IPR(370)  = 0
      IGBL(63)  = 3
      IGBL(49)  = 0
      IGBL(102) = 56
      NAUTO     = 0
      LUNIT     = LU16
      FLNAM = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT)
      OPEN (UNIT = LU16, FILE = FLNAM, STATUS = 'UNKNOWN', ERR = 90)
      LUNIT = LU11
      OPEN (UNIT = LU11, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1      ERR = 90)
      LUNIT = LU10
      OPEN (UNIT = LU10, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1 ERR = 90)
      LUNIT = LU9
      OPEN (UNIT = LU9, STATUS = 'SCRATCH', FORM = 'UNFORMATTED',
     1 ERR = 90)
      LUNIT = LU7
      OPEN (UNIT = LU7, FILE = NAMEFIL(1:KNMFIL)//'.lis',
     1      STATUS = 'UNKNOWN', ERR = 90)
      IGBL(6) = 15
      VERT    = 25.0
      HORS    = VERT * 4.0 / 3.0
      LU15    = LU1
      OPEN (UNIT = LU15, FILE = NAMEFIL(1:KNMFIL)//'.ins',
     1      STATUS = 'UNKNOWN')
      CALL GEN108 (LU10, 0)
      CALL GEN108 (LU11, 0)
      CALL GEN108 (LU9, 0)
      CALL GEN040 (IGBL(4), VERSION, IP)
      CALL PLA262 (0)
      WRITE (LU7, 99999, IOSTAT = IOST) VERSION(1:IP)
      CALL GEN097 (IHPR, 1, IP7, 0)
      IHPR(1)  = IP3 - 1
      IHPR(2)  = IP1
      IHPR(3)  = IP2
      IHPR(4)  = IP4
      IHPR(5)  = IP5 - 1
      IPR(446) = 1
      XIMX     = 0
      SIMX     = 0
      SCFOVFL  = 1.0
      IORF     = 0
      PERF     = 0.5
      XNPSIFL  = '******'
      CALL GEN097 (IORREF, 1, 100, 0)
      DO I = 1, 25
        HTAOIS(I) = XNPSIFL
      END DO
      CILT = 2.5
      CALL GEN097 (IPR(371), 1, 9, 1)
      CALL GEN097 (ISW, 1, 3, 0)
      CALL GEN074 (CELL, 1, 12, 0.0)
      CALL GEN097 (NMBR, 1, 20, 0)
      CALL GEN097 (IRFY, 1, IP3, 0)
      CALL GEN074 (XRF , 1, IP3, 0.0)
      DO I = 1, 26
        CALL GEN038 (RDMP(I), 1, 62)
      END DO
      CALL GEN074 (PSIS, 1, IP4 * 36, 0.0)
      ANPI     = 0.0
      HPAR(1)  = 1.0000
      HPAR(2)  = 1.0000
      HPAR(3)  = 0
      HPAR(4)  = 0
      HPAR(20) = 2
      HPAR(21) = 2
      HPAR(24) = RGBL(6)
      IPR(424) = 1
      IPR(425) = 0
      IPR(426) = 0
      IPR(428) = 0
      STM      = (SIN (35.0 / HPAR(24)) / 0.71073) ** 3 / IP9
      DO I = 1, IP9
        BAK(I, 1) = (STM * I) ** 0.3333333
        DO J = 2, 5
          BAK(I, J) = 0.0
        END DO
      END DO
      WRITE (LU6, 99998, IOSTAT = IOST) VERSION
      GO TO 20
   10 LU15 = LU5
   20 IF (LU15 .EQ. LU5) THEN
        BCD(1:12) = 'H.E.L.E.N.A'//CHAR(0)
        CALL GGIP (HORS, VERT, 0.0, 1)
        LINE = 'H E L E N A'
        CALL GGIP09 (0.0, LINE, 11, 2.2, 4, 15, 5.0, VERT - 3.0)
        CALL GGIP09 (0.0, LINE, 11, 2.2, 2, 15, 4.7, VERT - 3.2)
        LINE =
     1   'Version '//VERSION(1:IP)//' - A.L.Spek, Utrecht University'
        CALL GGIP09 (0.0, LINE, 50, 0.6, 1, 2, 4.0, VERT - 5.0)
        LINE = 'INSTRUCTIONS + SUB-KEYWORDS (# = DEFAULT)'
        CALL GGIP09 (0.0, LINE, 50, 0.6, 5 + IGBL(68), 2, 4.0,
     1               VERT - 7.0)
        LINE = 'CALC            - TO EXECUTE THE CALCULATION'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 8.0)
        LINE = '      - #SHELX  - INPUT FILE FOR SHELX (TYPE=4)'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 9.0)
        LINE = '      -  ABSPSI - ABSOLUTE PSI - VALUES'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 10.0)
        LINE = '      - #LSR    - NORMAL  BACKGROUND PROCEDURE'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 11.0)
        LINE = '      -  MSM    - SPECIAL BACKGROUND PROCEDURE'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 12.0)
        LINE = '      -  MSA    - SPECIAL BKG PROC. (ADD B+ TO ISC)'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 13.0)
        LINE = '      -  SUB    - SKIP REFLECTIONS WITH UNUSUAL BG,BL'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 14.0)
        LINE = '      -  AVE    - AVERAGE BACKGROUND SCALING'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 15.0)
        LINE = 'MONOCHR         - SET MONOCHROMATOR TYPE'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 16.0)
        LINE = '      -  BETA   - BETA-FILTER'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 17.0)
        LINE = '      -  PERP   - MONOCHROMATOR PERPENDICULAR'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 18.0)
        LINE = '      -  PARAL  - MONOCHROTOR PARALLEL'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 19.0)
        LINE = 'SCALE           - SCALING FUNCTION'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 20.0)
        LINE = '      -  DEGREE [ value ]'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 21.0)
        LINE = '      -  NONE    - SCALE = 1.0'
        CALL GGIP09 (0.0, LINE, 60, 0.5, 1, 2, 4.0, VERT - 22.0)
        LINE = 'Data Read From: '//FLNAM
        CALL GGIP09 (0.0, LINE, 60, 0.5, 3, 2, 4.0, VERT - 24.0)
        CALL PLA013 (5, 1)
        IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
          GO TO 20
        ELSE IF (IGGT(1:1) .EQ. '!') THEN
          CALL PLA280 ('CALC')
        END IF
        IF (IGGT(1:1) .NE. ' ') THEN
          ICL = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          GO TO 20
        END IF
      ELSE
        READ  (LU15, 99989, END = 10) ICL(1:80)
      END IF
      CALL GEN072 (ICL, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
      IF (IFL(1)(1:3) .EQ. 'SET') THEN
        IF (IFL(2)(1:4) .EQ. 'DISP') THEN
          MEDIUM = 1
        ELSE IF (IFL(2)(1:4) .EQ. 'META') THEN
          MEDIUM = 2
        END IF
        IF (KL .GT. 2) THEN
          IGGT(16:22) = IFL(3)(1:7)
          CALL GGIP (-999.0, 0.0, 0.0, 6)
        END IF
        GO TO 20
      END IF
      IF (IFL(1)(1:3) .EQ. 'MON') THEN
        IF (KL .EQ. 2) THEN
          IF (IFL(2)(1:4) .EQ. 'BETA') THEN
            IPR(424) = 0
          ELSE IF (IFL(2)(1:4) .EQ. 'PERP') THEN
            IPR(424) = 1
          ELSE IF (IFL(2)(1:3) .EQ. 'PAR') THEN
            IPR(424) = 2
          END IF
          GO TO 20
        END IF
      END IF
      IF (IFL(1)(1:4) .EQ. 'CALC') THEN
        K = 0
        IF (KL .GT. 1) THEN
          DO I = 2, KL
            IF (IFL(I)(1:6) .EQ. 'ABSPSI') THEN
              IPR(426) = 1
            ELSE IF (IFL(I)(1:3) .EQ. 'LSR') THEN
              IF (IPR(370) .EQ. 0) IPR(425) =  0
            ELSE IF (IFL(I)(1:3) .EQ. 'MSM') THEN
              IF (IPR(370) .EQ. 0) IPR(425) =  1
            ELSE IF (IFL(I)(1:3) .EQ. 'MSA') THEN
              IF (IPR(370) .EQ. 0) IPR(425) =  2
            ELSE IF (IFL(I)(1:3) .EQ. 'AVE') THEN
              IF (IPR(370) .EQ. 0) IPR(425) =  3
            ELSE IF (IFL(I)(1:3) .EQ. 'SUB') THEN
              IF (IPR(370) .EQ. 0) IPR(425) = -1
            ELSE IF (IFL(I)(1:4) .EQ. 'AUTO') THEN
              NAUTO = 1
              GO TO 60
            END IF
          END DO
        END IF
        IF (LU15 .EQ. LU1 .AND. NAUTO .EQ. 0) GO TO 20
        GO TO 60
      ELSE IF (IFL(1)(1:4) .EQ. 'HELP') THEN
          WRITE (LU6, 99991, IOSTAT = IOST)
        GO TO 20
      ELSE IF (IFL(1)(1:4) .EQ. 'STOP') THEN
        GO TO 70
      ELSE IF (IFL(1)(1:4) .EQ. 'EXIT') THEN
        GO TO 70
      ELSE IF (IFL(1)(1:4) .EQ. 'QUIT') THEN
        GO TO 70
      ELSE IF (IFL(1)(1:5) .EQ. 'SCALE') THEN
        IF (KL .GT. 1) THEN
          K = 0
          IPR(428) = 0
          DO I = 2, KL
            IF (IFL(I)(1:6) .EQ. 'DEGREE') THEN
              K      = K + 1
              IPR(446) = MIN (IP5 - 1, NINT(FN(K)))
            ELSE IF (IFL(I)(1:4) .EQ. 'NONE') THEN
              IPR(428) = 1
            END IF
          END DO
        END IF
        CALL PLA241
        GO TO 20
      ELSE IF (IFL(1)(1:2) .EQ. 'RR') THEN
        N = NINT(FN(1))
        IPR(370 + N) = MOD(IPR(370 + N) + 1, 2)
        IF (IPR(370 + N) .EQ. 1) THEN
          GO TO 30
        ELSE
          GO TO 40
        END IF
      ELSE IF (IFL(1)(1:2) .EQ. 'IN') THEN
        GO TO 30
      ELSE IF (IFL(1)(1:2) .EQ. 'EX') THEN
        GO TO 40
      ELSE IF (IFL(1)(1:3) .EQ. 'END') THEN
        GO TO 70
      END IF
      WRITE (LU6, 99997, IOSTAT = IOST) ICL(1:80)
      GO TO 20
   30 INS = 1
      GO TO 50
   40 INS = -1
   50 IF (IPR(370) .EQ. 0) CALL PLA248
      DO I = 1, KN
         IVAL = NINT(FN(I))
         IF (IVAL .GT. 0 .AND. IVAL .LE. IHPR(9)) THEN
           IRFY(IVAL) = INS * IABS(IRFY(IVAL))
         END IF
      END DO
      GO TO 20
   60 OPEN (UNIT = LU17, FILE = NAMEFIL(1:KNMFIL)//'.hkl',
     1    STATUS = 'UNKNOWN', ERR = 90)
      CALL GEN108 (LU17, 0)
      OPEN (UNIT = LU60, FILE = NAMEFIL(1:KNMFIL)//'.rap',
     1    STATUS = 'UNKNOWN', ERR = 90)
      OPEN (UNIT = LU4, FILE = NAMEFIL(1:KNMFIL)//'.psi',
     1    STATUS = 'UNKNOWN', ERR = 90)
        WRITE (LU6, 99993, IOSTAT = IOST)
      IF (ISW(1) .EQ. 0) CALL PLA241
      CALL PLA244 (2)
      CALL PLA247
      CALL PLA244 (3)
   70 WRITE (LU6, 99994, IOSTAT = IOST)
     1  NAMEFIL(1:KNMFIL), NAMEFIL(1:KNMFIL)
      CLOSE (UNIT = LU17)
      IF (IGBL(70) .EQ. 1) THEN
        WRITE (LU6, 99995, IOSTAT = IOST)
     1    NAMEFIL(1:KNMFIL), NAMEFIL(1:KNMFIL)
        CALL GEN108 (LU7, 1)
        CLOSE  (UNIT = LU1)
        READ (LU7, 99989, IOSTAT = IOST) PRBUF
        IF (IOST .EQ. 0) THEN
          CALL GEN108 (LU7, 0)
          FNLU1  = NAMEFIL(1:KNMFIL) //'.lps'
          OPEN (UNIT = LU1,  FILE = FNLU1, STATUS = 'UNKNOWN')
          CALL GEN089 (LU7, LU1, IGBL(49), IGBL(102))
          GO TO 100
        END IF
        CLOSE (UNIT = LU7, STATUS = 'DELETE')
      ELSE
        WRITE (LU6, 99990, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      END IF
      GO TO 100
   90 WRITE (LU6, 99996, IOSTAT = IOST) LUNIT
  100 IF (IPR(426) .EQ. 0) THEN
        CLOSE (UNIT = LU60, STATUS = 'DELETE')
      ELSE
        WRITE (LU6, 99992, IOSTAT = IOST) NAMEFIL(1:KNMFIL)
      END IF
      RETURN
99999 FORMAT ('P R O G R A M   H E L E N A   F O R   T H E   ',
     1 'H A N D L I N G   O F   C A D 4 - O U T P U T : V E R S I',
     2 ' O N = ', A, /, 120('='), //)
99998 FORMAT(/, 'HELENA - Version:', A,
     1 ' - <RETURN> for default run (= CALC SHELX)',/)
99997 FORMAT (':: Instruction Ignored', /, A, /)
99996 FORMAT (':: Cannot Open Unit:', I5)
99995 FORMAT (/, 80('='), /, ':: List Output   on: ', A, '.lis', /,
     1                       ':: EPS  Output   on: ', A, '.lps')
99994 FORMAT (':: SHELX-HKL     on: ', A, '.hkl', /,
     1        ':: SHELX-PSI     on: ', A, '.psi')
99993 FORMAT (/, '>> SHELX(L) - HKLF 4 FILE Will be Produced', /)
99992 FORMAT (':: ABSPSI-HKL    on: ', A, '.rap')
99991 FORMAT ('*EXCLUDE - EXCLUDES SPECIFIED REF.REFL NRS'//)
99990 FORMAT (/, 80('='), /, ':: List Output   on: ', A, '.lis')
99989 FORMAT (A)
      END SUBROUTINE PLA240
      SUBROUTINE PLA241
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     2 -(7*IP5+11)*(IP2*IP3)-149,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /PROT/ IRADIUS, SLIT, APMIN, APMAX, ISCANT, NPIPRE,
     1 NFRIDL, ICHKT, SIGMI, FADING, NORCHK, DANG, CON1, CON2, DTHMIN,
     2 DTHMAX, DOMA, DOMB, APTA, APTB, SIGPRE, SIGMA, ITMAX,NBALF,NEQFL,
     3 NRPSI, PSIST, DELPSI, DVECT(3), NFMS, IZZH, IHMIN, IHMAX, IZZK,
     4 KMIN, KMAX, IZZL, LMIN, LMAX, FLAM1, FLAM2, BETA,
     5 IORF, WL21,WL11,CILT, PERF, RLPMN,
     6 RLPMX, XIMX, SIMX, SCFOVFL, CELL(12)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER NFMS*4
      NST    = 0
      ISW(1) = 1
      IF (IPR(370) .EQ. 0) CALL PLA248
      IF (IPR(428) .EQ. 1) THEN
        WRITE (LU7, 99999, IOSTAT = IOST)
        GO TO 90
      END IF
      CALL GEN074 (FMN, 1, IP2 * IP3 * 9, 0.0)
      IRFX = IHPR(9) + 1
      ISW(2) = 0
      DO ICY = 1, 7, 6
        DO ISGR = 1, ISG
          PC(IRFX, ISGR) = 0.0
          IPC = 0
          IMX = IHPR(2)
          CALL GEN074 (WAV, 1, IMX, 1.0)
          CALL GEN074 (FAV, 1, IMX, 0.0)
          DO 60 IRF = 1, IRFX
            IX = IRFY(IRF)
            IF (IX .EQ. 0) THEN
              IF (ICY .NE. 1) GO TO 60
              NRF = IRFZ(ISW(2), ISGR)
              IRFZ(IRF, ISGR) = NRF
              DO I = 1, NRF
                F(I) = FAV(I)
                W(I) = WAV(I)
              END DO
            ELSE IF (IX .GT. 0) THEN
              CHISI = 0.0
              SJKIJ = 0.0
              STIJ  = 0.0
              NST   = 0
              IF (ISW(2) .EQ. 0) ISW(2) = IRF
              CALL GEN108 (LU9, 0)
   20         READ (LU9, IOSTAT = IOST) NIRF, XI, SI, XRT, ISGX, IORGR
              IF (IOST .EQ. 0) THEN
                IF (NIRF .EQ. IRF) THEN
                  IF (ISGR .LT. ISGX) THEN
                    GO TO 30
                  ELSE IF (ISGR .EQ. ISGX) THEN
                    NST = NST + 1
                    IF (NST .GT. IHPR(2)) CALL PLA245 (4)
                    SCF = 1
                    IF (ICY .NE. 1) THEN
                      CALL PLA246 (SCF, IRFX, ISGR, XRT)
                      CHISI = CHISI + (XI - P(1, IRF, 1) / SCF)**2
                      SJKIJ = SJKIJ + XI**2
                      STIJ  = STIJ + SI**2
                      XI    = XI * SCF
                      SI    = SI * SCF
                    END IF
                    IF (SI .GT. 0.0) THEN
                      WGHT = 1.0 / (SI**2)
                    ELSE
                      WGHT = 0.0
                    END IF
                    X(NST) = XRT
                    F(NST) = XI
                    W(NST) = WGHT
                    IF (IRF .EQ. ISW(2)) IONR(NST) =  IORGR
                    FMN(ICY, IRF, ISGR)     = FMN(ICY, IRF, ISGR) + XI
                    FMN(ICY + 1, IRF, ISGR) = FMN(ICY + 1, IRF, ISGR)
     1                                      + XI**2
                  END IF
                END IF
                GO TO 20
              END IF
   30         IF (NST .GT. 0) THEN
                IF (ICY .NE. 1) THEN
                  IF (IX .EQ. 0) THEN
                    PC(IRFX, ISGR) = PC(IRFX, ISGR) / IPC
                  ELSE IF (IX .GT. 0) THEN
                    PC(IRF, ISGR)  = (ABS(CHISI - STIJ)) / SJKIJ
                    PC(IRFX, ISGR) = PC(IRFX, ISGR) + PC(IRF, ISGR)
                    IPC = IPC + 1
                  END IF
                END IF
              END IF
              IRFZ(IRF, ISGR) = NST
              IF (NST .EQ. 0) THEN
                GO TO 60
              ELSE IF (NST .EQ. 1) THEN
                P(1, IRF, ISGR) = F(1)
                GO TO 40
              ELSE
                FMNX  = FMN(ICY,     IRF, ISGR) / NST
                FMNXK = FMN(ICY + 1, IRF, ISGR) / NST
                FMN(ICY, IRF, ISGR) = FMNX
                DELTA = ABS(FMNXK - FMNX**2)
                FMN(ICY + 1, IRF, ISGR) = SQRT(DELTA) * 100.0 / FMNX
              END IF
            ELSE
              GO TO 60
            END IF
            IF (NST .EQ. 0) THEN
              GO TO 60
            ELSE IF (NST .EQ. 1) THEN
              P(1, IRF, ISGR) = F(1)
            ELSE
              CALL GEN070 (IRFZ(IRF, ISGR), X, F, W, IPR(446),
     1         A(1, IRF, ISGR), B(1, IRF, ISGR), C(1, IRF, ISGR),
     2         G(1, IRF, ISGR), V(1, IRF, ISGR))
              CALL GEN069 (IPR(446), A(1, IRF, ISGR), B(1, IRF, ISGR),
     1        C(1, IRF, ISGR), P(1, IRF, ISGR), SIGMA,
     2         D(1, IRF, ISGR), G(1, IRF, ISGR))
            END IF
   40       CALL PLA249 (IRF, ISGR)
            IF (IX .GT. 0) THEN
              DO J = 1, NST
                XRT = X(J)
                CALL PLA246 (SCF, IRF, ISGR, XRT)
                FJ   = F(J) * SCF
                WGHT = W(J)
                IF (ICY .EQ. 1) THEN
                  FMN(4, IRF, ISGR) = FMN(4, IRF, ISGR) + FJ
                  FMN(5, IRF, ISGR) = FMN(5, IRF, ISGR) + FJ**2
                  FAV(J)            = FAV(J) + 1.0 / SCF
                END IF
              END DO
              IF (ICY .EQ. 1) THEN
                FMNX  = FMN(4, IRF, ISGR) / NST
                FMNXK = FMN(5, IRF, ISGR) / NST
                FMN(4, IRF, ISGR) = FMNX
                FMN(5, IRF, ISGR) = SQRT(ABS(FMNXK - FMNX**2))
     1                            * 100.0 / FMNX
              END IF
            END IF
   60     CONTINUE
        END DO
        CALL PLA249 (0, 0)
      END DO
   90 RETURN
99999 FORMAT (/, '>>>> SCF = 1.00 <<<< ', /)
      END SUBROUTINE PLA241
      SUBROUTINE PLA242 (CELL, DC, VOL, OR, D, NR, COMPID, LU, RAD)
      DIMENSION OR(3, 3), D(3, 3), GD(3, 3), GR(3, 3), CELL(12),
     1 RC(9), DC(6), SA(9), SAR(9)
      CHARACTER COMPID*6
      IF (NR .LE. 1 .AND. LU .GT. 0) THEN
        CALL PLA262 (0)
        WRITE (LU, 99998, IOSTAT = IOST) COMPID, NR
      END IF
      CALL GEN003 (OR, D, V, 0)
      IF (NR .LT. 1 .AND. LU .GT. 0)
     1  WRITE (LU, 99996, IOSTAT = IOST) ((OR(I, J), J = 1, 3),
     2                      (D(I, J), J = 1, 3), I = 1, 3)
      DO I = 1, 3
        J = I + 3
        K = MOD(I, 3) + 1
        L = MOD(I + 1, 3) + 1
        RC(I) = 0.0
        RC(J) = 0.0
        DO M = 1, 3
          RC(I) = RC(I) + OR(M, I)**2
          RC(J) = RC(J) + OR(M, K) * OR(M, L)
        END DO
      END DO
      DO I = 1, 3
        RC(I) = SQRT(RC(I))
      END DO
      DO I = 1, 3
        J = I + 3
        K = MOD(I, 3) + 1
        L = MOD(I + 1, 3) + 1
        RC(J) = RC(J) / (RC(K) * RC(L))
      END DO
      DO J = 1, 3
        RC(J + 6) = RC(J + 3)
        RC(J + 3) = ACOS(RC(J + 6)) * RAD
      END DO
      CALL GEN026 (1, GR, RC)
      CALL GEN003 (GR, GD, DET, 0)
      CALL GEN026 (-1, GD, DC)
      VOL = 1 / SQRT(DET)
      IF (NR .LT. 1 .AND. LU .GT. 0) THEN
        WRITE (LU, 99995, IOSTAT = IOST) ((GR(I, J), J = 1, 3),
     1    (GD(I, J), J = 1, 3), I = 1, 3)
        WRITE (LU, 99994, IOSTAT = IOST) GD(1, 1), GD(2, 2), GD(3, 3),
     1    GD(2, 3), GD(1, 3), GD(1, 2)
      END IF
      VSTAR = 1.0 / VOL
      SV    = 0.0
      SVS   = 0.0
      CALL GEN074 (SAR, 1, 9, 0.0)
      CALL GEN074 (SA,  1, 9, 0.0)
      IF (LU .GT. 0) THEN
        IF (NR .LT. 1) WRITE (LU, 99993, IOSTAT = IOST)
     1    (DC(I), SA(I), RC(I), SAR(I), I = 1, 6), VOL, SV, VSTAR, SVS
        IF (NR .EQ. 0) THEN
          IF (CELL(1) .EQ. 0.0) THEN
            DO I = 1, 6
              CELL(I) = DC(I)
            END DO
          END IF
          WRITE (LU, 99999, IOSTAT = IOST) (CELL(I), I = 1, 6),
     1     (CELL(I), I = 7, 12)
        END IF
        IF (NR .GT. 0) THEN
          WRITE (LU, 99997, IOSTAT = IOST)
     1      NR, ((OR(I, J), J = 1, 3), I = 1, 3), VOL
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (//, 'CELL : ', 3F10.4, 3F10.3/'CESD : ', 3F10.4, 3F10.3)
99998 FORMAT ('L A T T I C E  G E O M E T R Y  D O C U M E N T  O F :'
     1 , 5X, A, /, 65('=')//25X, 'MATRIX NR:', I2, /, 25X, 12('=')//)
99997 FORMAT (I5, 2X, 9F10.6, F10.2)
99996 FORMAT (4X, 'RECIPROCAL AXES MATRIX', 12X,'DIRECT AXES MATRIX'/
     1 , 2(30('-'), 5X)/3(3F10.6, 3X, 3F11.5/))
99995 FORMAT (4X, 'RECIPROCAL METRICAL TENSOR', 9X, 'DIRECT METRICAL',
     1 ' TENSOR', /, 2(30('-'), 5X), /, 3(3F10.6, 3X, 3F11.5/))
99994 FORMAT (21X, 'NIGGLI VALUES ', /, 21X, '-------------'/, 2X,
     1 'A.A = ', F9.4, '  B.B = ', F9.4, ' C.C = ', F9.4/2X, 'B.C = ',
     2 F9.4, '  A.C = ', F9.4, ' A.B = ', F9.4/)
99993 FORMAT (//, 22X, 'CELL PARAMETERS'/, 22X, 15('-')//'A      = ',
     1 F9.4, '(', F6.4, ')', 7X, 'A(STAR)      = ', F8.5, '(',
     2 F7.5, ')', /, 'B      = ', F9.4, '(', F6.4, ')', 7X, 'B(STAR',
     3 ')      = ', F8.5, '(', F7.5, ')'/'C      = ', F9.4, '(',
     4 F6.4, ')', 7X, 'C(STAR)      = ', F8.5, '(', F7.5, ')'/
     5 'ALPHA  = ', F9.2, '(', F6.2, ')', 7X, 'ALPHA(STAR)  = ',
     6 F8.2, '(', F7.2, ')'/'BETA   = ', F9.2, '(', F6.2, ')', 7X,
     7 'BETA(STAR)   = ', F8.2, '(', F7.2, ')'/'GAMMA  = ',
     8 F9.2, '(', F6.2, ')', 7X, 'GAMMA(STAR)  = ', F8.2, '(',
     9 F7.2, ')', /, 'V      = ', F9.1, '(', F6.1, ')', 7X, 'V(STAR',
     * ')      = ', F8.5, '(', F7.5, ')')
      END SUBROUTINE PLA242
      SUBROUTINE PLA243 (ISW, NMBR, IPRT)
      DIMENSION NMBR(20)
      NMBR(ISW) = NMBR(ISW) + 1
      NMBR(ISW + 10) = NMBR(ISW + 10) + 1
      SELECT CASE (ISW)
        CASE (1)
          IPRT = 0
        CASE (2)
          IPRT = IPRT + 2
        CASE (3)
          IPRT = IPRT + 1
        CASE (5)
          IPRT = IPRT + 4
        CASE (6)
          IPRT = IPRT + 8
        CASE (7)
          IPRT = IPRT + 32
        CASE (8)
          IPRT = IPRT + 64
        CASE (10)
          IPRT = IPRT + 16
      END SELECT
      RETURN
      END SUBROUTINE PLA243
      SUBROUTINE PLA244 (MODE)
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     2 -(7*IP5+11)*(IP2*IP3)-149,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PROT/ IRADIUS, SLIT, APMIN, APMAX, ISCANT, NPIPRE,
     1 NFRIDL, ICHKT, SIGMI, FADING, NORCHK, DANG, CON1, CON2, DTHMIN,
     2 DTHMAX, DOMA, DOMB, APTA, APTB, SIGPRE, SIGMA, ITMAX,NBALF,NEQFL,
     3 NRPSI, PSIST, DELPSI, DVECT(3), NFMS, IZZH, IHMIN, IHMAX, IZZK,
     4 KMIN, KMAX, IZZL, LMIN, LMAX, FLAM1, FLAM2, BETA,
     5 IORF, WL21,WL11,CILT, PERF, RLPMN,
     6 RLPMX, XIMX, SIMX, SCFOVFL, CELL(12)
      COMMON /XCHAR/ COMPID, TEXT, XNPSIFL, DATC, XSEQ, RDMP, ICAD,
     1 HTAOIS
      CHARACTER TEXT*36, COMPID*6, XNPSIFL*6, DATC*6, XSEQ*6,
     1 NFMS*4, RDMP(26)*62, ICAD*4, HTAOIS(25)*6
      COMMON /TODAY/ DATIJD
      CHARACTER DATIJD*25
      IF (MODE .EQ. 3) THEN
        CALL PLA262 (0)
        WRITE (LU7, 99986, IOSTAT = IOST) COMPID
        WRITE (LU7, 99985, IOSTAT = IOST) HPAR(1), HPAR(2), IPR(446)
        WRITE (LU7, 99995, IOSTAT = IOST) DTHMIN, DTHMAX, RLPMN,
     1                    RLPMX, IHMIN, IHMAX, KMIN, KMAX, LMIN, LMAX
        ANPI = ANPI / NMBR(11)
        WRITE (LU7, 99990, IOSTAT = IOST)
     1    (NMBR(I), RDMP(26), I = 11, 20)
        IF (IHPR(12) .GT. 0) THEN
          WRITE (LU7, 99978, IOSTAT = IOST) IHPR(12)
        END IF
        WRITE (LU7, 99989, IOSTAT = IOST) ANPI
        SSSI = HPAR(3) / HPAR(4)
        WRITE (LU7, 99977, IOSTAT = IOST) SSSI
        IF (IPR(425) .EQ. 1) WRITE (LU7,  99973, IOSTAT = IOST)
        IF (IPR(425) .EQ. 2) WRITE (LU7,  99972, IOSTAT = IOST)
        CALL PLA169 (-1, DUM, DUM, DUM, LU6)
        CALL PLA169 (-2, DUM, DUM, DUM, LU6)
        CALL PLA169 (-2, DUM, DUM, DUM, LU7)
      ELSE IF (MODE .EQ. 1) THEN
        NR = IHPR(8)
        DO I = 1, 3
          DO J = 1, 3
            R(I, J) = ORM(I, J, NR)
          END DO
        END DO
        CALL PLA242 (CELL, DC, VOL, R, ROR, NR - 1, COMPID, 0, RGBL(6))
        CALL PLA262 (0)
        WRITE (LU7, 99994, IOSTAT = IOST)
     1    COMPID, DATC, ISG, DATIJD(5:24)
        WRITE (LU7, 99993, IOSTAT = IOST)
     1    TEXT(31:36), RDMP(1), TEXT(23:25), RDMP(2), TEXT(8:11),
     2    TEXT(27:29), RDMP(3), TEXT(13:16), TEXT(17:21), RDMP(4)
        WRITE (LU7, 99992, IOSTAT = IOST)
     1    IRADIUS, RDMP(5), SLIT, RDMP(6), APTA, APTB, RDMP(7), APMIN,
     2    APMAX, RDMP(8), DTHMIN, DTHMAX, RDMP(9), DOMA, DOMB, RDMP(10)
        WRITE (LU7, 99991, IOSTAT = IOST)
     1    ISCANT, RDMP(11), NPIPRE, RDMP(12), SIGPRE, SIGMA, RDMP(13),
     2    ITMAX, RDMP(14), NBALF,NFRIDL,NEQFL, RDMP(15)
        WRITE (LU7, 99981, IOSTAT = IOST) IHPR(11), RDMP(16)
        WRITE (LU7, 99990, IOSTAT = IOST)
     1    (NMBR(I), RDMP(I + 16), I = 1, 10)
        WRITE (LU7, 99988, IOSTAT = IOST)
     1   IHMIN, IHMAX, NR - 1, KMIN, KMAX, LMIN, LMAX, XSEQ, PSIST,
     2   DELPSI, NRPSI, NFMS, (R(1, I), I = 1, 3),(ROR(1, I), I = 1, 3),
     3   IZZH, IZZK, IZZL, (R(2, I), I = 1, 3), (ROR(2, I), I = 1, 3),
     4   XNPSIFL, (R(3, I), I = 1, 3),
     4   (ROR(3, I), I = 1, 3), (DVECT(I), I = 1, 3), IHPR(9), ICHKT,
     5    SIGMI, FADING, NORCHK, DANG
        ICAD = '    '
        IF (NINT(CON1 *  1000000) .EQ. 586423) THEN
          ICAD = 'CAD0'
          IPR(424) = 0
        ELSE IF (NINT(CON1 * 1000000) .EQ. 586211) THEN
          ICAD = 'CAD1'
          IPR(424) = 0
        ELSE IF (NINT(CON1 * 1000000) .EQ. 587277) THEN
          ICAD = 'CAD2'
          IPR(424) = 2
        END IF
        WRITE (LU7, 99987, IOSTAT = IOST)
     1   FLAM1, FLAM2, WL21, PERF, IPR(424), DC(1), 0.0, DC(4), 0.0,
     2   BETA, DC(2), 0.0, DC(5), 0.0, ICAD, CON1, CON2, DC(3), 0.0,
     3   DC(6), 0.0, XRAYT(ISG), VOL, 0.0
      ELSE IF (MODE .EQ. 2) THEN
        KOR = IHPR(8)
        DO K = 1, KOR
          DO I = 1, 3
            DO J = 1, 3
              R(I, J) = ORM(I, J, K)
            END DO
          END DO
          CALL PLA242 (CELL, DC, VOL, R, ROR, K - 1, COMPID, LU7,
     1      RGBL(6))
        END DO
        IF (IPR(428) .EQ. 0) THEN
          DO ISGR = 1, ISG
            IF (IRFZ(ISW(2), ISGR) .GT. 1) THEN
              CALL PLA262 (0)
              WRITE (LU7,  99999, IOSTAT = IOST) COMPID, ISGR
              IRFX = IHPR(9) + 1
              DO 70 IRF = 1, IRFX
                IX = IRFY(IRF)
                IH = 0
                IK = 0
                IL = 0
                IF (IX .LT. 0) THEN
                  GO TO 70
                ELSE IF (IX .GT. 0) THEN
                  IH = IORREF(IX, 1)
                  IK = IORREF(IX, 2)
                  IL = IORREF(IX, 3)
                END IF
                IF (IRF .EQ. 4) CALL PLA262 (0)
                WRITE (LU7,  99984, IOSTAT = IOST) IH, IK, IL
                KK = IPR(446) + 1
                DO I = 1, KK
                  II = I - 1
                  WRITE (LU7, 99983, IOSTAT = IOST)
     1              II, P(I, IRF, ISGR), II, D(I, IRF, ISGR)
                END DO
                NST = IRFZ(IRF, ISGR)
                WRITE (LU7, 99998, IOSTAT = IOST) NST
                SQPC = SQRT(PC(IRF, ISGR))
                WRITE (LU7, 99997, IOSTAT = IOST)
     1            (FMN(I, IRF, ISGR), I = 1, 9), SQPC
   70         CONTINUE
            END IF
          END DO
        END IF
      END IF
      RETURN
99999 FORMAT ('R E F E R E N C E   A N D   S C A L I N G   D A T A'
     1 , '   FOR: ', A, /, 65('='), //, 25X, 'DATCOL SET:', I3,
     2 /, 25X, 14('=')/)
99998 FORMAT ('FREQUENCY OF THIS REFERENCE REFLECTION', 18('.'), I9)
99997 FORMAT ('MEAN OF UNSCALED REFERENCE REFLECTION', 19('.'),
     1 F9.0, /, 11X, 'R.M.S. DEVIATION (PERCENT)', 19('.'),
     2 F9.2, /, 26X, 'CHI-SQUARED', 19('.'),
     3 F9.2, /, 'MEAN OF 1-SCALED REFERENCE REFLECTION', 19('.'),
     4 F9.0, /, 11X, 'R.M.S. DEVIATION (PERCENT)', 19('.'),
     5 F9.2, /, 26X, 'CHI-SQUARED', 19('.'),
     6 F9.2, /, 'MEAN OF RESCALED REFERENCE REFLECTION', 19('.'),
     7 F9.0, /, 11X, 'R.M.S. DEVIATION (PERCENT)', 19('.'),
     8 F9.2, /, 26X, 'CHI-SQUARED', 19('.'),
     9 F9.2, /, 'INSTABILITY CONSTANT P ', 33('.'), F9.4)
99995 FORMAT ('THETA MIN / THETA MAX (DEG) (ACTUAL VALUES)', 4('.'),
     1 2F9.2,/,'1/LP  MIN / 1/LP  MAX', 26('.'), 2F9.2/'HMIN , HMAX ',
     2 ' (ACTUAL)', 26('.'), 2I9/'KMIN , KMAX  (ACTUAL)', 26('.'),
     3 2I9/'LMIN , LMAX  (ACTUAL)', 26('.'), 2I9)
99994 FORMAT (65('='), /, 'D A T A  C O L L E C T I O N  ',
     1 'D O C U M E N T  F O R :', 5X, A, /, 65('='), /, A,
     2 ' SET:', I3, 7X, 'ANALYSIS DATE: ', A, '   TIME: ', A, 22X,
     3 'R E F D U M P  L I S T', /, 65('-'), 22X, 22('='), /)
99993 FORMAT ('COLLECTION DATE', 43('.'), 1X, A, 4X, A, /,
     1 'DIFFRACTOMETER AND TEMPERATURE', 23('.'), 'CAD4', 5X, A3,
     2 4X, A, /, 'RADIATION AND FILTER', 33('.'), A4, 5X, A3, 4X,
     3 A, /, 'VOLTAGE AND CURRENT', 34('.'), A, 3X, A, 4X, A)
99992 FORMAT ('DETECTOR TO CRYSTAL DISTANCE (MM)', 25('.'), I7, 4X,
     1 A, /, 'VERTICAL APERTURE (MM)', 36('.'), F7.2, 4X, A, /,
     2 'HORIZONTAL APERTURE (MM), A + B TAN( THETA)', 7('.'), F7.2,
     3 ',', F7.2, 4X, A, /, 'HORIZONTAL APERTURE LIMITS (MM)',
     4 19('.'), F7.2, ',', F7.2, 4X, A, /,
     5 'THETA MIN / THETA MAX ( DEG )', 21('.'), F7.2, ',', F7.2,
     6 4X, A, /, 'OMEGA SCAN ANGLE (DEG),   A + B TAN( THETA)',
     7 7('.'), F7.2, ',', F7.2, 4X, A)
99991 FORMAT ('THETA/OMEGA MOVEMENT RATIO', 32('.'), I5, '/6',4X,A/
     1 'PRESCAN SPEED 20/N (DEG/MIN)', 30('.'), I7, 4X, A/,
     2 'PRE- AND FINAL SCAN SIGMA(I)/I RATIO',14('.'),
     3 F7.2,',',F7.2,4X,A/,'FINAL SCAN TIME LIMIT (SEC.)', 30('.'),
     4 I7,4X,A/,
     5 'NBALF,NFRIDL,NEQFL FLAGS',18('.'),I7,',',I7,',',I7,4X,A)
99990 FORMAT (
     1 'TOTAL NUMBER OF MEASURED REFLECTIONS', 22('.'), I7, 4X, A, /
     2 'TOTAL NUMBER OF NORMAL   REFLECTIONS', 22('.'), I7, 4X, A, /
     3 'NUMBER OF MEASURED REFF. REFLECTIONS', 22('.'), I7, 4X, A, /
     4 'NUMBER OF TOO WEAK       REFLECTIONS', 22('.'), I7, 4X, A, /
     5 'NUMBER OF STRONG         REFLECTIONS', 22('.'), I7, 4X, A, /
     6 'NUMBER OF TOO STRONG     REFLECTIONS', 22('.'), I7, 4X, A, /
     7 'NUMBER OF SIGN. DEV.     REFLECTIONS', 22('.'), I7, 4X, A, /
     8 'NUMBER OF FILTER         REFLECTIONS', 22('.'), I7, 4X, A, /
     9 'NUMBER OF IMPOSSIBLE     REFLECTIONS', 22('.'), I7, 4X, A, /
     * 'NUMBER OF NEG. RESCANNED REFLECTIONS', 22('.'), I7, 4X, A)
99989 FORMAT ('AVERAGE SCAN SPEED NPI', 36('.'), F7.1)
99988 FORMAT ('HMIN , HMAX', 39('.'), I7, ',', I7, 20X,
     1 'ORIENTATION MATRIX NR:', I3, /, 'KMIN , KMAX', 39('.'), I7,
     2 ',', I7, 20X, 25('='), /, 'LMIN , LMAX', 39('.'), I7, ',',
     3 I7, /, 'DATA COLLECTION TYPE', 38('.'), 1X, A, 6X,
     4 'RECIPROCAL AXES MATRIX', 10X, 'DIRECT AXES MATRIX', /,
     5 'PSI SCAN PARAMETERS(PSIST,DELPSI,NRPSI)', 3('.'), F7.2, ',',
     6 F7.2, ',', I7, 5X, 2(25('-'), 5X), /,
     7 'HKL INCREMENT ORDER(FAST,MEDIUM,SLOW)', 21('.'), 4X, A4,
     8 3F10.6, 2X, 3F10.5, /, 'STARTING VALUES OF H, K, L',
     9 16('.'), I7, ',', I7, ',', I7, 1X, 3F10.6, 2X, 3F10.5, /,
     * 'DATA COLLECTION METHOD', 36('.'), 1X, A, 1X, 3F10.6, 2X,
     1 3F10.5, /, 'FLAT OR NEEDLE VECTOR(WHEN USED)', 10('.'),
     2 F7.3, ',', F7.3, ',', F7.3, /,
     3 'NUMBER OF REFERENCE REFLECTIONS', 27('.'), I7, /,
     4 'REF. REFLECTION MEASURED EVERY (SEC)', 22('.'), I7, /,
     5 'SIGMA(I)/I RATIO FOR CONTROL REFL.', 24('.'), F7.3, /,
     6 'MAX. DROP IN REF. REFL. INTENSITY', 25('.'), F7.2, /,
     7 'ORIENTATION CONTROL EVERY N REFL.', 25('.'), I7, /,
     8 'MAXIMUM ROTATION OF SCATT. VECTOR', 25('.'), F7.3)
99987 FORMAT ('WAVE LENGTH ALPHA1,ALPHA2 AND MEAN', 8('.'), 2(F7.5,
     1 ','), F7.5, /, 'MONOCHROMATOR PERF ( 0=NO, 1/ 2=YES )',
     2 13('.'), ',', F7.2, I7, 5X, ' A  = ', F8.4, '(', F6.4, ')',
     3 4X, 'ALPHA =', F7.2, '(', F6.2, ')', /, 'FILTER FACTOR',
     4 45('.'), F7.2, 5X, ' B  = ', F8.4, '(', F6.4, ')', 4X,
     5 'BETA  =', F7.2, '(', F6.2, ')', /,
     6 'DIFFR. CONSTANTS CAD, CON1 AND CON2', 7('.'), 2X, A, ' ,',
     7 F7.6, ',', F7.6, 5X, ' C  = ', F8.4, '(', F6.4, ')', 4X,
     8 'GAMMA =', F7.2, '(', F6.2, ')', /,
     9 'TOTAL OF XRAY EXPOSURE TIME (HOUR)', 24('.'), F7.1, 5X,
     * ' V  = ', F8.1, '(', F6.1, ')')
99986 FORMAT ('D A T A   R E D U C T I O N   D O C U M E N T  F O R '
     1 , ':', 5X, A, /, 65('='), //)
99985 FORMAT ('MINIMUM AND MAXIMUM OF APPLIED SCF.', 12('.'), 2F9.3,
     1 /, 'DEGREE OF POLYNOMIAL THROUGH REF.R.', 21('.'), I9)
99984 FORMAT (/, 'POLYNOMIAL COEFFICIENTS FOR REFERENCE REFLECTION',
     1 8('.'), 3I3)
99983 FORMAT ((14X, 'A(', I2, ')= ', F16.5, ',SIG(A(', I2, '))= ',
     1 F15.5))
99981 FORMAT ('NUMBER  OF LAST MEASURED REFLECTION ', 22('.'), I7,
     1 4X, A)
99978 FORMAT ('NUMBER OF SKIPPED <SUB>  REFLECTIONS', 22('.'), I7)
99977 FORMAT ('SUM(SIGMA)/SUM(INTENSITY) RATIO', 27('.'), F7.4)
99973 FORMAT (//, 'MSM-Peak/Background option applied')
99972 FORMAT (//, 'MSA-Peak/Background option applied')
      END SUBROUTINE PLA244
      SUBROUTINE PLA245 (NR)
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NVD=100000000,NP23=28000,
     1 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     2 -(7*IP5+11)*(IP2*IP3)-149)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      IF (NR .LT. 0) THEN
        GO TO 10
      ELSE IF (NR .EQ. 1) THEN
        WRITE (LU6, 99999, IOSTAT = IOST) IHPR(3)
        WRITE (LU7, 99999, IOSTAT = IOST) IHPR(3)
      ELSE IF (NR .EQ. 2) THEN
        WRITE (LU6, 99998, IOSTAT = IOST) IHPR(1)
        WRITE (LU7, 99998, IOSTAT = IOST) IHPR(1)
      ELSE IF (NR .EQ. 3) THEN
        WRITE (LU6, 99997, IOSTAT = IOST)
        WRITE (LU7, 99997, IOSTAT = IOST)
      ELSE IF (NR .EQ. 4) THEN
        WRITE (LU6, 99996, IOSTAT = IOST) IHPR(2)
        WRITE (LU7, 99996, IOSTAT = IOST) IHPR(2)
      ELSE IF (NR .EQ. 5) THEN
        WRITE (LU6, 99995, IOSTAT = IOST)
        WRITE (LU7, 99995, IOSTAT = IOST)
      ELSE IF (NR .EQ. 6) THEN
        WRITE (LU6, 99994, IOSTAT = IOST) ISG
        WRITE (LU7, 99994, IOSTAT = IOST) ISG
      ELSE
        GO TO 10
      END IF
      CALL GEN127 (' ')
   10 RETURN
99999 FORMAT (//, ':: STOP, THERE ARE MORE THAN', I4,
     1 ' SCALING GROUPS')
99998 FORMAT (/, ':: EXIT - REASON : MORE THAN', I2,
     1 ' REFERENCE REFLECTIONS')
99997 FORMAT (/, ':: N O  D A T A  O N  F I L E   C A D 4'/)
99996 FORMAT (/, ':: MAXIMUM NUMBER OF REFL./SCGR:',I4,' EXCEEDED')
99995 FORMAT (/, ':: STOP - PROBLEM WITH REFDUMP REFLECTIONS',/)
99994 FORMAT (/, ':: STOP - INCOMPLETE REF. REFL. SET IN GROUP',I5,/)
      END SUBROUTINE PLA245
      SUBROUTINE PLA246 (SCF, IR, ISGR, XRT)
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     2 -(7*IP5+11)*(IP2*IP3)-149,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
       DATA J0, ISGR0, DER / 0, 0, 0.0/
      SCF = 1.0
      I   = IR
      J   = ISGR
   10 IF (IRFZ(I, J) .EQ. 0) THEN
        J = J - 1
        IF (J .GT. 0) GO TO 10
      ELSE IF (IRFZ(I, J) .EQ. 1) THEN
        SCF = P(1, I, 1) / P(1, I, J)
      ELSE
        SCF = P(1, I, 1) / GEN071 (IPR(446), A(1, I, J), B(1, I, J),
     1        C(1, I, J), XRT, DER)
      END IF
      IF (J .LT. ISGR) THEN
        IF (J .NE. J0 .AND. ISGR .NE. ISGR0) THEN
          WRITE (LU7, 99999, IOSTAT = IOST) J, ISGR
          J0 = J
          ISGR0 = ISGR
        END IF
      END IF
      RETURN
99999 FORMAT (':: Note: SCALING GROUP', I3,' Used for SCALING GROUP',
     1   I3)
      END SUBROUTINE PLA246
      SUBROUTINE PLA247
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     2 -(7*IP5+11)*(IP2*IP3)-149,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /PROT/ IRADIUS, SLIT, APMIN, APMAX, ISCANT, NPIPRE,
     1 NFRIDL, ICHKT, SIGMI, FADING, NORCHK, DANG, CON1, CON2, DTHMIN,
     2 DTHMAX, DOMA, DOMB, APTA, APTB, SIGPRE, SIGMA, ITMAX,NBALF,NEQFL,
     3 NRPSI, PSIST, DELPSI, DVECT(3), NFMS, IZZH, IHMIN, IHMAX, IZZK,
     4 KMIN, KMAX, IZZL, LMIN, LMAX, FLAM1, FLAM2, BETA,
     5 IORF, WL21,WL11,CILT, PERF, RLPMN,
     6 RLPMX, XIMX, SIMX, SCFOVFL, CELL(12)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /XCHAR/ COMPID, TEXT, XNPSIFL, DATC, XSEQ, RDMP, ICAD,
     1 HTAOIS
      CHARACTER TEXT*36, COMPID*6, XNPSIFL*6, DATC*6, XSEQ*6,
     1 RDMP(26)*62, ICAD*4, HTAOIS(25)*6
      CHARACTER NFMS*4, LINE*80, CODE*6, C1*1, C2*1, NQ1*7
      DIMENSION DX(3), TX(3), RFL(3), SFL(3)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      XLP    = 0.0
      IRIMIN = - 10000
      IF (IPR(425) .EQ. 3) THEN
        DO I = 1, IP9
          ABAK = BAK(I, 1) * WL21
          IF (ABAK .LT. 1.0) THEN
            ABAK = ASIN(ABAK) * HPAR(24)
          ELSE
            ABAK = 0.0
          END IF
          BAK(I, 1) = ABAK
        END DO
        CALL GEN108 (LU10, 0)
        DO
          READ (LU10, IOSTAT = IOST) NREFL, IH, IK, IL, CODE, PSI, NPI,
     1      IBGL, ISC, IBGR, THETA, PHIK, OMK, RKAPPA, WIDTH, IXRYT,
     2      IFRIDL, ILT, ISGR, XI, SI, IPRT, IORM, IBTST, FSCF
          IF (IOST .NE. 0) EXIT
          IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) EXIT
          SCF = 1.0
          IF (IPR(428) .NE. 1) THEN
            XRT = IXRYT / 3600.0
            CALL PLA246 (SCF, IHPR(9) + 1, ISGR, XRT)
          END IF
          DO J = 2, IP9, 2
            IF (THETA .LT. BAK(J, 1)) EXIT
          END DO
          XBGL = IBGL * SCF * FSCF / NPI
          XBGR = IBGR * SCF * FSCF / NPI
          BGMIN = MIN (XBGL, XBGR)
          BGMAX = MAX (XBGL, XBGR)
          IF (BGMAX .LT. 3.0 * BGMIN) THEN
            BAK(J, 4) = BAK(J, 4) + 1.0
            BAK(J, 5) = BAK(J, 5) + BGMIN
          END IF
        END DO
        DO I = 2, IP9, 2
          IF (NINT(BAK(I, 4)) .GT. 0) THEN
            BAK(I,     5) = 4.0 * BAK(I, 5) / BAK(I, 4)
            BAK(I - 1, 5) = BAK(I, 5)
          END IF
        END DO
        DO I = 2, IP9 - 2, 2
          IF (NINT(BAK(I, 4)) .GT. 0.0 .AND.
     1        NINT(BAK(I + 2, 4)) .GT. 0.0) THEN
            BAK(I, 5) = (BAK(I - 1, 5) + BAK(I + 1, 5)) / 2.0
          END IF
        END DO
        DO I = 1, IP9
          IF (BAK(I, 5) .GT. 0.0) THEN
            WRITE (LU6, '(I5, 3F10.2)', IOSTAT = IOST)
     1     I, BAK(I, 1), BAK(I, 4), BAK(I, 5)
          END IF
        END DO
      END IF
      CALL PLA169 (0, DUM, DUM, DUM, LU6)
      DTHMAX = 0.0
      DTHMIN = 90.0
      RLPMX  = 0.0
      RLPMN  = 10.0
      XMONCU = 26.6 / HPAR(24)
      XMONMO = 12.2 / HPAR(24)
      IPNR   = 0
      TMON   = XMONMO
      NN     = 1
      IF (WL21 .GT. 1.0) TMON = XMONCU
      CTTM   = COS(TMON)
      CKWTTM = CTTM**2
      SCFOVFL = 10.0
   40 SCFOVFL = SCFOVFL * 0.1
      IF (SCFOVFL * SIMX .GT. 10000.0) GO TO 40
      IF (SCFOVFL * XIMX .GT. 1.0E8) GO TO 40
      IHMAX  = -999
      IHMIN  =  999
      KMAX   = -999
      KMIN   =  999
      LMAX   = -999
      LMIN   =  999
      MORMO  =  0
      SINAL  = SQRT(CON1)
      COSAL  = CON2
      CALL GEN108 (LU10, 0)
      LX  = LU11
      CALL GEN108 (LX, 0)
      ILN = IGBL(102)
      DO
   50   READ (LX, END = 60) NREFL, IH, IK, IL, CODE, PSI, NPI, IBGL,
     1   ISC, IBGR, THETA, PHIK, OMK, RKAPPA, WIDTH, IXRYT, IFRIDL,
     2   ILT, ISGR, XI, SI, IPRT, IORM, IBTST, FSCF
        IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) THEN
          WRITE (LU7, 99999, IOSTAT = IOST)
          GO TO 50
        END IF
        IF ((IH .EQ. IK) .AND. (IK .EQ. IL)) THEN
          RFL(1) = REAL(IH)
          RFL(2) = REAL(-IH)
          RFL(3) = 0.0
        ELSE
          RFL(1) = REAL(IK - IL)
          RFL(2) = REAL(IL - IH)
          RFL(3) = REAL(IH - IK)
        END IF
        DO I = 1, 3
          SFL(I) = 0.0
          DO J = 1, 3
            SFL(I) = SFL(I) + RFL(J) * ROR(J, I)
          END DO
        END DO
        SINQ   = SIN(PHIK / HPAR(24))
        COSQ   = COS(PHIK / HPAR(24))
        RFL(1) =   SFL(1) * COSQ + SFL(2) * SINQ
        RFL(2) = - SFL(1) * SINQ + SFL(2) * COSQ
        RFL(3) =   SFL(3)
        SFL(1) =   RFL(1) * COSAL - RFL(3) * SINAL
        SFL(2) =   RFL(2)
        SFL(3) =   RFL(1) * SINAL + RFL(3) * COSAL
        SINQ   = SIN(RKAPPA / HPAR(24))
        COSQ   = COS(RKAPPA / HPAR(24))
        RFL(1) =   SFL(1) * COSQ + SFL(2) * SINQ
        RFL(2) = - SFL(1) * SINQ + SFL(2) * COSQ
        RFL(3) =   SFL(3)
        SFL(1) =   RFL(1) * COSAL + RFL(3) * SINAL
        SFL(2) =   RFL(2)
        SFL(3) = - RFL(1) * SINAL + RFL(3) * COSAL
        SINQ   = SIN((OMK - THETA) / HPAR(24))
        COSQ   = COS((OMK - THETA) / HPAR(24))
        RFL(1) =   SFL(1) * COSQ + SFL(2) * SINQ
        RFL(2) = - SFL(1) * SINQ + SFL(2) * COSQ
        RFL(3) =   SFL(3)
        IF (THETA .LT. 0.0) THEN
          RFL(2) = - RFL(2)
          RFL(3) = - RFL(3)
        END IF
        PSICRY = HPAR(24) * ATAN2(RFL(1), RFL(3))
        GO TO 80
   60   IF (LX .EQ. LU10) GO TO 110
        LX   = LU10
        CALL GEN108 (LX, 0)
        IF (IPNR  .GT. 0) THEN
          DO J = 1, IPNR
   70       IF (LU15 .EQ. 1) THEN
              CALL GGIP (-999.0, 0.0, 0.0, -2)
            ELSE
              CALL GGIP (-999.0, 0.0, 0.0, 3)
            END IF
            CALL GGIP (25.0, 25.0, 0.0, 1)
            CALL GGIP (0.0,   0.0, 0.0, 3)
            CALL GGIP (0.0,  25.0, 0.0, 2)
            CALL GGIP (25.0, 25.0, 0.0, 2)
            CALL GGIP (25.0,  0.0, 0.0, 2)
            CALL GGIP (0.0,   0.0, 0.0, 2)
            CALL GGIP09 (0.0, COMPID, 6, 0.7, 1, 2, 0.3, 24.0)
            CALL GGIP (12.5, 12.5, 0.0, -3)
            CALL GGIP09 (0.0, 'Psi-Scan', 8,  0.6, 1, 2, -12.0, -12.2)
            CALL GGIP09 (0.0, '0',        1, 0.25, 1, 2,  12.0,  -0.1)
            CALL GGIP09 (0.0, '90',       2, 0.25, 1, 2,  -0.2, -12.0)
            CALL GGIP09 (0.0, '180',      3, 0.25, 1, 2, -12.4,  -0.1)
            CALL GGIP09 (0.0, '270',      3, 0.25, 1, 2,  -0.2,  11.6)
            TEMP  = 0.0
            TEMP1 = 1.0E10
            DO I = 1, 36
              IF (PSIS(I, J) .GE. 0.01) THEN
                TEMP  = MAX (TEMP,  PSIS(I, J))
                TEMP1 = MIN (TEMP1, PSIS(I, J))
              END IF
            END DO
            IPERC = NINT(TEMP1 * 100.0 / TEMP)
            DO K = 1, 2
              CALL GGIP(0.0, FLOAT(K), 0.0, 0)
              DO I = 1, 36
                PSI = (I - 1) * 10.0 / HPAR(24)
                XPL =  COS(PSI)
                YPL = -SIN(PSI)
                XP  = 6.5
                YP  = 6.5
                DS  = 0.1 * (K - 1)
                IF (K .NE. 1) THEN
                  PSS = PSIS(I, J) / TEMP
                  IF (PSS .LT. 0.0) PSS = 0.0
                  XP = PSS * XP
                  YP = PSS * YP
                END IF
                XPL = XPL * (XP + 5.0)
                YPL = YPL * (YP + 5.0)
                IF (K .NE. 1) THEN
                  IF (I .LT. 2) THEN
                    XP0 = XPL
                    YP0 = YPL
                  ELSE
                    CALL GGIP (XPL, YPL, 0.0, 2)
                  END IF
                END IF
                YPL = YPL - DS
                CALL GGIP (XPL, YPL, 0.0, 3)
                IF (K .LT. 2) THEN
                  XPL = XPL * (5.0 / 11.5)
                  YPL = YPL * (5.0 / 11.5)
                  CALL GGIP (XPL, YPL, 0.0, 2)
                ELSE
                  DO L = 1, 3, 2
                    DY = DS * (2 - L)
                    DO M = 1, 3, 2
                      DDX  = DS * (2 - M) * (2 - L)
                      XPL = XPL + DDX
                      YPL = YPL + DY
                      CALL GGIP (XPL, YPL, 0.0, 2)
                    END DO
                  END DO
                  YPL = YPL + DS
                  CALL GGIP (XPL, YPL, 0.0, 3)
                END IF
              END DO
              IF (K .NE. 1) THEN
                CALL GGIP (XP0, YP0, 0.0, 2)
                CALL GGIP (0.0, 0.0, 0.0, 3)
              END IF
            END DO
            DO JJ = 1, 3
              XPL = 5 + JJ * 2
              CALL GEN040 (IHKLP(JJ, J), NQ1, IPX)
              CALL GGIP09 (0.0, NQ1, IPX, 0.5, 1, 2, XPL, -12.2)
            END DO
            IPX = 0
            CALL GEN040 (IPERC, NQ1, IPX)
            CALL GGIP09 (0.0, NQ1, IPX, 0.5, -1, 2, 11.0, 11.5)
            CALL GGIP (0.0, 0.0, 0.0, 3)
            CALL GGIP (0.0, 0.0, 0.0, -1)
            CALL PLA013 (4, 1)
            IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
              GO TO 70
            ELSE IF (IGGT(1:1) .EQ. '!') THEN
              CALL PLA280 ('NEXT')
            END IF
            IF (IGGT(1:4) .EQ. 'EXIT') GO TO 50
            CALL GEN038 (IGGT, 1, 80)
          END DO
        END IF
        GO TO 50
   80   IF (MORMO .NE. IORM) MORMO = IORM
        SCF  = 1.0
        ANPI = ANPI + IABS(NPI)
        IF (LX .NE. LU11) THEN
          IF (CODE(1:1) .NE. 'I') THEN
            IHMAX = MAX (IHMAX, IH)
            KMAX  = MAX (KMAX,  IK)
            LMAX  = MAX (LMAX,  IL)
            IHMIN = MIN (IHMIN, IH)
            KMIN  = MIN (KMIN,  IK)
            LMIN  = MIN (LMIN,  IL)
          END IF
          IF (IPR(428) .NE. 1) THEN
            XRT = IXRYT / 3600.0
            CALL PLA246 (SCF, IHPR(9) + 1, ISGR, XRT)
            HPAR(2) = MAX (HPAR(2), SCF)
            HPAR(1) = MIN (HPAR(1), SCF)
          END IF
        END IF
        IF (IPR(425) .EQ. 3) THEN
          IF (MAX(IBGL, IBGR) .GT. 3.0 * MIN (IBGL, IBGR)) THEN
            DO II = 1, IP9
              IF (THETA .LT. BAK(II, 1)) EXIT
            END DO
            SCFX = FSCF / FLOAT(IABS(NPI))
            BACK = BAK(II, 5) / (SCF * SCFX)
            XI = (ISC - BACK)     * 100.0 * SCFX
            SI = SQRT(FLOAT(ISC)) * 100.0 * SCFX
          END IF
        END IF
        XI = XI * SCF
        SI = SI * SCF
        PSI = PSI / HPAR(24)
        XXX = IH * ORM(1, 1, IORM) + IK * ORM(1, 2, IORM)
     1                             + IL * ORM(1, 3, IORM)
        YYY = IH * ORM(2, 1, IORM) + IK * ORM(2, 2, IORM)
     1                             + IL * ORM(2, 3, IORM)
        ZZZ = IH * ORM(3, 1, IORM) + IK * ORM(3, 2, IORM)
     1                             + IL * ORM(3, 3, IORM)
        HXY  = XXX**2   + YYY**2
        RRR  = SQRT(HXY + ZZZ**2)
        HXY  = SQRT(HXY)
        STH  = 0.5 * WL11 * RRR
        TH   = ASIN(STH)
        TTH  = 2 * TH
        IF (HXY .LT. 1.0E-7) THEN
          CHI = 90.0 / HPAR(24)
          PHI = 0.0
        ELSE
          PHI = ATAN2(-XXX, YYY)
          CHI = ATAN2( ZZZ, HXY)
        END IF
        OM   = TH
        CPHI = COS(PHI)
        SPHI = SIN(PHI)
        CCHI = COS(CHI)
        SCHI = SIN(CHI)
        CTT  = COS(TTH)
        STT  = SIN(TTH)
        SCTT = CTT**2
        COM  = COS(OM)
        SOM  = SIN(OM)
        IF (IPR(424) .EQ. 0) THEN
          XLP =  (1 + SCTT) / 2.0
        ELSE IF (IPR(424) .EQ. 1) THEN
          XLP = PERF * (CKWTTM + SCTT) / (1.0 + CKWTTM)
     1        + (1.0 - PERF) * (CTTM + SCTT) / (1.0 + CTTM)
        ELSE IF (IPR(424) .EQ. 2) THEN
          XLP = PERF * (1 + CKWTTM * SCTT) / (1 + CKWTTM)
     1        + (1.0 - PERF) * (1.0 + CTTM * SCTT) / (1.0 + CTTM)
        END IF
        RLP = STT / XLP
        DTHMAX = MAX (DTHMAX, ABS(THETA))
        DTHMIN = MIN (DTHMIN, ABS(THETA))
        RLPMX  = MAX (RLPMX, RLP)
        RLPMN  = MIN (RLPMN, RLP)
        SQSCHI = SCHI**2
        SQCHI  = SQRT(SQSCHI)
        IF (SQCHI .GT. 0.0) THEN
          SSS = SCHI / SQCHI
        ELSE
          SSS = 1
        END IF
        IF (ABS(PSI) .GT. 0.0) THEN
          CPSI   = COS(PSI)
          SPSI   = SIN(PSI)
          ACCHI  = CPSI * CCHI
          SQACHI = ACCHI**2
          ASCHI  = SSS * SQRT(ABS(1 - SQACHI))
          ACHI   = ATAN2(ASCHI, ACCHI)
          SETA   = CCHI * SPSI / ASCHI
          CETA   = SCHI / ASCHI
          ETA    = ATAN2(SETA, CETA)
          AOM    = ETA + TH
          SDD    = -SPSI / ASCHI
          CDD    = CPSI * SCHI / ASCHI
          DD     = ATAN2(SDD, CDD)
          APHI   = DD + PHI
          ACPHI  = COS(APHI)
          ASPHI  = SIN(APHI)
          ACOM   = COS(AOM)
          ASOM   = SIN(AOM)
        ELSE
          ACCHI = CCHI
          ASCHI = SCHI
          ACPHI = CPHI
          ASPHI = SPHI
          ACOM  = COM
          ASOM  = SOM
          ACHI  = CHI
          APHI  = PHI
          AOM   = OM
        END IF
        DO I = 1, 3
          DEN = SQRT(ORM(1, I, IORM)**2 + ORM(2, I, IORM)**2
     1                                  + ORM(3, I, IORM)**2)
          X1    = ORM(1, I, IORM) / DEN
          Y1    = ORM(2, I, IORM) / DEN
          Z1    = ORM(3, I, IORM) / DEN
          X2    =   X1 * ACPHI + Y1 * ASPHI
          Y2    = - X1 * ASPHI + Y1 * ACPHI
          Y3    =   Y2 * ACCHI + Z1 * ASCHI
          TX(I) =   X2 * ACOM  + Y3 * ASOM
          Y4    = - X2 * ASOM  + Y3 * ACOM
          DX(I) = - TX(I) * CTT + Y4 * STT
        END DO
        ACHI = ACHI * HPAR(24)
        APHI = APHI * HPAR(24)
        AOM  = AOM  * HPAR(24)
        PSI  = PSI  * HPAR(24)
        TH   = TH   * HPAR(24)
        XRLP = RLP
        HPAR(3) = HPAR(3) + SI
        HPAR(4) = HPAR(4) + XI
        IRI     = MAX (IRIMIN, NINT(XI * XRLP * SCFOVFL))
        IRISIG = MAX (1, NINT(SI * XRLP * SCFOVFL))
        ILT    = 1
        IF (IRI .LT. CILT * IRISIG) ILT = 2
        C1 = CODE(1:1)
        C2 = CODE(2:2)
        IC = 0
        IF (C1 .EQ. 'N') IC = 2
        IF (C1 .EQ. 'I') IC = 1
        IF (LX .NE. LU10 .AND. IC .NE. 1) THEN
          IF (IPNR .NE. 0) THEN
            IF (IH .EQ. IHKLP(1, IPNR) .AND. IK .EQ. IHKLP(2, IPNR)
     1        .AND. IL .EQ. IHKLP(3, IPNR)) GO TO 90
          END IF
          IF (IPNR .LT. IP4) THEN
            IPNR = IPNR + 1
          ELSE
            GO TO 100
          END IF
          IHKLP(1, IPNR) = IH
          IHKLP(2, IPNR) = IK
          IHKLP(3, IPNR) = IL
   90     IPSI0 = NINT(PSI)
          IF (IPSI0 .LT. 0) IPSI0 = IPSI0 + 360
          IPSI1 = IPSI0 / 10 + 1
          PSIS(IPSI1, IPNR) = IRI
          IPSI0 = MOD(NINT(PSI + 180.0), 360)
          IF (IPSI0 .LT. 0) IPSI0 = IPSI0 + 360
          IPSI2 = IPSI0 / 10 + 1
          IRI0 = NINT(PSIS(IPSI2, IPNR))
          IF (IRI0 .GT. 0) GO TO 100
          PSIS(IPSI2, IPNR) = - IRI
        END IF
  100   IF (LX .NE. LU11) THEN
          STHL = SIN(THETA * 0.01745329) / WL21
          CALL PLA169 (1, FLOAT(IRI), FLOAT(IRISIG), STHL, LU6)
        END IF
        IF (IAND(IPRT, 8189) .NE. 0) THEN
          XIOSI = FLOAT(IRI) / FLOAT(IRISIG)
          IORM0 = IORM - 1
          IIBGL = MIN (99999,  IBGL)
          IISC  = MIN (9999999, ISC)
          IIBGR = MIN (99999,  IBGR)
          IF (IBTST .LT. 0) ILT = 0
          IFRIDL = IABS(IFRIDL)
          IF (IPR(320) .GT. 0) THEN
            ILN = ILN + 1
            IF (ILN .GT. IGBL(102)) THEN
              CALL PLA262 (0)
              ILN = 6
              WRITE (LU7, 99993, IOSTAT = IOST)
            END IF
            WRITE (LU7, 99992, IOSTAT = IOST)
     1        IH, IK, IL, CODE, IFRIDL, ILT, ISGR, IORM0, SCF, 1.0, RLP,
     2        NPI, IIBGL, IISC, IIBGR, THETA, PHIK,  RKAPPA, OMK, WIDTH,
     3        IXRYT, IRI, IRISIG, XIOSI, PSI, NREFL
          END IF
        END IF
        IF (C1 .NE. 'I' .AND. C2 .NE. 'X' .AND. C2 .NE. 'C'
     1          .AND. IBTST .GE. 0) THEN
          IIRISIG = MIN (99999, IRISIG)
          IF (LX .EQ. LU11) THEN
            WRITE (LU4, 99994, IOSTAT = IOST)
     1        IH, IK, IL, IRI, IIRISIG, NN, (TX(I), DX(I), I = 1, 3)
          ELSE
            WRITE (LU17, 99994, IOSTAT = IOST)
     1        IH, IK, IL, IRI, IIRISIG, NN, (TX(I), DX(I), I = 1, 3)
            IF (IPR(426) .EQ. 1) WRITE (LU60, 99998, IOSTAT = IOST)
     1        IH, IK, IL, IRI, IIRISIG, PSICRY
          END IF
        END IF
      END DO
  110 WRITE (LU17, 99991, IOSTAT = IOST)
      IF (IPR(426) .EQ. 1) WRITE (LU60, 99991, IOSTAT = IOST)
      CALL GEN108 (LU4, 1)
      DO
        READ (LU4, 99997, IOSTAT = IOST) LINE
        IF (IOST .NE. 0) EXIT
        WRITE (LU17, 99997, IOSTAT = IOST) LINE
      END DO
      WRITE (LU17, 99991, IOSTAT = IOST)
      RETURN
99999 FORMAT (25('*'), ' REFLECTION H=0,K=0,L=0 DELETED ', 25('*'))
99998 FORMAT (3I4, 2I8, F9.3)
99997 FORMAT (A)
99994 FORMAT (3I4, 2I8, I4, 6F8.5)
99993 FORMAT ('  H  K  L  CODE FL S O  SCF  1/T 1/LP NPI  BL    ISC',
     1 3X, 'BR THETA   PHIK  KAPPA    OMK WIDTH XRAYT  I(NET) SIG(I) '
     2 , 'I/S(I)    PSI NREFL'/)
99992 FORMAT (3I3, 1X, A, 2I1, 2I2, 3F5.2, I3, I5, I7, I5, F6.2,
     1 3F7.2, F5.2, I7, I9, I6, F7.1, F7.2, I6)
99991 FORMAT (1X)
      END SUBROUTINE PLA247
      SUBROUTINE PLA248
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,NP52=200,
     2 NP56=30,NP57=35,
     3 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     4 -(7*IP5+11)*(IP2*IP3)-149)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /PROT/ IRADIUS, SLIT, APMIN, APMAX, ISCANT, NPIPRE,
     1 NFRIDL, ICHKT, SIGMI, FADING, NORCHK, DANG, CON1, CON2, DTHMIN,
     2 DTHMAX, DOMA, DOMB, APTA, APTB, SIGPRE, SIGMA, ITMAX,NBALF,NEQFL,
     3 NRPSI, PSIST, DELPSI, DVECT(3), NFMS, IZZH, IHMIN, IHMAX, IZZK,
     4 KMIN, KMAX, IZZL, LMIN, LMAX, FLAM1, FLAM2, BETA,
     5 IORF, WL21,WL11,CILT, PERF, RLPMN,
     6 RLPMX, XIMX, SIMX, SCFOVFL, CELL(12)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCHAR/ COMPID, TEXT, XNPSIFL, DATC, XSEQ, RDMP, ICAD,
     1 HTAOIS
      CHARACTER TEXT*36, COMPID*6, XNPSIFL*6, DATC*6, XSEQ*6,
     1 NFMS*4, RDMP(26)*62, ICAD*4, HTAOIS(25)*6
      CHARACTER FORMC*11, CARD*77, CODE*6, C1*1, C2*1, C4*1
      IPR(370) = 1
      IHPR(9)  = 0
      IDCDOC   = 0
      ISG      = 0
      IXRYT0   = 0
      XIMAX    = 1.0
      XIMIN    = 1.0
      NREFL    = 0
      ICNT     = 0
      IRF      = 0
      IRFX     = 0
      LX       = 0
      IRFD     = 0
      CALL GEN108 (LU16, 0)
      NERROR   = -1
   10 NERROR   = NERROR + 1
      IF (NERROR .GT. 100) GO TO 120
   20 READ  (LU16, 99985, END = 120, ERR = 10) ICDTYP
      IF (ICDTYP .EQ. 0) THEN
        GO TO 20
      ELSE IF (ICDTYP .EQ. 21) THEN
        FORMC = '(1X, I2, A)'
      ELSE
        FORMC = '(2X, I2, A)'
      END IF
      CALL GEN108 (LU16, 0)
      NCARD = 0
   30 NERROR = NERROR + 1
      IF (NERROR .GT. 100) GO TO 120
   40 READ (LU16, FORMC, END = 120, ERR = 30) KEY, CARD
      NCARD = NCARD + 1
C * TYPE 0 RECORD:LISTNR,RH,RK,RL,HTAOIS,RTHETA,RPHIK,ROMK,RKAPPA,
C * IRNPI,RSCANG,RSCINT
      IF (KEY .EQ. 0) THEN
        IF (IRFD .EQ. 0) GO TO 40
        READ (CARD, 99998, ERR = 140) LNR
        IF (LNR .GT. 0 .AND. LNR .LE. 25) THEN
          RDMP(LNR) = CARD(1:59)
          READ (CARD, 99997, ERR = 140) (IORREF(LNR, I), I = 1, 3),
     1          HTAOIS(LNR)
          IORR4  = IORREF(LNR, 1) * 40000 + IORREF(LNR, 2) * 200 +
     1             IORREF(LNR, 3)
          IORR40 = IORREF(LNR, 4)
          IF (IORR40 .NE. 0) THEN
            IF (IORR40 .EQ. IORR4) GO TO 40
            CALL PLA245 (5)
          END IF
          IORREF(LNR, 4) = IORR4
          IORF = IORF + 1
          IF (HTAOIS(LNR)(5:5) .EQ. 'I') THEN
            IHPR(9) = IHPR(9) + 1
            IF (IHPR(9) .GT. IHPR(1)) CALL PLA245 (2)
            IRFY(IHPR(9)) = LNR
          END IF
        END IF
C * TYPE 1 RECORD:NREFL, H, K, L, CODE, PSI, NPI, BGL, INT, BGR
      ELSE IF (KEY .EQ. 1) THEN
        READ (CARD, 99988, ERR = 140) NREFLN, IH, IK, IL, CODE, PSI,
     1        NPI, IBGL, ISC, IBGR
        IF (NREFLN .NE. NREFL + 1) THEN
          WRITE (LU7, 99983, IOSTAT = IOST) NREFLN
          WRITE (LU6, 99983, IOSTAT = IOST) NREFLN
        END IF
C * TYPE 2 RECORD:NREFL,THETA,PHIK,OMK,KAPPA,WIDTH,XRAYT,FRIDL
      ELSE IF (KEY .EQ. 2) THEN
        READ (CARD, 99996, ERR = 140) NREFLC, THETA, PHIK, OMK,
     1                     RKAPPA, WIDTH, IXRYT, IFRIDL
        IF (NREFLC .NE. NREFLN) THEN
          WRITE (LU7, 99984, IOSTAT = IOST) NREFLC
          WRITE (LU6, 99984, IOSTAT = IOST) NREFLC
        ELSE
          NREFL = NREFLN
          IF (ISW(3) .GE. 0) THEN
            IXRYTB = IXRYT
            IF (MOD(NMBR(3), IHPR(1)) .NE. 0) CALL PLA245 (6)
            IF (ISW(3) .NE. 2) THEN
              IF (NREFL .EQ. 1) IXRYTB = 0
            ELSE
              IXRYTB = IXRYT
            END IF
            IXRYT0 = - IXRYTB
            IF (ISG .GT. 1) IXRYT0 = IXRYT0 + NINT(XRAYT(ISG - 1)
     1                             * 3600.0)
            ISW(3) = - IABS(ISW(3))
          END IF
          IXRAYT     = IXRYT + IXRYT0
          XRT        = IXRAYT / 3600.0
          XRAYT(ISG) = XRT
          C1         = CODE(1:1)
          C2         = CODE(2:2)
          C4         = CODE(4:4)
          IHPR(11)   = NREFL
          CALL PLA243 (1, NMBR, IPRT)
          IF (C1 .EQ. 'N') CALL PLA243 (2, NMBR, IPRT)
          IF (C1 .EQ. '?') CALL PLA243 (2, NMBR, IPRT)
          IF (C1 .EQ. '!') CALL PLA243 (2, NMBR, IPRT)
          IF (C1 .EQ. 'I') CALL PLA243 (3, NMBR, IPRT)
          IF (C4 .EQ. 'W') CALL PLA243 (4, NMBR, IPRT)
          IF (C4 .EQ. 'S') CALL PLA243 (5, NMBR, IPRT)
          IF (C4 .EQ. 'T') CALL PLA243 (6, NMBR, IPRT)
          IF (C2 .EQ. 'X' .OR. C2 .EQ. 'C') CALL PLA243 (9, NMBR, IPRT)
          IF (LX .EQ. LU11) IPRT = IPRT + 512
          IF (C1 .EQ. '?')  IPRT = IPRT + 1024
          IF (C1 .EQ. '!')  IPRT = IPRT + 2048
          ILT  = 1
          FSCF = 1.0
          IF (NPI .LT. 0) THEN
            FSCF = BETA
            CALL PLA243 (8, NMBR, IPRT)
          END IF
          IF (THETA .LT. 5) IPRT = IPRT + 256
          XI = 0
          SI = 0
          IF (NPI .NE. 0) THEN
            RAT   = 2.0
            SCF   = FSCF * 100.0
            MINB  = MIN (IBGL, IBGR)
            MAXB  = MAX (IBGL, IBGR)
            IBTST = 0
            IF (MAXB .GT. 3.0 * MINB .OR. MAXB .GT. ISC) IBTST = 1
            IF (IBTST .EQ. 1) IPRT = IPRT + 4096
            IF (IPR(425) .EQ. 0) THEN
              GO TO 60
            ELSE IF (IPR(425) .GT. 0) THEN
              GO TO 50
            END IF
            IBTST = - IBTST
   50       IF (IBTST .NE. 0) THEN
              BACK = MINB
              IF (IPR(425) .EQ. 1) THEN
                RAT = 4.0
              ELSE
                RAT = 5.0
                ISC = ISC + MAXB
              END IF
              GO TO 70
            END IF
   60       BACK = IBGL + IBGR
   70       XI = (ISC - RAT * BACK) * SCF / FLOAT(IABS(NPI))
            SI = (SQRT(FLOAT(ISC) + (RAT**2) * BACK)) * SCF /
     1            FLOAT(IABS(NPI))
          END IF
          IF (IPR(425) .LT. 0) IHPR(12) = IHPR(12) + IABS(IBTST)
          IF (XI + 2.5 * SI .LT. 0) IPRT = IPRT + 128
          IF (XI .GT. XIMX) XIMX = XI
          IF (SI .GT. SIMX) SIMX = SI
          IF (C2 .EQ. 'D' .AND. XI .GT. 5.0 * SI)
     1        CALL PLA243 (7, NMBR, IPRT)
          IF (IABS(NPI) .GT. NPIPRE .AND. WIDTH .LT. 0.0)
     1      CALL PLA243 (10, NMBR, IPRT)
          WRITE (LX) NREFL, IH, IK, IL, CODE, PSI, NPI, IBGL, ISC,
     1      IBGR, THETA, PHIK, OMK,RKAPPA, WIDTH, IXRAYT, IFRIDL,
     2      ILT, ISG, XI, SI, IPRT, IHPR(8), IBTST, FSCF
          IF (C1 .EQ. 'I') THEN
            IHKL = IH * 40000 + IK * 200 + IL
            IRFX = IHPR(9)
            DO I = 1, IRFX
              IRF = MOD(IRF, IRFX) + I
              IX  = IRFY(IRF)
              IF (IX .LE. 0) GO TO 40
              IF (IORREF(IX, 4) .EQ. IHKL) GO TO 80
            END DO
            GO TO 40
   80       ICNT = MOD(ICNT, IRFX) + 1
            IF (ICNT .NE. IRF) THEN
              WRITE (LU9) ICNT, XRF(IRF), 0.0, XRT, ISG, IHPR(8)
              WRITE (LU6, 99980, IOSTAT = IOST) NREFL, ICNT
              GO TO 80
            ELSE
              WRITE (LU9) IRF, XI, SI, XRT, ISG, IHPR(8)
   90         XRFIRF = XRF(IRF)
              IF (XRFIRF .LE. 0.0) THEN
                XRF(IRF) = XI
                GO TO 90
              END IF
              XIS   = XI / XRFIRF
              XIMAX = MAX (XIS, XIMAX)
              XIMIN = MIN (XIS, XIMIN)
            END IF
          END IF
        END IF
C * TYPE 21 RECORD: NREFL,TEXT,IRADIUS,SLIT,APMIN,APMAX
      ELSE IF (KEY .EQ. 21) THEN
        IF (ISG .GT. 0) THEN
          IF (NMBR(2) .EQ. 0) WRITE (LU6, 99982, IOSTAT = IOST) ISG
        END IF
  100   IF (IRFX .GT. 0) THEN
          ICNT = MOD(ICNT, IRFX) + 1
          IF (ICNT .NE. 1) THEN
            WRITE (LU9) ICNT, XRF(ICNT), 0.0, XRT, ISG, IHPR(8)
            WRITE (LU6, 99980) NREFL, ICNT
            GO TO 100
          END IF
          IRF  = 0
          ICNT = 0
        END IF
        IF (IDCDOC .NE. 0) THEN
          CALL PLA244 (IDCDOC)
          IDCDOC = 1
        END IF
        READ (CARD, 99986, ERR = 140) COMPID
        JID = COMPID
        IF (IDCDOC .EQ. 0) CALL PLA244 (IDCDOC)
        IDCDOC = 1
        READ (CARD, 99995, ERR = 140) NR, TEXT, IRADIUS, SLIT,
     1    APMIN, APMAX
        ISG = ISG + 1
        IF (ISG .GT. IHPR(3)) CALL PLA245 (1)
        IF (NR .LE. 1) THEN
          ISW(3) = 1
          DATC   = 'DATCOL'
        ELSE
          ISW(3) = 2
          DATC   = 'DATCON'
        END IF
        CALL GEN097 (NMBR, 1, 10, 0)
        IF (TEXT(27:29) .EQ. 'ZR ') IPR(424) = 0
C * TYPE 22 RECORD: DTHMIN,DTHMAX,DOMA,DOMB,APTA,APTB,ISCANT,SIGPRE,
C *                 SIGMA,NPIPRE,ITMAX,IDUMPF,NBALF,NFRIDL
      ELSE IF (KEY .EQ. 22) THEN
        READ (CARD, 99994, ERR = 140) DTHMIN, DTHMAX, DOMA, DOMB,
     1    APTA, APTB, ISCANT, SIGPRE, SIGMA, NPIPRE, ITMAX, NBALF,
     2    NBALF, NFRIDL
C * TYPE 23 RECORD: NPSIFL,NRPSI,PSIST,DELPSI,DVECT(1),DVECT(2),DVECT(3)
      ELSE IF (KEY .EQ. 23) THEN
        READ (CARD, 99993, ERR = 140) NEQFL, XNPSIFL, NRPSI, PSIST,
     1        DELPSI, (DVECT(I), I = 1, 3)
        IF (XNPSIFL .EQ. 'AZIMUT' .AND. NRPSI .GE. 36) THEN
          LX = LU11
        ELSE
          LX = LU10
        END IF
C * TYPE 24 RECORD: XSEQ,NFMS,ZZH,HMIN,HMAX,ZZK,KMIN,KMAX,ZZL,LMIN,LMAX
      ELSE IF (KEY .EQ. 24) THEN
        READ (CARD, 99992, ERR = 140) XSEQ, NFMS, IZZH, IHMIN,
     1        IHMAX, IZZK, KMIN, KMAX, IZZL, LMIN, LMAX
        IHPR(16) = MAX (IHPR(16), IHMAX, - IHMIN)
        IHPR(17) = MAX (IHPR(17), KMAX,  - KMIN)
        IHPR(18) = MAX (IHPR(18), LMAX,  - LMIN)
C * TYPE 26 RECORD: ICHKT,SIGMI,FADING,NORCHK,DANG,CON1,CON2,XRAYT
      ELSE IF (KEY .EQ. 26) THEN
        IRFD = 1
        READ (CARD, 99990, ERR = 140) ICHKT, SIGMI, FADING, NORCHK,
     1                                 DANG, CON1, CON2, IXRAYT
C * TYPE 31 RECORD: R(1,1),R(1,2),R(1,3),R(2,1)...............R(2,3)
      ELSE IF (KEY .EQ. 31) THEN
        IRFD = 0
        READ (CARD, 99989, ERR = 140) R(1, 1), R(1, 2), R(1, 3),
     1                                 R(2, 1), R(2, 2), R(2, 3)
C * TYPE 32 RECORD:   R(3,1),R(3,2),R(3,3),FLAM1,FLAM2,BETA/FF
      ELSE IF (KEY .EQ. 32) THEN
        READ (CARD, 99989, ERR = 140) R(3, 1), R(3, 2), R(3, 3),
     1                                 FLAM1, FLAM2, BETA
        DIF  = 0.0
        IPRM = IHPR(8)
        IF (IPRM .LT. IP6) THEN
          IPR8 = IPRM + 1
          DO I = 1, 3
            DO J = 1, 3
              ORM(I, J, IPR8) = R(I, J)
              IF (IPR8 .GT. 1) THEN
                DIF = DIF + ABS(ABS(ORM(I, J, IPRM)) - ABS(R(I, J)))
              END IF
            END DO
          END DO
          IF (IPR8 .NE. 1) THEN
            IF (DIF .LT. 0.000005) GO TO 110
          END IF
          IHPR(8) = IPR8
        ELSE
          WRITE (LU7, 99981, IOSTAT = IOST)
          WRITE (LU6, 99981, IOSTAT = IOST)
        END IF
  110   WL21 = (2.0 * FLAM1 + FLAM2) / 3.0
        WL11 = (FLAM1 + FLAM2) / 2.0
        IF (BETA .LT. 0.1) BETA = 16.00
C * TYPE 33 RECORD: A, B, C, SIG(A), SIG(B), SIG(C)
      ELSE IF (KEY .EQ. 33) THEN
        READ (CARD, 99989, ERR = 140) (CELL(I), I = 1, 3),
     1                                 (CELL(I), I = 7, 9)
C * TYPE 34 RECORD: ALFA, BETA, GAMMA, SIG(ALFA), SIG(BETA), SIG(GAMMA)
      ELSE IF (KEY .EQ. 34) THEN
        READ (CARD, 99989, ERR = 140) (CELL(I), I = 4, 6),
     1                                 (CELL(I), I = 10, 12)
      END IF
      GO TO 40
  120 IF (IRFX .GT. 0) THEN
        ICNT = MOD(ICNT, IRFX) + 1
        IF (ICNT .NE. 1) THEN
          WRITE (LU9) ICNT, XRF(ICNT), 0.0, XRT, ISG, IHPR(8)
          WRITE (LU6, 99980, IOSTAT = IOST) NREFL, ICNT
          GO TO 120
        END IF
      END IF
      IHPR(6) = NINT(MAX(XIMAX - 1.0, 1.0 - XIMIN) * 100) * 2 + 10
      IF (NMBR(2)  .EQ. 0) WRITE (LU6, 99982, IOSTAT = IOST) ISG
      IF (NMBR(12) .EQ. 0) CALL PLA245 (3)
      IF (IHPR(9)  .EQ. 0) IPR(428) = 1
      CALL PLA244 (IDCDOC)
      CALL GEN097 (IPR(IHPR(9) + 371), 1, 9 - IHPR(9), 0)
      RETURN
  140 WRITE (LU6, 99999, IOSTAT = IOST) NCARD
      WRITE (LU6, FORMC, IOSTAT = IOST) KEY, CARD
      CALL GEN127 (' ')
99999 FORMAT (/, 'Fatal Error in CAD4-data : Offending Line =', I6, /)
99998 FORMAT (I2)
99997 FORMAT (2X, 3I3, A)
99996 FORMAT (I6, F8.3, 3F9.3, F7.3, I7, I3)
99995 FORMAT (I6, A, I4, F4.1, F4.1, F4.1)
99994 FORMAT (2F6.2, 4F5.2, I2, 2F6.3, I2, I4, 3I2)
99993 FORMAT (I2, 1X, A, I5, F7.2, F7.2, 3(F10.6))
99992 FORMAT (1X, A, 2X, A, I5, 9I5)
99990 FORMAT (I7, F7.3, F6.3, I5, F6.3, F10.7, F10.7, I7)
99989 FORMAT (2(2X, 3F9.6))
99988 FORMAT (I6, 3I5, 1X, A, F7.0, I4, I6, I7, I6)
99986 FORMAT (6X, A)
99985 FORMAT (I3)
99984 FORMAT (':: DATA FOR REFLECTION ',I5,' INCOMPLETE AND SKIPPED'/)
99983 FORMAT (':: WARNING: DISCONTINUITY AT REFLECTION NR:',I6,/)
99982 FORMAT (':: DATA SET NR.', I3, ' DOES NOT CONTAIN NORMAL',
     1  ' REFLECTIONS'/)
99981 FORMAT (19X, 'REORIENTATION MATRIX SKIPPED')
99980 FORMAT ('Reference reflection missing at reflection',
     1         I6,/,'Zero weight reflection substituted for r.r.',I3)
      END SUBROUTINE PLA248
      SUBROUTINE PLA249 (IRF, ISGR)
      PARAMETER (IP1=500, IP2=50, IP3=16, IP4=100, IP5=6, IP6=99,
     1 IP7=25, IP8=25, IP9 = 100)
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP99=NVD+NP23*2-6*IP1-IP2-2*IP3-39*IP4-9*IP6-IP7-IP8-5*IP9
     2 -(7*IP5+11)*(IP2*IP3)-149,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON // X(IP1), F(IP1), W(IP1), IONR(IP1), WAV(IP1), FAV(IP1),
     1 A(IP5, IP3, IP2), B(IP5, IP3, IP2), C(IP5, IP3, IP2),
     2 D(IP5, IP3, IP2), P(IP5, IP3, IP2), G(IP5, IP3, IP2),
     3 V(IP5, IP3, IP2), FMN(9, IP3, IP2), PC(IP3, IP2), IRFZ(IP3, IP2),
     4 IRFY(IP3), XRF(IP3), XRAYT(IP2), PSIS(36, IP4), IHKLP(3, IP4),
     5 BAK(IP9, 5), ORM(3, 3, IP6), IHPR(IP7), HPAR(IP8), IORREF(25, 4),
     6 ISW(3), NMBR(20), ROR(3, 3), DC(6), R(3, 3), ANPI, ISG, XR(NP99)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /SAVPL/ XPL, YPL, SCFX, IXRT, VS
      COMMON /XCHAR/ COMPID, TEXT, XNPSIFL, DATC, XSEQ, RDMP, ICAD,
     1 HTAOIS
      CHARACTER TEXT*36, COMPID*6, XNPSIFL*6, DATC*6, XSEQ*6,
     1 RDMP(26)*62, ICAD*4, HTAOIS(25)*6
      CHARACTER NQ*7, PLTXT1*46, PLTXT2*36, PLTXT3*7, PLTXT4*20
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /TODAY/ DATIJD
      CHARACTER DATIJD*25
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      NSGR = 0
      HORS = 33.3333
      VERT = 25.0
      CALL GEN040 (ISG, NQ, IPX)
   10 PLTXT1 = 'HELENA....'//TEXT
      PLTXT2 = DATIJD(5:24)//' ,SET NR :'//NQ(1:6)
      PLTXT3 = 'PERCENT'
      PLTXT4 = 'HOURS XRAY EXP. TIME'
      IF (IRF .LT. ISW(2)) THEN
        CALL GGIP (0.0, 0.0, 0.0, -1)
        CALL PLA013 (4, 1)
        IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
          GO TO 10
        ELSE IF (IGGT(1:1) .EQ. '!') THEN
          CALL PLA280 ('NEXT')
        END IF
        CALL GEN038 (IGGT, 1, 80)
        GO TO 100
      ELSE IF (IRF .GT. ISW(2)) THEN
        GO TO 60
      END IF
      IF (ISGR .LE. 1) THEN
        SCFX = HORS / XRAYT(ISG)
        IXRT = IFIX(XRAYT(ISG))
        IF (LU15 .EQ. 1) THEN
          CALL GGIP (-999.0, 0.0, 0.0, -2)
        ELSE
          CALL GGIP (-999.0, 0.0, 0.0, 3)
        END IF
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL GGIP (0.0, 0.0, 0.0, 3)
        CALL GGIP (0.0, 1.0, 0.0, 0)
        II = 0
        XX = 0.0
   20   II = II + 1
        IF (II .GT. IXRT) GO TO 30
        XX = XX + SCFX
        YY = 0.5
        IF (MOD(II, 10) .EQ. 0) YY = 1.0
        CALL GGIP (XX, 0.0, 0.0, 2)
        CALL GGIP (XX,  YY, 0.0, 2)
        CALL GGIP (XX, 0.0, 0.0, 2)
        GO TO 20
   30   CALL GGIP (HORS, 0.0, 0.0, 2)
        YY = 0.0
        IV = IHPR(6)
        VS = VERT / IV
        DO I = 1, IV
          XX = HORS - 0.2
          IF (MOD(I - IV / 2, 10) .EQ. 0) XX = HORS - 0.6
          YY = YY + VS
          CALL GGIP (HORS, YY, 0.0, 2)
          CALL GGIP (XX,   YY, 0.0, 2)
          CALL GGIP (HORS, YY, 0.0, 2)
        END DO
        CALL GGIP (0.0, VERT, 0.0, 2)
        YY = VERT
        DO I = 1, IV
          XX = 0.3
          IF (MOD(I - IV / 2, 10) .EQ. 0) XX = 0.60
          YY = YY - VS
          CALL GGIP (0.0, YY, 0.0, 2)
          CALL GGIP (XX,  YY, 0.0, 2)
          CALL GGIP (0.0, YY, 0.0, 2)
        END DO
        CALL GGIP (0.0, 0.0, 0.0, 2)
        XX = 1.0
        YY = VERT - 1.0
        CALL GGIP09 (0.0, PLTXT1, 46, 0.5, -1, 2, XX, YY)
        XX = 1.0
        YY = 1.3
        CALL GGIP09 (0.0, PLTXT2, 36, 0.5, -1, 2, XX, YY)
        XX = 1.4
        YY = VERT - 5.0
        CALL GGIP09 (90.0, PLTXT3, 7, 0.5, -1, 2, XX, YY)
        XX = HORS - 11.0
        YY = 1.3
        CALL GGIP09 (0.0, PLTXT4, 20, 0.5, -1, 2, XX, YY)
        WRITE (BCD, '(''Scale Degree ='', I3)', IOSTAT = IOST) IPR(446)
        CALL GGIP09 (0.0, BCD, 17, 0.5, 1, 2, 7.5, VERT - 3.0)
      END IF
      CALL GGIP (0.0, 0.0, 0.0, 3)
   60 CALL GGIP (0.0, FLOAT(IRF), 0.0, 0)
      IF (ISGR .LE. 1) THEN
        XPL = 2.3
        YPL = VERT - 1.5 - IRF * 0.7
        CALL GGIP09 (0.0, CHAR(ICHAR('A') - 1 + IRF), 2, 0.3,
     1              -1, 0, XPL, YPL)
        IRFX = IRFY(IRF)
        DO I = 1, 3
          XPL  = 2.3 + 1.0 * I
          IPX  = 0
          NUMB = 0
          IF (IRFX .GT. 0) NUMB = IORREF(IRFX, I)
          CALL GEN040 (NUMB, NQ, IPX)
          CALL GGIP09 (0.0, NQ, 3, 0.3, -1, 2, XPL, YPL)
        END DO
      END IF
      IF (IRF .EQ. ISW(2)) NSGR = MOD(ISGR, 10)
      NST = IRFZ(IRF, ISGR)
      DO I = 1, NST
        XX = X(I) * SCFX
        YY = (F(I) / P(1, IRF, 1) - 1.0) * VS * 100.0 + VERT / 2.0
        CALL GGIP09 (0.0, CHAR(ICHAR('A') - 1 + IRF), 1, 0.3,
     1              -1, 0, XX, YY)
        IF (IRF .EQ. ISW(2)) THEN
          CALL GGIP09 (0.0, CHAR(ICHAR('0') + NSGR), 1, 0.3, -1, 0, XX,
     1                2.8)
          NOGR = MOD(IONR(I) - 1, 10)
          CALL GGIP09 (0.0, CHAR(ICHAR('0') + NOGR), 1, 0.3, -1, 0, XX,
     1                2.3)
        END IF
      END DO
      DO I = 1, NST
        IPN = 2
        IF (I .EQ. 1) IPN = 3
        XRT = X(I)
        CALL PLA246 (SCF, IRF, ISGR, XRT)
        XX = X(I) * SCFX
        YY = (1.0 / SCF - 1.0) * VS * 100.0 + VERT / 2.0
        CALL GGIP (XX, YY, 0.0, IPN)
      END DO
      CALL GGIP (0.0, 0.0, 0.0, 3)
  100 RETURN
      END SUBROUTINE PLA249
      SUBROUTINE PLA250
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35)
      PARAMETER (NCT0 = 5000, NCT1 = 1000000, NTC4 = 200, NCT5 = 2000,
     1 NCT6 = 100, NCT7 = NCT6 + 1, NCT8 = 2500, NCT3 =  NVD + 2 * NP23
     2 -2007 - 9 * NCT8 -2 * NCT5 - 7 * NCT0 - NCT1 - 3 * NTC4 * NTC4
     3 - NCT6 * (NCT6 + 13))
      COMMON // LATOM(NCT0), ATOM(3, NCT0), IFLG(3, NCT0), COEFF(NCT1),
     1 XMPC(NCT8, 5), IMPC(3, NCT8), JMPC(NCT8), Q8(2, NCT5),
     2 FMP(NTC4, NTC4), IEXX(2, NTC4, NTC4), SMA(NCT6, NCT7),
     3 P8(12, NCT6), DXF(3), DYF(3), NAT, XMCT(4, 500), SK(NCT3)
      COMMON /ISCR/ FC(3, 5), XFO(3), ULC(3)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /CTR/ NA, ICENT, IKM, ILM, IHM
      COMMON /APLOT/ X, Y, SCALE, PXS, PYS, STEP, VLAK(4)
      COMMON /AINPUT/ NS, NE, MX, MY, NXP, NXM, NYP, NYM, PHI,
     1  XN(3, 4), FMAT(3, 3), CMAT(3, 3)
      DIMENSION IOFF(4), MH(24), MK(24), ML(24)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER PLPATH*255
      INTEGER FINDEXE
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      DIMENSION V0(3)
      COMMON /TEXT/ TXT
      CHARACTER TXT(8)*62
      DATA TXT /
     1 'Key/Click Point (Label or x,y,z)  def. the map x-axis [1 0 0]',
     2 'Key/Click Point (Label or x,y,z)  def. the map origin [0 0 0]',
     3 'Key/Click 3rd point (Label or x,y,z) in the map plane [0 1 0]',
     4 'Key/Click 1st point (Label or x,y,z)    on the normal [0 0 0]',
     5 'Key/Click 2nd point (Label or x,y,z)    on the normal [0 1 0]',
     6 'Key/Click 3rd point (Label or x,y,z)    in the plane  [0 0 0]',
     7 'Give the 4 coeff. of the equation ax + by + cz = d [fract.]',
     8 'The Ax-System must now be def. (Opt. Excl. Atoms from SF-Calc)'
     9 /
C * CONTOURED ELECTRON DENSITY MAPS
      CALL GEN038 (PLPATH, 1, 255)
      NRSECT    = 0
      NSECTIONS = 0
      I0        = 0
      LRT1      = 1
      CALL PLA253 (1, LRT1)
      IF (LRT1 .LT. 0) GO TO 120
   10 IF (IPR(415) .GE. 0) THEN
        IF (IPR(414) .NE. 4) THEN
          IPR(211) = 1
          IPR(415) = 1
          IPR(346) = 1
          IF (IPR(414) .NE. 5) THEN
            CALL PLA106
          ELSE
            CALL GGIP (HORS, VERT, 0.0, 1)
          END IF
        END IF
      END IF
      CALL GEN021 (FMAT, 0)
      CALL GEN003 (OR, ROR, DET, 0)
      CALL GEN074 (VLAK, 1, 4, 0.0)
      SELECT CASE (IPR(420))
        CASE (0)
          FMAT(1, 1) = 1.0
          FMAT(2, 3) = 1.0
          VLAK(3)    = 1.0
          IB         = 1
        CASE (1)
          FMAT(1, 1) = 1.0
          FMAT(2, 3) = 1.0
          VLAK(3)    = 1.0
          IB         = 4
        CASE (2)
          FMAT(1, 1) = 1.0
          FMAT(3, 3) = 1.0
          VLAK(2)    = 1.0
          IB         = 4
        CASE DEFAULT
          FMAT(2, 1) = 1.0
          FMAT(3, 3) = 1.0
          VLAK(1)    = 1.0
          IB         = 4
      END SELECT
      IPR416 = IPR(416)
      IPR414 = IPR(414)
C * DEFINE THE PLANE TYPE
   20 DO I = IB, 4
   30   SELECT CASE (IPR(416))
C * 0 - PLANE DEFINED BY 3 POINTS
          CASE (0)
            IF (I .LT. 4) THEN
              I0   = I
              NTXT = I
            ELSE
              CYCLE
            END IF
C * 1 - Plane defined by ax + by + cz = d
          CASE (1)
            SELECT CASE (I)
              CASE (1)
                NTXT = 7
              CASE (2)
                I0   = 1
                NTXT = 1
              CASE (3)
                I0   = 2
                NTXT = 2
              CASE DEFAULT
               CYCLE
            END SELECT
C * 2 -  Rt. bisector of line between 2 pts. $ 3rd pt. for x-axis
          CASE (2)
            SELECT CASE (I)
              CASE (1)
                I0   = 1
                NTXT = 1
              CASE (2)
                I0   = 2
                NTXT = 4
              CASE (3)
                I0   = 3
                NTXT = 5
              CASE DEFAULT
                CYCLE
            END SELECT
C * 3 - Plane through 2 points, normal defined by a 3rd point
          CASE (3)
            SELECT CASE (I)
              CASE (1)
                I0   = 1
                NTXT = 1
              CASE (2)
                I0   = 2
                NTXT = 6
              CASE (3)
                I0   = 3
                NTXT = 3
              CASE DEFAULT
                CYCLE
            END SELECT
C * 4 - Plane XY/YZ/XZ
          CASE (4)
            CYCLE
C * CATCH OTHER
          CASE DEFAULT
            GO TO 20
        END SELECT
        IF (IPR(182) .EQ. 0) THEN
          IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
            SBCD = TXT(8)//CHAR(0)
            CALL GGIP (-999.0, 3.0, 79.0, 112)
            SBCD = TXT(NTXT)//CHAR(0)
          ELSE
            WRITE (LU6, '(A, $)', IOSTAT = IOST) TXT(NTXT)
          END IF
        END IF
        IPR(439) = 0
        CALL PLA013 (0, 1)
        IF (LRET .EQ. 3) GO TO 10
        SELECT CASE (IGGT(1:4))
          CASE ('****')
            GO TO 30
          CASE ('PLOT', 'EPS ')
            GO TO 10
          CASE ('Q   ', 'QUIT', 'END ', 'EXIT')
            GO TO 120
        END SELECT
        IF (IPR(414) .NE. IPR414) GO TO 10
        IF (IPR(416) .NE. IPR416) GO TO 10
        CALL PLA006 (0, IS)
        IF (IFL(1)(2:4) .EQ. 'ROT') THEN
          IF (IFL(1)(1:1) .EQ. 'X') THEN
            N = -1
          ELSE IF (IFL(1)(1:1) .EQ. 'Y') THEN
            N = -2
          ELSE
            N = -3
          END IF
          IF (IPR(221) .GT. 0) THEN
            ANGL = - FN(1) / RGBL(6)
          ELSE
            ANGL = - 10.0  / RGBL(6)
          END IF
          CALL GEN021 (RMAT, IGBL(87))
          DO L = 1, 3
            CALL GEN051 (0, RMAT, - RGBL(27 + L) / RGBL(6), L)
          END DO
          CALL PLA226 (N, ANGL)
          GO TO 10
        END IF
        IF (IPR(220) .GT. 0) THEN
          NAMS(1, I0) = IFL(1)
          FMAT(1, I0) = -10000.0
        ELSE IF (IPR(221) .EQ. 3) THEN
          DO J = 1, 3
            FMAT(J, I0) = FN(J)
          END DO
        ELSE IF (IPR(221) .EQ. 4) THEN
          DO J = 1, 3
            XPV(J) = FN(J)
          END DO
          VLAK(4) = FN(4)
          CALL GEN002 (-1, ROR, XPV(1), VLAK, XLNG)
        END IF
      END DO
      NASUP = IPR(39) + IPR(64)
      CALL PLA034 (-1, NASUP)
      DO I = 1, IPR(39)
        DO J = 1, 3
          XMCT(J, I) = XXO(I, J)
        END DO
        CALL GEN048 (-4, IFG(1, I), 15, IVAL)
        XMCT(4, I) = IVAL
      END DO
      DO I = 1, 3
        IF (FMAT(1, I) .LT. -9999.0) THEN
          NQ1 = NAMS(1, I)(1:7)
          CALL GEN020 (1, NQ1, 1, 7)
          CALL PLA046 (3, NQ1, IENM, LBB, LBC, LBD, INQNR, JYDUM, II)
          IF (II .GT. 0) THEN
            DO J = 1, 3
              FMAT(J, I) = XXO(II, J)
            END DO
          ELSE
            CALL PLA015 (0, 42)
            GO TO 20
          END IF
        END IF
      END DO
      CALL GEN004 (OR, FMAT, CMAT)
      SELECT CASE (IPR(416))
        CASE (0)
          CALL GEN015 (CMAT(1, 1), CMAT(1, 2), V3, -1.0)
          CALL GEN015 (CMAT(1, 3), CMAT(1, 2), V2, -1.0)
          IF (GEN017 (V3) .EQ. 0.0 .OR. GEN017 (V2) .EQ. 0.0) THEN
            CALL PLA015 (0, 42)
            GO TO 20
          ELSE
            CALL GEN008 (V3, V2, VLAK, 0)
            IF (GEN017 (VLAK) .EQ. 0.0) THEN
              CALL PLA015 (0, 42)
              GO TO 20
            ELSE
              VLAK(4) = GEN009 (VLAK, CMAT(1, 1))
            END IF
          END IF
        CASE (1)
        CASE (2)
          CALL GEN015 (CMAT(1, 3), CMAT(1, 2), V2, -1.0)
          D2 = 1.0 / SQRT(V2(1)**2 + V2(2)**2 + V2(3)**2)
          DO J = 1, 3
            VLAK(J) = D2 * V2(J)
          END DO
          CALL GEN015 (CMAT(1, 2), CMAT(1, 3), V2, 1.0)
          VLAK(4) = GEN009 (V2, VLAK) / 2.0
          CMAT(1, 3) = 0.0
          CMAT(2, 3) = 0.0
          CMAT(3, 3) = 0.0
        CASE (3)
          DO J = 1, 3
            V1(J) = (CMAT(J, 1) + CMAT(J, 2)) / 2
          END DO
          DO J = 1, 3
            CMAT(J, 2) = V1(J)
          END DO
          CALL GEN015 (CMAT(1, 1), CMAT(1, 2), V1, -1.0)
          CALL GEN015 (CMAT(1, 3), CMAT(1, 2), V2, -1.0)
          IF (GEN017 (V1) .EQ. 0.0 .OR. GEN017 (V2) .LT. 0.0) THEN
            CALL PLA015 (0, 42)
            GO TO 20
          ELSE
            CALL GEN008 (V1, V2, V3, 0)
            IF (GEN017 (V3) .EQ. 0.0) THEN
              CALL PLA015 (0, 42)
              GO TO 20
            ELSE
              CALL GEN008 (V3, V1, VLAK, 0)
              IF (GEN017 (VLAK) .EQ. 0.0) THEN
                CALL PLA015 (0, 42)
                GO TO 20
              ELSE
                VLAK(4) = GEN009 (VLAK, CMAT(1, 1))
              END IF
            END IF
          END IF
      END SELECT
C * READ REFLECTION DATA
   40 CALL PLA251
      IPR(415) = -1
      IPR(418) = 0
      PAR(278) = PAR(271)
      IPR(417) = 1
      ICENT = IPR(257)
      NEQV  = IPR(255)
      NST   = IPR(48)
      IHM   = IPR(411) + 1
      IKM   = IPR(412) + 1
      ILM   = IPR(413) + 1
      IHKM  = IHM * IKM
      IOD8  = NCT3 / 8
      IOD4  = IOD8 * 2
      LIMIT = 4 * (3 - ICENT) * IHKM * ILM
      IF (LIMIT .GT. NCT1) THEN
        WRITE (LU6, 99999, IOSTAT = IOST) LIMIT
        CALL GEN127 (' ')
      END IF
      DO I = 1, 4
        IOFF(I) = (I - 1) * IOD4
      END DO
      N48 = 8 / ICENT
      LAYPP = ICENT * IOD8 / IHKM
      NPASS = ILM / LAYPP
      IF (ILM .GT. NPASS * LAYPP) NPASS = NPASS + 1
      ILS = 0
      ILE = LAYPP - 1
      DO NPAS = 1, NPASS
        IF (NPAS .EQ. NPASS) ILE = ILM - 1
        NN = 4 * IOD4
        CALL GEN074 (SK, 1, NN, 0.0)
        CALL GEN108 (LU9, 0)
        DO
          READ (LU9, END = 60) JH, JK, JL, ATERM, BTERM, RSIGI, STHL
          IF (RSIGI .GT. FLOAT(IPR(515)) .AND.
     1      STHL .LE. PAR(412)) THEN
            XJX(1) = JH
            XJX(2) = JK
            XJX(3) = JL
            XJX(4) = 0.0
            DO 50 K = 1, NEQV
              CALL SGSM (ICL, K, XJX, LU6, 5, IERR)
              IH   = NINT(XJX(7))
              IK   = NINT(XJX(8))
              IL   = NINT(XJX(9))
              MHKL = IABS(IL)
              IF (MHKL .GE. ILS .AND. MHKL .LE. ILE) THEN
                MH(K) = IH
                MK(K) = IK
                ML(K) = IL
                KCHK  = K - 1
                IF (KCHK .GT. 0) THEN
                  DO KK = 1, KCHK
                    IF (IH .EQ.  MH(KK) .AND. IK .EQ.  MK(KK) .AND.
     1                  IL .EQ.  ML(KK)) GO TO 50
                    IF (IH .EQ. -MH(KK) .AND. IK .EQ. -MK(KK) .AND.
     1                  IL .EQ. -ML(KK)) GO TO 50
                  END DO
                END IF
                NUL  = 1
                NFOR = 1
                NFR  = 1
                FSC  = 1.0
                IF (IH .LT. 0) THEN
                  NFR = -1
                ELSE IF (IH .EQ. 0) THEN
                  NUL = NUL + 1
                  FSC = FSC * 0.5
                END IF
                IH  = NFR * IH
                IK  = NFR * IK
                IL  = NFR * IL
                IF (IK .LT. 0) THEN
                  NFOR = NFOR + 1
                  IK   = - IK
                ELSE IF (IK .EQ. 0) THEN
                  NUL = NUL + 2
                  FSC = FSC * 0.5
                END IF
                IF (IL .LT. 0) THEN
                  NFOR = NFOR + 2
                  IL = - IL
                ELSE IF (IL .EQ. 0) THEN
                  NUL = NUL + 4
                  FSC = FSC * 0.5
                END IF
                IF (IPR(414) .LT. 5) THEN
                  FASE = XJX(10) / RGBL(6)
                  ATRM = ( ATERM * COS(FASE) + BTERM * SIN(FASE)) * FSC
                  BTRM = (-ATERM * SIN(FASE) + BTERM * COS(FASE)) * FSC
     1                 * NFR
                ELSE
                  FASE = 0.0
                  ATRM = ATERM * FSC
                  BTRM = BTERM * FSC * NFR
                END IF
                NC  = 1
                IND = IK + 1 + IH * IKM + IHKM * (IL - ILS)
                IF (NUL .EQ. 1) THEN
                  INDA     = IND  + IOFF(NFOR)
                  SK(INDA) = ATRM
                  IF (ICENT .EQ. 1) SK(INDA + IOD8) = BTRM
                ELSE IF (NUL .EQ. 2) THEN
                  DO I = 1, 2
                    INDA     = IND + IOFF(NFOR)
                    SK(INDA) = ATRM
                    IF (ICENT .EQ. 1) SK(INDA + IOD8) = BTRM * NC
                    NFOR = 5 - NFOR
                    NC   = -1
                  END DO
                ELSE IF (NUL .EQ. 3) THEN
                  DO I = 1, 2
                    INDA     = IND + IOFF(NFOR)
                    SK(INDA) = ATRM
                    IF (ICENT .EQ. 1) SK(INDA + IOD8) = BTRM
                    NFOR = NFOR + 1
                  END DO
                ELSE IF (NUL .EQ. 5) THEN
                  DO I = 1, 2
                    INDA = IND + IOFF(NFOR)
                    SK(INDA) = ATRM
                    IF (ICENT .EQ. 1) SK(INDA + IOD8) = BTRM
                    NFOR = NFOR + 2
                  END DO
                ELSE IF (NUL .EQ. 4) THEN
                  DO J = 1, 2
                    DO I = 1, 2
                      INDA     = IND + IOFF(NFOR)
                      SK(INDA) = ATRM
                      IF (ICENT .EQ. 1) SK(INDA + IOD8) = BTRM * NC
                      NFOR = NFOR + 1
                    END DO
                    NFOR = 6 - NFOR
                    NC   = -1
                  END DO
                ELSE IF (NUL .EQ. 6) THEN
                  DO J = 1, 2
                    DO I = 1, 2
                      INDA     = IND + IOFF(NFOR)
                      SK(INDA) = ATRM
                      IF (ICENT .EQ. 1) SK(INDA + IOD8) = BTRM * NC
                      NFOR = NFOR + 2
                    END DO
                    NFOR = 7 - NFOR
                    NC   = -1
                  END DO
                ELSE IF (NUL .EQ. 7) THEN
                  DO J = 1, 4
                    INDA     = IND + IOFF(J)
                    SK(INDA) = ATRM
                    IF (ICENT .EQ. 1) SK(INDA + IOD8) = BTRM
                  END DO
                END IF
              END IF
   50       CONTINUE
          END IF
        END DO
   60   DO III = ILS, ILE
          JS = (III - ILS) * IHKM
          JC = III  * IHKM * N48 + 1
          DO J = JS + 1, JS + IHKM
            J1 = J
            J2 = J1 + IOD4
            J3 = J2 + IOD4
            J4 = J3 + IOD4
            COEFF(JC)     =   SK(J1) + SK(J2) + SK(J3) + SK(J4)
            COEFF(JC + 1) = - SK(J1) + SK(J2) - SK(J3) + SK(J4)
            COEFF(JC + 2) = - SK(J1) - SK(J2) + SK(J3) + SK(J4)
            COEFF(JC + 3) = - SK(J1) + SK(J2) + SK(J3) - SK(J4)
            IF (ICENT .EQ. 1) THEN
              J1 = J1 + IOD8
              J2 = J2 + IOD8
              J3 = J3 + IOD8
              J4 = J4 + IOD8
              COEFF(JC + 4) =   SK(J1) + SK(J2) - SK(J3) - SK(J4)
              COEFF(JC + 5) = - SK(J1) + SK(J2) + SK(J3) - SK(J4)
              COEFF(JC + 6) =   SK(J1) + SK(J2) + SK(J3) + SK(J4)
              COEFF(JC + 7) =   SK(J1) - SK(J2) + SK(J3) - SK(J4)
            END IF
            JC = JC + N48
          END DO
        END DO
        ILS = ILS + LAYPP
        ILE = ILE + LAYPP
        IF (ILE .GT. ILM - 1) ILE = ILM - 1
      END DO
      NA = 0
      DO JJJ = 1, IPR(39)
        DO J = 1, 3
          XJX(J)     = XXO(JJJ, J)
          XJX(J + 3) = 0.0
        END DO
        MM = NA + 1
        IF (MM .LE. NCT0) THEN
          DO 80 J = 1, NST
            CALL SGSM (ICL, J, XJX, LU6, 3, IERR)
            DO K = 1, 3
              CXY = MOD(XJX(6 + K), 1.0)
              IF (CXY .LT. 0.0) CXY = CXY + 1.0
              ATOM(K, NA + 1) = CXY
            END DO
            IF (J .NE. 1) THEN
              DO 70 II = MM, NA
                DO K = 1, 3
                  IF (ABS(ATOM(K, NA + 1) - ATOM(K, II)) .GT. 1.0E-6)
     1                GO TO 70
                END DO
                GO TO 80
   70         CONTINUE
            END IF
            NA          = NA + 1
            LATOM(NA) = LABA(JJJ)
            DO K = 1, 3
              IFLG(K, NA) = IFG(K, JJJ)
            END DO
   80     CONTINUE
        ELSE IF (MM .GT. NCT0) THEN
          CALL PLA015 (0, 56)
          GO TO 90
        ENDIF
      END DO
   90 PHI = PAR(276) / RGBL(6)
      MX  = NINT(PAR(272) / PAR(271) + 0.5) + 1
      MY  = NINT(PAR(273) / PAR(271) + 0.5) + 1
      NXP = MX / 2
      NXM = 1 + NXP - MX
      NYP = MY / 2
      NYM = 1 + NYP - MY
      DO I = 1, 3
        DIST1 = GEN009 (VLAK, CMAT(1, I)) - VLAK(4)
        DO J = 1, 3
          V1(J) = DIST1 * VLAK(J)
        END DO
        CALL GEN015 (CMAT(1, I), V1, V2, -1.0)
        DO J = 1, 3
          CMAT(J, I) = V2(J)
        END DO
      END DO
      CALL GEN015 (CMAT(1, 1), CMAT(1, 2), V1, -1.0)
      DIST1 = SQRT(GEN009(V1, V1))
      DO I = 1, 3
        XN(I, 1) = V1(I) / DIST1
      END DO
      CALL GEN008 (VLAK, XN(1, 1), XN(1, 2), 0)
      DO I = 1, 3
        XN(I, 4) = PAR(274) * XN(I, 1) + PAR(275) * XN(I, 2)
     1           + CMAT(I, 2)
      END DO
      CALL GEN002 (1, ROR, XN(1, 4), XFO, XLNG)
      SINPHI = SIN(PHI)
      COSPHI = COS(PHI)
      DO I = 1, 3
        V1(I) =  COSPHI * XN(I, 1) + SINPHI * XN(I, 2)
        V2(I) = -SINPHI * XN(I, 1) + COSPHI * XN(I, 2)
      END DO
      DO I = 1, 3
        XN(I, 1) = PAR(271) * V1(I)
        XN(I, 2) = PAR(271) * V2(I)
      END DO
      CALL GEN002 (1, ROR, XN(1, 1), DXF, XLNG)
      CALL GEN002 (1, ROR, XN(1, 2), DYF, XLNG)
      CALL GEN002 (1, ROR, XN(1,4), FC(1,5), XLNG)
      DO I = 1, 3
        V0(I) = NYM * DYF(I)
        V1(I) = NYP * DYF(I)
        V2(I) = NXM * DXF(I)
        V3(I) = NXP * DXF(I)
      END DO
      CALL GEN015 (V2, V1, FC(1, 1), 1.0)
      CALL GEN015 (V3, V1, FC(1, 2), 1.0)
      CALL GEN015 (V3, V0, FC(1, 3), 1.0)
      CALL GEN015 (V2, V0, FC(1, 4), 1.0)
      DO I = 1, 4
        CALL GEN015 (FC(1, I), FC(1, 5), V1, 1.0)
        DO J = 1, 3
          FC(J, I) = V1(J)
        END DO
      END DO
      WRITE (LU7, 99996, IOSTAT = IOST)
      WRITE (LU7, 99995, IOSTAT = IOST) (XFO(I), I = 1, 3)
      WRITE (LU7, 99994, IOSTAT = IOST) (FC(I, 1), I = 1, 3), NXM, NYP
      WRITE (LU7, 99993, IOSTAT = IOST) (FC(I, 2), I = 1, 3), NXP, NYP
      WRITE (LU7, 99992, IOSTAT = IOST) (FC(I, 3), I = 1, 3), NXP, NYM
      WRITE (LU7, 99991, IOSTAT = IOST) (FC(I, 4), I = 1, 3), NXM, NYM
      DO I = 1, 3
        ULC(I) = FC(I, 1)
      END DO
C * DO THE FOURIER SUMMATION
      IF (IPR(414) .EQ. 3) THEN
        F000 = 0.0
      ELSE
        IF (PAR(277) .NE. 0.0) THEN
          F000 = PAR(277)
        ELSE
          F000 = PAR(157)
        END IF
      END IF
      DO IY = 1, MY
        UPL1 = ULC(1) - DXF(1) - (IY - 1) * DYF(1)
        UPL2 = ULC(2) - DXF(2) - (IY - 1) * DYF(2)
        UPL3 = ULC(3) - DXF(3) - (IY - 1) * DYF(3)
        DO IX = 1, MX
          X   = (UPL1 + IX * DXF(1)) * RGBL(5)
          Y   = (UPL2 + IX * DXF(2)) * RGBL(5)
          Z   = (UPL3 + IX * DXF(3)) * RGBL(5)
          SX1 = SIN(X)
          CX1 = COS(X)
          SY1 = SIN(Y)
          CY1 = COS(Y)
          SZ1 = SIN(Z)
          CZ1 = COS(Z)
          CZ  = CZ1
          SZ  = -SZ1
          ICO = 0
          R   = F000 / 2.0
          DO IL = 1, ILM
            CZT = CZ * CZ1 - SZ * SZ1
            SZ  = SZ * CZ1 + CZ * SZ1
            CZ  = CZT
            CX  = CX1
            SX  = -SX1
            DO IH = 1, IHM
              CXT  = CX * CX1 - SX * SX1
              SX   = SX * CX1 + CX * SX1
              CX   = CXT
              CXCZ = CX * CZ
              CXSZ = CX * SZ
              SXCZ = SX * CZ
              SXSZ = SX * SZ
              CY   = CY1
              SY   = -SY1
              DO IK = 1, IKM
                CYT = CY * CY1 - SY * SY1
                SY  = SY * CY1 + CY * SY1
                CY  = CYT
                ICO = ICO + 4
                R   = R + COEFF(ICO - 3) * CXCZ * CY
     1              +     COEFF(ICO - 2) * SXCZ * SY
     2              +     COEFF(ICO - 1) * SXSZ * CY
     3              +     COEFF(ICO)     * CXSZ * SY
                IF (ICENT .EQ. 1) THEN
                  ICO = ICO + 4
                  R   = R + COEFF(ICO - 3) * CXSZ * CY
     1                +     COEFF(ICO - 2) * SXSZ * SY
     2                +     COEFF(ICO - 1) * SXCZ * CY
     3                +     COEFF(ICO)     * CXCZ * SY
                END IF
              END DO
            END DO
          END DO
          FMP(IX, MY - IY + 1) = R * 200 / PAR(98)
        END DO
      END DO
      IF (IPR(580) .EQ. 1) THEN
        WRITE (LU65, 99998, IOSTAT = IOST) MX * MY
        WRITE (LU65, 99997, IOSTAT = IOST)
     1        ((FMP(I, J) * 0.01, J = 1, MY), I = 1, MX)
        NRSECT = NRSECT + 1
        IF (NRSECT .GT. NSECTIONS) THEN
          LRT1    = 2
          VLAK(4) = VLAK(4) - IPR(578) * PAR(278)
          CALL GEN008 (XN(1, 1), XN(1, 2), XN(1, 3), 1)
          DO I = 1, 3
            RORO(3, I) = XN(I, 3)
          END DO
          DO I = 1, 2
            DO J = 1, 3
              RORO(I, J) = XN(J, I) / PAR(271)
            END DO
          END DO
          WRITE (LU65, 99986, IOSTAT = IOST) IPR(39), 14
          DO I = 1, IPR(39)
            IVAL = NINT(XMCT(4, I)) + 1
            NQ1  = LMT(IVAL, 1)
            CALL GEN020 (1, NQ1, 2, 2)
            N = 0
            IF (NQ1(1:1) .EQ. ' ') N = 1
            DO J = 1, 3
              V1(J) = XMCT(J, I)  - FMAT(J, 2)
            END DO
            CALL GEN002 (1, OR, V1, V2, XLNG)
            CALL GEN002 (1, RORO, V2, V3, XLNG)
            V3(1) = V3(1) - PAR(274)
            V3(2) = V3(2) - PAR(275)
            WRITE (LU65, 99985, IOSTAT = IOST)
     1        NQ1(1+N:4+N), CHAR(0), FLOAT(I), 1.0, 0.0,
     2        (V3(J), J = 1, 3), 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0
          END DO
          CLOSE (UNIT = LU65)
C * F3D
          NE = FINDEXE ('F3DEXE', PLPATH, 'f3d')
          IF (NE .GT. 0) THEN
            PLPATH(NE + 1:) = ' '//NAMEFIL(1:KNMFIL)//'.fou &'
            KERR = 0
            CALL SPAWN (PLPATH, KERR)
          END IF
          IPR(580) = -1
        ELSE
          VLAK(4) = VLAK(4) + PAR(278)
        END IF
        GO TO 90
      END IF
C * DO THE PLOTTING
  100 CALL PLA252
      IF (IGBL(25) .NE. 1)
     1    CALL GEN125 (1, LU6, 'Next section (Up/Down/Quit/+,-dist)')
  110 IPR(439) = 1
      CALL PLA253 (2, LRT1)
      SELECT CASE (LRT1)
        CASE (1)
          GO TO 120
        CASE (2)
          VLAK(4) = VLAK(4) + PAR(278) * IPR(417)
          GO TO 90
        CASE (3)
          GO TO 40
        CASE (4)
          GO TO 10
        CASE (5)
          GO TO 110
        CASE (6)
          GO TO 100
        CASE (7)
          VLAK(4) = VLAK(4) - PAR(278) * IPR(577)
          NSECTIONS = IPR(577) + IPR(578) + 1
          NRSECT    = 1
          OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'.fou',
     1                              STATUS = 'UNKNOWN')
          WRITE (LU65, 99990, IOSTAT = IOST)
          WRITE (LU65, 99997, IOSTAT = IOST) 1.0, 0.0, 0.0, 0.0, 1.0,
     1      0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0
          WRITE (LU65, 99989, IOSTAT = IOST) (PAR(I), I = 101, 106)
          XMX  = (MX - 1) * PAR(271) / 2
          XMY  = (MY - 1) * PAR(271) / 2
          XMZM = IPR(577) * PAR(278)
          XMZP = IPR(578) * PAR(278)
          WRITE (LU65, 99988, IOSTAT = IOST)
     1      -XMX,  PAR(271), XMX,  1.0,
     2      -XMY,  PAR(271), XMY,  1.0,
     3      -XMZM, PAR(278), XMZP, 1.0
          WRITE (LU65, 99987, IOSTAT = IOST) MX, MY, NSECTIONS
          GO TO 90
      END SELECT
  120 IGBL(6) = 10
      RETURN
99999 FORMAT ('Job too large for COEFF array. ',I6,' needed ')
99998 FORMAT ('BLOCK', /, I8)
99997 FORMAT (F15.8)
99996 FORMAT (/, 20X, 'Origin and Map Corners')
99995 FORMAT ('Origin', 11X, 3F9.5, 6X, '0', 4X, '0')
99994 FORMAT ('UpperLeftCorner  ', 3F9.5, 2X, 2I5)
99993 FORMAT ('UpperRightCorner ', 3F9.5, 2X, 2I5)
99992 FORMAT ('LowerRightCorner ', 3F9.5, 2X, 2I5)
99991 FORMAT ('LowerLeftCorner  ', 3F9.5, 2X, 2I5)
99990 FORMAT ('INFO  DOWN, ACROSS AND SECTION', /, 'TRAN')
99989 FORMAT ('CELL', 6(/, F15.8))
99988 FORMAT ('L14', 12(/, F15.8))
99987 FORMAT ('SIZE', 3(/, I8))
99986 FORMAT ('LIST5', 2(/, I8))
99985 FORMAT (A, A, 13(/, F15.8))
      END SUBROUTINE PLA250
      SUBROUTINE PLA251
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NP60=100)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      COMMON /PL251/ RANDS(3)
      INTEGER HMAX
      CALL PLA023 (0)
      NATO = IPR(589)
      IF (NATO .LT. 0) THEN
        IPR(1) = 1
        IPR(2) = 42
        RETURN
      END IF
      NSYMH = IPR(255)
      ICNTR = IPR(257)
      AN0   = 0.0
      IND1  = 1
      IND2  = 2
      IND3  = 3
      NREF  = 0
      SOMXO = 0.0
      SOMXC = 0.0
      CALL GEN108 (LU9, 0)
      HMAX = -999
      KMAX = -999
      LMAX = -999
      IHT  = 0
      IKT  = 0
      ILT  = 0
      IEND = -1
      DO WHILE (IEND .NE. 1)
        CALL PLA137 (IH, IK, IL, IHT, IKT, ILT, XOBS, SIGI,
     1    SIGIW, UCINT, ACALS, BCALS, ABSCOR, IEND)
        IF (IEND .EQ. 1) THEN
          IF (NREF .EQ. 0) THEN
            WRITE (LU6, 99999, IOSTAT = IOST)
            IPR(210) = 0
            RETURN
          ELSE
            PAR(166) = ASIN(SQRT(PAR(166)) * PAR(17)) * RGBL(6)
            IF (IPR(259) .EQ. 5 .OR. IPR(259) .EQ. 6) THEN
              HMAX = MAX (KMAX, HMAX, IABS(IHT + IKT))
              KMAX = HMAX
            ELSE IF (IPR(259) .EQ. 4) THEN
              HMAX = MAX (HMAX, KMAX)
              KMAX = HMAX
            ELSE IF (IPR(259) .EQ. 7) THEN
              HMAX = MAX (HMAX, KMAX, LMAX)
              KMAX = HMAX
              LMAX = HMAX
            END IF
          END IF
        ELSE
          HMAX = MAX (HMAX, IABS(IHT))
          KMAX = MAX (KMAX, IABS(IKT))
          LMAX = MAX (LMAX, IABS(ILT))
          NREF = NREF + 1
          ACAL = 0.0
          BCAL = 0.0
          IF (IGBL(9) .EQ. -1) THEN
            IF (IPR(414) .EQ. 4) THEN
              ACAL = ACALS
              BCAL = BCALS
              XOBS = ACAL **2 + BCAL ** 2
            END IF
          END IF
          CALL PLA135 (IHT, IKT, ILT, ACAL, BCAL, ACALA, BCALA,
     1      ACALAF, BCALAF, SNTHA)
          IF (IGBL(9) .EQ. 21) THEN
            ACALA = (ACALA + ACALAF) / 2.0
            ACAL  = ACAL + ACALA
            ACALA = 0.0
            BCALA = 0.0
            XCAL = ACAL ** 2 + BCAL ** 2
          ELSE
            ACAL = ACAL + ACALA
            BCAL = BCAL + BCALA
            XCAL = ACAL ** 2 + BCAL ** 2
            IF (XOBS .GT. 2 * SIGI) THEN
              SOMXO = SOMXO + XOBS
              SOMXC = SOMXC + XCAL
            END IF
          END IF
          WRITE (LU9) IHT, IKT, ILT, XOBS, XCAL, SIGI,
     1                ACAL, BCAL, ACALA, BCALA, ACALAF, BCALAF
        END IF
      END DO
      IF (IPR(414) .EQ. 5) THEN
        SCF = 100.0 / (SOMXO * PAR(240))
      ELSE IF (IPR(414) .EQ. 4) THEN
        SCF = 1.0 / PAR(240)
      ELSE IF (IGBL(9) .EQ. 1 .OR. IGBL(9) .EQ. 21 .OR.
     1         IGBL(9) .EQ. 25) THEN
        IF (IPR(516) .EQ. 0) THEN
          SCF = PAR(240) / PAR(230)
        ELSE
          SCF = SOMXC / (SOMXO * PAR(240))
        END IF
      ELSE
        SCF = SOMXC / (SOMXO * PAR(240))
      END IF
      WRITE (LU6, 99995, IOSTAT = IOST) SCF
      CALL GEN108 (LU9,  0)
      NR7 = 0
      DO I = 1, NREF
        READ (LU9) IHT, IKT, ILT, XOBS, XCAL, SIGI,
     1             ACAL, BCAL, ACALA, BCALA, ACALAF, BCALAF
        XOBS = MAX (0.0, XOBS) * SCF
        SIGI = SIGI * SCF
        XCAL = XCAL / PAR(240)
        IF (IPR(414) .GT. 0) THEN
          IF (IGBL(9) .NE. 21) THEN
            MAPR = 1
            IF (MAPR .EQ. 1) THEN
              XOBS =
     1          (SQRT(XOBS) * ACAL / SQRT(XCAL) - ACALA) ** 2 +
     2          (SQRT(XOBS) * BCAL / SQRT(XCAL) - BCALA) ** 2
              ACAL = ACAL - ACALA
              BCAL = BCAL - BCALA
            ELSE IF (MAPR .EQ. 2) THEN
              ACAL = ACAL - ACALA
              BCAL = BCAL - BCALA
              FCAL = SQRT(ACAL**2 + BCAL**2)
              SINA = BCAL / FCAL
              COSA = ACAL / FCAL
              DANO = ACALA * SINA - BCALA * COSA
              DANO = SQRT(MAX(0.0, XOBS - DANO**2))
              XOBS = (DANO - ACALA * COSA - BCALA * SINA)**2
            ELSE IF (MAPR .EQ. 3) THEN
              BCAL = BCAL - BCALA
              XOBS = (ACAL**2 + BCAL**2) * XOBS / XCAL
            END IF
            XCAL = ACAL**2 + BCAL**2
          END IF
          IF (ACAL .EQ. 0.0 .AND. BCAL .EQ. 0.0) THEN
            PCAL = 0.0
          ELSE
            PCAL = ATAN2 (BCAL, ACAL) * RGBL(6)
          END IF
        END IF
        VOID(NR7 + 1) = IHT
        VOID(NR7 + 2) = IKT
        VOID(NR7 + 3) = ILT
        VOID(NR7 + 4) = XOBS * PAR(240)
        VOID(NR7 + 5) = XCAL * PAR(240)
        VOID(NR7 + 6) = SIGI * PAR(240)
        VOID(NR7 + 7) = PCAL
        NR7           = NR7  + 7
      END DO
      SUM1     = 0.0
      SUM2     = 0.0
      SUM3     = 0.0
      SUM4     = 0.0
      IPR(411) = HMAX
      IPR(412) = KMAX
      IPR(413) = LMAX
      MPH      = 2 * HMAX + 1
      MPK      = 2 * KMAX + 1
      MPL      = 2 * LMAX + 1
      MHK      = MPH * MPK
      MHKL     = MPL * MHK
      MHKLH    = (MHKL - 1) / 2
      IADR     = NVD - MHKLH
      IADR1    = NVD - MHKL
      IF (IADR1 .LT. NR7) THEN
        WRITE (LU6, 99997, IOSTAT = IOST)
        RETURN
      END IF
      DO I = 1, MHKL
        VOID(IADR1 + I) = - 1.0
      END DO
      NR7 = 0
      DO I = 1, NREF
        IHT  = NINT(VOID(NR7 + 1))
        IKT  = NINT(VOID(NR7 + 2))
        ILT  = NINT(VOID(NR7 + 3))
        IHKL = ILT * MHK + IKT * MPH + IHT
        N    = NINT (VOID(IADR + IHKL))
        IF (N .LT. 0) THEN
          VOID(IADR + IHKL) = I
        ELSE
          XOBS1 = VOID((N - 1) * 7 + 4)
          SIGI1 = VOID((N - 1) * 7 + 6)
          IF (SIGI1 .GT. 0.0) THEN
            WGTI1 = 1.0 / SIGI1**2
          ELSE
            WGTI1 = 1.0
          END IF
          XOBS2 = VOID(NR7 + 4)
          SIGI2 = VOID(NR7 + 6)
          IF (SIGI2 .GT. 0.0) THEN
            WGTI2 = 1.0 / SIGI2**2
          ELSE
            WGTI2 = 1.0
          END IF
          WGTIS = WGTI1 + WGTI2
          VOID((N - 1) * 7 + 4) =
     1         (WGTI1 * XOBS1 + WGTI2 * XOBS2) / WGTIS
          VOID((N - 1) * 7 + 6) = 1.0 / SQRT(WGTIS)
        END IF
        NR7  = NR7 + 7
      END DO
      NSYMC = NSYMH * 2
      DO I = 1, MHKL
        J = MHKL + 1 - I
        K = NINT(VOID(IADR1 + J))
        IF (K .GT. 0) THEN
          VOID(IADR1 + J) = -1
          IHT   = NINT(VOID((K - 1) * 7 + 1))
          IKT   = NINT(VOID((K - 1) * 7 + 2))
          ILT   = NINT(VOID((K - 1) * 7 + 3))
          XOBS  =      VOID((K - 1) * 7 + 4)
          SIGI  =      VOID((K - 1) * 7 + 6)
          PCAL  =      VOID((K - 1) * 7 + 7)
          IHKL0 = ILT * MHK + IKT * MPH  + IHT
          IHKLN = IHKL0
          PCALN = PCAL
          IHTN  = IHT
          IKTN  = IKT
          ILTN  = ILT
          IF (SIGI .NE. 0.0) THEN
            SUMT  = XOBS / SIGI**2
            SUMN  = 1.0  / SIGI**2
          ELSE
            SUMT = XOBS
            SUMN = 1.0
          END IF
          DO L = 2, NSYMC
            XJX(1) = IHT
            XJX(2) = IKT
            XJX(3) = ILT
            XJX(4) = PCAL
            IF (L .GT. NSYMH) THEN
              NS = L - NSYMH
              IS = -1
            ELSE
              NS = L
              IS = 1
            END IF
            CALL SGSM (ICL, NS, XJX, LU7, 5, IERR)
            IH   = NINT(XJX(7))
            IK   = NINT(XJX(8))
            IL   = NINT(XJX(9))
            IHKL = (IL * MHK + IK * MPH  + IH) * IS
            IF (IHKL .GT. IHKLN) THEN
              IHKLN = IHKL
              IHTN  = IH
              IKTN  = IK
              ILTN  = IL
              PCALN = XJX(10)
            END IF
            IF (IHKL .NE. IHKL0) THEN
              N = NINT(VOID(IADR + IHKL))
              IF (N .GT. 0) THEN
                NADR = (N - 1) * 7
                XOBS = VOID(NADR + 4)
                SIGI = VOID(NADR + 6)
                IF (SIGI .NE. 0.0) THEN
                  WGHT = 1.0 / SIGI**2
                ELSE
                  WGHT = 1.0
                END IF
                SUMT = SUMT + XOBS * WGHT
                SUMN = SUMN + WGHT
                VOID(IADR + IHKL) = - 1.0
              END IF
            END IF
          END DO
          VOID(IADR + IHKLN) = K
          NADR           = (K - 1) * 7
          VOID(NADR + 1) = IHTN
          VOID(NADR + 2) = IKTN
          VOID(NADR + 3) = ILTN
          VOID(NADR + 4) = SUMT / SUMN
          VOID(NADR + 6) = 1.0  / SQRT(SUMN)
          VOID(NADR + 7) = PCALN
        END IF
      END DO
      NRF  = 0
      NRF1 = 0
      CALL GEN108 (LU9, 0)
      DO I = 1, MHKL
        N = NINT(VOID(IADR1 + I))
        IF (N .GT. 0) THEN
          NADR = N * 7
          IH   = NINT (VOID(NADR - 6))
          IK   = NINT (VOID(NADR - 5))
          IL   = NINT (VOID(NADR - 4))
          XOBS = VOID(NADR - 3)
          XCAL = VOID(NADR - 2)
          SIGI = VOID(NADR - 1)
          PCAL = VOID(NADR)
          CALL PLA138 (1, IH, IK, IL, IEXT, IASM)
          IF (IEXT .EQ. 0) THEN
            NRF1 = NRF1 + 1
            IF (XOBS .GE. 2 * SIGI) THEN
              SUM1 = SUM1 + ABS(SQRT(XOBS) - SQRT(XCAL))
              SUM2 = SUM2 + SQRT(XOBS)
              NRF  = NRF  + 1
            END IF
            SGIK = SIGI ** 2
            STHLK = GEN095 (PAR(191), IH, IK, IL)
            IF (PAR(497) .GE. 0.0) THEN
              PXX  = (MAX(0.0, XOBS) + 2.0 * XCAL) / 3.0
              IF (PAR(499) .GT. 0.0) THEN
                SGIK = (SGIK + (PAR(497) * PXX)**2 + PAR(498) * PXX) /
     1            EXP (PAR(499) * STHLK)
              ELSE
                SGIK = SGIK + (PAR(497) * PXX)**2 + PAR(498) * PXX
              END IF
            END IF
            SUM3 = SUM3 + ((XOBS - XCAL) ** 2) / SGIK
            SUM4 = SUM4 + (XOBS ** 2) / SGIK
            STHL = SQRT(STHLK)
            FOBS = SQRT(MAX(0.0, XOBS))
            FCAL = SQRT(MAX(0.0, XCAL))
            IF (ICNTR .EQ. 2) THEN
              SINA = 0.0
              IF (ABS(PCAL) .LT. 90.0) THEN
                COSA = 1.0
              ELSE
                COSA = -1.0
              END IF
            ELSE
              PHI  = PCAL / RGBL(6)
              SINA = SIN (PHI)
              COSA = COS (PHI)
            END IF
            IF (IPR(414) .EQ. 1) THEN
              AN0 = FOBS
            ELSE IF (IPR(414) .EQ. 2) THEN
              AN0 = 2 * FOBS - FCAL
            ELSE IF (IPR(414) .EQ. 3) THEN
              AN0 = FOBS - FCAL
            ELSE IF (IPR(414) .EQ. 4) THEN
              AN0 = FOBS
            ELSE IF (IPR(414) .EQ. 5) THEN
              AN0  = FOBS **2
              COSA = 1.0
              SINA = 0.0
            END IF
            AI0 = AN0 * COSA
            BI0 = AN0 * SINA
            IF (AI0 .NE. 0.0 .OR. BI0 .NE. 0)
     1        WRITE (LU9) IH, IK, IL, AI0, BI0, XCAL / SIGI, STHL
          END IF
        END IF
      END DO
      IF (IPR(414) .LT. 4) THEN
        N = 0
        IF (PAR(497) .GE. 0) THEN
          N = INDEX (RLWS(1)(2:80), '''')
          IF (N .GE. 2) WRITE (LU6, 99996, IOSTAT = IOST) RLWS(1)(2:N)
        END IF
        RANDS(1) = SUM1 / SUM2
        RANDS(2) = SQRT(SUM3 / SUM4)
        RANDS(3) = SQRT(SUM3 / (NRF1 - IPR(226)))
        WRITE (LU6, 99998, IOSTAT = IOST)
     1    RANDS(1), NRF, RANDS(2), NRF1, RANDS(3)
        IF (N .GE. 2) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99996, IOSTAT = IOST) RLWS(1)(2:N)
        END IF
        CALL PLA262 (6)
        WRITE (LU7, 99998, IOSTAT = IOST)
     1    RANDS(1), NRF, RANDS(2), NRF1, RANDS(3)
      END IF
      RETURN
99999 FORMAT (/, ':: However, no reflection data found', /)
99998 FORMAT (':: R1   =', F7.3, ' for', I6,
     1        ' Refl. with I > 2 s(I) and', /,
     2        ':: wR2  =', F7.3, ' for', I6, ' reflections', /,
     3        ':: S    =', F7.3, /)
99997 FORMAT (/, 'NVD too Small in PLA251', /)
99996 FORMAT (/, ':: ', A)
99995 FORMAT (':: SCF =', F10.6)
      END SUBROUTINE PLA251
      SUBROUTINE PLA252
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35,NCT0=5000,
     4 NCT1=1000000,NTC4=200,NCT5=2000,NCT6=100,NCT7=NCT6+1,NCT8=2500,
     5 NCT3=NVD+2*NP23-2007-9*NCT8-2*
     6 NCT5 - 7 * NCT0 - NCT1 - 3 * NTC4 * NTC4 - NCT6 * (NCT6 + 13))
      COMMON // LATOM(NCT0), ATOM(3, NCT0), IFLG(3, NCT0), COEFF(NCT1),
     1 XMPC(NCT8, 5), IMPC(3, NCT8), JMPC(NCT8), Q8(2, NCT5),
     2 FMP(NTC4, NTC4), IEXX(2, NTC4, NTC4), SMA(NCT6, NCT7),
     3 P8(12, NCT6), DXF(3), DYF(3), NAT, XMCT(4, 500), SK(NCT3)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /APLOT/ X, Y, SCALE, PXS, PYS, STEP, VLAK(4)
      COMMON /ASESCH/ NT, IN, IXY, IX, IY, IV
      COMMON /AINPUT/ NS, NE, MX, MY, NXP, NXM, NYP, NYM, PHI,
     1  XN(3, 4), FMAT(3, 3), CMAT(3, 3)
      COMMON /ASETUP/ ID(6, 6, 2), IRANGE(12)
      COMMON /CTR/ NA, ICENT, IKM, ILM, IHM
      COMMON /AREA/ L7, T9(NCT6), N7, NS7, NE7, IC, MM, XX, YY, JV, NN
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /PL251/ RANDS(3)
      DIMENSION XT(3)
      IN7  = 0
      IXY7 = 0
      IX7  = 0
      IY7  = 0
      X7   = 0.0
      Y7   = 0.0
      RESX1 = PAR(279) / PAR(271)
      XLOW  = NXM - RESX1
      XHIGH = NXP + RESX1
      YLOW  = NYM - RESX1
      YHIGH = NYP + RESX1
      NAT   = 0
      DO IA = 1, NA
        DO IX = 1, 3
          XT(1) = ATOM(1, IA) + IX - 2
          DO IY = 1, 3
            XT(2) = ATOM(2, IA) + IY - 2
            DO IZ = 1, 3
              XT(3) = ATOM(3, IA) + IZ - 2
              CALL GEN002 (1, OR, XT, V3, XLNG)
              DO I = 1, 3
                XMPC(NAT + 1, I + 2) = V3(I)
              END DO
              DIST1 = GEN009 (VLAK, V3)
              DIS = DIST1 - VLAK(4)
              DO J = 1, 3
                V1(J) = DIS * VLAK(J)
              END DO
              CALL GEN015 (V3, V1, V2, -1.0)
              CALL GEN015 (V2, XN(1, 4), V1, -1.0)
              DO I = 1, 2
                V3(I) = GEN009 (V1, XN(1, I))
              END DO
              V3(1) = V3(1) / PAR(271)**2
              V3(2) = V3(2) / PAR(271)**2
              IF (V3(1) .GT. XLOW .AND. V3(1) .LT. XHIGH .AND.
     1            V3(2) .GT. YLOW .AND. V3(2) .LT. YHIGH .AND.
     2            ABS(DIS) .LT. PAR(279)) THEN
                IF (NAT .GE. NCT8) THEN
                  WRITE (LU6, '(''W: NAT .GT. NCT8'')', IOSTAT = IOST)
                  GO TO 10
                END IF
                NAT = NAT + 1
                CALL PLA047 (LATOM(IA), NQ1, IDUM1, IDUM2, 0,
     1                       IGBL(55), 0, 0)
                XMPC(NAT, 1) = V3(1)
                XMPC(NAT, 2) = V3(2)
                IF (ABS(DIS) .LT. PAR(271)) THEN
                  JMPC(NAT) = - LATOM(IA)
                ELSE
                  JMPC(NAT) = LATOM(IA)
                END IF
                DO J = 1, 3
                  IMPC(J, NAT) = IFLG(J, IA)
                END DO
              END IF
            END DO
          END DO
        END DO
      END DO
   10 TMIN =  100000.0
      TMAX = -100000.0
      DO J = 1, MY
        DO I = 1, MX
          T = FMP(I, J)
          TMIN = MIN (TMIN, T)
          TMAX = MAX (TMAX, T)
        END DO
      END DO
      ITMAX = NINT(TMAX)
      ITMIN = NINT(TMIN) - 1
      IF (IPR(418) .EQ. 0) THEN
        IDT   = ITMAX - ITMIN
        DO I = 1, 12
          IF (IRANGE(I) .GE. IDT) THEN
            IPR(419) = MAX (10,  IRANGE(I) / 20)
            GO TO 20
          END IF
        END DO
        IPR(419) = 100
      END IF
   20 NE = ((ITMAX / IPR(419)) + 1) * IPR(419)
      NS = ((ITMIN / IPR(419)) - 1) * IPR(419)
      IF (IPR(418) .EQ. 0 .AND. IGBL(25) .NE. 1) THEN
        WRITE (LU6, 99998, IOSTAT = IOST)
     1    TMIN / 100.0, TMAX / 100.0, IPR(419) / 100.0
        IGBL(24) = 0
        READ (LU5, 99996) IGGT(6:80)
        CALL PLA280 ('CONT')
        CALL PLA006 (0, IS)
        IF (IPR(221) .EQ. 1) THEN
          IPR(419) = MAX (10, NINT(FN(1) * 100.0))
        END IF
      END IF
      I  = (NE - NS) / IPR(419)
      J  =  NE - NS  - IPR(419) * I
      NE = NS + IPR(419) * I
      IF (J .NE. 0) NE = NE + IPR(419)
      DO J = 1, MY
        DO I = 1, MX
          T  = FMP(I, J)
          CH = T / IPR(419) - INT(T / IPR(419))
          IF (CH .EQ. 0.0) FMP(I, J) = T + SIGN (0.01, T)
        END DO
      END DO
      XS = HORS * 0.88
      SL = XS / 100.0
      IF (IPR(418) .EQ. 0) THEN
        SCALE = XS / (MX - 1)
        PYS = (VERT - SCALE * (MY - 1)) / 2.0
        PXS = (HORS - XS) / 2
        YS = VERT * 0.88
        IF ((MY - 1) * SCALE .GT. YS) THEN
          SCALE = YS / (MY - 1)
          PXS = (HORS - SCALE * (MX - 1)) / 2.0
          PYS = (VERT - YS) / 2
        END IF
        STEP = SCALE / PAR(271)
        IPR(418) = 1
      END IF
      CALL GGIP (HORS, VERT, 0.0, 1)
      OFF  = 0.25
      XPOS = HORS - PXS
      YPOS = VERT - PYS
      CALL GGIP (PXS,  PYS,  0.0, 3)
      CALL GGIP (XPOS, PYS,  0.0, 2)
      CALL GGIP (XPOS, YPOS, 0.0, 2)
      CALL GGIP (PXS,  YPOS, 0.0, 2)
      CALL GGIP (PXS,  PYS,  0.0, 2)
      XST = PXS
      DO WHILE (XST .LT. XPOS)
        CALL GGIP (XST, PYS,      0.0, 3)
        CALL GGIP (XST, PYS - SL, 0.0, 2)
        XST = XST + STEP
      END DO
      YST = PYS
      DO WHILE (YST .LT. YPOS)
        CALL GGIP (PXS,      YST, 0.0, 3)
        CALL GGIP (PXS - SL, YST, 0.0, 2)
        YST = YST + STEP
      END DO
      CALL GGIP09 (0.0, 'Ang', 3, 0.3, 1, 2, XPOS + OFF, PYS - OFF)
      IF (IGBL(103) .EQ. 1) THEN
        CALL GEN002 (-1, OR, VLAK, XPV(5), XLNG)
        XPV(8) = VLAK(4)
        WRITE (ICL, 99999, IOSTAT = IOST) (XPV(I), I = 5, 8),
     1        (NS + IPR(419)) / 100.0, (NE - IPR(419)) / 100.0,
     2        IPR(419) / 100.0
        CALL GGIP09 (0.0, ICL, 80, 0.3, 1, 2, 1.5, VERT - 0.5)
        SELECT CASE (IPR(414))
          CASE (1)
            NQ1 = ' Fo-Map'
          CASE (2)
            NQ1 = ' 2Fo-Fc'
          CASE (3)
            NQ1 = 'Dif-Map'
          CASE (4)
            NQ1 = 'SQZ-Map'
          CASE (5)
            NQ1 = 'PAT-Map'
        END SELECT
        CALL GGIP09 (0.0, NQ1, 7, 0.30, 1, 2, HORS - 3.5,
     1               VERT - 0.5)
        RESOL = MIN (PAR(166),
     1                 ASIN (MIN(PAR(412) * PAR(17), 1.0)) * RGBL(6))
        WRITE (ICL, 99997, IOSTAT = IOST)
     1    PAR(279), PAR(278) * IPR(417), RESOL, IPR(515)
        CALL GGIP09 (0.0, ICL, 80, 0.3, 1, 2, 2.0, VERT - 0.95)
        CALL PLA110 (HORS, VERT, -1)
        CALL GGIP09 (0.0, 'R1  =', 5, 0.3, 1, 2, XPOS + 0.2, YPOS - 0.5)
        WRITE (ICL, 99994, IOSTAT = IOST) RANDS(1)
        CALL GGIP09 (0.0,  ICL,    5, 0.3, 1, 2, XPOS + 0.2, YPOS - 1.0)
        CALL GGIP09 (0.0, 'wR2 =', 5, 0.3, 1, 2, XPOS + 0.2, YPOS - 1.7)
        WRITE (ICL, 99994, IOSTAT = IOST) RANDS(2)
        CALL GGIP09 (0.0,  ICL,    5, 0.3, 1, 2, XPOS + 0.2, YPOS - 2.2)
        CALL GGIP09 (0.0, 'S   =', 5, 0.3, 1, 2, XPOS + 0.2, YPOS - 2.9)
        WRITE (ICL, 99994, IOSTAT = IOST) RANDS(3)
        CALL GGIP09 (0.0,  ICL,    5, 0.3, 1, 2, XPOS + 0.2, YPOS - 3.4)
      END IF
      IF (IPR(458) .NE. 0 .OR. IGBL(75) .NE. 0) THEN
        MX2 = (MX - 1) / 2
        MY2 = (MY - 1) / 2
        IF (IPR(414) .LT. 5 .AND. NAT .GT. 0) THEN
          DO I = 1, NAT
            XXA = PXS + SCALE * (XMPC(I, 1) + MX2)
            YYA = PYS + SCALE * (XMPC(I, 2) + MY2)
            IF (XXA .GT. PXS .AND. XXA .LT. XPOS) THEN
              IF (YYA .GT. PYS .AND. YYA .LT. YPOS) THEN
                IF (JMPC(I) .LT. 0.0) THEN
                  CALL GGIP (0.0, 1.0, 0.0, 0)
                ELSE
                  CALL GGIP (0.0, 4.0, 0.0, 0)
                END IF
                XXP = XXA - OFF
                CALL GGIP (XXP, YYA, 0.0, 3)
                XXP = XXA + OFF
                CALL GGIP (XXP, YYA, 0.0, 2)
                YYP = YYA - OFF
                CALL GGIP (XXA, YYP, 0.0, 3)
                YYP = YYA + OFF
                CALL GGIP (XXA, YYP, 0.0, 2)
                CALL GGIP (0.0, 1.0, 0.0, 0)
                IF (IGBL(75) .EQ. 1) THEN
                  CALL GEN048 (-4, IMPC(1, I), 15, NO1)
                  NO1 = IEN(NO1 + 1)
                  IF (NO1 .NE. 1 .OR. (NO1 .EQ. 1 .AND.
     1                IPR(232) .EQ. 1)) THEN
                    XGGIP = XXA + OFF
                    YGGIP = YYA + OFF
                    IF (YGGIP + 0.3 .GT. YPOS) YGGIP = YGGIP - 2.0 * OFF
                    IF (XGGIP + 1.2 .GT. XPOS)
     1                  XGGIP = XGGIP - 2.0 * OFF - 1.2
                    CALL PLA047 (ABS(JMPC(I)), NQ1, IDUM1,
     1               IDUM2, 0, IGBL(55), 0, 0)
                    CALL GEN048 (-1, IMPC(1, I), 30, IVAL)
                    CALL GGIP09 (0.0, NQ1, 5, 0.3, 1 + IVAL * 4, 2,
     1                           XGGIP, YGGIP)
                  END IF
                END IF
              END IF
            END IF
          END DO
        END IF
      END IF
      IF (IPR(458) .EQ. 1 .AND. IPR(414) .LT. 5) THEN
        DO I = 1, NAT - 1
          CALL GEN048 (-4, IMPC(1, I), 15, NO1)
          CALL PLA047 (ABS(JMPC(I)), NQ1, IDUM1, IDUM2, 0,
     1      IGBL(55), 0, 0)
          DISTI = REL(IEN(NO1 + 1)) + 0.4
          DO J = I + 1, NAT
            CALL GEN048 (-4, IMPC(1, J), 15, NO2)
            CALL PLA047 (ABS(JMPC(J)), NQ2, IDUM1, IDUM2, 0,
     1                   IGBL(55), 0, 0)
            DISTMX = DISTI + REL(IEN(NO2 + 1))
            DIST   = 0
            DO K = 3, 5
              DIST = DIST + (XMPC(I, K) - XMPC(J, K))**2
            END DO
            IF (SQRT (DIST) .LT. DISTMX) THEN
              XXA = PXS + SCALE * (XMPC(I, 1) + MX2)
              YYA = PYS + SCALE * (XMPC(I, 2) + MY2)
              IF (XXA .GT. PXS .AND. XXA .LT. XPOS) THEN
                IF (YYA .GT. PYS .AND. YYA .LT. YPOS) THEN
                  XXB = PXS + SCALE * (XMPC(J, 1) + MX2)
                  YYB = PYS + SCALE * (XMPC(J, 2) + MY2)
                  IF (XXB .GT. PXS .AND. XXB .LT. XPOS) THEN
                    IF (YYB .GT. PYS .AND. YYB .LT. YPOS) THEN
                      CALL GGIP (XXA, YYA, 0.0, 3)
                      CALL GGIP (XXB, YYB, 0.0, 2)
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END DO
        END DO
      END IF
C *********************************************************************
C *********************************************************************
      DO 110 JV0 = NS, NE, IPR(419)
        IV = NE - JV0 + NS
        DO K = 1, 2
          DO J = 1, MX
            DO I = 1, MY
              IEXX(K, J, I) = 0
            END DO
          END DO
        END DO
        DO KX = 1, MX - 1
          JX = MX - KX
          DO 100 KY = 2, MY - 1
            JY = MY - KY + 1
            RA = (FMP(JX, JY) - IV) * (FMP(JX + 1, JY) - IV)
            IF (RA .GT. 0.0) GO TO 100
            IF (IEXX(1, JX, JY) .NE. 0) GO TO 100
            IUC = 0
            JUC = 0
            JC  = 0
            LC  = 0
            NT  = 0
            Q8(1, 1) = 0.0
            Q8(2, 1) = 0.0
   30       IXY = 1
            IN  = 6
            IX  = JX
            IY  = JY
            CALL PLA255
            XXX = X
            YYY = Y
            IEXX(1, JX, JY) = 2
            N5 = 6
            II = 1
   40       IF (IUC .EQ. 0) THEN
              I = IN + II
              IF (I .GT. 6) I = I - 6
            ELSE
              I = IN - II
              IF (I .LT. 1) I = I + 6
            END IF
            IX1 = ID(1, I, IXY) + IX
            IF (IX1 .NE. 0) THEN
              IY1 = ID(2, I, IXY) + IY
              IF (IY1 .NE. 0) THEN
                IX2 = ID(3, I, IXY) + IX
                IY2 = ID(4, I, IXY) + IY
                RA  = (FMP(IX1, IY1) - IV) * (FMP(IX2, IY2) - IV)
                IF (RA .LT. 0.0) GO TO 70
              END IF
            END IF
            II = II + 1
            IF (II .LE. N5) GO TO  40
   60       IF (JUC .EQ. 1) GO TO 90
            JUC = 1
            JC  = NT
            IUC = MOD(IUC + 1, 2)
            GO TO 30
   70       ICH = ID(5, I, IXY)
            IF (IEXX(ICH, IX1, IY1) .EQ. 1) THEN
              II = II + 1
              IF (II .LE. N5) THEN
                GO TO 40
              ELSE
                GO TO 60
              END IF
            END IF
            IN6  = ID(6, I, IXY)
            IXY6 = ICH
            IX6  = IX1
            IY6  = IY1
            MC   = 0
            II   = II + 1
            IF (LC .NE. 2) THEN
              IF (II .NE. 6) THEN
                DO III = II, 5
                  IF (IUC .EQ. 1) THEN
                    I9 = IN - III
                    IF (I9 .LT. 1) I9 = I9 + 6
                  ELSE
                    I9 = IN + III
                    IF (I9 .GT. 6) I9 = I9 - 6
                  END IF
                  IX9 = ID(1, I9, IXY) + IX
                  IF (IX9 .NE. 0) THEN
                    IY9 = ID(2, I9, IXY) + IY
                    IF (IY9 .NE. 0) THEN
                      IX8 = ID(3, I9, IXY) + IX
                      IY8 = ID(4, I9, IXY) + IY
                      RA9 = (FMP(IX9, IY9) - IV) * (FMP(IX8, IY8) - IV)
                      IF (RA9 .LT. 0.0) THEN
                        ICH9 = ID(5, I9, IXY)
                        IF (IEXX(ICH9, IX9, IY9) .NE. 1) THEN
                          IF ((ICH9 .EQ. 2 .AND. IY9 .NE. MY) .OR.
     1                        (ICH9 .NE. 2 .AND. IX9 .NE. MX)) THEN
                            IN7  = ID(6, I9, IXY)
                            IXY7 = ICH9
                            IX7  = IX9
                            IY7  = IY9
                            MC   = 1
                          END IF
                        END IF
                      END IF
                    END IF
                  END IF
                END DO
                IXY = IXY7
                IX  = IX7
                IY  = IY7
                CALL PLA255
                NT = NT - 1
                X7 = X
                Y7 = Y
              END IF
            END IF
            IXY = IXY6
            IX  = IX6
            IY  = IY6
            CALL PLA255
            IF (MC .NE. 0) THEN
              DX = X - XXX
              DY = Y - YYY
              R6 = SQRT(DX**2 + DY**2)
              DX = X7 - XXX
              DY = Y7 - YYY
              R7 = SQRT(DX**2 + DY**2)
              IF ((R6 / R7) .GE. 2.5) THEN
                IN                = IN7
                IXY               = IXY7
                IX                = IX7
                IY                = IY7
                IEXX(IXY, IX, IY) = 1
                Q8(1, NT)         = X7
                Q8(2, NT)         = Y7
                X                 = X7
                Y                 = Y7
                LC                = 1
                IUC = MOD(IUC + 1, 2)
                GO TO 80
              END IF
            END IF
            IEXX(IXY, IX, IY) = 1
            IN  = IN6
            LC  = 0
   80       XXX = X
            YYY = Y
            LC  = LC + 1
            IF (LC .EQ. 4) THEN
              IUC = MOD(IUC + 1, 2)
              LC  = 1
            END IF
            IF (Q8(1, 1) .NE. X .OR. Q8(2, 1) .NE. Y) THEN
              IF (IXY .EQ. 1) THEN
                IF (IY .EQ. 1 .OR. IY .EQ. MY) GO TO 60
              ELSE
                IF (IX .EQ. 1 .OR. IX .EQ. MX) GO TO 60
              END IF
              N5 = 5
              II = 1
              GO TO 40
            END IF
   90       IF (JC .GT. 0) THEN
              JCH = JC / 2
              DO I0 = 1, JCH
                J0 = JC - I0 + 1
                CALL GEN018 (Q8(1, I0), Q8(1, J0))
                CALL GEN018 (Q8(2, I0), Q8(2, J0))
              END DO
              NS0 = JC + 2
              IF (NS0 .LE. NT) THEN
                DO I0 = NS0, NT
                  Q8(1, I0 - 1) = Q8(1, I0)
                  Q8(2, I0 - 1) = Q8(2, I0)
                END DO
              END IF
              NT = NT - 1
            END IF
            IF (NT .NE. 1) THEN
              MM = IV
              IF (MM .EQ. 0) THEN
                NN = 8
              ELSE
                NN = 4
              END IF
              JV = 0
              IF (Q8(1, 1) .EQ. Q8(1, NT) .AND. Q8(2, 1) .EQ. Q8(2, NT))
     1         THEN
                IC = 3
                JCYCLE = 1
              ELSE
                IC = 2
                JCYCLE = 0
              END IF
              IF (NT .LE. 30) THEN
                DO J = 1, NT
                  P8(1, J) = Q8(1, J)
                  P8(2, J) = Q8(2, J)
                END DO
                NS7 = 1
                NE7 = NT
                N7  = NT
                CALL PLA254
                GO TO 100
              END IF
              N2 = NINT(NT / 20.0)
              IC = 2
              N3 = INT(NT / N2)
              N4 = NT - N2 * N3 + N3
              DO J = 1, N3 + 2
                P8(1, J) = Q8(1, J)
                P8(2, J) = Q8(2, J)
              END DO
              N7  = N3 + 2
              NS7 = 1
              NE7 = N7 - 2
              IF (JCYCLE .NE. 0) THEN
                DO J = 1, N3 + 2
                  P8(1, J + 2) = Q8(1, J)
                  P8(2, J + 2) = Q8(2, J)
                END DO
                DO I = 1, 2
                  P8(I, 1) = Q8(I, NT - 2)
                  P8(I, 2) = Q8(I, NT - 1)
                END DO
                N7  = N7 + 2
                NS7 = 3
                NE7 = NE7 + 2
              END IF
              CALL PLA254
              IF (N2 .NE. 2) THEN
                DO II = 1, N2 - 2
                  N5 = II * N3 - 3
                  DO J = 1, N3 + 5
                    P8(1, J) = Q8(1, N5 + J)
                    P8(2, J) = Q8(2, N5 + J)
                  END DO
                  N7  = N3 + 5
                  NS7 = 3
                  NE7 = N7 - 2
                  CALL PLA254
                END DO
              END IF
              N6 = N3 * (N2 - 1) - 3
              IF (N6 + N4 + 3 .LE. NCT5) THEN
                DO J = 1, N4 + 3
                  P8(1, J) = Q8(1, N6 + J)
                  P8(2, J) = Q8(2, N6 + J)
                END DO
              ELSE
                WRITE (LU6, 99995, IOSTAT = IOST)
                GO TO 110
              END IF
              N7  = N4 + 3
              NS7 = 3
              NE7 = N7
              IF (JCYCLE .NE. 0) THEN
                DO I = 1, 2
                  P8(I, N4 + 4) = Q8(I, 2)
                  P8(I, N4 + 5) = Q8(I, 3)
                END DO
                N7 = N7 + 2
              END IF
              CALL PLA254
            END IF
  100     CONTINUE
        END DO
  110 CONTINUE
      CALL GGIP (0.0, 0.0, 0.0,  3)
      CALL GGIP (0.0, 0.0, 0.0, -1)
      RETURN
99999 FORMAT ('Plane:', F8.4, 'x', F8.4, 'y', F8.4, 'z =', F8.4,
     1 4X, 'Cont-Lev(eA-3):', 3F6.2)
99998 FORMAT (/, 'Density values in the map range from',
     1  F7.2, ' to ', F7.2, ' eA-3', /,
     2 'New Interval[', F5.2, '] Contour Levels ', $)
99997 FORMAT ('Tol =', F5.1, ' Ang', 13X, 'Step =', F8.4, ' Ang',
     1 2X, 'Resolution', F5.1, ' Deg.', 2x, 'Omit', I2, '*SigI')
99996 FORMAT (A)
99995 FORMAT ('PROBLEM WITH Q8 IN PLA252')
99994 FORMAT (F5.3)
      END SUBROUTINE PLA252
      SUBROUTINE PLA253 (MODE, LRTN)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP45=2048)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /APLOT/ X, Y, SCALE, PXS, PYS, STEP, VLAK(4)
      COMMON /AINPUT/ NS, NE, MX, MY, NXP, NXM, NYP, NYM, PHI,
     1  XN(3, 4), FMAT(3, 3), CMAT(3, 3)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /GGT/ MEDIUM
      CHARACTER SKEY*3
      IF (MODE .EQ. 1) THEN
        IPR(414) = 1
        IF (IPR(220) .GT. 1) THEN
          DO I = 2, IPR(220)
            SELECT CASE (IFL(I)(1:2))
              CASE ('FO')
                IPR(414) = 1
              CASE ('FS')
                IPR(414) = 2
              CASE ('DI')
                IPR(414) = 3
              CASE ('SQ')
                IF (IGBL(9) .LT. 0) THEN
                  IPR(414) = 4
                ELSE
                  IPR(414) = 3
                END IF
              CASE ('PT')
                IPR(414) = 5
              CASE ('TN')
                IPR(416) = 0
              CASE ('AB')
                IPR(416) = 1
              CASE ('BI')
                IPR(416) = 2
              CASE ('PE')
                IPR(416) = 3
              CASE DEFAULT
                CYCLE
            END SELECT
          END DO
        END IF
        IF (FN(1) .GT. 0.0) THEN
          PAR(273) = FN(1)
          PAR(272) = FN(1) * 4.0 / 3.0
        END IF
        IF (FN(2) .NE. 0.0) PAR(274) = FN(2)
        IF (FN(3) .NE. 0.0) PAR(275) = FN(3)
        IF (FN(4) .NE. 0.0) PAR(276) = FN(4)
        IF (FN(5) .GT. 0.0) PAR(277) = FN(5)
        IF (IPR(30) .EQ. 0) THEN
          IF (IPR(37) .EQ. 0) THEN
            IPR(2) = 42
            LRTN   = -1
            RETURN
          END IF
          IGBL(52) = MAX (IGBL(52), IPR(23))
          CALL PLA287 (0, 1, 0)
        END IF
        IF (IPR(498) .GT. 0) THEN
          IPR(2) = 45
          LRTN   = -1
          RETURN
        END IF
C * CONTOUR
        IGBL(6) = 22
        CALL PLA262 (0)
C * MODE = 2
      ELSE IF (MODE .EQ. 2) THEN
        CALL PLA013 (0, 1)
        IF (LRET .EQ. 2) THEN
          LRTN = 6
          RETURN
        END IF
        CALL PLA006 (0, IS)
        SKEY = IFL(2)(1:3)
        IF (IPR(220) .GT. 0) THEN
          SELECT CASE (IFL(1)(1:3))
C * LIST IPR/PAR/IGBL/RGBL
            CASE ('LIS')
              IF (SKEY .EQ. 'PAR' .OR. SKEY .EQ. 'IPR' .OR.
     1          SKEY .EQ. 'IGB' .OR. SKEY .EQ. 'RGB')
     2          CALL PLA206 (-1, SKEY)
              LRTN = 5
              RETURN
C * DI
            CASE ('DI ')
              LRTN = 3
              RETURN
C * CONTOUR POSITION CLICK
            CASE ('CPS')
              XX = (FN(1) - PXS) / SCALE - FLOAT((MX - 1) / 2)
              YY = (FN(2) - PYS) / SCALE - FLOAT((MY - 1) / 2)
              WRITE (6, '(''CPS'', 2F10.3)', IOSTAT = IOST) XX, YY
              LRTN = 5
              RETURN
C * SET META TYPE
            CASE ('SET')
              IF (IFL(2)(1:3) .EQ. 'MET' .AND. IPR(220) .GT. 2) THEN
                MEDIUM = 2
                CALL GGIP (-999.0, 0.0, 0.0, 6)
C * SET IPR/PAR/IGBL/RGBL
              ELSE IF (IPR(221) .EQ. 2 .AND. IPR(220) .EQ. 2) THEN
                IF (SKEY .EQ. 'PAR' .OR. SKEY .EQ. 'IPR' .OR.
     1            SKEY .EQ. 'IGB' .OR. SKEY .EQ. 'RGB')
     2            CALL PLA206 (1, SKEY)
              END IF
              LRTN = 5
              RETURN
C * XR(OT)
            CASE ('XR ', 'XRO')
              LRTN = 5
              RETURN
C * YR(OT)
            CASE ('YR ', 'YRO')
              LRTN = 5
              RETURN
C * ZR(OT)
            CASE ('ZR ', 'ZRO')
              PAR(276) = PAR(276) + FN(1)
              IPR(417) = 0
              IPR(221) = 0
C * END
            CASE ('END')
              LRTN = 1
              RETURN
C * EXIT
            CASE ('EXI')
              LRTN = 1
              RETURN
C * PT
            CASE ('PT ')
              LRTN = 3
              RETURN
C * FO
            CASE ('FO ')
              LRTN = 3
              RETURN
C * FS
            CASE ('FS ')
              LRTN = 3
              RETURN
C * SQ
            CASE ('SQ ')
              LRTN = 3
              RETURN
C * OMIT
            CASE ('OMI')
              LRTN = 3
              RETURN
C * QUIT
            CASE ('QUI')
              LRTN = 1
              RETURN
C * UP
            CASE ('U  ', 'UP ')
              IPR(417) = 1
C * DOWN
            CASE ('D  ', 'DOW')
              IPR(417) = -1
C * CONTINUE
            CASE ('CON')
              IPR(417) = 0
C * PLOT
            CASE ('PLO')
              IPR(417) = 0
C * SCALE
            CASE ('SCA')
              IPR(417) = 0
              IPR(418) = 0
C * F3D
            CASE ('F3D')
              IPR(580) = 1
              LRTN     = 7
              RETURN
C * PLAN
            CASE ('PLA')
              LRTN = 4
              RETURN
            CASE ('CL ')
              IF (IPR(221) .EQ. 1) THEN
                IPR(419) = MAX (5, NINT(FN(1) * 100))
                IPR(221) = 0
                LRTN     = 6
                RETURN
              END IF
          END SELECT
        END IF
        IPR(416) = 1
        IF (IPR(221) .GT. 0) THEN
          PAR(278) = ABS(FN(1))
          IPR(417) = NINT (SIGN (1.0, FN(1)))
        END IF
        LRTN = 2
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
      END SUBROUTINE PLA253
      SUBROUTINE PLA254
      PARAMETER (NVD=100000000, NP23=28000, NCT0 = 5000, NCT1 =1000000,
     1 NTC4 = 200, NCT5 = 2000, NCT6 = 100, NCT7 = NCT6 + 1,
     2 NCT8 = 2500, NCT3 =  NVD + 2 * NP23 - 2007  - 9 * NCT8 -2 *
     3 NCT5 - 7 * NCT0 - NCT1 - 3 * NTC4 * NTC4 - NCT6 * (NCT6 + 13))
      COMMON // LATOM(NCT0), ATOM(3, NCT0), IFLG(3, NCT0), COEFF(NCT1),
     1 XMPC(NCT8, 5), IMPC(3, NCT8), JMPC(NCT8), Q8(2, NCT5),
     2 FMP(NTC4, NTC4), IEXX(2, NTC4, NTC4), SMA(NCT6, NCT7),
     3 P8(12, NCT6), DXF(3), DYF(3), NAT, XMCT(4, 500), SK(NCT3)
      COMMON /AREA/ L, T9(NCT6), N, NS, NE, ICB, JV, XX, YY, JC, NN
      COMMON /APLOT/ X, Y, SCALE, PXS, PYS, STEP, VLAK(4)
      DO I = 2, N
        P1        = P8(1, I) - P8(1, I - 1)
        P2        = P8(2, I) - P8(2, I - 1)
        T9(I - 1) = SQRT(P1**2 + P2**2)
      END DO
      DO K = 1, 2
        DO I = 1, N
          DO J = 1, N
            SMA(I, J) = 0.0
          END DO
        END DO
        IF (ICB .EQ. 1) THEN
          SMA(1, 1) = 1.0
          SMA(N, N) = 1.0
          DO I = 1, 2
            P8(I + 2, 1) = 1.0
            P8(I + 2, N) = 1.0
          END DO
        ELSE IF (ICB .EQ. 2) THEN
          SMA(1, 1)     = 1.0
          SMA(N, N - 1) = 2.0
          SMA(1, 2)     = 0.5
          SMA(N, N)     = 4.0
          DO I = 1, 2
            P8(I + 2, 1) = 3.0 * (P8(I, 2) - P8(I, 1)) / (2.0 * T9(1))
            P8(I + 2, N) = 6.0 * (P8(I, N) - P8(I, N - 1)) / T9(N - 1)
          END DO
        ELSE
          PN            =  1.0
          IF (ICB .EQ. 4) PN = -1.0
          T             = T9(N - 1) / T9(1)
          SMA(1, 1)     = 2.0 + 2.0 * T
          SMA(1, 2)     = T
          SMA(1, N - 1) = PN
          TEMP          = 3.0 / T9(1)
          DO I = 1, 2
            P8(I + 2, 1) = TEMP * (T * (P8(I, 2) - P8(I, 1))
     1                   + PN * (P8(I, N) - P8(I, N - 1)) / T)
          END DO
        END IF
        DO I = 3, N
          T3 = T9(I - 1)
          T2 = T9(I - 2)
          SMA(I - 1, I - 2) = T3
          SMA(I - 1, I - 1) = 2.0 * (T3 + T2)
          SMA(I - 1, I    ) = T2
          DO J = 1, 2
            P1 = P8(J, I - 2)
            P2 = P8(J, I - 1)
            P3 = P8(J, I)
            IF (T2 .NE. 0.0 .AND. T3 .NE. 0) THEN
              VALUE = 3.0 * (T2 * (P3 - P2) / T3 + T3 * (P2 - P1) / T2)
            ELSE
              VALUE = 0.0
            END IF
            P8(J + 2, I - 1) = VALUE
          END DO
        END DO
        L = N
        IF (ICB .GE. 3) L = N - 1
        LL = L + 1
        DO I = 1, L
          SMA(I, LL) = P8(K + 2, I)
        END DO
        NN0 = L + 1
        DO I0 = 1, L
          C0 = SMA(I0, I0)
          IF (C0 .NE. 1) THEN
            DO J0 = I0, NN0
              SMA(I0, J0) = SMA(I0, J0) / C0
            END DO
          END IF
          DO J0 = 1, L
            IF (I0 .NE. J0) THEN
              C0 = SMA(J0, I0)
              IF (C0 .NE. 0.0) THEN
                DO K0 = I0, NN0
                  D0 = SMA(I0, K0)
                  SMA(J0, K0) = SMA(J0, K0) - C0 * D0
                END DO
              END IF
            END IF
          END DO
        END DO
        IF (ICB .GE. 3) SMA(LL, LL) = SMA(1, LL)
        DO I = 2, N
          P1 = P8(K, I - 1)
          P2 = P8(K, I)
          T  = T9(I - 1)
          U1 = SMA(I - 1, LL)
          U2 = SMA(I, LL)
          P8(K + 10, I - 1) = P1
          P8(K +  8, I - 1) = U1
          P8(K +  6, I - 1) = (3.0 * (P2 - P1) / T - 2.0 * U1 - U2) / T
          P8(K +  4, I - 1) = (2.0 * (P1 - P2) / T + U1 + U2) / (T * T)
        END DO
      END DO
      DO I = NS, NE - 1
        TT = T9(I)
        NM  = INT(TT * ABS(SCALE * 50)) + 1
        STP = TT / NM
        T   = 0.0
        DO WHILE (T .LE. TT)
          IF (I .EQ. NS .AND. T .EQ. 0.0) THEN
            XX = P8(11, I)
            YY = P8(12, I)
            IPEN = 3
          ELSE
            IF (T .EQ. 0.0) GO TO 10
            T2 = T  * T
            T3 = T2 * T
            XX = P8(5,  I) * T3 + P8(7,  I) * T2
     1         + P8(9,  I) * T  + P8(11, I)
            YY = P8(6,  I) * T3 + P8(8,  I) * T2
     1         + P8(10, I) * T  + P8(12, I)
            IPEN = 2
          END IF
          SSX = (XX - 1) * SCALE + PXS
          SSY = (YY - 1) * SCALE + PYS
          IF (JV .GT. 0) THEN
            CALL GGIP (0.0, 3.0, 0.0, 0)
            CALL GGIP (SSX, SSY, 0.0, IPEN)
          ELSE
            IF (IPEN .EQ. 3) THEN
              IF (NN .EQ. 4) THEN
                CALL GGIP (0.0, 2.0, 0.0, 0)
              ELSE
                CALL GGIP (0.0, 4.0, 0.0, 0)
              END IF
              CALL GGIP (SSX, SSY, 0.0, 3)
            ELSE
              JC = JC + 1
              IF (JC .LT. NN) THEN
                CALL GGIP (SSX, SSY, 0.0, 2)
              ELSE
                IF (JC .EQ. (NN + NN)) JC = 0
                CALL GGIP (SSX, SSY, 0.0, 3)
              END IF
            END IF
          END IF
   10     T = T + STP
        END DO
      END DO
      RETURN
      END SUBROUTINE PLA254
      SUBROUTINE PLA255
      PARAMETER (NVD=100000000, NP23=28000, NCT0 = 5000, NCT1 =1000000,
     1 NTC4 = 200, NCT5 = 2000, NCT6 = 100, NCT7 = NCT6 + 1,
     2 NCT8 = 2500, NCT3 =  NVD + 2 * NP23 - 2007  - 9 * NCT8 -2 *
     2 NCT5 - 7 * NCT0 - NCT1 - 3 * NTC4 * NTC4 - NCT6 * (NCT6 + 13))
      COMMON // LATOM(NCT0), ATOM(3, NCT0), IFLG(3, NCT0), COEFF(NCT1),
     1 XMPC(NCT8, 5), IMPC(3, NCT8), JMPC(NCT8), Q8(2, NCT5),
     2 FMP(NTC4, NTC4), IEXX(2, NTC4, NTC4), SMA(NCT6, NCT7),
     3 P8(12, NCT6), DXF(3), DYF(3), NAT, XMCT(4, 500), SK(NCT3)
      COMMON /APLOT/ X, Y, SCALE, PXS, PYS, STEP, VLAK(4)
      COMMON /AINPUT/ NS, NE, MX, MY, NXP, NXM, NYP, NYM, PHI,
     1  XN(3, 4), FMAT(3, 3), CMAT(3, 3)
      COMMON /ASESCH/ NT, IN, IXY, IX, IY, IV
      COMMON /AFIND/  Y9(4), C8(4, 5), R, N
      KK = 0
      NT = NT + 1
      IF (NT .GT. NCT5) CALL GEN127 ('NT Out-of-Range-PROBLEM')
      IF (IXY .NE. 2) THEN
        IF (IX .EQ. 1) KK = 1
        DO I = 1, 4
          J = IX + I - 2 + KK
          IF (J .EQ. MX + 1) KK = 2
          IF (KK .NE. 2) THEN
            IF (J .GT. 0 .AND. IY .GT. 0) THEN
              Y9(I) = FMP(J, IY)
            ELSE
              Y9(I) = 0.0
            END IF
          END IF
        END DO
      ELSE
        IF (IY .EQ. 1) KK = 1
        DO I = 1, 4
          J = IY + I - 2 + KK
          IF (J .EQ. MY + 1) KK = 2
          IF (KK .NE. 2) THEN
            IF (J .GT. 0 .AND. IY .GT. 0) THEN
              Y9(I) = FMP(IX, J)
            ELSE
              Y9(I) = 0.0
            END IF
          END IF
        END DO
      END IF
      IF (KK .NE. 0) THEN
        N = 3
        DO I = 1, 3
          X        = I
          C8(I, 1) = X * X
          C8(I, 2) = X
          C8(I, 3) = 1.0
          C8(I, 4) = Y9(I)
        END DO
      ELSE
        N = 4
        DO I = 1, 4
          X        = I
          C8(I, 1) = X * X * X
          C8(I, 2) = X * X
          C8(I, 3) = X
          C8(I, 4) = 1.0
          C8(I, 5) = Y9(I)
        END DO
      END IF
      NN = N + 1
      DO I = 1, N
        C = C8(I, I)
        DO J = I, NN
          C8(I, J) = C8(I, J) / C
        END DO
        DO J = 1, N
          IF (I .NE. J) THEN
            C = C8(J, I)
            DO K = I, NN
              D        = C8(I, K)
              C8(J, K) = C8(J, K) - C * D
            END DO
          END IF
        END DO
      END DO
      IF (KK .NE. 0) THEN
        RR = KK
        A  = C8(1, 4)
        B  = C8(2, 4)
        C  = C8(3, 4) - IV
        IF (ABS(A) .LT. 1.E-25) THEN
          R2 = - C / B
        ELSE
          SB = SQRT(ABS(B * B - 4 * A * C))
          R1 = (- B + SB) / (2.0 * A)
          R2 = (- B - SB) / (2.0 * A)
          IF (R1 .GE. KK .AND. R1 .LE. KK + 1) R = R1 - RR
        END IF
        IF (R2 .GE. KK .AND. R2 .LE. KK + 1) R = R2 - RR
      ELSE
        PI  = 3.141592
        PT  = 1.0 / 3.0
        PF  = 0.5
        EE  = 1.E-20
        AA  = C8(1, 5)
        BB  = C8(2, 5)
        ISW = 1
        IF (ABS(AA) .LE. 1.E-5) THEN
          AA  = 1.0
          ISW = 2
          IF (ABS(BB) .LE. 1.E-20) ISW = 3
        END IF
        A = BB / AA / 3
        B = C8(3, 5) / AA
        C = (C8(4, 5) - IV) / AA
        IF (ISW .EQ. 1) THEN
          P  = B / 3.0 - A * A
          Q  = C - A * B + 2.0 * A * A * A
          PQ = Q * Q + 4 * P * P * P
          IF (ABS(PQ) .GE. EE) THEN
            IF (PQ .LE. 0.0) THEN
              R  = 2.0 * SQRT(-P)
              XX = Q / P / R
              IF ((1.0 - XX**2) .EQ. 0) THEN
                TH = 0
              ELSE
                TH = - ATAN(XX / SQRT(- XX * XX + 1.0)) + 1.5708
                TH = TH / 3.0
              END IF
              R1 =   R * SIN(PI / 2.0 - TH) - A
              R2 = - R * SIN(PI / 6.0 + TH) - A
              R3 = - R * SIN(PI / 6.0 - TH) - A
              IF (R1 .GE. 2.0 .AND. R1 .LE. 3.0) R = R1 - 2.0
              IF (R2 .GE. 2.0 .AND. R2 .LE. 3.0) R = R2 - 2.0
              IF (R3 .GE. 2.0 .AND. R3 .LE. 3.0) R = R3 - 2.0
              GO TO 10
            ELSE
              PQ = SQRT(PQ)
              U3 =   PF * (PQ - Q)
              V3 = - PF * (PQ + Q)
              U  = (ABS(U3)) ** PT * SIGN (1.0, U3)
              V  = (ABS(V3)) ** PT * SIGN (1.0, V3)
              R  = U + V - A - 2.0
              GO TO 10
            END IF
          ELSE
            IF (EE .GE. ABS(P)) THEN
              R = - A - 2.0
              GO TO 10
            ELSE
              R  = - 1.0 * ABS(PF * Q) ** PT * SIGN (1.0, Q)
              R1 = 2.0 * R - A
              R2 = - R - A
            END IF
          END IF
          IF (R1 .GE. 2.0 .AND. R1 .LE. 3.0) R = R1 - 2.0
        ELSE IF (ISW .EQ. 2) THEN
          A  = A * 3.0
          SB = B * B - 4 * A * C
          IF (SB .LT. 0.0) SB = 0.0
          SB = SQRT(SB)
          R1 = (- B + SB) / (2.0 * A)
          R2 = (- B - SB) / (2.0 * A)
          IF (R1 .GE. 2.0 .AND. R1 .LE. 3.0) R = R1 - 2.0
        ELSE
          IF (B .NE. 0.0) THEN
            R2 = - C / B
          ELSE
            R2 = 0.0
          END IF
        END IF
        IF (R2 .GE. 2.0 .AND. R2 .LE. 3.0) R = R2 - 2.0
   10   IF (R .LT. 0.0 .OR. R .GT. 1.0)
     1      R = (IV - Y9(2)) / (Y9(3) - Y9(2))
      END IF
      IF (IXY .NE. 2) THEN
        X = IX + R
        Y = IY
      ELSE
        X = IX
        Y = IY + R
      END IF
      Q8(1, NT) = X
      Q8(2, NT) = Y
      RETURN
      END SUBROUTINE PLA255
      SUBROUTINE PLA258
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER LINE*10
      IF (IGBL(110) .GT. 0 .AND. IGBL(139) .EQ. 0) THEN
        KERR = 0
        CALL SPAWN (SHLPATH(1:IGBL(110))//
     1      ' -a1 a1 > a1.log', KERR)
        OPEN (UNIT = LU60, FILE = 'a1.lst', STATUS = 'UNKNOWN')
        CLOSE (LU60, STATUS = 'DELETE')
        OPEN (UNIT = LU60, FILE = 'a1.log', STATUS = 'UNKNOWN')
        READ (LU60, 99999, IOSTAT = IOST) LINE
        READ (LU60, 99999, IOSTAT = IOST) LINE
        IF (LINE(2:5) .NE. '++++') IGBL(110) = - IABS(IGBL(110))
        CLOSE (LU60, STATUS = 'DELETE')
        IGBL(139) = 1
      END IF
      RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA258
      SUBROUTINE PLA259
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER LINE*10
      INTEGER FINDEXE
C * CHECK For PLATON
      PLAPATH  = ' '
      IGBL(80) = FINDEXE ('PLAEXE', PLAPATH, 'platon')
C * CHECK For SHELXL/XL (REFINEMENT) - VERSION 20xy
      SHLPATH = ' '
      IGBL(110) = FINDEXE ('SHLEXE', SHLPATH, 'shelxl')
      IF (IGBL(110) .EQ. 0)
     1    IGBL(110) = FINDEXE ('SHLEXE', SHLPATH, 'xl')
C * CHECK for SHELXT/XT (STRUCTURE SOLUTION)
      SHTPATH = ' '
      IGBL(119) = FINDEXE ('SHTEXE', SHTPATH, 'shelxt')
      IF (IGBL(119) .EQ. 0)
     1    IGBL(119) = FINDEXE ('SHTEXE', SHTPATH, 'xt')
C * CHECK FOR POVRAY
      IGBL(79) = FINDEXE ('POVEXE', CGETENV, 'povray')
C * CHECK FOR RASMOL
      IGBL(78) = FINDEXE ('RASEXE', CGETENV, 'rasmol')
C * CHECK FOR RASTER
      IGBL(77) = FINDEXE ('R3DEXE', CGETENV, 'render')
C * CHECK FOR CONQUEST/CQBATCH
      IGBL(76) = FINDEXE ('QUESTEXE', CGETENV, 'cqbatch')
C * CHECK FOR PS2PDF CONVERSION UTILITY
      IGBL(116) = FINDEXE ('PS2PDF', CGETENV, 'ps2pdf')
C * HTTPSERVER LOCATION
      IGBL(135) = LEN_TRIM (HTTPSERVER)
C * CHECK FOR FIREFOX etc.  HELP
      IGBL(47) = FINDEXE ('NETEXE', BROWSER, 'firefox')
C * CHECK FOR check.def (CIF-Validation)
      CALL GETENV ('CHECKDEF', CGETENV)
      IF (CGETENV(1:1) .EQ. ' ') CGETENV = 'check.def'
      OPEN (UNIT = LU12, FILE = CGETENV, FORM = 'FORMATTED',
     1      STATUS = 'OLD', IOSTAT = IOK)
      IF (IOK .EQ. 0) THEN
        READ (LU12, 99999, IOSTAT = IOST) LINE
        IF (IOST .EQ. 0) THEN
          IF (LINE .EQ. '#=========') IGBL(12) = 1
        END IF
        CALL GEN108 (LU12, 0)
      END IF
      RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA259
      SUBROUTINE PLA260 (UPDATE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER UPDATE*(*), UPDATE1*12
      INTEGER FINDEXE
      COMMON /MSWDS/ DOS
      LOGICAL DOS
      CHARACTER MONTH*3, MONTHS(12)*3, BUFFER*255
      DATA (MONTHS(I), I = 1, 12) /
     1 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP',
     2 'OCT', 'NOV', 'DEC'/
C * CHECK FOR CURL
      IF (IGBL(13) .EQ. 0) THEN
        CURLPATH = ' '
        IGBL(13) = FINDEXE ('CURLEXE', CURLPATH, 'curl')
        IF (IGBL(13) .GT. 0) THEN
          IF (DOS) THEN
            BUFFER = HTTPSERVER(1:IGBL(135))//
     1        'xraysoft/update_history_platon.html'
            CALL GET_URL (BUFFER, 'curl.html', KERR)
          ELSE
            CALL SPAWN (CURLPATH(1:IGBL(13))//' '//
     1        HTTPSERVER(1:IGBL(135))//
     2        'xraysoft/update_history_platon.html -m 3 -o curl.html',
     3        KERR)
          END IF
          IF (KERR .EQ. 0) THEN
            OPEN (UNIT = LU60, FILE = 'curl.html', STATUS = 'UNKNOWN')
            DO
              READ (LU60, 99999, IOSTAT = IOST) UPDATE
              IF (IOST .NE. 0) EXIT
              IF (UPDATE(1:5) .EQ. '<BODY') EXIT
            END DO
            READ (LU60, 99999, IOSTAT = IOST) UPDATE
            IF (IOST .EQ. 0) THEN
              CLOSE (LU60, STATUS = 'DELETE')
              UPDATE1 = UPDATE
              CALL GEN020 (1, UPDATE1, 1, 12)
              READ (UPDATE1, *, IOSTAT = IOST) MONTH, J1, J3
              J2 = 0
              J3 = MOD (J3, 100)
              IF (IOST .EQ. 0) THEN
                DO J = 1, 12
                  IF (MONTH .EQ. MONTHS(J)) THEN
                    J2 = J
                    EXIT
                  END IF
                END DO
                IF (J2 .NE. 0) THEN
                  I1 = IGBL(4) / 10000
                  I3 = IGBL(4) - I1 * 10000
                  I2 = I3 / 100
                  I3 = I3 - I2 * 100
                  IGBL(14) = 4
                  IF (J3 .EQ. I3) THEN
                    IF (J2 .EQ. I2) THEN
                      IF (J1 .EQ. I1) THEN
                        IGBL(14) = 0
                      ELSE IF (J1 .GT. I1) THEN
                        IGBL(14) = 2
                      END IF
                    ELSE IF (J2 .GT. I2) THEN
                      IGBL(14) = 2
                    END IF
                  ELSE IF (J3 .GT. I3) THEN
                    IGBL(14) = 2
                  END IF
                ELSE
                  IGBL(13) = -1000
                END IF
              ELSE
                IGBL(13) = -1000
              END IF
            ELSE
              IGBL(13) = -1000
            END IF
          ELSE
            IGBL(13) = -1000
          END IF
        ELSE
          IGBL(13) = -1000
        END IF
      END IF
      RETURN
99999 FORMAT(A)
      END SUBROUTINE PLA260
      SUBROUTINE PLA261 (NFILE)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      IF (NFILE .GT. 0) THEN
C * GET FILENAME ROOT AND EXTENSION
        IB   = 1
        IE   = 80
        KNMM = 70
        KXTM = 9
C * SEARCH FOR FILENAME EXTENSION
        KXT = 3
        KB  = IB
        KE  = IE
        CALL GEN039 (0, FILENAMES(1), IB, IE, KB, KE)
        IF (KE .GE. KB) THEN
          KD = 0
          DO I = KB, KE
            IF (FILENAMES(1)(I:I) .EQ. '.') KD = I
          END DO
          IF (KD .NE. 0) THEN
            IF (KB + KD - 1 .EQ. KE) THEN
              KE  = KE - 1
            ELSE
              EXTENS = FILENAMES(1)(KB + KD : KE)
              KXT    = KE - KB - KD + 1
              KE     = KB + KD - 2
            END IF
          ELSE
            IF (INDEX (FILENAMES(1), 'spgr') .NE. 0 .OR.
     1          INDEX (FILENAMES(1), 'SPGR') .NE. 0 .OR.
     2          INDEX (FILENAMES(1), 'hall') .NE. 0 .OR.
     3          INDEX (FILENAMES(1), 'Hall') .NE. 0 .OR.
     4          INDEX (FILENAMES(1), 'HALL') .NE. 0) THEN
              CALL PLA348
              STOP
            ELSE
              CALL GEN127 ('No Filename Extension Found on Filename')
            END IF
          END IF
        END IF
        IF (KB .LE. KE) THEN
          KNMFIL = KE - KB + 1
          IF (KNMFIL .GT. KNMM) CALL GEN127 ('Filename too long')
          IF (KXT .GT. KXTM) CALL GEN127 ('File-extention too long')
          IF (EXTENS(1:3) .EQ. 'eld')
     1      CALL GEN127 ('name.eld not allowed')
          NAMEFIL = FILENAMES(1)(KB : KE)
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA261
      SUBROUTINE PLA262 (N)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PAGEIN/ INDEXP(25), INDP
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      IF (N .EQ. -999) THEN
        IF (IGBL(63) .GT. 2) THEN
          WRITE (LU7, 99998, IOSTAT = IOST)
          DO I = 1, INDP
            WRITE (LU7, 99997, IOSTAT = IOST) INDEXP(I), PAGEIND(I)
          END DO
          WRITE (LU7, 99996, IOSTAT = IOST)
          IPR(83) = INDP + 4
        END IF
      ELSE
        IF (IGBL(7) .EQ. 0) THEN
          IF (IPR(210) .EQ. 1) THEN
            OPEN (UNIT = LU7, FILE = NAMEFIL(1:KNMFIL) //'_sq.lis',
     1                STATUS = 'UNKNOWN')
            IGBL(7) = 2
          ELSE
            OPEN (UNIT = LU7, FILE = NAMEFIL(1:KNMFIL) //'.lis',
     1                STATUS = 'UNKNOWN')
            IGBL(7) = 1
          END IF
        END IF
        IF (N .GT. 0) THEN
          IPR(83) = IPR(83) + N
          IF (IPR(83) .LE. IGBL(102)) RETURN
        END IF
        IPR(83) = IABS(N) + 3
        IF (IGBL(63) .GT. 2) THEN
          IGBL(49) = IGBL(49) + 1
          IF (IGBL(137) .EQ. 1) THEN
            WRITE (LU7, 99999, IOSTAT = IOST)
     1        CHAR(12), JID(1:10), PAGET, IGBL(49)
          ENDIF
          IF (INDP .EQ. 0) THEN
            INDP       = 1
            PAGEIND(1) = PAGET
            INDEXP(1)  = IGBL(49)
          ELSE
            IF (PAGET .NE. PAGEIND(INDP)) THEN
              INDP = INDP + 1
              PAGEIND(INDP) = PAGET
              INDEXP(INDP)  = IGBL(49)
            END IF
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (A, 92X, '"', A, '"  ', 'PLATON-', A, 2X, 'Page', I5,
     1 /, 132('='))
99998 FORMAT ('Page - Index', /, 80('='), /)
99997 FORMAT ('Page', I4, ' --- ', A)
99996 FORMAT (/)
      END SUBROUTINE PLA262
      SUBROUTINE PLA263 (LU, PRBUF, JBUFL, NLINE, JSUBST)
      CHARACTER PRBUF*(*)
      IF (NLINE .GT. 0) CALL PLA262 (NLINE)
      CALL GEN065 (LU, PRBUF, JBUFL, JSUBST)
      RETURN
      END SUBROUTINE PLA263
      SUBROUTINE PLA264
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP45=2048,
     1 NP58=50)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /WORDC/ NWRD, STRSAVE
      CHARACTER NWRD*82, STRSAVE*250
      COMMON /CIFCOM/ NLP(NP58), ILOOP, NL, NLPM, ISEMC, IVOID, KW, NW,
     1 FA(2), CELL(12), NHTP, INUM, NSTR, NSTRS, IRECMAX, LRETCIF
      CHARACTER ICL*(NP45), IFL*7
      LOGICAL OPEND
C * SKIP/SAVE TEXT WITHIN SECTION STRINGS AND EMBEDDED INFO
      LRETCIF = 0
      IF (ISEMC .EQ. 0) NSTRS = 0
      IF (ICL(1:1) .NE. ';') THEN
        IF (ISEMC .EQ. 1) THEN
          IF (IVOID .EQ. -1) THEN
            IF (INDEX (ICL, '_platon_squeeze_void_content') .NE. 0)
     1        IVOID = 1
          ELSE IF (IVOID .EQ. 1) THEN
            IF (INDEX (ICL, '_platon_squeeze_details') .NE. 0) THEN
                IVOID = 0
              ELSE
                IF (IPR(665) .EQ. 1) THEN
                READ (ICL, *, IOSTAT = IOST) (FN(I), I = 1, 6)
                PAR(437) = PAR(437) + FN(5)
                PAR(438) = PAR(438) + FN(6)
              END IF
            END IF
C * REPORT ON AFIX 1 RECORDS
          ELSE IF (ICL(1:4) .EQ. 'AFIX') THEN
            READ (ICL(5:80), *, IOSTAT = IOST) YUNK
            IF (NINT(YUNK) .EQ. 1) IPR(694) = IPR(694) + 1
C * REPORT ON DAMP INSTRUCTION IN EMBEDDED RES FILE
          ELSE IF (ICL(1:4) .EQ. 'DAMP') THEN
            READ (ICL(5:80), *, IOSTAT = IOST) YUNK
C * ALERT _936
              IF (YUNK .EQ. 0.0) THEN
                YUNC = 2
              ELSE IF (YUNK .GT. 0.7) THEN
                YUNC = 1
              ELSE
                YUNC = 0.001
              END IF
              CALL PLA231 (936, 1, YUNC, YUNK, ' ', ' ')
C * REGISTER EADP CONSTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'EADP') THEN
            IPR(685) = IPR(685) + 1
C * REGISTER DFIX RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'DFIX') THEN
            IPR(686) = IPR(686) + 1
C * REGISTER DANG RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'DANG') THEN
            IPR(687) = IPR(687) + 1
C * REGISTER FLAT RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'FLAT') THEN
            IPR(688) = IPR(688) + 1
C * REGISTER SAME RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'SAME') THEN
            IPR(689) = IPR(689) + 1
C * REGISTER SADI RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'SADI') THEN
            IPR(690) = IPR(690) + 1
C * REGISTER DELU RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'DELU') THEN
            IPR(691) = IPR(691) + 1
C * REGISTER SIMU RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'SIMU') THEN
            IPR(692) = IPR(692) + 1
C * REGISTER CHIV RESTRAINT INSTRUCTION RECORD(S)
          ELSE IF (ICL(1:4) .EQ. 'CHIV') THEN
            IPR(693) = IPR(693) + 1
          ELSE IF (ICL(1:4) .EQ. 'HKLF') THEN
            READ (ICL(5:80), *, IOSTAT = IOST) IYUNK
            IF (IOST .EQ. 0) THEN
              IF (IYUNK .EQ. 2) THEN
                IPR(106) = 1
              ELSE IF (IYUNK .EQ. 5) THEN
                IPR(619) = 1
              END IF
            ELSE
              IPR(2)  = 70
              LRETCIF = 12
            END IF
          ELSE IF (ICL(1:4) .EQ. 'TWIN') THEN
            READ (ICL(5:80), *, IOSTAT = IOST) IYUNK
            IF (IOST .EQ. 0) IPR(619) = 1
            IF (IPR(619) .EQ. 0) IPR(193) = IPR(193) + 1
          ELSE IF (ICL(1:4) .EQ. 'BASF') THEN
            IPR(193) = IPR(193) + 1
          ELSE IF (ICL(1:9) .EQ. '# SQUEEZE') THEN
            IF (IPR(665) .EQ. 1) THEN
              IPR(651) = -1
              IF (IPR(665) .NE. 0) IVOID = -1
            END IF
          ELSE IF (ICL(1:4) .EQ. 'ABIN') THEN
            IPR(651) = -1
          END IF
          IF (IPR(663) .EQ. 1) THEN
            WRITE (LU24, 99998, IOSTAT = IOST) ICL(1:80)
          ELSE IF (IPR(664) .EQ. 1) THEN
            WRITE (LU25, 99998, IOSTAT = IOST) ICL(1:80)
          ELSE IF (IPR(665) .EQ. 1 ) THEN
            WRITE (LU26, 99998, IOSTAT = IOST) ICL(1:80)
          ELSE
            IPR(654) = IPR(654) + 1
            IF (ICL(81:90) .NE. '          ') THEN
              IF (NLP(1) .NE. 569) THEN
                WRITE (LU6, 99999, IOSTAT = IOST) ICL(1:15)
                IPR(544) = IPR(544) + 1
              END IF
C * ALERT _802
              IF (IPR(544) .EQ. 1)
     1          CALL PLA231 (802, 0, -999.0, 1.0, ' ', ' ')
            END IF
            CALL GEN039 (1, ICL, 1, 250, NB, NE)
            IF (NE .GT. 0 .AND. NSTR + NE .LT. 250) THEN
              STRSAVE(NSTR + 1:) = ICL(1:NE + 1)
              NSTR = NSTR + NE + 1
            END IF
            NSTRS = NSTR
          END IF
          LRETCIF = 10
          RETURN
        END IF
      ELSE
        ISEMC = MOD (ISEMC + 1, 2)
        IF (ISEMC .EQ. 1) THEN
          IF (NLP(1) .EQ. 578 .OR.
     1     (NLP(1) .EQ. 513 .AND. IGBL(133) .EQ. 7)) THEN
            IPR(663) =  1
            IF (IGBL(133) .NE. 7) THEN
              IF (IPR(677) .EQ. 0) THEN
                IPR(677) = -1
              ELSE
                IPR(677) = IABS(IPR(677))
              END IF
            END IF
            INQUIRE (UNIT = LU24, OPENED = OPEND)
            IF (OPEND) THEN
              REWIND (LU24, IOSTAT = IOST)
            ELSE
              OPEN (UNIT = LU24, FILE =
     1          NAMEFIL(1:KNMFIL)//'_sx.ins',
     2          STATUS = 'UNKNOWN', IOSTAT = IOST)
              IF (IOST .NE. 0) REWIND (LU24)
            END IF
          ELSE IF (NLP(1) .EQ. 580 .OR.
     1      (NLP(1) .EQ. 569 .AND. IGBL(133) .EQ. 7)) THEN
            IPR(664) = 1
            IPR(676) = 1
            IPR(646) = 1
            IF (IGBL(133) .NE. 7) THEN
              IF (IPR(678) .EQ. 0) THEN
                IPR(678) = -1
              ELSE
                IPR(678) = IABS(IPR(678))
              END IF
            END IF
            INQUIRE (UNIT = LU25, OPENED = OPEND)
            IF (OPEND) THEN
              REWIND (LU25, IOSTAT = IOST)
            ELSE
              OPEN (UNIT = LU25, FILE =
     1          NAMEFIL(1:KNMFIL)//'_sx.hkl',
     2          STATUS = 'UNKNOWN', IOSTAT = IOST)
              IF (IOST .NE. 0) REWIND (LU25)
            END IF
C * _shelx_fab_file (SHELXL20xy)
          ELSE IF (NLP(1) .EQ. 601) THEN
            IPR(665) =  1
            IF (IPR(679) .EQ. 0) THEN
              IPR(679) = -1
            ELSE
              IPR(679) = IABS(IPR(679))
            END IF
            INQUIRE (UNIT = LU26, OPENED = OPEND)
            IF (OPEND) THEN
              REWIND (LU26, IOSTAT = IOST)
            ELSE
              OPEN (UNIT = LU26, FILE =
     1          NAMEFIL(1:KNMFIL)//'_sx.fab',
     2          STATUS = 'UNKNOWN')
              IF (IOST .NE. 0) REWIND (LU26)
            END IF
          ELSE
            IPR(654) = 0
            CALL GEN039 (1, ICL, 1, 250, NB, NE)
            IF (NE .GT. 1) THEN
              STRSAVE = ICL(2:NE + 1)
              NSTR    = NE
            ELSE
              STRSAVE = ' '
              NSTR    = 0
              NSTRS   = 0
            END IF
          END IF
          LRETCIF = 10
          RETURN
        ELSE
          IF (NLP(1) .EQ. 513 .OR. NLP(1) .EQ. 518) IPR(653) = IPR(654)
          IPR(646) = - IABS(IPR(646))
          IF (IPR(663) .EQ. 1) THEN
            IPR(663) = -1
            ENDFILE LU24
          ELSE IF (IPR(664) .EQ. 1) THEN
            IPR(664) = -1
          ELSE IF (IPR(665) .EQ. 1) THEN
            IPR(665) = -1
          ELSE
            MSTR = MIN(78, MAX (NSTR, 1))
            ICL  = CHAR(39)//STRSAVE(1:MSTR)//CHAR(39)
          END IF
        END IF
      END IF
      IF (ICL(1:1) .EQ. CHAR(13)) THEN
        LRETCIF = 10
        RETURN
      END IF
      NSTR = -1
      IRECMAX = 80
      IF (IPR(646) .LE. 0) THEN
        IF (ICL(81:81) .EQ. CHAR(13)) ICL(81:81) = CHAR(32)
        IF (ICL(81:90) .NE. '          ') THEN
          IRECMAX = NP45 - 1
          IF (IPR(654) .EQ. 0) THEN
            WRITE (LU6, 99999, IOSTAT = IOST) ICL(1:15)
            IPR(544) = IPR(544) + 1
C * ALERT _802
            IF (IPR(544) .EQ. 1)
     1        CALL PLA231 (802, 0, -999.0, 1.0, ' ', ' ')
          END IF
        END IF
      END IF
      N    = INDEX(ICL(1:IRECMAX), '#')
      IF (N .GT. 0) THEN
        IF (N .EQ. 1) THEN
          RETURN
        ELSE
          CALL GEN038 (ICL, N, IRECMAX)
        END IF
      END IF
      RETURN
99999 FORMAT (':: Record Longer than 80 Bytes found,',
     1        ' 2048 Bytes Assumed: ', A, ' ...')
99998 FORMAT (A)
      END SUBROUTINE PLA264
      SUBROUTINE PLA265 (N)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP45=2048,
     1 NP58=50)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /CIFCOM/ NLP(NP58), ILOOP, NL, NLPM, ISEMC, IVOID, KW, NW,
     1 FA(2), CELL(12), NHTP, INUM, NSTR, NSTRS, IRECMAX, LRETCIF
      COMMON /PL64/ M
      CHARACTER ICL*(NP45), IFL*7
      IF (N .NE. 0) THEN
        CELL(N)     = FA(1)
        CELL(6 + N) = FA(2)
        M           = M + 1
        IF (M .EQ. 6) THEN
          IFL(1) = 'CELL'
          DO I = 1, 12
            FN(I) = CELL(I)
          END DO
          IPR(220) = 1
          IPR(221) = 6
          LRETCIF  = 1
        END IF
      ELSE
        M       = 0
        LRETCIF = 0
      END IF
      RETURN
      END SUBROUTINE PLA265
      SUBROUTINE PLA266
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30, NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /WORDC/ NWRD, STRSAVE
      CHARACTER NWRD*82, STRSAVE*250
      RLWS(1) = ''''//NWRD(2:79)
      IF (IGBL(133) .LT. 3 .OR.
     1   (IGBL(9) .NE. 6  .AND. IGBL(9) .NE. 10 .AND.
     2    IGBL(9) .NE. 13 .AND. IGBL(9) .NE. 15)) THEN
        IF (INDEX (RLWS(1), 'CALC  [') .NE. 0) THEN
          READ (STRSAVE, 99999, ERR = 10, END = 10)
     1      (PAR(492 + K), K = 1, 8)
          WRITE(LU6, 99997, IOSTAT = IOST)
     1      (PAR(K), K = 493, 500)
          IF (PAR(493) .EQ. 1.0) THEN
            IPR(632) = -1
            CALL GEN018 (PAR(497), PAR(498))
          ELSE
            GO TO 10
          END IF
        ELSE
          IF (RLWS(1)(70:70) .EQ. '3') THEN
            ISTP = 0
          ELSE IF (RLWS(1)(71:71) .EQ. '3') THEN
            ISTP = 1
          ELSE
            ISTP = -1
          END IF
          IF (ISTP .GE. 0) THEN
            CALL GEN020 (-1, RLWS(1),  2, 13)
            IF (RLWS(1)(18:19) .EQ. 'FO') RLWS(1)(19:19) = 'o'
            IF (RLWS(1)(17:18) .EQ. 'FO')
     1          RLWS(1)(12:25) = CHAR(92)//'s^2^(Fo^2^)+('
            CALL GEN020 (-1, RLWS(1), 47 + ISTP, 51 + ISTP)
            CALL GEN020 (-1, RLWS(1), 57 + ISTP, 57 + ISTP)
            CALL GEN020 (-1, RLWS(1), 64 + ISTP, 64 + ISTP)
            IF (RLWS(1)(37:45) .EQ. '+0.0000P]')
     1          RLWS(1)(37:45) =    ']        '
          END IF
          JE = INDEX (RLWS(1), '(I)')
          JC = INDEX (RLWS(1), 'I^2')
          IF (JE .GT. 0 .AND. JC .GT. 0) THEN
            IPR(632) = 2
            PAR(484) = 3.0
            READ (RLWS(1)(JE + 3: JC - 1), *, ERR = 10) PAR(497)
            PAR(498) = 0.0
          ELSE
            JE = INDEX (RLWS(1), 'W=EXP[')
            IF (JE .NE. 0) THEN
              JC = INDEX (RLWS(1), '(SIN')
              IF (JC .NE. 0) THEN
                JE = JE + 6
                JC = JC - 1
                READ (RLWS(1)(JE:JC), *, IOSTAT = IOST) PAR(499)
              END IF
            END IF
            JE = INDEX (RLWS(1), 'P)')
            JC = INDEX (RLWS(1), 'P]')
            IF (JE .NE. 0 .OR. JC .NE. 0) THEN
              PAR(500) = 0.33333
              IPR(632) = 1
              JX = INDEX (RLWS(1), 'SHELDRICK')
              IF (JX .NE. 0) IPR(632) = 3
              IF (JE .EQ. 0 .AND. JC .NE. 0) PAR(497) = 0.0
              IF (JE .NE. 0) THEN
                JD = 2
                JB = INDEX (RLWS(1)(1:JE), '+(')
                IF (JB .EQ. 0) THEN
                  JB = INDEX (RLWS(1)(1:JE), '+ (')
                  IF (JB .NE. 0) JD = 3
                END IF
                IF (JB .GT. 0) THEN
                  READ (RLWS(1)(JB + JD: JE - 1), *,
     1                  ERR = 10, END = 10) PAR(497)
                  IF (PAR(497) .GE. 0.0) THEN
                    PAR(498) = 0.0
C * ALERT _072 : TEST FOR EXTREME FIRST WEIGHTING PARAMETER VALUE (SHELXL)
                    IF (PAR(497) .GT. 0.1) CALL PLA231
     1                 (72, 2, -999.0, PAR(497), ' ', ' ')
                  END IF
                END IF
              END IF
              IF (JC .NE. 0) THEN
                JB = INDEX(RLWS(1)(JE+1:JC - 1), '+')
                IF (JB .GT. 0 .AND. JB + JE .LE. JC - 1) THEN
                  READ (RLWS(1)(JB + JE + 1: JC - 1), *,
     1              ERR = 10, END = 10) PAR(498)
C * ALERT _083 : TEST FOR EXTREME SECOND WEIGHTING PARAMETER VALUE (SHELXL)
                  IF (PAR(498) .GT. 5.0) CALL PLA231
     1              (83, 2, -999.0, PAR(498), ' ', ' ')
C * ALERT _085 : TEST FOR SHELXL DEFAULT
                  IF (PAR(497) .EQ. 0.1 .AND. PAR(498) .EQ. 0.0)
     1              CALL PLA231 (85, 0, 1.0, 1.0, ' ', ' ')
                END IF
              END IF
            ELSE
              JB = INDEX (RLWS(1), '(FO^2^)')
              IF (JB .NE. 0) THEN
                PAR(497) = 0.0
                PAR(498) = 0.0
                IPR(632) = 1
              END IF
            END IF
          END IF
        END IF
        RETURN
   10   WRITE (LU6, 99998, IOSTAT = IOST) RLWS(1)
        IPR(632) = 0
        PAR(497) = -999999.0
        PAR(498) = -999999.0
        CALL PLA231 (809, 0, -999.0, 0.0, ' ', ' ')
      END IF
      RETURN
99999 FORMAT (8X, F7.0, F8.0, 4X, F4.0, 33X, F7.0, F7.0, 4X, F6.0, 5X,
     1        F7.0, 20X, F8.0)
99998 FORMAT (':: Problem with Weight Formula:', /, A)
99997 FORMAT (8F8.4)
      END SUBROUTINE PLA266
      SUBROUTINE PLA267 (ICH, KEYWRD)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP34=647,NP38=150,NP39=30,
     1 NP58=50,NKW=49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER ICH*1, ICHU*1
      COMMON /CIF/ CIFDIR
      CHARACTER CIFDIR(NP34)*(NKW)
      CHARACTER KEYWRD*(NKW), UCIFD*(NKW)
      COMMON /CIFCOM/ NLP(NP58), ILOOP, NL, NLPM, ISEMC, IVOID, KW, NW,
     1 FA(2), CELL(12), NHTP, INUM, NSTR, NSTRS, IRECMAX, LRETCIF
C * CONTINUE/FINISH BUILDING KEYWORD
      LRETCIF = 0
      ICHU    = ICH
      CALL GEN020 (1, ICHU, 1, 1)
      IF (ICH .EQ. CHAR(32)) THEN
        NLPM = NLPM + ILOOP
        IF (NLPM .GT. 0) THEN
          IF (NLPM .LE. NP58) THEN
            NLP(NLPM) = 0
          ELSE
            IPR(2)  = 60
            LRETCIF = 2
            RETURN
          END IF
        END IF
C * CHECK FOR OFFICIAL KEYWORDS
        DO J = 1, NP34
          IF (KEYWRD .EQ. CIFDIR(J)) THEN
            IF (NLPM .GT. 0) THEN
              IF (NLPM .LE. NP58) THEN
                IF (NLP(1) .EQ. 265) THEN
                  IF (J .LT. 265 .OR. J .GT. 270) THEN
                    NLPM  = 1
                    ILOOP = 0
                  END IF
                ELSE IF (NLP(1) .EQ. 258) THEN
                  IF (J .LT. 257 .OR. J .GT. 264) THEN
                    NLPM  = 1
                    ILOOP = 0
                  END IF
                ELSE IF (NLP(1) .EQ. 279) THEN
                  IF (J .LT. 278 .OR. J .GT. 288) THEN
                    NLPM  = 1
                    ILOOP = 0
                  END IF
                END IF
                NLP(NLPM) = J
              ELSE
                IPR(2)  = 60
                LRETCIF = 2
                RETURN
              END IF
            END IF
            GO TO 10
          END IF
        END DO
C * CHECK FOR UPPER/LOWER CASE VARIANTS
        CALL GEN020 (-1, KEYWRD, 1, NKW)
        DO J = 1, NP34
          UCIFD = CIFDIR(J)
          CALL GEN020 (-1, UCIFD, 1, NKW)
          IF (KEYWRD .EQ. UCIFD) THEN
            IF (NLPM .GT. 0) THEN
              IF (NLPM .LE. NP58) THEN
                NLP(NLPM) = J
              ELSE
                IPR(2)  = 60
                LRETCIF = 2
                RETURN
              END IF
            END IF
            GO TO 10
          END IF
        END DO
        J  = 0
        IF (KEYWRD(1:5) .NE. '_vrf_' .AND.
     1    KEYWRD(1:4) .NE. '_pd_') THEN
          IPR(429) = IPR(429) + 1
          WRITE (LU6, 99999, IOSTAT = IOST) KEYWRD
        END IF
C * CHECK FOR POWDER DATANAMES
        IF (KEYWRD(1:4) .EQ. '_pd_') IPR(105) = 1
   10   CALL GEN038 (KEYWRD, 1, NKW)
        KW = 0
        IF (J .EQ. 385) THEN
          IF (IGBL(3) .EQ. 14) THEN
            LRETCIF = 3
            RETURN
          END IF
        END IF
      ELSE
        IF (KW .LT. NKW) THEN
          KW            = KW + 1
          KEYWRD(KW:KW) = ICH
        END IF
      END IF
      RETURN
99999 FORMAT ('W: Keyword ', A, 'Not in PLATON/CIFDIR')
      END SUBROUTINE PLA267
      SUBROUTINE PLA268 (MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287, NP38=150,NP39=30,NP45=2048,NP52=200,NP56=30,NP57=35,
     2 NP58=50)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CIFCOM/ NLP(NP58), ILOOP, NL, NLPM, ISEMC, IVOID, KW, NW,
     1 FA(2), CELL(12), NHTP, INUM, NSTR, NSTRS, IRECMAX, LRETCIF
      IF (MODE .EQ. 0 .AND. IGBL(3) .NE. 14) THEN
        IF (LINE(1:4) .EQ. 'BOND' .OR.
     1      LINE(1:5) .EQ. 'ANGLE' .OR.
     2      LINE(1:5) .EQ. 'TORSI' .OR.
     3      LINE(1:7) .EQ. 'CONTACT') THEN
          WRITE (LU11) LINE, (IFL(N), N = 1, 4), (FN(N),  N = 1, 6)
          LRETCIF = 4
        ELSE IF (LINE(1:5) .EQ. 'HBOND') THEN
          IF (IFL(1)(1:1) .NE. '?') THEN
            NQ1 = IFL(1)
            CALL PLA046 (1, NQ1, IENM1, LBB, LBC, LBD, INQNR,
     1        JNQNR, NIEN)
            IF (NIEN .LT. 0) THEN
C * ALERT _715
              CALL PLA231 (715, 0, 1.0, 1.0, IFL(1), ' ')
            ELSE
              VDWR1 = VDWR(IEN(IENM1))
              NQ1 = IFL(2)
              CALL PLA046 (1, NQ1, IENM2, LBB, LBC, LBD, INQNR,
     1          JNQNR, NIEN)
              IF (NIEN .LT. 0) THEN
C * ALERT _716
                CALL PLA231 (716, 0, 1.0, 1.0, IFL(2), ' ')
              ELSE
                VDWR2 = VDWR(IEN(IENM2))
                NQ1 = IFL(3)
                CALL PLA046 (1, NQ1, IENM3, LBB, LBC, LBD, INQNR,
     1            JNQNR, NIEN)
                IF (NIEN .LT. 0) THEN
C * ALERT _717
                  CALL PLA231 (717, 0, 1.0, 1.0, IFL(3), ' ')
                ELSE
                  IENM0 = IEN(IENM3)
                  VDWR3 = VDWR(IENM0)
                  IF (FN(1) .GT. 0.0) THEN
                    LINE = 'D-H'
                    WRITE (LU11) LINE, (IFL(N), N = 1, 4),
     1                (FN(N), N = 1, 2), FN(9), FN(10), 0.0, 0.0
                  END IF
                  IF (FN(3) .GT. 0.0) THEN
                    DELTA = FN(3) - VDWR2 - VDWR3
                    IF (DELTA .GT. -0.2) THEN
                      NQ2 = IFL(2)
                      MSUBST = 0
                      CALL PLA281 (-1, NQ2, MSUBST)
C * ALERT _480
                      IF (IFL(3)(1:2) .NE. 'CG')
     1                  CALL PLA231 (480, 2, DELTA, FN(3), NQ2, IFL(3))
                    END IF
                    LINE = 'H..A'
                    WRITE (LU11) LINE, (IFL(N), N = 2, 5),
     1                (FN(N), N = 3, 4), FN(10), FN(11), 0.0, 0.0
                  END IF
                  IF (FN(5) .GT. 0.0) THEN
                    DELTA = FN(5) - VDWR1 - VDWR3
                    IF (DELTA .GT. 0.0) THEN
C * ALERT _481
                      CALL PLA231 (481, 2, DELTA, FN(5), IFL(1), IFL(3))
                    END IF
                    LINE = 'D..A'
                    WRITE (LU11) LINE, IFL(1), (IFL(N), N = 3, 5),
     1                (FN(N), N = 5, 6), FN(9), FN(11), 0.0, 0.0
                  END IF
                  IF (FN(7) .GT. 0.0) THEN
                    DELTA = 180.0 - FN(7)
                    IF (DELTA .GT. 60.0) THEN
C * ALERT _482
                      CALL PLA231 (482, 2, DELTA, FN(7), IFL(1), IFL(3))
                    END IF
                    IF (FN(8) .EQ. 0.0) THEN
C * ALERT _484
                      IF (ABS(FN(7) - NINT(FN(7))) .GT. 0.001)
     1                  CALL PLA231 (484, 0, -999.0, FN(7), IFL(1),
     2                    IFL(3))
                    END IF
                    LINE = 'D-H..A'
                    WRITE (LU11) LINE, (IFL(N), N = 1, 4),
     1                (FN(N), N = 7, 8), FN(9), FN(10), FN(11), 0.0
                  END IF
                END IF
              END IF
              LINE(1:1) = CHAR(32)
            END IF
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA268
      SUBROUTINE PLA269 (MODE, I0)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,
     3 NP47=9,NP52=200,NP56=30,NP57=35,NP58=50)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3,50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /WORDC/ NWRD, STRSAVE
      CHARACTER NWRD*82, STRSAVE*250
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CIFCOM/ NLP(NP58), ILOOP, NL, NLPM, ISEMC, IVOID, KW, NW,
     1 FA(2), CELL(12), NHTP, INUM, NSTR, NSTRS, IRECMAX, LRETCIF
      COMMON /LITREF/ LREF
      CHARACTER LREF(25)*80
      SELECT CASE (NLP(NL))
        CASE (48)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(10) = NWRD(2:NW-1)
            NCIF(10) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(10),  1, NP57)
        CASE (49)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(11) = NWRD(2:NW-1)
            NCIF(11) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(11),  1, NP57)
        CASE (50)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(12) = NWRD(2:NW-1)
            NCIF(12) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(12),  1, NP57)
C * NOTE GENERATION BY SHELXL/CRYSTALS etc
        CASE (72)
          IF (INDEX (NWRD, 'SHELXL-97') .NE. 0) THEN
            IGBL(133) = 1
C * ALERT _899
            CALL PLA231 (899, 0, -999.0, 2014.0, ' ', ' ')
            XLDTP = '97'
          ELSE IF (INDEX (NWRD, 'APEX') .NE. 0) THEN
            IGBL(133) = 1
          ELSE IF (INDEX (NWRD, 'SHELXL-20') .NE. 0) THEN
            IGBL(133) = 2
            N = INDEX (NWRD, '-20')
            XLDTP = NWRD(N+3:N+4)
          ELSE IF (INDEX (NWRD, 'PLATON') .NE. 0) THEN
            IGBL(133) = 3
          ELSE IF (INDEX (NWRD, 'CRYSTALSTRUCTURE') .NE. 0)
     1      THEN
            IGBL(133) = 4
          ELSE IF (INDEX (NWRD, 'CRYSTALS') .NE. 0) THEN
            IGBL(133) = 5
          ELSE IF (INDEX (NWRD, 'JANA') .NE. 0) THEN
            IGBL(133) = 6
          ELSE IF (INDEX (NWRD, 'WINGX') .NE. 0) THEN
            IGBL(133) = 7
          END IF
        CASE (118)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(20) = NWRD(2:NW-1)
            NCIF(20) = NW - 2
          END IF
        CASE (119)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(21) = NWRD(2:NW-1)
            NCIF(21) = NW - 2
          END IF
        CASE (122)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(22) = NWRD(2:NW-1)
            NCIF(22) = NW - 2
          END IF
C * _diffrn_measurement_method
        CASE (137)
          IF (INDEX (NWRD, 'LAUE') .NE. 0) IPR(106) = 1
C * DIFFR-RAD-TYPE and PROBE
        CASE (163, 481)
          J = INDEX (NWRD, 'CU')
          IF (J .NE. 0) THEN
            IPR(671) = 4
          ELSE
            J = INDEX (NWRD, 'GA')
            IF (J .NE. 0) THEN
              IPR(671) = 3
            ELSE
              J = INDEX (NWRD, 'MO')
              IF (J .NE. 0) THEN
                IPR(671) = 2
              ELSE
                J = INDEX (NWRD, 'AG')
                IF (J .NE. 0) THEN
                  IPR(671) = 1
                ELSE
                  J = INDEX (NWRD, 'NEUTRON')
                  IF (J .NE. 0) THEN
                    IPR(493) = 6
                    IPR(630) = 2
                  ELSE
                    J = INDEX (NWRD, 'SYNCHROTRON')
                    IF (J .NE. 0) THEN
                      IPR(493) = 5
                      IPR(630) = 1
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END IF
C * GET ABSORPTION CORRECTION TYPE
        CASE (232)
          RLWS(3)  = ''''//NWRD(2:79)
          IPR(485) = -2
          IF (INUM .LT. 0) THEN
            IPR(485) = -1
          ELSE
            SELECT CASE (NWRD(2:3))
              CASE ('NO')
                IPR(485) = 0
              CASE ('AN')
                IPR(485) = 1
              CASE ('IN', 'GA')
                IPR(485) = 2
              CASE ('NU')
                IPR(485) = 3
              CASE ('EM', 'PS')
                IPR(485) = 4
              CASE ('MU')
                IPR(485) = 5
              CASE ('RE')
                IPR(485) = 6
              CASE ('SP')
                IPR(485) = 7
              CASE ('CY')
                IPR(485) = 8
            END SELECT
          END IF
        CASE (233)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(19) = NWRD(2:NW-1)
            NCIF(19) = NW - 2
          END IF
        CASE (234)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(14) = NWRD(2:NW-1)
            NCIF(14) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(14),  1, NP57)
        CASE (239)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(5) = NWRD(2:NW-1)
            NCIF(5) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(5),  1, NP57)
C * EXTINCTION EXPRESSION
        CASE (353)
          RLWS(2) = ''''//NWRD(2:79)
        CASE (369)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(2) = NWRD(2:NW-1)
            NCIF(2) = NW - 2
          END IF
          IF (CCIF(2)(1:4) .EQ. 'FSQD') THEN
            CCIF(2) = 'Fsqd'
            IPR(309) = 2
          ELSE
            IPR(309) = 1
          END IF
C * _refine_ls_extinction_method
        CASE (354)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(4) = NWRD(2:NW-1)
            NCIF(4) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(4),  1, NP57)
        CASE (358)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(3) = NWRD(2:NW-1)
            NCIF(3) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(3),  1, NP57)
        CASE (362)
          IPR(273) = NINT(FA(1))
C * ALERT _860
          CALL SGSM (IDM, 0, XJX, 0, 18, IERR)
          NORC = 0
          DO K = 1, 3
            IF (NINT (XJX(9 + K)) .NE. 0) NORC = NORC + 1
          END DO
          IF (IPR(273) .GT. NORC) THEN
            CALL PLA231 (860, 0, -999.0, FA(1), ' ', ' ')
          END IF
C *  WEIGHT EXPRESSION
        CASE (370)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(9) = NWRD(2 : NW - 1)
            NCIF(9) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(9), 1, 9)
C * _reflns_observed_criterion
C * _reflns_threshold_expression
        CASE (412, 443)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(1) = NWRD(2:NW-1)
            NCIF(1) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(1),  1, NP57)
C * _refine_ls_weighting_details
        CASE (451)
          CALL PLA266
C * _iucr_refine_instruction(s)_details
C * _iucr_refine_instructions_details_restraints
C * _iucr_refine_instructions_details_constraints
        CASE (513, 518, 519, 520)
          IPR(653) = IPR(654)
        CASE (478)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(17) = NWRD(2:NW-1)
            NCIF(17) = NW - 2
          END IF
C * POWDER 2Thetamin
        CASE (544)
          IPR(105) = 1
C * POWDER 2Thetamax
        CASE (545)
          IPR(105) = 1
          PAR(168) = FA(1) / 2.0
C * _iucr_refine_reflections_details
        CASE (569)
          IPR(646) = 1
          IPR(660) = IPR(654)
          IPR(676) = 1
C * _reflns_Friedel_fraction_max
        CASE (572)
C * _reflns_Friedel_fraction_full
        CASE (573)
C * _shelx_res_checksum
        CASE (579)
          IF (IPR(677) .EQ. 0) THEN
            IPR(677) = -2
          ELSE
            IPR(677) =  IABS(IPR(677))
          END IF
C * _shelx_hkl_checksum
        CASE (581)
          IF (IPR(678) .EQ. 0) THEN
            IPR(678) = -2
          ELSE
            IPR(678) =  IABS(IPR(678))
          END IF
C * _diffrn_reflns_Laue_measured_fraction_max
        CASE (585)
C * _diffrn_reflns_Laue_measured_fraction_full
        CASE (586)
C * _diffrn_reflns_point_group_measured_fraction_max
        CASE (587)
C * _diffrn_reflns_point_group_measured_fraction_full
        CASE (588)
C * _reflns_Friedel_coverage
        CASE (589)
C * _shelx_fab_checksum
        CASE (602)
          IF (IPR(679) .EQ. 0) THEN
            IPR(679) = -1
          ELSE
            IPR(679) = IABS(IPR(679))
          END IF
C * _diffrn_measurement_device & _diffrn_measurement_device_type'
        CASE (136, 441)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(18) = NWRD(2:NW-1)
            NCIF(18) = NW - 2
          END IF
        CASE (357)
          IF (NW .GT. 2) THEN
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            CCIF(13) = NWRD(2:NW-1)
            NCIF(13) = NW - 2
          END IF
          CALL GEN020 (-1, CCIF(13),  1, NP57)
        CASE (308)
          LREF(1)  = NWRD(2:NW-1)
          IPR(565) = 0
        CASE (321)
          LREF(2)(1:NW) = NWRD(2: NW - 1)//', '
        CASE (320)
          LREF(2)(7:NW + 6) = NWRD(2:NW-1)//', '
        CASE (309)
          LREF(2)(12:NW + 11) = NWRD(2:NW-1)
        CASE (323)
          IF (IPR(565) .LT. 23) THEN
            IPR(565) = IPR(565) + 1
            LREF(2 + IPR(565)) = NWRD(2:NW-1)
          END IF
        CASE (322)
        CASE (469)
        CASE (532)
        CASE (480)
          IPR(648) = IPR(648) + 1
          JCA(IPR(648)) = NINT (FA(1))
        CASE (419, 490)
          IF (IPR(319) .EQ. 0) THEN
            IPR(319) = 1
            CALL SGSM (IDM, 0, FN, 0, 1, IERR)
            IPR(48)  = 1
          END IF
          DO J = I0 + 1, 80
            IF (ICL(J:J) .NE. ' ') THEN
              IGGT(1:80) = ICL(J:80)
              EXIT
            END IF
          END DO
          IFL(1)   = 'SYMM   '
          ICL      = 'SYMM '//NWRD(2:NW-1)
          IPR(220) = 1
          IPR(221) = 0
          IF (MODE .EQ. 0 .AND. IGBL(3) .NE. 14)
     1       WRITE (LU11) ICL(1:80), (IFL(J), J = 1, 4),
     2       (FN(J), J = 1, 6)
        CASE (245)
          FN(1) = FA(1)
        CASE (246)
          FN(2) = FA(1)
        CASE (247)
          FN(3) = FA(1)
        CASE (248)
          IF (FA(1) .GT. 0.0) THEN
            FN(4)    = FA(1)
            IPR(220) = 1
            IPR(221) = 4
            IFL(1)   = 'FACE'
            LRETCIF  = 1
            RETURN
          END IF
        CASE (385, 386, 387)
        CASE (70)
          IPR(639) = IPR(639) + 1
          CALL GEN020 (1, NWRD, 2, NW - 1)
          IF (NW .EQ. 3) THEN
            DISPTYPE(IPR(639)) = ' '//NWRD(2:2)
          ELSE
            CALL GEN020 (-1, NWRD, 3, 3)
            DISPTYPE(IPR(639)) = NWRD(2:3)
          END IF
        CASE (67)
          DISPVAL(IPR(639), 1) = FA(1)
        CASE (66)
          DISPVAL(IPR(639), 2) = FA(1)
        CASE (507)
          IPR(651) = 1
          PAR(437) = PAR(437) + FA(1)
        CASE (618)
          IPR(651) = 2
          PAR(437) = PAR(437) + FA(1)
        CASE (138)
          IPR(655) = IPR(655) + 1
          IF (IPR(655) .GT. 1) IPR(619) = 1
        CASE (139)
        CASE (140)
        CASE (141)
        CASE (142)
        CASE (143)
        CASE (144)
        CASE (145)
        CASE (146)
        CASE (147)
        CASE (508)
          IPR(651) = 1
          PAR(438) = PAR(438) + FA(1)
        CASE (619)
          IPR(651) = 2
          PAR(438) = PAR(438) + FA(1)
C * _atom_site_aniso_label
        CASE (1)
          IF (IPR(39) .EQ. 0) THEN
            IPR(2)  = 42
            LRETCIF = 4
            RETURN
          END IF
          IPR(220) = 2
          IPR(221) = 0
          IFL(1)   = 'UIJ'
          IFL(2)   = NWRD(2:NW-1)
C * ALERT _799
          IF (INUM .NE. 0) THEN
            CALL PLA231 (799, 1, 1.0, 1.0, IFL(2), ' ')
          END IF
C * _atom_site_aniso_U_11
        CASE (3)
          IF (INUM .NE. 0) THEN
            FN(1)    = FA(1)
            FN(7)    = FA(2)
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_aniso_U_12
        CASE (4)
          IF (INUM .NE. 0) THEN
            FN(6)    = FA(1)
            FN(12)   = FA(2)
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_aniso_U_13
        CASE (5)
          IF (INUM .NE. 0) THEN
            FN(5)    = FA(1)
            FN(11)   = FA(2)
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_aniso_U_22
        CASE (6)
          IF (INUM .NE. 0) THEN
            FN(2)    = FA(1)
            FN(8)    = FA(2)
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_aniso_U_23
        CASE (7)
          IF (INUM .NE. 0) THEN
            FN(4)    = FA(1)
            FN(10)   = FA(2)
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_aniso_U_33
        CASE (8)
          IF (INUM .NE. 0) THEN
            FN(3)    = FA(1)
            FN(9)    = FA(2)
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * B11, B22 etc
        CASE (452)
          FN(1)    = FA(1) / RGBL(8)
          FN(7)    = FA(2) / RGBL(8)
          IPR(221) = IPR(221) + 2
C * B12
        CASE (453)
          FN(6)    = FA(1) / RGBL(8)
          FN(12)   = FA(2) / RGBL(8)
          IPR(221) = IPR(221) + 2
C * B13
        CASE (454)
          FN(5)    = FA(1) / RGBL(8)
          FN(11)   = FA(2) / RGBL(8)
          IPR(221) = IPR(221) + 2
C * B22
        CASE (455)
          FN(2)    = FA(1) / RGBL(8)
          FN(8)    = FA(2) / RGBL(8)
          IPR(221) = IPR(221) + 2
C * B23
        CASE (456)
          FN(4)    = FA(1) / RGBL(8)
          FN(10)   = FA(2) / RGBL(8)
          IPR(221) = IPR(221) + 2
C * B33
        CASE (457)
          FN(3)    = FA(1) / RGBL(8)
          FN(9)    = FA(2) / RGBL(8)
          IPR(221) = IPR(221) + 2
C * _atom_site_label
        CASE (22)
          DO I = 1, 34
            FN(I) = 0.0
          END DO
          IPR(221) = 4
          IF (IPR(220) .EQ. 0) NHTP   = -1
          IFL(1) = 'ATOM'
          IFL(2) = NWRD(2:NW-1)
C * ALERT _798 : REPORT ON NUMERAL LABEL
          IF (INUM .NE. 0) THEN
            CALL PLA231 (798, 1, 1.0, 1.0, IFL(2), ' ')
          END IF
          FN(4)    = 1.0
          IPR(220) = IPR(220) + 2
C * _atom_site_type_symbol
        CASE (35)
          NHTP   = 0
          IFL(3) = NWRD(2:NW-1)
          IF (IFL(3)(1:2) .EQ. 'H ') NHTP = 1
          IF (NHTP .EQ. 0 .AND. IPR(220) .EQ. 2)
     1      IPR(644) = IPR(644) + NINT(FN(29))
          IPR(220) = IPR(220) + 1
C * _atom_site_fract_x
        CASE (19)
          IF (INUM .NE. 0) THEN
            FN(1) = FA(1)
            FN(5) = FA(2)
C * ALERT _101
            IF (FA(2) .EQ. 0.0) THEN
              IF (IPR(606) .EQ. 4 .OR. IPR(606) .EQ. 6) THEN
                IFL(4) = NWRD(2:NW-1)
                IF (FA(1) .EQ. 0.333 .OR. FA(1) .EQ. 0.667)
     1            CALL PLA231 (101, 1, 1.0, 1.0, IFL(4), IFL(2))
              END IF
            END IF
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_frac_y
        CASE (20)
          IF (INUM .NE. 0) THEN
            FN(2) = FA(1)
            FN(6) = FA(2)
C * ALERT _102
            IF (FA(2) .EQ. 0.0) THEN
              IF (IPR(606) .EQ. 4 .OR. IPR(606) .EQ. 6) THEN
                IFL(4) = NWRD(2:NW-1)
                IF (FA(1) .EQ. 0.333 .OR. FA(1) .EQ. 0.667)
     1            CALL PLA231 (102, 1, 1.0, 1.0, IFL(4), IFL(2))
              END IF
            END IF
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_fract_z
        CASE (21)
          IF (INUM .NE. 0) THEN
            FN(3) = FA(1)
            FN(7) = FA(2)
C * ALERT _103
            IF (FA(2) .EQ. 0.0) THEN
              IF (IPR(606) .EQ. 4 .OR. IPR(606) .EQ. 6) THEN
                IFL(4) = NWRD(2:NW-1)
                IF (FA(1) .EQ. 0.333 .OR. FA(1) .EQ. 0.667)
     1            CALL PLA231 (103, 1, 1.0, 1.0, IFL(4), IFL(2))
              END IF
            END IF
            IPR(221) = IPR(221) + 2
          ELSE
            LRETCIF = 1
            RETURN
          END IF
C * _atom_site_calc_flag
        CASE (11)
          IF (NWRD(2:3) .EQ. 'D''') THEN
            FN(21) = 1.0
          ELSE IF (NWRD(2:2) .EQ. 'C') THEN
            FN(22) = 1.0
          ELSE IF (NWRD(2:4) .EQ. 'DUM') THEN
            FN(23) = 1.0
          END IF
C * _atom_site_refinement_flags & _atom_site_refinement_flags_pos
        CASE (31, 598)
          IF (INDEX(NWRD(2:NW-1), 'S')  .NE. 0) FN(24) = 1.0
          IF (INDEX(NWRD(2:NW-1), 'G')  .NE. 0) FN(25) = 1.0
          IF (INDEX(NWRD(2:NW-1), 'R')  .NE. 0) FN(26) = 1.0
          IF (INDEX(NWRD(2:NW-1), 'D')  .NE. 0) THEN
            FN(27)   = 1.0
            IPR(643) = IPR(643) + 1
          END IF
          IF (INDEX(NWRD(2:NW-1), 'T')  .NE. 0) FN(28) = 1.0
          IF (INDEX(NWRD(2:NW-1), 'U')  .NE. 0) THEN
            FN(29) = 1.0
            IF (NHTP .EQ. 0) IPR(644) = IPR(644) + 1
          END IF
          IF (INDEX(NWRD(2:NW-1), 'P')  .NE. 0) THEN
            FN(30) = 1.0
          END IF
C * _atom_site_refinement_flags_adp
        CASE (599)
          IF (INDEX(NWRD(2:NW-1), 'T')  .NE. 0) FN(28) = 1.0
          IF (INDEX(NWRD(2:NW-1), 'U')  .NE. 0) THEN
            FN(29)   = 1.0
            IF (NHTP .EQ. 0) IPR(644) = IPR(644) + 1
          END IF
C * _atom_site_refinement_flags_occupancy
        CASE (600)
          IF (INDEX(NWRD(2:NW-1), 'P')  .NE. 0) THEN
            FN(30) = 1.0
          END IF
        CASE (450)
          IF (INDEX(NWRD(2:NW-1), 'A')  .NE. 0) FN(31) = 1.0
          IF (INDEX(NWRD(2:NW-1), 'B')  .NE. 0) FN(32) = 1.0
          IF (INDEX(NWRD(2:NW-1), 'S')  .NE. 0) FN(33) = 1.0
C * _atom_site_disorder_group
        CASE (18)
          IPR(612) = NINT(FA(1))
          IF (IPR(612) .LT. 0) IPR(695) = IPR(695) + 1
C * _atom_site_symmetry_multiplicity (SHELXL - JANA INTERPRETATION)
        CASE (33)
          IF (IGBL(133) .EQ. 6) FA(1) = IPR(48) / FA(1)
          FN(35) = FA(1)
C * _atom_site_site_symmetry_order
        CASE (570)
          FN(35) = FA(1)
C * _atom_site_thermal_displace_type & _atom_site_adp_type
        CASE (34, 449)
C * _atom_site_site_symmetry_multiplicity
        CASE (571)
          FN(36) = FA(1)
C *_atom_site_occupancy
        CASE (30)
          IF (INUM .EQ. 0)  THEN
            IPR(221) = IPR(221) - 2
            LRETCIF  = 1
            RETURN
          ELSE IF (INUM .LT. 0) THEN
            FA(1) = 1.0
            FA(2) = 0.0
          END IF
          IF (FA(1) .LT. 0.0001 .AND.
     1      IFL(2)(1:2) .NE. 'CG') THEN
C * ALERT _074
            CALL PLA231 (74, 1, 0.5, 0.5, IFL(2), ' ')
          END IF
          FN(4) = FA(1)
          FN(8) = FA(2)
        CASE (36)
          IF (INUM .NE. 0) THEN
            FN(9)  = FA(1)
            FN(10) = FA(2)
            IF (FN(9) .LT. 0.0) THEN
              CALL PLA231 (203, 3, -FN(9), FN(9), IFL(2), ' ')
            END IF
          ELSE
            IPR(221) = IPR(221) - 2
            LRETCIF  = 1
            RETURN
          END IF
        CASE (423)
          IF (INUM .NE. 0) THEN
            FN(9)  = FA(1) / RGBL(8)
            FN(10) = FA(2) / RGBL(8)
          ELSE
            IPR(221) = IPR(221) - 2
            LRETCIF  = 1
            RETURN
          END IF
C * BOND
        CASE (265)
          LINE   = 'BOND '
          IFL(1) = NWRD(2:NW - 1)
          FN(3)  = 1.555
          FN(4)  = 1.555
        CASE (266)
          IFL(2) = NWRD(2:NW - 1)
        CASE (267)
          FN(1)  = FA(1)
          FN(2)  = FA(2)
        CASE (269)
          CALL PLA058 (INUM, JCA, FA(1), FN(3), IPR(648))
        CASE (270)
          CALL PLA058 (INUM, JCA, FA(1), FN(4), IPR(648))
C * CONTACT
        CASE (271)
          LINE   = 'CONTACT '
          IFL(1) = NWRD(2:NW - 1)
          FN(3)  = 1.555
          FN(4)  = 1.555
        CASE (272)
          IFL(2) = NWRD(2:NW - 1)
        CASE (273)
          FN(1)  = FA(1)
          FN(2)  = FA(2)
        CASE (275)
          CALL PLA058 (INUM, JCA, FA(1), FN(3), IPR(648))
        CASE (276)
          CALL PLA058 (INUM, JCA, FA(1), FN(4), IPR(648))
C * ANGLE
        CASE (258)
          LINE   = 'ANGLE '
          IFL(1) = NWRD(2:NW - 1)
          FN(3)  = 1.555
          FN(4)  = 1.555
          FN(5)  = 1.555
        CASE (259)
          IFL(2) = NWRD(2:NW - 1)
        CASE (260)
          IFL(3) = NWRD(2:NW - 1)
        CASE (257)
          FN(1)  = FA(1)
          FN(2)  = FA(2)
        CASE (262)
          CALL PLA058 (INUM, JCA, FA(1), FN(3), IPR(648))
        CASE (263)
          CALL PLA058 (INUM, JCA, FA(1), FN(4), IPR(648))
        CASE (264)
          CALL PLA058 (INUM, JCA, FA(1), FN(5), IPR(648))
C * TORSION
        CASE (279)
          LINE   = 'TORSION '
          IFL(1) = NWRD(2:NW - 1)
          FN(3)  = 1.555
          FN(4)  = 1.555
          FN(5)  = 1.555
          FN(6)  = 1.555
        CASE (280)
          IFL(2) = NWRD(2:NW - 1)
        CASE (281)
          IFL(3) = NWRD(2:NW - 1)
        CASE (282)
          IFL(4) = NWRD(2:NW - 1)
        CASE (278)
          FN(1)  = FA(1)
          FN(2)  = FA(2)
        CASE (284)
          CALL PLA058 (INUM, JCA, FA(1), FN(3), IPR(648))
        CASE (285)
          CALL PLA058 (INUM, JCA, FA(1), FN(4), IPR(648))
        CASE (286)
          CALL PLA058 (INUM, JCA, FA(1), FN(5), IPR(648))
        CASE (287)
          CALL PLA058 (INUM, JCA, FA(1), FN(6), IPR(648))
C * H-BOND
        CASE (426)
          LINE   = 'HBOND '
          IFL(1) = NWRD(2:NW - 1)
          FN(9)  = 1.555
          FN(10) = 1.555
          FN(11) = 1.555
        CASE (427)
          IFL(2) = NWRD(2:NW - 1)
        CASE (428)
          IFL(3) = NWRD(2:NW - 1)
        CASE (429)
          FN(1)  = FA(1)
          FN(2)  = FA(2)
        CASE (430)
          FN(3)  = FA(1)
          FN(4)  = FA(2)
        CASE (431)
          FN(5)  = FA(1)
          FN(6)  = FA(2)
        CASE (432)
          FN(7)  = FA(1)
          FN(8)  = FA(2)
        CASE (466)
          CALL PLA058 (INUM, JCA, FA(1), FN(9), IPR(648))
        CASE (467)
          CALL PLA058 (INUM, JCA, FA(1), FN(10), IPR(648))
        CASE (433)
          CALL PLA058 (INUM, JCA, FA(1), FN(11), IPR(648))
C * SUM & MOIETY FORMULA
        CASE (107)
          IF (NSTRS .LT. 79) THEN
            CALL GEN134 (NWRD, RLWS(4), 2, 79)
          ELSE
            CALL GEN134 (STRSAVE, RLWS(4), 1, NP52)
          END IF
        CASE (109)
          CALL GEN134 (NWRD, RLWS(5), 2, 79)
          IFL(1)  = 'FSUM'
          ICL     = RLWS(5)
          LRETCIF = 1
          RETURN
        CASE (418, 483)
          IF (INDEX (NWRD, 'TRICLINIC') .NE. 0) THEN
            KRSYST(1) = '   triclinic'
            IPR(606)  = 1
          ELSE IF (INDEX (NWRD, 'MONOCLINIC') .NE. 0) THEN
            KRSYST(1) = '  monoclinic'
            IPR(606)  = 2
          ELSE IF (INDEX (NWRD, 'ORTHORHOMBIC') .NE. 0) THEN
            KRSYST(1) = 'orthorhombic'
            IPR(606)  = 3
          ELSE IF (INDEX (NWRD, 'TRIGONAL') .NE. 0) THEN
            KRSYST(1) = '    trigonal'
            IPR(606)  = 4
          ELSE IF (INDEX (NWRD, 'TETRAGONAL') .NE. 0) THEN
            KRSYST(1) = '  tetragonal'
            IPR(606)  = 5
          ELSE IF (INDEX (NWRD, 'HEXAGONAL') .NE. 0) THEN
            KRSYST(1) = '   hexagonal'
            IPR(606)  = 6
          ELSE IF (INDEX (NWRD, 'CUBIC') .NE. 0) THEN
            KRSYST(1) = '       cubic'
            IPR(606)  = 7
          ELSE IF (INDEX (NWRD, 'RHOMBOHEDRAL') .NE. 0) THEN
            KRSYST(1) = 'rhombohedral'
            IPR(606) = 8
          END IF
C * _symmetry_Int_Tables_number & _space_group_IT_number
        CASE (420, 485)
C * _symmetry_space_group_name_Hall & _space_group_name_Hall (OLD & NEW FORMS)
        CASE (421, 486)
          IF (IPR(37) .EQ. 0) THEN
            IF (IPR(319) .EQ. 0) IPR(318) =  1
            IF (NW .GT. 2) THEN
              IF (NW .GT. NP57 + 2) NW = NP57 + 2
              LINE = NWRD(2:NW-1)
              LB   = 1
              LE   = NW - 2
              NB   = 1
              NE   = NW - 2
              CALL GEN039 (0, LINE, LB, LE, NB, NE)
              CCIF(16) = LINE(NB:NE)
              NCIF(16) = NE - NB + 1
            END IF
            CALL GEN020 (-1, CCIF(16), 3, NP57)
            IF (NWRD(2:2) .NE. '?' .AND. NWRD(2:2) .NE. ' ') THEN
              IFL(1) = 'HALL'
              ICL    = 'HALL '//NWRD(2:NW-1)
              IPR(220) = 2
              IPR(221) = 0
              LRETCIF  = 1
              RETURN
            END IF
          ELSE
C * ALERT _800 - MISPLACED SYMMETRY INFO
            CALL PLA231 (-800, 0, 1.0, 1.0, ' ', ' ')
            CALL PLA231 (0, 0, 0.0, 0.0,
     1        '              '//ICL(1:50), ' ')
          END IF
C * H-M SPACEGROUP SYMBOL (OLD & NEW FORMS - 488 preferred)
        CASE (422, 487, 488)
          IF (IPR(37) .EQ. 0) THEN
            IF (IPR(319) .EQ. 0) IPR(318) =  1
            IF (NW .GT. NP57 + 2) NW = NP57 + 2
            NB = 2
            NE = NW - 1
            CALL GEN039 (0, NWRD, 2, NW -1, NB, NE)
            CCIF(6) = NWRD(NB:NE)
            NCIF(6) = NE - NB + 1
            CALL GEN020 (-1, CCIF(6), 2, NP57)
            IF (NWRD(NB:NB) .NE. '?' .AND.
     1          NWRD(NB:NB) .NE. ' ') THEN
              IFL(1) = 'SPGR'
              ICL    = 'SPGR '//NWRD(NB:NE)
              JID(11:11 + NE - NB) = NWRD(NB:NE)
              CALL GEN020 (-1, JID, 12, 23)
              IPR(220) = 2
              IPR(221) = 0
              LRETCIF  = 1
              RETURN
            ELSE
C * NO H-M SPACEGROUP SPECIFIED
C * ALERT _122
              CALL PLA231 (122, 0, 1.0, 1.0, ' ', ' ')
            END IF
          ELSE
C * ALERT _800 - MISPLACED SYMMETRY INFO
            CALL PLA231 (-800, 0, 1.0, 1.0, ' ', ' ')
            CALL PLA231 (0, 0, 0.0, 0.0,
     1        '              '//ICL(1:50), ' ')
          END IF
C * _space_group_ssg_name
        CASE (622)
          IGBL(140) = 1
C * ALERT _814 - (In)Commensurate Structure
          CALL PLA231 (814, 0, -999.0, 0.0, ' ', ' ')
        CASE DEFAULT
          IF (INUM .EQ. 1) THEN
            SELECT CASE (NLP(NL))
C * ALPHA
              CASE (74)
                CALL PLA265 (4)
                LRETCIF = 10
                RETURN
C * BETA
              CASE (75)
                CALL PLA265 (5)
                LRETCIF = 10
                RETURN
C * GAMMA
              CASE (76)
                CALL PLA265 (6)
                LRETCIF = 10
                RETURN
C * REPORTED Z
              CASE (77)
                IPR(276) = NINT(FA(1))
C * A-AXIS
              CASE (78)
                CALL PLA265 (1)
                LRETCIF = 10
                RETURN
C * B-AXIS
              CASE (79)
                CALL PLA265 (2)
                LRETCIF = 10
                RETURN
C * C-AXIS
              CASE (80)
                CALL PLA265 (3)
                LRETCIF = 10
                RETURN
C * CELL_MEASUREMENT_REFLNS_USED
              CASE (87)
                IPR(601) = NINT(FA(1))
C * CELL_MEASUREMENT_TEMPERATURE
              CASE (88)
                IPR(261) = NINT(FA(1))
                IPR(220) = 1
                IPR(221) = 1
                IFL(1)   = 'TEMP'
                IFL(2)   = 'K'
                FN(1)    = FA(1)
                LRETCIF  = 1
                RETURN
C * CELL_MEASUREMENT_THETA_MAX
              CASE (89)
                PAR (470) = FA(1)
C * CELL_MEASUREMENT_THETA_MIN
              CASE (90)
                PAR(469) = FA(1)
C * VOLUME
              CASE (93)
                PAR(164) = FA(1)
                PAR(327) = MAX (0.0, FA(2))
C * ALERT _151
                IF (FA(2) .LE. 0.0 .AND. IGBL(94) .EQ. 0) THEN
                  CALL PLA231 (151, 0, 1.0, 1.0, ' ', ' ')
                ELSE
                  CALL GEN041 (PAR(164), PAR(327), IPR(313),
     1              3, IPR(314), IPR(68))
                END IF
                LRETCIF = 10
                RETURN
C * MOL-WEIGHT
              CASE (110)
                PAR(308) = FA(1)
C * CELL_AMBIENT_TEMPERATURE
              CASE (133)
                IPR(310) = NINT(FA(1))
              CASE (164)
                IPR(220) = 1
                IPR(221) = 1
                IFL(1)   = 'RADN'
                FN(1)    = FA(1)
                LRETCIF  = 1
                RETURN
C * R(int)
              CASE (196)
                PAR(197) = FA(1)
C * R(sig)
              CASE (197, 497)
                PAR(198) = FA(1)
C * HMIN... LMAX, THETA-MIN THETA-MAX
              CASE (198)
                IPR(268) = NINT(FA(1))
                IPR(672) = IPR(672) + 1
              CASE (199)
                IPR(267) = NINT(FA(1))
                IPR(672) = IPR(672) + 1
              CASE (200)
                IPR(270) = NINT(FA(1))
                IPR(672) = IPR(672) + 1
              CASE (201)
                IPR(269) = NINT(FA(1))
                IPR(672) = IPR(672) + 1
              CASE (202)
                IPR(272) = NINT(FA(1))
                IPR(672) = IPR(672) + 1
              CASE (203)
                IPR(271) = NINT(FA(1))
                IPR(672) = IPR(672) + 1
C * NR REFL & PARAMETERS
              CASE (204)
                IPR(262) = NINT(FA(1))
C * REFLECTION -_DIFFRN_REFLNS_THETA_MAX
              CASE (206)
                PAR(168) = FA(1)
                IF (PAR(17) .GT. 0) PAR(287) =
     1            SIN (PAR(168) / RGBL(6)) / PAR(17)
C * REFLECTION -THETA-MIN
              CASE (207)
                PAR(167) = FA(1)
C * DATA RELATED TO ABSORPTION
              CASE (229)
                PAR(301) = FA(1)
C * transmission min
              CASE (230, 582)
                PAR(306) = FA(1)
C * transmission max
              CASE (231, 583)
                PAR(307) = FA(1)
C * DENSITY(diffrn)
              CASE (235)
                PAR(267) = FA(1)
C * DENSITY(meas)
              CASE (236)
                PAR(158) = FA(1)
C * REPORTED F000
              CASE (240)
                PAR(324) = FA(1)
C * DIFF-DENS-MAX
              CASE (347)
                PAR(177) = FA(1)
C * DIFF-DENS-MIN
              CASE (348)
                PAR(176) = FA(1)
C * FLACK PARAMETER
              CASE (350)
                CALL GEN041 (FA(1), FA(2), IPR(279), 3,
     1                       IPR(280), IPR(68))
                PAR(433) = FA(1)
                PAR(434) = FA(2)
                IF (FA(2) .LE. 0.0) THEN
C * ALERT _036 - Test for no-su on Flack x
                  IF (FA(1) .NE. 0.500) THEN
                    CALL PLA231 (36, 3, 1.0, 1.0, ' ', ' ')
                  END IF
                ELSE
C * ALERT _032
                  IF (FA(2) .GT. 0.2)
     1              CALL PLA231 (32, 3, -999.0, FA(2), ' ', ' ')
                END IF
C * ALERT _033 - TEST FOR FLACK PARAMETER VALUE OFF ZERO
                IF (FA(1) .LT. 99999.0) THEN
                  IF (IPR(275) .EQ. 1) THEN
                    IF (CHSG(1:1) .EQ. 'C') THEN
                      IF (ABS(FA(1)) .GT. 2 * FA(2)) THEN
                        CALL PLA231 (33, 3, -999.0, FA(1), ' ', ' ')
                      END IF
                    END IF
                  ELSE
C * ALERT _781 - NO FLACK PARAMETER FOR CENTRO STRUCTURE
                    CALL PLA231 (781, 0, 1.0, 1.0, ' ', ' ')
                  END IF
                END IF
C * ALERT _850
                IF (FA(1) .EQ. 0.0 .AND. FA(2) .GT. 0.0)
     1            CALL PLA231 (850, 2, -999.0, FA(2), ' ', ' ')
C * XTAL-SIZE-MAX
              CASE (251)
                PAR(302) = FA(1)
C * XTAL-SIZE-MID
              CASE (252)
                PAR(303) = FA(1)
C * XTAL-SIZE-MIN
              CASE (253)
                PAR(304) = FA(1)
C * XTAL-RADIUS
              CASE (254)
                PAR(305) = FA(1)
C * EXTINCTION PARAMETER
              CASE (352)
                RATIO = 0.0
                IF (FA(2) .GT. 0.0) THEN
                  IF (FA(1) .LT. 0.1 * FA(2)) THEN
                    RATIO1 = 10.0
                  ELSE
                    RATIO  = FA(1) / FA(2)
                    RATIO1 = 1.0 / RATIO
                  END IF
C * ALERT _031
                  CALL PLA231 (31, 3, RATIO1, RATIO, ' ', ' ')
                END IF
                CALL GEN041 (FA(1), FA(2), IPR(277), -8,
     1                       IPR(278), IPR(68))
                PAR(229) = FA(1)
C * S(all/ref/obs)
              CASE (355, 447, 356)
                PAR(299) = FA(1)
C * NUMBER OF L.S.-PARAMETERS
              CASE (360)
                IPR(266) = NINT(FA(1))
C * NUMBER OF UNIQUE REFLECTIONS _refine_ls_number_reflns
              CASE (361)
                IPR(265) = NINT(FA(1))
C * R-all
              CASE (363)
                IF (FA(1) .GT. 1.0) FA(1) = FA(1) * 0.01
                PAR(309) = FA(1)
C * R-obs/gt
              CASE (364, 445)
                IF (FA(1) .GT. 1.0) FA(1) = FA(1) * 0.01
                PAR(173) = FA(1)
                WRITE (JID(24:31), 99999, IOSTAT = IOST) FA(1)
C * S(Restrained-obs)
              CASE (365)
                PAR(300) = FA(1)
C * SHIFT/ESD(SU)-MAX
              CASE (367, 448)
                IF (PAR(178) .LT. 0.0) PAR(178) = FA(1)
C * SHIFT/ESD(SU)-MEAN
              CASE (368, 461)
                PAR(179) = FA(1)
C * wR-All/Ref
              CASE (371, 446)
                IF (FA(1) .GT. 1.0) FA(1) = FA(1) * 0.01
                PAR(174) = FA(1)
C * wR-obs/gt
              CASE (372, 460)
                IF (FA(1) .GT. 1.0) FA(1) = FA(1) * 0.01
                PAR(310) = FA(1)
              CASE (410)
                IPR(263) = NINT(FA(1))
              CASE (411)
                IPR(264) = NINT(FA(1))
              CASE (442)
                IPR(264) = NINT(FA(1))
C * REFLECTION - THETA FULL
              CASE (444)
                PAR(312) = FA(1)
C * MEAS FRACTION THETA-MAX
              CASE (458)
                PAR(313) = FA(1)
C * MEAS FRACTION THETA-FULL
              CASE (459)
                PAR(314) = FA(1)
C * DIFF-DENS-RMS
              CASE (462)
                PAR(175) = FA(1)
C * SHIFT/ESD(SU)-MAX_LT
              CASE (511)
                IF (PAR(178) .LT. 0.0) PAR(178) = FA(1)
C * HOOFT PARAMETER
              CASE (512)
                CALL GEN041 (FA(1), FA(2), IPR(615), 3,
     1                       IPR(616), IPR(68))
                PAR(435) = FA(1)
                PAR(436) = FA(2)
            END SELECT
          END IF
      END SELECT
      RETURN
99999 FORMAT ('R =', F5.2)
      END SUBROUTINE PLA269
      SUBROUTINE PLA270 (XM1, XM2, XM3)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION XJX(12)
      CHARACTER ICLX*1
      IPR(2) = 0
      ISW    = 9
      M1     = NINT(XM1 * PAR(42))
      CALL GEN098 (M1, PAR(42), MS1, MT11, MT12, MT13, MR3)
      XJX(1) = MS1
      XJX(2) = MT11
      XJX(3) = MT12
      XJX(4) = MT13
      M2     = NINT(XM2 * PAR(42))
      IF (M2 .NE. 0) THEN
        ISW    = 8
        CALL GEN098 (M2, PAR(42), MS2, MT21, MT22, MT23, MR3)
        XJX(5) = MS2
        XJX(6) = MT21
        XJX(7) = MT22
        XJX(8) = MT23
      END IF
      CALL SGSM (ICLX, 0, XJX, LU6, ISW, IERR)
      DO I = 10, 12
        IF (ABS(XJX(I)) .GT. 4.1) THEN
          WRITE (LU6, 99999, IOSTAT = IOST)
     1      XM1, XM2, (XJX(J), J = 9, 12)
          IF (IGBL(63) .GT. 0) WRITE (LU7, 99999, IOSTAT = IOST)
     1      XM1, XM2, (XJX(J), J = 9, 12)
          IPR(600) = IPR(600) + 1
          XM3      = 0.0
          IPR(210) = 0
          RETURN
        END IF
      END DO
      XM3  = (((XJX(9) * 10 + XJX(10)) * 10 + XJX(11)) * 10 + XJX(12))
      XM3 = NINT(XM3) + 555 + FLOAT(MR3) / PAR(42)
      RETURN
99999 FORMAT (':: ARU-Pack Problem :', 2F10.2, 4F5.0,/,
     1        ':: IPR(210) Reset to ZERO i.e. no SQUEEZE etc.')
      END SUBROUTINE PLA270
      SUBROUTINE PLA271
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
C * LAST MINUTE SYMMETRY UPDATE
      CALL SGSM (ICL, 0, XJS, 0, 18, IERR)
      SPGRNM(1) = ICL(1:26)
      SPGRNM(3) = ICL(44:60)
      SPGRNM(4) = ICL(15:26)
      IF (ICL(73:73) .NE. ' ') THEN
        ZSPG = ICL(73:79)
        J    = INDEX (ZSPG(2:7), 'r')
        IF (J .NE. 0) ZSPG(J+1:J+1) = 'R'
      END IF
      KRSYST(2) = ICL(27:38)
      LAUEGR    = ICL(39:43)
      CHSG      = ICL(72:72)
      CALL GEN020 (-1, SPGRNM(1), 16, 24)
      CALL GEN020 (-1, KRSYST(2), 1,  12)
      IPR(202) = NINT(XJS(1))
      IPR(241) = NINT(XJS(7))
      IPR(242) = NINT(XJS(8))
      IPR(255) = NINT(XJS(4))
      IPR(256) = NINT(XJS(6))
      IPR(257) = NINT(XJS(5))
      IPR(258) = NINT(XJS(3))
      IPR(259) = NINT(XJS(2))
      IPR(48)  = NINT(XJS(9))
      IF (IGBL(8) .EQ. 3) THEN
        IF (CCIF(7)(1:1) .EQ. ' ') THEN
          CCIF(7) = SPGRNM(4)(1:11)
        ELSE
          CCIF(8) = SPGRNM(4)(1:11)
        END IF
      END IF
      CALL SGSM (ICL, 0, XJS, 0, 13, IERR)
      IPR(275) = NINT(XJS(1))
      RETURN
      END SUBROUTINE PLA271
      SUBROUTINE PLA272
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,NP47=9,
     3 NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      DIMENSION NRAT(4)
      A       = 0.0
      SA      = 0.0
      ISA     = 0
      NDEC    = 0
      NRAT(3) = 0
      NRAT(4) = 0
      N3      = 0
      N4      = 0
      N5      = 0
      NAT     = IPR(39) + IPR(64)
      NAHAT   = 0
      NBHAT   = 0
      NRTORS  = 0
      CALL GEN108 (LU11, 0)
      DO
   10   READ (LU11, END = 20) ICL(1:80), (IFL(I), I = 1, 4),
     1                        (FN(I), I = 1, 6)
        IER  = 0
        NHAT = 0
        SELECT CASE (ICL(1:4))
          CASE ('BOND')
            N5 = N5 + 1
            N  = 2
            M7 = 1
          CASE ('CONT')
            N  = 2
            M7 = 4
C * ALERT _705
          CASE ('D-H ')
            N  = 2
            M7 = 5
C * ALERT _706
          CASE ('H..A')
            N  = 2
            M7 = 6
C * ALERT _707
          CASE ('D..A')
            N  = 2
            M7 = 7
          CASE ('ANGL')
            N4 = N4 + 1
            N  = 3
            M7 = 2
C * ALERT _708
        CASE ('D-H.')
            N  = 3
            M7 = 8
          CASE ('TORS')
            N3 = N3 + 1
            N  = 4
            M7 = 3
          CASE DEFAULT
            GO TO 10
        END SELECT
        NPOP  = 0
        NCSYM = 0
        IDAR2 = 0
        IRAT2 = 0
        IGAT2 = 0
        IER   = 0
        DO I = 1, N
          CALL PLA273 (1, LU11, FN(I + 2), IPR(54), ITR(1), ITR(2),
     1                 ITR(3), IER)
          IF (IER .NE. 0) GO TO 10
          NQ2 = IFL(I)
          IF (NQ2(1:1) .EQ. '?') GO TO 10
          CALL PLA046 (-2, NQ2, IENM, LBB, LBC, LBD, INQNR, JNQNR, L)
          IF (L .GT. 0) THEN
            NRAT(I) = L
            CALL GEN048 (-1, IFG(3, L), 7, IVAL)
            IDAR2 = MAX (IDAR2, IVAL)
            CALL GEN048 (-1, IFG(3, L), 6, IVAL)
            IRAT2 = MAX (IRAT2, IVAL)
            CALL GEN048 (-1, IFG(3, L), 5, IVAL)
            IGAT2 = MAX (IGAT2, IVAL)
            CALL GEN048 (-1, IFG(1, L), 7, IVAL)
            NHAT = NHAT + IVAL
            IF (M7 .EQ. 1) NBHAT = NBHAT + IVAL
            IF (M7 .EQ. 2) NAHAT = NAHAT + IVAL
            CALL GEN048 (-7, IFG(2, L), 1, IDIS)
            NPOP = NPOP + IPPR(IDIS + 1, 1) / 1000
          ELSE
            IF (NQ2(1:2) .NE. 'Cg'.AND. NQ2(1:2) .NE. 'CG') THEN
C * ALERT _710 (+M7)
              CALL PLA231 (-(710 + M7), 2, 1.0, 1.0, NQ2, ' ')
              WRITE (LINE, 99995, IOSTAT = IOST) (IFL(J), J = 1, N)
              CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
            END IF
            GO TO 10
          END IF
          IF (FN(I + 2) .NE. 1.555) THEN
            NCSYM   = NCSYM + 1
            K       = NAT + I
            NRAT(I) = K
            LABA(K) = LABA(L)
            CALL PLA059 (L, K)
            DO J = 1, 3
              IFG(J, K) = IFG(J, L)
            END DO
            CALL GEN048 (1, IFG(1, K), 5, 1)
          END IF
        END DO
        IF (N .EQ. 2) THEN
          INR = 0
          IF (M7 .EQ. 1) THEN
            YUNK = 1.0
            CALL GEN048 (-4, IFG(1, NRAT(1)), 15, NO1)
            CALL GEN048 (-4, IFG(1, NRAT(2)), 15, NO2)
            IEN1 = IEN(NO1 + 1)
            IEN2 = IEN(NO2 + 1)
            IAT1 = IATNR(IEN1)
            IAT2 = IATNR(IEN2)
            IF (IAT1 .LT. IAT2) THEN
              CALL GEN014 (IEN1, IEN2)
              CALL GEN014 (IAT1, IAT2)
            END IF
            IEN12 = IEN1 * 1000 + IEN2
            INR   = 0
            IF (IEN12 .EQ. 2001) THEN
              IF (FN(1) .GT. 1.3) INR = 770
            ELSE IF (IEN12 .EQ. 4001) THEN
              IF (FN(1) .GT. 1.3) INR = 771
            ELSE IF (IEN12 .EQ. 3001) THEN
              IF (FN(1) .GT. 1.3) INR = 772
              YUNK = FN(1)
            ELSE IF (IEN12 .EQ. 2002) THEN
              IF (FN(1) .GT. 1.7) INR = 773
              YUNK = -999.0
            ELSE IF (FN(1) .GT. 4.0) THEN
              IF (IGBL(97) .EQ. 1) THEN
                YUNK = -999.0
                INR  = 774
              END IF
            END IF
          ELSE IF (M7 .EQ. 4) THEN
            IF (FN(1) .GT. 4.0) THEN
              YUNK = FN(1)
              INR  = 775
            END IF
          ELSE IF (M7 .EQ. 5) THEN
            IF (FN(1) .GT. 1.3) THEN
              YUNK = FN(1)
              INR  = 776
            END IF
          END IF
C * ALERT _77x
          IF (INR .GT. 0) THEN
            CALL PLA231 (INR, 2, YUNK, FN(1), IFL(1), IFL(2))
          END IF
          M8 = M7
          IF (M7 .EQ. 1 .AND. NHAT .EQ. 0) IPR(316) = IPR(316) + 1
          CALL PLA053 (NRAT(1), NRAT(2), 0, 0, A, SA, ISA, NDEC, IER)
          IF (IER .NE. 0) GO TO 10
          SB = MAX (0.0, SA)
          RATIO = ABS(FN(1) - A)
          IF (FN(2) .LE. 0.0 .OR. SA .LE. 0.0) THEN
            M8 = M8 + 20
            RATIO1 = RATIO * 100
          ELSE
            RATIO  = RATIO / SA
            RATIO1 = RATIO
          END IF
C * ALERT _70x,_72x
          IF (RATIO1 .GT. 1.0 .AND. FN(2) .NE. 0) THEN
            IF (A .LT. 9.9) THEN
              WRITE (NQ3, 99997, IOSTAT = IOST) A
              WRITE (NQ4, 99997, IOSTAT = IOST) SB
              CALL PLA231 (-(700 + M8), 2, RATIO1, RATIO, NQ3, NQ4)
              WRITE (LINE, 99993, IOSTAT = IOST) (FN(I), I = 1, 2),
     1          (IFL(I), I = 1, 2), (FN(I), I = 3, 4), N5
              CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
            ELSE IF (A .LT. 99.9) THEN
              WRITE (NQ3, 99998, IOSTAT = IOST) A
              WRITE (NQ4, 99997, IOSTAT = IOST) SB
              CALL PLA231 (-(700 + M8), 2, RATIO1, RATIO, NQ3, NQ4)
              WRITE (LINE, 99990, IOSTAT = IOST) (FN(I), I = 1, 2),
     1          (IFL(I), I = 1, 2), (FN(I), I = 3, 4)
              CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
            END IF
          END IF
          IF (NPOP .EQ. 2) THEN
            IF (SA .GT. 0.0) THEN
              IF (FN(2) .GT. 0) THEN
                RATIO  = MIN (9.9, MAX (FN(2) / SA, SA / FN(2)))
                IF (RATIO .GT. 1.5) THEN
                  M7 = M7 + 30
C * ALERT _73x
                  IF (IDAR2 .EQ. 0) THEN
                    Y = ABS (FN(3) - FN(4))
                    IF (M7 .NE. 31 .OR. Y .EQ. 0.0 .OR. Y .GE. 1.0) THEN
                      IF (A .LT. 9.9) THEN
                        WRITE (NQ3, 99997, IOSTAT = IOST) A
                        WRITE (NQ4, 99997, IOSTAT = IOST) SB
                        CALL PLA231 (-(700 + M7), 1, RATIO, RATIO, NQ3,
     1                               NQ4)
                        WRITE (LINE, 99993, IOSTAT = IOST)
     1                    (FN(I), I = 1, 2), (IFL(I)(1:5), I = 1, 2),
     2                    (FN(I), I = 3, 4), N5
                        CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                      ELSE IF (A .LT. 99.9) THEN
                        WRITE (NQ3, 99998, IOSTAT = IOST) A
                        WRITE (NQ4, 99997, IOSTAT = IOST) SB
                        CALL PLA231 (-(700 + M7), 2, RATIO, RATIO, NQ3,
     1                               NQ4)
                        WRITE (LINE, 99990, IOSTAT = IOST)
     1                    (FN(I), I = 1, 2), (IFL(I)(1:5), I = 1, 2),
     2                    (FN(I), I = 3, 4)
                        CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                     END IF
                    END IF
                  END IF
                END IF
              ELSE
                IF (IRAT2 + IDAR2 + IGAT2 .EQ. 0) THEN
                  M7 = M7 + 40
C * ALERT _74x
                  IF (A .LT. 9.9) THEN
                    WRITE (NQ3, 99997, IOSTAT = IOST) A
                    WRITE (NQ4, 99997, IOSTAT = IOST) SB
                    CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                    WRITE (LINE, 99993, IOSTAT = IOST)
     1                (FN(I), I = 1, 2), (IFL(I)(1:5), I = 1, 2),
     2                (FN(I), I = 3, 4), N5
                    CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                  ELSE IF (A .LT. 99.9) THEN
                    WRITE (NQ3, 99998, IOSTAT = IOST) A
                    WRITE (NQ4, 99997, IOSTAT = IOST) SB
                    CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                    WRITE (LINE, 99990, IOSTAT = IOST)
     1                (FN(I), I = 1, 2), (IFL(I)(1:5), I = 1, 2),
     2                (FN(I), I = 3, 4)
                    CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                  END IF
                END IF
              END IF
            ELSE IF (FN(2) .GT. 0.0) THEN
              M7 = M7 + 50
C * ALERT _75x
              IF (A .LT. 9.9) THEN
                WRITE (NQ3, 99997, IOSTAT = IOST) A
                WRITE (NQ4, 99997, IOSTAT = IOST) SB
                CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                WRITE (LINE, 99993, IOSTAT = IOST) (FN(I), I = 1, 2),
     1            (IFL(I)(1:5), I = 1, 2), (FN(I), I = 3, 4), N5
                CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
              ELSE IF (A .LT. 99.9) THEN
                WRITE (NQ3, 99998, IOSTAT = IOST) A
                WRITE (NQ4, 99997, IOSTAT = IOST) SB
                CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                WRITE (LINE, 99990, IOSTAT = IOST) (FN(I), I = 1, 2),
     1            (IFL(I)(1:5), I = 1, 2), (FN(I), I = 3, 4)
                CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
              END IF
            END IF
          END IF
        ELSE IF (N .EQ. 3) THEN
          IF (FN(1) .LT. 45.0 .AND. IGBL(97) .EQ. 1) THEN
            CALL GEN048 (-1, IFG(1, NRAT(2)), 19, IVAL)
            IF (IVAL .EQ. 0) THEN
C * ALERT _779
              WRITE (LINE, 99996, IOSTAT = IOST) N4
              CALL PLA231 (-779, 2, -999.0, 0.0, LINE(1:7), ' ')
              WRITE (LINE, 99989, IOSTAT = IOST)
     1         (IFL(I)(1:5), I = 1, 3), (FN(I), I = 3, 5), FN(1)
              CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
            END IF
          END IF
          M8 = M7
          CALL PLA053 (NRAT(1), NRAT(2), NRAT(3), 0, A, SA, ISA, NDEC,
     1        IER)
          IF (IER .NE. 0) GO TO 10
          SB    = MAX (0.0, SA)
          RATIO = ABS (FN(1) - A)
          IF (FN(2) .LE. 0.0 .OR. SA .LE. 0.0) THEN
            M8 = M8 + 20
            RATIO1 = RATIO
          ELSE
            RATIO  = RATIO / SA
            RATIO1 = RATIO
          END IF
          IF (RATIO1 .GT. 1.0 .AND. FN(2) .NE. 0) THEN
            WRITE (NQ3, 99999, IOSTAT = IOST) A
            WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _70x,_72x
            CALL PLA231 (-(700 + M8), 2, RATIO1, RATIO, NQ3, NQ4)
            WRITE (LINE, 99994, IOSTAT = IOST) (FN(I), I = 1, 2),
     1        (IFL(I)(1:5), I = 1, 3), (FN(I), I = 3, 5), N4
            CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
          END IF
          IF (NPOP .EQ. 3) THEN
            IF (NCSYM .EQ. 0) THEN
              IF (SA .GT. 0.0 .AND. ABS(A) .LT. 179.95) THEN
                IF (FN(2) .GT. 0.0) THEN
                  RATIO  = MIN (9.9, MAX (FN(2) / SA, SA / FN(2)))
                  CALL GEN048 (-1, IFG(1, NRAT(1)), 7, IVAL)
                  IF (IVAL .NE. 0) THEN
                    CALL GEN048 (-1, IFG(3, NRAT(1)), 6, IVAL)
                    IF (IVAL .NE. 0) GO TO 10
                  END IF
                  CALL GEN048 (-1, IFG(1, NRAT(3)), 7, IVAL)
                  IF (IVAL .NE. 0) THEN
                    CALL GEN048 (-1, IFG(3, NRAT(3)), 6, IVAL)
                    IF (IVAL .NE. 0) GO TO 10
                  END IF
                  IF (SA .GT. 0.01 .AND. FN(2) .GT. 0.007) THEN
                    IF (RATIO .GT. 1.5) THEN
                      M7 = M7 + 30
                      IF (IDAR2 .EQ. 0) THEN
                        WRITE (NQ3, 99999, IOSTAT = IOST) A
                        WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _73x
                        CALL PLA231 (-(700 + M7), 2, RATIO, RATIO, NQ3,
     1                    NQ4)
                        WRITE (LINE, 99994, IOSTAT = IOST)
     1                    (FN(I), I = 1, 2), (IFL(I)(1:5), I = 1, 3),
     2                    (FN(I), I = 3, 5), N4
                        CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                      END IF
                    END IF
                  END IF
                ELSE
                  IF (IRAT2 + IGAT2 + IDAR2 .EQ. 0) THEN
                    M7 = M7 + 40
                    WRITE (NQ3, 99999, IOSTAT = IOST) A
                    WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _74x
                    CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                    WRITE (LINE, 99994, IOSTAT = IOST)
     1                (FN(I), I = 1, 2), (IFL(I)(1:5), I = 1, 3),
     2                (FN(I), I = 3, 5), N4
                    CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                  END IF
                END IF
              ELSE IF (FN(2) .GT. 0.0 .AND. ABS(A) .LT. 179.95) THEN
                M7 = M7 + 50
                WRITE (NQ3, 99999, IOSTAT = IOST) A
                WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _75x
                CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                WRITE (LINE, 99994, IOSTAT = IOST) (FN(I), I = 1, 2),
     1            (IFL(I)(1:5), I = 1, 3), (FN(I), I = 3, 5), N4
                CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
              END IF
            END IF
          END IF
        ELSE IF (N .EQ. 4) THEN
          NRTORS = NRTORS + 1
          M8 = M7
          CALL PLA050 (NRAT(1), NRAT(2), NRAT(3), 0, A1)
          CALL PLA050 (NRAT(2), NRAT(3), NRAT(4), 0, A2)
          IF (A1 .LT. 170 .AND. A2 .LT. 170) THEN
            CALL PLA053 (NRAT(1), NRAT(2), NRAT(3), NRAT(4), A, SA,
     1                   ISA, NDEC, IER)
            IF (IER .NE. 0) GO TO 10
            SB = MAX (0.0, SA)
            RATIO = ABS(FN(1) - A)
            IF (RATIO .GT. 180.0) RATIO = 360.0 - RATIO
            IF (FN(2) .LE. 0.0 .OR. SA .LE. 0.0) THEN
              M8 = M8 + 20
              RATIO1 = RATIO
            ELSE
              RATIO  = RATIO / SA
              RATIO1 = RATIO
            END IF
            IF (RATIO .GT. 1.0) THEN
              WRITE (NQ3, 99999, IOSTAT = IOST) A
              WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _70x,_72x
              CALL PLA231 (-(700 + M8), 2, RATIO1, RATIO, NQ3, NQ4)
              WRITE (LINE, 99992, IOSTAT = IOST)
     1              (FN(I), I = 1, 2), (IFL(I)(1:4), I = 1, 4),
     2          (FN(I), I = 3, 6), N3
              CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
            END IF
            IF (NPOP .EQ. 4) THEN
              IF (ABS(A) .GT. 0.05 .AND. ABS(A) .LT. 179.95) THEN
                IF (SA .GT. 0.0) THEN
                  IF (FN(2) .GT. 0.0) THEN
                    RATIO  = MIN (9.9, MAX (FN(2) / SA, SA / FN(2)))
                    IF (RATIO .GT. 1.5) THEN
                      M7 = M7 + 30
                      WRITE (NQ3, 99999, IOSTAT = IOST) A
                      WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _73x
                      CALL PLA231 (-(700 + M7), 2, RATIO, RATIO, NQ3,
     1                             NQ4)
                      WRITE (LINE, 99992, IOSTAT = IOST)
     1                      (FN(I), I = 1, 2), (IFL(I)(1:4), I = 1, 4),
     2                      (FN(I), I = 3, 6), N3
                      CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                    END IF
                  ELSE
                    IF (IRAT2 + IDAR2 + IGAT2 .EQ. 0) THEN
                      M7 = M7 + 40
                      WRITE (NQ3, 99999, IOSTAT = IOST) A
                      WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _74x
                      CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                      WRITE (LINE, 99992, IOSTAT = IOST)
     1                      (FN(I), I = 1, 2), (IFL(I)(1:4), I = 1, 4),
     2                      (FN(I), I = 3, 6), N3
                      CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                    END IF
                  END IF
                ELSE IF (FN(2) .GT. 0.0) THEN
                  M7 = M7 + 50
                  WRITE (NQ3, 99999, IOSTAT = IOST) A
                  WRITE (NQ4, 99999, IOSTAT = IOST) SB
C * ALERT _75x
                  CALL PLA231 (-(700 + M7), 2, 1.0, 1.0, NQ3, NQ4)
                  WRITE (LINE, 99992, IOSTAT = IOST)
     1                  (FN(I), I = 1, 2), (IFL(I)(1:4), I = 1, 4),
     2                  (FN(I), I = 3, 6), N3
                  CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
                END IF
              END IF
            END IF
          ELSE
            WRITE (LINE, 99996, IOSTAT = IOST) N3
C * ALERT _710
            CALL PLA231 (-710, 0, -999.0, 0.0, LINE(1:7), ' ')
            WRITE (LINE, 99991, IOSTAT = IOST)
     1            (IFL(I)(1:4), I = 1, 4), (FN(I), I = 1, 6)
            CALL PLA231 (0, 0, 0.0, 0.0, LINE, ' ')
          END IF
        END IF
      END DO
   20 IF (IGBL(94) .EQ. 0) THEN
        IF (IGBL(97) .EQ. 1) THEN
C * ALERT _760
          IF (NRTORS .EQ. 0) CALL PLA231 (760, 1, -999.0, 1.0, ' ', ' ')
          IF (IPR(484) .GT. 0) THEN
C * ALERT _761
            IF (NBHAT .EQ. 0) CALL PLA231 (761, 0, 1.0, 1.0, ' ', ' ')
C * ALERT _762
            IF (NAHAT .EQ. 0) CALL PLA231 (762, 0, 1.0, 1.0, ' ', ' ')
          END IF
        END IF
      END IF
      CALL GEN108 (LU11, 0)
99999 FORMAT (F7.2)
99998 FORMAT (F7.4)
99997 FORMAT (F7.5)
99996 FORMAT (I5, 2X)
99995 FORMAT (20X, 4A)
99994 FORMAT (2F7.2, 2(A, '-'), A, 3F8.3, 6X, '#', 6X, I5)
99993 FORMAT (2F7.5, A, '-', A, 2F8.3, 16X, '#', 6X, I5)
99992 FORMAT (2F7.2, 3(A, '-'), A, 4F8.3, 3X, I5)
99991 FORMAT (12X, 3(A, '-'), A, F8.2, F6.2, 4F8.3)
99990 FORMAT (F7.4, F7.5, A, '-', A, 2F8.3)
99989 FORMAT (14X, 2(A, '-'), A, 3F8.3, 10X, F8.2, ' Deg.')
      RETURN
      END SUBROUTINE PLA272
      SUBROUTINE PLA273 (MODE, LU, CODE, NS, IT1, IT2, IT3, IER)
      COMMON /PL273/ NSCIF(4, 192), NSCF
      DIMENSION B(12)
      CHARACTER A*80
C * HANDLE/STORE EXPLICIT SYMMETRY CODES IN CIF
      IER = 0
      IF (MODE .EQ. 0) THEN
        NSCF = 0
        CALL GEN108 (LU, 0)
        DO
          READ (LU, END = 10) A
          IF (A(1:4) .EQ. 'SYMM') THEN
            CALL SGSM (A, 0, B, 0, 22, IER)
            IF (IER .NE. 0) RETURN
            IF (NSCF .LT. 192) THEN
              NSCF = NSCF + 1
              DO I = 1, 4
                NSCIF(I, NSCF) = NINT (B(I + 8))
              END DO
            ELSE
              IER = 1
              GO TO 10
            END IF
          END IF
        END DO
      ELSE IF (MODE .EQ. 1) THEN
        M0 =  INT (CODE) * 1000
        M  = NINT (CODE  * 1000.0)
        IF (M .EQ. M0) THEN
          M    = M + 555
          CODE = M / 1000.0
        END IF
        IF (M .NE. 1555) THEN
          MS      = M  / 1000
          IF (MS .LE. 0 .OR. MS .GT. NSCF) THEN
            IER = 1
            RETURN
          END IF
          M  = M  - MS * 1000
          M1 = M  / 100
          M  = M  - M1 * 100
          M1 = M1 - 5
          M2 = M  / 10
          M3 = M  - M2 * 10 - 5
          M2 = M2 - 5
          NS = NSCIF(1, MS)
          IF (NS .EQ. 0) THEN
            IER = 1
            RETURN
          END IF
          IT1  = M1 + NSCIF(2, MS)
          IT2  = M2 + NSCIF(3, MS)
          IT3  = M3 + NSCIF(4, MS)
        END IF
      ELSE IF (MODE .EQ. 2) THEN
        M  = INT(CODE)
        MS = M  / 1000
        M  = M  - MS * 1000
        M1 = M  / 100
        M  = M  - M1 * 100
        M1 = M1 - 5
        M2 = M  / 10
        M3 = M  - M2 * 10 - 5
        M2 = M2 - 5
        DO I = 1, NSCF
          IF (MS .EQ. NSCIF(1, I)) THEN
            NS = I
            IT1 = M1 - NSCIF(2, I)
            IT2 = M2 - NSCIF(3, I)
            IT3 = M3 - NSCIF(4, I)
            RETURN
          END IF
        END DO
        IER = 1
        RETURN
      END IF
   10 RETURN
      END SUBROUTINE PLA273
      SUBROUTINE PLA274
      PARAMETER (NP45=2048)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER ICL*(NP45), ICH*1
      DIMENSION XJX(12)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      IF (IWIN .EQ. 1) THEN
        VRT = VERT - 0.2
        CALL GGIP (HORS, VERT, 0.0, 1)
        OPEN (LU61, FILE = 'srcsrc', STATUS = 'UNKNOWN')
        CALL SGSM (ICL, 0, XJX, LU61, 2, IERR)
        CALL GEN108 (LU61, 0)
        DO
          READ (LU61, 99999, IOSTAT = IOST) ICL(1:80)
          IF (IOST .NE. 0) EXIT
          IF (VRT - 0.5 .LT. 0.0) THEN
            CALL PLA013 (1, 1)
            ICH = IGGT(1:1)
            CALL GGIP (HORS, VERT, 0.0, 1)
            IF (ICH .NE. 'Y' .AND. ICH .NE. '!') EXIT
            VRT = VERT
          END IF
          VRT = VRT - 0.5
          CALL GGIP09 (0.0, ICL, 80, 0.35, 1, 2, 1.0, VRT)
        END DO
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        CALL PLA297 (0)
      ELSE
        CALL SGSM (ICL, 0, XJX, LU6, 2, IERR)
      END IF
      RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA274
      SUBROUTINE PLA278 (NP, XP, LU)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DIMENSION XP(3, 12), V1(3), V2(3), D(3), DM(20), IH(3)
      CHARACTER LINE*80, POLY*11
C * PROGRAM TO CALCULATE POLYHEDRAL VOLUMES AND DISTORTION PARAMETERS
C * ORIGINAL PROGRAM BY L. W. FINGER,  9/21/71
      SUM = 0.0
      DO I = 1, NP
        YUNK  = XP(1, I)**2 + XP(2, I)**2 + XP(3, I)**2
        SUM   = SUM + YUNK
        DM(I) = SQRT (YUNK)
      END DO
      VOL    = 0.0
      SUMTH  = 0.0
      SUMTH2 = 0.0
      NA     = 0
      DO I = 1, NP - 2
        IH(1) = I
        DO J = I + 1, NP - 1
          IH(2) = J
          DO K = 1, 3
            V1(K) = XP(K, J) - XP(K, I)
          END DO
          DO 10 K = J + 1, NP
            IH(3) = K
            DO N = 1, 3
              V2(N) = XP(N, K) - XP(N, I)
            END DO
            CALL GEN008 (V1, V2, D, 0)
            AREA = SQRT(GEN009 (D, D)) / 2.0
            Z0   = 0.5 * (XP(1, I) * D(1) + XP(2, I) * D(2)
     1           + XP(3, I) * D(3)) / AREA
            IF (ABS(Z0) .GE. 0.0025) THEN
              FACTOR = 3.0
              DO L = 1, NP
                IF (L .NE. I .AND. L .NE. J .AND. L .NE. K) THEN
                  Z = 0.5 * ((XP(1, I) - XP(1, L)) * D(1)
     1              + (XP(2, I) - XP(2, L)) * D(2)
     2              + (XP(3, I) - XP(3, L)) * D(3)) / AREA
                  IF (Z * Z0 .LT. -0.001) GO TO 10
                  IF (ABS(Z * Z0) .LT. 0.001) THEN
                    FACTOR = 6.0
                  END IF
                END IF
              END DO
              VOL = VOL + AREA * ABS(Z0) / FACTOR
              DO L = 1, 2
                NM = IH(L)
                DO M = L + 1, 3
                  MN   = IH(M)
                  TEMP = 0.0
                  DO N = 1, 3
                    TEMP = TEMP + XP(N, NM) * XP(N, MN)
                  END DO
                  TEMP   = TEMP / (DM(NM) * DM(MN))
                  TEMP   = 57.2958 * ATAN2(SQRT(ABS(1.0 - TEMP * TEMP)),
     1                   TEMP)
                  SUMTH  = SUMTH  + TEMP
                  SUMTH2 = SUMTH2 + TEMP**2
                END DO
              END DO
              NA = NA + 3
            END IF
   10     CONTINUE
        END DO
      END DO
      IF (NP .EQ. 6) THEN
        CONS  = 0.75
        CONS2 = 90.0
        POLY  = 'Octahedral '
      ELSE IF (NP .EQ. 4) THEN
        CONS  = 9.0 * SQRT(3.0) / 8.0
        CONS2 = 109.45
        POLY  = 'Tetrahedral'
      ELSE
        CALL PLA262 (2)
        WRITE (LU, 99998, IOSTAT = IOST) VOL
        GO TO 20
      END IF
      IF (VOL .GT. 1.0) THEN
        VLO    = EXP (2.0 * ALOG (CONS * VOL) / 3.0)
        QE     = SUM / (NP * VLO)
        NA     = (NA + 1) / 2
        SUMTH2 = SUMTH2 / 2
        SUMTH  = SUMTH / 2
        SIGA   = (SUMTH2 - 2.0 * CONS2 * SUMTH + NA * CONS2**2)
     1         / (NA - 1)
        CALL PLA262 (2)
        WRITE (LU, 99999, IOSTAT = IOST) POLY, VOL, QE, SIGA
        IF (IWIN .EQ. 1) THEN
          VRT = 3.9
          HRT = HORS / 2.0 + 2.0
          WRITE (LINE, 99997, IOSTAT = IOST) POLY
          CALL GGIP09 (0.0, LINE, 40, 0.35, 1, 1, HRT, VRT)
          VRT = VRT - 0.5
          WRITE (LINE, 99996, IOSTAT = IOST) VOL
          CALL GGIP09 (0.0, LINE, 40, 0.35, 1, 1, HRT, VRT)
          VRT = VRT - 0.5
          WRITE (LINE, 99995, IOSTAT = IOST) QE
          CALL GGIP09 (0.0, LINE, 40, 0.35, 1, 1, HRT, VRT)
          VRT = VRT - 0.5
          WRITE (LINE, 99994, IOSTAT = IOST) SIGA
          CALL GGIP09 (0.0, LINE, 40, 0.35, 1, 1, HRT, VRT)
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
   20 RETURN
99999 FORMAT(/, A, ' Volume', F7.3,
     1          ' Ang**3, Quadratic Elongation', F7.3,
     2          ', Angle Variance', F7.2, ' Deg**2',
     3          ' [K.Robinson +, Science 1971,172,567-570]')
99998 FORMAT (/, 'Polyhedral Volume', F7.3, ' Ang**3')
99997 FORMAT (A)
99996 FORMAT ('Volume', 14X, F7.3, ' Ang**3')
99995 FORMAT ('Quadratic Elongation', F7.3)
99994 FORMAT ('Angle Variance', 6X, F7.2, ' Deg**2')
      END SUBROUTINE PLA278
      SUBROUTINE PLA279
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP47=9,NP54=42,NP56=30,NREC=12)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /PL119/ TWM(3, 3, 5), IHKLR(3, 5), IHKLD(3, 5), SCL, IADR,
     1 NREF, NTW(5), DRVAL(5), NADR, HMAX, KMAX, LMAX, MTWIN(10), NTWIN,
     2 BASFM(5), NFRQ(5), ALPHA(5), NTW0(5), ICALT, NSEL
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON // IDATA(2, NP23), VOID(NVD)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CGRAPH/ GRAPH(44)
      CHARACTER GRAPH*125
      COMMON /REFLCELL/ RCELL(6)
      COMMON /COMPCELL/ CELLA(7), CELLB(7), RCELLA(7), RCELLB(7),
     1 TRNSA(3, 3), TRNSB(3, 3), NSYMHA, NSYMHB, NREF1, NREF2
      COMMON /SPGRNAME/ SPGRNAM
      CHARACTER SPGRNAM*11
      COMMON /COMPSPGR/ SPGRA, SPGRB
      CHARACTER SPGRA*11, SPGRB*11
      CHARACTER IDM*80
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CENTRY*75
      IGBL(1) = 4
      IF (IGBL(19) .EQ. 2) THEN
        NREFM    = NP23 / 2
        PAR(440) = 1000.0
        CALL PLA017
        IGBL(6) = 34
        IWIN    = IGBL(25) * IGBL(32)
        OPEN (LU60, FILE = FILENAMES(1),  STATUS = 'UNKNOWN')
        OPEN (LU61, FILE = 'COMPAREFILE', STATUS = 'UNKNOWN')
        CALL PLA010 (LU60)
        IDTYP1       = IGBL(9)
        IGBL(54)     = 1
        IENTRY(1, 3) = - IDTYP1
        IENTRY(1, 4) = 0
        NREF1        = 0
        CALL PLA134 (LU6, LU60, LU61, NREF1)
        CLOSE (UNIT = LU60)
        REWIND LU61
        IF (IDTYP1 .EQ. 1) THEN
          CALL GEN026 (1, AA, RCELL)
          CALL GEN003 (AA, BB, DET, 0)
          CALL GEN113 (RCELL, CELLA, 6)
          CELLA(7) = SQRT (DET)
          PAR(98)  = CELLA(7)
          NSYMHA   = IPR(255)
          SPGRA    = SPGRNAM
          CALL PLA202 (1)
          CALL GEN113 (PAR(123), RCELLA, 7)
          RCELLA(7) = PAR(99)
          CALL GEN005 (TRNS, TRNSA)
        END IF
        N     = NVD
        NRF1  = 0
        NREF1 = MIN (NREF1, NREFM)
        DO I = 1, NREF1
          READ  (LU61, 99999) (VOID(J), J = N - 4, N)
          IF (VOID(N) .GT. 0.0) THEN
            NRF1 = NRF1 + 1
            N    = N - 5
          END IF
        END DO
        NREF1 = NRF1
        NSET1 = N
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        OPEN (LU60, FILE = FILENAMES(2),  STATUS = 'UNKNOWN')
        OPEN (LU61, FILE = 'COMPAREFILE', STATUS = 'UNKNOWN')
        CALL PLA010 (LU60)
        IDTYP2       = IGBL(9)
        IGBL(54)     = 2
        IENTRY(2, 3) = -IDTYP2
        IENTRY(2, 4) = 0
        NREF2        = 0
        CALL PLA134 (LU6, LU60, LU61, NREF2)
        CLOSE (UNIT = LU60)
        REWIND LU61
        IF (IDTYP2 .EQ. 1) THEN
          CALL GEN026 (1, AA, RCELL)
          CALL GEN003 (AA, BB, DET, 0)
          CALL GEN113 (RCELL, CELLB, 6)
          CELLB(7) = SQRT (DET)
          PAR(98)  = CELLB(7)
          NSYMHB   = IPR(255)
          SPGRB    = SPGRNAM
          CALL PLA202 (1)
          CALL GEN113 (PAR(123), RCELLB, 6)
          RCELLB(7) = PAR(99)
          CALL GEN005 (TRNS, TRNSB)
        END IF
        NRF2  = 0
        NREF2 = MIN (NREF2, NREFM)
        DO I = 1, NREF2
          READ  (LU61, 99999) (VOID(J), J = N - 4, N)
          IF (VOID(N) .GT. 0.0) THEN
            NRF2 = NRF2 + 1
            N    = N - 5
          END IF
        END DO
        NREF2 = NRF2
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        NTOT = NREF1 + NREF2
   10   DO I = 1, 2
          IF (I .EQ. 1) THEN
            IDM = 'SPGR '//SPGRA
            CALL SGSM (IDM, 0, XJX, 0, 0, IERR)
            CALL GEN052 (TRNSA, TM1)
            NSYMH = NSYMHA
            JMAX  = NREF1
            N     = NVD
            M     = 0
          ELSE
            IDM = 'SPGR '//SPGRB
            CALL SGSM (IDM, 0, XJX, 0, 0, IERR)
            CALL GEN052 (TRNSB, TM1)
            NSYMH = NSYMHB
            JMAX  = NREF2
            N     = NVD - NREF1 * 5
            M     = NREF1
          END IF
          DO J = 1, JMAX
            N  = N - 5
            DO K = 1, 3
              XJX(K) = VOID(N + K)
            END DO
            IF (IPR(657) .EQ. 0) THEN
              IHKLM = NINT(XJX(3)) * 62500 + NINT(XJX(2)) * 250
     1              + NINT(XJX(1))
            ELSE
              IHKLM = 0
              DO NS = 1, NSYMH
                CALL SGSM (IDM, NS, XJX, 0, 5, IERR)
                CALL GEN002 (1, TM1, XJX(7), V2, DUMMY)
                IHKL = NINT(V2(3)) * 62500 + NINT(V2(2)) * 250
     1              + NINT(V2(1))
                IHKLM = MAX (IHKLM, IHKL, -IHKL)
              END DO
            END IF
            IDATA (1, M + J) = IHKLM
            IDATA (2, M + J) = N + 1
          END DO
        END DO
        CALL GEN037 (IDATA, 1, NTOT)
        NREF = 0
        M    = 0
        SUMT = 0.0
        SUMB = 0.0
        IDAT1 = IDATA (1, 1)
        DO I = 2, NTOT
          IDAT2 = IDATA (1, I)
          IF (IDAT1 .EQ. IDAT2) THEN
            JDAT1 = IDATA (2, I - 1)
            JDAT2 = IDATA (2, I)
            IF (JDAT2 .GT. NSET1) CALL GEN014 (JDAT1, JDAT2)
            VOID (M + 4) = MAX (0.0, VOID (JDAT1 + 3)) / 100.0
            VOID (M + 5) = MAX (0.0, VOID (JDAT2 + 3)) / 100.0
            VOID (M + 6) = MAX (0.0, VOID (JDAT1 + 4)) / 100.0
            VOID (M + 7) = MAX (0.0, VOID (JDAT2 + 4)) / 100.0
            SUMT         = SUMT + VOID(M + 4)
            SUMB         = SUMB + VOID(M + 5)
            NREF         = NREF + 1
            M            = M    + NREC
          ELSE
            IDAT1 = IDAT2
          END IF
        END DO
        SCALE = SUMT / SUMB
        NADR  = M
        M = 0
        DO I = 1, NREF
          VOID (M + 5) = VOID (M + 5) * SCALE
          VOID (M + 7) = VOID (M + 7) * SCALE
          VOID (NADR + I) = (VOID(M + 4) - VOID(M + 5)) /
     1                 SQRT(VOID(M + 6)**2 + VOID(M + 7)**2)
          M = M + NREC
        END DO
        CALL GEN116 (2, VOID(NADR + 1), VOID(NADR + NREF + 1), NREF,
     1    GRAPH, 0)
        IPR(633) = 1
        NOPT     = 1
   20   IF (NREF1 .GT. 0 .AND. NREF2 .GT. 0) THEN
          IF (NOPT .EQ. 0) THEN
            CALL PLA204
          ELSE IF (NOPT .EQ. 1) THEN
            CALL PLA119 (1, SCALE, IDTYP1, IDTYP2, LU6)
            IF (IGBL(3) .EQ. 47) RETURN
          END IF
          DO
   30       CALL PLA013 (0, 1)
            IF (LRET .EQ. 2) GO TO 20
            CALL GEN020 (1, IGGT, 1, 10)
            SELECT CASE (IGGT(1:4))
              CASE ('END ')
                RETURN
              CASE ('EXIT')
                RETURN
              CASE ('PLOT')
                GO TO 20
              CASE ('!   ')
                 GO TO 20
              CASE ('NPP ')
                NOPT = 0
                GO TO 20
              CASE ('SCAT')
                NOPT = 1
                GO TO 20
              CASE ('LOGL')
                IPR(633) = 1
                IPR(634) = 0
                NOPT     = 1
                GO TO 20
              CASE ('LINE')
                IPR(633) = 0
                IPR(634) = 0
                GO TO 20
              CASE ('STAN')
                GO TO 30
              CASE ('REDU')
                IPR(657) = MOD(IPR(657) + 1, 2)
                GO TO 10
            END SELECT
          END DO
        END IF
      END IF
      RETURN
99999 FORMAT (3F4.0, 2F8.0)
      END SUBROUTINE PLA279
      SUBROUTINE PLA280 (STR)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER STR*(*)
      LENM = MIN (80, LEN(STR))
      IGGT = STR(1:LENM)
      RETURN
      END SUBROUTINE PLA280
      SUBROUTINE PLA281 (MODE, NQ, MSUBST)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP36=3000,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /ALIASES/ ALAB(NP36), BLAB(NP36)
      CHARACTER ALAB*7, BLAB*7, NQ*7
      MSUBST = 0
      NALIAS = IPR(683)
      IF (NALIAS .GT. 0) THEN
        CALL GEN020 (-1, NQ, 2, 2)
        IF (MODE .EQ. -1) THEN
          DO I = 1, NALIAS
            IF (BLAB(I) .EQ. NQ) THEN
              NQ     = ALAB(I)
              MSUBST = MODE
              EXIT
            END IF
          END DO
        ELSE IF (MODE .EQ. 1) THEN
          DO I = 1, NALIAS
            IF (ALAB(I) .EQ. NQ) THEN
              NQ     = BLAB(I)
              MSUBST = MODE
              EXIT
            END IF
          END DO
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA281
      SUBROUTINE PLA282 (N, NQA, NQB, LU)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP36=3000,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /ALIASES/ ALAB(NP36), BLAB(NP36)
      CHARACTER ALAB*7, BLAB*7, NQA*7, NQB*7, NQ1*7, NQ2*7
      NQ1 = NQA
      NQ2 = NQB
      CALL GEN020 (-1, NQ1, 2, 2)
      ALAB(N) = NQ1
      BLAB(N) = NQ2
      M  = INDEX (NQ1//' ', ' ')
      IF (M .GT. 7) THEN
        IPR(684) = IPR(684) + 1
        IF (IPR(684) .EQ. 1) WRITE (LU, 99999)
        WRITE (LU, 99998) NQ1, NQ2
      END IF
99999 FORMAT (//, ':: ALIASES substituted for ATOM labels that',
     1 ' are unsuitable for PLATON/CheckCIF', /, 78('='))
99998 FORMAT (':: ', A, ' ======> ', A, 2X, 'No BackSubstitution')
      RETURN
      END SUBROUTINE PLA282
      SUBROUTINE PLA283 (MODE, MZ, N, CDUM)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      DIMENSION IENSS(NP10)
      CHARACTER JDM*(NP52), CDUM*(NP52)
      XKZ = 0.0
      KZ  = 0
      N = NP52 + 1
      IF (MODE .NE. 0) THEN
        KB = MODE
        KE = MODE
      ELSE IF (MODE .EQ. 0) THEN
        KB = 4
        KE = IPR(488)
      END IF
      DO K0 = KB, KE
        K1 = KB + KE - K0
        IMODE = 0
        DO I = 1, IAN
          IF (IEN(I) .EQ. 2) THEN
            IF (CONT(I, K1) .GT. 0.001) THEN
              IMODE = 1
              GO TO 20
            END IF
          END IF
        END DO
   20   CALL GEN123 (IMODE, IEN, IENSS, IEL, IAN)
        N0 = NP52 + 1
        DO I = 1, IAN
          K = IENSS(IAN + 1 - I)
          IF (LMT(K, 1) .NE. 'Cg') THEN
            CKK1 = CONT(K, K1)
            IF (CKK1 .GT. 0.001) THEN
              M = NINT(CKK1 / MZ)
              IF (ABS (M * MZ - CKK1) .GT. MZ * PAR(331)) THEN
                CKK1 = CKK1 / MZ
                INTT = INT(CKK1 * 1000.0 + 0.01)
                MINT = MOD (INTT, 10)
                IF (MINT .GT. 4) INTT = INTT + 10 - MINT
                INTTA = INTT / 1000
                INTTB = MOD (INTT, 1000) / 10
                WRITE (NQ1, 99998, IOSTAT = IOST) INTTA, INTTB
                IF (CKK1 .LT. 10.0) THEN
                  IP = 4
                ELSE IF (CKK1 .LT. 100.0) THEN
                  IP = 5
                ELSE
                  IP = 6
                END IF
                N0 = N0 - IP
                JDM(N0:N0 + IP - 1) = NQ1 (8 - IP:7)
              ELSE
                IP = 0
                IF (M .GT. 1) THEN
                  CALL GEN040 (M, NQ1, IP)
                  N0 = N0 - IP
                  JDM(N0:N0 + IP - 1) = NQ1(1:IP)
                END IF
              END IF
              N0 = N0 - 1
              JDM(N0:N0) = LMT(K, 1)(2:2)
              IF (LMT(K, 1)(1:1) .NE. CHAR(32)) THEN
                N0 = N0 - 1
                JDM(N0:N0) = LMT(K, 1)(1:1)
              END IF
              N0         = N0 - 1
              JDM(N0:N0) = CHAR(32)
            END IF
          END IF
        END DO
        IF (N0 .LT. NP52 + 1) THEN
          IF (JDM(N0:N0) .EQ. CHAR(32)) N0 = N0 + 1
        END IF
        IF (MODE .EQ. 0) THEN
          XKZ = CONT(NP10 + 1, K1) * 2 / IPR(260)
          KZ  = NINT(CONT(NP10 + 1, K1) * 2) / IPR(260)
          IF (ABS(XKZ - KZ) .GT. 0.0015 * KZ) THEN
            KZ = 0
          END IF
          IF (KZ .NE. 2) THEN
            IF (N .EQ. 1) GO TO 60
            N = N - 1
            CDUM(N:N) = ')'
          END IF
        END IF
        DO N1 = N0, NP52
          N2 = NP52 + N0 - N1
          IF (N .EQ. 1) GO TO 60
          N  = N  - 1
          CDUM(N:N) = JDM(N2:N2)
        END DO
        IF (MODE .EQ. 0) THEN
          IP0 = 1
          IF (KZ .NE. 2) THEN
            IF (KZ .EQ. 0) THEN
              IP = 6
              IF (XKZ / 2.0 .LT. 10.0) IP0 = 2
              WRITE (NQ1(1:IP), 99999, IOSTAT = IOST) XKZ / 2.0
              IF (NQ1(5:6) .EQ. '00') THEN
                IP = 4
              ELSE IF (NQ1(6:6) .EQ. '0') THEN
                IP = 5
              END IF
            ELSE IF (MOD(KZ, 2) .EQ. 1) THEN
              IP = 3
              WRITE (NQ1(1:IP), 99997, IOSTAT = IOST)
     1         (KZ + 0.00001) / 2.0
            ELSE
              KZZ = KZ / 2
              CALL GEN040 (KZZ, NQ1, IP)
            END IF
            IF (N .LT. IP + 2) GO TO 60
            N = N - 1
            CDUM(N:N) = '('
            CDUM(N - IP + IP0 - 1:N - 1) = NQ1(IP0:IP)
            N = N - IP + IP0 - 1
          END IF
          IF (K0 .NE. KE) THEN
            IF (N .LE. 2) GO TO 60
            N = N - 1
            CDUM(N:N) = CHAR(32)
            N = N - 1
            CDUM(N:N) = ','
          END IF
        END IF
      END DO
      IF (N .GT. 1) CALL GEN038 (CDUM, 1, N - 1)
      IF (IOST .NE. 0) RETURN
   60 RETURN
99999 FORMAT (F6.3)
99998 FORMAT (I4, '.', I2.2)
99997 FORMAT (F3.1)
      END SUBROUTINE PLA283
      SUBROUTINE PLA284 (MORT, JID)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
C ******************************************************************
C * STRAIN TENSOR CALCULATION PROGRAM FROM TWO SETS OF CELL PARAMETERS
C * VERSION 1 (1972). CODED BY Y.OHASHI, GEOPHYSICAL LABORATORY,
C * CARNEGIE INSTITUTION C OF WASHINGTON. ADAPTED FOR PLATON 2014
C ******************************************************************
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PL266A/ CELAB(2, 6), VCAB(2, 6), ICV(2), TEMPAB(2)
      COMMON /PL266B/ C(12), VC(2, 6), QI(3, 3), Q(3, 3), FO(13),
     1 DC(3, 3), S(13), RAD
      DIMENSION E(3, 3), EVL(3), EVC(3, 3), AN(3), DUM(3,3)
      CHARACTER JID*(*), IZ*1, IAX(6)*2, LINE*80, TXT1*70, TXT2*70,
     1 TXT3(2)*54
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      DIMENSION YUNK (3, 3)
      DATA IAX /
     1 '+X', '+Y', '+Z', '+A', '+B', '+C'/
      TXT1 = 'Axis      Strain  Unit Strain (* 1000000)   Angle With'
      TXT2 =
     1'                                     +A         +B         +C'
      TXT3(1) =
     1 'x//a, z//c*, z//y^x (Dunitz p237)'
      TXT3(2) =
     1 'z//c, x//a*, y//z^x (Hazen & Finger, Comp.Cryst.Chem.)'
      PAGET = 'STRAIN'
      RAD   = RGBL(6)
      MORTH = - IABS(MORT)
      DO MODE = 1, 2
        IF (MODE .EQ. 1) THEN
          LU = LU6
        ELSE
          LU = LU7
          CALL PLA262 (0)
          CALL GGIP (HORS, VERT, 0.0, 1)
          CALL PLA110 (HORS, VERT, -1)
          CALL GGIP (0.0, 0.0, 0.0, 6)
          BCD = 'Strain Analysis'//CHAR(0)
          CALL GGIP09 (0.0,  BCD, 15, 1.4, 4, 8, 4.0, VERT - 1.8)
          CALL GGIP09 (0.0,  BCD, 15, 1.4, 2, 8, 3.8, VERT - 1.9)
        END IF
        WRITE (LU, 99999, IOSTAT = IOST) JID, TXT3(MORT)
        DO K = 1, 2
          WRITE (LINE, 99998, IOSTAT = IOST)
     1      NINT(TEMPAB(K)), (CELAB(K, I), I = 1, 6)
          WRITE (LU, 99983, IOSTAT = IOST) LINE(1:78)
          IF (MODE .EQ. 2) THEN
            IF (K .EQ. 1) THEN
              VRT = VERT - 3.0
              CALL GGIP09 (0.0, 'Cell Parameters - Orth: '//TXT3(MORT),
     1                     78, 0.37, 5 + IGBL(68), 2, 1.0, VRT)
            END IF
            VRT = VRT - 1.0
            CALL GGIP09 (0.0, LINE, 78, 0.3, 1, 2, 1.0, VRT)
          END IF
          IF (ICV(K) .EQ. 1) THEN
            WRITE (LINE, 99986, IOSTAT = IOST) (VCAB(K, J), J = 1, 6)
            WRITE (LU, 99983, IOSTAT = IOST) LINE(1:78)
            IF (MODE .EQ. 2) THEN
              VRT = VRT - 1.0
              CALL GGIP09 (0.0, LINE, 78, 0.3, 1, 2, 1.0, VRT)
            END IF
          END IF
        END DO
        DO I = 1, 3
          C(I)     = CELAB(1, I)
          C(I + 3) = COS(CELAB(1, I + 3) / RAD)
          C(I + 6) = CELAB(2, I)
          C(I + 9) = COS(CELAB(2, I + 3) / RAD)
        END DO
        DO I = 1, 2
          IF (ICV(I) .EQ. 1) THEN
            DO J = 1, 3
              VC(I, J + 3) = (VCAB(I, J + 3) / RAD)**2
              VC(I, J)     = VCAB(I, J)**2
            END DO
          END IF
        END DO
        DTEM = TEMPAB(2) - TEMPAB(1)
        CALL GEN044 (C(1), DC, MORTH)
        CALL GEN005 (DC, Q)
        CALL GEN003 (Q, QI, DET, 0)
        CALL GEN044 (C(7), Q, MORTH)
        CALL GEN005 (Q, YUNK)
        CALL GEN052 (YUNK, Q)
        CALL GEN004 (QI, Q, E)
        DO I = 1, 3
          E(I, I) = E(I, I) - 1.0
        END DO
        WRITE (LU, 99981, IOSTAT = IOST)
     1    NINT(TEMPAB(1)), NINT(TEMPAB(2)), ((DC(I, J), J = 1, 3),
     2    (Q(J, I),  J = 1, 3), (E(I, J) * 1.0E+6, J = 1, 3), I = 1, 3)
        DO I = 1, 3
          DO J = 1, 3
            DC(I, J) = DC(I, J) / C(J)
          END DO
        END DO
        DO I = 1, 3
          DO J = I, 3
            E(I, J) = 0.5 * (E(I, J) + E(J, I))
            E(J, I) = E(I, J)
          END DO
        END DO
        DO K = 1, 2
          IF (K .EQ. 1) THEN
            WRITE (LU, 99992, IOSTAT = IOST) '     '
          ELSE
            WRITE (LU, 99992, IOSTAT = IOST) 'Unit '
          END IF
          WRITE (LU, 99982, IOSTAT = IOST)
          DO I = 1, 3
            DO J = 1, 3
              AN(J) = RAD * ACOS(DC(I, J))
            END DO
            IF (K .EQ. 1) THEN
              WRITE (LU, 99991, IOSTAT = IOST)
     1          IAX(I), AN, (E(I, J) * 1.0E+6, J = 1, 3)
            ELSE
              WRITE (LU, 99980, IOSTAT = IOST)
     1        IAX(I), AN, (E(I, J) * 1.0E+6 / DTEM, J = 1, 3)
            END IF
          END DO
        END DO
        CALL GEN024 (E, EVC, EVL, DUM)
        WRITE (LU, 99993, IOSTAT = IOST)
        DO I = 1, 3
          DO J = 1, 3
            AN(J) = RAD * ACOS(EVC(I, J))
          END DO
          RHO = AN(3)
          PHI = ATAN2(EVC(I, 2), EVC(I, 1))
          IF (EVC(I, 3) .LT. 0.0) THEN
            IZ   = '-'
            TEMP = TAN((180.0 - RHO) / (2.0 * RAD)) * 100.0
          ELSE
            IZ   = '+'
            TEMP = TAN(RHO / (2.0 * RAD)) * 100.0
          END IF
          PX  = TEMP * COS(PHI)
          PY  = TEMP * SIN(PHI)
          PHI = PHI  * RAD
          EX  = EVL(I) / DTEM
          WRITE (LU, 99996, IOSTAT = IOST)
     1      I, EVL(I)*1.0E+6, EX*1.0E+6, AN, RHO, PHI, PX, PY, IZ
        END DO
        WRITE (LU, 99988, IOSTAT = IOST)
        DO K = 1, 3
          DO J = 1, 3
            AN(J) = ACOS(DC(J, K)) * RAD
          END DO
          RHO = AN(3)
          PHI = ATAN2(DC(2, K), DC(1, K))
          IF (DC(3, K) .LT. 0.0) THEN
            IZ   = '-'
            TEMP = TAN((180.0 - RHO) / (2.0 * RAD)) * 100.0
          ELSE
            IZ   = '+'
            TEMP = TAN(RHO / (2.0 * RAD)) * 100.0
          END IF
          PX  = TEMP * COS(PHI)
          PY  = TEMP * SIN(PHI)
          PHI = PHI * RAD
          WRITE (LU, 99990, IOSTAT = IOST)
     1      IAX(3 + K), AN, RHO, PHI, PX, PY, IZ
        END DO
        IF (MODE .EQ. 2) CALL PLA262 (0)
        WRITE (LU, 99994, IOSTAT = IOST) TXT1, TXT2
        IF (MODE .EQ. 2) THEN
          VRT = VRT - 2.0
          CALL GGIP09 (0.0, TXT1, 70, 0.3, 5 + IGBL(68), 2, 1.0, VRT)
          VRT = VRT - 1.0
          CALL GGIP09 (0.0, TXT2, 70, 0.3, 5 + IGBL(68), 2, 1.0, VRT)
        END IF
        DO I = 1, 3
          DO J = 1, 3
            TEMP = 0.0
            DO K = 1, 3
              TEMP = TEMP + EVC(I, K) * DC(K, J)
            END DO
            FO(3 * J + I) = ACOS(TEMP)
          END DO
          FO(I) = EVL(I)
        END DO
        TEMP   = EVL(1) + EVL(2) + EVL(3)
        FO(13) = TEMP
        ITEMP  = ICV(1) + ICV(2)
        IF (ITEMP .NE. 0) CALL PLA285 (MORTH)
        DO I = 1, 3
          DO J = 1, 3
            AN(J) = RAD * FO(3 * J + I)
          END DO
          TEMP  = EVL(I) / DTEM
          TEMP1 = S(I)   / DTEM
          WRITE (LINE, 99995, IOSTAT = IOST)
     1      I, EVL(I) * 1.0E+6, TEMP * 1.0E+6, (AN(J), J = 1, 3)
          WRITE (LU, 99983, IOSTAT = IOST) LINE
          IF (MODE .EQ. 2) THEN
            VRT = VRT - 1.0
            CALL GGIP09 (0.0, LINE, 78, 0.3, 1, 2, 1.0, VRT)
          END IF
          IF (ITEMP .NE. 0) THEN
            WRITE (LINE, 99997, IOSTAT = IOST)
     1        S(I) * 1.0E+6, TEMP1 * 1.0E+6, (S(3 * J + I), J = 1, 3)
            WRITE (LU, 99983, IOSTAT = IOST) LINE
            IF (MODE .EQ. 2) THEN
              VRT = VRT - 1.0
              CALL GGIP09 (0.0, LINE, 78, 0.3, 1, 2, 1.0, VRT)
            END IF
          END IF
        END DO
        TEMP  = FO(13) / DTEM
        TEMP1 = S(13)  / DTEM
        WRITE (LU, 99987, IOSTAT = IOST)
     1   FO(13) * 1.0E+6, S(13) * 1.0E+6, TEMP * 1.0E+6, TEMP1 * 1.0E+6
        IF (MODE .EQ. 2) THEN
          IF (MORT .EQ. 1) THEN
            CALL PLA262 (0)
            WRITE (LU, 99985, IOSTAT = IOST)
          END IF
          CALL PLA013 (0, 1)
        END IF
      END DO
      RETURN
99999 FORMAT ('Titl: ', A, /, 'Cell Parameters - Orth: ', A, /,
     1  78('='))
99998 FORMAT ('At', I6, 'C:', 6(F11.5))
99997 FORMAT (6X, '(', F9.2, ')  (', F9.4, ')',
     1        3(4X, '(', F5.2, ')'))
99996 FORMAT (2X, I1, F13.2, F11.4, 3F6.1, 2X, F5.1,
     1        F7.1, 2F7.1, 4X, A)
99995 FORMAT (2X, I1, F13.2, F13.4, 3(F11.2))
99994 FORMAT (/, A, /, 78('='), /, A)
99993 FORMAT (/, 'Strain Ellipsoid (Strain values multiplied by 10^6)',
     1 /, 51('='), /, 'Axis', 6X,
     1 'Strain', 2X, 'Unit Strain', 4X, 'Angle With', 6X,
     2 'Rho', 4X, 'Phi', 1X, 'Proj.X Proj.Y Hemi', /, 78('='), /,
     3 31X, '+X', 4X, '+Y', 4X, '+Z')
99992 FORMAT (/, 'Angles Between XYZ and ABC Systems', 5X, A,
     1           'Strain Tensor * 10^6 Based on XYZ')
99991 FORMAT (A, 1X, 3F9.2, 10X, '(', 3F9.2, ')')
99990 FORMAT (A, '-Axis', 20X, 3F6.1, F7.1, F7.1, 2F7.1, 4X, A)
99988 FORMAT (/, 'Crystallographic Axes', /, 78('='))
99987 FORMAT (/, 'Volume * 1000000', 1X, F10.2, '(', F10.2, ')', /,
     1            '(Unit Vol)', 7X, F10.4, '(', F10.4, ')', /)
99986 FORMAT (11X, 6(2X, '(', F7.5, ')'))
99985 FORMAT ('Explanation of the Printout', //, 'See:', /,
     1'Y.Ohashi & C.W. Burnham (1973). Amer. Mineralogist, 58, 843-849'/
     2'R.M. Hazen & L.W. Finger (1982). Comparative Crystal Chemistry,'/
     3'Wiley & Sons, Chapter #5.', /,
     4'**************************************************************'//
     5'1. ABC and XYZ coordinate systems:', /,
     6'   Direction of principle axis of strain ellipsoid is given in',/
     7'   terms of two coordinate systems. A,B and C are the', /
     8'   crystallographic axes and can be oblique. X,Y and Z are', /,
     9'   orthogonal axes set up in the program. angular relations,', /,
     *'   between ABC and XYZ systems are printed.', //,
     1'2. Dimensions of strain and unit strain:', /,
     2'   Strain is dimensionless (change in length original length),',/
     3'   and unit strain is (strain per unit change of temperature', /,
     4'   or composition)', //,
     5'3. Polar coordinates and stereographic projection coordinates:',/
     6'   System XYZ is used for stereo projection axes with Z', /,
     7'   being the azimuthal axis.', /,
     8'   RHO is an azimuthal angle and PHI is a longitudinal angle,', /
     9'   Thus X(RHO=90, PHI=0), Y(RHO=90, PHI=90) and Z(RHO=0).', /,
     *'   Proj.X and Proj.Y are projected components on a stereo-', /,
     1'   graphic projection plane and scaled as RADIUS=100.', /,
     2'   + and - denote upper and lower hemispheres respectively.', //,
     3'   To obtain stereographic projection of principle axes and', /,
     4'   also of crystallographic axes, plot Proj.X and Proj.Y on', /,
     5'   graph paper and draw a circle with radius 100.')
99983 FORMAT (A)
99982 FORMAT (77('='), /, 9X, '+A', 7X, '+B', 7X, '+C')
99981 FORMAT (/, 'Orth.', I9, 'C', 19X, I4, 'C', 14X,
     1 'Asymmetric Tensor * 10^6', /, 78('='),
     2 3(/, '(', 3F7.3, ') (', 3F7.3, ')  (', 3F9.2, ')'))
99980 FORMAT (A, 1X, 3F9.2, 10X, '(', 3F9.4, ')')
      END SUBROUTINE PLA284
      SUBROUTINE PLA285  (MORTH)
      COMMON /PL266A/ CELAB(2, 6), VCAB(2, 6), ICV(2), TEMPAB(2)
      COMMON /PL266B/ C(12), VC(2, 6), QI(3, 3), Q(3, 3), FO(13),
     1 DC(3, 3), S(13), RAD
      DIMENSION F(13), D(12, 13), A(3, 3), B(3, 3), XX(3), VV(3, 3),
     1 R(3, 3), E(3, 3), DUM(3, 3), YUNK(3, 3)
      DO I = 1, 2
        DO J = 1, 6
          IJ = (I - 1) * 6 + J
          IF (VC(I, J) .LE. 1.E-10) THEN
            DO K = 1, 13
              D(IJ, K) = 0.0
            END DO
          ELSE
            DEL = 0.1 * SQRT(VC(I, J))
            IF (J .LE. 3) THEN
              C(IJ) = C(IJ) + DEL
            ELSE
              C(IJ) = COS(ACOS(C(IJ)) + DEL)
            END IF
            IF (I. EQ. 1) THEN
              CALL GEN044 (C(1), R, MORTH)
              CALL GEN005 (R, DUM)
              CALL GEN003 (DUM, A, DET, 0)
              CALL GEN052 (Q, B)
              DO II = 1, 3
                DO JJ = 1, 3
                  R(II, JJ) = R(II, JJ) / C(JJ)
                END DO
              END DO
            ELSE
              CALL GEN044 (C(7), B, MORTH)
              CALL GEN005 (B, YUNK)
              CALL GEN052 (YUNK, B)
              CALL GEN052 (QI, A)
              CALL GEN052 (DC, R)
            END IF
            CALL GEN004 (A, B, E)
            DO L = 1, 3
              E(L, L) = E(L, L) - 1.0
            END DO
            DO L = 1, 3
              DO N = L, 3
                E(L, N) = 0.5 * (E(L, N) + E(N, L))
                E(N, L) = E(L, N)
              END DO
            END DO
            CALL GEN024 (E, VV, XX, DUM)
            DO L = 1, 3
              F(L) = XX(L)
              DO N = 1, 3
                TEMP = 0.0
                DO K = 1, 3
                  TEMP = TEMP + VV(L, K) * R(K, N)
                END DO
                F(3 * N + L) = ACOS(TEMP)
              END DO
            END DO
            F(13) = F(1) + F(2) + F(3)
            DO K = 1, 13
              D(IJ, K) = (F(K) - FO(K)) / DEL
            END DO
            IF (J .LE. 3) THEN
              C(IJ) = C(IJ) - DEL
            ELSE
              C(IJ) = COS(ACOS(C(IJ)) - DEL)
            END IF
          END IF
        END DO
      END DO
      CALL GEN074 (S, 1, 13, 0.0)
      DO I = 1, 2
        L = 6 * (I - 1)
        IF (ICV(I) .EQ. 1) THEN
          DO K = 1, 13
            TEMP = 0.0
            DO IP = 1, 6
              LP   = L + IP
              TEMP = TEMP + D(LP, K)**2 * VC(I, IP)
            END DO
            S(K) = S(K) + TEMP
          END DO
        END IF
      END DO
      DO K = 1, 3
        S(K) = SQRT(S(K))
      END DO
      DO K = 4, 12
        S(K) = RAD * SQRT(S(K))
      END DO
      S(13) = SQRT(S(13))
      RETURN
      END SUBROUTINE PLA285
      SUBROUTINE PLA286
      PARAMETER (NP12=700,NP13=550,NP17=99, NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      LOGICAL EXST16
      IF (ABS(IGBL(8)) .EQ. 3 .OR.
     1    EXTENS(1:3) .EQ. 'fcf' .OR. EXTENS(1:3) .EQ. 'FCF') THEN
        KNM16    = KNMFIL + 4
        FNLU16   = NAMEFIL(1:KNMFIL)//'.fcf'
        RDTYPE   = 'FCF'
        IGBL(15) = 1
        INQUIRE (FILE = FNLU16, EXIST = EXST16)
        IF (.NOT. EXST16) THEN
          FNLU16   = NAMEFIL(1:KNMFIL) //'.FCF'
          INQUIRE (FILE = FNLU16, EXIST = EXST16)
          IF (.NOT. EXST16) THEN
            RDTYPE = 'HKL'
            FNLU16 = NAMEFIL(1:KNMFIL) //'.hkl'
            INQUIRE (FILE = FNLU16, EXIST = EXST16)
            IF (.NOT. EXST16) THEN
              FNLU16 = NAMEFIL(1:KNMFIL) //'.HKL'
              INQUIRE (FILE = FNLU16, EXIST = EXST16)
              IF (.NOT. EXST16) IGBL(15) = -1
            END IF
          END IF
        END IF
      ELSE
        FNLU16 = NAMEFIL(1:KNMFIL) //'.hkl'
        RDTYPE = 'HKL'
        KNM16  = KNMFIL + 4
        INQUIRE (FILE = FNLU16, EXIST = EXST16)
        IF (.NOT. EXST16) THEN
          FNLU16 = NAMEFIL(1:KNMFIL) //'.HKL'
          INQUIRE (FILE = FNLU16, EXIST = EXST16)
          IF (.NOT. EXST16) THEN
            KNM16  = KNMFIL + 4
            FNLU16 = NAMEFIL(1:KNMFIL) //'.fcf'
            RDTYPE = 'FCF'
            INQUIRE (FILE = FNLU16, EXIST = EXST16)
            IF (.NOT. EXST16) THEN
              FNLU16 = NAMEFIL(1:KNMFIL) //'.FCF'
              INQUIRE (FILE = FNLU16, EXIST = EXST16)
              IF (.NOT. EXST16) IGBL(15) = -1
            END IF
          END IF
        END IF
      END IF
      IGBL(29) = 0
C * OPEN & DETERMINE REFLECTION FILE TYPE
      IF (IGBL(15) .GE. 0) THEN
        OPEN (UNIT = LU16, FILE = FNLU16, STATUS = 'OLD', IOSTAT = IOST)
        IF (IOST .NE. 0) RETURN
        CALL PLA010 (LU16)
        IF (IABS(IGBL(8)) .EQ. 2) THEN
          IF (IABS(IGBL(9)) .EQ. 0) THEN
            IGBL(29) = -1
          ELSE IF (IABS(IGBL(9)) .EQ. 1) THEN
            IGBL(29) = -2
          END IF
        ELSE IF (IABS(IGBL(8)) .EQ. 3) THEN
          IF (IABS(IGBL(9)) .EQ. 1) THEN
            IGBL(29) = 1
          ELSE IF (IABS(IGBL(9)) .EQ. 23) THEN
            IGBL(29) = 2
          ELSE IF (IABS(IGBL(9)) .EQ. 25) THEN
            IGBL(29) = 3
          END IF
        END IF
      ENDIF
      RETURN
      END SUBROUTINE PLA286
      SUBROUTINE PLA287 (MODE1, MODE2, MODE3)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      CALL PLA066
      IF (IPR(2) .NE. 0) RETURN
      IF (MODE2 .NE. 0) THEN
        CALL PLA072 (-1, 1)
      END IF
      IF (IPR(85) .EQ. 0) THEN
        CALL PLA024
      END IF
      IF (MODE1 .NE. 0) CALL PLA023 (MODE3)
      RETURN
      END SUBROUTINE PLA287
      SUBROUTINE PLA288 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50, NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NVD=100000000,
     2 NP22=287,NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,
     3 NP45=2048,NP47=9,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
C * DEFINE BOND
      DASH = 1.0
      NFN  = 0
      NCG  = 0
      DO I = 2, IPR(220)
        IF (IFL(I) .EQ. 'DASH') THEN
          DASH = -1.0
        ELSE IF (IFL(I) .EQ. 'NODASH') THEN
          DASH = 2.0
        ELSE IF (IFL(I) .EQ. 'LDASH') THEN
          DASH = -2.0
        ELSE IF (IFL(I) .EQ. 'TO') THEN
          NCG  = 1
          IPR(64) = IPR(64) + 1
          ICGA = IPR(39) + IPR(64)
          DO J = 1, 6
            XXO(ICGA, J) = 0.0
            XSD(ICGA, J) = 0.0
          END DO
        ELSE
          CALL PLA046 (4, IFL(I), IENM, LBB, LBC, LBD,
     1                 INQNR, JNQNR, NIEN)
          IF (NIEN .LT. 0) THEN
            CALL PLA015 (0, 28)
            GO TO 10
          END IF
          NFN       = NFN + 1
          IATC(NFN) = NIEN
        END IF
      END DO
      DO J = 2, NFN
        CALL PLA100 (IATC(1), IATC(J), MODE, DASH)
        IF (NCG .EQ. 1) THEN
          DO K = 1, 6
            XXO(ICGA, K) =  XXO(ICGA, K) + XXO(IATC(J), K)
            XSD(ICGA, K) =  XSD(ICGA, K) + XSD(IATC(J), K)
          END DO
        END IF
      END DO
      IF (NCG .EQ. 1) THEN
        DO K = 1, 3
          IFG(K, ICGA) = IFG(K, IATC(2))
        END DO
        CALL GEN040 (IPR(64), NQ2, IP)
        NQ1(1:7)      = 'CG     '
        NQ1(3:2 + IP) = NQ2(1:IP)
        CALL PLA046 (1, NQ1, IENM, LBB, LBC, LBD,
     1               INQNR, JNQNR, NIEN)
        LABA(ICGA) = INQNR
        DO K = 1, 6
          XXO(ICGA, K) = XXO(ICGA, K) / (NFN - 1)
          XSD(ICGA, K) = XSD(ICGA, K) / ((NFN - 1)**2)
          VOID((IPR(39) + IPR(64) - 1) * (NP4 + 15) + K) =
     1              XXO(ICGA, K)
          VOID((IPR(39) + IPR(64) - 1) * (NP4 + 15) + K + 6) =
     1              XSD(ICGA, K)
        END DO
        WRITE (LU6, 99999, IOSTAT = IOST)
     1    NQ1, (XXO(ICGA, K), K = 1, 6), (SQRT(XSD(ICGA, K)), K = 1, 6)
        WRITE (LU7, 99999, IOSTAT = IOST)
     1    NQ1, (XXO(ICGA, K), K = 1, 6), (SQRT(XSD(ICGA, K)), K = 1, 6)
        CALL PLA100 (IATC(1), ICGA, 1, -1.0)
      END IF
   10 RETURN
99999 FORMAT (/, ':: ', A, 6F10.5, /, 10X, 6F10.5)
      END SUBROUTINE PLA288
      SUBROUTINE PLA289 (X, Y, R, N)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      RT0 = RGBL(5) / N
      CALL GGIP (X + R, Y, 0.0, 3)
      DO I = 1, N
        XGGIP = X + R * COS(I * RT0)
        YGGIP = Y + R * SIN(I * RT0)
        CALL GGIP (XGGIP, YGGIP, 0.0, 2)
      END DO
      CALL GGIP (0.0, 0.0, 0.0, 3)
      RETURN
      END SUBROUTINE PLA289
      SUBROUTINE PLA290 (MODE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PL290/ TPMTDM, TOMTCM
      IF (MODE .EQ. 0) THEN
        TPMTDM = 0.0
        TOMTCM = 0.0
      ELSE
        WRITE (LU6, 99999, IOSTAT = IOST)
     1    TPMTDM, PAR(77), TOMTCM, PAR(78)
        WRITE (LU7, 99999, IOSTAT = IOST)
     1    TPMTDM, PAR(77), TOMTCM, PAR(78)
      END IF
      RETURN
99999 FORMAT (/, ':: Max(TPRIM - TDIFF) and Default:', 2F10.3,
     1        /, ':: Max(THobs - THcal) and Default:', 2F10.3, /)
      END SUBROUTINE PLA290
      SUBROUTINE PLA291 (TPRIM, TDIFF, THETA, THHKL, ITEST)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER PRBUF*132
      COMMON /PL290/ TPMTDM, TOMTCM
      ITEST  = 0
      TPMTD  = ABS (TPRIM - TDIFF)
      TOMTC  = ABS (THETA - THHKL)
      TPMTDM = MAX (TPMTDM, TPMTD)
      TOMTCM = MAX (TOMTCM, TOMTC)
      IF (TPMTD .GT. PAR(77) .OR. TOMTC .GT. PAR(78)) THEN
        IF (IPR(363) .EQ. 1) THEN
          BACKSPACE LU16
          READ (LU16, 99998, IOSTAT = IOST) PRBUF
          WRITE (LU6, 99999, IOSTAT = IOST)
     1      TPRIM, TDIFF, THETA, THHKL, PRBUF(1:80)
          WRITE (LU7, 99999, IOSTAT = IOST)
     1      TPRIM, TDIFF, THETA, THHKL, PRBUF(1:80)
          ITEST = 1
        END IF
      END IF
      RETURN
99999 FORMAT (/, ':: Bad Direction Cosines:', 4F9.4, ' for:', /, A, //,
     1 ':: Check Cell Dimensions/Transformation and Wavelength !!', //,
     2 ':: The First  number [i.e. dot product H.P (reversed)] and', /,
     3 ':: The Second number [i.e. dot product H.S] should be equal',/,
     4 ':: The Third  number [i.e. Theta(Calc)from Dir.Cos.] and', /,
     5 ':: The Fourth number [i.e. Theta(obs) from Cell Dimensions]',/,
     6 '::                    should be equal within error',//,
     7 ':: Check may be overruled with NOCHECK option (DANGEROUS)', //)
99998 FORMAT (A)
      END SUBROUTINE PLA291
      SUBROUTINE PLA292
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      CHARACTER FNLU2*80, FILEN*80
      LOGICAL OPEND
C * FILE OPEN
      IF (IGBL(31) .EQ. IPR(437)) THEN
        WRITE (LU2, 99999, IOSTAT = IOST)
      ELSE
        IPR(437) = IGBL(31)
        SELECT CASE (IPR(437))
          CASE (-3)
            FNLU2 = NAMEFIL(1:KNMFIL)//'_sx.ins'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (-2)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.res'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (-1)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.res'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (1)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.ome'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
            IPR(438) = 1
          CASE (3)
            FNLU2   = NAMEFIL(1:KNMFIL)//'_p.spf'
            IGBL(2) = IGBL(2) + 1
            INQUIRE (UNIT = LU2, OPENED = OPEND)
C * WORK-AROUND FOR SALFORD-COMPILER
            FILEN = ' '
            IF (OPEND) THEN
              INQUIRE (UNIT = LU2, NAME = FILEN)
            END IF
            IF (OPEND .AND. FILEN .NE. 'UNDEFINED') THEN
              WRITE (LU2, 99999, IOSTAT = IOST)
            ELSE
              OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
            END IF
          CASE (4)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.que'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (5)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.par'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (6)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.res'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (7)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.pdb'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (8)
            FNLU2 = NAMEFIL(1:KNMFIL)//'_acc.cif'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
            IPR(438) = 1
          CASE (10)
            IF (IPR(663) .EQ. 0) THEN
              FNLU2 = NAMEFIL(1:KNMFIL)//'_sqd.sqz'
            ELSE
              FNLU2 = NAMEFIL(1:KNMFIL)//'_sq.sqz'
            END IF
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
          CASE (11)
            FNLU2 = NAMEFIL(1:KNMFIL)//'.dif'
            OPEN (UNIT = LU2, FILE = FNLU2, STATUS = 'UNKNOWN')
        END SELECT
        IF (IGBL(2) .LE. 1) THEN
           REWIND (UNIT = LU2, IOSTAT = IOST)
           IF (IOST .NE. 0) CALL GEN148 (LU2, 1)
        END IF
      END IF
      RETURN
99999 FORMAT ('ENDS')
      END SUBROUTINE PLA292
      SUBROUTINE PLA293 (WAVEL)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /DEFWL/ STWL(4)
      COMMON /DEFCWL/ CSTWL
      CHARACTER CSTWL(4)*4
      WL = WAVEL
      IF (WL .LE. 0.0) THEN
        WL       = STWL(3)
        IPR(493) = -2
        KRAD     = CSTWL(3)
      ELSE
        IF (IABS(IPR(493)) .EQ. 6) THEN
          KRAD = 'neut'
        ELSE IF (IPR(493) .EQ. 0) THEN
          IPR(493) = 5
          KRAD     = 'SYNC'
          DO I = 1, 4
            IF (ABS(WL - STWL(5 - I)) .LT. PAR(63)) THEN
              IPR(493) =  I
              KRAD     = CSTWL(5 - I)
              EXIT
            END IF
          END DO
        END IF
      END IF
      PAR(17) = WL
      IF (PAR(168) .GT. 0.0) THEN
        PAR(287) = SIN (PAR(168) / RGBL(6)) / PAR(17)
      END IF
      RETURN
      END SUBROUTINE PLA293
      SUBROUTINE PLA294 (MODE)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      INTEGER FINDEXE
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      IGBL(70) = 0
      IF (MODE .EQ. 1) THEN
        IF (SPGRNM(1)(13:13) .NE. ' ') THEN
          CLOSE (UNIT = LU2, IOSTAT = IOST)
          IGBL(31) = 4
          IPR(437) = 0
          CALL PLA292
          IF (INDEX (KRSYST(2), 'tri') .NE. 0) THEN
            LINE = 'Hexagonal'
          ELSE
            LINE = KRSYST(2)
          END IF
          CALL GEN020 (1, LINE, 1, 12)
          WRITE (LU2, 99998, IOSTAT = IOST)
     1      SPGRNM(1)(13:13), LINE(1:12), (PAR(100 + I), I = 1, 6),
     2      PAR(28)
          WRITE (LU2, 99999, IOSTAT = IOST)
        ELSE
          BCD = 'No SPGR info Given ...'//CHAR(0)
          CALL GGIP (-999.0, 2.0, 30.0, 111)
          RETURN
        END IF
      ELSE
        WRITE (LU2, 99997, IOSTAT = IOST)
        NRES = IPR(75)
        IF (NRES .GT. 1) THEN
          DO I = 2, NRES
            IF (RCONT(NRES) .GE. IPR(487)) THEN
              WRITE (LU2, 99996, IOSTAT = IOST) I
            END IF
          END DO
        END IF
        WRITE (LU2, '(1X)', IOSTAT = IOST)
      END IF
      CLOSE (UNIT = LU2, IOSTAT = IOST)
C * FIND CONQUEST (cqbatch)
      CALL GEN038 (CGETENV, 1, 80)
      NE = FINDEXE ('QUESTEXE', CGETENV, 'cqbatch')
      IF (NE .GT. 0) THEN
        CGETENV(NE + 1:) =
     1' -j cqbatch -rerun '//NAMEFIL(1:KNMFIL)//'.que'//' -export cif'
        KERR = 0
        CALL SPAWN (CGETENV, KERR)
        NENT = 0
        OPEN (LU61, FILE = 'cqbatch.cif', STATUS = 'UNKNOWN',
     1        IOSTAT = IOK)
        IF (IOK .EQ. 0) THEN
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_cq.cif',
     1              STATUS = 'UNKNOWN')
          DO
            READ (LU61, 99995, IOSTAT = IOST) LINE
            IF (IOST .NE. 0) EXIT
            WRITE (LU62, 99995, IOSTAT = IOST) LINE
            IF (LINE(1:12) .EQ. 'data_CSD_CIF') NENT = NENT + 1
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          CLOSE (UNIT = LU62)
          BCD = 'Number of Hits =      '//CHAR(0)
          WRITE (BCD(17:21), 99994, IOSTAT = IOST) NENT
          CALL GGIP (-999.0, 2.0, 30.0, 111)
          IF (IGBL(80) * NENT .GT. 0) THEN
            KERR = 0
            CALL SPAWN
     1      (PLAPATH(1:IGBL(80))//' -a '//NAMEFIL(1:KNMFIL)//'_cq.cif',
     2      KERR)
          END IF
          OPEN (UNIT = LU61, FILE = 'cqbatch.cqs', STATUS = 'UNKNOWN',
     1      IOSTAT = IOST)
          IF (IOST .EQ. 0) CLOSE (LU61, STATUS = 'DELETE')
          OPEN (UNIT = LU61, FILE = NAMEFIL(1:KNMFIL)//'_cq.eld',
     1      IOSTAT = IOST)
          IF (IOST .EQ. 0) CLOSE (LU61, STATUS = 'DELETE')
          OPEN (UNIT = LU61, FILE = NAMEFIL(1:KNMFIL)//'_cq.lis',
     1      IOSTAT = IOST)
          IF (IOST .EQ. 0) CLOSE (LU61, STATUS = 'DELETE')
        END IF
      ELSE
        CALL PLA015 (0, 9)
      END IF
      RETURN
99999 FORMAT ('QUESTION T1')
99998 FORMAT ('SAVE 3', /, 'T1 *', A, 'CELL ', A, 3F9.3, 3F7.2, F6.3)
99997 FORMAT ('QUESTION T1', $)
99996 FORMAT (' .OR. T', I1, $)
99995 FORMAT (A)
99994 FORMAT (I5)
      END SUBROUTINE PLA294
      SUBROUTINE PLA295
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP10=16,
     1 NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP25=99,NP29=63,
     2 NP38=150,NP39=30,NP41=200,NP47=9,NP56=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      KN   = IPR(221)
      NMOL = IPR(53)
      IF (KN .GT. 0) THEN
        DO 10 I = 1, KN
          NS = INT(ABS(FN(I)) / 1000.0)
          IF (NS .LE. IPR(48)) THEN
            MLS = NINT(FN(I) * PAR(42))
            IF (NINT(FN(I)) * NINT(PAR(42)) .EQ. MLS) THEN
              IF (MLS .GT. 0) THEN
                MLS = MLS + 1
              ELSE
                MLS = MLS - 1
              END IF
            END IF
            IF (NMOL .GT. 0) THEN
              DO J = 1, NMOL
                IF (IABS(MLS) .EQ. MOLS(J)) THEN
                  IF (MLS .GT. 0) THEN
                    GO TO 10
                  ELSE
                    IF (J . LT. NMOL) THEN
                      DO K = J + 1, NMOL
                        MOLS(K - 1) = MOLS(K)
                      END DO
                    END IF
                    NMOL = NMOL - 1
                    GO TO 10
                  END IF
                END IF
              END DO
            END IF
            NMOL       = NMOL + 1
            MOLS(NMOL) = MLS
          END IF
   10   CONTINUE
      END IF
      IPR(53) = NMOL
      DO I = 1, IPR(53)
        MOL(I) = MOLS(I)
      END DO
      IPR(13) = IPR(53)
      IF (IPR(17) .NE. 0) THEN
        IPR(17) = 0
        CALL PLA087
      END IF
      IPR(39) = IPR(37)
      CALL PLA071 (-1)
      CALL PLA024
      CALL PLA043 (0, -2, LU6, 0)
      IPR(201) = 0
      IPR(64)  = 0
      RETURN
      END SUBROUTINE PLA295
      SUBROUTINE PLA296 (LU, LINE)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER LINE*(*)
      IF (LU .NE. 0) THEN
        WRITE (LU, 99999, IOSTAT = IOST) LINE
      ELSE
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA296
      SUBROUTINE PLA297 (MODE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CALL PLA013 (2, 5)
      IF (IGGT(1:4) .EQ. 'PLOT') THEN
        IF (MODE .EQ. 2) IGGT(1:4) = 'CALC'
      END IF
      IF (IGGT(1:4) .NE. 'CALC') CALL GEN038 (IGGT, 1, 80)
      IF (MODE .EQ. 1) THEN
        IF (IGBL(6) .EQ. 10) THEN
          CALL PLA280 ('!')
        ELSE
          CALL PLA280 ('PLOT')
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA297
      SUBROUTINE PLA298 (MODE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER LIJN*80
      IF (MODE .EQ. 1) THEN
        LU = LU65
        OPEN (UNIT = LU, FILE = 'valid.chk',  STATUS = 'UNKNOWN')
      ELSE IF (MODE .EQ. 2) THEN
        LU = LU65
        OPEN (UNIT = LU, FILE = 'tm/sg/valid/valid.chk',
     1        STATUS = 'UNKNOWN')
      ELSE
        LU       = LU10
        IGBL(83) = 0
        CALL GEN108 (LU, 0)
      END IF
      N     = 0
      ISAVE = 0
      IGBL6SAVE = IGBL(6)
      IGBL(6)   = 0
      DO
        VRT   = 19.4
        BCD(1:11) = 'VALIDATION'//CHAR(0)
        CALL GGIP (HORS, VERT, 0.0, 1)
        N    = N + 1
        IF (N .EQ. 1) THEN
          LIJN = 'VALIDATION REPORT FOR CURRENT CIF'
          CALL GGIP09 (0.0, LIJN, 33, 0.375, 5 + IGBL(68), 2, 7.0,
     1                 VRT - 0.6)
          VRT = VRT - 0.6
        END IF
   10   IF (ISAVE .EQ. 0) THEN
          READ (LU, 99999, IOSTAT = IOST) LIJN
          IF (IOST .NE. 0) THEN
            CALL PLA297 (0)
            EXIT
          END IF
          IF (LIJN(80:80) .EQ. '#' .AND. N .NE. 1) THEN
            ISAVE = 1
            GO TO 20
          END IF
        END IF
        ISAVE = 0
        M     = 1
        IF (LIJN(5:9) .EQ. 'ALERT') THEN
          IF (LIJN(13:13) .EQ. 'A' .OR.
     1        LIJN(11:17) .EQ. 'Level_A') THEN
            M = 2
          ELSE IF (LIJN(13:13) .EQ. 'B' .OR.
     1             LIJN(11:17) .EQ. 'Level_B') THEN
            M = 6
          ELSE IF (LIJN(13:13) .EQ. 'C' .OR.
     1             LIJN(11:17) .EQ. 'Level_C') THEN
            M = 5
          END IF
        END IF
        VRT = VRT - 0.5
        CALL GGIP09 (0.0, LIJN, 80, 0.35, M, 2, 1.0, VRT)
        IF (VRT .GT. 0.4) GO TO 10
   20   CALL PLA013 (1, 1)
        IF (IGGT(1:4) .EQ. 'PLOT') GO TO 20
        IF (IGGT(1:4) .EQ. 'CALC' .OR. IGGT(1:1) .EQ. 'Y') CYCLE
        IF (IGGT(1:4) .EQ. 'EXIT') EXIT
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          IF (IGGT(1:1) .EQ. 'N') EXIT
          IF (LRET .EQ. 2) THEN
            CALL GEN108 (LU, 0)
            CYCLE
          END IF
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        END IF
      END DO
      CLOSE (UNIT = LU)
      IGBL(6) = IGBL6SAVE
      RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA298
      SUBROUTINE PLA299 (MODE)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /MAN/ MANUAL(140), PLUMAN(116)
      CHARACTER MANUAL*65, PLUMAN*65
      IF (IWIN .EQ. 1) CALL GGIP (HORS, VERT, 0.0, 1)
      VRT = VERT
      HRT = HORS / 2.0
      IF (MODE .EQ. 1) THEN
        DO I = 1, 135
          WRITE (LU6, 99999, IOSTAT = IOST) MANUAL(I)
        END DO
        IF (IWIN .EQ. 1) THEN
          DO I = 1, 70
            VRT = VRT - 0.25
            CALL GGIP09 (0.0, MANUAL(I), 65, 0.2, 1, 1, 0.2, VRT)
          END DO
          VRT = VERT
          DO I = 71, 135
            VRT = VRT - 0.25
            CALL GGIP09 (0.0, MANUAL(I), 65, 0.2, 1, 1, HRT, VRT)
          END DO
          CALL PLA013 (1, 1)
          IGGT = '!'
        END IF
      ELSE
        DO I = 1, 70
          VRT = VRT - 0.25
          CALL GGIP09 (0.0, PLUMAN(I), 65, 0.2, 1, 1, 0.2, VRT)
        END DO
        IF (IWIN .EQ. 1) THEN
          VRT = VERT
          DO I = 71, 116
            VRT = VRT - 0.25
            CALL GGIP09 (0.0, PLUMAN(I), 65, 0.2, 1, 1, HRT, VRT)
          END DO
          DO I = 1, 116
            WRITE (LU6, 99999, IOSTAT = IOST) PLUMAN(I)
          END DO
          CALL PLA013 (1, 1)
          IGGT = '!'
        END IF
      END IF
      RETURN
99999 FORMAT (A)
      END SUBROUTINE PLA299
      SUBROUTINE PLA300 (M1, M2, M3)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30,NP45=2048,NP46=15,NP52=200,
     2 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER N1*2, N2*2, N3*2
C * GET WEB-PAGE - BROWSER-HTML HELP
      IF (IGBL(47) .GT. 0) THEN
        NA = M1
        NB = M2
        NC = M3
C * CLICK ON CANVAS = AREA #1
        IF (NA .EQ. 1) THEN
          IF (IGBL(6) .GE. 10 .AND. IGBL(6) .LE. 12) THEN
            N1 = '00'
            IF (NC .LT. 0 .OR. NC .GT. NP46) THEN
              NB = 0
              NC = 0
            END IF
          ELSE
            RETURN
          END IF
          WRITE (N2, 99997, IOSTAT = IOST) NB
C * CLICK ON SIDE MENU  = AREA #2
        ELSE IF (NA .EQ. 2) THEN
          WRITE (N1, 99997, IOSTAT = IOST) IGBL(6)
          N2 = '02'
C * CLICK IN AREA #3
        ELSE IF (NA .EQ. 3) THEN
          N1 = '10'
          N2 = '03'
          N3 = '00'
        ELSE IF (NA .EQ. 0) THEN
          WRITE (N1, 99997, IOSTAT = IOST) NB
          N2 = '00'
        END IF
        WRITE (N3, 99997, IOSTAT = IOST) MAX (0, NC)
C * PREPARE URL IN PRBUF
        CALL GETENV ('PLAHTM', LINE)
        WRITE (6, 99999, IOSTAT = IOST) LINE
        WRITE (6, 99999, IOSTAT = IOST) HTTPSERVER
        IF (LINE(1:1) .EQ. ' ') THEN
          PRBUF = 'http://'//HTTPSERVER(1:IGBL(135))//'platon/'
        ELSE
          PRBUF = 'file:'//LINE
        END IF
        NX = 1
        CALL GEN039 (1, PRBUF, 1, 132, NX, NE)
        PRBUF(NE + 1:) = 'pl'//N1//N2//N3//'.html'
C * PREPARE NETSCAPE COMMAND LINE IN CGETENV
        KERR = 0
        CALL SPAWN ('sh -c "rm nsk.x 2> /dev/null" ', KERR)
        NF = IGBL(47)
        IF (NF .GT. 0) THEN
          BROWSER(NF + 1: )  =
     1     ' -remote "openURL('//PRBUF(1:NE + 13)//')" 2> nsk.x'
          KERR = 0
          CALL SPAWN ('sh -c '''//BROWSER(1:NF + NE + 42)//' '' ',
     1      KERR)
          OPEN (UNIT = 66, FILE = 'nsk.x', STATUS = 'UNKNOWN')
          READ (66, 99999, END = 10) ICL(1:80)
          WRITE (LU6, 99999, IOSTAT = IOST) ICL(1:80)
          IF (NA .NE. 0) THEN
            LINE(1:4) = 'HELP'
            CALL GGIP09 (0.0,  LINE, 4,  1.0, 0, 4, HORS - 3.5, 0.3)
            LINE = 'Browser -'
            CALL GGIP09 (0.0,  LINE, 9, 0.5, 0, 3, HORS - 8.8, 0.7)
            LINE = 'Browser STARTUP'
            CALL GGIP09 (0.0,  LINE, 15, 0.5, 2, 3, HORS - 8.8, 0.7)
            CALL GGIP (0.0, 0.0, 0.0, 6)
          ELSE
            WRITE (LU6, 99998, IOSTAT = IOST)
          END IF
          BROWSER(NF + 1:) = ' '//PRBUF(1:NE + 13)//' & '
          WRITE(LU6, 99999, IOSTAT = IOST) BROWSER(1:NF + NE + 17)
          KERR = 0
          CALL SPAWN (BROWSER(1:NF + NE + 17), KERR)
   10     CLOSE (UNIT = 66, STATUS = 'DELETE')
        END IF
      END IF
      RETURN
99999 FORMAT (A)
99998 FORMAT (/, '(Startup) Browser', /)
99997 FORMAT (I2.2)
      END SUBROUTINE PLA300
      SUBROUTINE PLA301
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      PARAMETER (NUMAT=150, NELTS=16, NTOT=1000)
C * STRUCTURE TIDY: Program to standardize structure data.
C * See E. Parthe & L.M. Gelato (1984). Acta Cryst. A40, 169-183
C *     L.M. Gelato & E. Parthe (1987). J. Appl. Cryst. 20, 139-143.
C *     S-Z.Hu & E.Parthe (2004). Chinese J. Struct. Chem. 23, 1150-1160
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM (3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /STBL4/ IPOL, R, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /AT/ IAT, POS(3), IHEX, FNUM
      COMMON /ATCH/ ELT1, ELT2, F
      COMMON /BUR/ NT, SPGR
      COMMON /CH/ XA(3, NUMAT)
      COMMON /LAB/ AX
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1       NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /MESSA/ IW
      COMMON /ORGIN/ NOR, ORGADD(3, 8), NTEXT, ICOORD
      COMMON /PAR/ GMIN
      COMMON /POL/ NPOL, XPOL(3, NTOT), XP(3, NTOT), ORGA(3), SMIN,
     1        KKORD(NUMAT), NAT(NTOT)
      COMMON /POSI/ X(3, 192), DIST(192), KOUNT
      COMMON /RES/ ATOM1, ATOM2, FOCCU, INTXT, CODE, ELT
      COMMON /ROT/ XROT(3, NUMAT), NATOM
      COMMON /SP/ N, NW, NS(26), IS(27), MULT(15), NSET(8), KSET,
     1       MU, KORD
      COMMON /TRANS/ UVW(3, 3), U(9), T(9), P(9)
      COMMON /TRIP/ DMIN, MIN, KORDER(192), IFLAG, XMIN(3, NUMAT),
     1        MUL(NUMAT), LET(NUMAT), NRSET(NUMAT), NNSET(8, NUMAT)
      COMMON /XPOLAR/ IPOLAR, KPOL(3), LOWLET
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      LOGICAL OPEND
      CHARACTER PAGET*8, PAGEIND*8, ELT1*2, ATOM1(NUMAT)*2,
     1 STCSH(17)*14, NT(16)*1, INTEXT*80, ANSR*1, KO*1, INTXT*40,
     2 STAA(107)*11, STBB(39)*15, STTEXT(21)*17, F*5, FOCCU(NUMAT)*5,
     3 AX*47, CODE(2)*1, ELT(NELTS)*2, SPGR*10, SPGP(230)*10,
     4 PSYM(47)*14, FORMS(15)*16, ELT2*4, ATOM2(NUMAT)*4, DAT*50,
     5 XELN(105)*2, LATICE(6)*1, HBR(7)*1, KOORD(12)*8, CHORI(9)*3
      DIMENSION FINXYZ(3, NUMAT), PEAR(NELTS),
     1 SSAVE(3, 3), NSP(NUMAT), ORIG(3), TOTSH(3)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      DIMENSION PL(3), IAR(4), NIGAR1(4), NIGAR2(4)
      DATA IAR /6, 5, 3, 1/
      DATA NIGAR1 /19, 18, 5, 1/
      DATA NIGAR2 /21, 20, 15, 11/
      IF (EXTENS(1:3) .NE. 'sty' .AND. EXTENS(1:3) .NE. 'STY') THEN
        WRITE (LU6, 99964, IOSTAT = IOST)
        WRITE (LU7, 99996, IOSTAT = IOST)
        RETURN
      END IF
      INQUIRE (FILE = NAMEFIL(1:KNMFIL)//'.lis', OPENED = OPEND)
      IF (.NOT. OPEND) THEN
        OPEN (LU7, FILE = NAMEFIL(1:KNMFIL)//'.lis', STATUS = 'UNKNOWN')
      END IF
      OPEN (UNIT = LU21, FILE = NAMEFIL(1:KNMFIL)//'_stidy.spf',
     1 STATUS = 'UNKNOWN')
      OPEN (UNIT = LU60, STATUS = 'SCRATCH', FORM = 'UNFORMATTED')
      OPEN (UNIT = LU61, STATUS = 'SCRATCH', FORM = 'UNFORMATTED')
      OPEN (UNIT = LU63, STATUS = 'SCRATCH')
      OPEN (UNIT = LU64, FILE = NAMEFIL(1:KNMFIL)//'.'//EXTENS(1:KXT),
     1        STATUS = 'UNKNOWN')
      IF (IWIN .EQ. 1) THEN
        BCD = 'Stucture Tidy'//CHAR(0)
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL GGIP09 (0.0,  BCD, 14, 1.0, 4, 6, 7.6, VERT - 1.5)
        CALL GGIP09 (0.0,  BCD, 14, 1.0, 2, 6, 7.5, VERT - 1.6)
        VRT = VERT - 2.0
      END IF
      PAGET = 'STR-TIDY'
      CALL PLA262 (0)
      WRITE (LU7, 99966, IOSTAT = IOST)
      CALL PLA262 (6)
      IMPCEL = 0
      INTXT  = ' '
      J1     = 0
      IBL    = 0
      NIG    = 0
      IC     = 0
      MIX    = 0
      R      = RGBL(6)
      NIGG   = 0
      IFSHIF = 0
      IPOL   = 0
      CALL GEN126 (NT, 1, 16)
      READ (LU64, 99995, IOSTAT=IOST) INTEXT
      IF (IOST .NE. 0) GO TO 70
      CALL GEN020 (1, INTEXT, 1, 16)
      DO J = 1, 80
        IF (INTEXT(J:J) .EQ. '*') THEN
          NIG         = 1
          INTEXT(J:J) = ' '
        ELSE IF (INTEXT(J:J) .EQ. '+') THEN
          IMPCEL      = 1
          INTEXT(J:J) = ' '
        ELSE IF (INTEXT(J:J) .EQ. ' ') THEN
          IF (J1 .NE. 0) THEN
            IBL = IBL + 1
            IF (IBL .EQ. 2) EXIT
            J1     = J1 + 1
            NT(J1) = ' '
          END IF
        ELSE
          J1 = J1 + 1
          IF (J1 .GT. 16) GO TO 70
          NT(J1)      = INTEXT(J:J)
          INTEXT(J:J) = ' '
          IBL         = 0
        END IF
      END DO
      MKORD = 28
      INTXT(1:40) = INTEXT(16:55)
      WRITE (LU7, 99999, IOSTAT = IOST) INTXT, NT
      CALL PLA262 (2)
      IF (IMPCEL .EQ. 1) THEN
        CALL PLA262 (3)
        WRITE (LU7,  99993, IOSTAT = IOST)
        WRITE (LU6,  99993, IOSTAT = IOST)
        WRITE (LU63, 99992, IOSTAT = IOST)
      END IF
      WRITE (LU63, 99991, IOSTAT = IOST) INTXT
      CALL GEN021 (XMAT,  1)
      CALL GEN021 (UVW,   1)
      CALL GEN074 (PLUS,  1, 3, 0.0)
      CALL GEN074 (SH,    1, 3, 0.0)
      CALL GEN074 (PEAR,  1, NELTS, 0.0)
      CALL GEN097 (NRSET, 1, NUMAT, 0)
      CALL GEN126 (FOCCU, 1, NUMAT)
      KO      = ' '
      CODE(1) = ' '
      CODE(2) = ' '
      IPEARS  = 0
      GMIN    = 1000000.0
      PMIN    = 0.0
      VOLRAT  = 0.0
      AX      = 'abc'
      IFSH    = 0
      IFPLUS  = 0
      IFNIG   = 0
      IHEX    = 0
      IOCFL   = 0
      NABC    = 0
      NSH     = 0
      NSHTRA  = 0
      NFL = 0
      IF (IFSHIF .EQ. 1) IFSH = 1
      IF (NIGG   .EQ. 1) NIG  = 1
      READ  (LU64, 99998, IOSTAT = IOST) A, B, C, AL, BE, GA
      IF (IOST .NE. 0) GO TO 70
      CALL PLA262 (1)
      WRITE (LU7, 99997, IOSTAT = IOST) A, B, C, AL, BE, GA
      IER = 0
      CALL PLA302 (NCS, NTRANS, LU7, LU63, IER)
      IF (IER .EQ. 1) THEN
        WRITE (LU6, 99967, IOSTAT = IOST)
        GO TO 80
      END IF
      IF (NSHTRA .GT. 0) THEN
        CALL PLA262 (1)
        WRITE (LU7, 99990, IOSTAT = IOST) STCSH(NSHTRA)
        WRITE (LU6, 99990, IOSTAT = IOST) STCSH(NSHTRA)
      END IF
      IW   = ISETS (1, NGR)
      IROT = ISETS (2, NGR)
      NTIO = ISETS (3, NGR)
      N    = ISETS (4, NGR)
      NW   = ISETS (5, NGR)
      ISH  = ISETS (6, NGR)
      DO J = 1, N
        NS(J) = ISETS(J + 6,     NGR)
        IS(J) = ISETS(J + N + 6, NGR)
      END DO
      DO J = 1, NW
        MULT(J) = ISETS(J + 2 * N + 6, NGR)
      END DO
      IS(N + 1) = NW
      IF (IMPCEL .EQ. 0) THEN
        IF (IW .EQ. 16) THEN
          IF (AL .GT. 0.0 .AND. AL .NE. 90.0) THEN
            CALL PLA262 (1)
            WRITE (LU7, 99989, IOSTAT = IOST) A, AL
            AL   = AL / R
            AH   = 2.0 * A * SIN(0.5 * AL)
            CH   = 1.73205 * A * SQRT(1.0 + 2.0 * COS(AL))
            IHEX = 1
            A    = AH
            C    = CH
            AX   = 'a-b,b-c,a+b+c'
            CALL PLA262 (1)
            WRITE (LU7, 99988, IOSTAT = IOST) A, C
            IFMAT     = 2
            UVW(1, 1) = 1.0
            UVW(1, 2) = 0.0
            UVW(1, 3) = 1.0
            UVW(2, 1) = -1.0
            UVW(2, 2) = 1.0
            UVW(2, 3) = 1.0
            UVW(3, 1) = 0.0
            UVW(3, 2) =-1.0
            UVW(3, 3) = 1.0
            CALL GEN003 (UVW, XMAT, DET, -2)
          END IF
          IF (IFMAT .GT. 0) THEN
            CALL PLA262 (1)
            WRITE (LU7, 99987, IOSTAT = IOST) NGR, SPGR
          END IF
        END IF
      END IF
      VOL  = 0.0
      ALF  = AL / R
      BET  = BE / R
      GAM  = GA / R
      COSB = COS(BET)
      IF (NGR .LE. 2) THEN
        IC   = 1
        COSA = COS(ALF)
        COSG = COS(GAM)
        V = 1.0 - COSA**2 - COSB**2 - COSG**2 + 2.0 * COSA * COSB * COSG
        IF (V .GT. 0.0001) VOL = A * B * C * SQRT(V)
      ELSE
        AL   = 90.0
        GA   = 90.0
        COSA = 0.0
        COSG = 0.0
        ALF  = 90.0 / R
        GAM  = ALF
        IF (NGR .GE. 3 .AND. NGR .LE. 15) THEN
          IC  = 2
          VOL = A * B * C * SIN(BET)
          IF (IMPCEL .EQ. 1) GO TO 10
          IF (BE .LT. 90.0) THEN
            BE    = 180.0 - BE
            BET   = BE / R
            COSB  = - COSB
            IFMAT = 2
            CALL GEN074 (U, 1, 9, 0.0)
            U(1) = -1.0
            U(5) = -1.0
            U(9) =  1.0
            CALL GEN004 (UVW, U, P)
            CALL GEN113 (P, UVW, 9)
            CALL PLA262 (2)
            WRITE (LU7, 99963, IOSTAT = IOST) BE
          END IF
        ELSE
          BE   = 90.0
          COSB = 0.0
          BET  = 90.0 / R
          IF (NGR .GE. 16 .AND. NGR .LE. 74) THEN
            IC  = 3
            VOL = A * B * C
          ELSE
            B = A
            IF (NGR .GE. 75 .AND. NGR .LE. 142) THEN
              IC  = 4
              VOL = A * A * C
            ELSE IF (NGR .GE. 143 .AND. NGR .LE. 194) THEN
              GA   = 120.0
              GAM  = GA / R
              COSG = -0.5
              IC   = 5
              VOL  = 0.86603 * A * A * C
            ELSE IF (NGR .GE. 195) THEN
              C   = A
              IC  = 6
              VOL = A**3
            END IF
          END IF
        END IF
      END IF
      IF (VOL .LT. 0.0001) THEN
        CALL PLA262 (1)
        WRITE (LU7, 99962, IOSTAT = IOST)
        GO TO 80
      END IF
      IF (IMPCEL .EQ. 0) THEN
        IF (IFMAT .EQ. 2) THEN
          CALL GEN003 (UVW, XMAT, DET, -2)
          CALL PLA309 (UVW)
        END IF
        IAT = 0
        IF (NIG .EQ. 1) THEN
          VOL1 = VOL
          ISH  = 0
          IW   = 1
          IROT = 1
          CALL GEN052 (UVW,   SSAVE)
          CALL GEN052 (XMAT, XMSAVE)
          WRITE (LU63, 99986, IOSTAT = IOST)
          IFNIG = 0
          CALL PLA311 (IFNIG)
          IF (IFNIG .EQ. 2) THEN
            CALL GEN003 (UVW, XMAT, DET, -2)
            CALL PLA309 (UVW)
          END IF
          IF (IFMAT .EQ. 1) THEN
            DO J = 1, 3
              DO I = 1, 3
                UVW(I, J) = - UVW(I, J)
              END DO
            END DO
          END IF
          DO I = 1, 3
            DO J = 1, 3
              K    = (I - 1) * 3 + J
              U(K) = UVW(J, I)
              T(K) = SSAVE(J, I)
            END DO
          END DO
          CALL GEN004 (T, U, P)
          CALL PLA309 (P)
          CALL PLA262 (2)
          WRITE (LU7, 99983, IOSTAT = IOST) AX
          CALL PLA320 (ISEQ, LU7)
          CALL PLA262 (5)
          WRITE (LU7, 99982, IOSTAT = IOST) ISEQ, FORMS(IFORM(ISEQ))
          IF (ABS(A - B) .LT. 0.005) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99981, IOSTAT = IOST)
            IF (ABS(A - C) .LT. 0.005) THEN
              CALL PLA262 (4)
              WRITE (LU7, 99980, IOSTAT = IOST)
              WRITE (LU7, 99979, IOSTAT = IOST)
            END IF
          ELSE IF (ABS(B - C) .LT. 0.005) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99980, IOSTAT = IOST)
          ELSE IF (ABS(A - C) .LT. 0.005) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99979, IOSTAT = IOST)
          END IF
          IER = 0
          CALL PLA303 (PEAR, IPEARS, PMIN, KELT, NCS, NTIO, IER)
          IF (IER .EQ. 1) GO TO 80
          IS(N + 1) = NW
          VOL = A * B * C * SQRT(1.0 - COSG**2 - COSB**2 - COSA**2
     1        + 2.0 * COSA * COSB * COSG)
          VOLRAT = VOL / VOL1
          GO TO 40
        END IF
      END IF
   10 CODE(1) = LATICE(IC)
      KO = SPGR(1:1)
      IF (KO .EQ. 'A' .OR. KO .EQ. 'C') KO = 'S'
      CODE(2) = KO
      IF (IMPCEL .EQ. 0) THEN
        IF (IW .NE. 0 .AND. IW .NE. 16) CALL PLA314
        IF (IFMAT .EQ. 2) THEN
          CALL GEN003 (UVW, XMAT, DET, -2)
          CALL PLA309 (UVW)
        END IF
        IF (NSH .GT. 0) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99984, IOSTAT = IOST) STCSH(NSH)
        END IF
        IF (NABC .GT. 0) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99985, IOSTAT = IOST) STCSH(NABC)
        END IF
        IF (IW .EQ. 1) THEN
          IF (ABS(A - B) .LT. 0.005) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99981, IOSTAT = IOST)
            IF (ABS(A - C) .LT. 0.005) THEN
              CALL PLA262 (4)
              WRITE (LU7, 99980, IOSTAT = IOST)
              WRITE (LU7, 99979, IOSTAT = IOST)
            END IF
          ELSE IF (ABS(B - C) .LT. 0.005) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99980, IOSTAT = IOST)
          ELSE IF (ABS(A - C) .LT. 0.005) THEN
            CALL PLA262 (2)
            WRITE(LU7, 99979, IOSTAT = IOST)
          END IF
        END IF
        IF (IFSH .GT. 0) THEN
          DO J = 1, 3
            SH(J) = XSHIFT(J, ISH)
          END DO
          CALL PLA262 (4)
          WRITE (LU7, 99978, IOSTAT = IOST) STCSH(ISH)
        END IF
      END IF
      CALL PLA306 (NGR)
      NATOM = 0
      KELT  = 0
   20 IER = 0
      CALL PLA304 (NIG, IER)
      IF (IER .EQ. 0) THEN
        IF (MIX .NE. 1) THEN
          DO I = 1, 105
            IF (ELT1 .EQ. XELN(I)) EXIT
          END DO
          MIX = 1
        END IF
        CALL PLA322
        KSET = 0
        IF (N .EQ. 0) THEN
          MU   = MULT(1)
          KORD = 1
          CALL PLA262 (1)
          WRITE (LU7, 99977, IOSTAT = IOST) MU, CHAR(97)
        ELSE
          CALL PLA324 (NIG)
        END IF
        IF (KORD .LT. MKORD) MKORD = KORD
        FMU    = FLOAT(MU)
        FNX    = FNUM * FMU
        PMIN   = PMIN + FMU - FNX
        IPEARS = IPEARS + MU
        IF (KELT .GT. 0) THEN
          DO I = 1, KELT
            IF (ELT1 .EQ. ELT(I)) GO TO 30
          END DO
        END IF
        KELT = KELT + 1
        IF (KELT .GT. NELTS) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99976, IOSTAT = IOST) NELTS
          KELT = KELT - 1
        END IF
        ELT(KELT) = ELT1
        I         = KELT
   30   PEAR(I)   = PEAR(I) + FNX
        NATOM     = NATOM + 1
        IF (NATOM .LE. NUMAT) THEN
          KKORD(NATOM) = KORD
          ATOM1(NATOM) = ELT1
          ATOM2(NATOM) = ELT2
          FOCCU(NATOM) = F
          DO J = 1, 3
            XA(J, NATOM) = X(J, 1)
          END DO
          NRSET(NATOM) = KSET
          IF (KSET .GT. 0) THEN
            DO I = 1, KSET
              NNSET(I, NATOM) = NSET(I)
            END DO
          END IF
          GO TO 20
        ELSE
          CALL PLA262 (1)
          WRITE (LU7, 99975, IOSTAT = IOST) NUMAT
          GO TO 80
        END IF
      END IF
      IPOL   = 1
      ICOORD = 0
      IF (NOR .LT. 0) THEN
        IPOL = 0
        DAT  = ' '
        READ (LU64, 99974, IOSTAT = IOST) ANSR, DAT
        IF (IOST .NE. 0) GO TO 80
        WRITE (LU6, 99957, IOSTAT = IOST) ANSR, DAT
        IF (ANSR .EQ. 'N' .or. ANSR .EQ. 'n') THEN
          IF (DAT .EQ. ' ') THEN
            ORGA(1) = 0.0
            ORGA(2) = 0.0
            ORGA(3) = 0.0
          ELSE
            READ (DAT, *) (ORGA(III), III = 1, 3)
          END IF
          IPOL = 1
          NOR  = 1
          DO J = 1, 3
            ORGADD(J, 1) = ORGA(J)
          END DO
          CALL PLA262 (1)
          WRITE (LU7, 99972, IOSTAT = IOST) ORGA
        END IF
      END IF
   40 IF (NOR .LT. 0) THEN
        NOR2   = - NOR
        II     = NOR2 / 10
        NOR    = NOR2 - 10 * II
        ICOORD = II + 1
      END IF
      NSAVE = NOR
      REWIND LU61
      NAGAIN = 0
      KEER   = 1
      IF (IROT .GT. 1 .AND. IROT .LT. 8) KEER = 2
      IF (IROT .EQ. 8) KEER = 4
      KSAVE = KEER
   50 IF (NAGAIN .EQ. 0) THEN
        IF (IROT .LT. 8) THEN
          IF (KEER .EQ. 2) THEN
            NTEXT = 1
          ELSE
            NTEXT = IROT
          END IF
        ELSE IF (IROT .EQ. 18 .OR. IROT .EQ. 19) THEN
          NTEXT = IROT
          IF (KEER .EQ. 2) NTEXT = 1
        ELSE IF (IROT .EQ. 20) THEN
          NTEXT = NIGAR1(KEER)
        ELSE
         NTEXT = IAR(KEER)
        END IF
      ELSE
        IF (NTIO .EQ. 1) THEN
          IF (IROT .LT. 8) THEN
            IF (KEER .EQ. 2) THEN
              NTEXT = 11
            ELSE
              NTEXT = 10 + IROT
            END IF
          ELSE IF (IROT .EQ. 18 .OR. IROT .EQ. 19) THEN
            NTEXT = IROT + 2
            IF (KEER .EQ. 2) NTEXT = 11
          ELSE IF (IROT .EQ. 20) THEN
            NTEXT = NIGAR2(KEER)
          ELSE
            NTEXT = IAR(KEER) + 10
          END IF
        ELSE IF (NTIO .EQ. 2) THEN
          NTEXT = 8
          IF (KEER .EQ. 2) NTEXT = 9
        ELSE IF (NTIO .EQ. 3) THEN
          NTEXT = 10
          IF (KEER .EQ. 2) NTEXT = 17
        ELSE IF (NTIO .EQ. 4) THEN
          NTEXT = 14
        END IF
      END IF
      DO J = 1, 3
        PL(J) = 2 * PLUS(J)
        DO WHILE (PL(J) .GT. 0.99999)
          PL(J) = PL(J) - 1.0
        END DO
      END DO
      IF (NTEXT .GT. 17) CALL GEN113 (SH, SHIF, 3)
      IF (NTEXT .EQ. 1 .OR. NTEXT .GT. 17) THEN
        DO IA = 1, NATOM
          CALL GEN080 (XA, XROT, IA, IA)
        END DO
      ELSE IF (NTEXT .EQ. 2) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 1.0 - XA(1, IA) + PL(1)
          XROT(3, IA) = 1.0 - XA(3, IA) + PL(3)
          XROT(2, IA) = XA(2, IA)
        END DO
      ELSE IF (NTEXT .EQ. 3) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 1.0 - XA(1, IA) + PL(1)
          XROT(2, IA) = 1.0 - XA(2, IA) + PL(2)
          XROT(3, IA) = XA(3, IA)
        END DO
      ELSE IF (NTEXT .EQ. 4) THEN
        SHIF(2) = 1.0 - SH(2)
        SHIF(3) = 1.0 - SH(3)
        DO IA = 1, NATOM
          XROT(2, IA) = 1.0 - XA(2, IA) + PL(2)
          XROT(3, IA) = 1.0 - XA(3, IA) + PL(3)
          XROT(1, IA) = XA(1, IA)
        END DO
      ELSE IF (NTEXT .EQ. 5) THEN
        SHIF(1) = SH(2)
        SHIF(2) = SH(1)
        SHIF(3) = 1.0 - SH(3)
        DO IA = 1, NATOM
          XROT(1, IA) = XA(2, IA)
          XROT(2, IA) = XA(1, IA)
          XROT(3, IA) = 1.0 - XA(3, IA) + PL(3)
        END DO
      ELSE IF (NTEXT .EQ. 6) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 1.0 - XA(2, IA) + PL(1)
          XROT(2, IA) = 1.0 - XA(1, IA) + PL(2)
          XROT(3, IA) = 2.0 - XA(3, IA) + PL(3)
        END DO
      ELSE IF (NTEXT .EQ. 7) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 0.25 - XA(2, IA) + PL(1)
          XROT(2, IA) = 0.25 - XA(1, IA) + PL(2)
          XROT(3, IA) = 1.25 - XA(3, IA) + PL(3)
        END DO
      ELSE IF (NTEXT .EQ. 8) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 1.0 - XA(1, IA) + PL(1)
          XROT(2, IA) = 0.5 - XA(2, IA) + PL(2)
          XROT(3, IA) = 1.0 - XA(3, IA) + PL(3)
        END DO
      ELSE IF (NTEXT .EQ. 9) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 1.0 - XA(2, IA) + PL(2)
          XROT(2, IA) = 0.5 - XA(1, IA) + PL(3)
          XROT(3, IA) = XA(3, IA)
        END DO
      ELSE IF (NTEXT .EQ. 10) THEN
        DO IA = 1, NATOM
          DO J = 1, 3
            XROT(J, IA) = 0.25 - XA(J, IA) + PL(J)
          END DO
        END DO
      ELSE IF (NTEXT .EQ. 11) THEN
        DO IA = 1, NATOM
          DO J = 1, 3
            XROT(J, IA) = 1.0 - XA(J, IA) + PL(J)
          END DO
        END DO
      ELSE IF (NTEXT .EQ. 12) THEN
        DO IA = 1, NATOM
          DO J = 1, 3, 2
            XROT(J, IA) = XA(J, IA)
          END DO
          XROT(2, IA) = 1.0 - XA(2, IA) + PL(2)
        END DO
      ELSE IF (NTEXT .EQ. 13) THEN
        DO IA = 1, NATOM
          DO J = 1, 2
            XROT(J, IA) = XA(J, IA)
          END DO
          XROT(3, IA) = 1.0 - XA(3, IA) + PL(3)
        END DO
      ELSE IF (NTEXT .EQ. 14) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 1.0  - XA(1, IA) + PL(1)
          XROT(2, IA) = 0.5  - XA(2, IA) + PL(2)
          XROT(3, IA) = 0.25 - XA(3, IA) + PL(3)
        END DO
      ELSE IF (NTEXT .EQ. 15) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 1.0 - XA(2, IA) + PL(2)
          XROT(2, IA) = 1.0 - XA(1, IA) + PL(1)
          XROT(3, IA) = XA(3, IA)
        END DO
      ELSE IF (NTEXT .EQ. 16) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = XA(2, IA)
          XROT(2, IA) = XA(1, IA)
          XROT(3, IA) = XA(3, IA)
        END DO
      ELSE IF (NTEXT .EQ. 17) THEN
        DO IA = 1, NATOM
          XROT(1, IA) = 0.25 + XA(2, IA)
          XROT(2, IA) = 0.25 + XA(1, IA)
          XROT(3, IA) = 0.25 + XA(3, IA)
        END DO
      END IF
      DO J = 1, NATOM
        DO i = 1, 3
          IF (XROT(I, J) .GT. 0.99999) XROT(I, J) = XROT(I, J) - 1.0
          IF (XROT(I, J) .LT.     0.0) XROT(I, J) = XROT(I, J) + 1.0
        END DO
      END DO
      IF (NTEXT .GT. 0) THEN
        CALL PLA262 (0)
        CALL PLA262 (2)
        WRITE (LU7, 99971, IOSTAT = IOST) STTEXT(NTEXT)
      END IF
      NOR = NSAVE
      IF (IPOL .EQ. 0) THEN
        CALL GEN097 (NAT, 1, NTOT, 0)
        ISMIN = IS(MKORD)
        LOWLET = 27
        DO J = 1, 27
          IF (IS(J) .EQ. ISMIN) THEN
            IF (J .LT. LOWLET) LOWLET = J
          END IF
        END DO
        NPOL = 0
        DO IA = 1, NATOM
          DO J = 1, 3
            POS(J) = XROT(J, IA)
          END DO
          CALL PLA322
          KOR = KKORD(IA)
          KK  = IS(KOR)
          IF (KK .EQ. ISMIN) THEN
            DO J = 1, KOUNT
              NPOL = NPOL + 1
              IF (NPOL .GT. NTOT) THEN
                WRITE (LU7, 99958, IOSTAT = IOST)
                GO TO 80
              END IF
              NAT(NPOL) = IA
              DO K = 1, 3
                XP(K, NPOL) = X(K, J)
              END DO
            END DO
          END IF
        END DO
        CALL PLA262 (4)
        WRITE (LU7, 99961, IOSTAT = IOST)
        WRITE (LU7, 99960, IOSTAT = IOST)
     1    (I, (XP(J, I), J = 1, 3), I = 1, NPOL)
        IK = ICOORD - 1
        IF (IK .EQ. 0) IK = 1
        I1 = 3
        IF (ICOORD .EQ. 2) I1 = 2
        DO IOR = 1, NOR
          DO J = 1, 3
            ORGA(J) = ORGADD(J, IOR)
          END DO
          CALL PLA262 (4)
          WRITE (LU7, 99959, IOSTAT = IOST) STTEXT(NTEXT), ORGA
          LRET319 = 0
          CALL PLA319 (I1, IK, NATOM, LRET319)
          IF (LRET319 .EQ. 1) GO TO 80
        END DO
      ELSE
        DO 60 IOR = 1, NOR
          IF (IPR(83) .GT. 5) CALL PLA262 (0)
          CALL PLA262 (2)
          WRITE (LU7, 99969, IOSTAT = IOST)
     1      IOR, (ORGADD(J, IOR), J = 1, 3)
          sum = 0.0
          DO IA = 1, NATOM
            ELT1 = ATOM1(IA)
            ELT2 = ATOM2(IA)
            DO j = 1, 3
              POS(J) = XROT(J, IA) - ORGADD(J, IOR)
              EPS    = -0.000001
              EPS1   = 1.0 + eps
              IF (POS(J) .LT. EPS)  POS(J) = POS(J) + 1.0
              IF (POS(J) .GE. EPS1) POS(J) = POS(J) - 1.0
            END DO
            CALL PLA322
            CALL PLA262 (4)
            WRITE (LU7, 99970, IOSTAT = IOST) ELT1, ELT2
            KORD    = 0
            IPOLAR  = 0
            LRET330 = 0
            CALL PLA326 (IA, NP, LU7, LRET330)
            IF (LRET330 .EQ. 0) NSP(IA) = NP
            IF (IFLAG .EQ. 1) THEN
              CALL PLA262 (5)
              WRITE (LU7, 99970, IOSTAT = IOST) ELT1, ELT2
              WRITE (LU7, 99994, IOSTAT = IOST)
              GO TO 60
            END IF
            DO J = 1, 3
              FINXYZ(J, IA) = X(J, MIN)
            END DO
            MUL(IA) = MU
            LET(IA) = KORD
            SUM     = SUM + DMIN
          END DO
          DO I = 1, 3
            ORIG(I) = ORGADD(I, IOR)
          END DO
          IFS = 1
          IF (NGR .EQ. 85 .or. NGR .EQ. 86 .or. NGR .EQ. 88) THEN
            IF (STTEXT(NTEXT)(1:7) .EQ. 'x,-y,-z' .or.
     1          STTEXT(NTEXT)(1:6) .EQ. 'y,x,-z') IFS = 2
          ELSE
            IFS = 1
          END IF
          IF (IFSH .GT. 0 .OR. IFPLUS .GT. 0) THEN
            DO I = 1, 3
              IF (IFS .EQ. 1) TOTSH(I) = PLUS(I) + SH(I)
              IF (IFS .EQ. 2) TOTSH(I) = PLUS(I) + SHIF(I)
              IF (TOTSH(I) .GE. .9999) TOTSH(I) = TOTSH(I) - 1.0
              ORIG(I) = ORIG(I) + TOTSH(I)
              IF (ORIG(I) .GE. 0.9999) ORIG(I) = ORIG(I) - 1.0
            END DO
            IF (MINSH .GT. 0) THEN
              ORIG(MINSH) = ORIG(MINSH) - 2 * TOTSH(MINSH)
              DO WHILE (ORIG(MINSH) .LT. 0.0)
                ORIG(MINSH) = ORIG(MINSH) + 1.0
              END DO
            END IF
          END IF
          IF (SUM .LT. GMIN)   GMIN = SUM
          CALL PLA323 (1, IOR, NATOM, SUM, FINXYZ, MUL, LET, LU7)
          IF (NTEXT .GT. 0) WRITE (LU61, IOSTAT = IOST)
     1      SUM, STTEXT(NTEXT), (ORIG(K), K = 1, 3)
            IF (IOST .NE. 0) THEN
              WRITE (LU7, 99968, IOSTAT = IOST)
              GO TO 80
            END IF
          DO I = 1, NATOM
            WRITE (LU61, IOSTAT = IOST) NSP(I),
     1        (FINXYZ(J, I), J = 1, 3), MUL(I), LET(I), FOCCU(I)
            IF (IOST .NE. 0) THEN
              WRITE (LU7, 99968, IOSTAT = IOST)
              GO TO 80
            END IF
          END DO
   60   CONTINUE
      END IF
      KEER = KEER - 1
      IF (KEER .GT. 0) GO TO 50
      IF (NTIO .NE. 0 .AND. NAGAIN .NE. 1) THEN
        KEER   = KSAVE
        NAGAIN = 1
        GO TO 50
      END IF
      CALL PLA318 (NATOM, IHEX, IPEARS, PMIN, PEAR, KELT)
      GO TO 80
   70 WRITE (LU6, 99965, IOSTAT = IOST)
   80 WRITE (LU6, 99996, IOSTAT = IOST)
      WRITE (LU7, 99996, IOSTAT = IOST)
      IF (IWIN .EQ. 1) THEN
        CALL PLA013 (1, 1)
      END IF
      CLOSE (UNIT = LU21)
      CLOSE (UNIT = LU60)
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU63)
      CLOSE (UNIT = LU64)
      RETURN
99999 FORMAT ('Input Data for     :', A, /,
     1        'Space Group Symbol : ', 16A)
99998 FORMAT (6F10.4)
99997 FORMAT ('Cell Parameters    : ', 3F9.5, 3F8.3)
99996 FORMAT (//, 'End of STRUCTURE TIDY Routine', /)
99995 FORMAT (A)
99994 FORMAT ('No permitted choice of coordinate triplet.')
99993 FORMAT (42('-'), /, 'Standardization with imposed unit cell', /,
     1        42('-'))
99992 FORMAT ('OTHER Standardization with Non-Standard Cell:')
99991 FORMAT ('DATA', 3X, A)
99990 FORMAT ('Origin shift due to change of setting : ', A)
99989 FORMAT ('Rhombohedral cell with a = ', F8.4,'   alpha = ', F8.4)
99988 FORMAT ('Transformed to hexagonal cell : a =', F9.4,
     1        '  c =', F9.4)
99987 FORMAT ('Transformed to setting ', I3, 2X, A, '.')
99986 FORMAT ('REMARK Niggli-reduced cell')
99985 FORMAT ('Extra origin shift due to interchange of axes : ', A, /)
99984 FORMAT ('Extra origin shift due to cell reduction : ', A, /)
99983 FORMAT ('Total transformation = ', A, /)
99982 FORMAT (/, 'Reduced form', I3, ' , which means metrically ',
     1   A, /, ' Transformation matrix to a conventional basis is',
     2 ' given in', /, ' International Tables for Crystallography',
     3 '  Vol.A, Table 9.3.1 (page 742)', /)
99981 FORMAT ('WARNING : Axes a and b of reduced cell are very',
     1' similar.'/)
99980 FORMAT ('WARNING : Axes b and c of reduced cell are very',
     1' similar.'/)
99979 FORMAT ('WARNING : Axes a and c of reduced cell are very',
     1' similar.'/)
99978 FORMAT (/, 'Origin shift of ', A14, ' is applied in order to',
     1   ' have', /, ' the symmetry centre at the origin.', /)
99977 FORMAT ('General Position ', I3, A1)
99976 FORMAT ('More than', I4, ' different elements in structure,', /,
     1' giving wrong Pearson code and displacements in output.')
99975 FORMAT ('Too many atoms in input; the arrays are limited to',
     1 I4, ' atoms.')
99974 FORMAT (A , A50)
99972 FORMAT ('Polar group; Imposed origin : ', 3F9.5)
99971 FORMAT (A, /, 17('-'))
99970 FORMAT (/, 12('='), /, 'Atom ', A2, 1X, A4, /, 12('='))
99969 FORMAT (/, 'Origin Shift #', I2, 5X, '(', 3F9.5, ')')
99968 FORMAT (//, 'ERROR  in MAIN while writing on unit LU61')
99967 FORMAT (/, 'ERROR in SPACE GROUP ROUTINE', /)
99966 FORMAT ('Structure Tidy: Standardisation of Inorganic Crystal',
     1        ' Structure Data', /, 80('='), /, 'References: ',
     2 'E.Parthe & L.M.Gelato (1984). Acta Cryst., A40, 169-183.', /,
     3 12X, 'L.M.Gelato & E.Parthe (1987). J. Appl. Cryst. 20, 139-143.'
     4 , /, 12X, 'S-Z.Hu & E.Parthe (2004). Chinese J. Struct. Chem. '
     5 , '23, 1150-1160.', /)
99965 FORMAT (/, ':: Input Error in .sty File.', /)
99964 FORMAT (/, ':: ** .sty Style Files and Extension Allowed Only ',
     1        ' with -Y Option.' /)
99963 FORMAT ('In order to Obtain Obtuse Angle beta, Transform Axes',
     1' by -a,-b,c', /, ' new beta =', F9.3)
99962 FORMAT ('Parameters DO not Define Valid Cell ')
99961 FORMAT (/, 'Coordinates of Atoms for Finding Origin : ', /,
     1        41('='))
99960 FORMAT (4(I4, 3F9.5, 3X))
99959 FORMAT (//, 'Origin Shift for Setting ', A, 3F9.5, /)
99958 FORMAT ('DIMENSION of XPOL is too small')
99957 FORMAT ('Special Read (Check ! )', 2A)
      END SUBROUTINE PLA301
      SUBROUTINE PLA302 (NCS, NTRANS, LU, LUA, IER)
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM (3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /STBL4/ IPOL, RR, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /BRZ/ NGO, NROT(48, 3, 3), NTRAN(48, 3), NBR
      COMMON /BUR/ NT, SPGR
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /TRANS/ SS(9), DUMMY(27)
      CHARACTER HBR(7)*1, HS(14)*1, NT(16)*1, SPGR*10, AUX*17,
     1 SPGP(230)*10, NT3(16)*1, NTT*14, PSYM(47)*14, FORMS(15)*16,
     2 LATICE(6)*1, XELN(105)*2, KOORD(12)*8, CHORI(9)*3, STAA(107)*11,
     3 STBB(39)*15, STCSH(17)*14, STTEXT(21)*17
      INTEGER NET(3), IN(7), IS(14), S(3), LGT(48), Z, SC(3, 3),
     1 NGT(48, 48)
      DATA IS /
     1   1, 5, 6, 7, 11, 18, 13, 17, 21, 22, 28, 24, 31, 29/
      DATA HS /
     1 'M','A','B','C','N','D','-','1','2','3','4','5','6','/'/
      DATA IRC /72/
      CALL GEN074 (PLUS, 1, 3, 0.0)
      CALL GEN097 (S, 1, 3, 0)
      NBR = 0
      Z   = 0
      IZ  = 0
      NGC = 0
      NGO = 0
      ID  = 0
      LT  = 0
      DO I = 1, 3
        DO J = 1, 3
          DO K = 1, 48
            NROT(K, J, I) = 0
            IF (I .EQ. 1) THEN
              NTRAN(K, J) = 0
              IF (J .EQ. 1) LGT(K) = 0
            END IF
          END DO
        END DO
      END DO
   10 DO I = 1, 7
        IN(I)                      = 0
        IF (NT(1) .EQ. HBR(I)) NBR = I
      END DO
      IF (NBR .EQ. 0 .OR. NT(2) .NE. ' ') THEN
        IER = 1
        RETURN
      END IF
      N = 0
      DO I = 2, 16
        IF (NT(I) .EQ. ' ') THEN
          K = 0
          N = N + 1
        ELSE
          M = 0
          DO J = 1, 14
            IF(NT(I) .EQ. HS(J)) M = J
          END DO
          IF (M .EQ. 0 .OR. K .GT. 3) THEN
            IER = 1
            RETURN
          END IF
          IN(N + 1) = IN(N + 1) + M * 15**K
          K         = K + 1
        END IF
      END DO
      DO I = 1, 3
        NET(I) = 0
        DO J = 1, 43
          IF (MM5(J, I) .EQ. IN(I + 1)) NET(I) = J
        END DO
        IF (NET(I) .EQ. 0) THEN
          IER = 1
          RETURN
        END IF
      END DO
      MD4 = MM4(NET(2), NET(3))
      IF (MD4 .EQ. 0) THEN
        IER = 1
        RETURN
      END IF
      MC = MD4 + NET(1) * 95 + (NBR - 1) * 4085
      DO I = 1, 541
        IF (MC .EQ. NNT1(I)) Z = I
      END DO
      IF (NT(1) .EQ. 'I' .AND. NT(3) .EQ. 'C' .AND. NT(5) .EQ. 'A'
     1   .AND. NT(7) .EQ. 'B') THEN
        CALL GEN074 (PLUS, 1, 3, 0.25)
        NGR    = 73
        IFPLUS = 1
        NTRANS = -2
        NSHTRA = 5
        GO TO 80
      END IF
      IF (Z .EQ. 0) THEN
        NTT = ' '
        DO I = 1, 14
          WRITE (NTT(I:I), 99992, IOSTAT = IOST) NT(I + 2)
        END DO
        SELECT CASE (NBR)
          CASE (1)
            DO I = 1, 17
              IF (NTT .EQ. PSYM(I)) GO TO 20
            END DO
          CASE (2)
            DO I = 18, 24
              IF (NTT .EQ. PSYM(I)) GO TO 20
            END DO
          CASE (3)
            DO I = 25, 31
              IF (NTT .EQ. PSYM(I)) GO TO 20
            END DO
          CASE (4)
            DO I = 32, 38
              IF (NTT .EQ. PSYM(I)) GO TO 20
            END DO
          CASE (5, 7)
          CASE (6)
            DO I = 39, 47
              IF (NTT .EQ. PSYM(I)) GO TO 20
            END DO
        END SELECT
            IER = 1
            RETURN
   20   CALL GEN126 (NT3, 1, 16)
        II = 1
        IF (AL .NE. 0.0 .AND. AL .NE. 90.0) II = 2
        IF (BE .NE. 0.0 .AND. BE .NE. 90.0) II = II + 2
        IF (GA .NE. 0.0 .AND. GA .NE. 90.0) II = II + 4
        SELECT CASE (II)
          CASE (1)
            WRITE (LU, 99993, IOSTAT = IOST)
            GO TO 30
          CASE (2)
            DO I = 3, 16
              IF (NT(I) .EQ. ' ') THEN
                NT(I + 1) = '1'
                NT(I + 2) = ' '
                NT(I + 3) = '1'
                GO TO 40
              END IF
            END DO
            WRITE (LU, 99993, IOSTAT = IOST)
            GO TO 30
          CASE (3)
            GO TO 30
          CASE (4)
            IER = 1
            RETURN
          CASE (5)
            NT3(3) = '1'
            NT3(5) = '1'
            DO I = 3, 12
              NT3(I + 4) = NT(I)
            END DO
            DO I = 3, 16
              NT(I) = NT3(I)
            END DO
            GO TO 40
          CASE DEFAULT
            IER = 1
            RETURN
        END SELECT
   30   NT3(3) = '1'
        DO I = 3, 16
          IF (NT(I) .EQ. ' ') EXIT
          NT3(I + 2) = NT(I)
        END DO
        NT3(I + 3) = '1'
        DO I = 3, 16
          NT(I) = NT3(I)
        END DO
   40   CALL PLA262 (1)
        WRITE (LU, 99994, IOSTAT = IOST) NT
        GO TO 10
      END IF
      NTRANS = ITRAFO(Z)
      IF (NTRANS .GT. 0) THEN
        NBL      = 0
        AUX      = ' '
        AUX(1:1) = NT(1)
        K        = 2
        DO 50 I = 3, 16
          K = K + 1
          AUX(K:K) = NT(I)
          IF (NT(I) .EQ. ' ') THEN
            NBL = NBL + 1
            IF (NBL .EQ. 2) GO TO 60
            GO TO 50
          ELSE
            NBL = 0
          END IF
          AUX(K:K) = NT(I)
          CALL GEN020 (-1, AUX, K, K)
   50   CONTINUE
   60   DO I = 16, 1, -1
          IF (AUX(I:I) .NE. ' ') THEN
            K        = I + 1
            AUX(K:K) = '.'
            GO TO 70
          END IF
        END DO
   70   WRITE (LUA, 99995, IOSTAT = IOST) AUX
      END IF
      NGR = ITGRP(Z)
      IZ  = Z
   80 IF (Z .EQ. 182 .OR. Z .EQ. 183) THEN
        CALL PLA262 (2)
        WRITE (LU, 99998, IOSTAT = IOST)
      ELSE IF (Z .EQ. 184 .OR. Z .EQ. 185) THEN
        CALL PLA262 (2)
        WRITE (LU, 99997, IOSTAT = IOST)
      ELSE IF (Z .EQ. 186 .OR. Z .EQ. 187) THEN
        CALL PLA262 (2)
        WRITE (LU, 99996, IOSTAT = IOST)
      END IF
      Z    = NLST(NGR)
      SPGR = SPGP(NGR)
      NBR  = NCENT(NGR)
      NB   = NBR
      IF (NBR .GT. 2) NB = NBR + 1
      CALL PLA262 (1)
      WRITE (LU, 99999, IOSTAT = IOST) NGR
      DO I = 1, 45
        IF(NT2(I) .LT. Z) NGC = I
      END DO
      ISYS   = ISY(NGC)
      N      = Z + 541
      M      = Z + 2 * 541
      NSE    = NNT1(M)
      NET(3) = NNT1(N) / 900 + 1
      NET(2) = (NNT1(N) - 900 * (NET(3) - 1)) / 30 + 1
      NET(1) = MOD(NNT1(N), 30) + 1
      NCS    = 1 - NGC / 32
      ND     = NGC
      IF (ND .GT. 31) ND = IS(NGC - 31)
      DO I = 1, 216
        IF (LLF(I) .EQ. 1) ID = ID + 1
        IF (ID .EQ. ND) THEN
          M = LLF(I) * ISIGN (1, LLF(I)) + 24 * (5 / ISYS) * (ISYS / 5)
          NGO = NGO + 1
          DO K = 1, 3
            DO L = 1, 3
              NROT(NGO, K, L) = IGES(K, L, M) * ISIGN (1, LLF(I))
            END DO
          END DO
        ELSE IF (ID .GT. ND) THEN
          GO TO 90
        END IF
      END DO
   90 DO I = 1, NGO
        DO J = 1, 3
          DO K = 1, 3
            IF (NCS .EQ. 0) NROT(NGO + I, J, K) = - NROT(I, J, K)
          END DO
        END DO
        DO 110 J = 1, NGO
          DO K = 1, 3
            DO L = 1, 3
              SC(K, L) = NROT(I, K, 1) * NROT(J, 1, L)
     1                 + NROT(I, K, 2) * NROT(J, 2, L)
     2                 + NROT(I, K, 3) * NROT(J, 3, L)
            END DO
          END DO
          DO 100 K = 1, NGO
            DO L = 1, 3
              DO M = 1, 3
                IF (SC(L, M) .NE. NROT(K, L, M)) GO TO 100
              END DO
            END DO
            NGT(I, J)             = K
            NGT(NGO + I, J)       = (K + NGO) * (1 - NCS)
            NGT(I, NGO + J)       = (K + NGO) * (1 - NCS)
            NGT(NGO + I, NGO + J) = K * (1 - NCS)
            GO TO 110
  100     CONTINUE
  110   CONTINUE
      END DO
      NGO = NGO + NGO * (1 - NCS)
      DO I = 1, 3
        ID = LGN(I, NGC)
        DO J = 1, 3
          IF (ID .NE. 0) NTRAN(ID, J) = NGET(J, NET(I))
          SC(I, J) = NSEM(I, J, NSE)
        END DO
      END DO
      DO I = 1, 3
        IF (LGN(I, NGC) .NE. 0) THEN
          LT      = LT + 1
          LGT(LT) = LGN(I, NGC)
        END IF
      END DO
      DO WHILE (LT .NE. NGO)
        N = 0
        DO I = 1, LT
          DO 120 J = 1, LT
            KL = NGT(LGT(I), LGT(J))
            DO M = 1, NGO
              IF (LGT(M) .EQ. KL) GO TO 120
            END DO
            DO K = 1, 3
              DO L = 1, 3
                NTRAN(KL, K) = NTRAN(KL, K)
     1                       + NROT(LGT(I), K, L) * NTRAN(LGT(J), L)
              END DO
              NTRAN(KL, K) = MOD(NTRAN(KL, K)
     1                     + NTRAN(LGT(I), K) + 48, 24)
            END DO
            N           = N + 1
            LGT(LT + N) = KL
  120     CONTINUE
        END DO
        LT = LT + N
      END DO
      DO I = 1, NGO
        DO J = 1, 3
          NTRAN(I, J) = NTRAN(I, J) + NROT(I, J, 1) * S(1)
     1      + NROT(I, J, 2) * S(2) + NROT(I, J, 3) * S(3) - S(J)
          NTRAN(I, J) = MOD (NTRAN(I, J) + 48, 24)
        END DO
        IF (NB .NE. 1 .AND. NB .NE. 7) THEN
          DO L = 1, 4
            DO K = 1, 3
              NET(K) = MOD(NTRAN(I, K) + NNQ(K, L, NB - 1), 24)
            END DO
            IF (IRC .GT. NET(1) + NET(2) + NET(3)) THEN
              IRC = NET(1) + NET(2) + NET(3)
              DO K = 1, 3
                NTRAN(I, K) = NET(K)
              END DO
            END IF
          END DO
        END IF
        IRC = 72
      END DO
      IFMAT = 0
      N     = MOD (NTRANS, 20)
      IF (NTRANS .EQ. -2) N     = 30
      IF (NTRANS .EQ. -1) IFMAT = 1
      IF (N .GT. 0) THEN
        IFMAT = 2
        IF (NTRANS .GT. 0) CALL PLA307 (N, IER)
        IF (IER .EQ. 1) RETURN
        DO K = 1, 9
          SS(K) = XABC(K, N)
        END DO
      END IF
      IF (NTRANS .EQ. -2) RETURN
      SELECT CASE (N)
        CASE (13, 25)
          IF (IZ .EQ. 8 .OR. IZ .EQ. 299) THEN
            NTRANS = 7
          ELSE IF (IZ .EQ. 11)  THEN
            NTRANS = 27
          ELSE IF (IZ .EQ. 302) THEN
            NTRANS = 47
          END IF
        CASE (15, 27)
          IF (IZ .EQ. 28)  THEN
            NTRANS = 29
          ELSE IF (IZ .EQ. 34 .OR. IZ .EQ. 329) THEN
            NTRANS = 9
          ELSE IF (IZ .EQ. 323) THEN
            NTRANS = 49
          END IF
        CASE (17, 29)
          IF (IZ .EQ. 47 .OR. IZ .EQ. 350) THEN
            NTRANS = 11
          ELSE IF (IZ .EQ. 50) THEN
            NTRANS = 31
          ELSE IF (IZ .EQ. 353) THEN
            NTRANS = 51
          END IF
      END SELECT
      IF (NTRANS .GE. 20) THEN
        IFPLUS  = 1
        PLUS(2) = 0.25
        IF (NTRANS .GE. 40) THEN
          PLUS(1) = 0.25
          NSHTRA  = 6
        ELSE
          NSHTRA = 17
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('Number in IT       :', I4)
99998 FORMAT ('WARNING : The origin should be at  2 1 21;', /,
     1' if the origin is at  1 2 21, substract 1/4 from z-coordinates.')
99997 FORMAT ('WARNING : The origin should be at  21 2 1;', /,
     1' if the origin is at  21 1 2, substract 1/4 from x-coordinates.')
99996 FORMAT ('WARNING : The origin should be at  1 21 1;', /,
     1' if the origin is at  2 21 1, substract 1/4 from y-coordinates.')
99995 FORMAT ('REMARK Transformed from setting  ', A)
99994 FORMAT ('Complete Symbol for Space Group Setting : ', 16A1)
99993 FORMAT ('Input of monoclinic space group with all angles = 90 ',
     1' may lead to difficulties.', /, ' The program assumes b-axis',
     2' unique. If different setting,'/
     3' rerun program with monoclinic angle=90.0001')
99992 FORMAT (A1)
      END SUBROUTINE PLA302
      SUBROUTINE PLA303 (PEAR, IPEARS, PMIN, KELT, NCS, NTIO, LRET325)
      PARAMETER (NUMAT=150, NELTS=16)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /STBL4/ IPOL, R, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /AT/ IAT, POS(3), IHEX, FNUM
      COMMON /ATCH/ ELT1, ELT2, F
      COMMON /BRZ/ NGO, IR(48, 3, 3), IT(48, 3), NBR
      COMMON /BUR/ NT, SPGR
      COMMON /CH/ XA(3, NUMAT)
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /ORGIN/ NOR, ORGADD(3, 8), NTEXT, ICOORD
      COMMON /POSI/ X(3, 192), DIST(192), KOUNT
      COMMON /RES/ ATOM1, ATOM2, FOCCU, INTXT, CODE, ELT
      COMMON /ROT/ XROT(3, NUMAT), NATOM
      COMMON /SP/ N, NW, NS(26), IS(27), MULT(15), NSET(8), KSET, MU,
     1 KORD
      COMMON /TRIP/ DMIN, MIN, KORDER(192), IFLAG, XMIN(3, NUMAT),
     1 MUL(NUMAT), LET(NUMAT), NRSET(NUMAT), NNSET(8, NUMAT)
      CHARACTER NT(16)*1, CODE(2)*1, INTXT*40
      CHARACTER SPGR*10, ATOM1(NUMAT)*2, ATOM2(NUMAT)*4,
     1          FOCCU(NUMAT)*5
      CHARACTER ELT(NELTS)*2, ELT1*2, ELT2*4, F*5
      DIMENSION PEAR(NELTS), XX(3, NUMAT), SAV(3, 3), NENT(11), Y(3),
     1 FF(NUMAT)
      DATA NENT /
     1 76, 91, 92, 144, 151, 152, 169, 171, 178, 180, 213/
      EP  = 0.000001
      NIG = 1
      DO J = 1, NUMAT
        DO I = 1, 3
          XX(I, J) = 0.0
        END DO
      END DO
      CALL GEN052 (XMAT, SAV)
      CALL GEN052 (XMSAVE, XMAT)
      IPEARS = 0
      PMIN   = 0.0
c
c if centric group, take only half of positions :
      IF (NCS .EQ. 0) NGO = NGO / 2
      NATOM = 0
      KELT  = 0
      KNT   = 0
c set centring as for primitive cell :
      NBR = 1
   10 IER = 0
      CALL PLA304 (NIG, IER)
      IF (IER .EQ. 0) THEN
        CALL PLA322
        DO 20 I = 1, KOUNT
          IF (IFNIG .EQ. 2) THEN
            DO J = 1, 3
              POS(J) = X(1, I) * SAV(1, J) + X(2, I) * SAV(2, J)
     1               + X(3, I) * SAV(3, J)
            END DO
c put positions between 0 and 1 :
            DO J = 1, 3
              DO WHILE (POS(J) .LT. - 0.000001)
                POS(J) = POS(J) + 1.0
              END DO
              DO WHILE (POS(J) .GE. 0.999999)
                POS(J) = POS(J) - 1.0
              END DO
            END DO
          ELSE
            DO J = 1, 3
              POS(J) = X(J, I)
            END DO
          END IF
c get out doubles caused by transformation :
          IF (KNT .GT. 0) THEN
            DO J = 1, KNT
              IF (ABS(POS(1) - XX(1, J)) .LT. EP .AND.
     1            ABS(POS(2) - XX(2, J)) .LT. EP .AND.
     2            ABS(POS(3) - XX(3, J)) .LT. EP) GO TO 20
            END DO
c for P-1 eliminate also positions -x,-y,-z :
            IF (NCS .EQ. 0) THEN
              DO J = 1, KNT
                DO K = 1, 3
                  Y(K) = POS(K) + XX(K, J)
                  IF (Y(K) .GT. 0.999999) Y(K) = Y(K) - 1.0
                END DO
                IF (ABS(Y(1)) .LT. EP .AND. ABS(Y(2)) .LT. EP .AND.
     1              ABS(Y(3)) .LT. EP) GO TO 20
              END DO
            END IF
          END IF
          KNT        = KNT + 1
          ATOM1(KNT) = ELT1
          ATOM2(KNT) = ELT2
          FOCCU(KNT) = F
          FF(KNT)    = FNUM
          DO J = 1, 3
            XX(J, KNT) = POS(J)
          END DO
   20   CONTINUE
        IF (KNT .GE. NUMAT) THEN
          WRITE (LU7, 99995, IOSTAT = IOST)
          LRET325 = 1
          RETURN
        END IF
        GO TO 10
      END IF
      NATOM = KNT
      WRITE (LU7, 99998, IOSTAT = IOST)
      DO I = 1, NATOM
        WRITE (LU7, 99997, IOSTAT = IOST)
     1    ATOM1(I), ATOM2(I), (XX(J, I), J = 1, 3)
      END DO
c new symmetry factors :
      DO I = 1, 3
        DO J = 1, 3
          DO K = 1, 48
            IR(K, J, I) = 0
          END DO
        END DO
      END DO
      DO I = 1, 3
        DO J = 1, 48
          IT(J, I) = 0
        END DO
      END DO
      DO I = 1, 8
        DO J = 1, 3
          ORGADD(J, I) = 0.0
        END DO
      END DO
      NT(1)   = 'P'
      NT(2)   = ' '
      CODE(1) = 'a'
      CODE(2) = 'P'
      IF (NCS .EQ. 0) THEN
        NT(3) = '-'
        NT(4) = '1'
        SPGR  = 'P -1'
        NGR   = 2
        N     = 8
        NW    = 2
        NTIO  = 0
        DO I = 1, 8
          IS(I) = 1
          NS(I) = 9 - i
        END DO
        MULT(1) = 1
        MULT(2) = 2
        DO I = 1, 3
          IR(1, I, I) = 1
          IR(2, I, I) = -1
        END DO
        NGO  = 2
        NOR  = 8
        IPOL = 1
        ORGADD(1, 2) = 0.5
        ORGADD(2, 3) = 0.5
        ORGADD(3, 4) = 0.5
        ORGADD(2, 5) = 0.5
        ORGADD(3, 5) = 0.5
        ORGADD(1, 6) = 0.5
        ORGADD(3, 6) = 0.5
        ORGADD(1, 7) = 0.5
        ORGADD(2, 7) = 0.5
        ORGADD(1, 8) = 0.5
        ORGADD(2, 8) = 0.5
        ORGADD(3, 8) = 0.5
      ELSE
        SPGR        = 'P 1'
        IPOL        = 0
        NOR         = -31
        NT(3)       = '1'
        NT(4)       = ' '
        N           = 0
        NW          = 1
        IS(1)       = 1
        NTIO        = 1
        MULT(1)     = 1
        IR(1, 1, 1) = 1
        IR(1, 2, 2) = 1
        IR(1, 3, 3) = 1
        NGO         = 1
        NGR         = 1
        DO I = 1, 11
          IF (NGR .EQ. NENT(I)) THEN
            NTIO = 0
            NFL  = 1
            GO TO 30
          END IF
        END DO
      END IF
   30 CALL GEN126 (NT, 5, 16)
      WRITE (LU7, 99996, IOSTAT = IOST) NGR, SPGR
      DO IA = 1, NATOM
        DO J = 1, 3
          POS(J) = XX(J, IA)
        END DO
        CALL PLA322
        KSET = 0
        IF (N .EQ. 0) THEN
          MU   = MULT(1)
          KORD = 1
        ELSE
          CALL PLA324 (NIG)
        END IF
        FMU    = FLOAT(MU)
        FN     = FF(IA) * FMU
        IPEARS = IPEARS + MU
        PMIN   = PMIN + FMU - FN
        ELT1   = ATOM1(IA)
        IF (KELT .GT. 0) THEN
          DO I = 1, KELT
            IF (ELT1 .EQ. ELT(I)) GO TO 40
          END DO
        END IF
        KELT = KELT + 1
        IF (kelt .GT. NELTS) THEN
          WRITE (LU7, 99999, IOSTAT = IOST) NELTS
          KELT = KELT - 1
        END IF
        ELT(KELT) = ELT1
        I         = KELT
   40   PEAR(I)   = PEAR(I) + FN
        DO J = 1, 3
          XA(J, IA) = X(J, 1)
        END DO
        IF (KSET .NE. 0) THEN
          DO J = 1, KSET
            NNSET(J, IA) = NSET(J)
          END DO
          NRSET(IA) = KSET
        END IF
      END DO
      RETURN
99999 FORMAT ('More than ', I3,' different elements in structure,', /,
     1 ' giving wrong Pearson code and displacements in output.')
99998 FORMAT (//, 'Atoms in asymmetric unit of new space group :')
99997 FORMAT (A2, A4, 5X, 3F9.5)
99996 FORMAT (/, 'Niggli reduced cell option; new space group:',
     1        I2, 5X, A, /)
99995 FORMAT ('too many atoms for Niggli option; stop job')
      END SUBROUTINE PLA303
      SUBROUTINE PLA304 (NIG, IER)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /AT/ IAT, POS(3), IHEX, FNUM
      COMMON /ATCH/ ELT1, ELT2, F
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      CHARACTER T(70)*1, DAT(30)*1, AUX*10, F*5, LAB*4
      CHARACTER ELT1*2, ELT2*4, TIM1*1
      DIMENSION NUMB(2), X(3)
      ELT1 = ' '
      ELT2 = ' '
      F    = ' '
      ISL  = 0
      FNUM = 1.0
      CALL GEN126 (DAT, 1, 30)
      IF (IAT .EQ. 0) THEN
        CALL PLA262 (12)
        WRITE (LU7, 99993, IOSTAT = IOST)
      END IF
   10 READ (LU64, 99999) T
      IAT = IAT + 1
      DO I = 1, 4
        LAB(I:I) = T(I)
      END DO
      IF (LAB .EQ. 'DEFI') THEN
        WRITE (LU63, 99999, IOSTAT = IOST) T
        GO TO 10
      END IF
      DO 30 I = 1, 70
        IF (I .GT. 1) THEN
          TIM1 = T(I - 1)
        ELSE
          TIM1 = ' '
        ENDIF
        IF (T(I) .EQ. '.' .OR. T(I) .EQ. '/' .OR. T(I) .EQ. '0'
     1   .AND. TIM1 .EQ. ' ')  THEN
          IF (I .LT. 3) THEN
            CALL PLA262 (1)
            WRITE (LU7, 99998, IOSTAT = IOST) T
            GO TO 10
          END IF
          IF (T(I) .EQ. '.') THEN
            IJ = I - 1
            IF (T(I - 1) .EQ. '0') IJ = I - 2
            IF (T(I - 2) .EQ. '+' .OR. T(I - 2) .EQ. '-') IJ = I - 3
            IF (T(I - 1) .EQ. '-' .OR. T(I - 1) .EQ. '+') IJ = I - 2
          ELSE IF (T(I) .EQ. '/') THEN
            I1 = I - 1
            DO J = 1, I1
              K = I - J
              IF (T(K) .EQ. ' ') GO TO 20
            END DO
            WRITE (LU6, 99988, IOSTAT = IOST)
            GO TO 10
   20       IJ = K
          ELSE
            IJ = I - 1
          END IF
        ELSE
          GO TO 30
        END IF
        GO TO 40
   30 CONTINUE
      IJ = 70
   40 IE = 1
      DO 50 I = 1, IJ
        IF (T(I) .NE. ' ') THEN
          KK = ICHAR(T(I))
          IF (KK .LT. 65 .OR. KK .GT. 90) THEN
            IF (KK .GE. 97 .AND. KK .LE. 122) THEN
              KK   = KK - 32
              T(I) = CHAR(KK)
            ELSE
              GO TO 50
            END IF
          END IF
          ELT1(1:1) = T(I)
          KK = ICHAR(T(I + 1))
          IF (KK .LT. 97 .OR. KK .GT. 122) THEN
            IF (KK .GE. 65 .AND. KK .LE. 90) THEN
              KK       = KK + 32
              T(I + 1) = CHAR(KK)
            ELSE
              ELT1(2:2) = ' '
              I1        = I + 1
              GO TO 60
            END IF
          END IF
          ELT1(2:2) = T(I + 1)
          I1        = I + 2
          IF (ELT1 .NE. 'En') GO TO 60
          IER = 1
          RETURN
        END IF
   50 CONTINUE
      WRITE (LU6, 99998, IOSTAT = IOST) T
      WRITE (LU7, 99998, IOSTAT = IOST) T
      GO TO 10
   60 IF (IJ .EQ. 70) THEN
        DO I = I1, 70
          IF (T(I) .EQ. '0' .AND. T(I - 1) .EQ. ' ') GO TO 70
        END DO
        GO TO 80
   70   IJ = I - 2
      END IF
   80 DO I = I1, IJ
        IF (T(I) .NE. ' ') GO TO 90
      END DO
      IF (IJ .EQ. 70) GO TO 110
      GO TO 100
   90 ELT2(1:1) = T(I)
      DO J = 1, 3
        K = I + J
        IF (T(K) .EQ. ' ') GO TO 100
        IE = J + 1
        ELT2(IE:IE) = T(K)
      END DO
  100 DO J = 4, 1, -1
        IF (ELT2(J:J) .NE. ' ') THEN
          IF (J .NE. 4) THEN
            DO K = 1, J
              L           = J + 1 - K
              KK          = 5 - K
              ELT2(KK:KK) = ELT2(L:L)
            END DO
            ELT2(1:KK-1) = ' '
          END IF
          GO TO 110
        END IF
      END DO
  110 IF (IJ .EQ. 70) THEN
        CALL GEN074 (POS, 1, 3, 0.0)
        FNUM = 1.0
        CALL PLA262 (2)
        WRITE (LU7, 99992, IOSTAT = IOST)
        WRITE (LU7, 99997, IOSTAT = IOST) ELT1, ELT2
      ELSE
        J  = 0
        IJ = IJ + 1
        DO K = 1, 3
          DO I = IJ, 70
            IF (T(I) .NE.' ') THEN
              J      = J + 1
              DAT(J) = T(I)
              I2     = I + 1
              DO II = I2, 70
                IF (T(II) .EQ. ' ') GO TO 130
                J      = J + 1
                DAT(J) = T(II)
              END DO
              GO TO 160
            ENDIF
          END DO
          K1      = (K - 1) * 10 + 2
  120     DAT(K1) = '0'
          IF (K1 .GT. 20) GO TO 140
          K1 = K1 + 10
          GO TO 120
  130     J1 = J + 1
          J2 = (J1 / 10 + 1) * 10
          IF (J1 .LT. J2) THEN
            DO I = J1, J2
              DAT(I) = ' '
            END DO
          END IF
          IJ = II + 1
          J  = J2
        END DO
  140   DO II = IJ, 70
          IF (T(II) .NE. ' ') THEN
            I1 = II + 4
            J  = 0
            DO I = II, I1
              IF (T(I) .EQ. '/') ISL = I
                J = J + 1
              F(J:J) = T(I)
            END DO
            GO TO 150
          END IF
        END DO
  150   CALL PLA262 (2)
        WRITE (LU7, 99992, IOSTAT = IOST)
        WRITE (LU7, 99996, IOSTAT = IOST) ELT1, ELT2, DAT, F
  160   IF (ISL .EQ. 0) THEN
          READ (F, 99991) FNUM
        ELSE
          NUM1 = 0
          NUM2 = 0
          DO I = II, ISL - 1
            READ (T(I), 99990, IOSTAT = IOST) N
            IF (IOST .NE. 0) THEN
              CALL PLA262 (1)
              WRITE (LU7, 99995, IOSTAT = IOST) F
              FNUM = 1.0
              GO TO 170
            END IF
            NUM1 = 10 * NUM1 + N
          END DO
          DO I = ISL + 1, I1
            IF (T(I) .EQ. ' ') EXIT
            READ (T(I), 99990, IOSTAT = IOST) N
            IF (IOST .NE. 0) THEN
              CALL PLA262 (1)
              WRITE (LU7, 99995, IOSTAT = IOST) F
              FNUM = 1.0
              GO TO 170
            END IF
            NUM2 = 10 * NUM2 + N
          END DO
          FNUM = FLOAT(NUM1) / FLOAT(NUM2)
        END IF
        IF (FNUM .EQ. 0.0) FNUM = 1.0
  170   DO 190 I = 1, 3
          J1  = (I - 1) * 10 + 1
          J2  = J1 + 9
          AUX = ' '
          JJ  = 0
          DO L = J1, J2
            if (DAT(L) .EQ. '/') THEN
              KKK     = 1
              NUMB(1) = 0
              NUMB(2) = 0
              NEG     = 1
              DO 180 K = J1, J2
                IF (DAT(K) .NE. ' ') THEN
                  IF (DAT(K) .NE. '/') THEN
                    IF (DAT(K) .EQ. '-') THEN
                      NEG = -1
                      GO TO 180
                    END IF
                    KK = ICHAR(DAT(K)) - ICHAR('0')
                    IF (KK .LT. 0 .OR. KK .GT. 9) THEN
                      WRITE (LU7, 99987, IOSTAT = IOST) DAT(K), DAT
                      RETURN
                    END IF
                    NUMB(KKK) = KK + 10 * NUMB(KKK)
                  ELSE
                    KKK = 2
                  END IF
                END IF
  180         CONTINUE
              F1     = NUMB(1) * NEG
              F2     = NUMB(2)
              POS(I) = F1 / F2
              GO TO 190
            END IF
            JJ = JJ + 1
            AUX(JJ:JJ) = DAT(L)
          END DO
          READ (AUX, 99989) POS(I)
  190   CONTINUE
      END IF
      IF (IFSH .EQ. 1) THEN
        DO J = 1, 3
          POS(J) = POS(J) - SH(J)
        END DO
      END IF
      IF (IFMAT .EQ. 2) THEN
        DO J = 1, 3
          X(J) = POS(1) * XMAT(1, J) + POS(2) * XMAT(2, J)
     1         + POS(3) * XMAT(3, J) - PLUS(J)
       END DO
       DO J = 1, 3
         POS(J) = X(J)
       END DO
      END IF
      IF (IFMAT .EQ. 1) THEN
         DO J = 1, 3
           POS(J) = 1.0 - POS(J)
         END DO
      END IF
      DO J = 1, 3
        DO WHILE (POS(J) .LT. -0.000001)
          POS(J) = POS(J) + 1.0
        END DO
        DO WHILE (POS(J) .GE. 0.999999)
          POS(J) = POS(J) - 1.0
        END DO
      END DO
      IF (IHEX .EQ. 1) THEN
        DO J = 1, 3
          IF (ABS(POS(J)) .LT. 0.001) POS(J) = 0.0
        END DO
      END IF
      IF (NIG .EQ. 0) THEN
        IF (IFMAT .GT. 0 .OR. IFSH .EQ. 1 .OR. IHEX .EQ. 1) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99994, IOSTAT = IOST) ELT1, ELT2, POS, F
        END IF
      END IF
      RETURN
99999 FORMAT (70A)
99998 FORMAT ('Error, no element name; Write this line again',
     1        /, 70A)
99997 FORMAT ('         ', 2A, 2X, '0         0         0')
99996 FORMAT ('Input  : ', 2A, 2X, 30A1, 5X, A)
99995 FORMAT ('WARNING : Error in reading occupation factor', A,
     1 ' we take value F=1')
99994 FORMAT ('Changed: ', A, A4, 1X, 3F9.5, 5X, A5, /)
99993 FORMAT (/, 'Coordinate Data Input:', /, 80('='), /,
     1 'Atom identification (1 or 2 letters and as option',
     2 ' a number),', /, 'the 3 coordinates (fractions are allowed)',
     3 ' and the occupation factor (if < 1).', /,
     4 'One record for each atom site in the assymmetric unit.', /,
     5 'For recognition of special positions, non-rational numbers',
     6 ' should', /, 'be given with at least 5 decimals, or as',
     7 ' fractions. The order', /, 'in which the sites of different',
     8 ' elements are entered determines', /, 'the indenting in the',
     9 ' final atom site list. Coordinates for mixed', /, 'sites',
     * ' should be entered only once, with a dummy element name.', /,
     1 'The program will THEN ask you to define the actual',
     2 ' occupation.')
99992 FORMAT (80('='))
99991 FORMAT (F5.1)
99990 FORMAT (I1)
99989 FORMAT (F10.5)
99988 FORMAT ('Items should by separated by at least one blank.',
     1 ' Write this line again')
99987 FORMAT (' Unrecognized number in SUBROUTINE PLA304 : ',
     1        A1, 2X, 30A1)
      END SUBROUTINE PLA304
      SUBROUTINE PLA305 (NATOM, IG, IK, NELT, AX, TEXT, O1, O2, O3,
     1                   NSP)
      PARAMETER (NUMAT=150, NSET=120, NELTS=16, NDIF=30)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM (3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /STBL4/ IPOL, R, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /BUR/ NT, SPGR
      COMMON /ELTNAME/ FINELT
      COMMON /NUM/ NEL, NEWN, NR(NDIF), MAXNR(NDIF)
      COMMON /ORD/ X(3, NUMAT), MUL(NUMAT), LET(NUMAT),
     1 HORSUM(NUMAT, NSET), SUM(3, NSET), SXY(NSET), SXZ(NSET),
     2 SYZ(NSET)
      COMMON /RES/ ATOM1, ATOM2, FOC, INTXT, CODE, ELT
      COMMON /SP/ NSPEC, NW, NSUMMY(79)
      CHARACTER ELT(NELTS)*2, ATOM1(NUMAT)*2, ATOM2(NUMAT)*4,
     1 FOC(NUMAT)*5
      CHARACTER CODE(2)*1, NT(16)*1, WSEQ(108)*1, SPGR*10
      CHARACTER NEWELT*11, AUX*3, FINELT(NDIF)*2, AX*47, TEXT*17,
     1 INTXT*40
      CHARACTER COORD(3)*8
      DIMENSION KATOM(NUMAT), T(3, NUMAT), KY(NUMAT), KZ(NUMAT),
     1 NWYCK(27), XX(3), NSP(NUMAT), NP(NUMAT)
      CHARACTER SPGP(230)*10, PSYM(47)*14, FORMS(15)*16, LATICE(6)*1,
     1 HBR(7)*1, XELN(105)*2, KOORD(12)*8, CHORI(9)*3, STAA(107)*11,
     2 STBB(39)*15, STCSH(17)*14, STTEXT(21)*17
      COMMON /ORGIN/ NOR, ORGADD(3, 8), NTEXT, ICOORD
      CHARACTER TRATXT*69, ORTXT*37, AUX1*6, NWELT*11
      DIMENSION OR(3), ORI(9)
      DATA ORI /
     1  0.125, 0.25, 0.375, 0.5, 0.625, 0.75, 0.875, 0.3333, 0.6667/
c offset for conversion number -> CHARACTER :
c ik is index in arrays sum,sxy,sxz,syz :
      CALL GEN097 (NR,     1, NDIF, 0)
      CALL GEN097 (MAXNR,  1, NDIF, 0)
      CALL GEN097 (NWYCK,  1, 27,   0)
      CALL GEN126 (FINELT, 1, NDIF)
      CALL GEN126 (WSEQ,   1, 108)
      IF (IG .LT. 0) THEN
        KN = -IG
      ELSE
        KN = 1
      END IF
      NN     = 0
      EPS    = 0.0001
      KOUNTY = 0
      KOUNTZ = 0
      KTY    = 0
      KTZ    = 0
      NSPOS  = 0
      NEL    = 0
      MX     = 1
      MY     = 1
      MZ     = 1
      MAXORD = NSPEC + 1
      DO 110 II = 1, MAXORD
        K = MAXORD + 1 - II
        KT = 0
        DO I = 1, NATOM
          KK = LET(I)
          IF (KK .EQ. K) THEN
            KT = KT + 1
            DO J = 1, 3
              T(J, KT) = X(J, I)
            END DO
            NP(KT)    = NSP(I)
            NSPOS     = NP(KT)
            KATOM(KT) = I
          END IF
        END DO
        IF (KT .NE. 0) THEN
          KOUNT = 0
   10     XMIN  = 2.0
          MEQ   = 0
          DO 30 IX = 1, KT
            DO J = 1, 3
              IF (T(J, IX) .GT. 9.0) GO TO 30
            END DO
            IF (ABS(T(1, IX) - XMIN) .GE. EPS) THEN
              IF (T(1, IX) .LT. XMIN) THEN
                XMIN = T(1, IX)
                MX   = IX
                MEQ  = 0
                GO TO 30
              ELSE IF (T(1, IX) .EQ. XMIN) THEN
                GO TO 20
              ELSE
                GO TO 30
              END IF
            END IF
   20       MEQ = 1
            MX  = ix
   30     CONTINUE
          IGO = 1
          IF (MEQ .NE. 1) THEN
            L = KATOM(MX)
            CALL PLA321 (L)
            IPOS = LET(L)
            IF (IG .LE. 1) THEN
              DO J = 1, 3
                XX(J) = T(J, MX)
              END DO
              NSPOS = NP(MX)
              IPR   = 1
            ELSE
              NN = NN + 1
              HORSUM(NN, IK) = T(1, MX) + T(2, MX) + T(3, MX)
              IPR = 0
            END IF
            KOUNT    = KOUNT + 1
            T(1, MX) = 10.0
            IF (KOUNT .LT. KT) IGO = 2
            GO TO 80
          END IF
          KTY = 0
          DO IY = 1, KT
            IF (ABS(T(1, IY) - T(1, MX)) .LE. EPS) THEN
              KTY     = KTY + 1
              KY(KTY) = IY
            END IF
          END DO
          KOUNTY = 0
   40     YMIN   = 2.0
          MEQ    = 0
          DO 60 J = 1, KTY
            IY = KY(J)
            IF (ABS(T(2, IY) - YMIN) .GE. EPS) THEN
              IF (T(2, IY) .LT. YMIN) THEN
                YMIN = T(2, IY)
                MY   = IY
                MEQ  = 0
                GO TO 60
              ELSE IF (T(2, IY) .EQ. YMIN) THEN
                GO TO 50
              ELSE
                GO TO 60
              END IF
            END IF
   50       MEQ = 1
            MY  = IY
   60     CONTINUE
          IF (MEQ .NE. 1) THEN
            L = KATOM(MY)
            CALL PLA321 (L)
            IPOS = LET(L)
            IF (IG .LE. 1) THEN
              IPR   = 1
              DO J = 1, 3
                XX(J) = T(J, MY)
              END DO
              NSPOS = NP(MY)
            ELSE
              IPR = 0
              NN  = NN + 1
              HORSUM(NN, IK) = T(1, MY) + T(2, MY) + T(3, MY)
            END IF
            KOUNT    = KOUNT  + 1
            KOUNTY   = KOUNTY + 1
            T(2, MY) = 10.0
            IGO      = 1
            IF (KOUNTY .LT. KTY) THEN
              IGO = 3
            ELSE IF (KOUNT .LT. KT) THEN
              IGO = 2
            END IF
            GO TO 80
          END IF
          KTZ = 0
          DO IZ = 1, KT
            IF (ABS(T(1, MX) - T(1, IZ)) .LE. EPS) THEN
              IF (ABS(T(2, IZ) - T(2, MY)) .LE. EPS) THEN
                KTZ     = KTZ + 1
                KZ(KTZ) = IZ
              END IF
            END IF
          END DO
          KOUNTZ = 0
   70     ZMIN   = 2.0
          MEQ    = 0
          DO J = 1, KTZ
            IZ = KZ(J)
            IF (ABS(T(3, IZ) - ZMIN) .GE. EPS) THEN
              IF (T(3, IZ) .LT. ZMIN) THEN
                ZMIN = T(3, IZ)
                MZ   = IZ
                MEQ  = 0
              END IF
            END IF
          END DO
          L = KATOM(MZ)
          CALL PLA321 (L)
          IPOS = LET(L)
          IF (IG .LE. 1) THEN
            IPR   = 1
            DO J = 1, 3
              XX(J) = T(J, MZ)
            END DO
            NSPOS = NP(MZ)
          ELSE
            IPR = 0
            NN  = NN + 1
            HORSUM(NN, IK) = T(1, MZ) + T(2, MZ) + T(3, MZ)
          END IF
          KOUNT    = KOUNT + 1
          KOUNTY   = KOUNTY + 1
          KOUNTZ   = KOUNTZ + 1
          T(3, MZ) = 10.0
          T(2, MZ) = 10.0
          IGO      = 1
          IF (KOUNTZ .LT. KTZ) THEN
            IGO = 4
          ELSE IF (KOUNTY .LT. KTY) THEN
            IGO = 3
          ELSE IF (KOUNT .LT. KT) THEN
            IGO = 2
          END IF
   80     IF (IPR .EQ. 1) THEN
            NEWELT = ' '
            AUX    = ' '
            NWYCK(IPOS) = NWYCK(IPOS) + 1
            IF (ATOM1(L)(1:1) .EQ. 'X') THEN
              NEWELT(1:2) = ATOM1(L)
              JJ = 2
              IF (NEWELT(2:2) .EQ. ' ') JJ = 1
              GO TO 100
            END IF
            DO I = 1, NELT
              IF (ATOM1(L) .EQ. ELT(I)) THEN
                K = 0
                DO J = 1, I
                  IF (ELT(J)(1:1) .NE. 'X') K = K + 1
                END DO
                K             = K + 1
                NEWELT(K:K+1) = ELT(I)
                JJ = K + 1
                IF (NEWELT(K + 1:K + 1) .EQ. ' ') JJ = K
                GO TO 90
              END IF
            END DO
            WRITE (LU7, 99991, IOSTAT = IOST) ATOM1(L), NELT
            NEWELT(1:2) = ATOM1(L)
            JJ = 1
   90       WRITE (AUX, 99989, IOSTAT = IOST) NEWN
            K = 0
            DO J = 1, 3
              IF (AUX(J:J) .NE. ' ') THEN
                K = K + 1
                AUX(K:K) = AUX(J:J)
              END IF
            END DO
            IF (K .LT. 3) AUX(K+1:3) = ' '
            NEWELT(JJ + 1:JJ + 3) = AUX
            IF (NSPOS .GT. 0) THEN
              DO I = 1, 3
                IF (KSPEC(I, NSPOS) .EQ. 0) THEN
                  WRITE (COORD(I), 99998, IOSTAT = IOST) XX(I)
                ELSE
                  COORD(I) = KOORD(KSPEC(I, NSPOS))
                END IF
              END DO
            ELSE
              DO I = 1, 3
                WRITE (COORD(I), 99998, IOSTAT = IOST) XX(I)
                COORD(I)(1:1) = ' '
              END DO
            END IF
            DO J = 1, 5
              IF (FOC(L)(J:J) .EQ. '.') THEN
                READ (FOC(L), 99988) FFOC
                FOC(L) = ' '
                WRITE (FOC(L)(1:4), 99987, IOSTAT = IOST) FFOC
                GO TO 100
              END IF
            END DO
  100       WRITE (LU63, 99993, IOSTAT = IOST)
     1        NEWELT, MUL(L), CHAR(96 + IPOS),
     1        COORD, FOC(L), ATOM2(L)
            WRITE (LU6,  99992, IOSTAT = IOST) NEWELT, MUL(L),
     1        CHAR(96 + IPOS), COORD, FOC(L), ATOM1(L), ATOM2(L)
            NWELT = ' '
            M = 0
            DO N = 1, 11
              IF (NEWELT(N:N) .NE. ' ') THEN
                M = M + 1
                NWELT(M:M) = NEWELT(N:N)
              END IF
            END DO
            WRITE (LU21, 99984, IOSTAT = IOST) NWELT, (XX(N), N = 1, 3)
          END IF
          IF (IGO .EQ. 1) THEN
            GO TO 110
          ELSE IF (IGO .EQ. 2) THEN
            GO TO 10
          ELSE IF (IGO .EQ. 3) THEN
            GO TO 40
          ELSE IF (IGO .EQ. 4) THEN
            GO TO 70
          END IF
        END IF
  110 CONTINUE
      IF (IG .GT. 1) RETURN
      J = 0
      DO I = 27, 1, -1
        IF (NWYCK(I) .NE. 0) THEN
          J       = J + 1
          WSEQ(J) = CHAR(96 + I)
          N = NWYCK(I)
          IF (N .GT. 1) THEN
            WRITE (AUX, 99989, IOSTAT = IOST) N
            DO K = 1, 3
              IF (AUX(K:K) .NE. ' ') THEN
                J = J + 1
                WSEQ(J) = AUX(K:K)
              END IF
            END DO
          END IF
          J       = J + 1
          WSEQ(J) = ' '
        END IF
      END DO
      WRITE (LU6,  99990, IOSTAT = IOST) WSEQ
      WRITE (LU63, 99994, IOSTAT = IOST) NGR, SPGR, (WSEQ(K), K = 1, 47)
      DO J = 48, 94
        IF (WSEQ(J) .NE. ' ') THEN
          WRITE (LU63, 99995, IOSTAT = IOST) (WSEQ(K), K = 48, 94)
          EXIT
        END IF
      END DO
      DO J = 95, 108
        IF (WSEQ(J) .NE. ' ') THEN
          WRITE (LU63, 99995, IOSTAT = IOST) (WSEQ(K), K = 95, 108)
          EXIT
        END IF
      END DO
      AUX1   = ' '
      TRATXT = ' '
      ORTXT  = ' '
      OR(1)  = O1
      OR(2)  = O2
      OR(3)  = O3
      LAX = 47
      IF (AX .EQ. 'abc' .OR. AX .EQ. 'a,b,c') THEN
        LAX = 0
      ELSE
        NBL = 0
        DO I = 1, 47
          IF (AX(I:I) .EQ. ' ') THEN
            NBL = NBL + 1
            IF (NBL .EQ. 2) THEN
              LAX = I - 2
              GO TO 120
            END IF
          END IF
        END DO
      END IF
  120 LXYZ = 17
      IF (TEXT .EQ. 'x,y,z') THEN
        LXYZ = 0
      ELSE
        NBL = 0
        DO I = 1, 17
          IF (TEXT(I:I) .EQ. ' ') THEN
            NBL = NBL + 1
            IF (NBL .EQ. 2) THEN
              LXYZ = I - 2
              GO TO 130
            END IF
          END IF
        END DO
      END IF
  130 I1 = 1
      IF (LAX .GT. 0) THEN
        TRATXT(I1:LAX + 4) = AX(1:LAX)//'     '
        I1 = I1 + LAX + 5
      END IF
      IF (LXYZ .GT. 0) THEN
        TRATXT(I1: LXYZ + 4) = TEXT(1:LXYZ)//'     '
        I1 = I1 + LXYZ + 5
      END IF
      I1 = I1 -1
      LORI = 1
      IF (O1 .EQ. 0. .AND. O2 .EQ. 0. .AND. O3 .EQ. 0.) THEN
        IF (LAX .EQ. 0 .AND. LXYZ .EQ. 0) GO TO 170
        GO TO 160
      ELSE
        IF (LAX .EQ. 0 .AND. LXYZ .EQ. 0) THEN
          ORTXT(LORI:LORI+6) = 'Origin '
        ELSE
          ORTXT(LORI:LORI+6) = 'origin '
        END IF
        LORI                 = LORI + 7
      END IF
      DO 150 KEER = 1, 3
        IF ((ICOORD .EQ. 1 .AND. KEER .EQ. 3) .OR.
     1      (ICOORD .EQ. 2 .AND. KEER .EQ. 2) .OR.
     2      (ICOORD .EQ. 3 .AND. KEER .EQ. 1) .OR.
     3      (ICOORD .EQ. 3 .AND. KEER .EQ. 3)) GO TO 140
        IF (ICOORD .NE. 4) THEN
          IF (OR(KEER) .EQ. 0.0) THEN
            ORTXT(LORI:LORI+1) = ' 0'
            LORI               = LORI + 2
          ELSE
            DO I = 1, 9
              IF (ABS(OR(KEER) - ORI(I)) .LE. 0.0001) THEN
                ORTXT(LORI:LORI + 3) = ' '//CHORI(I)(1:3)
                LORI                 = LORI + 4
                GO TO 150
              END IF
            END DO
            GO TO 140
          END IF
          GO TO 150
        END IF
  140   ORTXT(LORI:LORI) = ' '
        AUX1 = ' '
        WRITE (AUX1, 99985, IOSTAT = IOST) OR(KEER)
        ORTXT(LORI + 1:LORI + 6) = AUX1(1:6)
        LORI                     = LORI + 7
  150 CONTINUE
  160 IF (I1 .GT. 0) THEN
        WRITE (LU63, 99986, IOSTAT = IOST) TRATXT(1:I1), ORTXT(1:LORI)
      ELSE
        WRITE (LU63, 99986, IOSTAT = IOST) ORTXT(1:LORI)
      END IF
  170 CG = 0.0
      IF (VOL .GT. 0.0001) THEN
        V = VOL**0.333333
        WRITE (LU6, 99996, IOSTAT = IOST) VOL
        IF (VOLRAT .GT. 0.0) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99997, IOSTAT = IOST) VOLRAT
        END IF
        CG = SQRT ((A * SUM(1, KN))**2 + (B * SUM(2, KN))**2
     1   + (C * SUM(3, KN))**2 + 2.0 * (A * B * SXY(KN) * COSG
     2   + A * C * COSB * SXZ(KN) + B * C * COSA * SYZ(KN)))
     3   / (NATOM * V)
      END IF
      WRITE (LU63, 99999, IOSTAT = IOST) CG
      RETURN
99999 FORMAT ('CG', F8.4)
99998 FORMAT (F8.5)
99997 FORMAT ('Ratio volume Niggli-reduced cell/original cell : ',f5.2)
99996 FORMAT (/, 'Volume of Unit Cell : ', F10.4)
99995 FORMAT ('SPCGRP', 27x, 47A1)
99994 FORMAT('SPCGRP (', I3, ') ', A, ' - ', 47A1)
99993 FORMAT ('ATOM', 3X, A, I3, '(', A, ')', 2X, 3A, 1X, A, 13X, A)
99992 FORMAT (5X, A, I3, '(', A, ')', 1X, 3A, 1X, A, 20X, 2A)
99991 FORMAT ('Element ', A2, ' is not in list of first ', I2,
     1 /' elements so it will not have the correct indentation.')
99990 FORMAT (/, 'Wyckoff sequence : ', 108a1)
99989 FORMAT (I3)
99988 FORMAT (F5.3)
99987 FORMAT (F4.3)
99986 FORMAT ('TRANS  ', 2A)
99985 FORMAT (F6.5)
99984 FORMAT (A, 3F10.4)
      END SUBROUTINE PLA305
      SUBROUTINE PLA306 (NUM)
      COMMON /ORGIN/ NOR, ORGADD(3, 8), NTEXT, ICOORD
      DIMENSION IGROUP(230)
      DATA IGROUP /
     1 10,  1, 17, 17, 18, 19, 19, 20, 20,  1,  1,  6,  1,  1,  6,  1,
     2  1,  1,  1,  6,  6,  7,  6,  6, 11, 11, 11, 11, 11, 11, 11, 11,
     3 11, 11, 12, 12, 12, 13, 13, 13, 13, 14, 14, 12, 12, 12,  1,  1,
     4  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  6,  6,
     5  6,  6,  6,  6,  4,  4,  6,  6,  6,  6, 15, 15, 15, 15, 14, 14,
     6  2,  8,  2,  2,  2,  2,  3,  3,  2,  2,  2,  2,  2,  2,  2,  2,
     7  3,  3, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14,  2,  2,
     8  2,  2,  2,  2,  2,  2,  8,  8,  3,  3,  2,  2,  2,  2,  2,  2,
     9  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  3,  3,  3,  3, 16, 16,
     * 16, 14,  3,  3,  5,  3,  5,  3,  5,  3,  3, 16, 14, 16, 14, 14,
     1 14,  3,  3,  3,  3,  3,  3, 14, 14, 14, 14, 14, 14,  5,  3,  3,
     2  3,  3,  3,  3,  3,  3, 14, 14, 14, 14,  5,  5,  3,  3,  3,  3,
     3  3,  3,  4,  7,  9,  4,  9,  4,  4,  4,  4,  9,  4,  9,  4,  4,
     4  4,  4,  9,  4,  4,  9,  4,  7,  9,  4,  7,  9,  4,  4,  4,  4,
     5  4,  4,  4,  4,  9,  9/
      DO I = 1, 8
        DO J = 1, 3
          ORGADD(J, I) = 0.0
        END DO
      END DO
      SELECT CASE (IGROUP(NUM))
        CASE (1)
          NOR          = 8
          ORGADD(1, 2) = 0.5
          ORGADD(2, 3) = 0.5
          ORGADD(3, 4) = 0.5
          ORGADD(2, 5) = 0.5
          ORGADD(3, 5) = 0.5
          ORGADD(1, 6) = 0.5
          ORGADD(3, 6) = 0.5
          ORGADD(1, 7) = 0.5
          ORGADD(2, 7) = 0.5
          ORGADD(1, 8) = 0.5
          ORGADD(2, 8) = 0.5
          ORGADD(3, 8) = 0.5
c 0 0 0, 0 0 1/2, 1/2 1/2 0, 1/2 1/2 1/2
        CASE (2)
          NOR          = 4
          ORGADD(3, 2) = 0.5
          ORGADD(1, 3) = 0.5
          ORGADD(2, 3) = 0.5
          ORGADD(1, 4) = 0.5
          ORGADD(2, 4) = 0.5
          ORGADD(3, 4) = 0.5
        CASE (3)
          NOR          = 2
          ORGADD(3, 2) = 0.5
        CASE (4)
          NOR          = 2
          ORGADD(1, 2) = 0.5
          ORGADD(2, 2) = 0.5
          ORGADD(3, 2) = 0.5
        CASE (5)
          NOR          = 6
          ORGADD(3, 2) = 0.5
          ORGADD(1, 3) = 1.0 / 3.0
          ORGADD(2, 3) = 2.0 / 3.0
          ORGADD(1, 4) = 1.0 / 3.0
          ORGADD(2, 4) = 2.0 / 3.0
          ORGADD(3, 4) = 0.5
          ORGADD(1, 5) = 2.0 / 3.0
          ORGADD(2, 5) = 1.0 / 3.0
          ORGADD(1, 6) = 2.0 / 3.0
          ORGADD(2, 6) = 1.0 / 3.0
          ORGADD(3, 6) = 0.5
        CASE (6)
          NOR          = 4
          ORGADD(3, 2) = 0.5
          ORGADD(2, 3) = 0.5
          ORGADD(2, 4) = 0.5
          ORGADD(3, 4) = 0.5
        CASE (7)
          NOR          = 4
          ORGADD(1, 2) = 0.25
          ORGADD(2, 2) = 0.25
          ORGADD(3, 2) = 0.25
          ORGADD(1, 3) = 0.5
          ORGADD(2, 3) = 0.5
          ORGADD(3, 3) = 0.5
          ORGADD(1, 4) = 0.75
          ORGADD(2, 4) = 0.75
          ORGADD(3, 4) = 0.75
        CASE (8)
          NOR          = 4
          ORGADD(3, 2) = 0.5
          ORGADD(2, 3) = 0.5
          ORGADD(3, 3) = 0.25
          ORGADD(2, 4) = 0.5
          ORGADD(3, 4) = 0.75
        CASE (9)
          NOR = 1
c x y z
        CASE (10)
          NOR = -31
        CASE (11)
          NOR          = -4
          ORGADD(2, 2) = 0.5
          ORGADD(1, 3) = 0.5
          ORGADD(1, 4) = 0.5
          ORGADD(2, 4) = 0.5
        CASE (12)
          NOR          = -2
          ORGADD(2, 2) = 0.5
        CASE (13)
          NOR          = -2
          ORGADD(1, 2) = 0.5
        CASE (14)
          NOR = -1
        CASE (15)
          NOR          = -2
          ORGADD(1, 2) = 0.5
          ORGADD(2, 2) = 0.5
        CASE (16)
          NOR          = -3
          ORGADD(1, 2) = 1.0 / 3.0
          ORGADD(2, 2) = 2.0 / 3.0
          ORGADD(1, 3) = 2.0 / 3.0
          ORGADD(2, 3) = 1.0 / 3.0
        CASE (17)
          NOR          = -14
          ORGADD(3, 2) = 0.5
          ORGADD(1, 3) = 0.5
          ORGADD(1, 4) = 0.5
          ORGADD(3, 4) = 0.5
c 0 y 0, 0 y 1/2
        CASE (18)
          NOR          = -12
          ORGADD(3, 2) = 0.5
        CASE (19)
          NOR          = -22
          ORGADD(2, 2) = 0.5
c x 0 z
        CASE (20)
          NOR = -21
      END SELECT
      RETURN
      END SUBROUTINE PLA306
      SUBROUTINE PLA307 (N, IER)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /STBL4/ IPOL, R, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /BUR/ NT, SPGR
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      CHARACTER AXES*9, NT(16)*1, SPGR*10
      EPS  = 0.0001
      ALF  = AL / R
      BET  = BE / R
      GAM  = GA / R
      COSA = COS(ALF)
      COSB = COS(BET)
      COSG = COS(GAM)
   10 SELECT CASE (N)
        CASE (1)
          AXES = 'b,c,a'
          AN   = B
          BN   = C
          CN   = A
          BEN  = GA
        CASE (2)
          AXES = 'c,a,b'
          AN   = C
          BN   = A
          CN   = B
          BEN  = AL
        CASE (3)
          AXES = 'a,-c,b'
          AN   = A
          BN   = C
          CN   = B
          BEN  = GA
        CASE (4)
          AXES = 'b,-a,c'
          AN   = B
          BN   = A
          CN   = C
          BEN  = AL
        CASE (5)
          AXES = 'c,-b,a'
          AN   = C
          BN   = B
          CN   = A
          BEN  = BE
        CASE (6)
          IF (AL .LT. 90.0) THEN
            N = 18
            GO TO 10
          END IF
          IF (C .LT. B) THEN
            N = 12
            GO TO 10
          END IF
          AXES = '-b,a,b+c'
          AN   = B
          BN   = A
          CN   = SQRT(B**2 + C**2 + 2.0 * B * C * COSA)
          IF (B .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS (-((B**2 + CN**2 - C**2) / (2.0 * B * CN)))
        CASE (7)
          IF (AL .LT. 90.0) THEN
            N = 19
            GO TO 10
          END IF
          IF (B .LT. C) THEN
            N = 13
            GO TO 10
          END IF
          AXES = '-b-c,a,c'
          AN2  = B**2 + C**2 + 2.0 * B * C * COSA
          AN   = SQRT(AN2)
          BN   = A
          CN   = C
          IF (C .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + C**2 - B**2) / (2.0 * AN * C)))
        CASE (8)
          IF (BE .LT. 90.0) THEN
            N = 20
            GO TO 10
          END IF
          IF (A .LT. C) THEN
            N = 14
            GO TO 10
          END IF
          AXES = '-c,b,a+c'
          AN   = C
          BN   = B
          CN2  = A**2 + C**2 + 2.0 * A * C * COSB
          CN   = SQRT(CN2)
          IF (C .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((C**2 + CN2 - A**2) / (2.0 * C * CN)))
        CASE (9)
          IF (BE .LT. 90.0) THEN
            N = 21
            GO TO 10
          END IF
          IF (C .LT. A) THEN
            N = 15
            GO TO 10
          END IF
          AXES = '-a-c,b,a'
          AN2  = A**2 + C**2 + 2.0 * A * C * COSB
          AN   = SQRT(AN2)
          BN   = B
          CN   = A
          IF (A .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN = R * ACOS(-((AN2 + A**2 - C**2) / (2.0 * AN * A)))
        CASE (10)
          IF (GA .LT. 90.0) THEN
            N = 22
            GO TO 10
          END IF
          IF (B .LT. A) THEN
            N = 16
            GO TO 10
          END IF
          AXES = '-a,c,a+b'
          AN   = A
          BN   = C
          CN2  = A**2 + B**2 + 2.0 * A * B * COSG
          CN   = SQRT(CN2)
          IF (A .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((CN2 + A**2 - B**2) / (2.0 * CN * A)))
        CASE (11)
          IF (ga .LT. 90.0) THEN
            N = 23
            GO TO 10
          END IF
          IF (A .LT. B) THEN
            N = 17
            GO TO 10
          END IF
          AXES = '-a-b,c,b'
          AN2  = A**2 + B**2 + 2.0 * A * B * COSG
          BN   = C
          CN   = B
          AN   = sqrt(AN2)
          IF (B .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + B**2 - A**2) / (2.0 * AN * B)))
        CASE (12)
          AXES = '-c,-a,b+c'
          AN   = C
          BN   = A
          CN2  = B**2 + C**2 + 2.0 * B * C * COSA
          CN   = SQRT(CN2)
          IF (C .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((C**2 + CN2 - B**2) / (2.0 * CN * C)))
        CASE (13)
          AXES = '-b-c,-a,b'
          AN2  = B**2 + C**2 + 2.0 * B * C * COSA
          AN   = SQRT(AN2)
          BN   = A
          CN   = B
          IF (B .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + B**2 - C**2) / (2.0 * AN * B)))
        CASE (14)
          AXES = '-a,-b,a+c'
          AN   = A
          BN   = B
          CN2  = A**2 + C**2 + 2.0 * A * C * COSB
          CN   = SQRT(CN2)
          IF (A .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((A**2 + CN2 - C**2) / (2.0 * A * CN)))
        CASE (15)
          AXES = '-a-c,-b,c'
          AN2  = A**2 + C**2 + 2.0 * A * C * COSB
          AN   = SQRT(AN2)
          BN   = B
          CN   = C
          IF (C .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + C**2 - A**2) / (2.0 * AN * C)))
        CASE (16)
          AXES = '-b,-c,a+b'
          AN   = B
          BN   = C
          CN2  = A**2 + B**2 + 2.0 * A * B * COSG
          CN   = SQRT(CN2)
          IF (B .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((CN2 + B**2 - A**2) / (2.0 * CN * B)))
        CASE (17)
          AXES = '-a-b,-c,a'
          AN2  = A**2 + B**2 + 2.0 * A * B * COSG
          BN   = C
          CN   = A
          AN   = SQRT(AN2)
          IF (A .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + A**2 - B**2) / (2.0 * AN * A)))
        CASE (18)
          IF (C .LT. B) THEN
            N = 24
            GO TO 10
          END IF
          AXES = 'b,-a,c-b'
          AN   = B
          BN   = A
          CN2  = B**2 + C**2 - 2.0 * B * C * COSA
          CN   = SQRT(CN2)
          IF (B .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((B**2 + CN2 - C**2) / (2.0 * B * CN)))
        CASE (19)
          IF (B .LT. C) THEN
            N = 25
            GO TO 10
          END IF
          AXES = 'b-c,-a,c'
          AN2  = B**2 + C**2 - 2.0 * B * C * COSA
          AN   = SQRT(AN2)
          BN   = A
          CN   = C
          IF (C .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + C**2 - B**2) / (2.0 * AN * C)))
        CASE (20)
          IF (A .LT. C) THEN
            N = 26
            GO TO 10
          END IF
          AXES = 'c,-b,a-c'
          AN   = C
          BN   = B
          CN2  = A**2 + C**2 - 2.0 * A * C * COSB
          CN   = SQRT(CN2)
          IF (C .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((C**2 + CN2 - A**2) / (2.0 * C * CN)))
        CASE (21)
          IF (C .LT. A) THEN
            N = 27
            GO TO 10
          END IF
          AXES = 'c-a,-b,a'
          AN2  = A**2 + C**2 - 2.0 * A * C * COSB
          AN   = SQRT(AN2)
          BN   = B
          CN   = A
          IF (A .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + A**2 - C**2) / (2.0 * AN * A)))
        CASE (22)
          IF (B .LT. A) THEN
            N = 28
            GO TO 10
          END IF
          AXES = 'a,-c,b-a'
          AN   = A
          BN   = C
          CN2  = A**2 + B**2 - 2.0 * A * B * COSG
          CN   = SQRT(CN2)
          IF (A .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((CN2 + A**2 - B**2) / (2.0 * CN * A)))
        CASE (23)
          IF (A .LT. B) THEN
            N = 29
            GO TO 10
          END IF
          AXES = 'a-b,-c,b'
          AN2  = A**2 + B**2 - 2.0 * A * B * COSG
          BN   = C
          CN   = B
          AN   = SQRT(AN2)
          IF (B .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + B**2 - A**2) / (2.0 * AN * B)))
        CASE (24)
          AXES = 'c,a,b-c'
          AN   = C
          BN   = A
          CN2  = B**2 + C**2 - 2.0 * B * C * COSA
          CN   = SQRT(CN2)
          IF (C .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((C**2 + CN2 - B**2) / (2.0 * C * CN)))
        CASE (25)
          AXES = 'c-b,a,b'
          AN2  = B**2 + C**2 - 2.0 * B * C * COSA
          AN   = SQRT(AN2)
          BN   = A
          CN   = B
          IF (B .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + B**2 - C**2) / (2.0 * AN * B)))
c a,b,c-a
        CASE (26)
          AXES = 'a,b,c-a'
          AN   = A
          BN   = B
          CN2  = A**2 + C**2 - 2.0 * A * C * COSB
          CN   = SQRT(CN2)
          IF (A .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((A**2 + CN2 - C**2) / (2.0 * A * CN)))
c a-c,b,c
        CASE (27)
          AXES = 'a-c,b,c'
          AN2  = A**2 + C**2 - 2.0 * A * C * COSB
          AN   = SQRT(AN2)
          BN   = B
          CN   = C
          IF (C .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + C**2 - A**2) / (2.0 * AN * C)))
c b,c,a-b
        CASE (28)
          AXES = 'b,c,a-b'
          AN   = B
          BN   = C
          CN2  = A**2 + B**2 - 2.0 * A * B * COSG
          CN   = SQRT(CN2)
          IF (B .LT. EPS .OR. CN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((CN2 + B**2 - A**2) / (2.0 * CN * B)))
        CASE (29)
          AXES = 'b-a,c,a'
          AN2  = A**2 + B**2 - 2.0 * A * B * COSG
          BN   = C
          CN   = A
          AN   = sqrt(AN2)
          IF (A .LT. EPS .OR. AN .LT. EPS) GO TO 20
          BEN  = R * ACOS(-((AN2 + A**2 - B**2) / (2.0 * AN * A)))
      END SELECT
      a  = an
      b  = bn
      c  = cn
      be = ben
      IF (be .EQ. 0.0) be = 90.0
      IFMAT = 2
      CALL PLA262 (2)
      WRITE (LU7, 99999, IOSTAT = IOST) SPGR, AXES, A, B, C, BE
      RETURN
   20 CALL PLA262 (1)
      WRITE (LU7, 99998, IOSTAT = IOST)
      IER = 1
      RETURN
99999 FORMAT ('Transformation of axes into standard setting ',
     1 A, ' : ', A, /, 'New axes :', 3F8.4, 5X, 'beta=', F6.2)
99998 FORMAT ('Division by 0; no transformation performed.')
      END SUBROUTINE PLA307
      SUBROUTINE PLA308
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /MESSA/ IW
      COMMON /TRANS/ S(9), U(9), T(9), P(9)
      CHARACTER AXES*6
      DIMENSION PL(3)
c
      AXES  = 'a,b,c'
      AXTOL = 0.005
      IAB   = 0
      IBC   = 0
      MINSH = 0
      II    = IW - 6
      CALL GEN074 (U, 1, 9, 0.0)
      IF (II .EQ. 1 .OR. II .EQ. 4 .OR. II .EQ. 7 .OR. II .EQ. 8) THEN
        IF (ABS(A - B) .LT. AXTOL) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99998, IOSTAT = IOST) A, B
          IAB = 1
        END IF
        IF (ABS(B - C) .LT. AXTOL) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99997, IOSTAT = IOST) B, C
          IBC = 1
        END IF
        IF (IAB .EQ. 1 .AND. IBC .EQ. 1) RETURN
        IF (A .LT. B) THEN
          IF (B .GT. C) THEN
            IF (A .LT. C) THEN
              IF (IW .EQ. 14) RETURN
c a-cb
              AXES  = 'a,-c,b'
              CALL GEN018 (B, C)
              U(1)  = 1.0
              U(6)  =-1.0
              U(8)  = 1.0
              MINSH = 2
c x-1/4 -z-1/4 y-1/4
              IF (IW .EQ. 10) THEN
                PL(1) = 0.25
                PL(2) = 0.25
                PL(3) = 0.25
                NABC  = 5
              END IF
              IF (IW .EQ. 13) THEN
                PL(1) = 0.25
                PL(3) = 0.25
                NABC  = 12
              END IF
            ELSE
              AXES = 'c,a,b'
              X    = C
              C    = B
              B    = A
              A    = X
              U(3) = 1.0
              U(4) = 1.0
              U(8) = 1.0
            END IF
          END IF
        ELSE
          IF (B .LT. C) THEN
            IF (A .LT. C) THEN
              IF (IW .EQ. 14) THEN
c bca  (for Pbca, IW=14)
                AXES = 'b,c,a'
                X    = B
                B    = C
                C    = A
                A    = X
                U(2) = 1.0
                U(6) = 1.0
                U(7) = 1.0
                GO TO 10
              END IF
              AXES  = 'b,a,-c'
              CALL GEN018 (A, B)
              U(2)  = 1.0
              U(4)  = 1.0
              U(9)  =-1.0
              MINSH = 3
              IF (IW .EQ. 10) THEN
                PL(1) = 0.25
                PL(2) = 0.25
                PL(3) = 0.25
                NABC  = 5
              END IF
              IF (IW .EQ. 13) THEN
                PL(1) = 0.25
                PL(2) = 0.25
                NABC  = 6
              END IF
            ELSE
              AXES = 'b,c,a'
              X    = B
              B    = C
              C    = A
              A    = X
              U(2) = 1.0
              U(6) = 1.0
              U(7) = 1.0
            END IF
          ELSE
            IF (IW .EQ. 14) THEN
              AXES = 'c,a,b'
              X    = C
              C    = B
              B    = A
              A    = X
              U(3) = 1.0
              U(4) = 1.0
              U(8) = 1.0
              GO TO 10
            END IF
            AXES  = '-c,b,a'
            CALL GEN018 (A, C)
            U(3)  =-1.0
            U(5)  = 1.0
            U(7)  = 1.0
            MINSH = 1
            IF (IW .EQ. 10) THEN
              PL(1) = 0.25
              PL(2) = 0.25
              PL(3) = 0.25
              NABC  = 5
            END IF
c -z y-1/4 x-1/4
            IF (IW .EQ. 13) THEN
              PL(2) = 0.25
              PL(3) = 0.25
              NABC  = 15
            END IF
          END IF
        END IF
        GO TO 10
      ELSE IF (II .EQ. 2 .OR. II .EQ. 3 .OR. II .EQ. 5 .OR. II .EQ. 6)
     1 THEN
c a<b
        IF (ABS(A - B) .LT. AXTOL) THEN
          CALL PLA262 (2)
          WRITE (LU7, 99998, IOSTAT = IOST) A, B
          RETURN
        END IF
        IF (A .GT. B) THEN
          AXES  = 'b,a,-c'
          CALL GEN018 (A, B)
          U(2)  = 1.0
          U(4)  = 1.0
          U(9)  =-1.0
          MINSH = 3
          IF (IW .EQ. 9) THEN
            PL(3) = 0.25
            NABC  = 16
          END IF
c y-1/4 x-1/4 3/4-z
          IF (IW .EQ. 11) THEN
            PL(1) = 0.25
            PL(2) = 0.25
            PL(3) = 0.25
            NABC  = 5
          END IF
          IF (IW .EQ. 12) THEN
            PL(1) = 0.25
            PL(2) = 0.25
            NABC  = 6
          END IF
        END IF
        GO TO 10
      END IF
   10 IF (AXES .EQ. 'a,b,c') RETURN
      DO I = 1, 3
        PLUS(I) = PLUS(I) + PL(I)
        IF (PLUS(I) .GT. 1.0) PLUS(I) = PLUS(I) - 1.0
      END DO
      IF (IFMAT .EQ. 2) THEN
        CALL GEN004 (S, U, P)
        CALL GEN113 (P, S, 9)
      ELSE
        CALL GEN113 (U, S, 9)
      END IF
      IFMAT = 2
      IF (NABC .GT. 0) IFPLUS = IFPLUS + 2
      CALL PLA262 (1)
      WRITE (LU7, 99999, IOSTAT = IOST) AXES, A, B, C
      RETURN
99999 FORMAT ('Axes are changed to ', A6, 6x,'new axes: ', 3F9.4)
99998 FORMAT (/, 'WARNING : axes a & b are very similar:', 2F10.4)
99997 FORMAT (/, 'WARNING : axes b & c are very similar:', 2F10.4)
      END SUBROUTINE PLA308
      SUBROUTINE PLA309 (S)
      COMMON /LAB/ AX
      CHARACTER AX*47, CC(3)*1
      DIMENSION IFLAG(9), S(9)
      DATA CC / 'a', 'b', 'c'/
      AX = ' '
      EP = 0.00001
      DO I = 1, 9
        IFLAG(I) = 0
        SABS     = ABS(S(I))
        K        = INT (SABS + EP)
        IF (ABS (FLOAT (K) - SABS) .GT. 0.0001) IFLAG(I) = 1
      END DO
      K = 0
      M = 1
      DO I = 1, 3
        MM = M
        DO J = 1, 3
          M1 = M
          K  = K + 1
          KK = 0
          SK = ABS(S(K))
          IF (SK .GT. EP) THEN
            IF (IFLAG(K) .EQ. 0) KK = INT(SK + EP)
            IF (S(K) .LT. 0.0) THEN
              AX(M:M) = '-'
              M       = M + 1
            ELSE IF (M .GT. MM) THEN
              AX(M:M) = '+'
              M       = M + 1
            END IF
            IF (IFLAG(K) .EQ. 0) THEN
              IF (KK .EQ. 1) THEN
                M1 = M1 - 1
              ELSE IF (KK .GT. 1) THEN
                WRITE (AX(M:M), 99999, IOSTAT = IOST) KK
                M = M + 1
              END IF
            ELSE
              II = INT (SK + EP)
              WRITE (AX(M:M), 99999, IOSTAT = IOST) II
              AX(M + 1:M + 1) = '.'
              WRITE (AX(M + 2:M + 2), 99999, IOSTAT = IOST)
     1          INT ((SK + 0.05 - FLOAT(II)) * 10)
              M = M + 3
            END IF
            IF (M .NE. M1 .OR. KK .NE. 0) THEN
              AX(M:M) = CC(J)
              M       = M + 1
            END IF
          END IF
        END DO
        IF (I .LT. 3) THEN
          AX(M:M) = ','
          M       = M + 1
        END IF
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (I1)
      END SUBROUTINE PLA309
      SUBROUTINE PLA310 (LU)
      PARAMETER (NSIZ=50)
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /STBL4/ IPOL, R, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /LAB/ AXS
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /MESSA/ IW
      COMMON /TRANS/ S(9), U(9), T(9), P(9)
      CHARACTER AXS*47
      DIMENSION V(NSIZ, NSIZ), VS(NSIZ), II(NSIZ), JJ(NSIZ)
c remember if axes have already been transformed :
      IFTRA = 0
      IF (IFMAT .EQ. 2) IFTRA = 1
      CALL GEN074 (U, 1, 9, 0.0)
      BB   = BE
      ANEW = A
      CNEW = C
      L1   = 0
      L2   = 1
      SINB = SIN(BET)
      DO I = 1, NSIZ
        DO J = 1, NSIZ
          V(J, I) = - 0.5
        END DO
      END DO
      IP     = 1
      IQ     = 0
      IR     = 0
      IS     = 1
      CSA    = COSB
      CSC    = COSB
      VMAX   = AMAX1(A, C)
      VLIMIT = VMAX / SINB
      V2MAX  = VMAX**2
      IMAX   = INT(VLIMIT / A + 1.0)
      JMAX   = INT(VLIMIT / C + 1.0)
      IF (IMAX .GE. NSIZ .OR. JMAX .GE. NSIZ) THEN
        WRITE (LU, 99991, IOSTAT = IOST) IMAX, JMAX
        RETURN
      END IF
      DO I = 1, IMAX
        AX = I * A
        AX2 = AX**2
        DO J = 1, JMAX
          CX = J * C
          V2 = AX2 + CX**2 + 2.0 * AX * CX * COSB
          IF (V2 .LE. V2MAX) THEN
            VV              = SQRT(V2)
            V(I + 1, J + 1) = VV
          END IF
        END DO
      END DO
      V(2, 1) = A
      V(1, 2) = C
      K    = 0
   10 VMIN = VMAX
      IFK  = 0
      K    = K + 1
      IF (K .GT. NSIZ) THEN
        WRITE (LU, 99992, IOSTAT = IOST)
        RETURN
      END IF
      IMAX = IMAX + 1
      JMAX = JMAX + 1
      DO J = 1, JMAX
        DO I = 1, IMAX
          IF (V(I, J) .GE. 0.0) THEN
            IF (V(I, J) .LE. VMIN) THEN
              VMIN = V(I, J)
              II(K) = I
              JJ(K) = J
              IFK   = 1
            END IF
          END IF
        END DO
      END DO
      IF (IFK .EQ. 0) THEN
        K = K - 1
      ELSE
        VS(K)   = VMIN
        I       = II(K)
        J       = JJ(K)
        V(I, J) = -VMIN
        GO TO 10
      END IF
      IF (IW .EQ. 2) THEN
        IF (VS(1) .EQ. VS(2)) THEN
          WRITE (LU, 99993, IOSTAT = IOST)
        END IF
        IFA  = 1
        IFC  = 1
        ANEW = VS(1)
        CNEW = VS(2)
        IP   = II(1) - 1
        IQ   = II(2) - 1
        IR   = JJ(1) - 1
        IS   = JJ(2) - 1
        GO TO 30
      END IF
c
      IGROUP = IW - 2
      IFA    = 0
      IFC    = 0
      IF (IGROUP .EQ. 1) THEN
        K1 = 1
      ELSE IF (IGROUP .EQ. 2) THEN
c group 1 : C-groups ; q even, s odd
c group 2 : P-groups ; p odd, r even
        L1 = 1
        L2 = 0
        K1 = 1
      ELSE IF (IGROUP .EQ. 3 .OR. IGROUP .EQ. 4) THEN
        K1 = 1
        DO
          DO I = K1, K
            I1 = II(I) - 1
            J1 = JJ(I) - 1
            IF (MOD(J1, 2) .EQ. 0) THEN
              IF (MOD(I1, 2) .EQ. 1) THEN
                IF (IFC .EQ. 0 .OR. ABS (I1 * IS - J1 * IR) .EQ. 1) THEN
                  IP   = I1
                  IQ   = J1
                  IFA  = I
                  ANEW = VS(I)
                END IF
              END IF
            ELSE
              IF (IFA .EQ. 0 .OR. ABS (I1 * IQ - J1 * IP) .EQ. 1) THEN
                IS   = J1
                IR   = I1
                CNEW = VS(I)
                IFC  = I
              END IF
            END IF
            IF (IFA .GT. 0 .AND. IFC .GT. 0) GO TO 20
            IF (IFA .GT. 0 .OR.  IFC .GT. 0) EXIT
          END DO
          IF (IFA .GT. 0) THEN
            DO J = 1, K
              IF (J .NE. IFA) THEN
                I1 = II(J) - 1
                J1 = JJ(J) - 1
                IF (MOD(J1, 2) .EQ. 1) THEN
                  IF (ABS (I1 * IQ - J1 * IP) .EQ. 1) THEN
                    IS   = J1
                    IR   = I1
                    CNEW = VS(J)
                    IFC  = J
                    GO TO 20
                  END IF
                END IF
              END IF
            END DO
            IF (K1 .EQ. K) GO TO 40
            IFA = 0
            IFC = 0
            K1  = K1 + 1
          ELSE
            DO J = 1, K
              IF (J .NE. IFC) THEN
                I1 = II(J) - 1
                J1 = JJ(J) - 1
                IF (MOD(I1, 2) .EQ. 1 .AND. MOD(J1, 2) .EQ. 0) THEN
                  IF (ABS (I1 * IS - J1 * IR) .EQ. 1) THEN
                    IP   = I1
                    IQ   = J1
                    IFA  = J
                    ANEW = VS(J)
                    GO TO 20
                  END IF
                END IF
              END IF
            END DO
            IF (K1 .EQ. K) GO TO 40
            IFA = 0
            IFC = 0
            K1  = K1 + 1
          END IF
        END DO
      END IF
      DO
        DO I = K1, K
          I1 = II(I) - 1
          J1 = JJ(I) - 1
          KK = I1
          IF (IGROUP .EQ. 1) KK = J1
          IF (MOD(KK, 2) .EQ. L1) THEN
            IF (IFC .EQ. 0 .or. ABS(I1 * IS - J1 * IR) .EQ. 1) THEN
              IP   = I1
              IQ   = J1
              IFA  = I
              ANEW = VS(I)
            END IF
          ELSE
            IF (IFA .EQ. 0 .OR. ABS (I1 * IQ - J1 * IP) .EQ. 1) THEN
              IS   = J1
              IR   = I1
              CNEW = VS(I)
              IFC  = I
            END IF
          END IF
          IF (IFA .GT. 0 .AND. IFC .GT. 0) GO TO 30
          IF (IFA .GT. 0 .OR.  IFC .GT. 0) EXIT
        END DO
        IF (IFA .GT. 0) THEN
          DO J = 1, K
            IF (J .NE. IFA) THEN
              I1 = II(J) - 1
              J1 = JJ(J) - 1
              KK = I1
              IF (IGROUP .EQ. 1) KK = J1
              IF (MOD(KK, 2) .EQ. L2) THEN
                IF (ABS (I1 * IQ - J1 * IP) .EQ. 1) THEN
                  IS   = J1
                  IR   = I1
                  CNEW = VS(J)
                  IFC  = J
                  GO TO 30
                END IF
              END IF
            END IF
          END DO
          IF (K1 .EQ. K) GO TO 40
          IFA = 0
          IFC = 0
          K1  = K1 + 1
        ELSE
          DO J = 1, K
            IF (J .NE. IFC) THEN
              I1 = II(J) - 1
              J1 = JJ(J) - 1
              KK = I1
              IF (IGROUP .EQ. 1) KK = J1
              IF (MOD(KK, 2) .EQ. L1) THEN
                IF (ABS (I1 * IS - J1 * IR) .EQ. 1) THEN
                  IP   = I1
                  IQ   = J1
                  IFA  = J
                  ANEW = VS(J)
                  GO TO 30
                END IF
              END IF
            END IF
          END DO
          IF (K1 .EQ. K) GO TO 40
          IFA = 0
          IFC = 0
          K1  = K1 + 1
        END IF
      END DO
   20 IF (MOD(IR, 2) .EQ. 1) THEN
        IF (IGROUP .EQ. 3) THEN
          PLUS(2) = PLUS(2) + 0.25
          NSH     = 17
        ELSE
          PLUS(1) = PLUS(1) + 0.25
          PLUS(2) = PLUS(2) + 0.25
          NSH     = 6
        END IF
        IFPLUS = IFPLUS + 4
      END IF
   30 IF (IP .NE. 1 .OR. IQ .NE. 0 .OR. IR .NE. 0 .OR.
     1    IS .NE. 1) THEN
        IFMAT = 2
        IF (IP .EQ. 0 .OR. IQ .EQ. 0) IFA = 0
        IF (IR .EQ. 0 .OR. IS .EQ. 0) IFC = 0
        U(5) = 1.0
        U(1) = FLOAT(IP)
        U(3) = FLOAT(IQ)
        CSC  = 1.0
        IF (IQ .NE. 0) CSC = (ANEW**2 + (IQ * C)**2 - (IP * A)**2) /
     1     (2.0 * ANEW * IQ * C)
        U(7) = FLOAT(IR)
        U(9) = FLOAT(IS)
        CSA = 1.0
        IF (IR .NE. 0) CSA = (CNEW**2 + (IR * A)**2 - (IS * C)**2) /
     1     (2.0 * CNEW * IR * A)
        NEG = 1
        IF (IFA .GT. 0 .AND. IFC .GT. 0) THEN
          B1 = R * ACOS(CSA)
          B2 = R * ACOS(CSC)
          BB = BE - B1 - B2
          IF (BB .LT. 0.0) THEN
            BB  = 180.0 + BB
            NEG = - 1
          END IF
          if (BB .LT. 90.0) THEN
            BB = 180.0 - BB
            NEG = - NEG
          END IF
        ELSE IF (IFA .GT. 0) THEN
          IF (IR .EQ. 0) THEN
            CS = CSC
          ELSE
            CS = ((IP * A)**2 + ANEW**2 - (IQ * C)**2) /
     1           (2.0 * IP * A * ANEW)
          END IF
          IF (CS .GT. 0.0) NEG = -1
          BB = R * ACOS(NEG * CS)
        ELSE IF (IFC .GT. 0) THEN
          IF (IQ .EQ. 0) THEN
            CS = CSA
          ELSE
            CS = ((IS * C)**2 + CNEW**2 - (IR * A)**2) /
     1           (2.0 * IS * C * CNEW)
          END IF
          IF (CS .GT. 0.0) NEG = -1
          COSB = NEG * CS
          BB   = R * ACOS(NEG * CS)
        END IF
        CALL PLA262 (4)
        WRITE (LU, 99999, IOSTAT = IOST) IP, A, IQ, C, ANEW
        WRITE (LU, 99998, IOSTAT = IOST) IR, A, IS, C, CNEW
        WRITE (LU, 99997, IOSTAT = IOST) BB
        U(1) = NEG * U(1)
        U(3) = NEG * U(3)
        DET  = U(1) * U(9) - U(3) * U(7)
        IF (DET .LT. 0.0) U(5) = - U(5)
        CALL PLA309 (U)
        WRITE (LU, 99996, IOSTAT = IOST) AXS
        CALL GEN004 (S, U, P)
        CALL GEN113 (P, S, 9)
        A  = ANEW
        C  = CNEW
        BE = BB
        IF (IFTRA .EQ. 1) THEN
          CALL PLA309 (S)
          CALL PLA262 (1)
          WRITE (LU, 99995, IOSTAT = IOST) AXS
        END IF
        CALL PLA262 (3)
        WRITE (LU, 99994, IOSTAT = IOST) A, B, C, AL, BE, GA
      END IF
      RETURN
   40 WRITE (LU, 99993, IOSTAT = IOST)
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, 'New a = ', I2, ' *', F8.4, ' +', I2, ' *', F8.4,
     1        ' = ', F8.4)
99998 FORMAT ('New c = ', I2, ' *', F8.4, ' +', I2, ' *', F8.4,
     1        ' = ', F8.4)
99997 FORMAT ('New angle beta = ', f8.4)
99996 FORMAT ('Transformation of Axes due to Cell Reduction : ', A47)
99995 FORMAT ('Total transformation of axes : ', A)
99994 FORMAT ('Cell parameters after reduction :', /, 6F9.4)
99993 FORMAT ('No cell reduction found ')
99992 FORMAT ('WARNING : cell has not been reduced due to too ',
     1 ' small array size.')
99991 FORMAT ('WARNING : array size too small in routine for PLA310', /,
     1 'cell needed are : ', 2I4)
      END SUBROUTINE PLA310
      SUBROUTINE PLA311 (IFMAT)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM (3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /STBL4/ IPOL, R, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /BRZ/ NGO, IR(48, 3, 3), IT(48, 3), NBR
      COMMON /DOTS/ SF11, SF22, SF33, SF23, SF13, SF12, ITYPE
      COMMON /GARB/ IERR, IGO, IRED, E1, ITHRU
      COMMON /TRANS/ UVW(9), U(9), T(9), P(9)
      DIMENSION DOT(6), AXF(6), UX1(3), UX2(3)
c
      E1   = 0.000001
      IERR = 0
      DO I = 1, 9
        UVW(I) = UVWX(I, NBR)
      END DO
      DO N = 1, 6
        DO I = 1, 3
          J = I
          M = I
          IF (N .EQ. 2) THEN
            M = I + 3
            J = I + 3
          ELSE IF (N .EQ. 3) THEN
            M = I + 6
            J = I + 6
          ELSE IF (N .EQ. 4) THEN
            J = I + 3
          ELSE IF (N .EQ. 5) THEN
            J = I + 6
          ELSE IF (N .EQ. 6) THEN
            M = I + 3
            J = I + 6
          END IF
          UX1(I) = UVW(M)
          UX2(I) = UVW(J)
        END DO
        C1 = UX1(1) * UX2(1)
        C2 = UX1(2) * UX2(2)
        C3 = UX1(3) * UX2(3)
        C4 = UX1(3) * UX2(2) + UX1(2) * UX2(3)
        C5 = UX1(3) * UX2(1) + UX1(1) * UX2(3)
        C6 = UX1(1) * UX2(2) + UX1(2) * UX2(1)
        DOT(N) = C1 * (A**2) + C2 * (B**2) + C3 * (C**2)
     1         + C4 * C * B * COS(ALF) + C5 * C * A * COS(BET)
     2         + C6 * A * B * COS(GAM)
      END DO
      DO I = 1, 3
        AXF(I) = SQRT(DOT(I))
      END DO
      COSA   = DOT(6) / (AXF(2) * AXF(3))
      COSB   = DOT(5) / (AXF(1) * AXF(3))
      COSG   = DOT(4) / (AXF(1) * AXF(2))
      AXF(4) = ACOS(COSA) * R
      AXF(5) = ACOS(COSB) * R
      AXF(6) = ACOS(COSG) * R
      A      = AXF(1)
      B      = AXF(2)
      C      = AXF(3)
      ALF    = AXF(4) / R
      BET    = AXF(5) / R
      GAM    = AXF(6) / R
      AL     = AXF(4)
      BE     = AXF(5)
      GA     = AXF(6)
      CALL PLA317
      WRITE (LU7, 99999, IOSTAT = IOST) UVW
      IF (GEN135 (UVW) .EQ. 0.0) THEN
        IFMAT = 2
        A     = SQRT(SF11)
        B     = SQRT(SF22)
        C     = SQRT(SF33)
        COSA  = SF23 / (B * C)
        COSB  = SF13 / (A * C)
        COSG  = SF12 / (A * B)
        ALF   = ACOS(COSA)
        BET   = ACOS(COSB)
        GAM   = ACOS(COSG)
        AL    = ALF * R
        BE    = BET * R
        GA    = GAM * R
        WRITE (LU7, 99998, IOSTAT = IOST) A, B, C, AL, BE, GA
        CALL PLA309 (UVW)
      ELSE
        WRITE (LU7, 99997, IOSTAT = IOST) A, B, C, AL, BE, GA
        IFMAT = 0
      END IF
      RETURN
99999 FORMAT (//, 'Transformation matrix for Niggli cell : ',
     1 /, (' ', 3F4.1))
99998 FORMAT (//, 'Cell parameters after reduction :', /, 6F10.4)
99997 FORMAT ('No cell reduction; keep original cell parameters :', /,
     1 6F10.4)
      END SUBROUTINE PLA311
      SUBROUTINE PLA312
      PARAMETER (NDIF=30)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ELTNAME/ FINELT(NDIF)
      COMMON /NUM/ NEL, NEWN, NR(NDIF), MAXNR(NDIF)
      CHARACTER DATA*73, DATAS*73, PARAMS*24, REMS(5)*73, PEARS*14,
     1 SP*17, DEF*73, WS*38, FINELT*2, CH*2, KEL(NDIF)*2, NUMS*10
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DATA NUMS /'1234567890'/
      CALL GEN126 (KEL, 1, NDIF)
      KK = 0
      DO I = 1, NDIF
        IF (MAXNR(I) .LE. 1) THEN
          KK = KK + 1
          KEL(KK) = FINELT(I)
        END IF
      END DO
      IOTH   = 0
      PARAMS = ' '
      DATAS  = ' '
      DEF    = ' '
      PEARS  = ' '
      SP     = ' '
      WS     = ' '
      NRREM  = 0
      CALL GEN126 (REMS, 1, 5)
      REWIND LU63
      READ (LU63, 99999, IOSTAT = IOST) DATA
      IF (IOST .EQ. 0) THEN
        IF (DATA(1:3) .EQ. 'OTH') IOTH = 1
        DO
          READ (LU63, 99999, IOSTAT = IOST) DATA
          IF (IOST .NE. 0) EXIT
          IF (DATA(1:2) .EQ. 'CG') PARAMS(14:24) = ', CG='//DATA(5:10)
          IF (DATA(1:2) .EQ. 'ga') PARAMS(1:13)  = 'Gamma='//DATA(7:13)
          IF (DATA(1:6) .EQ. 'SPCGRP') THEN
            DATAS = DATA
            SP    = DATA(8:24)
            WS    = DATA(27:64)
          END IF
          IF (DATA(1:5) .EQ. 'PCODE') PEARS = DATA(8:21)
          IF (DATA(1:6) .EQ. 'REMARK') THEN
            NRREM       = NRREM + 1
            REMS(NRREM) = DATA
          END IF
          IF (DATA(1:6) .EQ. 'DEFINE') DEF = DATA
        END DO
      END IF
      IF (IOTH .EQ. 0) THEN
        CALL PLA262 (3)
        WRITE (DATA, 99997, IOSTAT = IOST) SP, WS, PEARS
        WRITE (LU7, 99999, IOSTAT = IOST) DATA
        IF (IWIN .EQ. 1) THEN
          VRT = VRT - 0.55
          CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
        END IF
        IF (DATAS(65:73) .NE.' ')  THEN
          CALL PLA262 (1)
          WRITE (DATA, 99996, IOSTAT = IOST) DATAS(65:73)
          WRITE (LU7, 99999, IOSTAT = IOST) DATA
          IF (IWIN .EQ. 1) THEN
            VRT = VRT - 0.45
            CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
          END IF
        END IF
        WRITE (DATA, 99995, IOSTAT = IOST)
        WRITE (LU7, 99999, IOSTAT = IOST) DATA
        IF (IWIN .EQ. 1) THEN
          VRT = VRT - 0.45
          CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
        END IF
      END IF
      REWIND LU63
      NATPR = 0
      DO
        READ (LU63, 99999, IOSTAT = IOST) DATA
        IF (IOST .NE. 0) EXIT
        IF (DATA(1:4) .EQ. 'DATA' .OR. DATA(1:4) .EQ. 'OTHE') THEN
          DATA(50:73) = PARAMS
          IF (DATA(1:4) .EQ. 'OTHE') THEN
            CALL PLA262 (3)
            WRITE (LU7, 99998, IOSTAT = IOST)
            WRITE (LU7, 99999, IOSTAT = IOST) DATA
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
              WRITE (LU7, 99999, IOSTAT = IOST) DATAS
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, DATAS, 73, 0.35, 1, 2, 1.0, VRT)
            END IF
          ELSE
            CALL PLA262 (1)
            WRITE (LU7, 99999, IOSTAT = IOST) DATA
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
            END IF
          END IF
        ELSE IF (DATA(1:5) .EQ. 'PCODE') THEN
          IF (IOTH .EQ. 1) THEN
            CALL PLA262 (2)
            WRITE (LU7, 99999, IOSTAT = IOST) DATAS
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, DATAS, 73, 0.35, 1, 2, 1.0, VRT)
              WRITE (LU7, 99999, IOSTAT = IOST) DATA
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
            END IF
          END IF
        ELSE IF (DATA(1:2) .EQ. 'ga' .OR. DATA(1:6) .EQ. 'SPCGRP' .OR.
     1           DATA(1:3) .EQ. 'DEF') THEN
          CYCLE
        ELSE IF (DATA(1:5) .EQ. 'OTHER') THEN
           EXIT
        ELSE IF (DATA(1:4) .EQ. 'ATOM') THEN
          NATPR = NATPR + 1
          IF (DEF .NE. ' ') THEN
            CALL PLA262 (1)
            WRITE (LU7, 99999, IOSTAT = IOST) DEF
            IF (IWIN .EQ. 1) THEN
              IF (NATPR .LT. 31) THEN
                VRT = VRT - 0.45
                CALL GGIP09 (0.0, DEF, 73, 0.35, 1, 2, 1.0, VRT)
              ELSE IF (NATPR .EQ. 31) THEN
                VRT = VRT - 0.45
                CALL GGIP09 (0.0, '... (Etc. - See Listing) ...', 28,
     1                       0.35, 5, 2, 8.0, VRT)
                VRT = VRT - 0.15
              END IF
            END IF
          END IF
          DEF = ' '
          IF (KK .GT. 0) THEN
            JJ = 8
            DO I = 8, 13
              IF (DATA(I:I) .NE. ' ') THEN
                CH = DATA(I:I + 1)
                JJ = I + 2
                K  = INDEX(NUMS, CH(2:2))
                IF (K .GT. 0) THEN
                  CH(2:2) = ' '
                  JJ      = I + 1
                END IF
                DO N = 1, KK
                  IF (CH .EQ. KEL(N)) THEN
                    KEL(N)          = ' '
                    DATA(JJ:JJ + 2) = ' '
                    EXIT
                  END IF
                END DO
                EXIT
              END IF
            END DO
          END IF
          CALL PLA262 (1)
          WRITE (LU7, 99999, IOSTAT = IOST) DATA
          IF (IWIN .EQ. 1) THEN
            IF (NATPR .LT. 31) THEN
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
            ELSE IF (NATPR .EQ. 31) THEN
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, '... (Etc. - See Listing) ...', 28,
     1                     0.35, 1, 2, 8.0, VRT)
              VRT = VRT - 0.15
            END IF
          END IF
          CYCLE
        ELSE IF (DATA(1:2) .EQ. 'CG') THEN
          DO I = 1, NRREM
            IF (REMS(I) .NE. ' ')  THEN
              CALL PLA262 (1)
              WRITE (LU7, 99999, IOSTAT = IOST) REMS(I)
              IF (IWIN .EQ. 1) THEN
                VRT = VRT - 0.45
                CALL GGIP09 (0.0, REMS(I), 73, 0.35, 1, 2, 1.0, VRT)
              END IF
            END IF
          END DO
          EXIT
        ELSE
          IF (DATA(1:6) .NE. 'REMARK')  THEN
            CALL PLA262 (1)
            WRITE (LU7, 99999, IOSTAT = IOST) DATA
            IF (IWIN .EQ. 1) THEN
              VRT = VRT - 0.45
              CALL GGIP09 (0.0, DATA, 73, 0.35, 1, 2, 1.0, VRT)
            END IF
          END IF
        END IF
      END DO
      REWIND LU63
      RETURN
99999 FORMAT (A)
99998 FORMAT (1X)
99997 FORMAT (A, ' - ', A, 1X, A)
99996 FORMAT (19X, A9)
99995 FORMAT (73('-'))
      END SUBROUTINE PLA312
      SUBROUTINE PLA313 (NATOM, II, IG, K, NR, NEWNR)
      PARAMETER (NUMAT=150, NSET=120)
      COMMON /ORD/ X(3, NUMAT), MUL(NUMAT), LET(NUMAT),
     1 HORSUM(NUMAT, NSET), SUM(3, NSET), SXY(NSET), SXZ(NSET),
     2 SYZ(NSET)
      DIMENSION NR(NSET), NEWNR(NSET), NEW(NSET)
      CALL GEN097 (NEW,   1, NSET, 0)
      CALL GEN097 (NEWNR, 1, NSET, 0)
      KK = 1
      IF (II .NE. 2) THEN
        DO I = 1, 3
          S = 1000000.0
          DO J = 1, IG
            M = NR(J)
            IF (I .GT. 1) THEN
              DO L = 1, KK
                IF (M .EQ. NEWNR(L)) GO TO 10
              END DO
              CYCLE
            END IF
   10       IF (S .GT. SUM(I, M)) S = SUM(I, M)
          END DO
          K = 0
          DO J = 1, IG
            L = NR(J)
            IF (I .GT. 1) THEN
              DO M = 1, KK
                IF (L .EQ. NEWNR(M)) GO TO 20
              END DO
              CYCLE
            END IF
   20       IF (ABS(SUM(I, L) - S) .LT. 0.0001) THEN
              K = K + 1
              NEWNR(K) = l
            END IF
          END DO
          IF (K .LE. 1) RETURN
          KK = K
        END DO
      ELSE
        DO I = 1, NATOM
          S = 1000000.0
          DO J = 1, IG
            M = NR(J)
            IF (I .GT. 1) THEN
              DO L = 1, KK
                IF (M .EQ. NEWNR(L)) GO TO 30
              END DO
              CYCLE
            END IF
   30       IF (S .GT. HORSUM(I, J)) S = HORSUM(I, J)
          END DO
          K = 0
          DO J = 1, IG
            L = NR(J)
            IF (I .GT. 1) THEN
              DO M = 1, KK
                IF (J .EQ. NEW(M)) GO TO 40
              END DO
              CYCLE
            END IF
   40       IF (ABS(HORSUM(I, J) - S) .LT. 0.0001) THEN
              K        = K + 1
              NEW(K)   = J
              NEWNR(K) = L
            END IF
          END DO
          IF (K .LE. 1) RETURN
          KK = K
        END DO
      END IF
      RETURN
      END SUBROUTINE PLA313
      SUBROUTINE PLA314
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /MESSA/ IW
      CHARACTER ANSR*1
      IFBEST = 0
      ROOT   = 1.0
      CSB    = - COSB
      CS     = 1.0 / 2.0 * CSB
      CSS    = CSB
      CA     = C / A
      IF (IW .LT. 0) THEN
        WRITE (LU7, 99998, IOSTAT = IOST)
        IW = -IW
        READ (LU64, 99997) ANSR
        IF (ANSR .EQ. 'Y'.OR. ANSR .EQ. 'y') IFSH = 1
      END IF
      SELECT CASE (IW)
        CASE (1)
          GO TO 10
        CASE (2)
          CALL PLA262 (1)
          WRITE (LU7, 99999, IOSTAT = IOST)
          IF (A .GT. C) GO TO 30
          ROOT = 1.0
          CS   = 1.0 / (2.0 * CSB)
          IF (CA .GE. 1.0 .AND. CA .GE. CS)  GO TO 30
          CSS = 2.0 * CSB
          IF (CA .LE. 1.0 .AND. CA .LE. CSS) GO TO 30
          WRITE (LU7, 99981, IOSTAT = IOST)
          IF (ABS(A - C) .LT. 0.001 * A) THEN
            WRITE (LU7, 99982, IOSTAT = IOST)
          END IF
          GO TO 40
        CASE (3, 5, 6)
          ROOT = 1.0 / SQRT(2.0)
          CS   = 1.0 / (2.0 * CSB)
          CSS  = CSB
          IF (CA .GE. ROOT .AND. CA .GE. CS)  GO TO 20
          IF (CA .LE. ROOT .AND. CA .LE. CSS) GO TO 20
          WRITE (LU7, 99981, IOSTAT = IOST)
          GO TO 40
        CASE (4)
          ROOT = SQRT(2.0)
          CS   = 1.0 / CSB
          IF (CA .GE. ROOT .AND. CA .GE. CS)  GO TO 20
          CSS = 2.0 * CSB
          IF (CA .LE. ROOT .AND. CA .LE. CSS) GO TO 20
          WRITE (LU7, 99981, IOSTAT = IOST)
          GO TO 40
        CASE (7)
          WRITE (LU7, 99990, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (8)
          WRITE (LU7, 99989, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (9)
          WRITE (LU7, 99988, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (10)
          WRITE (LU7, 99987, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (11)
          WRITE (LU7, 99986, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (12)
          WRITE (LU7, 99985, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (13)
          WRITE (LU7, 99984, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (14)
          WRITE (LU7, 99983, IOSTAT = IOST)
          CALL PLA308
          RETURN
        CASE (15)
          WRITE (LU7, 99998, IOSTAT = IOST)
          READ (LU64, 99997) ANSR
          IF (ANSR .EQ. 'Y' .OR. ANSR .EQ. 'y') IFSH = 1
          RETURN
        CASE (16)
          RETURN
      END SELECT
   10 WRITE (LU7, 99992, IOSTAT = IOST)
      CALL PLA311 (IFMAT)
      RETURN
   20 WRITE (LU7, 99991, IOSTAT = IOST)
   30 CALL PLA310 (LU7)
      IFBEST = 1
      CA  = C / A
      CSB = - COS(BE * 3.1415926 / 180.0)
      IF (IW .EQ. 2) THEN
        ROOT = 1.0
        CS   = 1.0 / (2.0 * CSB)
        CSS  = 2.0 * CSB
      ELSE IF (IW .EQ. 3 .OR. IW .EQ. 5 .OR. IW .EQ. 6) THEN
        ROOT = 1.0 / SQRT(2.0)
        CS   = 1.0 / (2.0 * CSB)
        CSS  = CSB
      ELSE IF (IW .EQ. 4) THEN
        ROOT = SQRT(2.0)
        CS   = 1.0 / CSB
        CSS  = 2.0 * CSB
      END IF
   40 RT1  = ROOT - 0.01 * ROOT
      RT2  = ROOT + 0.01 * ROOT
      CS1  = CS   - 0.01 * CS
      CSS2 = CSS  + 0.01 * CSS
      IF (CA .GE. RT1 .AND. CA .GE. CS1) THEN
        IF (IFBEST .EQ. 0) THEN
          WRITE (LU7, 99996, IOSTAT = IOST)
        ELSE
          WRITE (LU7, 99995, IOSTAT = IOST)
        END IF
      ELSE IF (CA .LE. RT2 .AND. CA .LE. CSS2) THEN
        IF (IFBEST .EQ. 0) THEN
          WRITE (LU7, 99996, IOSTAT = IOST)
        ELSE
          WRITE (LU7, 99995, IOSTAT = IOST)
        END IF
      END IF
      IF (CA .GE. 0.97 .AND. CA .LE. 1.03 .AND. IW .EQ. 2) THEN
        WRITE (LU7, 99994, IOSTAT = IOST)
      END IF
      IF (BE .LE. 90.3) THEN
        WRITE (LU7, 99993, IOSTAT = IOST)
      END IF
      RETURN
99999 FORMAT ('Take Reset Niggli Reduced Cell with  a < c.')
99998 FORMAT ('Take setting with origin in centre of symmetry')
99997 FORMAT (A)
99996 FORMAT (55('-'), /,
     1 'WARNING : slightly different cell parameters may give', /,
     2 'a different BEST cell.', /, 55('-'))
99995 FORMAT (55('-'), /,
     1'WARNING : the found "best" cell is very near a border line.'/
     2'A slight difference in c/a or beta may give a different'/
     3'BEST cell.'/
     4 55('-'))
99994 FORMAT (55('-'), /,
     1'WARNING : c/a value near to 1. Slightly different cell'/
     2'parameters may give a different BEST cell.'/
     3 55('-'))
99993 FORMAT (55('-'), /,
     1'WARNING : beta near to 90 deg. A slight difference'/
     2'in beta may give a different BEST cell.'/
     3 55('-'))
99992 FORMAT ('Take Niggli reduced cell with  a < b < c.')
99991 FORMAT ('a & c should be shortest translation vectors possible.')
99990 FORMAT ('Axial Order        : a < b < c')
99989 FORMAT (' a < b')
99988 FORMAT (' a < b , for ba-c origin shift of 0 0 1/4 after',
     1 ' permutation'/)
99987 FORMAT (' a < b < c, for ba-c , a-cb , -cba'/' origin shift of',
     1'  1/4 1/4 1/4  after permutation of axes', /)
99986 FORMAT (' a < b , for ba-c  origin shift of 1/4 1/4 1/4', /)
99985 FORMAT (' a < b , for ba-c  origin shift of 1/4 1/4 0', /)
99984 FORMAT (' a < b < c , for ba-c , a-cb , -cba'/'  origin shift ',
     1 'of resp.  1/4 1/4 0 , 1/4 0 1/4 , 0 1/4 1/4 after permutation'/)
99983 FORMAT (' a < b < c   only if possible by cyclic permutation; ',
     1 'otherwise  a < b'/)
99982 FORMAT (/, 'WARNING : a & c are very similar.', /)
99981 FORMAT (/, 'No cell reduction possible.')
      END SUBROUTINE PLA314
      SUBROUTINE PLA315
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DOTS/ SF11, SF22, SF33, SF23, SF13, SF12, ITYPE
      COMMON /GARB/ IERR, IGO, IRED, E1, ITHRU
      IGO    = 0
      IRED   = 0
      IMAIN1 = 0
      ER     = 0.000001
      Q      = 0.0005
      QQ     = 0.0005
      IF (ITHRU .EQ. 1) THEN
        IF (ITYPE .EQ. 1) THEN
          TS1 = ABS(SF11 - SF22)
          TS2 = ABS(SF22 - SF33)
          TS3 = ABS((2.0 * SF23) - SF22)
          TS4 = ABS((2.0 * SF13) - SF11)
          TS5 = ABS((2.0 * SF12) - SF11)
          IF ((TS1 / SF11) .LE. QQ) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '+++ A', SF11, SF22, SF33, SF23, SF13, SF12
            IF ((SF13 + ER) .LT. SF23) THEN
              IGO = 1
              RETURN
            END IF
          END IF
          IF ((TS2 / SF22) .LE. QQ) THEN
            WRITE(LU7, 99998, IOSTAT = IOST)
     1        '+++ B', SF11, SF22, SF33, SF23, SF13, SF12
            IF ((SF12 + ER) .LT. SF13) THEN
              IGO = 2
              RETURN
            END IF
          END IF
          IF ((TS3 / SF22) .LE. Q) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '+++ C', SF11, SF22, SF33, SF23, SF13, SF12
            IF ((2.0 * SF13 + ER) .LT. SF12) THEN
              IGO = 3
              RETURN
            END IF
          END IF
          IF ((TS4 / SF11) .LE. Q) THEN
            WRITE(LU7, 99998, IOSTAT = IOST)
     1        '+++ D', SF11, SF22, SF33, SF23, SF13, SF12
            IF ((2.0 * SF23 + ER) .LT. SF12) THEN
              IGO = 4
              RETURN
            END IF
          END IF
          IF ((TS5 / SF11) .LE. Q) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '+++ E', SF11, SF22, SF33, SF23, SF13, SF12
            IF ((2.0 * SF23 + ER) .LT. SF13) THEN
              IGO = 5
              RETURN
            END IF
          END IF
          IRED = 1
          RETURN
        ELSE IF (ITYPE .EQ. 2) THEN
          TS1  = ABS(SF11 - SF22)
          TS2  = ABS(SF22 - SF33)
          TS3  = ABS(ABS(2.0 * SF23) - SF22)
          TS4  = ABS(ABS(2.0 * SF13) - SF11)
          TS5  = ABS(ABS(2.0 * SF12) - SF11)
          TEM1 = SF11 + SF22
          TEM2 = 2.0 * (ABS(SF23) + ABS(SF13) + ABS(SF12))
          TS6  = ABS(TEM1 - TEM2)
          IF ((TS1 / SF11) .LE. QQ) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '--- A', SF11, SF22, SF33, SF23, SF13, SF12
            IF ((ABS(SF13) + ER) .LT. ABS(SF23)) THEN
              IGO = 1
              RETURN
            END IF
          END IF
          IF ((TS2 / SF22) .LE. QQ) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '--- B', SF11, SF22, SF33, SF23, SF13, SF12
            IF ((ABS(SF12) + ER) .LT. ABS(SF13)) THEN
              IGO = 2
              RETURN
            END IF
          END IF
          IF ((TS3 / SF22) .LE. Q) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '--- C', SF11, SF22, SF33, SF23, SF13, SF12
            IF (Q .LT. ABS(SF12)) THEN
              IGO = 6
              RETURN
            END IF
          END IF
          IF ((TS4 / SF11) .LE. Q) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '--- D', SF11, SF22, SF33, SF23, SF13, SF12
            IF (Q .LT. ABS(SF12)) THEN
              IGO = 7
              RETURN
            END IF
          END IF
          IF ((TS5 / SF11) .LE. Q) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '--- E', SF11, SF22, SF33, SF23, SF13, SF12
            IF (Q .LT. ABS(SF13)) THEN
              IGO = 8
              RETURN
            END IF
          END IF
          IF ((TS6 / (SF11 + SF22)) .LE. Q) THEN
            WRITE (LU7, 99998, IOSTAT = IOST)
     1        '--- F', SF11, SF22, SF33, SF23, SF13, SF12
            X1 = ABS(SF13)
            X2 = ABS(SF12)
            X3 = 2.0 * X1 + X2
            IF ((X3 + ER) .LT. SF11) THEN
              IGO = 9
              RETURN
            END IF
          END IF
          IRED = 1
          RETURN
        END IF
      END IF
      Q1  = 2.0 * ABS(SF23)
      Q2  = 2.0 * ABS(SF13)
      Q3  = 2.0 * ABS(SF12)
      X11 = SF11 + ER
      X22 = SF22 + ER
      X33 = SF33 + ER
      IF (X11 .LE. X22 .AND. X22 .LE. X33 .AND. Q1 .LE. X22 .AND.
     1 Q2 .LE. X11 .AND. Q3 .LE. X11) IMAIN1 = 1
      IF (ITYPE .NE. 1) THEN
        TEMP1 = SF11 + SF22 + ER
        TEMP2 = 2.0 * (ABS(SF23) + ABS(SF13) + ABS(SF12))
        IF (TEMP1 .LT. TEMP2) IMAIN1 = 0
      END IF
      ITHRU = 1
      E1    = 0.00001
      IF (IMAIN1 .EQ. 0) THEN
        WRITE (LU7, 99999, IOSTAT = IOST)
        IERR = IERR + 1
      END IF
      RETURN
99999 FORMAT (//,'**ERROR** Failed Main Conditions for Reduction')
99998 FORMAT ('NIGGLI ', A, 2X, 6F15.6)
      END SUBROUTINE PLA315
      SUBROUTINE PLA316
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DOTS/ SF11, SF22, SF33, SF23, SF13, SF12, ITYPE
      COMMON /GARB/ IERR, IGO, IRED ,E1, ITHRU
      COMMON /TRANS/ UVW(9), U(9), T(9), P(9)
c This routine was adapted from NBS*AIDS80 (Mighell, Hubbard & Stali
      ITYPE = 0
      CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
      Z     = 0
      COSA  = SF23 / (SQRT(SF22) * SQRT(SF33))
      ACOSA = ABS(COSA)
      COSB  = SF13 / (SQRT(SF11) * SQRT(SF33))
      ACOSB = ABS(COSB)
      COSG  = SF12 / (SQRT(SF11) * SQRT(SF22))
      ACOSG = ABS(COSG)
      IF (ACOSA .LE. E1 .OR. ACOSB .LE. E1 .OR. ACOSG .LE. E1) THEN
        IF (COSA .LE. E1 .AND. COSB .LE. E1 .AND. COSG .LE. E1)
     1      ITYPE = 2
        IF (COSA .LE. E1 .AND. COSB .LE. E1 .AND. COSG .LE. E1) GO TO 10
        IF (ACOSA .LE. E1 .AND. COSB  .GT. E1 .AND.  COSG .GT. E1 .OR.
     1      ACOSA .LE. E1 .AND. COSB  .GT. E1 .AND. ACOSG .LE. E1 .OR.
     2      ACOSA .GT. E1 .AND. COSA  .LT. Z  .AND.
     3      COSB  .GT. E1 .AND. ACOSG .LE. E1 .OR.
     4      ACOSA .GT. E1 .AND. COSA  .LT. Z  .AND.
     5      ACOSB .LE. E1 .AND. COSG  .GT. E1) THEN
          U(1) =  1.0
          U(5) = -1.0
          U(9) = -1.0
        ELSE IF (COSA .GT. E1 .AND. ACOSB .LE. E1 .AND.
     1           COSG .GT. E1 .OR.  ACOSA .LE. E1 .AND.
     2          ACOSB .LE. E1 .AND. COSG  .GT. E1 .OR.
     3           COSA .GT. E1 .AND. ACOSB .GT. E1 .AND.
     4           COSB .LT. Z  .AND. ACOSG .LE. E1 .OR.
     5          ACOSA .LE. E1 .AND. ACOSB .GT. E1 .AND.
     6           COSB .LT. Z  .AND. COSG  .GT. E1) THEN
          U(1) = -1.0
          U(5) =  1.0
          U(9) = -1.0
        ELSE IF (COSA .GT. E1 .AND. COSB  .GT. E1 .AND.
     1          ACOSG .LE. E1 .OR.  COSA  .GT. E1 .AND.
     2          ACOSB .LE. E1 .AND. ACOSG .LE. E1 .OR.
     3           COSA .GT. E1 .AND. ACOSB .LE. E1 .AND.
     4          ACOSG .GT. E1 .AND. COSG  .LT. Z  .OR.
     5          ACOSA .LE. E1 .AND. COSB  .GT. E1 .AND.
     6          ACOSG .GT. E1 .AND. COSG  .LT. Z) THEN
          U(1) = -1.0
          U(5) = -1.0
          U(9) =  1.0
        ELSE
          GO TO 10
        END IF
        SF23 = - ABS(SF23)
        SF13 = - ABS(SF13)
        SF12 = - ABS(SF12)
        CALL GEN004 (T, U, P)
        ITYPE = 2
      ELSE
        IF (SF23  .GT. Z .AND. SF13 .GT. Z .AND. SF12 .GT. Z) ITYPE = 1
        IF (SF23  .LE. Z .AND. SF13 .LE. Z .AND. SF12 .LE. Z) ITYPE = 2
        IF (ITYPE .EQ. 1 .OR.  ITYPE .EQ. 2) GO TO 10
        IF (SF23 .GT. Z .AND. SF13 .LE. Z .AND. SF12 .LE. Z) THEN
          SF23 = ABS(SF23)
          SF13 = ABS(SF13)
          SF12 = ABS(SF12)
          U(1) = 1.0
          U(5) = -1.0
          U(9) = -1.0
          CALL GEN004 (T, U, P)
          ITYPE = 1
        ELSE IF (SF23 .LE. Z .AND. SF13 .GT. Z .AND. SF12 .LE. Z) THEN
          SF23 = ABS(SF23)
          SF13 = ABS(SF13)
          SF12 = ABS(SF12)
          U(1) = -1.0
          U(5) = 1.0
          U(9) = -1.0
          CALL GEN004 (T, U, P)
          ITYPE = 1
        ELSE IF (SF23 .LE. Z .AND. SF13 .LE. Z .AND. SF12 .GT. Z) THEN
          SF23 = ABS(SF23)
          SF13 = ABS(SF13)
          SF12 = ABS(SF12)
          U(1) = -1.0
          U(5) = -1.0
          U(9) = 1.0
          CALL GEN004 (T, U, P)
          ITYPE = 1
        ELSE IF (SF23 .GT. Z .AND. SF13 .GT. Z .AND. SF12 .LE. Z) THEN
          SF23 = -ABS(SF23)
          SF13 = -ABS(SF13)
          SF12 = -ABS(SF12)
          U(1) = -1.0
          U(5) = -1.0
          U(9) = 1.0
          CALL GEN004 (T, U, P)
          ITYPE = 2
        ELSE IF (SF23 .GT. Z .AND. SF13 .LE. Z .AND. SF12 .GT. Z) THEN
          SF23 = -ABS(SF23)
          SF13 = -ABS(SF13)
          SF12 = -ABS(SF12)
          U(1) = -1.0
          U(5) = 1.0
          U(9) = -1.0
          CALL GEN004 (T, U, P)
          ITYPE = 2
        ELSE IF (SF23 .LE. Z .AND. SF13 .GT. Z .AND. SF12 .GT. Z) THEN
          SF23 = -ABS(SF23)
          SF13 = -ABS(SF13)
          SF12 = -ABS(SF12)
          U(1) = 1.0
          U(5) = -1.0
          U(9) = -1.0
          CALL GEN004 (T, U, P)
          ITYPE = 2
        ELSE
          GO TO 10
        END IF
      END IF
      CALL GEN113 (P, UVW, 9)
   10 IF (ITYPE .EQ. 0) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
        IERR = IERR + 1
      END IF
      RETURN
99999 FORMAT(//, '**ERROR**SUBROUTINE NORM FAILED TO TYPE CELL')
      END SUBROUTINE PLA316
      SUBROUTINE PLA317
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CEL/ AF, BF, CF, AL, BE, GA, AALP, ABET, AGAM, COSA, COSB,
     1 COSG
      COMMON /DOTS/ SF11, SF22, SF33, SF23, SF13, SF12, ITYPE
      COMMON /GARB/ IERR, IGO, IRED, EL, ITHRU
      COMMON /TRANS/ UVW(9), U(9), T(9), P(9)
      ITHRU = 0
      ICT   = 0
      S11 = AF**2
      S22 = BF**2
      S33 = CF**2
      IF (ABS(Al - 90.0) .LT. 0.0001) THEN
        S23 = 0
      ELSE
        S23 = BF * CF * COS(AALP)
      END IF
      IF (ABS(ga - 90.0) .LT. 0.0001) THEN
        S12 = 0
      ELSE
        S12 = AF * BF * COS(AGAM)
      END IF
      IF (ABS(be - 90.0) .LT. 0.0001) THEN
        S13 = 0
      ELSE
        S13 = AF * CF * COS(ABET)
      END IF
      A23 = ABS(S23)
      A13 = ABS(S13)
      A12 = ABS(S12)
   10 IF (2.0 * A23 .GT. S22 .OR. 2.0 * A23 .GT. S33) THEN
        IF (S23 .LT. 0.0) THEN
          XN  = 1.0
          XN1 = 0.0
          GO TO 40
        ELSE IF (S23 .GT. 0.0) THEN
          XN  = -1.0
          XN1 = 0.0
          GO TO 40
        END IF
      END IF
   20 IF (2.0 * A13 .GT. S11 .OR. 2.0 * A13 .GT. S33) THEN
        IF (S13 .GT. 0.0) THEN
          XN = -1.0
        ELSE
          XN  = 1.0
        END IF
        XN1 = 0.0
        R13 = ABS(S13 + XN * S11)
        GO TO 50
      END IF
      IF (2.0 * A12 .GT. S11 .OR. 2.0 * A12 .GT. S22) THEN
        IF (S12 .LE. 0.0) THEN
          XN = 1.0
        ELSE
          XN = -1.0
        END IF
        XN1 = 0.0
        GO TO 70
      END IF
      A    = SQRT(S11)
      B    = SQRT(S22)
      C    = SQRT(S33)
      COSA = S23 / (B * C)
      COSB = S13 / (A * C)
      COSG = S12 / (A * B)
      GO TO 90
   30 R23 = ABS(S23 + XN * S22)
      IF (R23 .LE. A23) THEN
        IF (S23 .LT. 0.0) THEN
          XN  = XN  + 1.0
          XN1 = XN1 + 1.0
        ELSE
          XN  = XN  - 1.0
          XN1 = XN1 - 1.0
        END IF
        A23 = R23
        GO TO 30
      END IF
      S33 = S33 + (XN1**2) * S22 + 2.0 * XN1 * S23
      S23 = S23 + XN1 * S22
      S13 = S13 + XN1 * S12
      A23 = ABS(S23)
      A13 = ABS(S13)
      CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
      U(1) = 1.0
      U(5) = 1.0
      U(8) = XN1
      U(9) = 1.0
      CALL GEN004 (T, U, P)
      CALL GEN113 (P, UVW, 9)
      IF (S23 .LT. 0.0) THEN
        XN  = 1.0
        XN1 = 0.0
      ELSE IF (S23 .GT. 0.0) THEN
        XN  = -1.0
        XN1 = 0.0
      ELSE
        GO TO 20
      END IF
   40 R23 = ABS(S23 + XN * S22)
      IF (R23 .LE. A23) THEN
        IF (S23 .LT. 0.0) THEN
          XN  = XN  + 1.0
          XN1 = XN1 + 1.0
        ELSE
          XN  = XN  - 1.0
          XN1 = XN1 - 1.0
        END IF
        A23 = R23
        GO TO 40
      END IF
      S22 = S22 + (XN1**2) * S33 + 2.0 * XN1 * S23
      S23 = S23 + XN1  * S33
      S12 = S12 + (XN1 * S13)
      A23 = ABS(S23)
      A12 = ABS(S12)
      CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
      U(1) = 1.0
      U(5) = 1.0
      U(6) = XN1
      U(9) = 1.0
      CALL GEN004 (T, U, P)
      CALL GEN113 (P, UVW, 9)
      GO TO 10
   50 IF (R13 .LE. A13) THEN
        IF (S13 .GE. 0.0) THEN
          XN  = XN  - 1.0
          XN1 = XN1 - 1.0
        ELSE
          XN  = XN  + 1.0
          XN1 = XN1 + 1.0
        END IF
        A13 = R13
        R13 = ABS(S13 + XN * S11)
        GO TO 50
      END IF
      S33 = S33 + (XN1**2) * S11 + 2.0 * XN1 * S13
      S13 = S13 + XN1 * S11
      S23 = S23 + XN1 * S12
      A13 = ABS(S13)
      A23 = ABS(S23)
      CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
      U(1) = 1.0
      U(5) = 1.0
      U(7) = XN1
      U(9) = 1.0
      CALL GEN004 (T, U, P)
      CALL GEN113 (P, UVW, 9)
      IF (S13 .GT. 0.0) THEN
        XN = -1.0
      ELSE
        XN  = 1.0
      END IF
      XN1 = 0.0
   60 R13 = ABS(S13 + XN * S33)
      IF (R13 .GT. A13) THEN
        S11 = S11 + (XN1**2) * S33 + 2.0 * XN1 * S13
        S13 = S13 + XN1 * S33
        S12 = S12 + XN1 * S23
        A13 = ABS(S13)
        A12 = ABS(S12)
        CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
        U(1) = 1.0
        U(3) = XN1
        U(5) = 1.0
        U(9) = 1.0
        CALL GEN004 (T, U, P)
        CALL GEN113 (P, UVW, 9)
        GO TO 10
      END IF
      IF (S13 .LT. 0.0) THEN
        XN  = XN  + 1.0
        XN1 = XN1 + 1.0
      ELSE
        XN  = XN  - 1.0
        XN1 = XN1 - 1.0
      END IF
      A13 = R13
      GO TO 60
   70 R12 = ABS(S12 + XN * S11)
      IF (R12 .LE. A12) THEN
        IF (S12 .LT. 0.0) THEN
          XN  = XN  + 1.0
          XN1 = XN1 + 1.0
        ELSE
          XN  = XN  - 1.0
          XN1 = XN1 - 1.0
        END IF
        A12 = R12
        GO TO 70
      END IF
      S22 = S22 + (XN1**2) * S11 + 2.0 * XN1 * S12
      S12 = S12 + XN1 * S11
      S23 = S23 + XN1 * S13
      A12 = ABS(S12)
      A23 = ABS(S23)
      CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
      U(1) = 1.0
      U(4) = XN1
      U(5) = 1.0
      U(9) = 1.0
      CALL GEN004 (T, U, P)
      CALL GEN113 (P, UVW, 9)
      IF (S12 .GT. 0.0) THEN
        XN = -1.0
      ELSE
        XN = 1.0
      END IF
      XN1 = 0.0
   80 R12 = ABS(S12 + XN * S22)
      IF (R12 .LE. A12) THEN
        IF (S12 .GE. 0.0) THEN
          XN  = XN  - 1.0
          XN1 = XN1 - 1.0
        ELSE
          XN  = XN  + 1.0
          XN1 = XN1 + 1.0
        END IF
        A12 = R12
        GO TO 80
      END IF
      S11 = S11 + (XN1**2) * S22 + 2.0 * XN1 * S12
      S12 = S12 + XN1 * S22
      S13 = S13 + XN1 * S23
      A12 = ABS(S12)
      A13 = ABS(S13)
      CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
      U(1) = 1.0
      U(2) = XN1
      U(5) = 1.0
      U(9) = 1.0
      CALL GEN004 (T, U, P)
      CALL GEN113 (P, UVW, 9)
      GO TO 10
   90 CALL GEN113 (UVW, T, 9)
      CALL GEN074 (U, 1, 9, 0.0)
      IF (A .LE. B) THEN
        IF (A .GT. C) THEN
          T1   = C
          T2   = A
          T3   = B
          E12  = COSB
          E13  = COSA
          E23  = COSG
          U(3) = 1.0
          U(4) = 1.0
          U(8) = 1.0
          GO TO 100
        END IF
        T1  = A
        IF (B .GT. C) THEN
          T2   = C
          T3   = B
          E12  = COSB
          E13  = -COSG
          E23  = -COSA
          U(1) = 1.0
          U(6) = 1.0
          U(8) = -1.0
          GO TO 100
        END IF
        T2  = B
        T3  = C
        E23 = COSA
        E13 = COSB
        E12 = COSG
        GO TO 110
      END IF
      IF (A .GT. C) THEN
        T3   = A
        IF (B .GT. C) THEN
          T1   = C
          T2   = B
          E12  = COSA
          E13  = -COSB
          E23  = -COSG
          U(3) = 1.0
          U(5) = 1.0
          U(7) = -1.0
        ELSE
          T1   = B
          T2   = C
          E12  = COSA
          E13  = COSG
          E23  = COSB
          U(2) = 1.0
          U(6) = 1.0
          U(7) = 1.0
        END IF
      ELSE
        T1   = B
        T2   = A
        T3   = C
        E12  = COSG
        E13  = -COSA
        E23  = -COSB
        U(2) = 1.0
        U(4) = 1.0
        U(9) = -1.0
      END IF
  100 CALL GEN004 (T, U, P)
      CALL GEN113 (P, UVW, 9)
  110 A    = T1
      B    = T2
      C    = T3
      COSA = E23
      COSB = E13
      COSG = E12
      SF11 = A**2
      SF22 = B**2
      SF33 = C**2
      SF23 = B * C * COSA
      SF13 = A * C * COSB
      SF12 = A * B * COSG
      CALL PLA316
      IF (ITYPE .EQ. 2) THEN
        CALL GEN113 (UVW, T, 9)
        CALL GEN074 (U, 1, 9, 0.0)
        TX1 = SF11 + SF22
        TX2 = 2.0 * (ABS(SF23) + ABS(SF13) + ABS(SF12))
        ICT = ICT + 1
        IF (ICT .LE. 2) THEN
          IF (TX1 .LT. TX2) THEN
            SF33 = SF11 + SF22 + SF33 + 2.0 * SF12 + 2.0 * SF13
     1           + 2.0 * SF23
            SF23 = SF12 + SF23 + SF22
            SF13 = SF11 + SF12 + SF13
            U(1) = 1.0
            U(2) = 0.0
            U(3) = 0.0
            U(4) = 0.0
            U(5) = 1.0
            U(6) = 0.0
            U(7) = 1.0
            U(8) = 1.0
            U(9) = 1.0
            CALL GEN004 (T, U, P)
            CALL GEN113 (P, UVW, 9)
            A    = SQRT(SF11)
            B    = SQRT(SF22)
            C    = SQRT(SF33)
            COSA = SF23 / (B * C)
            COSB = SF13 / (A * C)
            COSG = SF12 / (A * B)
            GO TO 90
          END IF
        END IF
      END IF
      CALL PLA315
      ICOUNT = 0
  120 CALL PLA316
      CALL PLA315
      IF (IRED .NE. 1) THEN
        IF (IGO .GE. 1 .AND. IGO .LE. 9) THEN
          CALL GEN113 (UVW, T, 9)
          CALL GEN074 (U, 1, 9, 0.0)
          SSF23 = SF23
          SSF13 = SF13
          SSF12 = SF12
          IF (IGO .EQ. 1) THEN
            SF23 = SSF13
            SF13 = SSF23
            SF12 = SSF12
            U(2) = -1.0
            U(4) = -1.0
            U(9) = -1.0
          ELSE IF (IGO .EQ. 2) THEN
            SF23 = SSF23
            SF13 = SSF12
            SF12 = SSF13
            U(1) = -1.0
            U(6) = -1.0
            U(8) = -1.0
          ELSE IF (IGO .EQ. 3) THEN
            SF23 = SSF23
            SF13 = SSF12 - SSF13
            SF12 = SSF12
            U(1) = -1.0
            U(5) = -1.0
            U(8) = -1.0
            U(9) =  1.0
          ELSE IF (IGO .EQ. 4) THEN
            SF23 = SSF12 - SSF23
            SF13 = SSF13
            SF12 = SSF12
            U(1) = -1.0
            U(5) = -1.0
            U(7) = -1.0
            U(9) =  1.0
          ELSE IF (IGO .EQ. 5) THEN
            SF23 = SSF13 - SSF23
            SF13 = SSF13
            SF12 = SSF12
            U(1) = -1.0
            U(4) = -1.0
            U(5) =  1.0
            U(9) = -1.0
          ELSE IF (IGO .EQ. 6) THEN
            SF23 = ABS(SSF23)
            SF13 = ABS(SSF13) + ABS(SSF12)
            SF12 = ABS(SSF12)
            U(1) =  1.0
            U(5) = -1.0
            U(8) = -1.0
            U(9) = -1.0
          ELSE IF (IGO .EQ. 7) THEN
            SF23 = ABS(SSF23) + ABS(SSF12)
            SF13 = ABS(SSF13)
            SF12 = ABS(SSF12)
            U(1) = -1.0
            U(5) =  1.0
            U(7) = -1.0
            U(9) = -1.0
          ELSE IF (IGO .EQ. 8) THEN
            SF23 = ABS(SSF23) + ABS(SSF13)
            SF13 = ABS(SSF13)
            SF12 = ABS(SSF12)
            U(1) = -1.0
            U(4) = -1.0
            U(5) = -1.0
            U(9) =  1.0
          ELSE IF (IGO .EQ. 9) THEN
            SF23 = ABS(SSF12) + ABS(SSF23) - SF22
            SF13 = ABS(SSF12) + ABS(SSF13) - SF11
            SF12 = SSF12
            U(1) = -1.0
            U(5) = -1.0
            U(7) =  1.0
            U(8) =  1.0
            U(9) =  1.0
          END IF
          CALL GEN004 (T, U, P)
          CALL GEN113 (P, UVW, 9)
          ICOUNT = ICOUNT + 1
          IF (ICOUNT .LT. 20) GO TO 120
        END IF
        WRITE (LU7, 99999, IOSTAT = IOST)
        IERR = IERR + 1
      END IF
      RETURN
99999 FORMAT('ERROR - PROGRAM FAILS AT END OF SUBROUTINE PLA317')
      END SUBROUTINE PLA317
      SUBROUTINE PLA318 (NATOM, IHEX, IPEARS, PMIN, PEAR, NELT)
      PARAMETER (NUMAT=150, NSET=120, NELTS=16)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      COMMON /STBL4/ IPOL, R, NGR, IOCFL, VOL, NFL, VOLRAT
      COMMON /BUR/ NT, SPGR
      COMMON /LAB/ AX
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /ORD/ X(3, NUMAT), MUL(NUMAT), LET(NUMAT),
     1 HORSUM(NUMAT, NSET), SUM(3, NSET), SXY(NSET), SXZ(NSET),
     2 SYZ(NSET)
      COMMON /PAR/ GMIN
      COMMON /RES/ ATOM1, ATOM2, FOC, INTXT, CODE, ELT
      CHARACTER SPGP(230)*10, PSYM(47)*14, FORMS(15)*16, LATICE(6)*1,
     1 HBR(7)*1, XELN(105)*2, KOORD(12)*8, CHORI(9)*3, STAA(107)*11,
     2 STBB(39)*15, STCSH(17)*14, STTEXT(21)*17
      CHARACTER ELT(NELTS)*2, TEXT*17, AX*47, SPGR*10
      CHARACTER NT(16)*1, CODE(2)*1, STAR*1
      CHARACTER ATOM1(NUMAT)*2, ATOM2(NUMAT)*4, FOC(NUMAT)*5
      CHARACTER CPEARS*10, CPEAR(NELTS)*7, INTXT*40
      CHARACTER CA*8, CB*8, CC*8, CAL*9, CBE*9, CGA*9
      DIMENSION ORG(3), NRFILE(NSET), ORSAVE(3, NSET), NEWNR(NSET),
     1 KRES(NSET), PEAR(NELTS), KEQ(NSET), SM(3), NSP(NUMAT),
     2 NCHOIC(NSET)
      CHARACTER AUX1*6, AUX*7
      IF (IFMAT .EQ. 1) AX = '-a,-b,-c'
      KFL   = 0
      IG    = 0
      KOUNT = 0
      NRRES = 1
      CALL GEN074 (SXY, 1, NSET, 0.0)
      CALL GEN074 (SXZ, 1, NSET, 0.0)
      CALL GEN074 (SYZ, 1, NSET, 0.0)
      DO I = 1, NSET
        DO J = 1, 3
          SUM(J, I) = 0.0
        END DO
      END DO
      DO I = 1, NUMAT
        DO J = 1, NSET
          HORSUM(I, J) = 0.0
        END DO
      END DO
      REWIND LU61
      CALL PLA262 (3)
      WRITE (LU7, 99987, IOSTAT = IOST) GMIN
      CALL PLA262 (0)
      CALL PLA262 (2)
      WRITE (LU7, 99986, IOSTAT = IOST)
      IF (IPOL .EQ. 0) THEN
        CALL PLA262 (4)
        WRITE (LU7, 99985, IOSTAT = IOST)
      END IF
      CPEARS = ' '
      AUX    = ' '
      AUX1   = ' '
      WRITE (AUX1, 99963, IOSTAT = IOST) IPEARS
      K = 0
      DO J = 1, 6
        IF (AUX1(J:J) .NE. ' ') THEN
          K           = K + 1
          CPEARS(K:K) = AUX1(J:J)
        END IF
      END DO
      IF (PMIN .NE. 0.0) THEN
        K           = K + 1
        CPEARS(K:K) = '-'
        WRITE (AUX1, 99964, IOSTAT = IOST) PMIN
        DO J = 1, 6
          IF (AUX1(J:J) .NE. ' ') THEN
            K           = K + 1
            CPEARS(K:K) = AUX1(J:J)
          END IF
        END DO
      END IF
C * ABUNDANCES OF ELEMENTS
      DO I = 1, NELT
        K        = 0
        CPEAR(I) = ' '
        WRITE (AUX, 99965, IOSTAT = IOST) PEAR(I)
        DO J = 1, 7
          IF (AUX(J:J) .NE. ' ') THEN
            IF (AUX(J:J) .NE. '.') THEN
              K             = K + 1
              CPEAR(I)(K:K) = AUX(J:J)
            ELSE
              K             = K + 1
              CPEAR(I)(K:K) = '.'
              EXIT
            END IF
          END IF
        END DO
        DO L = J + 1, 7
          IF (AUX(L:L) .NE. '0') THEN
            DO N = J + 1, 7
              IF (AUX(N:N) .EQ. ' ') EXIT
              K = K + 1
              CPEAR(I)(K:K) = AUX(N:N)
            END DO
            EXIT
          END IF
        END DO
      END DO
      DO
        READ (LU61, IOSTAT = IOST) GAMMA, TEXT, ORG
        IF (IOST .NE. 0) EXIT
        KOUNT = KOUNT + 1
        IF (GMIN .GT. 0.0001) THEN
          FAC = GAMMA / GMIN
        ELSE
          IF (GAMMA .LT. 0.0001) THEN
            FAC = 1.0
          ELSE
            FAC = GAMMA
          END IF
        END IF
c
c count settings with gamma = gmin
        ISUM = 0
        IF (ABS(FAC - 1.0) .LE. 0.00001) THEN
          ISUM = 1
          IG   = IG + 1
          DO I = 1, 3
            ORSAVE(I, IG) = ORG(I)
          END DO
          NRFILE(IG) = KOUNT
          KRES(IG) = IG
        END IF
        IF (FAC .GT. 1.00001 .AND. FAC .LE. 1.0025) THEN
          KFL      = KFL + 1
          KEQ(KFL) = KOUNT
        END IF
        CALL PLA262 (4)
        WRITE (LU7, 99984, IOSTAT = IOST) TEXT, ORG, GAMMA, FAC
        WRITE (LU7, 99983, IOSTAT = IOST) A, B, C, AL, BE, GA
        DO I = 1, NATOM
          READ (LU61, IOSTAT = IOST) NSP(I), (X(J, I), J = 1, 3),
     1          MUL(I), LET(I), FOC(I)
          IF (IOST .NE. 0) GO TO 10
          IF (ISUM .EQ. 1) THEN
            DO J = 1, 3
              SUM(J, IG) = SUM(J, IG) + X(J, I)
            END DO
            SXY(IG) = SXY(IG) + X(1, I) * X(2, I)
            SXZ(IG) = SXZ(IG) + X(1, I) * X(3, I)
            SYZ(IG) = SYZ(IG) + X(2, I) * X(3, I)
          END IF
        END DO
        DO I = 1, NATOM
          K = LET(I)
          CALL PLA262 (1)
          WRITE (LU7, 99993, IOSTAT = IOST)
     1      ATOM1(I), ATOM2(I), (X(J, I), J = 1, 3),
     2      FOC(I), MUL(I), CHAR(96 + K)
        END DO
        IF (ISUM .EQ. 1) THEN
          CALL PLA262 (3)
          WRITE (LU7, 99994, IOSTAT = IOST) (SUM(K, IG), K = 1, 3)
        END IF
      END DO
   10 IF (KOUNT .GT. NSET) THEN
        CALL PLA262 (3)
        WRITE (LU7, 99992, IOSTAT = IOST) KOUNT, NSET
      END IF
C * WRITE HEADINGS FOR RESULT
      WRITE (LU21, 99959, IOSTAT = IOST) INTXT
      CALL PLA262 (0)
      CALL PLA262 (3)
      WRITE (LU7, 99960, IOSTAT = IOST)
      WRITE (LU7, 99991, IOSTAT = IOST) INTXT
      WRITE (LU7, 99960, IOSTAT = IOST)
      WRITE (LU6, 99960, IOSTAT = IOST)
      WRITE (LU6, 99991, IOSTAT = IOST) INTXT
      WRITE (LU6, 99960, IOSTAT = IOST)
      IF (IOCFL .EQ. 1) THEN
        CALL PLA262 (2)
        WRITE (LU7, 99990, IOSTAT = IOST)
        WRITE (LU6, 99990, IOSTAT = IOST)
      END IF
      IF (NFL .EQ. 1) THEN
        CALL PLA262 (4)
        WRITE (LU7, 99989, IOSTAT = IOST)
      END IF
      IF (IFMAT .EQ. 1) THEN
        WRITE (LU6,  99979, IOSTAT = IOST)
        WRITE (LU63, 99978, IOSTAT = IOST)
      END IF
      IF (IFSH .GT. 0) THEN
        WRITE (LU63, 99971, IOSTAT = IOST)
        WRITE (LU6, 99972, IOSTAT = IOST) sh
      END IF
      IF (IHEX .EQ. 1) THEN
        WRITE (LU63, 99977, IOSTAT = IOST)
        WRITE (LU6,  99976, IOSTAT = IOST)
        CALL PLA262 (1)
        WRITE (LU7, 99995, IOSTAT = IOST) A, A, C
      END IF
      STAR = ' '
      IF (IFMAT .GT. 0 .OR. IHEX .EQ. 1 .OR. IFNIG .EQ. 2) THEN
        WRITE (LU6, 99980, IOSTAT = IOST) AX
        STAR = '*'
      END IF
      IF (PMIN .EQ. 0) THEN
        WRITE (LU6, 99970, IOSTAT = IOST)
     1    CODE, IPEARS, (ELT(I), PEAR(I), I = 1, NELT)
      ELSE
        WRITE (LU6, 99969, IOSTAT = IOST)
     1    CODE, IPEARS, PMIN, (ELT(I), PEAR(I), I = 1, NELT)
      END IF
      IF (NELT .LT. 5) THEN
        CALL GEN126 (ELT,   NELT + 1, 5)
        CALL GEN126 (CPEAR, NELT + 1, 5)
      END IF
      IF (IFMAT .GT. 0 .OR. IHEX .EQ. 1 .OR. IFNIG .EQ. 2)
     1   WRITE (LU6, 99980, IOSTAT = IOST) AX
      WRITE (CA,  99962, IOSTAT = IOST) A
      WRITE (CB,  99962, IOSTAT = IOST) B
      WRITE (CC,  99962, IOSTAT = IOST) C
      WRITE (CAL, 99961, IOSTAT = IOST) AL
      WRITE (CBE, 99961, IOSTAT = IOST) BE
      WRITE (CGA, 99961, IOSTAT = IOST) GA
      IF (NGR .GE. 3 .AND. NGR .LE. 15) THEN
        CAL = '   90    '
        CGA = '   90    '
      ELSE IF (NGR .GE. 16 .AND. NGR .LE. 142) THEN
        CAL = '   90    '
        CBE = '   90    '
        CGA = '   90    '
      ELSE IF (NGR .GE. 143 .AND. NGR .LE. 194) THEN
        CAL = '   90    '
        CBE = '   90    '
        CGA = '  120    '
      ELSE IF (NGR .GE. 195) THEN
        CAL = '   90    '
        CBE = '   90    '
        CGA = '   90    '
      END IF
      WRITE (LU63, 99988, IOSTAT = IOST) CA, CB, CC, CAL, CBE, CGA, STAR
      WRITE (LU21, 99958, IOSTAT = IOST) A, B, C, AL, BE, GA
      WRITE (LU6,  99983, IOSTAT = IOST) A, B, C, AL, BE, GA
      WRITE (LU63, 99968, IOSTAT = IOST)
     1  CODE, CPEARS, (ELT(I), CPEAR(I), I = 1, 5)
      IF (NELT .GT. 5) WRITE (LU63, 99967, IOSTAT = IOST)
     1  (ELT(I), CPEAR(I), I = 6, NELT)
      WRITE (LU6,  99966, IOSTAT = IOST) SPGR, NGR
      WRITE (LU21, 99957, IOSTAT = IOST) SPGR
      IF (IFPLUS .GT. 5) THEN
        CALL PLA262 (1)
        WRITE (LU7, 99996, IOSTAT = IOST)
      END IF
      IF (IFPLUS .EQ. 1 .OR. IFPLUS .EQ. 3 .OR. IFPLUS .EQ. 5) THEN
        WRITE (LU6, 99974, IOSTAT = IOST) STCSH(NSHTRA)
        IF (IFPLUS .EQ. 3) THEN
          WRITE (LU6, 99975, IOSTAT = IOST) STCSH(NABC)
        ELSE IF (IFPLUS .EQ. 5) THEN
          WRITE (LU6, 99973, IOSTAT = IOST) STCSH(NSH)
        END IF
      ELSE IF (IFPLUS .EQ. 2) THEN
        WRITE (LU6, 99975, IOSTAT = IOST) STCSH(NABC)
      ELSE IF (IFPLUS .EQ. 4) THEN
        WRITE (LU6, 99973, IOSTAT = IOST) STCSH(NSH)
      END IF
      IF (IG .GT. 0) THEN
        IGG = IG
        IF (IG .GT. NSET) IGG = NSET
        IF (IGG .EQ. 1) THEN
          NRRES    = 1
          KRES(1)  = 1
          NEWNR(1) = IG
        ELSE
          CALL PLA313 (NATOM, 1, IGG, NRRES, KRES, NEWNR)
          IF (NRRES .EQ. 0) THEN
            WRITE (LU7, 99999, IOSTAT = IOST)
            RETURN
          END IF
        END IF
        REWIND LU61
        KOUNT = 0
        IK    = 0
        DO II = 1, NRRES
          K1 = NEWNR(II)
          KK = NRFILE(K1)
   20     READ (LU61, IOSTAT = IOST) GAMMA, TEXT, ORG
          IF (IOST .NE. 0) GO TO 30
          KOUNT = KOUNT + 1
          DO I = 1, NATOM
            READ (LU61, IOSTAT = IOST) NSP(I), (X(J, I), J = 1, 3),
     1                       MUL(I), LET(I), FOC(I)
            IF (IOST .NE. 0) GO TO 30
          END DO
          IF (KOUNT .EQ. KK) THEN
            IF (NRRES .EQ. 1) THEN
              CALL PLA262 (2)
              WRITE (LU7, 99998, IOSTAT = IOST)
     1          TEXT, (ORSAVE(K, K1), K = 1, 3), GAMMA
              WRITE (LU63, 99997, IOSTAT = IOST) GAMMA
            END IF
            IK = IK + 1
            CALL PLA305 (NATOM, NRRES, IK, NELT, AX, TEXT,
     1        ORSAVE(1, K1), ORSAVE(2, K1), ORSAVE(3, K1), NSP)
            IF (NRRES .EQ. 1) CALL PLA312
          ELSE
            GO TO 20
          END IF
        END DO
   30   IF (NRRES .NE. 1) THEN
          IGG = IK
          CALL PLA313 (NATOM, 2, IGG, NRRES, NEWNR, NCHOIC)
          IF (NRRES .EQ. 0) THEN
            WRITE (LU7, 99999, IOSTAT = IOST)
            RETURN
          END IF
          REWIND LU61
          K  = 0
          IK = 0
          DO II = 1, NRRES
            K1    = NCHOIC(II)
            KOUNT = NRFILE(K1)
   40       READ (LU61, IOSTAT = IOST) GAMMA, TEXT, ORG
            IF (IOST .NE. 0) GO TO 50
            K = K + 1
            DO I = 1, NATOM
              READ (LU61, IOSTAT = IOST) NSP(I), (X(J, I), J = 1, 3),
     1              MUL(I), LET(I), FOC(I)
              IF (IOST .NE. 0) RETURN
            END DO
            IF (K .EQ. KOUNT) THEN
              IF (IK .GT. 0) THEN
                WRITE (LU63, 99981, IOSTAT = IOST)
                WRITE (LU6,  99982, IOSTAT = IOST)
              END IF
              WRITE (LU6,  99998, IOSTAT = IOST)
     1          TEXT, (ORSAVE(L, K1), L = 1, 3), GAMMA
              WRITE (LU63, 99997, IOSTAT = IOST) GAMMA
              IK = IK + 1
              CALL PLA305 (NATOM, -II, IK, NELT, AX, TEXT,
     1          ORSAVE(1, K1), ORSAVE(2, K1), ORSAVE(3, K1), NSP)
              CALL PLA312
            ELSE
              GO TO 40
            END IF
          END DO
        END IF
   50   IF (KFL .GT. 0) THEN
          REWIND LU61
          K  = 0
          KK = 0
          DO I = 1, KFL
            WRITE (LU6,  99982, IOSTAT = IOST)
            WRITE (LU63, 99981, IOSTAT = IOST)
            KOUNT = KEQ(I)
            DO WHILE (K .NE. KOUNT - 1)
              READ (LU61, IOSTAT = IOST) GAMMA, TEXT, ORG
              IF (IOST .NE. 0) RETURN
              K = K + 1
              DO J = 1, NATOM
                READ (LU61, IOSTAT = IOST) NSP(J), (X(L, J), L = 1, 3),
     1                MUL(J), LET(J), FOC(J)
                IF (IOST .NE. 0) RETURN
              END DO
            END DO
            KK = KK + 1
            CALL GEN074 (SM, 1, 3, 0.0)
            DO J = 1, NATOM
              DO L = 1, 3
                SM(L) = SM(L) + X(L, J)
              END DO
            END DO
            WRITE (LU6,  99998, IOSTAT = IOST) TEXT, ORG, GAMMA
            WRITE (LU63, 99997, IOSTAT = IOST) GAMMA
            CALL PLA305 (NATOM, 1, KK, NELT, AX, TEXT, ORG(1), ORG(2),
     1        ORG(3), NSP)
            CALL PLA262 (3)
            WRITE (LU63, 99994, IOSTAT = IOST) SM
            CALL PLA312
          END DO
        END IF
      END IF
      RETURN
99999 FORMAT ('ERROR in SUBROUTINE PLA313 ')
99998 FORMAT (/, 'Setting ', A, ' Origin (', 3F7.4, ')', 2X,
     1        'Gamma = ', F7.4, /)
99997 FORMAT ('gamma', F8.4)
99996 FORMAT ('SUBROUTINE PLA318 : error in value of IFPLUS (too many',
     1 ' extra shifts')
99995 FORMAT ('New cell parameters : ', 3F8.4, ' 90  90  120')
99994 FORMAT (/, 'Sums :    ',3F9.5, /)
99993 FORMAT (A, 1X, A, 3X, 3F9.5, 5X, A, 5X, I3, '(', A, ')')
99992 FORMAT (/, 'WARNING ]]] ',/, I4, ' different settings;',
     1' only', I4, ' will be considered in printing results.')
99991 FORMAT ('Structure Tidy Results for ', A)
99990 FORMAT (/, 'WARNING : occupation factor not = 1')
99989 FORMAT (/, 'WARNING : setting -x,-y,-z has NOT been',
     1 ' considered since this would correspond to ',
     2 /, ' a space group with different chirality', /)
99988 FORMAT ('CELL', 9X, 3A, 1X, 3A, 7X, A)
99987 FORMAT (//, 'Minimum Standardization Parameter Gamma = ', F8.4)
99986 FORMAT ('All Possible Settings :', /, 23('='))
99985 FORMAT ('For every Setting, Origin Shifts Giving up to 1.0025',
     1 /, 'times the Minimum Gamma have been retained.', //)
99984 FORMAT (/, 'Setting ', A, 2X, 'Origin (', 3F8.5, ')', 3X,
     1        'Gamma = ', F8.4, /, 52X, 'Gamma/min(Gamma) = ', F8.4)
99983 FORMAT ('Cell : ', 3F8.4, 3F9.3)
99982 FORMAT (//, 'OTHER Standardization with Similar Gamma :')
99981 FORMAT ('OTHER Standardization with Similar Gamma :')
99980 FORMAT (/, 'Axes changed to : ', A47)
99979 FORMAT ('Transformed from enantiomorphic space group')
99978 FORMAT ('REMARK Transformed from enantiomorphic space group.')
99977 FORMAT ('REMARK Transformed from rhombohedral cell.')
99976 FORMAT ('Transformation from rhombohedral cell to triple ',
     1 'hexagonal cell')
99975 FORMAT ('Extra origin shift, due to interchange of axes : ', A)
99974 FORMAT ('Extra origin shift, due to change of setting : ', A)
99973 FORMAT ('Extra origin shift, due to cell reduction : ', A)
99972 FORMAT ('Extra origin shift of ',3F7.3, /,' due to transformation'
     1 , ' to setting with centre of symmetry at the origin')
99971 FORMAT ('REMARK Transformed from non-centrosymmetric setting.')
99970 FORMAT ('Pearson code : ', 2A, I4, 2X, 10(A, F5.1, 2X))
99969 FORMAT ('Pearson code : ', 2A, I4, '(-', F6.2, ')', 2X,
     1         10(A, F5.1, 2X))
99968 FORMAT ('PCODE', 2X, 2A, A10, 4X, 5(A, 1X, A))
99967 FORMAT ('PCODE', 18X            , 5(A, 1X, A))
99966 FORMAT ('Space group : ', A, ' Number in IT : ', I3)
99965 FORMAT (F7.3)
99964 FORMAT (F6.2)
99963 FORMAT (I6)
99962 FORMAT (F8.4)
99961 FORMAT (F9.3)
99960 FORMAT (79('='))
99959 FORMAT ('TITL ', A)
99958 FORMAT ('CELL ', 6F10.4)
99957 FORMAT ('SPGR ', A)
      END SUBROUTINE PLA318
      SUBROUTINE PLA319 (II, IK, NATOM, IER)
      PARAMETER (NUMAT=150,NTOT=1000,NELTS=16)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      COMMON /AT/ IAT, POS(3), IHEX, FNUM
      COMMON /MATR/ IFMAT, IFSH, IFPLUS, XMAT(3, 3), PLUS(3), SH(3),
     1 NABC, NSH, NSHTRA, IFNIG, XMSAVE(3, 3), SHIF(3), MINSH
      COMMON /ORGIN/ NOR, ORGADD(3, 8), NTEXT, ICOORD
      COMMON /PAR/ GMIN
      COMMON /POL/ NPOL, XPOL(3, NTOT), XP(3, NTOT), ORGA(3), SMIN,
     1 KKORD(NUMAT), NAT(NTOT)
      COMMON /RES/ ATOM1, ATOM2, FOCCU, INTXT, CODE, ELT
      COMMON /ROT/ XROT(3, NUMAT), NAGAIN
      common /TRIP/ DMIN, MIN, KORDER(192), IFLAG, XMIN(3, NUMAT),
     1 MUL(NUMAT), LE(NUMAT), NRSET(NUMAT), NNSET(8, NUMAT)
      COMMON /XPOLAR/ IPOLAR, KPOL(3), LOWLET
      DIMENSION XS(3, NUMAT), XM(3, NTOT), SADD(3, 50), ZMIN(3),
     1 ORG(3), NSP(NUMAT), XX(3), NAT2(NTOT)
      CHARACTER ATOM1(NUMAT)*2, ATOM2(NUMAT)*4, FOCCU(NUMAT)*5
      CHARACTER SPGP(230)*10, PSYM(47)*14, FORMS(15)*16, LATICE(6)*1,
     1 HBR(7)*1, XELN(105)*2, KOORD(12)*8, CHORI(9)*3, STAA(107)*11,
     2 STBB(39)*15, STCSH(17)*14, STTEXT(21)*17
      CHARACTER INTXT*40, CODE(2)*1, ELT(NELTS)*2
      DO I = 1, 3
        ZMIN(I) = ORGA(I)
        ORG(I)  = ORGA(I)
      END DO
      DO J = 1, NTOT
        NAT2(J) = 0
        DO K = 1, 3
          XM(K, J) = 0.0
        END DO
      END DO
      REWIND LU60
      SMIN = 1000.0
      S  = 0.0
      EP = -0.000001
      DO I = 1, NPOL
        DO J = 1, 3
          XPOL(J, I) = XP(J, I) - ORGA(J)
          IF (XPOL(J, I) .LT. 0.0) XPOL(J, I) = XPOL(J, I) + 1.0
        END DO
      END DO
      KNT = 0
      NR  = 0
      IF (IK .EQ. 1) THEN
        IF (II .EQ. 2) THEN
          I1 = 2
        ELSE
          I1 = 3
        END IF
        I2 = 0
        I3 = 0
      ELSE IF (IK .EQ. 2) THEN
        I1 = 1
        I2 = 3
        I3 = 0
      ELSE IF (IK .EQ. 3) THEN
        I1 = 1
        I2 = 2
        I3 = 3
      END IF
      KPOL(1) = I1
      KPOL(2) = I2
      KPOL(3) = I3
      KT      = 0
      DO 20 K = 1, NPOL
        CALL GEN074 (XX, 1, 3, 0.0)
        XX(I1) = XPOL(I1, K)
        IF (I2 .GT. 0) XX(I2) = XPOL(I2, K)
        IF (I3 .GT. 0) XX(I3) = XPOL(I3, K)
        IF (K .NE. 1) THEN
          DO 10 KK = 1, KT
            DO JJ = 1, 3
              IF (XX(JJ) .EQ. 0.0) THEN
                IF (JJ .NE. I1 .AND. JJ .NE. I2 .AND. J .NE. I3)
     1            CYCLE
              END IF
              IF (ABS(XX(JJ) - XM(JJ, KK)) .GT. 0.0001) GO TO 10
            END DO
            IF (NAT2(KK) .NE. NAT(K)) GO TO 10
            GO TO 20
   10     CONTINUE
        END IF
        KT       = KT + 1
        NAT2(KT) = NAT(K)
        DO J = 1, 3
          XM(J, KT) = XX(J)
        END DO
        S = 0.0
        IIA = NAT(K)
        IPOLAR = 0
        DO IA = 1, NATOM
          DO J = 1, 3
            POS(J) = XROT(J, IA) - ORGA(J)
          END DO
          DO J = 1, 3
            IF (POS(J) .LT. EP) POS(J) = POS(J) + 1.0
          END DO
          CALL PLA322
          LRET330 = 0
          CALL PLA326 (IA, NP, LU7, LRET330)
          IF (LRET330 .EQ. 0) NSP(IA) = NP
        END DO
        DO IA = 1, NATOM
          DO J = 1, 3
            POS(J) = XROT(J, IA) - ORGA(J) - XX(J)
          END DO
          DO J = 1, 3
            IF (POS(J) .LT. EP) POS(J) = POS(J) + 1.0
          END DO
          CALL PLA322
          IPOLAR = 0
          IF (IA .EQ. IIA) IPOLAR = 1
          LRET330 = 0
          CALL PLA326 (IA, NP, LU7, LRET330)
          S = S + DMIN
        END DO
        IF (S .GT. 99) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99998, IOSTAT = IOST) ORGA, XX
          GO TO 20
        ELSE
          CALL PLA262 (3)
          WRITE (LU7, 99999, IOSTAT = IOST) ORGA, XX, S
        END IF
        WRITE (LU60) XX, S
        KNT = KNT + 1
        IF (S .LT. SMIN) THEN
          SMIN = S
          NR   = KNT
          DO J = 1, 3
            ZZ = XX(J) + ORGA(J)
            IF (ZZ .GT. 0.99999) ZZ = ZZ - 1.0
            ZMIN(J) = ZZ
          END DO
          DO IA = 1, NATOM
            DO J = 1, 3
              XS(J, IA) = XMIN(J, IA)
            END DO
          END DO
        END IF
   20 CONTINUE
      IF (SMIN .GT. 99) THEN
        WRITE (LU7, 99997, IOSTAT = IOST) ORGA, XX
        RETURN
      END IF
      DO J = 1, 3
        ORGA(J) = ZMIN(J)
      END DO
      IF (IFSH .GT. 0 .OR. IFPLUS .GT. 0) THEN
        DO J = 1, 3
          ORGA(J) = ORGA(J) + PLUS(J)
        END DO
      END IF
      WRITE (LU61, IOSTAT = IOST) SMIN, STTEXT(NTEXT), ORGA
      IF (IOST .NE. 0) GO TO 30
      DO IA = 1, NATOM
        WRITE (LU61, IOSTAT = IOST) NSP(IA), (XS(J, IA), J = 1, 3),
     1     MUL(IA), LE(IA), FOCCU(IA)
        IF (IOST .NE. 0) GO TO 30
      END DO
      CALL PLA323 (2, IOR, NATOM, SMIN, XS, MUL, LE, LU7)
      IF (SMIN .LT. GMIN) GMIN = SMIN
      KT1 = 0
      IF (KNT .NE. 0) THEN
        SS = 1.0025 * SMIN
        REWIND LU60
        KT = 0
        DO I = 1, KNT
          READ (LU60, IOSTAT = IOST) XX, S
          IF (IOST .NE. 0) EXIT
          KT = KT + 1
          IF (KT .NE. NR) THEN
            IF (S .LT. SS) THEN
              KT1 = KT1 + 1
              DO J = 1, 3
                ZZ = XX(J) + ORG(J)
                IF (ZZ .GT. 0.99999) ZZ = ZZ - 1.0
                SADD(J, KT1) = ZZ
              END DO
            END IF
          END IF
        END DO
      END IF
      CALL PLA262 (4)
      WRITE (LU7, 99996, IOSTAT = IOST) STTEXT(ntext), smin, zmin
      IF (KT1 .GT. 0) THEN
        WRITE (LU7, 99995, IOSTAT = IOST)
        WRITE (LU7, 99994, IOSTAT = IOST)
     1    ((SADD(I, J), I = 1, 3), J = 1, KT1)
        DO I = 1, KT1
          S = 0.0
          DO IA = 1, NATOM
            DO J = 1, 3
              POS(J) = XROT(J, IA) - SADD(J, I)
              IF (POS(J) .LT. EP) POS(J) = POS(J) + 1.0
            END DO
            CALL PLA322
            IPOLAR  = 0
            LRET330 = 0
            CALL PLA326 (IA, NP, LU7, LRET330)
            S = S + DMIN
          END DO
          DO J = 1, 3
            ORGA(J) = SADD(J, I)
          END DO
          WRITE (LU61, IOSTAT = IOST) S, STTEXT(NTEXT), ORGA
          IF (IOST .NE. 0) GO TO 30
          DO IA = 1, NATOM
            WRITE (LU61, IOSTAT = IOST) NSP(IA),
     1         (XMIN(J, IA), J = 1, 3), MUL(IA), LE(IA), FOCCU(IA)
            IF (IOST .NE. 0) GO TO 30
          END DO
          CALL PLA323 (2, IOR, NATOM, SMIN, XMIN, MUL, LE, LU7)
        END DO
      END IF
      IF (NR .EQ. 0) WRITE (LU7, 99993, IOSTAT = IOST)
      RETURN
   30 WRITE (LU7, 99992, IOSTAT = IOST)
      IER = 1
      RETURN
99999 FORMAT (/, 'Shift of ', 3F8.5, ' + ', 3F8.5,
     1        ' Gave Sum ', F10.4, /)
99998 FORMAT ('Shift of ', 3F8.5, ' + ', 3F8.5, ' no triplet possible')
99997 FORMAT ('No Setting Possible for ', 6F9.5)
99996 FORMAT (//, 'Result for setting : ', A, /
     1 'Standardization parameter', F9.4, ' is Attained for Shift ',
     2 3f8.4)
99995 FORMAT ('Shifts giving slightly higher standardidation :')
99994 FORMAT (12F8.5)
99993 FORMAT (/, 'ERROR in SUBROUTINE PLA319')
99992 FORMAT (//, 'ERROR  in PLA319 while writing on unit 10')
      END SUBROUTINE PLA319
      SUBROUTINE PLA320 (ISEQ, LU)
      COMMON /CEL/ A, B, C, AL, BE, GA, ALF, BET, GAM, COSA, COSB, COSG
      Q      = 0.004
      DQ     = 0.04
      IFLAG1 = 0
      IFLAG2 = 0
      IFLAG3 = 0
      NEG    = 1
      ISEQ   = 0
      E1     = A**2
      E2     = B**2
      E3     = C**2
      E4     = COSA * B * C
      E5     = COSB * A * C
      E6     = COSG * A * B
      ONE    = ABS(E1 - E3)
      TWO    = ABS(E1 - E2)
      THREE  = ABS(E2 - E3)
      IF (ONE .LT. (Q * E3)) IFLAG1 = 1
      IF (TWO .LT. (Q * E2)) IFLAG2 = 1
      IF (THREE .LT. (Q * E3)) IFLAG3 = 1
      IF (E4 .LT. Q .AND. E5 .LT. Q .AND. E6 .LE. Q) NEG = -1
      IF (E4 .GT. Q .AND. E5 .GT. Q .AND. E6 .GE. Q) NEG = 0
      IF (NEG .EQ. 1) THEN
        NEG = -1
        IF (AL .LT. 89.99 .OR. BE .LT. 89.99 .OR. GA .LT. 89.99) NEG = 0
        WRITE (LU, 99999, IOSTAT = IOST)
      END IF
      IF (IFLAG1 .EQ. 1) THEN
        IF (NEG .NE. -1) THEN
          X = E1 / 2.0
          IF (ABS(E4 - X) .LT. (E4 * Q + DQ) .AND.
     1        ABS(E5 - X) .LT. (E5 * Q + DQ) .AND.
     2        ABS(E6 - X) .LT. (E6 * Q + DQ)) THEN
            ISEQ = 1
          ELSE IF (ABS(E4 - E5) .LT. (E4 * Q + DQ) .AND.
     1        ABS(E5 - E6) .LT. (E5 * Q + DQ)) THEN
            ISEQ = 2
          ELSE IF (ISEQ .EQ. 0) THEN
            GO TO 10
          END IF
          RETURN
        END IF
        Z = E1 / 3.0
        IF ((ABS(E4) + ABS(E5) + ABS(E6)) .LT. (DQ * 3.0)) THEN
          ISEQ = 3
        ELSE IF (ABS(E4 + Z) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS(E5 + Z) .LT. (ABS(E5 * Q) + DQ) .AND.
     2      ABS(E6 + Z) .LT. (ABS(E6 * Q) + DQ)) THEN
          ISEQ = 5
        ELSE IF (ABS(E4 - E5) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 4
        ELSE IF (ABS(E4 - E5) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS((E6 + E1) / 2.0 + E4) .LT. (ABS(E4 * Q) + DQ)) THEN
          ISEQ = 6
        ELSE IF (ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ) .AND.
     1      ABS((E4 + E1) / 2.0 + E5) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 7
        ELSE IF (ABS(E1 + E4 + E5 + E6) .LT. (ABS(E6 * Q) + DQ)) THEN
          ISEQ = 8
        ELSE IF (ISEQ .EQ. 0) THEN
          GO TO 30
        END IF
        RETURN
      END IF
      IF (IFLAG2 .EQ. 1) GO TO 10
      IF (IFLAG3 .EQ. 1) GO TO 40
      GO TO 60
   10 IF (NEG .NE. -1) THEN
        X = E1 / 2.0
        IF (ABS(E4 - X) .LT. (E4 * Q + DQ) .AND.
     1      ABS(E5 - X) .LT. (E5 * Q + DQ) .AND.
     2      ABS(E6 - X) .LT. (E6 * Q + DQ)) THEN
          ISEQ = 9
        ELSE IF (ABS(E4 - E5) .LT. (ABS(E4 * Q) + DQ)) THEN
          ISEQ = 10
        ELSE IF (ISEQ .EQ. 0) THEN
          GO TO 40
        END IF
        RETURN
      END IF
   30 X = E1 / 2.0
      IF (ABS(E4 + E5) .LT. (DQ * 2.0) .AND.
     1    ABS(E6 + X)  .LT. (ABS(E6 * Q) + DQ)) THEN
        ISEQ = 12
      ELSE IF ((ABS(E4) + ABS(E5) + ABS(E6)) .LT. (DQ * 3.0)) THEN
        ISEQ = 11
      ELSE IF (ABS(E4 - E5) .LT. (ABS(E4 * Q) + DQ) .AND.
     1    ABS(E4 + X)  .LT. (ABS(E4 * Q) + DQ)) THEN
        ISEQ = 15
      ELSE IF (ABS(E4 + E5) .LT. (DQ * 2.0)) THEN
        ISEQ = 13
      ELSE IF (ABS(E4 - E5) .LT. (ABS(E4 * Q) + DQ) .AND.
     1    ABS(E1 + 2.0 * E4 + E6) .LT. (ABS(E6 * Q)  + DQ)) THEN
        ISEQ = 16
      ELSE IF (ABS(E1 + E4 + E5 + E6) .LT. (ABS(E6 * Q) + DQ)) THEN
        ISEQ = 17
      ELSE IF (ABS(E4 - E5) .LT. (ABS(E4 * Q) + DQ)) THEN
        ISEQ = 14
      ELSE IF (ISEQ .EQ. 0) THEN
        GO TO 50
      END IF
      RETURN
   40 IF (ABS(B - C) .GT. ABS(B * Q)) GO TO 60
      IF (NEG .NE. -1) THEN
        X = E1 / 2.0
        IF (ABS(E4 - X / 2.0) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ) .AND.
     2      ABS(E5 - X)  .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 18
        ELSE IF (ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ) .AND.
     1      ABS(E5 - X)  .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 19
        ELSE IF (ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 10
        ELSE IF (ISEQ .EQ. 0) THEN
          GO TO 60
        END IF
        RETURN
      END IF
   50 IF (ABS(B - C) .LE. ABS(B * Q)) THEN
        Y = E2 / 2.0
        IF (ABS(((E2 - E1 / 3.0) / 2.0) + E4) .LT. (ABS(E4 * Q) + DQ)
     1    .AND. ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ)
     2    .AND. ABS(E5 + E1 / 3.0) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 24
        ELSE IF (ABS(E6 + E5) .LT. (DQ * 2.0) .AND.
     1      ABS(E4 + Y)  .LT. (ABS(E4 * Q) + DQ)) THEN
          ISEQ = 22
        ELSE IF ((ABS(E4) + ABS(E5) + ABS(E6)) .LT. (DQ * 3.0)) THEN
          ISEQ = 21
        ELSE IF (ABS(E6 + E5) .LT. (DQ * 2.0)) THEN
          ISEQ = 23
        ELSE IF (ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 25
        END IF
        IF (ISEQ .NE. 0) RETURN
      END IF
      GO TO 70
   60 IF (NEG .NE. -1) THEN
        X = E1 / 2.0
        Y = E2 / 2.0
        IF (ABS(E4 - X / 2.0) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ) .AND.
     2      ABS(E5 - X) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 26
        ELSE IF (ABS(E5 - E6) .LT. (ABS(E5 * Q) + DQ) .AND.
     1      ABS(E5 - X)  .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 27
        ELSE IF (ABS(E4 - E6 / 2.0) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS(E5 - X) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 28
        ELSE IF (ABS(E4 - E5 / 2.0) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS(E6 - X) .LT. (ABS(E6 * Q) + DQ)) THEN
          ISEQ = 29
        ELSE IF (ABS(E4 - Y) .LT. (ABS(E4 * Q) + DQ) .AND.
     1      ABS(E5 - E6 / 2.0) .LT. (ABS(E5 * Q) + DQ)) THEN
          ISEQ = 30
        ELSE IF (ISEQ .EQ. 0) THEN
          ISEQ = 31
        END IF
        RETURN
      END IF
   70 X = E1 / 2.0
      Y = E2 / 2.0
      IF ((ABS(E4) + ABS(E5) + ABS(E6)) .LT. (DQ * 3.0)) THEN
        ISEQ = 32
      ELSE IF (ABS(E6 + E4) .LT. (DQ * 2.0) .AND.
     1    ABS(E5 + X)  .LT. (ABS(E5 * Q) + DQ)) THEN
        ISEQ = 36
      ELSE IF (ABS(E5 + E4) .LT. (DQ * 2.0) .AND.
     1    ABS(E6 + X)  .LT. (ABS(E6 * Q) + DQ)) THEN
        ISEQ = 38
      ELSE IF (ABS(E6 + E5) .LT. (DQ * 2.0) .AND.
     1    ABS(E4 + Y)  .LT. (ABS(E4 * Q) + DQ)) THEN
        ISEQ = 40
      ELSE IF (ABS(E6) .LT. DQ .AND. ABS(E4 + Y) .LT. (ABS(E4 * Q) + DQ)
     1   .AND. ABS(E5 + X) .LT. (ABS(E5 * Q) + DQ)) THEN
        ISEQ = 42
      ELSE IF (ABS(E4 + E6) .LT. (DQ * 2.0)) THEN
        ISEQ = 33
      ELSE IF (ABS(E4 + E5) .LT. (DQ * 2.0)) THEN
        ISEQ = 34
      ELSE IF (ABS(E6 + E5) .LT. (DQ * 2.0)) THEN
        ISEQ = 35
      ELSE IF (ABS(E5 + X) .LT. (ABS(E5 * Q) + DQ) .AND.
     1    ABS(E6) .LT. DQ) THEN
        ISEQ = 37
      ELSE IF (ABS(E6 + X) .LT. (ABS(E6 * Q) + DQ) .AND.
     1    ABS(E5) .LT. DQ) THEN
        ISEQ = 39
      ELSE IF (ABS(E4 + Y) .LT. (ABS(E4 * Q) + DQ) .AND.
     1    ABS(E6) .LT. DQ) THEN
        ISEQ = 41
      ELSE IF (ABS(E4 + (E2 + E6) / 2.0) .LT. (ABS(E4 * Q) + DQ) .AND.
     1    ABS(E5 + (E1 + E6) / 2.0) .LT. (ABS(E5 * Q) + DQ)) THEN
        ISEQ = 43
      ELSE IF (ISEQ .EQ. 0) THEN
        ISEQ = 44
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT(//,'**WARNING** REDUCED FORM MAY NOT BE CORRECT')
      END SUBROUTINE PLA320
      SUBROUTINE PLA321 (L)
      PARAMETER (NUMAT=150, NELTS=16, NDIF=30)
      COMMON /NUM/ NEL, NEWN, NR(NDIF), MAXNR(NDIF)
      COMMON /RES/ ATOM1, ATOM2, FOCCU, INTXT, CODE, ELT
      COMMON /ELTNAME/ FINELT
      CHARACTER FINELT(NDIF)*2, ATOM1(NUMAT)*2, ATOM2(NUMAT)*4,
     1 FOCCU(NUMAT)*5, INTXT*40, CODE(2)*1, elt(NELTS)*2
      IF (NEL .EQ. 0) THEN
        FINELT(1) = ATOM1(l)
        NEL   = 1
        NEWN  = 1
        NR(1) = 1
      ELSE
        I = 1
        DO J = 1, NEL
          I = J
          IF (ATOM1(L) .EQ. FINELT(J)) THEN
            NR(I) = NR(I) + 1
            NEWN  = NR(I)
            GO TO 10
          END IF
        END DO
        NEL         = NEL + 1
        NEWN        = 1
        FINELT(NEL) = ATOM1(L)
        NR(NEL)     = 1
   10   IF (NEWN .GT. MAXNR(I)) MAXNR(I) = NEWN
      END IF
      RETURN
      END SUBROUTINE PLA321
      SUBROUTINE PLA322
      COMMON /AT/ IAT, POS(3), IHEX, FNUM
      COMMON /BRZ/ NGO, NROT(48, 3, 3), NTRAN(48, 3), NBR
      COMMON /POSI/ X(3, 192), DIST(192), KOUNT
      NG = NGO
      K  = NG
      P1 = 1.0 / 3.0
      P2 = 2.0 / 3.0
      DO I = 1, NG
        DO J = 1, 3
          S = FLOAT(NTRAN(I, J)) / 24.0
          X(J, I) = NROT(I, J, 1) * POS(1) + NROT(I, J, 2) * POS(2)
     1            + NROT(I, J, 3) * POS(3) + S
        END DO
      END DO
      IF (NBR .EQ. 1) THEN
        GO TO 20
      ELSE IF (NBR .EQ. 3) THEN
        GO TO 10
      ELSE IF (NBR .EQ. 5) THEN
        DO I = 1, NG
          K = NG + I
          DO J = 1, 3
            X(J, K) = X(J, I) + 0.5
          END DO
        END DO
        NG = K
        GO TO 20
      ELSE IF (NBR .EQ. 6) THEN
        DO I = 1, NG
          K       = NG + I
          X(1, K) = X(1, I) + P2
          X(2, K) = X(2, I) + P1
          X(3, K) = X(3, I) + P1
        END DO
        K1 = NG + NG
        DO I = 1, NG
          K       = K1 + I
          X(1, K) = X(1, I) + P1
          X(2, K) = X(2, I) + P2
          X(3, K) = X(3, I) + P2
        END DO
        NG = K
        GO TO 20
      ELSE IF (NBR .EQ. 2 .OR. NBR .EQ. 4) THEN
        DO I = 1, NG
          K       = NG + I
          X(1, K) = X(1, I)
          X(2, K) = X(2, I) + 0.5
          X(3, K) = X(3, I) + 0.5
        END DO
        NG = K
        IF (nbr .NE. 4) GO TO 20
      END IF
   10 DO I = 1, NG
        K       = NG + I
        X(1, K) = X(1, I) + 0.5
        X(2, K) = X(2, I) + 0.5
        X(3, K) = X(3, I)
      END DO
      NG = K
c Put positions between 0 and 1:
   20 DO J = 1, NG
        DO I = 1, 3
          EPS  = - 0.000001
          EPS1 = 1.0 + EPS
   30     IF (X(I, J) .LT. EPS) THEN
            X(I, J) = X(I, J) + 1.0
            GO TO 30
          END IF
   40     IF (X(I, J) .GE. EPS1) THEN
            X(I, J) = X(I, J) - 1.0
            GO TO 40
          END IF
        END DO
      END DO
c Get out doubles
      EPS = 0.0001
      NG1 = NG - 1
      DO I = 1, NG1
        XX = X(1, I)
        IF (XX .LE. 1.0) THEN
          YY = X(2, I)
          ZZ = X(3, I)
          I1 = I + 1
          DO J = I1, NG
            IF (X(1, J) .LE. 1.0) THEN
              D1 = ABS(X(1, J) - XX)
              D2 = ABS(X(2, J) - YY)
              D3 = ABS(X(3, J) - ZZ)
              IF (D1 .LT. EPS .AND. D2 .LT. EPS .AND. D3 .LT. EPS)
     1           X(1, J) = 10.0
            END IF
          END DO
        END IF
      END DO
      KOUNT = 0
      DO I = 1, NG
        IF (X(1, I) .LE. 1.0) THEN
          KOUNT = KOUNT + 1
          SUM   = 0.0
          DO J = 1, 3
            SUM = SUM + X(J, I)**2
          END DO
          DIST(KOUNT) = SQRT(SUM)
          DO J = 1, 3
            X(J, KOUNT) = X(J, I)
          END DO
        END IF
      END DO
      RETURN
      END SUBROUTINE PLA322
      SUBROUTINE PLA323 (NN, IOR, NATOM, SUM, FINXYZ, MUL, LET, LU)
      PARAMETER (NUMAT=150,NTOT=1000,NELTS=16)
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      COMMON /ORGIN/ NOR, ORGADD(3, 8), NTEXT, ICOORD
      COMMON /POL/ NPOL, XPOL(3, NTOT), XP(3, NTOT), ORGA(3), SMIN,
     1 KKORD(NUMAT), NAT(NTOT)
      COMMON /RES/ ATOM1, ATOM2, FOCCU, INTXT, CODE, ELT
      DIMENSION FINXYZ(3, NUMAT), MUL(NUMAT), LET(NUMAT)
      CHARACTER SPGP(230)*10, PSYM(47)*14, FORMS(15)*16, LATICE(6)*1,
     1 HBR(7)*1, XELN(105)*2, KOORD(12)*8, CHORI(9)*3, STAA(107)*11,
     2 STBB(39)*15, STCSH(17)*14, STTEXT(21)*17
      CHARACTER ATOM1(NUMAT)*2, ATOM2(NUMAT)*4, FOCCU(NUMAT)*5,
     1 INTXT*40, CODE(2)*1, ELT(NELTS)*2
      IF (NTEXT .GT. 0) THEN
        CALL PLA262 (0)
        CALL PLA262 (3)
        IF (NN .EQ. 1) THEN
          WRITE (LU, 99999, IOSTAT = IOST)
     1      STTEXT(NTEXT), (ORGADD(J, IOR), J = 1, 3)
        ELSE IF (NN .EQ. 2) THEN
          WRITE (LU, 99999, IOSTAT = IOST) STTEXT(NTEXT), ORGA
        END IF
      END IF
      CALL PLA262 (3)
      WRITE (LU, 99998, IOSTAT = IOST)
      DO I = 1, NATOM
        K = LET(I)
        CALL PLA262 (1)
        WRITE (LU, 99996, IOSTAT = IOST) ATOM1(I), ATOM2(I),
     1    (FINXYZ(J, I), J = 1, 3), FOCCU(I), MUL(I), CHAR(K + 96)
      END DO
      CALL PLA262 (2)
      WRITE (LU, 99997, IOSTAT = IOST) SUM
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('Chosen Positions for Setting ', A, /, 45('='), /,
     1 'Origin Shift (', 3f8.5, ')')
99998 FORMAT (/, 'Atom ',9X, 'x', 9X, 'y', 9X, 'z', 5X, 'Occupancy',
     1        /, 58('='))
99997 FORMAT (/, 'Standardization Parameter Gamma =', F9.4)
99996 FORMAT (A, 1X, A, 3F10.5, 5X, A, 5X, I3, '(', A, ')')
      END SUBROUTINE PLA323
      SUBROUTINE PLA324 (NIG)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM (3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      COMMON /POSI/ X(3, 192), DIST(192), KOUNT
      COMMON /SP/ NSPEC, NW, NS(26), IS(27), MULT(15), NSET(8), KSET,
     1            KM, IPOS
      CHARACTER SPGP(230)*10, PSYM(47)*14, FORMS(15)*16, LATICE(6)*1,
     1 HBR(7)*1, XELN(105)*2, KOORD(12)*8, CHORI(9)*3, STAA(107)*11,
     2 STBB(39)*15, STCSH(17)*14, STTEXT(21)*17
      DIMENSION POS(3)
      IATOM = 1
      DO NPOS = 1, KOUNT
        NP = NPOS
        DO J = 1, 3
          POS(J) = X(J, NP)
        END DO
        DO 10 I = 1, NSPEC
          K = NS(I)
          IF (K .GE. 0) THEN
            DO J = 1, 3
              IF (SPECIA(J, K) .GE. 0.0) THEN
                IF (ABS(POS(J) - SPECIA(J, K)) .GT. 0.0001) GO TO 10
              END IF
            END DO
            IF (KSET .NE. 0) THEN
              IF (IS(I) .GE. KSET) GO TO 10
            END IF
          ELSE
            IFOUND = 0
            CALL PLA325 (POS, IFOUND, K)
            IF (IFOUND .EQ. 0) GO TO 10
            IF (KSET .NE. 0) THEN
              IF (IS(I) .GE. KSET) GO TO 10
            END IF
          END IF
          KSET  = IS(I)
          IATOM = NP
          IPOS  = I
   10   CONTINUE
      END DO
      IF (KSET .EQ. 0) THEN
        KM   = MULT(NW)
        IPOS = NSPEC + 1
        IF (NIG .EQ. 0) THEN
          CALL PLA262 (1)
          WRITE (LU7, 99996, IOSTAT = IOST) KM, CHAR(96 + IPOS)
        END IF
        RETURN
      END IF
      KM = MULT(KSET)
      IF (IATOM .GT. 1) THEN
        DO J = 1, 3
          X(J, 1) = X(J, IATOM)
        END DO
      END IF
      K = NS(IPOS)
      IF (NIG .EQ. 0) THEN
        CALL PLA262 (1)
        IF (K .GT. 0) THEN
          WRITE (LU7, 99999, IOSTAT = IOST) STAA(K), KM, CHAR(96 + IPOS)
        ELSE
          K = -K
          WRITE (LU7, 99999, IOSTAT = IOST) STBB(K), KM, CHAR(96 + IPOS)
        END IF
      END IF
      II = 0
      NN = IS(IPOS)
      DO I = 1, NSPEC
        IF (NN .EQ. IS(I)) THEN
          II       = II + 1
          NSET(II) = NS(I)
        END IF
      END DO
      KSET = II
      IF (II .GT. 0) THEN
        CALL PLA262 (1 + II)
        WRITE (LU7, 99997, IOSTAT = IOST)
        DO J = 1, II
          K = NSET(J)
          IF (K .GT. 0) THEN
            WRITE (LU7, 99998, IOSTAT = IOST) STAA(K)
          ELSE
            K = - K
            WRITE (LU7, 99998, IOSTAT = IOST) STBB(K)
          END IF
        END DO
      END IF
      RETURN
99999 FORMAT ('Special Position : ', A, ' Multiplicity ', I3,
     1'  Wyckoff Letter: ', A)
99998 FORMAT (A)
99997 FORMAT ('All Possible Special Positions for this Atom :')
99996 FORMAT ('General Position ', I3, A)
      END SUBROUTINE PLA324
      SUBROUTINE PLA325 (POS, IFOUND, K)
      DIMENSION POS(3)
      DATA EPS /0.0001/, EPS1 /0.9999/, SMALL /0.0005/
      K     = - K
      IF (K .LT. 7 .OR. K .EQ. 35 .OR. K .EQ. 36) THEN
        IF (ABS(POS(1) - POS(2)) .LE. SMALL) THEN
          IF (K .EQ. 36) THEN
            IFOUND = 1
          ELSE IF (K .EQ. 35) THEN
            IF (ABS(POS(2) - POS(3)) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 1) THEN
            IF (ABS(POS(3))          .LT. SMALL) THEN
              IFOUND = 1
            ELSE IF (ABS(POS(3) - 1.0) .LT. SMALL) THEN
               IFOUND = 1
            END IF
          ELSE IF (K .EQ. 2) THEN
            IF (ABS(POS(3) - 0.5)    .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 3) THEN
            IF (ABS(POS(3) - 0.25)   .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 4) THEN
            IF (ABS(POS(3) - 0.75)   .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 5) THEN
            IF (ABS(POS(3) - 0.375)  .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 6) THEN
            IF (ABS(POS(3) - 0.625)  .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF ((K .GT. 6 .AND. K .LT. 14) .OR. K .EQ. 37) THEN
        A = 1.0 - POS(2)
        IF (A .LT. EPS) A = A + 1.0
        IF (ABS(A - POS(1)) .LE. SMALL) THEN
          IF (K .EQ. 37) THEN
            IFOUND = 1
          ELSE IF (K .EQ. 7) THEN
            IF (ABS(POS(3))          .LT. SMALL) THEN
              IFOUND = 1
            ELSE IF (ABS(POS(3) - 1.0) .LT. SMALL) THEN
              IFOUND = 1
            END IF
          ELSE IF (K .EQ. 8) THEN
            IF (ABS(POS(3) - 0.5)    .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 9) THEN
            IF (ABS(POS(3) - 0.25)   .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 10) THEN
            IF (ABS(POS(3) - 0.3333) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 11) THEN
            IF (ABS(POS(3) - 0.6667) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 12) THEN
            IF (ABS(POS(3) - 0.1667) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 13) THEN
            IF (ABS(POS(3) - 0.8333) .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF (K .GT. 23 .AND. K .LT. 27) THEN
        IF (ABS(POS(2) - POS(3)) .LE. SMALL) THEN
          IF (K .EQ. 24) THEN
            IF (ABS(POS(1))          .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 25) THEN
            IF (ABS(POS(1) - 0.5)    .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 26) THEN
            IF (ABS(POS(1) - 0.25)   .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF (K .EQ. 27 .OR. K .EQ. 28) THEN
        A = 1.0 - POS(2)
        IF (A .LT. EPS) A = A + 1.0
        IF (ABS(A - POS(3)) .LE. SMALL) THEN
          IF (K .EQ. 27) THEN
            IF (ABS(POS(1))          .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 28) THEN
            IF (ABS(POS(1) - 0.25)   .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF ((K .GT. 13 .AND. K .LT. 17) .OR. K .EQ. 38) THEN
        A = POS(1) + 0.5
        IF (A .GT. EPS1) A = A - 1.0
        IF (ABS(A - POS(2)) .LE. SMALL) THEN
          IF (K .EQ. 38) THEN
            IFOUND = 1
          ELSE IF (K .EQ. 14) THEN
            IF (ABS(POS(3) - 0.25)   .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 15) THEN
            IF (ABS(POS(3) - 0.5)    .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 16) THEN
            IF (ABS(POS(3))          .LT. SMALL) THEN
              IFOUND = 1
            ELSE IF (ABS(POS(3) - 1.0) .LT. SMALL) THEN
              IFOUND = 1
            END IF
          END IF
        END IF
      ELSE IF (K .EQ. 17) THEN
        A = 0.5 - POS(1)
        IF (A .LT. EPS) A = A + 1.0
        IF (ABS(A - POS(2)) .LT. SMALL .AND.
     1    ABS(POS(3) - 0.25) .LT.  SMALL) IFOUND = 1
      ELSE IF (K .EQ. 18 .OR. K .EQ. 19) THEN
        A = POS(1) + 0.25
        IF (A .GT. EPS1) A = A - 1.0
        IF (ABS(A - POS(2)) .LE. SMALL) THEN
          IF (K .EQ. 18) THEN
            IF (ABS(POS(3) - 0.125) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 19) THEN
            IF (ABS(POS(3) - 0.875) .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF ((K .GT. 19 .AND. K .LT. 24) .OR. K .EQ. 39) THEN
        A = POS(1) + POS(1)
        IF (A .GT. EPS1) A = A - 1.0
        IF (ABS(A - POS(2)) .LE. SMALL) THEN
          IF (K .EQ. 39) THEN
            IFOUND = 1
          ELSE IF (K .EQ. 20) THEN
            IF (ABS(POS(3))        .LT. SMALL) THEN
              IFOUND = 1
            ELSE IF (ABS(POS(3) - 1.0) .LT. SMALL) THEN
              IFOUND = 1
            END IF
          ELSE IF (K .EQ. 21) THEN
            IF (ABS(POS(3) - 0.5)  .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 22) THEN
            IF (ABS(POS(3) - 0.25) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 23) THEN
            IF (ABS(POS(3) - 0.75) .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF (K .EQ. 29 .OR. K .EQ. 30) THEN
        IF (ABS(POS(1) - 0.25) .LE. SMALL) THEN
          IF (K .EQ. 30) THEN
            A = 0.5 - POS(2)
            IF (A .LT. EPS) A = A + 1.0
            IF (ABS(A - POS(3)) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 29) THEN
            A = 0.5 + POS(2)
            IF (A .GT. EPS1) A = A - 1.0
            IF (ABS(A - POS(3)) .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF (K .EQ. 31 .OR. K .EQ. 32) THEN
        IF (ABS(POS(1) - 0.5) .LT. SMALL) THEN
          IF (K .EQ. 32) THEN
            A = 1.0 - POS(2)
            IF (A .LT. EPS) A = A + 1.0
            IF (ABS(POS(3) - A) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 31) THEN
            A = 0.5 + POS(2)
            IF (A .GT. EPS1) A = A - 1.0
            IF (ABS(POS(3) - A) .LT. SMALL) IFOUND = 1
          END IF
        END IF
      ELSE IF (K .EQ. 33 .OR. K .EQ. 34) THEN
        IF (ABS(POS(1) - 0.125) .LT. SMALL) THEN
          IF (K .EQ. 34) THEN
            A = 0.25 - POS(2)
            IF (A .LT. EPS) A = A + 1.0
            IF (ABS(POS(3) - A) .LT. SMALL) IFOUND = 1
          ELSE IF (K .EQ. 33) THEN
            A = 0.25 + POS(2)
            IF (A .GT. EPS1) A = A - 1.0
            IF (ABS(POS(3) - A) .LT. SMALL) IFOUND = 1
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE PLA325
      SUBROUTINE PLA326 (IA, NP, LU, IER)
      PARAMETER (NUMAT=150)
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM (3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /POSI/ X(3, 192), DIST(192), KOUNT
      COMMON /SP/ NSPEC, NW, NS(26), IS(27), MULT(15), NSET(8), KSET,
     1       MU, KORD
      COMMON /TRIP/ DMIN, MIN, KORDER(192), IFLAG, XMI(3, NUMAT),
     1       MUL(NUMAT), LE(NUMAT), NRSET(NUMAT), NNSET(8, NUMAT)
      COMMON /XPOLAR/ IPOLAR, KPOL(3), LOWLET
      DIMENSION MULSET(8), POS(3)
      CALL GEN097 (KORDER, 1, KOUNT, NSPEC + 1)
      KORD  = 0
      NP    = 0
      E1    = 0.0001
      E2    = 0.0001
      E3    = 0.0001
      IFLAG = 0
      MEQ   = 0
      KSET  = NRSET(IA)
      IF (KSET .GT. 0) THEN
        DO 20 I = 1, KOUNT
          DO 10 M = 1, KSET
            K = NNSET(M, IA)
            IF (K .GT. 0) THEN
              DO J = 1, 3
                IF (SPECIA(J, K) .GE. 0) THEN
                  IF (ABS(X(J, I) - SPECIA(J, K)) .GT. 0.001) GO TO 10
                END IF
              END DO
              DO J = 1, NSPEC
                IF (NS(J) .EQ. K) THEN
                  KORDER(I) = J
                  GO TO 20
                END IF
              END DO
            ELSE
              DO J = 1, 3
                POS(J) = X(J, I)
              END DO
              IFOUND = 0
              CALL PLA325 (POS, IFOUND, K)
              IF (IFOUND .EQ. 0) GO TO 10
              DO J = 1, NSPEC
                KK = - K
                IF (KK .EQ. NS(J)) THEN
                  KORDER(I) = J
                  GO TO 20
                END IF
              END DO
            END IF
            WRITE (LU, 99994, IOSTAT = IOST) (X(J, I), J = 1, 3)
            IFLAG = 1
            IER   = 1
            RETURN
   10     CONTINUE
          DIST(I) = 100.0
          CALL PLA262 (1)
          WRITE (LU, 99989, IOSTAT = IOST) I, (X(J, I), J = 1, 3)
   20   CONTINUE
      END IF
      IF (IPOLAR .EQ. 1) THEN
        KLOW = 27
        DO J = 1, KOUNT
          IF (KORDER(J) .LT. KLOW) KLOW = KORDER(J)
        END DO
        IF (KLOW .NE. LOWLET) THEN
          CALL PLA262 (1)
          WRITE (LU, 99988, IOSTAT = IOST) X(1, 1), X(2, 1), X(3, 3)
          DMIN = 100.0
          RETURN
        END IF
      END IF
      CALL PLA262 (3)
      WRITE (LU, 99998, IOSTAT = IOST)
      DO 30 I = 1, KOUNT
        IF (DIST(I) .LE. 99.0) THEN
          IF (IPOLAR .EQ. 1) THEN
            DO J = 1, 3
              K = KPOL(J)
              IF (K .NE. 0) THEN
                IF (X(K, I) .NE. 0.0) THEN
                  DIST(I) = 100.0
                  CALL PLA262 (3)
                  WRITE (LU, 99996, IOSTAT = IOST)
     1               I, (X(N, I), N = 1, 3)
                  GO TO 30
                END IF
              END IF
            END DO
          END IF
          SUM     = X(1, I)**2 + X(2, I)**2 + X(3, I)**2
          DIST(I) = SQRT(SUM)
          KK      = KORDER(I)
          K1      = IS(KK)
          CALL PLA262 (1)
          WRITE (LU, 99995, IOSTAT = IOST)
     1      I, (X(J, I), J = 1, 3), DIST(I), MULT(K1),
     1      CHAR(96 + KK)
        END IF
   30 CONTINUE
      DMIN = 100.0
      DO I = 1, KOUNT
        IF (DIST(I) .LT. DMIN) THEN
          DMIN = DIST(I)
          MIN  = I
        END IF
      END DO
      IF (DMIN .GE. 99.99) THEN
        CALL PLA262 (1)
        WRITE (LU, 99987, IOSTAT = IOST)
        IFLAG = 1
        IER   = 1
        RETURN
      END IF
      KK        = 1
      MULSET(1) = MIN
      E1        = 0.0001
      E2        = 0.0001
      E3        = 0.0001
      DO I = 1, KOUNT
        IF (I .NE. MIN) THEN
          IF (ABS(DIST(I) - DMIN) .LE. E1) THEN
            KK = KK + 1
            IF (KK .GT. 8) THEN
              CALL PLA262 (1)
              WRITE (LU, 99991, IOSTAT = IOST)
              GO TO 70
            END IF
            MULSET(KK) = I
          END IF
        END IF
      END DO
      IF (KK .EQ. 1) GO TO 80
      MX   = MULSET(1)
      XMIN = X(1, MIN)
      DO K = 2, KK
        I = MULSET(K)
        IF (ABS(X(1, I) - XMIN) .GE. E1) THEN
          IF (X(1, I) .LT. XMIN) THEN
            XMIN = X(1, I)
            MEQ  = 0
            MX   = I
            CYCLE
          ELSE IF (X(1, I) .GT. XMIN) THEN
            CYCLE
          END IF
        END IF
        MEQ = 1
        MX  = I
      END DO
      MIN = MX
      IF (MEQ .NE. 0) THEN
        YMIN = X(2, MX)
        MEQ  = 0
        MY   = MX
        DO 50 K = 1, KK
          I = MULSET(K)
          IF (I .NE. MX) THEN
            IF (ABS(X(1, I) - X(1, MX)) .LE. E1) THEN
              IF (ABS(X(2, I) - YMIN) .GE. E2) THEN
                IF (X(2, I) .LT. YMIN) THEN
                  YMIN = X(2, I)
                  MEQ  = 0
                  MY   = I
                  GO TO 50
                ELSE IF (X(2, I) .EQ. YMIN) THEN
                  GO TO 40
                ELSE
                  GO TO 50
                END IF
              END IF
   40         IF (I .NE. MY) THEN
                MEQ = 1
                MY  = I
              END IF
            END IF
          END IF
   50   CONTINUE
        MIN = MY
        IF (MEQ .NE. 0) THEN
          MEQ  = 0
          MZ   = MY
          ZMIN = X(3, MY)
          DO 60 K = 1, KK
            I = MULSET(K)
            IF (I .NE. MY) THEN
              IF (ABS(X(1, I) - X(1, MX)) .GT. E1 .OR.
     1            ABS(X(2, I) - X(2, MY)) .GT. E2) GO TO 60
              IF (ABS(X(3, I) - ZMIN) .GE. E3) THEN
                IF (X(3, I) .LT. ZMIN) THEN
                  ZMIN = X(3, I)
                  MEQ  = 0
                  MZ   = I
                  GO TO 60
                END IF
              END IF
              IF (X(3, I) .EQ. ZMIN) THEN
                IF (I .NE. MZ) THEN
                  MEQ = 1
                  MZ  = I
                END IF
              END IF
            END IF
   60     CONTINUE
          IF (MEQ .EQ. 1) THEN
            CALL PLA262 (1)
            WRITE (LU, 99992, IOSTAT = IOST)
            GO TO 80
          END IF
          MIN = MZ
        END IF
      END IF
   70 CALL PLA262 (2)
      WRITE (LU, 99990, IOSTAT = IOST) DMIN
      DO K = 1, KK
        I = MULSET(K)
        CALL PLA262 (1)
        WRITE (LU, 99993, IOSTAT = IOST) I, (X(J, I), J = 1, 3)
      END DO
   80 KORD = KORDER(MIN)
      IF (KORD .LE. NSPEC) NP = NS(KORD)
      IF (NP .LT. 0) NP = 107 - NP
      K1 = IS(KORD)
      MU = MULT(K1)
      CALL PLA262 (2)
      WRITE (LU, 99999, IOSTAT = IOST)
     1   MIN, (X(J, MIN), J = 1, 3), DMIN, MU, CHAR(96 + KORD)
      DO J = 1, 3
        XMI(J, IA) = X(J, MIN)
      END DO
      MUL(IA) = MU
      LE(IA)  = KORD
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, 'Chosen :', I3, 5X, 3F9.5, 5X,
     1        F8.4, 8X, I3, '(', A1, ')')
99998 FORMAT (/, 'Permitted Positions', 3X, 'x', 8X, 'y', 8X, 'z', 12X,
     1  'D', /, 80('='))
99996 FORMAT (/, 'We Exclude', I3, 3X, 3F9.5,
     1        ': Polar Coordinate(s) not = 0', /)
99995 FORMAT (6X, I5, 5X, 3F9.5, 5X, F8.4, 8X, I3, '(', A1, ')')
99994 FORMAT ('Trouble in Finding Special Position for ', 3F9.5)
99993 FORMAT (I3, 3F9.5)
99992 FORMAT ('SUBROUTINE PLA326: all coordinates equal: IMPOSSIBLE')
99991 FORMAT ('ERROR : more than 8 possibilities for equal "distance"',
     1 '(subroutine PLA326)')
99990 FORMAT (/, 'Several Choices give same Minimum "Distance"', F8.4)
99989 FORMAT ('Exclude: ',I2, 5X, 3F9.5)
99988 FORMAT ('Exclude Atom ', 3F8.5, ' : not Lowest Wyckoff Letter')
99987 FORMAT ('No permitted choice of coordinate triplet')
      END SUBROUTINE PLA326
      SUBROUTINE PLA345
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      IF (IPR(663) .EQ. -1) IPR(663) = -2
      IF (IPR(664) .EQ. -1) IPR(664) = -2
      IF (IPR(665) .EQ. -1) IPR(665) = -2
      IF (IPR(664) .EQ. 0)  THEN
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sx.hkl',
     1            STATUS = 'UNKNOWN')
        CALL PLA134 (LU6, LU16, LU61, IPR(384))
        CLOSE (UNIT = LU61)
        IGBL(131) = 1
        PAR(74)   = 10.0
        IPR(675)  = 1
        IPR(664)  = -3
      END IF
      IF (IPR(663) .EQ. 0)  CALL PLA280 ('CALC SHELX NOSF')
      RETURN
      END SUBROUTINE PLA345
      SUBROUTINE PLA346
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP45=2048,
     1 NP54=42)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER ICL*(NP45), DUM*80, IFL*7
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CENTRY*75
C * CREATE FCF FROM SHELXL20xy CIF
           FNLU16(KNM16-2:KNM16) = 'fcf'
      IF (IPR(663) .NE. 0 .AND. IPR(664) .NE. 0 .AND. IGBL(110) .GT. 0)
     1  THEN
        WRITE (6, 99996)
        OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'.dum',
     1    STATUS = 'UNKNOWN')
        REWIND LU24
        DO
          READ (LU24, 99999, IOSTAT = IOST) DUM
          IF (IOST .NE. 0) EXIT
          IF (DUM(1:4) .EQ. 'L.S.') THEN
            CALL GEN072 (DUM, IFL, FN, KL, KN, 0, 0, 1, 5, 80, 7, NP17)
            FN(1) = IGBL(93)
            WRITE (DUM, 99998) 'L.S.', (NINT(FN(I)), I = 1, KN)
            WRITE (LU65, 99999) DUM
            WRITE (6, 99999)
     1       'Substituted SHELXL Instruction:'//DUM(1:65)
          ELSE IF (DUM(1:4) .EQ. 'LIST') THEN
            WRITE (DUM, 99999) 'LIST 4'
            WRITE (LU65, 99999) DUM
            WRITE (6, 99999) 'Substituted SHELXL Instruction:LIST 4'
          ELSE IF (DUM(1:4) .EQ. 'WGHT') THEN
            WRITE (LU65, 99999) DUM
            WRITE (LU65, 99999) 'BLOC'
            WRITE (6, 99999) 'Inserted    SHELXL Instruction:BLOC'
            CYCLE
          ELSE IF (DUM(1:4) .EQ. 'DAMP') THEN
            WRITE (6, 99999) 'Deleted:    '//DUM(1:65)
          ELSE
            WRITE (LU65, 99999) DUM
          END IF
        END DO
        WRITE (6, 99997)
        REWIND LU24
        REWIND LU65
        DO
          READ (LU65, 99999, IOSTAT = IOST) DUM
          IF (IOST .NE. 0) EXIT
          WRITE (LU24, 99999) DUM
        END DO
        CLOSE (UNIT = LU65, STATUS = 'DELETE')
        CLOSE (UNIT = LU24)
        CLOSE (UNIT = LU25)
        IF (IPR(665) .NE. 0) CLOSE (UNIT = LU26)
        KERR = 0
        CALL SPAWN (
     1      SHLPATH(1:IGBL(110))//' '//NAMEFIL(1:KNMFIL)//
     2      '_sx', KERR)
        IGBL(9)   = 1
        IGBL(133) = 1
        OPEN (UNIT = LU61, FILE = NAMEFIL(1:KNMFIL)//'_sx.fcf',
     1    STATUS = 'UNKNOWN')
        CLOSE (UNIT = LU16, IOSTAT = IOST)
        OPEN (UNIT = LU16, FILE = NAMEFIL(1:KNMFIL)//'.fcf',
     1    STATUS = 'UNKNOWN')
        M = 0
        DO
          READ (LU16, 99999, IOSTAT = IOST) DUM
          IF (IOST .NE. 0) EXIT
          M = M + 1
        END DO
        DO
          READ (LU61, 99999, IOSTAT = IOST) DUM
          IF (IOST .NE. 0) EXIT
          M = M + 1
          IF (DUM(1:5) .EQ. 'data_') THEN
            DUM(1:) = 'data_'//CENTRY(IGBL(54))
            IENTRY(IGBL(54), 3) = 1
            IENTRY(IGBL(54), 4) = M
          END IF
          WRITE (LU16, 99999, IOSTAT = IOST) DUM
        END DO
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        REWIND LU16
        IGBL(15) = 1
        OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'_sx.cif',
     1    STATUS = 'UNKNOWN', IOSTAT = IOST)
        IF (IOST .EQ. 0) CLOSE (UNIT = LU65, STATUS = 'DELETE')
        OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'_sx.ins',
     1    STATUS = 'UNKNOWN', IOSTAT = IOST)
        IF (IOST .EQ. 0) CLOSE (UNIT = LU65, STATUS = 'DELETE')
        OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'_sx.res',
     1    STATUS = 'UNKNOWN', IOSTAT = IOST)
        IF (IOST .EQ. 0) CLOSE (UNIT = LU65, STATUS = 'DELETE')
        OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'_sx.hkl',
     1    STATUS = 'UNKNOWN', IOSTAT = IOST)
        IF (IOST .EQ. 0) CLOSE (UNIT = LU65, STATUS = 'DELETE')
        OPEN (UNIT = LU65, FILE = NAMEFIL(1:KNMFIL)//'_sx.lst',
     1    STATUS = 'UNKNOWN', IOSTAT = IOST)
        IF (IOST .EQ. 0) CLOSE (UNIT = LU65, STATUS = 'DELETE')
      END IF
      RETURN
99999 FORMAT (A)
99998 FORMAT (A, I3, 10I5)
99997 FORMAT (/)
99996 FORMAT (/, 'Create .fcf from SHELXL .ins & .hkl.', /)
      END SUBROUTINE PLA346
      SUBROUTINE PLA348
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP45=2048)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION X(12), CRD(192), ICRD(192)
      DIMENSION TM1(3,3), OSHFT(3)
      CHARACTER LINE*80, ICL*(NP45), IFL*7, IFL21*4
      WRITE (LU6, 99993)
      LINE(1:4) = 'LATT'
      ITRNS     = 0
      JARG      = IARGC()
      KL        = 1
      KN        = 0
      ISW  = 0
      ISWX = 1
      IF (JARG .EQ. 2) THEN
        CALL GETARG (1, LINE)
        CALL GETARG (2, LINE(6:80))
        JARG = -1
        KL = 2
        KN = 0
      END IF
      GO TO 20
   10 IF (JARG .GT. 1) THEN
        CALL GETARG(1, LINE(6:80))
        LINE(1:5) = 'SPGR'
        JARG      = -1
      ELSE IF (JARG .LT. 0) THEN
        LINE = 'LIST'
        JARG = 0
      ELSE
        WRITE (LU6, 99992)
        READ (LU5, 99997) LINE
      ENDIF
      ISW  = 0
      ISWX = 1
      CALL GEN020 (1, LINE, 1, 4)
      CALL GEN072 (LINE, IFL, FN, KL, KN, 0, LU6, 1, 1, 80, 7, NP17)
      IF (LINE(1:4) .EQ. 'HELP') THEN
        CALL SGSM(LINE, 5, X, LU6, 14, IERR)
        GO TO 10
      ELSE IF (LINE(1:4) .EQ. 'SYMM' .AND. KN .EQ. 12) THEN
        CALL SGSM (LINE, 0, FN, IOUR, 15, IERR)
        GOTO 10
      ELSE IF (LINE(1:4) .EQ. 'INFO') THEN
        CALL SGSM(LINE, 0, X, LU6, 18, IERR)
        WRITE(LU6, 99996) LINE, (X(I), I = 1, 12)
        GOTO 10
      ELSE IF (LINE(1:4) .EQ. 'SITE') THEN
        X(1)  = FN(1)
        X(2)  = FN(2)
        X(3)  = FN(3)
        X(10) = FN(4)
        CALL SGSM(LINE, 0, X, LU6, 19, IERR)
        WRITE(LU6, 99999) LINE(1:5), NINT(X(11)), X(10),
     1                    X(7), X(8), X(9)
      ELSE IF (LINE(1:3) .EQ. 'END') THEN
        RETURN
      ELSE IF (LINE(1:4) .EQ. 'STOP') THEN
        RETURN
      ELSE IF (LINE(1:4) .EQ. 'QUIT') THEN
        RETURN
      ELSE IF (LINE(1:4) .EQ. 'TRNS' .OR.
     1         LINE(1:4) .EQ. 'TRMX') THEN
        K = 0
        DO I = 1, 3
          OSHFT(I) = FN(I + 9)
          DO J = 1, 3
            K = K + 1
            TM1(I, J) = FN(K)
          END DO
        END DO
        ITRNS = 1
        GOTO 10
      ENDIF
      IFL21 = IFL(2)(1:4)
      IF ((IFL21 .EQ. 'PATT' .OR. IFL21 .EQ. 'LAUE').AND.
     1 KL .GT. 1) ISWX = -1
      NRSM = NINT(FN(1))
   20 CALL GEN020 (1, LINE, 1, 4)
      IF (LINE(1:4) .EQ. 'LATT' .AND. KN .EQ. 0 .AND. KL .EQ. 1) THEN
        ISW = 1
      ELSE IF (LINE(1:4) .EQ. 'LIST') THEN
        ISW = 2 * ISWX
      ELSE IF (LINE(1:4) .EQ. 'DMAT') THEN
        ISW = 6
      ELSE IF (LINE(1:4) .EQ. 'GSNR') THEN
        ISW = 7
        LINE(1:4) = 'SYMM'
        ISW = 22
        CALL SGSM (LINE, 0, X, 0, 22, IERR)
        WRITE (LU6, 99995) X(9), X(10), X(11), X(12)
        GOTO 10
      ELSE IF (LINE(1:4) .EQ. 'MULT') THEN
        ISW = 8
      ELSE IF (LINE(1:4) .EQ. 'INVT') THEN
        ISW = 9
      ELSE IF (LINE(1:4) .EQ. 'ATOM' .OR. LINE(1:3) .EQ. 'HKL') THEN
        IF (LINE(1:4) .EQ. 'ATOM') THEN
          ISW = 3 * ISWX
        ELSE
          ISW = 5 * ISWX
        END IF
        CALL SGSM(LINE, 0, X, LU6, 18, IERR)
        NSYMP = NINT(X(4))
        ICNTR = NINT(X(5))
        IBV   = NINT(X(6))
        DO I = 1, 6
          X(I) = 0
          IF (I .LE. KN) X(I) = FN(I)
        END DO
        NSYMR = NSYMP * ICNTR
        IF (IABS(ISW) .LT. 4) NSYMR = NSYMR * IBV
        IF (ICNTR .EQ. 1 .AND. ISW .LT. 0) NSYMR = NSYMR * 2
        IF (IABS(ISW) .NE. 5) THEN
          DO I = 1, NSYMR
            CRD(I)  = 0
            ICRD(I) = I
            CALL SGSM(LINE, I, X, LU6, ISW, IERR)
            DO J = 7, 9
              CRD(I) = CRD(I) + MOD(X(J) + 10.0, 1.0) * 100**(9-J)
            END DO
          END DO
          CALL GEN013 (CRD, ICRD, 1, NSYMR)
          DO K = 1, NSYMR
            I = ICRD(K)
            CALL SGSM(LINE, I, X, LU6, ISW, IERR)
            DO J = 7, 9
              X(J) = MOD(X(J) + 10.0, 1.0)
            END DO
            IF (ISW .GT. 0) THEN
              CALL SGSM(LINE, I, X, 0, 2, IERR)
            ELSE
              CALL SGSM(LINE, I, X, 0, -2, IERR)
            ENDIF
            WRITE (LU6, 99991) I, X(7), X(8), X(9), LINE(1:45)
          END DO
        ELSE
          DO I = 1, NSYMR
            CALL SGSM(LINE, I, X, LU6, ISW, IERR)
            WRITE (LU6, 99994) I, X(7), X(8), X(9), X(10)
          END DO
        ENDIF
        GO TO 10
      ELSE IF (LINE(1:4) .EQ. 'VECT') THEN
        ISW = -3
      ELSE IF (LINE(1:4) .EQ. 'RLST') THEN
        ISW = 4 * ISWX
      ELSE IF (LINE(1:4) .EQ. 'SHEL') THEN
        ISM = NINT(FN(1))
        CALL SGSM(LINE, ISM, X, LU6, 17, IERR)
        GOTO 10
      ELSE IF (LINE(1:3) .EQ. 'RTM') THEN
        ISW = 15
      END IF
      IF (ISW .GE. 7) THEN
        DO I = 1, 12
          IF (I .GT. KN) FN(I) = 0.0
          X(I) = FN(I)
        END DO
      END IF
      IF (LINE(1:4) .EQ. 'LATT' .OR. LINE(1:4) .EQ. 'SPGR'
     1   .OR. LINE(1:4) .EQ. 'SYMM' .OR. LINE(1:4) .EQ. 'HALL') THEN
        IF (ITRNS .EQ. 1) THEN
          ISW = 16
          K = 0
          DO I = 1, 3
            X(I + 9) = OSHFT(I)
            DO J = 1, 3
              K = K + 1
              X(K) = TM1(I, J)
            END DO
          END DO
        ENDIF
      ENDIF
      IF (LINE(1:4) .EQ. 'SPGR') THEN
        IF (KL .EQ. 1 .AND. KN .EQ. 0) GO TO 10
      ENDIF
      CALL SGSM(LINE, NRSM, X, LU6, ISW, IERR)
      IF (ISW .EQ. 6) WRITE (LU6, 99990)
     1 (X(J), J = 1, 3), X(10), (X(J), J = 4, 6),
     2 X(11), (X(J), J = 7, 9), X(12)
      IF (ISW .GT. 6 .AND. ISW .LT. 15)
     1  WRITE(LU6, 99998) NINT(X(9)), X(10), X(11), X(12)
      GO TO 10
      RETURN
99999 FORMAT('site: ', A, I10, ' mult ', F10.4, ' pos:', 3F8.4)
99998 FORMAT ('SYMM NR', I4, ' UNIT TRANSL.', 3F5.0)
99997 FORMAT (A)
99996 FORMAT (A, /, 12F5.0)
99995 FORMAT (4F10.2)
99994 FORMAT (I5, 6X, F10.0, 3(7X, F10.0))
99993 FORMAT (/, 20X, 36('='),
     1        /, 20X, '=== SPACE GROUP EXERCISE PROGRAM ===',
     2        /, 20X, 36('='),
     3       //, 20X, 'TYPE <HELP> FOR HELP OR INSTRUCTION', /)
99992 FORMAT (/,'>>',$)
99991 FORMAT (I4, 3(F8.4), 2X, A)
99990 FORMAT (2X, 3F10.0, F10.5)
      END SUBROUTINE PLA348
      SUBROUTINE PLA350
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NP38=150,NP39=30, NP45=2048,NVD=100000000,NP23=28000,
     2 NP52=200,NP56=30,NP57=35,MP3=1000,
     3 MP1=NVD+2*NP23-11702-87*MP3)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER ICL*(NP45), IFL*7
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // SFC(1616), F(84), PEAK(MP3, 46), ICON(MP3, 40),
     1 NCON(MP3), RCURVE(5001, 2), VOID(MP1)
      COMMON /PL350/ NTRY, NLOOP, MTRY, NSOLVED, FACTOR, RVAL0, RVMIN,
     1 NTEL, MFTRY, FOBSMIN, NSOLVMIN, NSPGR, PFLIP, UISO, VRTY, IPEN,
     2 MXSOL, MLOOP(4), IHKLMAX(3), NREF
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      LOGICAL OPEND
      IWIN = IGBL(25) * IGBL(32)
C * CHARGE FLIPPING DRIVER ROUTINE
C * DEFAULTS
      MLOOP(1) = 5000
      MLOOP(2) = 500
      MLOOP(3) = 1000
      MLOOP(4) = 2000
      FACTOR   = PAR(475)
      PFLIP    = 0.25
      UISO     = 0.02
      MXSOL    = 3
      NSOLVED  = 0
C * CLOSE CHECK.DEF (NOT NEEDED FOR CHARGE FLIPPING)
      INQUIRE (UNIT = LU12, OPENED = OPEND)
      IF (OPEND) CLOSE (UNIT = LU12)
C * CLOSE <NAME>.DEF (NOT NEEDED FOR CHARGE FLIPPING)
      INQUIRE (UNIT = LU23, OPENED = OPEND)
      IF (OPEND) CLOSE (UNIT = LU23)
C * DELETE previous _sol.res
      CALL GEN129 (LU62, NAMEFIL(1:KNMFIL)//'_sol.res')
C * DELETE previous _res.res
      CALL GEN129 (LU62, NAMEFIL(1:KNMFIL)//'_res.res')
C * DELETE previous _res.new
      CALL GEN129 (LU62, NAMEFIL(1:KNMFIL)//'_res.new')
C * OPEN FILE FOR THE COLLECTION OF RAW SOLUTIONS
      OPEN (LU60, FILE = NAMEFIL(1:KNMFIL)//'_flp.res',
     1        STATUS = 'UNKNOWN')
C * OPEN FILE FOR THE COLLECTION OF CONVERGED SOLUTIONS
      OPEN (LU63, FILE = NAMEFIL(1:KNMFIL)//'_sol.res',
     1        STATUS = 'UNKNOWN')
C * INSTRUCTIONS
      KL = IPR(220)
      DO I = 1, KL
        IF (IFL(I)(1:4) .EQ. 'FLIP') THEN
          NTRY     = 25
          IPR(640) = 0
        ELSE IF (IFL(I)(1:4) .EQ. 'STRU') THEN
          NTRY     = 1
          IPR(640) = 1
        ELSE IF (IFL(I)(1:4) .EQ. 'PATT') THEN
          NTRY     = 1
          IPR(640) = 0
        ELSE IF (IFL(I)(1:4) .EQ. 'SHOW') THEN
          IPR(614) = 1
        ELSE IF (IFL(I)(1:4) .EQ. 'MENU') THEN
          IF (IWIN .EQ. 1) IGBL(6) = 31
        END IF
      END DO
      IF (NTRY .GT. 1) MLOOP(1) = 250
      KN = IPR(221)
      IF (KN .GT. 0) THEN
        IF (FN(1) .LT. 0.0) THEN
          IPR(604) = 1
          UISO     = 0.0
          MLOOP(1) = 500
        END IF
        NTRY = MAX(1, MIN (25, NINT (ABS(FN(1)))))
        IF (KN .GT. 1) THEN
          IF (FN(2) .NE. 0.0) THEN
            MLOOP(1) = NINT (FN(2))
            MLOOP(2) = MLOOP(1)
            MLOOP(3) = MLOOP(1)
            MLOOP(4) = MLOOP(1)
          END IF
          IF (KN .GT. 2) THEN
            IF (FN(3) .GT. 0) MXSOL = NINT(FN(3))
            IF (KN .GT. 3) THEN
              FACTOR = MIN(0.05, FN(4))
              IF (KN .GT. 4) THEN
                PFLIP = MIN(0.50, FN(5) / 100.0)
                IF (KN .GT. 5) THEN
                  UISO = MIN(0.06, FN(6))
                END IF
              END IF
            END IF
          END IF
        END IF
      END IF
      IF (IGBL(6) .EQ. 31) THEN
        NTRY     = 1
        IPR(640) = 0
        DO WHILE (.TRUE.)
          VRT  = VERT - 1.5
          LINE = 'Flipper Menu - Current Settings'
          CALL GGIP (HORS, VERT, 0.0, 1)
          CALL GGIP09 (0.0, LINE, 31, 0.85, 5, 2, 1.0, VRT)
          VRT = VRT - 3.0
          WRITE (LINE,
     1      '(''NTRY   - Number of Trials           '', I10)',
     2      IOSTAT = IOST) NTRY
          CALL GGIP09 (0.0, LINE, 46, 0.5, 1, 2, 1.0, VRT)
          VRT = VRT - 1.0
          WRITE (LINE,
     1      '(''NLOOP  - Maximum Number of Flips    '', I10)',
     2      IOSTAT = IOST) MLOOP(1)
          CALL GGIP09 (0.0, LINE, 46, 0.5, 1, 2, 1.0, VRT)
          VRT = VRT - 1.0
          WRITE (LINE,
     1      '(''NSOLVE - Maximum Number of Solutions'', I10)',
     2      IOSTAT = IOST) MXSOL
          CALL GGIP09 (0.0, LINE, 46, 0.5, 1, 2, 1.0, VRT)
          VRT = VRT - 1.0
          WRITE (LINE,
     1      '(''DELTA  - Flip Factor Delta          '', F10.3)',
     2      IOSTAT = IOST) FACTOR
          CALL GGIP09 (0.0, LINE, 46, 0.5, 1, 2, 1.0, VRT)
          VRT = VRT - 1.0
          WRITE (LINE,
     1      '(''PERC   - Phase Shift Percentage     '', F10.3)',
     2      IOSTAT = IOST) PFLIP
          CALL GGIP09 (0.0, LINE, 46, 0.5, 1, 2, 1.0, VRT)
          VRT = VRT - 1.0
          WRITE (LINE,
     1      '(''UISO   - Normalizing Uiso           '', F10.3)',
     2      IOSTAT = IOST) UISO
          CALL GGIP09 (0.0, LINE, 46, 0.5, 1, 2, 1.0, VRT)
          VRT = VRT - 3
          WRITE (LINE,
     1      '(''Enter New Parameter Data Values, Continue or END'')',
     2      IOSTAT = IOST)
          CALL GGIP09 (0.0, LINE, 50, 0.5, 5, 2, 1.0, VRT)
C * CHANGE PARAMETER VALUE LOOP
          CALL PLA013 (0, 1)
          CALL GEN072 (IGGT, IFL, FN, IPR(220), IPR(221), 0, LU6,
     1               1, 1, 80, 7, NP17)
          KN = IPR(221)
          IF (IFL(1)(1:4) .EQ. 'UISO') THEN
            IF (KN .GT. 0) UISO = FN(1)
          ELSE IF (IFL(1)(1:5) .EQ. 'NLOOP') THEN
            IF (KN .GT. 0) THEN
              MLOOP(1) = NINT(FN(1))
              MLOOP(2) = MLOOP(1)
              MLOOP(3) = MLOOP(2)
              MLOOP(4) = MLOOP(3)
            END IF
          ELSE IF (IFL(1)(1:4) .EQ. 'NTRY') THEN
            IF (KN .GT. 0) NTRY = NINT(FN(1))
          ELSE IF (IFL(1)(1:6) .EQ. 'NSOLVE') THEN
            IF (KN .GT. 0) MXSOL = NINT(FN(1))
          ELSE IF (IFL(1)(1:5) .EQ. 'DELTA') THEN
            IF (KN .GT. 0) FACTOR = FN(1)
          ELSE IF (IFL(1)(1:4) .EQ. 'PERC') THEN
            IF (KN .GT. 0) PFLIP = FN(1)
          ELSE IF (IFL(1)(1:4) .EQ. 'SHOW') THEN
            IPR(614) = 1
          ELSE IF (IFL(1)(1:3) .EQ. 'END') THEN
            EXIT
          ELSE IF (IFL(1)(1:4) .EQ. 'CONT') THEN
            EXIT
          ELSE IF (IFL(1)(1:4) .EQ. 'STRU') THEN
            IPR(640) = 1
          ELSE IF (IFL(1)(1:4) .EQ. 'EXIT') THEN
            GOTO 80
          END IF
        END DO
        KN   = 0
      END IF
C * COPY (HKL OR FCF) REFLECTION FILE FOR EXOR RUN
      OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_xor.hkl',
     1      STATUS = 'UNKNOWN')
      REWIND LU16
      IF (IGBL(9) .GT. 0) THEN
        CALL PLA134 (LU6, LU16, LU61, IPR(384))
      ELSE
        DO
          READ  (LU16, 99999, IOSTAT = IOST) LINE
          IF (IOST .NE. 0) EXIT
          WRITE (LU61, 99999, IOSTAT = IOST) LINE
        END DO
      END IF
      CLOSE (UNIT = LU61)
      IGBL(16) = 0
      CALL PLA150 (-1)
      IF (IPR(604) .GT. 0 .AND. IPR(37) .GT. 0) THEN
        CALL PLA024
        CALL PLA023 (0)
      END IF
      IF (IPR(602) .GT. 0) THEN
        DO I = 1, 3
          J          = 2 * I
          IHKLMAX(I) = MAX (-IPR(265 + J), IPR(266 + J))
        END DO
        CALL GEN108 (LU19, 0)
        NREF = 0
   50   READ (LU19) F
        DO I = 1, 79, 6
          IF (NINT(F(I)) .EQ. 0) GO TO 70
          NREF        = NREF + 1
          VOID (NREF) = - F(I + 1)
        END DO
        GO TO 50
   70   CALL GEN034 (VOID, 1, NREF)
        FOBSMIN  = - VOID (NINT(PFLIP * NREF))
        IGBL(6) = 31
        WRITE (LINE, 99998, IOSTAT = IOST)
        WRITE (LU6,  99997, IOSTAT = IOST) LINE
        WRITE (LU7,  99997, IOSTAT = IOST) LINE
        IF (IWIN .EQ. 1) THEN
          CALL GGIP (HORS, VERT, 0.0, 1)
          CALL PLA110 (HORS, VERT, -1)
          BCD = 'Click on Window to STOP Loops'//CHAR(0)
          CALL GGIP (-999.0, 2.0, 33.0, 111)
          VRT = VERT - 1.1
          IF (NTRY .EQ. 1) THEN
            VRTY = 0.80 * VERT
          ELSE
            VRTY = 0.38 * VERT
          END IF
          CALL GGIP09 (0.0, LINE, 80, 0.55, 5, 2, 3.0, VRT)
          CALL GGIP (1.0,   0.0, 0.0, 3)
          CALL GGIP (HORS,  0.0, 0.0, 2)
          CALL GGIP (HORS, VRTY, 0.0, 2)
          CALL GGIP (1.0,  VRTY, 0.0, 2)
          CALL GGIP (1.0,   0.0, 0.0, 2)
          DO I = 1, 7
            VRTYI = (I - 1) * VRTY / 7.0
            CALL GGIP (1.0, VRTYI, 0.0, 3)
            CALL GGIP (1.3, VRTYI, 0.0, 2)
            WRITE (NQ1, 99995, IOSTAT = IOST) I * 10
            CALL GGIP09 (0.0, NQ1, 2, 0.15, 1, 1, 1.05, VRTYI + 0.08)
          END DO
          CALL GGIP09 (90.0, 'R-Value' , 7, 0.35, 1, 2, 1.8, 0.2)
          CALL GGIP09 (0.0,  'Log(N)-Iteration', 16, 0.35, 1, 2,
     1                 HORS -5.2, 0.1)
          CALL GGIP09 (0.0, 'Experimental !', 14, 0.6, 2, 2, 2.1, 1.2)
          WRITE (LINE, 99996, IOSTAT = IOST)
     1      FACTOR, PFLIP * 100.0, UISO, PAR(466), PAR(467)
          CALL GGIP09 (0.0, LINE, 80, 0.25, 5, 1, 3.0, VRTY - 0.3)
          CALL GGIP09 (0.0, 'Spgr    Rexor Frq Nsl Try', 25, 0.25,
     1                 5, 1, HORS - 5.5, VRTY - 0.35)
          CALL GGIP (0.0, 0.0, 0.0, 6)
        END IF
        WRITE (LU6, 99994, IOSTAT = IOST)
     1    NTRY, (MLOOP(I), I = 1, 4), MXSOL, FACTOR, PFLIP * 100.0, UISO
        WRITE (LU7, 99994, IOSTAT = IOST)
     1    NTRY, (MLOOP(I), I = 1, 4), MXSOL, FACTOR, PFLIP * 100.0, UISO
C * FLIP
        CALL PLA351
        IF (NSOLVED .GT. 0) THEN
C * FLIPPER MODE
          IF (IPR(640) .EQ. 0) THEN
            CALL GEN129 (LU23, 'satom.def')
            KERR = 0
            CALL SPAWN (PLAPATH(1:IGBL(80))//' -r +0pluton.log '//
     1                  NAMEFIL(1:KNMFIL)//'_res.res', KERR)
C * STRUCTURE? MODE
          ELSE IF (IPR(640) .EQ. 1) THEN
            IF (IGBL(110) .GT. 0) CALL PLA353
          END IF
        END IF
        IF (IGBL(16) .EQ. 1) THEN
          CLOSE (UNIT = LU19, STATUS = 'DELETE')
          IGBL(16) = 0
        END IF
        CALL GEN129 (LU64, 'NEXT')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'_res.pjn')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'_xor.ins')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'_xor.hkl')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'_xor.bin')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'.def')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'_ads.eld')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'_ads.ins')
        CALL GEN129 (LU64, NAMEFIL(1:KNMFIL)//'_ads.lis')
        CALL GEN129 (LU64, 'satom.spf')
      END IF
   80 IGBL(6) = 10
      RETURN
99999 FORMAT (A)
99998 FORMAT ('Charge Flipping Ab Initio Structure Solution')
99997 FORMAT (/, A, /)
99996 FORMAT ('Delta =', F7.3, ', Perc =', F5.1, ', UISO =',
     1         F6.3, ', RFLMX =', F5.2, ', REXMX =', F5.2)
99995 FORMAT (I2)
99994 FORMAT ('Number of Trials ....... =', I6, /,
     1        'Max Number of Flips .... =', 4I6, /,
     2        'Max Mumber of Solutions  =', I6, /,
     3        'Flip Factor Delta ...... =', F6.3, /,
     4        'Phase Shift Percentage . =', F6.1, /,
     5        'Normalizing U .......... =', F6.2, /)
      END SUBROUTINE PLA350
      SUBROUTINE PLA351
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP22=287,NVD=100000000,NP23=28000,NP38=150,NP39=30,NP52=200,
     2 NP56=30,NP57=35,MP3=1000,MP1=NVD+2*NP23-11702-87*MP3)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /COM3/ NGRID, STHM, ITOP
      COMMON // SFC(1616), F(84), PEAK(MP3, 46), ICON(MP3, 40),
     1 NCON(MP3), RCURVE(5001, 2), VOID(MP1)
      COMMON /PL350/ NTRY, NLOOP, MTRY, NSOLVED, FACTOR, RVAL0, RVMIN,
     1 NTEL, MFTRY, FOBSMIN, NSOLVMIN, NSPGR, PFLIP, UISO, VRTY, IPEN,
     2 MXSOL, MLOOP(4), IHKLMAX(3), NREF
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      DIMENSION XJX(12)
      CHARACTER SPGRSAV*7
      COMMON /CTRLC/ CC
      LOGICAL CC
C * THIS ROUTINE IMPLEMENTS THE CHARGE FLIPPING CONCEPT - Oszlanyi et al.
      RVMIN    = 1.0
      NSOLVMIN = 0
      IPEN     = 4
      NSPGR    = 0
      MFTRY    = 0
      IDUM     = -1
      PHI      = GEN036 (IDUM)
      CALL SGSM (IDM, 0, XJX, LU6, 18, IER)
      SPGRSAV = IDM(1:7)
      CALL GEN038 (PRBUF, 1, 132)
      IPR(409) = 1
      DO 10 I = 1, 3
        DO J = 4, 8
          IPR(I + 394) = 2**J
          IF (PAR(I + 100) * 3.0 .LT. IPR(I + 394)) GO TO 10
        END DO
   10 CONTINUE
      DO I = 1, 3
        J = IPR(394 + I)
        IF (2 * IHKLMAX(I) .GE. IPR(J)) IPR(J) = IPR(J) * 2
      END DO
      M1    = IPR(395)
      M2    = IPR(396)
      M3    = IPR(397)
      NGRID = M1 * M2 * M3
      WRITE (LU6, 99999, IOSTAT = IOST) M1, M2, M3
      WRITE (LU7, 99999, IOSTAT = IOST) M1, M2, M3
      ITOP  = NGRID * 2
      ITOP1 = 2 * ITOP
      ITOP2 = ITOP1 + 3 * (M1 + 2) * (M2 + 2)
      IF (ITOP2 .GT. MP1) THEN
        IPR(2) = 49
      ELSE
        WRITE (LINE, 99997, IOSTAT = IOST)
        WRITE (LU6,  99998, IOSTAT = IOST) LINE
        WRITE (LU7,  99998, IOSTAT = IOST) LINE
        IF (IWIN .EQ. 1) THEN
          VRT = VRT - 0.7
          CALL GGIP09 (0.0, LINE, 80, 0.32, 5, 2, 1.0, VRT)
          VRT = VRT - 0.2
        END IF
        CALL GGIP (0.0, 0.0, 0.0, 6)
        NSYMH   = IPR(255)
        NSOLVED = 0
        NLOOP   = MLOOP(1)
        NTEL    = 0
        DO M = 1, NTRY
          IF (CC) GO TO 40
          IDM = 'SPGR '//SPGRSAV
          CALL SGSM (IDM, 0, XJX, LU6,  0, IER)
          IPEN = MOD (IPEN + 1, 5) + 1
          MTRY = M
          IF (NSOLVED .EQ. 0) THEN
            IF (M .GT. 3) THEN
              NLOOP = MLOOP(2)
              IF (M .GT. 6) THEN
                NLOOP = MLOOP(3)
                IF (M .GT. 10) THEN
                  NLOOP = MLOOP(4)
                END IF
              END IF
            END IF
          ELSE IF (NSOLVED .EQ. 1) THEN
            IF (M .GT. 5) THEN
              NLOOP = MLOOP(2)
              IF (M .GT. 10) THEN
                NLOOP = MLOOP (3)
                IF (M .GT. 15) THEN
                  NLOOP = MLOOP(4)
                END IF
              END IF
            END IF
          END IF
          VRT = VRT - 0.4
          CALL GEN074 (VOID, 1, ITOP1, 0.0)
          RVAL0   = 1.0
          FS000   = 0.0
          VOID(1) = FS000
          CALL GEN108 (LU19, 0)
   20     READ (LU19) F
          DO I = 1, 79, 6
            IF (NINT(F(I)) .EQ. 0) GO TO 30
            CALL GEN046 (F(I), XJX(1), XJX(2), XJX(3))
            FOBS = F(I + 1) * EXP (UISO * F(I + 3))
            PHI  = 0.0
            IF (IPR(604) .NE. 0) THEN
              ACAL = 0.0
              BCAL = 0.0
              CALL PLA135 (NINT(XJX(1)), NINT(XJX(2)), NINT(XJX(3)),
     1          ACAL, BCAL, ACALA, BCALA, ACALAF, BCALAF, YUNK)
              ACAL = ACAL + ACALA
              BCAL = BCAL + BCALA
              PHI  = ATAN2 (BCAL, ACAL) * RGBL(6)
            END IF
            DO N = 1, NSYMH
              XJX(4) = PHI
              CALL SGSM (LINE, N, XJX, LU6, 5, IERR)
              IHT = NINT(XJX(7))
              IKT = NINT(XJX(8))
              ILT = NINT(XJX(9))
              IF (MTRY .GT. 1 .OR. NTRY .GT. 1) THEN
                PHI  = GEN036(IDUM) * RGBL(5)
                AOBS = FOBS * COS (PHI)
                BOBS = FOBS * SIN (PHI)
              ELSE
                IF (IPR(604) .EQ. 0) THEN
                  AOBS = FOBS
                  BOBS = 0.0
                ELSE
                  PHIA = XJX(10) / RGBL(6)
                  AOBS = FOBS * COS (PHIA)
                  BOBS = FOBS * SIN (PHIA)
                END IF
              END IF
              ISN  = -1
              DO J = 1, 2
                ISN = - ISN
                IH = ISN * IHT
                IK = ISN * IKT
                IL = ISN * ILT
                IF (IH .LT. 0) IH = IH + M1
                IF (IK .LT. 0) IK = IK + M2
                IF (IL .LT. 0) IL = IL + M3
                LOC = 2 * ((IL * M2 + IK) * M1 + IH + 1)
                VOID(LOC - 1)        = ISN * ABS(FOBS)
                VOID(LOC)            = 4 * SQRT(F(I + 2))
                VOID(ITOP + LOC - 1) = AOBS
                VOID(ITOP + LOC)     = ISN * BOBS
              END DO
            END DO
          END DO
          GO TO 20
   30     IDM = 'SPGR '//SPGRSAV(1:1)//'1'
          CALL SGSM (IDM, 0, XJX, 0, 0, IERR)
          CALL SGSM (IDM, 0, XJX, 0, 18, IERR)
          IPR(48) = NINT (XJX(9))
          CALL PLA352 (VOID(1), VOID(ITOP + 1), VOID(ITOP1 + 1))
        END DO
   40   CLOSE (UNIT = LU60)
        CLOSE (UNIT = LU63)
        IF (NSOLVED .GT. 0) THEN
          OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_sol.res',
     1          STATUS = 'UNKNOWN')
          OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_res.res',
     1          STATUS = 'UNKNOWN')
          NTITLE = 0
   50     READ (LU61, 99998, END = 70) LINE
          IF (LINE(1:4) .EQ. 'TITL') THEN
            NTITLE = NTITLE + 1
            IF (NTITLE .NE. NSOLVMIN) GO TO 50
            WRITE (LU62, 99998, IOSTAT = IOST) LINE
   60       READ (LU61, 99998, END = 70) LINE
            IF (LINE(1:4) .EQ. 'SFAC') THEN
              WRITE (LU62, 99998, IOSTAT = IOST) LINE
            ELSE IF (LINE(1:4) .EQ. 'UNIT') THEN
              WRITE (LU62, 99998, IOSTAT = IOST) LINE
            ELSE IF (LINE(1:4) .EQ. '    ') THEN
            ELSE IF (LINE(1:4) .EQ. 'TITL') THEN
              GO TO 70
            ELSE
              WRITE (LU62, 99998, IOSTAT = IOST) LINE
            END IF
            GO TO 60
          ELSE
            GO TO 50
          END IF
   70     CLOSE (UNIT = LU61)
          CLOSE (UNIT = LU62)
        END IF
      END IF
      RETURN
99999 FORMAT ('FFT grid =', 3I5, /)
99998 FORMAT (A)
99997 FORMAT ('try Loop(  max) Delta Phi Rho(min) Rho(max) F000 ',
     1        ' R(F) DeltaR Npk Rexor Nat Spgr')
      END SUBROUTINE PLA351
      SUBROUTINE PLA352 (FFT1, FFT2, R3D)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50, NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP23=28000,NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP45=2048,
     3 NP47=9,NP52=200,NP56=30,NP57=35,MP3=1000,NVD=100000000,
     4 MP1=NVD+2*NP23-11702-87*MP3)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON // SFC(1616), F(84), PEAK(MP3, 46), ICON(MP3, 40),
     1 NCON(MP3), RCURVE(5001, 2), VOID(MP1)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /COM3/ NGRID, STHM, ITOP
      COMMON /PL350/ NTRY, NLOOP, MTRY, NSOLVED, FACTOR, RVAL0, RVMIN,
     1 NTEL, MFTRY, FOBSMIN, NSOLVMIN, NSPGR, PFLIP, UISO, VRTY, IPEN,
     2 MXSOL, MLLOP(4), IHKLMAX(3), NREF
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      DIMENSION FFT1(*), FFT2(*), R3D(*)
      COMMON /CTRLC/ CC
      CHARACTER SPGR*7, SFT*4
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      LOGICAL CC
      CHARACTER SLINE*80
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      IF (ABS(IGBL(8)) .EQ. 3) THEN
        M = 2
      ELSE
        M = 3
      END IF
      RHOMIN = 2.0 * PAR(98)
      RVAL   = 1.0
      DELR   = 1.0
      REXOR  = 0.0
      TERM   = 1.0
      ITEL   = 0
      MTEL   = 0
      NCURVE = 0
      NCURC  = 0
      DO N = 1, NLOOP
        XG = 0.0
        YG = 0.0
        ZG = 0.0
        IG = 9
        CALL GGIP (XG, YG, ZG, IG)
        IF (IG .EQ. 1) THEN
          CALL PLA013 (0, 1)
          CALL GEN072 (IGGT, IFL, FN, IPR(220), IPR(221), 0, LU6,
     1                   1, 1, 80, 7, NP17)
          IF (IGGT(1:1) .EQ. 'N' .OR. IGGT(1:3) .EQ. 'END' .OR.
     1        IGGT(1:4) .EQ. 'EXIT') THEN
            CC   = .TRUE.
            GO TO 20
          ELSE IF (IGGT(1:4) .EQ. 'CONV') THEN
            CC   = .TRUE.
            TERM = 0.0
          ELSE IF (IGGT(1:4) .EQ. 'CONT') THEN
            CC   = .FALSE.
          ELSE IF (IFL(1)(1:4) .EQ. 'FACT') THEN
            FACTOR = FN(1)
            CC   = .FALSE.
          END IF
          IF (IWIN .EQ. 1) THEN
            CALL GGIP09 (0.0, SLINE, 80, 0.32, 1, 2, 1.0, VRT)
            CALL GGIP (0.0, 0.0, 0.0, 6)
          END IF
        END IF
        CALL GEN028 (FFT2, IPR(395), 3, -1)
        RMIN = 0.0
        RMAX = 0.0
        F000 = 0.0
        SXSQ = 0.0
        SUMX = 0.0
        DO I = 1, ITOP - 1, 2
          FFTX = FFT2(I)
          SXSQ = SXSQ + FFTX ** 2
          SUMX = SUMX + FFTX
          RMIN = MIN (RMIN, FFTX)
          RMAX = MAX (RMAX, FFTX)
        END DO
        DENS = TERM * FACTOR * RMAX
        DO I = 1, ITOP -1, 2
          IF (TERM .GT. 0) THEN
            IF (FFT2(I) .LT. DENS) FFT2(I) = - FFT2(I)
          ELSE
            IF (FFT2(I) .LT. FACTOR * RMAX) FFT2(I) = 0.0
          END IF
          FFT2(I + 1) = 0.0
        END DO
        IF (IPR(614) .GT. 0) THEN
            CALL PLA140 (FFT2, R3D, 0, RHOMIN, 1, NPK0, 1, 1)
            NPK = MIN(999, MIN (NPK0, NINT(PAR(98) / 14.0)))
            CALL PLA355 (0, LU60, NPK, M, N, RVAL)
          CALL PLA355 (1, LU61, NPK, M, N, RVAL)
        END IF
        IF (RVAL .GT. PAR(468)) THEN
          DO I = 1, ITOP -1, 2
            IF (FFT2(I) .GT. RMAX + 0.25 * RMIN) THEN
              FFT2(I) = 0.5 * FFT2(I)
            END IF
          END DO
        END IF
        CALL GEN028 (FFT2, IPR(395), 3, 1)
        SUMFO = 0.0
        SUMFC = 0.0
        DO I = 3, ITOP, 2
          FOBS = ABS(FFT1(I))
          IF (FOBS .GT. 0.0) THEN
            FCAL  = SQRT (FFT2(I) ** 2 + FFT2(I + 1) ** 2) / NGRID
            SUMFO = SUMFO + FOBS
            SUMFC = SUMFC + FCAL
          END IF
        END DO
        SCALE = SUMFC / SUMFO
        SUMDL = 0.0
        F000  = FFT2(1) / (SCALE * NGRID)
        FFT2(1) = 0.0
        FFT2(2) = 0.0
        DO 10 I = 3, ITOP, 2
          ISN = 1
          FOBS = FFT1(I)
          IF (FOBS .NE. 0.0) THEN
            IF (FOBS .LT. 0.0) THEN
              FOBS = - FOBS
              ISN  = -1
            END IF
            ACAL = FFT2(I)     / (SCALE * NGRID)
            BCAL = FFT2(I + 1) / (SCALE * NGRID)
            FCAL = SQRT (ACAL ** 2 + BCAL ** 2)
            SUMDL = SUMDL + ABS (FOBS - FCAL)
            SFT = ' '
            IF (PFLIP .GT. 0.0) THEN
              IF (RVAL .GT. 0.40 .AND. N .GT. 100) THEN
                SFT = '  90'
                IF (FOBS .LT. FOBSMIN) THEN
                  FFT2(I)     = - BCAL
                  FFT2(I + 1) =   ACAL * ISN
                  GO TO 10
                END IF
              END IF
            END IF
            FFT2(I)     = FOBS * ACAL / FCAL
            FFT2(I + 1) = FOBS * BCAL / FCAL
          ELSE
            FFT2(I)     = 0.0
            FFT2(I + 1) = 0.0
          END IF
   10   CONTINUE
        RVAL  = SUMDL / SUMFO
        RMIN  = RMIN  / (2.0 * PAR(98))
        RMAX  = RMAX  / (2.0 * PAR(98))
        DELT  = DENS  / (2.0 * PAR(98))
        DELR  = RVAL0 - RVAL
        RVAL0 = RVAL
        IF (IWIN .EQ. 1) THEN
          IF (IPR(614) .EQ. 1) THEN
            VRT20 = 0.2
          ELSE
            VRT20 = VRT
            CALL GGIP09 (0.0, SLINE, 80, 0.32, 0, 2, 1.0, VRT20)
          END IF
          WRITE (SLINE, 99991, IOSTAT = IOST)
     1      MTRY, N, NLOOP, DELT, SFT, RMIN, RMAX, NINT(F000), RVAL,
     2      DELR
          CALL GGIP09 (0.0, SLINE, 80, 0.32, IPEN, 2, 1.0, VRT20)
          CALL GGIP (0.0, FLOAT(IPEN), 0.0, 0)
          XP = 1.0 + (HORS - 1.0) * LOG(FLOAT(N)) / LOG(FLOAT(NLOOP))
          YP = VRTY * (MIN (0.8, RVAL) - 0.1) / 0.7
          IF (IPR(614) .EQ. 0) THEN
            IF (N .GT. 1) THEN
              CALL GGIP (XPOLD,    YPOLD   , 0.0, 3)
              CALL GGIP (XP,       YP      , 0.0, 2)
            END IF
            XPOLD             = XP
            YPOLD             = YP
          ELSE
            IF (NCURVE .LT. 5001) THEN
              NCURVE            = NCURVE + 1
              RCURVE(NCURVE, 1) = XP
              RCURVE(NCURVE, 2) = YP
              IF (RVAL .LT. PAR(467) .AND. NCURC .EQ. 0) NCURC = NCURVE
            END IF
            CALL GGIP (0.0, 2.0, 0.0, 0)
            IF (NCURVE .GT. 1) THEN
              CALL GGIP (RCURVE(1, 1), RCURVE(1, 2), 0.0, 3)
              DO I = 2, NCURVE
                IF (I .EQ. NCURC) CALL GGIP (0.0, 3.0, 0.0, 0)
                CALL GGIP (RCURVE(I, 1), RCURVE(I, 2), 0.0, 2)
              END DO
            END IF
          END IF
          CALL GGIP (0.0, 0.0, 0.0, 6)
        END IF
        WRITE (LU7, 99996, IOSTAT = IOST) LINE
        IF (N .LT. NLOOP - 10) THEN
          IF (RVAL .LT. 0.35) THEN
            IF (RVAL .LT. PAR(467)) THEN
              IF (ABS(DELR) .LT. 0.005) THEN
                ITEL = ITEL + 1
                IF (ITEL .GT. 5) TERM = 0.0
                IF (ITEL .GT. 20) GO TO 20
              ELSE
                ITEL = 0
              END IF
            ELSE
              IF (ABS(DELR) .LT. 0.005) THEN
                MTEL = MTEL + 1
                IF (MTEL .GT. 25) THEN
                  TERM = TERM * 0.5
                  MTEL = 0
                  ITEL = 0
                END IF
                IF (TERM .LT. 0.01) TERM = 0.0
              ELSE
                MTEL = 0
                ITEL = 0
              END IF
            END IF
          END IF
        ELSE
          TERM = 0.0
        END IF
      END DO
   20 WRITE (LU6, 99996, IOSTAT = IOST) LINE
      IF (RVAL .LT. PAR(466)) THEN
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_ads.ins',
     1        STATUS = 'UNKNOWN')
        CALL GEN028 (FFT2, IPR(395), 3, -1)
        CALL PLA140 (FFT2, R3D, 0, RHOMIN, 1, NPK0, 1, 1)
        NPK = MIN(999, MIN (NPK0, NINT(PAR(98) / 14.0)))
        CALL PLA355 (0, LU60, NPK, M, N, RVAL)
        CALL PLA355 (0, LU61, NPK, M, N, RVAL)
        CLOSE (UNIT = LU61)
        CALL GEN129 (LU61, NAMEFIL(1:KNMFIL)//'_xor.bin')
        SPGR   = ' '
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -N +0addsym.log '//
     1              NAMEFIL(1:KNMFIL)//'_ads.ins', KERR)
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_ads.res',
     1      STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_xor.ins',
     1      STATUS = 'UNKNOWN')
        ISKIP = 0
   30   READ (LU61, 99996, END = 40) LINE
        IF (LINE(1:4) .EQ. 'TITL') THEN
          SPGR = LINE(39:45)
        ELSE IF (LINE(1:4) .EQ. 'UNIT') THEN
          ISKIP = 0
          WRITE (LU62, 99983, IOSTAT = IOST)
     1      (LMT(IENS(K), 1), K = 1, IAN)
          WRITE (LU62, 99982, IOSTAT = IOST)
     1      (NINT(CONT(IENS(L), M)), L = 1, IAN)
          GO TO 30
        ELSE IF (LINE(1:4) .EQ. 'SFAC') THEN
          ISKIP = 1
        END IF
        IF (ISKIP .EQ. 0) WRITE (LU62, 99996, IOSTAT = IOST) LINE
        GO TO 30
   40   CLOSE (UNIT = LU61, STATUS = 'DELETE')
        CLOSE (UNIT = LU62)
        REXOR = 0.0
        KERR  = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -E +0exor.log '//
     1    NAMEFIL(1:KNMFIL)//'_xor.ins', KERR)
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_xor_log',
     1        STATUS = 'UNKNOWN')
        DO
          READ (LU61, 99996, IOSTAT = IOST) LINE
          IF (IOST .NE. 0) EXIT
          N = INDEX (LINE, 'RVAL=')
          IF (N .NE. 0) READ (LINE(13:18), 99998) REXOR
        END DO
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_xor.res',
     1        STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = NAMEFIL(1:KNMFIL)//'_ads.ins',
     1      STATUS = 'UNKNOWN')
        DO
          READ (LU61, 99996, IOSTAT = IOST) LINE
          IF (IOST .NE. 0) EXIT
          WRITE (LU62, 99996, IOSTAT = IOST) LINE
        END DO
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -N +0addsym.log '//
     1              NAMEFIL(1:KNMFIL)//'_ads.ins', KERR)
        OPEN (LU61, FILE = NAMEFIL(1:KNMFIL)//'_ads.res')
        NAT    = 0
        NCOUNT = 0
        DO
          READ  (LU61, 99996, IOSTAT = IOST) LINE
          IF (IOST .NE. 0) EXIT
          IF (LINE(1:4) .EQ. 'TITL') THEN
            SPGR = LINE(39:45)
          ELSE IF (LINE(1:4) .EQ. 'FVAR') THEN
            NCOUNT = 1
          ELSE IF (LINE(1:4) .EQ. 'HKLF') THEN
            NCOUNT = 0
          ELSE
            NAT = NAT + NCOUNT
          END IF
          WRITE (LU63, 99996, IOSTAT = IOST) LINE
        END DO
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        IF (IWIN .EQ. 1) CALL GGIP09 (0.0, PRBUF, 25, 0.25, 0, 1,
     1    HORS - 5.5, VRTY - 0.7)
        CALL GGIP (0.0, 0.0, 0.0, 6)
        NSOLVED = NSOLVED + 1
          IDM     = 'SPGR '//SPGR
          CALL SGSM (IDM, 0, XJX, LU6,  0, IER)
          CALL SGSM (IDM, 0, XJX, LU6, 18, IER)
          NSP = NINT(XJX(1))
          IF (REXOR .LT. RVMIN) THEN
            IF (NSP .GT. NSPGR) THEN
              PRBUF(1:7) = SPGR
              NSPGR      = NSP
              NTEL       = 0
            END IF
          END IF
          IF (NSP .GT. NSPGR) THEN
            IF (REXOR .LT. RVMIN) THEN
              PRBUF(1:7) = SPGR
              NSPGR      = NSP
              RVMIN      = REXOR
              NSOLVMIN   = NSOLVED
              MFTRY      = MTRY
              NTEL       = 1
            END IF
          ELSE IF (NSP .EQ. NSPGR) THEN
            NTEL = NTEL + 1
            IF (REXOR .LT. RVMIN) THEN
              RVMIN    = REXOR
              NSOLVMIN = NSOLVED
              MFTRY    = MTRY
            END IF
          END IF
        WRITE (PRBUF(8:49), 99980, IOSTAT = IOST)
     1     RVMIN, NTEL, NSOLVMIN, MFTRY
        IF (IWIN .EQ. 1 .AND. RVMIN .LT. 1.0) THEN
          CALL GGIP09 (0.0, PRBUF, 25, 0.25, 1, 1, HORS - 5.5,
     1                 VRTY - 0.7)
          CALL GGIP (0.0, 0.0, 0.0, 6)
        END IF
        IF (IWIN .EQ. 1) THEN
          WRITE (LINE, 99981, IOSTAT = IOST) NPK
          IF (REXOR .GT. 0.0) THEN
            WRITE (LINE(5:10), 99998, IOSTAT = IOST) REXOR
              WRITE (LINE(11:), 99997, IOSTAT = IOST) NAT, SPGR
          END IF
          CALL GGIP09 (0.0, LINE(1:23), 23, 0.32, IPEN, 2, 17.8, VRT)
          CALL GGIP (0.0, FLOAT(IPEN), 0.0, 0)
          CALL GGIP (0.0, 0.0, 0.0, 6)
        END IF
      END IF
      RETURN
99998 FORMAT (F6.3)
99997 FORMAT (I4, 1X, A)
99996 FORMAT (A)
99991 FORMAT (I3, I5, '(', I5, ')', F6.3, A, 2F9.3, I5, F6.3, F7.3)
99983 FORMAT ('SFAC', 16(1X, A))
99982 FORMAT ('UNIT ', 2I5, 14I4)
99981 FORMAT (I4)
99980 FORMAT (F6.3, 3I4)
      END SUBROUTINE PLA352
      SUBROUTINE PLA353
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IF (IWIN .EQ. 1) THEN
        CALL GGIP09 (0.0, 'RefinemenT', 10, 2.5, 2, 10, 3.0, 12.0)
        CALL GGIP (0.0, 0.0, 0.0, 6)
      END IF
C * SHELXL ISO
      CALL PLA354 (0, LU61, LU62, '_res.res', '_shx.ins')
      CALL PLA354 (0, LU61, LU62, '_xor.hkl', '_shx.hkl')
      KERR = 0
      CALL SPAWN (SHLPATH(1:IGBL(110))//' '//
     1            NAMEFIL(1:KNMFIL)//'_shx', KERR)
C * SHELXL ANISO
      CALL PLA354 (1, LU61, LU62, '_shx.res', '_shx.ins')
      KERR = 0
      CALL SPAWN (SHLPATH(1:IGBL(110))//' '//
     1            NAMEFIL(1:KNMFIL)//'_shx', KERR)
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -D '//
     1            NAMEFIL(1:KNMFIL)//'_shx.res', KERR)
      CALL PLA354 (0, LU61, LU62, '_shx.res', '_shx.ins')
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -R '//
     1            NAMEFIL(1:KNMFIL)//'_shx.ins', KERR)
      CALL PLA354 (0, LU61, LU62, '_shx.res', '_shx.ins')
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -f '//
     1            NAMEFIL(1:KNMFIL)//'_shx.ins', KERR)
      CALL PLA354 (0, LU61, LU62, '_shx.new', '_shx.ins')
      KERR = 0
      CALL SPAWN (SHLPATH(1:IGBL(110))//' '//
     1            NAMEFIL(1:KNMFIL)//'_shx', KERR)
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -a '//
     1            NAMEFIL(1:KNMFIL)//'_shx.cif', KERR)
      RETURN
      END SUBROUTINE PLA353
      SUBROUTINE PLA354 (MODE, LUA, LUB, EXTENA, EXTENB)
      CHARACTER EXTENA*8, EXTENB*8, KEY*4, LINE*76
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      OPEN (LUA, FILE = NAMEFIL(1:KNMFIL)//EXTENA, STATUS = 'UNKNOWN')
      OPEN (LUB, FILE = NAMEFIL(1:KNMFIL)//EXTENB, STATUS = 'UNKNOWN')
      DO
        READ  (LUA, 99999, IOSTAT = IOST) KEY, LINE
        IF (IOST .NE. 0) EXIT
        IF (MODE .EQ. 1) THEN
          IF (KEY .EQ. 'L.S.') WRITE (LUB, 99998, IOSTAT = IOST) 1000
        END IF
        WRITE (LUB, 99999, IOSTAT = IOST) KEY, LINE
      END DO
      CLOSE (UNIT = LUA)
      CLOSE (UNIT = LUB)
      RETURN
99999 FORMAT (2A)
99998 FORMAT ('ANIS', I5)
      END SUBROUTINE PLA354
      SUBROUTINE PLA355 (MODE, LU, NPK, M, N, RVAL)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50, NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /PL350/ NTRY, NLOOP, MTRY, NSOLVED, FACTOR, RVAL0, RVMIN,
     1 NTEL, MFTRY, FOBSMIN, NSOLVMIN, NSPGR, PFLIP, UISO, VRTY, IPEN,
     2 MXSOL, MLLOP(4), IHKLMAX(3), NREF
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      DIMENSION IPRSAVE(NP12), PARSAVE(NP13)
      CHARACTER NAME1*80, PROJ*10
      CHARACTER FORMA*43
      FORMA(1:43) = '(A,I1,4X,I3,3F10.3,'' 11'',F10.4,'' ! '',F12.2)'
      IF (MODE .EQ. 1) THEN
        OPEN (LU, FILE = 'satom.spf', STATUS = 'UNKNOWN')
      END IF
      DO K = 1, IAN
        IF (LMT(IENS(K), 1) .EQ. ' C') THEN
          KEL = K
          K1  = 2
          GO TO 10
        END IF
      END DO
      DO K = 1, IAN
        IF (LMT(IENS(K), 1) .NE. ' H') THEN
          KEL = K
          K1  = 1
          IF (LMT(IENS(K), 1)(1:1) .EQ. ' ') K1 = 2
          GO TO 10
        END IF
      END DO
   10 WRITE (LU, 99998, IOSTAT = IOST) MTRY, N, RVAL
      WRITE (LU, 99999, IOSTAT = IOST) PAR(17), (PAR(100 + I), I = 1, 6)
      WRITE (LU, 99992, IOSTAT = IOST) (PAR(106 + I), I = 1, 6)
      WRITE (LU, 99991, IOSTAT = IOST)  - IABS(IPR(242))
      WRITE (LU, 99990, IOSTAT = IOST) (LMT(IENS(K), 1), K = 1, IAN)
      WRITE (LU, 99989, IOSTAT = IOST)
     1  (NINT(CONT(IENS(L), M)), L = 1, IAN)
      WRITE (LU, 99993, IOSTAT = IOST)
      DO J = 1, NPK
        USIMUL = 0.05 * SQRT (XXO(J, 4) / XXO(1, 4))
        IF (J .LT. 10) THEN
          FORMA(5:5) = '1'
        ELSE IF (J. LT. 100) THEN
          FORMA(5:5) = '2'
        ELSE IF (J .LT. 1000) THEN
          FORMA(5:5) = '3'
        END IF
        WRITE (LU, FORMA, IOSTAT = IOST)
     1    LMT(IENS(KEL), 1)(K1:2), J, KEL,
     2    (XXO(J, K), K = 1, 3), USIMUL,  XXO(J, 4)
      END DO
      WRITE (LU, 99994, IOSTAT = IOST)
      IF (MODE .EQ. 1) THEN
        CLOSE (UNIT = LU61)
        IGBL(3)  = 8
        IGBL(20) = 1
        IGBL(50) = 1
        DO I = 1, NP12
          IPRSAVE(I) = IPR(I)
        END DO
        DO I = 1, NP13
          PARSAVE(I) = PAR(I)
        END DO
        IANSAVE = IAN
        OPEN (LU23, FILE='satom.def', STATUS = 'UNKNOWN')
        SHORT = MIN( PAR(101), PAR(102), PAR(103))
        IF (SHORT .EQ. PAR(101)) THEN
          IF (PAR(102) .GE. PAR(103)) THEN
            PROJ = 'XO'
          ELSE
            PROJ = 'XO ZROT 90'
          END IF
          WRITE (LU23, 99987, IOSTAT = IOST)
     1      -5.0, 5.0, -0.01, 1.01, -0.01, 1.01
        ELSE IF (SHORT .EQ. PAR(102)) THEN
          IF (PAR(103) .GT. PAR(101)) THEN
            PROJ = 'YO'
          ELSE
            PROJ = 'YO ZROT 90'
          END IF
          WRITE (LU23, 99987, IOSTAT = IOST)
     1      -0.01, 1.01, -5.0, 5.0, -0.01, 1.01
        ELSE
          IF (PAR(101) .GT. PAR(102)) THEN
            PROJ = 'ZO'
          ELSE
            PROJ = 'ZO ZROT 90'
          END IF
          WRITE (LU23, 99987, IOSTAT = IOST)
     1      -0.01, 1.01, -0.01, 1.01, -5.0, 5.0
        END IF
        WRITE (LU23, 99988, IOSTAT = IOST) PROJ
        CLOSE (UNIT = LU23)
        CLOSE (UNIT = LU1)
        NAME1   = NAMEFIL
        KNM1    = KNMFIL
        IGBL8   = IGBL(8)
        IGBL(8) = 1
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL PLUTON (0)
        IGBL(8) = IGBL8
        NAMEFIL = NAME1
        KNMFIL  = KNM1
        CLOSE (UNIT = LU1)
        DO I = 1, NP12
          IPR(I) = IPRSAVE(I)
        END DO
        DO I = 1, NP13
          PAR(I) = PARSAVE(I)
        END DO
        IAN = IANSAVE
        CLOSE (UNIT = LU1)
      END IF
      RETURN
99999 FORMAT ('CELL ', F9.5, 3F10.4, 3F10.3)
99998 FORMAT ('TITL F', I2.2, I3.3, ' R =', F5.2)
99994 FORMAT ('HKLF 4', /, 'END')
99993 FORMAT ('FVAR 1.0')
99992 FORMAT ('ZERR 1 ', 3F10.4, 3F10.3)
99991 FORMAT ('LATT ', I5)
99990 FORMAT ('SFAC', 16(1X, A))
99989 FORMAT ('UNIT ', 2I5, 14I4)
99988 FORMAT ('JOIN RADII UNIQUE', /, 'SET IPR 231 1', /,
     1        'VIEW ', A, /, 'UNITCELL', /, 'STRAW', /,
     2        'BOX OFF', /, 'PACK RANGE -0.5 1.5 -0.5 1.5 -0.5 1.5', /,
     3        'PLOT')
99987 FORMAT ('OMIT OUTSIDE', 6F6.3)
      END SUBROUTINE PLA355
      SUBROUTINE PLA360
      PARAMETER (NP12=700,NP13=550,NP17=99,NVD=100000000,NP23=28000,
     1 NP38=150,NP39=30,NP60=100)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /PL138/ IHKLS(5, 48), PHIS(48), NSYM, NSYMH, MHK, MPH,
     1  ICNTR, IND1, IND2, IND3, MISSING(4, NP60)
      INTEGER HMAX
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
C * Subroutine Analysis the Refinement results with a Difference Fourier
      SUMFO = 0.0
      SUMFC = 0.0
      SCF   = 1.0
      IF (IGBL(15) .GT. 0 .AND. IPR(619) .EQ. 0) THEN
        IF (IPR(85) .EQ. 0) CALL PLA024
        CALL PLA023 (0)
        NATO = IPR(589)
        IF (NATO .LE. 0) RETURN
        NSYM  = IPR(48)
        NSYMH = IPR(255)
        ICNTR = IPR(257)
        PAGET = 'DiffFour'
        IF (IGBL(63) .GT. 0) THEN
          CALL PLA262 (0)
          WRITE (LU7, 99995, IOSTAT = IOST)
        END IF
        NREF = 0
        HMAX = -999
        KMAX = -999
        LMAX = -999
        CALL PLA139 (NREF, HMAX, KMAX, LMAX)
        IF (IPR(2) .GT. 0) RETURN
        DO I = 1, 3
          DO J = 4, 8
            IPR(394 + I) = 2**J
            IF (PAR(100 + I) * 3.0 .LT. IPR(394 + I)) EXIT
          END DO
        END DO
        IF (IPR(395) .LE. 2 * HMAX) IPR(395) = IPR(395) * 2
        IF (IPR(396) .LE. 2 * KMAX) IPR(396) = IPR(396) * 2
        IF (IPR(397) .LE. 2 * LMAX) IPR(397) = IPR(397) * 2
        M1 = IPR(395)
        M2 = IPR(396)
        M3 = IPR(397)
        IF (IGBL(63) .GT. 0) THEN
          WRITE (LU6, 99998, IOSTAT = IOST) M1, M2, M3
        END IF
        NGRID   = M1 * M2 * M3
        PAR(79) = PAR(98) / NGRID
        CALL PLA133 (HMAX, KMAX, LMAX, NREF, IADR, NREFA, NREFB)
        IF (NREFB .GT. 0) THEN
          IF (IGBL(9) .NE. 1 .OR. IPR(516) .NE. 0) THEN
            N15 = 0
            DO N = 1, NREFB
              IF (VOID(N15 + 1) .GT. 6.0 * VOID(N15 + 2)) THEN
                ACAL  = VOID(N15 + 3)
                BCAL  = VOID(N15 + 4)
                SUMFO = SUMFO + VOID(N15 + 1)
                SUMFC = SUMFC + SQRT (ACAL**2 + BCAL**2)
              END IF
              N15 = N15 + 15
            END DO
            SCF = SUMFC / SUMFO
          END IF
          N15  = 0
          NSEL = 0
          DO N = 1, NREFB
            FO   = VOID(N15 + 1) * SCF
            ACAL = VOID(N15 + 3)
            BCAL = VOID(N15 + 4)
            FC   = SQRT(ACAL**2 + BCAL**2)
            SIGF = MAX (VOID(N15 + 2) * SCF, 0.0001)
            IF (FC .GT. 2 * IPR(515) * SIGF .AND. FC .NE. 0.0) THEN
              VOID(N15 + 7) = FO * ACAL / FC - ACAL
              VOID(N15 + 8) = FO * BCAL / FC - BCAL
              NSEL          = NSEL + 1
            ELSE
              VOID(N15 + 7) = 0.0
              VOID(N15 + 8) = 0.0
            END IF
            VOID(N15 + 5) = 0.0
            VOID(N15 + 6) = 0.0
            N15           = N15 + 15
          END DO
          IF (IGBL(63) .GT. 0) THEN
            WRITE (LU6, 99997, IOSTAT = IOST) SCF, NSEL, 2 * IPR(515)
            CALL PLA262 (3)
            WRITE (LU7, 99997, IOSTAT = IOST) SCF, NSEL, 2 * IPR(515)
          END IF
          IBOT = NREFA * 15
          ITOP = IBOT + NGRID * 2
          IF (ITOP + 3 * (M1 + 2) * (M2 + 2) .GT. IADR) THEN
            IF (IGBL(63) .GT. 0) THEN
              WRITE (LU6, 99996, IOSTAT = IOST) 2, CHAR(IPR(223))
              WRITE (LU7, 99996, IOSTAT = IOST) 2, CHAR(IPR(223))
            END IF
          ELSE
            IF (IGBL(129) .LE. 0) THEN
              PAR(269) = 0.3
            ELSE
              PAR(269) = 0.05
            END IF
            CALL PLA142 (-3, VOID(1), VOID(IBOT + 1),
     1                     VOID(ITOP + 1), NREFB, 0.0)
            IF (IGBL(63) .GT. 0) THEN
              IF (PAR(329) .NE. 0.0 .AND. PAR(330) .NE. 0.0) THEN
                CALL PLA262 (1)
                WRITE (LU6, 99999, IOSTAT = IOST)
     1            PAR(329), PAR(330), PAR(269)
                WRITE (LU7, 99999, IOSTAT = IOST)
     1            PAR(329), PAR(330), PAR(269)
              END IF
            END IF
          END IF
        END IF
      END IF
      IPR(1) = 1
      RETURN
99999 FORMAT ('PeaksCloseToAtoms: Rho(min) =', F10.2, ', Rho(max) =',
     3        F10.2, ', RhoCutOff =', F6.2)
99998 FORMAT (':: FFT-grid:', 11X,  3I5)
99997 FORMAT (/, ':: Fo-scale = ', E12.6, /,
     1        ':: # Selected Refl.=', I6,
     2       ', with Fo > ', I2, ' * sig(Fo)', /)
99996 FORMAT (/, 'F: Scratch Array Overrun Code', I2, ' (Fatal)', /,
     1        '    Use larger program version i.e. larger NVD', A, /)
99995 FORMAT ('Analysis of the (Final) Difference Fourier Map', /,
     1        80('='))
      END SUBROUTINE PLA360
      SUBROUTINE PLA361 (DMX, N1, N2, IPOSNEG)
      PARAMETER (NP1=20000,NP2=99,NP4=9,NP6=100,NP7=50,NP8=50,NP9=118,
     1 NP10=16,NP11=128,NP12=700,NP13=550,NP17=99,NP19=31,NP22=287,
     2 NP25=99,NP29=63,NP38=150,NP39=30,NP41=200,NP47=9,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLATO/ LABA(NP1), XXO(NP1, 6), XSD(NP1, 6), CON(NP1, NP4),
     1 ANIS(NP1, 6), SUAN(NP1, 6), IATP(NP1), IFG(3, NP1),
     2 IATC(NP1), NTRNS(NP1), JATC(NP1), DATC(NP1), IFNT(NP1), JCA(NP1),
     3 JR(NP1), IBON(NP6, 2), IDIR(NP7), XDIR(NP7, 3, 4), KBO(NP8, 5),
     4 BOK(NP8, 6), MP(NP11), MOL(NP11), CONT(NP10 + 1, 99), NPOL(NP29),
     5 RCG(4, NP29), NCN(NP19), JLN(NP19), NALV(55), BASF(15), SHFT(3),
     6 NEWLAT(NP47), XLS(10, NP2), YMOL(2, 100), MOLS(NP11), ORG(3),
     7 VIEWV(3), DUMA(6), DUMV(3, 3), IXPV(8), XPV(8), XSPV(8),
     8 PAT(3, 3), AA(3, 3), BB(3, 3), DBUF(10), IDBUF(10), ORRES(3, 3),
     9 QQ(3, 3), UIJC(3, 3), OR(3, 3), XJS(12), ITR(3), VECN(8), DEV(6),
     * UIJ(3, 3),  SDV(6), ISDV(6), DP(2, 132), XJX(12), V1(4), V2(3),
     1 V3(3), V4(3), V5(3), V6(3), V7(3), V8(3), TRNS(3, 3), ROR(3, 3),
     2 RCONT(63), RMAT(3, 3), IXSD(6), RP(NP25), RAA(3, 3), RBB(3, 3),
     3 IPPR(129, 3), SCIR(3, 155), ADIR(3, 3), AINV(3, 3), TRNSM1(3, 3),
     4 ROTM1(3, 3), ROTM2(3, 3), DAM(3, 3), PAC(3, 5), RMS(5), QM(3, 3),
     5 SLN(10, 2), SXYZ(15, NP41), TM1(3, 3), TM2(3, 3), MLTI(NP29),
     6 MPOL(NP29), IHKLOMIT(3, 50), RORO(3, 3), NCIF(NP56)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER MAXMIN*6
      IF (N2 .GE. N1) THEN
        NSYM = IPR(48)
        NAT  = IPR(37)
        V2(1) = DMX / (PAR(101) * SIN(PAR(105) / RGBL(6)) * PAR(121))
        V2(2) = DMX / (PAR(102) * SIN(PAR(106) / RGBL(6)) * PAR(119))
        V2(3) = DMX / (PAR(103) * SIN(PAR(104) / RGBL(6)) * PAR(120))
        IF (IPOSNEG .GT. 0) THEN
          MAXMIN   = 'Maxima'
          REWIND (UNIT = LU2, IOSTAT = IOST)
          IF (IOST .NE. 0) CALL GEN148 (LU2, 1)
        ELSE
          MAXMIN   = 'Minima'
        END IF
        IF (IGBL(129) .NE. 0) THEN
          WRITE (LU13, 99998, IOSTAT = IOST)
          WRITE (LU13, 99999, IOSTAT = IOST) MAXMIN, DMX,
     1      MAX (0.10, PAR(269)) * IPOSNEG
        END IF
        IF (IGBL(63) .GT. 0) THEN
          WRITE (LU6, 99999, IOSTAT = IOST) MAXMIN, DMX,
     1      MAX (0.10, PAR(269)) * IPOSNEG
          CALL PLA262 (4)
          WRITE (LU7, 99999, IOSTAT = IOST) MAXMIN, DMX,
     1      MAX (0.10, PAR(269)) * IPOSNEG
        END IF
        DO I = 1, NAT
          CALL PLA047 (LABA(I), NQ1, IDUM, JDUM, 0, IGBL(55),
     1                 0, 0)
          NPK = 0
          DO J = N1, N2
            DO 70 N = 1, NSYM
              DO K = 1, 3
                XJX(K)     = XXO(J, K)
                XJX(K + 3) = 0.0
              END DO
              NS = N
              CALL SGSM (LINE, NS, XJX, LU6, 3, IERR)
              K = 1
              GO TO 20
   10         XJX(6 + K) = XJX(6 + K) - 1.0
   20         IF ((XXO(I, K) - XJX(6 + K)) .LE. V2(K)) GO TO 10
              GO TO 40
   30         IF (ABS(XXO(I, K)  - XJX(6 + K)) .LE. V2(K)) GO TO 50
   40         XJX(6 + K) = XJX(6 + K) + 1.0
              IF ((XXO(I, K)  - XJX(6 + K)) .GE. - V2(K)) GO TO 30
              K = K - 1
              IF (K .EQ. 0) GO TO 70
              GO TO 40
   50         K = K + 1
              IF (K .GT. 3) THEN
                DO L = 1, 3
                  V3(L) = XXO(I, L) - XJX(6 + L)
                END DO
                CALL GEN002 (2, OR, V3, V4, DIST)
                IF (DIST .LT. DMX) THEN
                  IF (NPK .EQ. 0) THEN
                    JTEST = 0
                  ELSE
                    JTEST = IATC(NPK)
                  END IF
                  IF (J .NE. JTEST) THEN
                    NPK       = NPK + 1
                    DATC(NPK) = DIST
                    IATC(NPK) = J
                  ELSE
                    IF (DIST .LT. DATC(NPK)) DATC(NPK) = DIST
                  END IF
                END IF
                GO TO 60
              END IF
              GO TO 20
   60         K = K - 1
              GO TO 40
   70       CONTINUE
          END DO
          CALL GEN013 (DATC, IATC, 1, NPK)
          NPKM1 = MIN (NPK, MIN (4, NP4))
          IF (NPKM1 .GT. 0) THEN
            DO J = 1, NPKM1
              XDENS = IPOSNEG * XXO(IATC(J), 4) / PAR(98)
              WRITE (NAMS(J, 1), 99996, IOSTAT = IOST) XDENS
            END DO
            WRITE (LINE, 99997, IOSTAT = IOST)
     1        NQ1, (IATC(J) - N1 + 1, NAMS(J, 1)(1:6),
     2        DATC(J), J = 1, NPKM1)
            IF (IGBL(129) .NE. 0)
     1        WRITE (LU13, 99994, IOSTAT = IOST) LINE(1:80)
            IF (IGBL(63) .GT. 0) THEN
              CALL PLA262 (1)
              WRITE (LU6, 99994, IOSTAT = IOST) LINE(1:80)
              WRITE (LU7, 99997, IOSTAT = IOST) LINE(1:80)
            END IF
          END IF
        END DO
        IF (IGBL(63) .GT. 0) THEN
          CALL PLA262 (1)
          WRITE (LU6, 99998, IOSTAT = IOST)
          WRITE (LU7, 99998, IOSTAT = IOST)
        END IF
      END IF
      RETURN
99999 FORMAT ('Density ', A, ' within', F5.1, ' Angstrom from Atoms',
     1 ' (CutOff level =', F9.2, ' eA-3)', /, 79('='), /, 'Atom', 3X,
     2 4(3X, '# e/A^3   Ang '), /,  79('='))
99998 FORMAT (' ')
99997 FORMAT (A, 4(I4, A, F6.2, ':'))
99996 FORMAT (F6.2)
99994 FORMAT (A)
      END SUBROUTINE PLA361
      SUBROUTINE PLA362 (FFT, N, V)
      PARAMETER (NPOINT = 200)
      DIMENSION FFT(*), NSTAT(NPOINT + 1)
      CHARACTER BALK*60
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CALL GEN097 (NSTAT, 1, NPOINT + 1, 0)
      XMIN  = 0.0
      XMAX  = 0.0
      SMXI  = 0.0
      SMXIK = 0.0
      DO I = 1, N, 2
        FFTI  = FFT(I) / V
        SMXI  = SMXI  + FFTI
        SMXIK = SMXIK + FFTI**2
        IF (FFTI .GT. XMAX) XMAX = FFTI
        IF (FFTI .LT. XMIN) XMIN = FFTI
        M = NINT(FFTI * 20) +  NPOINT / 2 + 1
        IF (M .GT. 0 .AND. M .LT. NPOINT + 2) NSTAT(M) = NSTAT(M) + 1
      END DO
      AVER  = 2 * SMXI / N
      SIGMA = SQRT(2 * SMXIK / N + AVER**2)
      WRITE (LU13, 99999, IOSTAT = IOST) XMIN, XMAX, AVER, SIGMA
      NSTATM = 0
      DO I = 1, NPOINT + 1
        IF (NSTAT(I) .GT. NSTATM) NSTATM = NSTAT(I)
      END DO
      DO I = 1, NPOINT + 1
        N = I - (NPOINT / 2 + 1)
        D = N * 0.05
        K = NINT (SQRT(FLOAT(NSTAT(I))) * 60.0 / SQRT(FLOAT(NSTATM)))
        DO M = 1, 60
          IF (M .GT. K) THEN
            BALK(M:M) = ' '
          ELSE
            BALK(M:M) = '*'
          END IF
        END DO
        IF (D .GT. XMIN - 0.1 .AND. D .LT. XMAX + 0.1) THEN
          WRITE (LU13, 99998, IOSTAT = IOST) D, NSTAT(I), BALK
        END IF
      END DO
      RETURN
99999 FORMAT (/, 'Section 10:', /, 79('='), /,
     1 'Analysis of Difference Map Grid Point Density. - (MIN =',
     2 F6.2, ', MAX = ', F6.2, ')', /, 79('='), /,
     3 '  eA-3 Frequency Plot Sqrt(Frequency) - Average =', F7.3,
     4 ', Sigma =', F7.3, ' eA-3', /, 79('='), /,
     5 31X, 'Note: F(obs) from FCF and F(calc) from CIF model')
99998 FORMAT (F6.2, I10, 1X, A)
      END SUBROUTINE PLA362
      SUBROUTINE PLA370 (IMODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NVD=100000000,NP22=287,NP23=28000,NP38=150,NP39=30,
     2 NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON // JNSC(2, NP23), VOID(NVD)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DIMENSION IZ(NP10)
      COMMON /DEFWL/ STWL(4)
      COMMON /DEFCWL/ CSTWL
      CHARACTER CSTWL(4)*4
      MODE    = IMODE
      IGBL(6) = 33
      IWIN    = IGBL(25) * IGBL(32)
C * DETERMINE AND PLOT F', F'' AND MU-VALUES
      FP    = 0.0
      FPP   = 0.0
      XMU   = 0.0
      N12   = 0
      IZ(1) = 0
      VRTM  = VERT - 1.0
      HRTM  = HORS - 1.0
      VRTH  = VRTM / 2.0
   10 IF (IPR(220) .EQ. 2) THEN
        DO I = 1, 26
          IF (IFL(2)(1:1) .EQ. CHAR(ICHAR('A') + I - 1)) THEN
            N12 = I * 100
            IF (IFL(2)(2:2) .NE. ' ') THEN
              DO J = 1, 26
                IF (IFL(2)(2:2) .EQ. CHAR(ICHAR('A') + J - 1)) THEN
                  N12 =  N12 + J
                  GO TO 20
                END IF
              END DO
              GO TO 60
            ELSE
              GO TO 20
            END IF
          END IF
        END DO
        GO TO 60
      END IF
      GO TO 30
   20 DO K = 1, NP9
        IF (IEL(K) .EQ. N12) THEN
          IZ(1) = IATNR(K)
          GO TO 30
        END IF
      END DO
      GO TO 60
   30 IF (IPR(221) .EQ. 1) THEN
        IF (IZ(1) .NE. 0) THEN
          CALL PLA371 (IZ(1), FN(1), FP, FPP, XMU, LU6)
          CALL GEN020 (-1, IFL(2), 2, 2)
          WRITE (SBCD, 99999, IOSTAT = IOST) IFL(2)(1:2), FN(1), FP,
     1      FPP, XMU, CHAR(0)
          WRITE (LU6, 99998, IOSTAT = IOST) SBCD(1:80)
          GO TO 60
        ELSE
          M    = 0
          FMX  = 0.0
          FMUM = 0.0
          JEL = 0
          DO I = 1, 92
            IZ(1) = I
            DO J = 1, NP9
              IF (IATNR(J) .EQ. IZ(1)) THEN
                JEL = J
                GO TO 40
              ENDIF
            END DO
   40       CALL PLA371 (IZ(1), FN(1), FP, FPP, XMU, 0)
            WRITE (SBCD, 99999, IOSTAT = IOST) ELB(JEL), FN(1), FP,
     1        FPP, XMU, CHAR(0)
            WRITE (LU6, 99998, IOSTAT = IOST) SBCD(1:79)
            VOID (M + 1) = FLOAT (JEL)
            VOID (M + 2) = FP
            VOID (M + 3) = FPP
            VOID (M + 4) = XMU
            M            = M + 4
            FMX          = MAX (FMX, ABS(FP), FPP)
            FMUM         = MAX (FMUM, XMU)
          END DO
          SCALEV   = (VRTH - 1.0) / FMX
          SCALEM   = (VERT - 3.0) / FMUM
          IF (MODE .EQ. 1) THEN
            WRITE (BCD, 99994, IOSTAT = IOST) FN(1)
          ELSE
            WRITE (BCD, 99993, IOSTAT = IOST) FN(1)
          END IF
          CALL GGIP (HORS, VERT, 0.0, 1)
          CALL GGIP09 (0.0, BCD, 35, 0.8, 4, 8, 1.0, VERT - 1.2)
          CALL GGIP09 (0.0, BCD, 35, 0.8, 2, 8, 0.9, VERT - 1.3)
          CALL PLA110 (HORS, VERT, -1)
          X1 = 1.0
          IF (MODE .EQ. 1) THEN
            Y1 = VRTH
          ELSE IF (MODE .EQ. 2) THEN
            Y1 = 1.0
          END IF
          Z1 = 0.0
          CALL GGIP (X1, Y1, Z1, -3)
          CALL GGIP (0.0, 0.0, 0.0, 3)
          CALL GGIP (HRTM, 0.0, 0.0, 2)
          CALL GGIP (0.0, 0.0, 0.0, 3)
          DO I = 1, 92
            X1 = I * (HRTM - 0.5) / 92
            JEL = NINT(VOID((I - 1) * 4 + 1))
            IF (MODE .EQ. 1) THEN
              Y1 = VOID ((I - 1) * 4 + 2) * SCALEV
              CALL GGIP09 (-90.0, 'o '//ELB(JEL), 4, 0.2, 1, 1,
     1            X1 - 0.2, Y1)
              Y1 = VOID ((I - 1) * 4 + 3) * SCALEV
              CALL GGIP09 (90.0, 'x '//ELB(JEL), 4, 0.2, 1, 1, X1, Y1)
            ELSE IF (MODE .EQ. 2) THEN
              Y1 = VOID ((I - 1) * 4 + 4) * SCALEM
              CALL GGIP09 (90.0, 'x '//ELB(JEL), 4, 0.2, 1, 1, X1, Y1)
            END IF
          END DO
          GO TO 50
        END IF
      ELSE IF (IPR(221) .EQ. 0) THEN
        IF (IPR(220) .EQ. 1) THEN
          NELM = 0
          DO I = 1, IAN
            N = IATNR(IEN(I))
            IF (N .GT. 7) THEN
              NELM = NELM + 1
              IFL(NELM + 1) = LMT(I, 1)
              IZ(NELM) = N
            END IF
          END DO
          IF (NELM .EQ. 0) GO TO 60
        ELSE
          NELM = 1
        ENDIF
        N    = 0
        FMX  = 0.0
        FMUM = 0.0
        WLB  = 2.0
        WLE  = 0.3
        WDF  = WLB - WLE
        NSTP = 500
        DWL  = WDF / NSTP
        DO J = 1, NELM
          WL = WLB + DWL
          DO I = 1, NSTP + 1
            WL = WL - DWL
            CALL PLA371 (IZ(J), WL, FP, FPP, XMU, 0)
            VOID (N + 1) = WL
            VOID (N + 2) = FP
            VOID (N + 3) = FPP
            VOID (N + 4) = XMU
            N            = N + 4
            FMX = MAX (FMX, ABS(FP), FPP)
            FMUM = MAX (FMUM, XMU)
          END DO
        END DO
        SCALEV   = VRTH / FMX
        SCALEM   = (VERT - 3.0) / FMUM
        IF (MODE .EQ. 1) THEN
          N = INT (LOG(FMX) / LOG(10.0))
          XMARK = 10**N
          NMX  = INT(FMX / XMARK)
          IF (NMX .LT. 3) THEN
            XMARK = XMARK / 2.0
            NMX  = INT (FMX / XMARK)
          END IF
        ELSE IF (MODE .EQ. 2) THEN
          N = INT (LOG(FMUM) / LOG(10.0))
          MARK = 10**N
          NMX  = INT(FMUM / MARK)
          IF (NMX .LT. 3) THEN
            MARK = MARK / 2
            NMX  = INT (FMUM / MARK)
          END IF
        ENDIF
        IF (MODE .EQ. 1) THEN
          NBCD = 21
          BCD(1:NBCD) = 'Anomalous Dispersion'//CHAR(0)
        ELSE
          NBCD = 23
          BCD(1:NBCD) = 'Mu-value versus Lambda'//CHAR(0)
        END IF
        CALL GGIP (HORS, VERT, 0.0, 1)
        CALL GGIP09 (0.0, BCD, NBCD, 1.2, 4, 8, 3.0, VERT - 1.7)
        CALL GGIP09 (0.0, BCD, NBCD, 1.2, 2, 8, 2.9, VERT - 1.8)
        CALL PLA110 (HORS, VERT, -1)
        X1 = 1.0
        IF (MODE .EQ. 1) THEN
          Y1 = VRTH
        ELSE IF (MODE .EQ. 2) THEN
          Y1 = 1.0
        END IF
        Z1 = 0.0
        CALL GGIP (X1, Y1, Z1, -3)
        IF (MODE .EQ. 1) THEN
          SGN = 1.0
          DO J = 1, 2
            IF (J .EQ. 2) SGN = -1.0
            X1 = 0.0
            Y1 = 0.0
            CALL GGIP (X1, Y1, Z1, 3)
            DO I = 1, NMX
              Y1 = I * XMARK * SCALEV * SGN
              CALL GGIP (X1, Y1, Z1, 2)
              X2 = 0.2
              CALL GGIP (X2, Y1, Z1, 2)
              WRITE (NQ1, 99996, IOSTAT = IOST) I * XMARK * SGN
              CALL GGIP09 (0.0, NQ1, 6, 0.2, 1, 1, 0.1, Y1 + 0.1)
              CALL GGIP (X1, Y1, Z1, 3)
            END DO
            Y1 = VRTH * SGN
            CALL GGIP (X1, Y1, Z1, 2)
            Y1 = 0.0
            CALL GGIP (X1, Y1, Z1, 3)
          END DO
        ELSE
          DO I = 1, NMX
            X1 = 0.0
            Y1 = I * MARK * SCALEM
            CALL GGIP (X1, Y1, 0.0, 2)
            X2 = 0.2
            CALL GGIP (X2, Y1, 0.0, 2)
            WRITE (NQ1, 99995, IOSTAT = IOST) I * MARK
            CALL GGIP09 (0.0, NQ1, 6, 0.2, 1, 1, 0.1, Y1 + 0.1)
            CALL GGIP (X1, Y1, Z1, 3)
          END DO
          Y1 = VERT - 2.0
          CALL GGIP (X1, Y1, 0.0, 2)
          Y1 = 0.0
          CALL GGIP (X1, Y1, 0.0, 3)
        END IF
        X1 = 0.0
        Y1 = 0.0
        X2 = WLB
        WRITE (NQ1, 99997, IOSTAT = IOST) WLB
        CALL GGIP09 (0.0, NQ1, 3, 0.2, 1, 1, 0.1, -0.3)
        CALL GGIP (X1, Y1, Z1, 3)
        DO I = 1, 17
          X1 = I * HRTM / 17
          CALL GGIP (X1, Y1, Z1, 2)
          Y2 = Y1 - 0.2
          CALL GGIP (X1, Y2, Z1, 2)
          IF (I .LT. 17) THEN
            WLB = WLB - 0.1
            WRITE (NQ1, 99997, IOSTAT = IOST) WLB
            CALL GGIP09 (0.0, NQ1, 3, 0.2, 1, 1, X1 + 0.1, -0.3)
          END IF
          CALL GGIP (X1, Y1, Z1, 3)
        END DO
        DO I = 1, 4
          X1 = HRTM * (1.0 - ((STWL(I) - WLE) / WDF))
          Y1 = 0.5
          CALL GGIP09 (0.0, CSTWL(I), 4, 0.25, 5, 1, X1 - 0.3, Y1 + 0.1)
          CALL GGIP (0.0, 5.0, 0.0, 0)
          CALL GGIP (X1, 0.0, 0.0, 3)
          CALL GGIP (X1, Y1, 0.0, 2)
          CALL GGIP (0.0, 0.0, 0.0, 3)
        END DO
        CALL GGIP09 (0.0, 'Angstrom', 8, 0.25, 1, 1, HRTM - 1.8, 0.2)
        NB = 0
        DO K = 1, NELM
          NQ2 = IFL(K + 1)(1:2)
          IF (NQ2(1:1) .NE. ' ') CALL GEN020 (-1, NQ2, 2, 2)
          CALL GGIP09 (0.0, NQ2, 2, 0.3, K, 1, HRTM - 1.0,
     1        2.0 + K * 0.4)
          IF (MODE .EQ. 1) THEN
            X1 = 0.0
            Y1 = VOID(NB + 2) * SCALEV
            CALL GGIP09 (0.0, 'f''', 2, 0.3, K, 1, 0.3, Y1 + 0.1)
            CALL GGIP (0.0, FLOAT(K), 0.0, 0)
            CALL GGIP (X1, Y1, Z1, 3)
            DO I = 2, NSTP + 1
              X1 = HRTM * (I - 1) / NSTP
              Y1 = VOID (NB + I * 4 + 2) * SCALEV
              CALL GGIP (X1, Y1, Z1, 2)
            END DO
            X1 = 0.0
            Y1 = 0.0
            CALL GGIP (X1, Y1, Z1, 3)
            X1 = 0.0
            Y1 = VOID(NB + 3) * SCALEV
            CALL GGIP09 (0.0, 'f''''', 3, 0.3, K, 1, 0.3, Y1 + 0.1)
            CALL GGIP (0.0, FLOAT(K), 0.0, 0)
            CALL GGIP (X1, Y1, Z1, 3)
            DO I = 2, NSTP + 1
              X1 = HRTM * (I - 1) / NSTP
              Y1 = VOID (NB + I * 4 + 3) * SCALEV
              CALL GGIP (X1, Y1, Z1, 2)
            END DO
          ELSE
            X1 = 0.0
            Y1 = 0.0
            CALL GGIP (X1, Y1, Z1, 3)
            X1 = 0.0
            Y1 = VOID(NB + 4) * SCALEM
            CALL GGIP (0.0, FLOAT(K), 0.0, 0)
            CALL GGIP (X1, Y1, Z1, 3)
            DO I = 2, NSTP + 1
              X1 = HRTM * (I - 1) / NSTP
              Y1 = VOID (NB + I * 4 + 4) * SCALEM
              CALL GGIP (X1, Y1, Z1, 2)
            END DO
          END IF
          CALL GGIP (0.0, 0.0, 0.0, 3)
          NB = NB + (NSTP + 1) * 4
        END DO
      END IF
   50 CALL PLA013 (0, 1)
        CALL GEN072 (IGGT, IFL, FN, KL, KN, 0, LU6, 1,
     1                   1, 80, 7, NP17)
        IPR(220) = KL
        IPR(221) = KN
        IF (IFL(1)(1:4) .EQ. 'ANOM') THEN
          MODE  = 1
          IZ(1) = 0
          GO TO 10
        ELSE IF (IFL(1)(1:2) .EQ. 'MU') THEN
          MODE  = 2
          IZ(1) = 0
          GO TO 10
        ELSE IF (IFL(1)(1:4) .NE. 'EXIT') THEN
          SELECT CASE (LRET)
            CASE (1)
              GO TO 30
            CASE (2)
              GO TO 60
            CASE (4)
              GO TO 60
          END SELECT
        END IF
   60 IGBL(6) = 10
      RETURN
99999 FORMAT ('Element: ', A, ', WaveLength:', F8.5, ', f'':', F10.4,
     1        ', f":', F10.4, ', Mu:', F10.1, A)
99998 FORMAT (A)
99997 FORMAT (F3.1)
99996 FORMAT (F6.2)
99995 FORMAT (I6)
99994 FORMAT ('f'' and f" at Lambda =', F8.5, ' Ang.')
99993 FORMAT ('Mu-Values at Lambda =', F8.5, ' Ang.')
      END SUBROUTINE PLA370
      SUBROUTINE PLA371 (IZED, WAVELENGTH, FP, FPP, MU, LU)
C * Calculate f', f'' and mu values for arbitrary wavelengths.
C * Calculations based on Cromer and Liberman and McMasters
C * Code adapted from S.Brennan & P.L.Cowan (1992). Rev.Sci.Instr.,63,850-853
C * This version is based on the Roger J. Dejus distribution (25-Jan-1996)
      COMMON /ANOMD/ XSC(92, 24, 11), XNRG(92, 24, 6), RELCOR(92),
     1 XKPCOR(92), IFUNTYP(92, 24), NPARMS(92, 24), DRAY(92, 4),
     2 DCMP(92, 4), NORB(92), BINDNRG(92, 24)
      DOUBLE PRECISION XSC, XNRG, YNRG(24, 11), RELCOR, XKPCOR, BINDNRG,
     1 DRAY, DCMP, DFPORB, DFPPORB, DNRGS(11), DXSECTS(11), DLOGNRG(11),
     2 DLOGXSECT(11), DNRGINT(5), DXSECTINT(5), DXSECTEDGEAU, DFPCORR,
     3 DENERGY, DLOGENERGY, DENERGYAU, DBINDNRGAU, DXSECTBARNS, DVAR,
     4 DSUMFP, DSUMFPP, AU, KEVPERRYD, PI, INVFINESTRUCT, FINEPI,
     5 PLA372, GEN149, P1, P2, P3, BARNSTOELECTRONS, FTOMU, ENERGY, RAY,
     6 COMP
      COMMON /DANOM/ DXSECTEDGEAU, DXSECTBARNS, DBINDNRGAU, DXSECTINT,
     1 DENERGYAU
      REAL MU, ABSEDGE(24), KA1, KA2, KB1, KB3, LB1, LB2, LB3, LB4,
     1 LA1, LA2, LG1, LG3, LI, LE
      FTOMU            = 0.420803153D+8
      BARNSTOELECTRONS = 1.43110541D-8 ! barns to f"
      AU               = 2.80022D+7
      KEVPERRYD        = 0.02721D0
      FINEPI           = 0.6942325D+1
      PI               = 3.1415927D0
      INVFINESTRUCT    = 1.37036D+2
      IF (IZED .GE. 1 .AND. IZED .LE. 92 .AND. WAVELENGTH .GT. 0) THEN
C * Conversion E = hc/lambda = 41.3566733*299.792458/lambda
        ENERGY = 12398.52D0 / DBLE(WAVELENGTH)
        NEDGE = NORB(IZED)
        DO I = 1, NEDGE
          ABSEDGE(I) = SNGL(BINDNRG(IZED, I) * 1000.0D0)
        END DO
        IF (LU .GT. 0) THEN
          IF (NEDGE .EQ. 1) THEN
            WRITE (LU, 99972, IOSTAT = IOST) ABSEDGE(1)
          ELSE IF (NEDGE .EQ. 2) THEN
            WRITE (LU, 99973, IOSTAT = IOST) (ABSEDGE(I), I = 1, 2)
          ELSE IF (NEDGE .eq. 3) THEN
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            WRITE (LU, 99974, IOSTAT = IOST) (ABSEDGE(I), I = 1, 3)
            WRITE (LU, 99975, IOSTAT = IOST) KA2
          ELSE IF (NEDGE .EQ. 4) THEN
            KA1 = ABSEDGE(1) - ABSEDGE(4)
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            WRITE (LU, 99994, IOSTAT = IOST) (ABSEDGE(I), I = 1, 4)
            WRITE (LU, 99977, IOSTAT = IOST) KA1, KA2
          ELSE IF (NEDGE .EQ. 5) THEN
            KA1 = ABSEDGE(1) - ABSEDGE(4)
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            WRITE (LU, 99994, IOSTAT = IOST) (ABSEDGE(I), I = 1, 4)
            WRITE (LU, 99979, IOSTAT = IOST) KA1, KA2
            WRITE (LU, 99980, IOSTAT = IOST) ABSEDGE(5)
          ELSE IF (NEDGE .EQ. 6) THEN
            KB3 = ABSEDGE(1) - ABSEDGE(6)
            KA1 = ABSEDGE(1) - ABSEDGE(4)
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            WRITE (LU, 99994, IOSTAT = IOST) (ABSEDGE(I), I = 1, 4)
            WRITE (LU, 99982, IOSTAT = IOST) KA1, KA2, KB3
            WRITE (LU, 99983, IOSTAT = IOST) (ABSEDGE(I), I = 5, 6)
          ELSE IF (NEDGE .EQ. 7) THEN
            KB1 = ABSEDGE(1) - ABSEDGE(7)
            KB3 = ABSEDGE(1) - ABSEDGE(6)
            KA1 = ABSEDGE(1) - ABSEDGE(4)
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            WRITE (LU, 99994, IOSTAT = IOST) (ABSEDGE(I), I = 1, 4)
            WRITE (LU, 99995, IOSTAT = IOST) KA1, KA2, KB1, KB3
            WRITE (LU, 99986, IOSTAT = IOST) (ABSEDGE(I), I = 5, 7)
          ELSE IF (NEDGE .EQ. 8) THEN
            LB1 = ABSEDGE(2) - ABSEDGE(8)
            KB1 = ABSEDGE(1) - ABSEDGE(7)
            KB3 = ABSEDGE(1) - ABSEDGE(6)
            KA1 = ABSEDGE(1) - ABSEDGE(4)
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            WRITE (LU, 99994, IOSTAT = IOST) (ABSEDGE(I), I = 1, 4)
            WRITE (LU, 99995, IOSTAT = IOST) KA1, KA2, KB1, KB3
            WRITE (LU, 99989, IOSTAT = IOST) (ABSEDGE(I), I = 5, 8), LB1
          ELSE IF ((NEDGE .EQ. 9) .AND. (NEDGE .LT. 14)) THEN
            LB1 = ABSEDGE(2) - ABSEDGE(8)
            LA1 = ABSEDGE(3) - ABSEDGE(9)
            KB1 = ABSEDGE(1) - ABSEDGE(7)
            KB3 = ABSEDGE(1) - ABSEDGE(6)
            KA1 = ABSEDGE(1) - ABSEDGE(4)
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            WRITE (LU, 99994, IOSTAT = IOST) (ABSEDGE(I), I = 1, 4)
            WRITE (LU, 99995, IOSTAT = IOST) KA1, KA2, KB1, KB3
            WRITE (LU, 99996, IOSTAT = IOST) (ABSEDGE(I), I = 5, 9)
            WRITE (LU, 99993, IOSTAT = IOST) LB1, LA1
          ELSE
            KA1 = ABSEDGE(1) - ABSEDGE(4)
            KA2 = ABSEDGE(1) - ABSEDGE(3)
            KB1 = ABSEDGE(1) - ABSEDGE(7)
            KB3 = ABSEDGE(1) - ABSEDGE(6)
            LB1 = ABSEDGE(3) - ABSEDGE(8)
            LB2 = ABSEDGE(4) - ABSEDGE(14)
            LB3 = ABSEDGE(2) - ABSEDGE(7)
            LB4 = ABSEDGE(2) - ABSEDGE(6)
            LA1 = ABSEDGE(4) - ABSEDGE(9)
            LA2 = ABSEDGE(4) - ABSEDGE(8)
            LG1 = ABSEDGE(3) - ABSEDGE(13)
            LG3 = ABSEDGE(2) - ABSEDGE(12)
            LI  = ABSEDGE(4) - ABSEDGE(5)
            LE  = ABSEDGE(3) - ABSEDGE(5)
            WRITE (LU, 99994, IOSTAT = IOST) (ABSEDGE(I), I = 1, 4)
            WRITE (LU, 99995, IOSTAT = IOST) KA1, KA2, KB1, KB3
            WRITE (LU, 99996, IOSTAT = IOST) (ABSEDGE(I), I = 5, 9)
            WRITE (LU, 99997, IOSTAT = IOST)
     1        LB1, LB2, LB3, LB4, LA1, LA2
            WRITE (LU, 99998, IOSTAT = IOST) (ABSEDGE(I), I = 10, 14)
            WRITE (LU, 99999, IOSTAT = IOST) LG1, LG3, LI, LE
          END IF
        END IF
        IF (IZED .GT. 2) THEN
          DO J = 1, NORB(IZED)
            DO K = 1, 5
              YNRG(J, K) = XNRG(1, 1, K)
            END DO
            DO K = 6, NPARMS(IZED, J)
              YNRG (J, K) = XNRG(IZED, J, K - 5)
            END DO
          END DO
        END IF
        P1         = DLOG(ENERGY / 1000.0D0)
        P2         = P1 * P1
        P3         = P1 * P2
        DENERGY    = ENERGY / 1000.0D0
        DLOGENERGY = DLOG(DENERGY)
        DENERGYAU  = DENERGY / KEVPERRYD
        DSUMFP     = 0.D0
        DSUMFPP    = 0.D0
C * RELCOR is the relativistic correction term
C * BARNS_TO ELECTRONS[is a constant that converts the cross section in
C * barns/atom into a cross-section in electrons/atom which is the same
C * as f''. It is calculated as:
C *   1/(10^8 [b/A^2]*2* rsube=2.8179^-5 * hc=12398.52)
        IF (IZED .EQ. 1) THEN
C * Hydrogen
          IF (ENERGY .GE. 14.0D-3) THEN
            FPP = SNGL(BARNSTOELECTRONS * ENERGY *
     1            DEXP(2.44964D0 - 3.34953D0 * P1 - 0.047137D0 * P2
     2                           + 0.0070996D0 * P3))
          END IF
        ELSE IF (IZED .EQ. 2) THEN
C * Helium
          IF (ENERGY .GE. 25.0D-3) then
            FPP = SNGL(BARNSTOELECTRONS * ENERGY *
     1            DEXP(6.06488D0 - 3.2905D0 * P1 - 0.107256D0 * P2
     2                           + 0.0144465D0 * P3))
          END IF
        ELSE
          DO IRB = 1, NORB(IZED)
            DFPORB      = 0.D0
            DFPCORR     = 0.D0
            DFPPORB     = 0.D0
            DXSECTBARNS = 0.D0
            DBINDNRGAU  = BINDNRG(IZED, IRB) / KEVPERRYD
            IF (NPARMS(IZED, IRB) .EQ. 11) THEN
              DXSECTEDGEAU = XSC(IZED, IRB, 11) / AU
            END IF
C * also copy subset into second array
            DO I = 6, 10
              DXSECTINT(I - 5) = XSC(IZED, IRB, I) / AU
              DNRGINT(I - 5)   = YNRG(IRB, I)
            END DO
C * the sorting routine messes up subsequent calls with same energy
C * so copy to second array before sorting.
            DO I = 1, NPARMS(IZED, IRB)
              DXSECTS(I) = XSC(IZED, IRB, I)
              DNRGS(I)   = YNRG(IRB, I)
            END DO
            CALL GEN150 (NPARMS(IZED, IRB), DNRGS, DXSECTS)
            CALL GEN150 (5, DNRGINT, DXSECTINT)
C * convert to log of energy, xsect
            DO I = 1, NPARMS(IZED, IRB)
              DLOGNRG(I) = DLOG(DNRGS(I))
              IF (DXSECTS(I) .EQ. 0.0D0) THEN
                DLOGXSECT(I) = 0.0D0
              ELSE
                DLOGXSECT(I) = DLOG(DXSECTS(I))
              END IF
            END DO
            IF (BINDNRG(IZED, IRB) .LE. DENERGY) THEN
              IZERO = 0
              I     = 1
              DO WHILE(DLOGXSECT(I) .EQ. 0.0D0)
                IZERO = IZERO + 1
                I     = I + 1
              END DO
              INXSECT     = NPARMS(IZED, IRB) - IZERO
              IZERO       = IZERO + 1
              DXSECTBARNS = GEN149 (DLOGENERGY, INXSECT,
     1                      DLOGNRG(IZERO), DLOGXSECT(IZERO))
              DXSECTBARNS = DEXP (DXSECTBARNS) / AU
              DFPPORB     = INVFINESTRUCT * DXSECTBARNS
     1                    * DENERGYAU / (4.0D0 * PI)
              DVAR        = DENERGYAU - DBINDNRGAU
              IF (DVAR .EQ. 0.0D0) DVAR = 1.0D0
              DFPCORR = -0.5D0 * DXSECTBARNS * DENERGYAU * FINEPI
     1                  * DLOG ((DENERGYAU + DBINDNRGAU) / DVAR)
            END IF
            IF (BINDNRG(IZED, IRB) .GT. DENERGY .AND.
     1        IFUNTYP(IZED, IRB) .EQ. 0) THEN
                DFPORB  = PLA372 (3) * FINEPI
                DFPCORR = 0.5D0 * DXSECTEDGEAU * DBINDNRGAU**2
     1                  * DLOG ((-DBINDNRGAU + DENERGYAU) /
     2                      (-DBINDNRGAU - DENERGYAU)) /
     3                      DENERGYAU * FINEPI
            ELSE
              DFPORB = PLA372 (IFUNTYP(IZED, IRB)) * FINEPI
            END IF
            DSUMFP  = DSUMFP  + DFPORB + DFPCORR
            DSUMFPP = DSUMFPP + DFPPORB
          END DO
C * this is the end of the loop over orbits
          FPP = SNGL(DSUMFPP)
C * Kissel and Pratt give better corrections.  The relativistic correction
C * that Ludwig used is (5/3)(E_tot/mc^2).  Kissel and Pratt say that this
C * should be simply (E_tot/mc^2), but their correction (XKPCOR) apparently
C * takes this into account.  So we can use the old RELCOR and simply add
C * the (energy independent) XKPCOR term:
          FP = SNGL(DSUMFP - RELCOR(IZED) + XKPCOR(IZED))
        END IF
C * Calculate elastic and compton cross-sections (in electrons/atom)
C * BARNSTOELECTRONS is a constant that converts the cross section in
C * barns/atom into a cross-section in electrons/atom which is the same
C * as f''. It is calculated as
C * BARNSTOELECTRONS= 1/( 10^8 [b/A^2]*2* rsube=2.8179^-5* hc=12398.52)
        RAY  = BARNSTOELECTRONS * ENERGY *
     1         DEXP(DRAY(IZED, 1) + DRAY(IZED, 2) * P1 +
     2         DRAY(IZED, 3) * P2 + DRAY(IZED, 4) * P3)
        COMP = BARNSTOELECTRONS * ENERGY *
     1         DEXP(DCMP(IZED, 1) + DCMP(IZED, 2) * P1 +
     2         DCMP(IZED, 3) * P2 + DCMP(IZED, 4) * P3)
        MU   = SNGL(1.66043D0 * FTOMU * (DBLE(FPP) + RAY + COMP) /
     1         ENERGY)
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('Lg1:',f8.1,' Lg3:',f8.1,' Li: ',f8.1,' Le: ',f8.1)
99998 FORMAT ('N1: ',f8.1,' N2: ',f8.1,' N3: ',f8.1,' N4: ',f8.1,
     1 ' N5: ',f8.1)
99997 FORMAT ('Lb1:',f8.1,' Lb2:',f8.1,' Lb3:',f8.1,' Lb4:',f8.1,
     1 ' La1:',f8.1,' La2:',f9.1)
99996 FORMAT ('M1: ',f8.1,' M2: ',f8.1,' M3: ',f8.1,' M4: ',f8.1,
     1 ' M5: ',f8.1)
99995 FORMAT ('Ka1:',f8.1,' Ka2:',f8.1,' Kb1:',f8.1,' Kb3:',f8.1)
99994 FORMAT ('K:  ',f8.1,' L1: ',f8.1,' L2: ',f8.1,' L3: ',f8.1)
99993 FORMAT ('Lb1:',f8.1,' La1:',f8.1)
99989 FORMAT ('M1: ',f8.1,' M2: ',f8.1,' M3: ',f8.1,' M4: ',f8.1,
     1 ' Lb1:',f8.1)
99986 FORMAT ('M1: ',f8.1,' M2: ',f8.1,' M3: ',f8.1)
99983 FORMAT ('M1: ',f8.1,' M2: ',f8.1)
99982 FORMAT ('Ka1:',f8.1,' Ka2:',f8.1,' Kb3:',f8.1)
99980 FORMAT ('M1: ',f8.1)
99979 FORMAT ('Ka1:',f8.1,' Ka2:',f8.1)
99977 FORMAT ('Ka1:',f8.1,' Ka2:',f8.1)
99975 FORMAT ('Ka2:',f8.1)
99974 FORMAT ('K:  ',f8.1,' L1: ',f8.1,' L2: ',f8.1)
99973 FORMAT ('K:  ',f8.1,' L1: ',f8.1)
99972 FORMAT ('K-edge: ',f8.1)
      END SUBROUTINE PLA371
      DOUBLE PRECISION FUNCTION PLA372 (MODE)
      DOUBLE PRECISION A, B, C, D, E, F, P1, P2, P3, P4, DCONST, DX(2),
     1 DA(3), DXSECTBARNS, DBINDNRGAU, DXSECTINT(5), DENERGYAU, DP,
     2 DXSECTEDGEAU, SMALL, SIGMA
      COMMON /DANOM/ DXSECTEDGEAU, DXSECTBARNS, DBINDNRGAU,
     1 DXSECTINT, DENERGYAU
      DX(1) = 0.04691007703067D0
      DX(2) = 0.23076534494716D0
      DA(1) = 0.11846344252810D0
      DA(2) = 0.23931433524968D0
      DA(3) = 0.28444444444444D0
      SMALL = 1.0D-31
      A     = 0.d0
      DO I = 1, 5
        P1     = 0.5D0
        DCONST = 0.D0
        IP     = I
        IF (IP .GT. 3) THEN
          IP     = 6 - IP
          DCONST = -1.D0
        END IF
        IF (IP .NE. 3) P1 = - DCONST + DSIGN(DX(IP), DCONST)
        P2 = P1 * P1
        P3 = P1 * P2
        P4 = P1 * P3
        B  = DXSECTINT(6 - I)
        C  = DENERGYAU
        D  = DBINDNRGAU
        E  = DXSECTBARNS
        F  = DXSECTEDGEAU
        SELECT CASE (MODE)
          CASE (0)
            DP = C**2 * P2 - D**2
            IF (DABS(DP) .LT. 1.D-30) THEN
              SIGMA = B * D / P2
            ELSE
              SIGMA = (B * D**3 / P2 - D * E * C**2) / DP
            END IF
          CASE (1)
            SIGMA = 0.5D0 * D**3 * B /
     1              (DSQRT(P1) * (C**2 * P2 - D**2 * P1))
          CASE (2)
            IF (DABS(P1) .LT. SMALL) THEN
              SIGMA = 0.0D0
            ELSE IF (C .LT. SMALL) THEN
              SIGMA = 0.0D0
            ELSE IF (DABS(B - E) .LT. 1.0D-30) THEN
              SIGMA = -2.0D0 * B * D / P3
            ELSE
              DP = P3 * C**2 - D**2 / P1
              IF (DABS(DP) .LT. SMALL) THEN
                SIGMA = -2.0D0 * B * D / P3
              ELSE
                SIGMA = 2.0D0 * (B * D**3 / P4 - D * E * C**2) / DP
              END IF
            ENDIF
          CASE (3)
            SIGMA = D**3 * (B - F * P2) / (P2 * (P2 * C**2 - D**2))
        END SELECT
        A = A + DA(IP) * SIGMA
      END DO
      PLA372 = A
      RETURN
      END FUNCTION PLA372
      BLOCK DATA ATOM_DATA
      DOUBLE PRECISION XSC, XNRG, RELCOR, XKPCOR, BINDNRG,
     1 DRAY, DCMP
      COMMON /ANOMD/ XSC(92, 24, 11), XNRG(92, 24, 6), RELCOR(92),
     1 XKPCOR(92), IFUNTYP(92, 24), NPARMS(92, 24), DRAY(92, 4),
     2 DCMP(92, 4), NORB(92), BINDNRG(92, 24)
C * DUMMY USE OF NOT USED H-ATOM ENTRY
      DATA (XNRG(1, 1, J), J = 1, 5)/
     1 80.0002518D0,   26.7000599D0,   8.89995575D0,   3.00003362D0,
     2 1.00000000D0/
C * DATA FOR LI ELEMENT # 3
      DATA ((XNRG(3, I, J), J = 1, 5), I = 1, 2)/
     1 24.8800831D0,   1.02811790D0,   0.218999997D0,  9.252656251D-02,
     2 6.027210504D-02,2.42666030D0,   0.100276709D0,  2.136000060D-02,
     3 9.024509229D-03,5.878594704D-03/
C * DATA FOR BE ELEMENT # 4
      DATA ((XNRG(4, I, J), J = 1, 5), I = 1, 2)/
     1 50.4418144D0,   2.08440351D0,   0.444000006D0,  0.187588111D0,
     2 0.122195505D0,  3.82630682D0,   0.158114210D0,  3.367999941D-02,
     3 1.422965620D-02,9.269244038D-03/
C * DATA FOR B  ELEMENT # 5
      DATA ((XNRG(5, I, J), J = 1, 5), I = 1, 3)/
     1 85.4329758D0,   3.53034091D0,   0.751999974D0,  0.317716777D0,
     2 0.206961751D0,  6.12118196D0,   0.252945185D0,  5.387999862D-02,
     3 2.276406996D-02,1.482858974D-02,2.13582444D0,   8.825852722D-02,
     4 1.879999973D-02,7.942919619D-03,5.174043588D-03/
C * DATA FOR C  ELEMENT # 6
      DATA ((XNRG(6, I, J), J = 1, 5), I = 1, 3)/
     1 128.967453D0,   5.32931280D0,   1.13520002D0,   0.479617149D0,
     2 0.312424183D0,  8.86594391D0,   0.366366804D0,  7.804000378D-02,
     3 3.297156841D-02,2.147778682D-02,2.90835667D0,   0.120181821D0,
     4 2.559999935D-02,1.081589051D-02,7.045506500D-03/
C * DATA FOR N  ELEMENT # 7
      DATA ((XNRG(7, I, J), J = 1, 5), I = 1, 4)/
     1 182.499390D0,   7.54140949D0,   1.60640001D0,   0.678697169D0,
     2 0.442105532D0,  11.9560728D0,   0.494059980D0,  0.105240002D0,
     3 4.446345195D-02,2.896363661D-02,4.18076277D0,   0.172761381D0,
     4 3.680000082D-02,1.554784272D-02,1.012791600D-02,4.18076277D0,
     5 0.172761381D0,  3.680000082D-02,1.554784272D-02,1.012791600D-02/
C * DATA FOR O  ELEMENT # 8
      DATA ((XNRG(8, I, J), J = 1, 5), I = 1, 4)/
     1 241.757156D0,   9.99011421D0,   2.12800002D0,   0.899070919D0,
     2 0.585657716D0,  10.7700090D0,   0.445048332D0,  9.480000287D-02,
     3 4.005259648D-02,2.609039098D-02,3.22645831D0,   0.133326709D0,
     4 2.840000018D-02,1.199887879D-02,7.816108875D-03,3.22645831D0,
     5 0.133326709D0,  2.840000018D-02,1.199887879D-02,7.816108875D-03/
C * DATA FOR F  ELEMENT # 9
      DATA ((XNRG(9, I, J), J = 1, 5), I = 1, 4)/
     1 311.466827D0,   12.8707218D0,   2.74160004D0,   1.15831435D0,
     2 0.754529715D0,  14.0873537D0,   0.582130730D0,  0.124000005D0,
     3 5.238947272D-02,3.412667289D-02,3.90810442D0,   0.161494330D0,
     4 3.440000117D-02,1.453385316D-02,9.467399679D-03,3.90810442D0,
     5 0.161494330D0,  3.440000117D-02,1.453385316D-02,9.467399679D-03/
C * DATA FOR NE ELEMENT #10
      DATA ((XNRG(10, I, J), J = 1, 5), I = 1, 4)/
     1 393.946014D0,   16.2790031D0,   3.46759987D0,   1.46504617D0,
     2 0.954335868D0,  20.4493828D0,   0.845028460D0,  0.180000007D0,
     3 7.604923099D-02,4.953871667D-02,8.31608295D0,   0.343644917D0,
     4 7.320000231D-02,3.092668764D-02,2.014574595D-02,8.31608295D0,
     5 0.343644917D0,  7.320000231D-02,3.092668764D-02,2.014574595D-02/
C * DATA FOR NA ELEMENT #11
      DATA ((XNRG(11, I, J), J = 1, 6), I = 1, 4)/
     1 22.8543644D0,   4.64584494D0,   2.14420009D0,   1.39372301D0,
     2 1.12486768D0,   1.07317209D0,   28.7654667D0,   1.18867338D0,
     3 0.253199995D0,  0.106975920D0,  6.968446076D-02,0.0D0,
     4 14.1327963D0,   0.584008574D0,  0.124399997D0,  5.255847052D-02,
     5 3.423675895D-02,0.0D0,          14.1327963D0,   0.584008574D0,
     6 0.124399997D0,  5.255847052D-02,3.423675895D-02,0.0D0/
C * DATA FOR MG ELEMENT #12
      DATA ((XNRG(12, I, J), J = 1, 6), I = 1, 4)/
     1 27.8191833D0,   5.65509510D0,   2.60999990D0,   1.69649148D0,
     2 1.36923075D0,   1.30630505D0,   40.6261101D0,   1.67878985D0,
     3 0.357600003D0,  0.151084468D0,  9.841691703D-02,0.0D0,
     4 23.3577404D0,   0.965210319D0,  0.205600008D0,  8.686511964D-02,
     5 5.658422410D-02,0.0D0,          23.3577404D0,   0.965210319D0,
     6 0.205600008D0,  8.686511964D-02,5.658422410D-02,0.0D0/
C * DATA FOR AL ELEMENT #13
      DATA ((XNRG(13, I, J), J = 1, 6), I = 1, 5)/
     1 33.2465858D0,   6.75838041D0,   3.11919999D0,   2.02746964D0,
     2 1.63636184D0,   1.56115961D0,   53.4864998D0,   2.21021891D0,
     3 0.47080001D0,   0.198910996D0,  0.129571274D0,  0.0D0,
     4 33.2188873D0,   1.37270176D0,   0.292400002D0,  0.123537749D0,
     5 8.047289401D-02,0.0D0,          33.2188873D0,   1.37270176D0,
     6 0.292400002D0,  0.123537749D0,  8.047289401D-02,0.0D0,
     7 3.80615973D0,   0.157281682D0,  3.350266069D-02,1.415473130D-02,
     8 9.220438078D-03,0.0D0/
C * DATA FOR SI ELEMENT #14
      DATA ((XNRG(14, I, J), J = 1, 6), I = 1, 6)/
     1 39.2005310D0,   7.96870089D0,   3.67779994D0,   2.39055800D0,
     2 1.92940867D0,   1.84073889D0,   67.5738525D0,   2.79234958D0,
     3 0.594799995D0,  0.251300454D0,  0.163697943D0,  0.0D0,
     4 45.0795288D0,   1.86281824D0,   0.396800011D0,  0.167646304D0,
     5 0.109205350D0,  0.0D0,          45.0795288D0,   1.86281824D0,
     6 0.396800011D0,  0.167646304D0,  0.109205350D0,  0.0D0,
     7 5.16104650D0,   0.213269562D0,  4.542867094D-02,1.919342019D-02,
     8 1.250265632D-02,0.0D0,          2.30989599D0,   9.545166790D-02,
     9 2.033221535D-02,8.590274490D-03,5.595732480D-03,0.0D0/
C * DATA FOR P  ELEMENT #15
      DATA ((XNRG(15, I, J), J = 1, 6), I = 1, 7)/
     1 45.7364426D0,   9.29732323D0,   4.29099989D0,   2.78913593D0,
     2 2.25109935D0,   2.14764547D0,   86.0237350D0,   3.55475307D0,
     3 0.757200003D0,  0.319913775D0,  0.208392873D0,  0.0D0,
     4 60.0757446D0,   2.48250580D0,   0.528800011D0,  0.223415747D0,
     5 0.145533741D0,  0.0D0,          60.0757446D0,   2.48250580D0,
     6 0.528800011D0,  0.223415747D0,  0.145533741D0,  0.0D0,
     7 6.57174635D0,   0.271563828D0,  5.784596503D-02,2.443967387D-02,
     8 1.592008211D-02,0.0D0,          2.90150857D0,   0.119898833D0,
     9 2.553972043D-02,1.079042256D-02,7.028916851D-03,0.0D0,
     * 2.87958717D0,   0.118992977D0,  2.534676343D-02,1.070889924D-02,
     1 6.975811906D-03,0.0D0/
C * DATA FOR S  ELEMENT #16
      DATA ((XNRG(16, I, J), J = 1, 6), I = 1, 7)/
     1 52.6965675D0,   10.7121801D0,   4.94400024D0,   3.21358371D0,
     2 2.59366918D0,   2.47447205D0,   104.155533D0,   4.30401182D0,
     3 0.916800022D0,  0.387344092D0,  0.252317220D0,  0.0D0,
     4 74.8901901D0,   3.09468198D0,   0.659200013D0,  0.278509200D0,
     5 0.181421801D0,  0.0D0,          74.8901901D0,   3.09468198D0,
     6 0.659200013D0,  0.278509200D0,  0.181421801D0,  0.0D0,
     7 8.03807640D0,   0.332156867D0,  7.075292617D-02,2.989280969D-02,
     8 1.947227307D-02,0.0D0,          3.55075431D0,   0.146727577D0,
     9 3.125452623D-02,1.320490334D-02,8.601716720D-03,0.0D0,
     * 3.51496625D0,   0.145248711D0,  3.093951195D-02,1.307181176D-02,
     1 8.515020832D-03,0.0D0/
C * DATA FOR CL ELEMENT #17
      DATA ((XNRG(17, I, J), J = 1, 6), I = 1, 7)/
     1 60.1661758D0,   12.2306061D0,   5.64479971D0,   3.66910148D0,
     2 2.96131539D0,   2.82522225D0,   122.787186D0,   5.07392645D0,
     3 1.08080006D0,   0.456633389D0,  0.297452480D0,  0.0D0,
     4 91.6132355D0,   3.78572750D0,   0.806400001D0,  0.340700567D0,
     5 0.221933454D0,  0.0D0,          90.8861542D0,   3.75568223D0,
     6 0.800000012D0,  0.337996602D0,  0.220172077D0,  0.0D0,
     7 7.95253801D0,   0.328622192D0,  7.000000030D-02,2.957470156D-02,
     8 1.926505752D-02,0.0D0,          3.09012914D0,   0.127693191D0,
     9 2.720000036D-02,1.149188355D-02,7.485850714D-03,0.0D0,
     * 3.09012914D0,   0.127693191D0,  2.720000036D-02,1.149188355D-02,
     1 7.485850714D-03,0.0D0/
C * DATA FOR AR ELEMENT #18
      DATA ((XNRG(18, I, J), J = 1, 6), I = 1, 7)/
     1 68.2774429D0,   13.8794670D0,   6.40580034D0,   4.16374922D0,
     2 3.36054349D0,   3.20610285D0,   145.417831D0,   6.00909138D0,
     3 1.27999997D0,   0.540794551D0,  0.352275312D0,  0.0D0,
     4 112.380722D0,   4.64390087D0,   0.989199996D0,  0.417932779D0,
     5 0.272242785D0,  0.0D0,          111.426414D0,   4.60446596D0,
     6 0.980799973D0,  0.414383799D0,  0.269930959D0,  0.0D0,
     7 11.4970980D0,   0.475093782D0,  0.101199999D0,  4.275656864D-02,
     8 2.785176784D-02,0.0D0,          5.63494110D0,   0.232852280D0,
     9 4.960000142D-02,2.095578797D-02,1.365066878D-02,0.0D0,
     * 5.63494110D0,   0.232852280D0,  4.960000142D-02,2.095578797D-02,
     1 1.365066878D-02,0.0D0/
C * DATA FOR K  ELEMENT #19
      DATA ((XNRG(19, I, J), J = 1, 6), I = 1, 7)/
     1 76.9003220D0,   15.6323299D0,   7.21479988D0,   4.68959618D0,
     2 3.78495240D0,   3.61100745D0,   171.365829D0,   7.08133841D0,
     3 1.50839996D0,   0.637292564D0,  0.415134460D0,  0.0D0,
     4 134.647827D0,   5.56404305D0,   1.18519998D0,   0.500741959D0,
     5 0.326184928D0,  0.0D0,          133.420868D0,   5.51334143D0,
     6 1.17439997D0,   0.496178985D0,  0.323212624D0,  0.0D0,
     7 15.4052029D0,   0.636588097D0,  0.135600001D0,  5.729041994D-02,
     8 3.731916845D-02,0.0D0,          8.08886719D0,   0.334255695D0,
     9 7.119999826D-02,3.008169681D-02,1.959531568D-02,0.0D0,
     * 8.08886719D0,   0.334255695D0,  7.119999826D-02,3.008169681D-02,
     1 1.959531568D-02,0.0D0/
C * DATA FOR CA ELEMENT #20
      DATA ((XNRG(20, I, J), J = 1, 6), I = 1, 7)/
     1 86.0817184D0,   17.4987278D0,   8.07619953D0,   5.24950361D0,
     2 4.23685122D0,   4.04213810D0,   198.949783D0,   8.22118759D0,
     3 1.75119996D0,   0.739874542D0,  0.481956691D0,  0.0D0,
     4 159.050766D0,   6.57244349D0,   1.39999998D0,   0.591494024D0,
     5 0.385301143D0,  0.0D0,          157.414810D0,   6.50484133D0,
     6 1.38559997D0,   0.585410118D0,  0.381338030D0,  0.0D0,
     7 19.8586235D0,   0.820616543D0,  0.174799994D0,  7.385225594D-02,
     8 4.810759798D-02,0.0D0,          11.5425415D0,   0.476971626D0,
     9 0.101599999D0,  4.292556643D-02,2.796185389D-02,0.0D0,
     * 11.5425415D0,   0.476971626D0,  0.101599999D0,  4.292556643D-02,
     1 2.796185389D-02,0.0D0/
C * DATA FOR SC ELEMENT #21
      DATA ((XNRG(21, I, J), J = 1, 6), I = 1, 7)/
     1 95.7747269D0,   19.4691277D0,   8.98559952D0,   5.84061050D0,
     2 4.71393061D0,   4.49729300D0,   227.397141D0,   9.39671612D0,
     3 2.00160003D0,   0.845667481D0,  0.550870538D0,  0.0D0,
     4 184.816986D0,   7.63717937D0,   1.62679994D0,   0.687316060D0,
     5 0.447719902D0,  0.0D0,          182.772049D0,   7.55267668D0,
     6 1.60880005D0,   0.679711163D0,  0.442766041D0,  0.0D0,
     7 24.4483738D0,   1.01027846D0,   0.215200007D0,  9.092108160D-02,
     8 5.922628939D-02,0.0D0,          14.6781130D0,   0.606542647D0,
     9 0.129199997D0,  5.458644778D-02,3.555779159D-02,0.0D0,
     * 14.6781130D0,   0.606542647D0,  0.129199997D0,  5.458644778D-02,
     1 3.555779159D-02,0.0D0/
C * DATA FOR TI ELEMENT #22
      DATA ((XNRG(22, I, J), J = 1, 6), I = 1, 7)/
     1 105.870644D0,   21.5214291D0,   9.93280029D0,   6.45628738D0,
     2 5.21084070D0,   4.97136641D0,   256.162628D0,   10.5853901D0,
     3 2.25480008D0,   0.952643394D0,  0.620554984D0,  0.0D0,
     4 209.719788D0,   8.66623592D0,   1.84599996D0,   0.779927135D0,
     5 0.508047044D0,  0.0D0,          206.993210D0,   8.55356598D0,
     6 1.82200003D0,   0.769787252D0,  0.501441896D0,  0.0D0,
     7 27.4021740D0,   1.13233817D0,   0.241200000D0,  0.101905972D0,
     8 6.638187915D-02,0.0D0,          15.7233038D0,   0.649733007D0,
     9 0.138400003D0,  5.847340822D-02,3.808977082D-02,0.0D0,
     * 15.7233038D0,   0.649733007D0,  0.138400003D0,  5.847340822D-02,
     1 3.808977082D-02,0.0D0/
C * DATA FOR V  ELEMENT #23
      DATA ((XNRG(23, I, J), J = 1, 6), I = 1, 8)/
     1 116.501617D0,   23.6824989D0,   10.9301996D0,   7.10459423D0,
     2 5.73408651D0,   5.47056532D0,   285.473389D0,   11.7965975D0,
     3 2.51279998D0,   1.06164730D0,   0.691560507D0,  0.0D0,
     4 236.531204D0,   9.77416229D0,   2.08200002D0,   0.879636109D0,
     5 0.572997808D0,  0.0D0,          233.077530D0,   9.63144684D0,
     6 2.05159998D0,   0.866792262D0,  0.564631283D0,  0.0D0,
     7 30.2196445D0,   1.24876428D0,   0.266000003D0,  0.112383865D0,
     8 7.320721447D-02,0.0D0,          17.1774826D0,   0.709823906D0,
     9 0.151199996D0,  6.388135254D-02,4.161252454D-02,0.0D0,
     * 17.1774826D0,   0.709823906D0,  0.151199996D0,  6.388135254D-02,
     1 4.161252454D-02,0.0D0,          0.999747634D0,  4.131250456D-02,
     2 8.799999952D-03,3.717962420D-03,2.421892947D-03,0.0D0/
C * DATA FOR CR ELEMENT #24
      DATA ((XNRG(24, I, J), J = 1, 6), I = 1, 9)/
     1 127.674065D0,   25.9536381D0,   11.9784002D0,   7.78592062D0,
     2 6.28398228D0,   5.99518919D0,   315.647583D0,   13.0434837D0,
     3 2.77839994D0,   1.17386210D0,   0.764657617D0,  0.0D0,
     4 265.251221D0,   10.9609585D0,   2.33480000D0,   0.986443043D0,
     5 0.642572224D0,  0.0D0,          261.070465D0,   10.7881966D0,
     6 2.29800010D0,   0.970895171D0,  0.632444322D0,  0.0D0,
     7 33.6733170D0,   1.39148021D0,   0.296400011D0,  0.125227734D0,
     8 8.157375455D-02,0.0D0,          19.3133068D0,   0.798082411D0,
     9 0.170000002D0,  7.182427496D-02,4.678656533D-02,0.0D0,
     * 19.3133068D0,   0.798082411D0,  0.170000002D0,  7.182427496D-02,
     1 4.678656533D-02,0.0D0,          1.04519069D0,   4.319034144D-02,
     2 9.200000204D-03,3.886960680D-03,2.531978767D-03,0.0D0,
     3 1.04519069D0,   4.319034144D-02,9.200000204D-03,3.886960680D-03,
     4 2.531978767D-03,0.0D0/
C * DATA FOR MN ELEMENT #25
      DATA ((XNRG(25, I, J), J = 1, 6), I = 1, 9)/
     1 139.394363D0,   28.3361435D0,   13.0780001D0,   8.50065708D0,
     2 6.86084270D0,   6.54553890D0,   349.457245D0,   14.4405975D0,
     3 3.07599998D0,   1.29959691D0,   0.846561670D0,  0.0D0,
     4 296.016174D0,   12.2322559D0,   2.60559988D0,   1.10085487D0,
     5 0.717100441D0,  0.0D0,          290.972015D0,   12.0238161D0,
     6 2.56119990D0,   1.08209610D0,   0.704880893D0,  0.0D0,
     7 38.1267395D0,   1.57550859D0,   0.335599989D0,  0.141789570D0,
     8 9.236218780D-02,0.0D0,          22.0853348D0,   0.912630737D0,
     9 0.194399998D0,  8.213317394D-02,5.350181460D-02,0.0D0,
     * 22.0853348D0,   0.912630737D0,  0.194399998D0,  8.213317394D-02,
     1 5.350181460D-02,0.0D0,          3.29989052D0,   0.136361137D0,
     2 2.904636599D-02,1.227196585D-02,7.993998006D-03,0.0D0,
     3 3.24635458D0,   0.134148881D0,  2.857512981D-02,1.207287051D-02,
     4 7.864307612D-03,0.0D0/
C * DATA FOR FE ELEMENT #26
      DATA ((XNRG(26, I, J), J = 1, 6), I = 1, 9)/
     1 151.609222D0,   30.8191853D0,   14.2240000D0,   9.24555302D0,
     2 7.46204519D0,   7.11911201D0,   384.493866D0,   15.8884125D0,
     3 3.38439989D0,   1.42989457D0,   0.931437969D0,  0.0D0,
     4 327.690002D0,   13.5411119D0,   2.88440013D0,   1.21864665D0,
     5 0.793830454D0,  0.0D0,          321.782410D0,   13.2969923D0,
     6 2.83240008D0,   1.19667697D0,   0.779519260D0,  0.0D0,
     7 42.2166176D0,   1.74451435D0,   0.371600002D0,  0.156999409D0,
     8 0.102269933D0,  0.0D0,          24.5392609D0,   1.01403415D0,
     9 0.216000006D0,  9.125907719D-02,5.944646150D-02,0.0D0,
     * 24.5392609D0,   1.01403415D0,   0.216000006D0,  9.125907719D-02,
     1 5.944646150D-02,0.0D0,          1.63595068D0,   6.760227680D-02,
     2 1.439999975D-02,6.083938293D-03,3.963097464D-03,0.0D0,
     3 1.63595068D0,   6.760227680D-02,1.439999975D-02,6.083938293D-03,
     4 3.963097464D-03,0.0D0/
C * DATA FOR CO ELEMENT #27
      DATA ((XNRG(27, I, J), J = 1, 6), I = 1, 9)/
     1 164.333557D0,   33.4057961D0,   15.4177999D0,   10.0215197D0,
     2 8.08832359D0,   7.71660900D0,   420.621094D0,   17.3812962D0,
     3 3.70239997D0,   1.56424820D0,   1.01895642D0,   0.0D0,
     4 360.636230D0,   14.9025459D0,   3.17440009D0,   1.34117043D0,
     5 0.873642802D0,  0.0D0,          353.819794D0,   14.6208706D0,
     6 3.11439991D0,   1.31582069D0,   0.857129872D0,  0.0D0,
     7 45.7611771D0,   1.89098597D0,   0.402799994D0,  0.170181274D0,
     8 0.110856637D0,  0.0D0,          27.0386295D0,   1.11731541D0,
     9 0.238000005D0,  0.100553982D0,  6.550119072D-02,0.0D0,
     * 27.0386295D0,   1.11731541D0,   0.238000005D0,  0.100553982D0,
     1 6.550119072D-02,0.0D0,          1.31784916D0,   5.445738882D-02,
     2 1.159999985D-02,4.900950473D-03,3.192495089D-03,0.0D0,
     3 1.31784916D0,   5.445738882D-02,1.159999985D-02,4.900950473D-03,
     4 3.192495089D-03,0.0D0/
C * DATA FOR NI ELEMENT #28
      DATA ((XNRG(28, I, J), J = 1, 6), I = 1, 9)/
     1 177.633469D0,   36.1094093D0,   16.6655998D0,   10.8325853D0,
     2 8.74293137D0,   8.34113312D0,   21.4900513D0,   4.36850691D0,
     3 2.01620007D0,   1.31052339D0,   1.05771756D0,   1.00910807D0,
     4 396.218170D0,   16.3728962D0,   3.48760009D0,   1.47349608D0,
     5 0.959840178D0,  0.0D0,          388.401947D0,   16.0499077D0,
     6 3.41880012D0,   1.44442844D0,   0.940905392D0,  0.0D0,
     7 50.8053589D0,   2.09942627D0,   0.447200000D0,  0.188940093D0,
     8 0.123076193D0,  0.0D0,          30.9467335D0,   1.27880979D0,
     9 0.272399992D0,  0.115087837D0,  7.496859133D-02,0.0D0,
     * 30.9467335D0,   1.27880979D0,   0.272399992D0,  0.115087837D0,
     1 7.496859133D-02,0.0D0,          1.63595068D0,   6.760227680D-02,
     2 1.439999975D-02,6.083938293D-03,3.963097464D-03,0.0D0,
     3 1.63595068D0,   6.760227680D-02,1.439999975D-02,6.083938293D-03,
     4 3.963097464D-03,0.0D0/
C * DATA FOR CU ELEMENT #29
      DATA ((XNRG(29, I, J), J = 1, 6), I = 1, 9)/
     1 191.406631D0,   38.9092216D0,   17.9577999D0,   11.6725111D0,
     2 9.42083168D0,   8.98787880D0,   23.3659821D0,   4.74984646D0,
     3 2.19219995D0,   1.42492282D0,   1.15004885D0,   1.09719610D0,
     4 432.163635D0,   17.8582687D0,   3.80399990D0,   1.60717380D0,
     5 1.04691827D0,   0.0D0,          423.120483D0,   17.4845772D0,
     6 3.72440004D0,   1.57354307D0,   1.02501106D0,   0.0D0,
     7 54.4408035D0,   2.24965358D0,   0.479200006D0,  0.202459961D0,
     8 0.131883070D0,  0.0D0,          33.4461021D0,   1.38209105D0,
     9 0.294400007D0,  0.124382742D0,  8.102332801D-02,0.0D0,
     * 33.4461021D0,   1.38209105D0,   0.294400007D0,  0.124382742D0,
     1 8.102332801D-02,0.0D0,          0.727089226D0,  3.004545718D-02,
     2 6.400000304D-03,2.703972859D-03,1.761376741D-03,0.0D0,
     3 0.727089226D0,  3.004545718D-02,6.400000304D-03,2.703972859D-03,
     4 1.761376741D-03,0.0D0/
C * DATA FOR ZN ELEMENT #30
      DATA ((XNRG(30, I, J), J = 1, 6), I = 1, 9)/
     1 205.896057D0,   41.8546371D0,   19.3171997D0,   12.5561171D0,
     2 10.1339865D0,   9.66825867D0,   25.4444256D0,   5.17235374D0,
     3 2.38720012D0,   1.55167222D0,   1.25234771D0,   1.19479358D0,
     4 22.2297649D0,   4.51887608D0,   2.08559990D0,   1.35563314D0,
     5 1.09412551D0,   1.04384279D0,   21.7373333D0,   4.41877460D0,
     6 2.03940010D0,   1.32560337D0,   1.06988859D0,   1.02071965D0,
     7 61.7571373D0,   2.55198598D0,   0.543600023D0,  0.229668677D0,
     8 0.149606928D0,  0.0D0,          39.3537025D0,   1.62621033D0,
     9 0.346399993D0,  0.146352515D0,  9.533450752D-02,0.0D0,
     * 39.3537025D0,   1.62621033D0,   0.346399993D0,  0.146352515D0,
     1 9.533450752D-02,0.0D0,          3.68088913D0,   0.152105123D0,
     2 3.240000084D-02,1.368886139D-02,8.916969411D-03,0.0D0,
     3 3.68088913D0,   0.152105123D0,  3.240000084D-02,1.368886139D-02,
     4 8.916969411D-03,0.0D0/
C * DATA FOR GA ELEMENT #31
      DATA ((XNRG(31, I, J), J = 1, 6), I = 1, 9)/
     1 220.999420D0,   44.9248581D0,   20.7341995D0,   13.4771624D0,
     2 10.8773575D0,   10.3774672D0,   27.6635666D0,   5.62346125D0,
     3 2.59540009D0,   1.68700147D0,   1.36157143D0,   1.29899764D0,
     4 24.3508453D0,   4.95004988D0,   2.28460002D0,   1.48498249D0,
     5 1.19852281D0,   1.14344227D0,   23.7774067D0,   4.83348131D0,
     6 2.23079991D0,   1.45001268D0,   1.17029881D0,   1.11651540D0,
     7 71.8455048D0,   2.96886683D0,   0.632400036D0,  0.267186314D0,
     8 0.174046025D0,  0.0D0,          48.5332031D0,   2.00553417D0,
     9 0.427199990D0,  0.180490181D0,  0.117571890D0,  0.0D0,
     * 46.7609253D0,   1.93229842D0,   0.411599994D0,  0.173899248D0,
     1 0.113278531D0,  0.0D0,          7.90709448D0,   0.326744318D0,
     2 6.960000098D-02,2.940570191D-02,1.915496960D-02,0.0D0,
     3 7.90709448D0,   0.326744318D0,  6.960000098D-02,2.940570191D-02,
     4 1.915496960D-02,0.0D0/
C * DATA FOR GE ELEMENT #32
      DATA ((XNRG(32, I, J), J = 1, 6), I = 1, 9)/
     1 236.689011D0,   48.1142426D0,   22.2061996D0,   14.4339571D0,
     2 11.6495829D0,   11.1142035D0,   30.1491718D0,   6.12873650D0,
     3 2.82859993D0,   1.83858073D0,   1.48391032D0,   1.41571426D0,
     4 26.5998287D0,   5.40722418D0,   2.49559999D0,   1.62213182D0,
     5 1.30921543D0,   1.24904776D0,   25.9368572D0,   5.27245522D0,
     6 2.43339992D0,   1.58170199D0,   1.27658463D0,   1.21791673D0,
     7 81.7975388D0,   3.38011384D0,   0.720000029D0,  0.304196924D0,
     8 0.198154882D0,  0.0D0,          58.1216927D0,   2.40175867D0,
     9 0.511600018D0,  0.216148809D0,  0.140800044D0,  0.0D0,
     * 54.8952332D0,   2.26843190D0,   0.483200014D0,  0.204149932D0,
     1 0.132983938D0,  0.0D0,          13.0421619D0,   0.538940370D0,
     2 0.114799999D0,  4.850250855D-02,3.159469366D-02,0.0D0,
     3 13.0421619D0,   0.538940370D0,  0.114799999D0,  4.850250855D-02,
     4 3.159469366D-02,0.0D0/
C * DATA FOR AS ELEMENT #33
      DATA ((XNRG(33, I, J), J = 1, 6), I = 1, 9)/
     1 252.966965D0,   51.4232330D0,   23.7334003D0,   15.4266319D0,
     2 12.4507666D0,   11.8785667D0,   32.5409851D0,   6.61494493D0,
     3 3.05300021D0,   1.98444009D0,   1.60163271D0,   1.52802658D0,
     4 28.9617939D0,   5.88736582D0,   2.71720004D0,   1.76617110D0,
     5 1.42546880D0,   1.35995865D0,   28.2050266D0,   5.73353004D0,
     6 2.64619994D0,   1.72002137D0,   1.38822162D0,   1.32442307D0,
     7 92.4766541D0,   3.82140660D0,   0.814000010D0,  0.343911529D0,
     8 0.224025086D0,  0.0D0,          66.5286636D0,   2.74915934D0,
     9 0.585600019D0,  0.247413501D0,  0.161165968D0,  0.0D0,
     * 63.8475227D0,   2.63836670D0,   0.562000036D0,  0.237442613D0,
     1 0.154670894D0,  0.0D0,          18.7225475D0,   0.773670495D0,
     2 0.164800003D0,  6.962729990D-02,4.535545036D-02,0.0D0,
     3 18.7225475D0,   0.773670495D0,  0.164800003D0,  6.962729990D-02,
     4 4.535545036D-02,0.0D0/
C * DATA FOR SE ELEMENT #34
      DATA ((XNRG(34, I, J), J = 1, 6), I = 1, 9)/
     1 269.831146D0,   54.8513908D0,   25.3155994D0,   16.4550571D0,
     2 13.2808037D0,   12.6704578D0,   35.2568169D0,   7.16702080D0,
     3 3.30780005D0,   2.15005922D0,   1.73530328D0,   1.65555394D0,
     4 31.4687195D0,   6.39697456D0,   2.95239997D0,   1.91905034D0,
     5 1.54885697D0,   1.47767615D0,   30.6074982D0,   6.22190523D0,
     6 2.87160015D0,   1.86653066D0,   1.50646865D0,   1.43723583D0,
     7 105.200722D0,   4.34720182D0,   0.925999999D0,  0.391231060D0,
     8 0.254849195D0,  0.0D0,          76.4352493D0,   3.15852857D0,
     9 0.672800004D0,  0.284255117D0,  0.185164720D0,  0.0D0,
     * 73.5723343D0,   3.04022455D0,   0.647599995D0,  0.273608238D0,
     1 0.178229287D0,  0.0D0,          25.7662239D0,   1.06473589D0,
     2 0.226799995D0,  9.582202882D-02,6.241878495D-02,0.0D0,
     3 25.7662239D0,   1.06473589D0,   0.226799995D0,  9.582202882D-02,
     4 6.241878495D-02,0.0D0/
C * DATA FOR BR ELEMENT #35
      DATA ((XNRG(35, I, J), J = 1, 6), I =  1, 9)/
     1 287.223999D0,   58.3870163D0,   26.9473991D0,   17.5157223D0,
     2 14.1368608D0,   13.4871740D0,   37.9875755D0,   7.72213030D0,
     3 3.56400013D0,   2.31658840D0,   1.86970818D0,   1.78378201D0,
     4 34.0225410D0,   6.91611624D0,   3.19199991D0,   2.07478952D0,
     5 1.67455339D0,   1.59759593D0,   33.0398102D0,   6.71634674D0,
     6 3.09980011D0,   2.01485991D0,   1.62618446D0,   1.55144989D0,
     7 116.561485D0,   4.81666231D0,   1.02600002D0,   0.433480620D0,
     8 0.282370687D0,  0.0D0,          86.0237350D0,   3.55475307D0,
     9 0.757200003D0,  0.319913775D0,  0.208392873D0,  0.0D0,
     * 82.4791794D0,   3.40828133D0,   0.726000011D0,  0.306731910D0,
     1 0.199806154D0,  0.0D0,          31.8555946D0,   1.31636655D0,
     2 0.280400008D0,  0.118467800D0,  7.717031240D-02,0.0D0,
     3 31.3557224D0,   1.29571033D0,   0.275999993D0,  0.116608821D0,
     4 7.595936954D-02,0.0D0/
C * DATA FOR KR ELEMENT #36
      DATA ((XNRG(36, I, J), J = 1, 6), I = 1, 9)/
     1 305.384277D0,   62.0786438D0,   28.6511993D0,   18.6231861D0,
     2 15.0306911D0,   14.3399258D0,   40.9506912D0,   8.32447338D0,
     3 3.84200001D0,   2.49728751D0,   2.01554966D0,   1.92292106D0,
     4 36.8193817D0,   7.48465967D0,   3.45440006D0,   2.24534869D0,
     5 1.81221104D0,   1.72892725D0,   35.7044830D0,   7.25802231D0,
     6 3.34979987D0,   2.17735887D0,   1.75733674D0,   1.67657483D0,
     7 131.026016D0,   5.41437912D0,   1.15331995D0,   0.487272769D0,
     8 0.317411065D0,  0.0D0,          101.201729D0,   4.18195200D0,
     9 0.890799999D0,  0.376359195D0,  0.245161608D0,  0.0D0,
     * 97.1572952D0,   4.01482391D0,   0.855199993D0,  0.361318350D0,
     1 0.235363945D0,  0.0D0,          40.3988914D0,   1.66940069D0,
     2 0.355599999D0,  0.150239483D0,  9.786649048D-02,0.0D0,
     3 40.3988914D0,   1.66940069D0,   0.355599999D0,  0.150239483D0,
     4 9.786649048D-02,0.0D0/
C * DATA FOR RB ELEMENT #37
      DATA ((XNRG(37, I, J), J = 1, 6), I = 1, 9)/
     1 324.017792D0,   65.8664780D0,   30.3993988D0,   19.7595100D0,
     2 15.9478130D0,   15.2148991D0,   44.0225258D0,   8.94891739D0,
     3 4.13019991D0,   2.68461657D0,   2.16674209D0,   2.06716514D0,
     4 39.7334671D0,   8.07703590D0,   3.72779989D0,   2.42305779D0,
     5 1.95563912D0,   1.86576390D0,   38.4650841D0,   7.81919861D0,
     6 3.60879993D0,   2.34570813D0,   1.89321065D0,   1.80620444D0,
     7 146.372147D0,   6.04852581D0,   1.28840005D0,   0.544343531D0,
     8 0.354587138D0,  0.0D0,          112.426170D0,   4.64577866D0,
     9 0.989600003D0,  0.418101788D0,  0.272352874D0,  0.0D0,
     * 108.381729D0,   4.47865057D0,   0.953999996D0,  0.403060913D0,
     1 0.262555212D0,  0.0D0,          50.8053589D0,   2.09942627D0,
     2 0.447200000D0,  0.188940093D0,  0.123076193D0,  0.0D0,
     3 50.1237106D0,   2.07125854D0,   0.441199988D0,  0.186405122D0,
     4 0.121424899D0,  0.0D0/
C * DATA FOR SR ELEMENT #38
      DATA ((XNRG(38, I, J), J = 1, 6), I = 1, 12)/
     1 343.307892D0,   69.7877731D0,   32.2092018D0,   20.9358749D0,
     2 16.8972511D0,   16.1207047D0,   47.2457123D0,   9.60412788D0,
     3 4.43260002D0,   2.88117552D0,   2.32538390D0,   2.21851635D0,
     4 42.7797203D0,   8.69628048D0,   4.01360035D0,   2.60882688D0,
     5 2.10557270D0,   2.00880694D0,   41.3471947D0,   8.40507507D0,
     6 3.87920022D0,   2.52146745D0,   2.03506517D0,   1.94153965D0,
     7 162.458984D0,   6.71328163D0,   1.42999995D0,   0.604168892D0,
     8 0.393557578D0,  0.0D0,          127.149719D0,   5.25419903D0,
     9 1.11919999D0,   0.472857207D0,  0.308020741D0,  0.0D0,
     * 122.287315D0,   5.05327034D0,   1.07640004D0,   0.454774410D0,
     1 0.296241522D0,  0.0D0,          61.3481522D0,   2.53508544D0,
     2 0.540000021D0,  0.228147700D0,  0.148616150D0,  0.0D0,
     3 60.4847336D0,   2.49940634D0,   0.532400012D0,  0.224936724D0,
     4 0.146524519D0,  0.0D0,          17.1320381D0,   0.707946062D0,
     5 0.150800005D0,  6.371235847D-02,4.150243476D-02,0.0D0,
     6 9.04317188D0,   0.373690367D0,  7.959999889D-02,3.363065794D-02,
     7 2.190712094D-02,0.0D0,          9.04317188D0,   0.373690367D0,
     8 7.959999889D-02,3.363065794D-02,2.190712094D-02,0.0D0/
C * DATA FOR Y  ELEMENT #39
      DATA ((XNRG(39, I, J), J = 1, 6), I = 1, 12)/
     1 363.214050D0,   73.8343048D0,   34.0767975D0,   22.1498070D0,
     2 17.8770123D0,   17.0554371D0,   50.5754852D0,   10.2810059D0,
     3 4.74499989D0,   3.08423448D0,   2.48927188D0,   2.37487245D0,
     4 45.9496155D0,   9.34065723D0,   4.31099987D0,   2.80213594D0,
     5 2.26159143D0,   2.15765548D0,   44.3401527D0,   9.01348495D0,
     6 4.15999985D0,   2.70398617D0,   2.18237543D0,   2.08207989D0,
     7 178.863937D0,   7.39118242D0,   1.57440007D0,   0.665177286D0,
     8 0.433298647D0,  0.0D0,          141.964172D0,   5.86637545D0,
     9 1.24960005D0,   0.527950704D0,  0.343908787D0,  0.0D0,
     * 136.465546D0,   5.63915634D0,   1.20120001D0,   0.507501841D0,
     1 0.330588371D0,  0.0D0,          72.5271454D0,   2.99703431D0,
     2 0.638400018D0,  0.269721270D0,  0.175697312D0,  0.0D0,
     3 71.5273972D0,   2.95572186D0,   0.629599988D0,  0.266003311D0,
     4 0.173275426D0,  0.0D0,          20.6311550D0,   0.852539837D0,
     5 0.181600004D0,  7.672522217D-02,4.997906089D-02,0.0D0,
     6 11.6334267D0,   0.480727285D0,  0.102399997D0,  4.326356202D-02,
     7 2.818202600D-02,0.0D0,          11.6334267D0,   0.480727285D0,
     8 0.102399997D0,  4.326356202D-02,2.818202600D-02,0.0D0/
C * DATA FOR ZR ELEMENT #40
      DATA ((XNRG(40, I, J), J = 1, 6), I = 1, 13)/
     1 383.661713D0,   77.9909134D0,   35.9952011D0,   23.3967628D0,
     2 18.8834229D0,   18.0155983D0,   53.9670830D0,   10.9704514D0,
     3 5.06320000D0,   3.29106331D0,   2.65620255D0,   2.53413153D0,
     4 49.1728020D0,   9.99586868D0,   4.61339998D0,   2.99869490D0,
     5 2.42023325D0,   2.30900669D0,   47.3736153D0,   9.63012886D0,
     6 4.44460011D0,   2.88897538D0,   2.33167934D0,   2.22452235D0,
     7 195.541550D0,   8.08034992D0,   1.72119999D0,   0.727199614D0,
     8 0.473700225D0,  0.0D0,          156.415070D0,   6.46352863D0,
     9 1.37679994D0,   0.581692100D0,  0.378916144D0,  0.0D0,
     * 150.189362D0,   6.20626450D0,   1.32200003D0,   0.558539391D0,
     1 0.363834351D0,  0.0D0,          82.8881683D0,   3.42518210D0,
     2 0.729600012D0,  0.308252901D0,  0.200796947D0,  0.0D0,
     3 81.7975388D0,   3.38011384D0,   0.720000029D0,  0.304196924D0,
     4 0.198154882D0,  0.0D0,          23.3122978D0,   0.963332415D0,
     5 0.205200002D0,  8.669612557D-02,5.647413805D-02,0.0D0,
     6 13.0421619D0,   0.538940370D0,  0.114799999D0,  4.850250855D-02,
     7 3.159469366D-02,0.0D0,          13.0421619D0,   0.538940370D0,
     8 0.114799999D0,  4.850250855D-02,3.159469366D-02,0.0D0,
     9 1.82837915D0,   7.555398345D-02,1.609379798D-02,6.799560972D-03,
     * 4.429256078D-03,0.0D0/
C * DATA FOR NB ELEMENT #41
      DATA ((XNRG(41, I, J), J = 1, 6), I = 1, 13)/
     1 404.723267D0,   82.2723160D0,   37.9711990D0,   24.6811543D0,
     2 19.9200497D0,   19.0045853D0,   57.5079002D0,   11.6902304D0,
     3 5.39540005D0,   3.50699234D0,   2.83047795D0,   2.70039773D0,
     4 52.5409508D0,   10.6805468D0,   4.92939997D0,   3.20409369D0,
     5 2.58600998D0,   2.46716475D0,   50.5328522D0,   10.2723398D0,
     6 4.74100018D0,   3.08163452D0,   2.48717356D0,   2.37287045D0,
     7 212.855362D0,   8.79580784D0,   1.87360001D0,   0.791588008D0,
     8 0.515643001D0,  0.0D0,          171.956589D0,   7.10575056D0,
     9 1.51359999D0,   0.639489532D0,  0.416565567D0,  0.0D0,
     * 164.958359D0,   6.81656265D0,   1.45200002D0,   0.613463819D0,
     1 0.399612308D0,  0.0D0,          94.2489319D0,   3.89464211D0,
     2 0.829599977D0,  0.350502461D0,  0.228318438D0,  0.0D0,
     3 92.9765320D0,   3.84206271D0,   0.818399966D0,  0.345770508D0,
     4 0.225236028D0,  0.0D0,          26.4024258D0,   1.09102559D0,
     5 0.232400000D0,  9.818800539D-02,6.395998597D-02,0.0D0,
     6 15.4052029D0,   0.636588097D0,  0.135600001D0,  5.729041994D-02,
     7 3.731916845D-02,0.0D0,          15.4052029D0,   0.636588097D0,
     8 0.135600001D0,  5.729041994D-02,3.731916845D-02,0.0D0,
     9 1.45417833D0,   6.009091064D-02,1.279999968D-02,5.407945253D-03,
     * 3.522753250D-03,0.0D0/
C * DATA FOR MO ELEMENT #42
      DATA ((XNRG(42, I, J), J = 1, 6), I = 1, 14)/
     1 426.336975D0,   86.6659546D0,   39.9990005D0,   25.9992180D0,
     2 20.9838543D0,   20.0194988D0,   61.0849571D0,   12.4173756D0,
     3 5.73099995D0,   3.72513127D0,   3.00653696D0,   2.86836553D0,
     4 55.9602585D0,   11.3756247D0,   5.25020027D0,   3.41261292D0,
     5 2.75430465D0,   2.62772512D0,   53.7240639D0,   10.9210510D0,
     6 5.04040003D0,   3.27624345D0,   2.64424157D0,   2.52272010D0,
     7 229.305756D0,   9.47558594D0,   2.01839995D0,   0.852765381D0,
     8 0.555494130D0,  0.0D0,          186.180283D0,   7.69351435D0,
     9 1.63880002D0,   0.692385972D0,  0.451022506D0,  0.0D0,
     * 178.273178D0,   7.36677027D0,   1.56920004D0,   0.662980318D0,
     1 0.431867540D0,  0.0D0,          104.655403D0,   4.32466793D0,
     2 0.921200037D0,  0.389203072D0,  0.253528148D0,  0.0D0,
     3 103.155777D0,   4.26269913D0,   0.907999992D0,  0.383626133D0,
     4 0.249895304D0,  0.0D0,          28.0838203D0,   1.16050577D0,
     5 0.247199997D0,  0.104440942D0,  6.803317368D-02,0.0D0,
     6 15.8141899D0,   0.653488696D0,  0.139200002D0,  5.881140754D-02,
     7 3.830994293D-02,0.0D0,          15.8141899D0,   0.653488696D0,
     8 0.139200002D0,  5.881140754D-02,3.830994293D-02,0.0D0,
     9 0.817975342D0,  3.380113840D-02,7.200000342D-03,3.041969379D-03,
     * 1.981548732D-03,0.0D0,          0.817975342D0,  3.380113840D-02,
     1 7.200000342D-03,3.041969379D-03,1.981548732D-03,0.0D0/
C * DATA FOR TC ELEMENT #43
      DATA ((XNRG(43, I, J), J = 1, 6), I = 1, 14)/
     1 448.602966D0,   91.1921997D0,   42.0879974D0,   27.3570614D0,
     2 22.0797634D0,   21.0650425D0,   64.8581314D0,   13.1843891D0,
     3 6.08500004D0,   3.95523000D0,   3.19224858D0,   3.04554248D0,
     4 59.5437088D0,   12.1040707D0,   5.58640003D0,   3.63114166D0,
     5 2.93067837D0,   2.79599309D0,   57.0644989D0,   11.6000948D0,
     6 5.35379982D0,   3.47995234D0,   2.80865407D0,   2.67957687D0,
     7 248.846268D0,   10.2830572D0,   2.19039989D0,   0.925434649D0,
     8 0.602831125D0,  0.0D0,          202.176239D0,   8.35451412D0,
     9 1.77960002D0,   0.751873374D0,  0.489772767D0,  0.0D0,
     * 193.133072D0,   7.98082447D0,   1.70000005D0,   0.718242764D0,
     1 0.467865676D0,  0.0D0,          116.516045D0,   4.81478453D0,
     2 1.02559996D0,   0.433311641D0,  0.282260597D0,  0.0D0,
     3 114.925537D0,   4.74906015D0,   1.01160002D0,   0.427396685D0,
     4 0.278407604D0,  0.0D0,          31.0830631D0,   1.28444326D0,
     5 0.273600012D0,  0.115594834D0,  7.529885322D-02,0.0D0,
     6 17.6773567D0,   0.730480134D0,  0.155599996D0,  6.574033201D-02,
     7 4.282346740D-02,0.0D0,          17.6773567D0,   0.730480134D0,
     8 0.155599996D0,  6.574033201D-02,4.282346740D-02,0.0D0,
     9 3.18627834D0,   0.131666362D0,  2.804632671D-02,1.184945367D-02,
     * 7.718772627D-03,0.0D0,          3.05805564D0,   0.126367822D0,
     1 2.691768296D-02,1.137260627D-02,7.408152800D-03,0.0D0/
C * DATA FOR RU ELEMENT #44
      DATA ((XNRG(44, I, J), J = 1, 6), I = 1, 14)/
     1 471.480804D0,   95.8428116D0,   44.2344017D0,   28.7522144D0,
     2 23.2057858D0,   22.1393166D0,   68.7272339D0,   13.9709015D0,
     3 6.44799995D0,   4.19117880D0,   3.38268185D0,   3.22722387D0,
     4 63.2465363D0,   12.8567829D0,   5.93379974D0,   3.85695052D0,
     5 3.11292768D0,   2.96986675D0,   60.4965973D0,   12.2977743D0,
     6 5.67580032D0,   3.68925142D0,   2.97757840D0,   2.84073806D0,
     7 265.841980D0,   10.9853697D0,   2.33999991D0,   0.988640010D0,
     8 0.644003332D0,  0.0D0,          219.399170D0,   9.06621647D0,
     9 1.93120003D0,   0.815923750D0,  0.531495392D0,  0.0D0,
     * 209.310806D0,   8.64933586D0,   1.84240007D0,   0.778406143D0,
     1 0.507056296D0,  0.0D0,          128.876556D0,   5.32555723D0,
     2 1.13440001D0,   0.479279160D0,  0.312204003D0,  0.0D0,
     3 126.967949D0,   5.24668789D0,   1.11759996D0,   0.472181231D0,
     4 0.307580382D0,  0.0D0,          34.0368614D0,   1.40650296D0,
     5 0.299600005D0,  0.126579717D0,  8.245444298D-02,0.0D0,
     6 19.5859642D0,   0.809349477D0,  0.172399998D0,  7.283826172D-02,
     7 4.744708166D-02,0.0D0,          19.5859642D0,   0.809349477D0,
     8 0.172399998D0,  7.283826172D-02,4.744708166D-02,0.0D0,
     9 0.908861518D0,  3.755681962D-02,8.000000380D-03,3.379965900D-03,
     * 2.201720839D-03,0.0D0,          0.908861518D0,  3.755681962D-02,
     1 8.000000380D-03,3.379965900D-03,2.201720839D-03,0.0D0/
C * DATA FOR RH ELEMENT #45
      DATA ((XNRG(45, I, J), J = 1, 6), I = 1, 14)/
     1 494.987457D0,   100.621262D0,   46.4398003D0,   30.1857166D0,
     2 24.3627586D0,   23.2431202D0,   72.7327728D0,   14.7851486D0,
     3 6.82380009D0,   4.43544769D0,   3.57983017D0,   3.41531181D0,
     4 67.0666122D0,   13.6333294D0,   6.29220009D0,   4.08990955D0,
     5 3.30094767D0,   3.14924622D0,   64.0331497D0,   13.0166855D0,
     6 6.00759983D0,   3.90492010D0,   3.15164375D0,   3.00680375D0,
     7 284.973511D0,   11.7759409D0,   2.50839996D0,   1.05978823D0,
     8 0.690349519D0,  0.0D0,          236.758423D0,   9.78355122D0,
     9 2.08400011D0,   0.880481124D0,  0.573548257D0,  0.0D0,
     * 225.488541D0,   9.31784725D0,   1.98479998D0,   0.838569522D0,
     1 0.546246946D0,  0.0D0,          141.646072D0,   5.85323048D0,
     2 1.24680007D0,   0.526767671D0,  0.343138188D0,  0.0D0,
     3 139.510239D0,   5.76497173D0,   1.22799993D0,   0.518824756D0,
     4 0.337964118D0,  0.0D0,          36.8088913D0,   1.52105117D0,
     5 0.324000001D0,  0.136888623D0,  8.916968852D-02,0.0D0,
     6 21.7672329D0,   0.899485826D0,  0.191599995D0,  8.095017821D-02,
     7 5.273121223D-02,0.0D0,          21.7672329D0,   0.899485826D0,
     8 0.191599995D0,  8.095017821D-02,5.273121223D-02,0.0D0,
     9 1.13607681D0,   4.694602638D-02,9.999999776D-03,4.224957433D-03,
     * 2.752150875D-03,0.0D0,          1.13607681D0,   4.694602638D-02,
     1 9.999999776D-03,4.224957433D-03,2.752150875D-03,0.0D0/
C * DATA FOR PD ELEMENT #46
      DATA ((XNRG(46, I, J), J = 1, 6), I = 1, 14)/
     1 519.084656D0,   105.519745D0,   48.7005997D0,   31.6552315D0,
     2 25.5487976D0,   24.3746510D0,   76.8342361D0,   15.6188955D0,
     3 7.20860004D0,   4.68556643D0,   3.78169966D0,   3.60790420D0,
     4 70.9932785D0,   14.4315434D0,   6.66060019D0,   4.32936811D0,
     5 3.49421382D0,   3.33363032D0,   67.6464462D0,   13.7511978D0,
     6 6.34660006D0,   4.12526894D0,   3.32948637D0,   3.17647314D0,
     7 304.423157D0,   12.5796566D0,   2.67960000D0,   1.13211954D0,
     8 0.737466395D0,  0.0D0,          254.072235D0,   10.4990091D0,
     9 2.23639989D0,   0.944869459D0,  0.615491033D0,  0.0D0,
     * 241.529938D0,   9.98072529D0,   2.12599993D0,   0.898225904D0,
     1 0.585107327D0,  0.0D0,          154.506454D0,   6.38465929D0,
     2 1.36000001D0,   0.574594200D0,  0.374292523D0,  0.0D0,
     3 152.097977D0,   6.28513384D0,   1.33879995D0,   0.565637290D0,
     4 0.368457973D0,  0.0D0,          39.2628174D0,   1.62245464D0,
     5 0.345600009D0,  0.146014526D0,  9.511433542D-02,0.0D0,
     6 23.2214108D0,   0.959576786D0,  0.204400003D0,  8.635812998D-02,
     7 5.625396594D-02,0.0D0,          23.2214108D0,   0.959576786D0,
     8 0.204400003D0,  8.635812998D-02,5.625396594D-02,0.0D0,
     9 2.47511697D0,   0.102279089D0,  2.178652771D-02,9.204714559D-03,
     * 5.995981395D-03,0.0D0,          2.28052115D0,   9.423781186D-02,
     1 2.007365227D-02,8.481032215D-03,5.524571985D-03,0.0D0/
C * DATA FOR AG ELEMENT #47
      DATA ((XNRG(47, I, J), J = 1, 6), I = 1, 14)/
     1 543.891663D0,   110.562531D0,   51.0279999D0,   33.1680336D0,
     2 26.7697716D0,   25.5395145D0,   81.1296921D0,   16.4920769D0,
     3 7.61159992D0,   4.94751501D0,   3.99311733D0,   3.80960584D0,
     4 75.1160583D0,   15.2696238D0,   7.04740000D0,   4.58078671D0,
     5 3.69713283D0,   3.52722383D0,   71.4366760D0,   14.5216780D0,
     6 6.70219994D0,   4.35640812D0,   3.51603746D0,   3.35445118D0,
     7 326.054047D0,   13.4735088D0,   2.86999989D0,   1.21256280D0,
     8 0.789867342D0,  0.0D0,          273.749084D0,   11.3121147D0,
     9 2.40960002D0,   1.01804566D0,   0.663158298D0,  0.0D0,
     * 259.661743D0,   10.7299833D0,   2.28559995D0,   0.965656221D0,
     1 0.629031599D0,  0.0D0,          169.411789D0,   7.00059128D0,
     2 1.49119997D0,   0.630025625D0,  0.410400748D0,  0.0D0,
     3 166.639755D0,   6.88604307D0,   1.46679997D0,   0.619716763D0,
     4 0.403685510D0,  0.0D0,          43.2618065D0,   1.78770459D0,
     5 0.380800009D0,  0.160886377D0,  0.104801908D0,  0.0D0,
     6 28.4473648D0,   1.17552853D0,   0.250400007D0,  0.105792932D0,
     7 6.891386211D-02,0.0D0,          25.4026775D0,   1.04971313D0,
     8 0.223600000D0,  9.447004646D-02,6.153809652D-02,0.0D0,
     9 1.49962151D0,   6.196875498D-02,1.319999993D-02,5.576943979D-03,
     * 3.632839303D-03,0.0D0,          1.49962151D0,   6.196875498D-02,
     1 1.319999993D-02,5.576943979D-03,3.632839303D-03,0.0D0/
C * DATA FOR CD ELEMENT #48
      DATA ((XNRG(48, I, J), J = 1, 6), I = 1, 14)/
     1 569.412842D0,   115.750481D0,   53.4224014D0,   34.7243843D0,
     2 28.0258961D0,   26.7379112D0,   85.6532364D0,   17.4116268D0,
     3 8.03600025D0,   5.22337341D0,   4.21576166D0,   4.02201796D0,
     4 79.4498825D0,   16.1506042D0,   7.45400000D0,   4.84507561D0,
     5 3.91043901D0,   3.73072696D0,   75.4102325D0,   15.3294249D0,
     6 7.07499981D0,   4.59872675D0,   3.71161199D0,   3.54103732D0,
     7 350.002563D0,   14.4631319D0,   3.08080006D0,   1.30162489D0,
     8 0.847882688D0,  0.0D0,          295.698090D0,   12.2191114D0,
     9 2.60279989D0,   1.09967184D0,   0.716329873D0,  0.0D0,
     * 280.156555D0,   11.5768900D0,   2.46600008D0,   1.04187453D0,
     1 0.678680420D0,  0.0D0,          186.543823D0,   7.70853758D0,
     2 1.64199996D0,   0.693737984D0,  0.451903194D0,  0.0D0,
     3 183.453690D0,   7.58084393D0,   1.61479998D0,   0.682246089D0,
     4 0.444417328D0,  0.0D0,          48.8967476D0,   2.02055693D0,
     5 0.430399984D0,  0.181842163D0,  0.118452579D0,  0.0D0,
     6 30.4014168D0,   1.25627565D0,   0.267600000D0,  0.113059856D0,
     7 7.364755869D-02,0.0D0,          30.4014168D0,   1.25627565D0,
     8 0.267600000D0,  0.113059856D0,  7.364755869D-02,0.0D0,
     9 4.22620583D0,   0.174639210D0,  3.720000014D-02,1.571684144D-02,
     * 1.023800205D-02,0.0D0,          4.22620583D0,   0.174639210D0,
     1 3.720000014D-02,1.571684144D-02,1.023800205D-02,0.0D0/
C * DATA FOR IN ELEMENT #49
      DATA ((XNRG(49, I, J), J = 1, 6), I = 1, 14)/
     1 595.605469D0,   121.074936D0,   55.8797989D0,   36.3216858D0,
     2 29.3150711D0,   27.9678402D0,   90.3324051D0,   18.3628082D0,
     3 8.47500038D0,   5.50872231D0,   4.44606543D0,   4.24173737D0,
     4 83.9478455D0,   17.0649548D0,   7.87599993D0,   5.11937428D0,
     5 4.13182449D0,   3.94193816D0,   79.5159683D0,   16.1640396D0,
     6 7.46019983D0,   4.84910536D0,   3.91369152D0,   3.73383021D0,
     7 375.178009D0,   15.5034552D0,   3.30239987D0,   1.39524984D0,
     8 0.908870339D0,  0.0D0,          319.101257D0,   13.1862001D0,
     9 2.80879998D0,   1.18670607D0,   0.773024142D0,  0.0D0,
     * 301.878357D0,   12.4744978D0,   2.65720010D0,   1.12265563D0,
     1 0.731301546D0,  0.0D0,          204.857376D0,   8.46530724D0,
     2 1.80320001D0,   0.761844337D0,  0.496267855D0,  0.0D0,
     3 201.358261D0,   8.32071304D0,   1.77240002D0,   0.748831451D0,
     4 0.487791240D0,  0.0D0,          55.3951073D0,   2.28908825D0,
     5 0.487599999D0,  0.206008926D0,  0.134194881D0,  0.0D0,
     6 35.1729393D0,   1.45344889D0,   0.309599996D0,  0.130804673D0,
     7 8.520659059D-02,0.0D0,          35.1729393D0,   1.45344889D0,
     8 0.309599996D0,  0.130804673D0,  8.520659059D-02,0.0D0,
     9 7.36177778D0,   0.304210246D0,  6.480000168D-02,2.737772278D-02,
     * 1.783393882D-02,0.0D0,          7.36177778D0,   0.304210246D0,
     1 6.480000168D-02,2.737772278D-02,1.783393882D-02,0.0D0/
C * DATA FOR SN ELEMENT #50
      DATA ((XNRG(50, I, J), J = 1, 6), I = 1, 14)/
     1 622.469666D0,   126.535896D0,   58.4001999D0,   37.9599380D0,
     2 30.6372986D0,   29.2293015D0,   95.1757126D0,   19.3473587D0,
     3 8.92940044D0,   5.80408049D0,   4.68444777D0,   4.46916485D0,
     4 88.5971680D0,   18.0100708D0,   8.31220055D0,   5.40290260D0,
     5 4.36065912D0,   4.16025639D0,   83.7517242D0,   17.0250874D0,
     6 7.85760021D0,   5.10741425D0,   4.12217140D0,   3.93272877D0,
     7 401.625885D0,   16.5963593D0,   3.53520012D0,   1.49360693D0,
     8 0.972940385D0,  0.0D0,          343.731415D0,   14.2039890D0,
     9 3.02559996D0,   1.27830303D0,   0.832690775D0,  0.0D0,
     * 324.645325D0,   13.4152966D0,   2.85759997D0,   1.20732379D0,
     1 0.786454678D0,  0.0D0,          224.170685D0,   9.26338959D0,
     2 1.97319996D0,   0.833668590D0,  0.543054461D0,  0.0D0,
     3 220.308029D0,   9.10377312D0,   1.93920004D0,   0.819303751D0,
     4 0.533697128D0,  0.0D0,          62.0297966D0,   2.56325293D0,
     5 0.546000004D0,  0.230682671D0,  0.150267437D0,  0.0D0,
     6 40.2625656D0,   1.66376710D0,   0.354400009D0,  0.149732485D0,
     7 9.753622860D-02,0.0D0,          40.2625656D0,   1.66376710D0,
     8 0.354400009D0,  0.149732485D0,  9.753622860D-02,0.0D0,
     9 10.8608942D0,   0.448803991D0,  9.559999406D-02,4.039059207D-02,
     * 2.631056309D-02,0.0D0,          10.8608942D0,   0.448803991D0,
     1 9.559999406D-02,4.039059207D-02,2.631056309D-02,0.0D0/
C * DATA FOR SB ELEMENT #51
      DATA ((XNRG(51, I, J), J = 1, 6), I = 1, 14)/
     1 649.992554D0,   132.130753D0,   60.9823990D0,   39.6383591D0,
     2 31.9919453D0,   30.5216904D0,   100.155449D0,   20.3596420D0,
     3 9.39659977D0,   6.10775900D0,   4.92954540D0,   4.70299816D0,
     4 93.3786545D0,   18.9820538D0,   8.76080036D0,   5.69449139D0,
     5 4.59599876D0,   4.38478041D0,   88.0876846D0,   17.9065018D0,
     6 8.26440048D0,   5.37183285D0,   4.33558273D0,   4.13633204D0,
     7 428.846283D0,   17.7211857D0,   3.77480006D0,   1.59483683D0,
     8 1.03888190D0,   0.0D0,          368.952332D0,   15.2461910D0,
     9 3.24760008D0,   1.37209713D0,   0.893788576D0,  0.0D0,
     * 347.912170D0,   14.3767509D0,   3.06239986D0,   1.29385090D0,
     1 0.842818737D0,  0.0D0,          243.983871D0,   10.0821285D0,
     2 2.14759994D0,   0.907351851D0,  0.591051936D0,  0.0D0,
     3 239.712219D0,   9.90561104D0,   2.10999990D0,   0.891465962D0,
     4 0.580703855D0,  0.0D0,          69.0734787D0,   2.85431838D0,
     5 0.608000040D0,  0.256877422D0,  0.167330787D0,  0.0D0,
     6 44.7159843D0,   1.84779561D0,   0.393600017D0,  0.166294321D0,
     7 0.108324662D0,  0.0D0,          44.7159843D0,   1.84779561D0,
     8 0.393600017D0,  0.166294321D0,  0.108324662D0,  0.0D0,
     9 14.2691259D0,   0.589642107D0,  0.125599995D0,  5.306546390D-02,
     * 3.456701711D-02,0.0D0,          14.2691259D0,   0.589642107D0,
     1 0.125599995D0,  5.306546390D-02,3.456701711D-02,0.0D0/
C * DATA FOR TE ELEMENT #52
      DATA ((XNRG(52, I, J), J = 1, 6), I = 1, 14)/
     1 678.186890D0,   137.862122D0,   63.6275978D0,   41.3577309D0,
     2 33.3796425D0,   31.8456135D0,   105.290810D0,   21.4035606D0,
     3 9.87839985D0,   6.42092752D0,   5.18230247D0,   4.94413948D0,
     4 98.3157654D0,   19.9856701D0,   9.22399998D0,   5.99556971D0,
     5 4.83899784D0,   4.61661196D0,   92.5472794D0,   18.8130493D0,
     6 8.68280029D0,   5.64379168D0,   4.55507898D0,   4.34574127D0,
     7 21.4452858D0,   4.35940695D0,   2.01200008D0,   1.30779338D0,
     8 1.05551422D0,   1.00700605D0,   395.218414D0,   16.3315830D0,
     9 3.47880006D0,   1.46977818D0,   0.957418263D0,  0.0D0,
     * 372.042450D0,   15.3738842D0,   3.27480006D0,   1.38358903D0,
     1 0.901274383D0,  0.0D0,          264.705902D0,   10.9384241D0,
     2 2.32999992D0,   0.984415054D0,  0.641251206D0,  0.0D0,
     3 259.979828D0,   10.7431288D0,   2.28839993D0,   0.966839254D0,
     4 0.629802227D0,  0.0D0,          76.4806976D0,   3.16040635D0,
     5 0.673200011D0,  0.284424126D0,  0.185274810D0,  0.0D0,
     6 50.0782700D0,   2.06938076D0,   0.440800011D0,  0.186236113D0,
     7 0.121314816D0,  0.0D0,          50.0782700D0,   2.06938076D0,
     8 0.440800011D0,  0.186236113D0,  0.121314816D0,  0.0D0,
     9 18.0863438D0,   0.747380733D0,  0.159199998D0,  6.726132333D-02,
     * 4.381424561D-02,0.0D0,          18.0863438D0,   0.747380733D0,
     1 0.159199998D0,  6.726132333D-02,4.381424561D-02,0.0D0/
C * DATA FOR I  ELEMENT #53
      DATA ((XNRG(53, I, J), J = 1, 6), I = 1, 14)/
     1 707.084778D0,   143.736481D0,   66.3387985D0,   43.1200027D0,
     2 34.8019638D0,   33.2025681D0,   110.596710D0,   22.4821453D0,
     3 10.3761997D0,   6.74449587D0,   5.44345284D0,   5.19328833D0,
     4 103.434067D0,   21.0261211D0,   9.70419979D0,   6.30769825D0,
     5 5.09091520D0,   4.85695219D0,   97.1454391D0,   19.7477665D0,
     6 9.11419964D0,   5.92420006D0,   4.78139591D0,   4.56165695D0,
     7 22.8543644D0,   4.64584494D0,   2.14420009D0,   1.39372301D0,
     8 1.12486768D0,   1.07317209D0,   422.847809D0,   17.4733105D0,
     9 3.72200012D0,   1.57252908D0,   1.02435064D0,   0.0D0,
     * 397.445129D0,   16.4235973D0,   3.49839997D0,   1.47805905D0,
     1 0.962812483D0,  0.0D0,          286.882141D0,   11.8548098D0,
     2 2.52519989D0,   1.06688619D0,   0.694973171D0,  0.0D0,
     3 281.474396D0,   11.6313477D0,   2.47760010D0,   1.04677546D0,
     4 0.681872904D0,  0.0D0,          84.7058945D0,   3.50029564D0,
     5 0.745599985D0,  0.315012813D0,  0.205200374D0,  0.0D0,
     6 55.7586517D0,   2.30411100D0,   0.490799993D0,  0.207360908D0,
     7 0.135075569D0,  0.0D0,          55.7586517D0,   2.30411100D0,
     8 0.490799993D0,  0.207360908D0,  0.135075569D0,  0.0D0,
     9 22.5397644D0,   0.931409121D0,  0.198400006D0,  8.382315189D-02,
     * 5.460267514D-02,0.0D0,          22.5397644D0,   0.931409121D0,
     1 0.198400006D0,  8.382315189D-02,5.460267514D-02,0.0D0/
C * DATA FOR XE ELEMENT #54
      DATA ((XNRG(54, I, J), J = 1, 6), I = 1, 14)/
     1 736.758545D0,   149.768585D0,   69.1228027D0,   44.9295921D0,
     2 36.2624741D0,   34.5959625D0,   116.239418D0,   23.6291981D0,
     3 10.9055996D0,   7.08860397D0,   5.72118092D0,   5.45825291D0,
     4 108.797523D0,   22.1164055D0,   10.2074003D0,   6.63477659D0,
     5 5.35489893D0,   5.10880375D0,   101.943985D0,   20.7232151D0,
     6 9.56439972D0,   6.21682882D0,   5.01757479D0,   4.78698206D0,
     7 24.3998737D0,   4.96001673D0,   2.28920007D0,   1.48797250D0,
     8 1.20093596D0,   1.14574456D0,   453.976318D0,   18.7596321D0,
     9 3.99600005D0,   1.68829298D0,   1.09975958D0,   0.0D0,
     * 425.801605D0,   17.5953712D0,   3.74799991D0,   1.58351398D0,
     1 1.03150618D0,   0.0D0,          311.466827D0,   12.8707218D0,
     2 2.74160004D0,   1.15831435D0,   0.754529715D0,  0.0D0,
     3 305.513794D0,   12.6247253D0,   2.68919992D0,   1.13617551D0,
     4 0.740108430D0,  0.0D0,          94.5670395D0,   3.90778708D0,
     5 0.832399964D0,  0.351685435D0,  0.229089037D0,  0.0D0,
     6 66.6649857D0,   2.75479269D0,   0.586799979D0,  0.247920483D0,
     7 0.161496207D0,  0.0D0,          66.6649857D0,   2.75479269D0,
     8 0.586799979D0,  0.247920483D0,  0.161496207D0,  0.0D0,
     9 29.0835686D0,   1.20181823D0,   0.256000012D0,  0.108158909D0,
     * 7.045506686D-02,0.0D0,          29.0835686D0,   1.20181823D0,
     1 0.256000012D0,  0.108158909D0,  7.045506686D-02,0.0D0/
C * DATA FOR CS ELEMENT #55
      DATA ((XNRG(55, I, J), J = 1, 6), I = 1, 17)/
     1 767.097412D0,   155.935883D0,   71.9692001D0,   46.7797432D0,
     2 37.7557220D0,   36.0205841D0,   121.813911D0,   24.7623844D0,
     3 11.4286003D0,   7.42855263D0,   5.99555159D0,   5.72001410D0,
     4 114.248375D0,   23.2244568D0,   10.7187996D0,   6.96718454D0,
     5 5.62318373D0,   5.36475945D0,   106.840584D0,   21.7185993D0,
     6 10.0237999D0,   6.51543713D0,   5.25858068D0,   5.01691198D0,
     7 25.9453850D0,   5.27418900D0,   2.43420005D0,   1.58222198D0,
     8 1.27700436D0,   1.21831715D0,   22.7030106D0,   4.61507750D0,
     9 2.12999988D0,   1.38449299D0,   1.11741817D0,   1.06606495D0,
     * 453.340118D0,   18.7333412D0,   3.99040008D0,   1.68592691D0,
     1 1.09821832D0,   0.0D0,          336.051544D0,   13.8866339D0,
     2 2.95799994D0,   1.24974239D0,   0.814086258D0,  0.0D0,
     3 329.689514D0,   13.6237364D0,   2.90199995D0,   1.22608256D0,
     4 0.798674226D0,  0.0D0,          104.882614D0,   4.33405685D0,
     5 0.923200011D0,  0.390048057D0,  0.254078567D0,  0.0D0,
     6 78.2984161D0,   3.23551989D0,   0.689199984D0,  0.291184038D0,
     7 0.189678237D0,  0.0D0,          73.4360123D0,   3.03459120D0,
     8 0.646400034D0,  0.273101240D0,  0.177899033D0,  0.0D0,
     9 35.8091431D0,   1.47973871D0,   0.315200001D0,  0.133170649D0,
     * 8.674779534D-02,0.0D0,          34.7639503D0,   1.43654835D0,
     1 0.305999994D0,  0.129283696D0,  8.421581984D-02,0.0D0,
     2 10.3155775D0,   0.426269919D0,  9.080000222D-02,3.836261109D-02,
     3 2.498953044D-02,0.0D0,          5.95304298D0,   0.245997176D0,
     4 5.240000039D-02,2.213877626D-02,1.442127116D-02,0.0D0,
     5 5.18051052D0,   0.214073882D0,  4.560000077D-02,1.926580630D-02,
     6 1.254980825D-02,0.0D0/
C * DATA FOR BA ELEMENT #56
      DATA ((XNRG(56, I, J), J = 1, 6), I = 1, 17)/
     1 798.135559D0,   162.245331D0,   74.8811951D0,   48.6725349D0,
     2 39.2833862D0,   37.4780388D0,   127.665535D0,   25.9519043D0,
     3 11.9776001D0,   7.78540087D0,   6.28356218D0,   5.99478865D0,
     4 119.880424D0,   24.3693428D0,   11.2472000D0,   7.31064320D0,
     5 5.90038776D0,   5.62922382D0,   111.852303D0,   22.7373829D0,
     6 10.4940004D0,   6.82106543D0,   5.50525188D0,   5.25224686D0,
     7 27.5591106D0,   5.60222769D0,   2.58559990D0,   1.68063152D0,
     8 1.35643029D0,   1.29409277D0,   24.2314682D0,   4.92578316D0,
     9 2.27340007D0,   1.47770250D0,   1.19264722D0,   1.13783669D0,
     * 22.6433220D0,   4.60294437D0,   2.12439990D0,   1.38085306D0,
     1 1.11448038D0,   1.06326222D0,   361.772308D0,   14.9494925D0,
     2 3.18440008D0,   1.34539545D0,   0.876394928D0,  0.0D0,
     3 354.774078D0,   14.6603050D0,   3.12279987D0,   1.31936967D0,
     4 0.859441698D0,  0.0D0,          114.970978D0,   4.75093746D0,
     5 1.01199996D0,   0.427565664D0,  0.278517663D0,  0.0D0,
     6 87.1598129D0,   3.60169911D0,   0.767199993D0,  0.324138731D0,
     7 0.211145014D0,  0.0D0,          81.6612015D0,   3.37448025D0,
     8 0.718800008D0,  0.303689927D0,  0.197824612D0,  0.0D0,
     9 42.0348434D0,   1.73700297D0,   0.370000005D0,  0.156323418D0,
     * 0.101829588D0,  0.0D0,          40.8533249D0,   1.68817914D0,
     1 0.359600008D0,  0.151929468D0,  9.896735102D-02,0.0D0,
     2 17.7682419D0,   0.734235823D0,  0.156399995D0,  6.607833505D-02,
     3 4.304363951D-02,0.0D0,          7.54355049D0,   0.311721623D0,
     4 6.639999896D-02,2.805371769D-02,1.827428304D-02,0.0D0,
     5 6.63468933D0,   0.274164796D0,  5.840000138D-02,2.467375249D-02,
     6 1.607256196D-02,0.0D0/
C * DATA FOR LA ELEMENT #57
      DATA ((XNRG(57, I, J), J = 1, 6), I = 1, 17)/
     1 829.770569D0,   168.676102D0,   77.8491974D0,   50.6017227D0,
     2 40.8404274D0,   38.9635239D0,   133.581100D0,   27.1544247D0,
     3 12.5326004D0,   8.14614868D0,   6.57472086D0,   6.27256632D0,
     4 125.572166D0,   25.5263634D0,   11.7812004D0,   7.65774155D0,
     5 6.18052912D0,   5.89649057D0,   116.876808D0,   23.7587662D0,
     6 10.9653997D0,   7.12747383D0,   5.75255251D0,   5.48818254D0,
     7 29.0193520D0,   5.89906597D0,   2.72259998D0,   1.76968110D0,
     8 1.42830181D0,   1.36266136D0,   25.6746540D0,   5.21915436D0,
     9 2.40880013D0,   1.56571209D0,   1.26367927D0,   1.20560443D0,
     * 23.9479465D0,   4.86814880D0,   2.24679995D0,   1.46041262D0,
     1 1.17869258D0,   1.12452340D0,   385.584503D0,   15.9334812D0,
     2 3.39400005D0,   1.43395054D0,   0.934080064D0,  0.0D0,
     3 377.950043D0,   15.6180038D0,   3.32679987D0,   1.40555882D0,
     4 0.915585577D0,  0.0D0,          122.878075D0,   5.07768202D0,
     5 1.08159995D0,   0.456971377D0,  0.297672659D0,  0.0D0,
     6 93.5218506D0,   3.86459684D0,   0.823199987D0,  0.347798496D0,
     7 0.226557061D0,  0.0D0,          86.9780426D0,   3.59418774D0,
     8 0.765600026D0,  0.323462725D0,  0.210704684D0,  0.0D0,
     9 44.9431992D0,   1.85718477D0,   0.395599991D0,  0.167139307D0,
     * 0.108875088D0,  0.0D0,          44.9431992D0,   1.85718477D0,
     1 0.395599991D0,  0.167139307D0,  0.108875088D0,  0.0D0,
     2 14.6781130D0,   0.606542647D0,  0.129199997D0,  5.458644778D-02,
     3 3.555779159D-02,0.0D0,          6.54380274D0,   0.270409107D0,
     4 5.759999901D-02,2.433575504D-02,1.585238986D-02,0.0D0,
     5 6.54380274D0,   0.270409107D0,  5.759999901D-02,2.433575504D-02,
     6 1.585238986D-02,0.0D0/
C * DATA FOR CE ELEMENT #58
      DATA ((XNRG(58, I, J), J = 1, 6), I = 1, 18)/
     1 862.138855D0,   175.255951D0,   80.8860016D0,   52.5756340D0,
     2 42.4335632D0,   40.4834442D0,   139.603271D0,   28.3786106D0,
     3 13.0976000D0,   8.51339722D0,   6.87112522D0,   6.55534887D0,
     4 131.404602D0,   26.7119827D0,   12.3283997D0,   8.01341915D0,
     5 6.46759558D0,   6.17036438D0,   122.007904D0,   24.8018188D0,
     6 11.4468002D0,   7.44038248D0,   6.00509977D0,   5.72912359D0,
     7 30.5819168D0,   6.21670485D0,   2.86919999D0,   1.86497056D0,
     8 1.50520957D0,   1.43603468D0,   27.1327629D0,   5.51555967D0,
     9 2.54559994D0,   1.65463161D0,   1.33544588D0,   1.27407277D0,
     * 25.2696247D0,   5.13681984D0,   2.37080002D0,   1.54101217D0,
     1 1.24374413D0,   1.18658543D0,   409.578430D0,   16.9249802D0,
     2 3.60520005D0,   1.52318156D0,   0.992205441D0,  0.0D0,
     3 401.398682D0,   16.5869694D0,   3.53320003D0,   1.49276197D0,
     4 0.972389996D0,  0.0D0,          131.603149D0,   5.43822765D0,
     5 1.15839994D0,   0.489419043D0,  0.318809152D0,  0.0D0,
     6 101.474380D0,   4.19321871D0,   0.893199980D0,  0.377373189D0,
     7 0.245822117D0,  0.0D0,          94.1580505D0,   3.89088655D0,
     8 0.828800023D0,  0.350164473D0,  0.228098273D0,  0.0D0,
     9 49.9873810D0,   2.06562519D0,   0.439999998D0,  0.185898125D0,
     * 0.121094644D0,  0.0D0,          49.9873810D0,   2.06562519D0,
     1 0.439999998D0,  0.185898125D0,  0.121094644D0,  0.0D0,
     2 39.0356026D0,   1.61306536D0,   0.343600005D0,  0.145169526D0,
     3 9.456390887D-02,0.0D0,          17.1774826D0,   0.709823906D0,
     4 0.151199996D0,  6.388135254D-02,4.161252454D-02,0.0D0,
     5 8.99772835D0,   0.371812522D0,  7.919999957D-02,3.346166015D-02,
     6 2.179703489D-02,0.0D0,          8.99772835D0,   0.371812522D0,
     7 7.919999957D-02,3.346166015D-02,2.179703489D-02,0.0D0/
C * DATA FOR PR ELEMENT #59
      DATA ((XNRG(59, I, J), J = 1, 6), I = 1, 18)/
     1 895.129639D0,   181.962326D0,   83.9812012D0,   54.5875053D0,
     2 44.0573349D0,   42.0325928D0,   145.700043D0,   29.6179657D0,
     3 13.6696005D0,   8.88519478D0,   7.17120171D0,   6.84163475D0,
     4 137.292465D0,   27.9088688D0,   12.8808002D0,   8.37247753D0,
     5 6.75738955D0,   6.44684029D0,   127.143257D0,   25.8457355D0,
     6 11.9286003D0,   7.75355101D0,   6.25785637D0,   5.97026443D0,
     7 32.2105637D0,   6.54777670D0,   3.02199984D0,   1.96429002D0,
     8 1.58536983D0,   1.51251101D0,   28.5098667D0,   5.79549742D0,
     9 2.67479992D0,   1.73861122D0,   1.40322542D0,   1.33873737D0,
     * 26.4804516D0,   5.38295746D0,   2.48440003D0,   1.61485183D0,
     1 1.30333972D0,   1.24344218D0,   432.209076D0,   17.8601456D0,
     2 3.80439997D0,   1.60734272D0,   1.04702830D0,   0.0D0,
     3 423.075012D0,   17.4827003D0,   3.72399998D0,   1.57337415D0,
     4 1.02490103D0,   0.0D0,          138.374161D0,   5.71802616D0,
     5 1.21800005D0,   0.514599800D0,  0.335211992D0,  0.0D0,
     6 107.381989D0,   4.43733835D0,   0.945200026D0,  0.399342954D0,
     7 0.260133296D0,  0.0D0,          98.8841324D0,   4.08618212D0,
     8 0.870400012D0,  0.367740303D0,  0.239547223D0,  0.0D0,
     9 51.4415588D0,   2.12571597D0,   0.452800006D0,  0.191306069D0,
     * 0.124617398D0,  0.0D0,          51.4415588D0,   2.12571597D0,
     1 0.452800006D0,  0.191306069D0,  0.124617398D0,  0.0D0,
     2 1.59050763D0,   6.572443992D-02,1.400000043D-02,5.914940499D-03,
     3 3.853011411D-03,0.0D0,          16.9957104D0,   0.702312529D0,
     4 0.149599999D0,  6.320536137D-02,4.117217660D-02,0.0D0,
     5 10.1338062D0,   0.418758541D0,  8.919999748D-02,3.768661991D-02,
     6 2.454918623D-02,0.0D0,          10.1338062D0,   0.418758541D0,
     7 8.919999748D-02,3.768661991D-02,2.454918623D-02,0.0D0/
C * DATA FOR ND ELEMENT #60
      DATA ((XNRG(60, I, J), J = 1, 6), I = 1, 18)/
     1 928.774841D0,   188.801743D0,   87.1378021D0,   56.6392822D0,
     2 45.7133141D0,   43.6124687D0,   151.907654D0,   30.8798542D0,
     3 14.2519999D0,   9.26375294D0,   7.47673416D0,   7.13312626D0,
     4 143.284775D0,   29.1269913D0,   13.4429998D0,   8.73790550D0,
     5 7.05232525D0,   6.72822142D0,   132.336166D0,   26.9013538D0,
     6 12.4158001D0,   8.07022953D0,   6.51344633D0,   6.21410799D0,
     7 33.5812721D0,   6.82641506D0,   3.15060019D0,   2.04787970D0,
     8 1.65283465D0,   1.57687533D0,   29.9040222D0,   6.07890224D0,
     9 2.80559993D0,   1.82363081D0,   1.47184432D0,   1.40420282D0,
     * 27.6571712D0,   5.62216139D0,   2.59480000D0,   1.68661153D0,
     1 1.36125672D0,   1.29869735D0,   454.203522D0,   18.7690201D0,
     2 3.99799991D0,   1.68913794D0,   1.10030997D0,   0.0D0,
     3 444.296936D0,   18.3596516D0,   3.91079998D0,   1.65229630D0,
     4 1.07631123D0,   0.0D0,          143.236572D0,   5.91895485D0,
     5 1.26080000D0,   0.532682598D0,  0.346991181D0,  0.0D0,
     6 110.562996D0,   4.56878710D0,   0.973199964D0,  0.411172837D0,
     7 0.267839313D0,  0.0D0,          102.065147D0,   4.21763086D0,
     8 0.898400009D0,  0.379570156D0,  0.247253239D0,  0.0D0,
     9 53.3956108D0,   2.20646310D0,   0.469999999D0,  0.198572993D0,
     * 0.129351094D0,  0.0D0,          53.3956108D0,   2.20646310D0,
     1 0.469999999D0,  0.198572993D0,  0.129351094D0,  0.0D0,
     2 1.36329222D0,   5.633522943D-02,1.200000010D-02,5.069948733D-03,
     3 3.302581143D-03,0.0D0,          17.0411530D0,   0.704190373D0,
     4 0.149999991D0,  6.337435544D-02,4.128226265D-02,0.0D0,
     5 9.58848858D0,   0.396224469D0,  8.440000564D-02,3.565864265D-02,
     6 2.322815545D-02,0.0D0,          9.58848858D0,   0.396224469D0,
     7 8.440000564D-02,3.565864265D-02,2.322815545D-02,0.0D0/
C * DATA FOR PM ELEMENT #61
      DATA ((XNRG(61, I, J), J = 1, 6), I = 1, 18)/
     1 963.204529D0,   195.800629D0,   90.3680038D0,   58.7389030D0,
     2 47.4079094D0,   45.2291832D0,   158.343384D0,   32.1881104D0,
     3 14.8557997D0,   9.65622139D0,   7.79349327D0,   7.43532801D0,
     4 149.494537D0,   30.3893108D0,   14.0255995D0,   9.11659431D0,
     5 7.35796261D0,   7.01981258D0,   137.695358D0,   27.9907703D0,
     6 12.9186001D0,   8.39704800D0,   6.77721977D0,   6.46575928D0,
     7 35.0990677D0,   7.13495350D0,   3.29299998D0,   2.14043927D0,
     8 1.72753906D0,   1.64814651D0,   31.3663960D0,   6.37617397D0,
     9 2.94280005D0,   1.91281044D0,   1.54382074D0,   1.47287142D0,
     * 28.9255543D0,   5.87999916D0,   2.71379995D0,   1.76396108D0,
     1 1.42368519D0,   1.35825694D0,   22.4152260D0,   4.55657673D0,
     2 2.10299993D0,   1.36694312D0,   1.10325372D0,   1.05255151D0,
     3 21.8908195D0,   4.44997501D0,   2.05380011D0,   1.33496320D0,
     4 1.07744288D0,   1.02792692D0,   150.143921D0,   6.20438671D0,
     5 1.32159996D0,   0.558370352D0,  0.363724262D0,  0.0D0,
     6 115.607178D0,   4.77722740D0,   1.01760006D0,   0.429931641D0,
     7 0.280058891D0,  0.0D0,          107.245651D0,   4.43170452D0,
     8 0.944000006D0,  0.398835957D0,  0.259803057D0,  0.0D0,
     9 54.7134628D0,   2.26092052D0,   0.481599987D0,  0.203473940D0,
     * 0.132543594D0,  0.0D0,          54.7134628D0,   2.26092052D0,
     1 0.481599987D0,  0.203473940D0,  0.132543594D0,  0.0D0,
     2 1.81772292D0,   7.511363924D-02,1.599999890D-02,6.759931799D-03,
     3 4.403441679D-03,0.0D0,          17.0411530D0,   0.704190373D0,
     4 0.149999991D0,  6.337435544D-02,4.128226265D-02,0.0D0,
     5 9.58848858D0,   0.396224469D0,  8.440000564D-02,3.565864265D-02,
     6 2.322815545D-02,0.0D0,          9.58848858D0,   0.396224469D0,
     7 8.440000564D-02,3.565864265D-02,2.322815545D-02,0.0D0/
C * DATA FOR SM ELEMENT #62
      DATA ((XNRG(62, I, J), J = 1, 6), I = 1, 18)/
     1 998.382507D0,   202.951614D0,   93.6684036D0,   60.8841515D0,
     2 49.1393318D0,   46.8810349D0,   164.928314D0,   33.5266991D0,
     3 15.4736004D0,   10.0577888D0,   8.11759758D0,   7.74453688D0,
     4 155.868423D0,   31.6849995D0,   14.6236000D0,   9.50529194D0,
     5 7.67167902D0,   7.31911182D0,   143.171799D0,   29.1040230D0,
     6 13.4323997D0,   8.73101616D0,   7.04676437D0,   6.72291613D0,
     7 36.7255821D0,   7.46559238D0,   3.44560003D0,   2.23962855D0,
     8 1.80759430D0,   1.72452271D0,   32.8436890D0,   6.67647886D0,
     9 3.08139992D0,   2.00289989D0,   1.61653161D0,   1.54224062D0,
     * 30.2664165D0,   6.15257025D0,   2.83959985D0,   1.84573066D0,
     1 1.48968101D0,   1.42121983D0,   23.5770245D0,   4.79274750D0,
     2 2.21199989D0,   1.43779278D0,   1.16043615D0,   1.10710597D0,
     3 23.0270348D0,   4.68094540D0,   2.16039991D0,   1.40425289D0,
     4 1.13336635D0,   1.08128023D0,   157.096710D0,   6.49169636D0,
     5 1.38279998D0,   0.584227085D0,  0.380567431D0,  0.0D0,
     6 120.696808D0,   4.98754597D0,   1.06239998D0,   0.448859483D0,
     7 0.292388529D0,  0.0D0,          112.426170D0,   4.64577866D0,
     8 0.989600003D0,  0.418101788D0,  0.272352874D0,  0.0D0,
     9 58.6215668D0,   2.42241502D0,   0.515999973D0,  0.218007803D0,
     * 0.142010987D0,  0.0D0,          58.6215668D0,   2.42241502D0,
     1 0.515999973D0,  0.218007803D0,  0.142010987D0,  0.0D0,
     2 2.49936914D0,   0.103281252D0,  2.199999988D-02,9.294905700D-03,
     3 6.054732017D-03,0.0D0,          16.9957104D0,   0.702312529D0,
     4 0.149599999D0,  6.320536137D-02,4.117217660D-02,0.0D0,
     5 9.67937469D0,   0.399980128D0,  8.519999683D-02,3.599663451D-02,
     6 2.344832569D-02,0.0D0,          9.67937469D0,   0.399980128D0,
     7 8.519999683D-02,3.599663451D-02,2.344832569D-02,0.0D0/
C * DATA FOR EU ELEMENT #63
      DATA ((XNRG(63, I, J), J = 1, 6), I = 1, 18)/
     1 1034.29797D0,   210.252533D0,   97.0380020D0,   63.0743828D0,
     2 50.9070549D0,   48.5675201D0,   171.647552D0,   34.8925858D0,
     3 16.1040001D0,   10.4675474D0,   8.44831085D0,   8.06005192D0,
     4 162.376633D0,   33.0079880D0,   15.2342005D0,   9.90217972D0,
     5 7.99200583D0,   7.62471724D0,   148.729233D0,   30.2337418D0,
     6 13.9538002D0,   9.06992435D0,   7.32029581D0,   6.98387671D0,
     7 38.3712883D0,   7.80013180D0,   3.60000014D0,   2.33998823D0,
     8 1.88859415D0,   1.80180001D0,   34.4041214D0,   6.99368429D0,
     9 3.22779989D0,   2.09805942D0,   1.69333446D0,   1.61551392D0,
     * 31.5625134D0,   6.41604137D0,   2.96120000D0,   1.92477024D0,
     1 1.55347359D0,   1.48208058D0,   24.7409534D0,   5.02935123D0,
     2 2.32119989D0,   1.50877237D0,   1.21772349D0,   1.16176057D0,
     3 24.1078262D0,   4.90064907D0,   2.26180005D0,   1.47016263D0,
     4 1.18656170D0,   1.13203084D0,   163.685959D0,   6.76398325D0,
     5 1.44079995D0,   0.608731866D0,  0.396529913D0,  0.0D0,
     6 129.012894D0,   5.33119059D0,   1.13559997D0,   0.479786158D0,
     7 0.312534273D0,  0.0D0,          116.606926D0,   4.81854010D0,
     8 1.02639997D0,   0.433649600D0,  0.282480776D0,  0.0D0,
     9 60.5301743D0,   2.50128436D0,   0.532800019D0,  0.225105733D0,
     * 0.146634609D0,  0.0D0,          60.5301743D0,   2.50128436D0,
     1 0.532800019D0,  0.225105733D0,  0.146634609D0,  0.0D0,
     2 1.32307839D0,   5.467347428D-02,1.164602861D-02,4.920397419D-03,
     3 3.205162939D-03,0.0D0,          14.4508972D0,   0.597153425D0,
     4 0.127199993D0,  5.374145508D-02,3.500736132D-02,0.0D0,
     5 9.99747658D0,   0.413125038D0,  8.799999952D-02,3.717962652D-02,
     6 2.421892807D-02,0.0D0,          9.99747658D0,   0.413125038D0,
     7 8.799999952D-02,3.717962652D-02,2.421892807D-02,0.0D0/
C * DATA FOR GD ELEMENT #64
      DATA ((XNRG(64, I, J), J = 1, 6), I = 1, 19)/
     1 1070.96606D0,   217.706436D0,   100.478195D0,   65.3105011D0,
     2 52.7118149D0,   50.2893372D0,   178.545853D0,   36.2948761D0,
     3 16.7511997D0,   10.8882246D0,   8.78783798D0,   8.38397598D0,
     4 169.053223D0,   34.3652115D0,   15.8606005D0,   10.3093376D0,
     5 8.32062054D0,   7.93823051D0,   154.397522D0,   31.3859959D0,
     6 14.4855995D0,   9.41559219D0,   7.59928274D0,   7.25004292D0,
     7 40.0937309D0,   8.15027046D0,   3.76160002D0,   2.44502759D0,
     8 1.97337091D0,   1.88268077D0,   35.9901352D0,   7.31609011D0,
     9 3.37660003D0,   2.19477892D0,   1.77139640D0,   1.68998826D0,
     * 32.9140358D0,   6.69077969D0,   3.08800006D0,   2.00718999D0,
     1 1.61999404D0,   1.54554403D0,   25.9475174D0,   5.27462196D0,
     2 2.43440008D0,   1.58235204D0,   1.27710927D0,   1.21841717D0,
     3 25.2653599D0,   5.13595295D0,   2.37039995D0,   1.54075217D0,
     4 1.24353433D0,   1.18638515D0,   170.775070D0,   7.05692673D0,
     5 1.50319993D0,   0.635095596D0,  0.413703322D0,  0.0D0,
     6 131.103271D0,   5.41757154D0,   1.15400004D0,   0.487560064D0,
     7 0.317598224D0,  0.0D0,          123.105293D0,   5.08707142D0,
     8 1.08360004D0,   0.457816362D0,  0.298223078D0,  0.0D0,
     9 63.8475227D0,   2.63836670D0,   0.562000036D0,  0.237442613D0,
     * 0.154670894D0,  0.0D0,          63.8475227D0,   2.63836670D0,
     1 0.562000036D0,  0.237442613D0,  0.154670894D0,  0.0D0,
     2 4.21684551D0,   0.174252421D0,  3.711760789D-02,1.568203233D-02,
     3 1.021532621D-02,0.0D0,          3.87365603D0,   0.160070822D0,
     4 3.409677744D-02,1.440574322D-02,9.383948520D-03,0.0D0,
     5 16.4049511D0,   0.677900612D0,  0.144400001D0,  6.100838631D-02,
     6 3.974106163D-02,0.0D0,          9.22494411D0,   0.381201744D0,
     7 8.120000362D-02,3.430665284D-02,2.234746702D-02,0.0D0,
     8 9.22494411D0,   0.381201744D0,  8.120000362D-02,3.430665284D-02,
     9 2.234746702D-02,0.0D0/
C * DATA FOR TB ELEMENT #65
      DATA ((XNRG(65, I, J), J = 1, 6), I = 1, 19)/
     1 1108.41211D0,   225.318497D0,   103.991402D0,   67.5940704D0,
     2 54.5548744D0,   52.0476952D0,   185.631760D0,   37.7353020D0,
     3 17.4160004D0,   11.3203430D0,   9.13659859D0,   8.71670818D0,
     4 175.902496D0,   35.7575340D0,   16.5032005D0,   10.7270260D0,
     5 8.65773487D0,   8.25985146D0,   160.178802D0,   32.5612144D0,
     6 15.0279999D0,   9.76815033D0,   7.88383102D0,   7.52151394D0,
     7 41.9419479D0,   8.52597713D0,   3.93499994D0,   2.55773711D0,
     8 2.06433821D0,   1.96946752D0,   37.6827354D0,   7.66016245D0,
     9 3.53539991D0,   2.29799843D0,   1.85470438D0,   1.76946771D0,
     * 34.3486977D0,   6.98241758D0,   3.22259998D0,   2.09467959D0,
     1 1.69060647D0,   1.61291134D0,   27.1796608D0,   5.52509308D0,
     2 2.54999995D0,   1.65749156D0,   1.33775413D0,   1.27627504D0,
     3 26.4591331D0,   5.37862396D0,   2.48239994D0,   1.61355186D0,
     4 1.30229056D0,   1.24244118D0,   180.817993D0,   7.47192955D0,
     5 1.59160006D0,   0.672444224D0,  0.438032359D0,  0.0D0,
     6 140.964417D0,   5.82506275D0,   1.24080002D0,   0.524232686D0,
     7 0.341486901D0,  0.0D0,          129.512772D0,   5.35184717D0,
     8 1.13999999D0,   0.481645137D0,  0.313745201D0,  0.0D0,
     9 66.8013229D0,   2.76042628D0,   0.588000000D0,  0.248427495D0,
     * 0.161826476D0,  0.0D0,          66.8013229D0,   2.76042628D0,
     1 0.588000000D0,  0.248427495D0,  0.161826476D0,  0.0D0,
     2 4.27164888D0,   0.176517054D0,  3.759999946D-02,1.588583924D-02,
     3 1.034808718D-02,0.0D0,          3.90810442D0,   0.161494330D0,
     4 3.440000117D-02,1.453385316D-02,9.467399679D-03,0.0D0,
     5 17.7227993D0,   0.732357979D0,  0.156000003D0,  6.590933353D-02,
     6 4.293355718D-02,0.0D0,          11.5425415D0,   0.476971626D0,
     7 0.101599999D0,  4.292556643D-02,2.796185389D-02,0.0D0,
     8 11.5425415D0,   0.476971626D0,  0.101599999D0,  4.292556643D-02,
     9 2.796185389D-02,0.0D0/
C * DATA FOR DY ELEMENT #66
      DATA ((XNRG(66, I, J), J = 1, 6), I = 1, 19)/
     1 1146.63000D0,   233.087433D0,   107.577003D0,   69.9246979D0,
     2 56.4359131D0,   53.8422890D0,   192.832764D0,   39.1991272D0,
     3 18.0916004D0,   11.7594805D0,   9.49102497D0,   9.05484581D0,
     4 182.915924D0,   37.1832275D0,   17.1611996D0,   11.1547232D0,
     5 9.00292778D0,   8.58918095D0,   166.064529D0,   33.7576675D0,
     6 15.5802002D0,   10.1270790D0,   8.17352009D0,   7.79789019D0,
     7 43.6324158D0,   8.86961651D0,   4.09359980D0,   2.66082668D0,
     8 2.14754128D0,   2.04884672D0,   39.2623520D0,   7.98126793D0,
     9 3.68360019D0,   2.39432788D0,   1.93245149D0,   1.84364188D0,
     * 35.7194023D0,   7.26105547D0,   3.35119987D0,   2.17826891D0,
     1 1.75807130D0,   1.67727554D0,   28.4054108D0,   5.77426386D0,
     2 2.66499996D0,   1.73224127D0,   1.39808428D0,   1.33383250D0,
     3 27.6038780D0,   5.61132765D0,   2.58980012D0,   1.68336153D0,
     4 1.35863364D0,   1.29619491D0,   189.179520D0,   7.81745195D0,
     5 1.66520000D0,   0.703539908D0,  0.458288163D0,  0.0D0,
     6 150.780121D0,   6.23067665D0,   1.32720006D0,   0.560736358D0,
     7 0.365265489D0,  0.0D0,          133.102768D0,   5.50019646D0,
     8 1.17159998D0,   0.494996011D0,  0.322442025D0,  0.0D0,
     9 70.0732193D0,   2.89563084D0,   0.616800010D0,  0.260595351D0,
     * 0.169752672D0,  0.0D0,          70.0732193D0,   2.89563084D0,
     1 0.616800010D0,  0.260595351D0,  0.169752672D0,  0.0D0,
     2 1.90860915D0,   7.886932045D-02,1.679999940D-02,7.097928319D-03,
     3 4.623613786D-03,0.0D0,          1.90860915D0,   7.886932045D-02,
     4 1.679999940D-02,7.097928319D-03,4.623613786D-03,0.0D0,
     5 28.5836945D0,   1.18116200D0,   0.251599997D0,  0.106299929D0,
     6 6.924411654D-02,0.0D0,          11.9515285D0,   0.493872195D0,
     7 0.105200000D0,  4.444655031D-02,2.895262837D-02,0.0D0,
     8 11.9515285D0,   0.493872195D0,  0.105200000D0,  4.444655031D-02,
     9 2.895262837D-02,0.0D0/
C * DATA FOR HO ELEMENT #67
      DATA ((XNRG(67, I, J), J = 1, 6), I = 1, 19)/
     1 1185.62378D0,   241.014099D0,   111.235397D0,   72.3026428D0,
     2 58.3551445D0,   55.6733170D0,   200.259750D0,   40.7088852D0,
     3 18.7884007D0,   12.2123985D0,   9.85657215D0,   9.40359402D0,
     4 190.104141D0,   38.6444511D0,   17.8355999D0,   11.5930815D0,
     5 9.35672474D0,   8.92671776D0,   172.054718D0,   34.9753571D0,
     6 16.1422005D0,   10.4923773D0,   8.46835136D0,   8.07917118D0,
     7 45.3697853D0,   9.22278881D0,   4.25659990D0,   2.76677608D0,
     8 2.23305273D0,   2.13042831D0,   40.9890594D0,   8.33227348D0,
     9 3.84559989D0,   2.49962735D0,   2.01743817D0,   1.92472279D0,
     * 37.1178246D0,   7.54532671D0,   3.48239994D0,   2.26354861D0,
     1 1.82690001D0,   1.74294114D0,   29.6631374D0,   6.02993488D0,
     2 2.78299999D0,   1.80894089D0,   1.45998824D0,   1.39289153D0,
     3 28.8083096D0,   5.85616541D0,   2.70280004D0,   1.75681114D0,
     4 1.41791451D0,   1.35275137D0,   197.995483D0,   8.18175316D0,
     5 1.74280000D0,   0.736325562D0,  0.479644865D0,  0.0D0,
     6 156.096954D0,   6.45038366D0,   1.37399995D0,   0.580509126D0,
     7 0.378145546D0,  0.0D0,          139.328461D0,   5.75746059D0,
     8 1.22640002D0,   0.518148780D0,  0.337523788D0,  0.0D0,
     9 73.1633530D0,   3.02332401D0,   0.643999994D0,  0.272087246D0,
     * 0.177238524D0,  0.0D0,          73.1633530D0,   3.02332401D0,
     1 0.643999994D0,  0.272087246D0,  0.177238524D0,  0.0D0,
     2 1.68139374D0,   6.948012114D-02,1.480000000D-02,6.252937019D-03,
     3 4.073183518D-03,0.0D0,          1.68139374D0,   6.948012114D-02,
     4 1.480000000D-02,6.252937019D-03,4.073183518D-03,0.0D0,
     5 23.2668552D0,   0.961454630D0,  0.204799995D0,  8.652712405D-02,
     6 5.636405200D-02,0.0D0,          9.22494411D0,   0.381201744D0,
     7 8.120000362D-02,3.430665284D-02,2.234746702D-02,0.0D0,
     8 9.22494411D0,   0.381201744D0,  8.120000362D-02,3.430665284D-02,
     9 2.234746702D-02,0.0D0/
C * DATA FOR ER ELEMENT #68
      DATA ((XNRG(68, I, J), J = 1, 6), I = 1, 19)/
     1 1225.44031D0,   249.108032D0,   114.971001D0,   74.7307739D0,
     2 60.3148766D0,   57.5429840D0,   207.872177D0,   42.2563438D0,
     3 19.5025997D0,   12.6766262D0,   10.2312489D0,   9.76105118D0,
     4 197.490616D0,   40.1459770D0,   18.5286007D0,   12.0435295D0,
     5 9.72027874D0,   9.27356434D0,   178.168549D0,   36.2181778D0,
     6 16.7157993D0,   10.8652153D0,   8.76926708D0,   8.36625767D0,
     7 47.0368042D0,   9.56166077D0,   4.41300011D0,   2.86843562D0,
     8 2.31510162D0,   2.20870662D0,   42.7584038D0,   8.69194698D0,
     9 4.01160002D0,   2.60752678D0,   2.10452342D0,   2.00780582D0,
     * 38.6228333D0,   7.85126591D0,   3.62360001D0,   2.35532808D0,
     1 1.90097499D0,   1.81361187D0,   30.9805508D0,   6.29773951D0,
     2 2.90660000D0,   1.88928056D0,   1.52482998D0,   1.45475340D0,
     3 30.0425854D0,   6.10706949D0,   2.81859994D0,   1.83208072D0,
     4 1.47866428D0,   1.41070926D0,   204.084839D0,   8.43338394D0,
     5 1.79639995D0,   0.758971334D0,  0.494396389D0,  0.0D0,
     6 166.412537D0,   6.87665367D0,   1.46480000D0,   0.618871748D0,
     7 0.403135061D0,  0.0D0,          145.417831D0,   6.00909138D0,
     8 1.27999997D0,   0.540794551D0,  0.352275312D0,  0.0D0,
     9 80.2979126D0,   3.31814504D0,   0.706799984D0,  0.298619986D0,
     * 0.194522023D0,  0.0D0,          76.1625900D0,   3.14726162D0,
     1 0.670400023D0,  0.283241153D0,  0.184504196D0,  0.0D0,
     2 1.95405221D0,   8.074716479D-02,1.720000058D-02,7.266926579D-03,
     3 4.733699840D-03,0.0D0,          1.95405221D0,   8.074716479D-02,
     4 1.720000058D-02,7.266926579D-03,4.733699840D-03,0.0D0,
     5 27.1749592D0,   1.12294888D0,   0.239199996D0,  0.101060979D0,
     6 6.583145261D-02,0.0D0,          13.3602638D0,   0.552085280D0,
     7 0.117600001D0,  4.968549684D-02,3.236529604D-02,0.0D0,
     8 13.3602638D0,   0.552085280D0,  0.117600001D0,  4.968549684D-02,
     9 3.236529604D-02,0.0D0/
C * DATA FOR TM ELEMENT #69
      DATA ((XNRG(69, I, J), J = 1, 6), I = 1, 19)/
     1 1266.03076D0,   257.359253D0,   118.779198D0,   77.2060928D0,
     2 62.3126945D0,   59.4489899D0,   215.640228D0,   43.8354378D0,
     3 20.2313995D0,   13.1503439D0,   10.6135836D0,   10.1258154D0,
     4 205.007126D0,   41.6739349D0,   19.2337990D0,   12.5019064D0,
     5 10.0902338D0,   9.62651730D0,   184.352707D0,   37.4752960D0,
     6 17.2959995D0,   11.2423429D0,   9.07364559D0,   8.65664768D0,
     7 49.1749344D0,   9.99630165D0,   4.61359978D0,   2.99882483D0,
     8 2.42033815D0,   2.30910683D0,   44.5490646D0,   9.05595303D0,
     9 4.17960024D0,   2.71672630D0,   2.19265771D0,   2.09188986D0,
     * 40.1726074D0,   8.16630459D0,   3.76900005D0,   2.44983768D0,
     1 1.97725320D0,   1.88638449D0,   32.2873077D0,   6.56337738D0,
     2 3.02920008D0,   1.96897018D0,   1.58914709D0,   1.51611471D0,
     3 31.2875195D0,   6.36014032D0,   2.93540001D0,   1.90800035D0,
     4 1.53993857D0,   1.46916771D0,   214.354980D0,   8.85777569D0,
     5 1.88679993D0,   0.797164917D0,  0.519275844D0,  0.0D0,
     6 175.364822D0,   7.24658871D0,   1.54359996D0,   0.652164400D0,
     7 0.424822032D0,  0.0D0,          152.961395D0,   6.32081270D0,
     8 1.34640002D0,   0.568848252D0,  0.370549619D0,  0.0D0,
     9 81.6157608D0,   3.37260246D0,   0.718400002D0,  0.303520918D0,
     * 0.197714522D0,  0.0D0,          81.6157608D0,   3.37260246D0,
     1 0.718400002D0,  0.303520918D0,  0.197714522D0,  0.0D0,
     2 2.40848303D0,   9.952557087D-02,2.119999938D-02,8.956909180D-03,
     3 5.834559910D-03,0.0D0,          2.40848303D0,   9.952557087D-02,
     4 2.119999938D-02,8.956909180D-03,5.834559910D-03,0.0D0,
     5 24.1757164D0,   0.999011397D0,  0.212799996D0,  8.990709484D-02,
     6 5.856577307D-02,0.0D0,          14.6781130D0,   0.606542647D0,
     7 0.129199997D0,  5.458644778D-02,3.555779159D-02,0.0D0,
     8 14.6781130D0,   0.606542647D0,  0.129199997D0,  5.458644778D-02,
     9 3.555779159D-02,0.0D0/
C * DATA FOR YB ELEMENT #70
      DATA ((XNRG(70, I, J), J = 1, 6), I = 1, 19)/
     1 1307.44409D0,   265.777771D0,   122.664604D0,   79.7315903D0,
     2 64.3510132D0,   61.3936348D0,   223.542587D0,   45.4418335D0,
     3 20.9727993D0,   13.6322508D0,   11.0025291D0,   10.4968863D0,
     4 212.709091D0,   43.2395935D0,   19.9563999D0,   12.9715948D0,
     5 10.4693165D0,   9.98817825D0,   190.654129D0,   38.7562523D0,
     6 17.8871994D0,   11.6266212D0,   9.38379478D0,   8.95254326D0,
     7 51.1212120D0,   10.3919420D0,   4.79619980D0,   3.11751413D0,
     8 2.51613188D0,   2.40049815D0,   46.3226700D0,   9.41649151D0,
     9 4.34599972D0,   2.82488561D0,   2.27995276D0,   2.17517304D0,
     * 41.5646286D0,   8.44927597D0,   3.89960003D0,   2.53472710D0,
     1 2.04576707D0,   1.95174980D0,   33.6025887D0,   6.83074808D0,
     2 3.15259981D0,   2.04917955D0,   1.65388381D0,   1.57787621D0,
     3 32.5686951D0,   6.62057781D0,   3.05559993D0,   1.98612988D0,
     4 1.60299659D0,   1.52932775D0,   221.398666D0,   9.14884186D0,
     5 1.94879997D0,   0.823359668D0,  0.536339164D0,  0.0D0,
     6 180.272675D0,   7.44939518D0,   1.58679998D0,   0.670416236D0,
     7 0.436711311D0,  0.0D0,          156.096954D0,   6.45038366D0,
     8 1.37399995D0,   0.580509126D0,  0.378145546D0,  0.0D0,
     9 90.0227356D0,   3.72000313D0,   0.792400002D0,  0.334785610D0,
     * 0.218080446D0,  0.0D0,          84.0242462D0,   3.47212815D0,
     1 0.739600003D0,  0.312477857D0,  0.203549087D0,  0.0D0,
     2 2.86291385D0,   0.118303984D0,  2.520000003D-02,1.064689271D-02,
     3 6.935420446D-03,0.0D0,          2.86291385D0,   0.118303984D0,
     4 2.520000003D-02,1.064689271D-02,6.935420446D-03,0.0D0,
     5 24.5847034D0,   1.01591194D0,   0.216399997D0,  9.142807871D-02,
     6 5.955654755D-02,0.0D0,          10.6336794D0,   0.439414799D0,
     7 9.360000491D-02,3.954559937D-02,2.576013282D-02,0.0D0,
     8 10.6336794D0,   0.439414799D0,  9.360000491D-02,3.954559937D-02,
     9 2.576013282D-02,0.0D0/
C * DATA FOR LU ELEMENT #71
      DATA ((XNRG(71, I, J), J = 1, 6), I = 1, 19)/
     1 1349.68445D0,   274.364410D0,   126.627602D0,   82.3075256D0,
     2 66.4300385D0,   63.3771133D0,   231.728455D0,   47.1058617D0,
     3 21.7408009D0,   14.1314487D0,   11.4054298D0,   10.8812704D0,
     4 220.605057D0,   44.8446884D0,   20.6972008D0,   13.4531116D0,
     5 10.8579473D0,   10.3589487D0,   197.059998D0,   40.0584412D0,
     6 18.4881992D0,   12.0172691D0,   9.69908524D0,   9.25334454D0,
     7 53.1058617D0,   10.7953815D0,   4.98239994D0,   3.23854375D0,
     8 2.61381435D0,   2.49369121D0,   48.2518921D0,   9.80866528D0,
     9 4.52699995D0,   2.94253516D0,   2.37490702D0,   2.26576352D0,
     * 43.1378517D0,   8.76908112D0,   4.04720020D0,   2.63066673D0,
     1 2.12319946D0,   2.02562356D0,   34.9477158D0,   7.10418606D0,
     2 3.27880001D0,   2.13120914D0,   1.72008955D0,   1.64103937D0,
     3 33.8626595D0,   6.88361549D0,   3.17699981D0,   2.06503940D0,
     4 1.66668427D0,   1.59008849D0,   230.032837D0,   9.50563145D0,
     5 2.02480006D0,   0.855469346D0,  0.557255507D0,  0.0D0,
     6 186.362045D0,   7.70102596D0,   1.64040005D0,   0.693062007D0,
     7 0.451462835D0,  0.0D0,          163.276962D0,   6.74708271D0,
     8 1.43719995D0,   0.607210875D0,  0.395539135D0,  0.0D0,
     9 93.0674210D0,   3.84581852D0,   0.819200039D0,  0.346108496D0,
     * 0.225456208D0,  0.0D0,          88.6139984D0,   3.66178989D0,
     1 0.780000031D0,  0.329546660D0,  0.214667782D0,  0.0D0,
     2 3.13557220D0,   0.129571036D0,  2.759999968D-02,1.166088227D-02,
     3 7.595936768D-03,0.0D0,          3.13557220D0,   0.129571036D0,
     4 2.759999968D-02,1.166088227D-02,7.595936768D-03,0.0D0,
     5 25.8116665D0,   1.06661367D0,   0.227200001D0,  9.599103034D-02,
     6 6.252887100D-02,0.0D0,          12.7240610D0,   0.525795460D0,
     7 0.112000003D0,  4.731952026D-02,3.082409129D-02,0.0D0,
     8 12.7240610D0,   0.525795460D0,  0.112000003D0,  4.731952026D-02,
     9 3.082409129D-02,0.0D0/
C * DATA FOR HF ELEMENT #72
      DATA ((XNRG(72, I, J), J = 1, 6), I = 1, 20)/
     1 1393.10791D0,   283.191559D0,   130.701599D0,   84.9556122D0,
     2 68.5672989D0,   65.4161530D0,   240.261810D0,   48.8405228D0,
     3 22.5414009D0,   14.6518364D0,   11.8254318D0,   11.2819710D0,
     4 228.935883D0,   46.5381851D0,   21.4787998D0,   13.9611429D0,
     5 11.2679815D0,   10.7501392D0,   203.809082D0,   41.4303970D0,
     6 19.1214008D0,   12.4288473D0,   10.0312672D0,   9.57026100D0,
     7 55.4443779D0,   11.2707567D0,   5.20179987D0,   3.38115287D0,
     8 2.72891355D0,   2.60350084D0,   50.4241333D0,   10.2502394D0,
     9 4.73079967D0,   3.07500434D0,   2.48182249D0,   2.36776543D0,
     * 44.9285126D0,   9.13308716D0,   4.21519995D0,   2.73986626D0,
     1 2.21133375D0,   2.10970759D0,   36.5891533D0,   7.43785858D0,
     2 3.43279982D0,   2.23130870D0,   1.80087936D0,   1.71811640D0,
     3 35.4230919D0,   7.20082092D0,   3.32339978D0,   2.16019893D0,
     4 1.74348700D0,   1.66336167D0,   244.529190D0,   10.1046629D0,
     5 2.15240002D0,   0.909379840D0,  0.592372954D0,  0.0D0,
     6 198.586227D0,   8.20616531D0,   1.74800003D0,   0.738522530D0,
     7 0.481075972D0,  0.0D0,          172.865463D0,   7.14330721D0,
     8 1.52160001D0,   0.642869532D0,  0.418767303D0,  0.0D0,
     9 101.701599D0,   4.20260811D0,   0.895199955D0,  0.378218174D0,
     * 0.246372551D0,  0.0D0,          97.1118469D0,   4.01294613D0,
     1 0.854799986D0,  0.361149341D0,  0.235253856D0,  0.0D0,
     2 7.77076530D0,   0.321110815D0,  6.839999557D-02,2.889870666D-02,
     3 1.882471144D-02,0.0D0,          7.77076530D0,   0.321110815D0,
     4 6.839999557D-02,2.889870666D-02,1.882471144D-02,0.0D0,
     5 29.4925556D0,   1.21871877D0,   0.259599984D0,  0.109679893D0,
     6 7.144583762D-02,0.0D0,          17.3138123D0,   0.715457439D0,
     7 0.152400002D0,  6.438834965D-02,4.194278270D-02,0.0D0,
     8 13.9055805D0,   0.574619353D0,  0.122400001D0,  5.171347782D-02,
     9 3.368632868D-02,0.0D0,          2.27215385D0,   9.389205277D-02,
     * 1.999999955D-02,8.449914865D-03,5.504302215D-03,0.0D0/
C * DATA FOR TA ELEMENT #73
      DATA ((XNRG(73, I, J), J = 1, 6), I = 1, 20)/
     1 1437.14111D0,   292.142639D0,   134.832794D0,   87.6408768D0,
     2 70.7345657D0,   67.4838181D0,   249.018982D0,   50.6206856D0,
     3 23.3629990D0,   15.1858730D0,   12.2564507D0,   11.6931810D0,
     4 237.392487D0,   48.2572441D0,   22.2721996D0,   14.4768572D0,
     5 11.6842070D0,   11.1472359D0,   210.639175D0,   42.8188210D0,
     6 19.7621994D0,   12.8453655D0,   10.3674374D0,   9.89098072D0,
     7 57.7274666D0,   11.7348642D0,   5.41599989D0,   3.52038217D0,
     8 2.84128499D0,   2.71070790D0,   52.6262169D0,   10.6978798D0,
     9 4.93739986D0,   3.20929360D0,   2.59020662D0,   2.47116852D0,
     * 46.7703362D0,   9.50749397D0,   4.38800001D0,   2.85218573D0,
     1 2.30198646D0,   2.19619393D0,   38.2263298D0,   7.77066422D0,
     2 3.58640003D0,   2.33114839D0,   1.88145947D0,   1.79499328D0,
     3 36.9877892D0,   7.51889324D0,   3.47019982D0,   2.25561857D0,
     4 1.82049978D0,   1.73683500D0,   256.980591D0,   10.6191912D0,
     5 2.26200008D0,   0.955685377D0,  0.622536540D0,  0.0D0,
     6 211.219406D0,   8.72820473D0,   1.85920000D0,   0.785504103D0,
     7 0.511679888D0,  0.0D0,          183.817245D0,   7.59586716D0,
     8 1.61800003D0,   0.683598101D0,  0.445298016D0,  0.0D0,
     9 109.654144D0,   4.53123045D0,   0.965200007D0,  0.407792896D0,
     * 0.265637606D0,  0.0D0,          104.200966D0,   4.30588913D0,
     1 0.917199969D0,  0.387513071D0,  0.252427280D0,  0.0D0,
     2 11.3607683D0,   0.469460249D0,  0.100000001D0,  4.224957153D-02,
     3 2.752150968D-02,0.0D0,          11.3607683D0,   0.469460249D0,
     4 0.100000001D0,  4.224957153D-02,2.752150968D-02,0.0D0,
     5 32.3100243D0,   1.33514500D0,   0.284399986D0,  0.120157786D0,
     6 7.827117294D-02,0.0D0,          20.4039402D0,   0.843150616D0,
     7 0.179600000D0,  7.588023692D-02,4.942863062D-02,0.0D0,
     8 16.5412788D0,   0.683534145D0,  0.145600006D0,  6.151537970D-02,
     9 4.007131979D-02,0.0D0,          2.59025526D0,   0.107036933D0,
     * 2.280000038D-02,9.632902220D-03,6.274904124D-03,0.0D0/
C * DATA FOR W  ELEMENT #74
      DATA ((XNRG(74, I, J), J = 1, 6), I = 1, 20)/
     1 1482.09094D0,   301.280060D0,   139.050003D0,   90.3820419D0,
     2 72.9469452D0,   69.5945282D0,   257.936066D0,   52.4333496D0,
     3 24.1996002D0,   15.7296610D0,   12.6953392D0,   12.1119003D0,
     4 246.087845D0,   50.0248413D0,   23.0879993D0,   15.0071239D0,
     5 12.1121836D0,   11.5555439D0,   217.582245D0,   44.2302132D0,
     6 20.4135990D0,   13.2687731D0,   10.7091675D0,   10.2170067D0,
     7 60.1064911D0,   12.2184725D0,   5.63920021D0,   3.66546154D0,
     8 2.95837784D0,   2.82241964D0,   54.8901253D0,   11.1580877D0,
     9 5.14979982D0,   3.34735298D0,   2.70163393D0,   2.57747483D0,
     * 48.6249466D0,   9.88449955D0,   4.56199980D0,   2.96528506D0,
     1 2.39326835D0,   2.28328085D0,   39.8976097D0,   8.11040306D0,
     2 3.74320006D0,   2.43306780D0,   1.96371818D0,   1.87347162D0,
     3 38.5674057D0,   7.83999872D0,   3.61840010D0,   2.35194802D0,
     4 1.89824688D0,   1.81100917D0,   270.386292D0,   11.1731539D0,
     5 2.37999988D0,   1.00553989D0,   0.655011952D0,  0.0D0,
     6 223.398148D0,   9.23146629D0,   1.96640003D0,   0.830795586D0,
     7 0.541182935D0,  0.0D0,          193.269394D0,   7.98645782D0,
     8 1.70120001D0,   0.718749762D0,  0.468195915D0,  0.0D0,
     9 117.606674D0,   4.85985279D0,   1.03520000D0,   0.437367588D0,
     * 0.284902662D0,  0.0D0,          111.517303D0,   4.60822201D0,
     1 0.981599987D0,  0.414721817D0,  0.270151138D0,  0.0D0,
     2 16.5867214D0,   0.685411990D0,  0.145999998D0,  6.168437749D-02,
     3 4.018140584D-02,0.0D0,          15.2688732D0,   0.630954564D0,
     4 0.134399995D0,  5.678342655D-02,3.698891029D-02,0.0D0,
     5 35.0366096D0,   1.44781542D0,   0.308400005D0,  0.130297676D0,
     6 8.487633616D-02,0.0D0,          21.2673588D0,   0.878829598D0,
     7 0.187199995D0,  7.909119874D-02,5.152026564D-02,0.0D0,
     8 16.1777344D0,   0.668511391D0,  0.142399997D0,  6.016339362D-02,
     9 3.919063136D-02,0.0D0,          2.77202749D0,   0.114548303D0,
     * 2.439999953D-02,1.030889619D-02,6.715248339D-03,0.0D0/
C * DATA FOR RE ELEMENT #75
      DATA ((XNRG(75, I, J), J = 1, 6), I = 1, 21)/
     1 1527.95313D0,   310.602966D0,   143.352798D0,   93.1788483D0,
     2 75.2042389D0,   71.7480774D0,   267.036438D0,   54.2832794D0,
     3 25.0534000D0,   16.2846279D0,   13.1432505D0,   12.5392265D0,
     4 254.928162D0,   51.8219070D0,   23.9174004D0,   15.5462313D0,
     5 12.5472946D0,   11.9706583D0,   224.585007D0,   45.6537361D0,
     6 21.0706005D0,   13.6958208D0,   11.0538359D0,   10.5458355D0,
     7 62.4961662D0,   12.7042475D0,   5.86339998D0,   3.81119061D0,
     8 3.07599521D0,   2.93463159D0,   57.1646881D0,   11.6204624D0,
     9 5.36319971D0,   3.48606229D0,   2.81358552D0,   2.68428159D0,
     * 50.4646378D0,   10.2584724D0,   4.73460007D0,   3.07747436D0,
     1 2.48381591D0,   2.36966729D0,   41.5454445D0,   8.44537544D0,
     2 3.89779997D0,   2.53355718D0,   2.04482269D0,   1.95084894D0,
     3 40.1384964D0,   8.15937042D0,   3.76580000D0,   2.44775772D0,
     4 1.97557437D0,   1.88478291D0,   284.019226D0,   11.7365065D0,
     5 2.50000000D0,   1.05623937D0,   0.688037753D0,  0.0D0,
     6 235.349686D0,   9.72533894D0,   2.07159996D0,   0.875242174D0,
     7 0.570135593D0,  0.0D0,          201.949020D0,   8.34512520D0,
     8 1.77759993D0,   0.751028419D0,  0.489222348D0,  0.0D0,
     9 124.377693D0,   5.13965082D0,   1.09480000D0,   0.462548316D0,
     * 0.301305473D0,  0.0D0,          118.242882D0,   4.88614225D0,
     1 1.04079998D0,   0.439733565D0,  0.286443889D0,  0.0D0,
     2 18.4498882D0,   0.762403429D0,  0.162399992D0,  6.861330569D-02,
     3 4.469493032D-02,0.0D0,          18.4498882D0,   0.762403429D0,
     4 0.162399992D0,  6.861330569D-02,4.469493032D-02,0.0D0,
     5 37.6268654D0,   1.55485237D0,   0.331200004D0,  0.139930591D0,
     6 9.115123749D-02,0.0D0,          20.7220421D0,   0.856295526D0,
     7 0.182400003D0,  7.706321776D-02,5.019923300D-02,0.0D0,
     8 15.7233038D0,   0.649733007D0,  0.138400003D0,  5.847340822D-02,
     9 3.808977082D-02,0.0D0,          2.75506401D0,   0.113847315D0,
     * 2.425068244D-02,1.024581026D-02,6.674154196D-03,0.0D0,
     1 2.36718655D0,   9.781908989D-02,2.083650045D-02,8.803332224D-03,
     2 5.734519567D-03,0.0D0/
C * DATA FOR OS ELEMENT #76
      DATA ((XNRG(76, I, J), J = 1, 6), I = 1, 21)/
     1 1574.73206D0,   320.112183D0,   147.741608D0,   96.0315552D0,
     2 77.5066452D0,   73.9446716D0,   276.443817D0,   56.1956139D0,
     3 25.9360008D0,   16.8583145D0,   13.6062717D0,   12.9809685D0,
     4 264.015778D0,   53.6692390D0,   24.7700005D0,   16.1004181D0,
     5 12.9945765D0,   12.3973846D0,   231.739120D0,   47.1080284D0,
     6 21.7418003D0,   14.1320982D0,   11.4059544D0,   10.8817711D0,
     7 64.9860382D0,   13.2103891D0,   6.09700012D0,   3.96302986D0,
     8 3.19854403D0,   3.05154848D0,   59.5223923D0,   12.0997372D0,
     9 5.58440018D0,   3.62984157D0,   2.92962909D0,   2.79499221D0,
     * 52.3810692D0,   10.6480455D0,   4.91440010D0,   3.19434381D0,
     1 2.57814074D0,   2.45965719D0,   43.2913399D0,   8.80028152D0,
     2 4.06160021D0,   2.64002681D0,   2.13075399D0,   2.03283095D0,
     3 41.7841988D0,   8.49390984D0,   3.92019987D0,   2.54811716D0,
     4 2.05657411D0,   1.96206009D0,   297.334045D0,   12.2867136D0,
     5 2.61720014D0,   1.10575581D0,   0.720292985D0,  0.0D0,
     6 248.346405D0,   10.2624006D0,   2.18600011D0,   0.923575640D0,
     7 0.601620197D0,  0.0D0,          212.764481D0,   8.79205132D0,
     8 1.87279999D0,   0.791249990D0,  0.515422821D0,  0.0D0,
     9 131.512253D0,   5.43447161D0,   1.15759993D0,   0.489081055D0,
     * 0.318589002D0,  0.0D0,          123.968712D0,   5.12275028D0,
     1 1.09119999D0,   0.461027354D0,  0.300314724D0,  0.0D0,
     2 21.0401440D0,   0.869440377D0,  0.185200006D0,  7.824621350D-02,
     3 5.096983537D-02,0.0D0,          21.0401440D0,   0.869440377D0,
     4 0.185200006D0,  7.824621350D-02,5.096983537D-02,0.0D0,
     5 38.0358543D0,   1.57175291D0,   0.334800005D0,  0.141451567D0,
     6 9.214201570D-02,0.0D0,          26.3569832D0,   1.08914781D0,
     7 0.231999993D0,  9.801901132D-02,6.384990364D-02,0.0D0,
     8 20.6311550D0,   0.852539837D0,  0.181600004D0,  7.672522217D-02,
     9 4.997906089D-02,0.0D0,          3.20493889D0,   0.132437468D0,
     * 2.821058221D-02,1.191885024D-02,7.763978094D-03,0.0D0,
     1 2.73928213D0,   0.113195166D0,  2.411176823D-02,1.018711925D-02,
     2 6.635922473D-03,0.0D0/
C * DATA FOR IR ELEMENT #77
      DATA ((XNRG(77, I, J), J = 1, 6), I = 1, 21)/
     1 1622.48718D0,   329.819885D0,   152.222000D0,   98.9438019D0,
     2 79.8571014D0,   76.1871109D0,   286.047272D0,   58.1478119D0,
     3 26.8369999D0,   17.4439621D0,   14.0789442D0,   13.4319181D0,
     4 273.376221D0,   55.5720367D0,   25.6481991D0,   16.6712456D0,
     5 13.4552889D0,   12.8369246D0,   239.078690D0,   48.6000175D0,
     6 22.4304008D0,   14.5796862D0,   11.7672005D0,   11.2264156D0,
     7 67.6549683D0,   13.7529316D0,   6.34739971D0,   4.12578917D0,
     8 3.32990599D0,   3.17687368D0,   62.0058670D0,   12.6045790D0,
     9 5.81739998D0,   3.78129101D0,   3.05186319D0,   2.91160870D0,
     * 54.3742447D0,   11.0532198D0,   5.10139990D0,   3.31589317D0,
     1 2.67624283D0,   2.55325079D0,   45.1097107D0,   9.16992092D0,
     2 4.23220015D0,   2.75091624D0,   2.22025228D0,   2.11821628D0,
     3 43.4959831D0,   8.84188175D0,   4.08080006D0,   2.65250659D0,
     4 2.14082623D0,   2.04244041D0,   313.602661D0,   12.9589806D0,
     5 2.76040006D0,   1.16625726D0,   0.759703755D0,  0.0D0,
     6 262.251984D0,   10.8370209D0,   2.30839992D0,   0.975289166D0,
     7 0.635306537D0,  0.0D0,          224.625122D0,   9.28216839D0,
     8 1.97720003D0,   0.835358560D0,  0.544155300D0,  0.0D0,
     9 141.509735D0,   5.84759665D0,   1.24559999D0,   0.526260674D0,
     * 0.342807919D0,  0.0D0,          134.011627D0,   5.53775311D0,
     1 1.17960000D0,   0.498375952D0,  0.324643731D0,  0.0D0,
     2 28.8109093D0,   1.19055116D0,   0.253600001D0,  0.107144915D0,
     3 6.979455054D-02,0.0D0,          27.4930611D0,   1.13609385D0,
     4 0.241999999D0,  0.102243967D0,  6.660205126D-02,0.0D0,
     5 43.2618065D0,   1.78770459D0,   0.380800009D0,  0.160886377D0,
     6 0.104801908D0,  0.0D0,          28.6291370D0,   1.18303990D0,
     7 0.252000004D0,  0.106468923D0,  6.935420632D-02,0.0D0,
     8 22.9487514D0,   0.948309720D0,  0.201999992D0,  8.534413576D-02,
     9 5.559344962D-02,0.0D0,          3.66395903D0,   0.151405513D0,
     * 3.225097805D-02,1.362590026D-02,8.875955828D-03,0.0D0,
     1 3.11492109D0,   0.128717676D0,  2.741822600D-02,1.158408355D-02,
     2 7.545909379D-03,0.0D0/
C * DATA FOR PT ELEMENT #78
      DATA ((XNRG(78, I, J), J = 1, 6), I = 1, 21)/
     1 1671.17188D0,   339.716522D0,   156.789597D0,   101.912727D0,
     2 82.2533112D0,   78.4731979D0,   295.883118D0,   60.1472473D0,
     3 27.7598000D0,   18.0437794D0,   14.5630541D0,   13.8937798D0,
     4 282.937073D0,   57.5155678D0,   26.5452003D0,   17.2542934D0,
     5 13.9258633D0,   13.2858725D0,   246.507797D0,   50.1102104D0,
     6 23.1273994D0,   15.0327339D0,   12.1328535D0,   11.5752640D0,
     7 70.2620850D0,   14.2829065D0,   6.59200001D0,   4.28477812D0,
     8 3.45822549D0,   3.29929590D0,   64.5170593D0,   13.1150541D0,
     9 6.05299997D0,   3.93443012D0,   3.17546129D0,   3.02952647D0,
     * 56.3929977D0,   11.4635925D0,   5.29080009D0,   3.43900251D0,
     1 2.77560377D0,   2.64804530D0,   46.9387398D0,   9.54172707D0,
     2 4.40380001D0,   2.86245537D0,   2.31027508D0,   2.20410180D0,
     3 45.2269554D0,   9.19375515D0,   4.24320030D0,   2.75806618D0,
     4 2.22602296D0,   2.12372160D0,   328.098999D0,   13.5580120D0,
     5 2.88800001D0,   1.22016764D0,   0.794821203D0,  0.0D0,
     6 276.839203D0,   11.4398079D0,   2.43680000D0,   1.02953756D0,
     7 0.670644164D0,  0.0D0,          235.849548D0,   9.74599457D0,
     8 2.07599998D0,   0.877101123D0,  0.571346521D0,  0.0D0,
     9 150.325684D0,   6.21189785D0,   1.32319999D0,   0.559046328D0,
     * 0.364164621D0,  0.0D0,          142.373154D0,   5.88327599D0,
     1 1.25320005D0,   0.529471636D0,  0.344899565D0,  0.0D0,
     2 33.7642059D0,   1.39523590D0,   0.297199994D0,  0.125565737D0,
     3 8.179392666D-02,0.0D0,          32.3100243D0,   1.33514500D0,
     4 0.284399986D0,  0.120157786D0,  7.827117294D-02,0.0D0,
     5 46.2156067D0,   1.90976429D0,   0.406800002D0,  0.171871260D0,
     6 0.111957498D0,  0.0D0,          29.6743279D0,   1.22623014D0,
     7 0.261200011D0,  0.110355884D0,  7.188618183D-02,0.0D0,
     8 23.4940701D0,   0.970843792D0,  0.206799999D0,  8.737211674D-02,
     9 5.691448227D-02,0.0D0,          3.38092208D0,   0.139709607D0,
     * 2.975962311D-02,1.257331390D-02,8.190297522D-03,0.0D0,
     1 2.78356099D0,   0.115024894D0,  2.450151928D-02,1.035178732D-02,
     2 6.743188016D-03,0.0D0/
C * DATA FOR AU ELEMENT #79
      DATA ((XNRG(79, I, J), J = 1, 6), I = 1, 21)/
     1 372.712921D0,   168.043701D0,   114.162247D0,   92.0403137D0,
     2 82.6876373D0,   0.0D0,          305.964111D0,   62.1965141D0,
     3 28.7056007D0,   18.6585464D0,   15.0592299D0,   14.3671532D0,
     4 292.764404D0,   59.5132713D0,   27.4672012D0,   17.8535900D0,
     5 14.4095535D0,   13.7473335D0,   254.075470D0,   51.6485710D0,
     6 23.8374004D0,   15.4942312D0,   12.5053253D0,   11.9306183D0,
     7 73.0099030D0,   14.8414831D0,   6.84980011D0,   4.45234728D0,
     8 3.59346986D0,   3.42832494D0,   67.1028519D0,   13.6406965D0,
     9 6.29559994D0,   4.09211922D0,   3.30273151D0,   3.15094781D0,
     * 58.4735756D0,   11.8865337D0,   5.48600006D0,   3.56588197D0,
     1 2.87800741D0,   2.74574304D0,   48.8402519D0,   9.92826748D0,
     2 4.58220005D0,   2.97841501D0,   2.40386558D0,   2.29339123D0,
     3 47.0197487D0,   9.55819416D0,   4.41139984D0,   2.86739564D0,
     4 2.31426215D0,   2.20790577D0,   344.822052D0,   14.2490578D0,
     5 3.03519988D0,   1.28235900D0,   0.835332870D0,  0.0D0,
     6 292.517059D0,   12.0876627D0,   2.57480001D0,   1.08784199D0,
     7 0.708623827D0,  0.0D0,          247.846527D0,   10.2417450D0,
     8 2.18160009D0,   0.921716690D0,  0.600409269D0,  0.0D0,
     9 159.959625D0,   6.61000013D0,   1.40799999D0,   0.594873965D0,
     * 0.387502849D0,  0.0D0,          151.734421D0,   6.27011108D0,
     1 1.33560002D0,   0.564285278D0,  0.367577285D0,  0.0D0,
     2 39.2628174D0,   1.62245464D0,   0.345600009D0,  0.146014526D0,
     3 9.511433542D-02,0.0D0,          37.6268654D0,   1.55485237D0,
     4 0.331200004D0,  0.139930591D0,  9.115123749D-02,0.0D0,
     5 48.9876328D0,   2.02431273D0,   0.431199998D0,  0.182180166D0,
     6 0.118672751D0,  0.0D0,          32.5826836D0,   1.34641194D0,
     7 0.286799997D0,  0.121171772D0,  7.893168926D-02,0.0D0,
     8 24.4029312D0,   1.00840068D0,   0.214800000D0,  9.075208008D-02,
     9 5.911620334D-02,0.0D0,          3.77558589D0,   0.156018272D0,
     * 3.323354200D-02,1.404102985D-02,9.146372788D-03,0.0D0,
     1 3.08572841D0,   0.127511337D0,  2.716126479D-02,1.147551835D-02,
     2 7.475190330D-03,0.0D0/
C * DATA FOR HG ELEMENT #80
      DATA ((XNRG(80, I, J), J = 1, 6), I = 1, 22)/
     1 383.689545D0,   172.992691D0,   117.524399D0,   94.7509613D0,
     2 85.1228409D0,   0.0D0,          316.335022D0,   64.3047180D0,
     3 29.6786003D0,   19.2909927D0,   15.5696745D0,   14.8541393D0,
     4 302.892303D0,   61.5720711D0,   28.4174004D0,   18.4712181D0,
     5 14.9080381D0,   14.2229090D0,   261.860565D0,   53.2311287D0,
     6 24.5678005D0,   15.9689894D0,   12.8885002D0,   12.2961836D0,
     7 75.9239883D0,   15.4338598D0,   7.12319994D0,   4.63005686D0,
     8 3.73689818D0,   3.56516171D0,   69.8890381D0,   14.2070723D0,
     9 6.55700016D0,   4.26202822D0,   3.43986440D0,   3.28177857D0,
     * 60.6927147D0,   12.3376408D0,   5.69420004D0,   3.70121121D0,
     1 2.98723125D0,   2.84994698D0,   50.8398209D0,   10.3347406D0,
     2 4.76979971D0,   3.10035419D0,   2.50228214D0,   2.38728476D0,
     3 48.9212570D0,   9.94473362D0,   4.58979988D0,   2.98335481D0,
     4 2.40785241D0,   2.29719496D0,   363.680939D0,   15.0283613D0,
     5 3.20120001D0,   1.35249329D0,   0.881018579D0,  0.0D0,
     6 307.604156D0,   12.7111053D0,   2.70759988D0,   1.14394939D0,
     7 0.745172381D0,  0.0D0,          259.479950D0,   10.7224722D0,
     8 2.28399992D0,   0.964980245D0,  0.628591299D0,  0.0D0,
     9 171.911148D0,   7.10387278D0,   1.51320004D0,   0.639320552D0,
     * 0.416455477D0,  0.0D0,          163.504181D0,   6.75647211D0,
     1 1.43920004D0,   0.608055890D0,  0.396089584D0,  0.0D0,
     2 46.4428215D0,   1.91915357D0,   0.408800006D0,  0.172716260D0,
     3 0.112507932D0,  0.0D0,          44.7614288D0,   1.84967339D0,
     4 0.393999994D0,  0.166463315D0,  0.108434752D0,  0.0D0,
     5 54.6680183D0,   2.25904274D0,   0.481200010D0,  0.203304946D0,
     6 0.132433504D0,  0.0D0,          36.5816765D0,   1.51166201D0,
     7 0.321999997D0,  0.136043623D0,  8.861926198D-02,0.0D0,
     8 26.1752110D0,   1.08163643D0,   0.230399996D0,  9.734302014D-02,
     9 6.340955943D-02,0.0D0,          2.90835667D0,   0.120181821D0,
     * 2.559999935D-02,1.081589051D-02,7.045506500D-03,0.0D0,
     1 2.90835667D0,   0.120181821D0,  2.559999935D-02,1.081589051D-02,
     2 7.045506500D-03,0.0D0,          3.50529981D0,   0.144849256D0,
     3 3.085442446D-02,1.303586271D-02,8.491603658D-03,0.0D0/
C * DATA FOR TL ELEMENT #81
      DATA ((XNRG(81, I, J), J = 1, 6), I = 1, 22)/
     1 394.900269D0,   178.047226D0,   120.958252D0,   97.5194168D0,
     2 87.6099777D0,   0.0D0,          327.151459D0,   66.5034866D0,
     3 30.6934013D0,   19.9506092D0,   16.1020489D0,   15.3620472D0,
     4 313.320740D0,   63.6919708D0,   29.3957996D0,   19.1071720D0,
     5 15.4213142D0,   14.7125969D0,   269.824768D0,   54.8500900D0,
     6 25.3150005D0,   16.4546661D0,   13.2804890D0,   12.6701574D0,
     7 78.9617157D0,   16.0513706D0,   7.40819979D0,   4.81530571D0,
     8 3.88641191D0,   3.70780420D0,   72.8137817D0,   14.8016167D0,
     9 6.83139992D0,   4.44038773D0,   3.58381724D0,   3.41911578D0,
     * 63.0269699D0,   12.8121490D0,   5.91319990D0,   3.84356046D0,
     1 3.10212064D0,   2.95955658D0,   52.9758263D0,   10.7689486D0,
     2 4.97020006D0,   3.23061371D0,   2.60741401D0,   2.48758507D0,
     3 50.9336205D0,   10.3538074D0,   4.77860022D0,   3.10607433D0,
     4 2.50689888D0,   2.39168930D0,   384.221191D0,   15.8771458D0,
     5 3.38199997D0,   1.42888057D0,   0.930777490D0,  0.0D0,
     6 327.780884D0,   13.5448675D0,   2.88520002D0,   1.21898472D0,
     7 0.794050574D0,  0.0D0,          276.748322D0,   11.4360514D0,
     8 2.43600011D0,   1.02919960D0,   0.670423985D0,  0.0D0,
     9 184.771545D0,   7.63530159D0,   1.62639999D0,   0.687147021D0,
     * 0.447609842D0,  0.0D0,          175.501160D0,   7.25222206D0,
     1 1.54480004D0,   0.652671397D0,  0.425152272D0,  0.0D0,
     2 55.8040962D0,   2.30598879D0,   0.491200000D0,  0.207529902D0,
     3 0.135185659D0,  0.0D0,          53.8500443D0,   2.22524166D0,
     4 0.474000007D0,  0.200262979D0,  0.130451962D0,  0.0D0,
     5 61.9389153D0,   2.55949736D0,   0.545200050D0,  0.230344683D0,
     6 0.150047272D0,  0.0D0,          45.2613029D0,   1.87032962D0,
     7 0.398400009D0,  0.168322295D0,  0.109645694D0,  0.0D0,
     8 34.2640762D0,   1.41589212D0,   0.301600009D0,  0.127424717D0,
     9 8.300486952D-02,0.0D0,          6.95279026D0,   0.287309676D0,
     * 6.120000035D-02,2.585673891D-02,1.684316434D-02,0.0D0,
     1 5.95304298D0,   0.245997176D0,  5.240000039D-02,2.213877626D-02,
     2 1.442127116D-02,0.0D0,          4.39199686D0,   0.181490168D0,
     3 3.865932673D-02,1.633340120D-02,1.063963026D-02,0.0D0/
C * DATA FOR PB ELEMENT #82
      DATA ((XNRG(82, I, J), J = 1, 6), I = 1, 23)/
     1 406.323364D0,   183.197510D0,   124.457153D0,   100.340317D0,
     2 90.1442337D0,   0.0D0,          338.110718D0,   68.7312927D0,
     3 31.7215996D0,   20.6189365D0,   16.6414528D0,   15.8766613D0,
     4 324.024200D0,   65.8677750D0,   30.4000015D0,   19.7599010D0,
     5 15.9481287D0,   15.2152004D0,   277.876343D0,   56.4868164D0,
     6 26.0704002D0,   16.9456749D0,   13.6767788D0,   13.0482349D0,
     7 82.0868378D0,   16.6866474D0,   7.70139980D0,   5.00588465D0,
     8 4.04022741D0,   3.85455060D0,   75.7662354D0,   15.4017925D0,
     9 7.10839987D0,   4.62043667D0,   3.72913408D0,   3.55775428D0,
     * 65.3676147D0,   13.2879572D0,   6.13280010D0,   3.98629975D0,
     1 3.21732497D0,   3.06946635D0,   55.1182213D0,   11.2044554D0,
     2 5.17119980D0,   3.36126304D0,   2.71286035D0,   2.58818555D0,
     3 52.9523735D0,   10.7641811D0,   4.96799994D0,   3.22918367D0,
     4 2.60625982D0,   2.48648405D0,   406.079315D0,   16.7803879D0,
     5 3.57439995D0,   1.51016879D0,   0.983728826D0,  0.0D0,
     6 347.139648D0,   14.3448277D0,   3.05559993D0,   1.29097795D0,
     7 0.840947270D0,  0.0D0,          292.880615D0,   12.1026850D0,
     8 2.57800007D0,   1.08919406D0,   0.709504545D0,  0.0D0,
     9 197.768265D0,   8.17236423D0,   1.74080002D0,   0.735480547D0,
     * 0.479094446D0,  0.0D0,          187.634460D0,   7.75360537D0,
     1 1.65160000D0,   0.697793961D0,  0.454545259D0,  0.0D0,
     2 64.9381561D0,   2.68343496D0,   0.571600020D0,  0.241498560D0,
     3 0.157312959D0,  0.0D0,          62.7568893D0,   2.59329844D0,
     4 0.552399993D0,  0.233386651D0,  0.152028829D0,  0.0D0,
     5 66.9376450D0,   2.76605964D0,   0.589199960D0,  0.248934478D0,
     6 0.162156731D0,  0.0D0,          47.6243439D0,   1.96797740D0,
     7 0.419200003D0,  0.177110210D0,  0.115370169D0,  0.0D0,
     8 39.0810432D0,   1.61494327D0,   0.344000012D0,  0.145338535D0,
     9 9.467399120D-02,0.0D0,          9.90659046D0,   0.409369349D0,
     * 8.720000088D-02,3.684162721D-02,2.399875596D-02,0.0D0,
     1 8.72507000D0,   0.360545486D0,  7.680000365D-02,3.244767338D-02,
     2 2.113652043D-02,0.0D0,          5.31246948D0,   0.219526812D0,
     3 4.676153511D-02,1.975654811D-02,1.286948007D-02,0.0D0,
     4 2.23201036D0,   9.223321080D-02,1.964665018D-02,8.300625719D-03,
     5 5.407054443D-03,0.0D0/
C * DATA FOR BI ELEMENT #83
      DATA ((XNRG(83, I, J), J = 1, 6), I = 1, 23)/
     1 417.964874D0,   188.446274D0,   128.022949D0,   103.215149D0,
     2 92.7269363D0,   0.0D0,          349.338593D0,   71.0136948D0,
     3 32.7750015D0,   21.3036423D0,   17.1940765D0,   16.4038887D0,
     4 334.919525D0,   68.0825806D0,   31.4222012D0,   20.4243279D0,
     5 16.4843845D0,   15.7268114D0,   286.049408D0,   58.1482468D0,
     6 26.8372002D0,   17.4440918D0,   14.0790491D0,   13.4320183D0,
     7 85.2503357D0,   17.3297253D0,   7.99819994D0,   5.19880342D0,
     8 4.19593143D0,   4.00309896D0,   78.7954330D0,   16.0175686D0,
     9 7.39260006D0,   4.80516577D0,   3.87822795D0,   3.69999623D0,
     * 67.7231903D0,   13.7667990D0,   6.35379982D0,   4.12994909D0,
     1 3.33326364D0,   3.18007684D0,   57.2925911D0,   11.6464624D0,
     2 5.37519979D0,   3.49386215D0,   2.81988072D0,   2.69028759D0,
     3 54.9903145D0,   11.1784544D0,   5.15919971D0,   3.35346293D0,
     4 2.70656514D0,   2.58217955D0,   426.346924D0,   17.6179047D0,
     5 3.75279999D0,   1.58554196D0,   1.03282726D0,   0.0D0,
     6 365.953094D0,   15.1222534D0,   3.22119999D0,   1.36094320D0,
     7 0.886522889D0,  0.0D0,          308.513031D0,   12.7486629D0,
     8 2.71560001D0,   1.14732945D0,   0.747374117D0,  0.0D0,
     9 210.674103D0,   8.70567131D0,   1.85440004D0,   0.783476114D0,
     * 0.510358870D0,  0.0D0,          199.949524D0,   8.26250076D0,
     1 1.75999999D0,   0.743592501D0,  0.484378576D0,  0.0D0,
     2 73.5723343D0,   3.04022455D0,   0.647599995D0,  0.273608238D0,
     3 0.178229287D0,  0.0D0,          71.5273972D0,   2.95572186D0,
     4 0.629599988D0,  0.266003311D0,  0.173275426D0,  0.0D0,
     5 72.3908234D0,   2.99140072D0,   0.637199998D0,  0.269214272D0,
     6 0.175367057D0,  0.0D0,          53.0775108D0,   2.19331837D0,
     7 0.467200011D0,  0.197390005D0,  0.128580496D0,  0.0D0,
     8 42.1711731D0,   1.74263644D0,   0.371199995D0,  0.156830415D0,
     9 0.102159843D0,  0.0D0,          12.0424147D0,   0.497627884D0,
     * 0.105999999D0,  4.478454962D-02,2.917280048D-02,0.0D0,
     1 11.0881100D0,   0.458193213D0,  9.759999812D-02,4.123558104D-02,
     2 2.686099336D-02,0.0D0,          6.46809006D0,   0.267280430D0,
     3 5.693355948D-02,2.405418642D-02,1.566897519D-02,0.0D0,
     4 2.80379581D0,   0.115861058D0,  2.467963099D-02,1.042703912D-02,
     5 6.792207249D-03,0.0D0/
C * DATA FOR PO ELEMENT #84
      DATA ((XNRG(84, I, J), J = 1, 6), I = 1, 24)/
     1 429.872772D0,   193.815140D0,   131.670349D0,   106.155762D0,
     2 95.3687439D0,   0.0D0,          361.101532D0,   73.4048691D0,
     3 33.8786011D0,   22.0209789D0,   17.7730350D0,   16.9562397D0,
     4 346.285950D0,   70.3931503D0,   32.4886017D0,   21.1174831D0,
     5 17.0438271D0,   16.2605438D0,   294.474060D0,   59.8608093D0,
     6 27.6276016D0,   17.9578495D0,   14.4937010D0,   13.8276148D0,
     7 88.4543457D0,   17.9810371D0,   8.29880047D0,   5.39419270D0,
     8 4.35362911D0,   4.15354967D0,   82.1593170D0,   16.7013817D0,
     9 7.70819998D0,   5.01030445D0,   4.04379463D0,   3.85795403D0,
     * 70.3878632D0,   14.3084745D0,   6.60379982D0,   4.29244804D0,
     1 3.46441603D0,   3.30520177D0,   59.6460304D0,   12.1248703D0,
     2 5.59599972D0,   3.63738155D0,   2.93571448D0,   2.80079794D0,
     3 57.1945343D0,   11.6265287D0,   5.36600018D0,   3.48788238D0,
     4 2.81505442D0,   2.68568301D0,   452.294922D0,   18.6901512D0,
     5 3.98119998D0,   1.68203998D0,   1.09568632D0,   0.0D0,
     6 386.720581D0,   15.9804268D0,   3.40400004D0,   1.43817544D0,
     7 0.936832190D0,  0.0D0,          320.373688D0,   13.2387791D0,
     8 2.81999993D0,   1.19143796D0,   0.776106596D0,  0.0D0,
     9 227.306259D0,   9.39296055D0,   2.00079989D0,   0.845329463D0,
     * 0.550650358D0,  0.0D0,          215.127518D0,   8.88969898D0,
     1 1.89359999D0,   0.800037920D0,  0.521147311D0,  0.0D0,
     2 79.6816254D0,   3.29267836D0,   0.701375306D0,  0.296328098D0,
     3 0.193029076D0,  0.0D0,          76.9632339D0,   3.18034625D0,
     4 0.677447379D0,  0.286218643D0,  0.186443746D0,  0.0D0,
     5 77.6650696D0,   3.20934820D0,   0.683625102D0,  0.288828701D0,
     6 0.188143954D0,  0.0D0,          57.1197777D0,   2.36035657D0,
     7 0.502780914D0,  0.212422788D0,  0.138372898D0,  0.0D0,
     8 44.6769676D0,   1.84618330D0,   0.393256575D0,  0.166149214D0,
     9 0.108230144D0,  0.0D0,          14.2691259D0,   0.589642107D0,
     * 0.125599995D0,  5.306546390D-02,3.456701711D-02,0.0D0,
     1 14.2691259D0,   0.589642107D0,  0.125599995D0,  5.306546390D-02,
     2 3.456701711D-02,0.0D0,          7.62429142D0,   0.315058053D0,
     3 6.711070240D-02,2.835398540D-02,1.846987754D-02,0.0D0,
     4 3.43538022D0,   0.141959980D0,  3.023897670D-02,1.277583838D-02,
     5 8.322223090D-03,0.0D0,          2.45154977D0,   0.101305217D0,
     6 2.157908306D-02,9.117070585D-03,5.938889459D-03,0.0D0/
C * DATA FOR AT ELEMENT #85
      DATA ((XNRG(85, I, J), J = 1, 6), I = 1, 24)/
     1 441.992126D0,   199.279358D0,   135.382523D0,   109.148605D0,
     2 98.0574646D0,   0.0D0,          372.904938D0,   75.8042755D0,
     3 34.9860001D0,   22.7407856D0,   18.3539867D0,   17.5104923D0,
     4 357.805847D0,   72.7349243D0,   33.5694008D0,   21.8199997D0,
     5 17.6108246D0,   16.8014851D0,   302.994598D0,   61.5928688D0,
     6 28.4269981D0,   18.4774551D0,   14.9130726D0,   14.2277126D0,
     7 92.0271378D0,   18.7073154D0,   8.63399982D0,   5.61207151D0,
     8 4.52947807D0,   4.32131720D0,   85.4400635D0,   17.3682919D0,
     9 8.01599979D0,   5.21037388D0,   4.20526934D0,   4.01200819D0,
     * 73.0333481D0,   14.8462505D0,   6.85200024D0,   4.45377731D0,
     1 3.59462404D0,   3.42942595D0,   62.0058670D0,   12.6045790D0,
     2 5.81739998D0,   3.78129101D0,   3.05186319D0,   2.91160870D0,
     3 59.4051476D0,   12.0759029D0,   5.57340002D0,   3.62269163D0,
     4 2.92385840D0,   2.78948665D0,   22.2127113D0,   4.51540947D0,
     5 2.08400011D0,   1.35459316D0,   1.09328616D0,   1.04304194D0,
     6 402.625641D0,   16.6376705D0,   3.54399991D0,   1.49732482D0,
     7 0.975362301D0,  0.0D0,          336.278748D0,   13.8960238D0,
     8 2.96000004D0,   1.25058734D0,   0.814636707D0,  0.0D0,
     9 242.302475D0,   10.0126486D0,   2.13280010D0,   0.901098907D0,
     * 0.586978734D0,  0.0D0,          216.029388D0,   8.92696762D0,
     1 1.90153849D0,   0.803391874D0,  0.523332119D0,  0.0D0,
     2 89.5572205D0,   3.70076704D0,   0.788302481D0,  0.333054453D0,
     3 0.216952756D0,  0.0D0,          86.6041489D0,   3.57873726D0,
     4 0.762308896D0,  0.322072238D0,  0.209798917D0,  0.0D0,
     5 84.3500137D0,   3.48558974D0,   0.742467463D0,  0.313689321D0,
     6 0.204338253D0,  0.0D0,          62.9383812D0,   2.60079837D0,
     7 0.553997576D0,  0.234061599D0,  0.152468488D0,  0.0D0,
     8 49.2721024D0,   2.03606772D0,   0.433703929D0,  0.183238059D0,
     9 0.119361870D0,  0.0D0,          18.9016819D0,   0.781072855D0,
     * 0.166376784D0,  7.029347867D-02,4.578940198D-02,0.0D0,
     1 17.1146832D0,   0.707228839D0,  0.150647223D0,  6.364781410D-02,
     2 4.146039113D-02,0.0D0,          8.78822899D0,   0.363155365D0,
     3 7.735593617D-02,3.268255293D-02,2.128952183D-02,0.0D0,
     4 4.10398197D0,   0.169588551D0,  3.612415865D-02,1.526230201D-02,
     5 9.941913188D-03,0.0D0,          2.83769464D0,   0.117261857D0,
     6 2.497801557D-02,1.055310573D-02,6.874327082D-03,0.0D0/
C * DATA FOR RN ELEMENT #86
      DATA ((XNRG(86, I, J), J = 1, 6), I = 1, 24)/
     1 454.338654D0,   204.845993D0,   139.164276D0,   112.197540D0,
     2 100.796585D0,   0.0D0,          384.757416D0,   78.2136536D0,
     3 36.0979996D0,   23.4635811D0,   18.9373531D0,   18.0670490D0,
     4 369.581573D0,   75.1287003D0,   34.6741982D0,   22.5381165D0,
     5 18.1904144D0,   17.3544369D0,   311.647308D0,   63.3517990D0,
     6 29.2388000D0,   19.0051231D0,   15.3389511D0,   14.6340189D0,
     7 95.5445023D0,   19.4223270D0,   8.96399975D0,   5.82657051D0,
     8 4.70259953D0,   4.48648214D0,   88.6589890D0,   18.0226364D0,
     9 8.31799984D0,   5.40667248D0,   4.36370134D0,   4.16315889D0,
     * 75.4208908D0,   15.3315916D0,   7.07599974D0,   4.59937668D0,
     1 3.71213651D0,   3.54153800D0,   64.4104691D0,   13.0933867D0,
     2 6.04299974D0,   3.92793012D0,   3.17021489D0,   3.02452135D0,
     3 61.6583939D0,   12.5339441D0,   5.78480005D0,   3.76010108D0,
     4 3.03476095D0,   2.89529252D0,   23.3851681D0,   4.75374651D0,
     5 2.19400001D0,   1.42609274D0,   1.15099323D0,   1.09809697D0,
     6 422.166168D0,   17.4451427D0,   3.71600008D0,   1.56999409D0,
     7 1.02269936D0,   0.0D0,          349.002808D0,   14.4218187D0,
     8 3.07200003D0,   1.29790688D0,   0.845460773D0,  0.0D0,
     9 257.480469D0,   10.6398468D0,   2.26640010D0,   0.957544327D0,
     * 0.623747468D0,  0.0D0,          244.029312D0,   10.0840063D0,
     1 2.14800000D0,   0.907520831D0,  0.591162026D0,  0.0D0,
     2 99.8069687D0,   4.12431622D0,   0.878523052D0,  0.371172220D0,
     3 0.241782799D0,  0.0D0,          96.6063461D0,   3.99205732D0,
     4 0.850350440D0,  0.359269410D0,  0.234029278D0,  0.0D0,
     5 91.2637482D0,   3.77128530D0,   0.803323686D0,  0.339400828D0,
     6 0.221086800D0,  0.0D0,          68.9694824D0,   2.85002112D0,
     7 0.607084632D0,  0.256490648D0,  0.167078853D0,  0.0D0,
     8 53.9939003D0,   2.23118615D0,   0.475266248D0,  0.200797960D0,
     9 0.130800441D0,  0.0D0,          22.1267567D0,   0.914342403D0,
     * 0.194764599D0,  8.228721470D-02,5.360215902D-02,0.0D0,
     1 20.1108532D0,   0.831039429D0,  0.177020177D0,  7.479026914D-02,
     2 4.871862754D-02,0.0D0,          9.97006226D0,   0.411992192D0,
     3 8.775869757D-02,3.707767278D-02,2.415251732D-02,0.0D0,
     4 4.80451918D0,   0.198536798D0,  4.229043797D-02,1.786752976D-02,
     5 1.163896732D-02,0.0D0,          3.23821735D0,   0.133812636D0,
     6 2.850350551D-02,1.204260904D-02,7.844595239D-03,0.0D0/
C * DATA FOR FR ELEMENT #87
      DATA ((XNRG(87, I, J), J = 1, 6), I = 1, 24)/
     1 466.957123D0,   210.535233D0,   143.029312D0,   115.313629D0,
     2 103.596031D0,   0.0D0,          397.334656D0,   80.7703629D0,
     3 37.2779999D0,   24.2305775D0,   19.5563908D0,   18.6576385D0,
     4 381.719696D0,   77.5961456D0,   35.8129997D0,   23.2783337D0,
     5 18.7878399D0,   17.9244061D0,   320.425812D0,   65.1362915D0,
     6 30.0623989D0,   19.5404606D0,   15.7710190D0,   15.0462303D0,
     7 99.1684570D0,   20.1590061D0,   9.30399990D0,   6.04756927D0,
     8 4.88096666D0,   4.65665197D0,   92.2403107D0,   18.7506485D0,
     9 8.65400028D0,   5.62507153D0,   4.53997040D0,   4.33132696D0,
     * 78.0855713D0,   15.8732672D0,   7.32600021D0,   4.76187611D0,
     1 3.84328890D0,   3.66666293D0,   66.8555756D0,   13.5904293D0,
     2 6.27239990D0,   4.07703924D0,   3.29056048D0,   3.13933635D0,
     3 63.9457474D0,   12.9989185D0,   5.99940014D0,   3.89959025D0,
     4 3.14734197D0,   3.00269961D0,   24.5789413D0,   4.99641752D0,
     5 2.30599999D0,   1.49889243D0,   1.20974946D0,   1.15415299D0,
     6 445.342133D0,   18.4028416D0,   3.92000008D0,   1.65618324D0,
     7 1.07884324D0,   0.0D0,          368.088898D0,   15.2105122D0,
     8 3.24000001D0,   1.36888611D0,   0.891696930D0,  0.0D0,
     9 274.158081D0,   11.3290148D0,   2.41319990D0,   1.01956666D0,
     * 0.664149106D0,  0.0D0,          262.206543D0,   10.8351431D0,
     1 2.30800009D0,   0.975120127D0,  0.635196447D0,  0.0D0,
     2 112.011917D0,   4.62866068D0,   0.985953689D0,  0.416561216D0,
     3 0.271349341D0,  0.0D0,          108.546692D0,   4.48546743D0,
     4 0.955451965D0,  0.403674394D0,  0.262954801D0,  0.0D0,
     5 99.9908829D0,   4.13191652D0,   0.880141914D0,  0.371856183D0,
     6 0.242228344D0,  0.0D0,          76.8030090D0,   3.17372537D0,
     7 0.676037073D0,  0.285622776D0,  0.186055616D0,  0.0D0,
     8 60.4199524D0,   2.49672937D0,   0.531829774D0,  0.224695817D0,
     9 0.146367580D0,  0.0D0,          27.0558186D0,   1.11802578D0,
     * 0.238151312D0,  0.100617915D0,  6.554283947D-02,0.0D0,
     1 24.7905121D0,   1.02441657D0,   0.218211561D0,  9.219345450D-02,
     2 6.005511805D-02,0.0D0,          12.6640158D0,   0.523314238D0,
     3 0.111471474D0,  4.709622264D-02,3.067863174D-02,0.0D0,
     4 6.89143038D0,   0.284774095D0,  6.065989658D-02,2.562854625D-02,
     5 1.669451967D-02,0.0D0,          4.82253885D0,   0.199281439D0,
     6 4.244905338D-02,1.793454401D-02,1.168262027D-02,0.0D0/
C * DATA FOR RA ELEMENT #88
      DATA ((XNRG(88, I, J), J = 1, 6), I = 1, 24)/
     1 479.815216D0,   216.332504D0,   146.967758D0,   118.488899D0,
     2 106.448647D0,   0.0D0,          410.076080D0,   83.3604355D0,
     3 38.4734001D0,   25.0075836D0,   20.1835098D0,   19.2559376D0,
     4 394.036865D0,   80.0999832D0,   36.9686012D0,   24.0294685D0,
     5 19.3940773D0,   18.5027847D0,   329.234161D0,   66.9268646D0,
     6 30.8888016D0,   20.0776196D0,   16.2045574D0,   15.4598446D0,
     7 102.792412D0,   20.8956852D0,   9.64400005D0,   6.26856852D0,
     8 5.05933380D0,   4.82682180D0,   95.7043839D0,   19.4548283D0,
     9 8.97900009D0,   5.83632040D0,   4.71046829D0,   4.49398947D0,
     * 80.8312454D0,   16.4314098D0,   7.58360004D0,   4.92931509D0,
     1 3.97842836D0,   3.79559183D0,   69.2473831D0,   14.0766373D0,
     2 6.49679995D0,   4.22289848D0,   3.40828276D0,   3.25164843D0,
     3 66.1883392D0,   13.4547930D0,   6.20980024D0,   4.03634977D0,
     4 3.25771999D0,   3.10800505D0,   25.7599239D0,   5.23648834D0,
     5 2.41680002D0,   1.57091200D0,   1.26787615D0,   1.20960844D0,
     6 22.5452633D0,   4.58301067D0,   2.11520004D0,   1.37487304D0,
     7 1.10965395D0,   1.05865765D0,   399.490082D0,   16.5081005D0,
     8 3.51640010D0,   1.48566401D0,   0.967766345D0,  0.0D0,
     9 288.972504D0,   11.9411907D0,   2.54360008D0,   1.07466018D0,
     * 0.700037122D0,  0.0D0,          273.885406D0,   11.3177481D0,
     1 2.41079998D0,   1.01855266D0,   0.663488567D0,  0.0D0,
     2 135.829346D0,   5.61286688D0,   1.19560003D0,   0.505135894D0,
     3 0.329047173D0,  0.0D0,          135.829346D0,   5.61286688D0,
     4 1.19560003D0,   0.505135894D0,  0.329047173D0,  0.0D0,
     5 115.607178D0,   4.77722740D0,   1.01760006D0,   0.429931641D0,
     6 0.280058891D0,  0.0D0,          91.0679245D0,   3.76319337D0,
     7 0.801599979D0,  0.338672578D0,  0.220612422D0,  0.0D0,
     8 69.4370193D0,   2.86934090D0,   0.611199975D0,  0.258229375D0,
     9 0.168211460D0,  0.0D0,          30.5377464D0,   1.26190913D0,
     * 0.268799990D0,  0.113566853D0,  7.397782058D-02,0.0D0,
     1 30.5377464D0,   1.26190913D0,   0.268799990D0,  0.113566853D0,
     2 7.397782058D-02,0.0D0,          19.7677383D0,   0.816860855D0,
     3 0.173999995D0,  7.351426035D-02,4.788742587D-02,0.0D0,
     4 8.54329777D0,   0.353034109D0,  7.519999892D-02,3.177167848D-02,
     5 2.069617435D-02,0.0D0,          8.54329777D0,   0.353034109D0,
     6 7.519999892D-02,3.177167848D-02,2.069617435D-02,0.0D0/
C * DATA FOR AC ELEMENT #89
      DATA ((XNRG(89, I, J), J = 1, 6), I = 1, 24)/
     1 492.897217D0,   222.230743D0,   150.974792D0,   121.719460D0,
     2 109.350937D0,   0.0D0,          422.936829D0,   85.9747772D0,
     3 39.6800003D0,   25.7918701D0,   20.8165035D0,   19.8598404D0,
     4 406.803864D0,   82.6952591D0,   38.1664009D0,   24.8080349D0,
     5 20.0224552D0,   19.1022835D0,   338.328156D0,   68.7754898D0,
     6 31.7420006D0,   20.6321964D0,   16.6521549D0,   15.8868713D0,
     7 106.629539D0,   21.6756973D0,   10.0039997D0,   6.50256729D0,
     8 5.24819326D0,   5.00700188D0,   99.2537231D0,   20.1763401D0,
     9 9.31200027D0,   6.05276918D0,   4.88516331D0,   4.66065598D0,
     * 83.3296432D0,   16.9392853D0,   7.81799984D0,   5.08167410D0,
     1 4.10139704D0,   3.91290903D0,   71.8438416D0,   14.6044455D0,
     2 6.74039984D0,   4.38123798D0,   3.53607774D0,   3.37357020D0,
     3 68.6206512D0,   13.9492350D0,   6.43800020D0,   4.18467903D0,
     4 3.37743568D0,   3.22221899D0,   27.0517559D0,   5.49909258D0,
     5 2.53800011D0,   1.64969170D0,   1.33145881D0,   1.27026904D0,
     6 23.0227718D0,   4.68007898D0,   2.16000009D0,   1.40399289D0,
     7 1.13315642D0,   1.08107996D0,   404.443359D0,   16.7127857D0,
     8 3.55999994D0,   1.50408483D0,   0.979765713D0,  0.0D0,
     9 306.695313D0,   12.6735487D0,   2.69959998D0,   1.14056945D0,
     * 0.742970705D0,  0.0D0,          289.472382D0,   11.9618473D0,
     1 2.54800010D0,   1.07651913D0,   0.701248050D0,  0.0D0,
     2 138.121368D0,   5.70758009D0,   1.21577489D0,   0.513659716D0,
     3 0.334599614D0,  0.0D0,          134.087570D0,   5.54089117D0,
     4 1.18026841D0,   0.498658359D0,  0.324827671D0,  0.0D0,
     5 118.722435D0,   4.90595865D0,   1.04502118D0,   0.441516966D0,
     6 0.287605584D0,  0.0D0,          93.6906281D0,   3.87157130D0,
     7 0.824685633D0,  0.348426163D0,  0.226965934D0,  0.0D0,
     8 74.1787567D0,   3.06528354D0,   0.652937829D0,  0.275863439D0,
     9 0.179698348D0,  0.0D0,          37.7796021D0,   1.56116390D0,
     * 0.332544416D0,  0.140498593D0,  9.152124077D-02,0.0D0,
     1 34.9634132D0,   1.44479060D0,   0.307755679D0,  0.130025461D0,
     2 8.469901234D-02,0.0D0,          18.3879013D0,   0.759841919D0,
     3 0.161854371D0,  6.838277727D-02,4.454476759D-02,0.0D0,
     4 11.4448824D0,   0.472936064D0,  0.100740388D0,  4.256238416D-02,
     5 2.772527561D-02,0.0D0,          8.36247349D0,   0.345561922D0,
     6 7.360834628D-02,3.109921142D-02,2.025812678D-02,0.0D0/
C * DATA FOR TH ELEMENT #90
      DATA ((XNRG(90, I, J), J = 1, 6), I = 1, 24)/
     1 506.266418D0,   228.258469D0,   155.069794D0,   125.020943D0,
     2 112.316940D0,   0.0D0,          436.411560D0,   88.7139282D0,
     3 40.9441986D0,   26.6135941D0,   21.4797153D0,   20.4925709D0,
     4 419.807465D0,   85.3386383D0,   39.3864021D0,   25.6010303D0,
     5 20.6624794D0,   19.7128944D0,   347.479706D0,   70.6358185D0,
     6 32.6006012D0,   21.1902828D0,   17.1025829D0,   16.3166008D0,
     7 110.473068D0,   22.4570122D0,   10.3646002D0,   6.73695612D0,
     8 5.43736744D0,   5.18748236D0,   102.971481D0,   20.9320869D0,
     9 9.66079998D0,   6.27948856D0,   5.06814718D0,   4.83523035D0,
     * 86.2522583D0,   17.5333958D0,   8.09220028D0,   5.25990343D0,
     1 4.24524498D0,   4.05014610D0,   74.4147110D0,   15.1270542D0,
     2 6.98159981D0,   4.53801727D0,   3.66261339D0,   3.49429083D0,
     3 71.0295105D0,   14.4389095D0,   6.66400003D0,   4.33157825D0,
     4 3.49599743D0,   3.33533192D0,   28.3414593D0,   5.76126385D0,
     5 2.65899992D0,   1.72834122D0,   1.39493656D0,   1.33082950D0,
     6 24.9029655D0,   5.06228542D0,   2.33640003D0,   1.51865232D0,
     7 1.22569752D0,   1.16936815D0,   439.570862D0,   18.1643562D0,
     8 3.86919999D0,   1.63472044D0,   1.06486225D0,   0.0D0,
     9 324.509003D0,   13.4096622D0,   2.85640001D0,   1.20681679D0,
     * 0.786124408D0,  0.0D0,          307.376953D0,   12.7017164D0,
     1 2.70560002D0,   1.14310443D0,   0.744621992D0,  0.0D0,
     2 156.505951D0,   6.46728468D0,   1.37759995D0,   0.582030118D0,
     3 0.379136324D0,  0.0D0,          152.325180D0,   6.29452324D0,
     4 1.34080005D0,   0.566482306D0,  0.369008392D0,  0.0D0,
     5 131.875809D0,   5.44949436D0,   1.16079998D0,   0.490433037D0,
     6 0.319469690D0,  0.0D0,          104.246414D0,   4.30776739D0,
     7 0.917599976D0,  0.387682080D0,  0.252537370D0,  0.0D0,
     8 82.6155090D0,   3.41391516D0,   0.727200031D0,  0.307238907D0,
     9 0.200136423D0,  0.0D0,          42.8528175D0,   1.77080405D0,
     * 0.377200007D0,  0.159365386D0,  0.103811137D0,  0.0D0,
     1 39.9444618D0,   1.65062225D0,   0.351599991D0,  0.148549497D0,
     2 9.676562995D-02,0.0D0,          27.0386295D0,   1.11731541D0,
     3 0.238000005D0,  0.100553982D0,  6.550119072D-02,0.0D0,
     4 22.2671070D0,   0.920142114D0,  0.195999995D0,  8.280916512D-02,
     5 5.394215882D-02,0.0D0,          19.5405216D0,   0.807471633D0,
     6 0.172000006D0,  7.266926765D-02,4.733699560D-02,0.0D0/
C * DATA FOR PA ELEMENT #91
      DATA ((XNRG(91, I, J), J = 1, 6), I = 1, 24)/
     1 519.889099D0,   234.400482D0,   159.242432D0,   128.385025D0,
     2 115.339180D0,   0.0D0,          449.894806D0,   91.4548035D0,
     3 42.2091980D0,   27.4358406D0,   22.1433449D0,   21.1257038D0,
     4 433.034882D0,   88.0275192D0,   40.6273994D0,   26.4076767D0,
     5 21.3135185D0,   20.3340130D0,   356.705872D0,   72.5113220D0,
     6 33.4662018D0,   21.7529202D0,   17.5566864D0,   16.7498341D0,
     7 114.408257D0,   23.2569580D0,   10.7337999D0,   6.97693491D0,
     8 5.63105297D0,   5.37226677D0,   106.606094D0,   21.6709328D0,
     9 10.0018005D0,   6.50113726D0,   5.24703884D0,   5.00590086D0,
     * 88.9744873D0,   18.0867710D0,   8.34759998D0,   5.42591286D0,
     1 4.37923002D0,   4.17797375D0,   76.9813232D0,   15.6487970D0,
     2 7.22239971D0,   4.69453621D0,   3.78893948D0,   3.61481118D0,
     3 73.3701630D0,   14.9147177D0,   6.88359976D0,   4.47431755D0,
     4 3.61120176D0,   3.44524169D0,   29.5693417D0,   6.01086807D0,
     5 2.77420020D0,   1.80322099D0,   1.45537162D0,   1.38848710D0,
     6 26.0988693D0,   5.30538940D0,   2.44860005D0,   1.59158194D0,
     7 1.28455877D0,   1.22552431D0,   21.4602070D0,   4.36244011D0,
     8 2.01340008D0,   1.30870342D0,   1.05624866D0,   1.00770664D0,
     9 337.823822D0,   13.9598703D0,   2.97359991D0,   1.25633335D0,
     * 0.818379641D0,  0.0D0,          321.827850D0,   13.2988701D0,
     1 2.83279991D0,   1.19684589D0,   0.779629350D0,  0.0D0,
     2 168.684692D0,   6.97054577D0,   1.48479998D0,   0.627321661D0,
     3 0.408639371D0,  0.0D0,          163.367859D0,   6.75083828D0,
     4 1.43799996D0,   0.607548833D0,  0.395759314D0,  0.0D0,
     5 140.691757D0,   5.81379557D0,   1.23839998D0,   0.523218691D0,
     6 0.340826362D0,  0.0D0,          106.165833D0,   4.38708353D0,
     7 0.934495151D0,  0.394820213D0,  0.257187188D0,  0.0D0,
     8 83.1835709D0,   3.43738890D0,   0.732200205D0,  0.309351444D0,
     9 0.201512545D0,  0.0D0,          43.9338608D0,   1.81547582D0,
     * 0.386715561D0,  0.163385674D0,  0.106429957D0,  0.0D0,
     1 40.5537643D0,   1.67580032D0,   0.356963187D0,  0.150815427D0,
     2 9.824166447D-02,0.0D0,          20.6577549D0,   0.853638947D0,
     3 0.181834131D0,  7.682414353D-02,5.004349723D-02,0.0D0,
     4 12.9717808D0,   0.536032021D0,  0.114180483D0,  4.824076593D-02,
     5 3.142419457D-02,0.0D0,          9.23429012D0,   0.381587923D0,
     6 8.128226548D-02,3.434140980D-02,2.237010561D-02,0.0D0/
C * DATA FOR U  ELEMENT #92
      DATA ((XNRG(92, I, J), J = 1, 6), I = 1, 24)/
     1 533.762024D0,   240.655319D0,   163.491714D0,   131.810898D0,
     2 118.416931D0,   0.0D0,          463.810791D0,   94.2836533D0,
     3 43.5148010D0,   28.2844772D0,   22.8282757D0,   21.7791576D0,
     4 446.547974D0,   90.7744598D0,   41.8951988D0,   27.2317429D0,
     5 21.9786186D0,   20.9685478D0,   365.940582D0,   74.3885498D0,
     6 34.3325996D0,   22.3160782D0,   18.0112076D0,   17.1834660D0,
     7 118.268829D0,   24.0417385D0,   11.0959997D0,   7.21236372D0,
     8 5.82106686D0,   5.55354786D0,   110.470932D0,   22.4565792D0,
     9 10.3643999D0,   6.73682594D0,   5.43726254D0,   5.18738222D0,
     * 91.7372208D0,   18.6483803D0,   8.60680008D0,   5.59439182D0,
     1 4.51520872D0,   4.30770350D0,   79.4626694D0,   16.1532059D0,
     2 7.45519972D0,   4.84585571D0,   3.91106844D0,   3.73132753D0,
     3 75.7129440D0,   15.3909588D0,   7.10339975D0,   4.61718655D0,
     4 3.72651100D0,   3.55525160D0,   30.7140846D0,   6.24357176D0,
     5 2.88160014D0,   1.87303054D0,   1.51171470D0,   1.44224083D0,
     6 27.1285000D0,   5.51469278D0,   2.54519987D0,   1.65437162D0,
     7 1.33523607D0,   1.27387261D0,   22.2745323D0,   4.52797604D0,
     8 2.08979988D0,   1.35836315D0,   1.09632885D0,   1.04594493D0,
     9 354.637756D0,   14.6546717D0,   3.12159991D0,   1.31886268D0,
     * 0.859111428D0,  0.0D0,          335.233551D0,   13.8528328D0,
     1 2.95079994D0,   1.24670041D0,   0.812104702D0,  0.0D0,
     2 177.818756D0,   7.34799194D0,   1.56519997D0,   0.661290348D0,
     3 0.430766672D0,  0.0D0,          173.092667D0,   7.15269661D0,
     4 1.52359998D0,   0.643714488D0,  0.419317722D0,  0.0D0,
     5 147.099228D0,   6.07857132D0,   1.29480004D0,   0.547047496D0,
     6 0.356348515D0,  0.0D0,          117.833893D0,   4.86924171D0,
     7 1.03719997D0,   0.438212574D0,  0.285453111D0,  0.0 D0,
     8 88.6594391D0,   3.66366792D0,   0.780400038D0,  0.329715669D0,
     9 0.214777872D0,  0.0D0,          47.7152290D0,   1.97173309D0,
     * 0.419999987D0,  0.177448213D0,  0.115590341D0,  0.0D0,
     1 43.7616806D0,   1.80836093D0,   0.385199994D0,  0.162745357D0,
     2 0.106012858D0,  0.0D0,          32.1282539D0,   1.32763362D0,
     3 0.282799989D0,  0.119481795D0,  7.783082873D-02,0.0D0,
     4 19.2224197D0,   0.794326723D0,  0.169200003D0,  7.148627937D-02,
     5 4.656639323D-02,0.0D0,          14.6781130D0,   0.606542647D0,
     6 0.129199997D0,  5.458644778D-02,3.555779159D-02,0.0D0/
C * DATA FOR LI ELEMENT # 3
      DATA ((XSC(3, I, J), J = 1, 10), I = 1, 2)/
     1 1.301553100D-03,5.167718977D-02,2.04572558D0,   73.6826706D0,
     2 2367.26001D0,   6.531799585D-02,2174.78979D0,   189729.859D0,
     3 1618910.88D0,   3022227.00D0,   2.456936636D-05,8.661831380D-04,
     4 3.219022229D-02,1.14365172D0,   35.4625931D0,   2.25543308D0,
     5 17745.8359D0,   440576.219D0,   1333729.63D0,   1448481.13D0/
C * DATA FOR BE ELEMENT # 4
      DATA ((XSC(4, I, J), J = 1, 10), I = 1, 2)/
     1 5.501731299D-03,0.216350690D0,  8.28356647D0,   277.734161D0,
     2 7976.12500D0,   2.560380660D-02,866.962646D0,   81105.0859D0,
     3 771925.063D0,   2051785.63D0,   2.081731509D-04,7.329026237D-03,
     4 0.263835013D0,  8.65200520D0,   237.105286D0,   4.02921534D0,
     5 31112.8418D0,   621490.375D0,   1648233.50D0,   1031229.06D0/
C * DATA FOR B  ELEMENT # 5
      DATA ((XSC(5, I, J), J = 1, 10), I = 1, 3)/
     1 1.651980355D-02,0.639404237D0,  23.6173916D0,   741.657715D0,
     2 19577.5059D0,   1.335961837D-02,447.895050D0,   43871.5781D0,
     3 435450.094D0,   1167093.38D0,   8.280635811D-04,2.931262553D-02,
     4 1.02559197D0,   31.2025394D0,   776.768555D0,   3.39596200D0,
     5 26979.2715D0,   581240.375D0,   1365937.50D0,   870618.875D0,
     6 1.498534630D-07,1.311181040D-05,1.204593806D-03,0.104659230D0,
     7 7.67965651D0,   0.400328189D0,  30321.8242D0,   1377606.13D0,
     8 6894477.00D0,   14448549.0D0/
C * DATA FOR C  ELEMENT # 6
      DATA ((XSC(6, I, J), J = 1, 10), I = 1, 3)/
     1 4.022771120D-02,1.52750432D0,   54.3804855D0,   1610.34399D0,
     2 39562.0547D0,   8.320189081D-03,275.130463D0,   27737.3262D0,
     3 281872.813D0,   765563.438D0,   2.234945307D-03,7.857172936D-02,
     4 2.65592504D0,   75.4173965D0,   1707.09705D0,   2.68837976D0,
     5 21804.5703D0,   492388.406D0,   1077516.38D0,   678007.188D0,
     6 1.561928684D-06,1.310063381D-04,1.182175893D-02,0.941143930D0,
     7 63.7416344D0,   1.06329751D0,   76115.4297D0,   3070108.00D0,
     8 11207961.0D0,   18938980.0D0/
C * DATA FOR N  ELEMENT # 7
      DATA ((XSC(7, I, J), J = 1, 10), I = 1, 4)/
     1 8.473966271D-02,3.15485168D0,   108.397171D0,   3054.15259D0,
     2 70342.9141D0,   5.561249331D-03,182.452774D0,   18816.3184D0,
     3 196109.391D0,   545683.125D0,   4.933742341D-03,0.170914933D0,
     4 5.56366348D0,   148.861649D0,   3093.78003D0,   2.19790149D0,
     5 17981.0859D0,   406345.625D0,   854337.875D0,   509074.750D0,
     6 5.528737347D-06,4.511051520D-04,3.958846256D-02,2.99486256D0,
     7 182.204178D0,   0.817081749D0,  60970.3750D0,   2508748.50D0,
     8 7526410.50D0,   10705870.0D0,   2.359686050D-06,2.124716120D-04,
     9 1.939095370D-02,1.48126984D0,   90.3186340D0,   0.402362198D0,
     * 30338.6758D0,   1251751.25D0,   3764252.50D0,   5362577.00D0/
C * DATA FOR O  ELEMENT # 8
      DATA ((XSC(8, I, J), J = 1, 10), I = 1, 4)/
     1 0.160504997D0,  5.85706615D0,   194.312134D0,   5221.68848D0,
     2 111657.734D0,   4.204052500D-03,135.399689D0,   14075.4473D0,
     3 147497.984D0,   417832.938D0,   9.546677582D-03,0.325384855D0,
     4 10.1911001D0,   256.266083D0,   4902.52197D0,   5.65027618D0,
     5 33413.8359D0,   514644.063D0,   839019.875D0,   466361.438D0,
     6 1.560978126D-05,1.245745225D-03,0.105102435D0,  7.58270359D0,
     7 419.397400D0,   5.73374319D0,   230141.391D0,   3959252.50D0,
     8 8621531.00D0,   10632627.0D0,   1.317946135D-05,1.174610457D-03,
     9 0.102651693D0,  7.48369217D0,   415.102356D0,   5.65493631D0,
     * 228981.328D0,   3953836.50D0,   8638009.00D0,   10673776.0D0/
C * DATA FOR F  ELEMENT # 9
      DATA ((XSC(9, I, J), J = 1, 10), I = 1, 4)/
     1 0.280725479D0,  10.0407209D0,   322.387848D0,   8296.84570D0,
     2 164967.891D0,   3.362095449D-03,102.271927D0,   10743.9775D0,
     3 113532.219D0,   328530.594D0,   1.684946194D-02,0.564888954D0,
     4 17.0781956D0,   405.708954D0,   7241.59912D0,   4.16125727D0,
     5 25509.5801D0,   409591.969D0,   663627.438D0,   342294.719D0,
     6 3.755814032D-05,2.953280695D-03,0.240616351D0,  16.3673668D0,
     7 847.311951D0,   6.02639341D0,   224444.438D0,   3326680.75D0,
     8 6272801.50D0,   6917325.50D0,   4.756415365D-05,4.174075089D-03,
     9 0.351481318D0,  24.1645908D0,   1255.78772D0,   8.86773872D0,
     * 334560.344D0,   4983429.00D0,   9439702.00D0,   10439668.0D0/
C * DATA FOR NE ELEMENT #10
      DATA ((XSC(10, I, J), J = 1, 10), I = 1, 4)/
     1 0.461048841D0,  16.1760311D0,   504.382843D0,   12496.9648D0,
     2 235837.344D0,   2.751233522D-03,77.5974884D0,   8264.11914D0,
     3 88570.9688D0,   262354.688D0,   2.783099376D-02,0.915888429D0,
     4 26.7597961D0,   604.638611D0,   10104.3848D0,   2.09819627D0,
     5 14937.3867D0,   281951.719D0,   503242.344D0,   240853.344D0,
     6 8.132271614D-05,6.272922270D-03,0.495196134D0,  31.8960037D0,
     7 1569.13635D0,   0.647712648D0,  45953.0586D0,   1562452.63D0,
     8 3068620.50D0,   2868416.00D0,   1.363403426D-04,1.177385636D-02,
     9 0.960985005D0,  62.6071243D0,   3095.17505D0,   1.25661778D0,
     * 91011.9609D0,   3113751.25D0,   6153211.00D0,   5780000.50D0/
C * DATA FOR NA ELEMENT #11
      DATA ((XSC(11, I, J), J = 1, 11), I = 1, 4)/
     1 0.719678938D0,  24.7575035D0,   749.831604D0,   17837.6504D0,
     2 0.0000D+00,     40.4996109D0,   5139.83252D0,   44760.4258D0,
     3 137345.703D0,   242031.281D0,   194894.047D0,   4.549028352D-02,
     4 1.47548819D0,   41.7576790D0,   896.968445D0,   13934.4736D0,
     5 1.17296302D0,   9320.54199D0,   201357.344D0,   518224.594D0,
     6 355563.563D0,   0.0D0,          1.788535155D-04,1.378671546D-02,
     7 1.06470704D0,   65.0138245D0,   2978.45313D0,   0.172413975D0,
     8 16576.0566D0,   938347.875D0,   2437551.50D0,   1397262.13D0,
     9 0.0D0,          3.001188161D-04,2.587055042D-02,2.06276727D0,
     * 127.485764D0,   5874.59863D0,   0.329745412D0,  32774.9375D0,
     1 1869307.13D0,   4888040.00D0,   2814550.00D0,   0.0D0/
C * DATA FOR MG ELEMENT #12
      DATA ((XSC(12, I, J), J = 1, 11), I = 1, 4)/
     1 1.07748890D0,   36.3590317D0,   1071.03394D0,   24479.2656D0,
     2 0.000000000D0,  31.9452724D0,   4077.84326D0,   35751.1758D0,
     3 110366.938D0,   192795.563D0,   195278.125D0,   7.123360038D-02,
     4 2.27467704D0,   62.3694611D0,   1277.60583D0,   18539.1563D0,
     5 0.615424693D0,  5559.92969D0,   139329.063D0,   436742.563D0,
     6 487870.688D0,   0.0D0,          3.576920135D-04,2.731011063D-02,
     7 2.05052972D0,   119.007393D0,   5120.11670D0,   4.636003450D-02,
     8 5738.63086D0,   450838.188D0,   2111516.75D0,   1120995.88D0,
     9 0.0D0,          5.990033969D-04,5.106269196D-02,3.96210837D0,
     * 232.971024D0,   10091.8086D0,   8.693627268D-02,11313.0215D0,
     1 896493.500D0,   4229249.00D0,   2257596.50D0,   0.0D0/
C * DATA FOR AL ELEMENT #13
      DATA ((XSC(13, I, J), J = 1, 11), I = 1, 5)/
     1 1.55751050D0,   51.5725327D0,   1478.33850D0,   32428.1270D0,
     2 0.000000000D0,  25.9100971D0,   3315.86548D0,   29194.6914D0,
     3 90483.5703D0,   157688.125D0,   167248.469D0,   0.107318684D0,
     4 3.36706495D0,   89.3895264D0,   1748.37085D0,   23709.1934D0,
     5 0.384381026D0,  3783.99194D0,   104031.250D0,   369606.750D0,
     6 494166.094D0,   0.0D0,          6.674015895D-04,5.023531988D-02,
     7 3.65229011D0,   201.835403D0,   8114.76563D0,   2.148255892D-02,
     8 2929.53931D0,   269588.344D0,   1592395.75D0,   1433475.88D0,
     9 0.0D0,          1.112943166D-03,9.348440170D-02,7.03663921D0,
     * 394.388367D0,   15981.2051D0,   3.948111460D-02,5758.07031D0,
     1 535215.063D0,   3186256.00D0,   2885157.25D0,   0.0D0,
     2 7.879838347D-03,0.224162638D0,  5.65236759D0,   109.529068D0,
     3 1489.20581D0,   58.8560448D0,   45791.7344D0,   266193.563D0,
     4 71344.7734D0,   347980.688D0,   0.0D0/
C * DATA FOR SI ELEMENT #14
      DATA ((XSC(14, I, J), J = 1, 11), I = 1, 6)/
     1 2.18636870D0,   71.0673218D0,   1984.17834D0,   41781.9570D0,
     2 0.000000000D0,  21.3957233D0,   2740.57544D0,   24228.9063D0,
     3 75374.5000D0,   131083.328D0,   142535.563D0,   0.156227812D0,
     4 4.81014633D0,   123.655083D0,   2312.42090D0,   29410.8008D0,
     5 0.263393164D0,  2770.06958D0,   81446.5391D0,   310726.656D0,
     6 444896.500D0,   0.0D0,          1.176461577D-03,8.714818954D-02,
     7 6.12822819D0,   323.639862D0,   12196.4600D0,   1.126069110D-02,
     8 1652.95496D0,   172008.016D0,   1209017.13D0,   1656120.25D0,
     9 0.0D0,          1.959844725D-03,0.161601678D0,  11.7720785D0,
     * 631.226135D0,   24000.7852D0,   2.011139318D-02,3237.92676D0,
     1 340892.344D0,   2417061.00D0,   3331674.75D0,   0.0D0,
     2 1.411816571D-02,0.401187301D0,  9.87669754D0,   183.102570D0,
     3 2358.03467D0,   44.4429398D0,   42208.6055D0,   313736.125D0,
     4 162653.281D0,   80005.2031D0,   0.0D0,          6.249973376D-05,
     5 3.996924497D-03,0.261709213D0,  13.4452877D0,   475.203278D0,
     6 32.8313789D0,   122243.977D0,   216556.953D0,   11214985.0D0,
     7 32290612.0D0,   0.0D0/
C * DATA FOR P  ELEMENT #15
      DATA ((XSC(15, I, J), J = 1, 11), I = 1, 7)/
     1 2.99109888D0,   95.5345459D0,   2601.35400D0,   52644.3086D0,
     2 0.000000000D0,  17.7680607D0,   2290.75854D0,   20345.6113D0,
     3 63556.0977D0,   110514.297D0,   121777.781D0,   0.220793724D0,
     4 6.66793537D0,   166.183395D0,   2980.13110D0,   35851.7344D0,
     5 0.176890522D0,  1945.68689D0,   61948.0781D0,   254934.203D0,
     6 385898.719D0,   0.0D0,          1.978232060D-03,0.144055828D0,
     7 9.80049324D0,   496.497589D0,   17670.9141D0,   6.065215450D-03,
     8 949.569885D0,   110775.891D0,   887976.250D0,   1629468.25D0,
     9 0.0D0,          3.278829157D-03,0.265864342D0,  18.7691917D0,
     * 966.596558D0,   34750.7227D0,   1.049841568D-02,1852.47876D0,
     1 219093.813D0,   1773571.75D0,   3276616.50D0,   0.0D0,
     2 2.243389189D-02,0.631072283D0,  15.1140366D0,   268.409637D0,
     3 3296.84058D0,   34.8709259D0,   38114.8672D0,   321233.156D0,
     4 227968.109D0,   4926.22803D0,   0.0D0,          1.338380243D-04,
     5 8.599226363D-03,0.548111379D0,  26.8109093D0,   882.155823D0,
     6 30.0270767D0,   129890.227D0,   204304.078D0,   12901790.0D0,
     7 30727232.0D0,   0.0D0,          5.532951764D-05,3.981444519D-03,
     8 0.261431783D0,  12.9882307D0,   431.338715D0,   14.9381475D0,
     9 65373.6758D0,   102237.445D0,   6433917.50D0,   15425960.0D0,
     * 0.0D0/
C * DATA FOR S  ELEMENT #16
      DATA ((XSC(16, I, J), J = 1, 11), I = 1, 7)/
     1 4.00297880D0,   125.645302D0,   3336.60425D0,   64908.2656D0,
     2 0.000000000D0,  15.0581884D0,   1949.67810D0,   17367.4648D0,
     3 54399.3633D0,   94464.5781D0,   105087.281D0,   0.303693503D0,
     4 8.99559212D0,   217.438217D0,   3737.79248D0,   42614.5664D0,
     5 0.130291492D0,  1515.55530D0,   50511.7813D0,   218041.891D0,
     6 344550.156D0,   0.0D0,          3.195327241D-03,0.228410363D0,
     7 15.0264416D0,   729.671326D0,   24527.0723D0,   4.100469407D-03,
     8 656.268738D0,   81419.5938D0,   699896.000D0,   1532038.00D0,
     9 0.0D0,          5.274787080D-03,0.419763833D0,  28.6901493D0,
     * 1417.97913D0,   48208.3945D0,   6.840255111D-03,1274.83459D0,
     1 160726.359D0,   1396900.50D0,   3080348.75D0,   0.0D0,
     2 3.336768597D-02,0.925767303D0,  21.5492477D0,   366.828888D0,
     3 4318.39111D0,   28.5174408D0,   34478.0508D0,   311271.250D0,
     4 263840.156D0,   5097.19873D0,   0.0D0,          2.531304199D-04,
     5 1.616474427D-02,0.997793913D0,  46.4188728D0,   1431.60376D0,
     6 26.2621441D0,   127479.820D0,   190660.828D0,   13336919.0D0,
     7 26273610.0D0,   0.0D0,          2.077342215D-04,1.485415734D-02,
     8 0.948392630D0,  44.8675652D0,   1397.84741D0,   26.2266979D0,
     9 128772.211D0,   192191.422D0,   13350413.0D0,   26480780.0D0,
     * 0.0D0/
C * DATA FOR CL ELEMENT #17
      DATA ((XSC(17, I, J), J = 1, 11), I = 1, 7)/
     1 5.25414228D0,   162.141266D0,   4201.44678D0,   78930.8828D0,
     2 0.000000000D0,  12.9650497D0,   1677.90186D0,   14986.1406D0,
     3 47054.5273D0,   81640.5781D0,   91375.2969D0,   0.408017427D0,
     4 11.8550882D0,   278.075928D0,   4582.91162D0,   49648.3242D0,
     5 0.106112912D0,  1241.04224D0,   42662.8477D0,   190254.953D0,
     6 310957.031D0,   0.0D0,          4.981699865D-03,0.349480033D0,
     7 22.2610455D0,   1037.18677D0,   33091.1836D0,   2.997984877D-03,
     8 469.981140D0,   61464.7539D0,   560663.125D0,   1384550.63D0,
     9 0.0D0,          8.185919374D-03,0.639391720D0,  42.3526001D0,
     * 2009.42236D0,   64820.0625D0,   4.982291255D-03,933.104126D0,
     1 123397.305D0,   1131530.13D0,   2813498.00D0,   0.0D0,
     2 4.733937234D-02,1.29461861D0,   29.2959709D0,   478.582855D0,
     3 5403.11523D0,   39.7703285D0,   42692.8984D0,   342222.719D0,
     4 275203.469D0,   19442.5215D0,   0.0D0,          4.393915879D-04,
     5 2.781425416D-02,1.66258872D0,   73.4911575D0,   2122.91431D0,
     6 66.6478119D0,   197430.234D0,   462803.625D0,   20593570.0D0,
     7 28671536.0D0,   0.0D0,          5.393139436D-04,3.811880946D-02,
     8 2.36163688D0,   106.294724D0,   3105.21143D0,   96.3641510D0,
     9 295091.563D0,   665788.375D0,   30513632.0D0,   43049564.0D0,
     * 0.0D0/
C * DATA FOR AR ELEMENT #18
      DATA ((XSC(18, I, J), J = 1, 11), I = 1, 7)/
     1 6.78045702D0,   205.872787D0,   5211.41455D0,   0.00000000D0,
     2 0.000000000D0,  11.2206945D0,   1451.25696D0,   13007.5967D0,
     3 40969.3633D0,   71071.4063D0,   79858.5313D0,   0.537745595D0,
     4 15.3215637D0,   349.145355D0,   5530.56934D0,   57249.9609D0,
     5 8.058060706D-02,990.483459D0,   35425.1172D0,   163749.750D0,
     6 276381.094D0,   0.0D0,          7.535587996D-03,0.518801868D0,
     7 32.0660934D0,   1437.97949D0,   43965.0234D0,   2.033560770D-03,
     8 325.793732D0,   45366.8281D0,   443202.438D0,   1192494.38D0,
     9 0.0D0,          1.232103910D-02,0.945011258D0,  60.8128281D0,
     * 2780.07568D0,   86040.3672D0,   3.250034759D-03,644.774658D0,
     1 91015.1250D0,   894592.375D0,   2427436.25D0,   0.0D0,
     2 6.486418098D-02,1.74860966D0,   38.5277634D0,   606.492554D0,
     3 6609.77051D0,   19.1251431D0,   27166.3066D0,   268914.438D0,
     4 284672.375D0,   42450.8164D0,   0.0D0,          7.182126865D-04,
     5 4.501340538D-02,2.61000037D0,   110.124474D0,   3000.17920D0,
     6 13.2102203D0,   91612.4297D0,   198423.344D0,   10275668.0D0,
     7 15258303.0D0,   0.0D0,          1.170826145D-03,8.175848424D-02,
     8 4.92371416D0,   211.844940D0,   5842.46826D0,   25.1585808D0,
     9 181295.203D0,   407273.000D0,   20135490.0D0,   30561258.0D0,
     * 0.0D0/
C * DATA FOR K  ELEMENT #19
      DATA ((XSC(19, I, J), J = 1, 11), I = 1, 7)/
     1 8.61559391D0,   257.381226D0,   6361.01416D0,   0.00000000D0,
     2 0.000000000D0,  9.75314999D0,   1266.26306D0,   11374.3389D0,
     3 35897.2773D0,   62242.4883D0,   70476.5469D0,   0.695426166D0,
     4 19.4439659D0,   430.745331D0,   6562.66797D0,   64891.7344D0,
     5 6.338828057D-02,788.968140D0,   29275.7754D0,   139685.906D0,
     6 254293.172D0,   0.0D0,          1.109857671D-02,0.749247313D0,
     7 44.9230194D0,   1933.97839D0,   56408.4883D0,   1.546652056D-03,
     8 238.654984D0,   34589.0430D0,   352950.938D0,   918931.813D0,
     9 0.0D0,          1.805134118D-02,1.35872793D0,   84.9236145D0,
     * 3731.17749D0,   110303.227D0,   2.377696102D-03,470.763550D0,
     1 69328.6250D0,   712621.875D0,   1866130.50D0,   0.0D0,
     2 8.954766393D-02,2.38756752D0,   51.3165588D0,   778.871826D0,
     3 8213.99219D0,   11.3997135D0,   19505.7285D0,   222586.125D0,
     4 398011.063D0,   198676.953D0,   0.0D0,          1.234294148D-03,
     5 7.772114873D-02,4.40419769D0,   177.011063D0,   4530.33447D0,
     6 6.19070959D0,   62596.0508D0,   371854.625D0,   2104738.75D0,
     7 26572800.0D0,   0.0D0,          2.018780215D-03,0.141051933D0,
     8 8.31027031D0,   341.028473D0,   8845.39355D0,   11.7073212D0,
     9 123850.641D0,   762296.438D0,   4081948.00D0,   52652676.0D0,
     * 0.0D0/
C * DATA FOR CA ELEMENT #20
      DATA ((XSC(20, I, J), J = 1, 11), I = 1, 7)/
     1 10.8012180D0,   317.499695D0,   7660.65479D0,   0.00000000D0,
     2 0.000000000D0,  8.58940220D0,   1112.51978D0,   10011.2959D0,
     3 31645.1211D0,   54821.7813D0,   62620.7578D0,   0.886400521D0,
     4 24.3066006D0,   523.445618D0,   7676.92627D0,   72531.1406D0,
     5 5.192638189D-02,645.348877D0,   24651.0664D0,   120790.688D0,
     6 221150.344D0,   0.0D0,          1.598180458D-02,1.05744219D0,
     7 61.5380554D0,   2544.06226D0,   70789.5391D0,   1.159604290D-03,
     8 180.250580D0,   26956.6484D0,   284359.000D0,   774663.750D0,
     9 0.0D0,          2.587469853D-02,1.90957880D0,   115.956467D0,
     * 4897.30762D0,   138282.609D0,   1.726604300D-03,354.880554D0,
     1 54049.7734D0,   574529.375D0,   1575394.13D0,   0.0D0,
     2 0.121023893D0,  3.18752408D0,   66.8213043D0,   979.660217D0,
     3 10024.3721D0,   7.39177656D0,   14683.5410D0,   186835.031D0,
     4 421672.531D0,   383247.125D0,   0.0D0,          1.983818365D-03,
     5 0.123837739D0,  6.82274866D0,   261.554993D0,   6312.27588D0,
     6 2.69190574D0,   38421.3984D0,   406731.313D0,   350113.156D0,
     7 4626078.50D0,   0.0D0,          3.220621264D-03,0.223583385D0,
     8 12.8490229D0,   503.650238D0,   12333.3105D0,   5.03576231D0,
     9 75807.5547D0,   827790.938D0,   700751.563D0,   9119556.00D0,
     * 0.0D0/
C * DATA FOR SC ELEMENT #21
      DATA ((XSC(21, I, J), J = 1, 11), I = 1, 7)/
     1 13.3754511D0,   387.105499D0,   9124.26074D0,   0.00000000D0,
     2 0.000000000D0,  7.63245869D0,   985.740845D0,   8887.63965D0,
     3 28145.1992D0,   48765.2773D0,   55765.8750D0,   1.11466527D0,
     4 29.9885063D0,   628.362183D0,   8892.73633D0,   80391.9453D0,
     5 4.445857555D-02,544.732727D0,   21299.0742D0,   106495.711D0,
     6 198788.484D0,   0.0D0,          2.259455808D-02,1.46455920D0,
     7 82.8303070D0,   3300.45557D0,   88189.5781D0,   9.547692607D-04,
     8 142.253525D0,   21883.9707D0,   237792.031D0,   660498.188D0,
     9 0.0D0,          3.633770719D-02,2.63203478D0,   155.574493D0,
     * 6340.27686D0,   172182.266D0,   1.371221151D-03,279.049683D0,
     1 43849.1992D0,   480606.969D0,   1344320.00D0,   0.0D0,
     2 0.157317132D0,  4.07192469D0,   83.1233444D0,   1180.57031D0,
     3 11781.1436D0,   5.22513533D0,   11549.5293D0,   158022.641D0,
     4 381183.219D0,   393901.906D0,   0.0D0,          2.940912731D-03,
     5 0.180802792D0,  9.67005634D0,   354.716370D0,   8119.83496D0,
     6 1.61626744D0,   27698.6602D0,   365879.313D0,   277917.594D0,
     7 1868140.75D0,   0.0D0,          4.759747069D-03,0.325096637D0,
     8 18.1512680D0,   681.726746D0,   15855.2959D0,   2.99188566D0,
     9 54482.2539D0,   742810.500D0,   575778.188D0,   3671602.75D0,
     * 0.0D0/
C * DATA FOR TI ELEMENT #22
      DATA ((XSC(22, I, J), J = 1, 11), I = 1, 7)/
     1 16.3783951D0,   466.729553D0,   10741.3164D0,   0.000000000D0,
     2 0.000000000D0,  6.81414413D0,   881.864502D0,   7959.78369D0,
     3 25236.7109D0,   43721.8906D0,   50025.1211D0,   1.38360548D0,
     4 36.5285339D0,   744.958191D0,   10184.4697D0,   88024.4688D0,
     5 3.695865348D-02,473.029541D0,   18804.6387D0,   95396.0859D0,
     6 180583.906D0,   0.0D0,          3.134495765D-02,1.98984599D0,
     7 109.354668D0,   4199.17480D0,   107379.313D0,   8.467737352D-04,
     8 120.095116D0,   18723.7754D0,   206431.688D0,   581895.938D0,
     9 0.0D0,          5.011180788D-02,3.55951881D0,   204.702057D0,
     * 8047.52686D0,   209401.109D0,   1.190659008D-03,235.652359D0,
     1 37602.7813D0,   418222.250D0,   1187201.38D0,   0.0D0,
     2 0.199400857D0,  5.07217216D0,   100.853806D0,   1388.92346D0,
     3 13522.3828D0,   4.71482325D0,   10629.2871D0,   147303.156D0,
     4 361211.375D0,   393500.281D0,   0.0D0,          4.219437949D-03,
     5 0.254280508D0,  13.1719360D0,   462.252045D0,   10030.2881D0,
     6 1.74592924D0,   28436.1680D0,   360342.531D0,   275575.281D0,
     7 1358419.00D0,   0.0D0,          6.784337573D-03,0.454848289D0,
     8 24.6371078D0,   886.506653D0,   19570.9004D0,   3.21035886D0,
     9 55870.5195D0,   732970.688D0,   575839.313D0,   2673432.25D0,
     * 0.0D0/
C * DATA FOR V  ELEMENT #23
      DATA ((XSC(23, I, J), J = 1, 11), I = 1, 8)/
     1 19.8593178D0,   557.293579D0,   12524.9434D0,   0.00000000D0,
     2 0.000000000D0,  6.15256977D0,   793.150940D0,   7166.36816D0,
     3 22744.7285D0,   39397.2227D0,   45205.3203D0,   1.69736111D0,
     4 43.9810371D0,   873.232361D0,   11541.8584D0,   95371.6563D0,
     5 3.313467652D-02,418.870239D0,   16851.0996D0,   86395.4922D0,
     6 165305.313D0,   0.0D0,          4.274908826D-02,2.65845490D0,
     7 142.064880D0,   5268.31689D0,   129182.891D0,   7.210918702D-04,
     8 102.273438D0,   16152.1201D0,   180568.219D0,   515993.250D0,
     9 0.0D0,          6.792763621D-02,4.73335934D0,   265.038300D0,
     * 10073.6582D0,   251756.672D0,   9.996999288D-04,200.471283D0,
     1 32481.7402D0,   366493.250D0,   1054867.88D0,   0.0D0,
     2 0.248241663D0,  6.20659971D0,   120.277809D0,   1608.43457D0,
     3 15290.3027D0,   4.38909674D0,   9963.03711D0,   138626.078D0,
     4 342480.813D0,   385242.594D0,   0.0D0,          5.895125680D-03,
     5 0.348192871D0,  17.4781113D0,   587.836182D0,   12128.6934D0,
     6 1.71744359D0,   27477.3926D0,   344220.781D0,   266125.000D0,
     7 1052709.13D0,   0.0D0,          9.413871914D-03,0.619588792D0,
     8 32.5734215D0,   1124.89624D0,   23648.6406D0,   3.13177872D0,
     9 53901.5117D0,   701182.125D0,   560652.000D0,   2076638.38D0,
     * 0.0D0,          7.826552064D-06,1.302643330D-03,0.193255246D0,
     1 20.0691166D0,   1380.06238D0,   1381.32471D0,   5239243.00D0,
     2 9182668.00D0,   10412750.0D0,   10710503.0D0,   0.0D0/
C * DATA FOR CR ELEMENT #24
      DATA ((XSC(24, I, J), J = 1, 11), I = 1, 9)/
     1 23.8584499D0,   659.701660D0,   14486.9111D0,   0.00000000D0,
     2 0.000000000D0,  5.58467245D0,   716.948975D0,   6486.02197D0,
     3 20613.4258D0,   35712.5781D0,   40916.9805D0,   2.06217980D0,
     4 52.4386368D0,   1014.19061D0,   12981.0391D0,   102526.242D0,
     5 3.025845997D-02,375.973938D0,   15277.1689D0,   79048.1406D0,
     6 151559.484D0,   0.0D0,          5.744704604D-02,3.50119233D0,
     7 182.161697D0,   6545.91699D0,   154516.766D0,   6.451446097D-04,
     8 87.9408264D0,   14092.8447D0,   160078.109D0,   468845.625D0,
     9 0.0D0,          9.077656269D-02,6.20592070D0,   338.715240D0,
     * 12490.7891D0,   301108.000D0,   8.811053121D-04,171.919571D0,
     1 28343.8750D0,   325225.781D0,   960945.375D0,   0.0D0,
     2 0.302706599D0,  7.43203974D0,   140.450073D0,   1828.28052D0,
     3 17014.6992D0,   3.90112567D0,   9012.97559D0,   126689.531D0,
     4 309776.031D0,   321821.813D0,   0.0D0,          7.973670959D-03,
     5 0.460968494D0,  22.4341736D0,   725.293579D0,   14298.7051D0,
     6 1.47912800D0,   24396.9609D0,   310075.875D0,   223923.734D0,
     7 1302581.75D0,   0.0D0,          1.263785642D-02,0.815583825D0,
     8 41.6369019D0,   1384.22351D0,   27850.6758D0,   2.66806769D0,
     9 47729.0195D0,   632149.500D0,   472555.719D0,   2572403.00D0,
     * 0.0D0,          1.598890958D-05,2.490416402D-03,0.352081299D0,
     1 35.3093948D0,   2332.49268D0,   1990.50281D0,   5731099.50D0,
     2 11103850.0D0,   15900373.0D0,   17578990.0D0,   0.0D0,
     3 2.306908527D-06,4.717691918D-04,7.798123360D-02,8.36031055D0,
     4 565.273315D0,   482.098938D0,   1422491.13D0,   2800122.25D0,
     5 4079126.25D0,   4554578.50D0,   0.0D0/
C * DATA FOR MN ELEMENT #25
      DATA ((XSC(25, I, J), J = 1, 11), I = 1, 9)/
     1 28.4208565D0,   774.182983D0,   16600.3594D0,   0.00000000D0,
     2 0.000000000D0,  5.09475040D0,   650.499634D0,   5888.91309D0,
     3 18730.2344D0,   32452.0781D0,   37298.2930D0,   2.47825813D0,
     4 61.8827705D0,   1166.31567D0,   14459.9814D0,   109372.039D0,
     5 2.737544663D-02,333.641083D0,   13715.8770D0,   71665.7734D0,
     6 139514.672D0,   0.0D0,          7.602304220D-02,4.54017782D0,
     7 229.838562D0,   7990.76465D0,   180338.203D0,   5.802452797D-04,
     8 75.9000168D0,   12276.8643D0,   140810.891D0,   412271.844D0,
     9 0.0D0,          0.119360931D0,  8.00909424D0,   425.921082D0,
     * 15215.7480D0,   351552.875D0,   7.861307240D-04,148.008759D0,
     1 24696.9512D0,   286419.781D0,   845586.250D0,   0.0D0,
     2 0.369769335D0,  8.92678928D0,   164.650696D0,   2087.09033D0,
     3 18974.6934D0,   3.25346279D0,   7935.61279D0,   114448.820D0,
     4 292233.063D0,   339664.719D0,   0.0D0,          1.085056923D-02,
     5 0.614776731D0,  29.0170918D0,   900.749329D0,   16910.4805D0,
     6 1.21343887D0,   20973.2129D0,   287629.000D0,   238536.297D0,
     7 650341.813D0,   0.0D0,          1.704382896D-02,1.08166397D0,
     8 53.6815720D0,   1716.14941D0,   32937.5547D0,   2.16276741D0,
     9 40929.7813D0,   586108.750D0,   510700.938D0,   1289947.25D0,
     * 0.0D0,          2.829528239D-05,4.537343513D-03,0.637378931D0,
     1 61.7960281D0,   3924.17334D0,   42.0984802D0,   1352013.25D0,
     2 6780917.00D0,   5107832.00D0,   3621647.25D0,   0.0D0,
     3 4.043392892D-06,8.592494996D-04,0.141584083D0,  14.6815014D0,
     4 954.535461D0,   10.6563883D0,   346167.406D0,   1705718.13D0,
     5 1301684.50D0,   926458.625D0,   0.0D0/
C * DATA FOR FE ELEMENT #26
      DATA ((XSC(26, I, J), J = 1, 11), I = 1, 9)/
     1 33.5967026D0,   901.826782D0,   18909.1035D0,   0.00000000D0,
     2 0.000000000D0,  4.64799356D0,   593.258423D0,   5374.18408D0,
     3 17106.8340D0,   29643.8125D0,   34122.8516D0,   2.95297790D0,
     4 72.4341125D0,   1331.50403D0,   16011.6406D0,   115667.063D0,
     5 2.514671162D-02,299.203613D0,   12430.0166D0,   65528.4492D0,
     6 128504.328D0,   0.0D0,          9.943902493D-02,5.81886387D0,
     7 286.807678D0,   9667.25781D0,   209151.594D0,   5.338012706D-04,
     8 66.8126221D0,   10892.3428D0,   126080.281D0,   372604.250D0,
     9 0.0D0,          0.155008718D0,  10.2135296D0,   529.719604D0,
     * 18373.6797D0,   407788.563D0,   7.196301012D-04,129.786392D0,
     1 21899.6582D0,   256620.547D0,   765136.438D0,   0.0D0,
     2 0.443230689D0,  10.5243616D0,   189.634857D0,   2344.99683D0,
     3 20846.9414D0,   2.90282345D0,   7199.48584D0,   105066.070D0,
     4 271252.344D0,   318037.219D0,   0.0D0,          1.434014179D-02,
     5 0.796495140D0,  36.4943275D0,   1089.90161D0,   19528.9355D0,
     6 1.07614696D0,   18903.8281D0,   265300.969D0,   225420.891D0,
     7 544294.313D0,   0.0D0,          2.241079509D-02,1.39496934D0,
     8 67.2663040D0,   2072.01074D0,   38024.9414D0,   1.89621890D0,
     9 36795.9922D0,   540918.875D0,   485733.313D0,   1083631.13D0,
     * 0.0D0,          4.385668217D-05,6.915745325D-03,0.943884850D0,
     1 88.1911469D0,   5344.88770D0,   904.588257D0,   4360846.00D0,
     2 6479449.50D0,   6033488.00D0,   5995079.50D0,   0.0D0,
     3 1.248026183D-05,2.616845304D-03,0.418635994D0,  41.8461266D0,
     4 2598.32959D0,   436.012756D0,   2171087.50D0,   3276084.50D0,
     5 3056089.75D0,   3007959.75D0,   0.0D0/
C * DATA FOR CO ELEMENT #27
      DATA ((XSC(27, I, J), J = 1, 11), I = 1, 9)/
     1 39.4313164D0,   1043.13147D0,   21369.3008D0,   0.00000000D0,
     2 0.000000000D0,  4.28146601D0,   543.329163D0,   4923.98242D0,
     3 15683.9902D0,   27184.9941D0,   31321.7324D0,   3.49209929D0,
     4 84.1281891D0,   1508.71106D0,   17605.7676D0,   121267.266D0,
     5 2.347338758D-02,270.816925D0,   11345.8652D0,   60245.4531D0,
     6 118855.930D0,   0.0D0,          0.128448009D0,  7.37002563D0,
     7 353.904449D0,   11571.7295D0,   239973.906D0,   4.955939366D-04,
     8 59.5110245D0,   9754.95801D0,   113755.008D0,   338721.719D0,
     9 0.0D0,          0.199023858D0,  12.8761759D0,   651.491699D0,
     * 21956.6172D0,   468721.469D0,   6.732242764D-04,115.055496D0,
     1 19594.3516D0,   231614.719D0,   696498.438D0,   0.0D0,
     2 0.527080059D0,  12.2973413D0,   216.458298D0,   2613.66479D0,
     3 22692.3418D0,   2.73499870D0,   6767.11426D0,   98785.1719D0,
     4 255470.359D0,   301436.031D0,   0.0D0,          1.868808270D-02,
     5 1.01760614D0,   45.2823868D0,   1302.37842D0,   22269.2207D0,
     6 0.973131120D0,  17233.8945D0,   245676.391D0,   212413.641D0,
     7 467092.094D0,   0.0D0,          2.898808010D-02,1.77265680D0,
     8 83.1538925D0,   2470.61206D0,   43352.5391D0,   1.69353569D0,
     9 33457.4688D0,   501269.844D0,   460572.344D0,   933397.188D0,
     * 0.0D0,          6.596191088D-05,1.024698000D-02,1.36048698D0,
     1 122.744514D0,   7140.04639D0,   2703.98633D0,   5272268.00D0,
     2 5839494.00D0,   6107424.50D0,   6859508.00D0,   0.0D0,
     3 2.791640509D-05,5.796468351D-03,0.903280079D0,  87.2194901D0,
     4 5200.96289D0,   1960.57092D0,   3948209.75D0,   4443491.50D0,
     5 4623939.50D0,   5131735.50D0,   0.0D0/
C * DATA FOR NI ELEMENT #28
      DATA ((XSC(28, I, J), J = 1, 11), I = 1, 9)/
     1 45.9692841D0,   1198.94641D0,   23975.1094D0,   0.00000000D0,
     2 0.000000000D0,  3.95673132D0,   499.031403D0,   4524.92383D0,
     3 14424.6455D0,   25003.7090D0,   28779.6367D0,   4.09878159D0,
     4 97.0018768D0,   1697.90784D0,   19234.1719D0,   0.00000000D0,
     5 175.452911D0,   8759.09961D0,   41247.1641D0,   85691.0078D0,
     6 115743.359D0,   125379.633D0,   0.164238393D0,  9.24035645D0,
     7 432.607697D0,   13745.6699D0,   277654.313D0,   4.599943059D-04,
     8 52.9345589D0,   8730.52051D0,   102716.945D0,   308360.781D0,
     9 0.0D0,          0.252628744D0,  16.0622597D0,   793.752747D0,
     * 26041.0527D0,   541307.000D0,   6.338458625D-04,101.764656D0,
     1 17515.0469D0,   209193.891D0,   634732.625D0,   0.0D0,
     2 0.620443940D0,  14.2436867D0,   245.278503D0,   2896.93066D0,
     3 24583.4199D0,   2.32250309D0,   6039.97852D0,   89677.1250D0,
     4 235188.766D0,   278220.125D0,   0.0D0,          2.409890480D-02,
     5 1.28517413D0,   55.5597305D0,   1541.96960D0,   25191.3965D0,
     6 0.763312697D0,  14306.6006D0,   218936.094D0,   199737.891D0,
     7 384962.188D0,   0.0D0,          3.709980473D-02,2.22665858D0,
     8 101.645332D0,   2918.94946D0,   49043.4727D0,   1.30890584D0,
     9 27669.1055D0,   446311.094D0,   435478.656D0,   771988.000D0,
     * 0.0D0,          9.720342496D-05,1.483889204D-02,1.91603458D0,
     1 167.094742D0,   9355.44727D0,   1645.66589D0,   4322541.00D0,
     2 4872569.00D0,   4804619.50D0,   5332216.00D0,   0.0D0,
     3 5.445885472D-05,1.115813758D-02,1.69257736D0,   158.038025D0,
     4 9076.38281D0,   1582.09875D0,   4310802.50D0,   4948048.50D0,
     5 4847296.50D0,   5294123.00D0,   0.0D0/
C * DATA FOR CU ELEMENT #29
      DATA ((XSC(29, I, J), J = 1, 11), I = 1, 9)/
     1 53.2751999D0,   1370.01917D0,   0.000000000D0,  0.00000000D0,
     2 0.000000000D0,  3.67557979D0,   460.387970D0,   4176.02441D0,
     3 13321.4180D0,   23094.5840D0,   26531.3652D0,   4.77699661D0,
     4 111.155106D0,   1901.57800D0,   20946.1465D0,   0.00000000D0,
     5 159.816452D0,   8044.51953D0,   38107.1836D0,   79578.3594D0,
     6 107951.578D0,   98264.7188D0,   0.207876742D0,  11.4773922D0,
     7 524.464844D0,   16219.5195D0,   335328.406D0,   4.353651893D-04,
     8 47.9885559D0,   7946.92432D0,   94237.9219D0,   285755.063D0,
     9 0.0D0,          0.317746878D0,  19.8555527D0,   959.083496D0,
     * 30679.8008D0,   642349.813D0,   6.144578801D-04,91.8376389D0,
     1 15937.9561D0,   192159.094D0,   590128.125D0,   0.0D0,
     2 0.722816169D0,  16.2981033D0,   274.493652D0,   3175.11328D0,
     3 26342.4785D0,   2.21426272D0,   5730.03467D0,   84846.7969D0,
     4 216483.391D0,   234566.063D0,   0.0D0,          3.050390072D-02,
     5 1.59164131D0,   66.8567581D0,   1792.96069D0,   27991.2402D0,
     6 0.722355902D0,  13405.5195D0,   202315.969D0,   164977.609D0,
     7 484288.344D0,   0.0D0,          4.648753628D-02,2.73926282D0,
     8 121.781357D0,   3385.16455D0,   54478.8164D0,   1.22389197D0,
     9 25846.0547D0,   413024.906D0,   362458.844D0,   968524.375D0,
     * 0.0D0,          1.341273601D-04,1.955577545D-02,2.42353272D0,
     1 204.523788D0,   11062.6572D0,   31380.8027D0,   4706225.00D0,
     2 6409198.00D0,   8098560.00D0,   9343090.00D0,   0.0D0,
     3 1.116064741D-04,2.188922837D-02,3.18954372D0,   288.272064D0,
     4 16006.7266D0,   45622.2109D0,   7098642.00D0,   9932945.00D0,
     5 12575751.0D0,   14364417.0D0,   0.0D0/
C * DATA FOR ZN ELEMENT #30
      DATA ((XSC(30, I, J), J = 1, 11), I = 1, 9)/
     1 61.3851280D0,   1556.50842D0,   0.000000000D0,  0.00000000D0,
     2 0.000000000D0,  3.41738033D0,   424.861633D0,   3855.01636D0,
     3 12305.6807D0,   21342.2305D0,   24597.9238D0,   5.53230429D0,
     4 126.530487D0,   2115.26636D0,   22648.3418D0,   0.00000000D0,
     5 144.203690D0,   7324.24951D0,   34937.3711D0,   73252.3047D0,
     6 99417.7656D0,   107036.820D0,   0.260641187D0,  14.1196003D0,
     7 629.830200D0,   18958.1777D0,   0.000000000D0,  27.0905952D0,
     8 5521.70898D0,   53473.4570D0,   167394.891D0,   300247.656D0,
     9 1333241.00D0,   0.395631582D0,  24.3039589D0,   1147.85352D0,
     * 35802.5313D0,   0.000000000D0,  51.2061539D0,   11047.5537D0,
     1 108699.633D0,   343778.188D0,   622572.875D0,   2775663.50D0,
     2 0.843118131D0,  18.7137108D0,   308.696930D0,   3499.22192D0,
     3 28351.6152D0,   1.81062496D0,   4876.25684D0,   74630.8828D0,
     4 200414.328D0,   237135.188D0,   0.0D0,          3.875831515D-02,
     5 1.98363042D0,   81.0585175D0,   2100.58325D0,   31268.1074D0,
     6 0.500795305D0,  10337.0840D0,   176975.906D0,   176503.344D0,
     7 277110.688D0,   0.0D0,          5.864527449D-02,3.39699197D0,
     8 147.175522D0,   3960.25513D0,   60918.1406D0,   0.831809580D0,
     9 19836.1797D0,   360242.563D0,   388554.844D0,   559752.813D0,
     * 0.0D0,          1.970313460D-04,2.921710163D-02,3.58537722D0,
     1 293.221649D0,   15270.9492D0,   132.655106D0,   1802453.38D0,
     2 3597675.00D0,   2548656.25D0,   2326434.25D0,   0.0D0,
     3 1.636254747D-04,3.274735808D-02,4.72995329D0,   414.446899D0,
     4 22173.4941D0,   185.929138D0,   2675326.50D0,   5466531.50D0,
     5 3880210.50D0,   3443699.50D0,   0.0D0/
C * DATA FOR GA ELEMENT #31
      DATA ((XSC(31, I, J), J = 1, 11), I = 1, 9)/
     1 70.3515015D0  , 1759.00732D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,3.18604612D0  , 392.892303D0  , 3565.45703D0  ,
     3 11387.8984D0  , 19762.4121D0  , 22863.1387D0  , 6.36879921D0  ,
     4 143.186615D0  , 2339.80249D0  , 24352.5195D0  , 0.00000000D+00,
     5 130.087662D0  , 6664.97998D0  , 32003.0059D0  , 67459.7031D0  ,
     6 93002.2422D0  , 97879.8594D0  , 0.323959708D0  ,17.2229671D0  ,
     7 750.230164D0  , 21983.3828D0  , 0.000000000D+00,23.8705845D0  ,
     8 4887.52295D0  , 47695.3945D0  , 150168.469D0  , 264292.719D0  ,
     9 1161609.88D0  , 0.488045543D0  ,29.4898682D0  , 1362.54773D0  ,
     * 41448.9023D0  , 0.000000000D+00,44.8492928D0  , 9771.77344D0  ,
     1 97009.0781D0  , 308733.250D0  , 547964.938D0  , 2423530.50D0  ,
     2 0.980047762D0  ,21.4168129D0  , 346.233002D0  , 3849.91260D0  ,
     3 30489.5234D0  , 1.32787907D0  , 3933.51074D0  , 63336.6367D0  ,
     4 180888.016D0  , 223851.828D0  , 0.0D0         , 4.889723286D-02,
     5 2.45786095D0  , 97.8323288D0  , 2453.60913D0  , 34869.2188D0  ,
     6 0.302032202D0  ,7056.10400D0  , 145255.656D0  , 194211.641D0  ,
     7 153909.406D0  , 0.0D0         , 7.358220965D-02,4.18986750D0  ,
     8 176.936600D0  , 4610.36816D0  , 67755.8047D0  , 0.556340277D0  ,
     9 14740.4688D0  , 307470.469D0  , 427068.250D0  , 334535.438D0  ,
     * 0.0D0         , 2.864034032D-04,4.266745225D-02,5.15593910D0  ,
     1 408.520752D0  , 20417.7539D0  , 8.49055195D0  , 496642.375D0  ,
     2 3697577.00D0  , 1791704.50D0  , 1466864.75D0  , 0.0D0         ,
     3 2.360964572D-04,4.774709046D-02,6.80612516D0  , 578.010925D0  ,
     4 29699.7559D0  , 11.3159914D0  , 733049.250D0  , 5574049.00D0  ,
     5 2732383.00D0  , 2190759.75D0  , 0.0D0         /
C * DATA FOR GE ELEMENT #32
      DATA ((XSC(32, I, J), J = 1, 11), I = 1, 9)/
     1 80.2246170D0  , 1978.03235D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,2.97958446D0  , 364.208313D0  , 3305.44434D0  ,
     3 10563.2871D0  , 18339.8008D0  , 21252.4922D0  , 7.28964853D0  ,
     4 161.231857D0  , 2578.17993D0  , 26116.5684D0  , 0.00000000D+00,
     5 116.147964D0  , 6021.05811D0  , 29166.0547D0  , 61864.8750D0  ,
     6 85900.4766D0  , 91946.7969D0  , 0.399251997D0  ,20.8421402D0  ,
     7 887.159058D0  , 25318.9590D0  , 0.000000000D+00,21.1208858D0  ,
     8 4340.14258D0  , 42661.2109D0  , 135139.531D0  , 236204.406D0  ,
     9 1025463.19D0  , 0.597486913D0  ,35.5078125D0  , 1605.66748D0  ,
     * 47667.3398D0  , 0.000000000D+00,39.4249001D0  , 8668.75293D0  ,
     1 86800.4922D0  , 278110.656D0  , 490046.188D0  , 2151649.50D0  ,
     2 1.13551497D0  , 24.4313889D0  , 387.218262D0  , 4224.90674D0  ,
     3 32690.6797D0  , 1.06691349D0  , 3305.13623D0  , 55324.1563D0  ,
     4 165297.047D0  , 210959.625D0  , 0.0D0         , 6.146106869D-02,
     5 3.03055429D0  , 117.449364D0  , 2851.64014D0  , 38660.9688D0  ,
     6 0.194859102D0  ,5125.17773D0  , 121457.352D0  , 203937.344D0  ,
     7 119521.008D0  , 0.0D0         , 9.169522673D-02,5.13813210D0  ,
     8 211.667389D0  , 5344.65771D0  , 75049.6797D0  , 0.374449104D0  ,
     9 11211.8652D0  , 263858.656D0  , 451811.719D0  , 274452.563D0  ,
     * 0.0D0         , 4.109158472D-04,6.092090160D-02,7.22076845D0  ,
     1 554.850220D0  , 26606.1992D0  , 1.40949738D0  , 170372.672D0  ,
     2 2955295.25D0  , 1788004.63D0  , 925162.063D0  , 0.0D0         ,
     3 3.384672746D-04,6.817138195D-02,9.52997208D0  , 785.181580D0  ,
     4 38735.9609D0  , 1.78750610D0  , 250344.313D0  , 4433116.00D0  ,
     5 2723435.00D0  , 1394704.25D0  , 0.0D0         /
C * DATA FOR AS ELEMENT #33
      DATA ((XSC(33, I, J), J = 1, 11), I = 1, 9)/
     1 91.0590286D0  , 2214.20728D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,2.77999401D0  , 338.074158D0  , 3071.30420D0  ,
     3 9819.92090D0  , 17059.8027D0  , 19765.7715D0  , 8.30234146D0  ,
     4 180.560242D0  , 2823.69092D0  , 27807.3613D0  , 0.00000000D+00,
     5 106.028755D0  , 5528.84961D0  , 26914.7109D0  , 57309.3477D0  ,
     6 79884.0313D0  , 86638.7656D0  , 0.488622487D0  ,25.0425739D0  ,
     7 1041.92041D0  , 28968.4316D0  , 0.000000000D+00,18.8089008D0  ,
     8 3873.24927D0  , 38317.7344D0  , 122051.578D0  , 212553.844D0  ,
     9 910310.875D0  , 0.725964069D0  ,42.4437675D0  , 1879.37708D0  ,
     * 54474.1758D0  , 0.000000000D+00,34.8414116D0  , 7723.30566D0  ,
     1 77956.7031D0  , 251346.531D0  , 441191.563D0  , 1911485.38D0  ,
     2 1.31026614D0  , 27.7612228D0  , 431.583313D0  , 4623.30566D0  ,
     3 34990.5742D0  , 0.875532150D0  ,2808.80566D0  , 48673.4727D0  ,
     4 152043.938D0  , 200912.766D0  , 0.0D0         , 7.672012597D-02,
     5 3.71009231D0  , 139.956955D0  , 3287.16162D0  , 42463.3164D0  ,
     6 0.146437481D0  ,4137.73193D0  , 106420.070D0  , 207359.031D0  ,
     7 121932.625D0  , 0.0D0         , 0.113692299D0  ,6.26289845D0  ,
     8 251.658844D0  , 6162.21240D0  , 82752.8125D0  , 0.268081605D0  ,
     9 8669.26953D0  , 226513.859D0  , 457978.469D0  , 282961.406D0  ,
     * 0.0D0         , 5.811402225D-04,8.526003361D-02,9.88842010D0  ,
     1 737.480530D0  , 33899.0352D0  , 0.408280015D0  ,74780.4766D0  ,
     2 2276189.50D0  , 1982255.38D0  , 636077.063D0  , 0.0D0         ,
     3 4.769114603D-04,9.527547657D-02,13.0436487D0  , 1043.49854D0  ,
     4 49382.5664D0  , 0.488065064D0  ,109408.219D0  , 3403490.75D0  ,
     5 3013125.75D0  , 961699.813D0  , 0.0D0         /
C * DATA FOR SE ELEMENT #34
      DATA ((XSC(34, I, J), J = 1, 11), I = 1, 9)/
     1 102.904449D0  , 2467.74854D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,2.61308599D0  , 314.814301D0  , 2859.95776D0  ,
     3 9148.33203D0  , 15902.4307D0  , 18405.3477D0  , 9.41354561D0  ,
     4 201.409302D0  , 3084.02319D0  , 29570.8711D0  , 0.00000000D+00,
     5 95.5265350D0  , 5028.90283D0  , 24670.2402D0  , 52813.6211D0  ,
     6 73890.2188D0  , 80790.6172D0  , 0.593881845D0  ,29.8914223D0  ,
     7 1216.38818D0  , 32970.6836D0  , 0.000000000D+00,16.7941189D0  ,
     8 3464.03857D0  , 34490.4727D0  , 110469.086D0  , 192158.172D0  ,
     9 806454.875D0  , 0.875946045D0  ,50.3962593D0  , 2186.65649D0  ,
     * 61936.3945D0  , 0.000000000D+00,30.8629723D0  , 6894.74365D0  ,
     1 70160.8828D0  , 227644.938D0  , 399123.906D0  , 1695917.13D0  ,
     2 1.50731444D0  , 31.4317169D0  , 479.496704D0  , 5048.24072D0  ,
     3 37444.2422D0  , 0.671760857D0  ,2349.33813D0  , 42372.9219D0  ,
     4 138259.844D0  , 189295.625D0  , 0.0D0         , 9.510219097D-02,
     5 4.51131201D0  , 165.746719D0  , 3769.60205D0  , 46480.4180D0  ,
     6 0.111424357D0  ,3291.01318D0  , 92255.5781D0  , 204266.703D0  ,
     7 134721.031D0  , 0.0D0         , 0.139976755D0  ,7.58119965D0  ,
     8 297.261536D0  , 7063.01318D0  , 90829.4453D0  , 0.190035895D0  ,
     9 6817.16602D0  , 195496.141D0  , 450909.063D0  , 315883.531D0  ,
     * 0.0D0         , 8.087955648D-04,0.117163680D0  ,13.2909241D0  ,
     1 963.809387D0  , 42543.8438D0  , 0.137163624D0  ,34927.3047D0  ,
     2 1639086.38D0  , 2139142.50D0  , 459565.406D0  , 0.0D0         ,
     3 6.616109749D-04,0.130725905D0  ,17.5188789D0  , 1363.39148D0  ,
     4 62003.9180D0  , 0.154018119D0  ,50843.1367D0  , 2443793.00D0  ,
     5 3244723.25D0  , 694652.125D0  , 0.0D0         /
C * DATA FOR BR ELEMENT #35
      DATA ((XSC(35, I, J), J = 1, 11), I = 1, 9)/
     1 115.801857D0  , 2738.54492D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,2.46435618D0  , 293.933472D0  , 2669.65356D0  ,
     3 8542.25879D0  , 14855.8311D0  , 17168.5137D0  , 10.6241693D0  ,
     4 223.629333D0  , 3352.69434D0  , 31288.7969D0  , 0.00000000D+00,
     5 87.0761642D0  , 4614.44434D0  , 22768.4023D0  , 48947.3555D0  ,
     6 68661.2578D0  , 75400.8125D0  , 0.717057228D0  ,35.4425697D0  ,
     7 1410.52295D0  , 37236.1719D0  , 0.000000000D+00,15.1906128D0  ,
     8 3129.47437D0  , 31291.8672D0  , 100618.641D0  , 174956.828D0  ,
     9 717155.438D0  , 1.04939413D0  , 59.4305878D0  , 2526.89600D0  ,
     * 69876.7578D0  , 0.000000000D+00,27.7121754D0  , 6221.36328D0  ,
     1 63677.0000D0  , 207570.500D0  , 364118.344D0  , 1505880.75D0  ,
     2 1.72405887D0  , 35.4125748D0  , 530.380676D0  , 5485.78857D0  ,
     3 39851.4297D0  , 0.576584041D0  ,2067.87671D0  , 38239.3828D0  ,
     4 128469.820D0  , 181360.719D0  , 0.0D0         , 0.117057204D0  ,
     5 5.44646025D0  , 194.888123D0  , 4290.66504D0  , 50516.0938D0  ,
     6 9.125851095D-02,2744.77466D0  , 81830.6953D0  , 199421.891D0  ,
     7 151311.875D0  , 0.0D0         , 0.171111077D0  ,9.11055565D0  ,
     8 348.548157D0  , 8031.59326D0  , 98924.9609D0  , 0.153152615D0  ,
     9 5720.55713D0  , 174393.688D0  , 441951.531D0  , 357866.969D0  ,
     * 0.0D0         , 1.109156408D-03,0.158323511D0  ,17.5431156D0  ,
     1 1235.59436D0  , 52167.1211D0  , 7.276616246D-02,21845.5039D0  ,
     2 1291753.50D0  , 2164522.00D0  , 369368.375D0  , 0.0D0         ,
     3 9.028668865D-04,0.176223963D0  ,23.0945625D0  , 1745.56506D0  ,
     4 75881.2969D0  , 8.406757563D-02,33285.5859D0  , 1971108.13D0  ,
     5 3277090.25D0  , 564616.125D0  , 0.0D0         /
C * DATA FOR KR ELEMENT #36
      DATA ((XSC(36, I, J), J = 1, 11), I = 1, 9)/
     1 129.995651D0  , 3029.05200D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,2.32620788D0  , 274.610352D0  , 2494.08398D0  ,
     3 7984.88086D0  , 13894.3145D0  , 16032.0732D0  , 11.9420261D0  ,
     4 247.392990D0  , 3634.12915D0  , 33032.5078D0  , 0.00000000D+00,
     5 78.6450119D0  , 4222.15674D0  , 20975.0977D0  , 45307.5313D0  ,
     6 63711.9375D0  , 70149.6953D0  , 0.860745907D0  ,41.8030548D0  ,
     7 1629.10864D0  , 41976.5313D0  , 0.000000000D+00,13.6485691D0  ,
     8 2812.35938D0  , 28296.9355D0  , 91485.9141D0  , 159344.422D0  ,
     9 637128.125D0  , 1.25032532D0  , 69.7208557D0  , 2908.56104D0  ,
     * 78711.8125D0  , 0.000000000D+00,24.6885414D0  , 5580.72559D0  ,
     1 57580.0781D0  , 188882.234D0  , 332067.063D0  , 1340001.13D0  ,
     2 1.96369970D0  , 39.7445793D0  , 584.965515D0  , 5951.28271D0  ,
     3 42458.3047D0  , 0.475202024D0  ,1761.07068D0  , 33711.1406D0  ,
     4 117089.836D0  , 170235.375D0  , 0.0D0         , 0.143166572D0  ,
     5 6.53821802D0  , 228.273178D0  , 4881.62988D0  , 55085.2852D0  ,
     6 6.140151992D-02,2028.23376D0  , 67512.3281D0  , 185534.875D0  ,
     7 159878.906D0  , 0.0D0         , 0.208088011D0  ,10.8912735D0  ,
     8 407.198456D0  , 9133.87207D0  , 108257.883D0  , 9.887553006D-02,
     9 4190.48828D0  , 143476.719D0  , 410401.406D0  , 378941.063D0  ,
     * 0.0D0         , 1.498913509D-03,0.210859850D0  ,22.8473740D0  ,
     1 1567.29126D0  , 63664.1602D0  , 3.360760957D-02,12333.9443D0  ,
     2 935434.938D0  , 2128649.75D0  , 295130.188D0  , 0.0D0         ,
     3 1.216916484D-03,0.234330356D0  ,30.0603981D0  , 2215.63501D0  ,
     4 92852.1797D0  , 3.355485573D-02,17778.7051D0  , 1389055.50D0  ,
     5 3219008.75D0  , 444752.625D0  , 0.0D0         /
C * DATA FOR RB ELEMENT #37
      DATA ((XSC(37, I, J), J = 1, 11), I = 1, 9)/
     1 145.150543D0  , 3335.24902D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,2.20369673D0  , 257.035278D0  , 2335.36548D0  ,
     3 7478.15186D0  , 13017.0439D0  , 15004.7373D0  , 13.3684654D0  ,
     4 272.545593D0  , 3922.27734D0  , 34714.9336D0  , 0.00000000D+00,
     5 71.6623535D0  , 3874.45020D0  , 19358.7090D0  , 41990.6445D0  ,
     6 59185.3477D0  , 64918.2656D0  , 1.02672589D0  , 49.0009155D0  ,
     7 1869.27454D0  , 46924.0781D0  , 0.000000000D+00,12.3343239D0  ,
     8 2535.96387D0  , 25624.2520D0  , 83175.4922D0  , 145147.594D0  ,
     9 169550.125D0  , 1.48078465D0  , 81.2901382D0  , 3325.66699D0  ,
     * 87919.4688D0  , 0.000000000D+00,22.1339550D0  , 5025.31738D0  ,
     1 52153.3359D0  , 171869.922D0  , 302482.156D0  , 355350.250D0  ,
     2 2.22920394D0  , 44.4258423D0  , 642.403442D0  , 6425.02148D0  ,
     3 45004.0195D0  , 0.379439354D0  ,1512.92029D0  , 29823.3379D0  ,
     4 106568.219D0  , 166562.719D0  , 0.0D0         , 0.173848987D0  ,
     5 7.78626299D0  , 264.755524D0  , 5475.88672D0  , 59050.4336D0  ,
     6 5.199510977D-02,1728.84705D0  , 60143.6719D0  , 179115.750D0  ,
     7 170479.313D0  , 0.0D0         , 0.250936806D0  ,12.9117928D0  ,
     8 471.177307D0  , 10247.3936D0  , 116533.945D0  , 8.001378179D-02,
     9 3515.19214D0  , 126855.000D0  , 395169.250D0  , 401144.719D0  ,
     * 0.0D0         , 1.996008214D-03,0.276897550D0  ,29.3404846D0  ,
     1 1958.40479D0  , 76366.8516D0  , 1.569856517D-02,6946.48096D0  ,
     2 651206.750D0  , 2144910.75D0  , 288034.063D0  , 0.0D0         ,
     3 1.618464827D-03,0.307255805D0  ,38.5445099D0  , 2763.93921D0  ,
     4 111082.711D0  , 1.564608514D-02,10406.0605D0  , 990321.813D0  ,
     5 3254537.25D0  , 431920.219D0  , 0.0D0         /
C * DATA FOR SR ELEMENT #38
      DATA ((XSC(38, I, J), J = 1, 11), I = 1, 12)/
     1 161.513519D0  , 3660.20239D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,2.09155250D0  , 241.108521D0  , 2189.63208D0  ,
     3 7012.84424D0  , 12210.6865D0  , 14059.6348D0  , 14.9101200D0  ,
     4 299.185394D0  , 4219.23926D0  , 36356.2305D0  , 0.00000000D+00,
     5 65.4292450D0  , 3560.53760D0  , 17888.4688D0  , 38957.1836D0  ,
     6 55047.1719D0  , 60405.5820D0  , 1.21865380D0  , 57.1402168D0  ,
     7 2133.73535D0  , 52165.9063D0  , 0.000000000D+00,11.1423483D0  ,
     8 2294.35181D0  , 23263.1074D0  , 75764.1719D0  , 132247.688D0  ,
     9 150195.922D0  , 1.74423289D0  , 94.2742844D0  , 3783.10938D0  ,
     * 97674.4453D0  , 0.000000000D+00,19.8181324D0  , 4538.41113D0  ,
     1 47343.8086D0  , 156657.875D0  , 275882.625D0  , 315142.156D0  ,
     2 2.51823068D0  , 49.4545937D0  , 703.053589D0  , 6912.58838D0  ,
     3 47542.7813D0  , 0.320201725D0  ,1313.70667D0  , 26578.0039D0  ,
     4 97467.1953D0  , 153493.984D0  , 0.0D0         , 0.209908247D0  ,
     5 9.22296047D0  , 305.693665D0  , 6123.24658D0  , 63259.9023D0  ,
     6 4.140869156D-02,1399.07043D0  , 51847.1016D0  , 167731.375D0  ,
     7 180220.813D0  , 0.0D0         , 0.300864190D0  ,15.2228489D0  ,
     8 542.591614D0  , 11452.9717D0  , 125273.719D0  , 6.202661991D-02,
     9 2845.76807D0  , 109597.852D0  , 370477.844D0  , 422457.781D0  ,
     * 0.0D0         , 2.632827265D-03,0.359631956D0  ,37.2268562D0  ,
     1 2414.14160D0  , 90173.9453D0  , 8.880086243D-03,4397.25391D0  ,
     2 476697.594D0  , 2032991.00D0  , 424226.844D0  , 0.0D0         ,
     3 2.128628781D-03,0.398270935D0  ,48.8483047D0  , 3404.98462D0  ,
     4 131123.516D0  , 8.409592323D-03,6564.34180D0  , 725246.188D0  ,
     5 3091865.00D0  , 635316.875D0  , 0.0D0         , 0.378550559D0  ,
     6 7.14977789D0  , 99.8566971D0  , 995.345764D0  , 7467.83545D0  ,
     7 21.4249725D0  , 13344.4141D0  , 124349.555D0  , 205973.406D0  ,
     8 104676.906D0  , 0.0D0         , 2.590393834D-02,1.07259893D0  ,
     9 34.1239853D0  , 668.743408D0  , 7179.04785D0  , 32.5392952D0  ,
     * 33407.7227D0  , 113940.352D0  , 2081546.50D0  , 15789259.0D0  ,
     1 0.0D0         , 3.694827110D-02,1.76024485D0  , 60.2213287D0  ,
     2 1243.12451D0  , 14006.2578D0  , 57.3781700D0  , 68820.7734D0  ,
     3 243546.422D0  , 3774906.50D0  , 30677134.0D0  , 0.0D0         /
C * DATA FOR Y  ELEMENT #39
      DATA ((XSC(39, I, J), J = 1, 11), I = 1, 12)/
     1 179.146790D0  , 4003.60840D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.98952651D0  , 226.568222D0  , 2056.57666D0  ,
     3 6588.13281D0  , 11473.4834D0  , 13194.2031D0  , 16.5722656D0  ,
     4 327.370148D0  , 4525.74902D0  , 38015.5039D0  , 0.00000000D+00,
     5 60.0163879D0  , 3284.59888D0  , 16586.6406D0  , 36256.3047D0  ,
     6 51340.8867D0  , 56210.4727D0  , 1.43939900D0  , 66.3263550D0  ,
     7 2426.01465D0  , 57802.6680D0  , 0.000000000D+00,10.1674337D0  ,
     8 2085.79395D0  , 21220.9609D0  , 69344.5781D0  , 121139.367D0  ,
     9 138701.953D0  , 2.04443002D0  , 108.828255D0  , 4286.77734D0  ,
     * 108218.703D0  , 0.000000000D+00,17.9094810D0  , 4117.66357D0  ,
     1 43179.9531D0  , 143478.172D0  , 252981.453D0  , 291438.125D0  ,
     2 2.83639383D0  , 54.8693581D0  , 767.066040D0  , 7417.85059D0  ,
     3 50142.5820D0  , 0.276592433D0  ,1157.77515D0  , 23958.1934D0  ,
     4 89794.2656D0  , 144308.313D0  , 0.0D0         , 0.251975983D0  ,
     5 10.8622761D0  , 351.090485D0  , 6813.45313D0  , 67504.2188D0  ,
     6 3.296152130D-02,1167.85828D0  , 45512.6055D0  , 156651.328D0  ,
     7 183206.031D0  , 0.0D0         , 0.358618289D0  ,17.8460426D0  ,
     8 621.632385D0  , 12742.8994D0  , 134270.031D0  , 5.000425503D-02,
     9 2364.53101D0  , 96150.6016D0  , 346162.188D0  , 429718.688D0  ,
     * 0.0D0         , 3.440195462D-03,0.462344706D0  ,46.7640839D0  ,
     1 2949.67236D0  , 105896.805D0  , 5.328153260D-03,2960.22778D0  ,
     2 360749.375D0  , 1858937.13D0  , 552808.563D0  , 0.0D0         ,
     3 2.773017157D-03,0.510965705D0  ,61.2910271D0  , 4158.10840D0  ,
     4 153977.609D0  , 4.748226609D-03,4387.53125D0  , 547963.625D0  ,
     5 2829978.50D0  , 828897.438D0  , 0.0D0         , 0.451179683D0  ,
     6 8.43212128D0  , 116.126633D0  , 1141.38098D0  , 8498.56152D0  ,
     7 15.9779139D0  , 11140.9570D0  , 112213.250D0  , 209913.750D0  ,
     8 150483.000D0  , 0.0D0         , 3.378038853D-02,1.38149095D0  ,
     9 42.9767265D0  , 816.078613D0  , 8485.08398D0  , 19.2197819D0  ,
     * 27772.6797D0  , 103374.656D0  , 1032195.00D0  , 6357127.50D0  ,
     1 0.0D0         , 4.790235683D-02,2.26003051D0  , 75.7655411D0  ,
     2 1518.69629D0  , 16618.9922D0  , 33.3941879D0  , 56679.7070D0  ,
     3 234334.891D0  , 1845420.75D0  , 12221569.0D0  , 0.0D0         /
C * DATA FOR ZR ELEMENT #40
      DATA ((XSC(40, I, J), J = 1, 11), I = 1, 13)/
     1 198.084564D0  , 4365.35010D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.89752984D0  , 213.369598D0  , 1935.44495D0  ,
     3 6200.74756D0  , 10803.4980D0  , 12404.0029D0  , 18.3579235D0  ,
     4 357.056580D0  , 4839.54834D0  , 39608.8945D0  , 0.00000000D+00,
     5 55.0786514D0  , 3045.32690D0  , 15444.5264D0  , 33866.7383D0  ,
     6 48042.4766D0  , 52498.1016D0  , 1.69195735D0  , 76.6252518D0  ,
     7 2745.34692D0  , 63772.3477D0  , 0.000000000D+00,9.37018871D0  ,
     8 1911.56104D0  , 19491.3379D0  , 63848.3672D0  , 111592.367D0  ,
     9 128467.000D0  , 2.38461804D0  , 125.030273D0  , 4834.98193D0  ,
     * 119323.406D0  , 0.000000000D+00,16.3419838D0  , 3766.07813D0  ,
     1 39653.8359D0  , 132203.844D0  , 233354.406D0  , 270296.406D0  ,
     2 3.17947149D0  , 60.6363792D0  , 834.236755D0  , 7938.17578D0  ,
     3 52774.6797D0  , 0.243396163D0  ,1033.27185D0  , 21803.2090D0  ,
     4 83217.4375D0  , 135922.281D0  , 0.0D0         , 0.301004767D0  ,
     5 12.7231665D0  , 400.982788D0  , 7538.53076D0  , 71666.0938D0  ,
     6 2.841274440D-02,1006.94525D0  , 40732.1367D0  , 147045.813D0  ,
     7 182756.844D0  , 0.0D0         , 0.425387323D0  ,20.8067722D0  ,
     8 708.235107D0  , 14099.4453D0  , 143236.375D0  , 4.015129432D-02,
     9 2032.82349D0  , 86105.8047D0  , 325500.844D0  , 429292.906D0  ,
     * 0.0D0         , 4.447322339D-03,0.588055849D0  ,58.1128082D0  ,
     1 3562.12866D0  , 122820.500D0  , 3.797446843D-03,2218.65479D0  ,
     2 291803.063D0  , 1696030.13D0  , 631846.563D0  , 0.0D0         ,
     3 3.569497028D-03,0.648275793D0  ,76.0760880D0  , 5019.27295D0  ,
     4 178619.703D0  , 3.210201627D-03,3261.68115D0  , 442121.875D0  ,
     5 2581909.75D0  , 947468.688D0  , 0.0D0         , 0.529819191D0  ,
     6 9.78068161D0  , 132.754120D0  , 1287.17285D0  , 9516.60938D0  ,
     7 13.6866503D0  , 10142.7656D0  , 105999.258D0  , 209340.328D0  ,
     8 171248.594D0  , 0.0D0         , 4.301036894D-02,1.72926521D0  ,
     9 52.4891701D0  , 965.794861D0  , 9737.61719D0  , 16.6749153D0  ,
     * 26720.4961D0  , 106705.492D0  , 768987.250D0  , 4248017.00D0  ,
     1 0.0D0         , 6.057272106D-02,2.81652451D0  , 92.3253784D0  ,
     2 1797.18713D0  , 19125.3691D0  , 28.6847382D0  , 54410.7930D0  ,
     3 245641.844D0  , 1375094.00D0  , 8130742.00D0  , 0.0D0         ,
     4 1.564582344D-04,1.751643978D-02,1.57011914D0  , 90.4214554D0  ,
     5 2764.07764D0  , 465.709259D0  , 26196.8945D0  , 11198567.0D0  ,
     6 13479409.0D0  , 12719175.0D0  , 0.0D0         /
C * DATA FOR NB ELEMENT #41
      DATA ((XSC(41, I, J), J = 1, 11), I = 1, 13)/
     1 218.421249D0  , 4747.14160D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.81405532D0  , 201.294617D0  , 1824.36816D0  ,
     3 5845.46338D0  , 10199.0410D0  , 11666.7500D0  , 20.2745953D0  ,
     4 388.375244D0  , 5163.62695D0  , 41282.5156D0  , 0.00000000D+00,
     5 50.8884010D0  , 2828.08960D0  , 14406.3662D0  , 31691.5313D0  ,
     6 45017.3555D0  , 49136.8516D0  , 1.98029768D0  , 88.1779251D0  ,
     7 3097.12842D0  , 70272.1328D0  , 0.000000000D+00,8.61602688D0  ,
     8 1756.81860D0  , 17960.6035D0  , 58998.5547D0  , 103244.578D0  ,
     9 118982.734D0  , 2.76925254D0  , 143.079041D0  , 5436.61084D0  ,
     * 131534.563D0  , 0.000000000D+00,14.9521971D0  , 3454.31055D0  ,
     1 36536.3594D0  , 122267.820D0  , 216200.359D0  , 250722.047D0  ,
     2 3.55402899D0  , 66.8008041D0  , 904.766113D0  , 8477.38574D0  ,
     3 55445.9492D0  , 0.217097908D0  ,928.643921D0  , 19960.2207D0  ,
     4 77480.8906D0  , 127574.836D0  , 0.0D0         , 0.357288361D0  ,
     5 14.8225965D0  , 455.976593D0  , 8313.54980D0  , 75939.4063D0  ,
     6 2.461441420D-02,870.914978D0  , 36546.6445D0  , 137495.297D0  ,
     7 179672.125D0  , 0.0D0         , 0.501355648D0  ,24.1268692D0  ,
     8 803.454651D0  , 15553.2676D0  , 152661.203D0  , 3.376957402D-02,
     9 1751.86255D0  , 77276.9609D0  , 305101.781D0  , 423001.219D0  ,
     * 0.0D0         , 5.694358610D-03,0.741096258D0  ,71.6300507D0  ,
     1 4274.30615D0  , 142226.250D0  , 2.645154018D-03,1681.38220D0  ,
     2 238178.453D0  , 1534821.38D0  , 582568.063D0  , 0.0D0         ,
     3 4.561474547D-03,0.815524220D0  ,93.6537781D0  , 6019.17334D0  ,
     4 206829.016D0  , 2.152563073D-03,2458.72705D0  , 360692.031D0  ,
     5 2338196.00D0  , 869593.438D0  , 0.0D0         , 0.612750053D0  ,
     6 11.1583605D0  , 149.253799D0  , 1429.06396D0  , 10510.4922D0  ,
     7 11.4717159D0  , 9049.18164D0  , 97834.2813D0  , 196611.281D0  ,
     8 157352.063D0  , 0.0D0         , 5.333347246D-02,2.10468006D0  ,
     9 62.3245010D0  , 1112.88916D0  , 10910.8672D0  , 11.9794130D0  ,
     * 23103.1055D0  , 102423.703D0  , 574271.688D0  , 3695229.25D0  ,
     1 0.0D0         , 7.447589189D-02,3.40727806D0  , 109.204124D0  ,
     2 2067.71436D0  , 21464.4473D0  , 20.2748394D0  , 46713.0156D0  ,
     3 237588.016D0  , 1027884.94D0  , 7088904.50D0  , 0.0D0         ,
     4 4.208431346D-04,4.603499547D-02,4.00764608D0  , 222.856277D0  ,
     5 6501.55127D0  , 2256.22852D0  , 360910.219D0  , 21367446.0D0  ,
     6 27653664.0D0  , 29049492.0D0  , 0.0D0         /
C * DATA FOR MO ELEMENT #42
      DATA ((XSC(42, I, J), J = 1, 11), I = 1, 14)/
     1 240.097275D0  , 5144.72656D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.73783219D0  , 190.097046D0  , 1722.38550D0  ,
     3 5518.71191D0  , 9627.55371D0  , 11005.0039D0  , 22.3213329D0  ,
     4 421.095978D0  , 5490.91113D0  , 42420.1602D0  , 0.00000000D+00,
     5 47.3239059D0  , 2639.03882D0  , 13488.4756D0  , 29747.5313D0  ,
     6 42303.9961D0  , 46096.3047D0  , 2.30739427D0  , 101.003838D0  ,
     7 3476.32935D0  , 77040.1797D0  , 0.000000000D+00,8.02373505D0  ,
     8 1624.74292D0  , 16628.1777D0  , 54710.8398D0  , 95766.4297D0  ,
     9 109727.063D0  , 3.20123339D0  , 162.969803D0  , 6082.30273D0  ,
     * 144061.484D0  , 0.000000000D+00,13.7183266D0  , 3188.79077D0  ,
     1 33827.0742D0  , 113491.219D0  , 200842.766D0  , 231035.063D0  ,
     2 3.95829892D0  , 73.3244247D0  , 977.726746D0  , 9017.90918D0  ,
     3 57976.3359D0  , 0.199403420D0  ,851.258484D0  , 18528.1855D0  ,
     4 72779.7734D0  , 121042.602D0  , 0.0D0         , 0.422186017D0  ,
     5 17.1760159D0  , 515.355103D0  , 9102.08594D0  , 79867.7734D0  ,
     6 2.242681757D-02,782.378540D0  , 33536.2383D0  , 130016.234D0  ,
     7 176863.469D0  , 0.0D0         , 0.588181078D0  ,27.8265152D0  ,
     8 905.909912D0  , 17032.8398D0  , 161457.938D0  , 3.009606339D-02,
     9 1572.45984D0  , 71061.6875D0  , 289479.813D0  , 417790.563D0  ,
     * 0.0D0         , 7.225201931D-03,0.925237000D0  ,87.4035797D0  ,
     1 5065.71143D0  , 162128.094D0  , 2.092840848D-03,1372.98071D0  ,
     2 203375.188D0  , 1406531.00D0  , 614487.563D0  , 0.0D0         ,
     3 5.769114941D-03,1.01592946D0  , 114.130440D0  , 7128.85303D0  ,
     4 235719.234D0  , 1.656617504D-03,2001.51587D0  , 308182.719D0  ,
     5 2145403.00D0  , 914660.375D0  , 0.0D0         , 0.703809321D0  ,
     6 12.6618958D0  , 167.027222D0  , 1578.99634D0  , 11535.5352D0  ,
     7 11.1804590D0  , 8929.43945D0  , 96923.2109D0  , 196239.875D0  ,
     8 165727.781D0  , 0.0D0         , 6.567740440D-02,2.54781103D0  ,
     9 73.6351395D0  , 1275.04834D0  , 12151.4619D0  , 13.2324371D0  ,
     * 24509.7188D0  , 107404.367D0  , 547929.938D0  , 3136452.50D0  ,
     1 0.0D0         , 9.101111442D-02,4.10334730D0  , 128.648575D0  ,
     2 2367.61401D0  , 23964.3633D0  , 22.2596340D0  , 49670.7539D0  ,
     3 251517.375D0  , 985744.375D0  , 6027433.50D0  , 0.0D0         ,
     4 6.148125976D-04,6.714596599D-02,5.73747110D0  , 308.015320D0  ,
     5 8571.79004D0  , 14348.6230D0  , 7814266.00D0  , 25720028.0D0  ,
     6 33348208.0D0  , 36858940.0D0  , 0.0D0         , 8.017745859D-05,
     7 1.205120422D-02,1.22094846D0  , 70.6675644D0  , 2032.77783D0  ,
     8 3417.11523D0  , 1867871.75D0  , 6514205.00D0  , 8738789.00D0  ,
     9 9799364.00D0  , 0.0D0         /
C * DATA FOR TC ELEMENT #43
      DATA ((XSC(43, I, J), J = 1, 11), I = 1, 14)/
     1 263.218353D0  , 5561.27295D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.66740632D0  , 179.844498D0  , 1627.83167D0  ,
     3 5215.59229D0  , 9100.87891D0  , 10391.3418D0  , 24.5051975D0  ,
     4 455.363861D0  , 5825.05176D0  , 0.000000000D+00,0.00000000D+00,
     5 43.9736137D0  , 2460.91431D0  , 12623.2471D0  , 27913.6055D0  ,
     6 39755.9648D0  , 43286.3984D0  , 2.67746568D0  , 115.233955D0  ,
     7 3886.97217D0  , 83721.3594D0  , 0.000000000D+00,7.47870445D0  ,
     8 1503.18005D0  , 15398.0850D0  , 50740.5664D0  , 88811.2891D0  ,
     9 101943.969D0  , 3.68525243D0  , 184.882828D0  , 6779.14258D0  ,
     * 157491.297D0  , 0.000000000D+00,12.6491575D0  , 2943.57031D0  ,
     1 31316.1777D0  , 105331.508D0  , 186493.297D0  , 215054.938D0  ,
     2 4.39064074D0  , 80.2249985D0  , 1054.03064D0  , 9577.97559D0  ,
     3 60510.0625D0  , 0.167934537D0  ,766.106262D0  , 16960.5234D0  ,
     4 67560.5156D0  , 114272.773D0  , 0.0D0         , 0.496396124D0  ,
     5 19.8073235D0  , 579.823730D0  , 9923.71777D0  , 83685.0391D0  ,
     6 2.020336129D-02,694.726440D0  , 30511.9727D0  , 122119.953D0  ,
     7 171240.531D0  , 0.0D0         , 0.686615527D0  ,31.9365902D0  ,
     8 1016.76294D0  , 18575.5742D0  , 170208.906D0  , 2.655065246D-02,
     9 1396.54407D0  , 64829.9766D0  , 272704.469D0  , 405984.375D0  ,
     * 0.0D0         , 9.092921391D-03,1.14576757D0  , 105.810783D0  ,
     1 5955.49951D0  , 183483.141D0  , 1.629359671D-03,1102.35706D0  ,
     2 171081.141D0  , 1266380.25D0  , 811327.688D0  , 0.0D0         ,
     3 7.236727048D-03,1.25537086D0  , 138.003021D0  , 8377.70313D0  ,
     4 266886.938D0  , 1.248953165D-03,1592.07019D0  , 258446.125D0  ,
     5 1929504.25D0  , 1213104.13D0  , 0.0D0         , 0.807469964D0  ,
     6 14.3330383D0  , 186.406754D0  , 1740.92493D0  , 12638.6240D0  ,
     7 9.87278652D0  , 8206.63672D0  , 91428.8672D0  , 195055.016D0  ,
     8 189214.219D0  , 0.0D0         , 8.067370206D-02,3.07626271D0  ,
     9 86.7981033D0  , 1458.61951D0  , 13531.8389D0  , 11.2235250D0  ,
     * 22794.4453D0  , 109566.453D0  , 395358.594D0  , 1882568.00D0  ,
     1 0.0D0         , 0.111048825D0  ,4.93399858D0  , 151.375626D0  ,
     2 2710.17578D0  , 26790.3730D0  , 18.6609764D0  , 46080.8359D0  ,
     3 257800.609D0  , 728719.875D0  , 3596759.75D0  , 0.0D0         ,
     4 9.261008236D-04,0.103053950D0  ,8.74145603D0  , 454.142639D0  ,
     5 12115.5635D0  , 370.902191D0  , 161808.516D0  , 18166836.0D0  ,
     6 12834695.0D0  , 8273540.00D0  , 0.0D0         , 1.214610529D-04,
     7 1.861779578D-02,1.87551463D0  , 105.118729D0  , 2899.72070D0  ,
     8 98.5036316D0  , 38843.8516D0  , 4626662.50D0  , 3323490.25D0  ,
     9 2198278.00D0  , 0.0D0         /
C * DATA FOR RU ELEMENT #44
      DATA ((XSC(44, I, J), J = 1, 11), I = 1, 14)/
     1 287.872009D0  , 6000.26904D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.59923828D0  , 170.411652D0  , 1540.85437D0  ,
     3 4937.02246D0  , 8611.95215D0  , 9830.63184D0  , 26.8350067D0  ,
     4 491.312775D0  , 6168.32861D0  , 0.000000000D+00,0.00000000D+00,
     5 41.0157661D0  , 2302.53369D0  , 11851.9229D0  , 26274.7012D0  ,
     6 37438.1367D0  , 40693.1719D0  , 3.09602880D0  , 131.068787D0  ,
     7 4337.21240D0  , 97572.5078D0  , 0.000000000D+00,6.99939537D0  ,
     8 1396.53210D0  , 14326.0068D0  , 47300.6523D0  , 82867.9531D0  ,
     9 93226.5938D0  , 4.22709703D0  , 209.091370D0  , 7540.30762D0  ,
     * 170757.391D0  , 0.000000000D+00,11.7136602D0  , 2729.48413D0  ,
     1 29138.4238D0  , 98301.0000D0  , 174310.500D0  , 196049.469D0  ,
     2 4.85759115D0  , 87.5167999D0  , 1132.91003D0  , 10143.5400D0  ,
     3 62980.7773D0  , 0.155831888D0  ,712.178772D0  , 15921.9951D0  ,
     4 64010.1133D0  , 108310.953D0  , 0.0D0         , 0.581026495D0  ,
     5 22.7495422D0  , 650.461365D0  , 10807.6689D0  , 87569.0625D0  ,
     6 1.823580079D-02,617.006958D0  , 27822.9355D0  , 114441.383D0  ,
     7 165762.281D0  , 0.0D0         , 0.797201991D0  ,36.4975395D0  ,
     8 1138.06311D0  , 20246.6113D0  , 179559.797D0  , 2.334276587D-02,
     9 1236.63257D0  , 59170.5859D0  , 256474.516D0  , 394525.250D0  ,
     * 0.0D0         , 1.136720739D-02,1.40930796D0  , 127.387573D0  ,
     1 6982.27832D0  , 208328.328D0  , 1.303084427D-03,903.103516D0  ,
     2 146945.813D0  , 1154545.50D0  , 683887.500D0  , 0.0D0         ,
     3 9.016356431D-03,1.54062247D0  , 165.916214D0  , 9814.36816D0  ,
     4 302962.688D0  , 9.781608824D-04,1300.55066D0  , 222252.859D0  ,
     5 1762292.63D0  , 1013434.63D0  , 0.0D0         , 0.910864234D0  ,
     6 15.9583178D0  , 204.765228D0  , 1891.68176D0  , 13675.8447D0  ,
     7 8.82271194D0  , 7577.24805D0  , 85910.4922D0  , 181337.719D0  ,
     8 162904.641D0  , 0.0D0         , 9.656544775D-02,3.61468291D0  ,
     9 99.5735474D0  , 1626.64807D0  , 14724.5879D0  , 9.53222752D0  ,
     * 20959.3516D0  , 105124.797D0  , 355984.500D0  , 1938333.38D0  ,
     1 0.0D0         , 0.131691754D0  ,5.75846052D0  , 172.905487D0  ,
     2 3016.97754D0  , 29205.1191D0  , 15.6216393D0  , 42190.2656D0  ,
     3 248403.688D0  , 657352.125D0  , 3728875.00D0  , 0.0D0         ,
     4 1.168414718D-03,0.126144901D0  ,10.3602219D0  , 519.234192D0  ,
     5 13235.6475D0  , 16849.2520D0  , 9683044.00D0  , 18919170.0D0  ,
     6 21132330.0D0  , 22473160.0D0  , 0.0D0         , 4.559287336D-04,
     7 6.772233546D-02,6.61125994D0  , 357.740875D0  , 9436.85938D0  ,
     8 12039.8447D0  , 6975326.00D0  , 14523259.0D0  , 16583439.0D0  ,
     9 17588262.0D0  , 0.0D0         /
C * DATA FOR RH ELEMENT #45
      DATA ((XSC(45, I, J), J = 1, 11), I = 1, 14)/
     1 314.038208D0  , 6447.44287D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.53989196D0  , 161.669327D0  , 1460.09253D0  ,
     3 4677.97705D0  , 8160.64990D0  , 9308.90527D0  , 29.3085480D0  ,
     4 528.739258D0  , 6515.34619D0  , 0.000000000D+00,0.00000000D+00,
     5 38.0843735D0  , 2156.85938D0  , 11137.7354D0  , 24749.6211D0  ,
     6 35295.7461D0  , 38326.3281D0  , 3.56632352D0  , 148.508102D0  ,
     7 4819.84473D0  , 0.000000000D+00,0.000000000D+00,6.57411432D0  ,
     8 1300.56580D0  , 13350.1484D0  , 44139.0898D0  , 77349.1563D0  ,
     9 85781.7344D0  , 4.82996225D0  , 235.562592D0  , 8353.98047D0  ,
     * 0.000000000D+00,0.000000000D+00,10.8769188D0  , 2535.83569D0  ,
     1 27146.8809D0  , 91811.0781D0  , 162951.688D0  , 181019.750D0  ,
     2 5.35817719D0  , 95.2024002D0  , 1214.72339D0  , 10722.4795D0  ,
     3 65303.3828D0  , 0.143014431D0  ,655.645508D0  , 14831.9404D0  ,
     4 60216.7891D0  , 102613.008D0  , 0.0D0         , 0.676429868D0  ,
     5 26.0001163D0  , 726.101990D0  , 11706.2002D0  , 91176.9219D0  ,
     6 1.582979597D-02,554.688538D0  , 25534.0957D0  , 107596.227D0  ,
     7 159663.047D0  , 0.0D0         , 0.922076643D0  ,41.5247650D0  ,
     8 1267.58264D0  , 21949.5234D0  , 188445.813D0  , 2.098630182D-02,
     9 1109.49890D0  , 54388.3359D0  , 241933.156D0  , 381712.625D0  ,
     * 0.0D0         , 1.410685759D-02,1.72059906D0  , 152.194992D0  ,
     1 8114.72852D0  , 234223.766D0  , 1.021503587D-03,751.620422D0  ,
     2 127058.289D0  , 1049446.50D0  , 715684.875D0  , 0.0D0         ,
     3 1.114092674D-02,1.87617385D0  , 197.972824D0  , 11399.3711D0  ,
     4 340686.688D0  , 7.530418225D-04,1075.53162D0  , 191977.859D0  ,
     5 1602119.00D0  , 1057860.88D0  , 0.0D0         , 1.02415228D0  ,
     6 17.7333393D0  , 224.654068D0  , 2052.98267D0  , 14765.3525D0  ,
     7 8.12298489D0  , 7134.23730D0  , 81918.4375D0  , 174728.828D0  ,
     8 160096.859D0  , 0.0D0         , 0.115625292D0  ,4.24856138D0  ,
     9 114.261101D0  , 1814.72986D0  , 16040.8086D0  , 8.03506279D0  ,
     * 19158.5625D0  , 102679.789D0  , 292163.031D0  , 1562784.25D0  ,
     1 0.0D0         , 0.156398177D0  ,6.73033333D0  , 197.786179D0  ,
     2 3364.05200D0  , 31917.4922D0  , 12.9800539D0  , 38416.9727D0  ,
     3 243174.047D0  , 550757.750D0  , 3011173.00D0  , 0.0D0         ,
     4 1.553658396D-03,0.166203409D0  ,13.3680382D0  , 647.823730D0  ,
     5 15844.0928D0  , 11416.7881D0  , 6163891.50D0  , 15592759.0D0  ,
     6 15830255.0D0  , 16222802.0D0  , 0.0D0         , 8.063389687D-04,
     7 0.118710421D0  ,11.3625679D0  , 594.924255D0  , 15067.2021D0  ,
     8 10823.0381D0  , 5871011.50D0  , 15941303.0D0  , 16474088.0D0  ,
     9 16681605.0D0  , 0.0D0         /
C * DATA FOR PD ELEMENT #46
      DATA ((XSC(46, I, J), J = 1, 11), I = 1, 14)/
     1 341.820618D0  , 6929.88525D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.48557293D0  , 153.623566D0  , 1385.51062D0  ,
     3 4438.48926D0  , 7752.14160D0  , 8818.31152D0  , 31.9330921D0  ,
     4 567.749390D0  , 6867.76660D0  , 0.000000000D+00,0.00000000D+00,
     5 35.6739388D0  , 2025.88623D0  , 10492.3643D0  , 23366.0879D0  ,
     6 33331.4141D0  , 36074.6445D0  , 4.09528351D0  , 167.752396D0  ,
     7 5341.66504D0  , 0.000000000D+00,0.000000000D+00,6.16704893D0  ,
     8 1215.63281D0  , 12484.5205D0  , 41325.7383D0  , 72403.0078D0  ,
     9 74949.1016D0  , 5.50118160D0  , 264.560547D0  , 9230.24219D0  ,
     * 0.000000000D+00,0.000000000D+00,10.1477365D0  , 2365.25098D0  ,
     1 25387.7773D0  , 86059.5313D0  , 152841.328D0  , 156774.797D0  ,
     2 5.89325142D0  , 103.292404D0  , 1299.56934D0  , 11316.4756D0  ,
     3 67682.6172D0  , 0.132441312D0  ,607.180298D0  , 13884.2705D0  ,
     4 56833.6680D0  , 97394.2891D0  , 0.0D0         , 0.784810185D0  ,
     5 29.6038456D0  , 807.572998D0  , 12640.6689D0  , 94440.4453D0  ,
     6 1.461805869D-02,505.420624D0  , 23651.6230D0  , 101696.453D0  ,
     7 154143.234D0  , 0.0D0         , 1.06200707D0  , 47.0543175D0  ,
     8 1406.76782D0  , 23728.8730D0  , 197113.906D0  , 1.815042086D-02,
     9 1009.27832D0  , 50481.5547D0  , 229668.359D0  , 370052.688D0  ,
     * 0.0D0         , 1.737349667D-02,2.08655882D0  , 180.792755D0  ,
     1 9387.08984D0  , 262496.344D0  , 8.519665571D-04,640.333557D0  ,
     2 111922.383D0  , 965541.938D0  , 597959.000D0  , 0.0D0         ,
     3 1.368676871D-02,2.27084923D0  , 234.873932D0  , 13178.5693D0  ,
     4 381904.469D0  , 6.217189366D-04,911.242188D0  , 169021.984D0  ,
     5 1475317.50D0  , 876121.938D0  , 0.0D0         , 1.14679289D0  ,
     6 19.5808277D0  , 244.713272D0  , 2213.70801D0  , 15841.3955D0  ,
     7 7.48869276D0  , 6840.04199D0  , 78827.8672D0  , 166242.125D0  ,
     8 137745.578D0  , 0.0D0         , 0.136756092D0  ,4.93306541D0  ,
     9 129.562637D0  , 2002.11621D0  , 17290.6992D0  , 7.61036730D0  ,
     * 18528.8125D0  , 100141.703D0  , 282794.250D0  , 1683916.13D0  ,
     1 0.0D0         , 0.183273137D0  ,7.76306963D0  , 223.361755D0  ,
     2 3706.39746D0  , 34494.4453D0  , 12.1436052D0  , 37082.0391D0  ,
     3 238696.328D0  , 533498.500D0  , 3273070.25D0  , 0.0D0         ,
     4 1.931572333D-03,0.200469404D0  ,15.6423988D0  , 734.317932D0  ,
     5 17329.5137D0  , 1353.56152D0  , 96767.9688D0  , 11283164.0D0  ,
     6 9874705.00D0  , 7802603.50D0  , 0.0D0         , 1.495557954D-03,
     7 0.212519825D0  ,19.7038517D0  , 999.829834D0  , 24445.3828D0  ,
     8 2400.72192D0  , 231654.063D0  , 17024572.0D0  , 16258404.0D0  ,
     9 13481004.0D0  , 0.0D0         /
C * DATA FOR AG ELEMENT #47
      DATA ((XSC(47, I, J), J = 1, 11), I = 1, 14)/
     1 371.173615D0  , 7404.35596D0  , 0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.43481195D0  , 146.067505D0  , 1315.53430D0  ,
     3 4213.75439D0  , 7359.54688D0  , 8367.52930D0  , 34.7085419D0  ,
     4 608.202698D0  , 7222.55518D0  , 0.000000000D+00,0.00000000D+00,
     5 33.4021225D0  , 1901.80884D0  , 9878.91504D0  , 22047.4551D0  ,
     6 31481.4609D0  , 34134.9883D0  , 4.68518305D0  , 188.830048D0  ,
     7 5899.13672D0  , 0.000000000D+00,0.000000000D+00,5.80971479D0  ,
     8 1135.11755D0  , 11660.7373D0  , 38641.9258D0  , 67712.7969D0  ,
     9 72616.8516D0  , 6.24195051D0  , 296.090698D0  , 10163.7803D0  ,
     * 0.000000000D+00,0.000000000D+00,9.39600563D0  , 2202.82422D0  ,
     1 23704.5723D0  , 80536.8672D0  , 143151.406D0  , 152821.203D0  ,
     2 6.46324205D0  , 111.762505D0  , 1386.70471D0  , 11912.9297D0  ,
     3 69822.0469D0  , 0.121659912D0  ,557.751953D0  , 12907.9512D0  ,
     4 53366.1133D0  , 92075.2422D0  , 0.0D0         , 0.906831205D0  ,
     5 33.5687065D0  , 894.524719D0  , 13595.2197D0  , 97441.9141D0  ,
     6 1.328355819D-02,453.930481D0  , 21669.6406D0  , 95233.3359D0  ,
     7 146965.922D0  , 0.0D0         , 1.21800828D0  , 53.0988960D0  ,
     8 1554.82153D0  , 25551.3164D0  , 205387.109D0  , 1.623871364D-02,
     9 905.297241D0  , 46351.3789D0  , 215771.313D0  , 354873.563D0  ,
     * 0.0D0         , 2.127772756D-02,2.51450348D0  , 213.351471D0  ,
     1 10782.4453D0  , 292004.375D0  , 6.910418742D-04,531.765259D0  ,
     2 96376.8438D0  , 867885.375D0  , 780110.813D0  , 0.0D0         ,
     3 1.668929122D-02,2.72970104D0  , 276.806854D0  , 15126.2559D0  ,
     4 424861.844D0  , 5.021790857D-04,752.546265D0  , 145539.859D0  ,
     5 1326624.63D0  , 1146642.13D0  , 0.0D0         , 1.27912045D0  ,
     6 21.5915146D0  , 266.562805D0  , 2387.33960D0  , 16980.1543D0  ,
     7 6.52393007D0  , 6185.69434D0  , 73095.4531D0  , 159421.859D0  ,
     8 149676.469D0  , 0.0D0         , 0.161787838D0  ,5.73900700D0  ,
     9 147.378464D0  , 2218.76978D0  , 18746.2285D0  , 4.71469355D0  ,
     * 14223.8457D0  , 92560.6094D0  , 182653.781D0  , 980771.875D0  ,
     1 0.0D0         , 0.215594113D0  ,8.98779106D0  , 253.145477D0  ,
     2 4098.16504D0  , 37397.2734D0  , 10.5392103D0  , 34347.0938D0  ,
     3 236129.094D0  , 444850.438D0  , 2185658.00D0  , 0.0D0         ,
     4 2.605415648D-03,0.273270607D0  ,21.0784111D0  , 955.892883D0  ,
     5 21619.0410D0  , 7536.34375D0  , 3400273.50D0  , 11635234.0D0  ,
     6 10617845.0D0  , 10882367.0D0  , 0.0D0         , 2.015347360D-03,
     7 0.291224808D0  ,26.7979927D0  , 1314.85693D0  , 30838.3770D0  ,
     8 10630.3838D0  , 4795128.50D0  , 17853854.0D0  , 16372035.0D0  ,
     9 16260426.0D0  , 0.0D0         /
C * DATA FOR CD ELEMENT #48
      DATA ((XSC(48, I, J), J = 1, 11), I = 1, 14)/
     1 402.193146D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.38744187D0  , 139.001984D0  , 1250.03833D0  ,
     3 4003.46631D0  , 6993.01221D0  , 7938.74268D0  , 37.6538239D0  ,
     4 650.309753D0  , 7583.02881D0  , 0.000000000D+00,0.00000000D+00,
     5 31.2527809D0  , 1783.91858D0  , 9296.45605D0  , 20793.3301D0  ,
     6 29788.5117D0  , 32232.9414D0  , 5.34350967D0  , 211.952164D0  ,
     7 6498.77979D0  , 0.000000000D+00,0.000000000D+00,5.47050619D0  ,
     8 1059.40247D0  , 10888.5313D0  , 36130.9141D0  , 63333.4414D0  ,
     9 70256.5078D0  , 7.06004715D0  , 330.427429D0  , 11165.3760D0  ,
     * 0.000000000D+00,0.000000000D+00,8.73649120D0  , 2050.06909D0  ,
     1 22124.5645D0  , 75358.7734D0  , 134077.578D0  , 148945.016D0  ,
     2 7.07008743D0  , 120.648285D0  , 1476.84485D0  , 12524.2734D0  ,
     3 71821.1172D0  , 0.111077316D0  ,508.901367D0  , 11937.0459D0  ,
     4 49828.3125D0  , 87278.6406D0  , 0.0D0         , 1.04392672D0  ,
     5 37.9316368D0  , 987.710999D0  , 14587.1270D0  , 100177.531D0  ,
     6 1.194320992D-02,403.858978D0  , 19719.7754D0  , 88850.4609D0  ,
     7 138626.625D0  , 0.0D0         , 1.39177334D0  , 59.7120972D0  ,
     8 1713.33618D0  , 27461.4473D0  , 213595.250D0  , 1.433763001D-02,
     9 801.577026D0  , 42172.6875D0  , 201692.719D0  , 335675.688D0  ,
     * 0.0D0         , 2.590886690D-02,3.01359344D0  , 250.567963D0  ,
     1 12343.2217D0  , 324396.969D0  , 5.484857247D-04,432.801788D0  ,
     2 81782.9531D0  , 773230.188D0  , 1046752.13D0  , 0.0D0         ,
     3 2.025088482D-02,3.26425838D0  , 324.690765D0  , 17305.2656D0  ,
     4 472220.563D0  , 3.991335398D-04,607.127319D0  , 123268.711D0  ,
     5 1181358.50D0  , 1555562.88D0  , 0.0D0         , 1.42603564D0  ,
     6 23.7744255D0  , 289.901031D0  , 2572.53320D0  , 18192.9414D0  ,
     7 5.35037184D0  , 5335.19873D0  , 65342.0234D0  , 151706.297D0  ,
     8 158377.469D0  , 0.0D0         , 0.190790504D0  ,6.65182829D0  ,
     9 166.873779D0  , 2444.54761D0  , 20169.2598D0  , 4.45543766D0  ,
     * 13676.0293D0  , 92448.1406D0  , 160554.719D0  , 692735.563D0  ,
     1 0.0D0         , 0.252439588D0  ,10.3763657D0  , 286.513611D0  ,
     2 4532.94678D0  , 40641.7773D0  , 6.85289192D0  , 27041.0039D0  ,
     3 218305.156D0  , 345191.938D0  , 1344777.13D0  , 0.0D0         ,
     4 3.445164068D-03,0.363392204D0  ,27.6695786D0  , 1215.86316D0  ,
     5 26505.5605D0  , 395.825348D0  , 203484.531D0  , 14914517.0D0  ,
     6 6239630.00D0  , 4870765.50D0  , 0.0D0         , 2.669762820D-03,
     7 0.388387829D0  ,35.3342743D0  , 1681.05505D0  , 38035.3438D0  ,
     8 537.642273D0  , 312976.813D0  , 22128590.0D0  , 9579849.00D0  ,
     9 7131414.00D0  , 0.0D0         /
C * DATA FOR IN ELEMENT #49
      DATA ((XSC(49, I, J), J = 1, 11), I = 1, 14)/
     1 434.917938D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.34354222D0  , 132.399948D0  , 1188.87671D0  ,
     3 3806.95923D0  , 6656.97412D0  , 7536.04053D0  , 40.7497978D0  ,
     4 693.810486D0  , 7944.25537D0  , 0.000000000D+00,0.00000000D+00,
     5 29.2774467D0  , 1675.00842D0  , 8755.65527D0  , 19626.1855D0  ,
     6 28158.8555D0  , 30508.5703D0  , 6.07568169D0  , 237.183563D0  ,
     7 7137.36230D0  , 0.000000000D+00,0.000000000D+00,5.16041517D0  ,
     8 989.900635D0  , 10175.6943D0  , 33801.3555D0  , 59266.4219D0  ,
     9 68483.8516D0  , 7.96010685D0  , 367.610535D0  , 12227.7061D0  ,
     * 0.000000000D+00,0.000000000D+00,8.13598537D0  , 1910.12476D0  ,
     1 20666.8047D0  , 70551.6797D0  , 125639.133D0  , 145913.063D0  ,
     2 7.71465921D0  , 129.926773D0  , 1569.21802D0  , 13137.7842D0  ,
     3 73556.2500D0  , 0.101870246D0  ,464.898895D0  , 11044.6797D0  ,
     4 46562.8008D0  , 82384.8047D0  , 0.0D0         , 1.19739389D0  ,
     5 42.7072029D0  , 1086.68335D0  , 15595.6992D0  , 102573.328D0  ,
     6 1.075263787D-02,359.387512D0  , 17930.0918D0  , 82653.3672D0  ,
     7 131364.328D0  , 0.0D0         , 1.58443534D0  , 66.9061966D0  ,
     8 1881.25659D0  , 29413.6855D0  , 221525.250D0  , 1.272562053D-02,
     9 710.295349D0  , 38356.5313D0  , 188043.344D0  , 317844.719D0  ,
     * 0.0D0         , 3.134656325D-02,3.59037566D0  , 292.593079D0  ,
     1 14046.4658D0  , 358032.625D0  , 4.392093979D-04,353.923401D0  ,
     2 69448.6328D0  , 684298.938D0  , 1362901.38D0  , 0.0D0         ,
     3 2.443429269D-02,3.88134480D0  , 378.674194D0  , 19679.1719D0  ,
     4 521345.250D0  , 3.238790378D-04,492.438324D0  , 104545.422D0  ,
     5 1045670.75D0  , 2049506.75D0  , 0.0D0         , 1.58318138D0  ,
     6 26.0998497D0  , 314.572235D0  , 2766.40479D0  , 19425.8887D0  ,
     7 4.18845844D0  , 4565.28613D0  , 58088.5039D0  , 144032.813D0  ,
     8 158709.734D0  , 0.0D0         , 0.224245504D0  ,7.68499517D0  ,
     9 188.437393D0  , 2689.43237D0  , 21684.5605D0  , 3.29573870D0  ,
     * 11402.6494D0  , 87467.1563D0  , 132859.359D0  , 445682.750D0  ,
     1 0.0D0         , 0.294052601D0  ,11.9301281D0  , 323.080231D0  ,
     2 4995.24609D0  , 43961.3984D0  , 4.95171165D0  , 22385.4727D0  ,
     3 204827.625D0  , 312471.688D0  , 859850.188D0  , 0.0D0         ,
     4 4.493633285D-03,0.474454135D0  ,35.5743599D0  , 1514.22400D0  ,
     5 31812.9629D0  , 71.5568008D0  , 237794.953D0  , 6435903.50D0  ,
     6 6812904.50D0  , 3388422.75D0  , 0.0D0         , 3.482840722D-03,
     7 0.507674456D0  ,45.5484734D0  , 2100.52588D0  , 45842.3477D0  ,
     8 93.4430008D0  , 355699.750D0  , 9263124.00D0  , 10435674.0D0  ,
     9 5075456.00D0  , 0.0D0         /
C * DATA FOR SN ELEMENT #50
      DATA ((XSC(50, I, J), J = 1, 11), I = 1, 14)/
     1 469.335571D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.30278218D0  , 126.259201D0  , 1131.63745D0  ,
     3 3622.84937D0  , 6329.84863D0  , 7176.64746D0  , 44.0108719D0  ,
     4 738.826843D0  , 8308.22559D0  , 0.000000000D+00,0.00000000D+00,
     5 27.4632511D0  , 1574.34033D0  , 8254.03809D0  , 18540.6504D0  ,
     6 26645.5977D0  , 28882.5742D0  , 6.88818979D0  , 264.686493D0  ,
     7 7817.49707D0  , 0.000000000D+00,0.000000000D+00,4.87964249D0  ,
     8 926.749756D0  , 9525.74512D0  , 31670.9961D0  , 55551.7070D0  ,
     9 64946.3008D0  , 8.94866943D0  , 407.852692D0  , 13358.3125D0  ,
     * 0.000000000D+00,0.000000000D+00,7.59024191D0  , 1782.53491D0  ,
     1 19333.6797D0  , 66145.1328D0  , 117902.984D0  , 138816.156D0  ,
     2 8.39794064D0  , 139.619003D0  , 1664.24524D0  , 13759.5059D0  ,
     3 75257.2188D0  , 9.384955466D-02,425.282135D0  , 10229.7158D0  ,
     4 43525.3945D0  , 77673.8906D0  , 0.0D0         , 1.36876702D0  ,
     5 47.9281425D0  , 1191.89270D0  , 16629.6406D0  , 104684.820D0  ,
     6 9.724338539D-03,320.816071D0  , 16334.0898D0  , 76944.7344D0  ,
     7 124711.328D0  , 0.0D0         , 1.79763031D0  , 74.7222824D0  ,
     8 2059.40894D0  , 31429.9531D0  , 228986.734D0  , 1.139104739D-02,
     9 631.474609D0  , 34957.1680D0  , 175520.609D0  , 302964.813D0  ,
     * 0.0D0         , 3.776062652D-02,4.25705576D0  , 340.030151D0  ,
     1 15916.9688D0  , 393437.000D0  , 3.568842076D-04,292.079224D0  ,
     2 59357.5664D0  , 608254.313D0  , 1563263.00D0  , 0.0D0         ,
     3 2.930581942D-02,4.59071922D0  , 439.543304D0  , 22287.4023D0  ,
     4 573262.688D0  , 2.687954111D-04,402.348206D0  , 89147.5625D0  ,
     5 928811.188D0  , 2384795.75D0  , 0.0D0         , 1.75388730D0  ,
     6 28.5942535D0  , 340.728271D0  , 2970.66602D0  , 20701.3730D0  ,
     7 3.48241735D0  , 3979.11450D0  , 52240.3828D0  , 135489.859D0  ,
     8 154490.063D0  , 0.0D0         , 0.262702942D0  ,8.84935951D0  ,
     9 212.117020D0  , 2951.28784D0  , 23259.3906D0  , 2.44925475D0  ,
     * 9630.53125D0  , 82213.8906D0  , 119546.063D0  , 314798.563D0  ,
     1 0.0D0         , 0.342183888D0  ,13.6839066D0  , 363.285828D0  ,
     2 5493.02246D0  , 47471.6484D0  , 3.59649491D0  , 18782.8730D0  ,
     3 191162.406D0  , 299461.094D0  , 616534.125D0  , 0.0D0         ,
     4 5.804231856D-03,0.608823895D0  ,44.7936058D0  , 1847.76965D0  ,
     5 37422.2109D0  , 21.2291412D0  , 173031.516D0  , 872345.125D0  ,
     6 11045122.0D0  , 2410028.00D0  , 0.0D0         , 4.492963664D-03,
     7 0.651289523D0  ,57.4127159D0  , 2567.69458D0  , 54067.1875D0  ,
     8 26.5790653D0  , 256064.547D0  , 1202452.63D0  , 16681656.0D0  ,
     9 3680548.50D0  , 0.0D0         /
C * DATA FOR SB ELEMENT #51
      DATA ((XSC(51, I, J), J = 1, 11), I = 1, 14)/
     1 505.496216D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.26502931D0  , 120.533768D0  , 1078.21399D0  ,
     3 3450.94507D0  , 6030.91211D0  , 6829.84473D0  , 47.4398270D0  ,
     4 785.260803D0  , 8672.91797D0  , 0.000000000D+00,0.00000000D+00,
     5 25.6544991D0  , 1482.06189D0  , 7791.75391D0  , 17536.1699D0  ,
     6 25232.7207D0  , 27353.8516D0  , 7.78759003D0  , 294.564087D0  ,
     7 8538.69238D0  , 0.000000000D+00,0.000000000D+00,4.62826967D0  ,
     8 869.748779D0  , 8935.69824D0  , 29728.7031D0  , 52155.4648D0  ,
     9 61254.6172D0  , 10.0333748D0  , 451.272095D0  , 14553.6240D0  ,
     * 0.000000000D+00,0.000000000D+00,7.10404396D0  , 1667.56592D0  ,
     1 18124.2422D0  , 62121.6719D0  , 110940.953D0  , 131077.984D0  ,
     2 9.12128925D0  , 149.717255D0  , 1761.59387D0  , 14384.0293D0  ,
     3 76311.1875D0  , 8.717016876D-02,390.636078D0  , 9503.69238D0  ,
     4 40772.2461D0  , 73333.0547D0  , 0.0D0         , 1.55957532D0  ,
     5 53.6119347D0  , 1303.03162D0  , 17677.0840D0  , 106432.773D0  ,
     6 8.890544064D-03,288.707092D0  , 14956.6553D0  , 71811.6797D0  ,
     7 118304.641D0  , 0.0D0         , 2.03267574D0  , 83.1816788D0  ,
     8 2247.32642D0  , 33490.4336D0  , 236239.328D0  , 1.033644192D-02,
     9 565.778931D0  , 32018.3027D0  , 164208.984D0  , 288257.781D0  ,
     * 0.0D0         , 4.525857046D-02,5.02239656D0  , 393.184570D0  ,
     1 17949.7637D0  , 429912.750D0  , 2.794173197D-04,244.952682D0  ,
     2 51304.2305D0  , 542743.000D0  , 1568719.38D0  , 0.0D0         ,
     3 3.499866277D-02,5.40406275D0  , 507.655334D0  , 25119.6133D0  ,
     4 626949.313D0  , 2.189208753D-04,334.194427D0  , 76887.9844D0  ,
     5 828476.313D0  , 2417228.50D0  , 0.0D0         , 1.94081104D0  ,
     6 31.2639618D0  , 368.240997D0  , 3183.97900D0  , 22000.8223D0  ,
     7 2.83087897D0  , 3493.35181D0  , 47218.6758D0  , 127794.977D0  ,
     8 150779.203D0  , 0.0D0         , 0.306472033D0  ,10.1463585D0  ,
     9 237.725143D0  , 3225.05713D0  , 24828.2930D0  , 2.04246855D0  ,
     * 8548.25391D0  , 78516.2891D0  , 115483.641D0  , 241015.188D0  ,
     1 0.0D0         , 0.397216707D0  ,15.6378651D0  , 406.766937D0  ,
     2 6016.44824D0  , 51029.2969D0  , 2.94445682D0  , 16596.7090D0  ,
     3 181993.641D0  , 300497.594D0  , 492359.344D0  , 0.0D0         ,
     4 7.412088104D-03,0.769712508D0  ,55.4780731D0  , 2218.22095D0  ,
     5 43305.5313D0  , 9.27482128D0  , 126239.773D0  , 148987.328D0  ,
     6 18163230.0D0  , 1913123.50D0  , 0.0D0         , 5.726999138D-03,
     7 0.822774887D0  ,71.1408691D0  , 3086.07959D0  , 62696.1250D0  ,
     8 11.1955481D0  , 185709.500D0  , 206236.031D0  , 26991814.0D0  ,
     9 2937263.50D0  , 0.0D0         /
C * DATA FOR TE ELEMENT #52
      DATA ((XSC(52, I, J), J = 1, 11), I = 1, 14)/
     1 543.457947D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.23006237D0  , 115.191147D0  , 1028.25171D0  ,
     3 3290.14868D0  , 5755.02539D0  , 6500.19238D0  , 51.0387535D0  ,
     4 833.152344D0  , 9037.26660D0  , 0.000000000D+00,0.00000000D+00,
     5 24.1354580D0  , 1396.82263D0  , 7363.05762D0  , 16601.8809D0  ,
     6 23920.1660D0  , 25938.9570D0  , 8.78302097D0  , 327.007843D0  ,
     7 9303.80078D0  , 0.000000000D+00,0.000000000D+00,4.37503052D0  ,
     8 817.693420D0  , 8395.02051D0  , 27941.9473D0  , 49081.9805D0  ,
     9 57618.5156D0  , 11.2163792D0  , 498.023865D0  , 15818.6797D0  ,
     * 0.000000000D+00,0.000000000D+00,6.65949011D0  , 1562.56665D0  ,
     1 17016.8184D0  , 58433.0078D0  , 104470.789D0  , 123283.906D0  ,
     2 9.88542557D0  , 160.228302D0  , 1861.38550D0  , 15013.1504D0  ,
     3 0.000000000D+00,268.347015D0  , 7620.71045D0  , 29398.8750D0  ,
     4 55816.5430D0  , 72969.3047D0  , 78514.3203D0  , 1.77139270D0  ,
     5 59.7895050D0  , 1420.43896D0  , 18742.4453D0  , 107931.641D0  ,
     6 8.181498386D-03,260.860443D0  , 13730.5879D0  , 67091.4219D0  ,
     7 112186.773D0  , 0.0D0         , 2.29133701D0  , 92.3204727D0  ,
     8 2445.53735D0  , 35605.1328D0  , 243246.750D0  , 9.464330040D-03,
     9 509.012604D0  , 29406.4902D0  , 153818.844D0  , 274294.938D0  ,
     * 0.0D0         , 5.395657942D-02,5.89682484D0  , 452.654053D0  ,
     1 20165.2617D0  , 467900.031D0  , 2.316953905D-04,207.141403D0  ,
     2 44610.1406D0  , 485886.938D0  , 1451067.88D0  , 0.0D0         ,
     3 4.160211980D-02,6.33225298D0  , 583.754639D0  , 28203.6348D0  ,
     4 682898.125D0  , 1.897431648D-04,279.897980D0  , 66722.4688D0  ,
     5 741277.250D0  , 2247015.25D0  , 0.0D0         , 2.13859034D0  ,
     6 34.0773811D0  , 397.046326D0  , 3406.03345D0  , 23322.0332D0  ,
     7 2.39971447D0  , 3090.32886D0  , 42859.1563D0  , 120638.492D0  ,
     8 147175.891D0  , 0.0D0         , 0.356053442D0  ,11.5856295D0  ,
     9 265.413971D0  , 3513.79102D0  , 26433.5625D0  , 1.61186409D0  ,
     * 7437.31689D0  , 73759.3594D0  , 112976.242D0  , 191477.125D0  ,
     1 0.0D0         , 0.458347231D0  ,17.7873383D0  , 453.762604D0  ,
     2 6571.93799D0  , 54741.0703D0  , 2.26832080D0  , 14359.0488D0  ,
     3 170265.156D0  , 300900.313D0  , 417148.813D0  , 0.0D0         ,
     4 9.369441308D-03,0.960885108D0  ,67.7794189D0  , 2628.51807D0  ,
     5 49492.0039D0  , 4.53558826D0  , 91436.6875D0  , 153573.922D0  ,
     6 16884066.0D0  , 1665414.50D0  , 0.0D0         , 7.222595625D-03,
     7 1.02602172D0  , 86.9253845D0  , 3659.91162D0  , 71778.8203D0  ,
     8 5.26037979D0  , 133817.531D0  , 240597.859D0  , 24838258.0D0  ,
     9 2550610.75D0  , 0.0D0         /
C * DATA FOR I  ELEMENT #53
      DATA ((XSC(53, I, J), J = 1, 11), I = 1, 14)/
     1 583.245239D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.19740903D0  , 110.184814D0  , 981.340576D0  ,
     3 3138.84619D0  , 5488.67529D0  , 6199.58057D0  , 54.8252258D0  ,
     4 882.531311D0  , 9402.86230D0  , 0.000000000D+00,0.00000000D+00,
     5 22.7374363D0  , 1317.67639D0  , 6963.47266D0  , 15728.3428D0  ,
     6 22737.3457D0  , 24558.4648D0  , 9.87876797D0  , 362.167480D0  ,
     7 10115.4580D0  , 0.000000000D+00,0.000000000D+00,4.16131210D0  ,
     8 769.584045D0  , 7895.64453D0  , 26293.9961D0  , 46208.0469D0  ,
     9 54148.6484D0  , 12.5069389D0  , 548.316711D0  , 17158.7988D0  ,
     * 0.000000000D+00,0.000000000D+00,6.21549034D0  , 1465.90515D0  ,
     1 15995.8418D0  , 55028.0117D0  , 98476.6797D0  , 116015.422D0  ,
     2 10.6919308D0  , 171.167542D0  , 1963.88062D0  , 15650.5244D0  ,
     3 0.000000000D+00,246.685699D0  , 7083.80664D0  , 27512.1523D0  ,
     4 52495.8242D0  , 68880.9609D0  , 74222.1406D0  , 2.00614882D0  ,
     5 66.4919968D0  , 1544.36499D0  , 19827.3535D0  , 108353.477D0  ,
     6 7.553438190D-03,236.124390D0  , 12618.8340D0  , 62695.4531D0  ,
     7 106305.945D0  , 0.0D0         , 2.57510161D0  , 102.176842D0  ,
     8 2654.61157D0  , 37784.0742D0  , 250097.375D0  , 8.723785169D-03,
     9 458.359650D0  , 27024.2891D0  , 144081.719D0  , 260777.641D0  ,
     * 0.0D0         , 6.408919394D-02,6.89599848D0  , 519.143921D0  ,
     1 22592.1602D0  , 509126.281D0  , 1.929337450D-04,175.291458D0  ,
     2 38821.3633D0  , 435245.531D0  , 1298463.13D0  , 0.0D0         ,
     3 4.922960699D-02,7.38825369D0  , 668.624268D0  , 31571.2012D0  ,
     4 743100.750D0  , 1.664647862D-04,235.063843D0  , 58034.3086D0  ,
     5 664276.000D0  , 2012410.00D0  , 0.0D0         , 2.35337949D0  ,
     6 37.0662956D0  , 427.166504D0  , 3637.14014D0  , 24670.3906D0  ,
     7 2.03494740D0  , 2725.11133D0  , 38797.4688D0  , 113233.711D0  ,
     8 142574.188D0  , 0.0D0         , 0.412523240D0  ,13.1800241D0  ,
     9 295.146637D0  , 3815.27075D0  , 28041.0430D0  , 1.32522774D0  ,
     * 6511.53564D0  , 69118.1094D0  , 111560.750D0  , 161005.781D0  ,
     1 0.0D0         , 0.526673079D0  ,20.1478863D0  , 504.201324D0  ,
     2 7155.66553D0  , 58536.1875D0  , 1.81927359D0  , 12502.0205D0  ,
     3 159002.281D0  , 301011.219D0  , 377583.531D0  , 0.0D0         ,
     4 1.171184145D-02,1.18566418D0  , 81.8601913D0  , 3081.73657D0  ,
     5 56009.5430D0  , 2.33227348D0  , 65372.1094D0  , 245734.016D0  ,
     6 7527104.50D0  , 1628419.25D0  , 0.0D0         , 9.003613144D-03,
     7 1.26440704D0  , 104.971863D0  , 4293.61768D0  , 81361.2031D0  ,
     8 2.58736515D0  , 95179.1016D0  , 385469.375D0  , 10990779.0D0  ,
     9 2475894.75D0  , 0.0D0         /
C * DATA FOR XE ELEMENT #54
      DATA ((XSC(54, I, J), J = 1, 11), I = 1, 14)/
     1 624.902771D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.16669405D0  , 105.467674D0  , 937.121216D0  ,
     3 2996.29761D0  , 5237.44922D0  , 5917.15186D0  , 58.7911682D0  ,
     4 933.676514D0  , 9777.10059D0  , 0.000000000D+00,0.00000000D+00,
     5 21.3622379D0  , 1240.57385D0  , 6577.08008D0  , 14887.8174D0  ,
     6 21553.1895D0  , 23289.6211D0  , 11.0863647D0  , 400.323730D0  ,
     7 10981.6182D0  , 0.000000000D+00,0.000000000D+00,3.95615411D0  ,
     8 724.057129D0  , 7425.85840D0  , 24750.0664D0  , 43523.0820D0  ,
     9 50915.9023D0  , 13.9128065D0  , 602.490906D0  , 18586.5664D0  ,
     * 0.000000000D+00,0.000000000D+00,5.82589436D0  , 1374.63269D0  ,
     1 15035.8057D0  , 51837.3047D0  , 92885.4141D0  , 109281.883D0  ,
     2 11.5422506D0  , 182.560226D0  , 2069.69287D0  , 16305.2402D0  ,
     3 0.000000000D+00,225.554062D0  , 6558.44336D0  , 25666.5449D0  ,
     4 49240.8281D0  , 64829.4492D0  , 69698.6953D0  , 2.26599121D0  ,
     5 73.7758789D0  , 1676.35754D0  , 20961.6934D0  , 125156.141D0  ,
     6 6.453159265D-03,211.357910D0  , 11509.1846D0  , 58277.1328D0  ,
     7 100207.680D0  , 0.0D0         , 2.88628817D0  , 112.821999D0  ,
     8 2876.83911D0  , 40080.6445D0  , 254936.969D0  , 8.000156842D-03,
     9 408.548584D0  , 24666.2402D0  , 134316.453D0  , 246848.984D0  ,
     * 0.0D0         , 7.581371069D-02,8.03451633D0  , 593.645935D0  ,
     1 25286.0742D0  , 554710.313D0  , 1.593173656D-04,146.911163D0  ,
     2 33567.6992D0  , 388215.625D0  , 1148923.00D0  , 0.0D0         ,
     3 5.801723897D-02,8.58840179D0  , 763.666443D0  , 35315.5352D0  ,
     4 810876.438D0  , 1.457292674D-04,194.779999D0  , 50045.7188D0  ,
     5 592061.188D0  , 1774536.25D0  , 0.0D0         , 2.58266187D0  ,
     6 40.2186584D0  , 458.666656D0  , 3879.22339D0  , 26078.4570D0  ,
     7 1.62305725D0  , 2361.20264D0  , 34653.8359D0  , 104898.953D0  ,
     8 136050.734D0  , 0.0D0         , 0.475486934D0  ,14.9392967D0  ,
     9 327.582428D0  , 4144.67236D0  , 29800.2109D0  , 0.845944464D0  ,
     * 4936.92480D0  , 59695.6836D0  , 104645.664D0  , 133242.016D0  ,
     1 0.0D0         , 0.603808820D0  ,22.7610054D0  , 559.287720D0  ,
     2 7799.18701D0  , 62819.4063D0  , 1.11512387D0  , 9363.07715D0  ,
     3 135641.188D0  , 282984.938D0  , 336481.969D0  , 0.0D0         ,
     4 1.452930365D-02,1.44994819D0  , 97.9827118D0  , 3587.86743D0  ,
     5 63078.9258D0  , 1.02980137D0  , 41673.0234D0  , 314019.625D0  ,
     6 2160809.75D0  , 2001500.50D0  , 0.0D0         , 1.111309417D-02,
     7 1.54286444D0  , 125.607826D0  , 5001.27832D0  , 91777.6953D0  ,
     8 1.07193601D0  , 60255.1250D0  , 485718.219D0  , 3088150.00D0  ,
     9 2997721.00D0  , 0.0D0         /
C * DATA FOR CS ELEMENT #55
      DATA ((XSC(55, I, J), J = 1, 11), I = 1, 17)/
     1 668.320923D0  , 0.000000000D+00,0.000000000D+00,0.00000000D+00,
     2 0.000000000D+00,1.13831234D0  , 101.049385D0  , 895.576660D0  ,
     3 2862.36206D0  , 5007.01465D0  , 5643.01758D0  , 62.9148407D0  ,
     4 985.461731D0  , 10133.5908D0  , 0.000000000D+00,0.00000000D+00,
     5 20.2039261D0  , 1173.67969D0  , 6234.69531D0  , 14131.9902D0  ,
     6 20480.4668D0  , 22111.2813D0  , 12.4088593D0  , 441.206024D0  ,
     7 11877.7227D0  , 0.000000000D+00,0.000000000D+00,3.77663493D0  ,
     8 683.332703D0  , 6998.48926D0  , 23326.7520D0  , 41032.0469D0  ,
     9 48133.7227D0  , 15.4399595D0  , 660.235291D0  , 20066.7324D0  ,
     * 0.000000000D+00,0.000000000D+00,5.47628450D0  , 1291.51416D0  ,
     1 14149.7021D0  , 48858.8516D0  , 87793.4297D0  , 103287.031D0  ,
     2 12.4345665D0  , 194.303421D0  , 2176.17163D0  , 16932.8340D0  ,
     3 0.000000000D+00,207.813293D0  , 6103.18750D0  , 24027.2090D0  ,
     4 46306.1641D0  , 61175.3398D0  , 66349.1484D0  , 2.55166268D0  ,
     5 81.5791855D0  , 1811.97534D0  , 22041.3555D0  , 0.00000000D+00,
     6 132.541412D0  , 8887.50684D0  , 41439.9219D0  , 78768.7188D0  ,
     7 99256.2813D0  , 116908.328D0  , 3.22512913D0  , 124.162460D0  ,
     8 3105.34570D0  , 42307.8672D0  , 286714.625D0  , 7.030848414D-03,
     9 369.943176D0  , 22729.1934D0  , 125855.672D0  , 234657.953D0  ,
     * 0.0D0         , 8.929523826D-02,9.31651497D0  , 674.936401D0  ,
     1 28080.4043D0  , 598648.063D0  , 1.352251275D-04,125.515762D0  ,
     2 29354.1777D0  , 347528.063D0  , 1013736.50D0  , 0.0D0         ,
     3 6.807342172D-02,9.93690300D0  , 867.317322D0  , 39209.3945D0  ,
     4 875926.188D0  , 1.313709508D-04,164.260330D0  , 43590.1602D0  ,
     5 529143.375D0  , 1566129.13D0  , 0.0D0         , 2.82313156D0  ,
     6 43.5039444D0  , 491.150970D0  , 4124.45654D0  , 27439.4531D0  ,
     7 1.35660052D0  , 2063.27148D0  , 31075.7227D0  , 96953.8828D0  ,
     8 136826.000D0  , 0.0D0         , 0.545892358D0  ,16.8631973D0  ,
     9 362.008423D0  , 4482.41504D0  , 31513.4902D0  , 0.584037483D0  ,
     * 3832.93018D0  , 51790.2969D0  , 99812.5313D0  , 119684.563D0  ,
     1 0.0D0         , 0.688148081D0  ,25.5704937D0  , 616.470398D0  ,
     2 8429.50781D0  , 66677.3281D0  , 0.917055428D0  ,8224.60254D0  ,
     3 126086.664D0  , 282213.500D0  , 341443.250D0  , 0.0D0         ,
     4 1.783043146D-02,1.75544798D0  , 116.101906D0  , 4130.71094D0  ,
     5 70102.7969D0  , 0.542041779D0  ,28382.6523D0  , 333746.094D0  ,
     6 509263.906D0  , 33172810.0D0  , 0.0D0         , 1.359604299D-02,
     7 1.86466908D0  , 148.681335D0  , 5751.55957D0  , 101874.367D0  ,
     8 0.606637239D0  ,43811.2578D0  , 516660.094D0  , 794425.000D0  ,
     9 40387076.0D0  , 0.0D0         , 0.472456068D0  ,6.95320225D0  ,
     * 76.9159241D0  , 654.311829D0  , 4590.27783D0  , 56.5033722D0  ,
     1 17553.1426D0  , 113058.570D0  , 88327.1797D0  , 39314.4805D0  ,
     2 0.0D0         , 7.315488160D-02,2.10896921D0  , 43.6368027D0  ,
     3 542.001160D0  , 4002.73047D0  , 117.951195D0  , 22826.1758D0  ,
     4 299502.938D0  , 6245063.50D0  , 34782560.0D0  , 0.0D0         ,
     5 8.944954723D-02,3.08562970D0  , 71.4837799D0  , 977.464233D0  ,
     6 8012.70508D0  , 281.478271D0  , 62977.6602D0  , 667453.938D0  ,
     7 14187204.0D0  , 75207264.0D0  , 0.0D0         /
C * DATA FOR BA ELEMENT #56
      DATA ((XSC(56, I, J), J = 1, 11), I = 1, 17)/
     1 713.582458D0  , 0.000000000D+00,0.000000000D+0, 0.00000000D+00,
     2 0.000000000D+00,1.11179888D0  , 96.9028397D0  , 856.469177D0  ,
     3 2735.89893D0  , 4783.97607D0  , 5391.82031D0  , 67.2285004D0  ,
     4 1038.76208D0  , 10493.1992D0  , 0.000000000D+0, 0.00000000D+00,
     5 19.0881329D0  , 1109.38501D0  , 5906.62012D0  , 13409.1484D0  ,
     6 19454.8555D0  , 20960.9531D0  , 13.8606262D0  , 485.220032D0  ,
     7 12817.0371D0  , 0.000000000D+00,0.000000000D+0, 3.61123204D0  ,
     8 645.642761D0  , 6601.72070D0  , 22001.8965D0  , 38780.4063D0  ,
     9 45369.6211D0  , 17.0906467D0  , 721.810120D0  , 21613.8535D0  ,
     * 0.000000000D+00,0.000000000D+00,5.15737438D0  , 1215.44312D0  ,
     1 13334.3994D0  , 46105.3984D0  , 82941.5078D0  , 97501.9453D0  ,
     2 13.3712473D0  , 206.457520D0  , 2284.67334D0  , 17555.6973D0  ,
     3 0.000000000D+00,191.704315D0  , 5684.00342D0  , 22503.7188D0  ,
     4 43555.9180D0  , 57755.9063D0  , 62266.0430D0  , 2.86609626D0  ,
     5 89.9967422D0  , 1954.58813D0  , 23138.7617D0  , 0.00000000D+00,
     6 120.214737D0  , 8159.10010D0  , 38513.3047D0  , 74012.3203D0  ,
     7 93928.9297D0  , 108998.781D0  , 3.59444380D0  , 136.313110D0  ,
     8 3344.86377D0  , 44585.9531D0  , 0.000000000D+0, 227.145859D0  ,
     9 17394.1035D0  , 87520.2578D0  , 177928.750D0  , 235298.797D0  ,
     * 271842.844D0  , 0.104761206D0  ,10.7616501D0  , 764.411133D0  ,
     1 31069.1133D0  , 644373.125D0  , 1.156260405D-04,107.815460D0  ,
     2 25759.6895D0  , 311501.281D0  , 900985.125D0  , 0.0D0         ,
     3 7.956307381D-02,11.4523907D0  , 981.137512D0  , 43359.9141D0  ,
     4 943255.750D0  , 1.209549810D-04,139.529465D0  , 38155.8359D0  ,
     5 473915.219D0  , 1389455.50D0  , 0.0D0         , 3.08263111D0  ,
     6 46.9716301D0  , 524.796814D0  , 4374.58398D0  , 28774.8438D0  ,
     7 1.17016554D0  , 1838.27747D0  , 28246.3711D0  , 90572.1094D0  ,
     8 129712.180D0  , 0.0D0         , 0.625213265D0 , 18.9666653D0  ,
     9 398.201202D0  , 4820.63867D0  , 33107.3359D0  , 0.478750050D0 ,
     * 3297.26660D0  , 47314.3828D0  , 97749.9844D0  , 109830.711D0  ,
     1 0.0D0         , 0.781740725D0  ,28.6364632D0  , 677.618713D0  ,
     2 9093.28320D0  , 70677.2500D0  , 0.729823232D0 , 7054.22217D0  ,
     3 115113.430D0  , 276223.219D0  , 328282.125D0  , 0.0D0         ,
     4 2.173442580D-02,2.10992384D0  , 136.500305D0  , 4715.90088D0  ,
     5 77176.7109D0  , 0.333374560D0  ,21233.9199D0  , 328205.063D0  ,
     6 191381.984D0  , 5116668.00D0  , 0.0D0         , 1.655145921D-02,
     7 2.23914099D0  , 174.731979D0  , 6567.91357D0  , 112285.172D0  ,
     8 0.355158508D0  ,32598.8613D0  , 509330.250D0  , 286083.969D0  ,
     9 8133637.00D0  , 0.0D0         , 0.551031470D0 , 8.08315945D0  ,
     * 88.9186935D0  , 753.340576D0  , 5275.69482D0  , 20.1813545D0  ,
     1 8736.69629D0  , 76697.9141D0  , 119734.805D0  , 46879.7344D0  ,
     2 0.0D0         , 9.369242191D-02,2.68614078D0  , 54.6888275D0  ,
     3 664.928711D0  , 4825.64844D0  , 82.7137222D0  , 21627.6367D0  ,
     4 176767.813D0  , 2802744.50D0  , 14046967.0D0  , 0.0D0         ,
     5 0.115231708D0  ,3.96815205D0  , 90.7736359D0  , 1219.17761D0  ,
     6 9861.18945D0  , 193.207626D0  , 59549.1172D0  , 412173.219D0  ,
     7 5905087.50D0  , 30859814.0D0  , 0.0D0         /
C * DATA FOR LA ELEMENT #57
      DATA ((XSC(57, I, J), J = 1, 11), I = 1, 17)/
     1 760.622742D0  , 0.000000000D+0, 0.000000000D+0, 0.000000000D+0,
     2 0.000000000D+0, 1.08746529D0  , 93.0395203D0  , 819.900757D0  ,
     3 2617.47217D0  , 4574.85010D0  , 5157.28516D0  , 71.7344208D0  ,
     4 1093.24158D0  , 10849.6484D0  , 0.000000000D+0, 0.000000000D+0,
     5 18.1027164D0  , 1051.47766D0  , 5608.29297D0  , 12748.2500D0  ,
     6 18545.5527D0  , 19904.3516D0  , 15.4446859D0  , 532.367676D0  ,
     7 13792.8945D0  , 0.000000000D+0, 0.000000000D+0, 3.46828914D0  ,
     8 612.457642D0  , 6248.75586D0  , 20814.9590D0  , 36688.3828D0  ,
     9 41857.4805D0  , 18.8738060D0  , 787.280396D0  , 23222.7852D0  ,
     * 0.000000000D+0, 0.000000000D+0, 4.88159323D0  , 1148.77698D0  ,
     1 12612.4453D0  , 43647.6953D0  , 78571.0156D0  , 89963.6719D0  ,
     2 14.3574810D0  , 218.963730D0  , 2393.10010D0  , 18141.1133D0  ,
     3 0.000000000D+0, 180.240738D0  , 5369.84570D0  , 21318.6699D0  ,
     4 41354.8047D0  , 55034.1289D0  , 58846.9102D0  , 3.21070743D0  ,
     5 99.0047684D0  , 2101.86963D0  , 24202.1484D0  , 0.000000000D+0,
     6 111.235100D0  , 7595.96582D0  , 36149.2617D0  , 70033.2422D0  ,
     7 89405.4063D0  , 104330.344D0  , 3.99530911D0  , 149.249466D0  ,
     8 3592.67651D0  , 46846.2500D0  , 0.000000000D+0, 208.944336D0  ,
     9 16194.5527D0  , 82332.9766D0  , 168956.438D0  , 224955.078D0  ,
     * 259557.609D0  , 0.122428671D0  ,12.3795862D0  , 861.627136D0  ,
     1 34171.8516D0  , 689897.938D0  , 1.033526787D-04,95.9333115D0  ,
     2 23207.3984D0  , 284373.250D0  , 819914.250D0  , 0.0D0         ,
     3 9.262146056D-02,13.1446447D0  , 1104.64941D0  , 47668.8398D0  ,
     4 1009631.00D0  , 1.158792584D-04,122.895706D0  , 34300.3750D0  ,
     5 432385.813D0  , 1263590.63D0  , 0.0D0         , 3.35369444D0  ,
     6 50.5715675D0  , 559.346008D0  , 4626.12598D0  , 30044.0469D0  ,
     7 1.07607150D0  , 1714.85522D0  , 26598.2578D0  , 86576.2031D0  ,
     8 125810.188D0  , 0.0D0         , 0.712526858D0  ,21.2413349D0  ,
     9 436.218292D0  , 5161.81543D0  , 34613.3047D0  , 0.422868967D0  ,
     * 3052.04541D0  , 45007.6914D0  , 97081.1250D0  , 109125.227D0  ,
     1 0.0D0         , 0.885864735D0  ,31.9587975D0  , 741.741638D0  ,
     2 9764.77148D0  , 74519.5469D0  , 0.670626879D0  ,6612.56006D0  ,
     3 110712.016D0  , 276993.594D0  , 337661.438D0  , 0.0D0         ,
     4 2.634496614D-02,2.51742959D0  , 159.058853D0  , 5327.98145D0  ,
     5 83920.8281D0  , 0.305604696D0  ,19869.7539D0  , 330691.094D0  ,
     6 173071.016D0  , 1769126.13D0  , 0.0D0         , 1.999914832D-02,
     7 2.66824508D0  , 203.687515D0  , 7435.59229D0  , 122600.813D0  ,
     8 0.280723274D0  ,28343.6602D0  , 502299.375D0  , 256709.563D0  ,
     9 2599748.00D0  , 0.0D0         , 0.634120166D0  ,9.22574329D0  ,
     * 100.573242D0  , 845.609009D0  , 5863.55518D0  , 34.9373627D0  ,
     1 13069.1367D0  , 102413.617D0  , 145775.375D0  , 82583.2813D0  ,
     2 0.0D0         , 0.115328141D0  ,3.26670742D0  , 65.2264099D0  ,
     3 776.051514D0  , 5532.49072D0  , 138.578018D0  , 28625.2891D0  ,
     4 268284.125D0  , 3371859.00D0  , 11701498.0D0  , 0.0D0         ,
     5 0.141208023D0  ,4.82152081D0  , 108.560730D0  , 1432.34155D0  ,
     6 11431.7119D0  , 237.852753D0  , 70301.5703D0  , 473999.531D0  ,
     7 5534420.00D0  , 21534214.0D0  , 0.0D0         /
C * DATA FOR CE ELEMENT #58
      DATA ((XSC(58, I, J), J = 1, 11), I = 1, 18)/
     1 809.808044D0  , 0.000000000D+0, 0.000000000D+0, 0.000000000D+0,
     2 0.000000000D+0, 1.06494546D0  , 89.4196777D0  , 785.679443D0  ,
     3 2507.05469D0  , 4384.17139D0  , 4934.34863D0  , 76.4517670D0  ,
     4 1149.86023D0  , 11217.5518D0  , 0.000000000D+0, 0.000000000D+0,
     5 17.2115879D0  , 999.253052D0  , 5340.44824D0  , 12156.1689D0  ,
     6 17694.2715D0  , 18956.2617D0  , 17.1871319D0  , 583.774780D0  ,
     7 14862.6494D0  , 0.000000000D+00,0.000000000D+00,3.34046555D0  ,
     8 582.965149D0  , 5939.49902D0  , 19788.4238D0  , 34880.5117D0  ,
     9 39648.7305D0  , 20.8196659D0  , 858.343506D0  , 24986.5137D0  ,
     * 0.000000000D+0, 0.000000000D+0, 4.63358974D0  , 1089.41125D0  ,
     1 11981.6689D0  , 41540.0820D0  , 74921.2031D0  , 87887.2813D0  ,
     2 15.3994770D0  , 232.209656D0  , 2510.77319D0  , 18812.0273D0  ,
     3 0.000000000D+0, 169.179718D0  , 5079.00439D0  , 20256.5059D0  ,
     4 39389.9805D0  , 52409.5625D0  , 56607.7656D0  , 3.59319282D0  ,
     5 108.887032D0  , 2263.31470D0  , 25395.0762D0  , 0.000000000D+0,
     6 103.819031D0  , 7137.40576D0  , 34230.3945D0  , 66648.0156D0  ,
     7 85321.3125D0  , 100858.266D0  , 4.43625975D0  , 163.381516D0  ,
     8 3865.47168D0  , 49440.1797D0  , 0.000000000D+0, 193.663513D0  ,
     9 15214.8311D0  , 78193.3125D0  , 161653.813D0  , 216238.609D0  ,
     * 250859.453D0  , 0.142987847D0 , 14.2490416D0  , 974.597046D0  ,
     1 37971.5156D0  , 766256.375D0  , 9.374778892D-05,86.6941147D0  ,
     2 21336.9805D0  , 266197.406D0  , 783598.063D0  , 0.0D0         ,
     3 0.107752517D0  ,15.0949926D0  , 1248.11316D0  , 52964.6797D0  ,
     4 1117025.88D0  , 1.129675657D-04,109.798767D0  , 31450.6113D0  ,
     5 404560.438D0  , 1208476.25D0  , 0.0D0         , 3.61078858D0  ,
     6 53.8377266D0  , 589.919250D0  , 4852.89404D0  , 31144.9297D0  ,
     7 0.976827741D0  ,1578.11487D0  , 24810.5371D0  , 80955.2500D0  ,
     8 117010.914D0  , 0.0D0         , 0.800607145D0 , 23.4364147D0  ,
     9 471.346466D0  , 5469.02637D0  , 35751.8672D0  , 0.367917597D0 ,
     * 2727.51880D0  , 41595.8828D0  , 90040.4922D0  , 99440.3594D0  ,
     1 0.0D0         , 0.984948337D0  ,35.0290184D0  , 799.215332D0  ,
     2 10361.3623D0  , 77732.5938D0  , 0.551236331D0  ,5903.72998D0  ,
     3 102664.188D0  , 259700.688D0  , 312581.281D0  , 0.0D0         ,
     4 3.089012951D-02,2.90309620D0  , 179.588837D0  , 5875.51270D0  ,
     5 89656.0000D0  , 0.224790260D0  ,16450.4414D0  , 302828.688D0  ,
     6 155294.266D0  , 2181362.25D0  , 0.0D0         , 2.329728007D-02,
     7 3.06572342D0  , 229.529587D0  , 8191.41748D0  , 131030.469D0  ,
     8 0.198385447D0  ,23346.7324D0  , 458748.375D0  , 230269.875D0  ,
     9 3252526.25D0  , 0.0D0         , 1.035557761D-05,3.610637737D-03,
     * 0.808584511D0  ,99.4774170D0  , 7211.28125D0  , 5.046080914D-04,
     1 1199.99670D0  , 226161.875D0  , 939981.813D0  , 176164.344D0  ,
     2 0.0D0         , 0.651443303D0  ,9.37103844D0  , 101.202232D0  ,
     3 846.455566D0  , 5818.99902D0  , 25.0341949D0  , 10096.7607D0  ,
     4 82769.1406D0  , 119174.609D0  , 54989.6055D0  , 0.0D0         ,
     5 0.121410131D0  ,3.36805582D0  , 65.7644196D0  , 767.275940D0  ,
     6 5356.12988D0  , 63.9939270D0  , 19259.2656D0  , 134978.344D0  ,
     7 2124584.25D0  , 10484848.0D0  , 0.0D0         , 0.146372274D0  ,
     8 4.90951490D0  , 108.452263D0  , 1408.65442D0  , 11072.5674D0  ,
     9 105.411148D0  , 45629.6680D0  , 262444.625D0  , 3349819.25D0  ,
     * 19155670.0D0  , 0.0D0         /
C * DATA FOR PR ELEMENT #59
      DATA ((XSC(59, I, J), J = 1, 11), I = 1, 18)/
     1 860.712097D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,1.04404485D0  , 86.0257263D0  , 753.414917D0  ,
     3 2402.43408D0  , 4199.05176D0  , 4728.57568D0  , 81.3395538D0  ,
     4 1207.10864D0  , 11565.8018D0  , 0.000000000D+00,0.000000000D+0,
     5 16.3109131D0  , 951.270203D0  , 5091.45117D0  , 11600.6182D0  ,
     6 16877.1348D0  , 18157.6543D0  , 19.0795765D0  , 638.302734D0  ,
     7 15951.4932D0  , 0.000000000D+00,0.000000000D+00,3.22954988D0  ,
     8 556.463745D0  , 5655.64258D0  , 18830.7266D0  , 33142.2188D0  ,
     9 37849.7344D0  , 22.9036770D0  , 933.039917D0  , 26775.6172D0  ,
     * 0.000000000D+00,0.000000000D+00,4.41599846D0  , 1036.26831D0  ,
     1 11404.3916D0  , 39572.0508D0  , 71370.6797D0  , 83811.2344D0  ,
     2 16.4826298D0  , 245.755096D0  , 2628.28271D0  , 19448.8730D0  ,
     3 0.000000000D+00,158.747223D0  , 4798.38330D0  , 19215.6523D0  ,
     4 37455.7188D0  , 49881.4883D0  , 54007.9102D0  , 4.00849056D0  ,
     5 119.319763D0  , 2425.90112D0  , 26482.9023D0  , 0.000000000D+0,
     6 98.3049698D0  , 6764.58691D0  , 32577.4707D0  , 63681.0547D0  ,
     7 81833.2656D0  , 95781.7969D0  , 4.91230440D0  , 178.217194D0  ,
     8 4139.19287D0  , 51840.7891D0  , 0.000000000D+00,182.810226D0  ,
     9 14453.4980D0  , 74755.5313D0  , 155398.234D0  , 208608.172D0  ,
     * 243150.438D0  , 0.166180491D0  ,16.3103027D0  , 1094.47742D0  ,
     1 41736.0703D0  , 853500.313D0  , 8.752152644D-05,79.9549789D0  ,
     2 19838.3828D0  , 249923.359D0  , 741483.375D0  , 0.0D0         ,
     3 0.124732487D0  ,17.2376976D0  , 1399.79138D0  , 58175.6797D0  ,
     4 1234410.50D0  , 1.128136355D-04,100.572495D0  , 29242.8535D0  ,
     5 380224.063D0  , 1145307.25D0  , 0.0D0         , 3.88804603D0  ,
     6 57.3575478D0  , 622.517395D0  , 5085.46436D0  , 32177.2168D0  ,
     7 0.930876434D0  ,1505.27185D0  , 23761.2402D0  , 77547.5938D0  ,
     8 112279.977D0  , 0.0D0         , 0.899813354D0  ,25.8756599D0  ,
     9 509.420319D0  , 5787.86377D0  , 36860.5078D0  , 0.347547859D0 ,
     * 2571.41772D0  , 39730.1016D0  , 86690.9844D0  , 95286.7266D0  ,
     1 0.0D0         , 1.09892488D0  , 38.4812775D0  , 862.006897D0  ,
     2 10987.7666D0  , 80905.5938D0  , 0.521490991D0  ,5636.45605D0  ,
     3 99302.6797D0  , 253925.141D0  , 306984.688D0  , 0.0D0         ,
     4 3.637861088D-02,3.36317515D0  , 203.367188D0  , 6471.13867D0  ,
     5 95183.6875D0  , 0.234063476D0  ,16634.0469D0  , 300942.000D0  ,
     6 155594.250D0  , 1859522.25D0  , 0.0D0         , 2.732011490D-02,
     7 3.54275942D0  , 259.574341D0  , 9017.19824D0  , 139186.813D0  ,
     8 0.203849971D0  ,23572.1543D0  , 456056.719D0  , 231231.016D0  ,
     9 2776127.50D0  , 0.0D0         , 2.183549441D-05,7.402888034D-03,
     * 1.58398998D0  , 180.476883D0  , 11228.9365D0  , 2134.21289D0  ,
     1 3177413.00D0  , 1800969.50D0  , 1281234.88D0  , 1149309.13D0  ,
     2 0.0D0         , 0.698364556D0  ,9.93235111D0  , 106.226723D0  ,
     3 882.846558D0  , 6008.07275D0  , 27.0433693D0  , 10559.6523D0  ,
     4 83490.3438D0  , 114421.273D0  , 52936.0195D0  , 0.0D0         ,
     5 0.134908944D0  ,3.68196821D0  , 70.4402924D0  , 805.636169D0  ,
     6 5511.17969D0  , 50.8948174D0  , 17093.0000D0  , 110354.102D0  ,
     7 1795618.25D0  , 9865037.00D0  , 0.0D0         , 0.160756379D0 ,
     8 5.32210493D0  , 115.589355D0  , 1477.56909D0  , 11442.8271D0  ,
     9 82.3358917D0  , 40193.3594D0  , 223769.688D0  , 2781508.00D0  ,
     * 17979608.0D0  , 0.0D0         /
C * DATA FOR ND ELEMENT #60
      DATA ((XSC(60, I, J), J = 1, 11), I = 1, 18)/
     1 913.447388D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,1.02490735D0  , 82.8395767D0  , 723.043884D0  ,
     3 2304.07080D0  , 4028.49536D0  , 4529.63818D0  , 86.4296341D0  ,
     4 1265.45947D0  , 11914.8076D0  , 0.000000000D+00,0.000000000D+0,
     5 15.5730972D0  , 906.954590D0  , 4859.86523D0  , 11082.6943D0  ,
     6 16151.4941D0  , 17348.4160D0  , 21.1415882D0  , 696.520569D0  ,
     7 17076.5527D0  , 0.000000000D+00,0.000000000D+00,3.13180876D0  ,
     8 532.388794D0  , 5395.26465D0  , 17946.8633D0  , 31614.7520D0  ,
     9 36935.4258D0  , 25.1437130D0  , 1012.18188D0  , 28640.3652D0  ,
     * 0.000000000D+00,0.000000000D+00,4.22006083D0  , 987.990540D0  ,
     1 10876.1992D0  , 37762.1992D0  , 68143.7031D0  , 79710.7188D0  ,
     2 17.6077061D0  , 259.519012D0  , 2743.41016D0  , 20013.6563D0  ,
     3 0.000000000D+00,152.314575D0  , 4609.48486D0  , 18466.1133D0  ,
     4 35998.0273D0  , 47935.9570D0  , 51975.0820D0  , 4.46138382D0  ,
     5 130.456482D0  , 2594.31519D0  , 27548.5840D0  , 0.000000000D+0,
     6 93.4612045D0  , 6428.92871D0  , 31062.5059D0  , 60916.6875D0  ,
     7 78521.5781D0  , 91443.4609D0  , 5.42337370D0  , 193.898621D0  ,
     8 4421.40381D0  , 54216.1445D0  , 0.000000000D+00,174.003799D0  ,
     9 13811.7891D0  , 71773.0547D0  , 149865.641D0  , 201881.109D0  ,
     * 238359.641D0  , 0.192459345D0  ,18.6036015D0  , 1224.46497D0  ,
     1 45675.3984D0  , 10258765.0D0  , 7.803834887D-05,74.7325974D0  ,
     2 18626.1699D0  , 236190.359D0  , 705053.500D0  , 0.0D0         ,
     3 0.143891469D0  ,19.6166897D0  , 1564.23059D0  , 63645.9609D0  ,
     4 1330188.38D0  , 1.077217312D-04,93.2128067D0  , 27422.7539D0  ,
     5 359431.469D0  , 1089675.88D0  , 0.0D0         , 4.17606592D0  ,
     6 60.9531631D0  , 655.201355D0  , 5311.15576D0  , 33073.5000D0  ,
     7 0.876959801D0  ,1476.41321D0  , 23229.2422D0  , 75376.2891D0  ,
     8 109102.828D0  , 0.0D0         , 1.00769746D0  , 28.4614315D0  ,
     9 548.302368D0  , 6095.67090D0  , 37794.9883D0  , 0.357061416D0 ,
     * 2562.55591D0  , 39166.2227D0  , 84976.8047D0  , 93437.0938D0  ,
     1 0.0D0         , 1.22021139D0  , 42.1038475D0  , 926.316162D0  ,
     2 11606.6885D0  , 83823.6797D0  , 0.521504462D0  ,5574.42334D0  ,
     3 98074.5938D0  , 251388.953D0  , 305621.188D0  , 0.0D0         ,
     4 4.261606559D-02,3.87616181D0  , 229.196854D0  , 7099.17236D0  ,
     5 100678.688D0  , 0.234244794D0  ,16402.4570D0  , 296047.875D0  ,
     6 154744.047D0  , 1601790.63D0  , 0.0D0         , 3.191594034D-02,
     7 4.07501125D0  , 292.152466D0  , 9887.37012D0  , 147312.656D0  ,
     8 0.200786948D0  ,23198.9570D0  , 448626.906D0  , 230925.766D0  ,
     9 2393268.75D0  , 0.0D0         , 3.790792107D-05,1.291131414D-02,
     * 2.73084378D0  , 303.519989D0  , 18331.5410D0  , 6201.41406D0  ,
     1 4246958.50D0  , 1898921.63D0  , 1260278.00D0  , 900741.375D0  ,
     2 0.0D0         , 0.744405925D0  ,10.4884844D0  , 111.216232D0  ,
     3 918.484375D0  , 6185.98535D0  , 28.2904549D0  , 10784.8213D0  ,
     4 82883.8125D0  , 109374.461D0  , 51805.9492D0  , 0.0D0         ,
     5 0.149897382D0  ,4.01506662D0  , 75.1642990D0  , 842.401367D0  ,
     6 5641.87305D0  , 62.5228653D0  , 18274.9824D0  , 129760.617D0  ,
     7 2142587.50D0  , 11493880.0D0  , 0.0D0         , 0.176585436D0 ,
     8 5.75601721D0  , 122.752457D0  , 1543.74365D0  , 11766.4434D0  ,
     9 101.254219D0  , 43792.4063D0  , 248609.359D0  , 3320073.25D0  ,
     * 21039738.0D0  , 0.0D0         /
C * DATA FOR PM ELEMENT #61
      DATA ((XSC(61, I, J), J = 1, 11), I = 1, 18)/
     1 968.105164D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,1.00672913D0  , 79.8226166D0  , 694.223694D0  ,
     3 2210.44873D0  , 3862.62012D0  , 4345.92725D0  , 91.7074280D0  ,
     4 1325.11218D0  , 12263.9980D0  , 0.000000000D+00,0.000000000D+0,
     5 14.8659601D0  , 864.576538D0  , 4639.04932D0  , 10588.7500D0  ,
     6 15432.6221D0  , 16601.2402D0  , 23.3821125D0  , 758.867065D0  ,
     7 18264.5020D0  , 0.000000000D+00,0.000000000D+00,3.01800466D0  ,
     8 509.440186D0  , 5148.70850D0  , 17113.2383D0  , 30120.5820D0  ,
     9 35252.3320D0  , 27.5586643D0  , 1096.41223D0  , 30605.2305D0  ,
     * 0.000000000D+00,0.000000000D+00,4.03355980D0  , 942.017212D0  ,
     1 10375.3223D0  , 36054.0430D0  , 65171.3828D0  , 76039.9375D0  ,
     2 18.7907276D0  , 273.776337D0  , 2861.63306D0  , 20585.3867D0  ,
     3 0.000000000D+00,145.209839D0  , 4405.80762D0  , 17676.3828D0  ,
     4 34478.1602D0  , 45973.0469D0  , 49837.1992D0  , 4.95716000D0  ,
     5 142.364609D0  , 2769.53345D0  , 28606.2969D0  , 0.000000000D+0,
     6 88.7883835D0  , 6105.67725D0  , 29603.0605D0  , 58231.0273D0  ,
     7 75172.6953D0  , 87920.0313D0  , 5.97502613D0  , 210.568954D0  ,
     8 4716.79346D0  , 56664.7109D0  , 0.000000000D+00,164.718735D0  ,
     9 13151.1162D0  , 68740.3672D0  , 144250.172D0  , 195117.422D0  ,
     * 227489.813D0  , 0.222328722D0  ,21.1643238D0  , 1367.03345D0  ,
     1 49949.4805D0  , 0.000000000D+00,42.2864380D0  , 13450.1514D0  ,
     2 140667.063D0  , 436547.063D0  , 768294.688D0  , 9587678.00D0  ,
     3 0.165465444D0  ,22.2592735D0  , 1743.82324D0  , 69536.2188D0  ,
     4 0.000000000D+00,51.1324348D0  , 19737.7246D0  , 213320.188D0  ,
     5 671213.563D0  , 1194337.88D0  , 14725362.0D0  , 4.48026371D0  ,
     6 64.6739578D0  , 688.634399D0  , 5541.96533D0  , 33967.9531D0  ,
     7 0.835677087D0  ,1411.66357D0  , 22271.9531D0  , 72218.1797D0  ,
     8 104547.602D0  , 0.0D0         , 1.12526691D0  , 31.2218380D0  ,
     9 588.890503D0  , 6411.08105D0  , 38681.0781D0  , 0.348930359D0 ,
     * 2468.01147D0  , 37817.0000D0  , 82121.3359D0  , 90096.3047D0  ,
     1 0.0D0         , 1.35085428D0  , 45.9449043D0  , 993.455322D0  ,
     2 12249.7432D0  , 86818.5234D0  , 0.489623427D0  ,5293.72363D0  ,
     3 94433.5938D0  , 244521.234D0  , 298490.156D0  , 0.0D0         ,
     4 4.967614636D-02,4.44507980D0  , 257.014374D0  , 7749.38623D0  ,
     5 105896.570D0  , 0.246039420D0  ,16661.4395D0  , 293728.563D0  ,
     6 154141.938D0  , 1425006.00D0  , 0.0D0         , 3.703936562D-02,
     7 4.66134930D0  , 327.162567D0  , 10787.4014D0  , 155038.797D0  ,
     8 0.208176479D0  ,23531.9668D0  , 445345.063D0  , 229929.859D0  ,
     9 2132981.75D0  , 0.0D0          ,6.042137829D-05,2.064520679D-02,
     * 4.31517363D0  , 468.574341D0  , 27527.2949D0  , 3282.38892D0  ,
     1 4659896.50D0  , 2167964.00D0  , 1106787.13D0  , 625464.750D0  ,
     2 0.0D0         , 0.793453932D0  ,11.0569677D0  , 116.161903D0  ,
     3 953.135803D0  , 6350.88232D0  , 29.7003460D0  , 11026.4053D0  ,
     4 82262.7031D0  , 104472.398D0  , 51364.2109D0  , 0.0D0         ,
     5 0.165404201D0  ,4.35852671D0  , 79.9592667D0  , 878.540588D0  ,
     6 5760.62988D0  , 66.6086273D0  , 18324.8105D0  , 136198.859D0  ,
     7 2281655.50D0  , 12365242.0D0  , 0.0D0         , 0.192575037D0 ,
     8 6.19663668D0  , 129.966965D0  , 1609.01404D0  , 12074.4307D0  ,
     9 107.336311D0  , 44408.6367D0  , 253856.297D0  , 3515567.00D0  ,
     * 22672972.0D0  , 0.0D0         /
C * DATA FOR SM ELEMENT #62
      DATA ((XSC(62, I, J), J = 1, 11), I = 1, 18)/
     1 1024.60889D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,0.989990175D0  ,76.9716949D0  , 666.947815D0  ,
     3 2122.06958D0  , 3709.04028D0  , 4167.85449D0  , 97.1800232D0  ,
     4 1385.82727D0  , 12577.5488D0  , 0.000000000D+00,0.000000000D+0,
     5 14.2096920D0  , 824.943970D0  , 4431.94629D0  , 10124.3301D0  ,
     6 14750.3789D0  , 15886.4209D0  , 25.8145218D0  , 825.375854D0  ,
     7 19507.0449D0  , 0.000000000D+00,0.000000000D+00,2.92831445D0  ,
     8 488.056732D0  , 4918.67969D0  , 16334.6289D0  , 28715.1699D0  ,
     9 33631.8125D0  , 30.1455135D0  , 1185.63635D0  , 32645.8516D0  ,
     * 0.000000000D+00,0.000000000D+00,3.85827994D0  , 899.062134D0  ,
     1 9907.23438D0  , 34452.4336D0  , 62228.0156D0  , 73187.8359D0  ,
     2 20.0156765D0  , 288.433502D0  , 2982.33032D0  , 21155.1348D0  ,
     3 0.000000000D+00,137.929657D0  , 4200.35010D0  , 16887.6016D0  ,
     4 32973.0820D0  , 43966.6367D0  , 47779.8008D0  , 5.49368525D0  ,
     5 155.004822D0  , 2950.27979D0  , 29631.3262D0  , 0.000000000D+0,
     6 84.6665878D0  , 5814.60059D0  , 28265.7559D0  , 55739.7070D0  ,
     7 72101.6797D0  , 84933.0078D0  , 6.56906414D0  , 228.257263D0  ,
     8 5024.90869D0  , 59169.4727D0  , 0.000000000D+00,155.505859D0  ,
     9 12499.7314D0  , 65756.5703D0  , 138696.875D0  , 188337.016D0  ,
     * 217892.078D0  , 0.255926639D0  ,24.0063839D0  , 1522.65051D0  ,
     1 54543.4414D0  , 0.000000000D+00,39.2380524D0  , 12562.8447D0  ,
     2 132371.422D0  , 413444.719D0  , 727641.688D0  , 8914730.00D0  ,
     3 0.189811066D0  ,25.1965961D0  , 1940.54822D0  , 75954.4844D0  ,
     4 0.000000000D+00,46.8156319D0  , 18364.1543D0  , 200432.625D0  ,
     5 635388.875D0  , 1130759.25D0  , 13595857.0D0  , 4.79181480D0  ,
     6 68.4667816D0  , 722.490662D0  , 5771.56299D0  , 34794.7070D0  ,
     7 0.798738182D0  ,1352.46814D0  , 21380.3438D0  , 69235.1953D0  ,
     8 100161.945D0  , 0.0D0         , 1.25433755D0  , 34.1671867D0  ,
     9 630.850708D0  , 6726.20850D0  , 39463.2578D0  , 0.342500240D0 ,
     * 2380.81567D0  , 36525.8398D0  , 79284.4063D0  , 86797.0078D0  ,
     1 0.0D0         , 1.49108446D0  , 49.9956284D0  , 1062.76575D0  ,
     2 12899.3506D0  , 89694.4844D0  , 0.462454557D0  ,5043.36279D0  ,
     3 91066.2344D0  , 237872.828D0  , 291451.938D0  , 0.0D0         ,
     4 5.766981095D-02,5.07888269D0  , 287.474701D0  , 8456.42090D0  ,
     5 111497.336D0  , 0.214876041D0  ,15080.7578D0  , 279950.500D0  ,
     6 151400.031D0  , 1231856.88D0  , 0.0D0         , 4.280338809D-02,
     7 5.31219530D0  , 365.430267D0  , 11766.2344D0  , 163378.766D0  ,
     8 0.176703438D0  ,21222.5664D0  , 423828.625D0  , 228382.328D0  ,
     9 1842798.25D0  , 0.0D0         , 9.115662397D-05,3.120273724D-02,
     * 6.44168377D0  , 684.032349D0  , 39105.0742D0  , 1407.56836D0  ,
     1 4632811.00D0  , 2616724.75D0  , 1052927.88D0  , 517781.719D0  ,
     2 0.0D0         , 0.841388226D0  ,11.6187687D0  , 121.064171D0  ,
     3 986.825439D0  , 6502.87549D0  , 31.2840271D0  , 11289.3701D0  ,
     4 81614.6094D0  , 99689.8125D0  , 51566.5273D0  , 0.0D0         ,
     5 0.182548285D0  ,4.72200823D0  , 84.8162308D0  , 913.745117D0  ,
     6 5864.52930D0  , 69.1399307D0  , 18138.4902D0  , 140176.719D0  ,
     7 2382270.25D0  , 13121841.0D0  , 0.0D0         , 0.210070804D0 ,
     8 6.65772390D0  , 137.215744D0  , 1672.80249D0  , 12359.4609D0  ,
     9 110.741966D0  , 44411.7617D0  , 255105.328D0  , 3646091.75D0  ,
     * 24088756.0D0  , 0.0D0         /
C * DATA FOR EU ELEMENT #63
      DATA ((XSC(63, I, J), J = 1, 11), I = 1, 18)/
     1 1082.95947D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,0.974171460D0  ,74.2786179D0  , 641.095825D0  ,
     3 2037.95776D0  , 3560.11499D0  , 4002.50830D0  , 102.862061D0  ,
     4 1447.51978D0  , 12906.5879D0  , 0.000000000D+00,0.000000000D+0,
     5 13.6051102D0  , 788.036255D0  , 4237.81445D0  , 9688.19727D0  ,
     6 14137.7637D0  , 15188.7998D0  , 28.4541492D0  , 896.136658D0  ,
     7 20760.3008D0  , 0.000000000D+00,0.000000000D+00,2.84694123D0  ,
     8 468.369171D0  , 4705.22266D0  , 15609.0039D0  , 27462.1641D0  ,
     9 32092.1113D0  , 32.9148712D0  , 1279.87524D0  , 34769.1055D0  ,
     * 0.000000000D+00,0.000000000D+00,3.67583942D0  , 859.464600D0  ,
     1 9473.74414D0  , 32965.2734D0  , 59528.4609D0  , 70212.0781D0  ,
     2 21.2896595D0  , 303.460571D0  , 3104.04297D0  , 21702.4473D0  ,
     3 0.000000000D+00,131.338531D0  , 4011.77026D0  , 16156.6387D0  ,
     4 31568.1660D0  , 42096.6328D0  , 45800.4844D0  , 6.07634449D0  ,
     5 168.462387D0  , 3137.86792D0  , 30639.4648D0  , 0.000000000D+0,
     6 80.5750580D0  , 5529.34521D0  , 26960.1426D0  , 53302.7578D0  ,
     7 69107.0547D0  , 80889.2344D0  , 7.20967674D0  , 246.910980D0  ,
     8 5340.70264D0  , 61623.8750D0  , 0.000000000D+00,148.134735D0  ,
     9 11953.7559D0  , 63179.2500D0  , 133790.188D0  , 182081.109D0  ,
     * 211428.422D0  , 0.293706030D0  ,27.1489658D0  , 1690.91504D0  ,
     1 59372.9727D0  , 0.000000000D+00,36.6632385D0  , 11795.0303D0  ,
     2 125044.891D0  , 392674.344D0  , 691058.563D0  , 8393959.00D0  ,
     3 0.216936782D0  ,28.4228420D0  , 2151.36255D0  , 82561.6563D0  ,
     4 0.000000000D+00,43.5729256D0  , 17289.3379D0  , 189921.781D0  ,
     5 605157.125D0  , 1076519.50D0  , 12751725.0D0  , 5.11582518D0  ,
     6 72.3587494D0  , 756.797119D0  , 5998.93994D0  , 35548.1523D0  ,
     7 0.771124959D0  ,1304.55896D0  , 20625.2500D0  , 66597.2422D0  ,
     8 96260.0313D0  , 0.0D0         , 1.39358258D0  , 37.3071594D0  ,
     9 675.029053D0  , 7056.30273D0  , 40208.6094D0  , 0.312348515D0 ,
     * 2182.68188D0  , 34230.7852D0  , 75077.6719D0  , 81696.9531D0  ,
     1 0.0D0         , 1.64342415D0  , 54.2822533D0  , 1134.02893D0  ,
     2 13547.2734D0  , 92375.8125D0  , 0.452580839D0  ,4910.60840D0  ,
     3 88969.8750D0  , 233275.406D0  , 287084.031D0  , 0.0D0         ,
     4 6.667943299D-02,5.77828264D0  , 319.998474D0  , 9173.61035D0  ,
     5 116564.227D0  , 0.217281744D0  ,14959.1025D0  , 275113.344D0  ,
     6 149905.344D0  , 1111816.63D0  , 0.0D0         , 4.926908761D-02,
     7 6.02834845D0  , 406.214783D0  , 12758.1240D0  , 170930.344D0  ,
     8 0.176095545D0  ,21010.7500D0  , 416563.594D0  , 226317.938D0  ,
     9 1665856.63D0  , 0.0D0         , 1.146181894D-04,3.901197389D-02,
     * 7.91907215D0  , 820.722168D0  , 45399.4453D0  , 17581.6465D0  ,
     1 5085654.50D0  , 1741765.38D0  , 1076830.88D0  , 847386.250D0  ,
     2 0.0D0         , 0.893049419D0  ,12.1990910D0  , 125.938431D0  ,
     3 1018.71301D0  , 6625.91211D0  , 46.2834549D0  , 14583.2295D0  ,
     4 92570.0938D0  , 99155.5078D0  , 59714.5078D0  , 0.0D0         ,
     5 0.200391889D0  ,5.09999228D0  , 89.8084869D0  , 948.916504D0  ,
     6 5960.54932D0  , 67.7624512D0  , 17511.6875D0  , 136995.969D0  ,
     7 2374781.50D0  , 13462045.0D0  , 0.0D0         , 0.228655919D0 ,
     8 7.13864422D0  , 144.625183D0  , 1736.83936D0  , 12636.8389D0  ,
     9 107.579514D0  , 43169.0313D0  , 246647.641D0  , 3599109.50D0  ,
     * 24708374.0D0  , 0.0D0         /
C * DATA FOR GD ELEMENT #64
      DATA ((XSC(64, I, J), J = 1, 11), I = 1, 19)/
     1 1143.10596D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,0.959365785D0  ,71.7253799D0  , 616.497253D0  ,
     3 1957.80847D0  , 3417.84131D0  , 3844.55103D0  , 108.705818D0  ,
     4 1509.59424D0  , 13262.7119D0  , 0.000000000D+00,0.000000000D+0,
     5 13.0326872D0  , 752.893372D0  , 4052.26807D0  , 9269.20313D0  ,
     6 13526.1328D0  , 14527.7451D0  , 31.2971840D0  , 970.748169D0  ,
     7 22036.9688D0  , 0.000000000D+00,0.000000000D+00,2.77000737D0  ,
     8 449.687836D0  , 4501.18213D0  , 14910.6494D0  , 26207.9980D0  ,
     9 29811.4863D0  , 35.8704872D0  , 1378.49341D0  , 36935.5586D0  ,
     * 0.000000000D+00,0.000000000D+00,3.52496028D0  , 821.969116D0  ,
     1 9058.11621D0  , 31526.7383D0  , 57033.2656D0  , 67089.6094D0  ,
     2 22.6053371D0  , 318.704803D0  , 3224.01489D0  , 22194.4258D0  ,
     3 0.000000000D+00,124.233932D0  , 3824.28784D0  , 15422.8926D0  ,
     4 30159.1445D0  , 40230.4570D0  , 43631.0859D0  , 6.70396900D0  ,
     5 182.570953D0  , 3325.80371D0  , 31544.6270D0  , 0.000000000D+0,
     6 76.8523788D0  , 5260.08838D0  , 25697.5762D0  , 50940.0703D0  ,
     7 66192.6016D0  , 77765.4844D0  , 7.88950205D0  , 266.344055D0  ,
     8 5659.05615D0  , 63945.3555D0  , 0.000000000D+00,140.800232D0  ,
     9 11401.4141D0  , 60519.6875D0  , 128700.688D0  , 175722.438D0  ,
     * 205292.328D0  , 0.335776091D0  ,30.5740318D0  , 1868.08398D0  ,
     1 64148.1680D0  , 0.000000000D+00,34.2140961D0  , 11034.2930D0  ,
     2 117430.922D0  , 370179.000D0  , 640741.938D0  , 7457943.00D0  ,
     3 0.247009426D0  ,31.9362679D0  , 2374.01660D0  , 89178.0625D0  ,
     4 0.000000000D+00,40.2313499D0  , 16143.1318D0  , 178306.984D0  ,
     5 570633.938D0  , 998727.500D0  , 11790371.0D0  , 5.46481276D0  ,
     6 76.5115356D0  , 792.899414D0  , 6229.29053D0  , 36272.9961D0  ,
     7 0.742980003D0  ,1255.48206D0  , 19839.9688D0  , 64191.5430D0  ,
     8 93504.5156D0  , 0.0D0         , 1.54827595D0  , 40.7001610D0  ,
     9 720.488281D0  , 7362.80664D0  , 40852.5234D0  , 0.332672507D0 ,
     * 2226.52393D0  , 34164.9609D0  , 74950.7344D0  , 83071.2188D0  ,
     1 0.0D0         , 1.81181812D0  , 58.9971085D0  , 1211.78772D0  ,
     2 14245.8799D0  , 95347.7031D0  , 0.417872757D0  ,4602.69824D0  ,
     3 84913.4297D0  , 227768.609D0  , 286891.344D0  , 0.0D0         ,
     4 7.735446095D-02,6.59424448D0  , 357.122192D0  , 9967.38086D0  ,
     5 122043.969D0  , 0.202335522D0  ,14063.8340D0  , 268268.563D0  ,
     6 165319.609D0  , 712462.688D0  , 0.0D0         , 5.692562088D-02,
     7 6.86587000D0  , 452.948425D0  , 13862.2871D0  , 179168.156D0  ,
     8 0.160692036D0  ,19700.2520D0  , 405765.781D0  , 255306.219D0  ,
     9 1038431.19D0  , 0.0D0         , 1.382994815D-04,5.050205067D-02,
     * 10.4638147D0  , 1061.43884D0  , 56876.5391D0  , 267.740540D0  ,
     1 3218998.75D0  , 2688464.25D0  , 642599.563D0  , 712302.250D0  ,
     2 0.0D0         , 2.152928209D-05,7.652925793D-03,1.61883366D0  ,
     3 167.511948D0  , 9102.13379D0  , 59.6805649D0  , 582469.250D0  ,
     4 432664.156D0  , 113483.703D0  , 131450.891D0  , 0.0D0         ,
     5 0.981478751D0  ,13.3112621D0  , 136.460098D0  , 1096.66003D0  ,
     6 7067.83691D0  , 38.4084663D0  , 12845.1797D0  , 87106.9688D0  ,
     7 106088.938D0  , 71148.1016D0  , 0.0D0         , 0.233047232D0 ,
     8 5.84594774D0  , 100.983673D0  , 1045.93884D0  , 6441.26855D0  ,
     9 92.7021561D0  , 20351.8477D0  , 175719.719D0  , 2570084.75D0  ,
     * 10158516.0D0  , 0.0D0         , 0.263996065D0  ,8.17296124D0  ,
     1 163.252853D0  , 1930.42529D0  , 13845.0762D0  , 149.189301D0  ,
     2 51857.5273D0  , 306965.938D0  , 3910144.00D0  , 18497008.0D0  ,
     3 0.0D0         /
C * DATA FOR TB ELEMENT #65
      DATA ((XSC(65, I, J), J = 1, 11), I = 1, 19)/
     1 1205.34631D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,0.945949912D0  ,69.3186493D0  , 593.315186D0  ,
     3 1882.57104D0  , 3287.10913D0  , 3693.98096D0  , 114.814537D0  ,
     4 1573.87476D0  , 13375.7695D0  , 0.000000000D+00,0.000000000D+0,
     5 12.5001888D0  , 720.184631D0  , 3880.36597D0  , 8883.49219D0  ,
     6 12978.4980D0  , 13936.3750D0  , 34.3973389D0  , 1051.35217D0  ,
     7 23490.6621D0  , 0.000000000D+00,0.000000000D+00,2.69980812D0  ,
     8 432.708130D0  , 4317.91797D0  , 14290.9492D0  , 25129.9688D0  ,
     9 29369.0313D0  , 39.0477180D0  , 1484.50305D0  , 39273.8164D0  ,
     * 0.000000000D+00,0.000000000D+00,3.38509846D0  , 787.803040D0  ,
     1 8687.35645D0  , 30263.5215D0  , 54709.1133D0  , 64491.0703D0  ,
     2 23.9997387D0  , 334.799286D0  , 3353.47583D0  , 22755.9551D0  ,
     3 0.000000000D+00,117.800514D0  , 3644.35376D0  , 14739.7920D0  ,
     4 28850.6484D0  , 38510.1875D0  , 41981.3789D0  , 7.39434862D0  ,
     5 197.906570D0  , 3531.16821D0  , 32558.9160D0  , 0.000000000D+0,
     6 73.1972122D0  , 5008.93066D0  , 24554.0254D0  , 48755.4336D0  ,
     7 63337.9180D0  , 75171.7266D0  , 8.62680721D0  , 287.360413D0  ,
     8 6009.16260D0  , 66647.3047D0  , 0.000000000D+00,133.595505D0  ,
     9 10891.2568D0  , 58180.1133D0  , 124256.758D0  , 170151.328D0  ,
     * 197383.625D0  , 0.383780777D0  ,34.4529114D0  , 2070.81250D0  ,
     1 69956.3516D0  , 0.000000000D+00,32.1261711D0  , 10430.3506D0  ,
     2 111923.531D0  , 355110.250D0  , 624042.125D0  , 7105357.00D0  ,
     3 0.281034321D0  ,35.9007416D0  , 2629.06689D0  , 97290.8906D0  ,
     4 0.000000000D+00,37.2868767D0  , 15211.0215D0  , 169810.875D0  ,
     5 547588.938D0  , 974825.438D0  , 10944593.0D0  , 5.80675125D0  ,
     6 80.4825516D0  , 827.448120D0  , 6460.78662D0  , 36959.6289D0  ,
     7 0.686059952D0  ,1169.97119D0  , 18663.2559D0  , 60345.0586D0  ,
     8 87095.1875D0  , 0.0D0         , 1.70720196D0  , 44.1261940D0  ,
     9 766.399048D0  , 7688.83008D0  , 41268.0859D0  , 0.283821434D0 ,
     * 2007.77905D0  , 31646.2520D0  , 69303.9453D0  , 75000.9297D0  ,
     1 0.0D0         , 1.97987509D0  , 63.5598145D0  , 1285.20654D0  ,
     2 14906.1006D0  , 97783.3438D0  , 0.387636513D0  ,4321.58154D0  ,
     3 81055.0938D0  , 217233.656D0  , 268992.719D0  , 0.0D0         ,
     4 8.829211444D-02,7.40487146D0  , 392.962372D0  , 10726.9199D0  ,
     5 126635.656D0  , 0.185695708D0  ,13399.7881D0  , 256613.031D0  ,
     6 146052.031D0  , 902967.500D0  , 0.0D0         , 6.464228779D-02,
     7 7.68600273D0  , 497.457062D0  , 14905.9932D0  , 186049.250D0  ,
     8 0.144532889D0  ,18709.5840D0  , 388000.563D0  , 222527.609D0  ,
     9 1354789.88D0  , 0.0D0         , 1.721229200D-04,6.180451438D-02,
     * 12.5331964D0  , 1244.15955D0  , 64718.2148D0  , 299.456726D0  ,
     1 3195598.25D0  , 2391837.75D0  , 624617.500D0  , 773388.250D0  ,
     2 0.0D0         , 5.317702744D-05,1.868223213D-02,3.86977792D0  ,
     3 392.014709D0  , 20689.9512D0  , 135.322144D0  , 1153528.25D0  ,
     4 769299.875D0  , 221514.781D0  , 285723.438D0  , 0.0D0         ,
     5 1.03394198D0  , 13.9011078D0  , 141.431335D0  , 1129.07935D0  ,
     6 7199.43555D0  , 33.8753967D0  , 11612.2939D0  , 80027.2891D0  ,
     7 98025.5156D0  , 66108.4219D0  , 0.0D0         , 0.254085600D0 ,
     8 6.27169275D0  , 106.286377D0  , 1080.55054D0  , 6513.52344D0  ,
     9 56.7002983D0  , 16049.0508D0  , 111103.094D0  , 1789577.25D0  ,
     * 8258508.00D0  , 0.0D0         , 0.285247445D0  ,8.70330620D0  ,
     1 171.062729D0  , 1995.06030D0  , 14106.6416D0  , 88.2457733D0  ,
     2 39786.7695D0  , 217099.766D0  , 2625967.25D0  , 14889155.0D0  ,
     3 0.0D0         /
C * DATA FOR DY ELEMENT #66
      DATA ((XSC(66, I, J), J = 1, 11), I = 1, 19)/
     1 1269.03821D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,0.933116853D0  ,67.0328217D0  , 571.199646D0  ,
     3 1810.45398D0  , 3159.20166D0  , 3552.20166D0  , 121.073395D0  ,
     4 1638.18860D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     5 12.0055704D0  , 689.449402D0  , 3717.61670D0  , 8515.11621D0  ,
     6 12436.9521D0  , 13368.8477D0  , 37.7270584D0  , 1136.07471D0  ,
     7 24637.5625D0  , 0.000000000D+00,0.000000000D+00,2.63352537D0  ,
     8 416.574951D0  , 4142.22021D0  , 13691.4355D0  , 24044.9551D0  ,
     9 28127.0898D0  , 42.4298096D0  , 1595.15820D0  , 41594.8398D0  ,
     * 0.000000000D+00,0.000000000D+00,3.25432801D0  , 755.406189D0  ,
     1 8330.66699D0  , 29036.6445D0  , 52571.1172D0  , 61865.2969D0  ,
     2 25.4214058D0  , 350.885254D0  , 3476.92969D0  , 23219.5254D0  ,
     3 0.000000000D+00,112.960999D0  , 3499.95288D0  , 14161.7920D0  ,
     4 27715.0840D0  , 36980.9453D0  , 40356.6797D0  , 8.13099670D0  ,
     5 213.814957D0  , 3732.61304D0  , 33409.2852D0  , 0.000000000D+0,
     6 70.5572205D0  , 4805.42578D0  , 23562.7539D0  , 46824.7617D0  ,
     7 60916.7031D0  , 71674.3516D0  , 9.41305542D0  , 309.148773D0  ,
     8 6356.02832D0  , 69104.2813D0  , 0.000000000D+00,127.893814D0  ,
     9 10452.6660D0  , 56052.5430D0  , 120100.625D0  , 164736.438D0  ,
     * 191838.219D0  , 0.436785549D0  ,38.6510544D0  , 2282.50684D0  ,
     1 75612.8828D0  , 0.000000000D+00,30.3219795D0  , 9870.32422D0  ,
     2 106393.242D0  , 338903.469D0  , 594702.563D0  , 6478023.00D0  ,
     3 0.318683326D0  ,40.1826210D0  , 2893.49243D0  , 105063.195D0  ,
     4 0.000000000D+00,34.9681435D0  , 14408.7461D0  , 161738.984D0  ,
     5 523696.688D0  , 931776.188D0  , 10292234.0D0  , 6.16890669D0  ,
     6 84.6834488D0  , 863.450195D0  , 6687.70117D0  , 37538.8594D0  ,
     7 0.654098988D0  ,1115.98035D0  , 17845.0586D0  , 57640.7539D0  ,
     8 83085.8359D0  , 0.0D0         , 1.88586521D0  , 47.8831367D0  ,
     9 815.259094D0  , 8020.14600D0  , 41676.5938D0  , 0.256207049D0 ,
     * 1830.93079D0  , 29529.2188D0  , 65308.7188D0  , 70211.6172D0  ,
     1 0.0D0         , 2.16415858D0  , 68.5139236D0  , 1362.90686D0  ,
     2 15563.0889D0  , 100088.992D0  , 0.388950288D0  ,4276.51904D0  ,
     3 79927.7734D0  , 214024.359D0  , 265998.406D0  , 0.0D0         ,
     4 0.101031192D0  ,8.34041023D0  , 433.510498D0  , 11552.5342D0  ,
     5 131406.703D0  , 0.174231455D0  ,12695.7656D0  , 247717.438D0  ,
     6 144066.406D0  , 825162.250D0  , 0.0D0         , 7.362566143D-02,
     7 8.63463211D0  , 548.028015D0  , 16047.1104D0  , 193261.594D0  ,
     8 0.132819816D0  ,17672.1348D0  , 374285.719D0  , 220294.266D0  ,
     9 1239739.75D0  , 0.0D0         , 2.185936755D-04,7.233473659D-02,
     * 13.9175034D0  , 1352.66003D0  , 68482.1563D0  , 7500.48291D0  ,
     1 4132833.50D0  , 1385385.25D0  , 828736.375D0  , 883879.313D0  ,
     2 0.0D0         , 1.387346565D-04,4.390750453D-02,8.51859379D0  ,
     3 845.185059D0  , 43485.8750D0  , 4717.44727D0  , 2783733.00D0  ,
     4 1026051.56D0  , 612730.688D0  , 501245.656D0  , 0.0D0         ,
     5 1.05230796D0  , 13.9913273D0  , 141.300461D0  , 1124.23755D0  ,
     6 7125.84473D0  , 12.0562201D0  , 5477.91113D0  , 47303.6328D0  ,
     7 71032.5000D0  , 36958.8359D0  , 0.0D0         , 0.263115197D0 ,
     8 6.35300446D0  , 105.325546D0  , 1050.53577D0  , 6179.10303D0  ,
     9 51.8145599D0  , 14367.9707D0  , 105505.625D0  , 1987611.88D0  ,
     * 12897179.0D0  , 0.0D0         , 0.289452046D0  ,8.66673756D0  ,
     1 167.291809D0  , 1923.84509D0  , 13376.9600D0  , 79.1424026D0  ,
     2 35618.4531D0  , 194356.781D0  , 2880928.50D0  , 23535914.0D0  ,
     3 0.0D0         /
C * DATA FOR HO ELEMENT #67
      DATA ((XSC(67, I, J), J = 1, 11), I = 1, 19)/
     1 1334.60571D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,0.921624780D0  ,64.8667908D0  , 550.195801D0  ,
     3 1742.11914D0  , 3040.18921D0  , 3414.98804D0  , 127.540550D0  ,
     4 1703.47290D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     5 11.5333118D0  , 660.078430D0  , 3562.11353D0  , 8163.54395D0  ,
     6 11921.4180D0  , 12838.9736D0  , 41.3182983D0  , 1225.84668D0  ,
     7 0.000000000D+00,0.000000000D+00,0.000000000D+00,2.57155919D0  ,
     8 401.451569D0  , 3977.12207D0  , 13127.6240D0  , 23027.7676D0  ,
     9 27011.9238D0  , 46.0263824D0  , 1711.56433D0  , 44107.8242D0  ,
     * 0.000000000D+00,0.000000000D+00,3.13175416D0  , 725.036011D0  ,
     1 7996.13916D0  , 27882.2988D0  , 50455.6523D0  , 59582.1641D0  ,
     2 26.8941078D0  , 367.326843D0  , 3601.06226D0  , 23651.1621D0  ,
     3 0.000000000D+00,108.356148D0  , 3362.00195D0  , 13608.3203D0  ,
     4 26627.5039D0  , 35508.2500D0  , 38797.9258D0  , 8.92685795D0  ,
     5 230.693222D0  , 3941.90771D0  , 34243.8906D0  , 0.000000000D+0,
     6 67.2341232D0  , 4589.64648D0  , 22539.3301D0  , 44850.4766D0  ,
     7 58392.7813D0  , 69366.3203D0  , 10.2482252D0  , 331.990784D0  ,
     8 6713.10693D0  , 71558.0859D0  , 0.000000000D+00,122.531265D0  ,
     9 10040.0723D0  , 54037.5586D0  , 116145.539D0  , 159645.594D0  ,
     * 188161.109D0  , 0.495855212D0  ,43.2557602D0  , 2510.42969D0  ,
     1 81572.2656D0  , 0.000000000D+00,28.6561489D0  , 9351.12891D0  ,
     2 101240.547D0  , 323746.344D0  , 568443.188D0  , 6167648.50D0  ,
     3 0.360295892D0  ,44.8689651D0  , 3179.04492D0  , 113355.961D0  ,
     4 0.000000000D+00,32.6780357D0  , 13619.6924D0  , 153859.719D0  ,
     5 500477.813D0  , 889989.313D0  , 9361720.00D0  , 6.54965067D0  ,
     6 89.0065689D0  , 899.932190D0  , 6912.58545D0  , 38045.2539D0  ,
     7 0.623715460D0  ,1062.71436D0  , 17037.9434D0  , 54990.2344D0  ,
     8 79177.1328D0  , 0.0D0         , 2.07605410D0  , 51.7956772D0  ,
     9 864.182861D0  , 8324.95703D0  , 41912.6055D0  , 0.255674392D0 ,
     * 1787.67529D0  , 28664.5137D0  , 63006.1758D0  , 67616.2500D0  ,
     1 0.0D0         , 2.36101580D0  , 73.7348785D0  , 1444.09924D0  ,
     2 16252.5742D0  , 102489.891D0  , 0.350760937D0  ,4059.06152D0  ,
     3 76798.9766D0  , 207234.531D0  , 258288.594D0  , 0.0D0         ,
     4 0.115379266D0  ,9.36775875D0  , 476.764099D0  , 12403.8252D0  ,
     5 135893.094D0  , 0.166401088D0  ,12151.7646D0  , 239899.516D0  ,
     6 141879.063D0  , 761918.750D0  , 0.0D0         , 8.369409293D-02,
     7 9.67334175D0  , 601.871643D0  , 17223.3164D0  , 200078.641D0  ,
     8 0.124392033D0  ,16865.3789D0  , 362281.500D0  , 217464.953D0  ,
     9 1146450.50D0  , 0.0D0         , 2.674403368D-04,8.751519024D-02,
     * 16.5284290D0  , 1573.17749D0  , 77197.3984D0  , 13586.1748D0  ,
     1 3802449.25D0  , 1208605.63D0  , 892395.938D0  , 1131814.25D0  ,
     2 0.0D0         , 2.103789157D-04,6.618701667D-02,12.6178923D0  ,
     3 1226.53137D0  , 61204.2852D0  , 10686.0869D0  , 3228999.00D0  ,
     4 1132930.50D0  , 786884.563D0  , 737857.188D0  , 0.0D0         ,
     5 1.10694396D0  , 14.5887871D0  , 146.121933D0  , 1151.68323D0  ,
     6 7187.39893D0  , 19.6703682D0  , 7636.67969D0  , 57470.4766D0  ,
     7 72151.2578D0  , 45606.9375D0  , 0.0D0         , 0.286340177D0 ,
     8 6.80150270D0  , 110.562202D0  , 1080.74817D0  , 6214.21094D0  ,
     9 101.692322D0  , 18338.1328D0  , 212050.547D0  , 3549127.75D0  ,
     * 20366612.0D0  , 0.0D0         , 0.311033279D0  ,9.19705486D0  ,
     1 174.798630D0  , 1979.67224D0  , 13542.6328D0  , 159.988159D0  ,
     2 48520.7188D0  , 316384.688D0  , 5354897.50D0  , 37786016.0D0  ,
     3 0.0D0         /
C * DATA FOR ER ELEMENT #68
      DATA ((XSC(68, I, J), J = 1, 11), I = 1, 19)/
     1 1402.23413D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     2 0.000000000D+00,0.910493791D0  ,62.8085632D0  , 530.175903D0  ,
     3 1676.71313D0  , 2924.07813D0  , 3286.56689D0  , 134.224869D0  ,
     4 1769.51392D0  , 0.000000000D+00,0.000000000D+00,0.000000000D+0,
     5 11.0918627D0  , 632.328796D0  , 3414.57690D0  , 7830.02783D0  ,
     6 11448.7598D0  , 12303.9238D0  , 45.1934395D0  , 1320.92285D0  ,
     7 0.000000000D+00,0.000000000D+00,0.000000000D+00,2.51335192D0  ,
     8 387.175659D0  , 3820.93506D0  , 12594.4482D0  , 22104.3848D0  ,
     9 25883.5938D0  , 49.8604622D0  , 1834.03943D0  , 46768.0977D0  ,
     * 0.000000000D+00,0.000000000D+00,3.01659632D0  , 696.403503D0  ,
     1 7680.22266D0  , 26794.0332D0  , 48556.0273D0  , 57260.2188D0  ,
     2 28.4245224D0  , 384.056274D0  , 3723.58569D0  , 24031.4414D0  ,
     3 0.000000000D+00,104.604179D0  , 3244.11865D0  , 13121.5859D0  ,
     4 25649.2266D0  , 34204.8359D0  , 37387.1719D0  , 9.78788471D0  ,
     5 248.512024D0  , 4155.96094D0  , 35022.5781D0  , 0.000000000D+0,
     6 64.4948883D0  , 4388.03076D0  , 21574.4277D0  , 42972.6523D0  ,
     7 55936.0938D0  , 66895.3828D0  , 11.1441288D0  , 356.091522D0  ,
     8 7084.56201D0  , 74073.6016D0  , 0.000000000D+00,116.850319D0  ,
     9 9610.54688D0  , 51969.5469D0  , 112100.977D0  , 154343.984D0  ,
     * 183117.734D0  , 0.561815262D0  ,48.3105659D0  , 2756.40894D0  ,
     1 87908.3125D0  , 0.000000000D+00,27.0312080D0  , 8847.34668D0  ,
     2 96264.0625D0  , 309125.344D0  , 542704.563D0  , 5805503.00D0  ,
     3 0.406345814D0  ,49.9846649D0  , 3485.59351D0  , 122086.500D0  ,
     4 0.000000000D+00,30.5725346D0  , 12886.4717D0  , 146502.688D0  ,
     5 478717.344D0  , 852600.375D0  , 8976748.00D0  , 6.93704367D0  ,
     6 93.3750305D0  , 936.191528D0  , 7123.01416D0  , 38406.8633D0  ,
     7 0.617027283D0  ,1041.06995D0  , 16609.8438D0  , 53253.5117D0  ,
     8 76497.2344D0  , 0.0D0         , 2.28188133D0  , 55.9661674D0  ,
     9 915.904053D0  , 8649.78418D0  , 42045.2266D0  , 0.232938945D0 ,
     * 1638.24182D0  , 26802.6348D0  , 59393.1172D0  , 63320.1914D0  ,
     1 0.0D0         , 2.57315612D0  , 79.2279968D0  , 1527.52917D0  ,
     2 16944.2441D0  , 104755.180D0  , 0.332286477D0  ,3873.14941D0  ,
     3 74026.1875D0  , 201022.984D0  , 251265.359D0  , 0.0D0         ,
     4 0.131258249D0  ,10.4975939D0  , 524.155212D0  , 13348.2412D0  ,
     5 140832.594D0  , 0.129286721D0  ,10204.1797D0  , 221111.578D0  ,
     6 141987.141D0  , 671699.750D0  , 0.0D0         , 9.472762048D-02,
     7 10.8004751D0  , 659.165894D0  , 18436.4121D0  , 206537.156D0  ,
     8 0.117730275D0  ,16194.6572D0  , 351368.469D0  , 214190.594D0  ,
     9 1068542.88D0  , 0.0D0         , 3.274603223D-04,0.105456732D0 ,
     * 19.5129871D0  , 1820.59167D0  , 86677.6875D0  , 9084.09766D0  ,
     1 3613573.25D0  , 1161608.38D0  , 818143.250D0  , 1083411.63D0  ,
     2 0.0D0         , 3.070689563D-04,9.543409199D-02,17.8338051D0  ,
     3 1700.11145D0  , 82362.3672D0  , 8540.36621D0  , 3669606.00D0  ,
     4 1304625.50D0  , 859613.500D0  , 804831.188D0  , 0.0D0         ,
     5 1.16627645D0  , 15.2216101D0  , 151.309143D0  , 1184.74243D0  ,
     6 7322.17041D0  , 14.6506004D0  , 6117.94434D0  , 48891.0039D0  ,
     7 66023.3203D0  , 41461.5586D0  , 0.0D0         , 0.312212288D0 ,
     8 7.28530025D0  , 116.161530D0  , 1114.94849D0  , 6270.96338D0  ,
     9 43.9072113D0  , 12625.0703D0  , 90044.5938D0  , 1784281.63D0  ,
     * 12572056.0D0  , 0.0D0         , 0.334918499D0  ,9.76585865D0  ,
     1 182.850647D0  , 2044.66467D0  , 13802.0625D0  , 65.2826080D0  ,
     2 31433.3828D0  , 168209.703D0  , 2505131.25D0  , 22829432.0D0  ,
     3 0.0D0         /
C * DATA FOR TM ELEMENT #69
      DATA ((XSC(69, I, J), J = 1, 11), I = 1, 19)/
     1 1471.39294D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.900793612D0,  60.8579330D0,   511.148865D0,
     3 1614.70337D0,   2815.89136D0,   3162.20386D0,   141.087921D0,
     4 1836.06555D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 10.6769648D0,   606.147705D0,   3275.28369D0,   7513.65723D0,
     6 10981.3125D0,   11814.0508D0,   49.3521461D0,   1421.06287D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.46011782D0,
     8 373.952698D0,   3675.54248D0,   12095.3730D0,   21194.6816D0,
     9 24834.6289D0,   53.9229431D0,   1962.25940D0,   48693.1875D0,
     * 0.000000000D0,  0.000000000D0,  2.91011405D0,   669.807983D0,
     1 7385.81055D0,   25773.7207D0,   46685.1289D0,   55121.9570D0,
     2 30.0097198D0,   401.448883D0,   3854.00562D0,   24460.3086D0,
     3 0.000000000D0,  98.9670410D0,   3083.91357D0,   12506.6670D0,
     4 24474.5977D0,   32640.4004D0,   35710.4648D0,   10.7098856D0,
     5 267.221588D0,   4373.77295D0,   35729.5391D0,   0.000000000D0,
     6 62.0311852D0,   4203.39844D0,   20678.1426D0,   41215.5820D0,
     7 53704.4063D0,   63454.3359D0,   12.0933790D0,   381.320831D0,
     8 7467.22461D0,   76588.0703D0,   0.000000000D0,  110.840065D0,
     9 9201.04980D0,   49991.0078D0,   108227.203D0,   149431.625D0,
     * 174449.719D0,   0.634685993D0,  53.8141022D0,   3018.67407D0,
     1 94442.3594D0,   0.000000000D0,  25.6605186D0,   8411.94238D0,
     2 91863.3594D0,   295954.406D0,   518979.188D0,   5293580.00D0,
     3 0.457368761D0,  55.5603256D0,   3813.18188D0,   131185.469D0,
     4 0.000000000D0,  28.7137737D0,   12225.6748D0,   139787.984D0,
     5 458623.906D0,   816952.000D0,   8491173.00D0,   7.33887577D0,
     6 97.8807297D0,   973.763184D0,   7345.04736D0,   38792.1875D0,
     7 0.582199454D0,  982.922791D0,   15753.3369D0,   50548.5898D0,
     8 72527.1875D0,   0.0D0,          2.50546837D0,   60.3660126D0,
     9 968.579041D0,   8961.88574D0,   42031.0703D0,   0.220133245D0,
     * 1537.44055D0,   25404.2891D0,   56425.6523D0,   59866.5938D0,
     1 0.0D0,          2.79648042D0,   84.9697342D0,   1614.07434D0,
     2 17656.3770D0,   106991.719D0,   0.306047380D0,  3628.43652D0,
     3 70536.3750D0,   193484.969D0,   242422.828D0,   0.0D0,
     4 0.148810402D0,  11.7134838D0,   572.790588D0,   14228.7041D0,
     5 144489.688D0,   0.137195289D0,  10440.6719D0,   219468.938D0,
     6 138375.516D0,   642768.188D0,   0.0D0,          0.106935367D0,
     7 12.0330038D0,   721.105347D0,   19745.8281D0,   213306.766D0,
     8 9.786464274D-02,14379.4043D0,   330647.188D0,   213969.000D0,
     9 969475.813D0,   0.0D0,          3.954572894D-04,0.125986248D0,
     * 22.9034939D0,   2096.21631D0,   96838.7969D0,   4822.57129D0,
     1 3442956.75D0,   1159065.38D0,   719061.125D0,   957708.813D0,
     2 0.0D0,          4.371200339D-04,0.133366182D0,  24.3661098D0,
     3 2279.20117D0,   107210.680D0,   5262.50977D0,   4053068.00D0,
     4 1512070.63D0,   890228.000D0,   796651.313D0,   0.0D0,
     5 1.22701144D0,   15.8550014D0,   156.277832D0,   1212.51257D0,
     6 7389.15381D0,   19.6424370D0,   7400.30957D0,   53884.4375D0,
     7 65175.7578D0,   49021.0898D0,   0.0D0,          0.338816017D0,
     8 7.78060484D0,   121.763123D0,   1146.57324D0,   6304.62207D0,
     9 36.6902924D0,   11354.2598D0,   76200.6406D0,   1554979.25D0,
     * 11641636.0D0,   0.0D0,          0.359959543D0,  10.3489361D0,
     1 190.831161D0,   2104.99976D0,   14006.3213D0,   53.4860840D0,
     2 28089.1348D0,   148433.328D0,   2130197.75D0,   21017072.0D0,
     3 0.0D0/
C * DATA FOR YB ELEMENT #70
      DATA ((XSC(70, I, J), J = 1, 11), I = 1, 19)/
     1 1541.71777D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.891275764D0,  59.0038948D0,   493.002045D0,
     3 1555.27869D0,   2710.34204D0,   3045.11670D0,   148.159210D0,
     4 1903.04565D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 10.2957468D0,   581.685791D0,   3144.11011D0,   7215.60938D0,
     6 10556.7441D0,   11334.2373D0,   53.8273430D0,   1526.73938D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.41081572D0,
     8 361.532532D0,   3538.25586D0,   11624.1348D0,   20375.9707D0,
     9 23828.7031D0,   58.2434082D0,   2096.82056D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.81023669D0,   644.727661D0,
     1 7107.52979D0,   24810.9688D0,   44999.6055D0,   53052.9805D0,
     2 31.6497993D0,   419.014099D0,   3980.23950D0,   24817.1445D0,
     3 0.000000000D0,  94.8272552D0,   2958.55615D0,   12004.4395D0,
     4 23485.4336D0,   31333.7148D0,   34275.3516D0,   11.6992607D0,
     5 286.825867D0,   4593.76123D0,   36350.0625D0,   0.000000000D0,
     6 59.9591522D0,   4040.46191D0,   19866.1914D0,   39596.6797D0,
     7 51595.8047D0,   61729.0781D0,   13.0980949D0,   407.446991D0,
     8 7849.08105D0,   78921.0469D0,   0.000000000D0,  107.206200D0,
     9 8900.72363D0,   48445.7031D0,   105081.813D0,   145282.313D0,
     * 172125.234D0,   0.715343714D0,  59.8061752D0,   3298.45850D0,
     1 101215.008D0,   0.000000000D0,  24.4502983D0,   8020.99121D0,
     2 87857.6094D0,   283850.594D0,   498111.625D0,   5105320.50D0,
     3 0.513391793D0,  61.6185150D0,   4163.95898D0,   140750.281D0,
     4 0.000000000D0,  26.9674721D0,   11601.7119D0,   133430.359D0,
     5 439541.156D0,   782701.625D0,   7711613.50D0,   7.75942469D0,
     6 102.477119D0,   1010.94470D0,   7549.69922D0,   39027.3984D0,
     7 0.573737562D0,  957.574097D0,   15289.0342D0,   48781.6914D0,
     8 69840.4219D0,   0.0D0,          2.74265718D0,   64.9363937D0,
     9 1021.21985D0,   9246.31445D0,   41915.9375D0,   0.224003002D0,
     * 1520.10571D0,   24818.6543D0,   54561.5313D0,   57819.7070D0,
     1 0.0D0,          3.03556943D0,   90.9325562D0,   1700.32141D0,
     2 18316.3105D0,   108793.031D0,   0.312239051D0,  3632.25000D0,
     3 70013.7891D0,   191272.922D0,   240422.688D0,   0.0D0,
     4 0.168596536D0,  13.0654650D0,   627.022766D0,   15258.4873D0,
     5 148995.359D0,   0.104630895D0,  8614.63477D0,   200358.922D0,
     6 139436.656D0,   566868.563D0,   0.0D0,          0.120508559D0,
     7 13.3664236D0,   785.539612D0,   21021.0391D0,   218893.000D0,
     8 9.704419225D-02,14176.2070D0,   323827.875D0,   209291.875D0,
     9 922033.500D0,   0.0D0,          4.783113254D-04,0.150039479D0,
     * 26.7413387D0,   2401.42017D0,   107613.094D0,   2872.09058D0,
     1 3231043.25D0,   1160468.25D0,   645744.625D0,   861925.125D0,
     2 0.0D0,          6.005421747D-04,0.180947632D0,  32.4296608D0,
     3 2977.81274D0,   135966.766D0,   3564.33423D0,   4325047.50D0,
     4 1725410.88D0,   922834.375D0,   786038.563D0,   0.0D0,
     5 1.28677082D0,   16.4926815D0,   161.412033D0,   1242.09070D0,
     6 7478.63379D0,   19.6980019D0,   7301.84863D0,   52230.3672D0,
     7 62098.7070D0,   51460.8164D0,   0.0D0,          0.368140638D0,
     8 8.30016899D0,   127.264908D0,   1173.84985D0,   6308.03711D0,
     9 84.3702698D0,   15436.2383D0,   179142.203D0,   3209781.50D0,
     * 20650992.0D0,   0.0D0,          0.384861618D0,  10.9296017D0,
     1 198.542496D0,   2156.73022D0,   14119.7676D0,   128.185013D0,
     2 41605.4023D0,   259133.484D0,   4670217.50D0,   38034944.0D0,
     3 0.0D0/
C * DATA FOR LU ELEMENT #71
      DATA ((XSC(71, I, J), J = 1, 11), I = 1, 19)/
     1 1613.48828D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.883233249D0,  57.2371292D0,   475.654175D0,
     3 1498.60583D0,   2611.30737D0,   2930.99756D0,   155.393066D0,
     4 1970.14307D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 9.92060280D0,   557.767273D0,   3016.21631D0,   6924.03613D0,
     6 10125.4639D0,   10887.1211D0,   58.6059151D0,   1637.07654D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.36310601D0,
     8 349.590149D0,   3405.74805D0,   11166.1563D0,   19539.6133D0,
     9 22904.3906D0,   62.7940331D0,   2236.17310D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.71535683D0,   620.746887D0,
     1 6838.91699D0,   23871.2461D0,   43283.5977D0,   51212.6484D0,
     2 33.3201714D0,   436.623932D0,   4102.14990D0,   25088.7871D0,
     3 0.000000000D0,  90.3469238D0,   2837.81519D0,   11514.1992D0,
     4 22520.4492D0,   30028.6621D0,   32739.8477D0,   12.7611723D0,
     5 307.310638D0,   4814.39746D0,   36885.3945D0,   0.000000000D0,
     6 57.6274033D0,   3863.48804D0,   19000.7676D0,   37902.2305D0,
     7 49390.6875D0,   59108.7813D0,   14.1667366D0,   434.669891D0,
     8 8237.31543D0,   81203.1641D0,   0.000000000D0,  102.608055D0,
     9 8537.13574D0,   46617.7578D0,   101414.391D0,   140450.109D0,
     * 166391.203D0,   0.804120004D0,  66.2429428D0,   3587.74219D0,
     1 107704.898D0,   0.000000000D0,  23.3029346D0,   7631.86670D0,
     2 83671.4688D0,   270691.625D0,   470973.875D0,   4747013.00D0,
     3 0.574538291D0,  68.0975571D0,   4525.43750D0,   149873.734D0,
     4 0.000000000D0,  25.3744278D0,   10999.2100D0,   126918.438D0,
     5 419047.344D0,   740054.438D0,   7348300.50D0,   8.19799042D0,
     6 107.265495D0,   1049.34241D0,   7751.48779D0,   39244.7852D0,
     7 0.527745187D0,  922.143555D0,   14694.8594D0,   46854.3125D0,
     8 67806.1094D0,   0.0D0,          3.00205064D0,   69.8310776D0,
     9 1076.05896D0,   9526.97656D0,   41866.3672D0,   0.224305376D0,
     * 1484.56787D0,   24069.7949D0,   53115.8008D0,   57030.2344D0,
     1 0.0D0,          3.29421878D0,   97.3660736D0,   1793.27148D0,
     2 19027.4980D0,   110932.484D0,   0.293062896D0,  3441.92285D0,
     3 67151.6953D0,   186272.109D0,   238990.172D0,   0.0D0,
     4 0.190909237D0,  14.5593395D0,   684.131104D0,   16224.4375D0,
     5 152658.563D0,   9.987676889D-02,8416.99707D0,   196324.063D0,
     6 150398.484D0,   419206.000D0,   0.0D0,          0.135900751D0,
     7 14.8690519D0,   857.071838D0,   22396.6934D0,   225081.625D0,
     8 8.654536307D-02,13099.7598D0,   310839.906D0,   230788.641D0,
     9 645989.625D0,   0.0D0,          5.493086064D-04,0.180792093D0,
     * 32.5430222D0,   2858.23975D0,   123095.383D0,   2413.55591D0,
     1 3257706.00D0,   1017187.19D0,   744482.438D0,   1443660.50D0,
     2 0.0D0,          6.554692518D-04,0.215257287D0,  39.6647453D0,
     3 3566.21997D0,   156586.266D0,   3008.99121D0,   4377753.00D0,
     4 1460495.00D0,   957145.563D0,   1859926.50D0,   0.0D0,
     5 1.39114165D0,   17.7119598D0,   172.230255D0,   1314.03467D0,
     6 7828.31934D0,   19.0485363D0,   7102.07129D0,   51647.7773D0,
     7 66721.8984D0,   55492.9336D0,   0.0D0,          0.419142008D0,
     8 9.31658077D0,   140.336517D0,   1269.64856D0,   6687.05322D0,
     9 60.9940910D0,   13675.2520D0,   119009.672D0,   2060831.88D0,
     * 9758692.00D0,   0.0D0,          0.437312812D0,  12.2985239D0,
     1 220.535339D0,   2363.42725D0,   15287.5957D0,   90.7493744D0,
     2 36299.0938D0,   200419.875D0,   2854342.50D0,   17617800.0D0,
     3 0.0D0/
C * DATA FOR HF ELEMENT #72
      DATA ((XSC(72, I, J), J = 1, 11), I = 1, 20)/
     1 1688.20093D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.874796391D0,  55.5281868D0,   458.902313D0,
     3 1443.75891D0,   2514.02637D0,   2823.03589D0,   162.862030D0,
     4 2038.14709D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 9.50245762D0,   534.485107D0,   2891.82593D0,   6642.30713D0,
     6 9725.18066D0,   10436.9785D0,   63.7537384D0,   1754.60303D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.31085491D0,
     8 337.440704D0,   3274.01147D0,   10717.6094D0,   18738.5156D0,
     9 21985.8203D0,   67.6438751D0,   2383.94409D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.61657453D0,   596.337463D0,
     1 6570.35596D0,   22947.1758D0,   41677.6367D0,   49231.2305D0,
     2 35.0507317D0,   454.802521D0,   4229.03564D0,   25362.2930D0,
     3 0.000000000D0,  85.5042877D0,   2697.13721D0,   10965.4121D0,
     4 21466.5176D0,   28631.2539D0,   31063.2051D0,   13.8976984D0,
     5 328.929138D0,   5043.80518D0,   37395.7422D0,   0.000000000D0,
     6 54.8440781D0,   3668.76709D0,   18083.6582D0,   36142.5859D0,
     7 47197.5508D0,   55615.4844D0,   15.2976475D0,   463.293823D0,
     8 8645.29688D0,   83623.2344D0,   0.000000000D0,  97.0691605D0,
     9 8123.25684D0,   44606.0742D0,   97459.6406D0,   135486.656D0,
     * 157065.313D0,   0.902078450D0,  73.3129120D0,   3907.98950D0,
     1 115234.406D0,   0.000000000D0,  21.6249485D0,   7123.05469D0,
     2 78621.7813D0,   255715.156D0,   441644.375D0,   4246291.50D0,
     3 0.642104566D0,  75.2015991D0,   4923.74219D0,   160371.875D0,
     4 0.000000000D0,  23.2587910D0,   10237.4199D0,   119206.297D0,
     5 395983.813D0,   693805.250D0,   6792580.00D0,   8.65830803D0,
     6 112.285439D0,   1090.12671D0,   7975.20752D0,   39552.8906D0,
     7 0.480294138D0,  849.728149D0,   13673.6367D0,   44007.0430D0,
     8 64164.0156D0,   0.0D0,          3.28429103D0,   75.0950470D0,
     9 1134.99402D0,   9836.72656D0,   41694.0547D0,   0.205113158D0,
     * 1359.13391D0,   22479.2051D0,   50541.5391D0,   54532.5078D0,
     1 0.0D0,          3.57295585D0,   104.230095D0,   1892.04309D0,
     2 19789.1621D0,   113293.516D0,   0.264104277D0,  3174.73242D0,
     3 63355.3164D0,   179580.281D0,   234113.688D0,   0.0D0,
     4 0.216101766D0,  16.2323036D0,   748.213989D0,   17346.4609D0,
     5 157133.984D0,   7.853221148D-02,7099.69336D0,   181097.531D0,
     6 164954.906D0,   298310.938D0,   0.0D0,          0.153188035D0,
     7 16.5431213D0,   936.576660D0,   23953.7383D0,   232304.688D0,
     8 6.261973083D-02,10912.7920D0,   285928.219D0,   257060.188D0,
     9 446283.844D0,   0.0D0,          6.675710320D-04,0.220822141D0,
     * 39.3831596D0,   3398.25854D0,   141960.484D0,   71.2154617D0,
     1 1770791.25D0,   1856734.88D0,   476388.219D0,   709763.125D0,
     2 0.0D0,          7.900626515D-04,0.262668312D0,  48.0901070D0,
     3 4250.57373D0,   181161.719D0,   87.1911545D0,   2318386.00D0,
     4 2598049.25D0,   641885.063D0,   975640.875D0,   0.0D0,
     5 1.51112092D0,   19.0874825D0,   184.359863D0,   1395.62964D0,
     6 8246.86230D0,   15.4164753D0,   6106.85547D0,   47049.9883D0,
     7 67087.8125D0,   55035.6289D0,   0.0D0,          0.477280259D0,
     8 10.4594488D0,   154.855560D0,   1375.17896D0,   7105.65918D0,
     9 31.8034935D0,   10495.0957D0,   64203.2539D0,   1095132.38D0,
     * 5265648.50D0,   0.0D0,          0.495673567D0,  13.8010616D0,
     1 244.304199D0,   2582.97314D0,   16523.7656D0,   80.3886871D0,
     2 35074.4531D0,   189362.813D0,   2306188.00D0,   12463341.0D0,
     3 0.0D0,          5.636430345D-03,0.354511261D0,  14.7646332D0,
     4 333.031616D0,   3140.31787D0,   648.280334D0,   102469.688D0,
     5 7361422.00D0,   11662020.0D0,   12384611.0D0,   0.0D0/
C * DATA FOR TA ELEMENT #73
      DATA ((XSC(73, I, J), J = 1, 11), I = 1, 20)/
     1 1764.08289D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.868327558D0,  53.9224358D0,   443.057892D0,
     3 1391.93054D0,   2423.33130D0,   2718.72656D0,   170.510300D0,
     4 2106.43604D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 9.15231609D0,   511.630402D0,   2773.23804D0,   6372.74121D0,
     6 9331.01563D0,   10000.7559D0,   69.2644882D0,   1877.56543D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.26493645D0,
     8 326.306915D0,   3151.53320D0,   10298.1045D0,   18016.4746D0,
     9 20370.0176D0,   72.7586212D0,   2537.89771D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.52462101D0,   573.537903D0,
     1 6318.83740D0,   22075.7539D0,   40093.8438D0,   47404.6367D0,
     2 36.8399849D0,   473.191589D0,   4352.81982D0,   25634.0977D0,
     3 0.000000000D0,  81.4038849D0,   2574.11890D0,   10475.6426D0,
     4 20512.1055D0,   27388.6699D0,   29541.9727D0,   15.1124964D0,
     5 351.513580D0,   5274.74268D0,   37790.0078D0,   0.000000000D0,
     6 52.0738792D0,   3491.09937D0,   17234.5039D0,   34495.3164D0,
     7 45095.1875D0,   53710.6758D0,   16.5006599D0,   493.182770D0,
     8 9062.79297D0,   86018.9922D0,   0.000000000D0,  91.9110031D0,
     9 7732.41016D0,   42691.3672D0,   93661.6953D0,   130546.828D0,
     * 151169.859D0,   1.00968874D0,   80.9500122D0,   4246.04883D0,
     1 122891.891D0,   0.000000000D0,  20.2029152D0,   6680.40820D0,
     2 74131.8359D0,   242187.578D0,   416389.344D0,   3998763.75D0,
     3 0.715727150D0,  82.8500214D0,   5344.44971D0,   171114.109D0,
     4 0.000000000D0,  21.4328136D0,   9566.49414D0,   112277.258D0,
     5 374941.938D0,   652197.063D0,   6060169.00D0,   9.13684845D0,
     6 117.435211D0,   1131.14722D0,   8187.01270D0,   39774.8008D0,
     7 0.450498790D0,  800.082458D0,   12929.4141D0,   41821.4141D0,
     8 61330.8359D0,   0.0D0,          3.59210086D0,   80.6877594D0,
     9 1195.90381D0,   10142.7871D0,   41449.8906D0,   0.189176232D0,
     * 1248.69189D0,   21034.2090D0,   48140.8828D0,   52246.6875D0,
     1 0.0D0,          3.87172508D0,   111.500801D0,   1995.66016D0,
     2 20583.1133D0,   115724.797D0,   0.234615475D0,  2898.20264D0,
     3 59392.9688D0,   172377.781D0,   228286.563D0,   0.0D0,
     4 0.244223863D0,  18.0670052D0,   816.785461D0,   18500.4902D0,
     5 161459.875D0,   6.520989537D-02,6196.16357D0,   169041.797D0,
     6 178054.969D0,   224480.016D0,   0.0D0,          0.172409460D0,
     7 18.3736744D0,   1021.24396D0,   25537.3867D0,   239193.469D0,
     8 5.150463432D-02,9607.10059D0,   268493.250D0,   279922.344D0,
     9 331131.531D0,   0.0D0,          8.157273987D-04,0.268452168D0,
     * 47.1837082D0,   3992.97632D0,   161293.719D0,   15.8366928D0,
     1 1023417.75D0,   2180539.50D0,   449506.844D0,   567391.875D0,
     2 0.0D0,          9.591804119D-04,0.318981498D0,  57.6663742D0,
     3 5002.06787D0,   206289.688D0,   19.2783432D0,   1330570.88D0,
     4 3008531.25D0,   611872.125D0,   797208.625D0,   0.0D0,
     5 1.64040196D0,   20.5572128D0,   197.213211D0,   1480.75830D0,
     6 8680.72852D0,   13.6645327D0,   5590.10547D0,   44457.9922D0,
     7 67152.5859D0,   56622.4805D0,   0.0D0,          0.541975379D0,
     8 11.7062254D0,   170.306900D0,   1483.91870D0,   7528.13330D0,
     9 23.3908730D0,   9218.46289D0,   50637.6055D0,   783713.750D0,
     * 3727575.25D0,   0.0D0,          0.561229527D0,  15.4432154D0,
     1 269.733032D0,   2815.31812D0,   17838.4727D0,   56.7247391D0,
     2 30256.5352D0,   162221.516D0,   1595024.88D0,   8489136.00D0,
     3 0.0D0,          1.150703989D-02,0.728107095D0,  30.0322151D0,
     4 661.442322D0,   6055.97852D0,   944.121033D0,   119037.039D0,
     5 11622477.0D0,   14882909.0D0,   12524732.0D0,   0.0D0/
C * DATA FOR W  ELEMENT #74
      DATA ((XSC(74, I, J), J = 1, 11), I = 1, 20)/
     1 1839.59070D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.861603260D0,  52.3897018D0,   427.891815D0,
     3 1342.07275D0,   2334.80713D0,   2620.14185D0,   178.335876D0,
     4 2174.81152D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 8.82645988D0,   490.719055D0,   2661.26294D0,   6117.26758D0,
     6 8952.00098D0,   9617.07813D0,   75.1551666D0,   2006.74841D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.20830035D0,
     8 315.302155D0,   3034.92700D0,   9898.46484D0,   17287.3848D0,
     9 19598.9844D0,   78.1690216D0,   2698.55029D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.43909431D0,   552.122559D0,
     1 6081.44873D0,   21254.2305D0,   38657.4180D0,   45660.5977D0,
     2 38.6690903D0,   491.844788D0,   4476.14502D0,   25778.6523D0,
     3 0.000000000D0,  77.4271851D0,   2455.24756D0,   10003.2510D0,
     4 19595.5137D0,   26147.5293D0,   28204.7148D0,   16.4158726D0,
     5 375.142456D0,   5507.75635D0,   38107.6367D0,   0.000000000D0,
     6 49.7714119D0,   3324.67725D0,   16432.8613D0,   32928.4063D0,
     7 43064.8789D0,   51348.9023D0,   17.7657871D0,   524.185852D0,
     8 9487.11426D0,   88367.6172D0,   0.000000000D0,  87.2588196D0,
     9 7375.69922D0,   40920.1836D0,   90119.0391D0,   125967.289D0,
     * 147796.500D0,   1.12825680D0,   89.2119217D0,   4604.43408D0,
     1 130792.680D0,   0.000000000D0,  18.8366451D0,   6276.40381D0,
     2 69987.8516D0,   229586.891D0,   393425.563D0,   3693187.00D0,
     3 0.796105862D0,  91.0866699D0,   5788.82764D0,   182139.047D0,
     4 0.000000000D0,  19.8286781D0,   8965.34570D0,   105974.055D0,
     5 355593.156D0,   616299.875D0,   5715916.50D0,   9.64179802D0,
     6 122.772850D0,   1173.07715D0,   8399.04297D0,   39935.5742D0,
     7 0.421601743D0,  751.282166D0,   12201.3760D0,   39692.8438D0,
     8 58542.0313D0,   0.0D0,          3.92075706D0,   86.5611801D0,
     9 1258.35046D0,   10439.9082D0,   41147.5898D0,   0.177314118D0,
     * 1160.63550D0,   19814.1895D0,   46024.0625D0,   50295.0273D0,
     1 0.0D0,          4.19067049D0,   119.129013D0,   2102.08813D0,
     2 21368.9277D0,   118118.719D0,   0.216527209D0,  2712.24292D0,
     3 56548.5117D0,   167150.609D0,   224852.141D0,   0.0D0,
     4 0.275548726D0,  20.0754814D0,   890.190186D0,   19696.5840D0,
     5 165691.563D0,   5.526931211D-02,5477.47314D0,   158389.719D0,
     6 189602.141D0,   177491.109D0,   0.0D0,          0.193728566D0,
     7 20.3751984D0,   1111.99805D0,   27188.4883D0,   246114.906D0,
     8 4.290794209D-02,8504.03711D0,   252341.953D0,   300490.063D0,
     9 259114.969D0,   0.0D0,          9.907740168D-04,0.324058443D0,
     * 56.1426735D0,   4666.74756D0,   182839.422D0,   3.27545214D0,
     1 496492.813D0,   2512080.00D0,   442645.656D0,   433333.844D0,
     2 0.0D0,          1.164219226D-03,0.385088027D0,  68.5707245D0,
     3 5836.61279D0,   232993.234D0,   5.84086895D0,   776562.438D0,
     4 3326166.50D0,   600367.000D0,   668055.625D0,   0.0D0,
     5 1.77789497D0,   22.1060219D0,   210.645462D0,   1568.55933D0,
     6 9127.75977D0,   12.3787432D0,   5189.83691D0,   42301.6406D0,
     7 66690.7344D0,   58239.9375D0,   0.0D0,          0.614715755D0,
     8 13.0612030D0,   186.514069D0,   1593.65063D0,   7943.89209D0,
     9 23.3992462D0,   9255.58008D0,   50394.6445D0,   732290.313D0,
     * 3191617.00D0,   0.0D0,          0.630771518D0,  17.1803799D0,
     1 296.236694D0,   3050.06738D0,   19139.8848D0,   66.5594025D0,
     2 33376.7227D0,   178937.891D0,   1679722.50D0,   7773797.00D0,
     3 0.0D0,          1.981321163D-02,1.25190413D0,   50.9601440D0,
     4 1095.75830D0,   9751.22949D0,   1327.13818D0,   150278.109D0,
     5 16371733.0D0,   17352948.0D0,   12707123.0D0,   0.0D0/
C * DATA FOR RE ELEMENT #75
      DATA ((XSC(75, I, J), J = 1, 11), I = 1, 21)/
     1 1915.94141D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.856772244D0,  50.9274673D0,   413.388062D0,
     3 1294.55408D0,   2251.55054D0,   2524.54565D0,   186.362640D0,
     4 2243.05322D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 8.52171612D0,   470.999451D0,   2555.01782D0,   5874.97314D0,
     6 8606.56836D0,   9233.93164D0,   81.4502411D0,   2141.64185D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.16742635D0,
     8 305.453949D0,   2925.90161D0,   9523.15723D0,   16638.9668D0,
     9 18821.6328D0,   83.8583908D0,   2865.32886D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.35974240D0,   532.163940D0,
     1 5859.44531D0,   20479.0078D0,   37230.5430D0,   42373.4063D0,
     2 40.5475540D0,   510.697052D0,   4597.07520D0,   25755.3281D0,
     3 0.000000000D0,  73.8408203D0,   2346.29224D0,   9565.46484D0,
     4 18739.3359D0,   25000.2461D0,   26851.5547D0,   17.7996998D0,
     5 399.693878D0,   5740.29785D0,   38368.5313D0,   0.000000000D0,
     6 47.7427826D0,   3174.26465D0,   15695.8252D0,   31477.2227D0,
     7 41229.4531D0,   48126.5547D0,   19.0995522D0,   556.300598D0,
     8 9915.43457D0,   90657.8906D0,   0.000000000D0,  83.2025681D0,
     9 7056.90430D0,   39308.3945D0,   86865.1719D0,   121818.766D0,
     * 139126.891D0,   1.25757134D0,   98.0825653D0,   4979.79834D0,
     1 138712.344D0,   0.000000000D0,  17.7671642D0,   5929.13525D0,
     2 66329.9375D0,   218231.391D0,   373204.563D0,   3301167.25D0,
     3 0.884033144D0,  99.9366913D0,   6255.14063D0,   193281.297D0,
     4 0.000000000D0,  18.3719311D0,   8438.23535D0,   100324.594D0,
     5 337942.750D0,   584597.063D0,   5269126.00D0,   10.1583014D0,
     6 128.224472D0,   1215.58923D0,   8605.82031D0,   40085.8594D0,
     7 0.396186143D0,  707.321289D0,   11537.1494D0,   37729.2148D0,
     8 55959.2500D0,   0.0D0,          4.27405453D0,   92.7415237D0,
     9 1322.24011D0,   10726.3467D0,   40762.2188D0,   0.159107268D0,
     * 1087.44250D0,   18750.2637D0,   44108.4883D0,   48576.1055D0,
     1 0.0D0,          4.53424215D0,   127.161201D0,   2211.54761D0,
     2 22153.6484D0,   120493.781D0,   0.204284385D0,  2572.76563D0,
     3 54298.7188D0,   162975.359D0,   222607.797D0,   0.0D0,
     4 0.310283005D0,  22.2605629D0,   967.831177D0,   20901.0840D0,
     5 169629.563D0,   4.961069301D-02,5023.96338D0,   150751.188D0,
     6 199682.219D0,   149001.297D0,   0.0D0,          0.217295468D0,
     7 22.5520267D0,   1208.34241D0,   28870.9023D0,   252725.297D0,
     8 3.730181977D-02,7712.63477D0,   239449.125D0,   318651.625D0,
     9 215458.031D0,   0.0D0,          1.201500068D-03,0.388672352D0,
     * 66.1321869D0,   5375.47461D0,   202675.484D0,   2.35555959D0,
     1 417513.969D0,   2530010.25D0,   432043.594D0,   420179.375D0,
     2 0.0D0,          1.404164592D-03,0.461420894D0,  80.8667755D0,
     3 6745.74121D0,   260033.359D0,   2.82714105D0,   538840.125D0,
     4 3440587.50D0,   593333.813D0,   597202.438D0,   0.0D0,
     5 1.92073214D0,   23.7256927D0,   224.696335D0,   1659.15942D0,
     6 9583.94531D0,   11.4298239D0,   4883.94971D0,   40571.7852D0,
     7 66197.8438D0,   60112.1328D0,   0.0D0,          0.693705618D0,
     8 14.5190458D0,   203.630386D0,   1705.74011D0,   8358.34766D0,
     9 27.6798763D0,   10018.3906D0,   56245.9688D0,   783515.875D0,
     * 2965132.75D0,   0.0D0,          0.708791614D0,  19.0751152D0,
     1 324.471436D0,   3295.98877D0,   20495.2559D0,   79.1133957D0,
     2 37051.2227D0,   198682.766D0,   1777104.75D0,   7157214.00D0,
     3 0.0D0,          2.498664521D-02,1.57436454D0,   63.2084389D0,
     4 1326.85498D0,   11485.3457D0,   1627.00220D0,   192282.688D0,
     5 17979350.0D0,   15546440.0D0,   10769062.0D0,   0.0D0,
     6 2.776123583D-03,0.249567151D0,  12.2760305D0,   284.824127D0,
     7 2630.48193D0,   502.536102D0,   73569.9609D0,   4687253.50D0,
     8 4525270.00D0,   3534136.00D0,   0.0D0/
C * DATA FOR OS ELEMENT #76
      DATA ((XSC(76, I, J), J = 1, 11), I = 1, 21)/
     1 1998.90881D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.851439536D0,  49.5324211D0,   399.505341D0,
     3 1248.81079D0,   2170.23877D0,   2434.48438D0,   194.573410D0,
     4 2311.51489D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 8.22620964D0,   451.903687D0,   2452.52637D0,   5641.01025D0,
     6 8263.15332D0,   8874.19434D0,   88.1680374D0,   2283.05469D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.12791586D0,
     8 296.024048D0,   2821.88159D0,   9165.03418D0,   15993.6143D0,
     9 18093.2109D0,   89.8695908D0,   3039.38940D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.28465271D0,   513.147217D0,
     1 5647.55273D0,   19742.5625D0,   35937.0938D0,   40865.7891D0,
     2 42.4907570D0,   529.875488D0,   4717.12939D0,   0.000000000D0,
     3 0.000000000D0,  70.3948135D0,   2240.75293D0,   9141.83301D0,
     4 17910.0566D0,   23923.6348D0,   25565.9590D0,   19.2818851D0,
     5 425.341064D0,   5974.59668D0,   38379.8125D0,   0.000000000D0,
     6 45.8187141D0,   3030.62378D0,   14990.4873D0,   30079.4863D0,
     7 39400.7031D0,   45775.0156D0,   20.5141945D0,   589.783813D0,
     8 10354.5322D0,   92906.1797D0,   0.000000000D0,  78.8293304D0,
     9 6746.38770D0,   37738.2813D0,   83675.9063D0,   117593.523D0,
     * 133297.078D0,   1.39927042D0,   107.673134D0,   5380.69873D0,
     1 147113.125D0,   0.000000000D0,  16.6950417D0,   5585.86182D0,
     2 62750.9883D0,   207209.391D0,   354913.469D0,   3120916.50D0,
     3 0.979503036D0,  109.458542D0,   6751.12744D0,   205034.984D0,
     4 0.000000000D0,  17.0489063D0,   7928.55518D0,   94875.0156D0,
     5 320961.156D0,   555184.313D0,   4692289.50D0,   10.6938610D0,
     6 133.808701D0,   1258.50085D0,   8806.44629D0,   40180.1016D0,
     7 0.375633150D0,  669.973206D0,   10958.3008D0,   35978.0820D0,
     8 53634.3945D0,   0.0D0,          4.65388107D0,   99.2522964D0,
     9 1388.01270D0,   11008.4053D0,   40285.1289D0,   0.149091095D0,
     * 1014.79846D0,   17698.9414D0,   42182.9766D0,   46797.1055D0,
     1 0.0D0,          4.89679003D0,   135.598221D0,   2326.23145D0,
     2 22975.7363D0,   122932.898D0,   0.187397838D0,  2393.85498D0,
     3 51509.3242D0,   157549.375D0,   218334.688D0,   0.0D0,
     4 0.348783582D0,  24.6409035D0,   1050.63794D0,   22148.4180D0,
     5 173515.281D0,   4.452895001D-02,4606.27441D0,   143338.641D0,
     6 208318.391D0,   130930.875D0,   0.0D0,          0.243262097D0,
     7 24.9115200D0,   1310.11157D0,   30572.0625D0,   259095.313D0,
     8 3.403215483D-02,7209.48877D0,   230274.516D0,   334488.406D0,
     9 191418.828D0,   0.0D0,          1.447967952D-03,0.463260889D0,
     * 77.4304123D0,   6157.79639D0,   223774.094D0,   1.48723567D0,
     1 326497.031D0,   2556644.50D0,   422422.719D0,   388640.281D0,
     2 0.0D0,          1.687170239D-03,0.549519956D0,  94.6720352D0,
     3 7731.37061D0,   287446.625D0,   1.77697241D0,   420702.313D0,
     4 3466842.00D0,   580206.188D0,   554103.000D0,   0.0D0,
     5 2.07420516D0,   25.4199944D0,   239.049011D0,   1749.07959D0,
     6 10019.4287D0,   11.9897060D0,   5035.51123D0,   41312.3555D0,
     7 67346.7422D0,   65126.1133D0,   0.0D0,          0.781921804D0,
     8 16.1034527D0,   221.873444D0,   1824.38684D0,   8787.28320D0,
     9 16.6444149D0,   7928.81055D0,   40503.4844D0,   488539.688D0,
     * 2061220.63D0,   0.0D0,          0.793199241D0,  21.1034431D0,
     1 354.554565D0,   3559.82104D0,   21988.5039D0,   42.5161095D0,
     2 27586.7891D0,   154677.563D0,   1046575.56D0,   4693892.50D0,
     3 0.0D0,          3.070637211D-02,1.92730153D0,   76.2970963D0,
     4 1563.94263D0,   13180.4521D0,   1332.16736D0,   118385.555D0,
     5 17022298.0D0,   13249806.0D0,   8565134.00D0,   0.0D0,
     6 6.823690142D-03,0.613249362D0,  29.7935276D0,   675.614624D0,
     7 6084.06689D0,   842.825684D0,   94287.0703D0,   9001080.00D0,
     8 7622129.50D0,   5465839.50D0,   0.0D0/
C * DATA FOR IR ELEMENT #77
      DATA ((XSC(77, I, J), J = 1, 11), I = 1, 21)/
     1 2084.31763D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.848372638D0,  48.1983681D0,   386.203674D0,
     3 1205.15100D0,   2093.68530D0,   2346.68823D0,   202.978378D0,
     4 2379.82813D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 7.94961882D0,   433.875183D0,   2355.21118D0,   5418.98389D0,
     6 7944.38232D0,   8525.54395D0,   95.3508377D0,   2431.26270D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.08959174D0,
     8 286.991730D0,   2722.27539D0,   8823.24609D0,   15401.6016D0,
     9 17388.1426D0,   96.2003555D0,   3221.25073D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.21084285D0,   494.703766D0,
     1 5443.54102D0,   19033.6289D0,   34653.4336D0,   39425.0234D0,
     2 44.4766579D0,   549.367920D0,   4837.60547D0,   0.000000000D0,
     3 0.000000000D0,  66.8703003D0,   2134.53540D0,   8720.20117D0,
     4 17093.2480D0,   22808.8457D0,   24449.2773D0,   20.8563576D0,
     5 452.088379D0,   6211.59619D0,   38778.5977D0,   0.000000000D0,
     6 43.8913994D0,   2889.76660D0,   14303.1133D0,   28721.6406D0,
     7 37636.5820D0,   44253.2461D0,   21.9989281D0,   624.555847D0,
     8 10804.3447D0,   95120.3594D0,   0.000000000D0,  74.9710388D0,
     9 6445.19922D0,   36214.6797D0,   80581.5391D0,   113507.164D0,
     * 130227.563D0,   1.55473530D0,   118.027016D0,   5806.80859D0,
     1 155937.141D0,   0.000000000D0,  15.6755810D0,   5258.79541D0,
     2 59341.3984D0,   196701.406D0,   337881.219D0,   2871178.25D0,
     3 1.08376312D0,   119.709694D0,   7277.57080D0,   217373.359D0,
     4 0.000000000D0,  15.8038664D0,   7443.31494D0,   89683.9844D0,
     5 304795.938D0,   528760.125D0,   4303920.00D0,   11.2494116D0,
     6 139.565872D0,   1302.66797D0,   9012.43750D0,   40174.4141D0,
     7 0.349638999D0,  625.133118D0,   10294.0283D0,   34029.5703D0,
     8 51012.5156D0,   0.0D0,          5.06145191D0,   106.100014D0,
     9 1455.52429D0,   11283.7832D0,   39719.5938D0,   0.139374569D0,
     * 945.073547D0,   16682.4863D0,   40277.2813D0,   44989.4844D0,
     1 0.0D0,          5.28274965D0,   144.459274D0,   2445.39209D0,
     2 23822.7559D0,   125401.656D0,   0.170843989D0,  2215.44385D0,
     3 48694.0586D0,   151871.141D0,   213374.094D0,   0.0D0,
     4 0.391450971D0,  27.2448635D0,   1140.29614D0,   23494.5469D0,
     5 177507.766D0,   3.553931415D-02,4019.15039D0,   132922.703D0,
     6 214696.141D0,   117752.625D0,   0.0D0,          0.271958530D0,
     7 27.4967785D0,   1421.43127D0,   32464.7871D0,   266095.906D0,
     8 2.719595842D-02,6175.17725D0,   212257.125D0,   346230.438D0,
     9 172286.266D0,   0.0D0,          1.736157807D-03,0.549801707D0,
     * 90.5000610D0,   7081.02197D0,   250507.734D0,   0.377159357D0,
     1 152774.266D0,   2498325.50D0,   461861.563D0,   300963.813D0,
     2 0.0D0,          2.016902668D-03,0.651284337D0,  110.502411D0,
     3 8871.02246D0,   320563.281D0,   0.563207269D0,  223356.625D0,
     4 3402945.75D0,   615073.625D0,   444890.000D0,   0.0D0,
     5 2.23526239D0,   27.1868801D0,   254.041412D0,   1844.41895D0,
     6 10506.6924D0,   9.46362782D0,   4318.91797D0,   37110.8359D0,
     7 63932.7344D0,   62294.8242D0,   0.0D0,          0.877922356D0,
     8 17.7858124D0,   240.620728D0,   1940.79102D0,   9193.33105D0,
     9 14.8904295D0,   7501.68311D0,   37936.2227D0,   423219.875D0,
     * 1749258.50D0,   0.0D0,          0.883787930D0,  23.2416325D0,
     1 385.564301D0,   3824.12793D0,   23457.9824D0,   35.0851936D0,
     2 25319.3652D0,   146989.172D0,   863663.250D0,   3837076.75D0,
     3 0.0D0,          3.728385270D-02,2.32002163D0,   90.3582153D0,
     4 1808.81775D0,   14857.0703D0,   1107.31140D0,   77534.5313D0,
     5 15999634.0D0,   11557034.0D0,   7199740.50D0,   0.0D0,
     6 1.240959018D-02,1.10907686D0,   53.0882607D0,   1176.70337D0,
     7 10343.2783D0,   1072.80054D0,   94213.7109D0,   12927625.0D0,
     8 9863556.00D0,   6704388.00D0,   0.0D0/
C * DATA FOR PT ELEMENT #78
      DATA ((XSC(78, I, J), J = 1, 11), I = 1, 21)/
     1 2152.86523D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  0.846432447D0,  46.9265976D0,   373.479858D0,
     3 1163.34302D0,   2020.09045D0,   2262.84082D0,   211.555557D0,
     4 2448.26978D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 7.68703556D0,   416.657501D0,   2262.49536D0,   5206.62012D0,
     6 7630.89746D0,   8209.95313D0,   103.003242D0,   2586.15039D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.05388427D0,
     8 278.498779D0,   2628.65894D0,   8500.87891D0,   14814.5088D0,
     9 16786.3652D0,   102.874779D0,   3410.68140D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.13092494D0,   476.970398D0,
     1 5252.69678D0,   18371.7715D0,   33486.5664D0,   38127.0547D0,
     2 46.5231895D0,   569.037903D0,   4954.47266D0,   0.000000000D0,
     3 0.000000000D0,  63.4835701D0,   2041.33167D0,   8343.52637D0,
     4 16352.0498D0,   21835.4512D0,   23311.2852D0,   22.5318508D0,
     5 479.917175D0,   6448.80908D0,   0.000000000D0,  0.000000000D0,
     6 42.1726990D0,   2761.56201D0,   13670.0547D0,   27461.3164D0,
     7 36029.4453D0,   40899.0625D0,   23.5708256D0,   660.746826D0,
     8 11264.8525D0,   97432.0156D0,   0.000000000D0,  71.4618454D0,
     9 6167.74268D0,   34803.2539D0,   77696.2500D0,   109723.523D0,
     * 123099.289D0,   1.72388852D0,   129.156601D0,   6258.42529D0,
     1 165190.234D0,   0.000000000D0,  14.7782784D0,   4969.39600D0,
     2 56307.0273D0,   187319.625D0,   322146.500D0,   2506648.50D0,
     3 1.19665027D0,   130.708649D0,   7836.30566D0,   230389.578D0,
     4 0.000000000D0,  14.6959858D0,   7008.56201D0,   85020.4922D0,
     5 290270.938D0,   504087.000D0,   4003906.75D0,   11.8233175D0,
     6 145.439590D0,   1346.93054D0,   9208.60059D0,   40177.9961D0,
     7 0.332287967D0,  592.279236D0,   9783.34766D0,   32463.5078D0,
     8 48631.1563D0,   0.0D0,          5.50269032D0,   113.329018D0,
     9 1525.03955D0,   11554.3320D0,   38976.4805D0,   0.130480543D0,
     * 880.564514D0,   15729.3545D0,   38386.2813D0,   43067.9727D0,
     1 0.0D0,          5.69251537D0,   153.742264D0,   2568.58374D0,
     2 24683.3379D0,   127952.664D0,   0.149947762D0,  2075.37939D0,
     3 46410.0625D0,   147089.547D0,   209243.250D0,   0.0D0,
     4 0.438516498D0,  30.0672398D0,   1235.32422D0,   24872.5625D0,
     5 181224.297D0,   3.104903921D-02,3631.53516D0,   125298.000D0,
     6 218161.641D0,   112476.070D0,   0.0D0,          0.303463370D0,
     7 30.2908669D0,   1539.00562D0,   34389.4453D0,   272764.500D0,
     8 2.241119184D-02,5549.03320D0,   200042.172D0,   352990.563D0,
     9 165764.000D0,   0.0D0,          2.073757816D-03,0.648876309D0,
     * 105.026894D0,   8065.94189D0,   276766.594D0,   0.201935664D0,
     1 105967.828D0,   2356522.00D0,   450271.250D0,   288861.844D0,
     2 0.0D0,          2.402246930D-03,0.767768264D0,  128.175995D0,
     3 10105.0068D0,   354410.719D0,   0.297191739D0,  154104.531D0,
     4 3225300.75D0,   597038.500D0,   432386.906D0,   0.0D0,
     5 2.39787269D0,   28.9441452D0,   268.689026D0,   1934.86853D0,
     6 10956.9707D0,   8.76206303D0,   4065.82104D0,   35385.5000D0,
     7 60787.6797D0,   60415.5820D0,   0.0D0,          0.977953315D0,
     8 19.4883652D0,   258.886353D0,   2048.14990D0,   9545.51953D0,
     9 14.9105349D0,   7464.91455D0,   37688.8164D0,   426000.906D0,
     * 1793904.38D0,   0.0D0,          0.973817170D0,  25.3129902D0,
     1 414.666168D0,   4062.57349D0,   24760.0371D0,   35.8129692D0,
     2 25837.0449D0,   149480.656D0,   885650.375D0,   4116500.50D0,
     3 0.0D0,          4.277142882D-02,2.60824323D0,   99.3904114D0,
     4 1943.15613D0,   15571.6396D0,   1458.41064D0,   130757.008D0,
     5 15573292.0D0,   10632751.0D0,   7138561.00D0,   0.0D0,
     6 2.346534841D-02,2.04996371D0,   95.8907242D0,   2077.51929D0,
     7 17845.7520D0,   2485.02710D0,   306832.750D0,   19785610.0D0,
     8 15738859.0D0,   11531171.0D0,   0.0D0/
C * DATA FOR AU ELEMENT #79
      DATA ((XSC(79, I, J), J = 1, 11), I = 1, 21)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  38.6293297D0,   324.666565D0,   902.221741D0,
     3 1572.68774D0,   2059.21899D0,   0.0D0,          220.632462D0,
     4 2516.19824D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 7.43844557D0,   400.267578D0,   2173.69653D0,   5003.65381D0,
     6 7338.01123D0,   7891.47705D0,   111.160133D0,   2747.67578D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  2.01955223D0,
     8 270.382141D0,   2538.76636D0,   8191.92285D0,   14277.0967D0,
     9 16157.1680D0,   109.872185D0,   3607.06885D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.06537437D0,   460.459686D0,
     1 5069.52979D0,   17732.0488D0,   32306.1172D0,   36908.1055D0,
     2 48.6085091D0,   588.897339D0,   5069.56836D0,   0.000000000D0,
     3 0.000000000D0,  60.4823265D0,   1949.15015D0,   7972.59766D0,
     4 15626.1211D0,   20858.4121D0,   22135.5469D0,   24.3186417D0,
     5 508.801605D0,   6683.98535D0,   0.000000000D0,  0.000000000D0,
     6 40.5689774D0,   2639.74976D0,   13064.5391D0,   26246.9785D0,
     7 34417.5859D0,   38574.1055D0,   25.2148151D0,   698.127991D0,
     8 11731.1084D0,   99664.2188D0,   0.000000000D0,  68.0884933D0,
     9 5900.46240D0,   33435.5117D0,   74900.0781D0,   106048.859D0,
     * 113809.922D0,   1.90877450D0,   141.108276D0,   6733.83203D0,
     1 174732.000D0,   0.000000000D0,  13.9222813D0,   4690.47510D0,
     2 53360.8867D0,   178147.047D0,   308140.906D0,   2278065.75D0,
     3 1.31898510D0,   142.470169D0,   8423.35449D0,   243802.313D0,
     4 0.000000000D0,  13.6534481D0,   6592.48730D0,   80502.7813D0,
     5 276057.313D0,   481926.281D0,   3517298.75D0,   12.4245834D0,
     6 151.485703D0,   1391.80408D0,   9401.99512D0,   40092.7461D0,
     7 0.312762827D0,  555.852295D0,   9229.88086D0,   30793.0605D0,
     8 46336.4688D0,   0.0D0,          5.97069407D0,   120.866180D0,
     9 1595.74219D0,   11811.1670D0,   38153.6992D0,   0.121744417D0,
     * 818.142944D0,   14798.9648D0,   36558.0859D0,   41252.3125D0,
     1 0.0D0,          6.13133955D0,   163.471375D0,   2695.16089D0,
     2 25549.3164D0,   130381.320D0,   0.137875795D0,  1938.36426D0,
     3 44127.1914D0,   142208.250D0,   204849.344D0,   0.0D0,
     4 0.490304232D0,  33.1184692D0,   1335.73010D0,   26275.9258D0,
     5 184691.813D0,   2.689767443D-02,3259.02222D0,   117527.594D0,
     6 221379.563D0,   109208.750D0,   0.0D0,          0.337982684D0,
     7 33.3066254D0,   1663.35889D0,   36360.0391D0,   279083.813D0,
     8 1.893635280D-02,4930.04053D0,   187187.797D0,   359200.031D0,
     9 162359.984D0,   0.0D0,          2.464715159D-03,0.761895299D0,
     * 121.243187D0,   9130.99805D0,   303588.688D0,   0.108959161D0,
     1 73797.3906D0,   2183817.25D0,   473625.219D0,   254614.594D0,
     2 0.0D0,          2.847113181D-03,0.900383472D0,  147.877197D0,
     3 11437.7539D0,   388956.375D0,   0.162117675D0,  107021.711D0,
     4 3008845.50D0,   623508.438D0,   379320.500D0,   0.0D0,
     5 2.57219863D0,   30.8129902D0,   284.109406D0,   2028.68372D0,
     6 11406.4199D0,   8.25963116D0,   3872.29126D0,   34036.7461D0,
     7 59422.1289D0,   61084.4102D0,   0.0D0,          1.09061289D0,
     8 21.3785706D0,   278.904144D0,   2164.76709D0,   9921.41602D0,
     9 12.9298220D0,   6920.77734D0,   34738.8086D0,   363105.688D0,
     * 1527340.13D0,   0.0D0,          1.07683420D0,   27.6668377D0,
     1 447.594238D0,   4332.26416D0,   26230.8809D0,   35.2958069D0,
     2 25916.6660D0,   151241.641D0,   843603.000D0,   3729802.50D0,
     3 0.0D0,          5.085494742D-02,3.07416463D0,   115.277191D0,
     4 2201.76416D0,   17229.4004D0,   1262.50232D0,   93408.2422D0,
     5 14953335.0D0,   9368696.00D0,   6231522.00D0,   0.0D0,
     6 3.338646144D-02,2.90079951D0,   133.737671D0,   2833.18213D0,
     7 23805.2930D0,   2647.12280D0,   271471.438D0,   22768304.0D0,
     8 16474063.0D0,   11680687.0D0,   0.0D0/
C * DATA FOR HG ELEMENT #80
      DATA ((XSC(80, I, J), J = 1, 11), I = 1, 22)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  37.6708527D0,   314.210602D0,   871.379089D0,
     3 1518.18823D0,   1988.59009D0,   0.0D0,          229.523453D0,
     4 2583.53491D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 7.19898653D0,   384.036194D0,   2088.10229D0,   4807.28418D0,
     6 7049.54932D0,   7582.37207D0,   119.987572D0,   2916.03564D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.98558009D0,
     8 262.480316D0,   2451.86548D0,   7892.88232D0,   13737.6699D0,
     9 15523.6602D0,   117.239082D0,   3811.51001D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  2.00101280D0,   444.345276D0,
     1 4891.01221D0,   17112.7383D0,   31212.5625D0,   35622.8555D0,
     2 50.7448845D0,   608.994934D0,   5182.54980D0,   0.000000000D0,
     3 0.000000000D0,  57.4882240D0,   1857.45996D0,   7605.57227D0,
     4 14912.4912D0,   19887.8281D0,   21237.7188D0,   26.2121353D0,
     5 538.837524D0,   6920.41309D0,   0.000000000D0,  0.000000000D0,
     6 38.6270218D0,   2514.95776D0,   12453.9170D0,   25036.1055D0,
     7 32819.9180D0,   37971.5625D0,   26.9522266D0,   736.975159D0,
     8 12208.2490D0,   101485.320D0,   0.000000000D0,  64.6448517D0,
     9 5628.21045D0,   32045.2227D0,   72048.1563D0,   102182.398D0,
     * 110843.000D0,   2.10924292D0,   153.905960D0,   7234.72949D0,
     1 184603.578D0,   0.000000000D0,  13.0759830D0,   4416.37061D0,
     2 50452.8555D0,   169043.188D0,   294712.563D0,   2243732.75D0,
     3 1.45195472D0,   155.072311D0,   9043.05273D0,   257820.844D0,
     4 0.000000000D0,  12.6301603D0,   6177.84326D0,   75985.2266D0,
     5 261800.734D0,   461422.781D0,   3343575.00D0,   13.0368004D0,
     6 157.633972D0,   1437.08508D0,   9591.41797D0,   39842.2656D0,
     7 0.291843653D0,  517.652100D0,   8656.07617D0,   29067.1582D0,
     8 44198.2227D0,   0.0D0,          6.46967506D0,   128.708359D0,
     9 1666.59021D0,   12044.7090D0,   37353.2266D0,   0.115271300D0,
     * 767.519165D0,   13999.4492D0,   34956.6250D0,   39751.6523D0,
     1 0.0D0,          6.59015846D0,   173.532974D0,   2823.66895D0,
     2 26396.5586D0,   132724.922D0,   0.128319412D0,  1824.18433D0,
     3 42133.4844D0,   137869.641D0,   200981.234D0,   0.0D0,
     4 0.547235131D0,  36.4216881D0,   1442.55212D0,   27736.9629D0,
     5 187947.438D0,   2.231793851D-02,2837.85498D0,   108309.156D0,
     6 223219.719D0,   109609.313D0,   0.0D0,          0.375783116D0,
     7 36.5666656D0,   1795.79980D0,   38421.8203D0,   285280.281D0,
     8 1.529175881D-02,4230.52148D0,   171749.438D0,   362657.750D0,
     9 165932.516D0,   0.0D0,          2.916152822D-03,0.890594184D0,
     * 139.378189D0,   10294.0381D0,   331971.719D0,   5.432848632D-02,
     1 47886.6445D0,   1922911.63D0,   565484.563D0,   208792.016D0,
     2 0.0D0,          3.359529423D-03,1.05118167D0,   169.904404D0,
     3 12895.7520D0,   425758.281D0,   7.615496218D-02,68313.9297D0,
     4 2655413.00D0,   744125.375D0,   302197.031D0,   0.0D0,
     5 2.75942302D0,   32.8090019D0,   300.530212D0,   2128.75781D0,
     6 11891.0273D0,   6.72155762D0,   3397.78882D0,   30975.9766D0,
     7 57560.1719D0,   60507.2617D0,   0.0D0,          1.21736455D0,
     8 23.4722557D0,   300.726715D0,   2289.89429D0,   10319.0693D0,
     9 10.6393175D0,   6229.20117D0,   31394.5254D0,   282175.094D0,
     * 1138393.13D0,   0.0D0,          1.19494247D0,   30.3488846D0,
     1 484.944244D0,   4637.80176D0,   27901.2949D0,   32.0235100D0,
     2 24897.1250D0,   149795.922D0,   723183.500D0,   2809717.75D0,
     3 0.0D0,          6.201901287D-02,3.75049901D0,   138.964645D0,
     4 2591.22046D0,   19821.1680D0,   2782.53613D0,   354706.813D0,
     5 17363448.0D0,   9453465.00D0,   8431507.00D0,   0.0D0,
     6 4.085951298D-02,3.58066297D0,   163.793716D0,   3392.00171D0,
     7 27899.5762D0,   3650.28955D0,   417583.906D0,   25729812.0D0,
     8 15345441.0D0,   12314197.0D0,   0.0D0,          0.243561655D0,
     9 2.62276173D0,   22.9374752D0,   163.816376D0,   958.838562D0,
     * 125.570839D0,   11494.9297D0,   45395.9727D0,   1154198.00D0,
     1 5944232.50D0,   0.0D0/
C * DATA FOR TL ELEMENT #81
      DATA ((XSC(81, I, J), J = 1, 11), I = 1, 22)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  36.7505112D0,   304.159332D0,   841.720154D0,
     3 1465.02539D0,   1917.29431D0,   0.0D0,          238.655640D0,
     4 2650.93481D0,   0.000000000D0,  0.000000000D0,  0.000000D0,
     5 6.96272993D0,   368.510254D0,   2004.36279D0,   4616.48633D0,
     6 6773.05127D0,   7278.79541D0,   129.225540D0,   3091.14038D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.95263731D0,
     8 254.904739D0,   2368.22070D0,   7605.98242D0,   13237.0400D0,
     9 14920.7422D0,   124.958359D0,   4023.65405D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.93868458D0,   428.747192D0,
     1 4718.60156D0,   16512.6172D0,   30123.8984D0,   34298.8086D0,
     2 52.9444160D0,   629.299194D0,   5292.59961D0,   0.000000000D0,
     3 0.000000000D0,  54.6170578D0,   1768.81311D0,   7250.07129D0,
     4 14218.6465D0,   19002.5254D0,   20241.8477D0,   28.2292805D0,
     5 570.029846D0,   7155.31543D0,   0.000000000D0,  0.000000000D0,
     6 36.9420433D0,   2393.39551D0,   11859.7744D0,   23856.9121D0,
     7 31273.2285D0,   36988.2617D0,   28.7684555D0,   777.151306D0,
     8 12694.6758D0,   107799.883D0,   0.000000000D0,  61.2213783D0,
     9 5359.04590D0,   30669.0098D0,   69222.7969D0,   98373.4688D0,
     * 113081.570D0,   2.32726169D0,   167.645569D0,   7766.12061D0,
     1 195036.063D0,   0.000000000D0,  12.1542692D0,   4141.63770D0,
     2 47547.7813D0,   159969.766D0,   281337.531D0,   2133384.75D0,
     3 1.59528470D0,   168.536713D0,   9697.68848D0,   272517.844D0,
     4 0.000000000D0,  11.6307917D0,   5770.26563D0,   71525.0859D0,
     5 247680.750D0,   440288.219D0,   3370416.00D0,   13.6683912D0,
     6 163.903152D0,   1482.60254D0,   9774.77051D0,   39569.7383D0,
     7 0.271508664D0,  480.142029D0,   8090.28613D0,   27381.3770D0,
     8 41939.8477D0,   0.0D0,          7.00394964D0,   136.961182D0,
     9 1740.10291D0,   12279.1162D0,   36269.2188D0,   0.104858741D0,
     * 698.989746D0,   12999.3340D0,   33023.7305D0,   37786.5898D0,
     1 0.0D0,          7.07736444D0,   184.146790D0,   2959.82471D0,
     2 27318.2383D0,   135199.766D0,   0.112245992D0,  1642.63049D0,
     3 39087.8398D0,   131048.930D0,   192620.031D0,   0.0D0,
     4 0.609680235D0,  39.9801559D0,   1555.03601D0,   29221.6465D0,
     5 190981.688D0,   1.847876050D-02,2464.54248D0,   99482.8906D0,
     6 224271.359D0,   117338.148D0,   0.0D0,          0.417017430D0,
     7 40.0667915D0,   1934.58154D0,   40495.5039D0,   291232.219D0,
     8 1.258266717D-02,3661.52075D0,   157913.375D0,   365015.281D0,
     9 181976.344D0,   0.0D0,          3.436008003D-03,1.03688824D0,
     * 159.680298D0,   11575.1328D0,   362794.156D0,   2.389349788D-02,
     1 28986.3750D0,   1593842.88D0,   749133.063D0,   184318.234D0,
     2 0.0D0,          3.947643563D-03,1.22219718D0,   194.503113D0,
     3 14495.2129D0,   465411.188D0,   3.316638619D-02,41200.2734D0,
     4 2209708.25D0,   983727.500D0,   257940.484D0,   0.0D0,
     5 2.95544767D0,   34.8801651D0,   317.410248D0,   2230.55225D0,
     6 12376.1113D0,   5.45351887D0,   2901.15405D0,   27592.9336D0,
     7 54876.1563D0,   56690.0430D0,   0.0D0,          1.35342801D0,
     8 25.7043285D0,   323.764130D0,   2419.94360D0,   10712.0381D0,
     9 6.59764719D0,   4895.47607D0,   25824.5352D0,   174385.094D0,
     * 777126.375D0,   0.0D0,          1.32109165D0,   33.2294579D0,
     1 525.348633D0,   4973.02100D0,   29784.1953D0,   16.8682785D0,
     2 17707.2637D0,   122690.359D0,   433154.469D0,   1640877.13D0,
     3 0.0D0,          7.489055395D-02,4.53407192D0,   166.225403D0,
     4 3031.78906D0,   22667.2891D0,   343.807739D0,   39589.9375D0,
     5 6899228.00D0,   9519483.00D0,   4303452.00D0,   0.0D0,
     6 4.969504476D-02,4.37703419D0,   198.447693D0,   4021.89771D0,
     7 32400.9922D0,   667.043518D0,   60946.2852D0,   13976118.0D0,
     8 14531094.0D0,   7702536.50D0,   0.0D0,          0.322027743D0,
     9 3.49257398D0,   30.5639877D0,   216.844971D0,   1261.86975D0,
     * 112.208260D0,   11709.5225D0,   38995.6016D0,   972106.063D0,
     1 5652065.00D0,   0.0D0/
C * DATA FOR PB ELEMENT #82
      DATA ((XSC(82, I, J), J = 1, 11), I = 1, 23)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  35.8716545D0,   294.524200D0,   813.227112D0,
     3 1414.63635D0,   1851.95520D0,   0.0D0,          247.877075D0,
     4 2717.17554D0,   0.000000000D0,  0.000000000D0,  0.000000D0,
     5 6.74366903D0,   353.930481D0,   1925.35803D0,   4434.95605D0,
     6 6505.57031D0,   6997.19141D0,   139.015854D0,   3272.97607D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.92084634D0,
     8 247.397278D0,   2288.31763D0,   7330.95020D0,   12735.9219D0,
     9 14381.0098D0,   133.052155D0,   4242.77148D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.88079166D0,   414.137512D0,
     1 4556.13574D0,   15947.2148D0,   29116.4727D0,   33094.9180D0,
     2 55.1786766D0,   649.716736D0,   5399.47363D0,   0.000000000D0,
     3 0.000000000D0,  51.9043045D0,   1684.87061D0,   6912.60889D0,
     4 13559.9385D0,   18136.0488D0,   19197.5273D0,   30.3572769D0,
     5 602.176270D0,   7385.01611D0,   0.000000000D0,  0.000000000D0,
     6 35.4397774D0,   2282.71826D0,   11311.4248D0,   22763.2051D0,
     7 29838.4570D0,   35104.1133D0,   30.6800423D0,   818.620605D0,
     8 13184.6084D0,   0.000000000D0,  0.000000000D0,  58.1819344D0,
     9 5114.12451D0,   29399.6211D0,   66591.6953D0,   94860.8672D0,
     * 109804.336D0,   2.56441355D0,   182.313431D0,   8320.59863D0,
     1 205728.031D0,   0.000000000D0,  11.4095411D0,   3897.81689D0,
     2 44929.0664D0,   151687.359D0,   268430.313D0,   2024232.25D0,
     3 1.75049591D0,   182.878403D0,   10380.8555D0,   287412.031D0,
     4 0.000000000D0,  10.7044430D0,   5407.70557D0,   67492.0313D0,
     5 234746.563D0,   419983.875D0,   3163863.50D0,   14.3185396D0,
     6 170.298172D0,   1528.43176D0,   9952.65332D0,   39227.0586D0,
     7 0.252745450D0,  444.717194D0,   7553.37305D0,   25753.1699D0,
     8 39676.5117D0,   0.0D0,          7.57276058D0,   145.542236D0,
     9 1813.84351D0,   12491.1357D0,   35186.3164D0,   9.720915556D-02,
     * 644.845276D0,   12162.3096D0,   31334.0801D0,   36176.0547D0,
     1 0.0D0,          7.59156179D0,   195.160721D0,   3098.26685D0,
     2 28227.4707D0,   137553.000D0,   0.100781851D0,  1504.72974D0,
     3 36656.7031D0,   125312.609D0,   186195.719D0,   0.0D0,
     4 0.678053319D0,  43.8103218D0,   1673.45789D0,   30730.8574D0,
     5 193726.781D0,   1.556147821D-02,2162.63745D0,   91739.6797D0,
     6 223297.859D0,   131120.797D0,   0.0D0,          0.461993575D0,
     7 43.8263206D0,   2080.62988D0,   42607.7734D0,   296820.406D0,
     8 1.058416534D-02,3199.59058D0,   145721.188D0,   364428.625D0,
     9 208738.016D0,   0.0D0,          4.032428842D-03,1.20229006D0,
     * 182.168381D0,   12949.8740D0,   394023.594D0,   1.262279321D-02,
     1 19181.6973D0,   1324029.13D0,   962867.563D0,   169274.266D0,
     2 0.0D0,          4.620685242D-03,1.41520584D0,   221.727631D0,
     3 16211.8027D0,   505706.313D0,   1.737721264D-02,27119.9004D0,
     4 1836849.50D0,   1265559.00D0,   233725.141D0,   0.0D0,
     5 3.16178107D0,   37.0364761D0,   334.694977D0,   2332.00024D0,
     6 12834.0713D0,   4.73887587D0,   2667.75488D0,   25855.5645D0,
     7 53445.3672D0,   55956.0820D0,   0.0D0,          1.50196934D0,
     8 28.0811501D0,   347.392487D0,   2546.10205D0,   11081.9209D0,
     9 6.37304354D0,   4764.15967D0,   25354.5469D0,   153902.828D0,
     * 663843.500D0,   0.0D0,          1.45888615D0,   36.3288460D0,
     1 567.993652D0,   5318.38916D0,   31683.5840D0,   12.5284662D0,
     2 15330.2109D0,   114308.805D0,   348896.344D0,   1225272.00D0,
     3 0.0D0,          8.954252303D-02,5.39927149D0,   195.322311D0,
     4 3483.39063D0,   25483.1211D0,   141.210983D0,   48489.7266D0,
     5 2526930.00D0,   13926979.0D0,   3251424.25D0,   0.0D0,
     6 5.954287946D-02,5.24107456D0,   234.869537D0,   4658.67432D0,
     7 36794.3047D0,   249.896179D0,   77629.7344D0,   4999401.00D0,
     8 19581046.0D0,   5958861.00D0,   0.0D0,          0.393189073D0,
     9 4.27342463D0,   37.3253899D0,   262.932922D0,   1523.90234D0,
     * 97.1954880D0,   11322.2471D0,   38387.7773D0,   706199.000D0,
     1 4520768.00D0,   0.0D0,          9.778127819D-02,1.60369289D0,
     2 18.6227684D0,   137.449020D0,   629.868591D0,   216.538300D0,
     3 37120.3281D0,   2332257.00D0,   14477358.0D0,   33478308.0D0,
     4 0.0D0/
C * DATA FOR BI ELEMENT #83
      DATA ((XSC(83, I, J), J = 1, 11), I = 1, 23)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  35.0313034D0,   285.287354D0,   785.885315D0,
     3 1365.58289D0,   1786.26929D0,   0.0D0,          257.295105D0,
     4 2782.74634D0,   0.000000000D0,  0.000000000D0,  0.000000D0,
     5 6.53682518D0,   340.036987D0,   1849.79492D0,   4261.91357D0,
     6 6253.20752D0,   6720.55078D0,   149.416214D0,   3460.82422D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.89219773D0,
     8 240.637894D0,   2213.10327D0,   7071.67627D0,   12280.5059D0,
     9 13831.9316D0,   141.511261D0,   4469.10352D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.82588029D0,   400.200531D0,
     1 4401.35645D0,   15404.8818D0,   28119.4688D0,   32014.1934D0,
     2 57.4725113D0,   670.225647D0,   5501.37598D0,   0.000000000D0,
     3 0.000000000D0,  49.4341507D0,   1606.95117D0,   6596.78760D0,
     4 12940.4873D0,   17344.4629D0,   18283.0898D0,   32.6096420D0,
     5 635.363953D0,   7610.20703D0,   0.000000000D0,  0.000000000D0,
     6 34.0434570D0,   2178.88477D0,   10792.9971D0,   21720.8320D0,
     7 28461.8203D0,   34004.9414D0,   32.6707001D0,   861.232056D0,
     8 13676.7070D0,   0.000000000D0,  0.000000000D0,  55.4122543D0,
     9 4888.97021D0,   28219.4629D0,   64132.8477D0,   91479.2813D0,
     * 105628.164D0,   2.82040119D0,   197.929398D0,   8899.62695D0,
     1 216495.000D0,   0.000000000D0,  10.7359819D0,   3675.45996D0,
     2 42511.4453D0,   143958.656D0,   255534.563D0,   1912356.63D0,
     3 1.91708291D0,   198.100357D0,   11092.5488D0,   302747.500D0,
     4 0.000000000D0,  9.93102837D0,   5079.45801D0,   63789.8672D0,
     5 222771.313D0,   401488.000D0,   2956409.00D0,   14.9950428D0,
     6 176.798233D0,   1573.41577D0,   10112.4609D0,   38650.5938D0,
     7 0.239857987D0,  417.083588D0,   7116.51025D0,   24382.7129D0,
     8 37838.4063D0,   0.0D0,          8.18303871D0,   154.478928D0,
     9 1887.62610D0,   12679.8613D0,   34116.4102D0,   9.152862430D-02,
     * 600.691833D0,   11441.7998D0,   29811.3867D0,   34709.4336D0,
     1 0.0D0,          8.13323975D0,   206.586700D0,   3239.14526D0,
     2 29127.9980D0,   139812.109D0,   9.195916355D-02,1392.10449D0,
     3 34588.3672D0,   120337.891D0,   181400.359D0,   0.0D0,
     4 0.752776563D0,  47.9184341D0,   1797.39246D0,   32245.8066D0,
     5 196220.234D0,   1.335039455D-02,1920.67053D0,   85025.8672D0,
     6 221361.969D0,   148493.578D0,   0.0D0,          0.510924935D0,
     7 47.8553734D0,   2233.79736D0,   44745.0469D0,   302076.063D0,
     8 9.048909880D-03,2817.76147D0,   134831.344D0,   361423.063D0,
     9 242470.063D0,   0.0D0,          4.714301322D-03,1.38842094D0,
     * 206.898804D0,   14403.4854D0,   424836.250D0,   7.369683590D-03,
     1 13740.0723D0,   1117142.50D0,   1183275.63D0,   157517.953D0,
     2 0.0D0,          5.388054997D-03,1.63211393D0,   251.696182D0,
     3 18037.5547D0,   546186.188D0,   9.792809375D-03,19018.0117D0,
     4 1538130.63D0,   1575194.88D0,   216121.422D0,   0.0D0,
     5 3.37275028D0,   39.2505760D0,   352.373291D0,   2434.26758D0,
     6 13285.7627D0,   4.22969723D0,   2445.92578D0,   24154.9160D0,
     7 52025.4648D0,   55566.9219D0,   0.0D0,          1.66625845D0,
     8 30.6352291D0,   372.132080D0,   2675.41235D0,   11441.5107D0,
     9 5.13349295D0,   4271.24170D0,   23504.8164D0,   121862.406D0,
     * 547337.938D0,   0.0D0,          1.60768282D0,   39.6253166D0,
     1 612.516968D0,   5670.96289D0,   33584.3477D0,   11.0835199D0,
     2 14409.6475D0,   111979.516D0,   313722.000D0,   1009973.50D0,
     3 0.0D0,          0.106654033D0,  6.36825800D0,   226.640030D0,
     4 3950.73438D0,   28295.7363D0,   89.7414627D0,   51561.1094D0,
     5 1270817.88D0,   20336782.0D0,   2788147.75D0,   0.0D0,
     6 7.075495273D-02,6.19856358D0,   273.989136D0,   5317.54688D0,
     7 41195.0039D0,   136.017487D0,   83653.1406D0,   2191223.75D0,
     8 29711264.0D0,   5008162.50D0,   0.0D0,          0.468857676D0,
     9 5.10219765D0,   44.4555626D0,   311.038757D0,   1796.65747D0,
     * 80.6937408D0,   10730.5605D0,   40150.2227D0,   452448.813D0,
     1 3054768.25D0,   0.0D0,          0.144043684D0,  2.36591268D0,
     2 27.2262955D0,   197.456253D0,   895.054871D0,   219.574280D0,
     3 28690.0664D0,   2224832.25D0,   15599741.0D0,   32534522.0D0,
     4 0.0D0/
C * DATA FOR PO ELEMENT #84
      DATA ((XSC(84, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  34.2208443D0,   276.376190D0,   759.477966D0,
     3 1318.86035D0,   1725.66687D0,   0.0D0,          266.872803D0,
     4 2848.68750D0,   0.000000000D0,  0.000000000D0,  0.000000D0,
     5 6.32812405D0,   326.251343D0,   1775.42444D0,   4091.75171D0,
     6 6004.19678D0,   6452.10645D0,   160.466888D0,   3657.99561D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.86150336D0,
     8 233.861206D0,   2139.08374D0,   6817.99902D0,   11823.7256D0,
     9 13289.1875D0,   150.405594D0,   4705.51270D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.77159297D0,   386.573853D0,
     1 4250.64844D0,   14882.2520D0,   27186.2402D0,   30899.5527D0,
     2 59.7953682D0,   690.732544D0,   5598.08887D0,   0.000000000D0,
     3 0.000000000D0,  47.1483383D0,   1534.45020D0,   6301.30176D0,
     4 12359.1094D0,   16543.8066D0,   17596.0977D0,   35.0146523D0,
     5 670.142517D0,   7840.27539D0,   0.000000000D0,  0.000000000D0,
     6 32.4779968D0,   2068.58521D0,   10257.8301D0,   20659.0410D0,
     7 27085.3965D0,   32381.3809D0,   34.7690544D0,   905.965210D0,
     8 14199.0693D0,   0.000000000D0,  0.000000000D0,  51.9325256D0,
     9 4640.19531D0,   26946.0840D0,   61510.2773D0,   87957.9922D0,
     * 102043.648D0,   3.09930158D0,   214.751480D0,   9521.85254D0,
     1 227992.469D0,   0.000000000D0,  10.0361357D0,   3448.90625D0,
     2 40089.4727D0,   136316.672D0,   242563.859D0,   1774240.50D0,
     3 2.09772229D0,   214.449371D0,   11856.1709D0,   319487.094D0,
     4 0.000000000D0,  9.14648628D0,   4746.33545D0,   60081.2852D0,
     5 210904.781D0,   381529.750D0,   2765607.75D0,   15.6847782D0,
     6 183.452728D0,   1620.00366D0,   10283.4570D0,   40372.1289D0,
     7 0.207703725D0,  383.014008D0,   6601.27393D0,   22815.6367D0,
     8 35706.0430D0,   0.0D0,          8.82795811D0,   163.769943D0,
     9 1962.60010D0,   12855.3604D0,   32902.6055D0,   8.550313860D-02,
     * 556.334351D0,   10723.8887D0,   28273.1523D0,   33159.0313D0,
     1 0.0D0,          8.70744705D0,   218.372986D0,   3379.19727D0,
     2 29969.9551D0,   142041.094D0,   8.800361305D-02,1331.04065D0,
     3 33340.2109D0,   117201.172D0,   178629.156D0,   0.0D0,
     4 0.834614336D0,  52.3687592D0,   1930.88782D0,   33889.8672D0,
     5 198118.484D0,   1.086249482D-02,1641.40857D0,   77060.2422D0,
     6 216239.391D0,   163054.609D0,   0.0D0,          0.564270496D0,
     7 52.2017975D0,   2397.88818D0,   47040.0234D0,   306972.500D0,
     8 7.494420279D-03,2406.56445D0,   122601.320D0,   353810.344D0,
     9 272668.813D0,   0.0D0,          5.490167998D-03,1.59623230D0,
     * 233.664749D0,   15881.7715D0,   452387.063D0,   5.607036874D-03,
     1 11417.5176D0,   1004739.50D0,   1346146.38D0,   148290.984D0,
     2 0.0D0,          6.257853005D-03,1.87339306D0,   283.922241D0,
     3 19864.8320D0,   580929.250D0,   7.690316066D-03,16142.7695D0,
     4 1399407.63D0,   1789339.88D0,   204764.938D0,   0.0D0,
     5 3.59758449D0,   41.5541191D0,   370.383270D0,   2536.76440D0,
     6 13722.8467D0,   3.84612560D0,   2268.73438D0,   22722.3086D0,
     7 50754.1758D0,   55935.4102D0,   0.0D0,          1.84124422D0,
     8 33.3191872D0,   397.508850D0,   2802.79980D0,   11776.8926D0,
     9 4.65631342D0,   4009.55371D0,   22531.4258D0,   105178.719D0,
     * 468122.031D0,   0.0D0,          1.77056026D0,   43.1420021D0,
     1 658.957031D0,   6033.04395D0,   35510.2031D0,   10.3189754D0,
     2 13909.4502D0,   111363.953D0,   296456.781D0,   870142.250D0,
     3 0.0D0,          0.125401482D0,  7.42411327D0,   260.130432D0,
     4 4433.51367D0,   31102.9941D0,   60.4447212D0,   51791.1797D0,
     5 671768.875D0,   21656248.0D0,   2575326.00D0,   0.0D0,
     6 8.318448067D-02,7.24629307D0,   315.867188D0,   6001.97363D0,
     7 45624.3789D0,   68.0741501D0,   80080.9219D0,   830642.250D0,
     8 31194066.0D0,   4331104.50D0,   0.0D0,          0.542585373D0,
     9 5.90712309D0,   51.3193245D0,   356.646271D0,   2053.41846D0,
     * 68.6135941D0,   10094.2344D0,   41401.5625D0,   322850.406D0,
     1 2148358.25D0,   0.0D0,          0.191404030D0,  3.12850118D0,
     2 35.5647087D0,   253.442856D0,   1136.24341D0,   204.103409D0,
     3 22289.6895D0,   1829071.25D0,   15444491.0D0,   30499764.0D0,
     4 0.0D0,          7.235468179D-02,1.55668128D0,   22.3732834D0,
     5 205.542908D0,   1246.63428D0,   294.814789D0,   26750.7090D0,
     6 1685096.00D0,   14813727.0D0,   35154412.0D0,   0.0D0/
C * DATA FOR AT ELEMENT #85
      DATA ((XSC(85, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  33.4477615D0,   267.846222D0,   734.165283D0,
     3 1273.40491D0,   1664.62390D0,   0.0D0,          276.584686D0,
     4 2912.15015D0,   0.000000000D0,  0.000000000D0,  0.000000D0,
     5 6.14143181D0,   313.561523D0,   1706.15686D0,   3932.88013D0,
     6 5771.06641D0,   6200.07471D0,   172.179092D0,   3860.64307D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.83471894D0,
     8 227.642502D0,   2070.02710D0,   6580.41406D0,   11404.3096D0,
     9 12789.5000D0,   159.925751D0,   4949.45166D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.72084296D0,   373.738007D0,
     1 4108.19775D0,   14386.8389D0,   26292.6484D0,   29845.1484D0,
     2 62.1954842D0,   711.726196D0,   5696.37939D0,   0.000000000D0,
     3 0.000000000D0,  44.6913452D0,   1457.77856D0,   5995.04395D0,
     4 11764.0693D0,   15779.8418D0,   16738.8672D0,   37.5388908D0,
     5 705.635925D0,   8058.35693D0,   0.000000000D0,  0.000000000D0,
     6 31.1980515D0,   1973.77893D0,   9784.15430D0,   19706.2461D0,
     7 25816.8613D0,   30766.2188D0,   36.9701653D0,   951.975098D0,
     8 14722.2813D0,   0.000000000D0,  0.000000000D0,  49.1683540D0,
     9 4418.11230D0,   25790.3516D0,   59101.8438D0,   84776.0000D0,
     * 97927.7500D0,   3.39954376D0,   232.614685D0,   10169.7500D0,
     1 245534.641D0,   0.000000000D0,  9.42238808D0,   3247.65674D0,
     2 37907.1563D0,   129371.938D0,   231361.875D0,   1661647.88D0,
     3 2.29122949D0,   231.771805D0,   12651.3115D0,   335991.906D0,
     4 0.000000000D0,  8.46072960D0,   4449.70996D0,   56726.8945D0,
     5 200025.984D0,   362108.594D0,   2547308.75D0,   16.3888626D0,
     6 190.113007D0,   1664.51538D0,   10423.3281D0,   0.000000000D0,
     7 278.480927D0,   5473.95068D0,   17455.6113D0,   29099.9414D0,
     8 35251.8594D0,   36664.1602D0,   9.50923252D0,   173.291367D0,
     9 2035.13770D0,   12990.9355D0,   31972.6758D0,   8.351007849D-02,
     * 532.281250D0,   10250.1025D0,   27125.6035D0,   32082.8555D0,
     1 0.0D0,          9.30827808D0,   230.684082D0,   3526.37354D0,
     2 30878.0488D0,   144276.859D0,   8.129967004D-02,1240.09729D0,
     3 31601.5723D0,   112773.047D0,   173837.141D0,   0.0D0,
     4 0.923649311D0,  57.1134109D0,   2069.04883D0,   35504.5117D0,
     5 199755.578D0,   8.756686933D-03,1450.80774D0,   71079.7188D0,
     6 211478.125D0,   175526.531D0,   0.0D0,          0.621270359D0,
     7 56.6601410D0,   2550.72974D0,   48721.6914D0,   312525.250D0,
     8 8.164047264D-03,2526.78271D0,   124631.594D0,   362389.063D0,
     9 312908.813D0,   0.0D0,          6.374954246D-03,1.83107507D0,
     * 263.773804D0,   17566.8594D0,   485916.688D0,   3.499210579D-03,
     1 8310.03711D0,   839269.250D0,   1534910.00D0,   132977.016D0,
     2 0.0D0,          7.247803267D-03,2.14576125D0,   320.237701D0,
     3 21964.8242D0,   624340.000D0,   4.749699496D-03,11686.6729D0,
     4 1168259.88D0,   2054845.50D0,   183562.797D0,   0.0D0,
     5 3.83146310D0,   43.9284134D0,   388.764069D0,   2640.73657D0,
     6 14159.3047D0,   3.40237308D0,   2059.03638D0,   21035.6172D0,
     7 48738.1797D0,   55508.8516D0,   0.0D0,          2.03308749D0,
     8 36.1748352D0,   423.725555D0,   2930.54126D0,   12088.4502D0,
     9 3.97840047D0,   3629.36279D0,   21085.6875D0,   88093.5234D0,
     * 389902.156D0,   0.0D0,          1.94541907D0,   46.8733482D0,
     1 707.780518D0,   6413.43506D0,   37545.8477D0,   8.31841469D0,
     2 12550.8926D0,   105896.617D0,   270469.938D0,   729713.875D0,
     3 0.0D0,          0.147015348D0,  8.59739876D0,   296.193359D0,
     4 4941.33105D0,   33947.9648D0,   27.7018490D0,   44771.9414D0,
     5 226886.781D0,   12036526.0D0,   2545714.25D0,   0.0D0,
     6 9.744767100D-02,8.40332127D0,   360.461853D0,   6706.18555D0,
     7 50046.8281D0,   41.8762245D0,   74827.9375D0,   402869.313D0,
     8 22061360.0D0,   4196645.50D0,   0.0D0,          0.619182169D0,
     9 6.72205544D0,   58.1308899D0,   401.326813D0,   2302.45313D0,
     * 59.5306664D0,   9449.20703D0,   41729.8555D0,   253140.563D0,
     1 1605019.50D0,   0.0D0,          0.239918485D0,  3.89793944D0,
     2 43.7474556D0,   306.356781D0,   1357.96216D0,   184.359955D0,
     3 18016.6719D0,   1456158.25D0,   14650160.0D0,   28570330.0D0,
     4 0.0D0,          0.139622480D0,  3.00979710D0,   43.0439720D0,
     5 391.753876D0,   2370.47290D0,   433.118469D0,   39754.7734D0,
     6 2284654.75D0,   23007766.0D0,   52331796.0D0,   0.0D0/
C * DATA FOR RN ELEMENT #86
      DATA ((XSC(86, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  32.7082405D0,   259.658112D0,   709.805664D0,
     3 1230.23901D0,   1608.56274D0,   0.0D0,          286.324463D0,
     4 2972.90430D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 5.97114515D0,   301.749786D0,   1641.25891D0,   3782.34375D0,
     6 5549.04736D0,   5963.90527D0,   184.543777D0,   4069.38232D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.80936372D0,
     8 221.735947D0,   2004.33875D0,   6352.86719D0,   10987.8975D0,
     9 12345.5225D0,   169.612091D0,   5201.73242D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.67247784D0,   361.447510D0,
     1 3972.32251D0,   13912.0547D0,   25430.2305D0,   28817.8984D0,
     2 64.6178741D0,   732.538330D0,   5786.84521D0,   0.000000000D0,
     3 0.000000000D0,  42.5356560D0,   1389.38672D0,   5717.67676D0,
     4 11219.5264D0,   15059.6963D0,   15867.3984D0,   40.2067871D0,
     5 741.913757D0,   8263.90039D0,   0.000000000D0,  0.000000000D0,
     6 30.1537457D0,   1891.12329D0,   9358.37988D0,   18830.8457D0,
     7 24668.4512D0,   29424.4844D0,   39.2416992D0,   998.335022D0,
     8 15222.5459D0,   0.000000000D0,  0.000000000D0,  47.1776733D0,
     9 4247.63916D0,   24860.7090D0,   57111.8984D0,   81949.1953D0,
     * 94896.7188D0,   3.72480917D0,   251.646774D0,   10847.8906D0,
     1 0.000000000D0,  0.000000000D0,  8.86661434D0,   3063.10254D0,
     2 35888.8672D0,   122888.352D0,   219814.375D0,   1555675.25D0,
     3 2.49988890D0,   250.186829D0,   13483.7422D0,   359265.281D0,
     4 0.000000000D0,  7.84287739D0,   4177.10596D0,   53618.7813D0,
     5 189895.703D0,   344056.375D0,   2367022.25D0,   17.1224976D0,
     6 196.950211D0,   1709.77856D0,   10565.5049D0,   0.000000000D0,
     7 259.228363D0,   5127.47314D0,   16426.4648D0,   27496.5684D0,
     8 33383.9609D0,   34959.8516D0,   10.2345371D0,   183.232803D0,
     9 2109.27319D0,   13117.0352D0,   30837.2793D0,   7.991340756D-02,
     * 501.215485D0,   9699.64551D0,   25842.3770D0,   30759.2852D0,
     1 0.0D0,          9.93726158D0,   243.324570D0,   3672.85864D0,
     2 31733.0859D0,   146491.719D0,   7.789496332D-02,1185.83594D0,
     3 30462.9922D0,   109736.867D0,   170845.469D0,   0.0D0,
     4 1.02049899D0,   62.1883850D0,   2213.63403D0,   37139.5391D0,
     5 201148.625D0,   7.511870470D-03,1292.48083D0,   65799.7656D0,
     6 206196.516D0,   184906.563D0,   0.0D0,          0.684727073D0,
     7 61.7869377D0,   2747.36743D0,   51662.1875D0,   315463.781D0,
     8 5.322730169D-03,1855.35278D0,   104139.547D0,   337458.000D0,
     9 316493.656D0,   0.0D0,          7.387246937D-03,2.09458923D0,
     * 296.885498D0,   19372.9922D0,   520578.719D0,   2.185826190D-03,
     1 6192.96729D0,   704435.938D0,   1681183.25D0,   119902.750D0,
     2 0.0D0,          8.376910351D-03,2.45077538D0,   360.115967D0,
     3 24213.7227D0,   669276.000D0,   2.965008840D-03,8667.49023D0,
     4 979375.500D0,   2265214.75D0,   165190.688D0,   0.0D0,
     5 4.07389593D0,   46.3649178D0,   407.378784D0,   2744.46777D0,
     6 14580.5107D0,   3.03716993D0,   1877.47229D0,   19520.6914D0,
     7 46664.3086D0,   54876.0547D0,   0.0D0,          2.23659277D0,
     8 39.1639290D0,   450.547058D0,   3056.46533D0,   12372.6953D0,
     9 3.31904221D0,   3301.19556D0,   19788.6934D0,   75461.7031D0,
     * 327917.344D0,   0.0D0,          2.12870932D0,   50.7740746D0,
     1 758.425842D0,   6803.62549D0,   39616.2148D0,   6.97234297D0,
     2 11397.9805D0,   100879.609D0,   252484.063D0,   626281.563D0,
     3 0.0D0,          0.170608014D0,  9.86708832D0,   334.363861D0,
     4 5458.49316D0,   36754.0469D0,   18.7006512D0,   40889.3008D0,
     5 129308.539D0,   7570712.00D0,   2955377.25D0,   0.0D0,
     6 0.112919755D0,  9.65379810D0,   407.838867D0,   7431.88428D0,
     7 54478.7461D0,   27.1053352D0,   68483.8750D0,   222144.750D0,
     8 13698569.0D0,   4497876.00D0,   0.0D0,          0.697724998D0,
     9 7.55132723D0,   64.9880676D0,   445.701447D0,   2547.71094D0,
     * 52.4515724D0,   8863.20605D0,   41573.1172D0,   212389.359D0,
     1 1263301.25D0,   0.0D0,          0.290859699D0,  4.69220400D0,
     2 51.9614487D0,   357.583649D0,   1567.24304D0,   165.204025D0,
     3 15162.6973D0,   1169024.63D0,   13539781.0D0,   26944454.0D0,
     4 0.0D0,          0.230380446D0,  4.94895029D0,   70.2489929D0,
     5 633.438477D0,   3824.13770D0,   551.077393D0,   52582.9805D0,
     6 2657891.25D0,   30586460.0D0,   67924296.0D0,   0.0D0/
C * DATA FOR FR ELEMENT #87
      DATA ((XSC(87, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  31.9943752D0,   251.755920D0,   686.283630D0,
     3 1188.50024D0,   1554.37158D0,   0.0D0,          296.320923D0,
     4 3034.51367D0,   0.000000000D0,  0.000000000D0,  0.0000000D0,
     5 5.79519224D0,   289.814911D0,   1576.21301D0,   3633.44873D0,
     6 5330.49902D0,   5726.51416D0,   197.661118D0,   4284.53076D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.78469050D0,
     8 216.020752D0,   1940.70569D0,   6133.70020D0,   10599.9395D0,
     9 11879.2715D0,   179.735413D0,   5460.53027D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.62679160D0,   349.418213D0,
     1 3842.15430D0,   13457.3525D0,   24601.6191D0,   27843.0977D0,
     2 67.0797348D0,   753.291138D0,   5871.17725D0,   0.000000000D0,
     3 0.000000000D0,  40.2350731D0,   1324.10559D0,   5452.16016D0,
     4 10698.1826D0,   14343.7090D0,   15202.3613D0,   43.0241318D0,
     5 779.583435D0,   8468.98926D0,   0.000000000D0,  0.000000000D0,
     6 28.9278431D0,   1801.74500D0,   8913.31836D0,   17933.7539D0,
     7 23499.6621D0,   24924.9941D0,   41.6333008D0,   1046.61279D0,
     8 15742.6631D0,   0.000000000D0,  0.000000000D0,  44.9014091D0,
     9 4058.74146D0,   23851.6895D0,   54968.7344D0,   79106.7031D0,
     * 91997.1406D0,   4.07376003D0,   271.746887D0,   11546.2959D0,
     1 0.000000000D0,  0.000000000D0,  8.35686111D0,   2892.12280D0,
     2 33985.2539D0,   116673.094D0,   208211.438D0,   1432288.88D0,
     3 2.72257781D0,   269.586182D0,   14340.2451D0,   0.000000000D0,
     4 0.000000000D0,  7.28321743D0,   3925.10522D0,   50692.0859D0,
     5 180248.219D0,   327725.219D0,   2252029.25D0,   17.8633900D0,
     6 203.805420D0,   1753.93909D0,   10689.7549D0,   0.000000000D0,
     7 241.903488D0,   4810.63721D0,   15469.8379D0,   25993.2148D0,
     8 31721.2422D0,   33730.0469D0,   11.0042925D0,   193.559799D0,
     9 2184.04248D0,   13225.3623D0,   29552.2559D0,   7.072333992D-02,
     * 465.379456D0,   9094.54102D0,   24473.4766D0,   29370.9590D0,
     1 0.0D0,          10.6014233D0,   256.580383D0,   3827.44263D0,
     2 32666.8652D0,   148676.000D0,   7.096084207D-02,1090.48291D0,
     3 28607.0156D0,   104814.398D0,   165223.531D0,   0.0D0,
     4 1.12570786D0,   67.6019821D0,   2364.32104D0,   38783.3672D0,
     5 202300.578D0,   6.375303492D-03,1142.47266D0,   60534.2539D0,
     6 200025.719D0,   191195.453D0,   0.0D0,          0.753192127D0,
     7 67.1091461D0,   2937.00317D0,   54118.6641D0,   319030.969D0,
     8 4.454412032D-03,1579.79993D0,   94146.6641D0,   324777.156D0,
     9 324697.000D0,   0.0D0,          8.524795994D-03,2.38788056D0,
     * 333.179413D0,   21303.7090D0,   556148.375D0,   1.353483414D-03,
     1 4465.52393D0,   575197.938D0,   1800094.88D0,   109305.172D0,
     2 0.0D0,          9.641480632D-03,2.78954172D0,   403.793365D0,
     3 26616.8008D0,   715483.375D0,   1.830850029D-03,6212.43799D0,
     4 797995.813D0,   2448281.25D0,   148537.156D0,   0.0D0,
     5 4.31972933D0,   48.8407059D0,   426.179840D0,   2847.59814D0,
     6 14988.2461D0,   2.51213217D0,   1672.80847D0,   17778.0117D0,
     7 43958.2109D0,   55705.2422D0,   0.0D0,          2.45826054D0,
     8 42.3176231D0,   477.886230D0,   3179.37451D0,   12626.5820D0,
     9 2.73784781D0,   2921.13599D0,   18260.4551D0,   62075.5117D0,
     * 251623.844D0,   0.0D0,          2.32740712D0,   54.9004822D0,
     1 810.926147D0,   7203.26953D0,   41725.6406D0,   5.50116587D0,
     2 9947.12988D0,   93407.3750D0,   232022.438D0,   531928.188D0,
     3 0.0D0,          0.197200686D0,  11.2590389D0,   374.991882D0,
     4 5991.90234D0,   39557.9727D0,   10.7602911D0,   34290.2656D0,
     5 76739.4609D0,   3658158.75D0,   16185262.0D0,   0.0D0,
     6 0.130038559D0,  11.0167799D0,   458.344269D0,   8182.57959D0,
     7 58945.6406D0,   14.4817677D0,   57082.9531D0,   127450.063D0,
     8 6339316.50D0,   18006056.0D0,   0.0D0,          0.786665022D0,
     9 8.52335644D0,   73.1453400D0,   498.471558D0,   2841.08960D0,
     * 37.4133263D0,   7173.56934D0,   38451.9102D0,   127378.500D0,
     1 560245.438D0,   0.0D0,          0.361461133D0,  5.83639669D0,
     2 64.0223694D0,   433.053284D0,   1879.62244D0,   105.092667D0,
     3 9165.91406D0,   527249.125D0,   7122332.50D0,   30174114.0D0,
     4 0.0D0,          0.309049726D0,  6.73805857D0,   95.7926941D0,
     5 856.510742D0,   5166.65625D0,   348.738373D0,   41605.0625D0,
     6 1091980.00D0,   18438080.0D0,   72377288.0D0,   0.0D0/
C * DATA FOR RA ELEMENT #88
      DATA ((XSC(88, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  31.3100777D0,   244.163834D0,   663.638000D0,
     3 1147.81702D0,   1499.77893D0,   0.0D0,          306.343689D0,
     4 3094.58105D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 5.63081169D0,   278.546875D0,   1514.61377D0,   3491.29004D0,
     6 5121.86621D0,   5501.38721D0,   211.452972D0,   4504.41064D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.76240766D0,
     8 210.690384D0,   1880.81946D0,   5925.33057D0,   10221.9863D0,
     9 11428.7754D0,   190.220993D0,   5724.52295D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.58466554D0,   338.502838D0,
     1 3719.79443D0,   13024.5957D0,   23807.6230D0,   26958.5313D0,
     2 69.5919037D0,   773.902649D0,   5947.17578D0,   0.000000000D0,
     3 0.000000000D0,  38.3973579D0,   1264.32166D0,   5205.85107D0,
     4 10210.7266D0,   13711.1406D0,   14467.4326D0,   45.9796181D0,
     5 817.757690D0,   8657.50586D0,   0.000000000D0,  0.000000000D0,
     6 27.9548969D0,   1725.49060D0,   8520.21973D0,   17128.5000D0,
     7 22414.0684D0,   23930.1797D0,   44.1171417D0,   1096.23083D0,
     8 16268.6279D0,   0.000000000D0,  0.000000000D0,  42.7194214D0,
     9 3877.75952D0,   22881.2480D0,   52901.7656D0,   76370.5938D0,
     * 82590.9453D0,   4.44829750D0,   292.898895D0,   12257.7246D0,
     1 0.000000000D0,  0.000000000D0,  7.88969946D0,   2745.00854D0,
     2 32304.4824D0,   111103.805D0,   198679.281D0,   177188.359D0,
     3 2.96144414D0,   289.992767D0,   15213.8330D0,   0.000000000D0,
     4 0.000000000D0,  6.81387997D0,   3706.67676D0,   48087.6328D0,
     5 171447.391D0,   311220.844D0,   214832.594D0,   18.6201916D0,
     6 210.705627D0,   1796.98657D0,   10796.8408D0,   0.000000000D0,
     7 226.921906D0,   4529.73535D0,   14609.6328D0,   24648.9258D0,
     8 30129.2930D0,   32176.0742D0,   11.8345547D0,   204.558075D0,
     9 2264.33569D0,   13339.8730D0,   0.000000000D0,  305.868378D0,
     * 7298.83887D0,   19680.2715D0,   26306.8438D0,   27586.1445D0,
     1 29280.1055D0,   11.3144207D0,   270.821228D0,   3999.07324D0,
     2 33804.1758D0,   150625.859D0,   5.938782915D-02,935.522278D0,
     3 25656.2949D0,   96879.2031D0,   155201.500D0,   0.0D0,
     4 1.24038506D0,   73.3497391D0,   2518.40259D0,   40360.0078D0,
     5 203748.609D0,   5.654674955D-03,1039.39172D0,   56579.8047D0,
     6 194990.953D0,   198087.109D0,   0.0D0,          0.826027393D0,
     7 72.6433868D0,   3123.74219D0,   56255.6680D0,   323509.313D0,
     8 4.171425942D-03,1465.78882D0,   89226.8438D0,   319066.719D0,
     9 341851.063D0,   0.0D0,          9.832645766D-03,2.72480321D0,
     * 376.080597D0,   23819.7715D0,   611912.938D0,   5.584582686D-04,
     1 2402.48877D0,   393222.969D0,   1755934.00D0,   120076.273D0,
     2 0.0D0,          1.109748799D-02,3.18180394D0,   456.724854D0,
     3 29953.3633D0,   797488.875D0,   6.517783040D-04,2963.92896D0,
     4 509079.594D0,   2362534.00D0,   161796.984D0,   0.0D0,
     5 4.58083582D0,   51.4267845D0,   445.765533D0,   2958.88501D0,
     6 15452.5674D0,   1.90909231D0,   1359.26526D0,   15092.7217D0,
     7 39369.9531D0,   50218.1484D0,   0.0D0,          2.69415879D0,
     8 45.6471405D0,   506.502319D0,   3306.69385D0,   12853.5693D0,
     9 1.91933167D0,   2339.09937D0,   15853.7207D0,   47174.8281D0,
     * 179422.031D0,   0.0D0,          2.53644729D0,   59.2411537D0,
     1 866.091980D0,   7624.38721D0,   43971.8086D0,   3.86100101D0,
     2 8254.29102D0,   83413.5703D0,   208301.781D0,   416361.406D0,
     3 0.0D0,          0.226390973D0,  12.7725086D0,   418.153687D0,
     4 6537.43896D0,   42370.2734D0,   8.06064320D0,   31118.6367D0,
     5 70931.5938D0,   2077290.13D0,   27086270.0D0,   0.0D0,
     6 0.149072587D0,  12.5121536D0,   512.665894D0,   8971.58398D0,
     7 63542.8398D0,   7.59291506D0,   45706.7578D0,   114507.891D0,
     8 2777723.00D0,   44059340.0D0,   0.0D0,          0.886055529D0,
     9 9.58439827D0,   81.9342346D0,   555.459351D0,   3162.22949D0,
     * 17.5091190D0,   4264.07861D0,   28889.3945D0,   65586.4219D0,
     1 260055.984D0,   0.0D0,          0.436373144D0,  7.01217413D0,
     2 75.9711151D0,   505.077942D0,   2168.33765D0,   82.3294144D0,
     3 7616.53564D0,   335531.406D0,   4094729.75D0,   19157046.0D0,
     4 0.0D0,          0.385011405D0,  8.42786121D0,   119.413391D0,
     5 1059.34106D0,   6383.57666D0,   130.730331D0,   25809.3125D0,
     6 308458.000D0,   4742936.50D0,   31345792.0D0,   0.0D0/
C * DATA FOR AC ELEMENT #89
      DATA ((XSC(89, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  30.6567307D0,   236.888184D0,   641.889221D0,
     3 1109.16467D0,   1449.53955D0,   0.0D0,          316.477295D0,
     4 3151.50293D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 5.48200941D0,   267.833832D0,   1456.66809D0,   3357.55054D0,
     6 4923.81934D0,   5289.55908D0,   226.114304D0,   4733.34521D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.74003148D0,
     8 205.477539D0,   1822.59863D0,   5724.74121D0,   9864.77539D0,
     9 11008.3662D0,   201.240692D0,   6000.46094D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.54255128D0,   327.727875D0,
     1 3600.14429D0,   12607.2275D0,   23046.5723D0,   26069.3262D0,
     2 72.1379547D0,   794.610840D0,   6019.70459D0,   0.000000000D0,
     3 0.000000000D0,  36.5615044D0,   1205.20618D0,   4964.37451D0,
     4 9734.85059D0,   13080.2842D0,   13720.7324D0,   49.1042252D0,
     5 856.942261D0,   8836.01172D0,   0.000000000D0,  0.000000000D0,
     6 26.8872776D0,   1653.85034D0,   8148.21484D0,   16358.6445D0,
     7 21413.0723D0,   22850.3496D0,   46.6983032D0,   1146.28943D0,
     8 16771.6113D0,   0.000000000D0,  0.000000000D0,  41.1373940D0,
     9 3736.69727D0,   22090.2813D0,   51169.0547D0,   74077.4141D0,
     * 79779.8984D0,   4.85433435D0,   315.624695D0,   13025.1230D0,
     1 0.000000000D0,  0.000000000D0,  7.43538141D0,   2592.81348D0,
     2 30611.1035D0,   105576.883D0,   188526.906D0,   195328.656D0,
     3 3.21741652D0,   311.810425D0,   16155.4209D0,   0.000000000D0,
     4 0.000000000D0,  6.32328796D0,   3482.07495D0,   45468.3867D0,
     5 162752.125D0,   295087.625D0,   338237.219D0,   19.3954716D0,
     6 217.705322D0,   1840.07129D0,   10899.5684D0,   0.000000000D0,
     7 211.895935D0,   4251.27832D0,   13759.5889D0,   23288.9883D0,
     8 28643.2637D0,   29793.3809D0,   12.6863012D0,   215.212051D0,
     9 2330.64307D0,   13359.8379D0,   0.000000000D0,  305.483002D0,
     * 7156.78564D0,   19147.0156D0,   25651.1367D0,   27066.9844D0,
     1 29640.3281D0,   12.0329638D0,   284.424713D0,   4142.14111D0,
     2 34493.0586D0,   152798.938D0,   6.149294972D-02,947.457397D0,
     3 25668.2832D0,   96631.8672D0,   155586.656D0,   0.0D0,
     4 1.36413980D0,   79.5076447D0,   2682.74268D0,   42052.0000D0,
     5 204243.516D0,   4.857109394D-03,925.638916D0,   52211.9570D0,
     6 188149.891D0,   202629.750D0,   0.0D0,          0.904943466D0,
     7 78.5924606D0,   3324.62476D0,   58619.4414D0,   326985.094D0,
     8 3.750892123D-03,1309.66064D0,   82803.7422D0,   309026.563D0,
     9 346923.031D0,   0.0D0,          1.126796473D-02,3.07849669D0,
     * 416.329987D0,   25565.6836D0,   630210.063D0,   5.881576217D-04,
     1 2465.20459D0,   390488.156D0,   1801447.88D0,   137987.719D0,
     2 0.0D0,          1.267871819D-02,3.58470702D0,   503.618317D0,
     3 31913.9668D0,   811952.313D0,   7.991899038D-04,3393.05811D0,
     4 539408.875D0,   2470865.00D0,   183959.109D0,   0.0D0,
     5 4.84823561D0,   54.0132103D0,   464.316376D0,   3051.76855D0,
     6 15752.6426D0,   1.90675843D0,   1345.01050D0,   14846.0020D0,
     7 39057.2734D0,   50900.0313D0,   0.0D0,          2.94850135D0,
     8 49.0861168D0,   534.170288D0,   3416.86621D0,   13048.9395D0,
     9 1.87780750D0,   2321.24805D0,   15658.3936D0,   45475.8203D0,
     * 160936.078D0,   0.0D0,          2.76166415D0,   63.7891426D0,
     1 922.139343D0,   8038.06787D0,   46089.5313D0,   3.45410872D0,
     2 7736.16016D0,   80580.0547D0,   203540.281D0,   375716.531D0,
     3 0.0D0,          0.259258419D0,  14.4386101D0,   464.838562D0,
     4 7122.88965D0,   45260.4453D0,   4.38500404D0,   24185.0078D0,
     5 72250.2734D0,   1012145.50D0,   6806866.00D0,   0.0D0,
     6 0.170383453D0,  14.1434507D0,   570.172852D0,   9780.20020D0,
     7 68143.4922D0,   5.16854811D0,   39766.3242D0,   124322.398D0,
     8 1605791.13D0,   11435348.0D0,   0.0D0,          0.987139583D0,
     9 10.6504345D0,   90.5672455D0,   609.544067D0,   3449.40454D0,
     * 22.4649811D0,   5156.58691D0,   33851.1367D0,   80294.3672D0,
     1 275116.500D0,   0.0D0,          0.515477836D0,  8.19324684D0,
     2 87.4149399D0,   571.221741D0,   2425.96313D0,   52.8046532D0,
     3 5783.98682D0,   182337.078D0,   2409595.00D0,   9638924.00D0,
     4 0.0D0,          0.456029475D0,  9.97208118D0,   140.421387D0,
     5 1234.91040D0,   7425.07813D0,   161.046219D0,   30990.6211D0,
     6 365109.531D0,   4785396.00D0,   23329580.0D0,   0.0D0/
C * DATA FOR TH ELEMENT #90
      DATA ((XSC(90, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D0,  0.000000000D0,  0.000000000D0,  0.000000000D0,
     2 0.000000000D0,  30.0256462D0,   229.867676D0,   620.880432D0,
     3 1071.32349D0,   1398.48145D0,   0.0D0,          326.748230D0,
     4 3206.74072D0,   0.000000000D0,  0.000000000D0,  0.000000000D0,
     5 5.32942200D0,   257.386353D0,   1399.47424D0,   3225.70532D0,
     6 4730.33398D0,   5081.20703D0,   241.548141D0,   4967.70508D0,
     7 0.000000000D0,  0.000000000D0,  0.000000000D0,  1.71924424D0,
     8 200.574661D0,   1767.55457D0,   5533.49854D0,   9516.22852D0,
     9 10637.3252D0,   212.661148D0,   6283.76123D0,   0.000000000D0,
     * 0.000000000D0,  0.000000000D0,  1.50324297D0,   317.605621D0,
     1 3487.47925D0,   12211.0791D0,   22325.4277D0,   25228.9023D0,
     2 74.7322159D0,   815.165771D0,   6084.66406D0,   0.000000000D0,
     3 0.000000000D0,  34.9095573D0,   1150.94543D0,   4740.57813D0,
     4 9292.06641D0,   12494.0732D0,   13091.6123D0,   52.3884277D0,
     5 897.195007D0,   9006.37988D0,   0.000000000D0,  0.000000000D0,
     6 25.9803047D0,   1583.89282D0,   7787.53174D0,   15613.9453D0,
     7 20437.0313D0,   21649.1680D0,   49.4018021D0,   1199.05383D0,
     8 17318.6953D0,   0.000000000D0,  0.000000000D0,  39.1069260D0,
     9 3568.88379D0,   21193.1660D0,   49261.0703D0,   71324.6953D0,
     * 77848.9531D0,   5.28865862D0,   339.583618D0,   13815.9453D0,
     1 0.000000000D0,  0.000000000D0,  7.04424381D0,   2459.69165D0,
     2 29104.2305D0,   100584.469D0,   179252.141D0,   217435.875D0,
     3 3.49079299D0,   334.796844D0,   17127.3691D0,   0.000000000D0,
     4 0.000000000D0,  5.86712837D0,   3284.89453D0,   43138.0977D0,
     5 154989.938D0,   281640.000D0,   284612.781D0,   20.1967239D0,
     6 224.785431D0,   1882.17468D0,   10988.6104D0,   0.000000000D0,
     7 198.749786D0,   4002.68408D0,   12988.8184D0,   22050.8066D0,
     8 27266.7383D0,   27966.6270D0,   13.6110401D0,   227.000778D0,
     9 2411.93018D0,   13423.7900D0,   0.000000000D0,  267.613220D0,
     * 6459.70215D0,   17602.8730D0,   23771.4902D0,   25100.8711D0,
     1 26530.9922D0,   12.8120422D0,   299.762665D0,   4325.41553D0,
     2 35709.0195D0,   154997.109D0,   5.151344091D-02,808.669556D0,
     3 22940.1172D0,   89038.2969D0,   145699.672D0,   0.0D0,
     4 1.49804378D0,   86.0589066D0,   2854.00293D0,   43763.1836D0,
     5 204403.484D0,   4.222495947D-03,831.180847D0,   48406.6719D0,
     6 181424.375D0,   203290.922D0,   0.0D0,          0.990160763D0,
     7 84.9544144D0,   3537.86011D0,   61136.7109D0,   329522.906D0,
     8 3.322858829D-03,1151.62366D0,   76118.0234D0,   296861.813D0,
     9 351032.781D0,   0.0D0,          1.291557774D-02,3.48761749D0,
     * 465.507446D0,   28162.8242D0,   678548.563D0,   3.316395741D-04,
     1 1685.94482D0,   305010.875D0,   1679498.13D0,   175044.375D0,
     2 0.0D0,          1.449720468D-02,4.05466318D0,   562.677917D0,
     3 35155.6523D0,   875816.438D0,   4.542820679D-04,2291.95605D0,
     4 418691.313D0,   2306520.25D0,   230358.953D0,   0.0D0,
     5 5.12543678D0,   56.6921768D0,   483.870819D0,   3157.56494D0,
     6 16144.9473D0,   1.59335065D0,   1164.63464D0,   13204.5693D0,
     7 35900.0742D0,   47829.9609D0,   0.0D0,          3.22147226D0,
     8 52.7174034D0,   563.078918D0,   3531.89648D0,   13205.3047D0,
     9 1.54382432D0,   2036.42456D0,   14326.3066D0,   39397.5703D0,
     * 133587.547D0,   0.0D0,          3.00122476D0,   68.5812454D0,
     1 981.033936D0,   8479.29980D0,   48400.3281D0,   2.72940397D0,
     2 6723.08105D0,   73879.2813D0,   190433.984D0,   334627.750D0,
     3 0.0D0,          0.295375645D0,  16.2332058D0,   513.687317D0,
     4 7711.88379D0,   48096.0586D0,   3.09335065D0,   21043.4316D0,
     5 77838.1016D0,   631898.438D0,   3774984.25D0,   0.0D0,
     6 0.193716198D0,  15.9032726D0,   630.955017D0,   10614.9180D0,
     7 72772.0156D0,   3.41730022D0,   34181.8906D0,   135000.875D0,
     8 965734.438D0,   5904875.00D0,   0.0D0,          1.09475064D0,
     9 11.7419624D0,   99.2631836D0,   664.996521D0,   3763.64331D0,
     * 11.4499903D0,   3186.35620D0,   24798.3672D0,   56315.5508D0,
     1 174274.469D0,   0.0D0,          0.599823773D0,  9.40906620D0,
     2 98.8109894D0,   635.234314D0,   2668.69360D0,   14.2233953D0,
     3 2937.01074D0,   40275.5586D0,   688249.250D0,   3604660.25D0,
     4 0.0D0,          0.530631721D0,  11.5330715D0,   161.249908D0,
     5 1410.66431D0,   8507.92773D0,   25.3249302D0,   11615.5664D0,
     6 91773.8047D0,   862096.063D0,   6226572.00D0,   0.0D0/
C * DATA FOR PA ELEMENT #91
      DATA ((XSC(91, I, J), J = 1, 11), I = 1, 24)/
     1 0.00000D+00,    0.00000D+00,    0.00000D+00,    0.00000D+00,
     2 0.00000D+00,    29.4217930D0,   223.136414D0,   600.697205D0,
     3 1035.42517D0,   1351.72815D0,   0.0D0,          337.117065D0,
     4 3259.90503D0,   0.00000D+00,    0.00000D+00,    0.00000D+00,
     5 5.19536877D0,   247.796692D0,   1346.48499D0,   3103.39087D0,
     6 4549.07129D0,   4889.17822D0,   257.905670D0,   5207.93652D0,
     7 0.00000D+00,    0.00000D+00,    0.00000D+00,    1.70157337D0,
     8 195.931076D0,   1716.45898D0,   5356.15381D0,   9198.30371D0,
     9 10276.5957D0,   224.646347D0,   6579.08398D0,   0.00000D+00,
     * 0.00000D+00,    0.00000D+00,    1.46701753D0,   308.214417D0,
     1 3383.15088D0,   11847.1455D0,   21659.8418D0,   24503.1035D0,
     2 77.3622284D0,   835.906982D0,   6148.06592D0,   0.00000D+00,
     3 0.00000D+00,    33.3525963D0,   1100.01904D0,   4531.10254D0,
     4 8875.43359D0,   11910.4385D0,   12559.3232D0,   55.8595657D0,
     5 938.530823D0,   9165.85547D0,   0.00000D+00,    0.00000D+00,
     6 25.2570820D0,   1523.98364D0,   7469.33203D0,   14942.1523D0,
     7 19542.1445D0,   20611.7461D0,   52.2285728D0,   1253.22778D0,
     8 17866.4277D0,   0.00000D+00,    0.00000D+00,    37.5625000D0,
     9 3435.58594D0,   20462.5117D0,   47677.2148D0,   69167.0703D0,
     * 75423.3516D0,   5.75961304D0,   365.341827D0,   14668.9941D0,
     1 0.00000D+00,    0.00000D+00,    6.70611525D0,   2344.94092D0,
     2 27821.2520D0,   96390.9688D0,   172092.281D0,   199769.953D0,
     3 3.78538799D0,   359.353912D0,   18164.5430D0,   0.00000D+00,
     4 0.00000D+00,    5.52108574D0,   3122.32910D0,   41225.8398D0,
     5 148619.266D0,   270616.875D0,   243039.594D0,   21.0021286D0,
     6 231.888794D0,   1923.84741D0,   11069.9834D0,   0.00000D+00,
     7 187.909515D0,   3793.61597D0,   12330.0967D0,   20968.8438D0,
     8 25971.4316D0,   26566.6719D0,   14.5760651D0,   238.804214D0,
     9 2485.84570D0,   13426.3496D0,   0.00000D+00,    251.954651D0,
     * 6102.91895D0,   16669.2676D0,   22509.7363D0,   23724.2344D0,
     1 26403.6543D0,   13.6208639D0,   315.044312D0,   4494.86768D0,
     2 36691.5938D0,   0.00000D+00,    555.756836D0,   18990.5801D0,
     3 68248.2109D0,   119065.188D0,   148118.625D0,   170989.891D0,
     4 1.64230478D0,   92.9962540D0,   3031.00464D0,   45459.7344D0,
     5 204356.516D0,   3.935094923D-03,784.074402D0,   46293.3555D0,
     6 177025.781D0,   205539.109D0,   0.0D0,          1.08176517D0,
     7 91.7048569D0,   3760.60034D0,   63706.4531D0,   331339.969D0,
     8 3.110173624D-03,1058.86145D0,   71959.8672D0,   288208.750D0,
     9 349291.844D0,   0.0D0,          1.475244574D-02,3.93603730D0,
     * 518.092651D0,   30809.9121D0,   723687.375D0,   2.541629074D-04,
     1 1390.44495D0,   268268.000D0,   1602622.00D0,   154225.938D0,
     2 0.0D0,          1.651385054D-02,4.56706667D0,   625.223999D0,
     3 38389.2852D0,   933006.688D0,   3.638048947D-04,1922.26392D0,
     4 372285.031D0,   2212278.25D0,   202474.141D0,   0.0D0,
     5 5.39867878D0,   59.2882462D0,   502.305939D0,   3254.17920D0,
     6 16468.6211D0,   1.38925898D0,   1076.47644D0,   12352.8877D0,
     7 33862.8359D0,   45490.0625D0,   0.0D0,          3.50052953D0,
     8 56.2884750D0,   589.689575D0,   3624.10645D0,   13284.4854D0,
     9 1.60460746D0,   2043.36145D0,   14154.6670D0,   39618.5391D0,
     * 134922.734D0,   0.0D0,          3.23309350D0,   73.0762100D0,
     1 1033.85815D0,   8852.53125D0,   50242.8086D0,   2.88203740D0,
     2 6937.99805D0,   75841.0234D0,   194803.375D0,   341959.656D0,
     3 0.0D0,          0.330870241D0,  17.9033680D0,   556.262878D0,
     4 8182.76172D0,   50086.0859D0,   3.14749432D0,   21223.2441D0,
     5 79335.6953D0,   639017.000D0,   3930551.75D0,   0.0D0,
     6 0.215997905D0,  17.4952431D0,   682.322693D0,   11258.5234D0,
     7 75960.1172D0,   3.56514740D0,   35011.4727D0,   137911.125D0,
     8 1001618.38D0,   6357603.00D0,   0.0D0,          1.13140631D0,
     9 12.0350523D0,   100.865013D0,   670.138062D0,   3754.40869D0,
     * 20.0664749D0,   4731.21875D0,   31794.8516D0,   81577.9766D0,
     1 277154.563D0,   0.0D0,          0.630836248D0,  9.71265221D0,
     2 99.9530487D0,   630.238342D0,   2609.59546D0,   47.1750145D0,
     3 5376.10059D0,   160318.656D0,   2133790.75D0,   8486705.00D0,
     4 0.0D0,          0.545299411D0,  11.6766758D0,   161.000015D0,
     5 1393.05579D0,   8330.90820D0,   148.432877D0,   30669.6621D0,
     6 333496.375D0,   4265278.50D0,   21050740.0D0,   0.0D0/
C * DATA FOR U  ELEMENT #92
      DATA ((XSC(92, I, J), J = 1, 11), I = 1, 24)/
     1 0.000000000D+00,0.000000000D+00,0.00000000D+00, 0.00000000D+00,
     2 0.000000000D+00,28.8420296D0,   216.662613D0,   581.247925D0,
     3 1000.75500D0,   1306.55957D0,   0.0D0,          347.511749D0,
     4 3312.69507D0,   0.000000000D+00,0.0000000D+00,  0.0000000D+00,
     5 5.04670286D0,   238.440948D0,   1294.83960D0,   2983.78101D0,
     6 4374.05371D0,   4702.30908D0,   275.066284D0,   5450.26367D0,
     7 0.0000000D+00,  0.000000D+00,   0.0000000D+00,  1.68461120D0,
     8 191.638474D0,   1667.37158D0,   5184.47363D0,   8887.00000D0,
     9 9914.98242D0,   237.038956D0,   6878.43262D0,   0.000000000D+00,
     * 0.000000000D+00,0.000000000D+00,1.43383610D0,   299.443634D0,
     1 3284.61499D0,   11500.2021D0,   21017.8418D0,   23796.3301D0,
     2 80.0252914D0,   856.124634D0,   6198.50488D0,   0.000000000D+00,
     3 0.000000000D+00,31.9933510D0,   1054.08093D0,   4338.32813D0,
     4 8489.07422D0,   11394.7461D0,   11993.1641D0,   59.4962463D0,
     5 980.760010D0,   9314.13086D0,   0.0000000D+00,  0.0000000D+00,
     6 24.4866905D0,   1463.05823D0,   7151.39600D0,   14279.6621D0,
     7 18608.2363D0,   19801.8965D0,   55.1471939D0,   1308.34705D0,
     8 18408.3984D0,   0.0000000D+00,  0.0000000D+00,  36.0961418D0,
     9 3308.43286D0,   19758.1250D0,   46138.4844D0,   67105.4063D0,
     * 72027.0781D0,   6.25987339D0,   392.130035D0,   15519.8467D0,
     1 0.0000000D+00,  0.0000000D+00,  6.42884302D0,   2246.63086D0,
     2 26677.9121D0,   92562.4453D0,   165677.625D0,   161128.875D0,
     3 4.09870529D0,   385.030487D0,   19217.2520D0,   0.0000000D+00,
     4 0.0000000D+00,  5.21098137D0,   2972.62866D0,   39420.1914D0,
     5 142481.063D0,   259586.344D0,   218465.656D0,   21.8197193D0,
     6 238.938248D0,   1962.87341D0,   11122.5977D0,   0.000000000D+00,
     7 179.128845D0,   3616.70117D0,   11754.8545D0,   20010.6035D0,
     8 24775.6016D0,   25608.8555D0,   15.5962124D0,   250.807953D0,
     9 2555.26270D0,   13389.1104D0,   0.000000000D+00,241.629105D0,
     * 5830.25635D0,   15898.3486D0,   21466.6270D0,   22644.9102D0,
     1 25456.2285D0,   14.4561348D0,   330.642548D0,   4663.99316D0,
     2 37632.7266D0,   0.000000000D+00,529.207092D0,   18250.4551D0,
     3 66057.5000D0,   115953.281D0,   145725.063D0,   141866.953D0,
     4 1.79938984D0,   100.411514D0,   3217.19214D0,   47229.0898D0,
     5 203494.406D0,   3.538780846D-03,720.358765D0,   43531.6289D0,
     6 171140.234D0,   204807.703D0,   0.0D0,          1.18061268D0,
     7 98.8114548D0,   3986.34106D0,   66153.5703D0,   333877.531D0,
     8 2.970987931D-03,987.693970D0,   68520.5469D0,   280925.094D0,
     9 351001.250D0,   0.0D0,          1.679878868D-02,4.42458105D0,
     * 573.094788D0,   33343.6875D0,   759708.875D0,   2.203819167D-04,
     1 1242.74731D0,   246723.141D0,   1552035.75D0,   155875.063D0,
     2 0.0D0,          1.875866763D-02,5.12651873D0,   691.397156D0,
     3 41594.4375D0,   982996.938D0,   3.104589123D-04,1681.13770D0,
     4 338206.375D0,   2135759.75D0,   203558.438D0,   0.0D0,
     5 5.68614292D0,   61.9411621D0,   520.420532D0,   3343.23804D0,
     6 16722.4473D0,   1.32321870D0,   1028.75464D0,   11836.4854D0,
     7 32616.0156D0,   44416.0352D0,   0.0D0,          3.80143571D0,
     8 60.0876083D0,   617.836304D0,   3722.43945D0,   13322.1113D0,
     9 1.32734489D0,   1789.09875D0,   12876.5469D0,   34906.4883D0,
     * 119073.344D0,   0.0D0,          3.48343849D0,   77.9058609D0,
     1 1090.78564D0,   9263.05469D0,   52299.1992D0,   2.57604432D0,
     2 6471.06104D0,   72662.7734D0,   188445.047D0,   325467.781D0,
     3 0.0D0,          0.370925695D0,  19.7877483D0,   604.217896D0,
     4 8715.60840D0,   52328.7227D0,   2.62085009D0,   19450.3066D0,
     5 81746.0547D0,   509536.844D0,   3205391.00D0,   0.00D0,
     6 0.241213620D0,  19.3023205D0,   740.695251D0,   11996.0439D0,
     7 79631.9766D0,   2.94554043D0,   32409.4219D0,   142580.594D0,
     8 805837.188D0,   5159188.50D0,   0.0D0,          1.19681120D0,
     9 12.6579933D0,   105.484665D0,   698.402161D0,   3911.92090D0,
     * 8.77220631D0,   2555.12280D0,   20492.0859D0,   50161.6914D0,
     1 174645.375D0,   0.0D0,          0.688192070D0,  10.4296017D0,
     2 105.452431D0,   653.458801D0,   2669.10205D0,   21.7011681D0,
     3 3465.78979D0,   66133.5859D0,   1070067.00D0,   5223840.00D0,
     4 0.0D0,          0.585494578D0,  12.4282341D0,   169.844070D0,
     5 1460.21033D0,   8725.37793D0,   54.2631149D0,   17623.1504D0,
     6 145704.859D0,   1739226.38D0,   11441855.0D0,   0.0D0/
C * DATA FOR ELEMENT H
      DATA DRAY( 1, 1)/-0.119080000D0  /,DCMP( 1, 1)/ -2.15770006D0  /
      DATA DRAY( 1, 2)/-0.937089980D0  /,DCMP( 1, 2)/  1.32690001D0  /
      DATA DRAY( 1, 3)/-0.200540006D0  /,DCMP( 1, 3)/-0.305620015D0  /
      DATA DRAY( 1, 4)/ 1.065899990D-02/,DCMP( 1, 4)/ 1.850200072D-02/
C * DATA FOR ELEMENT HE
      DATA DRAY( 2, 1)/  1.04770005D0  /,DCMP( 2, 1)/ -2.56360006D0  /
      DATA DRAY( 2, 2)/-8.517999947D-02/,DCMP( 2, 2)/  2.02539992D0  /
      DATA DRAY( 2, 3)/-0.403530002D0  /,DCMP( 2, 3)/-0.448709995D0  /
      DATA DRAY( 2, 4)/ 2.693999931D-02/,DCMP( 2, 4)/ 2.796900086D-02/
C * DATA FOR ELEMENT LI
      DATA DRAY( 3, 1)/  1.34370005D0  /,DCMP( 3, 1)/ -1.08739996D0  /
      DATA DRAY( 3, 2)/ 0.181559995D0  /,DCMP( 3, 2)/  1.03369999D0  /
      DATA DRAY( 3, 3)/-0.423979998D0  /,DCMP( 3, 3)/-0.190380007D0  /
      DATA DRAY( 3, 4)/ 2.661900036D-02/,DCMP( 3, 4)/ 7.799500134D-03/
C * DATA FOR ELEMENT BE
      DATA DRAY( 4, 1)/  2.00860000D0  /,DCMP( 4, 1)/-0.690079987D0  /
      DATA DRAY( 4, 2)/-4.619200155D-02/,DCMP( 4, 2)/ 0.946449995D0  /
      DATA DRAY( 4, 3)/-0.337020010D0  /,DCMP( 4, 3)/-0.171140000D0  /
      DATA DRAY( 4, 4)/ 1.869400032D-02/,DCMP( 4, 4)/ 6.514099892D-03/
C * DATA FOR ELEMENT B
      DATA DRAY( 5, 1)/  2.61859989D0  /,DCMP( 5, 1)/-0.791180015D0  /
      DATA DRAY( 5, 2)/-0.207920000D0  /,DCMP( 5, 2)/  1.21609998D0  /
      DATA DRAY( 5, 3)/-0.286280006D0  /,DCMP( 5, 3)/-0.239089996D0  /
      DATA DRAY( 5, 4)/ 1.449699979D-02/,DCMP( 5, 4)/ 1.176900044D-02/
C * DATA FOR ELEMENT C
      DATA DRAY( 6, 1)/  3.10859990D0  /,DCMP( 6, 1)/-0.982879996D0  /
      DATA DRAY( 6, 2)/-0.260580003D0  /,DCMP( 6, 2)/  1.46689999D0  /
      DATA DRAY( 6, 3)/-0.271970004D0  /,DCMP( 6, 3)/-0.293740004D0  /
      DATA DRAY( 6, 4)/ 1.351800002D-02/,DCMP( 6, 4)/ 1.559999958D-02/
C * DATA FOR ELEMENT N
      DATA DRAY( 7, 1)/  3.47760010D0  /,DCMP( 7, 1)/ -1.23689997D0  /
      DATA DRAY( 7, 2)/-0.215759993D0  /,DCMP( 7, 2)/  1.74510002D0  /
      DATA DRAY( 7, 3)/-0.288870007D0  /,DCMP( 7, 3)/-0.354660004D0  /
      DATA DRAY( 7, 4)/ 1.513100043D-02/,DCMP( 7, 4)/ 1.986999996D-02/
C * DATA FOR ELEMENT O
      DATA DRAY( 8, 1)/  3.77239990D0  /,DCMP( 8, 1)/ -1.73679996D0  /
      DATA DRAY( 8, 2)/-0.148540005D0  /,DCMP( 8, 2)/  2.17689991D0  /
      DATA DRAY( 8, 3)/-0.307119995D0  /,DCMP( 8, 3)/-0.449050009D0  /
      DATA DRAY( 8, 4)/ 1.672999933D-02/,DCMP( 8, 4)/ 2.647300065D-02/
C * DATA FOR ELEMENT F
      DATA DRAY( 9, 1)/  4.00719976D0  /,DCMP( 9, 1)/ -1.87570000D0  /
      DATA DRAY( 9, 2)/-5.609099939D-02/,DCMP( 9, 2)/  2.32019997D0  /
      DATA DRAY( 9, 3)/-0.332020015D0  /,DCMP( 9, 3)/-0.475410014D0  /
      DATA DRAY( 9, 4)/ 1.879299991D-02/,DCMP( 9, 4)/ 2.806800045D-02/
C * DATA FOR ELEMENT NE
      DATA DRAY(10, 1)/  4.20149994D0  /,DCMP(10, 1)/ -1.75510001D0  /
      DATA DRAY(10, 2)/ 4.162500054D-02/,DCMP(10, 2)/  2.24230003D0  /
      DATA DRAY(10, 3)/-0.356750011D0  /,DCMP(10, 3)/-0.447640002D0  /
      DATA DRAY(10, 4)/ 2.075899951D-02/,DCMP(10, 4)/ 2.558000013D-02/
C * DATA FOR ELEMENT NA
      DATA DRAY(11, 1)/  4.26370001D0  /,DCMP(11, 1)/-0.967719972D0  /
      DATA DRAY(11, 2)/ 0.134660006D0  /,DCMP(11, 2)/  1.61790001D0  /
      DATA DRAY(11, 3)/-0.370079994D0  /,DCMP(11, 3)/-0.287189990D0  /
      DATA DRAY(11, 4)/ 2.144699916D-02/,DCMP(11, 4)/ 1.315299980D-02/
C * DATA FOR ELEMENT MG
      DATA DRAY(12, 1)/  4.39400005D0  /,DCMP(12, 1)/-0.571609974D0  /
      DATA DRAY(12, 2)/ 0.137860000D0  /,DCMP(12, 2)/  1.35500002D0  /
      DATA DRAY(12, 3)/-0.359539986D0  /,DCMP(12, 3)/-0.224910006D0  /
      DATA DRAY(12, 4)/ 2.023800090D-02/,DCMP(12, 4)/ 8.301399648D-03/
C * DATA FOR ELEMENT AL
      DATA DRAY(13, 1)/  4.51989985D0  /,DCMP(13, 1)/-0.439319998D0  /
      DATA DRAY(13, 2)/ 0.140550002D0  /,DCMP(13, 2)/  1.30869997D0  /
      DATA DRAY(13, 3)/-0.352440000D0  /,DCMP(13, 3)/-0.211649999D0  /
      DATA DRAY(13, 4)/ 1.936900057D-02/,DCMP(13, 4)/ 7.542099804D-03/
C * DATA FOR ELEMENT SI
      DATA DRAY(14, 1)/  4.64680004D0  /,DCMP(14, 1)/-0.414970011D0  /
      DATA DRAY(14, 2)/ 0.162780002D0  /,DCMP(14, 2)/  1.34870005D0  /
      DATA DRAY(14, 3)/-0.358559996D0  /,DCMP(14, 3)/-0.222310007D0  /
      DATA DRAY(14, 4)/ 1.969300024D-02/,DCMP(14, 4)/ 8.419600315D-03/
C * DATA FOR ELEMENT P
      DATA DRAY(15, 1)/  4.78529978D0  /,DCMP(15, 1)/-0.476900011D0  /
      DATA DRAY(15, 2)/ 0.168709993D0  /,DCMP(15, 2)/  1.46029997D0  /
      DATA DRAY(15, 3)/-0.360379994D0  /,DCMP(15, 3)/-0.251329988D0  /
      DATA DRAY(15, 4)/ 1.971499994D-02/,DCMP(15, 4)/ 1.071999967D-02/
C * DATA FOR ELEMENT S
      DATA DRAY(16, 1)/  4.92710018D0  /,DCMP(16, 1)/-0.656419992D0  /
      DATA DRAY(16, 2)/ 0.165749997D0  /,DCMP(16, 2)/  1.65409994D0  /
      DATA DRAY(16, 3)/-0.359420002D0  /,DCMP(16, 3)/-0.298619986D0  /
      DATA DRAY(16, 4)/ 1.955099963D-02/,DCMP(16, 4)/ 1.429800037D-02/
C * DATA FOR ELEMENT CL
      DATA DRAY(17, 1)/  5.07219982D0  /,DCMP(17, 1)/-0.718630016D0  /
      DATA DRAY(17, 2)/ 0.149130002D0  /,DCMP(17, 2)/  1.74290001D0  /
      DATA DRAY(17, 3)/-0.352860004D0  /,DCMP(17, 3)/-0.319429994D0  /
      DATA DRAY(17, 4)/ 1.894400083D-02/,DCMP(17, 4)/ 1.584300026D-02/
C * DATA FOR ELEMENT AR
      DATA DRAY(18, 1)/  5.21080017D0  /,DCMP(18, 1)/-0.682110012D0  /
      DATA DRAY(18, 2)/ 0.135619998D0  /,DCMP(18, 2)/  1.74280000D0  /
      DATA DRAY(18, 3)/-0.347209990D0  /,DCMP(18, 3)/-0.317649990D0  /
      DATA DRAY(18, 4)/ 1.843300089D-02/,DCMP(18, 4)/ 1.564699970D-02/
C * DATA FOR ELEMENT K
      DATA DRAY(19, 1)/  5.25589991D0  /,DCMP(19, 1)/-0.344009995D0  /
      DATA DRAY(19, 2)/ 0.188040003D0  /,DCMP(19, 2)/  1.49240005D0  /
      DATA DRAY(19, 3)/-0.359620005D0  /,DCMP(19, 3)/-0.254139990D0  /
      DATA DRAY(19, 4)/ 1.930800080D-02/,DCMP(19, 4)/ 1.076800004D-02/
C * DATA FOR ELEMENT CA
      DATA DRAY(20, 1)/  5.32380009D0  /,DCMP(20, 1)/-9.824199975D-02/
      DATA DRAY(20, 2)/ 0.206689999D0  /,DCMP(20, 2)/  1.32830000D0  /
      DATA DRAY(20, 3)/-0.361660004D0  /,DCMP(20, 3)/-0.213750005D0  /
      DATA DRAY(20, 4)/ 1.933299936D-02/,DCMP(20, 4)/ 7.730599958D-03/
C * DATA FOR ELEMENT SC
      DATA DRAY(21, 1)/  5.43940020D0  /,DCMP(21, 1)/-0.159830004D0  /
      DATA DRAY(21, 2)/ 0.200169995D0  /,DCMP(21, 2)/  1.39059997D0  /
      DATA DRAY(21, 3)/-0.359059989D0  /,DCMP(21, 3)/-0.225850001D0  /
      DATA DRAY(21, 4)/ 1.910299994D-02/,DCMP(21, 4)/ 8.519499563D-03/
C * DATA FOR ELEMENT TI
      DATA DRAY(22, 1)/  5.55039978D0  /,DCMP(22, 1)/-0.230570003D0  /
      DATA DRAY(22, 2)/ 0.197699994D0  /,DCMP(22, 2)/  1.45850003D0  /
      DATA DRAY(22, 3)/-0.357690006D0  /,DCMP(22, 3)/-0.239160001D0  /
      DATA DRAY(22, 4)/ 1.898699999D-02/,DCMP(22, 4)/ 9.385299869D-03/
C * DATA FOR ELEMENT V
      DATA DRAY(23, 1)/  5.65509987D0  /,DCMP(23, 1)/-0.308099985D0  /
      DATA DRAY(23, 2)/ 0.199530005D0  /,DCMP(23, 2)/  1.52880001D0  /
      DATA DRAY(23, 3)/-0.357490003D0  /,DCMP(23, 3)/-0.252770007D0  /
      DATA DRAY(23, 4)/ 1.896899939D-02/,DCMP(23, 4)/ 1.025700010D-02/
C * DATA FOR ELEMENT CR
      DATA DRAY(24, 1)/  5.77400017D0  /,DCMP(24, 1)/-0.387639999D0  /
      DATA DRAY(24, 2)/ 0.203860000D0  /,DCMP(24, 2)/  1.59730005D0  /
      DATA DRAY(24, 3)/-0.359699994D0  /,DCMP(24, 3)/-0.266240001D0  /
      DATA DRAY(24, 4)/ 1.922200061D-02/,DCMP(24, 4)/ 1.115200017D-02/
C * DATA FOR ELEMENT MN
      DATA DRAY(25, 1)/  5.84600019D0  /,DCMP(25, 1)/-0.247060001D0  /
      DATA DRAY(25, 2)/ 0.213809997D0  /,DCMP(25, 2)/  1.49720001D0  /
      DATA DRAY(25, 3)/-0.359719992D0  /,DCMP(25, 3)/-0.238780007D0  /
      DATA DRAY(25, 4)/ 1.914599910D-02/,DCMP(25, 4)/ 8.932099678D-03/
C * DATA FOR ELEMENT FE
      DATA DRAY(26, 1)/  5.93289995D0  /,DCMP(26, 1)/-0.342379987D0  /
      DATA DRAY(26, 2)/ 0.225040004D0  /,DCMP(26, 2)/  1.57249999D0  /
      DATA DRAY(26, 3)/-0.361750007D0  /,DCMP(26, 3)/-0.253199995D0  /
      DATA DRAY(26, 4)/ 1.930199936D-02/,DCMP(26, 4)/ 9.858200327D-03/
C * DATA FOR ELEMENT CO
      DATA DRAY(27, 1)/  6.01480007D0  /,DCMP(27, 1)/-0.428799987D0  /
      DATA DRAY(27, 2)/ 0.237959996D0  /,DCMP(27, 2)/  1.64129996D0  /
      DATA DRAY(27, 3)/-0.364060014D0  /,DCMP(27, 3)/-0.266009986D0  /
      DATA DRAY(27, 4)/ 1.947499998D-02/,DCMP(27, 4)/ 1.065099984D-02/
C * DATA FOR ELEMENT NI
      DATA DRAY(28, 1)/  6.09200001D0  /,DCMP(28, 1)/-0.504360020D0  /
      DATA DRAY(28, 2)/ 0.252279997D0  /,DCMP(28, 2)/  1.70039999D0  /
      DATA DRAY(28, 3)/-0.366569996D0  /,DCMP(28, 3)/-0.276439995D0  /
      DATA DRAY(28, 4)/ 1.965899952D-02/,DCMP(28, 4)/ 1.126299985D-02/
C * DATA FOR ELEMENT CU
      DATA DRAY(29, 1)/  6.17740011D0  /,DCMP(29, 1)/-0.570209980D0  /
      DATA DRAY(29, 2)/ 0.273119986D0  /,DCMP(29, 2)/  1.75039995D0  /
      DATA DRAY(29, 3)/-0.372359991D0  /,DCMP(29, 3)/-0.284550011D0  /
      DATA DRAY(29, 4)/ 2.016399987D-02/,DCMP(29, 4)/ 1.169299986D-02/
C * DATA FOR ELEMENT ZN
      DATA DRAY(30, 1)/  6.23400021D0  /,DCMP(30, 1)/-0.420529991D0  /
      DATA DRAY(30, 2)/ 0.284310013D0  /,DCMP(30, 2)/  1.63399994D0  /
      DATA DRAY(30, 3)/-0.372139990D0  /,DCMP(30, 3)/-0.253650010D0  /
      DATA DRAY(30, 4)/ 2.005299926D-02/,DCMP(30, 4)/ 9.272299707D-03/
C * DATA FOR ELEMENT GA
      DATA DRAY(31, 1)/  6.28299999D0  /,DCMP(31, 1)/-0.358220011D0  /
      DATA DRAY(31, 2)/ 0.291330010D0  /,DCMP(31, 2)/  1.60049999D0  /
      DATA DRAY(31, 3)/-0.369390011D0  /,DCMP(31, 3)/-0.244910002D0  /
      DATA DRAY(31, 4)/ 1.970300078D-02/,DCMP(31, 4)/ 8.619000204D-03/
C * DATA FOR ELEMENT GE
      DATA DRAY(32, 1)/  6.33900023D0  /,DCMP(32, 1)/-0.334380001D0  /
      DATA DRAY(32, 2)/ 0.291509986D0  /,DCMP(32, 2)/  1.60239995D0  /
      DATA DRAY(32, 3)/-0.365640014D0  /,DCMP(32, 3)/-0.245550007D0  /
      DATA DRAY(32, 4)/ 1.929000020D-02/,DCMP(32, 4)/ 8.712399751D-03/
C * DATA FOR ELEMENT AS
      DATA DRAY(33, 1)/  6.39750004D0  /,DCMP(33, 1)/-0.339190006D0  /
      DATA DRAY(33, 2)/ 0.288870007D0  /,DCMP(33, 2)/  1.62530005D0  /
      DATA DRAY(33, 3)/-0.361750007D0  /,DCMP(33, 3)/-0.250779986D0  /
      DATA DRAY(33, 4)/ 1.887900010D-02/,DCMP(33, 4)/ 9.091000073D-03/
C * DATA FOR ELEMENT SE
      DATA DRAY(34, 1)/  6.45639992D0  /,DCMP(34, 1)/-0.432929993D0  /
      DATA DRAY(34, 2)/ 0.286740005D0  /,DCMP(34, 2)/  1.72829998D0  /
      DATA DRAY(34, 3)/-0.358790010D0  /,DCMP(34, 3)/-0.277139992D0  /
      DATA DRAY(34, 4)/ 1.856200024D-02/,DCMP(34, 4)/ 1.117299963D-02/
C * DATA FOR ELEMENT BR
      DATA DRAY(35, 1)/  6.51440001D0  /,DCMP(35, 1)/-0.448000014D0  /
      DATA DRAY(35, 2)/ 0.286320001D0  /,DCMP(35, 2)/  1.76080000D0  /
      DATA DRAY(35, 3)/-0.357030004D0  /,DCMP(35, 3)/-0.285100013D0  /
      DATA DRAY(35, 4)/ 1.835599914D-02/,DCMP(35, 4)/ 1.178599987D-02/
C * DATA FOR ELEMENT KR
      DATA DRAY(36, 1)/  6.57130003D0  /,DCMP(36, 1)/-0.391810000D0  /
      DATA DRAY(36, 2)/ 0.287710011D0  /,DCMP(36, 2)/  1.73010004D0  /
      DATA DRAY(36, 3)/-0.356310010D0  /,DCMP(36, 3)/-0.276820004D0  /
      DATA DRAY(36, 4)/ 1.824700087D-02/,DCMP(36, 4)/ 1.128000021D-02/
C * DATA FOR ELEMENT RB
      DATA DRAY(37, 1)/  6.59749985D0  /,DCMP(37, 1)/-0.128040001D0  /
      DATA DRAY(37, 2)/ 0.302390009D0  /,DCMP(37, 2)/  1.53040004D0  /
      DATA DRAY(37, 3)/-0.356750011D0  /,DCMP(37, 3)/-0.227400005D0  /
      DATA DRAY(37, 4)/ 1.817099936D-02/,DCMP(37, 4)/ 7.390299812D-03/
C * DATA FOR ELEMENT SR
      DATA DRAY(38, 1)/  6.62200022D0  /,DCMP(38, 1)/ 7.991600037D-02/
      DATA DRAY(38, 2)/ 0.324559987D0  /,DCMP(38, 2)/  1.38399994D0  /
      DATA DRAY(38, 3)/-0.361649990D0  /,DCMP(38, 3)/-0.192220002D0  /
      DATA DRAY(38, 4)/ 1.847999915D-02/,DCMP(38, 4)/ 4.786099773D-03/
C * DATA FOR ELEMENT Y
      DATA DRAY(39, 1)/  6.67100000D0  /,DCMP(39, 1)/ 6.290599704D-02/
      DATA DRAY(39, 2)/ 0.325080007D0  /,DCMP(39, 2)/  1.41579998D0  /
      DATA DRAY(39, 3)/-0.360610008D0  /,DCMP(39, 3)/-0.199709997D0  /
      DATA DRAY(39, 4)/ 1.833299920D-02/,DCMP(39, 4)/ 5.333099980D-03/
C * DATA FOR ELEMENT ZR
      DATA DRAY(40, 1)/  6.72279978D0  /,DCMP(40, 1)/ 3.666999936D-02/
      DATA DRAY(40, 2)/ 0.323960006D0  /,DCMP(40, 2)/  1.45210004D0  /
      DATA DRAY(40, 3)/-0.359459996D0  /,DCMP(40, 3)/-0.208120003D0  /
      DATA DRAY(40, 4)/ 1.818899997D-02/,DCMP(40, 4)/ 5.951399915D-03/
C * DATA FOR ELEMENT NB
      DATA DRAY(41, 1)/  6.79010010D0  /,DCMP(41, 1)/ 2.022900007D-04/
      DATA DRAY(41, 2)/ 0.311280012D0  /,DCMP(41, 2)/  1.49349999D0  /
      DATA DRAY(41, 3)/-0.355230004D0  /,DCMP(41, 3)/-0.217419997D0  /
      DATA DRAY(41, 4)/ 1.782299951D-02/,DCMP(41, 4)/ 6.622400135D-03/
C * DATA FOR ELEMENT MO
      DATA DRAY(42, 1)/  6.84600019D0  /,DCMP(42, 1)/-5.628599972D-02/
      DATA DRAY(42, 2)/ 0.302800000D0  /,DCMP(42, 2)/  1.55780005D0  /
      DATA DRAY(42, 3)/-0.351130009D0  /,DCMP(42, 3)/-0.233339995D0  /
      DATA DRAY(42, 4)/ 1.744000055D-02/,DCMP(42, 4)/ 7.855099626D-03/
C * DATA FOR ELEMENT TC
      DATA DRAY(43, 1)/  6.87599993D0  /,DCMP(43, 1)/ 7.576200366D-02/
      DATA DRAY(43, 2)/ 0.326160014D0  /,DCMP(43, 2)/  1.44949996D0  /
      DATA DRAY(43, 3)/-0.358969986D0  /,DCMP(43, 3)/-0.204889998D0  /
      DATA DRAY(43, 4)/ 1.804799959D-02/,DCMP(43, 4)/ 5.647500046D-03/
C * DATA FOR ELEMENT RU
      DATA DRAY(44, 1)/  6.93139982D0  /,DCMP(44, 1)/-4.249799997D-02/
      DATA DRAY(44, 2)/ 0.334789991D0  /,DCMP(44, 2)/  1.54639995D0  /
      DATA DRAY(44, 3)/-0.363499999D0  /,DCMP(44, 3)/-0.226469994D0  /
      DATA DRAY(44, 4)/ 1.844299957D-02/,DCMP(44, 4)/ 7.183799986D-03/
C * DATA FOR ELEMENT RH
      DATA DRAY(45, 1)/  6.97550011D0  /,DCMP(45, 1)/-0.160400003D0  /
      DATA DRAY(45, 2)/ 0.346390009D0  /,DCMP(45, 2)/  1.64859998D0  /
      DATA DRAY(45, 3)/-0.367790014D0  /,DCMP(45, 3)/-0.250239998D0  /
      DATA DRAY(45, 4)/ 1.878800057D-02/,DCMP(45, 4)/ 8.938199840D-03/
C * DATA FOR ELEMENT PD
      DATA DRAY(46, 1)/  7.03219986D0  /,DCMP(46, 1)/-0.267560005D0  /
      DATA DRAY(46, 2)/ 0.349839985D0  /,DCMP(46, 2)/  1.73740005D0  /
      DATA DRAY(46, 3)/-0.370099992D0  /,DCMP(46, 3)/-0.269879997D0  /
      DATA DRAY(46, 4)/ 1.899800077D-02/,DCMP(46, 4)/ 1.032499969D-02/
C * DATA FOR ELEMENT AG
      DATA DRAY(47, 1)/  7.06449986D0  /,DCMP(47, 1)/-0.166470006D0  /
      DATA DRAY(47, 2)/ 0.363460004D0  /,DCMP(47, 2)/  1.65789998D0  /
      DATA DRAY(47, 3)/-0.373600006D0  /,DCMP(47, 3)/-0.248740003D0  /
      DATA DRAY(47, 4)/ 1.924799941D-02/,DCMP(47, 4)/ 8.662199602D-03/
C * DATA FOR ELEMENT CD
      DATA DRAY(48, 1)/  7.09859991D0  /,DCMP(48, 1)/-5.166999996D-02/
      DATA DRAY(48, 2)/ 0.372200012D0  /,DCMP(48, 2)/  1.57430005D0  /
      DATA DRAY(48, 3)/-0.375340015D0  /,DCMP(48, 3)/-0.227650002D0  /
      DATA DRAY(48, 4)/ 1.934799924D-02/,DCMP(48, 4)/ 7.056499831D-03/
C * DATA FOR ELEMENT IN
      DATA DRAY(49, 1)/  7.12709999D0  /,DCMP(49, 1)/-8.172799833D-03/
      DATA DRAY(49, 2)/ 0.382079989D0  /,DCMP(49, 2)/  1.55869997D0  /
      DATA DRAY(49, 3)/-0.376850009D0  /,DCMP(49, 3)/-0.224490002D0  /
      DATA DRAY(49, 4)/ 1.941500045D-02/,DCMP(49, 4)/ 6.857799832D-03/
C * DATA FOR ELEMENT SN
      DATA DRAY(50, 1)/  7.16090012D0  /,DCMP(50, 1)/ 1.421499997D-02/
      DATA DRAY(50, 2)/ 0.385509998D0  /,DCMP(50, 2)/  1.55750000D0  /
      DATA DRAY(50, 3)/-0.376480013D0  /,DCMP(50, 3)/-0.224739999D0  /
      DATA DRAY(50, 4)/ 1.933000050D-02/,DCMP(50, 4)/ 6.914000027D-03/
C * DATA FOR ELEMENT SB
      DATA DRAY(51, 1)/  7.19670010D0  /,DCMP(51, 1)/ 1.563600078D-02/
      DATA DRAY(51, 2)/ 0.385540009D0  /,DCMP(51, 2)/  1.57179999D0  /
      DATA DRAY(51, 3)/-0.375050008D0  /,DCMP(51, 3)/-0.228750005D0  /
      DATA DRAY(51, 4)/ 1.916100085D-02/,DCMP(51, 4)/ 7.263899781D-03/
C * DATA FOR ELEMENT TE
      DATA DRAY(52, 1)/  7.23460007D0  /,DCMP(52, 1)/-4.075799882D-02/
      DATA DRAY(52, 2)/ 0.382490009D0  /,DCMP(52, 2)/  1.64269996D0  /
      DATA DRAY(52, 3)/-0.372709990D0  /,DCMP(52, 3)/-0.247899994D0  /
      DATA DRAY(52, 4)/ 1.891900040D-02/,DCMP(52, 4)/ 8.805699646D-03/
C * DATA FOR ELEMENT I
      DATA DRAY(53, 1)/  7.27409983D0  /,DCMP(53, 1)/-4.044200107D-02/
      DATA DRAY(53, 2)/ 0.377220005D0  /,DCMP(53, 2)/  1.65600002D0  /
      DATA DRAY(53, 3)/-0.369729996D0  /,DCMP(53, 3)/-0.251069993D0  /
      DATA DRAY(53, 4)/ 1.862799935D-02/,DCMP(53, 4)/ 9.048700333D-03/
C * DATA FOR ELEMENT XE
      DATA DRAY(54, 1)/  7.31470013D0  /,DCMP(54, 1)/-2.824099967D-03/
      DATA DRAY(54, 2)/ 0.370310009D0  /,DCMP(54, 2)/  1.64040005D0  /
      DATA DRAY(54, 3)/-0.366279989D0  /,DCMP(54, 3)/-0.247639999D0  /
      DATA DRAY(54, 4)/ 1.830299944D-02/,DCMP(54, 4)/ 8.821399882D-03/
C * DATA FOR ELEMENT CS
      DATA DRAY(55, 1)/  7.33489990D0  /,DCMP(55, 1)/ 0.184860006D0  /
      DATA DRAY(55, 2)/ 0.376830012D0  /,DCMP(55, 2)/  1.50030005D0  /
      DATA DRAY(55, 3)/-0.365709990D0  /,DCMP(55, 3)/-0.213330001D0  /
      DATA DRAY(55, 4)/ 1.818400063D-02/,DCMP(55, 4)/ 6.242599804D-03/
C * DATA FOR ELEMENT BA
      DATA DRAY(56, 1)/  7.35809994D0  /,DCMP(56, 1)/ 0.344379991D0  /
      DATA DRAY(56, 2)/ 0.379359990D0  /,DCMP(56, 2)/  1.38740003D0  /
      DATA DRAY(56, 3)/-0.364100009D0  /,DCMP(56, 3)/-0.186360002D0  /
      DATA DRAY(56, 4)/ 1.798200049D-02/,DCMP(56, 4)/ 4.249200225D-03/
C * DATA FOR ELEMENT LA
      DATA DRAY(57, 1)/  7.39529991D0  /,DCMP(57, 1)/ 0.409099996D0  /
      DATA DRAY(57, 2)/ 0.369899988D0  /,DCMP(57, 2)/  1.33070004D0  /
      DATA DRAY(57, 3)/-0.359380007D0  /,DCMP(57, 3)/-0.170880005D0  /
      DATA DRAY(57, 4)/ 1.754100062D-02/,DCMP(57, 4)/ 3.041099990D-03/
C * DATA FOR ELEMENT CE
      DATA DRAY(58, 1)/  7.44259977D0  /,DCMP(58, 1)/ 0.439880013D0  /
      DATA DRAY(58, 2)/ 0.371329993D0  /,DCMP(58, 2)/  1.30920005D0  /
      DATA DRAY(58, 3)/-0.359640002D0  /,DCMP(58, 3)/-0.164550006D0  /
      DATA DRAY(58, 4)/ 1.758500002D-02/,DCMP(58, 4)/ 2.526399912D-03/
C * DATA FOR ELEMENT PR
      DATA DRAY(59, 1)/  7.48350000D0  /,DCMP(59, 1)/ 0.449119985D0  /
      DATA DRAY(59, 2)/ 0.368429989D0  /,DCMP(59, 2)/  1.30350006D0  /
      DATA DRAY(59, 3)/-0.357690006D0  /,DCMP(59, 3)/-0.161840007D0  /
      DATA DRAY(59, 4)/ 1.741000079D-02/,DCMP(59, 4)/ 2.273899969D-03/
C * DATA FOR ELEMENT ND
      DATA DRAY(60, 1)/  7.52330017D0  /,DCMP(60, 1)/ 0.437279999D0  /
      DATA DRAY(60, 2)/ 0.366459996D0  /,DCMP(60, 2)/  1.31369996D0  /
      DATA DRAY(60, 3)/-0.356050014D0  /,DCMP(60, 3)/-0.162870005D0  /
      DATA DRAY(60, 4)/ 1.726200059D-02/,DCMP(60, 4)/ 2.293800004D-03/
C * DATA FOR ELEMENT PM
      DATA DRAY(61, 1)/  7.56220007D0  /,DCMP(61, 1)/ 0.405820012D0  /
      DATA DRAY(61, 2)/ 0.365049988D0  /,DCMP(61, 2)/  1.33840001D0  /
      DATA DRAY(61, 3)/-0.354510009D0  /,DCMP(61, 3)/-0.167229995D0  /
      DATA DRAY(61, 4)/ 1.712100022D-02/,DCMP(61, 4)/ 2.555700019D-03/
C * DATA FOR ELEMENT SM
      DATA DRAY(62, 1)/  7.60020018D0  /,DCMP(62, 1)/ 0.355379999D0  /
      DATA DRAY(62, 2)/ 0.364129990D0  /,DCMP(62, 2)/  1.37730002D0  /
      DATA DRAY(62, 3)/-0.353089988D0  /,DCMP(62, 3)/-0.174940005D0  /
      DATA DRAY(62, 4)/ 1.698900014D-02/,DCMP(62, 4)/ 3.062099917D-03/
C * DATA FOR ELEMENT EU
      DATA DRAY(63, 1)/  7.63710022D0  /,DCMP(63, 1)/ 0.280319989D0  /
      DATA DRAY(63, 2)/ 0.363959998D0  /,DCMP(63, 2)/  1.44019997D0  /
      DATA DRAY(63, 3)/-0.351920009D0  /,DCMP(63, 3)/-0.188639998D0  /
      DATA DRAY(63, 4)/ 1.687799953D-02/,DCMP(63, 4)/ 4.012300167D-03/
C * DATA FOR ELEMENT GD
      DATA DRAY(64, 1)/  7.66940022D0  /,DCMP(64, 1)/ 0.273130000D0  /
      DATA DRAY(64, 2)/ 0.359750003D0  /,DCMP(64, 2)/  1.43840003D0  /
      DATA DRAY(64, 3)/-0.348899990D0  /,DCMP(64, 3)/-0.186140001D0  /
      DATA DRAY(64, 4)/ 1.658900082D-02/,DCMP(64, 4)/ 3.752399934D-03/
C * DATA FOR ELEMENT TB
      DATA DRAY(65, 1)/  7.70800018D0  /,DCMP(65, 1)/ 0.257539988D0  /
      DATA DRAY(65, 2)/ 0.365350008D0  /,DCMP(65, 2)/  1.45060003D0  /
      DATA DRAY(65, 3)/-0.350030005D0  /,DCMP(65, 3)/-0.187590003D0  /
      DATA DRAY(65, 4)/ 1.669299975D-02/,DCMP(65, 4)/ 3.799299942D-03/
C * DATA FOR ELEMENT DY
      DATA DRAY(66, 1)/  7.74189997D0  /,DCMP(66, 1)/ 0.242689997D0  /
      DATA DRAY(66, 2)/ 0.367110014D0  /,DCMP(66, 2)/  1.46270001D0  /
      DATA DRAY(66, 3)/-0.349429995D0  /,DCMP(66, 3)/-0.189099997D0  /
      DATA DRAY(66, 4)/ 1.662700064D-02/,DCMP(66, 4)/ 3.856299911D-03/
C * DATA FOR ELEMENT HO
      DATA DRAY(67, 1)/  7.77470016D0  /,DCMP(67, 1)/ 0.228489995D0  /
      DATA DRAY(67, 2)/ 0.369720012D0  /,DCMP(67, 2)/  1.47440004D0  /
      DATA DRAY(67, 3)/-0.349130005D0  /,DCMP(67, 3)/-0.190559998D0  /
      DATA DRAY(67, 4)/ 1.658600010D-02/,DCMP(67, 4)/ 3.909000196D-03/
C * DATA FOR ELEMENT ER
      DATA DRAY(68, 1)/  7.80639982D0  /,DCMP(68, 1)/ 0.215230003D0  /
      DATA DRAY(68, 2)/ 0.373230010D0  /,DCMP(68, 2)/  1.48549998D0  /
      DATA DRAY(68, 3)/-0.349150002D0  /,DCMP(68, 3)/-0.191909999D0  /
      DATA DRAY(68, 4)/ 1.657100022D-02/,DCMP(68, 4)/ 3.956499975D-03/
C * DATA FOR ELEMENT TM
      DATA DRAY(69, 1)/  7.83710003D0  /,DCMP(69, 1)/ 0.202659994D0  /
      DATA DRAY(69, 2)/ 0.377550006D0  /,DCMP(69, 2)/  1.49629998D0  /
      DATA DRAY(69, 3)/-0.349440008D0  /,DCMP(69, 3)/-0.193230003D0  /
      DATA DRAY(69, 4)/ 1.657800004D-02/,DCMP(69, 4)/ 4.002300091D-03/
C * DATA FOR ELEMENT YB
      DATA DRAY(70, 1)/  7.86660004D0  /,DCMP(70, 1)/ 0.202250004D0  /
      DATA DRAY(70, 2)/ 0.382930011D0  /,DCMP(70, 2)/  1.48800004D0  /
      DATA DRAY(70, 3)/-0.350129992D0  /,DCMP(70, 3)/-0.189140007D0  /
      DATA DRAY(70, 4)/ 1.661700010D-02/,DCMP(70, 4)/ 3.622600110D-03/
C * DATA FOR ELEMENT LU
      DATA DRAY(71, 1)/  7.89139986D0  /,DCMP(71, 1)/ 0.197180003D0  /
      DATA DRAY(71, 2)/ 0.386029989D0  /,DCMP(71, 2)/  1.50259995D0  /
      DATA DRAY(71, 3)/-0.349759996D0  /,DCMP(71, 3)/-0.192469999D0  /
      DATA DRAY(71, 4)/ 1.654800028D-02/,DCMP(71, 4)/ 3.857499920D-03/
C * DATA FOR ELEMENT HF
      DATA DRAY(72, 1)/  7.91800022D0  /,DCMP(72, 1)/ 0.199469998D0  /
      DATA DRAY(72, 2)/ 0.387019992D0  /,DCMP(72, 2)/  1.50230002D0  /
      DATA DRAY(72, 3)/-0.348879993D0  /,DCMP(72, 3)/-0.191389993D0  /
      DATA DRAY(72, 4)/ 1.644100063D-02/,DCMP(72, 4)/ 3.740099957D-03/
C * DATA FOR ELEMENT TA
      DATA DRAY(73, 1)/  7.94530010D0  /,DCMP(73, 1)/ 0.196869999D0  /
      DATA DRAY(73, 2)/ 0.387300014D0  /,DCMP(73, 2)/  1.50619996D0  /
      DATA DRAY(73, 3)/-0.347930014D0  /,DCMP(73, 3)/-0.191400006D0  /
      DATA DRAY(73, 4)/ 1.633000001D-02/,DCMP(73, 4)/ 3.708899952D-03/
C * DATA FOR ELEMENT W
      DATA DRAY(74, 1)/  7.97270012D0  /,DCMP(74, 1)/ 0.191019997D0  /
      DATA DRAY(74, 2)/ 0.387699991D0  /,DCMP(74, 2)/  1.51240003D0  /
      DATA DRAY(74, 3)/-0.347160012D0  /,DCMP(74, 3)/-0.191919997D0  /
      DATA DRAY(74, 4)/ 1.623700000D-02/,DCMP(74, 4)/ 3.714499995D-03/
C * DATA FOR ELEMENT RE
      DATA DRAY(75, 1)/  7.99940014D0  /,DCMP(75, 1)/ 0.189640000D0  /
      DATA DRAY(75, 2)/ 0.388740003D0  /,DCMP(75, 2)/  1.50870001D0  /
      DATA DRAY(75, 3)/-0.346729994D0  /,DCMP(75, 3)/-0.189569995D0  /
      DATA DRAY(75, 4)/ 1.617500000D-02/,DCMP(75, 4)/ 3.495800076D-03/
C * DATA FOR ELEMENT OS
      DATA DRAY(76, 1)/  8.02569962D0  /,DCMP(76, 1)/ 0.116449997D0  /
      DATA DRAY(76, 2)/ 0.390460014D0  /,DCMP(76, 2)/  1.57609999D0  /
      DATA DRAY(76, 3)/-0.346659988D0  /,DCMP(76, 3)/-0.205530003D0  /
      DATA DRAY(76, 4)/ 1.614500023D-02/,DCMP(76, 4)/ 4.667299800D-03/
C * DATA FOR ELEMENT IR
      DATA DRAY(77, 1)/  8.05150032D0  /,DCMP(77, 1)/ 7.199099660D-02/
      DATA DRAY(77, 2)/ 0.393139988D0  /,DCMP(77, 2)/  1.61199999D0  /
      DATA DRAY(77, 3)/-0.347050011D0  /,DCMP(77, 3)/-0.213190004D0  /
      DATA DRAY(77, 4)/ 1.615699939D-02/,DCMP(77, 4)/ 5.204999819D-03/
C * DATA FOR ELEMENT PT
      DATA DRAY(78, 1)/  8.08080006D0  /,DCMP(78, 1)/ 4.201899841D-02/
      DATA DRAY(78, 2)/ 0.395790011D0  /,DCMP(78, 2)/  1.63610005D0  /
      DATA DRAY(78, 3)/-0.348030001D0  /,DCMP(78, 3)/-0.217960000D0  /
      DATA DRAY(78, 4)/ 1.623499952D-02/,DCMP(78, 4)/ 5.526700057D-03/
C * DATA FOR ELEMENT AU
      DATA DRAY(79, 1)/  8.10519981D0  /,DCMP(79, 1)/ 1.569199935D-02/
      DATA DRAY(79, 2)/ 0.400579989D0  /,DCMP(79, 2)/  1.65409994D0  /
      DATA DRAY(79, 3)/-0.349339992D0  /,DCMP(79, 3)/-0.220980003D0  /
      DATA DRAY(79, 4)/ 1.632600091D-02/,DCMP(79, 4)/ 5.707500037D-03/
C * DATA FOR ELEMENT HG
      DATA DRAY(80, 1)/  8.12539959D0  /,DCMP(80, 1)/ 0.114589997D0  /
      DATA DRAY(80, 2)/ 0.405860007D0  /,DCMP(80, 2)/  1.58080006D0  /
      DATA DRAY(80, 3)/-0.350329995D0  /,DCMP(80, 3)/-0.202969998D0  /
      DATA DRAY(80, 4)/ 1.637700014D-02/,DCMP(80, 4)/ 4.356900230D-03/
C * DATA FOR ELEMENT TL
      DATA DRAY(81, 1)/  8.14400005D0  /,DCMP(81, 1)/ 0.147049993D0  /
      DATA DRAY(81, 2)/ 0.408690006D0  /,DCMP(81, 2)/  1.56690001D0  /
      DATA DRAY(81, 3)/-0.349799991D0  /,DCMP(81, 3)/-0.200350001D0  /
      DATA DRAY(81, 4)/ 1.628899947D-02/,DCMP(81, 4)/ 4.209000152D-03/
C * DATA FOR ELEMENT PB
      DATA DRAY(82, 1)/  8.15999985D0  /,DCMP(82, 1)/ 0.182170004D0  /
      DATA DRAY(82, 2)/ 0.418029994D0  /,DCMP(82, 2)/  1.54659998D0  /
      DATA DRAY(82, 3)/-0.352329999D0  /,DCMP(82, 3)/-0.195789993D0  /
      DATA DRAY(82, 4)/ 1.646599919D-02/,DCMP(82, 4)/ 3.907700069D-03/
C * DATA FOR ELEMENT BI
      DATA DRAY(83, 1)/  8.17490005D0  /,DCMP(83, 1)/ 0.189860001D0  /
      DATA DRAY(83, 2)/ 0.427920014D0  /,DCMP(83, 2)/  1.56120002D0  /
      DATA DRAY(83, 3)/-0.355069995D0  /,DCMP(83, 3)/-0.200929999D0  /
      DATA DRAY(83, 4)/ 1.665999927D-02/,DCMP(83, 4)/ 4.367699847D-03/
C * DATA FOR ELEMENT PO
      DATA DRAY(84, 1)/  8.19359970D0  /,DCMP(84, 1)/ 0.194100007D0  /
      DATA DRAY(84, 2)/ 0.434500009D0  /,DCMP(84, 2)/  1.57790005D0  /
      DATA DRAY(84, 3)/-0.357190013D0  /,DCMP(84, 3)/-0.205149993D0  /
      DATA DRAY(84, 4)/ 1.683500037D-02/,DCMP(84, 4)/ 4.707800224D-03/
C * DATA FOR ELEMENT AT
      DATA DRAY(85, 1)/  8.20750046D0  /,DCMP(85, 1)/ 0.195850000D0  /
      DATA DRAY(85, 2)/ 0.443300009D0  /,DCMP(85, 2)/  1.59249997D0  /
      DATA DRAY(85, 3)/-0.359880000D0  /,DCMP(85, 3)/-0.209830001D0  /
      DATA DRAY(85, 4)/ 1.698499918D-02/,DCMP(85, 4)/ 5.121100228D-03/
C * DATA FOR ELEMENT RN
      DATA DRAY(86, 1)/  8.22550011D0  /,DCMP(86, 1)/ 0.196620002D0  /
      DATA DRAY(86, 2)/ 0.451480001D0  /,DCMP(86, 2)/  1.60080004D0  /
      DATA DRAY(86, 3)/-0.362060010D0  /,DCMP(86, 3)/-0.213799998D0  /
      DATA DRAY(86, 4)/ 1.715599932D-02/,DCMP(86, 4)/ 5.517200101D-03/
C * DATA FOR ELEMENT FR
      DATA DRAY(87, 1)/  8.23349953D0  /,DCMP(87, 1)/ 0.193220004D0  /
      DATA DRAY(87, 2)/ 0.460599989D0  /,DCMP(87, 2)/  1.61670005D0  /
      DATA DRAY(87, 3)/-0.364410013D0  /,DCMP(87, 3)/-0.217370003D0  /
      DATA DRAY(87, 4)/ 1.727100089D-02/,DCMP(87, 4)/ 5.795000121D-03/
C * DATA FOR ELEMENT RA
      DATA DRAY(88, 1)/  8.24709988D0  /,DCMP(88, 1)/ 0.189150006D0  /
      DATA DRAY(88, 2)/ 0.468199998D0  /,DCMP(88, 2)/  1.62730002D0  /
      DATA DRAY(88, 3)/-0.365990013D0  /,DCMP(88, 3)/-0.220500007D0  /
      DATA DRAY(88, 4)/ 1.738899946D-02/,DCMP(88, 4)/ 6.078000180D-03/
C * DATA FOR ELEMENT AC
      DATA DRAY(89, 1)/  8.26220036D0  /,DCMP(89, 1)/ 0.181580007D0  /
      DATA DRAY(89, 2)/ 0.474400014D0  /,DCMP(89, 2)/  1.64059997D0  /
      DATA DRAY(89, 3)/-0.367009997D0  /,DCMP(89, 3)/-0.224219993D0  /
      DATA DRAY(89, 4)/ 1.747700013D-02/,DCMP(89, 4)/ 6.406699773D-03/
C * DATA FOR ELEMENT TH
      DATA DRAY(90, 1)/  8.27840042D0  /,DCMP(90, 1)/ 0.170890003D0  /
      DATA DRAY(90, 2)/ 0.479059994D0  /,DCMP(90, 2)/  1.65559995D0  /
      DATA DRAY(90, 3)/-0.367659986D0  /,DCMP(90, 3)/-0.229699999D0  /
      DATA DRAY(90, 4)/ 1.746200025D-02/,DCMP(90, 4)/ 6.925200112D-03/
C * DATA FOR ELEMENT PA
      DATA DRAY(91, 1)/  8.30169964D0  /,DCMP(91, 1)/ 0.144180000D0  /
      DATA DRAY(91, 2)/ 0.480199993D0  /,DCMP(91, 2)/  1.69449997D0  /
      DATA DRAY(91, 3)/-0.367549986D0  /,DCMP(91, 3)/-0.239150003D0  /
      DATA DRAY(91, 4)/ 1.751700044D-02/,DCMP(91, 4)/ 7.667399943D-03/
C * DATA FOR ELEMENT U
      DATA DRAY(92, 1)/  8.33010006D0  /,DCMP(92, 1)/ 0.108280003D0  /
      DATA DRAY(92, 2)/ 0.478309989D0  /,DCMP(92, 2)/  1.74160004D0  /
      DATA DRAY(92, 3)/-0.367249995D0  /,DCMP(92, 3)/-0.254099995D0  /
      DATA DRAY(92, 4)/ 1.741299964D-02/,DCMP(92, 4)/ 8.950600401D-03/
C * DATA FOR LI ELEMENT # 3
      DATA XKPCOR( 3)/ 1.000000000D-03/
      DATA RELCOR( 3)/ 1.000000047D-03/
      DATA (IFUNTYP(3, I), I = 1, 2)/2, 2/
      DATA (NPARMS( 3, I), I = 1, 2)/10, 10/
C * DATA FOR BE ELEMENT # 4
      DATA XKPCOR( 4)/ 0.000000000D-03/
      DATA RELCOR( 4)/ 1.000000047D-03/
      DATA (IFUNTYP(4, I), I = 1, 2)/2, 2/
      DATA (NPARMS( 4, I), I = 1, 2)/10, 10/
C * DATA FOR B  ELEMENT # 5
      DATA XKPCOR( 5)/ 1.000000000D-03/
      DATA RELCOR( 5)/ 2.000000095D-03/
      DATA (IFUNTYP(5, I), I = 1, 3)/2, 2, 2/
      DATA (NPARMS( 5, I), I = 1, 3)/10, 10, 10/
C * DATA FOR C  ELEMENT # 6
      DATA XKPCOR( 6)/ 1.000000000D-03/
      DATA RELCOR( 6)/ 3.000000026D-03/
      DATA (IFUNTYP(6, I), I = 1, 3)/2, 2, 2/
      DATA (NPARMS( 6, I), I = 1, 3)/10, 10, 10/
C * DATA FOR N  ELEMENT # 7
      DATA XKPCOR( 7)/ 2.000000000D-03/
      DATA RELCOR( 7)/ 4.999999888D-03/
      DATA (IFUNTYP(7, I), I = 1, 4)/2, 2, 2, 2/
      DATA (NPARMS( 7, I), I = 1, 4)/10, 10, 10, 10/
C * DATA FOR O  ELEMENT # 8
      DATA XKPCOR( 8)/ 3.000000000D-03/
      DATA RELCOR( 8)/ 7.000000216D-03/
      DATA (IFUNTYP(8, I), I = 1, 4)/2, 2, 2, 2/
      DATA (NPARMS( 8, I), I = 1, 4)/10, 10, 10, 10/
C * DATA FOR F  ELEMENT # 9
      DATA XKPCOR( 9)/ 4.000000000D-03/
      DATA RELCOR( 9)/ 8.999999613D-03/
      DATA (IFUNTYP(9, I), I = 1, 4)/2, 2, 2, 2/
      DATA (NPARMS( 9, I), I = 1, 4)/10, 10, 10, 10/
C * DATA FOR NE ELEMENT #10
      DATA XKPCOR(10)/ 4.000000000D-03/
      DATA RELCOR(10)/ 1.099999994D-02/
      DATA (IFUNTYP(10, I), I = 1, 4)/2, 2, 2, 2/
      DATA (NPARMS( 10, I), I = 1, 4)/10, 10, 10, 10/
C * DATA FOR NA ELEMENT #11
      DATA XKPCOR(11)/ 6.000000000D-03/
      DATA RELCOR(11)/ 1.400000043D-02/
      DATA (IFUNTYP(11, I), I = 1, 4)/0, 2, 2, 2/
      DATA (NPARMS( 11, I), I = 1, 4)/11, 10, 10, 10/
C * DATA FOR MG ELEMENT #12
      DATA XKPCOR(12)/ 8.000000000D-03/
      DATA RELCOR(12)/ 1.799999923D-02/
      DATA (IFUNTYP(12, I), I = 1, 4)/0, 2, 2, 2/
      DATA (NPARMS( 12, I), I = 1, 4)/11, 10, 10, 10/
C * DATA FOR AL ELEMENT #13
      DATA XKPCOR(13)/ 8.000000000D-03/
      DATA RELCOR(13)/ 2.099999972D-02/
      DATA (IFUNTYP(13, I), I = 1, 5)/0, 2, 2, 2, 2/
      DATA (NPARMS( 13, I), I = 1, 5)/11, 10, 10, 10, 10/
C * DATA FOR SI ELEMENT #14
      DATA XKPCOR(14)/ 1.100000000D-02/
      DATA RELCOR(14)/ 2.600000054D-02/
      DATA (IFUNTYP(14, I), I = 1, 6)/0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 14, I), I = 1, 6)/11, 10, 10, 10, 10, 10/
C * DATA FOR P  ELEMENT #15
      DATA XKPCOR(15)/ 1.200000000D-02/
      DATA RELCOR(15)/ 2.999999933D-02/
      DATA (IFUNTYP(15, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 15, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR S  ELEMENT #16
      DATA XKPCOR(16)/ 1.400000000D-02/
      DATA RELCOR(16)/ 3.500000015D-02/
      DATA (IFUNTYP(16, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 16, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR CL ELEMENT #17
      DATA XKPCOR(17)/ 1.700000000D-02/
      DATA RELCOR(17)/ 4.100000113D-02/
      DATA (IFUNTYP(17, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 17, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR AR ELEMENT #18
      DATA XKPCOR(18)/ 2.000000000D-02/
      DATA RELCOR(18)/ 4.699999839D-02/
      DATA (IFUNTYP(18, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 18, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR K  ELEMENT #19
      DATA XKPCOR(19)/ 2.200000000D-02/
      DATA RELCOR(19)/ 5.299999937D-02/
      DATA (IFUNTYP(19, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 19, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR CA ELEMENT #20
      DATA XKPCOR(20)/ 2.500000000D-02/
      DATA RELCOR(20)/ 5.999999866D-02/
      DATA (IFUNTYP(20, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 20, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR SC ELEMENT #21
      DATA XKPCOR(21)/ 2.800000000D-02/
      DATA RELCOR(21)/ 6.800000370D-02/
      DATA (IFUNTYP(21, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 21, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR TI ELEMENT #22
      DATA XKPCOR(22)/ 3.100000000D-02/
      DATA RELCOR(22)/ 7.500000298D-02/
      DATA (IFUNTYP(22, I), I = 1, 7)/0, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 22, I), I = 1, 7)/11, 10, 10, 10, 10, 10, 10/
C * DATA FOR V  ELEMENT #23
      DATA XKPCOR(23)/ 3.500000000D-02/
      DATA RELCOR(23)/ 8.399999887D-02/
      DATA (IFUNTYP(23, I), I = 1, 8)/0, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 23, I), I = 1, 8)/11, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR CR ELEMENT #24
      DATA XKPCOR(24)/ 3.900000000D-02/
      DATA RELCOR(24)/ 9.300000221D-02/
      DATA (IFUNTYP(24, I), I = 1, 9)/0, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 24, I), I = 1, 9)/11, 10, 10, 10, 10, 10, 10, 10,
     1 10/
C * DATA FOR MN ELEMENT #25
      DATA XKPCOR(25)/ 4.200000000D-02/
      DATA RELCOR(25)/ 0.101999998D0  /
      DATA (IFUNTYP(25, I), I = 1, 9)/0, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 25, I), I = 1, 9)/11, 10, 10, 10, 10, 10, 10, 10,
     1 10/
C * DATA FOR FE ELEMENT #26
      DATA XKPCOR(26)/ 4.800000000D-02/
      DATA RELCOR(26)/ 0.112999998D0  /
      DATA (IFUNTYP(26, I), I = 1, 9)/0, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 26, I), I = 1, 9)/11, 10, 10, 10, 10, 10, 10, 10,
     1 10/
C * DATA FOR CO ELEMENT #27
      DATA XKPCOR(27)/ 5.200000000D-02/
      DATA RELCOR(27)/ 0.123000003D0  /
      DATA (IFUNTYP(27, I), I = 1, 9)/0, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 27, I), I = 1, 9)/11, 10, 10, 10, 10, 10, 10, 10,
     1 10/
C * DATA FOR NI ELEMENT #28
      DATA XKPCOR(28)/ 5.700000000D-02/
      DATA RELCOR(28)/ 0.135000005D0  /
      DATA (IFUNTYP(28, I), I = 1, 9)/0, 0, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 28, I), I = 1, 9)/11, 11, 10, 10, 10, 10, 10, 10,
     1 10/
C * DATA FOR CU ELEMENT #29
      DATA XKPCOR(29)/ 6.100000000D-02/
      DATA RELCOR(29)/ 0.145999998D0  /
      DATA (IFUNTYP(29, I), I = 1, 9)/0, 0, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 29, I), I = 1, 9)/11, 11, 10, 10, 10, 10, 10, 10,
     1 10/
C * DATA FOR ZN ELEMENT #30
      DATA XKPCOR(30)/ 6.700000000D-02/
      DATA RELCOR(30)/ 0.158999994D0  /
      DATA (IFUNTYP(30, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 30, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR GA ELEMENT #31
      DATA XKPCOR(31)/ 7.300000000D-02/
      DATA RELCOR(31)/ 0.172000006D0  /
      DATA (IFUNTYP(31, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 31, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR GE ELEMENT #32
      DATA XKPCOR(32)/ 7.900000000D-02/
      DATA RELCOR(32)/ 0.186000004D0  /
      DATA (IFUNTYP(32, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 32, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR AS ELEMENT #33
      DATA XKPCOR(33)/ 8.500000000D-02/
      DATA RELCOR(33)/ 0.200000003D0  /
      DATA (IFUNTYP(33, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 33, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR SE ELEMENT #34
      DATA XKPCOR(34)/ 9.200000000D-02/
      DATA RELCOR(34)/ 0.215000004D0  /
      DATA (IFUNTYP(34, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 34, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR BR ELEMENT #35
      DATA XKPCOR(35)/ 9.900000000D-02/
      DATA RELCOR(35)/ 0.231000006D0  /
      DATA (IFUNTYP(35, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 35, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR KR ELEMENT #36
      DATA XKPCOR(36)/ 1.060000000D-01/
      DATA RELCOR(36)/ 0.246999994D0  /
      DATA (IFUNTYP(36, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 36, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR RB ELEMENT #37
      DATA XKPCOR(37)/ 1.140000000D-01/
      DATA RELCOR(37)/ 0.263999999D0  /
      DATA (IFUNTYP(37, I), I = 1, 9)/0, 0, 0, 0, 2, 2, 2, 2, 2/
      DATA (NPARMS( 37, I), I = 1, 9)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10/
C * DATA FOR SR ELEMENT #38
      DATA XKPCOR(38)/ 1.220000000D-01/
      DATA RELCOR(38)/ 0.282000005D0  /
      DATA (IFUNTYP(38, I), I = 1, 12)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2/
      DATA (NPARMS( 38, I), I = 1, 12)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10/
C * DATA FOR Y  ELEMENT #39
      DATA XKPCOR(39)/ 1.300000000D-01/
      DATA RELCOR(39)/ 0.300000012D0  /
      DATA (IFUNTYP(39, I), I = 1, 12)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2/
      DATA (NPARMS( 39, I), I = 1, 12)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10/
C * DATA FOR ZR ELEMENT #40
      DATA XKPCOR(40)/ 1.380000000D-01/
      DATA RELCOR(40)/ 0.319000006D0  /
      DATA (IFUNTYP(40, I), I = 1, 13)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2/
      DATA (NPARMS( 40, I), I = 1, 13)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10/
C * DATA FOR NB ELEMENT #41
      DATA XKPCOR(41)/ 1.470000000D-01/
      DATA RELCOR(41)/ 0.338000000D0  /
      DATA (IFUNTYP(41, I), I = 1, 13)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2/
      DATA (NPARMS( 41, I), I = 1, 13)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10/
C * DATA FOR MO ELEMENT #42
      DATA XKPCOR(42)/1.560000000D-01/
      DATA RELCOR(42)/ 0.358999997D0  /
      DATA (IFUNTYP(42, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 42, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR TC ELEMENT #43
      DATA XKPCOR(43)/1.660000000D-01/
      DATA RELCOR(43)/ 0.379999995D0  /
      DATA (IFUNTYP(43, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 43, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR RU ELEMENT #44
      DATA XKPCOR(44)/1.750000000D-01/
      DATA RELCOR(44)/ 0.400999993D0  /
      DATA (IFUNTYP(44, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 44, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR RH ELEMENT #45
      DATA XKPCOR(45)/1.860000000D-01/
      DATA RELCOR(45)/ 0.423999995D0  /
      DATA (IFUNTYP(45, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 45, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR PD ELEMENT #46
      DATA XKPCOR(46)/1.960000000D-01/
      DATA RELCOR(46)/ 0.446999997D0  /
      DATA (IFUNTYP(46, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 46, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR AG ELEMENT #47
      DATA XKPCOR(47)/2.070000000D-01/
      DATA RELCOR(47)/ 0.470999986D0  /
      DATA (IFUNTYP(47, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 47, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR CD ELEMENT #48
      DATA XKPCOR(48)/2.190000000D-01/
      DATA RELCOR(48)/ 0.495999992D0  /
      DATA (IFUNTYP(48, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 48, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR IN ELEMENT #49
      DATA XKPCOR(49)/2.30000000D-01/
      DATA RELCOR(49)/ 0.521000028D0  /
      DATA (IFUNTYP(49, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 49, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR SN ELEMENT #50
      DATA XKPCOR(50)/2.42000000D-01/
      DATA RELCOR(50)/ 0.546999991D0  /
      DATA (IFUNTYP(50, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 50, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR SB ELEMENT #51
      DATA XKPCOR(51)/2.55000000D-01/
      DATA RELCOR(51)/ 0.574999988D0  /
      DATA (IFUNTYP(51, I), I = 1, 14)/0, 0, 0, 0, 2, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 51, I), I = 1, 14)/11, 11, 11, 11, 10, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR TE ELEMENT #52
      DATA XKPCOR(52)/2.67000000D-01/
      DATA RELCOR(52)/ 0.601999998D0  /
      DATA (IFUNTYP(52, I), I = 1, 14)/0, 0, 0, 0, 0, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 52, I), I = 1, 14)/11, 11, 11, 11, 11, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR I  ELEMENT #53
      DATA XKPCOR(53)/2.81000000D-01/
      DATA RELCOR(53)/ 0.630999982D0  /
      DATA (IFUNTYP(53, I), I = 1, 14)/0, 0, 0, 0, 0, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 53, I), I = 1, 14)/11, 11, 11, 11, 11, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR XE ELEMENT #54
      DATA XKPCOR(54)/2.94000000D-01/
      DATA RELCOR(54)/ 0.660000026D0  /
      DATA (IFUNTYP(54, I), I = 1, 14)/0, 0, 0, 0, 0, 2, 2, 2, 2, 2,
     1 2, 2, 2, 2/
      DATA (NPARMS( 54, I), I = 1, 14)/11, 11, 11, 11, 11, 10, 10, 10,
     1 10, 10, 10, 10, 10, 10/
C * DATA FOR CS ELEMENT #55
      DATA XKPCOR(55)/3.08000000D-01/
      DATA RELCOR(55)/ 0.689999998D0  /
      DATA (IFUNTYP(55, I), I = 1, 17)/0, 0, 0, 0, 0, 0, 2, 2, 2, 2,
     1 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 55, I), I = 1, 17)/11, 11, 11, 11, 11, 11, 10, 10,
     1 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR BA ELEMENT #56
      DATA XKPCOR(56)/3.23000000D-01/
      DATA RELCOR(56)/ 0.721000016D0  /
      DATA (IFUNTYP(56, I), I = 1, 17)/0, 0, 0, 0, 0, 0, 0, 2, 2, 2,
     1 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 56, I), I = 1, 17)/11, 11, 11, 11, 11, 11, 11, 10,
     1 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR LA ELEMENT #57
      DATA XKPCOR(57)/3.38000000D-01/
      DATA RELCOR(57)/ 0.753000021D0  /
      DATA (IFUNTYP(57, I), I = 1, 17)/0, 0, 0, 0, 0, 0, 0, 2, 2, 2,
     1 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 57, I), I = 1, 17)/11, 11, 11, 11, 11, 11, 11, 10,
     1 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR CE ELEMENT #58
      DATA XKPCOR(58)/3.54000000D-01/
      DATA RELCOR(58)/ 0.786000013D0  /
      DATA (IFUNTYP(58, I), I = 1, 18)/0, 0, 0, 0, 0, 0, 0, 2, 2, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 58, I), I = 1, 18)/11, 11, 11, 11, 11, 11, 11, 10,
     1 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR PR ELEMENT #59
      DATA XKPCOR(59)/3.69000000D-01/
      DATA RELCOR(59)/ 0.819000006D0  /
      DATA (IFUNTYP(59, I), I = 1, 18)/0, 0, 0, 0, 0, 0, 0, 2, 2, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 59, I), I = 1, 18)/11, 11, 11, 11, 11, 11, 11, 10,
     1 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR ND ELEMENT #60
      DATA XKPCOR(60)/3.86000000D-01/
      DATA RELCOR(60)/ 0.853999972D0  /
      DATA (IFUNTYP(60, I), I = 1, 18)/0, 0, 0, 0, 0, 0, 0, 2, 2, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 60, I), I = 1, 18)/11, 11, 11, 11, 11, 11, 11, 10,
     1 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR PM ELEMENT #61
      DATA XKPCOR(61)/4.02000000D-01/
      DATA RELCOR(61)/ 0.888999999D0  /
      DATA (IFUNTYP(61, I), I = 1, 18)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 61, I), I = 1, 18)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR SM ELEMENT #62
      DATA XKPCOR(62)/4.19000000D-01/
      DATA RELCOR(62)/ 0.925000012D0  /
      DATA (IFUNTYP(62, I), I = 1, 18)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 62, I), I = 1, 18)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR EU ELEMENT #63
      DATA XKPCOR(63)/4.37000000D-01/
      DATA RELCOR(63)/ 0.962000012D0  /
      DATA (IFUNTYP(63, I), I = 1, 18)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 63, I), I = 1, 18)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR GD ELEMENT #64
      DATA XKPCOR(64)/4.55000000D-01/
      DATA RELCOR(64)/  1.00000000D0  /
      DATA (IFUNTYP(64, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 64, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR TB ELEMENT #65
      DATA XKPCOR(65)/4.74000000D-01/
      DATA RELCOR(65)/  1.03900003D0  /
      DATA (IFUNTYP(65, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 65, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR DY ELEMENT #66
      DATA XKPCOR(66)/4.93000000D-01/
      DATA RELCOR(66)/  1.07900000D0  /
      DATA (IFUNTYP(66, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 66, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR HO ELEMENT #67
      DATA XKPCOR(67)/5.12000000D-01/
      DATA RELCOR(67)/  1.11899996D0  /
      DATA (IFUNTYP(67, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 67, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR ER ELEMENT #68
      DATA XKPCOR(68)/5.32000000D-01/
      DATA RELCOR(68)/  1.16100001D0  /
      DATA (IFUNTYP(68, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 68, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR TM ELEMENT #69
      DATA XKPCOR(69)/5.53000000D-01/
      DATA RELCOR(69)/  1.20400000D0  /
      DATA (IFUNTYP(69, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 69, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR YB ELEMENT #70
      DATA XKPCOR(70)/5.74000000D-01/
      DATA RELCOR(70)/  1.24800003D0  /
      DATA (IFUNTYP(70, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 70, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR LU ELEMENT #71
      DATA XKPCOR(71)/5.96000000D-01/
      DATA RELCOR(71)/  1.29299998D0  /
      DATA (IFUNTYP(71, I), I = 1, 19)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 71, I), I = 1, 19)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR HF ELEMENT #72
      DATA XKPCOR(72)/6.17000000D-01/
      DATA RELCOR(72)/  1.33800006D0  /
      DATA (IFUNTYP(72, I), I = 1, 20)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 72, I), I = 1, 20)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR TA ELEMENT #73
      DATA XKPCOR(73)/6.40000000D-01/
      DATA RELCOR(73)/  1.38499999D0  /
      DATA (IFUNTYP(73, I), I = 1, 20)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 73, I), I = 1, 20)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR W  ELEMENT #74
      DATA XKPCOR(74)/6.63000000D-01/
      DATA RELCOR(74)/  1.43299997D0  /
      DATA (IFUNTYP(74, I), I = 1, 20)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 74, I), I = 1, 20)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR RE ELEMENT #75
      DATA XKPCOR(75)/6.87000000D-01/
      DATA RELCOR(75)/  1.48199999D0  /
      DATA (IFUNTYP(75, I), I = 1, 21)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 75, I), I = 1, 21)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR OS ELEMENT #76
      DATA XKPCOR(76)/7.11000000D-01/
      DATA RELCOR(76)/  1.53199995D0  /
      DATA (IFUNTYP(76, I), I = 1, 21)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 76, I), I = 1, 21)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR IR ELEMENT #77
      DATA XKPCOR(77)/7.36000000D-01/
      DATA RELCOR(77)/  1.58299994D0  /
      DATA (IFUNTYP(77, I), I = 1, 21)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 77, I), I = 1, 21)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR PT ELEMENT #78
      DATA XKPCOR(78)/7.62000000D-01/
      DATA RELCOR(78)/  1.63600004D0  /
      DATA (IFUNTYP(78, I), I = 1, 21)/0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 78, I), I = 1, 21)/11, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR AU ELEMENT #79
      DATA XKPCOR(79)/7.88000000D-01/
      DATA RELCOR(79)/  1.68900001D0  /
      DATA (IFUNTYP(79, I), I = 1, 21)/1, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 79, I), I = 1, 21)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR HG ELEMENT #80
      DATA XKPCOR(80)/8.14000000D-01/
      DATA RELCOR(80)/  1.74300003D0  /
      DATA (IFUNTYP(80, I), I = 1, 22)/1, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 80, I), I = 1, 22)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR TL ELEMENT #81
      DATA XKPCOR(81)/8.42000000D-01/
      DATA RELCOR(81)/  1.79900002D0  /
      DATA (IFUNTYP(81, I), I = 1, 22)/1, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 81, I), I = 1, 22)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR PB ELEMENT #82
      DATA XKPCOR(82)/8.70000000D-01/
      DATA RELCOR(82)/  1.85599995D0  /
      DATA (IFUNTYP(82, I), I = 1, 23)/1, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 82, I), I = 1, 23)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR BI ELEMENT #83
      DATA XKPCOR(83)/8.99000000D-01/
      DATA RELCOR(83)/  1.91400003D0  /
      DATA (IFUNTYP(83, I), I = 1, 23)/1, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 83, I), I = 1, 23)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR PO ELEMENT #84
      DATA XKPCOR(84)/9.28000000D-01/
      DATA RELCOR(84)/  1.97300005D0  /
      DATA (IFUNTYP(84, I), I = 1, 24)/1, 0, 0, 0, 0, 0, 0, 0, 0, 2,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 84, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR AT ELEMENT #85
      DATA XKPCOR(85)/9.57000000D-01/
      DATA RELCOR(85)/  2.03299999D0  /
      DATA (IFUNTYP(85, I), I = 1, 24)/1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 85, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR RN ELEMENT #86
      DATA XKPCOR(86)/9.88000000D-01/
      DATA RELCOR(86)/  2.09500003D0  /
      DATA (IFUNTYP(86, I), I = 1, 24)/1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 86, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR FR ELEMENT #87
      DATA XKPCOR(87)/1.01800000D-00/
      DATA RELCOR(87)/  2.15700006D0  /
      DATA (IFUNTYP(87, I), I = 1, 24)/1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 87, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR RA ELEMENT #88
      DATA XKPCOR(88)/1.05000000D-00/
      DATA RELCOR(88)/  2.22099996D0  /
      DATA (IFUNTYP(88, I), I = 1, 24)/1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 88, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR AC ELEMENT #89
      DATA XKPCOR(89)/1.08300000D-00/
      DATA RELCOR(89)/  2.28699994D0  /
      DATA (IFUNTYP(89, I), I = 1, 24)/1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS( 89, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR TH ELEMENT #90
      DATA XKPCOR(90)/1.11500000D-00/
      DATA RELCOR(90)/  2.35299993D0  /
      DATA (IFUNTYP(90, I), I = 1, 24)/ 1,  0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS(90, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR PA ELEMENT #91
      DATA XKPCOR(91)/1.14900000D-00/
      DATA RELCOR(91)/  2.42100000D0  /
      DATA (IFUNTYP(91, I), I = 1, 24)/ 1,  0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS(91, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR U  ELEMENT #92
      DATA XKPCOR(92)/1.18400000D-00/
      DATA RELCOR(92)/  2.49000001D0  /
      DATA (IFUNTYP(92, I), I = 1, 24)/ 1,  0, 0, 0, 0, 0, 0, 0, 0, 0,
     1 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
      DATA (NPARMS(92, I), I = 1, 24)/10, 11, 11, 11, 11, 11, 11, 11,
     1 11, 11, 11, 11, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10/
C * DATA FOR H  ELEMENT # 1
      DATA NORB( 1)/ 1/
      DATA BINDNRG( 1, 1)/ 14.D-3/
C * DATA FOR HE ELEMENT # 2
      DATA NORB( 2)/ 1/
      DATA BINDNRG( 2, 1)/ 25.D-3/
C * DATA FOR LI ELEMENT # 3
      DATA NORB( 3)/ 2/
      DATA (BINDNRG( 3, II), II = 1, 2)/
     1 5.474999920D-02, 5.34000014D-03/
C * DATA FOR BE ELEMENT # 4
      DATA NORB( 4)/ 2/
      DATA (BINDNRG( 4, II), II = 1, 2)/
     1 0.111000001D0, 8.419999853D-03/
C * DATA FOR B  ELEMENT # 5
      DATA NORB( 5)/ 3/
      DATA (BINDNRG( 5, II), II = 1, 3)/
     1 0.187999994D0, 1.346999966D-02, 4.699999932D-03/
C * DATA FOR C  ELEMENT # 6
      DATA NORB( 6)/ 3/
      DATA (BINDNRG( 6, II), II = 1, 3)/
     1 0.283800006D0, 1.951000094D-02, 6.399999838D-03/
C * DATA FOR N  ELEMENT # 7
      DATA NORB( 7)/ 4/
      DATA (BINDNRG( 7, II), II = 1, 4)/
     1 0.401600003D0, 2.631000057D-02, 9.200000204D-03, 9.200000204D-03/
C * DATA FOR O  ELEMENT # 8
      DATA NORB( 8)/ 4/
      DATA (BINDNRG( 8, II), II = 1, 4)/
     1 0.532000005D0, 2.370000072D-02, 7.100000046D-03, 7.100000046D-03/
C * DATA FOR F  ELEMENT # 9
      DATA NORB( 9)/ 4/
      DATA (BINDNRG( 9, II), II = 1, 4)/
     1 0.685400009D0, 3.100000136D-02, 8.600000292D-03, 8.600000292D-03/
C * DATA FOR NE ELEMENT #10
      DATA NORB(10)/ 4/
      DATA (BINDNRG(10, II), II = 1, 4)/
     1 0.866899967D0, 4.500000179D-02, 1.830000058D-02, 1.830000058D-02/
C * DATA FOR NA ELEMENT #11
      DATA NORB(11)/ 4/
      DATA (BINDNRG(11, II), II = 1, 4)/
     1 1.07210004D0, 6.329999864D-02, 3.109999932D-02, 3.109999932D-02/
C * DATA FOR MG ELEMENT #12
      DATA NORB(12)/ 4/
      DATA (BINDNRG(12, II), II = 1, 4)/
     1 1.30499995D0, 8.940000087D-02, 5.140000209D-02, 5.140000209D-02/
C * DATA FOR AL ELEMENT #13
      DATA NORB(13)/ 5/
      DATA (BINDNRG(13, II), II = 1, 5)/
     1 1.55960000D0, 0.117700003D0, 7.310000062D-02, 7.310000062D-02,
     2 8.375665173D-03/
C * DATA FOR SI ELEMENT #14
      DATA NORB(14)/ 6/
      DATA (BINDNRG(14, II), II = 1, 6)/
     1 1.83889997D0, 0.148699999D0, 9.920000285D-02, 9.920000285D-02,
     2 1.135716774D-02, 5.083053838D-03/
C * DATA FOR P  ELEMENT #15
      DATA NORB(15)/ 7/
      DATA (BINDNRG(15, II), II = 1, 7)/
     1 2.14549994D0, 0.189300001D0, 0.132200003D0, 0.132200003D0,
     2 1.446149126D-02, 6.384930108D-03, 6.336690858D-03/
C * DATA FOR S  ELEMENT #16
      DATA NORB(16)/ 7/
      DATA (BINDNRG(16, II), II = 1, 7)/
     1 2.47200012D0, 0.229200006D0, 0.164800003D0, 0.164800003D0,
     2 1.768823154D-02, 7.813631557D-03, 7.734877989D-03/
C * DATA FOR CL ELEMENT #17
      DATA NORB(17)/ 7/
      DATA (BINDNRG(17, II), II = 1, 7)/
     1 2.82239985D0, 0.270199984D0, 0.201600000D0, 0.200000003D0,
     2 1.750000007D-02, 6.800000090D-03, 6.800000090D-03/
C * DATA FOR AR ELEMENT #18
      DATA NORB(18)/ 7/
      DATA (BINDNRG(18, I), I = 1, 7)/
     1 3.20290017D0, 0.319999993D0, 0.247299999D0, 0.245199993D0,
     2 2.529999986D-02, 1.240000036D-02, 1.240000036D-02/
C * DATA FOR K  ELEMENT #19
      DATA NORB(19)/ 7/
      DATA (BINDNRG(19, I), I = 1, 7)/
     1 3.60739994D0, 0.377099991D0, 0.296299994D0, 0.293599993D0,
     2 3.390000015D-02, 1.779999956D-02, 1.779999956D-02/
C * DATA FOR CA ELEMENT #20
      DATA NORB(20)/ 7/
      DATA (BINDNRG(20, I), I = 1, 7)/
     1 4.03809977D0, 0.437799990D0, 0.349999994D0, 0.346399993D0,
     2 4.369999841D-02, 2.539999969D-02, 2.539999969D-02/
C * DATA FOR SC ELEMENT #21
      DATA NORB(21)/ 7/
      DATA (BINDNRG(21, I), I = 1, 7)/
     1 4.49279976D0, 0.500400007D0, 0.406699985D0, 0.402200013D0,
     2 5.380000174D-02, 3.229999915D-02, 3.229999915D-02/
C * DATA FOR TI ELEMENT #22
      DATA NORB(22)/ 7/
      DATA (BINDNRG(22, I), I = 1, 7)/
     1 4.96640015D0, 0.563700020D0, 0.461499989D0, 0.455500007D0,
     2 6.030000001D-02, 3.460000083D-02, 3.460000083D-02/
C * DATA FOR V  ELEMENT #23
      DATA NORB(23)/ 8/
      DATA (BINDNRG(23, I), I = 1, 8)/
     1 5.46509981D0, 0.628199995D0, 0.520500004D0, 0.512899995D0,
     2 6.650000066D-02, 3.779999912D-02,3.779999912D-02,2.199999988D-03/
C * DATA FOR CR ELEMENT #24
      DATA NORB(24)/ 9/
      DATA (BINDNRG(24, I), I = 1, 9)/
     1 5.98920012D0, 0.694599986D0, 0.583700001D0, 0.574500024D0,
     2 7.410000265D-02, 4.250000045D-02,4.250000045D-02,2.300000051D-03,
     3 2.300000051D-03/
C * DATA FOR MN ELEMENT #25
      DATA NORB(25)/ 9/
      DATA (BINDNRG(25, I), I = 1, 9)/
     1 6.53900003D0, 0.768999994D0, 0.651399970D0, 0.640299976D0,
     2 8.389999717D-02, 4.859999940D-02, 4.859999940D-02,
     3 7.261591498D-03, 7.143782452D-03/
C * DATA FOR FE ELEMENT #26
      DATA NORB(26)/ 9/
      DATA (BINDNRG(26, I), I = 1, 9)/
     1 7.11199999D0, 0.846100032D0, 0.721100032D0, 0.708100021D0,
     2 9.290000051D-02, 5.400000140D-02, 5.400000140D-02,
     3 3.599999938D-03, 3.599999938D-03/
C * DATA FOR CO ELEMENT #27
      DATA NORB(27)/ 9/
      DATA (BINDNRG(27, I), I = 1, 9)/
     1 7.70889997D0, 0.925599992D0, 0.793600023D0, 0.778599977D0,
     2 0.100699998D0, 5.950000137D-02, 5.950000137D-02, 2.899999963D-03,
     3 2.899999963D-03/
C * DATA FOR NI ELEMENT #28
      DATA NORB(28)/ 9/
      DATA (BINDNRG(28, I), I = 1, 9)/
     1 8.33279991D0, 1.00810003D0, 0.871900022D0, 0.854700029D0,
     2 0.111800000D0, 6.809999794D-02, 6.809999794D-02, 3.599999938D-03,
     3 3.599999938D-03/
C * DATA FOR CU ELEMENT #29
      DATA NORB(29)/ 9/
      DATA (BINDNRG(29, I), I = 1, 9)/
     1 8.97889996D0, 1.09609997D0, 0.950999975D0, 0.931100011D0,
     2 0.119800001D0, 7.360000163D-02, 7.360000163D-02, 1.600000076D-03,
     3 1.600000076D-03/
C * DATA FOR ZN ELEMENT #30
      DATA NORB(30)/ 9/
      DATA (BINDNRG(30, I), I = 1, 9)/
     1 9.65859985D0, 1.19360006D0, 1.04279995D0, 1.01970005D0,
     2 0.135900006D0, 8.659999818D-02, 8.659999818D-02, 8.100000210D-03,
     3 8.100000210D-03/
C * DATA FOR GA ELEMENT #31
      DATA NORB(31)/ 9/
      DATA (BINDNRG(31, I), I = 1, 9)/
     1 10.3670998D0, 1.29770005D0, 1.14230001D0, 1.11539996D0,
     2 0.158100009D0, 0.10679999D0, 0.102899998D0, 1.740000024D-02,
     3 1.740000024D-02/
C * DATA FOR GE ELEMENT #32
      DATA NORB(32)/ 9/
      DATA (BINDNRG(32, I), I = 1, 9)/
     1 11.1030998D0, 1.41429996D0, 1.24779999D0, 1.21669996D0,
     2 0.180000007D0, 0.127900004D0, 0.120800003D0, 2.869999968D-02,
     3 2.869999968D-02/
C * DATA FOR AS ELEMENT #33
      DATA NORB(33)/ 9/
      DATA (BINDNRG(33, I), I = 1, 9)/
     1 11.8667002D0, 1.52650011D0, 1.35860002D0, 1.32309997D0,
     2 0.203500003D0, 0.146400005D0, 0.140500009D0, 4.120000079D-02,
     3 4.120000079D-02/
C * DATA FOR SE ELEMENT #34
      DATA NORB(34)/ 9/
      DATA (BINDNRG(34, I), I = 1, 9)/
     1 12.6577997D0, 1.65390003D0, 1.47619998D0, 1.43580008D0,
     2 0.231500000D0, 0.168200001D0, 0.161899999D0, 5.669999868D-02,
     3 5.669999868D-02/
C * DATA FOR BR ELEMENT #35
      DATA NORB(35)/ 9/
      DATA (BINDNRG(35, I), I = 1, 9)/
     1 13.4736996D0, 1.78200006D0, 1.59599996D0, 1.54990005D0,
     2 0.256500006D0, 0.189300001D0, 0.181500003D0, 7.010000199D-02,
     3 6.899999827D-02/
C * DATA FOR KR ELEMENT #36
      DATA NORB(36)/ 9/
      DATA (BINDNRG(36, I), I = 1, 9)/
     1 14.3255997D0, 1.92100000D0, 1.72720003D0, 1.67489994D0,
     2 0.288329989D0, 0.222700000D0, 0.213799998D0, 8.889999986D-02,
     3 8.889999986D-02/
C * DATA FOR RB ELEMENT #37
      DATA NORB(37)/ 9/
      DATA (BINDNRG(37, I), I = 1, 9)/
     1 15.1996994D0, 2.06509995D0, 1.86389995D0, 1.80439997D0,
     2 0.322100013D0, 0.247400001D0, 0.238499999D0, 0.111800000D0,
     3 0.110299997D0/
C * DATA FOR SR ELEMENT #38
      DATA NORB(38)/12/
      DATA (BINDNRG(38, I), I = 1, 12)/
     1 16.1046009D0, 2.21630001D0, 2.00680017D0, 1.93959999D0,
     2 0.357499987D0, 0.279799998D0, 0.269100010D0, 0.135000005D0,
     3 0.133100003D0, 3.770000115D-02, 1.989999972D-02, 1.989999972D-02/
C * DATA FOR Y  ELEMENT #39
      DATA NORB(39)/12/
      DATA (BINDNRG(39, I), I = 1, 12)/
     1 17.0383987D0, 2.37249994D0, 2.15549994D0, 2.07999992D0,
     2 0.393600017D0, 0.312400013D0, 0.300300002D0, 0.159599990D0,
     3 0.157399997D0, 4.540000111D-02, 2.559999935D-02, 2.559999935D-02/
C * DATA FOR ZR ELEMENT #40
      DATA NORB(40)/13/
      DATA (BINDNRG(40, I), I = 1, 13)/
     1 17.9976006D0, 2.53160000D0, 2.30669999D0, 2.22230005D0,
     2 0.430299997D0, 0.344199985D0, 0.330500007D0, 0.182400003D0,
     3 0.180000007D0, 5.130000040D-02, 2.869999968D-02,2.869999968D-02,
     4 4.023449495D-03/
C * DATA FOR NB ELEMENT #41
      DATA NORB(41)/13/
      DATA (BINDNRG(41, I), I = 1, 13)/
     1 18.9855995D0, 2.69770002D0, 2.46469998D0, 2.37050009D0,
     2 0.468400002D0, 0.378399998D0, 0.363000005D0, 0.207399994D0,
     3 0.204600006D0, 5.810000002D-02, 3.390000015D-02, 3.390000015D-02,
     4 3.199999919D-03/
C * DATA FOR MO ELEMENT #42
      DATA NORB(42)/14/
      DATA (BINDNRG(42, I), I = 1, 14)/
     1 19.9995003D0, 2.86549997D0, 2.62510014D0, 2.52020001D0,
     2 0.504599988D0, 0.409700006D0, 0.392300010D0, 0.230300009D0,
     3 0.226999998D0, 6.179999933D-02, 3.480000049D-02, 3.480000049D-02,
     4 1.800000085D-03,1.800000085D-03/
C * DATA FOR TC ELEMENT #43
      DATA NORB(43)/14/
      DATA (BINDNRG(43, I), I = 1, 14)/
     1 21.0439987D0, 3.04250002D0, 2.79320002D0, 2.67689991D0,
     2 0.547599971D0, 0.444900006D0, 0.425000012D0, 0.256399989D0,
     3 0.252900004D0, 6.840000302D-02, 3.889999911D-02, 3.889999911D-02,
     4 7.011581678D-03, 6.729420740D-03/
C * DATA FOR RU ELEMENT #44
      DATA NORB(44)/14/
      DATA (BINDNRG(44, I), I = 1, 14)/
     1 22.1172009D0, 3.22399998D0, 2.96689987D0, 2.83789992D0,
     2 0.584999979D0, 0.482800007D0, 0.460600019D0, 0.283600003D0,
     3 0.279399991D0, 7.490000129D-02, 4.309999943D-02, 4.309999943D-02,
     4 2.000000095D-03,2.000000095D-03/
C * DATA FOR RH ELEMENT #45
      DATA NORB(45)/14/
      DATA (BINDNRG(45, I), I = 1, 14)/
     1 23.2199001D0, 3.41190004D0, 3.14610004D0, 3.00379992D0,
     2 0.627099991D0, 0.521000028D0, 0.496199995D0, 0.311700016D0,
     3 0.306999981D0, 8.100000024D-02, 4.789999872D-02,4.789999872D-02,
     4 2.499999944D-03, 2.499999944D-03/
C * DATA FOR PD ELEMENT #46
      DATA NORB(46)/14/
      DATA (BINDNRG(46, I), I = 1, 14)/
     1 24.3502998D0, 3.60430002D0, 3.33030009D0, 3.17330003D0,
     2 0.669900000D0, 0.559099972D0, 0.531499982D0, 0.340000004D0,
     3 0.334699988D0, 8.640000224D-02, 5.110000074D-02, 5.110000074D-02,
     4 5.446631927D-03, 5.018413067D-03/
C * DATA FOR AG ELEMENT #47
      DATA NORB(47)/14/
      DATA (BINDNRG(47, I), I = 1, 14)/
     1 25.5139999D0, 3.8057999D0, 3.52370000D0, 3.35109997D0,
     2 0.717499971D0, 0.602400005D0, 0.571399987D0, 0.372799993D0,
     3 0.366699994D0, 9.520000219D-02, 6.260000169D-02, 5.590000004D-02,
     4 3.299999982D-03, 3.299999982D-03/
C * DATA FOR CD ELEMENT #48
      DATA NORB(48)/14/
      DATA (BINDNRG(48,I), I = 1, 14)/
     1 26.7112007D0, 4.01800013D0, 3.72700000D0, 3.53749990D0,
     2 0.770200014D0, 0.650699973D0, 0.616500020D0, 0.410499990D0,
     3 0.403699994D0, 0.107600003D0, 6.689999998D-02, 6.689999998D-02,
     4 9.300000034D-03, 9.300000034D-03/
C * DATA FOR IN ELEMENT #49
      DATA NORB(49)/14/
      DATA (BINDNRG(49, I), I = 1, 14)/
     1 27.9398994D0, 4.23750019D0, 3.93799996D0, 3.73009992D0,
     2 0.825599968D0, 0.702199996D0, 0.664300025D0, 0.450800002D0,
     3 0.443100005D0, 0.121900000D0, 7.739999890D-02, 7.739999890D-02,
     41.620000042D-02, 1.620000042D-02/
C * DATA FOR SN ELEMENT #50
      DATA NORB(50)/14/
      DATA (BINDNRG(50, I), I = 1, 14)/
     1 29.2000999D0, 4.46470022D0, 4.15610027D0, 3.92880011D0,
     2 0.883800030D0, 0.756399989D0, 0.714399993D0, 0.493299991D0,
     3 0.484800011D0, 0.136500001D0, 8.860000223D-02, 8.860000223D-02,
     4 2.389999852D-02, 2.389999852D-02/
C * DATA FOR SB ELEMENT #51
      DATA NORB(51)/14/
      DATA( BINDNRG(51, I), I = 1, 14)/
     1 30.4911995D0, 4.69829988D0, 4.38040018D0, 4.13220024D0,
     2 0.943700016D0, 0.811900020D0, 0.765600026D0, 0.536899984D0,
     3 0.527499974D0, 0.152000010D0, 9.840000421D-02, 9.840000421D-02,
     4 3.139999881D-02, 3.139999881D-02/
C * DATA FOR TE ELEMENT #52
      DATA NORB(52)/14/
      DATA (BINDNRG(52, I), I = 1, 14)/
     1 31.8137989D0, 4.93919992D0, 4.61199999D0, 4.34140015D0,
     2 1.00600004D0, 0.869700015D0, 0.818700016D0, 0.582499981D0,
     3 0.572099984D0, 0.168300003D0, 0.110200003D0, 0.110200003D0,
     4 3.979999945D-02, 3.979999945D-02/
C * DATA FOR I  ELEMENT #53
      DATA NORB(53)/14/
      DATA (BINDNRG(53, I), I = 1, 14)/
     1 33.1693993D0, 5.18809986D0, 4.85209990D0, 4.55710030D0,
     2 1.07210004D0, 0.930500031D0, 0.874599993D0, 0.631299973D0,
     3 0.619400024D0, 0.186399996D0, 0.122699998D0, 0.122699998D0,
     4 4.960000142D-02, 4.960000142D-02/
C * DATA FOR XE ELEMENT #54
      DATA NORB(54)/14/
      DATA (BINDNRG(54, I), I = 1, 14)/
     1 34.5614014D0, 5.45279980D0, 5.10370016D0, 4.78219986D0,
     2 1.14460003D0, 0.999000013D0, 0.936999977D0, 0.685400009D0,
     3 0.672299981D0, 0.208099991D0, 0.146699995D0, 0.146699995D0,
     4 6.400000304D-02, 6.400000304D-02/
C * DATA FOR CS ELEMENT #55
      DATA NORB(55)/17/
      DATA (BINDNRG(55, I), I = 1, 17)/
     1 35.9846001D0, 5.71430016D0, 5.35939980D0, 5.01189995D0,
     2 1.21710002D0, 1.06500006D0, 0.997600019D0, 0.739499986D0,
     3 0.725499988D0, 0.230800003D0, 0.172299996D0, 0.161599994D0,
     4 7.880000025D-02, 7.649999857D-02, 2.270000055D-02,
     5 1.310000010D-02, 1.140000019D-02/
C * DATA FOR BA ELEMENT #56
      DATA NORB(56)/17/
      DATA (BINDNRG(56, II), II = 1, 17)/
     1 37.4405975D0, 5.98880005D0, 5.62360001D0, 5.24700022D0,
     2 1.29279995D0, 1.13670003D0, 1.06219995D0, 0.796100020D0,
     3 0.780699968D0, 0.252999991D0, 0.191799998D0, 0.179700002D0,
     4 9.250000119D-02, 8.990000188D-02, 3.909999877D-02,
     5 1.659999974D-02, 1.460000034D-02/
C * DATA FOR LA ELEMENT #57
      DATA NORB(57)/17/
      DATA (BINDNRG(57, II), II = 1, 17)/
     1 38.9245987D0, 6.26630020D0, 5.89060020D0, 5.48269987D0,
     2 1.36129999D0, 1.20439994D0, 1.12339997D0, 0.848500013D0,
     3 0.831699967D0, 0.270400017D0, 0.205799997D0, 0.191400006D0,
     4 9.889999777D-02, 9.889999777D-02, 3.229999915D-02,
     5 1.439999975D-02, 1.439999975D-02/
C * DATA FOR CE ELEMENT #58
      DATA NORB(58)/18/
      DATA (BINDNRG(58, II), II = 1, 18)/
     1 40.4430008D0, 6.54879999D0, 6.16419983D0, 5.72340012D0,
     2 1.43460000D0, 1.27279997D0, 1.18540001D0, 0.901300013D0,
     3 0.883300006D0, 0.289599985D0, 0.223299995D0, 0.207200006D0,
     4 0.109999999D0, 0.109999999D0, 8.590000123D-02,
     5 3.779999912D-02, 1.979999989D-02, 1.979999989D-02/
C * DATA FOR PR ELEMENT #59
      DATA NORB(59)/18/
      DATA (BINDNRG(59, II), II = 1, 18)/
     1 41.9906006D0, 6.83480024D0, 6.44040012D0, 5.96430016D0,
     2 1.51099992D0, 1.33739996D0, 1.24220002D0, 0.951099992D0,
     3 0.930999994D0, 0.304500014D0, 0.236300007D0, 0.217600003D0,
     4 0.113200001D0, 0.113200001D0, 3.500000108D-03,
     4 3.739999980D-02, 2.229999937D-02, 2.229999937D-02/
C * DATA FOR ND ELEMENT #60
      DATA NORB(60)/18/
      DATA (BINDNRG(60, II), II = 1, 18)/
     1 43.5689011D0, 7.12599993D0, 6.72149992D0, 6.20790005D0,
     2 1.57530010D0, 1.40279996D0, 1.29740000D0, 0.999499977D0,
     3 0.977699995D0, 0.315200001D0, 0.243299991D0, 0.224600002D0,
     4 0.117500000D0, 0.117500000D0, 3.000000026D-03,
     5 3.749999776D-02, 2.110000141D-02, 2.110000141D-02/
C * DATA FOR PM ELEMENT #61
      DATA NORB(61)/18/
      DATA (BINDNRG(61, II), II = 1, 18)/
     1 45.1840019D0, 7.42789984D0, 7.01279974D0, 6.45930004D0,
     2 1.64649999D0, 1.47140002D0, 1.35689998D0, 1.05149996D0,
     3 1.02690005D0, 0.330399990D0, 0.254399985D0, 0.236000001D0,
     4 0.120399997D0, 0.120399997D0, 4.000000190D-03,
     5 3.749999776D-02, 2.110000141D-02, 2.110000141D-02/
C * DATA FOR SM ELEMENT #62
      DATA NORB(62)/18/
      DATA (BINDNRG(62, II), II = 1, 18)/
     1 46.8342018D0, 7.73680019D0, 7.31180000D0, 6.71619987D0,
     2 1.72280002D0, 1.54069996D0, 1.41979992D0, 1.10599995D0,
     3 1.08019996D0, 0.345699996D0, 0.265599996D0, 0.247400001D0,
     4 0.128999993D0, 0.128999993D0, 5.499999970D-03,
     4 3.739999980D-02, 2.129999921D-02, 2.129999921D-02/
C * DATA FOR EU ELEMENT #63
      DATA NORB(63)/18/
      DATA (BINDNRG(63, II), II = 1, 18)/
     1 48.5190010D0, 8.05200005D0, 7.61710024D0, 6.97690010D0,
     2 1.80000007D0, 1.61389995D0, 1.48060000D0, 1.16059995D0,
     3 1.13090003D0, 0.360199988D0, 0.283899993D0, 0.256599993D0,
     4 0.133200005D0, 0.133200005D0, 2.911507152D-03,
     4 3.179999813D-02, 2.199999988D-02, 2.199999988D-02/
C * DATA FOR GD ELEMENT #64
      DATA NORB(64)/19/
      DATA (BINDNRG(64, II), II = 1, 19)/
     1 50.2391014D0, 8.37559986D0, 7.93029976D0, 7.24279976D0,
     2 1.88080001D0, 1.68830001D0, 1.54400003D0, 1.21720004D0,
     3 1.18519998D0, 0.375799984D0, 0.288500011D0, 0.270900011D0,
     4 0.140500009D0, 0.140500009D0, 9.279401973D-03, 8.524194360D-03,
     5 3.610000014D-02, 2.030000091D-02, 2.030000091D-02/
C * DATA FOR TB ELEMENT #65
      DATA NORB(65)/19/
      DATA (BINDNRG(65, II), II = 1, 19)/
     1 51.9957008D0, 8.70800018D0, 8.25160027D0, 7.51399994D0,
     2 1.96749997D0, 1.76769996D0, 1.61129999D0, 1.27499998D0,
     3 1.24119997D0, 0.397900015D0, 0.310200006D0, 0.284999996D0,
     4 0.147000000D0, 0.147000000D0, 9.399999864D-03, 8.600000292D-03,
     5 3.900000080D-02, 2.539999969D-02, 2.539999969D-02/
C * DATA FOR DY ELEMENT #66
      DATA NORB(66)/19/
      DATA (BINDNRG(66, II), II = 1, 19)/
     1 53.7885017D0, 9.04580021D0, 8.58059978D0, 7.79010010D0,
     2 2.04679990D0, 1.84180009D0, 1.67559993D0, 1.33249998D0,
     3 1.29489994D0, 0.416299999D0, 0.331800014D0, 0.292899996D0,
     4 0.154200003D0 ,0.154200003D0, 4.199999850D-03, 4.199999850D-03,
     5 6.289999932D-02, 2.630000003D-02, 2.630000003D-02/
C * DATA FOR HO ELEMENT #67
      DATA NORB(67)/19/
      DATA (BINDNRG(67, II), II = 1, 19)/
     1 55.6176987D0, 9.39420033D0, 8.91779995D0, 8.07110023D0,
     2 2.12829995D0, 1.92279994D0, 1.74119997D0, 1.39150000D0,
     3 1.35140002D0, 0.435699999D0, 0.343499988D0, 0.306600004D0,
     4 0.160999998D0, 0.160999998D0, 3.700000001D-03, 3.700000001D-03,
     5 5.119999871D-02, 2.030000091D-02, 2.030000091D-02/
C * DATA FOR ER ELEMENT #68
      DATA NORB(68)/19/
      DATA (BINDNRG(68, II), II = 1, 19)/
     1 57.4855003D0, 9.75129986D0, 9.26430035D0, 8.35789967D0,
     2 2.20650005D0, 2.00580001D0, 1.81180000D0, 1.45330000D0,
     3 1.40929997D0, 0.449099988D0, 0.366200000D0, 0.319999993D0,
     4 0.17669999D0, 0.167600006D0, 4.300000146D-03, 4.300000146D-03,
     5 5.979999900D-02, 2.940000035D-02, 2.940000035D-02/
C * DATA FOR TM ELEMENT #69
      DATA NORB(69)/19/
      DATA (BINDNRG(69, II), II = 1, 19)/
     1 59.3895988D0, 10.1156998D0, 9.61689949D0, 8.64799976D0,
     2 2.30679989D0, 2.08980012D0, 1.88450003D0, 1.51460004D0,
     3 1.46770000D0, 0.471699983D0, 0.385900021D0, 0.336600006D0,
     4 0.179600000D0, 0.179600000D0, 5.299999844D-03, 5.299999844D-03,
     5 5.319999903D-02, 3.229999915D-02, 3.229999915D-02/
C * DATA FOR YB ELEMENT #70
      DATA NORB(70)/19/
      DATA (BINDNRG(70, II), II = 1, 19)/
     1 61.3323021D0, 10.4863997D0, 9.97819996D0, 8.94359970D0,
     2 2.39809990D0, 2.17300010D0, 1.94980001D0, 1.57629991D0,
     3 1.52779996D0, 0.487199992D0, 0.396699995D0, 0.343499988D0,
     4 0.198100001D0, 0.184900001D0, 6.300000008D-03, 6.300000008D-03,
     5 5.409999937D-02, 2.340000123D-02, 2.340000123D-02/
C * DATA FOR LU ELEMENT #71
      DATA NORB(71)/19/
      DATA (BINDNRG(71, II), II = 1, 19)/
     1 63.3138008D0, 10.8704004D0, 10.3486004D0, 9.24409962D0,
     2 2.49119997D0, 2.26349998D0, 2.02360010D0, 1.63940001D0,
     3 1.58849990D0, 0.506200016D0, 0.410100013D0, 0.359299988D0,
     4 0.204800010D0, 0.195000008D0, 6.899999920D-03, 6.899999920D-03,
     5 5.680000037D-02, 2.800000086D-02, 2.800000086D-02/
C * DATA FOR HF ELEMENT #72
      DATA NORB(72)/20/
      DATA (BINDNRG(72,II), II = 1, 20)/
     1 65.3507996D0, 11.2707005D0, 10.7393999D0, 9.56070042D0,
     2 2.60089993D0, 2.36539984D0, 2.10759997D0, 1.71639991D0,
     3 1.66169989D0, 0.538100004D0, 0.437000006D0, 0.380400002D0,
     4 0.223799989D0, 0.213699996D0, 1.709999889D-02, 1.709999889D-02,
     5 6.489999592D-02,3.810000047D-02, 3.060000017D-02,
     6 4.999999888D-03/
C * DATA FOR TA ELEMENT #73
      DATA NORB(73)/20/
      DATA (BINDNRG(73, II), II = 1, 20)/
     1 67.4163971D0, 11.6814995D0, 11.1360998D0, 9.88109970D0,
     2 2.70799994D0, 2.46869993D0, 2.19400001D0, 1.79320002D0,
     3 1.73509991D0, 0.565500021D0, 0.464800000D0, 0.404500008D0,
     4 0.241300002D0, 0.229299992D0, 2.500000037D-02, 2.500000037D-02,
     5 7.109999657D-02, 4.490000010D-02, 3.640000150D-02,
     6 5.700000096D-03/
C * DATA FOR W  ELEMENT #74
      DATA NORB(74)/20/
      DATA (BINDNRG(74, II), II = 1, 20)/
     1 69.5250015D0, 12.0998001D0, 11.5439997D0, 10.2068005D0,
     2 2.81960011D0, 2.57489991D0, 2.28099990D0, 1.87160003D0,
     3 1.80920005D0, 0.594999969D0, 0.491600007D0, 0.425300002D0,
     4 0.258800000D0, 0.245399997D0, 3.649999946D-02, 3.359999880D-02,
     5 7.710000128D-02, 4.679999873D-02, 3.559999913D-02,
     6 6.099999882D-03/
C * DATA FOR RE ELEMENT #75
      DATA NORB(75)/21/
      DATA (BINDNRG(75, II), II = 1, 21)/
     1 71.6763992D0, 12.5267000D0, 11.9587002D0, 10.5353003D0,
     2 2.93169999D0, 2.68159986D0, 2.36730003D0, 1.94889998D0,
     3 1.88290000D0, 0.625000000D0, 0.517899990D0, 0.444399983D0,
     4 0.273699999D0, 0.260199994D0, 4.059999809D-02, 4.059999809D-02,
     5 8.280000091D-02, 4.560000077D-02, 3.460000083D-02,
     6 6.062670611D-03, 5.209125113D-03/
C * DATA FOR OS ELEMENT #76
      DATA NORB(76)/21/
      DATA (BINDNRG(76, II), II = 1, 21)/
     1 73.8708038D0, 12.9680004D0, 12.3850002D0, 10.8709002D0,
     2 3.04850006D0, 2.79220009D0, 2.45720005D0, 2.03080010D0,
     3 1.96009994D0, 0.654300034D0, 0.546500027D0, 0.468199998D0,
     4 0.289399981D0, 0.272799999D0, 4.630000144D-02, 4.630000144D-02,
     5 8.370000124D-02, 5.799999833D-02, 4.540000111D-02,
     6 7.052645553D-03, 6.027942058D-03/
C * DATA FOR IR ELEMENT #77
      DATA NORB(77)/21/
      DATA (BINDNRG(77, II), II = 1, 21)/
     1 76.1110001D0, 13.4184999D0, 12.8240995D0, 11.2152004D0,
     2 3.17369986D0, 2.90869999D0, 2.55069995D0, 2.11610007D0,
     3 2.04040003D0, 0.690100014D0, 0.577099979D0, 0.494300008D0,
     4 0.311399996D0, 0.294900000D0, 6.340000033D-02, 6.049999967D-02,
     5 9.520000219D-02, 6.300000101D-02, 5.049999803D-02,
     6 8.062744513D-03, 6.854556501D-03/
C * DATA FOR PT ELEMENT #78
      DATA NORB(78)/21/
      DATA (BINDNRG(78, II), II = 1, 21)/
     1 78.3947983D0, 13.8799000D0, 13.2726002D0, 11.5636997D0,
     2 3.29600000D0, 3.02649999D0, 2.64540005D0, 2.20190001D0,
     3 2.12160015D0, 0.722000003D0, 0.609200001D0, 0.518999994D0,
     4 0.330799997D0, 0.313300014D0, 7.429999858D-02, 7.109999657D-02,
     5 0.101700000D0, 6.530000269D-02, 5.169999972D-02, 7.439905778D-03,
     6 6.125379819D-03/
C * DATA FOR AU ELEMENT #79
      DATA NORB(79)/21/
      DATA (BINDNRG(79, II), II = 1, 21)/
     1 80.7248993D0, 14.3528004D0, 13.7336006D0, 11.9187002D0,
     2 3.42490005D0, 3.14779997D0, 2.74300003D0, 2.29110003D0,
     3 2.20569992D0, 0.758799970D0, 0.643700004D0, 0.545400023D0,
     4 0.351999998D0, 0.333900005D0, 8.640000224D-02, 8.280000091D-02,
     5 0.107799999D0, 7.169999927D-02, 5.370000005D-02, 8.308385499D-03,
     6 6.790316198D-03/
C * DATA FOR HG ELEMENT #80
      DATA NORB(80)/22/
      DATA (BINDNRG(80, II), II = 1, 22)/
     1 83.1023026D0, 14.8393002D0, 14.2087002D0, 12.2839003D0,
     2 3.56159997D0, 3.27850008D0, 2.84710002D0, 2.38489985D0,
     3 2.29489994D0, 0.800300002D0, 0.676899970D0, 0.570999980D0,
     4 0.378300011D0, 0.359800011D0, 0.102200001D0, 9.849999845D-02,
     5 0.120300002D0, 8.049999923D-02, 5.759999901D-02,
     6 6.399999838D-03, 6.399999838D-03, 7.713606115D-03/
C * DATA FOR TL ELEMENT #81
      DATA NORB(81)/22/
      DATA (BINDNRG(81, II), II = 1, 22)/
     1 85.5304031D0, 15.3467007D0, 14.6978998D0, 12.6575003D0,
     2 3.70409989D0, 3.41569996D0, 2.95659995D0, 2.48510003D0,
     3 2.38930011D0, 0.845499992D0, 0.721300006D0, 0.609000027D0,
     4 0.406599998D0, 0.386200011D0, 0.122800000D0, 0.118500002D0,
     5 0.136300012D0, 9.960000217D-02, 7.540000230D-02,
     6 1.530000009D-02, 1.310000010D-02, 9.664831683D-03/
C * DATA FOR PB ELEMENT #82
      DATA NORB(82)/23/
      DATA (BINDNRG(82, II), II = 1, 23)/
     1 88.0045013D0, 15.8607998D0, 15.2000008D0, 13.0352001D0,
     2 3.85069990D0, 3.55419993D0, 3.06640005D0, 2.58559990D0,
     3 2.48399997D0, 0.893599987D0, 0.763899982D0, 0.644500017D0,
     4 0.435200006D0, 0.412900001D0, 0.142900005D0, 0.138100013D0,
     5 0.147299990D0, 0.104800001D0, 8.600000292D-02, 2.180000022D-02,
     6 1.920000091D-02, 1.169038378D-02, 4.911662545D-03/
C * DATA FOR BI ELEMENT #83
      DATA NORB(83)/23/
      DATA (BINDNRG(83, II), II = 1, 23)/
     1 90.5259018D0, 16.3875008D0, 15.7111006D0, 13.4186001D0,
     2 3.99909997D0, 3.69630003D0, 3.17689991D0, 2.68759990D0,
     3 2.57959986D0, 0.938199997D0, 0.805299997D0, 0.678900003D0,
     4 0.463600010D0, 0.439999998D0, 0.161899999D0, 0.157399997D0,
     5 0.159299999D0, 0.116800003D0, 9.279999882D-02, 2.649999969D-02,
     6 2.439999953D-02, 1.423338987D-02, 6.169907749D-03/
C * DATA FOR PO ELEMENT #84
      DATA NORB(84)/24/
      DATA (BINDNRG(84, II), II = 1, 24)/
     1 93.1050034D0, 16.9393005D0, 16.2443008D0, 13.8138008D0,
     2 4.14940023D0, 3.85409999D0, 3.30189991D0, 2.79799986D0,
     3 2.68300009D0,0.995299995D0, 0.851000011D0, 0.704999983D0,
     4 0.500199974D0, 0.473399997D0, 0.175343826D0, 0.169361845D0,
     5 0.170906276D0, 0.125695229D0, 9.831414372D-02, 3.139999881D-02,
     6 3.139999881D-02, 1.677767560D-02, 7.559744176D-03,
     7 5.394770764D-03/
C * DATA FOR AT ELEMENT #85
      DATA NORB(85)/24/
      DATA (BINDNRG(85, II), II = 1, 24)/
     1 95.7298965D0, 17.4930000D0, 16.7847004D0, 14.2134991D0,
     2 4.31699991D0, 4.00799990D0, 3.42600012D0, 2.90869999D0,
     3 2.78670001D0, 1.04200006D0, 0.885999978D0, 0.740000010D0,
     4 0.533200026D0, 0.475384623D0, 0.197075620D0, 0.190577224D0,
     5 0.185616866D0, 0.138499394D0, 0.108425982D0, 4.159419611D-02,
     6 3.766180575D-02, 1.933898404D-02, 9.031039663D-03,
     7 6.244503893D-03/
C * DATA FOR RN ELEMENT #86
      DATA NORB(86)/24/
      DATA (BINDNRG(86, II), II = 1, 24)/
     1 98.4039993D0, 18.0489998D0, 17.3370991D0, 14.6194000D0,
     2 4.48199987D0, 4.15899992D0, 3.53799987D0, 3.02149987D0,
     3 2.89240003D0, 1.09700000D0, 0.929000020D0, 0.768000007D0,
     4 0.566600025D0, 0.537000000D0, 0.219630763D0, 0.212587610D0,
     5 0.200830922D0, 0.151771158D0, 0.118816562D0, 4.869114980D-02,
     6 4.425504431D-02, 2.193967439D-02, 1.057260949D-02,
     7 7.125876378D-03/
C * DATA FOR FR ELEMENT #87
      DATA NORB(87)/24/
      DATA (BINDNRG(87, II), II = 1, 24)/
     1 101.137001D0, 18.6389999D0, 17.9064999D0, 15.0311995D0,
     2 4.65199995D0, 4.32700014D0, 3.66300011D0, 3.13619995D0,
     3 2.99970007D0, 1.15300000D0, 0.980000019D0, 0.810000002D0,
     4 0.603300035D0, 0.577000022D0, 0.246488422D0, 0.238862991D0,
     5 0.220035478D0, 0.169009268D0, 0.132957444D0, 5.953782797D-02,
     6 5.455289036D-02, 2.786786854D-02, 1.516497415D-02,
     7 1.061226334D-02/
C * DATA FOR RA ELEMENT #88
      DATA NORB(88)/24/
      DATA (BINDNRG(88, II), II = 1, 24)/
     1 103.921898D0, 19.2367001D0, 18.4843006D0, 15.4444008D0,
     2 4.82200003D0, 4.48950005D0, 3.79180002D0, 3.24839997D0,
     3 3.10490012D0, 1.20840001D0, 1.05760002D0, 0.879100025D0,
     4 0.635900021D0, 0.602699995D0, 0.298900008D0, 0.298900008D0,
     5 0.254399985D0, 0.200399995D0, 0.152799994D0, 6.719999760D-02,
     6 6.719999760D-02, 4.349999875D-02, 1.879999973D-02,
     7 1.879999973D-02/
C * DATA FOR AC ELEMENT #89
      DATA NORB(89)/24/
      DATA (BINDNRG(89, II), II = 1, 24)/
     1 106.755302D0, 19.8400002D0, 19.0832005D0, 15.8710003D0,
     2 5.00199986D0, 4.65600014D0, 3.90899992D0, 3.37019992D0,
     3 3.21900010D0, 1.26900005D0, 1.08000004D0, 0.889999986D0,
     4 0.674899995D0, 0.637000024D0, 0.303943723D0, 0.295067102D0,
     5 0.261255294D0, 0.206171408D0, 0.163234457D0, 8.313610405D-02,
     6 7.693891972D-02, 4.046359286D-02, 2.518509701D-02,
     7 1.840208657D-02/
C * DATA FOR TH ELEMENT #90
      DATA NORB(90)/24/
      DATA (BINDNRG(90, II), II = 1, 24)/
     1    109.650902D0,    20.4720993D0,   19.6932011D0,   16.3003006D0,
     2    5.18230009D0,    4.83039999D0,   4.04610014D0,   3.49079990D0,
     3    3.33200002D0,    1.32949996D0,   1.16820002D0,  0.967299998D0,
     4   0.714100003D0,   0.676400006D0,  0.344399989D0,  0.335200012D0,
     5   0.290199995D0,   0.229399994D0,  0.181800008D0,9.430000186d-02,
     6 8.789999783D-02, 5.950000137D-02,4.899999872D-02,4.300000146D-02/
C * DATA FOR PA ELEMENT #91
      DATA NORB(91)/24/
      DATA (BINDNRG(91, II), II = 1, 24)/
     1    112.601402D0,    21.1045990D0,   20.3136997D0,   16.7331009D0,
     2    5.36689997D0,    5.00090027D0,   4.17379999D0,   3.61119986D0,
     3    3.44179988D0,    1.38710010D0,   1.22430003D0,   1.00670004D0,
     4   0.743399978D0,   0.708199978D0,  0.371199995D0,  0.359499991D0,
     5   0.309599996D0,   0.233623788D0,  0.183050051D0,9.667889029D-02,
     6 8.924079686D-02, 4.545853287D-02,2.854512073D-02,2.032056637D-02/
C * DATA FOR U  ELEMENT #92
      DATA NORB(92)/24/
      DATA (BINDNRG(92, II), II = 1, 24)/
     1    115.606102D0,   21.7574005D0,   20.9475994D0,   17.1662998D0,
     2    5.54799986D0,   5.18219995D0,   4.30340004D0,   3.72760010D0,
     3    3.55169988D0,   1.44080007D0,   1.27259994D0,   1.04489994D0,
     4   0.780399978D0,  0.737699986D0,  0.391299993D0,  0.380899996D0,
     5   0.323700011D0,  0.259299994D0,  0.195100009D0,  0.104999997D0,
     6 9.629999846D-02,7.069999725D-02,4.230000079D-02,3.229999915D-02/
      END
      BLOCK DATA STRUCTURE_TIDY
      COMMON /STID/ ISETS(73, 230), NNT1(1623), ITRAFO(541), NLST(230),
     1 NSEM(3, 3, 18), MM4(20, 18), IGES(3, 3, 36), ITGRP(541),
     2 LGN(3, 45), LLF(216), MM5(43, 3), NCENT(230), XABC(9, 30),
     3 ISY(45), NNQ(3, 4, 5), NGET(3, 25), NT2(45), IFORM(44),
     4 XSHIFT(3, 11), KSPEC(3, 146), SPECIA(3, 107), UVWX(9, 6)
      COMMON /CSTID/ SPGP, PSYM, FORMS, LATICE, HBR, XELN, KOORD,
     1 CHORI, STAA, STBB, STCSH, STTEXT
      CHARACTER SPGP(230)*10, PSYM(47)*14, FORMS(15)*16, LATICE(6)*1,
     1 STAA(107)*11, STBB(39)*15, STTEXT(21)*17, STCSH(17)*14,
     2 HBR(7)*1, XELN(105)*2, KOORD(12)*8, CHORI(9)*3
      DATA XELN /
     1 'H ','He','Li','Be','B ','C ','N ','O ','F ','Ne','Na','Mg','Al',
     2 'Si','P ','S ','Cl','Ar','K ','Ca','Sc','Ti','V ','Cr','Mn','Fe',
     3 'Co','Ni','Cu','Zn','Ga','Ge','As','Se','Br','Kr','Rb','Sr','Y ',
     4 'Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn','Sb','Te',
     5 'I ','Xe','Cs','Ba','La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb',
     6 'Dy','Ho','Er','Tm','Yb','Lu','Hf','Ta','W ','Re','Os','Ir','Pt',
     7 'Au','Hg','Tl','Pb','Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',
     8 'U ','Np','Pu','Am','Cm','Bk','Cf','Es','Fm','Md','No','Lr','Tu',
     9 'D '/
      DATA HBR /'P','A','B','C','F','I','R'/
      DATA LATICE /'a', 'm', 'o', 't', 'h', 'c'/
      DATA FORMS /
     1 'Triclinic aP',     'Monoclinic mP',   'Monoclinic mC',
     2 'Monoclinic mC(I)', 'Orthorhombic oP', 'Orthorhombic oC',
     3 'Orthorhombic oF',  'Orthorhombic oI', 'Tetragonal tP',
     4 'Tetragonal tI',    'Hexagonal hP',    'Rhombohedral hR',
     5 'Cubic cP',         'Cubic cF',        'Cubic cI'/
      DATA ((UVWX(I, J), I = 1, 9), J = 1, 6) /
     1  1.0,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     2  0.0,  0.5, -0.5,  0.0,  0.5,  0.5,  1.0,  0.0,  0.0,
     3  0.5, -0.5,  0.0,  0.5,  0.5,  0.0,  0.0,  0.0,  1.0,
     4  0.5,  0.5,  0.0,  0.0,  0.5,  0.5,  0.5,  0.0,  0.5,
     5  0.5,  0.5, -0.5, -0.5,  0.5,  0.5,  0.5, -0.5,  0.5,
     6  0.333333, -0.333333, -0.333333, -0.666667, -0.333333,
     7 -0.333333,  0.333333,  0.666667, -0.333333/
      DATA CHORI /
     1 '1/8', '1/4', '3/8', '1/2', '5/8', '3/4', '7/8', '1/3', '2/3'/
      DATA KOORD /
     1 ' 0     ',' 1/2   ',' 1/4   ',' 3/4   ',' 1/8   ', ' 3/8   ',
     2 ' 5/8   ',' 7/8   ',' 1/3   ',' 2/3   ',' 1/6   ', ' 5/6   '/
      DATA KSPEC /
     1  2,2,2,  1,2,2,  2,1,2,  2,2,1,  2,1,1,  1,2,1,  1,1,2,  1,1,1,
     2  3,3,2,  3,3,1,  3,3,4,  3,3,3,  3,4,3,  4,3,3,  2,2,3,  1,2,3,
     3  2,1,3,  1,1,3,  3,3,2,  4,3,2,  4,3,1,  3,3,1,  3,4,1,  3,1,1,
     4  3,1,2,  1,3,3,  1,3,4,  5,5,5,  3,1,3,  5,5,7,  1,2,4,  3,4,2,
     5  1,3,5,  1,3,7,  3,4,4,  4,3,4,  1,4,5,  1,3,6, 9,10,1, 9,10,2,
     6 10,9,1, 10,9,2, 9,10,3, 10,9,3, 9,10,4,  4,4,4,  7,7,7,  3,2,1,
     7  6,6,6,  8,8,8,  5,1,3,  7,1,3,  6,1,3,  8,1,3,  1,4,3,  2,3,4,
     8  8,5,5,  0,2,2,  0,2,1,  0,1,2,  0,1,1,  0,3,3,  0,1,3,  0,3,4,
     9  0,2,3,  0,3,2,  0,3,1,  0,5,5,  0,3,5,  0,4,3,  0,1,9, 0,1,12,
     * 0,1,10, 0,1,11,  2,0,2,  1,0,2,  2,0,1,  1,0,1,  2,0,3,  1,0,3,
     1  3,0,3,  3,0,1,  4,0,3,  3,0,2,  5,0,5,  2,2,0,  1,2,0,  2,1,0,
     2  1,1,0,  3,3,0,  1,3,0,  3,4,0,  3,2,0,  3,1,0,  5,5,0,  4,3,0,
     3 9,10,0, 10,9,0,  0,0,2,  0,0,1,  0,0,3,  0,2,0,  0,1,0,  0,3,0,
     4  2,0,0,  1,0,0,  3,0,0,  0,0,1,  0,0,2,  0,0,3,  0,0,4,  0,0,6,
     5  0,0,7,  0,0,1,  0,0,2,  0,0,3,  0,0,9, 0,0,10, 0,0,11, 0,0,12,
     6  0,0,3,  0,0,2,  0,0,1,  0,0,3,  0,0,5,  0,0,8,  0,0,1,  0,0,2,
     7  0,0,3,  0,0,4,  1,0,0,  2,0,0,  3,0,0,  1,0,0,  3,0,0,  3,0,0,
     8  3,0,0,  2,0,0,  2,0,0,  5,0,0,  5,0,0,  0,0,0,  0,0,0,  0,0,0,
     9  0,0,0,  0,0,0/
      DATA IFORM /
     1 14, 12, 13, 12, 15, 10, 10, 8, 12, 3, 9, 11, 6, 3, 10, 7, 3, 10,
     2  8,  3,  9, 11,  6, 12,  3, 7,  3, 3, 3,  3, 1, 5,  2, 2, 2,  6,
     3  3,  6,  3,  6,  3,  8,  4, 1/
      DATA XSHIFT /
     1 0.75,  0.75, 0.75, 0.75, 0.75,  0.0, 0.0, 0.75, 0.75, 0.25, 0.75,
     2  0.0,  0.25, 0.25, 0.25, 0.25, 0.25, 0.0, 0.25, 0.75, 0.25,  0.0,
     3 0.75, 0.125,  0.0, 0.25, 0.125, 0.125, 0.125, 0.125, 0.375,
     4 0.375, 0.375/
      DATA SPECIA /
     1 0.5, 0.5, 0.5, 0.0, 0.5, 0.5, 0.5, 0.0, 0.5, 0.5, 0.5, 0.0, 0.5,
     2 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.25,
     3 0.25, 0.5, 0.25, 0.25, 0.0, 0.25, 0.25, 0.75, 0.25, 0.25, 0.25,
     4 0.25, 0.75, 0.25, 0.75, 0.25, 0.25, 0.5, 0.5, 0.25, 0.0, 0.5,
     5 0.25, 0.5, 0.0, 0.25, 0.0, 0.0, 0.25, 0.25, 0.25, 0.5, 0.75,
     6 0.25, 0.5, 0.75, 0.25, 0.0, 0.25, 0.25, 0.0, 0.25, 0.75, 0.0,
     7 0.25, 0.0, 0.0, 0.25, 0.0, 0.5, 0.0, 0.25, 0.25, 0.0, 0.25, 0.75,
     8 0.125, 0.125, 0.125, 0.25, 0.0, 0.25, 0.125, 0.125, 0.625, 0.0,
     9 0.5, 0.75, 0.25, 0.75, 0.5, 0.0, 0.25, 0.125, 0.0, 0.25, 0.625,
     * 0.25, 0.75, 0.75, 0.75, 0.25, 0.75, 0.0, 0.75, 0.125, 0.0, 0.25,
     1 0.375, 0.33333, 0.66667, 0.0, 0.33333, 0.66667, 0.5, 0.66667,
     2 0.33333, 0.0, 0.66667, 0.33333, 0.5, 0.33333, 0.66667, 0.25,
     3 0.66667, 0.33333, 0.25, 0.33333, 0.66667, 0.75, 0.75, 0.75, 0.75,
     4 0.625, 0.625, 0.625, 0.25, 0.5, 0.0, 0.375, 0.375, 0.375, 0.875,
     5 0.875, 0.875, 0.125, 0.0, 0.25, 0.625, 0.0, 0.25, 0.375, 0.0,
     6 0.25, 0.875, 0.0, 0.25, 0.0, 0.75, 0.25, 0.5, 0.25, 0.75, 0.875,
     7 0.125, 0.125, -1.0, 0.5, 0.5, -1.0, 0.5, 0.0, -1.0, 0.0, 0.5,
     8 -1.0, 0.0, 0.0, -1.0, 0.25, 0.25, -1.0, 0.0, 0.25, -1.0, 0.25,
     9 0.75, -1.0, 0.5, 0.25, -1.0, 0.25, 0.5, -1.0, 0.25, 0.0, -1.0,
     * 0.125, 0.125, -1.0, 0.25, 0.125, -1.0, 0.75, 0.25, -1.0, 0.0,
     1 0.33333, -1.0, 0.0, 0.83333, -1.0, 0.0, 0.66667, -1.0, 0.0,
     2 0.16667, 0.5, -1.0, 0.5, 0.0, -1.0, 0.5, 0.5, -1.0, 0.0, 0.0,
     3 -1.0, 0.0, 0.5, -1.0, 0.25, 0.0, -1.0, 0.25, 0.25, -1.0, 0.25,
     4 0.25, -1.0, 0.0, 0.75, -1.0, 0.25, 0.25, -1.0, 0.5, 0.125, -1.0,
     5 0.125, 0.5, 0.5, -1.0, 0.0, 0.5, -1.0, 0.5, 0.0, -1.0, 0.0, 0.0,
     6 -1.0, 0.25, 0.25, -1.0, 0.0, 0.25, -1.0, 0.25, 0.75, -1.0, 0.25,
     7 0.5, -1.0, 0.25, 0.0, -1.0, 0.125, 0.125, -1.0, 0.75, 0.25, -1.0,
     8 0.33333, 0.66667, -1.0, 0.66667, 0.33333, -1.0, -1.0, -1.0, 0.5,
     9 -1.0, -1.0, 0.0, -1.0, -1.0, 0.25, -1.0, 0.5, -1.0, -1.0, 0.0,
     * -1.0, -1.0, 0.25, -1.0, 0.5, -1.0, -1.0, 0.0, -1.0, -1.0, 0.25,
     1 -1.0, -1.0/
      DATA (STAA(I), I = 1, 107)/
     1 '1/2 1/2 1/2', '0   1/2 1/2', '1/2 0   1/2', '1/2 1/2 0  ',
     2 '1/2 0   0  ', '0   1/2 0  ', '0   0   1/2', '0   0   0  ',
     3 '1/4 1/4 1/2', '1/4 1/4 0  ', '1/4 1/4 3/4', '1/4 1/4 1/4',
     4 '1/4 3/4 1/4', '3/4 1/4 1/4', '1/2 1/2 1/4', '0   1/2 1/4',
     5 '1/2 0   1/4', '0   0   1/4', '1/4 1/4 1/2', '3/4 1/4 1/2',
     6 '3/4 1/4 0  ', '1/4 1/4 0  ', '1/4 3/4 0  ', '1/4 0   0  ',
     7 '1/4 0   1/2', '0   1/4 1/4', '0   1/4 3/4', '1/8 1/8 1/8',
     8 '1/4 0   1/4', '1/8 1/8 5/8', '0   1/2 3/4', '1/4 3/4/1/2',
     9 '0   1/4 1/8', '0   1/4 5/8', '1/4 3/4 3/4', '3/4 1/4 3/4',
     * '0   3/4 1/8', '0   1/4 3/8', '1/3 2/3 0  ', '1/3 2/3 1/2',
     1 '2/3 1/3 0  ', '2/3 1/3 1/2', '1/3 2/3 1/4', '2/3 1/3 1/4',
     2 '1/3 2/3 3/4', '3/4 3/4 3/4', '5/8 5/8 5/8', '1/4 1/2 0  ',
     3 '3/8 3/8 3/8', '7/8 7/8 7/8', '1/8 0   1/4', '5/8 0   1/4',
     4 '3/8 0   1/4', '7/8 0   1/4', '0   3/4 1/4', '1/2 1/4 3/4',
     5 '7/8 1/8 1/8', 'x   1/2 1/2', 'x   1/2 0  ', 'x   0   1/2',
     6 'x   0   0  ', 'x   1/4 1/4', 'x   0   1/4', 'x   1/4 3/4',
     7 'x   1/2 1/4', 'x   1/4 1/2', 'x   1/4 0  ', 'x   1/8 1/8',
     8 'x   1/4 1/8', 'x   3/4 1/4', 'x   0   1/3', 'x   0   5/6',
     9 'x   0   2/3', 'x   0   1/6', '1/2 y   1/2', '0   y   1/2',
     * '1/2 y   0  ', '0   y   0  ', '1/2 y   1/4', '0   y   1/4',
     1 '1/4 y   1/4', '1/4 y   0  ', '3/4 y   1/4', '1/4 y   1/2',
     2 '1/8 y   1/8', '1/2 1/2 z  ', '0   1/2 z  ', '1/2 0   z  ',
     3 '0   0   z  ', '1/4 1/4 z  ', '0   1/4 z  ', '1/4 3/4 z  ',
     4 '1/4 1/2 z  ', '1/4 0   z  ', '1/8 1/8 z  ', '3/4 1/4 z  ',
     5 '1/3 2/3 z  ', '2/3 1/3 z  ', 'x   y   1/2', 'x   y   0  ',
     6 'x   y   1/4', 'x   1/2 z  ', 'x   0   z  ', 'x   1/4 z  ',
     7 '1/2 y   z  ', '0   y   z  ', '1/4 y   z  '/
      DATA (STBB(I), I = 1, 39)/
     1 'x x 0          ', 'x x 1/2        ', 'x x 1/4        ',
     2 'x x 3/4        ', 'x x 3/8        ', 'x x 5/8        ',
     3 'x -x 0         ', 'x -x 1/2       ', 'x -x 1/4       ',
     4 'x -x 1/3       ', 'x -x 2/3       ', 'x -x 1/6       ',
     5 'x -x 5/6       ', 'x 1/2+x 1/4    ', 'x 1/2+x 1/2    ',
     6 'x 1/2+x 0      ', 'x 1/2-x 1/4    ', 'x 1/4+x 1/8    ',
     7 'x 1/4+x 7/8    ', 'x 2x 0         ', 'x 2x 1/2       ',
     8 'x 2x 1/4       ', 'x 2x 3/4       ', '0 y y          ',
     9 '1/2 y y        ', '1/4 y y        ', '0 y -y         ',
     * '1/4 y -y       ', '1/4 y 1/2+y    ', '1/4 y 1/2-y    ',
     1 '1/2 y 1/2+y    ', '1/2 y -y       ', '1/8 y 1/4+y    ',
     2 '1/8 y 1/4-y    ', 'x x x          ', 'x x z          ',
     I 'x -x z         ', 'x 1/2+x z      ', 'x 2x z         '/
      DATA STCSH/
     1 '3/4 3/4 3/4', '3/4 3/4 0',   '0 3/4 3/4',   '1/4 3/4 0',
     2 '1/4 1/4 1/4', '1/4 1/4 0',   '1/4 3/4 1/4', '0 3/4 1/8',
     3 '0 1/4 1/8',   '1/8 1/8 1/8', '3/8 3/8 3/8', '1/4 0 1/4',
     4 '1/4 1/4 3/4', '3/4 1/4 1/4', '0 1/4 1/4',   '0 0 1/4',
     5 '0 1/4 0'/
      DATA STTEXT/
     1 'x,y,z',      '-x,y,-z',  '-x,-y,z',           'x,-y,-z',
     2 'y,x,-z',     '-y,-x,-z', '1/4-y,1/4-x,1/4-z', '-x,1/2-y,-z',
     3 '-y,1/2-x,z', '1/4-x,1/4-y,1/4-z', '-x,-y,-z', 'x,-y,z',
     4 'x,y,-z',     '-x,1/2-y,1/4-z',    '-y,-x,z',  'y,x,z',
     5 '1/4+y,1/4+x,1/4+z', 'x,-z,y', '-z,y,x', '-x,z,-y', 'z,-y,-x'/
      DATA (ISETS(I,  1), I = 1, 7)/
     1   1,  1,  1,  0,  1,  0,  1/
      DATA (ISETS(I,  2), I = 1, 24)/
     1   1,  1,  0,  8,  2,  0,  8,  7,  6,  5,  4,  3,  2,  1,  1,  1,
     2   1,  1,  1,  1,  1,  1,  1,  2/
      DATA (ISETS(I,  3), I = 1, 16)/
     1   2,  1,  1,  4,  2,  0, 78, 76, 77, 75,  1,  1,  1,  1,  1,  2/
      DATA (ISETS(I,  4), I = 1, 7)/
     1   2,  1,  1,  0,  1,  0,  2/
      DATA (ISETS(I,  5), I = 1, 12)/
     1   3,  1,  1,  2,  2,  0, 78, 76,  1,  1,  2,  4/
      DATA (ISETS(I,  6), I = 1, 12)/
     1   2,  1,  1,  2,  2,  0,103,102,  1,  1,  1,  2/
      DATA (ISETS(I,  7), I = 1, 7)/
     1   4,  1,  1,  0,  1,  0,  2/
      DATA (ISETS(I,  8), I = 1, 10)/
     1   3,  1,  1,  1,  2,  0,103,  1,  2,  4/
      DATA (ISETS(I,  9), I = 1, 7)/
     1   5,  1,  1,  0,  1,  0,  4/
      DATA (ISETS(I, 10), I = 1, 38)/
     1   2,  1,  0, 14,  4,  0,  8,  6,  7,  5,  4,  2,  3,  1, 78, 77,
     2  76, 75,103,102,  1,  1,  1,  1,  1,  1,  1,  1,  2,  2,  2,  2,
     3   3,  3,  1,  2,  2,  4/
      DATA (ISETS(I, 11), I = 1, 19)/
     1   2,  1,  0,  5,  3,  0,  8,  5,  7,  3,104,  1,  1,  1,  1,  2,
     2   2,  2,  4/
      DATA (ISETS(I, 12), I = 1, 29)/
     1   3,  1,  0,  9,  5,  0,  8,  6,  7,  2, 10,  9, 78, 76,103,  1,
     2   1,  1,  1,  2,  2,  3,  3,  4,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 13), I = 1, 21)/
     1   4,  1,  0,  6,  3,  0,  8,  4,  6,  5, 80, 79,  1,  1,  1,  1,
     2   2,  2,  2,  2,  4/
      DATA (ISETS(I, 14), I = 1, 16)/
     1   4,  1,  0,  4,  2,  0,  8,  5,  7,  3,  1,  1,  1,  1,  2,  4/
      DATA (ISETS(I, 15), I = 1, 20)/
     1   6,  1,  0,  5,  4,  0,  8,  6, 10,  9, 80,  1,  1,  2,  2,  3,
     2   4,  4,  4,  8/
      DATA (ISETS(I, 16), I = 1, 51)/
     1   7,  1,  1, 20,  5,  0,  8,  5,  6,  7,  4,  3,  2,  1, 61, 60,
     2  59, 58, 78, 76, 77, 75, 89, 88, 87, 86,  1,  1,  1,  1,  1,  1,
     3   1,  1,  2,  2,  2,  2,  3,  3,  3,  3,  4,  4,  4,  4,  1,  2,
     4   2,  2,  4/
      DATA (ISETS(I, 17), I = 1, 17)/
     1   9,  1,  1,  4,  3,  0, 61, 59, 80, 79,  1,  1,  2,  2,  2,  2,
     2   4/
      DATA (ISETS(I, 18), I = 1, 12)/
     1   8,  1,  1,  2,  2,  0, 89, 87,  1,  1,  2,  4/
      DATA (ISETS(I, 19), I = 1, 7)/
     1  10,  1,  1,  0,  1,  0,  4/
      DATA (ISETS(I, 20), I = 1, 13)/
     1   9,  1,  1,  2,  3,  0, 61, 80,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 21), I = 1, 34)/
     1   8,  1,  1, 11,  6,  0,  8,  6,  3,  7, 61, 60, 78, 76, 89, 87,
     2  90,  1,  1,  1,  1,  2,  2,  3,  3,  4,  4,  5,  2,  4,  4,  4,
     3   4,  8/
      DATA (ISETS(I, 22), I = 1, 31)/
     1   7,  1,  1, 10,  5,  0,  8,  7, 12, 11, 61, 78, 89, 90, 81, 62,
     2   1,  1,  1,  1,  2,  3,  4,  4,  3,  2,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 23), I = 1, 31)/
     1   7,  1,  1, 10,  5,  0,  8,  5,  7,  6, 61, 60, 78, 77, 89, 87,
     2   1,  1,  1,  1,  2,  2,  3,  3,  4,  4,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 24), I = 1, 16)/
     1  10,  1,  1,  3,  4,  0, 63, 82, 91,  1,  2,  3,  4,  4,  4,  8/
      DATA (ISETS(I, 25), I = 1, 26)/
     1   8,  1,  1,  8,  4,  0, 89, 87, 88, 86,103,102,106,105,  1,  1,
     2   1,  1,  2,  2,  3,  3,  1,  2,  2,  4/
      DATA (ISETS(I, 26), I = 1, 12)/
     1   0,  1,  1,  2,  2,  0,106,105,  1,  1,  2,  4/
      DATA (ISETS(I, 27), I = 1, 16)/
     1   8,  1,  1,  4,  2,  0, 89, 87, 88, 86,  1,  1,  1,  1,  2,  4/
      DATA (ISETS(I, 28), I = 1, 15)/
     1   0,  1,  1,  3,  3,  0, 89, 87,107,  1,  1,  2,  2,  2,  4/
      DATA (ISETS(I, 29), I = 1, 7)/
     1   0,  1,  1,  0,  1,  0,  4/
      DATA (ISETS(I, 30), I = 1, 12)/
     1   0,  1,  1,  2,  2,  0, 89, 88,  1,  1,  2,  4/
      DATA (ISETS(I, 31), I = 1, 10)/
     1   0,  1,  1,  1,  2,  0,106,  1,  2,  4/
      DATA (ISETS(I, 32), I = 1, 12)/
     1   8,  1,  1,  2,  2,  0, 89, 87,  1,  1,  2,  4/
      DATA (ISETS(I, 33), I = 1, 7)/
     1   0,  1,  1,  0,  1,  0,  4/
      DATA (ISETS(I, 34), I = 1, 12)/
     1   8,  1,  1,  2,  2,  0, 89, 87,  1,  1,  2,  4/
      DATA (ISETS(I, 35), I = 1, 21)/
     1   8,  1,  1,  5,  5,  0, 89, 87, 90,103,106,  1,  1,  2,  3,  4,
     2   2,  4,  4,  4,  8/
      DATA (ISETS(I, 36), I = 1, 10)/
     1   0,  1,  1,  1,  2,  0,106,  1,  4,  8/
      DATA (ISETS(I, 37), I = 1, 15)/
     1   8,  1,  1,  3,  3,  0, 89, 87, 90,  1,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 38), I = 1, 20)/
     1   0,  1,  1,  5,  4,  0, 89, 88,103,106,105,  1,  1,  2,  3,  3,
     2   2,  4,  4,  8/
      DATA (ISETS(I, 39), I = 1, 15)/
     1   0,  1,  1,  3,  3,  0, 89, 88,104,  1,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 40), I = 1, 13)/
     1   0,  1,  1,  2,  3,  0, 89,107,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 41), I = 1, 10)/
     1   0,  1,  1,  1,  2,  0, 89,  1,  4,  8/
      DATA (ISETS(I, 42), I = 1, 19)/
     1   8,  1,  1,  4,  5,  0, 89, 90,106,103,  1,  2,  3,  4,  4,  8,
     2   8,  8, 16/
      DATA (ISETS(I, 43), I = 1, 10)/
     1  11,  1,  3,  1,  2,  0, 89,  1,  8, 16/
      DATA (ISETS(I, 44), I = 1, 18)/
     1   8,  1,  1,  4,  4,  0, 89, 87,103,106,  1,  1,  2,  3,  2,  4,
     2   4,  8/
      DATA (ISETS(I, 45), I = 1, 12)/
     1   8,  1,  1,  2,  2,  0, 89, 87,  1,  1,  4,  8/
      DATA (ISETS(I, 46), I = 1, 13)/
     1   0,  1,  1,  2,  3,  0, 89,107,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 47), I = 1, 66)/
     1   7,  1,  0, 26,  8,  0,  8,  5,  7,  3,  6,  4,  2,  1, 61, 60,
     2  59, 58, 78, 76, 77, 75, 89, 87, 88, 86,106,105,103,102,100, 99,
     3   1,  1,  1,  1,  1,  1,  1,  1,  2,  2,  2,  2,  3,  3,  3,  3,
     4   4,  4,  4,  4,  5,  5,  6,  6,  7,  7,  1,  2,  2,  2,  4,  4,
     5   4,  8/
      DATA (ISETS(I, 48), I = 1, 36)/
     1  -7,  1,  0, 12,  6,  1, 12, 14, 11, 13,  1,  8, 62, 64, 81, 83,
     2  90, 92,  1,  1,  1,  1,  2,  2,  3,  3,  4,  4,  5,  5,  2,  4,
     3   4,  4,  4,  8/
      DATA (ISETS(I, 49), I = 1, 47)/
     1   8,  1,  0, 17,  7,  0,  8,  4,  6,  5, 18, 17, 16, 15, 63, 65,
     2  80, 79, 89, 86, 87, 88,100,  1,  1,  1,  1,  2,  2,  2,  2,  3,
     3   3,  4,  4,  5,  5,  5,  5,  6,  2,  2,  4,  4,  4,  4,  8/
      DATA (ISETS(I, 50), I = 1, 36)/
     1  -8,  1,  0, 12,  6,  2, 22, 21, 20, 19,  8,  7, 67, 66, 82, 84,
     2  90, 92,  1,  1,  1,  1,  2,  2,  3,  3,  4,  4,  5,  5,  2,  4,
     3   4,  4,  4,  8/
      DATA (ISETS(I, 51), I = 1, 34)/
     1   0,  1,  0, 11,  6,  0,  8,  6,  7,  2, 94, 93, 78, 76,103,102,
     2 107,  1,  1,  1,  1,  2,  2,  3,  3,  4,  4,  5,  2,  2,  4,  4,
     3   4,  8/
      DATA (ISETS(I, 52), I = 1, 18)/
     1   0,  1,  0,  4,  4,  0,  8,  7, 94, 62,  1,  1,  2,  3,  4,  4,
     2   4,  8/
      DATA (ISETS(I, 53), I = 1, 27)/
     1   0,  1,  0,  8,  5,  0,  8,  5,  4,  6, 61, 59, 81,106,  1,  1,
     2   1,  1,  2,  2,  3,  4,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 54), I = 1, 20)/
     1   0,  1,  0,  5,  4,  0,  8,  6, 80, 94, 93,  1,  1,  2,  3,  3,
     2   4,  4,  4,  8/
      DATA (ISETS(I, 55), I = 1, 26)/
     1   8,  1,  0,  8,  4,  0,  8,  7,  6,  2, 89, 87,100, 99,  1,  1,
     2   1,  1,  2,  2,  3,  3,  2,  4,  4,  8/
      DATA (ISETS(I, 56), I = 1, 17)/
     1   8,  1,  0,  4,  3,  0,  8,  7, 90, 92,  1,  1,  2,  2,  4,  4,
     2   8/
      DATA (ISETS(I, 57), I = 1, 18)/
     1   0,  1,  0,  4,  4,  0,  8,  5, 67,101,  1,  1,  2,  3,  4,  4,
     2   4,  8/
      DATA (ISETS(I, 58), I = 1, 24)/
     1   8,  1,  0,  7,  4,  0,  8,  7,  6,  2, 89, 87,100,  1,  1,  1,
     2   1,  2,  2,  3,  2,  4,  4,  8/
      DATA (ISETS(I, 59), I = 1, 23)/
     1  -8,  1,  0,  6,  5,  2, 90, 92,  8,  7,107,104,  1,  1,  2,  2,
     2   3,  4,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 60), I = 1, 15)/
     1   0,  1,  0,  3,  3,  0,  8,  6, 80,  1,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 61), I = 1, 12)/
     1  14,  1,  0,  2,  2,  0,  8,  7,  1,  1,  4,  8/
      DATA (ISETS(I, 62), I = 1, 15)/
     1   0,  1,  0,  3,  3,  0,  8,  7,104,  1,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 63), I = 1, 27)/
     1   0,  1,  0,  7,  7,  0,  8,  6, 80, 22, 61,106,101,  1,  1,  2,
     2   3,  4,  5,  6,  4,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 64), I = 1, 24)/
     1   0,  1,  0,  6,  6,  0,  8,  5, 22, 61, 81,106,  1,  1,  2,  3,
     2   4,  5,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 65), I = 1, 50)/
     1   8,  1,  0, 17, 10,  0,  8,  5,  3,  7, 22, 19, 61, 60, 78, 76,
     2  89, 87, 90,106,103,100, 99,  1,  1,  1,  1,  2,  2,  3,  3,  4,
     3   4,  5,  5,  6,  7,  8,  9,  9,  2,  4,  4,  4,  4,  8,  8,  8,
     4   8, 16/
      DATA (ISETS(I, 66), I = 1, 39)/
     1   8,  1,  0, 12,  9,  0, 18, 16,  8,  6, 22, 23, 63, 80, 89, 87,
     2  90,100,  1,  1,  2,  2,  3,  3,  4,  5,  6,  6,  7,  8,  4,  4,
     3   4,  8,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 67), I = 1, 44)/
     1  12,  1,  0, 14, 10,  0, 24, 25,  8,  7, 22, 19, 91, 61, 60, 82,
     2  84, 94,106,104,  1,  1,  2,  2,  3,  3,  4,  5,  5,  6,  6,  7,
     3   8,  9,  4,  4,  4,  4,  8,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 68), I = 1, 30)/
     1 -12,  1,  0,  8,  8,  3, 26, 27, 23,  8, 62, 80, 91, 94,  1,  1,
     2   2,  3,  4,  5,  6,  7,  4,  8,  8,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 69), I = 1, 51)/
     1   7,  1,  0, 15, 15,  0,  8,  7, 26, 29, 22, 12, 61, 78, 89, 90,
     2  81, 62,106,103,100,  1,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10,
     3  11, 12, 13, 14,  4,  8,  8,  8,  8,  8,  8,  8, 16, 16, 16, 16,
     4  16, 16, 32/
      DATA (ISETS(I, 70), I = 1, 26)/
     1 -13,  1,  0,  7,  6, 10, 28, 30,  8,  1, 68, 85, 95,  1,  1,  2,
     2   2,  3,  4,  5,  8, 16, 16, 16, 16, 32/
      DATA (ISETS(I, 71), I = 1, 43)/
     1   7,  1,  0, 14,  9,  0,  8,  2,  4,  3, 61, 59, 78, 76, 89, 88,
     2  12,106,103,100,  1,  1,  1,  1,  2,  2,  3,  3,  4,  4,  5,  6,
     3   7,  8,  2,  4,  4,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 72), I = 1, 34)/
     1   8,  1,  0, 10,  8,  0, 18, 17,  8,  5, 12, 63, 80, 89, 87,100,
     2   1,  1,  2,  2,  3,  4,  5,  6,  6,  7,  4,  4,  8,  8,  8,  8,
     3   8, 16/
      DATA (ISETS(I, 73), I = 1, 22)/
     1  10,  1,  0,  5,  6,  0,  8, 12, 63, 82, 91,  1,  2,  3,  4,  5,
     2   8,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 74), I = 1, 32)/
     1  11,  1,  0,  9,  8,  0,  8,  7, 12, 11, 91, 61, 81,106,104,  1,
     2   1,  2,  2,  3,  4,  5,  6,  7,  4,  4,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 75), I = 1, 15)/
     1   0,  2,  1,  3,  3,  0, 89, 86, 87,  1,  1,  2,  1,  2,  4/
      DATA (ISETS(I, 76), I = 1, 7)/
     1   0,  2,  0,  0,  1,  0,  4/
      DATA (ISETS(I, 77), I = 1, 15)/
     1   0,  2,  1,  3,  3,  0, 89, 86, 87,  1,  1,  2,  2,  2,  4/
      DATA (ISETS(I, 78), I = 1, 7)/
     1  20,  2,  0,  0,  1,  0,  4/
      DATA (ISETS(I, 79), I = 1, 13)/
     1   0,  2,  1,  2,  3,  0, 89, 87,  1,  2,  2,  4,  8/
      DATA (ISETS(I, 80), I = 1, 10)/
     1   0,  5,  2,  1,  2,  0, 89,  1,  4,  8/
      DATA (ISETS(I, 81), I = 1, 24)/
     1   0,  6,  1,  7,  4,  0,  8,  7,  4,  1, 89, 86, 87,  1,  1,  1,
     2   1,  2,  2,  3,  1,  2,  2,  4/
      DATA (ISETS(I, 82), I = 1, 21)/
     1   0,  6,  1,  6,  3,  0,  8,  7, 16, 31, 89, 87,  1,  1,  1,  1,
     2   2,  2,  2,  4,  8/
      DATA (ISETS(I, 83), I = 1, 34)/
     1   0,  2,  0, 11,  6,  0,  8,  7,  4,  1,  6,  2, 89, 86, 87,100,
     2  99,  1,  1,  1,  1,  2,  2,  3,  3,  4,  5,  5,  1,  2,  2,  4,
     3   4,  8/
      DATA (ISETS(I, 84), I = 1, 33)/
     1   0,  2,  0, 10,  7,  0,  8,  4,  6,  2, 18, 15, 89, 86, 87,100,
     2   1,  1,  2,  2,  3,  3,  4,  4,  5,  6,  2,  2,  2,  4,  4,  4,
     3   8/
      DATA (ISETS(I, 85), I = 1, 23)/
     1  15,  5,  0,  6,  5,  4, 23, 32, 90,  8,  7, 92,  1,  1,  2,  3,
     2   3,  4,  2,  2,  4,  4,  8/
      DATA (ISETS(I, 86), I = 1, 23)/
     1  15,  5,  0,  6,  5,  5, 12, 11,  8,  7, 96, 90,  1,  1,  2,  2,
     2   3,  4,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 87), I = 1, 30)/
     1   0,  2,  0,  8,  8,  0,  8,  7,  6, 16, 89, 12, 87,100,  1,  1,
     2   2,  3,  4,  5,  6,  7,  2,  4,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 88), I = 1, 20)/
     1  15,  4,  0,  5,  4,  9, 33, 34,  8,  7, 91,  1,  1,  2,  2,  3,
     2   4,  8,  8, 16/
      DATA (ISETS(I, 89), I = 1, 43)/
     1   0,  1,  1, 15,  7,  0,  8,  7,  4,  1,  5,  3, 89, 86, 87, -1,
     2  -2, 61, 58, 60, 59,  1,  1,  1,  1,  2,  2,  3,  3,  4,  5,  5,
     3   6,  6,  6,  6,  1,  2,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 90), I = 1, 23)/
     1   0,  1,  1,  6,  5,  0,  8,  7, 87, 89, -1, -2,  1,  1,  2,  3,
     2   4,  4,  2,  2,  4,  4,  8/
      DATA (ISETS(I, 91), I = 1, 15)/
     1   0,  1,  0,  3,  3,  0, 78, 77, -5,  1,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 92), I = 1, 10)/
     1   0,  1,  0,  1,  2,  0, -1,  1,  4,  8/
      DATA (ISETS(I, 93), I = 1, 44)/
     1   0,  1,  1, 15,  8,  0,  8,  4,  6,  2, 18, 15, 89, 86, 87, 61,
     2  58, 60, 59, -3, -4,  1,  1,  2,  2,  3,  3,  4,  4,  5,  6,  6,
     3   6,  6,  7,  7,  2,  2,  2,  4,  4,  4,  4,  8/
      DATA (ISETS(I, 94), I = 1, 23)/
     1   0,  1,  1,  6,  5,  0,  8,  7, 89, 87, -1, -2,  1,  1,  2,  3,
     2   4,  4,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 95), I = 1, 15)/
     1  20,  1,  0,  3,  3,  0, 78, 77, -6,  1,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 96), I = 1, 10)/
     1  20,  1,  0,  1,  2,  0, -1,  1,  4,  8/
      DATA (ISETS(I, 97), I = 1, 35)/
     1   0,  1,  1, 10,  9,  0,  8,  7,  6, 16, 89, 87, -1, 61, 60,-14,
     2   1,  1,  2,  3,  4,  5,  6,  7,  7,  8,  2,  4,  4,  4,  8,  8,
     3   8,  8, 16/
      DATA (ISETS(I, 98), I = 1, 23)/
     1   0,  1,  4,  6,  5,  0,  8,  7, 89, -1, -7, 69,  1,  1,  2,  3,
     2   3,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 99), I = 1, 23)/
     1   0,  1,  1,  6,  5,  0, 89, 86, 88,-36,103,102,  1,  1,  2,  3,
     2   4,  4,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 100), I = 1, 16)/
     1   0,  1,  1,  3,  4,  0, 89, 88,-38,  1,  2,  3,  2,  2,  4,  8/
      DATA (ISETS(I, 101), I = 1, 18)/
     1   0,  1,  1,  4,  4,  0, 89, 86, 87,-36,  1,  1,  2,  3,  2,  4,
     2   4,  8/
      DATA (ISETS(I, 102), I = 1, 16)/
     1   0,  1,  1,  3,  4,  0, 89, 87,-36,  1,  2,  3,  2,  4,  4,  8/
      DATA (ISETS(I, 103), I = 1, 15)/
     1   0,  1,  1,  3,  3,  0, 89, 86, 87,  1,  1,  2,  2,  4,  8/
      DATA (ISETS(I, 104), I = 1, 13)/
     1   0,  1,  1,  2,  3,  0, 89, 87,  1,  2,  2,  4,  8/
      DATA (ISETS(I, 105), I = 1, 20)/
     1   0,  1,  1,  5,  4,  0, 89, 86, 87,103,102,  1,  1,  2,  3,  3,
     2   2,  2,  4,  8/
      DATA (ISETS(I, 106), I = 1, 13)/
     1   0,  1,  1,  2,  3,  0, 89, 87,  1,  2,  4,  4,  8/
      DATA (ISETS(I, 107), I = 1, 19)/
     1   0,  1,  1,  4,  5,  0, 89, 87,-36,103,  1,  2,  3,  4,  2,  4,
     2   8,  8, 16/
      DATA (ISETS(I, 108), I = 1, 16)/
     1   0,  1,  1,  3,  4,  0, 89, 88,-38,  1,  2,  3,  4,  4,  8, 16/
      DATA (ISETS(I, 109), I = 1, 13)/
     1   0,  1,  2,  2,  3,  0, 89,106,  1,  2,  4,  8, 16/
      DATA (ISETS(I, 110), I = 1, 10)/
     1   0,  1,  2,  1,  2,  0, 89,  1,  8, 16/
      DATA (ISETS(I, 111), I = 1, 41)/
     1   0,  1,  1, 14,  7,  0,  8,  1,  7,  4,  5,  3, 89, 86, 61, 58,
     2  60, 59, 87,-36,  1,  1,  1,  1,  2,  2,  3,  3,  4,  4,  4,  4,
     3   5,  6,  1,  2,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 112), I = 1, 39)/
     1   0,  1,  1, 13,  7,  0, 18, 17, 15, 16,  8,  4, 63, 79, 65, 80,
     2  89, 86, 87,  1,  2,  1,  2,  3,  3,  4,  4,  4,  4,  5,  5,  6,
     3   2,  2,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 113), I = 1, 21)/
     1   0,  1,  1,  5,  5,  0,  8,  7, 87, 89,-38,  1,  1,  2,  3,  4,
     2   2,  2,  4,  4,  8/
      DATA (ISETS(I, 114), I = 1, 18)/
     1   0,  1,  1,  4,  4,  0,  8,  7, 89, 87,  1,  1,  2,  3,  2,  4,
     2   4,  8/
      DATA (ISETS(I, 115), I = 1, 34)/
     1   0,  1,  1, 11,  6,  0,  8,  4,  1,  7, 89, 86, 87, -1, -2,103,
     2 102,  1,  1,  1,  1,  2,  2,  3,  4,  4,  5,  5,  1,  2,  2,  4,
     3   4,  8/
      DATA (ISETS(I, 116), I = 1, 30)/
     1   0,  1,  1,  9,  6,  0, 18, 15,  8,  4, -3, -4, 89, 86, 87,  1,
     2   1,  2,  2,  3,  3,  4,  4,  5,  2,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 117), I = 1, 28)/
     1   0,  1,  1,  8,  6,  0,  8,  7,  6,  2, 89, 87,-16,-15,  1,  1,
     2   2,  2,  3,  4,  5,  5,  2,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 118), I = 1, 28)/
     1   0,  1,  1,  8,  6,  0,  8,  7, 16, 31, 89,-17,-14, 87,  1,  1,
     2   2,  2,  3,  4,  4,  5,  2,  2,  4,  4,  4,  8/
      DATA (ISETS(I, 119), I = 1, 29)/
     1   0,  1,  1,  9,  5,  0,  8,  7, 16, 31, 89, 87, -1,-14,103,  1,
     2   1,  1,  1,  2,  2,  3,  3,  4,  2,  4,  8,  8, 16/
      DATA (ISETS(I, 120), I = 1, 27)/
     1   0,  1,  1,  8,  5,  0, 18,  8, 16,  6, -3, 89, 87,-16,  1,  2,
     2   2,  1,  3,  4,  4,  3,  4,  4,  8,  8, 16/
      DATA (ISETS(I, 121), I = 1, 32)/
     1   0,  1,  1,  9,  8,  0,  8,  7,  6, 16, 89, 61, 60, 87,-36,  1,
     2   1,  2,  3,  4,  5,  5,  6,  7,  2,  4,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 122), I = 1, 18)/
     1   0,  1,  4,  4,  4,  0,  8,  7, 89, 69,  1,  1,  2,  3,  4,  8,
     2   8, 16/
      DATA (ISETS(I, 123), I = 1, 56)/
     1   0,  1,  0, 20, 10,  0,  8,  7,  4,  1,  2,  6, 89, 86, 87, -1,
     2  -2, 61, 60, 59, 58,100, 99,-36,103,102,  1,  1,  1,  1,  2,  2,
     3   3,  3,  4,  5,  5,  6,  6,  6,  6,  7,  7,  8,  9,  9,  1,  2,
     4   2,  4,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 124), I = 1, 42)/
     1   0,  1,  0, 13, 10,  0, 18,  8, 15,  4,  6, 16, 89, 86, 87, -3,
     2  63, 65,100,  1,  2,  1,  2,  3,  4,  5,  5,  6,  7,  8,  8,  9,
     3   2,  2,  4,  4,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 125), I = 1, 41)/
     1  15,  1,  0, 13,  9,  6, 22, 19, 21, 20,  8,  7, 90, 96, -1, -2,
     2  67, 66,-37,  1,  1,  2,  2,  3,  3,  4,  5,  6,  6,  7,  7,  8,
     3   2,  2,  4,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 126), I = 1, 35)/
     1  15,  1,  0, 10,  9,  5, 12, 11, 35, 23, 90,  8, 92, -3, 62, 70,
     2   1,  1,  2,  3,  4,  5,  6,  7,  8,  8,  2,  4,  4,  4,  8,  8,
     3   8,  8, 16/
      DATA (ISETS(I, 127), I = 1, 36)/
     1   0,  1,  0, 11,  8,  0,  8,  7,  2,  6, 89, 87,-16,-15,100, 99,
     2 -38,  1,  1,  2,  2,  3,  4,  5,  5,  6,  6,  7,  2,  2,  4,  4,
     3   4,  8,  8, 16/
      DATA (ISETS(I, 128), I = 1, 30)/
     1   0,  1,  0,  8,  8,  0,  8,  7,  6, 16, 89, 87,-14,100,  1,  1,
     2   2,  3,  4,  5,  6,  7,  2,  4,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 129), I = 1, 34)/
     1  15,  1,  0, 10,  8,  4, 21, 20, 90,  8,  7, 96, -7, -8,107,-36,
     2   1,  1,  2,  3,  3,  4,  5,  5,  6,  7,  2,  2,  4,  4,  8,  8,
     3   8, 16/
      DATA (ISETS(I, 130), I = 1, 25)/
     1  15,  1,  0,  6,  7,  4, 14, 21, 90,  8, 96, -9,  1,  2,  3,  4,
     2   5,  6,  4,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 131), I = 1, 50)/
     1   0,  1,  0, 17, 10,  0,  8,  4,  6,  2, 18, 15, 89, 86, 87, 61,
     2  58, 60, 59, -3,106,105,100,  1,  1,  2,  2,  3,  3,  4,  4,  5,
     3   6,  6,  6,  6,  7,  8,  8,  9,  2,  2,  2,  4,  4,  4,  8,  8,
     4   8, 16/
      DATA (ISETS(I, 132), I = 1, 47)/
     1   0,  1,  0, 15, 11,  0,  8, 18,  4, 15, 16,  6, 89, 86, -1, -2,
     2  87, 63, 65,100,-36,  1,  2,  1,  2,  3,  4,  5,  5,  6,  6,  7,
     3   8,  8,  9, 10,  2,  2,  4,  4,  4,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 133), I = 1, 36)/
     1  15,  1,  0, 10, 10,  7, 22, 21, 12, 36,  8, 90, 96, 67, 66, -3,
     2   1,  2,  3,  4,  5,  6,  7,  8,  8,  9,  4,  4,  4,  4,  8,  8,
     3   8,  8,  8, 16/
      DATA (ISETS(I, 134), I = 1, 42)/
     1  15,  1,  0, 13, 10,  7, 13, 14, 12, 22,  7,  8, 96, 90, 64, 62,
     2  -1, -2,-37,  1,  1,  2,  3,  4,  4,  5,  6,  7,  7,  8,  8,  9,
     3   2,  4,  4,  4,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 135), I = 1, 31)/
     1   0,  1,  0,  8,  9,  0,  8, 18,  6, 16, 89, 87,-14,100,  1,  2,
     2   3,  4,  5,  6,  7,  8,  4,  4,  4,  4,  8,  8,  8,  8, 16/
      DATA (ISETS(I, 136), I = 1, 35)/
     1   0,  1,  0, 10,  9,  0,  8,  7,  6, 16, 89, -1, -7, 87,100,-36,
     2   1,  1,  2,  3,  4,  5,  5,  6,  7,  8,  2,  4,  4,  4,  4,  8,
     3   8,  8, 16/
      DATA (ISETS(I, 137), I = 1, 27)/
     1  15,  1,  0,  7,  7,  7, 36, 14, 96, 90,  8, -9,107,  1,  1,  2,
     2   3,  4,  5,  6,  2,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 138), I = 1, 32)/
     1  15,  1,  0,  9,  8,  7, 21, 36,  7,  8, 90, 96, -8, -7,-36,  1,
     2   2,  3,  3,  4,  5,  6,  6,  7,  4,  4,  4,  4,  8,  8,  8, 16/
      DATA (ISETS(I, 139), I = 1, 47)/
     1   0,  1,  0, 14, 13,  0,  8,  7,  6, 16, 89, 12, 87, -1, 61, 59,
     2 -14,100,-36,106,  1,  1,  2,  3,  4,  5,  6,  7,  8,  8,  9, 10,
     3  11, 12,  2,  4,  4,  4,  8,  8,  8,  8, 16, 16, 16, 16, 32/
      DATA (ISETS(I, 140), I = 1, 43)/
     1   0,  1,  0, 12, 13,  0, 18, 16,  8,  6, 12, 89, 87,-16, -3, 63,
     2 100,-38,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12,  4,  4,
     3   4,  4,  8,  8,  8,  8, 16, 16, 16, 16, 32/
      DATA (ISETS(I, 141), I = 1, 29)/
     1  15,  1,  0,  8,  7,  8, 37, 38,  8,  7, 91, 61,-19,106,  1,  1,
     2   2,  2,  3,  4,  5,  6,  4,  8,  8, 16, 16, 16, 32/
      DATA (ISETS(I, 142), I = 1, 25)/
     1  15,  1,  0,  6,  7,  8, 38, 33,  8, 91, 63,-18,  1,  2,  3,  4,
     2   5,  6,  8,  8, 16, 16, 16, 16, 32/
      DATA (ISETS(I, 143), I = 1, 14)/
     1   0,  8,  1,  3,  2,  0, 89, 97, 98,  1,  1,  1,  1,  3/
      DATA (ISETS(I, 144), I = 1, 7)/
     1   0,  8,  0,  0,  1,  0,  3/
      DATA (ISETS(I, 145), I = 1, 7)/
     1  20,  8,  0,  0,  1,  0,  3/
      DATA (ISETS(I, 146), I = 1, 10)/
     1  16,  5,  1,  1,  2,  0, 89,  1,  3,  9/
      DATA (ISETS(I, 147), I = 1, 23)/
     1   0,  8,  0,  6,  5,  0,  8,  7, 89, 97,  5,  3,  1,  1,  2,  3,
     2   4,  4,  1,  2,  2,  3,  6/
      DATA (ISETS(I, 148), I = 1, 20)/
     1  16,  5,  0,  5,  4,  0,  8,  7, 89,  3,  5,  1,  1,  2,  3,  3,
     2   3,  6,  9, 18/
      DATA (ISETS(I, 149), I = 1, 32)/
     1   0,  3,  1, 11,  4,  0,  8,  7, 39, 40, 41, 42, 89, 97, 98, -7,
     2  -8,  1,  1,  1,  1,  1,  1,  2,  2,  2,  3,  3,  1,  2,  3,  6/
      DATA (ISETS(I, 150), I = 1, 23)/
     1   0,  3,  1,  6,  5,  0,  8,  7, 89, 97, 61, 60,  1,  1,  2,  3,
     2   4,  4,  1,  2,  2,  3,  6/
      DATA (ISETS(I, 151), I = 1, 12)/
     1   0,  3,  0,  2,  2,  0,-10,-13,  1,  1,  3,  6/
      DATA (ISETS(I, 152), I = 1, 12)/
     1   0,  3,  0,  2,  2,  0, 71, 72,  1,  1,  3,  6/
      DATA (ISETS(I, 153), I = 1, 12)/
     1  20,  3,  0,  2,  2,  0,-11,-12,  1,  1,  3,  6/
      DATA (ISETS(I, 154), I = 1, 12)/
     1  20,  3,  0,  2,  2,  0, 74, 73,  1,  1,  3,  6/
      DATA (ISETS(I, 155), I = 1, 20)/
     1  16,  1,  1,  5,  4,  0,  8,  7, 89, 61, 60,  1,  1,  2,  3,  3,
     2   3,  6,  9, 18/
      DATA (ISETS(I, 156), I = 1, 17)/
     1   0,  3,  1,  4,  3,  0, 89, 97, 98,-37,  1,  1,  1,  2,  1,  3,
     2   6/
      DATA (ISETS(I, 157), I = 1, 16)/
     1   0,  3,  1,  3,  4,  0, 89, 97,103,  1,  2,  3,  1,  2,  3,  6/
      DATA (ISETS(I, 158), I = 1, 14)/
     1   0,  3,  1,  3,  2,  0, 89, 97, 98,  1,  1,  1,  2,  6/
      DATA (ISETS(I, 159), I = 1, 13)/
     1   0,  3,  1,  2,  3,  0, 89, 97,  1,  2,  2,  2,  6/
      DATA (ISETS(I, 160), I = 1, 13)/
     1  16,  1,  1,  2,  3,  0, 89,-37,  1,  2,  3,  9, 18/
      DATA (ISETS(I, 161), I = 1, 10)/
     1  16,  1,  1,  1,  2,  0, 89,  1,  6, 18/
      DATA (ISETS(I, 162), I = 1, 36)/
     1   0,  3,  0, 11,  8,  0,  8,  7, 39, 40, 89,  5,  3, 97, -7, -8,
     2 103,  1,  1,  2,  2,  3,  4,  4,  5,  6,  6,  7,  1,  2,  2,  3,
     3   4,  6,  6, 12/
      DATA (ISETS(I, 163), I = 1, 30)/
     1   0,  3,  0,  8,  8,  0, 18,  8, 43, 44, 89, 97,  5, -9,  1,  2,
     2   3,  3,  4,  5,  6,  7,  2,  2,  2,  4,  4,  6,  6, 12/
      DATA (ISETS(I, 164), I = 1, 31)/
     1   0,  3,  0,  9,  7,  0,  8,  7, 89, 97,  5,  3, 61, 60,-37,  1,
     2   1,  2,  3,  4,  4,  5,  5,  6,  1,  2,  2,  3,  6,  6, 12/
      DATA (ISETS(I, 165), I = 1, 25)/
     1   0,  3,  0,  6,  7,  0, 18,  8, 89, 97,  5, 63,  1,  2,  3,  4,
     2   5,  6,  2,  2,  4,  4,  6,  6, 12/
      DATA (ISETS(I, 166), I = 1, 28)/
     1  16,  1,  0,  8,  6,  0,  8,  7, 89,  3,  5, 61, 60,-37,  1,  1,
     2   2,  3,  3,  4,  4,  5,  3,  6,  9, 18, 18, 36/
      DATA (ISETS(I, 167), I = 1, 22)/
     1  16,  1,  0,  5,  6,  0, 18,  8, 89,  5, 63,  1,  2,  3,  4,  5,
     2   6,  6, 12, 18, 18, 36/
      DATA (ISETS(I, 168), I = 1, 16)/
     1   0,  5,  1,  3,  4,  0, 89, 97, 88,  1,  2,  3,  1,  2,  3,  6/
      DATA (ISETS(I, 169), I = 1, 7)/
     1   0,  5,  0,  0,  1,  0,  6/
      DATA (ISETS(I, 170), I = 1, 7)/
     1  20,  5,  0,  0,  1,  0,  6/
      DATA (ISETS(I, 171), I = 1, 13)/
     1   0,  5,  0,  2,  3,  0, 89, 86,  1,  2,  3,  3,  6/
      DATA (ISETS(I, 172), I = 1, 13)/
     1  20,  5,  0,  2,  3,  0, 89, 86,  1,  2,  3,  3,  6/
      DATA (ISETS(I, 173), I = 1, 13)/
     1   0,  5,  1,  2,  3,  0, 89, 97,  1,  2,  2,  2,  6/
      DATA (ISETS(I, 174), I = 1, 32)/
     1   0,  6,  1, 11,  4,  0,  8,  7, 39, 40, 41, 42, 89, 97, 98,100,
     2  99,  1,  1,  1,  1,  1,  1,  2,  2,  2,  3,  3,  1,  2,  3,  6/
      DATA (ISETS(I, 175), I = 1, 36)/
     1   0,  5,  0, 11,  8,  0,  8,  7, 39, 40, 89,  5,  3, 97, 88,100,
     2  99,  1,  1,  2,  2,  3,  4,  4,  5,  6,  7,  7,  1,  2,  2,  3,
     3   4,  6,  6, 12/
      DATA (ISETS(I, 176), I = 1, 30)/
     1   0,  5,  0,  8,  8,  0, 18,  8, 43, 44, 89, 97,  5,101,  1,  2,
     2   3,  3,  4,  5,  6,  7,  2,  2,  2,  4,  4,  6,  6, 12/
      DATA (ISETS(I, 177), I = 1, 41)/
     1   0,  1,  1, 13,  9,  0,  8,  7, 39, 40, 89,  5,  3, 97, 88, 61,
     2  60, -7, -8,  1,  1,  2,  2,  3,  4,  4,  5,  6,  7,  7,  8,  8,
     3   1,  2,  2,  3,  4,  6,  6,  6, 12/
      DATA (ISETS(I, 178), I = 1, 13)/
     1   0,  1,  0,  2,  3,  0, 61,-22,  1,  2,  6,  6, 12/
      DATA (ISETS(I, 179), I = 1, 13)/
     1  20,  1,  0,  2,  3,  0, 61,-23,  1,  2,  6,  6, 12/
      DATA (ISETS(I, 180), I = 1, 33)/
     1   0,  1,  0, 10,  7,  0,  8,  7,  5,  3, 89, 88, 61, 60,-20,-21,
     2   1,  1,  2,  2,  3,  4,  5,  5,  6,  6,  3,  3,  6,  6,  6,  6,
     3  12/
      DATA (ISETS(I, 181), I = 1, 33)/
     1  20,  1,  0, 10,  7,  0,  8,  7,  5,  3, 89, 88, 61, 60,-20,-21,
     2   1,  1,  2,  2,  3,  4,  5,  5,  6,  6,  3,  3,  6,  6,  6,  6,
     3  12/
      DATA (ISETS(I, 182), I = 1, 30)/
     1   0,  1,  1,  8,  8,  0,  8, 18, 43, 45, 89, 97, 61,-22,  1,  2,
     2   3,  3,  4,  5,  6,  7,  2,  2,  2,  4,  4,  6,  6, 12/
      DATA (ISETS(I, 183), I = 1, 22)/
     1   0,  1,  1,  5,  6,  0, 89, 97, 88,103,-37,  1,  2,  3,  4,  5,
     2   1,  2,  3,  6,  6, 12/
      DATA (ISETS(I, 184), I = 1, 16)/
     1   0,  1,  1,  3,  4,  0, 89, 97, 88,  1,  2,  3,  2,  4,  6, 12/
      DATA (ISETS(I, 185), I = 1, 16)/
     1   0,  1,  1,  3,  4,  0, 89, 97,103,  1,  2,  3,  2,  4,  6, 12/
      DATA (ISETS(I, 186), I = 1, 16)/
     1   0,  1,  1,  3,  4,  0, 89, 97,-37,  1,  2,  3,  2,  2,  6, 12/
      DATA (ISETS(I, 187), I = 1, 40)/
     1   0,  1,  1, 14,  6,  0,  8,  7, 39, 40, 41, 42, 89, 97, 98, -7,
     2  -8,100, 99,-37,  1,  1,  1,  1,  1,  1,  2,  2,  2,  3,  3,  4,
     3   4,  5,  1,  2,  3,  6,  6, 12/
      DATA (ISETS(I, 188), I = 1, 34)/
     1   0,  1,  1, 11,  6,  0,  8, 18, 39, 43, 41, 44, 89, 97, 98, -7,
     2 101,  1,  2,  1,  2,  1,  2,  3,  3,  3,  4,  5,  2,  2,  4,  6,
     3   6, 12/
      DATA (ISETS(I, 189), I = 1, 36)/
     1   0,  1,  1, 11,  8,  0,  8,  7, 39, 40, 89, 61, 60, 97,103,100,
     2  99,  1,  1,  2,  2,  3,  4,  4,  5,  6,  7,  7,  1,  2,  2,  3,
     3   4,  6,  6, 12/
      DATA (ISETS(I, 190), I = 1, 30)/
     1   0,  1,  1,  8,  8,  0,  8, 18, 43, 44, 89, 97, 61,101,  1,  2,
     2   3,  3,  4,  5,  6,  7,  2,  2,  2,  4,  4,  6,  6, 12/
      DATA (ISETS(I, 191), I = 1, 52)/
     1   0,  1,  0, 17, 12,  0,  8,  7, 39, 40, 89,  5,  3, 97, 88, 61,
     2  60,-20,-21,103,-39,100, 99,  1,  1,  2,  2,  3,  4,  4,  5,  6,
     3   7,  7,  8,  8,  9, 10, 11, 11,  1,  2,  2,  3,  4,  6,  6,  6,
     4  12, 12, 12, 24/
      DATA (ISETS(I, 192), I = 1, 43)/
     1   0,  1,  0, 12, 13,  0, 18,  8, 43, 39, 89, 17,  5, 97, 88, 63,
     2 -22,100,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12,  2,  2,
     3   4,  4,  4,  6,  6,  8, 12, 12, 12, 12, 24/
      DATA (ISETS(I, 193), I = 1, 40)/
     1   0,  1,  0, 11, 12,  0, 18,  8, 43, 39, 89,  5, 63, 97,-20,101,
     2 103,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11,  2,  2,  4,  4,
     3   4,  6,  6,  8, 12, 12, 12, 24/
      DATA (ISETS(I, 194), I = 1, 39)/
     1   0,  1,  0, 11, 11,  0,  8, 18, 43, 45, 89, 97,  5,-22, 61,101,
     2 -39,  1,  2,  3,  3,  4,  5,  6,  7,  8,  9, 10,  2,  2,  2,  4,
     3   4,  6,  6, 12, 12, 12, 24/
      DATA (ISETS(I, 195), I = 1, 30)/
     1   0,  5,  1,  9,  6,  0,  8,  1,  2,  5,-35, 61, 60, 59, 58,  1,
     2   1,  2,  2,  3,  4,  5,  5,  4,  1,  3,  4,  6,  6, 12/
      DATA (ISETS(I, 196), I = 1, 24)/
     1   0,  5,  1,  7,  4,  0,  8,  1, 12, 46,-35, 61, 62,  1,  1,  1,
     2   1,  2,  3,  3,  4, 16, 24, 48/
      DATA (ISETS(I, 197), I = 1, 22)/
     1   0,  5,  1,  5,  6,  0,  8,  2,-35, 61, 59,  1,  2,  3,  4,  5,
     2   2,  6,  8, 12, 12, 24/
      DATA (ISETS(I, 198), I = 1, 10)/
     1   0,  7,  1,  1,  2,  0,-35,  1,  4, 12/
      DATA (ISETS(I, 199), I = 1, 13)/
     1   0,  7,  1,  2,  3,  0,-35, 63,  1,  2,  8, 12, 24/
      DATA (ISETS(I, 200), I = 1, 35)/
     1   0,  5,  0, 11,  7,  0,  8,  1,  2,  5, 61, 60, 59, 58,-35,106,
     2 105,  1,  1,  2,  2,  3,  4,  4,  3,  5,  6,  6,  1,  3,  6,  6,
     3   8, 12, 24/
      DATA (ISETS(I, 201), I = 1, 27)/
     1  15,  6,  0,  7,  7,  5, 12,  8,  1, 35,-35, 62, 70,  1,  2,  2,
     2   3,  4,  5,  6,  2,  4,  6,  8, 12, 12, 24/
      DATA (ISETS(I, 202), I = 1, 30)/
     1   0,  5,  0,  8,  8,  0,  8,  1, 12, 26, 61,-35, 62,106,  1,  1,
     2   2,  3,  4,  5,  6,  7,  4,  8, 24, 24, 32, 48, 48, 96/
      DATA (ISETS(I, 203), I = 1, 23)/
     1  15,  6,  0,  6,  5, 10, 28, 47,  8,  1,-35, 68,  1,  1,  2,  2,
     2   3,  4,  8, 16, 32, 48, 96/
      DATA (ISETS(I, 204), I = 1, 28)/
     1   0,  5,  0,  7,  8,  0,  8,  2, 12, 61, 60,-35,106,  1,  2,  3,
     2   4,  5,  6,  7,  2,  6,  8, 12, 12, 16, 24, 48/
      DATA (ISETS(I, 205), I = 1, 15)/
     1   0,  1,  0,  3,  3,  0,  8,  1,-35,  1,  1,  2,  4,  8, 24/
      DATA (ISETS(I, 206), I = 1, 18)/
     1   0,  7,  0,  4,  4,  0,  8, 12,-35, 63,  1,  1,  2,  3,  8, 16,
     2  24, 48/
      DATA (ISETS(I, 207), I = 1, 33)/
     1   0,  1,  1, 10,  7,  0,  8,  1,  2,  5, 61, 58,-35, 59,-24,-25,
     2   1,  1,  2,  2,  3,  3,  4,  5,  6,  6,  1,  3,  6,  8, 12, 12,
     3  24/
      DATA (ISETS(I, 208), I = 1, 39)/
     1   0,  1,  1, 12,  9,  0,  8, 12, 46,  2, 25, 48,-35, 61, 60, 59,
     2 -30,-29,  1,  2,  2,  3,  4,  4,  5,  6,  7,  7,  8,  8,  2,  4,
     3   6,  6,  8, 12, 12, 12, 24/
      DATA (ISETS(I, 209), I = 1, 32)/
     1   0,  1,  1,  9,  8,  0,  8,  1, 12, 26, 61,-35,-24,-25, 62,  1,
     2   1,  2,  3,  4,  5,  6,  6,  7,  4,  8, 24, 24, 32, 48, 48, 96/
      DATA (ISETS(I, 210), I = 1, 26)/
     1   0,  1,  3,  7,  6,  0,  8,  1, 28, 47,-35, 61,-34,  1,  1,  2,
     2   2,  3,  4,  5,  8, 16, 32, 48, 48, 96/
      DATA (ISETS(I, 211), I = 1, 34)/
     1   0,  1,  1,  9, 10,  0,  8,  2, 12, 48, 61,-35, 59,-24,-30,  1,
     2   2,  3,  4,  5,  6,  7,  8,  9,  2,  6,  8, 12, 12, 16, 24, 24,
     3  24, 48/
      DATA (ISETS(I, 212), I = 1, 18)/
     1  20,  1,  0,  4,  4,  0, 28, 47,-35,-34,  1,  1,  2,  3,  4,  8,
     2  12, 24/
      DATA (ISETS(I, 213), I = 1, 18)/
     1   0,  1,  0,  4,  4,  0, 49, 50,-35,-33,  1,  1,  2,  3,  4,  8,
     2  12, 24/
      DATA (ISETS(I, 214), I = 1, 28)/
     1   0,  1,  1,  8,  6,  0, 28, 50, 51, 52,-35, 63,-33,-34,  1,  1,
     2   2,  2,  3,  4,  5,  5,  8, 12, 16, 24, 24, 48/
      DATA (ISETS(I, 215), I = 1, 31)/
     1   0,  1,  1,  9,  7,  0,  8,  1,  2,  5,-35, 61, 58, 59,-36,  1,
     2   1,  2,  2,  3,  4,  4,  5,  6,  1,  3,  4,  6, 12, 12, 24/
      DATA (ISETS(I, 216), I = 1, 27)/
     1   0,  1,  1,  8,  5,  0,  8,  1, 12, 46,-35, 61, 62,-36,  1,  1,
     2   1,  1,  2,  3,  3,  4,  4, 16, 24, 48, 96/
      DATA (ISETS(I, 217), I = 1, 28)/
     1   0,  1,  1,  7,  8,  0,  8,  2,-35, 48, 61, 59,-36,  1,  2,  3,
     2   4,  5,  6,  7,  2,  6,  8, 12, 12, 24, 24, 48/
      DATA (ISETS(I, 218), I = 1, 29)/
     1   0,  1,  1,  8,  7,  0,  8,  2, 48, 25,-35, 61, 59, 60,  1,  2,
     2   3,  3,  4,  5,  6,  6,  2,  6,  6,  8, 12, 12, 24/
      DATA (ISETS(I, 219), I = 1, 25)/
     1   0,  1,  1,  7,  5,  0,  8, 12, 26, 24,-35, 61, 62,  1,  1,  2,
     2   2,  3,  4,  4,  8, 24, 32, 48, 96/
      DATA (ISETS(I, 220), I = 1, 18)/
     1   0,  1,  1,  4,  4,  0, 53, 54,-35, 63,  1,  1,  2,  3, 12, 16,
     2  24, 48/
      DATA (ISETS(I, 221), I = 1, 41)/
     1   0,  1,  0, 13,  9,  0,  8,  1,  2,  5, 61, 58,-35, 59,-24,-25,
     2 106,105,-36,  1,  1,  2,  2,  3,  3,  4,  5,  6,  6,  7,  7,  8,
     3   1,  3,  6,  8, 12, 12, 24, 24, 48/
      DATA (ISETS(I, 222), I = 1, 31)/
     1  15,  1,  0,  8,  9,  5, 12, 14,  8, 55, 62,-35, 70,-26,  1,  2,
     2   3,  4,  5,  6,  7,  8,  2,  6,  8, 12, 12, 16, 24, 24, 48/
      DATA (ISETS(I, 223), I = 1, 38)/
     1   0,  1,  0, 11, 10,  0,  8,  2, 25, 48, 12, 61, 60, 59,-35,-29,
     2 106,  1,  2,  3,  3,  4,  5,  6,  6,  7,  8,  9,  2,  6,  6,  8,
     3  12, 12, 16, 24, 24, 48/
      DATA (ISETS(I, 224), I = 1, 38)/
     1  15,  1,  0, 11, 10,  5, 12,  8,  1, 35,-35, 56, 62, 64,-32,-31,
     2 -36,  1,  2,  2,  3,  4,  5,  6,  7,  8,  8,  9,  2,  4,  6,  8,
     3  12, 12, 24, 24, 24, 48/
      DATA (ISETS(I, 225), I = 1, 38)/
     1   0,  1,  0, 11, 10,  0,  8,  1, 12, 26, 61,-35, 62,-24,-25,106,
     2 -36,  1,  1,  2,  3,  4,  5,  6,  7,  7,  8,  9,  4,  8, 24, 24,
     3  32, 48, 48, 96, 96,192/
      DATA (ISETS(I, 226), I = 1, 34)/
     1   0,  1,  0,  9, 10,  0, 12,  8, 24, 26, 61, 62,-35,-26,106,  1,
     2   2,  3,  4,  5,  6,  7,  8,  9,  8,  8, 24, 24, 48, 48, 64, 96,
     3  96,192/
      DATA (ISETS(I, 227), I = 1, 29)/
     1  15,  1,  0,  8,  7, 10, 28, 49,  8,  1,-35, 68,-36,-27,  1,  1,
     2   2,  2,  3,  4,  5,  6,  8, 16, 32, 48, 96, 96,192/
      DATA (ISETS(I, 228), I = 1, 28)/
     1  15,  1,  0,  7,  8, 11, 28, 12,  8, 57,-35, 68,-28,  1,  2,  3,
     2   4,  5,  6,  7, 16, 32, 32, 48, 64, 96, 96,192/
      DATA (ISETS(I, 229), I = 1, 40)/
     1   0,  1,  0, 11, 12,  0,  8,  2, 12, 25, 61,-35, 60,-24,-30,106,
     2 -36,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11,  2,  6,  8, 12,
     3  12, 16, 24, 24, 48, 48, 48, 96/
      DATA (ISETS(I, 230), I = 1, 28)/
     1   0,  1,  0,  7,  8,  0,  8, 28, 51, 53,-35, 63,-34,  1,  2,  3,
     2   4,  5,  6,  7, 16, 16, 24, 24, 32, 48, 48, 96/
      DATA (NNT1(I), I = 1, 249) /
     1 656, 96, 12351, 8266, 20521, 286, 8456, 20711, 381, 12636, 20806,
     2 476, 8646, 12731, 0, 572, 0, 4657, 0, 12827, 0, 20997, 0, 573, 0,
     3 4658, 0, 20998, 0, 574, 0, 12829, 0, 20999, 0, 575, 0, 4660, 0,
     4 12830, 586, 4671, 8756, 21011, 596, 4681, 21021, 603, 8773,
     5 21028, 619, 4704, 8789, 666, 12921, 8836, 21091, 761, 0, 576, 0,
     6 4661, 0, 12831, 0, 21001, 0, 577, 634, 4719, 8804, 21059, 644,
     7 682, 4767, 8852, 12937, 21107, 17022, 699, 8869, 21124, 12954,
     8 787, 4872, 685, 8855, 12940, 21110, 701, 8871, 12956, 21126, 789,
     9 795, 812, 797, 778, 4863, 693, 4778, 695, 716, 718, 781, 810,
     * 17065, 117, 4202, 8287, 12372, 20542, 16457, 402, 12657, 20827,
     1 4487, 134, 8304, 126, 12381, 4211, 20551, 411, 20836, 12666,
     2 4496, 317, 419, 507, 435, 308, 8478, 323, 8493, 339, 513, 529,
     3 150, 498, 18206, 160, 4245, 8330, 12415, 20585, 16500, 161, 4246,
     4 20586, 8331, 172, 12427, 350, 4435, 8520, 20775, 351, 20776,
     5 4436, 8521, 362, 456, 363, 551, 455, 12710, 448, 12703, 543, 449,
     6 544, 550, 173, 18215, 736, 4821, 8906, 12991, 21161, 17076, 744,
     7 12999, 831, 4916, 737, 8907, 832, 839, 745, 840, 21265, 1986,
     8 22411, 2081, 22506, 2176, 2271, 2366, 22601, 2012, 22437, 2014,
     9 2205, 2206, 2038, 22440, 2039, 2226, 2227, 22573, 22574, 1922,
     * 22347, 1945, 1923, 1946, 22386, 1965, 22390, 1968, 22393, 1967,
     1 1969, 2066, 22491, 2067, 2161, 2162, 2256, 2257, 2351, 2352,
     2 22586, 3031, 27541, 3221, 3316, 2947, 27536, 2949, 27537, 2961,
     3 2985, 2951, 27538, 3141, 3236, 3009/
       DATA (NNT1(I), I = 250, 500) /
     1 3199, 3294, 3411, 3506, 3601, 3981, 3696, 3886, 3791, 3437, 3463,
     2 3725, 3746, 3390, 3393, 3347, 3370, 3491, 3586, 3966, 3681, 3871,
     3 3776, 749, 17089, 21174, 844, 21269, 1924, 18264, 22349, 1956,
     4 18287, 22387, 2068, 22493, 18408, 2163, 2258, 2353, 22588, 18503,
     5 3126, 856, 9026, 13111, 21281, 1236, 9406, 21661, 1426, 13681,
     6 21851, 1616, 9786, 13871, 951, 1331, 1521, 1711, 0, 578, 0, 4663,
     7 0, 12833, 0, 21003, 0, 579, 0, 4664, 0, 21004, 0, 580, 0, 12835,
     8 0, 21005, 0, 581, 0, 4666, 0, 12836, 0, 582, 0, 583, 0, 584, 0,
     9 585, 657, 4742, 8827, 21082, 658, 4743, 21083, 659, 8829, 21084,
     * 660, 4745, 8830, 661, 662, 663, 664, 112, 4197, 8282, 12367,
     1 20537, 16452, 129, 20547, 8299, 115, 20538, 12370, 125, 12379,
     2 146, 123, 20556, 12377, 8283, 4208, 131, 8300, 148, 122, 20554,
     3 4207, 113, 20540, 4198, 124, 130, 145, 116, 132, 147, 319, 20832,
     4 4387, 12384, 8489, 302, 20822, 8472, 338, 313, 4398, 321, 8491,
     5 305, 315, 336, 400, 20728, 8285, 4482, 12655, 397, 20727, 12652,
     6 433, 416, 12671, 408, 4493, 414, 431, 410, 415, 401, 409, 12664,
     7 407, 4397, 432, 398, 417, 430, 528, 505, 526, 509, 12669, 495,
     8 8475, 503, 492, 511, 335, 320, 8490, 303, 4483, 322, 312, 337,
     9 314, 20739, 306, 512, 527, 496, 525, 504, 510, 502, 493, 18205,
     * 2936, 27446, 2461, 22886, 2556, 2746, 2841, 23076, 2392, 22817,
     1 2418, 22820, 2679, 2704, 2394, 2419, 2677, 2703, 2511, 2490,
     2 2797, 2776, 2512, 2491, 2796, 2775, 23048, 23049, 2852, 27441,
     3 2854, 27442, 2866/
      DATA (NNT1(I), I = 501, 1000) /
     1 2890, 4007, 4033, 4105, 4126, 4076, 4171, 119, 120, 20544, 20545,
     2 16459, 16460, 531, 532, 151, 152, 16482, 16483, 499, 500, 18169,
     3 18170, 18192, 18193, 20677, 20678, 179, 180, 20604, 20605, 16519,
     4 16520, 559, 560, 274, 275, 20699, 20700, 18229, 18230, 5*0, 3*2,
     5 3*3, 3*4, 8*0, 6*1, 6*3, 6*5, 4*0, 3*1, 3*2, 3*6, 4*0, 1,8*0,
     6 2*2, 4*0, 3, 6*0, 4*62, 2*30, 4*93, 4*124, 153, 66, 214, 127, 1,
     7 1, 2*31, 155, 186, 217, 5, 180, 341, 6*0, 4*93, 2*60, 4*31,
     8 4*155, 36, 123, 157, 215, 2, 2, 2*62, 186, 124, 217, 180, 4, 341,
     9 6*0, 4*31, 2*90, 4*62, 4*186, 122, 35, 216, 187, 3, 3, 2*93, 124,
     * 155, 217, 4, 150, 341, 6*0, 2*90, 2*1, 2*62, 186, 5, 120, 2*126,
     1 4*0, 14, 3, 18, 16, 0, 0, 186, 3, 7, 2*93, 217, 90, 216, 480,
     2 606, 0, 0, 93, 186, 217, 496, 0, 0, 2*93, 186, 217, 0, 0, 6, 423,
     3 111, 90, 7, 543, 112, 16, 0, 0, 15, 17, 0, 0, 2*90, 0, 90, 0,0,
     4 15, 17, 0, 15, 17, 0, 0, 13, 19, 15, 17, 3, 0, 93, 3, 90, 0, 3,
     5 0, 90, 0, 19, 13, 17, 15, 3, 3*0, 2*5, 3*0, 2*210, 360, 3*0, 360,
     6 210, 3*690, 5*0, 3*62, 3*93, 3*124, 31, 186, 155, 217, 8*0, 6*31,
     7 6*93, 6*155, 2*62, 2*186, 2*124, 2*217, 4*0, 3*31, 3*62, 3*186,
     8 93,155, 124, 217, 6*0, 3*1860, 3*2790, 2*4650, 5580, 5*930,
     9 2*3720, 6510, 3*901, 3*31, 4591, 1981, 5461, 2851, 3811, 6421,
     * 5*1802, 3*62, 6452, 2*1082, 2*3692, 2822, 4712, 5432, 5*93,
     1 3*2703, 5613, 2*1923, 2*4533, 3663, 6483, 1053, 3785,155, 2*995,
     2 2*4505, 5525, 2735, 2015, 6365, 5554, 1114, 6334, 2*3604, 2*124,
     3 4684, 2764, 1894, 5406, 2*1836, 2*186, 3756, 966, 6396, 2*4626,
     4 2916, 1957/
      DATA (NNT1(I), I= 1001, 1623) /
     1 5497, 217, 6307, 1027, 3637, 4567, 2887, 9278, 0, 0, 0, 0, 3,
     2 181, 184, 162, 0, 0, 2790, 2790, 5466, 6426, 5580, 6510, 36,
     3 2856, 2700, 90, 6366, 5526, 6480, 210, 2736, 156, 21602, 9992, 0,
     4 0, 90, 90, 0, 90, 0, 2790, 93, 2703, 0, 93, 0, 0, 0, 0, 0, 0,
     5 6306, 6306, 6300, 6300, 6300, 6300, 6, 6, 10, 10, 6310, 6310,
     6 9902, 9902, 0, 0, 0, 0, 0, 0, 6, 6, 5, 5, 5, 5, 10, 10, 1, 2, 2,
     7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
     8 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4,
     9 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7,
     * 7, 7, 7, 7, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
     1 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6,
     2 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
     3 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
     4 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8,
     5 8, 17, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 10, 18, 9, 9, 9, 9, 9, 9,
     6 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10,
     7 18, 10, 18, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 15,
     8 15, 15, 15, 15, 15, 15, 15, 13, 13, 11, 14, 11, 11, 16, 16, 16,
     9 16, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 16, 16, 11, 11, 11,
     * 11, 11, 11, 11, 11, 12, 17, 12, 12, 12, 12, 17, 12, 12, 17, 12,
     1 12, 12, 8, 12, 12, 12, 12, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     2 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     3 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     4 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     5 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     6 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     7 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     8 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
     9 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 11, 14, 10, 10, 3 10, 10, 10, 10,
     * 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
     1 10, 10, 10, 10, 11, 14, 11, 14, 11, 11, 11, 11, 11, 11, 11, 11,
     2 12, 12, 12, 12, 8, 8, 12, 12, 12, 12, 8, 8, 12, 12, 8, 8, 8, 8,
     3 12, 12, 12, 12, 12, 12, 8, 8, 12, 12, 12, 12, 12, 12, 8, 8/
      DATA ISY /
     1  1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5,
     2  5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 1, 2, 2, 2, 3, 5, 4, 4, 5, 5, 5,
     3  5, 6, 6/
      DATA NNQ /
     1   0,  0,  0,  0, 12, 12,  0,  0,  0,  0,  0,  0,  0,  0,  0, 12,
     2   0, 12,  0,  0,  0,  0,  0,  0,  0,  0,  0, 12, 12,  0,  0,  0,
     3   0,  0,  0,  0,  0,  0,  0,  0, 12, 12, 12,  0, 12, 12, 12,  0,
     4   0,  0,  0, 12, 12, 12,  0,  0,  0,  0,  0,  0/
      DATA NGET /
     1   0,  0,  0, 12,  0,  0,  0, 12,  0,  0,  0, 12,  0, 12, 12, 12,
     2   0, 12, 12, 12,  0, 12, 12, 12,  0,  6,  6,  6,  0,  6,  6,  6,
     3   0,  6,  6,  6, 18,  6,  6,  0,  0,  4,  0,  0,  6,  0,  0,  8,
     4   0, 12,  6,  0,  0, 16,  0,  0, 18,  0,  0, 20, 12,  0,  6, 12,
     5  12, 18, 12, 12,  6,  6, 18, 18,  6,  6, 18/
      DATA NT2 /
     1   0,   1,  14,  40,  53,  58,  68,  73, 107, 141, 175, 192, 194,
     2 200, 212, 218, 224, 234, 238, 242, 244, 248, 251, 252, 258, 262,
     3 264, 266, 272, 277, 283, 291, 292, 309, 343, 360, 467, 469, 475,
     4 495, 499, 501, 505, 507, 527/
      DATA LGN /
     1   1,  0,  0,  2,  0,  0,  2,  0,  0,  2,  0,  0,  2,  0,  0,  2,
     2   0,  0,  2,  0,  0,  3,  4,  0,  3,  4,  0,  3,  4,  0,  3,  4,
     3   0,  3,  0,  0,  3,  0,  0,  5,  7,  0,  5,  3,  0,  5,  3,  0,
     4   3,  5,  0,  2,  0,  0,  2,  4,  0,  2,  4,  0,  2,  6,  0,  2,
     5   5,  0,  5,  0,  0,  5,  0,  0,  7, 10,  0,  7,  4,  0,  4,  7,
     6   0, 10,  7,  0,  2,  5,  0,  5, 14,  0,  5, 14,  0,  2,  0,  0,
     7   4,  2,  0,  4,  2,  0,  4,  2,  0,  7,  8,  6,  5,  0,  0,  3,
     8   6,  0, 10, 11, 13,  8, 10,  0,  8, 10,  0, 14, 19, 22,  5,  8,
     9   0, 26,  5, 37, 14,  5,  0/
      DATA LLF /
     1   1,  1, -2,  1, -3,  1, -4,  1,  2,  1,  3,  1,  4,  1,  2, -3,
     2  -4,  1,  3, -2, -4,  1,  4, -2, -3,  1,  4,  2,  3,  1,  4,-15,
     3 -14,  1,  4, 15, 14,  1,  4, 15, 14, -2, -3,-13,-16,  1,  4,  2,
     4   3,-13,-16,-14,-15,  1,  4, 13, 16, -2, -3,-14,-15,  1,  4,  2,
     5   3, 13, 16, 14, 15,  1,  3,  5,  1,  3,  5, -9,-11, -7,  1,  3,
     6   5,-10, -8,-12,  1,  3,  5,  9, 11,  7,  1,  3,  5, 10,  8, 12,
     7   1,  3,  5, -4, -2, -6,  1,  4,  3,  5,  2,  6,  1,  4,  3,  5,
     8   2,  6, -9,-11, -7,-10, -8,-12,  1,  3,  5, 10,  8, 12, -9,-11,
     9  -7, -4, -2, -6,  1,  3,  5,  9, 11,  7,-10, -8,-12, -4, -2, -6,
     *   1,  4,  3,  5,  2,  6,  9, 11,  7, 10,  8, 12,  1,  4,  2,  3,
     1   5,  9,  7, 12,  8, 10,  6, 11,  1,  4,  2,  3,  5,  9,  7, 12,
     2   8, 10,  6, 11,-13,-16,-14,-15,-17,-21,-19,-24,-20,-22,-18,-23,
     3   1,  4,  2,  3,  5,  9,  7, 12,  8, 10,  6, 11, 13, 16, 14, 15,
     4  17, 21, 19, 24, 20, 22, 18, 23/
      DATA MM5 /
     1     1,    2,    3,    4,    5,    8,    9,  129,  444, 6654, 669,
     2 10029,  894,13404, 1119,16779, 1344,20154,    6,  172,   11, 131,
     3   146,  161,  446, 6671,10031, 1346,20171,  157,   10,  127, 130,
     4   145,  202,   13,  133,  148,  163,  178,  193,  448, 6688,   8,
     5     1,    2,    3,    4,    5,    6,    9,  129,   10,  157,   0,
     6   444,  669, 1119, 1344, 6654,10029,16779,20154,   -1,   -1,  -1,
     7    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  -1,
     8    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,    8,   1,
     9     2,    3,    4,    5,    6,    9,  129,    0,  444,  669, 894,
     *  1344, 6654,10029,13404,20154,   -1,   -1,   -1,   -1,   -1,  -1,
     1    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  -1,
     2    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1/
      DATA XABC /
     1  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,  1.0,  0.0,  0.0,
     2  0.0,  0.0,  1.0,  1.0,  0.0,  0.0,  0.0,  1.0,  0.0,
     3  1.0,  0.0,  0.0,  0.0,  0.0, -1.0,  0.0,  1.0,  0.0,
     4  0.0,  1.0,  0.0, -1.0,  0.0,  0.0,  0.0,  0.0,  1.0,
     5  0.0,  0.0,  1.0,  0.0, -1.0,  0.0,  1.0,  0.0,  0.0,
     6  0.0, -1.0,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,  1.0,
     7  0.0, -1.0, -1.0,  1.0,  0.0,  0.0,  0.0,  0.0,  1.0,
     8  0.0,  0.0, -1.0,  0.0,  1.0,  0.0,  1.0,  0.0,  1.0,
     9 -1.0,  0.0, -1.0,  0.0,  1.0,  0.0,  1.0,  0.0,  0.0,
     * -1.0,  0.0,  0.0,  0.0,  0.0,  1.0,  1.0,  1.0,  0.0,
     1 -1.0, -1.0,  0.0,  0.0,  0.0,  1.0,  0.0,  1.0,  0.0,
     2  0.0,  0.0, -1.0, -1.0,  0.0,  0.0,  0.0,  1.0,  1.0,
     3  0.0, -1.0, -1.0, -1.0,  0.0,  0.0,  0.0,  1.0,  0.0,
     4 -1.0,  0.0,  0.0,  0.0, -1.0,  0.0,  1.0,  0.0,  1.0,
     5 -1.0,  0.0, -1.0,  0.0, -1.0,  0.0,  0.0,  0.0,  1.0,
     6  0.0, -1.0,  0.0,  0.0,  0.0, -1.0,  1.0,  1.0,  0.0,
     7 -1.0, -1.0,  0.0,  0.0,  0.0, -1.0,  1.0,  0.0,  0.0,
     8  0.0,  1.0,  0.0, -1.0,  0.0,  0.0,  0.0, -1.0,  1.0,
     9  0.0,  1.0, -1.0, -1.0,  0.0,  0.0,  0.0,  0.0,  1.0,
     *  0.0,  0.0,  1.0,  0.0, -1.0,  0.0,  1.0,  0.0, -1.0,
     1 -1.0,  0.0,  1.0,  0.0, -1.0,  0.0,  1.0,  0.0,  0.0,
     2  1.0,  0.0,  0.0,  0.0,  0.0, -1.0, -1.0,  1.0,  0.0,
     3  1.0, -1.0,  0.0,  0.0,  0.0, -1.0,  0.0,  1.0,  0.0,
     4  0.0,  0.0,  1.0,  1.0,  0.0,  0.0,  0.0,  1.0, -1.0,
     5  0.0, -1.0,  1.0,  1.0,  0.0,  0.0,  0.0,  1.0,  0.0,
     6  1.0,  0.0,  0.0,  0.0,  1.0,  0.0, -1.0,  0.0,  1.0,
     7  1.0,  0.0, -1.0,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     8  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,  1.0, -1.0,  0.0,
     9 -1.0,  1.0,  0.0,  0.0,  0.0,  1.0,  1.0,  0.0,  0.0,
     * -1.0,  0.0,  0.0,  0.0, -1.0,  0.0,  0.0,  0.0, -1.0/
      DATA NCENT /
     1  1,  1,  1,  1,  3,  1,  1,  3,  3,  1,  1,  3,  1,  1,  3,  1,
     2  1,  1,  1,  3,  3,  4,  5,  5,  1,  1,  1,  1,  1,  1,  1,  1,
     3  1,  1,  3,  3,  3,  2,  2,  2,  2,  4,  4,  5,  5,  5,  1,  1,
     4  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  3,  3,
     5  3,  3,  3,  3,  4,  4,  5,  5,  5,  5,  1,  1,  1,  1,  5,  5,
     6  1,  5,  1,  1,  1,  1,  5,  5,  1,  1,  1,  1,  1,  1,  1,  1,
     7  5,  5,  1,  1,  1,  1,  1,  1,  1,  1,  5,  5,  5,  5,  1,  1,
     8  1,  1,  1,  1,  1,  1,  5,  5,  5,  5,  1,  1,  1,  1,  1,  1,
     9  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  5,  5,  5,  5,  1,  1,
     *  1,  6,  1,  6,  1,  1,  1,  1,  1,  1,  6,  1,  1,  1,  1,  6,
     1  6,  1,  1,  1,  1,  6,  6,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     2  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     3  1,  1,  1,  4,  5,  1,  5,  1,  1,  4,  4,  5,  1,  5,  1,  1,
     4  4,  4,  5,  1,  1,  5,  1,  4,  5,  1,  4,  5,  1,  1,  1,  1,
     5  4,  4,  4,  4,  5,  5/
      DATA NLST /
     1   1, 292,  59,  67,  63,  15,  29,  19,  31, 310, 336, 314, 324,
     2 340, 326, 176, 182, 188, 191, 183, 179, 181, 180, 192, 142, 152,
     3 168, 148, 163, 170, 174, 158, 165, 172, 145, 153, 169, 143, 155,
     4 149, 160, 147, 175, 146, 159, 150, 361, 438, 412, 411, 384, 439,
     5 373, 430, 451, 434, 409, 461, 392, 455, 456, 465, 372, 374, 364,
     6 416, 378, 431, 366, 467, 365, 413, 457, 368, 195, 197, 198, 199,
     7 196, 200, 193, 194, 470, 472, 473, 474, 471, 475, 225, 227, 228,
     8 229, 230, 231, 232, 233, 226, 234, 201, 203, 204, 205, 206, 208,
     9 209, 210, 202, 207, 211, 212, 213, 215, 216, 217, 219, 221, 223,
     * 224, 220, 222, 214, 218, 476, 478, 480, 481, 482, 483, 484, 485,
     1 486, 487, 488, 489, 490, 491, 492, 493, 477, 479, 494, 495, 235,
     2 237, 238, 236, 468, 469, 249, 245, 250, 247, 251, 248, 246, 239,
     3 243, 241, 244, 240, 242, 500, 501, 496, 498, 497, 499, 253, 254,
     4 255, 256, 257, 258, 252, 506, 507, 267, 268, 269, 270, 271, 272,
     5 259, 260, 261, 262, 263, 264, 265, 266, 502, 503, 504, 505, 273,
     6 274, 275, 276, 277, 529, 535, 533, 541, 531, 537, 539, 284, 288,
     7 286, 291, 285, 289, 287, 290, 278, 279, 280, 281, 282, 283, 509,
     8 515, 517, 521, 513, 519, 523, 525, 511, 527/
      DATA NSEM /
     1  1,  0,  0,  0,  1,  0,  0,  0,  1, 96,  0,  0,  0,  1,  0,  0,
     2  0,  1,  1,  0,  0,  0, 96,  0,  0,  0,  1,  1,  0,  0,  0,  1,
     3  0,  0,  0, 96,  1,  0,  0,  0, 96,  0,  0,  0, 96, 96,  0,  0,
     4  0,  1,  0,  0,  0, 96, 96,  0,  0,  0, 96,  0,  0,  0,  1, 96,
     5  0,  0,  0, 96,  0,  0,  0, 96, 96, 96,  0,  0,  0,  1,  0,  0,
     6  0, 96, 96,  0,  0,  0, 96,  0,  0,  0,  0,  0, 96,  0,  0,  0,
     7  0,  0,  0, 96, 96, 96,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,
     8  0,  0,  0,  0,  0, 64,128, 32,  0,  0,  0,  0,  0,  0,128, 64,
     9  0,  0,  0,  1,  0,  0,  0,128, 64,  0,  0,  0, 96,  0,  0,  0,
     * 48, 48, 48, 96,  0,  0,  0, 96,  0, 96, 96,  0,  0, 96, 48,  0,
     1  0, 96/
      DATA PSYM /
     1 '2', '21', 'M', 'N', 'A', 'B', 'C', '2/M', '21/M', '2/A', '2/B',
     2 '2/C', '2/N', '21/A', '21/B', '21/C', '21/N', '2', 'M', 'N', 'A',
     3 '2/M', '2/A', '2/N', '2', 'M', 'N', 'B', '2/M', '2/B', '2/N',
     4 '2', 'M', 'N', 'C', '2/M', '2/C', '2/N', '2', 'M', 'A', 'B', 'C',
     5 '2/M', '2/A', '2/B', '2/C'/
      DATA (SPGP(I), I = 1, 119) /
     1 'P 1',       'P -1',      'P 2',       'P 21',       'C 2',
     2 'P m',       'P c',       'C m',       'C c',        'P 2/m',
     3 'P 21/m',    'C 2/m',     'P 2/c',     'P 21/c',     'C 2/c',
     4 'P 2 2 2',   'P 2 2 21',  'P 21 21 2', 'P 21 21 21', 'C 2 2 21',
     5 'C 2 2 2',   'F 2 2 2',   'I 2 2 2',   'I 21 21 21', 'P m m 2',
     6 'P m c 21',  'P c c 2',   'P m a 2',   'P c a 21',   'P n c 2',
     7 'P m n 21',  'P b a 2',   'P n a 21',  'P n n 2',    'C m m 2',
     8 'C m c 21',  'C c c 2',   'A m m 2',   'A b m 2',    'A m a 2',
     9 'A b a 2',   'F m m 2',   'F d d 2',   'I m m 2',    'I b a 2',
     * 'I m a 2',   'P m m m',   'P n n n',   'P c c m',    'P b a n',
     1 'P m m a',   'P n n a',   'P m n a',   'P c c a',    'P b a m',
     2 'P c c n',   'P b c m',   'P n n m',   'P m m n',    'P b c n',
     3 'P b c a',   'P n m a',   'C m c m',   'C m c a',    'C m m m',
     4 'C c c m',   'C m m a',   'C c c a',   'F m m m',    'F d d d',
     5 'I m m m',   'I b a m',   'I b c a',   'I m m a',    'P 4',
     6 'P 41',      'P 42',      ' ',         'I 4',        'I 41',
     7 'P -4',      'I -4',      'P 4/m',     'P 42/m',     'P 4/n',
     8 'P 42/n',    'I 4/m',     'I 41/a',    'P 4 2 2',    'P 4 21 2',
     9 'P 41 2 2',  'P 41 21 2', 'P 42 2 2',  'P 42 21 2',  ' ',
     * ' ',         'I 4 2 2',   'I 41 2 2',  'P 4 m m',    'P 4 b m',
     1 'P 42 c m',  'P 42 n  m', 'P 4 c c',   'P 4 n c',    'P 42 m c',
     2 'P 42 b c',  'I 4 m m',   'I 4 c m',   'I 41 m d',   'I 41 c d',
     3 'P -4 2 m',  'P -4 2 c',  'P -4 21 m', 'P -4 21 c',  'P -4 m 2',
     4 'P -4 c 2',  'P -4 b 2',  'P -4 n 2',  'I -4 m 2'/
      DATA (SPGP(I),I = 120, 230) /
     1 'I -4 c 2',  'I -4 2 m',  'I -4 2 d',  'P 4/m m m',  'P 4/m c c',
     2 'P 4/n b m', 'P 4/n n c', 'P 4/m b m', 'P 4/m n c',  'P 4/n m m',
     3 'P 4/n c c', 'P 42/m m c','P 42/m c m','P 42/n b c', 'P 42/n n m'
     4,'P 42/m b c','P 42/m n m','P 42/n m c','P 42/n c m', 'I 4/m m m',
     5 'I 4/m c m', 'I 41/a m d','I 41/a c d','P 3','P 31', ' ',
     6 'R 3',       'P -3',      'R -3',      'P 3 1 2',    'P 3 2 1',
     7 'P 31 1 2',  'P 31 2 1',  ' ',         ' ',          'R 3 2',
     8 'P 3 m 1',   'P 3 1 m',   'P 3 c 1',   'P 3 1 c',    'R 3 m',
     9 'R 3 c',     'P -3 1 m',  'P -3 1 c',  'P -3 m 1',   'P -3 c 1',
     * 'R -3 m',    'R -3 c',    'P 6',       'P 61',       ' ',
     1 'P 62',      ' ',         'P 63',      'P -6',       'P 6/m',
     2 'P 63/m',    'P 6 2 2',   'P 61 2 2',  ' ',          'P 62 2 2',
     3 ' ',         'P 63 2 2',  'P 6 m m',   'P 6 c c',    'P 63 c m',
     4 'P 63 m c',  'P -6 m 2',  'P -6 c 2',  'P -6 2 m',   'P -6 2 c',
     5 'P 6/m m m', 'P 6/m c c', 'P 63/m c m','P 63/m m c', 'P 2 3',
     6 'F 2 3',     'I 2 3',     'P 21 3',    'I 21 3',     'P m -3',
     7 'P n -3',    'F m -3',    'F d -3',    'I m -3',     'P a -3',
     8 'I a -3',    'P 4 3 2',   'P 42 3 2',  'F 4 3 2',    'F 41 3 2',
     9 'I 4 3 2',   ' ',         'P 41 3 2',  'I 41 3 2',   'P -4 3 m',
     * 'F -4 3 m',  'I -4 3 m',  'P -4 3 n',  'F -4 3 c',   'I -4 3 d',
     1 'P m -3 m',  'P n -3 n',  'P m -3 n',  'P n -3 m',   'F m -3 m',
     2 'F m -3 c',  'F d -3 m',  'F d -3 c',  'I m -3 m',   'I a -3 d'/
      DATA MM4 /
     1   1,  2,  3,  0,  4,  5,  0,  6,  7,  0,  0,  0,  8,  9, 10, 11,
     2  12, 13, 14, 15, 16, 17, 18, 19, 20, 21,  0, 22, 23, 24, 25,  0,
     3   0,  0,  0,  0,  0,  0,  0,  0, 26, 27, 28,  0, 29, 30,  0, 31,
     4  32,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 33, 34, 35,  0,
     5  36, 37,  0, 38, 39,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     6  40, 41,  0, 42, 43, 44,  0, 45, 46, 47, 48,  0,  0,  0,  0,  0,
     7   0,  0,  8,  0, 49, 50, 51,  0, 52, 53,  0, 54, 55, 56, 57,  0,
     8   0,  0,  0,  0,  0,  0,  0,  0,  0, 58,  0,  0, 59,  0, 60, 61,
     9   0, 62, 63,  0,  0,  0,  0,  0,  0,  0,  0,  0, 64, 65, 66, 67,
     *  68, 69, 70, 71, 72, 73,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     1  74, 75, 76,  0, 77, 78,  0, 79, 80,  0,  0,  0,  0,  0,  0,  0,
     2   0,  0,  0,  0,  0, 81,  0,  0, 82,  0,  0, 83,  0, 84, 85, 86,
     3   0,  0,  0,  0,  0,  0,  0,  0, 87,  0,  0,  0,  0,  0,  0,  0,
     4   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 88,  0,  0,  0,
     5   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     6  89,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     7   0,  0,  0,  0, 90,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     8   0,  0,  0,  0,  0,  0,  0,  0, 91,  0,  0,  0,  0,  0,  0,  0,
     9   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 92,  0,  0,  0,
     *   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     1  93,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     2   0,  0,  0,  0, 94,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     3   0,  0,  0,  0,  0,  0,  0,  0/
      DATA IGES /
     1   1,  0,  0,  0,  1,  0,  0,  0,  1,  1,  0,  0,  0, -1,  0,  0,
     2   0, -1, -1,  0,  0,  0,  1,  0,  0,  0, -1, -1,  0,  0,  0, -1,
     3   0,  0,  0,  1,  0,  1,  0,  0,  0,  1,  1,  0,  0,  0,  1,  0,
     4   0,  0, -1, -1,  0,  0,  0, -1,  0,  0,  0,  1, -1,  0,  0,  0,
     5  -1,  0,  0,  0, -1,  1,  0,  0,  0,  0,  1,  1,  0,  0,  0,  1,
     6   0,  0,  0,  1, -1,  0,  0,  0, -1,  0,  0,  0, -1,  1,  0,  0,
     7   0, -1,  0,  0,  0, -1, -1,  0,  0,  0,  1,  0,  0, -1,  0, -1,
     8   0,  0,  0,  0, -1,  0, -1,  0,  1,  0,  0,  0,  0,  1,  0,  1,
     9   0, -1,  0,  0,  0,  0,  1,  0,  1,  0,  1,  0,  0,  0,  0, -1,
     *  -1,  0,  0,  0,  0, -1,  0, -1,  0, -1,  0,  0,  0,  0,  1,  0,
     1   1,  0,  1,  0,  0,  0,  0, -1,  0,  1,  0,  1,  0,  0,  0,  0,
     2   1,  0, -1,  0,  0,  0, -1,  0, -1,  0, -1,  0,  0,  0,  0, -1,
     3   0,  1,  0,  1,  0,  0,  0,  0,  1,  0, -1,  0,  1,  0,  0,  0,
     4   0,  1,  0,  1,  0, -1,  0,  0,  1,  0,  0,  0,  1,  0,  0,  0,
     5   1,  1,  1,  0, -1,  0,  0,  0,  0,  1,  0,  1,  0, -1, -1,  0,
     6   0,  0,  1, -1,  0,  0,  0, -1,  0,  0,  0,  1, -1, -1,  0,  1,
     7   0,  0,  0,  0,  1,  0, -1,  0,  1,  1,  0,  0,  0,  1,  0,  1,
     8   0,  1,  0,  0,  0,  0, -1,  1,  1,  0,  0, -1,  0,  0,  0, -1,
     9   1,  0,  0, -1, -1,  0,  0,  0, -1,  0, -1,  0, -1,  0,  0,  0,
     *   0, -1, -1, -1,  0,  0,  1,  0,  0,  0, -1, -1,  0,  0,  1,  1,
     1   0,  0,  0, -1/
      DATA (ITGRP(I), I = 1, 466) /
     1   1,  6,  8,  8,  8,  7,  9,  9,  7,  9,  9,  7,  9,  9,  6,  6,
     2   8,  8,  8,  8,  8,  8,  7,  7,  9,  9,  9,  9,  7,  7,  9,  9,
     3   9,  9,  7,  7,  9,  9,  9,  9,  6,  8,  8,  8,  7,  9,  9,  7,
     4   9,  9,  7,  9,  9,  3,  5,  5,  5,  4,  3,  3,  5,  5,  5,  5,
     5   5,  5,  4,  4,  3,  5,  5,  5,  4, 25, 35, 38, 38, 44, 42, 28,
     6  40, 46, 39, 26, 36, 28, 39, 40, 46, 32, 41, 41, 45, 29, 29, 33,
     7  33, 26, 36, 27, 37, 30, 30, 34, 31, 31, 43, 25, 38, 35, 38, 44,
     8  42, 28, 40, 46, 39, 26, 36, 28, 39, 40, 46, 32, 45, 41, 41, 29,
     9  29, 33, 33, 26, 36, 27, 37, 30, 30, 34, 31, 31, 43, 25, 38, 38,
     *  35, 44, 42, 28, 40, 46, 39, 26, 36, 28, 39, 40, 46, 32, 45, 41,
     1  41, 29, 29, 33, 33, 26, 36, 27, 37, 30, 30, 34, 31, 31, 43, 16,
     2  21, 21, 21, 23, 22, 17, 20, 17, 20, 17, 20, 18, 18, 18, 19, 24,
     3  81, 82, 75, 79, 76, 77, 76, 80, 99,107,100,101,102,103,108,104,
     4 105,106,109,110,111,121,112,113,114,122,115,119,116,120,117,118,
     5  89, 97, 90, 91, 92, 93, 94, 91, 92, 98,143,146,144,144,156,160,
     6 158,161,157,159,150,155,152,152,149,151,151,174,168,169,169,171,
     7 171,173,183,184,185,186,187,188,189,190,177,178,178,180,180,182,
     8 195,196,197,198,199,215,216,217,218,219,220,207,211,209,213,208,
     9 213,214,210,  2, 10, 12, 12, 12, 13, 15, 15, 13, 15, 15, 13, 15,
     *  15, 11, 14, 14, 14, 10, 10, 12, 12, 12, 12, 12, 12, 13, 13, 15,
     1  15, 15, 15, 13, 13, 15, 15, 15, 15, 13, 13, 15, 15, 15, 15, 11,
     2  11, 14, 14, 14, 14, 14, 14, 10, 12, 12, 12, 13, 15, 15, 13, 15,
     3  15, 13, 15, 15, 11, 14, 14, 14, 47, 65, 65, 65, 71, 69, 51, 74,
     4  63, 51, 74, 63, 53, 64, 53, 49, 72, 67, 67, 66, 55, 64, 58, 51,
     5  74, 63, 51, 74, 63, 57, 57, 59, 59, 62, 62, 49, 72, 67, 67, 66,
     6  51, 74, 63, 52, 54, 68, 54, 68, 57, 60, 50, 49, 72, 67, 67, 66,
     7  51, 74, 63, 52, 54, 68, 54, 68, 57, 60, 50, 61, 53, 54, 68, 55,
     8  64, 56, 57, 60, 62, 48, 52, 52, 53, 64, 53, 64, 56, 59, 50, 53,
     9  54, 68, 55, 64, 56, 57, 60, 61, 73, 62, 52, 52, 58, 58, 60, 60,
     *  62, 62/
      DATA (ITGRP(I), I = 467, 541) /
     1  70,147,148, 83, 87, 84, 85, 86, 88,123,139,124,140,125,126,127,
     2 128,129,130,131,132,133,134,135,136,137,138,141,142,164,166,165,
     3 167,162,163,191,192,193,194,175,176,221,221,229,229,225,225,222,
     4 222,223,223,226,226,224,224,227,227,228,228,230,230,200,200,204,
     5 204,202,202,201,201,205,205,206,206,203,203/
      DATA ITRAFO /
     1  0,  4,  4,  2,  7,  2,  2, 27,  4,  4,  7,  6, 22, 24,  0,  0,
     2  5,  5,  0,  0,  9,  9,  5,  5,  5,  5,  9,  9,  0,  0,  0,  0,
     3 29, 29,  8,  8, 25, 25, 20, 20,  1,  1,  3, 11,  1,  1, 31,  3,
     4  3, 11, 10, 21, 23,  4,  4,  2,  7,  4,  0,  0,  5,  5,  0,  0,
     5  9,  9,  0,  0,  1,  1,  3, 11,  1,  1,  1,  1,  5,  1,  1,  1,
     6  1,  1,  5,  1,  1,  5,  1,  5,  5,  1,  1,  5,  1,  5,  1,  5,
     7  1,  5,  5,  1,  5,  1,  5,  1,  5,  1,  1,  2,  3,  2,  2,  2,
     8  2,  2,  2,  2,  3,  3,  3,  3,  2,  3,  3,  2,  2,  2,  3,  3,
     9  2,  3,  2,  2,  2,  2,  2,  2,  3,  2,  3,  2,  2,  0,  0,  4,
     *  0,  0,  0,  0,  0,  0,  4,  0,  0,  4,  0,  4,  4,  0,  0,  0,
     1  4,  4,  0,  4,  0,  4,  4,  0,  0,  0,  4,  0,  4,  0,  0,  0,
     2  1,  2,  0,  0,  0,  0,  0,  1,  1,  2,  2,  0,  2,  1,  0,  0,
     3  0,  0,  0,  0,  0,  0, -1,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     4  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     5  0,  0,  0,  0,  0,  0,  0, -1, -1,  0,  0,  0,  0, -1,  0,  0,
     6  0,  0,  0,  0,  0,  8,  0, -1,  0,  0, -1,  0,  0,  0, -1,  0,
     7 -1,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, -1,  0, -1,  0,
     8  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     9 -1,  0,  0,  0,  4,  2,  4,  7,  2,  2, 47,  4,  4,  7,  6, 42,
     * 44,  4,  2,  4,  6,  0,  0,  5,  5,  0,  0,  9,  9,  5,  5,  5,
     1  5,  9,  9,  0,  0,  0,  0, 49, 49,  8,  8, 45, 45, 40, 40,  0,
     2  0,  5,  5,  0,  0,  8,  8,  1,  1,  3, 11,  1,  1, 51,  3,  3,
     3 11, 10, 41, 43,  1,  1,  3, 10,  0,  1,  2,  0,  0,  0,  4,  0,
     4  3,  2,  3,  0,  0,  0,  3,  1,  1,  0,  3,  1,  1,  3,  1,  0,
     5  4,  1,  3,  2,  5,  1,  5,  0,  2,  4,  2,  2,  2,  1,  4,  2,
     6  1,  5,  2,  1,  1,  1,  2,  2,  0,  2,  0,  0,  0,  2,  5,  0,
     7  5,  1,  4,  5,  4,  4,  5,  5,  3,  4,  2,  3,  5,  0,  0,  2,
     8  1,  0,  4,  3,  5,  0,  0,  3,  4,  4,  2,  2,  1,  1,  1,  1,
     9  3,  3,  0,  5,  2,  2,  0,  0,  0,  1,  4,  2,  0,  2,  1,  5,
     *  0,  3,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     1  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     2  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     3  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     4  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0/
      END
      BLOCK DATA PLATOD
      PARAMETER (NP4=9,NP9=118,NP10=16,NP22=287,NP24=207,NCS=52,
     1 NP31=34,NP34=647,NP35=110,NP37=191,NP40=432,NP46=15,NP52=200,
     2 NP56=30,NP57=35,NP53=1630,NKW=49)
      COMMON /MEN/ MENA(25, NP31), MENS(25, NP31), MENU(50, NP31),
     1             MNH(NP35)
      COMMON /CMEN/ OPTS(NP46, 7)
      COMMON /IMEN/ IOPT(NP46, 7)
      COMMON /NKEYS/ NCNT
      CHARACTER OPTS*10
      COMMON /DATASPGR/ EXTYPE, NLAUE
      CHARACTER EXTYPE(NCS)*16, NLAUE(13)*5
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      COMMON /CIF/ CIFDIR
      CHARACTER CIFDIR(NP34)*(NKW)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /ALL/ NN(12, 3), LO(12, 2), IE(12, 2)
      COMMON /BONDVAL/ VALENCE(NP53)
      CHARACTER VALENCE*18
      COMMON /FSPGR/ CRI(11), PNZ(13, 10), STLS(20)
      COMMON /SABS/ TMC(7), RMF(5, 7), X(6)
      COMMON /ASETUP/ ID(6, 6, 2), IRANGE(12)
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, COLR*10, BWCT*10
      COMMON /PLA22/ LGR(12), XSYST(8), IBVL(8), LAT(7)
      CHARACTER LGR*5, XSYST*12, IBVL*1, LAT*1
      COMMON /CTRNS/ TRTYP
      CHARACTER TRTYP(8)*5
      COMMON /POINTGR/ PNTGR(32)
      CHARACTER PNTGR*5
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /MAN/ MANUAL(140), PLUMAN(116)
      CHARACTER MANUAL*65, PLUMAN*65
      COMMON /UNITC/ IUNCL(2, 12)
      COMMON /MSWDS/ DOS
      COMMON /XMENU/ MENX, CMEN
      CHARACTER MENX(NP31)*11, CMEN(NP40)*11
      COMMON /PAGENM/ PAGET, PAGEIND(25)
      CHARACTER PAGET*8, PAGEIND*8
      LOGICAL DOS
      COMMON /DEFWL/ STWL(4)
      COMMON /DEFCWL/ CSTWL
      CHARACTER CSTWL(4)*4
      DATA (STWL(I),  I = 1, 4) /1.5418, 1.3414, 0.71073, 0.56086/
      DATA (CSTWL(I), I = 1, 4) /'CuKa', 'GaKa', 'MoKa', 'AgKa'/
      DATA PAGET /'        '/
      DATA DOS /.FALSE./
      DATA IUNCL /1, 2, 1, 3, 1, 5, 3, 4, 2, 4, 2, 6, 5, 6, 4, 8,
     1            7, 8, 3, 7, 6, 8, 5, 7/
       DATA  IOST,  LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,
     1 LU10, LU11, LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20,
     2 LU21, LU22, LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63,
     3 LU64, LU65, LU98/
     4  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
     5 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 60, 61, 62, 63,
     6 64, 65, 98/
      DATA DTYPE /'SPF  ', 'RES  ', 'CIF  ', 'PDB  ', 'C3D  '/
      DATA RMF /
     1  1.4997809, -0.07413433, -0.00943029,  0.00040669,  0.00015026,
     2  1.4999662, -0.09367724, -0.01235379, -0.00058663,  0.00050426,
     3  1.4988822, -0.14574555, -0.02797312,  0.00817433, -0.00049362,
     4  1.4995843, -0.24116768, -0.01740035,  0.01511804, -0.00195657,
     5  1.5018433, -0.36087828,  0.03103321,  0.00846806, -0.00183552,
     6  1.5037652, -0.46125653,  0.08544717, -0.00449737, -0.00059269,
     7  1.5043426, -0.49981128,  0.10691309, -0.00980878, -0.00007175/
      DATA IRANGE /10, 20, 50, 100, 200, 500, 1000, 2000, 5000, 10000,
     1         20000, 50000/
      DATA ID/ 0, 0, 0, 1, 2, 4,   0,-1, 0, 0, 2, 6,   0,-1, 1,-1, 1, 6,
     1         1,-1, 1, 0, 2, 1,   1, 0, 1, 1, 2, 3,   0, 1, 1, 1, 1, 3,
     2        -1, 1, 0, 1, 1, 4,  -1, 0,-1, 1, 2, 5,  -1, 0, 0, 0, 1, 5,
     3         0, 0, 1, 0, 1, 1,   1, 0, 1, 1, 2, 2,   0, 1, 1, 1, 1, 2/
      DATA LGR /'   -1', '  2/m', '  mmm', '  4/m', '4/mmm', '   -3',
     1          '  -3m', '  6/m', '6/mmm', '  m-3', ' m-3m', '     '/
      DATA XSYST /'   Triclinic', '  Monoclinic', 'Orthorhombic',
     1            '  Tetragonal', '    Trigonal', '   Hexagonal',
     2            '       Cubic', '            '/
      DATA IBVL /'a', 'm', 'o', 't', 'r', 'h', 'c', ' '/
      DATA LAT  / 'P', 'A', 'B', 'C', 'F', 'I', 'R'/
      DATA NN/ 2, 2, 2, 2, 7, 7, 7, 7, 2, 2, 3, 2, 3, 3, 4, 5, 3, 3, 5,
     2         4, 3, 3, 4, 4, 5, 4, 6, 6, 4, 5, 6, 6, 4, 5, 5, 5/
      DATA LO/ 1, 2, 5, 3, 1, 4, 6, 8, 7, 2, 5, 3, 2, 5, 3, 1, 4, 6,
     1         8, 7, 4, 6, 8, 7/
      DATA (PNTGR(I), I = 1, 32) /
     1 'C1 ', 'Ci ', 'C2 ', 'Cs ', 'C2h', 'D2 ', 'C2v', 'D2h', 'C4 ',
     2 'S4 ', 'C4h', 'D4 ', 'C4v', 'D2d', 'D4h', 'C3 ', 'C3i', 'D3 ',
     3 'C3v', 'D3d', 'C6 ', 'C3h', 'C6h', 'D6 ', 'C6v', 'D3h', 'D6h',
     4 'T  ', 'Th ', 'O  ', 'Td ', 'Oh '/
      DATA (CRI(I), I = 1, 11)
     1     /1.0, 2.5, 1.5, 5.0, 2.5, 10.0, 10.0, 20.0, 50.0, 100.0, 5.0/
      DATA (PNZ(13, I), I = 1, 10) / 24.81, 34.53, 41.87, 47.38,
     1      52.05, 56.14, 59.72, 62.89, 65.72, 68.33/
      DATA LINE, NAMEFIL, EXTENS
     1 /'       ', 'platon', 'spf'/
      DATA KNMFIL /6/
      DATA JTP /'--', 'LN', 'AN', 'TR', 'AK', 'AE', 'HL', '  '/
      DATA IEN /0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
      DATA IDOAC /
     1 3, 4, 5, 6, 7, 8, 9, 38, 84, 110, 10, 2, 0, 0, 0, 0/
      DATA JACL /17, 1, 2, 4, 3, 5, 6, 7, 8, 0, 0, 0, 0, 0, 0, 0/
      DATA IBCL /17, 3, 6, 2, 5, 4, 1, 7, 8, 9, 0, 0, 0, 0, 0, 0/
C ********************************************************************
C * TABLE OF ELEMENT SYMBOLS KNOWN TO THE PROGRAM.                   *
C * THE ELEMENTS ARE GIVEN IN THE ORDER OF THE 11 MOST FREQUENTLY    *
C * OCCURRING, AND THEN ALPHABETICALLY.                              *
C * RS = RESIDUE, CG = RING CENTRE OF GRAV., ZA,ZB,ZC   : AUXILLARY  *
C * OW = OXYGEN ATOM OF WATER MOLECULE                               *
C ********************************************************************
      DATA ELB /
     1  'H ', 'C ', 'O ', 'N ', 'Cl', 'S ', 'Br', 'P ', 'I ', 'Cu',
     2  'Ni', 'Ac', 'Ag', 'Al', 'Am', 'Ar', 'As', 'At', 'Au', 'B ',
     3  'Ba', 'Be', 'Bi', 'Bk', 'Ca', 'Cd', 'Ce', 'Cf', 'Cm', 'Co',
     4  'Cr', 'Cs', 'D ', 'Dy', 'Er', 'Es', 'Eu', 'F ', 'Fe', 'Fm',
     5  'Fr', 'Ga', 'Gd', 'Ge', 'He', 'Hf', 'Hg', 'Ho', 'In', 'Ir',
     6  'K ', 'Kr', 'La', 'Li', 'Lu', 'Lr', 'Md', 'Mg', 'Mn', 'Mo',
     7  'Na', 'Nb', 'Nd', 'Ne', 'No', 'Np', 'Os', 'Pa', 'Pb', 'Pd',
     8  'Pm', 'Po', 'Pr', 'Pt', 'Pu', 'Ra', 'Rb', 'Re', 'Rh', 'Rn',
     9  'Ru', 'Sb', 'Sc', 'Se', 'Si', 'Sm', 'Sn', 'Sr', 'Ta', 'Tb',
     *  'Tc', 'Te', 'Th', 'Ti', 'Tl', 'Tm', 'U ', 'V ', 'W ', 'Xe',
     1  'Y ', 'Yb', 'Zn', 'Zr', 'Rs', 'Cg', 'Za', 'Zb', 'Zc', 'Ow',
     2  'Q ', 'X ', 'Hw', 'Z ', 'Or', 'Oa', 'Ob', 'Oc'/
      DATA IEL /
     1  800,  300, 1500, 1400,  312, 1900,  218, 1600,  900,  321,
     2 1409,  103,  107,  112,  113,  118,  119,  120,  121,  200,
     3  201,  205,  209,  211,  301,  304,  305,  306,  313,  315,
     4  318,  319,  400,  425,  518,  519,  521,  600,  605,  613,
     5  618,  701,  704,  705,  805,  806,  807,  815,  914,  918,
     6 1100, 1118, 1201, 1209, 1221, 1223, 1304, 1307, 1314, 1315,
     7 1401, 1402, 1404, 1405, 1415, 1416, 1519, 1601, 1602, 1604,
     8 1613, 1615, 1618, 1620, 1621, 1801, 1802, 1805, 1808, 1814,
     9 1821, 1902, 1903, 1905, 1909, 1913, 1914, 1918, 2001, 2002,
     * 2003, 2005, 2008, 2009, 2012, 2013, 2100, 2200, 2300, 2405,
     1 2500, 2502, 2614, 2618, 1819,  307, 2601, 2602, 2603, 1523,
     2 1700, 2400,  823, 2600, 1518, 1501, 1502, 1503/
C * COVALENT RADII
      DATA REL /
     1 0.35, 0.68, 0.68, 0.68, 0.99, 1.04, 1.21, 1.05, 1.40, 1.52,
     2 1.50, 1.88, 1.59, 1.35, 1.51, 0.00, 1.21, 0.00, 1.50, 0.83,
     3 1.34, 0.35, 1.72, 0.00, 0.99, 1.69, 1.83, 0.00, 0.00, 1.23,
     4 1.35, 1.67, 0.35, 1.75, 1.73, 0.00, 1.99, 0.64, 1.35, 0.00,
     5 0.00, 1.22, 1.79, 1.27, 0.00, 1.57, 1.70, 1.74, 1.63, 1.32,
     6 1.33, 0.00, 1.87, 0.68, 1.72, 0.00, 0.00, 1.10, 1.35, 1.47,
     7 0.97, 1.48, 1.81, 0.00, 0.00, 1.55, 1.50, 1.61, 1.97, 1.50,
     8 1.80, 1.68, 1.82, 1.50, 1.53, 1.90, 1.47, 1.60, 1.45, 0.00,
     9 1.50, 1.46, 1.44, 1.22, 1.20, 1.80, 1.65, 1.12, 1.43, 1.76,
     * 1.35, 1.49, 1.79, 1.47, 1.64, 1.72, 1.75, 1.33, 1.37, 1.40,
     1 1.78, 1.94, 1.45, 1.56, 0.00, 0.00, 0.00, 0.00, 0.00, 0.68,
     2 0.68, 1.00, 0.23, 1.00, 0.00, 0.00, 0.00, 0.00/
C * VAN DER WAALS RADII - A.BONDI, J.CHEM.PHYS.(1964),68,441-451.
C * OTHER ENTRIES FROM CCDC/MERCURY
C * NEGATIVE ENTRIES WERE ESTIMATED AS COVALENT RADIUS + 0.8 ANG.
      DATA VDWR /
     1 1.20, 1.70, 1.52, 1.55, 1.75, 1.80, 1.85, 1.80, 1.98, 1.40,
     2 1.63,-2.68, 1.72,-2.15,-2.31, 1.88, 1.85, 0.00, 1.66,-1.63,
     3-2.14,-1.15,-2.34, 0.00,-1.79, 1.58,-2.63, 0.00, 0.00,-2.03,
     4-2.15,-2.47, 1.20,-2.55,-2.53, 0.00,-2.79, 1.47,-2.14, 0.00,
     5 0.00, 1.87,-2.59,-1.97, 1.40,-2.37, 1.55,-2.54, 1.93,-2.12,
     6 2.75, 2.02,-2.67, 1.82,-2.52, 0.00, 0.00, 1.73,-2.15,-2.27,
     7 2.27,-2.28,-2.61, 1.54, 0.00,-2.35,-2.17,-2.41, 2.02, 1.63,
     8-2.60,-2.48,-2.62, 1.72,-2.33,-2.70,-2.27,-2.15,-2.25, 0.00,
     9-2.30,-2.26,-2.24, 1.90, 2.10,-2.60, 2.17,-1.92,-2.23,-2.56,
     *-2.15, 2.06,-2.59,-2.27, 1.96,-2.52, 1.86,-2.13,-2.17, 2.16,
     1-2.58,-2.74,-2.25,-2.36, 0.00, 1.80, 0.00, 0.00, 0.00, 1.52,
     2 1.70, 1.80, 1.20, 1.80, 0.00, 0.00, 0.00, 0.00/
C * ATOM NUMBERS
      DATA IATNR /
     1    1,    6,    8,    7,   17,   16,   35,   15,   53,   29,
     2   28,   89,   47,   13,   95,   18,   33,   85,   79,    5,
     3   56,    4,   83,   97,   20,   48,   58,   98,   96,   27,
     4   24,   55,    1,   66,   68,   99,   63,    9,   26,  100,
     5   87,   31,   64,   32,    2,   72,   80,   67,   49,   77,
     6   19,   36,   57,    3,   71,  103,  101,   12,   25,   42,
     7   11,   41,   60,   10,  102,   93,   76,   91,   82,   46,
     8   61,   84,   59,   78,   94,   88,   37,   75,   45,   86,
     9   44,   51,   21,   34,   14,   62,   50,   38,   73,   65,
     *   43,   52,   90,   22,   81,   69,   92,   23,   74,   54,
     1   39,   70,   30,   40,    0,    0,    0,    0,    0,    8,
     2    6,    0,    1,    0,    0,    0,    0,    0/
C * ELEMENT CHARACTERISTICS   (NEGATIVE = NONMETAL)
C * 2 = LANTHANIDE, 3 = ACTINIDE, 4 = TRANSITION, 5 = ALKALI
C * 6 = ALKALI EARTH, 7 = HALOGEN
      DATA IATPR /
     1   -1,   -1,   -1,   -1,   -7,   -1,   -7,   -1,   -7,   4,
     2    4,    3,    4,    1,    3,   -1,   -1,   -7,    4,  -1,
     3    6,    6,    1,    3,    6,    4,    2,    3,    3,   4,
     4    4,    5,   -1,    2,    2,    3,    2,   -7,    4,   3,
     5    5,    1,    2,   -1,   -1,    4,    4,    2,    1,   4,
     6    5,   -1,    2,    5,    2,    3,    3,    6,    4,   4,
     7    5,    4,    2,   -1,    3,    3,    4,    3,    1,   4,
     8    2,    1,    2,    4,    3,    6,    5,    4,    4,  -1,
     9    4,    1,    4,   -1,   -1,    2,    1,    6,    4,   2,
     *    4,   -1,    3,    4,    1,    2,    3,    4,    4,  -1,
     1    4,    2,    4,    4,    8,    8,    8,    8,    8,  -1,
     2   -1,   -1,   -1,   -1,    8,    8,    8,    8/
C * ATOMIC WEIGHTS (C12-IUPAC 1989) - HANDBOOK FOR PHYSICS & CHEMISTRY
C * UPDATED (IUPAC 1993) FROM Inorg. Chim. Acta 217 (1994) 217-218
      DATA (ATWT(I), I = 1, 60) /
     1   1.00794,    12.011,   15.9994, 14.00674,   35.4527,    32.06,
     2    79.904, 30.973762, 126.90447,   63.546,   58.6934, 227.0278,
     3  107.8682, 26.981539,    241.06,   39.948,  74.92159,   209.99,
     4 196.96654,    10.811,   137.327, 9.012182, 208.98037,   249.08,
     5    40.078,   112.411,   140.115,   252.08,    244.06, 58.93320,
     6   51.9961, 132.90543,     2.014,   162.50,    167.26,   252.08,
     7   151.965, 18.998403,    55.845,   257.10,    223.02,   69.723,
     8    157.25,     72.61,  4.002602,   178.49,    200.59, 164.9303,
     9    114.82,    192.22,   39.0983,    83.80,  138.9055,    6.941,
     *   174.967,    262.11,    258.10,  24.3050,  54.93805,    95.94/
      DATA (ATWT(I), I = 61, NP9) /
     1 22.989768,  92.90638,    144.24,  20.1797,    259.10, 237.0482,
     2    190.23, 231.03588,     207.2,   106.42,    146.92,   209.98,
     3 140.90765,    195.08,    239.05, 226.0254,   85.4678,  186.207,
     4 102.90550,    222.02,    101.07,  121.757, 44.955910,    78.96,
     5   28.0855,    150.36,   118.710,    87.62,  180.9479, 158.9253,
     6    98.906,    127.60,  232.0381,   47.867,  204.3833, 168.9342,
     7  238.0289,   50.9415,    183.84,   131.29,  88.90585,   173.04,
     8     65.39,    91.224,       0.0,      0.0,     999.0,    999.0,
     9     999.0,   15.9994,      12.0,      0.0,   1.00794,      0.0,
     *       0.0,       0.0,       0.0,      0.0/
C * MU(A) BASED ON MU/RHO VALUES FROM INT. TABLES C - TABLE 4.2.4.2
C * - P 193-199 (CF. SHELXL97):(MU(A) = (MU/RHO) * ATWEIGHT * 1.66043)
C * CuKa/GaKa/MoKa/AgKa
      DATA (AMR(I, 4), I = 1, NP9) /
     1 0.655E+00, 0.899E+02, 0.304E+03, 0.173E+03, 0.624E+04,
     2 0.497E+04, 0.118E+05, 0.388E+04, 0.607E+05, 0.547E+04,
     3 0.476E+04, 0.143E+06, 0.382E+05, 0.222E+04, 0.144E+06,
     4 0.772E+04, 0.929E+04, 0.865E+05, 0.669E+05, 0.415E+02,
     5 0.750E+05, 0.166E+02, 0.843E+05, 0.143E+06, 0.113E+05,
     6 0.415E+05, 0.857E+05, 0.150E+06, 0.138E+06, 0.314E+05,
     7 0.213E+05, 0.700E+05, 0.655E+00, 0.977E+05, 0.367E+05,
     8 0.000E+00, 0.110E+06, 0.498E+03, 0.280E+05, 0.000E+00,
     9 0.102E+06, 0.719E+04, 0.105E+06, 0.819E+04, 0.194E+01,
     * 0.460E+05, 0.668E+05, 0.347E+05, 0.450E+05, 0.624E+05,
     1 0.940E+04, 0.132E+05, 0.803E+05, 0.576E+01, 0.450E+05,
     2 0.000E+00, 0.000E+00, 0.161E+04, 0.246E+05, 0.246E+05,
     3 0.114E+04, 0.223E+05, 0.968E+05, 0.768E+03, 0.000E+00,
     4 0.123E+06, 0.580E+05, 0.106E+06, 0.798E+05, 0.352E+05,
     5 0.102E+06, 0.881E+05, 0.912E+05, 0.634E+05, 0.113E+06,
     6 0.102E+06, 0.148E+05, 0.572E+05, 0.323E+05, 0.972E+05,
     7 0.295E+05, 0.525E+05, 0.135E+05, 0.105E+05, 0.297E+04,
     8 0.108E+06, 0.486E+05, 0.165E+05, 0.485E+05, 0.847E+05,
     9 0.270E+05, 0.565E+05, 0.118E+06, 0.159E+05, 0.754E+05,
     * 0.393E+05, 0.112E+06, 0.185E+05, 0.513E+05, 0.652E+05,
     1 0.183E+05, 0.410E+05, 0.629E+04, 0.203E+05, 0.000E+00,
     2 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.304E+03,
     3 0.000E+00, 0.000E+00, 0.655E+00, 0.0      , 0.0      ,
     4 0.0      , 0.0      , 0.0/
      DATA (AMR(I, 3), I = 1, NP9) /
     1       0.6,      57.1,     193.4,     109.9,    4162.2,
     2    3294.4,    7840.1,    2560.5,   41756.0,   28058.5,
     3   25038.0,   74252.0,   26090.1,    1447.9,       0.0,
     4    5181.0,    6173.2,   61961.4,   46030.9,      26.6,
     5   51793.2,      11.0,   56254.7,       0.0,    7678.0,
     6   28360.2,   59203.9,       0.0,       0.0,   22109.5,
     7   14773.5,   48349.0,       0.6,   95237.5,   67379.9,
     8       0.0,   80378.8,     317.7,   19450.3,       0.0,
     9   67977.1,    4786.5,   85155.2,    5448.7,       1.7,
     *   31510.4,   48465.2,   87267.5,   30756.5,   41453.6,
     1    6349.0,    8795.2,   55362.7,       4.2,   29737.4,
     2       0.0,       0.0,    1045.0,   17004.7,   16653.4,
     3     732.4,   15119.3,   67162.7,     494.0,       0.0,
     4       0.0,   39295.1,   80981.3,   53590.1,   23961.5,
     5   71418.3,   59082.9,   63110.1,   43704.6,       0.0,
     6   71084.4,    9820.1,   37233.7,   21950.7,   64939.0,
     7   20068.6,   35966.3,    9182.7,    6972.5,    1947.9,
     8   75832.4,   33293.6,   11104.2,   33349.3,   90317.2,
     9   18296.1,   38783.4,   77588.3,   10857.6,   50984.7,
     *   71284.4,   84399.8,   12716.4,   35261.7,   44918.3,
     1   12343.5,   75481.0,    4188.7,   13676.4,       0.0,
     2       0.0,       0.0,       0.0,       0.0,     193.4,
     3       0.0,       0.0,       0.6,       0.0,       0.0,
     4       0.0,       0.0,       0.0/
      DATA (AMR(I, 2), I = 1, NP9) /
     1 0.624E+00, 0.115E+02, 0.325E+02, 0.196E+02, 0.678E+03,
     2 0.532E+03, 0.100E+05, 0.410E+03, 0.773E+04, 0.518E+04,
     3 0.457E+04, 0.540E+05, 0.476E+04, 0.229E+03, 0.189E+05,
     4 0.851E+03, 0.822E+04, 0.407E+05, 0.365E+05, 0.661E+01,
     5 0.965E+04, 0.383E+01, 0.438E+05, 0.201E+05, 0.129E+04,
     6 0.518E+04, 0.111E+05, 0.209E+05, 0.201E+05, 0.401E+04,
     7 0.258E+04, 0.898E+04, 0.624E+00, 0.184E+05, 0.207E+05,
     8 0.000E+00, 0.154E+05, 0.515E+02, 0.349E+04, 0.000E+00,
     9 0.322E+05, 0.660E+04, 0.163E+05, 0.738E+04, 0.134E+01,
     * 0.258E+05, 0.382E+05, 0.195E+05, 0.563E+04, 0.331E+05,
     1 0.105E+04, 0.110E+05, 0.104E+05, 0.228E+01, 0.244E+05,
     2 0.000E+00, 0.000E+00, 0.165E+03, 0.302E+04, 0.300E+04,
     3 0.116E+03, 0.273E+04, 0.127E+05, 0.786E+02, 0.000E+00,
     4 0.257E+05, 0.316E+05, 0.387E+05, 0.419E+05, 0.436E+04,
     5 0.135E+05, 0.458E+05, 0.119E+05, 0.348E+05, 0.162E+05,
     6 0.330E+05, 0.121E+05, 0.301E+05, 0.399E+04, 0.398E+05,
     7 0.364E+04, 0.662E+04, 0.156E+04, 0.911E+04, 0.310E+03,
     8 0.144E+05, 0.611E+04, 0.132E+05, 0.272E+05, 0.174E+05,
     9 0.332E+04, 0.716E+04, 0.370E+05, 0.186E+04, 0.401E+05,
     * 0.219E+05, 0.403E+05, 0.220E+04, 0.286E+05, 0.834E+04,
     1 0.143E+05, 0.231E+05, 0.586E+04, 0.247E+04, 0.000E+00,
     2 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.325E+02,
     3 0.000E+00, 0.000E+00, 0.624E+00, 0.0      , 0.0      ,
     4 0.0      , 0.0      , 0.0/
      DATA (AMR(I, 1), I = 1, NP9) /
     1 0.614E+00, 0.745E+01, 0.182E+02, 0.117E+02, 0.341E+03,
     2 0.267E+03, 0.535E+04, 0.206E+03, 0.409E+04, 0.271E+04,
     3 0.238E+04, 0.311E+05, 0.251E+04, 0.116E+03, 0.250E+05,
     4 0.429E+03, 0.433E+04, 0.262E+05, 0.199E+05, 0.479E+01,
     5 0.511E+04, 0.313E+01, 0.240E+05, 0.250E+05, 0.652E+03,
     6 0.273E+04, 0.588E+04, 0.289E+05, 0.246E+05, 0.207E+04,
     7 0.133E+04, 0.475E+04, 0.614E+00, 0.985E+04, 0.111E+05,
     8 0.000E+00, 0.819E+04, 0.277E+02, 0.180E+04, 0.000E+00,
     9 0.285E+05, 0.346E+04, 0.872E+04, 0.387E+04, 0.128E+01,
     * 0.139E+05, 0.209E+05, 0.104E+05, 0.297E+04, 0.180E+05,
     1 0.532E+03, 0.592E+04, 0.549E+04, 0.206E+01, 0.131E+05,
     2 0.000E+00, 0.000E+00, 0.842E+02, 0.155E+04, 0.115E+05,
     3 0.596E+02, 0.922E+04, 0.674E+04, 0.412E+02, 0.000E+00,
     4 0.299E+05, 0.171E+05, 0.342E+05, 0.229E+05, 0.230E+04,
     5 0.720E+04, 0.251E+05, 0.630E+04, 0.189E+05, 0.227E+05,
     6 0.298E+05, 0.652E+04, 0.162E+05, 0.210E+04, 0.273E+05,
     7 0.192E+04, 0.350E+04, 0.789E+03, 0.482E+04, 0.156E+03,
     8 0.768E+04, 0.323E+04, 0.715E+04, 0.146E+05, 0.927E+04,
     9 0.107E+05, 0.378E+04, 0.323E+05, 0.947E+03, 0.219E+05,
     * 0.117E+05, 0.350E+05, 0.112E+04, 0.154E+05, 0.441E+04,
     1 0.780E+04, 0.124E+05, 0.307E+04, 0.847E+04, 0.000E+00,
     2 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.182E+02,
     3 0.000E+00, 0.000E+00, 0.614E+00, 0.0      , 0.0      ,
     4 0.0      , 0.0      , 0.0/
C * AVERAGE ATOMIC VOLUME
C * (D.W.M.Hofmann (2002). Acta Cryst. B58, 489-493)
      DATA ATVOL /
     1 5.08,13.87,11.39, 11.8, 25.8, 25.2, 32.7, 29.5, 46.2, 26.9,
     2 26.0, 74.0, 35.0, 39.6, 17.0,  0.0, 36.4,  0.0, 43.0,13.24,
     3 66.0, 36.0, 60.0,  0.0, 45.0, 51.0, 54.0,  0.0,  0.0, 29.4,
     4 28.1, 46.0, 5.08, 50.0, 54.0,  0.0, 53.0,11.17, 30.4,  0.0,
     5  0.0, 37.8, 56.0, 41.6,  0.0, 40.0, 38.0, 42.0, 55.0, 34.3,
     6 36.0,  0.0, 58.0, 22.6, 35.0,  0.0,  0.0, 36.0, 31.9, 38.0,
     7 26.0, 37.0, 50.0,  0.0,  0.0, 45.0, 41.9, 60.0, 52.0, 35.0,
     8  0.0,  0.0,  0.0, 38.0,  0.0,  0.0, 42.0, 42.7, 31.2,  0.0,
     9 37.3, 48.0, 42.0, 30.3, 37.3, 50.0, 52.8, 47.0, 43.0, 45.0,
     * 38.0, 46.7, 56.0, 27.3, 54.0, 49.0, 58.0, 24.0, 38.8, 45.0,
     1 44.0, 59.0, 39.0, 27.0,  0.0,  0.0,  0.0,  0.0,  0.0,11.39,
     2  0.0,  0.0, 5.08,  0.0,  0.0,  0.0,  0.0,  0.0/
C * NEUTRON SCATTERING LENGTHS (NEUTRON DATA BOOKLET, 2003)
      DATA RNSCL /
     1 -3.7423, 6.6484,  5.805,  9.36, 9.5792,  2.847,   6.79,  5.13,
     2    5.28,  7.718,   10.3,   0.0,  5.922,  3.449,    8.3, 1.909,
     3    6.58,    0.0,   7.90,  5.30,   5.07,   7.79,  8.532,   0.0,
     4    4.70,   4.83,   4.84,   0.0,    9.5,   2.49,  3.635,  5.42,
     5   6.674,   16.9,   7.79,   0.0,    5.3,  5.654,   9.45,   0.0,
     6     0.0,  7.288,    9.5, 8.185,   3.26,   7.77, 12.595,  8.44,
     7   4.065,   10.6,   3.67,  7.81,   8.24,  -1.90,   7.21,   0.0,
     8     0.0,  5.375, -3.750, 6.715,   3.63,  7.054,   7.69, 4.566,
     9     0.0,  10.55,   10.7,   9.1,  9.401,   5.91,   12.6,   0.0,
     *    4.58,   9.60,    7.7,  10.0,   7.08,    9.2,   5.90,   0.0,
     1    7.02,   5.57,   12.1, 7.970, 4.1507,   0.00,  6.225,  7.02,
     2    6.91,   7.34,    6.8,  5.68,  10.31, -3.370,  8.776,  7.07,
     3   8.417, -0.443,  4.755,  4.69,   7.75,  12.41,  5.680,  7.16,
     4     0.0,    0.0,    0.0,   0.0,    0.0, 6.6484,    0.0,   0.0,
     5 -3.7423,    0.0,    0.0,   0.0,    0.0,    0.0/
C * SCATTERING FACTORS ETC FOR ELEMENTS 1 - 103
C * INTERNATIONAL TABLES VOL C - Table 6.1.1.4 - p500-502
C * ANOMALOUS DISPERSION CORRECTIONS FOR CU, GA, MO & Ag RADIATION FROM
C * INT. TABLES C, TABLE 4.2.6.8
C * ELEMENT  H     C     O     N     CL    S
      DATA (SFAC(I), I = 1, 102) /
     1   0.493000, 10.510910,  0.322910, 26.125731,  0.140190,
     2   3.142360,  0.040810, 57.799770,  0.003040,  0.000000,
     3   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     4   0.000000,  0.000000,
     5   2.310000, 20.843920,  1.020000, 10.207510,  1.588600,
     6   0.568700,  0.865000, 51.651249,  0.215600,  0.018100,
     7   0.009100,    0.0137,    0.0067,  0.003300,  0.001600,
     8   0.001500,  0.000900,
     9   3.048500, 13.277110,  2.286800,  5.701110,  1.546300,
     *   0.323900,  0.867000, 32.908939,  0.250800,  0.049200,
     1   0.032200,    0.0389,    0.0241,  0.010600,  0.006000,
     2   0.005600,  0.003600,
     3  12.212610,  0.005700,  3.132200,  9.893310,  2.012500,
     4  28.997540,  1.166300,  0.582600,-11.529010,  0.031100,
     5   0.018000,    0.0241,    0.0134,  0.006100,  0.003300,
     6   0.003000,  0.001900,
     7  11.460410,  0.010400,  7.196410,  1.166200,  6.255610,
     8  18.519421,  1.645500, 47.778461, -9.557410,  0.363900,
     9   0.701800,    0.3281,    0.5435,  0.148400,  0.158500,
     *   0.099800,  0.098400,
     1   6.905310,  1.467900,  5.203410, 22.215120,  1.437900,
     2   0.253600,  1.586300, 56.172070,  0.866900,  0.333100,
     3   0.556700,    0.2925,    0.4295,  0.124600,  0.123400,
     4   0.082600,  0.076300/
C * ELEMENT  BR    P     I     CU    NI    AC
      DATA (SFAC(I), I = 103, 204) /
     1  17.178921,  2.172300,  5.235810, 16.579620,  5.637710,
     2   0.260900,  3.985100, 41.432850,  2.955700, -0.676300,
     3   1.280500,   -0.9338,    1.0006, -0.290100,  2.459500,
     4   0.181100,  1.645200,
     5   6.434510,  1.906700,  4.179100, 27.157040,  1.780000,
     6   0.526000,  1.490800, 68.164574,  1.114900,  0.295500,
     7   0.433500,    0.2543,    0.3332,  0.102300,  0.094200,
     8   0.066700,  0.058000,
     9  20.147221,  4.347000, 18.994921,  0.381400,  7.513810,
     *  27.766041,  2.273500, 66.877670,  4.071200, -0.325700,
     1   6.836200,    0.0030,    5.4350, -0.474200,  1.811900,
     2  -0.891900,  1.186800,
     3  13.338010,  3.582800,  7.167610,  0.247000,  5.615810,
     4  11.396610,  1.673500, 64.812668,  1.191000, -1.964600,
     5   0.588800,   -2.7974,    3.6876,  0.320100,  1.265100,
     6   0.324000,  0.825700,
     7  12.837610,  3.878500,  7.292010,  0.256500,  4.443800,
     8  12.176310,  2.380000, 66.342163,  1.034100, -3.002900,
     9   0.509100,   -1.3357,    3.2904,  0.339300,  1.112400,
     *   0.314700,  0.723200,
     1  35.659729,  0.589090, 23.103230,  3.651550, 12.597710,
     2  18.599010,  4.086550,117.02010 , 13.526610, -4.079400,
     3  11.799400,   -3.9501,    9.5298, -6.849400,  8.517800,
     4  -3.278400,  9.450200/
C * ELEMENT  AG    AL    AM    AR    AS    AT
      DATA (SFAC(I), I = 205, 306) /
     1  19.280821,  0.644600, 16.688520,  7.472610,  4.804510,
     2  24.660540,  1.046300, 99.815697,  5.179000,  0.130600,
     3   4.282000,    0.0782,    3.3823, -0.897100,  1.101500,
     4  -1.647300,  0.716700,
     5   6.420210,  3.038700,  1.900200,  0.742600,  1.593600,
     6  31.547239,  1.964600, 85.088676,  1.115100,  0.213000,
     7   0.245500,    0.1771,    0.1873,  0.064500,  0.051400,
     8   0.040600,  0.031300,
     9    36.6706,  0.483629,   24.0992,   3.20647,   17.3415,
     *    14.3136,   3.49331,   102.273,   13.3592,  0.000000,
     1   0.000000,       0.0,       0.0,   -7.8986,    4.5125,
     2   0.000000,  0.000000,
     3   7.484510,  0.907200,  6.772310, 14.840710,  0.653900,
     4  43.898350,  1.644200, 33.392929,  1.444500,  0.384300,
     5   0.871700,    0.3587,    0.6774,  0.174300,  0.200300,
     6   0.119100,  0.124900,
     7  16.672319,  2.634500,  6.070110,  0.264700,  3.431300,
     8  12.947910,  4.277900, 47.797260,  2.531000, -0.930000,
     9   1.005100,   -1.2701,    0.7845,  0.049900,  2.005800,
     *   0.275800,  1.331400,
     1  35.316330,  0.685870, 19.021120,  3.974580,  9.498880,
     2  11.382410,  7.425190, 45.471561, 13.710810, -3.958800,
     3   9.843300,   -4.1476,    7.9301, -7.912200,  9.977700,
     4  -1.803900,  7.950900/
C * ELEMENT  AU    B     BA    BE    BI    BK
      DATA (SFAC(I), I = 307, 408) /
     1  16.881929,  0.461100, 18.591320,  8.621610, 25.558241,
     2   1.482600,  5.860010, 36.395630, 12.065810, -4.419700,
     3   7.298000,   -5.1040,    5.8603, -2.013300,  8.802200,
     4  -0.763800,  5.997800,
     5   2.054500, 23.218519,  1.332600,  1.021000,  1.097900,
     6  60.349869,  0.706800,  0.140300, -0.193200,  0.009000,
     7   0.003900,    0.0070,    0.0029,  0.001300,  0.000700,
     8   0.000400,  0.000400,
     9  20.336121,  3.216000, 19.297029,  0.275600, 10.888010,
     *  20.207319,  2.695900,167.20219 ,  2.773100, -1.045600,
     1   8.461700,   -0.3132,    6.7527, -0.324400,  2.281900,
     2  -0.694000,  1.500400,
     3   1.591900, 43.642750,  1.127800,  1.862300,  0.539100,
     4 103.48310 ,  0.702900,  0.542000,  0.038500,  0.003800,
     5   0.001400,    0.0024,    0.0010,  0.000500,  0.000200,
     6   0.000100,  0.000100,
     7  33.368938,  0.704000, 12.951010,  2.923800, 16.587721,
     8   8.793710,  6.469210, 48.009350, 13.578210, -4.011100,
     9   8.931000,   -4.3533,    7.1873, -4.107700, 10.256600,
     *  -1.349400,  7.256600,
     1   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     2   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     4   0.000000,  0.000000/
C * ELEMENT  CA    CD    CE    CF    CM    CO
      DATA (SFAC(I), I = 409, 510) /
     1   8.626610, 10.442110,  7.387310,  0.659900,  1.589900,
     2  85.748489,  1.021100,178.43720 ,  1.375100,  0.364100,
     3   1.285500,    0.3829,    1.0059,  0.226200,  0.306400,
     4   0.161100,  0.192600,
     5  19.221420,  0.594600, 17.644421,  6.908910,  4.461000,
     6  24.700840,  1.602900, 87.482567,  5.069410,  0.118500,
     7   4.653300,    0.1061,    3.6794, -0.807500,  1.202400,
     8  -1.439600,  0.783200,
     9  21.167110,  2.812190, 19.769520,  0.226840, 11.851310,
     *  17.608320,  3.330490,127.11310 ,  1.862640, -1.848200,
     1   9.659600,   -0.6939,    7.7244, -0.248600,  2.633100,
     2  -0.589000,  1.735800,
     3   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     4   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     5   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     6   0.000000,  0.000000,
     7   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     8   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     9   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     *   0.000000,  0.000000,
     1  12.284110,  4.279100,  7.340910,  0.278400,  4.003400,
     2  13.535910,  2.348800, 71.169273,  1.011800, -2.365300,
     3   3.614300,   -0.6628,    2.9049,  0.349400,  0.972100,
     4   0.305000,  0.629600/
C * ELEMENT  CR    CS    D     DY    ER   ES
      DATA (SFAC(I), I = 511, 612) /
     1  10.640610,  6.103810,  7.353710,  0.392000,  3.324000,
     2  20.262621,  1.492200, 98.739990,  1.183200, -0.163500,
     3   2.443900,    0.1560,    1.9394,  0.320900,  0.623600,
     4   0.249600,  0.399200,
     5  20.389219,  3.569000, 19.106220,  0.310700, 10.662010,
     6  24.387939,  1.495300,213.90421 ,  3.335200, -0.745700,
     7   7.905200,   -0.1739,    6.3004, -0.368000,  2.119200,
     8  -0.752700,  1.391600,
     9   0.493000, 10.510910,  0.322910, 26.125731,  0.140190,
     *   3.142360,  0.040810, 57.799770,  0.003040,  0.000000,
     1   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     2   0.000000,  0.000000,
     3  26.507030,  2.180200, 17.638321,  0.202170, 14.559620,
     4  12.189910,  2.965770,111.87410 ,  4.297280, -9.804600,
     5   9.847700,   -5.9987,   12.4498, -0.189200,  4.409800,
     6  -0.330200,  2.940400,
     7  27.656340,  2.073560, 16.428530,  0.223550, 14.977910,
     8  11.360410,  2.982330,105.70310 ,  5.920470, -9.436700,
     9   3.938000,  -10.7818,    8.7525, -0.258600,  4.957600,
     *  -0.309100,  3.315800,
     1   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     2   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     4   0.000000,  0.000000/
C * ELEMENT  EU    F     FE    FM    FR   GA
      DATA (SFAC(I), I = 613, 714) /
     1  24.627439,  2.387900, 19.088619,  0.194200, 13.760310,
     2  13.754610,  2.922700,123.17410 ,  2.574500, -8.929400,
     3  11.185700,   -2.6997,   10.5010, -0.157800,  3.668200,
     4  -0.397700,  2.435100,
     5   3.539200, 10.282510,  2.641200,  4.294400,  1.517000,
     6   0.261500,  1.024300, 26.147631,  0.277600,  0.072700,
     7   0.053400,    0.0583,    0.0400,  0.017100,  0.010300,
     8   0.009600,  0.006100,
     9  11.769510,  4.761110,  7.357310,  0.307200,  3.522200,
     *  15.353510,  2.304500, 76.880577,  1.036900, -1.133600,
     1   3.197400,   -0.2673,    2.5550,  0.346300,  0.844400,
     2   0.288600,  0.544800,
     3   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     4   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     5   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     6   0.000000,  0.000000,
     7  35.929932,  0.646450, 23.054720,  4.176190, 12.143910,
     8  23.105221,  2.112530,150.64510 , 13.724710, -3.968900,
     9  10.803800,   -4.0051,    8.7136, -7.222400,  7.784700,
     *  -2.412900,  8.683900,
     1  15.235410,  3.066900,  6.700610,  0.241200,  4.359100,
     2  10.780510,  2.962300, 61.413570,  1.718900, -1.284600,
     3   0.776300,    -1.903,    0.6051,  0.230700,  1.608300,
     4   0.317900,  1.058900/
C * ELEMENT  GD    GE    HE    HF    HG   HO
      DATA (SFAC(I), I = 715, 816) /
     1  25.070940,  2.253410, 19.079821,  0.181950, 13.851810,
     2  12.933110,  3.545450,101.39810 ,  2.419600, -8.838000,
     3  11.915700,   -3.4578,   11.1283, -0.165300,  3.903500,
     4  -0.374100,  2.595400,
     5  16.081619,  2.850900,  6.374710,  0.251600,  3.706800,
     6  11.446810,  3.683000, 54.762562,  2.131300, -1.088500,
     7   0.885500,   -1.5187,    0.6907,  0.154700,  1.800100,
     8   0.301600,  1.190300,
     9   0.873400,  9.103710,  0.630900,  3.356800,  0.311200,
     *  22.927629,  0.178000,  0.982100,  0.006400,  0.000000,
     1   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     2   0.000000,  0.000000,
     3  29.144039,  1.832620, 15.172610,  9.599910, 14.758610,
     4   0.275120,  4.300130, 72.029083,  8.581550, -6.179400,
     5   4.977600,   -9.4190,    3.9832, -0.583000,  6.185200,
     6  -0.354800,  4.164300,
     7  20.680920,  0.545000, 19.041719,  8.448410, 21.657520,
     8   1.572900,  5.967610, 38.324631, 12.608910, -4.292300,
     9   7.684900,   -4.8790,    6.1759, -2.389400,  9.226600,
     *  -0.880100,  6.298900,
     1  26.904940,  2.070510, 17.294020,  0.197940, 14.558310,
     2  11.440710,  3.638370, 92.656693,  4.567970,-14.973400,
     3   3.704600,   -7.4624,   11.3895, -0.217500,  4.678300,
     4  -0.316800,  3.124100/
C * ELEMENT  IN    IR    K     KR    LA   LI
      DATA (SFAC(I), I = 817, 918) /
     1  19.162411,  0.547600, 18.559620,  6.377610,  4.294800,
     2  25.849930,  2.039600, 92.802994,  4.939110,  0.082200,
     3   5.044900,    0.1167,    3.9932, -0.727600,  1.310000,
     4  -1.284300,  0.854200,
     5  27.304930,  1.592790, 16.729610,  8.865540, 15.611520,
     6   0.417920,  5.833780, 45.001141, 11.472210, -4.771000,
     7   6.566700,   -5.7005,    5.2682, -1.444200,  7.988700,
     8  -0.597700,  5.426900,
     9   8.218610, 12.794910,  7.439810,  0.774800,  1.051900,
     * 213.18720 ,  0.865900, 41.684158,  1.422800,  0.386800,
     1   1.065700,    0.3778,    0.8310,  0.200900,  0.249400,
     2   0.139900,  0.156200,
     3  17.355511,  1.938400,  6.728610, 16.562321,  5.549310,
     4   0.226100,  3.537500, 39.397228,  2.825000, -0.565700,
     5   1.438500,   -0.8018,    1.1247, -0.557400,  2.707900,
     6   0.106700,  1.819200,
     7  20.578020,  2.948170, 19.599010,  0.244480, 11.372710,
     8  18.772610,  3.287190,133.12410 ,  2.146780, -1.409400,
     9   9.037600,   -0.4908,    7.2214, -0.287100,  2.452300,
     *  -0.641100,  1.614800,
     1   1.128200,  3.954600,  0.750800,  1.052400,  0.617500,
     2  85.390579,  0.465300,168.26120 ,  0.037700,  0.000800,
     3   0.000300,    0.0011,    0.0002, -0.000300,  0.000100,
     4  -0.000400,  0.000000/
C * ELEMENT  LU    LR    MD    MG    MN   MO
      DATA (SFAC(I), I = 919, 1020) /
     1  28.947630,  1.901820, 15.220810,  9.985200, 15.100010,
     2   0.261030,  3.716010, 84.329880,  7.976290, -6.617900,
     3   4.693700,  -21.3766,    3.7544, -0.472000,  5.858400,
     4  -0.329900,  3.937700,
     5   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     6   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     7   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     8   0.000000,  0.000000,
     9   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     *   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     1   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     2   0.000000,  0.000000,
     3   5.420410,  2.827500,  2.173500, 79.261177,  1.226900,
     4   0.380800,  2.307300,  7.193710,  0.858400,  0.171900,
     5   0.177100,    0.1421,    0.1346,  0.048600,  0.036300,
     6   0.029800,  0.022000,
     7  11.281910,  5.340910,  7.357310,  0.343200,  3.019300,
     8  17.867420,  2.244100, 83.754379,  1.089600, -0.529900,
     9   2.805200,   -0.0162,    2.2332,  0.336800,  0.728300,
     *   0.270400,  0.468100,
     1   3.702500,  0.277200, 17.235630,  1.095800, 12.887610,
     2  11.004010,  3.742900, 61.658459,  4.387500, -0.048300,
     3   2.733900,   -0.2130,    2.1496, -1.683200,  0.685700,
     4  -1.270300,  3.097800/
C * ELEMENT  NA    NB    ND    NE    NO    NP
      DATA (SFAC(I), I = 1021, 1122) /
     1   4.762600,  3.285000,  3.173600,  8.842210,  1.267400,
     2   0.313600,  1.112800, 129.42410,  0.676000,  0.135300,
     3   0.123900,    0.1104,    0.0938,  0.036200,  0.024900,
     4   0.021800,  0.015000,
     5  17.614229,  1.188650, 12.014410, 11.766010,  4.041830,
     6   0.204790,  3.533460, 69.795761,  3.755910, -0.112100,
     7   2.482600,   -0.2894,    1.9494, -2.072700,  0.621500,
     8  -0.828200,  2.840400,
     9  22.684521,  2.662480, 19.684719,  0.210630, 12.774010,
     *  15.885020,  2.851370, 137.90311,  1.984860, -3.180700,
     1  10.907900,   -1.2627,    8.7680, -0.194300,  3.017900,
     2  -0.501200,  1.995000,
     3   3.955300,  8.404210,  3.112500,  3.426200,  1.454600,
     4   0.230600,  1.125100, 21.718410,  0.351500,  0.101900,
     5   0.083300,    0.0817,    0.0628,  0.025900,  0.016400,
     6   0.015200,  0.009800,
     7   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     8   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     9   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     *   0.000000,  0.000000,
     1  36.187439,  0.511930, 23.596420,  3.253960, 15.640220,
     2  15.362220,  4.185500, 97.490891, 13.357310, -4.505300,
     3  13.966600,       0.0,       0.0,-11.493700,  4.149300,
     4  -6.999500,  9.587600/
C * ELEMENT  OS    PA    PB    PD    PM    PO
      DATA (SFAC(I), I = 1123, 1224) /
     1  28.189440,  1.629030, 16.155010,  8.979490, 14.930510,
     2   0.382660,  5.675900, 48.164749, 11.000510, -4.980100,
     3   6.221600,   -6.0803,    4.9890, -1.216500,  7.603000,
     4  -0.528000,  5.155800,
     5  35.884739,  0.547750, 23.294821,  3.415190, 14.189110,
     6  16.923519,  4.172870, 105.25110, 13.428710, -4.247300,
     7  12.868100,   -3.9435,   10.4050, -8.033400,  9.280700,
     8  -4.606700, 10.241300,
     9  31.061741,  0.690200, 13.063710,  2.357600, 18.442020,
     *   8.618010,  5.969610, 47.257950, 13.411810, -4.075300,
     1   8.506000,   -4.4950,    6.8412, -3.394400, 10.111100,
     2  -1.167600,  6.928700,
     3  19.331921,  0.698660, 15.501720,  7.989300,  5.295370,
     4  25.205231,  0.605840, 76.898682,  5.265930,  0.121500,
     5   3.933700,    0.0375,    3.1039, -0.998800,  1.007200,
     6  -1.955600,  0.654600,
     7  23.340521,  2.562700, 19.609529,  0.202090, 13.123510,
     8  15.100910,  2.875160, 132.72110,  2.028760, -4.059800,
     9  11.552300,   -1.6454,    9.3260, -0.175300,  3.224900,
     *  -0.462600,  2.134700,
     1  34.672642,  0.701000, 15.473310,  3.550780, 13.113810,
     2   9.556430,  7.025890, 47.004551, 13.677010, -3.967000,
     3   9.383400,   -4.2319,    7.5551, -5.121000, 11.049600,
     4  -1.561300,  7.598600/
C * ELEMENT  PR    PT    PU    RA    RB    RE
      DATA (SFAC(I), I = 1225, 1326) /
     1  22.044020,  2.773930, 19.669720,  0.222090, 12.385610,
     2  16.766920,  2.824280,143.64410 ,  2.058300, -2.416400,
     3  10.282000,   -0.9513,    8.2366, -0.218000,  2.821400,
     4  -0.542400,  1.862400,
     5  27.005939,  1.512930, 17.763920,  8.811750, 15.713120,
     6   0.424590,  5.783710, 38.610340, 11.688310, -4.593200,
     7   6.926400,   -5.3886,    5.5592, -1.703300,  8.390500,
     8  -0.681200,  5.708100,
     9  36.525440,  0.499380, 23.808319,  3.263710, 16.770720,
     *  14.945510,  3.479470, 105.98010, 13.381210, -4.656300,
     1  14.372900,       0.0,       0.0, -9.410000,  4.305600,
     2 -13.590500,  6.946800,
     3  35.763031,  0.616340, 22.906420,  3.871350, 12.473910,
     4  19.988720,  3.210970, 142.32510, 13.621110, -4.008800,
     5  11.296900,   -3.9666,    9.1179, -6.770400,  8.143500,
     6  -2.808100,  9.061400,
     7  17.178419,  1.788800,  9.643510, 17.315121,  5.139900,
     8   0.274800,  1.529200, 164.93420,  3.487300, -0.468800,
     9   1.607900,   -0.6884,    1.2581, -0.939300,  2.967600,
     *   0.006800,  2.002500,
     1  28.762131,  1.671910, 15.718920,  9.092280, 14.556410,
     2   0.350500,  5.441740, 52.086151, 10.472010, -5.208300,
     3   5.892300,   -6.5366,    4.7224, -1.018500,  7.231000,
     4  -0.469300,  4.894400/
C * ELEMENT  RH    RN    RU    SB    SC    SE
      DATA (SFAC(I), I = 1327, 1428) /
     1  19.295719,  0.751540, 14.350110,  8.217590,  4.734250,
     2  25.874941,  1.289180, 98.606293,  5.328000,  0.092700,
     3   3.604500,   -0.0161,    2.8414, -1.117800,  0.918700,
     4  -2.528000,  0.596400,
     5  35.563141,  0.663100, 21.281620,  4.069100,  8.003710,
     6  14.042210,  7.443310, 44.247341, 13.690510, -3.948700,
     7  10.318100,   -4.0632,    8.3167, -8.065900, 10.458000,
     8  -2.084700,  8.311200,
     9  19.267429,  0.808520, 12.918210,  8.434680,  4.863370,
     *  24.799740,  1.567560, 94.292892,  5.378750,  0.055200,
     1   3.296000,   -0.0760,    2.5955, -1.259400,  0.836300,
     2  -5.363000,  3.650600,
     3  19.641821,  5.303400, 19.045521,  0.460700,  5.037110,
     4  27.907440,  2.682700, 75.282578,  4.590910, -0.056200,
     5   5.894600,    0.1003,    4.6759, -0.586600,  1.546100,
     6  -1.054700,  1.010400,
     7   9.189010,  9.021310,  7.367910,  0.572900,  1.640900,
     8 136.10809 ,  1.468000, 51.353149,  1.332900,  0.311900,
     9   1.533100,    0.3700,    1.2039,  0.251900,  0.371600,
     *   0.182900,  0.234800,
     1  17.000629,  2.409800,  5.819610,  0.272600,  3.973100,
     2  15.237210,  4.354300, 43.816349,  2.840900, -0.794300,
     3   1.137200,   -1.0833,    0.8881, -0.092900,  2.225900,
     4   0.236700,  1.483100/
C * ELEMENT  SI    SM    SN    SR    TA    TB
      DATA (SFAC(I), I = 1429, 1530) /
     1   6.291510,  2.438600,  3.035300, 32.333740,  1.989100,
     2   0.678500,  1.541000, 81.693787,  1.140700,  0.254100,
     3   0.330200,    0.2153,    0.2529,  0.081700,  0.070400,
     4   0.052200,  0.043100,
     5  24.004240,  2.472740, 19.425831,  0.196450, 13.439610,
     6  14.399610,  2.896040, 128.00710,  2.209630, -5.323600,
     7  12.217800,   -2.1214,    9.9048, -0.163800,  3.441800,
     8  -0.428700,  2.281500,
     9  19.188919,  5.830310, 19.100519,  0.503100,  4.458500,
     *  26.890930,  2.466300, 83.957176,  4.782110,  0.025900,
     1   5.459100,    0.1164,    4.3256, -0.653700,  1.424600,
     2  -1.158700,  0.929900,
     3  17.566311,  1.556400,  9.818410, 14.098810,  5.422000,
     4   0.166400,  2.669400,132.37610 ,  2.506400, -0.352800,
     5   1.820000,   -0.5625,    1.4257, -1.530700,  3.249800,
     6  -0.117200,  2.202500,
     7  29.202440,  1.773330, 15.229310,  9.370470, 14.513510,
     8   0.295980,  4.764920, 63.364471,  9.243550, -5.795900,
     9   5.271800,   -7.9760,    4.2206, -0.705200,  6.522700,
     *  -0.383100,  4.399200,
     1  25.897631,  2.242560, 18.218519,  0.196140, 14.316710,
     2  12.664810,  2.953540, 115.36210,  3.583240, -9.147200,
     3   9.189100,   -4.4782,   11.8047, -0.172300,  4.153700,
     4  -0.349600,  2.765400/
C * ELEMENT  TC    TE    TH    TI    TL    TM
      DATA (SFAC(I), I = 1531, 1632) /
     1  19.130131,  0.864130, 11.094810,  8.144880,  4.649020,
     2  21.570721,  2.712630, 86.847267,  5.404290,  0.005700,
     3   3.004900,   -0.1426,    2.3642, -1.439000,  0.759300,
     4  -2.008700,  3.349000,
     5  19.964420,  4.817420, 19.013821,  0.420890,  6.144880,
     6  28.528440,  2.523900, 70.840363,  4.352000, -0.175900,
     7   6.353100,    0.0584,    5.0452, -0.530800,  1.675100,
     8  -0.971000,  1.096000,
     9  35.564529,  0.563360, 23.421921,  3.462040, 12.747310,
     *  17.830919,  4.807040, 99.172302, 13.431410, -4.149100,
     1  12.329600,   -3.9342,    9.9644, -7.240000,  8.897900,
     2  -3.853300,  9.840300,
     3   9.759510,  7.850810,  7.355810,  0.500000,  1.699100,
     4  35.633831,  1.902100,116.10510 ,  1.280700,  0.219100,
     5   1.806900,    0.3343,    1.4243,  0.277600,  0.445700,
     6   0.206000,  0.283000,
     7  27.544630,  0.655150, 19.158421,  8.707520, 15.538020,
     8   1.963470,  5.525940, 45.814960, 13.174610, -4.162700,
     9   8.090000,   -4.6638,    6.5029, -2.835800,  9.668800,
     *  -1.011700,  6.609000,
     1  28.181931,  2.028590, 15.885120,  0.238850, 15.154210,
     2  10.997510,  2.987060,102.96110 ,  6.756220, -8.039300,
     3   4.182100,   -8.6980,    9.2627, -0.313900,  5.248300,
     4  -0.308400,  3.515500/
C * ELEMENT  U     V     W     XE    Y     YB
      DATA (SFAC(I), I = 1633, 1734) /
     1  36.022839,  0.529300, 23.412830,  3.325300, 14.949110,
     2  16.092730,  4.188000,100.61310 , 13.396610, -4.363800,
     3  13.409000,   -3.9641,   10.8496, -9.676700,  9.664600,
     4  -5.722500, 10.642800,
     5  10.297110,  6.865710,  7.351110,  0.438500,  2.070300,
     6  26.893829,  2.057100, 102.47810,  1.219900,  0.068700,
     7   2.109700,    0.2663,    1.6689,  0.300500,  0.529400,
     8   0.227600,  0.337600,
     9  29.081829,  1.720290, 15.430010,  9.225910, 14.432710,
     *   0.321700,  5.119830, 57.056061,  9.887510, -5.473400,
     1   5.577400,   -7.1285,    4.4676, -0.849000,  6.872200,
     2  -0.420100,  4.643000,
     3  20.293320,  3.928200, 19.029819,  0.344000,  8.976710,
     4  26.465940,  1.990000, 64.265869,  3.711800, -0.517900,
     5   7.350000,   -0.0772,    5.8499, -0.420500,  1.957800,
     6  -0.820000,  1.283800,
     7  17.776020,  1.402900, 10.294610, 12.800610,  5.726300,
     8   0.125600,  3.265880,104.35410 ,  1.912130, -0.267000,
     9   2.024400,   -0.4654,    1.5873, -2.796200,  3.566700,
     *  -0.287900,  2.409900,
     1  28.664141,  1.988900, 15.434510,  0.257120, 15.308710,
     2  10.664710,  2.989630,100.41710 ,  7.566730, -7.210800,
     3   4.432900,   -9.3530,    9.8114, -0.385000,  5.548600,
     4  -0.315700,  3.722900/
C * ELEMENT  ZN    ZR   (RS)   (CG)  (ZA)  (ZB)
      DATA (SFAC(I), I = 1735, 1836) /
     1  14.074310,  3.265500,  7.031810,  0.233300,  5.165210,
     2  10.316310,  2.410000, 58.709759,  1.304100, -1.549100,
     3   0.677800,   -2.7473,    0.5279,  0.283900,  1.430100,
     4   0.324200,  0.937500,
     5  17.876530,  1.276180, 10.948010, 11.916010,  5.417330,
     6   0.117620,  3.657210, 87.662781,  2.069290, -0.186200,
     7   2.244900,   -0.3750,    1.7612, -2.967300,  0.559700,
     8  -0.536400,  2.614100,
     9   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     *   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     1   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     2   0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     4   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     5   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     6   0.000000,  0.000000,
     7   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     8   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     9   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     *   0.000000,  0.000000,
     1   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     2   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     4   0.000000,  0.000000/
C * ELEMENT  (ZC)  OW    Q     X     HW   Z
      DATA (SFAC(I), I = 1837, 1938) /
     1   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     2   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     4   0.000000,  0.000000,
     5   3.048500, 13.277110,  2.286800,  5.701110,  1.546300,
     6   0.323900,  0.867000, 32.908939,  0.250800,  0.049200,
     7   0.032200,    0.0389,    0.0241,  0.010600,  0.006000,
     8   0.005600,  0.003600,
     9   2.310000, 20.843920,  1.020000, 10.207510,  1.588600,
     *   0.568700,  0.865000, 51.651249,  0.215600,  0.018100,
     1   0.009100,    0.0137,    0.0067,  0.003300,  0.001600,
     2   0.001500,  0.000900,
     3   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     4   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     5   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     6   0.000000,  0.000000,
     7   0.493000, 10.510910,  0.322910, 26.125731,  0.140190,
     8   3.142360,  0.040810, 57.799770,  0.003040,  0.000000,
     9   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     *   0.000000,  0.000000,
     1   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     2   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     4   0.000000,  0.000000/
C * ELEMENT  (OR) (OA) (OB) (OC)
      DATA (SFAC(I), I = 1939, 2006) /
     1   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     2   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     4   0.000000,  0.000000,
     5   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     6   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     7   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     8   0.000000,  0.000000,
     9   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     *   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     1   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     2   0.000000,  0.000000,
     3   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     4   0.000000,  0.000000,  0.000000,  0.000000,  0.000000,
     5   0.000000,  0.000000,  0.000000,       0.0,       0.0,
     6   0.000000,  0.000000/
C * 'PLATON'
      DATA (VALENCE(I), I = 1, 102)/
     1 'Ac3O -2 2.24 0.37b', 'Ac3O -2 2.29 0.35p', 'Ac3F -1 2.13 0.37b',
     2 'Ac3F -1 2.10 0.40p', 'Ac3Cl-1 2.63 0.37b', 'Ac3Cl-1 2.60 0.40p',
     3 'Ac3Br-1 2.75 0.40p', 'Ag1O -2 1.8420.37a', 'Ag1O -2 1.8050.37b',
     4 'Ag1S -2 2.1190.37a', 'Ag1F -1 1.80 0.37b', 'Ag1Cl-1 2.09 0.37b',
     5 'Ag2F -1 1.79 0.37e', 'Ag3F -1 1.83 0.37e', 'Ag9Br-1 2.22 0.37b',
     6 'Ag9I -1 2.38 0.37b', 'Ag9Se-2 2.26 0.37b', 'Ag9Te-2 2.51 0.37b',
     7 'Ag9N -3 1.85 0.37b', 'Ag9P -3 2.22 0.37b', 'Ag9As-3 2.30 0.37b',
     8 'Ag9H -1 1.50 0.37b', 'Al3O -2 1.6200.37e', 'Al3O -2 1.6440.38o',
     9 'Al3S -2 2.21 0.37e', 'Al3S -2 2.13 0.37b', 'Al3Se-2 2.27 0.37b',
     * 'Al3Te-2 2.48 0.37b', 'Al3F -1 1.5450.37a', 'Al3Cl-1 2.0320.37a',
     1 'Al3Br-1 2.20 0.37b', 'Al3I -1 2.41 0.37b', 'Al3N -3 1.79 0.37b',
     2 'Al3P -3 2.24 0.37b', 'Al3As-3 2.30 0.37b', 'Al3H -1 1.45 0.37b',
     3 'Am3O -2 2.11 0.37b', 'Am3O -2 2.13 0.35p', 'Am3F -1 2.00 0.37b',
     4 'Am3F -1 1.98 0.40p', 'Am3Cl-1 2.48 0.37b', 'Am3Cl-1 2.45 0.40p',
     5 'Am3Br-1 2.59 0.40p', 'Am4O -2 2.08 0.37p', 'Am4O -2 2.12 0.37e',
     6 'Am4F -1 1.96 0.40p', 'Am5O -2 2.07 0.35p', 'Am5F -1 1.95 0.40p',
     7 'Am6O -2 2.05 0.35p', 'Am6F -1 1.95 0.40p', 'Am5O -2 2.12 0.37e',
     8 'As2S -2 2.24 0.37e', 'As2Se-2 2.38 0.37e', 'As3O -2 1.7890.37a',
     9 'As3S -2 2.2720.37a', 'As3Se-2 2.40 0.37e', 'As3Te-2 2.65 0.37e',
     * 'As3F -1 1.70 0.37b', 'As3Cl-1 2.16 0.37b', 'As3Br-1 2.35 0.37e',
     1 'As3I -1 2.58 0.37e', 'As3C -4 1.93 0.37b', 'As5O -2 1.7670.37a',
     2 'As5S -2 2.28 0.37e', 'As5F -1 1.6200.37a', 'As5Cl-2 2.14 0.37b',
     3 'Au1Cl-1 2.02 0.37e', 'Au1I -1 2.35 0.37e', 'Au3O -2 1.89 0.37e',
     4 'Au3O -2 1.8330.37b', 'Au3S -2 2.39 0.35e', 'Au3F -1 1.89 0.37e',
     5 'Au3F -1 1.81 0.37b', 'Au3Cl-1 2.17 0.37b', 'Au3Br-1 2.32 0.37e',
     6 'Au3I -1 2.54 0.37e', 'Au3N -3 1.94 0.35e', 'Au5F -1 1.80 0.37e',
     7 'Au9S -2 2.03 0.37b', 'Au9Se-2 2.18 0.37b', 'Au9Te-2 2.41 0.37b',
     8 'Au9Br-1 2.12 0.37b', 'Au9I -1 2.34 0.37b', 'Au9N -3 1.72 0.37b',
     9 'Au9P -3 2.14 0.37b', 'Au9As-3 2.22 0.37b', 'Au9H -1 1.37 0.37b',
     * 'B 3O -2 1.3710.37a', 'B 3S -2 1.77 0.37e', 'B 3S -2 1.82 0.37b',
     1 'B 3Se-2 1.95 0.37b', 'B 3Te-2 2.20 0.37b', 'B 3F -1 1.2810.37a',
     2 'B 3F -1 1.31 0.37b', 'B 3Cl-1 1.74 0.37b', 'B 3Br-1 1.88 0.37b',
     3 'B 3I -1 2.10 0.37b', 'B 3N -3 1.47 0.37b', 'B 3P -3 1.88 0.37b',
     4 'B 3As-3 1.97 0.37b', 'B 3H -1 1.14 0.37b', 'B 3B  3 1.4020.37e'/
      DATA (VALENCE(I), I = 103, 207)/
     5 'Ba2O -2 2.2850.37a', 'Ba2S -2 2.7690.37a', 'Ba2Se-2 2.88 0.37b',
     6 'Ba2Te-2 3.08 0.37b', 'Ba2F -1 2.1880.37a', 'Ba2Cl-1 2.69 0.37b',
     7 'Ba2Br-1 2.88 0.37b', 'Ba2I -1 3.13 0.37b', 'Ba2N -3 2.47 0.37b',
     8 'Ba2P -3 2.88 0.37b', 'Ba2As-3 2.96 0.37b', 'Ba2H -1 2.22 0.37b',
     9 'Be2O -2 1.3810.37a', 'Be2S -2 1.83 0.37b', 'Be2Se-2 1.97 0.37b',
     * 'Be2Te-2 2.21 0.37b', 'Be2F -1 1.2810.37a', 'Be2Cl-1 1.76 0.37b',
     1 'Be2Br-1 1.90 0.37b', 'Be2I -1 2.10 0.37b', 'Be2N -3 1.50 0.37b',
     2 'Be2P -3 1.95 0.37b', 'Be2As-3 2.00 0.37b', 'Be2H -1 1.11 0.37b',
     3 'Bi3O -2 2.0940.37a', 'Bi3S -2 2.5700.37a', 'Bi2Se-2 2.70 0.35e',
     4 'Bi3F -1 1.99 0.37b', 'Bi3Cl-1 2.48 0.37b', 'Bi3Cl-1 2.40 0.37e',
     5 'Bi3Br-1 2.59 0.37e', 'Bi3I -1 2.82 0.37e', 'Bi3N -3 2.02 0.35e',
     6 'Bi5O -2 2.06 0.37b', 'Bi5F -1 1.97 0.37b', 'Bi5Cl-1 2.44 0.37b',
     7 'Bi9Br-1 2.62 0.37b', 'Bi9I -1 2.84 0.37b', 'Bi9S -2 2.55 0.37b',
     8 'Bi9Se-2 2.72 0.37b', 'Bi9Te-2 2.87 0.37b', 'Bi9N -3 2.24 0.37b',
     9 'Bi9P -3 2.63 0.37b', 'Bi9As-3 2.72 0.37b', 'Bi9H -1 1.97 0.37b',
     * 'Bk3O -2 2.08 0.37b', 'Bk3O -2 2.10 0.35p', 'Bk3F -1 1.96 0.37b',
     1 'Bk3F -1 1.95 0.40p', 'Bk3Cl-1 2.35 0.37e', 'Bk3Cl-1 2.46 0.37b',
     2 'Bk3Cl-1 2.42 0.40p', 'Bk3Br-1 2.56 0.40p', 'Bk4O -2 2.07 0.35p',
     3 'Bk4F -1 1.93 0.40p', 'Br3O -2 1.90 0.37e', 'Br3F -1 1.75 0.37e',
     4 'Br5O -2 1.84 0.37e', 'Br5F -1 1.76 0.37e', 'Br7O -2 1.81 0.37b',
     5 'Br7F -1 1.72 0.37b', 'Br7Cl-1 2.19 0.37b', 'C 2O -2 1.3660.37e',
     6 'C 2Cl-1 1.4100.37e', 'C 4O -2 1.3900.37a', 'C 4O -2 1.40 0.26o',
     7 'C 4C  4 1.54 0.37e', 'C 4S -2 1.80 0.37e', 'C 4F -1 1.32 0.37b',
     8 'C 4F -1 1.41 0.37e', 'C 4Cl-1 1.76 0.37b', 'C 4Br-1 1.91 0.37e',
     9 'C 4N -3 1.4420.37a', 'C 9Se-2 1.97 0.37b', 'C 9I -1 2.12 0.37b',
     * 'C 9Br-1 1.90 0.37b', 'C 9S -2 1.82 0.37b', 'C 9Te-2 2.21 0.37b',
     1 'C 9N -3 1.47 0.37b', 'C 9P -3 1.89 0.37b', 'C 9As-3 1.99 0.37b',
     2 'C 9H -1 1.10 0.37b', 'Ca2O -2 1.9670.37a', 'Ca2O -2 1.8960.41o',
     3 'Ca2S -2 2.45 0.37b', 'Ca2Se-2 2.56 0.37b', 'Ca2Te-2 2.76 0.37b',
     4 'Ca2F -1 1.8420.37a', 'Ca2Cl-1 2.37 0.37b', 'Ca2Br-1 2.5070.37e',
     5 'Ca2Br-1 2.49 0.37b', 'Ca2I -1 2.72 0.37b', 'Ca2N -3 2.14 0.37b',
     6 'Ca2P -3 2.55 0.37b', 'Ca2As-3 2.62 0.37b', 'Ca2H -1 1.83 0.37b',
     7 'Cd2O -2 1.9040.37a', 'Cd2S -2 2.3040.37a', 'Cd2Se-2 2.40 0.37b',
     8 'Cd2Te-2 2.59 0.37b', 'Cd2F -1 1.8110.37b', 'Cd2Cl-1 2.2120.37a',
     9 'Cd2Cl-1 2.23 0.37b', 'Cd2Br-1 2.35 0.37b', 'Cd2I -1 2.57 0.37b'/
      DATA (VALENCE(I), I = 208, 312)/
     * 'Cd2I -1 2.60 0.37e', 'Cd2N -3 1.96 0.37b', 'Cd2P -3 2.34 0.37b',
     1 'Cd2As-3 2.43 0.37b', 'Cd2H -1 1.66 0.37b', 'Ce3O -2 2.1510.37b',
     2 'Ce3O -2 2.1210.37a', 'Ce3O -2 2.1160.37a', 'Ce3S -2 2.65 0.37e',
     3 'Ce3F -1 2.0360.37b', 'Ce3F -1 2.00 0.40p', 'Ce3Cl-1 2.52 0.37b',
     4 'Ce3Cl-1 2.49 0.40p', 'Ce3Br-1 2.65 0.35e', 'Ce3Br-1 2.65 0.40p',
     5 'Ce3I -1 2.87 0.40p', 'Ce4O -2 2.0280.37b', 'Ce4O -2 2.0680.37a',
     6 'Ce4S -2 2.65 0.35e', 'Ce4F -1 1.9950.37b', 'Ce4F -1 1.97 0.40p',
     7 'Ce9Cl-1 2.41 0.37b', 'Ce9Br-1 2.69 0.37b', 'Ce9I -1 2.92 0.37b',
     8 'Ce9S -2 2.62 0.37b', 'Ce9Se-2 2.74 0.37b', 'Ce9Te-2 2.92 0.37b',
     9 'Ce9N -3 2.34 0.37b', 'Ce9P -3 2.70 0.37b', 'Ce9As-3 2.78 0.37b',
     * 'Ce9H -1 2.04 0.37b', 'Cf3O -2 2.07 0.37b', 'Cf3F -1 1.95 0.37b',
     1 'Cf3F -1 1.94 0.40p', 'Cf3Cl-1 2.45 0.37b', 'Cf3Cl-1 2.41 0.40p',
     2 'Cf3Br-1 2.55 0.40p', 'Cf4O -2 2.06 0.35p', 'Cf4F -1 1.92 0.40p',
     3 'Cl3O -2 1.71 0.37e', 'Cl3F -1 1.69 0.37e', 'Cl5O -2 1.67 0.37e',
     4 'Cl7O -2 1.6320.37a', 'Cl7F -1 1.55 0.37b', 'Cl7Cl-1 2.00 0.37b',
     5 'Cf3Cl-1 2.45 0.37b', 'Cm3O -2 2.23 0.37b', 'Cm3O -2 2.12 0.35p',
     6 'Cm3F -1 2.12 0.37b', 'Cm3F -1 1.96 0.40p', 'Cm3Cl-1 2.62 0.37b',
     7 'Cm3Cl-1 2.44 0.40p', 'Cm4O -2 2.08 0.35p', 'Cm4F -1 1.94 0.40p',
     8 'Co1H -1 1.0000.35e', 'Co2O -2 1.6920.37a', 'Co2O -2 1.6850.37i',
     9 'Co2S -2 1.94 0.37e', 'Co2F -1 1.64 0.37b', 'Co2Cl-1 2.0330.37a',
     * 'Co2Cl-1 2.01 0.37b', 'Co2N -3 1.65 0.37e', 'Co3O -2 1.6370.37i',
     1 'Co3O -2 1.70 0.37b', 'Co3S -2 2.02 0.37e', 'Co3F -1 1.62 0.37b',
     2 'Co3Cl-1 2.05 0.37b', 'Co3N -3 1.75 0.37e', 'Co3C  2 1.6340.37b',
     3 'Co4O -2 1.72 0.37e', 'Co4F -1 1.55 0.37e', 'Co9O -2 1.6550.42o',
     4 'Co9Br-1 2.18 0.37b', 'Co9I -1 2.37 0.35b', 'Co9S -2 2.06 0.37b',
     5 'Co9Se-2 2.24 0.37b', 'Co9Te-2 2.46 0.37b', 'Co9N -3 1.84 0.37b',
     6 'Co9P -3 2.21 0.37b', 'Co9As-3 2.28 0.37b', 'Co9H -1 1.44 0.37b',
     7 'Cr2O -2 1.73 0.37b', 'Cr2F -1 1.67 0.37b', 'Cr2F -1 1.74 0.37e',
     8 'Cr2Cl-1 2.09 0.37b', 'Cr2Br-1 2.26 0.37e', 'Cr2I -1 2.48 0.37e',
     9 'Cr2N -3 1.83 0.35e', 'Cr3O -2 1.7240.37a', 'Cr3O -2 1.7080.37w',
     * 'Cr3S -2 2.1620.37e', 'Cr3F -1 1.6570.37a', 'Cr3F -1 1.64 0.37b',
     1 'Cr3Cl-1 2.08 0.37b', 'Cr3Br-1 2.28 0.37e', 'Cr3N -3 1.81 0.37e',
     2 'Cr4O -2 1.81 0.37e', 'Cr4F -1 1.56 0.37e', 'Cr5O -2 1.76 0.37w',
     3 'Cr5O -2 1.78 0.37e', 'Cr6O -2 1.7940.37a', 'Cr6F -1 1.74 0.37b',
     4 'Cr6Cl-1 2.12 0.37b', 'Cr9O -2 1.79 0.34o', 'Cr9O -2 1.7240.37w'/
      DATA (VALENCE(I), I = 313, 417)/
     5 'Cr9Br-1 2.26 0.37b', 'Cr9I -1 2.45 0.37b', 'Cr9S -2 2.18 0.37b',
     6 'Cr9Se-2 2.29 0.37b', 'Cr9Te-2 2.52 0.37b', 'Cr9N -3 1.85 0.37b',
     7 'Cr9P -3 2.27 0.37b', 'Cr9As-3 2.34 0.37b', 'Cr9H -1 1.52 0.37b',
     8 'Cs1O -2 2.4170.37a', 'Cs1O -2 2.2860.40c', 'Cs1S -2 2.89 0.37b',
     9 'Cs1S -2 2.5250.51c', 'Cs1S -2 2.93 0.37e', 'Cs1Se-2 2.98 0.37b',
     * 'Cs1Se-2 2.6420.55c', 'Cs1Te-2 3.16 0.37b', 'Cs1Te-2 2.7640.60c',
     1 'Cs1F -1 2.33 0.37b', 'Cs1F -1 2.1980.41c', 'Cs1F -1 2.38 0.37e',
     2 'Cs1Cl-1 2.7910.37a', 'Cs1Cl-1 2.4710.49c', 'Cs1Br-1 2.95 0.37b',
     3 'Cs1Br-1 2.5030.54c', 'Cs1I -1 3.18 0.37b', 'Cs1I -1 2.6920.60c',
     4 'Cs1I -1 3.29 0.37e', 'Cs1N -3 2.83 0.37e', 'Cs1N -3 2.53 0.37b',
     5 'Cs1P -3 2.93 0.37b', 'Cs1As-3 3.04 0.37b', 'Cs1H -1 2.44 0.37b',
     6 'Cu1O -2 1.6100.37e', 'Cu1O -2 1.5040.37l', 'Cu1S -2 1.8980.37a',
     7 'Cu1S -2 1.8110.37l', 'Cu1Se-2 1.9000.37l', 'Cu1F -1 1.6  0.37b',
     8 'Cu1Cl-1 1.8580.37l', 'Cu1Cl-1 1.89 0.37e', 'Cu1Br-1 2.03 0.37e',
     9 'Cu1I -1 2.1080.37a', 'Cu1I -1 2.1550.37l', 'Cu1N -3 1.5200.37l',
     * 'Cu1N -3 1.4800.37l', 'Cu1N -3 1.6300.37l', 'Cu1P -3 1.7740.37l',
     1 'Cu1As-3 1.8560.37l', 'Cu1C -4 1.4460.37l', 'Cu2O -2 1.6790.37a',
     2 'Cu2O -2 1.6490.37j', 'Cu2O -2 1.6550.37l', 'Cu2S -2 2.0540.37a',
     3 'Cu2S -2 2.0600.37j', 'Cu2S -2 2.0240.37l', 'Cu2S -2 1.86 0.37b',
     4 'Cu2Se-2 2.02 0.37b', 'Cu2Se-2 2.1240.37l', 'Cu2Te-2 2.27 0.37b',
     5 'Cu2F -1 1.5940.37a', 'Cu2Cl-1 2.00 0.37b', 'Cu2Br-1 1.99 0.37b',
     6 'Cu2Br-1 2.1340.37l', 'Cu2I -1 2.16 0.37b', 'Cu2I -1 2.36 0.37l',
     7 'Cu2N -3 1.7510.37j', 'Cu2N -3 1.7130.37l', 'Cu2N -3 1.61 0.37b',
     8 'Cu2N -3 1.7090.37l', 'Cu2N -3 1.7040.37l', 'Cu2N -3 1.7630.37l',
     9 'Cu2P -3 1.97 0.37b', 'Cu2P -3 2.05 0.37l', 'Cu2As-3 2.08 0.37b',
     * 'Cu2C -4 1.72 0.37l', 'Cu2H -1 1.21 0.37b', 'Cu3O -2 1.7350.37t',
     1 'Cu3O -2 1.7390.37e', 'Cu3F -1 1.58 0.37e', 'Cu3Cl-1 2.0780.37l',
     2 'Cu3N -3 1.7680.37l', 'Cu3N -3 1.7530.37t', 'Cu3C -4 1.84 0.37l',
     3 'Dy2O -2 1.90 0.37e', 'Dy3O -2 2.0010.37a', 'Dy3O -2 2.0050.37a',
     4 'Dy3F -1 1.9220.37b', 'Dy3F -1 1.89 0.40p', 'Dy3Cl-1 2.41 0.37b',
     5 'Dy3Cl-1 2.38 0.40p', 'Dy3Br-1 2.53 0.40p', 'Dy3I -1 2.76 0.40p',
     6 'Dy9Br-1 2.56 0.37b', 'Dy9I -1 2.77 0.37b', 'Dy9S -2 2.47 0.37b',
     7 'Dy9Se-2 2.61 0.37b', 'Dy9Te-2 2.80 0.37b', 'Dy9N -3 2.18 0.37b',
     8 'Dy9P -3 2.57 0.37b', 'Dy9As-3 2.64 0.37b', 'Dy9H -1 1.89 0.37b',
     9 'Er2O -2 1.88 0.37e', 'Er2S -2 2.52 0.37e', 'Er3O -2 1.9880.37a'/
      DATA (VALENCE(I), I = 418, 520)/
     * 'Er3O -2 2.0100.37b', 'Er3O -2 1.9790.37a', 'Er3S -2 2.52 0.37e',
     1 'Er3Se-2 2.58 0.37e', 'Er3F -1 1.9040.37a', 'Er3F -1 1.87 0.40p',
     2 'Er3Cl-1 2.39 0.37b', 'Er3Cl-1 2.36 0.40p', 'Er3Br-1 2.51 0.40p',
     3 'Er3I -1 2.75 0.40p', 'Er9Br-1 2.54 0.37b', 'Er9I -1 2.75 0.37b',
     4 'Er9S -2 2.46 0.37b', 'Er9Se-2 2.59 0.37b', 'Er9Te-2 2.78 0.37b',
     5 'Er9N -3 2.16 0.37b', 'Er9P -3 2.55 0.37b', 'Er9As-3 2.63 0.37b',
     6 'Er9H -1 1.86 0.37b', 'Es3O -2 2.08 0.35p', 'Eu2O -2 2.13 0.37e',
     7 'Eu2S -2 2.5840.37a', 'Eu2F -1 2.04 0.37b', 'Eu2Cl-1 2.53 0.37b',
     8 'Eu2Br-1 2.67 0.37e', 'Eu2I -1 2.90 0.37e', 'Eu2N -3 2.34 0.37e',
     9 'Eu3O -2 2.0740.37a', 'Eu3O -2 2.0380.37a', 'Eu3S -2 2.58 0.35e',
     * 'Eu3F -1 1.9610.37b', 'Eu3F -1 1.93 0.40p', 'Eu3Cl-1 2.48 0.37e',
     1 'Eu3Cl-1 2.42 0.40p', 'Eu3Br-1 2.57 0.40p', 'Eu3I -1 2.79 0.40p',
     2 'Eu9Br-1 2.61 0.37b', 'Eu9I -1 2.83 0.37b', 'Eu9S -2 2.53 0.37b',
     3 'Eu9Se-2 2.66 0.37b', 'Eu9Te-2 2.85 0.37b', 'Eu9N -3 2.24 0.37b',
     4 'Eu9P -3 2.62 0.37b', 'Eu9As-3 2.70 0.37b', 'Eu9H -1 1.95 0.37b',
     5 'Fe2C -4 1.47 0.37*',
     5 'Fe2O -2 1.7340.37a', 'Fe2O -2 1.7130.37h', 'Fe2O -2 1.7000.37j',
     6 'Fe2S -2 2.12 0.37e', 'Fe2S -2 2.1250.37j', 'Fe2F -1 1.65 0.37b',
     7 'Fe2Cl-1 2.06 0.37b', 'Fe2Cl-1 2.15 0.37e', 'Fe2Br-1 2.21 0.35e',
     8 'Fe2I -1 2.47 0.35e', 'Fe2N -3 1.7690.37j', 'Fe3O -2 1.7590.37a',
     9 'Fe3O -2 1.7510.37h', 'Fe3O -2 1.7650.37j', 'Fe3S -2 2.1490.37a',
     * 'Fe3S -2 2.1340.37j', 'Fe3F -1 1.6790.37a', 'Fe3Cl-1 2.09 0.37b',
     1 'Fe3Cl-1 2.15 0.37e', 'Fe3N -3 1.8150.37j', 'Fe3C  2 1.6890.37a',
     2 'Fe4S -2 2.23 0.35e', 'Fe6O -2 1.76 0.35e', 'Fe9O -2 1.74 0.38o',
     3 'Fe9Br-1 2.26 0.37b', 'Fe9I -1 2.47 0.37b', 'Fe9S -2 2.16 0.37b',
     4 'Fe9Se-2 2.28 0.37b', 'Fe9Te-2 2.53 0.37b', 'Fe9N -3 1.86 0.37b',
     5 'Fe9P -3 2.27 0.37b', 'Fe9As-3 2.35 0.37b', 'Fe9H -1 1.53 0.37b',
     6 'Ga1Se-1 2.55 0.37e', 'Ga3O -2 1.7300.37a', 'Ga3S -2 2.1630.37a',
     7 'Ga3F -1 1.62 0.37b', 'Ga3F -1 1.69 0.37e', 'Ga3Cl-1 2.07 0.37b',
     8 'Ga3Br-1 2.20 0.35e', 'Ga3I -1 2.46 0.37e', 'Ga9Br-1 2.24 0.37b',
     9 'Ga9I -1 2.45 0.37b', 'Ga9S -2 2.17 0.37b', 'Ga9Se-2 2.30 0.37b',
     * 'Ga9Te-2 2.54 0.37b', 'Ga9N -3 1.84 0.37b', 'Ga9P -3 2.26 0.37b',
     1 'Ga9As-3 2.34 0.37b', 'Ga9H -1 1.51 0.37b', 'Gd2O -2 2.01 0.37e',
     2 'Gd2F -1 2.40 0.37e', 'Gd3O -2 2.0650.37b', 'Gd3O -2 2.0310.37a',
     3 'Gd3S -2 2.53 0.37e', 'Gd3F -1 1.95 0.37b', 'Gd3F -1 1.92 0.40p'/
      DATA (VALENCE(I), I = 521, 625)/
     4 'Gd3Cl-1 2.4450.37b', 'Gd3Cl-1 2.41 0.40p', 'Gd3Cl-1 2.47 0.37e',
     5 'Gd3Br-1 2.56 0.40p', 'Gd3I -1 2.78 0.40p', 'Gd9Br-1 2.60 0.37b',
     6 'Gd9I -1 2.82 0.37b', 'Gd9S -2 2.53 0.37b', 'Gd9Se-2 2.65 0.37b',
     7 'Gd9Te-2 2.84 0.37b', 'Gd9N -3 2.22 0.37b', 'Gd9N -3 2.10 0.37e',
     8 'Gd9P -3 2.61 0.37b', 'Gd9As-3 2.68 0.37b', 'Gd9H -1 1.93 0.37b',
     9 'Ge4O -2 1.7480.37a', 'Ge4S -2 2.2170.37a', 'Ge4Se-2 2.35 0.37e',
     * 'Ge4F -1 1.66 0.37b', 'Ge4Cl-1 2.14 0.37b', 'Ge9Br-1 2.30 0.37b',
     1 'Ge9I -1 2.50 0.37b', 'Ge9S -2 2.23 0.37b', 'Ge9Se-2 2.35 0.37b',
     2 'Ge9Te-2 2.56 0.37b', 'Ge9N -3 1.88 0.37b', 'Ge9P -3 2.32 0.37b',
     3 'Ge9As-3 2.43 0.37b', 'Ge9H -1 1.55 0.37b', 'H 1O -2 0.5690.94e',
     4 'H 1O -2 0.9070.28e', 'H 1O -2 0.9900.59e', 'Hf3F -1 2.62 0.37e',
     5 'Hf4O -2 1.9230.37b', 'Hf4F -1 1.85 0.37b', 'Hf4F -1 1.82 0.40p',
     6 'Hf4Cl-1 2.24 0.37e', 'Hf4Cl-1 2.30 0.37b', 'Hf9Br-1 2.47 0.37b',
     7 'Hf9S -2 2.39 0.37b', 'Hf9Se-2 2.52 0.37b', 'Hf9Te-2 2.72 0.37b',
     8 'Hf9I -1 2.68 0.37b', 'Hf9N -3 2.09 0.37b', 'Hf9P -3 2.48 0.37b',
     9 'Hf9As-3 2.56 0.37b', 'Hf9H -1 1.78 0.37b', 'Hg1O -2 1.90 0.37b',
     * 'Hg1F -1 1.81 0.37b', 'Hg1Cl-1 2.28 0.37b', 'Hg2O -2 1.9720.37a',
     1 'Hg2O -2 1.93 0.37b', 'Hg2S -2 2.3080.37a', 'Hg2F -1 2.17 0.37e',
     2 'Hg2F -1 1.90 0.37b', 'Hg2Cl-1 2.28 0.37e', 'Hg2Cl-1 2.25 0.37b',
     3 'Hg2Br-1 2.38 0.37e', 'Hg2I -1 2.62 0.37e', 'Hg9Br-1 2.40 0.37b',
     4 'Hg9I -1 2.59 0.37b', 'Hg9S -2 2.32 0.37b', 'Hg9Se-2 2.47 0.37b',
     5 'Hg9Te-2 2.61 0.37b', 'Hg9N -3 2.02 0.37b', 'Hg9P -3 2.42 0.37b',
     6 'Hg9As-3 2.50 0.37b', 'Hg9H -1 1.71 0.37b', 'Hg2Hg 2 2.51 0.35f',
     7 'Ho3O -2 2.0250.37a', 'Ho3O -2 1.9920.37a', 'Ho3S -2 2.49 0.37e',
     8 'Ho3F -1 1.9080.37b', 'Ho3F -1 1.88 0.40p', 'Ho3Cl-1 2.4010.37b',
     9 'Ho3Cl-1 2.37 0.40p', 'Ho3Br-1 2.52 0.40p', 'Ho3I -1 2.76 0.40p',
     * 'Ho9Br-1 2.55 0.37b', 'Ho9I -1 2.77 0.37b', 'Ho9S -2 2.48 0.37b',
     1 'Ho9Se-2 2.61 0.37b', 'Ho9Te-2 2.80 0.37b', 'Ho9N -3 2.18 0.37b',
     2 'Ho9P -3 2.56 0.37b', 'Ho9As-3 2.64 0.37b', 'Ho9H -1 1.88 0.37b',
     3 'I 0I  0 2.1950.35e', 'I 1F -1 2.32 0.37e', 'I 1Cl-1 2.47 0.37e',
     4 'I 3O -2 2.02 0.37e', 'I 3F -1 1.90 0.37b', 'I 3Cl-1 2.39 0.37e',
     5 'I 5O -2 2.0030.37a', 'I 5F -1 1.84 0.37e', 'I 5F -1 1.90 0.37b',
     6 'I 5Cl-1 2.38 0.37b', 'I 7O -2 1.93 0.37b', 'I 7F -1 1.83 0.37b',
     7 'I 7Cl-1 2.31 0.37b', 'In1Cl-1 2.56 0.37e', 'In3O -2 1.9020.37a',
     8 'In3S -2 2.3700.37a', 'In3F -1 1.7920.37a', 'In3Cl-1 2.28 0.37b'/
      DATA (VALENCE(I), I = 626, 730)/
     9 'In3Br-1 2.51 0.35e', 'In3I -1 2.63 0.37e', 'In3Co-1 2.5930.35e',
     * 'In3Mn-2 2.6040.35e', 'In9Br-1 2.41 0.37b', 'In9I -1 2.63 0.37b',
     1 'In9S -2 2.36 0.37b', 'In9Se-2 2.47 0.37b', 'In9Te-2 2.69 0.37b',
     2 'In9N -3 2.03 0.37b', 'In9P -3 2.43 0.37b', 'In9As-3 2.51 0.37b',
     3 'In9H -1 1.72 0.37b', 'Ir4O -2 1.87 0.37e', 'Ir4F -1 1.80 0.37e',
     4 'Ir5O -2 1.9160.37b', 'Ir5O -2 2.01 0.37e', 'Ir5F -1 1.82 0.37b',
     5 'Ir5Cl-1 2.30 0.37b', 'Ir9S -2 2.38 0.37b', 'Ir9Se-2 2.51 0.37b',
     6 'Ir9Te-2 2.71 0.37b', 'Ir9Br-1 2.45 0.37b', 'Ir9I -1 2.66 0.37b',
     7 'Ir9N -3 2.06 0.37b', 'Ir9P -3 2.46 0.37b', 'Ir9As-3 2.54 0.37b',
     8 'Ir9H -1 1.76 0.37b', 'K 1O -2 2.1320.37a', 'K 1O -2 2.1130.37u',
     9 'K 1O -2 1.9540.43c', 'K 1O -2 1.84 0.48o', 'K 1S -2 2.59 0.37b',
     * 'K 1S -2 2.1510.58c', 'K 1S -2 2.63 0.37e', 'K 1Se-2 2.72 0.37b',
     1 'K 1Se-2 2.2810.61c', 'K 1Te-2 2.93 0.37b', 'K 1Te-2 2.4100.65c',
     2 'K 1F -1 1.9920.37a', 'K 1F -1 1.8300.42c', 'K 1Cl-1 2.5190.37a',
     3 'K 1Cl-1 2.0700.55c', 'K 1Br-1 2.66 0.37b', 'K 1Br-1 2.1520.60c',
     4 'K 1I -1 2.88 0.37b', 'K 1I -1 2.2820.65c', 'K 1I -1 2.92 0.37e',
     5 'K 1N -3 2.26 0.37b', 'K 1N -3 2.30 0.37e', 'K 1P -3 2.64 0.37b',
     6 'K 1As-3 2.83 0.37b', 'K 1H -1 2.10 0.37b', 'Kr2F -1 1.89 0.37e',
     7 'La3O -2 2.1720.37a', 'La3O -2 2.1720.33a', 'La3O -2 2.1480.37a',
     8 'La3S -2 2.6430.37a', 'La3Se-2 2.74 0.37b', 'La3Te-2 2.94 0.37b',
     9 'La3F -1 2.02 0.40p', 'La3F -1 2.08 0.37e', 'La3Cl-1 2.5450.37b',
     * 'La3Cl-1 2.57 0.37e', 'La3Cl-1 2.58 0.40p', 'La3Br-1 2.72 0.37b',
     1 'La3Br-1 2.66 0.40p', 'La3I -1 2.93 0.37b', 'La3I -1 2.88 0.40p',
     2 'La3N -3 2.34 0.37b', 'La3P -3 2.73 0.37b', 'La3As-3 2.80 0.37b',
     3 'La3H -1 2.06 0.37b', 'Li1O -2 1.4660.37a', 'Li1O -2 1.1740.51c',
     4 'Li1O -2 1.29 0.48o', 'Li1S -2 1.94 0.37b', 'Li1S -2 1.4600.65c',
     5 'Li1Se-2 2.09 0.37b', 'Li1Se-2 1.6270.68c', 'Li1Te-2 2.30 0.37b',
     6 'Li1Te-2 1.7340.71c', 'Li1F -1 1.3600.37a', 'Li1F -1 1.0960.50c',
     7 'Li1Cl-1 1.91 0.37b', 'Li1Cl-1 1.3870.64c', 'Li1Cl-1 1.94 0.37e',
     8 'Li1Br-1 2.02 0.37b', 'Li1Br-1 1.5150.67c', 'Li1I -1 2.22 0.37b',
     9 'Li1I -1 1.6750.72c', 'Li1N -3 1.61 0.37b', 'Lu3O -2 1.9710.37b',
     * 'Lu3O -2 1.9470.37a', 'Lu3S -2 2.43 0.37b', 'Lu3Se-2 2.56 0.37b',
     1 'Lu3Te-2 2.75 0.37b', 'Lu3F -1 1.8760.37b', 'Lu3F -1 1.84 0.40p',
     2 'Lu3Cl-1 2.3610.37b', 'Lu3Cl-1 2.33 0.40p', 'Lu3Br-1 2.50 0.37b',
     3 'Lu3Br-1 2.48 0.40p', 'Lu3I -1 2.73 0.37b', 'Lu3I -1 2.73 0.40p'/
      DATA (VALENCE(I), I = 731, 835)/
     4 'Lu3N -3 2.11 0.37b', 'Lu3P -3 2.51 0.37b', 'Lu3As-3 2.59 0.37b',
     5 'Lu3H -1 1.82 0.37b', 'Mg2O -2 1.6930.37a', 'Mg2O -2 1.6360.42o',
     6 'Mg2S -2 2.18 0.37b', 'Mg2Se-2 2.32 0.37b', 'Mg2Te-2 2.53 0.37b',
     7 'Mg2F -1 1.5780.37a', 'Mg2Cl-1 2.08 0.37b', 'Mg2Br-1 2.28 0.37b',
     8 'Mg2I -1 2.46 0.37b', 'Mg2N -3 1.85 0.37b', 'Mg2P -3 2.29 0.37b',
     9 'Mg2As-3 2.38 0.37b', 'Mg2H -1 1.53 0.37b', 'Mn1C -4 1.2370.37*',
     * 'Mn1P -3 1.6230.37*', 'Mn1N -3 1.2750.37*', 'Mn1O -2 1.3000.37*',
     * 'Mn2O -2 1.7900.37a', 'Mn2S -2 2.22 0.37e', 'Mn2F -1 1.6980.37a',
     1 'Mn2Cl-1 2.1330.37a', 'Mn2Br-1 2.34 0.37e', 'Mn2I -2 2.52 0.37e',
     2 'Mn2N -3 1.8490.37j', 'Mn2N -3 1.65 0.35e', 'Mn3O -2 1.7600.37a',
     3 'Mn3O -2 1.7320.37j', 'Mn3F -1 1.66 0.37b', 'Mn3Cl-1 2.14 0.37b',
     4 'Mn3N -3 1.8370.37j', 'Mn4O -2 1.7530.37a', 'Mn4O -2 1.7500.37j',
     5 'Mn4F -1 1.71 0.37b', 'Mn4F -1 1.63 0.37e', 'Mn4Cl-1 2.13 0.37b',
     6 'Mn4N -3 1.8220.37j', 'Mn6O -2 1.79 0.37e', 'Mn7O -2 1.8270.37e',
     7 'Mn7O -2 1.79 0.37b', 'Mn7F -1 1.72 0.37b', 'Mn7Cl-1 2.17 0.37b',
     8 'Mn9O -2 1.7540.37g', 'Mn9Br-1 2.26 0.37b', 'Mn9I -1 2.49 0.37b',
     9 'Mn9S -2 2.20 0.37b', 'Mn9Se-1 2.32 0.37b', 'Mn9Te-2 2.55 0.37b',
     * 'Mn9N -3 1.87 0.37b', 'Mn9P -3 2.24 0.37b', 'Mn9As-3 2.36 0.37b',
     1 'Mn9H -1 1.55 0.37b', 'Mo3O -2 1.8340.37m', 'Mo3F -1 1.76 0.35e',
     2 'Mo3Cl-1 2.22 0.37e', 'Mo3Br-1 2.34 0.37e', 'Mo3N -3 1.96 0.37e',
     3 'Mo4O -2 1.8860.37j', 'Mo4O -2 1,8560.37m', 'Mo4S -2 2.2350.37j',
     4 'Mo4F -1 1.80 0.37e', 'Mo4Cl-1 2.17 0.37e', 'Mo4N -3 2.0430.37j',
     5 'Mo5O -2 1.9070.37j', 'Mo5O -2 1.8780.37m', 'Mo5S -2 2.2880.37j',
     6 'Mo5Cl-1 2.26 0.37e', 'Mo5N -3 2.0090.37j', 'Mo6O -2 1.9070.37a',
     7 'Mo6O -2 1.9150.41x', 'Mo6O -2 1.87 0.26n', 'Mo6O -2 1.9000.37m',
     8 'Mo6S -2 2.3310.37j', 'Mo6F -1 1.81 0.37b', 'Mo6Cl-1 2.28 0.37b',
     9 'Mo6N -3 2.0090.37j', 'Mo9O -2 1.8790.30z', 'Mo9Br-1 2.43 0.37b',
     * 'Mo9I -1 2.64 0.37b', 'Mo9S -2 2.35 0.37b', 'Mo9Se-2 2.49 0.37b',
     1 'Mo9Te-2 2.69 0.37b', 'Mo9N -3 2.04 0.37b', 'Mo9P -3 2.44 0.37b',
     2 'Mo9As-3 2.52 0.37b', 'Mo9H -1 1.73 0.37b', 'N 3O -2 1.3610.37a',
     3 'N 3S -2 1.73 0.37e', 'N 3F -1 1.37 0.37b', 'N 3Cl-1 1.75 0.37b',
     4 'N 3N -3 1.44 0.35e', 'N 5O -2 1.4320.37a', 'N 5O -2 1.41 0.43o',
     5 'N 5F -1 1.36 0.37b', 'N 5Cl-1 1.80 0.37b', 'Na1O -2 1.8030.37a',
     6 'Na1O -2 1.7560.37v', 'Na1O -2 1.5760.47c', 'Na1O -2 1.6610.44o',
     7 'Na1S -2 2.3000.37a', 'Na1S -2 2.28 0.37b', 'Na1S -2 1.8210.62c'/
      DATA (VALENCE(I), I = 836, 940)/
     8 'Na1Se-2 2.41 0.37b', 'Na1Se-2 1.8900.65c', 'Na1Te-2 2.64 0.37b',
     9 'Na1Te-2 2.0400.69c', 'Na1F -1 1.6770.37a', 'Na1F -1 1.4480.46c',
     * 'Na1Cl-1 2.15 0.37b', 'Na1Cl-1 1.6830.60c', 'Na1Cl-1 2.22 0.37e',
     1 'Na1Br-1 2.33 0.37b', 'Na1Br-1 1.7710.64c', 'Na1I -1 2.56 0.37b',
     2 'Na1I -1 1.9550.69c', 'Na1N -3 1.93 0.37b', 'Na1N -3 2.01 0.37e',
     3 'Na1P -3 2.36 0.37b', 'Na1As-3 2.53 0.37b', 'Na1H -1 1.68 0.37b',
     4 'Nb3O -2 1.91 0.35e', 'Nb3F -1 1.71 0.37e', 'Nb3Cl-1 2.20 0.37e',
     5 'Nb3Br-1 2.35 0.37e', 'Nb4O -2 1.88 0.37e', 'Nb4F -1 1.90 0.37e',
     6 'Nb4Cl-1 2.26 0.35e', 'Nb4Br-1 2.62 0.37e', 'Nb5O -2 1.9110.37a',
     7 'Nb5O -2 1.9160.37x', 'Nb5F -1 1.87 0.37b', 'Nb5Cl-1 2.27 0.37b',
     8 'Nb5I -1 2.77 0.37e', 'Nb5N -3 2.01 0.35e', 'Nb9Br-1 2.45 0.37b',
     9 'Nb9I -1 2.68 0.37b', 'Nb9S -2 2.37 0.37b', 'Nb9Se-2 2.51 0.37b',
     * 'Nb9Te-2 2.70 0.37b', 'Nb9N -3 2.06 0.37b', 'Nb9P -3 2.46 0.37b',
     1 'Nb9As-3 2.54 0.37b', 'Nb9H -1 1.75 0.37b', 'Nd2O -2 1.95 0.37e',
     2 'Nd2S -2 2.60 0.35e', 'Nd3O -2 2.1050.37a', 'Nd3O -2 2.1170.37b',
     3 'Nd3O -2 2.0860.37a', 'Nd3S -2 2.59 0.37b', 'Nd3Se-2 2.71 0.37b',
     4 'Nd3Te-2 2.89 0.37b', 'Nd3F -1 2.0080.37b', 'Nd3F -1 1.98 0.40p',
     5 'Nd3Cl-1 2.4920.37b', 'Nd3Cl-1 2.46 0.40p', 'Nd3Br-1 2.66 0.37b',
     6 'Nd3Br-1 2.61 0.40p', 'Nd3I -1 2.87 0.37b', 'Nd3I -1 2.84 0.40p',
     7 'Nd3N -3 2.30 0.37b', 'NH1O -2 2.2260.37s', 'NH1F -1 2.1290.37s',
     8 'NH1Cl-1 2.6190.37s', 'Ni2O -2 1.6540.37a', 'Ni2O -2 1.6700.37j',
     9 'Ni2S -2 1.98 0.37e', 'Ni2S -2 1.9370.37j', 'Ni2F -1 1.5960.37a',
     * 'Ni2Cl-1 2.02 0.37b', 'Ni2Br-1 2.20 0.37e', 'Ni2I -1 2.40 0.37e',
     1 'Ni2N -3 1.70 0.37e', 'Ni2N -3 1.6470.37j', 'Ni3O -2 1.75 0.37e',
     2 'Ni3S -2 2.0400.37j', 'Ni3F -1 1.58 0.37e', 'Ni3N -3 1.7310.37j',
     3 'Ni4O -2 1.78 0.35e', 'Ni4F -1 1.61 0.37e', 'Ni9Br-1 2.16 0.37b',
     4 'Ni9I -1 2.34 0.37b', 'Ni9S -2 2.04 0.37b', 'Ni9Se-2 2.14 0.37b',
     5 'Ni9Te-2 2.43 0.37b', 'Ni9N -3 1.75 0.37b', 'Ni9P -3 2.17 0.37b',
     6 'Ni9As-3 2.24 0.37b', 'Ni9H -1 1.40 0.37b', 'Np3F -1 2.00 0.40p',
     7 'Np3Cl-1 2.48 0.40p', 'Np3Br-1 2.62 0.40p', 'Np3I -1 2.85 0.40p',
     8 'Np4O -2 2.18 0.37e', 'Np4O -2 2.11 0.35p', 'Np4F -1 2.02 0.37e',
     9 'Np4F -1 1.98 0.40p', 'Np4Cl-1 2.46 0.40p', 'Np5O -2 2.09 0.35p',
     * 'Np5F -1 1.97 0.40p', 'Np5Cl-1 2.42 0.40p', 'Np6O -2 2.07 0.35p',
     1 'Np6F -1 1.97 0.40p', 'Np7O -2 2.06 0.35p', 'O 2O -2 1.5000.35e',
     2 'Os4O -2 1.8110.37b', 'Os4S -2 2.21 0.37e', 'Os4F -1 1.72 0.37b'/
      DATA (VALENCE(I), I = 941, 1045)/
     3 'Os4Cl-1 2.19 0.37b', 'Os4Br-1 2.37 0.37e', 'Os5F -1 1.81 0.37e',
     4 'Os6O -2 2.03 0.37a', 'Os6F -1 1.80 0.35e', 'Os8O -2 1.92 0.37e',
     5 'P 3O -2 1.63 0.37e', 'P 3S -2 2.12 0.37e', 'P 3Se-2 2.24 0.37e',
     6 'P 3F -1 1.53 0.35e', 'P 4O -2 1.64 0.37e', 'P 4S -2 2.13 0.35e',
     7 'P 4F -1 1.66 0.37e', 'P 5O -2 1.6170.37a', 'P 5O -2 1.6040.37b',
     8 'P 5S -2 2.1450.37a', 'P 5F -1 1.54 0.37e', 'P 5Cl-1 2.02 0.37e',
     9 'P 5Br-1 2.17 0.40e', 'P 5N -3 1.7040.37a', 'P 9Br-1 2.15 0.37b',
     * 'P 9I -1 2.40 0.37b', 'P 9S -2 2.11 0.37b', 'P 9Se-2 2.26 0.37b',
     1 'P 9Te-2 2.44 0.37b', 'P 9N -3 1.73 0.37b', 'P 9P -3 2.19 0.37b',
     2 'P 9As-3 2.25 0.37b', 'P 9H -1 1.41 0.37b', 'P 5P  5 2.22 0.35e',
     3 'Pa4O -2 2.15 0.35p', 'Pa4F -1 2.02 0.40p', 'Pa4Cl-1 2.49 0.40p',
     4 'Pa4Br-1 2.66 0.40p', 'Pa5O -2 2.09 0.35e', 'Pa5O -2 2.11 0.35p',
     5 'Pa5F -1 2.04 0.37e', 'Pa5F -1 2.01 0.40p', 'Pa5Cl-1 2.45 0.40p',
     6 'Pa5Br-1 2.58 0.40p', 'Pb2O -2 1.9630.49q', 'Pb2O -2 2.1120.37a',
     7 'Pb2S -2 2.5410.37a', 'Pb2Se-2 2.69 0.37e', 'Pb2F -1 2.03 0.37b',
     8 'Pb2Cl-1 2.53 0.37b', 'Pb2Br-1 2.68 0.37e', 'Pb2I -1 2.83 0.37e',
     9 'Pb2N -3 2.18 0.40e', 'Pb4O -2 2.0420.37a', 'Pb4F -1 1.94 0.37b',
     * 'Pb4Cl-1 2.43 0.37b', 'Pb4Cl-1 2.36 0.37e', 'Pb4Br-1 3.04 0.35e',
     1 'Pb9Br-1 2.64 0.37b', 'Pb9I -1 2.78 0.37b', 'Pb9S -2 2.55 0.37b',
     2 'Pb9Se-2 2.67 0.37b', 'Pb9Te-2 2.84 0.37b', 'Pb9N -3 2.22 0.37b',
     3 'Pb9P -3 2.64 0.37b', 'Pb9As-3 2.72 0.37b', 'Pb9H -1 1.97 0.37b',
     4 'Pd2O -2 1.7920.37b', 'Pd2S -2 2.09 0.37e', 'Pd2F -1 1.74 0.37b',
     5 'Pd2Cl-1 2.05 0.37b', 'Pd2Br-1 2.20 0.37e', 'Pd2I -1 2.36 0.37e',
     6 'Pd2N -3 1.82 0.35e', 'Pd2C -4 1.73 0.37e', 'Pd4S -2 2.30 0.37e',
     7 'Pd4F -1 1.66 0.37e', 'Pd9Br-1 2.19 0.37b', 'Pd9I -1 2.38 0.37b',
     8 'Pd9S -2 2.10 0.37b', 'Pd9Se-2 2.22 0.37b', 'Pd9Te-2 2.48 0.37b',
     9 'Pd9N -3 1.81 0.37b', 'Pd9P -3 2.22 0.37b', 'Pd9As-3 2.30 0.37b',
     * 'Pd9H -1 1.47 0.37b', 'Pm3F -1 1.96 0.40p', 'Pm3Cl-1 2.45 0.40p',
     1 'Pm3Br-1 2.59 0.40p', 'Pm3Cl-1 2.82 0.40p', 'Po4O -2 2.19 0.37e',
     2 'Po4F -1 2.38 0.37e', 'Pr3O -2 2.1380.37a', 'Pr3O -2 2.0980.37a',
     3 'Pr3S -2 2.60 0.37b', 'Pr3Se-1 2.72 0.37b', 'Pr3Te-2 2.90 0.37b',
     4 'Pr3F -1 2.0220.37b', 'Pr3F -1 1.99 0.40p', 'Pr3Cl-1 2.50 0.37b',
     5 'Pr3Cl-1 2.47 0.40p', 'Pr3Br-1 2.67 0.37b', 'Pr3Br-1 2.63 0.40p',
     6 'Pr3I -1 2.89 0.37b', 'Pr3I -1 2.85 0.40p', 'Pr3N -3 2.30 0.37b',
     7 'Pr3P -3 2.68 0.37b', 'Pr3As-3 2.75 0.37b', 'Pr3H -1 2.02 0.37b'/
      DATA (VALENCE(I), I = 1046, 1150)/
     8 'Pt2O -2 1.7680.37b', 'Pt2O -2 1.80 0.37e', 'Pt2S -2 2.16 0.37e',
     9 'Pt2F -1 1.68 0.37b', 'Pt2Cl-1 2.05 0.37b', 'Pt2Br-1 2.20 0.37e',
     * 'Pt2C  2 1.7600.37a', 'Pt2N -3 1.81 0.37e', 'Pt3O -2 1.87 0.37e',
     1 'Pt3Cl-1 2.30 0.37e', 'Pt3Br-1 2.47 0.35e', 'Pt4O -2 1.8790.37a',
     2 'Pt4F -1 1.7590.37b', 'Pt4F -1 2.19 0.37e', 'Pt4Cl-1 2.17 0.37b',
     3 'Pt4Cl-1 2.32 0.37e', 'Pt4Br-1 2.6  0.35e', 'Pt9Br-1 2.18 0.37b',
     4 'Pt9I -1 2.37 0.37b', 'Pt9S -2 2.08 0.37b', 'Pt9Se-2 2.19 0.37b',
     5 'Pt9Te-2 2.45 0.37b', 'Pt9N -3 1.77 0.37b', 'Pt9P -3 2.19 0.37b',
     6 'Pt9As-3 2.26 0.37b', 'Pt9H -1 1.40 0.37b', 'Pu3O -2 2.11 0.37b',
     7 'Pu3O -2 2.14 0.35p', 'Pu3F -1 2.00 0.37b', 'Pu3F -1 1.99 0.40p',
     8 'Pu3Cl-1 2.48 0.37b', 'Pu3Cl-1 2.46 0.40p', 'Pu3Br-1 2.60 0.40p',
     9 'Pu3I -1 2.84 0.40p', 'Pu4O -2 2.09 0.35p', 'Pu4F -1 1.97 0.40p',
     * 'Pu4Cl-1 2.44 0.40p', 'Pu5O -2 2.11 0.37e', 'Pu5O -2 2.08 0.35p',
     1 'Pu5F -1 1.96 0.40p', 'Pu6O -2 2.06 0.35p', 'Pu6F -1 1.96 0.40p',
     2 'Pu7O -2 2.05 0.35p', 'Rb1O -2 2.2630.37a', 'Rb1O -2 2.0810.41c',
     3 'Rb1S -2 2.70 0.37b', 'Rb1S -2 2.2990.55c', 'Rb1S -2 2.80 0.37e',
     4 'Rb1Se-2 2.81 0.37b', 'Rb1Se-2 2.3880.58c', 'Rb1Te-2 3.00 0.37b',
     5 'Rb1Te-2 2.4170.63c', 'Rb1F -1 2.16 0.37b', 'Rb1F -1 1.9710.41c',
     6 'Rb1F -1 2.20 0.37e', 'Rb1Cl-1 2.6520.37a', 'Rb1Cl-1 2.2650.53c',
     7 'Rb1Br-1 2.78 0.37b', 'Rb1Br-1 2.3290.57c', 'Rb1Br-1 2.86 0.37e',
     8 'Rb1I -1 3.01 0.37b', 'Rb1I -1 2.4500.63c', 'Rb1I -1 3.12 0.37e',
     9 'Rb1N -3 2.62 0.37e', 'Rb1N -3 2.37 0.37b', 'Rb1P -3 2.76 0.37b',
     * 'Rb1As-3 2.87 0.37b', 'Rb1H -1 2.26 0.37b', 'Re1Cl-1 2.62 0.35e',
     1 'Re3O -2 1.9  0.35e', 'Re3Cl-1 2.23 0.37e', 'Re4F -1 1.81 0.37e',
     2 'Re4Cl-1 2.23 0.37e', 'Re4Br-1 2.35 0.37e', 'Re5O -2 1.86 0.37e',
     3 'Re5Cl-1 2.24 0.37e', 'Re6F -1 1.79 0.37e', 'Re7O -2 1.97 0.37e',
     4 'Re7F -1 1.86 0.37b', 'Re7Cl-1 2.23 0.37b', 'Re9Br-1 2.45 0.37b',
     5 'Re9I -1 2.61 0.37b', 'Re9S -2 2.37 0.37b', 'Re9Se-2 2.50 0.37b',
     6 'Re9Te-2 2.70 0.37b', 'Re9N -3 2.06 0.37b', 'Re9P -3 2.46 0.37b',
     7 'Re9As-3 2.54 0.37b', 'Re9H -1 1.75 0.37b', 'Rh3O -2 1.7930.37b',
     8 'Rh3F -1 1.71 0.37b', 'Rh3Cl-1 2.08 0.37e', 'Rh3Cl-1 2.17 0.37b',
     9 'Rh3Br-1 2.27 0.35e', 'Rh3N -3 1.82 0.35e', 'Rh4F -1 1.59 0.37e',
     * 'Rh5F -1 1.80 0.37e', 'Rh9Br-1 2.25 0.37b', 'Rh9I -1 2.48 0.37b',
     1 'Rh9S -2 2.15 0.37b', 'Rh9Se-1 2.33 0.37b', 'Rh9Te-2 2.55 0.37b',
     2 'Rh9N -3 1.88 0.37b', 'Rh9P -3 2.29 0.37b', 'Rh9As-3 2.37 0.37b'/
      DATA (VALENCE(I), I = 1151, 1255)/
     3 'Rh9H -1 1.55 0.37b', 'Ru2Se-2 2.11 0.35e', 'Ru2F -1 1.84 0.35e',
     4 'Ru3O -2 1.77 0.37o', 'Ru3S -2 2.20 0.35e', 'Ru3F -1 2.12 0.37e',
     5 'Ru3Cl-1 2.25 0.37e', 'Ru3N -3 1.82 0.35e', 'Ru4O -2 1.8340.37b',
     6 'Ru4S -2 2.21 0.37e', 'Ru4F -1 1.74 0.37b', 'Ru4Cl-1 2.21 0.37b',
     7 'Ru5O -2 1.90 0.37o', 'Ru5F -1 1.82 0.37e', 'Ru5Cl-1 2.23 0.35e',
     8 'Ru6O -2 1.87 0.35e', 'Ru7O -2 1.99 0.37e', 'Ru9Br-1 2.26 0.37b',
     9 'Ru9I -1 2.48 0.37b', 'Ru9S -2 2.16 0.37b', 'Ru9Se-2 2.33 0.37b',
     * 'Ru9Te-2 2.54 0.37b', 'Ru9N -3 1.88 0.37b', 'Ru9P -3 2.29 0.37b',
     1 'Ru9As-3 2.36 0.37b', 'Ru9H -1 1.61 0.37b', 'S 2O -2 1.74 0.37e',
     2 'S 2S -2 2.03 0.37e', 'S 2N -2 1.5970.37a', 'S 2N -3 1.6820.37a',
     3 'S 2S  2 2.10 0.35e', 'S 4O -2 1.6440.37a', 'S 4F -1 1.60 0.37b',
     4 'S 4Cl-1 2.02 0.37b', 'S 4N -3 1.7620.37a', 'S 6O -2 1.6240.37a',
     5 'S 6F -1 1.56 0.37b', 'S 6Cl-1 2.03 0.37b', 'S 6N -3 1.72 0.37e',
     6 'S 9Br-1 2.17 0.37b', 'S 9I -1 2.36 0.37b', 'S 9S -2 2.07 0.37b',
     7 'S 9Se-2 2.21 0.37b', 'S 9Te-2 2.45 0.37b', 'S 9N -3 1.74 0.37b',
     8 'S 9P -3 2.15 0.37b', 'S 9As-3 2.25 0.37b', 'S 9H -1 1.38 0.37b',
     9 'Sb3O -2 1.9730.37a', 'Sb3S -2 2.4740.37a', 'Sb3Se-2 2.60 0.37e',
     * 'Sb3F -1 1.8830.37a', 'Sb3F -1 1.90 0.37b', 'Sb3Cl-1 2.35 0.37b',
     1 'Sb3Br-1 2.51 0.37e', 'Sb3I -1 2.76 0.37e', 'Sb3N -3 2.1080.37d',
     2 'Sb5O -2 1.9420.37a', 'Sb5F -1 1.7970.37a', 'Sb5Cl-1 2.30 0.37b',
     3 'Sb5Br-1 2.48 0.37e', 'Sb5N -3 1.99 0.35e', 'Sb9S -2 2.45 0.37b',
     4 'Sb9Se-2 2.57 0.37b', 'Sb9Te-2 2.78 0.37b', 'Sb9Br-1 2.50 0.37b',
     5 'Sb9I -1 2.72 0.37b', 'Sb9N -3 2.12 0.37b', 'Sb9P -3 2.52 0.37b',
     6 'Sb9As-3 2.60 0.37b', 'Sb9H -1 2.77 0.37b', 'Sc3O -2 1.8490.37a',
     7 'Sc3O -2 1.8770.35o', 'Sc3S -2 2.3210.37a', 'Sc3Se-2 2.44 0.37b',
     8 'Sc3Te-2 2.64 0.37b', 'Sc3F -1 1.76 0.37b', 'Sc3Cl-1 2.36 0.37e',
     9 'Sc3Cl-1 2.23 0.37b', 'Sc3Br-1 2.38 0.37b', 'Sc3I -1 2.59 0.37b',
     * 'Sc3N -3 1.98 0.37b', 'Sc3P -3 2.40 0.37b', 'Sc3As-3 2.48 0.37b',
     1 'Sc3H -1 1.68 0.37b', 'Se2S -2 2.21 0.37e', 'Se2Se-2 2.33 0.37e',
     2 'Se4O -2 1.8110.37a', 'Se4F -1 1.73 0.37b', 'Se4Cl-1 2.22 0.37b',
     3 'Se4Br-1 2.43 0.37e', 'Se6O -2 1.7880.37a', 'Se6F -1 1.69 0.37b',
     4 'Se6Cl-1 2.16 0.37b', 'Se6N -3 1.90 0.35e', 'Se9Br-1 2.33 0.37b',
     5 'Se9I -1 2.54 0.37b', 'Se9S -2 2.25 0.37b', 'Se9Se-2 2.36 0.37b',
     6 'Se9Te-2 2.55 0.37b', 'Se9P -3 2.34 0.37b', 'Se9As-3 2.42 0.37b',
     7 'Se9H -1 1.54 0.37b', 'Si4O -2 1.6240.37b', 'Si4O -2 1.6400.37a'/
      DATA (VALENCE(I), I = 1256, 1360)/
     8 'Si4S -2 2.1260.37a', 'Si4Se-2 2.26 0.37b', 'Si4Te-2 2.49 0.37b',
     9 'Si4F -1 1.58 0.37b', 'Si4Cl-1 2.03 0.37b', 'Si4Br-1 2.20 0.37b',
     * 'Si4I -1 2.41 0.37b', 'Si4C -4 1.8830.37a', 'Si4N -3 1.7240.37a',
     1 'Si4N -3 1.77 0.37b', 'Si4P -3 2.23 0.37b', 'Si4As-3 2.31 0.37b',
     2 'Si4H -1 1.47 0.37b', 'Sm3O -2 2.0880.37b', 'Sm3O -2 2.0630.37a',
     3 'Sm3S -2 2.55 0.37b', 'Sm3Se-2 2.67 0.37b', 'Sm3Te-2 2.86 0.37b',
     4 'Sm3F -1 1.94 0.40p', 'Sm3F -1 2.00 0.37e', 'Sm3Cl-1 1.9770.37b',
     5 'Sm3Cl-1 2.43 0.40p', 'Sm3Br-1 2.66 0.37b', 'Sm3Br-1 2.58 0.40p',
     6 'Sm3I -1 2.84 0.37b', 'Sm3I -1 2.80 0.40p', 'Sm3N -3 2.24 0.37b',
     7 'Sm3P -3 2.63 0.37b', 'Sm3As-3 2.70 0.37b', 'Sm3H -1 1.96 0.37b',
     8 'Sn2O -2 1.94 0.37b', 'Sn2S -2 2.44 0.37e', 'Sn2F -1 1.9250.37a',
     9 'Sn2Cl-1 2.41 0.37e', 'Sn3Cl-1 2.36 0.37b', 'Sn2Br-1 2.53 0.35d',
     * 'Sn2I -1 2.81 0.37e', 'Sn2N -3 2.03 0.35e', 'Sn4O -2 1.9050.37a',
     1 'Sn4S -2 2.3990.37a', 'Sn4Se-2 2.51 0.37e', 'Sn4F -1 1.8430.37a',
     2 'Sn4Cl-1 2.2760.37a', 'Sn4Br-1 2.40 0.37e', 'Sn4N -3 2.03 0.35e',
     3 'Sn9Br-1 2.55 0.37b', 'Sn9I -1 2.76 0.37b', 'Sn9S -2 2.39 0.37a',
     4 'Sn9S -2 2.45 0.37b', 'Sn9Se-2 2.59 0.37b', 'Sn9Te-2 2.76 0.37b',
     5 'Sn9N -3 2.06 0.37a', 'Sn9N -3 2.14 0.37b', 'Sn9P -3 2.45 0.37b',
     6 'Sn9As-3 2.62 0.37b', 'Sn9H -1 1.85 0.37b', 'Sr2O -2 2.1180.37a',
     7 'Sr2S -2 2.59 0.37b', 'Sr2S -2 2.65 0.37e', 'Sr2Se-2 2.72 0.37b',
     8 'Sr2Te-2 2.87 0.37b', 'Sr2Te-2 2.06 0.37e', 'Sr2F -1 2.0190.37b',
     9 'Sr2Cl-1 2.51 0.37b', 'Sr2Br-1 2.68 0.37b', 'Sr2I -1 2.88 0.37b',
     * 'Sr2N -3 2.23 0.37b', 'Sr2P -3 2.67 0.37b', 'Sr2As-3 2.76 0.37b',
     1 'Sr2H -1 2.01 0.37b', 'Ta4O -2 2.29 0.37e', 'Ta5O -2 1.9200.37a',
     2 'Ta5S -2 2.47 0.37e', 'Ta5F -1 1.88 0.37b', 'Ta5Cl-1 2.30 0.37b',
     3 'Ta9Br-1 2.45 0.37b', 'Ta9I -1 2.66 0.37b', 'Ta9S -2 2.39 0.37b',
     4 'Ta9Se-2 2.51 0.37b', 'Ta9Te-2 2.70 0.37b', 'Ta9N -3 2.01 0.37b',
     5 'Ta9P -3 2.47 0.37b', 'Ta9As-3 2.55 0.37b', 'Ta9H -1 1.76 0.37b',
     6 'Tb3O -2 2.0320.37a', 'Tb3O -2 2.0490.37b', 'Tb3O -2 2.0130.37a',
     7 'Tb3S -2 2.51 0.37b', 'Tb3Se-2 2.63 0.37b', 'Tb3Te-2 2.82 0.37b',
     8 'Tb3F -1 1.9360.37b', 'Tb3F -1 1.90 0.40p', 'Tb3Cl-1 2.4270.37b',
     9 'Tb3Cl-1 2.39 0.40p', 'Tb3Br-1 2.58 0.37b', 'Tb3Br-1 2.54 0.40p',
     * 'Tb3I -1 2.80 0.37b', 'Tb3I -1 2.77 0.40p', 'Tb3N -3 2.20 0.37b',
     1 'Tb3P -3 2.59 0.37b', 'Tb3As-3 2.66 0.37b', 'Tb3H -1 1.91 0.37b',
     2 'Tc4F -1 1.88 0.40p', 'Tc4Cl-1 2.21 0.37e', 'Tc7O -2 1.90 0.37e'/
      DATA (VALENCE(I), I = 1361, 1465)/
     3 'Te4O -2 1.9770.37a', 'Te4S -2 2.44 0.37e', 'Te4F -1 1.87 0.37b',
     4 'Te4Cl-1 2.37 0.37b', 'Te4Br-1 2.55 0.37e', 'Te4I -1 2.7870.37e',
     5 'Te6O -2 1.9170.37a', 'Te6F -1 1.82 0.37b', 'Te6Cl-1 2.30 0.37b',
     6 'Te9Br-1 2.53 0.37b', 'Te9I -1 2.76 0.37b', 'Te9S -2 2.45 0.37b',
     7 'Te9Se-2 2.53 0.37b', 'Te9Te-2 2.76 0.37b', 'Te9N -3 2.12 0.37b',
     8 'Te9P -3 2.52 0.37b', 'Te9As-3 2.60 0.37b', 'Te9H -1 1.83 0.37b',
     9 'Th4O -2 2.1670.37b', 'Th4O -2 2.18 0.35p', 'Th4S -2 2.64 0.37b',
     * 'Th4Se-2 2.76 0.37b', 'Th4Te-2 2.94 0.37b', 'Th4F -1 2.0680.37a',
     1 'Th4F -1 2.05 0.40p', 'Th4Cl-1 2.55 0.37b', 'Th4Cl-1 2.52 0.40p',
     2 'Th4Br-1 2.71 0.37b', 'Th4Br-1 2.68 0.40p', 'Th4I -1 2.93 0.37b',
     3 'Th4I -1 2.92 0.40p', 'Th4I -1 2.96 0.37e', 'Th4N -3 2.34 0.37b',
     4 'Th4P -3 2.73 0.37b', 'Th4As-3 2.80 0.37b', 'Th4H -1 2.07 0.37b',
     5 'Ti2F -1 2.15 0.37e', 'Ti2Cl-1 2.31 0.37e', 'Ti2Br-1 2.49 0.37e',
     6 'Ti3O -2 1.7910.37b', 'Ti3S -2 2.11 0.37e', 'Ti3F -1 1.7230.37b',
     7 'Ti3Cl-1 2.22 0.37e', 'Ti3Cl-1 2.17 0.37b', 'Ti3I -1 2.52 0.37e',
     8 'Ti4O -2 1.8150.37a', 'Ti4O -2 1.78 0.43o', 'Ti4S -2 2.29 0.37e',
     9 'Ti4F -1 1.76 0.37b', 'Ti4Cl-1 2.19 0.37b', 'Ti4Br-1 2.36 0.37e',
     * 'Ti9O -2 1.7900.37k', 'Ti9Cl-1 2.1840.37k', 'Ti9Br-1 2.32 0.37b',
     1 'Ti9I -1 2.54 0.37b', 'Ti9S -2 2.24 0.37b', 'Ti9Se-2 2.38 0.37b',
     2 'Ti9Te-2 2.60 0.37b', 'Ti9N -3 1.93 0.37b', 'Ti9N -3 1.9060.37k',
     3 'Ti9P -3 2.36 0.37b', 'Ti9As-3 2.42 0.37b', 'Ti9H -1 1.61 0.37b',
     4 'Tl1O -2 2.1240.37a', 'Tl1O -2 2.1720.37b', 'Tl1O -2 1.9270.50a',
     5 'Tl1S -2 2.5450.37a', 'Tl1F -1 2.15 0.37b', 'Tl1Cl-1 2.56 0.37b',
     6 'Tl1Cl-1 2.61 0.37e', 'Tl1Br-1 2.69 0.37e', 'Tl1I -1 2.8220.37a',
     7 'Tl3O -2 2.0030.37b', 'Tl3F -1 1.88 0.37b', 'Tl3Cl-1 2.32 0.37b',
     8 'Tl3Br-1 2.65 0.35e', 'Tl9Br-1 2.70 0.37b', 'Tl9I -1 2.91 0.37b',
     9 'Tl9S -2 2.63 0.37b', 'Tl9Se-2 2.70 0.37b', 'Tl9Te-2 2.93 0.37b',
     * 'Tl9N -3 2.29 0.37b', 'Tl9P -3 2.71 0.37b', 'Tl9As-3 2.79 0.37b',
     1 'Tl9H -1 2.05 0.37b', 'Tm3O -2 2.0000.37b', 'Tm3O -2 1.9680.37a',
     2 'Tm3O -2 1.93 0.37e', 'Tm3S -2 2.45 0.37b', 'Tm3Se-2 2.58 0.37b',
     3 'Tm3Te-2 2.77 0.37b', 'Tm3F -1 1.8420.37b', 'Tm3F -1 1.86 0.40p',
     4 'Tm3F -1 1.91 0.37e', 'Tm3Cl-1 2.38 0.37b', 'Tm3Cl-1 2.35 0.40p',
     5 'Tm3Br-1 2.53 0.37b', 'Tm3Br-1 2.50 0.40p', 'Tm3I -1 2.74 0.37b',
     6 'Tm3I -1 2.74 0.40p', 'Tm3N -3 2.14 0.37b', 'Tm3P -3 2.53 0.37b',
     7 'Tm3As-3 2.62 0.37b', 'Tm3H -1 1.85 0.37b', 'U 2O -1 2.08 0.37e'/
      DATA (VALENCE(I), I = 1466, 1567)/
     8 'U 3S -2 2.54 0.37e', 'U 3F -1 2.02 0.40p', 'U 3F -1 2.09 0.37e',
     9 'U 3Cl-1 2.49 0.40p', 'U 3Br-1 2.64 0.40p', 'U 3I -1 2.87 0.40p',
     * 'U 4O -2 2.1120.37b', 'U 4O -2 2.13 0.35p', 'U 4S -2 2.55 0.37e',
     1 'U 4F -1 2.0380.37a', 'U 4F -1 2.0340.37b', 'U 4F -1 2.00 0.40p',
     2 'U 4Cl-1 2.47 0.40p', 'U 4Br-1 2.60 0.40p', 'U 4Br-1 2.61 0.37e',
     3 'U 4I -1 2.88 0.37e', 'U 4N -3 2.18 0.37e', 'U 5O -2 2.0750.37b',
     4 'U 5O -2 2.10 0.35p', 'U 5F -1 1.9660.37b', 'U 5F -1 1.99 0.40p',
     5 'U 5Cl-1 2.46 0.37b', 'U 5Cl-1 2.43 0.40p', 'U 5Br-1 2.7  0.35e',
     6 'U 6O -2 2.0510.51r', 'U 6O -2 2.0750.37a', 'U 6O -2 2.08 0.35p',
     7 'U 6F -1 1.98 0.40p', 'U 6Cl-1 2.42 0.40p', 'U 6N -3 1.93 0.35e',
     8 'U 9Br-1 2.63 0.37b', 'U 9I -1 2.84 0.37b', 'U 9S -2 2.56 0.37b',
     9 'U 9Se-2 2.70 0.37b', 'U 9Te-2 2.86 0.37b', 'U 9N -3 2.24 0.37b',
     * 'U 9P -3 2.64 0.37b', 'U 9As-3 2.72 0.37b', 'U 9H -1 1.97 0.37b',
     1 'V 1O -2 1.88 0.37e', 'V 1Cl-1 2.00 0.35e', 'V 2O -2 1.70 0.37e',
     2 'V 2S -2 2.11 0.37e', 'V 2F -1 2.16 0.37e', 'V 2Cl-1 2.44 0.37e',
     3 'V 3O -2 1.7430.37a', 'V 3O -2 1.7490.37j', 'V 3S -2 2.17 0.37e',
     4 'V 3S -2 2.1850.37j', 'V 3F -1 1.7020.37b', 'V 3Cl-1 2.19 0.37b',
     5 'V 3Br-1 2.33 0.35e', 'V 3N -3 1.8130.37j', 'V 3N -3 1.84 0.35e',
     6 'V 4O -2 1.7840.37a', 'V 4O -2 1.7800.37j', 'V 4O -2 1.7350.37j',
     7 'V 4S -2 2.2260.37j', 'V 4S -2 2.1810.37j', 'V 4S -2 2.24 0.37e',
     8 'V 4F -1 1.70 0.37b', 'V 4Cl-1 2.16 0.37b', 'V 4N -3 1.8750.37j',
     9 'V 5O -2 1.8030.37a', 'V 5O -2 1.7990.37x', 'V 5S -2 2.25 0.37e',
     * 'V 5F -1 1.70 0.37e', 'V 5Cl-1 2.16 0.37b', 'V 9O -2 1.81 0.34o',
     1 'V 9Br-1 2.30 0.37b', 'V 9I -1 2.51 0.37b', 'V 9S -2 2.23 0.37b',
     2 'V 9Se-2 2.33 0.37b', 'V 9Te-2 2.57 0.37b', 'V 9N -3 1.86 0.37b',
     3 'V 9P -3 2.31 0.37b', 'V 9As-3 2.39 0.37b', 'V 9H -1 1.58 0.37b',
     4 'W 5O -2 1.89 0.37e', 'W 6O -2 1.9170.37a', 'W 6O -2 1.9160.41x',
     5 'W 6O -2 1.9210.37b', 'W 6F -1 1.83 0.37b', 'W 6Cl-1 2.27 0.37b',
     6 'W 9Br-1 2.45 0.37b', 'W 9I -1 2.66 0.37b', 'W 9S -2 2.39 0.37b',
     7 'W 9Se-2 2.51 0.37b', 'W 9Te-2 2.71 0.37b', 'W 9N -3 2.06 0.37b',
     8 'W 9P -3 2.46 0.37b', 'W 9As-3 2.54 0.37b', 'W 9H -1 1.76 0.37b',
     9 'Xe2O -2 2.05 0.35e', 'Xe2F -1 2.02 0.37e', 'Xe4F -1 1.93 0.37e',
     * 'Xe6O -2 2.00 0.37e', 'Xe6F -1 1.89 0.37e', 'Xe8O -2 1.94 0.37e',
     1 'Y 3O -2 2.0190.37a', 'Y 3O -2 2.0140.37b', 'Y 3S -2 2.48 0.37b'/
      DATA (VALENCE(I), I = 1568, NP53)/
     2 'Y 3Se-2 2.61 0.37b', 'Y 3Te-2 2.80 0.37b', 'Y 3F -1 1.9040.37b',
     3 'Y 3F -1 1.87 0.37e', 'Y 3Cl-1 2.40 0.37b', 'Y 3Br-1 2.55 0.37b',
     4 'Y 3I -1 2.77 0.37b', 'Y 3N -3 2.17 0.37b', 'Y 3P -3 2.57 0.37b',
     5 'Y 3As-3 2.64 0.37b', 'Y 3H -1 1.86 0.37b', 'Yb3O -2 1.9650.37a',
     6 'Yb3O -2 1.9850.37b', 'Yb3O -2 1.9540.37a', 'Yb3S -2 2.43 0.37b',
     7 'Yb3Se-2 2.56 0.37b', 'Yb3Te-2 2.76 0.37b', 'Yb3F -1 1.8750.37b',
     8 'Yb3F -1 1.85 0.40p', 'Yb3F -1 1.90 0.37e', 'Yb3Cl-1 2.3710.37b',
     9 'Yb3Cl-1 2.34 0.40p', 'Yb3Br-1 2.4510.37b', 'Yb3Br-1 2.49 0.40p',
     * 'Yb3I -1 2.72 0.37b', 'Yb3I -1 2.74 0.40p', 'Yb3N -3 2.12 0.37b',
     1 'Yb3P -3 2.53 0.37b', 'Yb3As-3 2.59 0.37b', 'Yb3H -1 1.82 0.37b',
     2 'Zn2O -2 1.7040.37a', 'Zn2O -2 1.6750.39o', 'Zn2S -2 2.09 0.37b',
     3 'Zn2Se-2 2.22 0.37b', 'Zn2Te-2 2.45 0.37b', 'Zn2F -1 1.62 0.37b',
     4 'Zn2F -1 1.67 0.37e', 'Zn2Cl-1 2.01 0.37b', 'Zn2Br-1 2.15 0.37b',
     5 'Zn2I -1 2.36 0.37b', 'Zn2N -3 1.72 0.37e', 'Zn2P -3 2.15 0.37b',
     6 'Zn2As-3 2.24 0.37b', 'Zn2H -1 1.42 0.37b', 'Zr2O -2 2.34 0.37e',
     7 'Zr2F -1 2.24 0.37e', 'Zr2Cl-1 2.58 0.37e', 'Zr4C -4 2.03 0.37*',
     8 'Zr4O -2 1.9280.37a',
     8 'Zr4O -2 1.9370.37b', 'Zr4S -2 2.41 0.37b', 'Zr4Se-2 2.53 0.37b',
     9 'Zr4Te-2 2.67 0.37b', 'Zr4F -1 1.8460.37a', 'Zr4F -1 1.8540.37b',
     * 'Zr4Cl-1 2.33 0.37b', 'Zr4Br-1 2.48 0.37b', 'Zr4I -1 2.69 0.37b',
     1 'Zr4N -3 2.11 0.37b', 'Zr4N -3 2.15 0.37e', 'Zr4P -3 2.52 0.37b',
     2 'Zr4As-3 2.57 0.37b', 'Zr4H -1 1.79 0.37b'/
C * KEYWORDS (PLATON)
      DATA (ISWS(I), I = 1, NP24) /
     1         'TITL', 'MESS', 'REM ', 'ANGS', 'ROUN', 'FIT ', 'LSPL',
     2 'RING', 'NOMO', 'PSID', 'DOAC', 'LINE', 'ENDS', 'PLOT', 'YES ',
     3 'NO  ', 'CALC', 'END ', 'INCL', 'EXCL', 'STOP', 'HELP', 'SAVE',
     4 'UIJ ', 'SUIJ', 'U   ', 'ATOM', 'LIST', 'CELL', 'CESD', 'SYMM',
     5 'SPGR', 'LATT', 'DIST', 'ANGL', 'TORS', 'HBON', 'BIJ ', 'SBIJ',
     6 'B   ', 'TRNS', 'FVAR', 'PARE', 'QUIT', 'SET ', 'AFIX', 'SFAC',
     7 'UNIT', 'WGHT', 'VIEW', 'BOX ', 'EXIT', 'BOND', 'ZERR', 'GEOM',
     8 'L   ', 'FMAP', 'INFO', 'TABL', 'RADI', 'BLOC', 'MENU', 'OMIT',
     9 'GRID', 'DFIX', 'JOIN', 'DETA', 'DEFI', 'HKLF', 'RADN', 'TRMX',
     * 'PART', 'INOR', 'ORGA', 'RTAB', 'SIMU', 'ENTR', 'ELLI', 'ORMA',
     1 'EXTI', 'SETU', 'EXOR', 'ABSG', 'FACE', 'ABST', 'ABSX', 'LEPA',
     2 'ASYM', 'ABSP', 'ABSS', 'CONT', 'REST', 'VALI', 'EXPT', 'PLUT',
     3 'MOLE', 'PLAN', 'TWIN', 'SPEC', 'MERG', 'SUMP', 'RESI', 'SHEL',
     4 'MORE', 'TIME', 'CGLS', 'ACTA', 'DAMP', 'DISP', 'SLIM', 'SIZE',
     5 'EQIV', 'EXYZ', 'EADP', 'BOND', 'FREE', 'BIND', 'SAME', 'CONF',
     6 'MPLA', 'FLAT', 'CHIV', 'DELU', 'ISOR', 'SADI', 'ANIS', 'CONN',
     7 'HFIX', 'LAUE', 'BUMP', 'TEMP', 'DEFS', 'ABSC', 'SWAT', 'EMPI',
     8 'LAMI', 'HOPE', 'DMAT', 'SKIP', 'WPDB', 'BASF', 'MOVE', 'FRAG',
     9 'FEND', 'HALL', 'HTAB', 'MULA', 'HKLT', 'XTAL', 'HINC', 'HEXC',
     * 'FILE', 'RENA', 'SYST', 'DELR', 'EXP1', 'ARU ', 'VARI', 'FCF2',
     1 'PORT', 'POWD', 'FSUM', 'SCAL', 'CRYS', 'ROTM', 'CAVI', 'SHXA',
     2 'DELE', 'COLO', 'RESE', 'SCAT', 'STID', 'BIJV', 'FLIP', 'STRU',
     3 'FROM', 'STRA', 'CELA', 'CELB', 'CSUA', 'CSUB', 'CIF2', 'NOEX',
     4 'RESD', 'ANOM', 'MU  ', 'XTPL', 'ABIN', 'ANSC', 'ANSR', 'NEUT',
     5 'PRIG', 'RIGU', 'STIR', 'TWST', 'WIGL', 'XNPD', 'HYBR', 'BYPA',
     6 'DANG', '    ', '    ', '    ', '    ', '    ', '    ', '    '/
      DATA (ISWS(I), I = NP24 + 1, NP22) /
     1 'GEOM', 'TMA ', 'INTR', 'INTE', 'NOTM', 'NOAN', 'NOTO', 'NOLS',
     2 'NOST', 'NORI', 'NOBO', 'NOMO', 'NOSY', 'NOBP', 'EWLS', 'TOLA',
     3 'COOR', 'META', 'AWLS', 'HBON', 'UWLS', 'SHEL', 'OMEG', '    ',
     4 'SPF ', 'FIVE', 'ALL ', 'TOLP', 'TOLR', 'NOTH', 'VOID', 'PROB',
     5 'PSTE', 'LIST', 'EXPA', 'DIST', 'TOLE', 'MISS', 'SOLV', 'TOLM',
     6 'NODI', 'BOND', 'ANGL', 'TORS', 'CSD ', 'SQUE', 'SAR ', 'FCF ',
     7 'DIFA', 'NEWS', 'NOCH', 'PDB ', 'HINC', 'NONS', 'NONA', 'MAXD',
     8 'WLSP', 'FCAL', 'ADDS', 'DELA', 'NOSO', 'DISO', 'GENE', 'EXPE',
     9 'MAXR', 'MOLS', 'RENU', 'PLOT', 'RDF ', 'GRID', 'F3D ', 'NOSF',
     * 'CYCL', 'DIFF', 'ICHX', '    ', '    ', '    ', '    ', '    '/
      DATA (((TRNSX (I, J, K), I = 1, 3), J = 1, 3), K = 1, 15)/
     1  1,   0,   0,   0,   1,   0,   0,   0,   1,
     2  1,   0,   0,   0,   1,   0.5, 0,   0,   0.5,
     3  0.5, 0,   0,   0,   1,   0,   0.5, 0,   1,
     4  1,   0.5, 0,   0,   0.5, 0,   0,   0,   1,
     5  0.5, 0.5, 0,   0,   0.5, 0.5, 0.5, 0,   0.5,
     6  1,   0,   0.5, 0,   1,   0.5, 0,   0,   0.5,
     7  0.666667, -0.333333, -0.333333, 0.333333, 0.333333, -0.666667,
     8  0.333333,  0.333333,  0.333333,
     9  0,   1, 0, 1,   0, 0, 0, 0,-1,
     * -1,   0, 0, 0,   0, 1, 0, 1, 0,
     1  0,   0, 0, 0,   0, 0, 0, 0, 0,
     2  0,   0, 0, 0,   0, 0, 0, 0, 0,
     3  1,   0, 0, 0,   1, 0, 0, 0, 1,
     4  1,   0, 0, 0,   1, 0, 0, 0, 1,
     5  1,   0, 0, 0,   1, 0, 0, 0, 1,
     6  1,   0, 1, 0,   1, 1, 0, 0, 1/
C * SUPERLAT1:
      DATA ((TRNSX(I, J, 16), I = 1, 3), J = 1, 3)/
     1  1, 0, 0, 0, 1, 0, 0, 0, 1/
C * SUPERLAT2: SANTORO & MIGHELL, ACTA CRYST (1972),A28,284-287
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 17, 23)/
     1  2.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     2  1.0, 0.0, 0.0, 0.0, 2.0, 0.0, 0.0, 0.0, 1.0,
     3  1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 2.0,
     4  2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     5  2.0, 0.0, 0.0, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0,
     6  1.0, 0.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0,
     7  1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.0, 1.0/
C * SUPERLAT3:
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 24, 36)/
     1  3.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     2  1.0, 0.0, 0.0, 0.0, 3.0, 0.0, 0.0, 0.0, 1.0,
     3  1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 3.0,
     4  1.0,-1.0, 0.0, 2.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     5  1.0, 1.0, 0.0,-2.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     6 -1.0, 0.0, 1.0, 2.0, 0.0, 1.0, 0.0, 1.0, 0.0,
     7  1.0, 0.0, 1.0, 2.0, 0.0,-1.0, 0.0, 1.0, 0.0,
     8  0.0, 1.0,-1.0, 0.0, 2.0, 1.0, 1.0, 0.0, 0.0,
     9  0.0, 1.0, 1.0, 0.0,-2.0, 1.0, 1.0, 0.0, 0.0,
     *  2.0, 1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0,
     1  1.0, 2.0, 1.0,-1.0,-1.0, 0.0, 2.0, 0.0, 1.0,
     2  1.0, 1.0, 2.0, 1.0, 0.0, 1.0, 2.0, 1.0, 0.0,
     3  1.0, 1.0, 1.0, 1.0, 2.0, 0.0, 0.0, 2.0, 1.0/
C * SUPERLAT4:
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 37, 54)/
     1  4.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     2  1.0, 0.0, 0.0, 0.0, 4.0, 0.0, 0.0, 0.0, 1.0,
     3  1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 4.0,
     4  4.0, 0.0, 0.0, 3.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     5  4.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     6  4.0, 0.0, 0.0, 0.0, 1.0, 0.0, 3.0, 0.0, 1.0,
     7  4.0, 0.0, 0.0, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0,
     8  1.0, 0.0, 0.0, 0.0, 1.0, 3.0, 0.0, 0.0, 4.0,
     9  1.0, 0.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 4.0,
     *  4.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     1  4.0, 0.0, 0.0, 0.0, 1.0, 0.0, 2.0, 0.0, 1.0,
     2  1.0, 0.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, 2.0,
     3  2.0, 0.0, 0.0, 1.0, 2.0, 0.0, 0.0, 0.0, 1.0,
     4  2.0, 0.0, 0.0, 0.0, 1.0, 0.0, 1.0, 0.0, 2.0,
     5  1.0, 0.0, 0.0, 0.0, 1.0, 2.0, 0.0, 0.0, 4.0,
     6  2.0, 2.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.0, 1.0,
     7  1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 2.0, 0.0, 2.0,
     8  1.0, 1.0, 0.0, 0.0, 2.0, 2.0, 1.0, 0.0, 1.0/
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 55, 71)/
     1  1.0, 2.0, 1.0, 1.0, 1.0, 2.0, 2.0, 1.0, 1.0,
     2  3.0, 1.0, 0.0, 1.0, 1.0, 1.0, 2.0, 0.0, 1.0,
     3  4.0, 0.0, 0.0, 1.0, 1.0, 0.0, 2.0, 0.0, 1.0,
     4  2.0, 1.0, 0.0, 1.0, 1.0, 1.0, 3.0, 0.0, 1.0,
     5  4.0, 0.0, 0.0, 2.0, 1.0, 0.0, 1.0, 0.0, 1.0,
     6  1.0, 1.0, 1.0, 0.0, 1.0, 3.0, 1.0, 0.0, 2.0,
     7  2.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.0, 2.0,
     8  2.0, 1.0, 0.0, 0.0, 1.0, 1.0, 2.0, 0.0, 1.0,
     9  1.0, 2.0, 0.0, 0.0, 2.0, 1.0, 1.0, 0.0, 1.0,
     *  1.0, 1.0, 0.0, 0.0, 1.0, 2.0, 1.0, 0.0, 2.0,
     1  2.0, 0.0, 0.0, 0.0, 2.0, 0.0, 0.0, 0.0, 1.0,
     2  2.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 2.0,
     3  1.0, 0.0, 0.0, 0.0, 2.0, 0.0, 0.0, 0.0, 2.0,
     4  2.0, 0.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0,
     5  2.0, 0.0, 0.0, 0.0, 2.0, 0.0, 1.0, 0.0, 1.0,
     6  2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0.0, 2.0,
     7  2.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.0, 0.0, 2.0/
C * SUBLAT1:
      DATA ((TRNSX(I, J, 72), J = 1, 3), I = 1, 3)/
     1  1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0/
C * SUBLAT2:
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 73, 79)/
     1  0.5, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     2  1.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 1.0,
     3  1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.5,
     4  0.5,-0.5, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     5  0.5, 0.0,-0.5, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     6  1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0,-0.5, 0.5,
     7  0.5, 0.5,-0.5,-0.5, 0.5, 0.5, 0.5,-0.5, 0.5/
C * SUBLAT3:
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 80, 92)/
     1 0.33333, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0,
     2 1.0, 0.0, 0.0, 0.0, 0.33333, 0.0, 0.0, 0.0, 1.0,
     3 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.33333,
     4 0.33333, -0.66667, 0.0, 0.33333, 0.33333, 0.0, 0.0, 0.0, 1.0,
     5 0.33333, 0.66667, 0.0, -0.33333, 0.33333, 0.0, 0.0, 0.0, 1.0,
     6-0.33333, 0.0, 0.66667, 0.33333, 0.0, 0.33333, 0.0, 1.0, 0.0,
     7 0.33333, 0.0, 0.66667, 0.33333, 0.0, -0.33333, 0.0, 1.0, 0.0,
     8 0.0, 0.33333, -0.66667, 0.0, 0.33333, 0.33333, 1.0, 0.0, 0.0,
     9 0.0, 0.33333, 0.66667, 0.0, -0.33333, 0.33333, 1.0, 0.0, 0.0,
     * 0.33333, -0.33333, 0.66667, 0.33333, 0.66667,-1.33333,-0.33333,
     1 0.33333, 0.33333,
     3-0.33333, 0.33333, 0.66667,-0.66667,-0.33333, 1.33333, 0.33333,
     4-0.33333, 0.33333,
     5 -0.33333, 0.66667, 0.33333, 0.66667,-1.33333, 0.33333, 0.33333,
     6 0.33333,-0.33333,
     7 0.66667,-0.33333, 0.66667, 0.33333, 0.33333, -0.66667,-0.66667,
     8 0.33333, 0.33333/
C * SUBLAT4:
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 93, 110)/
     1 0.25,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     2  1.0,  0.0,  0.0,  0.0, 0.25,  0.0,  0.0,  0.0,  1.0,
     3  1.0,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0, 0.25,
     4 0.25,-0.75,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     5 0.25,-0.25,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     6 0.25,  0.0,-0.75,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     7 0.25,  0.0,-0.25,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     8  1.0,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0,-0.75, 0.25,
     9  1.0,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0,-0.25, 0.25,
     * 0.25, -0.5,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     1 0.25,  0.0, -0.5,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     2  1.0,  0.0,  0.0,  0.0,  0.5,  0.0,  0.0,-0.25,  0.5,
     3  0.5,-0.25,  0.0,  0.0,  0.5,  0.0,  0.0,  0.0,  1.0,
     4  0.5,  0.0,-0.25,  0.0,  1.0,  0.0,  0.0,  0.0,  0.5,
     5  1.0,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0, -0.5, 0.25,
     6 0.25, 0.25,-0.25, -0.5,  0.5,  0.5,  0.5, -0.5,  0.5,
     7  0.5,  0.5, -0.5, -0.5,  0.5,-0.25, -0.5,  0.5, 0.25,
     8  0.5,  0.5, -0.5,-0.25, 0.25, 0.25,  0.5, -0.5,  0.5/
      DATA (((TRNSX(I, J, K), J = 1, 3), I = 1, 3), K = 111, 128)/
     1-0.25, 0.75,-0.25,-0.25,-0.25, 0.75, 0.75,-0.25,-0.25,
     2 0.25, 0.25, -0.5,-0.25, 0.75,  0.5, 0.25,-0.75,  0.5,
     3 0.25,-0.25, -0.5,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     4 0.25,  0.5,-0.75,-0.25,  0.5, 0.75, 0.25, -0.5, 0.25,
     5 0.25, -0.5,-0.25,  0.0,  1.0,  0.0,  0.0,  0.0,  1.0,
     6  0.5, 0.75,-0.25, -0.5, 0.25, 0.25,  0.5,-0.75, 0.25,
     7  0.5, 0.25,-0.25,  0.0,  1.0,  0.0,  0.0, -0.5,  0.5,
     8 0.25,  0.5, -0.5,-0.25,  0.5,  0.5, 0.25, -0.5,  0.5,
     9  0.5, 0.25, -0.5, -0.5, 0.25,  0.5,  0.5,-0.25,  0.5,
     *  0.5, -0.5,  0.5,  0.5,  0.5, -0.5,-0.25, 0.25, 0.25,
     1  0.5,  0.0,  0.0,  0.0,  0.5,  0.0,  0.0,  0.0,  1.0,
     2  0.5,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0,  0.5,
     3  1.0,  0.0,  0.0,  0.0,  0.5,  0.0,  0.0,  0.0,  0.5,
     4  0.5,  0.0,  0.0,  0.0,  1.0,  0.0,  0.0, -0.5,  0.5,
     5  0.5,  0.0, -0.5,  0.0,  0.5,  0.0,  0.0,  0.0,  1.0,
     6  0.5, -0.5,  0.0,  0.0,  1.0,  0.0,  0.0,  0.0,  0.5,
     7  0.5, -0.5,  0.0,  0.0,  1.0,  0.0,  0.0, -0.5,  0.5,
     8  0.5,  0.0,  0.0,  0.0,  0.5,  0.0,  0.0,  0.0,  0.5/
      DATA ROT/
     1  -1.0,-1.0, 0.0,  1.0, 0.0, 0.0,  0.0, 0.0,-1.0,  0.0, 0.0, 0.0,
     2   0.0, 0.0, 2.0,  0.0,-1.0, 0.0,  1.0, 1.0, 0.0,  0.0, 0.0,-1.0,
     3   0.0, 0.0, 0.0,  0.0, 0.0, 4.0,  0.0,-1.0, 0.0,  1.0, 0.0, 0.0,
     4   0.0, 0.0,-1.0,  0.0, 0.0, 0.0,  0.0, 0.0, 3.0, -1.0, 0.0, 0.0,
     5   0.0,-1.0, 0.0,  0.0, 0.0, 1.0,  0.0, 0.0, 6.0,  6.0, 6.0, 0.0,
     6  -1.0, 0.0, 0.0,  0.0,-1.0, 0.0,  0.0, 0.0,-1.0,  0.0, 0.0, 0.0,
     7   0.0, 0.0, 0.0/
      DATA (CIFDIR(I), I = 1, 18) /
     1 '_atom_site_aniso_label                           ',
     2 '_atom_site_aniso_type_symbol                     ',
     3 '_atom_site_aniso_U_11                            ',
     4 '_atom_site_aniso_U_12                            ',
     5 '_atom_site_aniso_U_13                            ',
     6 '_atom_site_aniso_U_22                            ',
     7 '_atom_site_aniso_U_23                            ',
     8 '_atom_site_aniso_U_33                            ',
     9 '_atom_site_attached_hydrogens                    ',
     * '_atom_site_calc_attached_atom                    ',
     1 '_atom_site_calc_flag                             ',
     2 '_atom_site_Cartn_x                               ',
     3 '_atom_site_Cartn_y                               ',
     4 '_atom_site_Cartn_z                               ',
     5 '_atom_site_chemical_conn_number                  ',
     6 '_atom_site_constraints                           ',
     7 '_atom_site_description                           ',
     8 '_atom_site_disorder_group                        '/
      DATA (CIFDIR(I), I = 19, 36) /
     1 '_atom_site_fract_x                               ',
     2 '_atom_site_fract_y                               ',
     3 '_atom_site_fract_z                               ',
     4 '_atom_site_label                                 ',
     5 '_atom_site_label_component_0                     ',
     6 '_atom_site_label_component_1                     ',
     7 '_atom_site_label_component_2                     ',
     8 '_atom_site_label_component_3                     ',
     9 '_atom_site_label_component_4                     ',
     * '_atom_site_label_component_5                     ',
     1 '_atom_site_label_component_6                     ',
     2 '_atom_site_occupancy                             ',
     3 '_atom_site_refinement_flags                      ',
     4 '_atom_site_restraints                            ',
     5 '_atom_site_symmetry_multiplicity                 ',
     6 '_atom_site_thermal_displace_type                 ',
     7 '_atom_site_type_symbol                           ',
     8 '_atom_site_U_iso_or_equiv                        '/
      DATA (CIFDIR(I), I = 37, 54) /
     1 '_atom_site_Wyckoff_symbol                        ',
     2 '_atom_sites_Cartn_tran_matrix_11                 ',
     3 '_atom_sites_Cartn_tran_matrix_12                 ',
     4 '_atom_sites_Cartn_tran_matrix_13                 ',
     5 '_atom_sites_Cartn_tran_matrix_21                 ',
     6 '_atom_sites_Cartn_tran_matrix_22                 ',
     7 '_atom_sites_Cartn_tran_matrix_23                 ',
     8 '_atom_sites_Cartn_tran_matrix_31                 ',
     9 '_atom_sites_Cartn_tran_matrix_32                 ',
     * '_atom_sites_Cartn_tran_matrix_33                 ',
     1 '_atom_sites_Cartn_transform_axes                 ',
     2 '_atom_sites_solution_primary                     ',
     3 '_atom_sites_solution_secondary                   ',
     4 '_atom_sites_solution_hydrogens                   ',
     5 '_atom_type_analytical_mass_%                     ',
     6 '_atom_type_description                           ',
     7 '_atom_type_number_in_cell                        ',
     8 '_atom_type_oxidation_number                      '/
      DATA (CIFDIR(I), I = 55, 72) /
     1 '_atom_type_radius_bond                           ',
     2 '_atom_type_radius_contact                        ',
     3 '_atom_type_scat_Cromer_Mann_a1                   ',
     4 '_atom_type_scat_Cromer_Mann_a2                   ',
     5 '_atom_type_scat_Cromer_Mann_a3                   ',
     6 '_atom_type_scat_Cromer_Mann_a4                   ',
     7 '_atom_type_scat_Cromer_Mann_b1                   ',
     8 '_atom_type_scat_Cromer_Mann_b2                   ',
     9 '_atom_type_scat_Cromer_Mann_b3                   ',
     * '_atom_type_scat_Cromer_Mann_b4                   ',
     1 '_atom_type_scat_Cromer_Mann_c                    ',
     2 '_atom_type_scat_dispersion_imag                  ',
     3 '_atom_type_scat_dispersion_real                  ',
     4 '_atom_type_scat_source                           ',
     5 '_atom_type_scat_versus_stol_list                 ',
     6 '_atom_type_symbol                                ',
     7 '_audit_creation_date                             ',
     8 '_audit_creation_method                           '/
      DATA (CIFDIR(I), I = 73, 90) /
     1 '_audit_update_record                             ',
     2 '_cell_angle_alpha                                ',
     3 '_cell_angle_beta                                 ',
     4 '_cell_angle_gamma                                ',
     5 '_cell_formula_units_Z                            ',
     6 '_cell_length_a                                   ',
     7 '_cell_length_b                                   ',
     8 '_cell_length_c                                   ',
     9 '_cell_measurement_pressure                       ',
     * '_cell_measurement_radiation                      ',
     1 '_cell_measurement_refln_index_h                  ',
     2 '_cell_measurement_refln_index_k                  ',
     3 '_cell_measurement_refln_index_l                  ',
     4 '_cell_measurement_refln_theta                    ',
     5 '_cell_measurement_reflns_used                    ',
     6 '_cell_measurement_temperature                    ',
     7 '_cell_measurement_theta_max                      ',
     8 '_cell_measurement_theta_min                      '/
      DATA (CIFDIR(I), I = 91, 108) /
     1 '_cell_measurement_wavelength                     ',
     2 '_cell_special_details                            ',
     3 '_cell_volume                                     ',
     4 '_chemical_compound_source                        ',
     5 '_chemical_conn_atom_charge                       ',
     6 '_chemical_conn_atom_display_x                    ',
     7 '_chemical_conn_atom_display_y                    ',
     8 '_chemical_conn_atom_NCA                          ',
     9 '_chemical_conn_atom_NH                           ',
     * '_chem_conn_atom_number                           ',
     1 '_chemical_conn_atom_type_symbol                  ',
     2 '_chemical_conn_bond_atom_1                       ',
     3 '_chemical_conn_bond_atom_2                       ',
     4 '_chemical_conn_bond_type                         ',
     5 '_chemical_formula_appendix                       ',
     6 '_chemical_formula_analytical                     ',
     7 '_chemical_formula_moiety                         ',
     8 '_chemical_formula_structural                     '/
      DATA (CIFDIR(I), I = 109, 126) /
     1 '_chemical_formula_sum                            ',
     2 '_chemical_formula_weight                         ',
     3 '_chemical_formula_weight_meas                    ',
     4 '_chemical_melting_point                          ',
     5 '_chemical_name_common                            ',
     6 '_chemical_name_mineral                           ',
     7 '_chemical_name_structure_type                    ',
     8 '_chemical_name_systematic                        ',
     9 '_computing_cell_refinement                       ',
     * '_computing_data_collection                       ',
     1 '_computing_data_reduction                        ',
     2 '_computing_molecular_graphics                    ',
     3 '_computing_publication_material                  ',
     4 '_computing_structure_refinement                  ',
     5 '_computing_structure_solution                    ',
     6 '_database_code_CAS                               ',
     7 '_database_code_CSD                               ',
     8 '_database_code_ICSD                              '/
      DATA (CIFDIR(I), I = 127, 144) /
     1 '_database_code_MDF                               ',
     2 '_database_code_NBS                               ',
     3 '_database_code_PDF                               ',
     4 '_database_journal_ASTM                           ',
     5 '_database_journal_CSD                            ',
     6 '_diffrn_ambient_pressure                         ',
     7 '_diffrn_ambient_temperature                      ',
     8 '_diffrn_attenuator_code                          ',
     9 '_diffrn_attenuator_scale                         ',
     * '_diffrn_measurement_device                       ',
     1 '_diffrn_measurement_method                       ',
     2 '_diffrn_orient_matrix_type                       ',
     3 '_diffrn_orient_matrix_UB_11                      ',
     4 '_diffrn_orient_matrix_UB_12                      ',
     5 '_diffrn_orient_matrix_UB_13                      ',
     6 '_diffrn_orient_matrix_UB_21                      ',
     7 '_diffrn_orient_matrix_UB_22                      ',
     8 '_diffrn_orient_matrix_UB_23                      '/
      DATA (CIFDIR(I), I = 145, 162) /
     1 '_diffrn_orient_matrix_UB_31                      ',
     2 '_diffrn_orient_matrix_UB_32                      ',
     3 '_diffrn_orient_matrix_UB_33                      ',
     4 '_diffrn_orient_refln_angle_chi                   ',
     5 '_diffrn_orient_refln_angle_kappa                 ',
     6 '_diffrn_orient_refln_angle_phi                   ',
     7 '_diffrn_orient_refln_angle_psi                   ',
     8 '_diffrn_orient_refln_index_h                     ',
     9 '_diffrn_orient_refln_index_k                     ',
     * '_diffrn_orient_refln_index_l                     ',
     1 '_diffrn_radiation_detector                       ',
     2 '_diffrn_radiation_detector_dtime                 ',
     3 '_diffrn_radiation_filter_edge                    ',
     4 '_diffrn_radiation_inhomogeneity                  ',
     5 '_diffrn_radiation_monochromator                  ',
     6 '_diffrn_radiation_polarisn_norm                  ',
     7 '_diffrn_radiation_polarisn_ratio                 ',
     8 '_diffrn_radiation_source                         '/
      DATA (CIFDIR(I), I = 163, 180) /
     1 '_diffrn_radiation_type                           ',
     2 '_diffrn_radiation_wavelength                     ',
     3 '_diffrn_radiation_wavelength_id                  ',
     4 '_diffrn_radiation_wavelength_wt                  ',
     5 '_diffrn_refln_angle_chi                          ',
     6 '_diffrn_refln_angle_kappa                        ',
     7 '_diffrn_refln_angle_omega                        ',
     8 '_diffrn_refln_angle_phi                          ',
     9 '_diffrn_refln_angle_psi                          ',
     * '_diffrn_refln_angle_theta                        ',
     1 '_diffrn_refln_attenuator_code                    ',
     2 '_diffrn_refln_counts_bg_1                        ',
     3 '_diffrn_refln_counts_bg_2                        ',
     4 '_diffrn_refln_counts_net                         ',
     5 '_diffrn_refln_counts_peak                        ',
     6 '_diffrn_refln_counts_total                       ',
     7 '_diffrn_refln_crystal_id                         ',
     8 '_diffrn_refln_detect_slit_horiz                  '/
      DATA (CIFDIR(I), I = 181, 198) /
     1 '_diffrn_refln_detect_slit_vert                   ',
     2 '_diffrn_refln_elapsed_time                       ',
     3 '_diffrn_refln_index_h                            ',
     4 '_diffrn_refln_index_k                            ',
     5 '_diffrn_refln_index_l                            ',
     6 '_diffrn_refln_intensity_net                      ',
     7 '_diffrn_refln_intensity_sigma                    ',
     8 '_diffrn_refln_scale_group_code                   ',
     9 '_diffrn_refln_scan_mode                          ',
     * '_diffrn_refln_scan_mode_backgd                   ',
     1 '_diffrn_refln_scan_width                         ',
     2 '_diffrn_refln_sinth/lambda                       ',
     3 '_diffrn_refln_standard_code                      ',
     4 '_diffrn_refln_wavelength                         ',
     5 '_diffrn_refln_wavelength_id                      ',
     6 '_diffrn_reflns_av_R_equivalents                  ',
     7 '_diffrn_reflns_av_sigmaI/netI                    ',
     8 '_diffrn_reflns_limit_h_max                       '/
      DATA (CIFDIR(I), I = 199, 216) /
     1 '_diffrn_reflns_limit_h_min                       ',
     2 '_diffrn_reflns_limit_k_max                       ',
     3 '_diffrn_reflns_limit_k_min                       ',
     4 '_diffrn_reflns_limit_l_max                       ',
     5 '_diffrn_reflns_limit_l_min                       ',
     6 '_diffrn_reflns_number                            ',
     7 '_diffrn_reflns_reduction_process                 ',
     8 '_diffrn_reflns_theta_max                         ',
     9 '_diffrn_reflns_theta_min                         ',
     * '_diffrn_reflns_trans_matrix_11                   ',
     1 '_diffrn_reflns_trans_matrix_12                   ',
     2 '_diffrn_reflns_trans_matrix_13                   ',
     3 '_diffrn_reflns_trans_matrix_21                   ',
     4 '_diffrn_reflns_trans_matrix_22                   ',
     5 '_diffrn_reflns_trans_matrix_23                   ',
     6 '_diffrn_reflns_trans_matrix_31                   ',
     7 '_diffrn_reflns_trans_matrix_32                   ',
     8 '_diffrn_reflns_trans_matrix_33                   '/
      DATA (CIFDIR(I), I = 217, 234) /
     1 '_diffrn_scale_group_code                         ',
     2 '_diffrn_scale_group_net                          ',
     3 '_diffrn_special_details                          ',
     4 '_diffrn_standard_refln_code                      ',
     5 '_diffrn_standard_refln_index_h                   ',
     6 '_diffrn_standard_refln_index_k                   ',
     7 '_diffrn_standard_refln_index_l                   ',
     8 '_diffrn_standards_decay_%                        ',
     9 '_diffrn_standards_interval_count                 ',
     * '_diffrn_standards_interval_time                  ',
     1 '_diffrn_standards_number                         ',
     2 '_diffrn_standards_scale_sigma                    ',
     3 '_exptl_absorpt_coefficient_mu                    ',
     4 '_exptl_absorpt_correction_T_max                  ',
     5 '_exptl_absorpt_correction_T_min                  ',
     6 '_exptl_absorpt_correction_type                   ',
     7 '_exptl_absorpt_process_details                   ',
     8 '_exptl_crystal_colour                            '/
      DATA (CIFDIR(I), I = 235, 252) /
     1 '_exptl_crystal_density_diffrn                    ',
     2 '_exptl_crystal_density_meas                      ',
     3 '_exptl_crystal_density_meas_temp                 ',
     4 '_exptl_crystal_density_method                    ',
     5 '_exptl_crystal_description                       ',
     6 '_exptl_crystal_F_000                             ',
     7 '_exptl_crystal_face_diffr_chi                    ',
     8 '_exptl_crystal_face_diffr_kappa                  ',
     9 '_exptl_crystal_face_diffr_phi                    ',
     * '_exptl_crystal_face_diffr_psi                    ',
     1 '_exptl_crystal_face_index_h                      ',
     2 '_exptl_crystal_face_index_k                      ',
     3 '_exptl_crystal_face_index_l                      ',
     4 '_exptl_crystal_face_perp_dist                    ',
     5 '_exptl_crystal_id                                ',
     6 '_exptl_crystal_preparation                       ',
     7 '_exptl_crystal_size_max                          ',
     8 '_exptl_crystal_size_mid                          '/
      DATA (CIFDIR(I), I = 253, 270) /
     1 '_exptl_crystal_size_min                          ',
     2 '_exptl_crystal_size_rad                          ',
     3 '_exptl_crystals_number                           ',
     4 '_exptl_special_details                           ',
     5 '_geom_angle                                      ',
     6 '_geom_angle_atom_site_label_1                    ',
     7 '_geom_angle_atom_site_label_2                    ',
     8 '_geom_angle_atom_site_label_3                    ',
     9 '_geom_angle_publ_flag                            ',
     * '_geom_angle_site_symmetry_1                      ',
     1 '_geom_angle_site_symmetry_2                      ',
     2 '_geom_angle_site_symmetry_3                      ',
     3 '_geom_bond_atom_site_label_1                     ',
     4 '_geom_bond_atom_site_label_2                     ',
     5 '_geom_bond_distance                              ',
     6 '_geom_bond_publ_flag                             ',
     7 '_geom_bond_site_symmetry_1                       ',
     8 '_geom_bond_site_symmetry_2                       '/
      DATA (CIFDIR(I), I = 271, 288) /
     1 '_geom_contact_atom_site_label_1                  ',
     2 '_geom_contact_atom_site_label_2                  ',
     3 '_geom_contact_distance                           ',
     4 '_geom_contact_publ_flag                          ',
     5 '_geom_contact_site_symmetry_1                    ',
     6 '_geom_contact_site_symmetry_2                    ',
     7 '_geom_special_details                            ',
     8 '_geom_torsion                                    ',
     9 '_geom_torsion_atom_site_label_1                  ',
     * '_geom_torsion_atom_site_label_2                  ',
     1 '_geom_torsion_atom_site_label_3                  ',
     2 '_geom_torsion_atom_site_label_4                  ',
     3 '_geom_torsion_publ_flag                          ',
     4 '_geom_torsion_site_symmetry_1                    ',
     5 '_geom_torsion_site_symmetry_2                    ',
     6 '_geom_torsion_site_symmetry_3                    ',
     7 '_geom_torsion_site_symmetry_4                    ',
     8 '_journal_coden_ASTM                              '/
      DATA (CIFDIR(I), I = 289, 306) /
     1 '_journal_coden_Cambridge                         ',
     2 '_journal_coeditor_address                        ',
     3 '_journal_coeditor_code                           ',
     4 '_journal_coeditor_email                          ',
     5 '_journal_coeditor_fax                            ',
     6 '_journal_coeditor_name                           ',
     7 '_journal_coeditor_notes                          ',
     8 '_journal_coeditor_phone                          ',
     9 '_journal_date_accepted                           ',
     * '_journal_date_from_coeditor                      ',
     1 '_journal_date_to_coeditor                        ',
     2 '_journal_date_printers_final                     ',
     3 '_journal_date_printers_first                     ',
     4 '_journal_date_proofs_in                          ',
     5 '_journal_date_proofs_out                         ',
     6 '_journal_date_recd_copyright                     ',
     7 '_journal_date_recd_electronic                    ',
     8 '_journal_date_recd_hard_copy                     '/
      DATA (CIFDIR(I), I = 307, 324) /
     1 '_journal_issue                                   ',
     2 '_journal_name_full                               ',
     3 '_journal_page_first                              ',
     4 '_journal_page_last                               ',
     5 '_journal_suppl_publ_number                       ',
     6 '_journal_suppl_publ_pages                        ',
     7 '_journal_techeditor_address                      ',
     8 '_journal_techeditor_code                         ',
     9 '_journal_techeditor_email                        ',
     * '_journal_techeditor_fax                          ',
     1 '_journal_techeditor_name                         ',
     2 '_journal_techeditor_notes                        ',
     3 '_journal_techeditor_phone                        ',
     4 '_journal_volume                                  ',
     5 '_journal_year                                    ',
     6 '_publ_author_address                             ',
     7 '_publ_author_name                                ',
     8 '_publ_contact_author                             '/
      DATA (CIFDIR(I), I = 325, 342) /
     1 '_publ_contact_author_email                       ',
     2 '_publ_contact_author_fax                         ',
     3 '_publ_contact_author_phone                       ',
     4 '_publ_contact_letter                             ',
     5 '_publ_manuscript_creation                        ',
     6 '_publ_manuscript_incl_extra_item                 ',
     7 '_publ_manuscript_incl_extra_info                 ',
     8 '_publ_manuscript_incl_extra_defn                 ',
     9 '_publ_manuscript_processed                       ',
     * '_publ_manuscript_text                            ',
     1 '_publ_requested_coeditor_name                    ',
     2 '_publ_requested_journal                          ',
     3 '_publ_section_title                              ',
     4 '_publ_section_abstract                           ',
     5 '_publ_section_comment                            ',
     6 '_publ_section_introduction                       ',
     7 '_publ_section_experimental                       ',
     8 '_publ_section_discussion                         '/
      DATA (CIFDIR(I), I = 343, 360) /
     1 '_publ_section_acknowledgements                   ',
     2 '_publ_section_references                         ',
     3 '_publ_section_figure_captions                    ',
     4 '_publ_section_table_legends                      ',
     5 '_refine_diff_density_max                         ',
     6 '_refine_diff_density_min                         ',
     7 '_refine_ls_abs_structure_details                 ',
     8 '_refine_ls_abs_structure_Flack                   ',
     9 '_refine_ls_abs_structure_Rogers                  ',
     * '_refine_ls_extinction_coef                       ',
     1 '_refine_ls_extinction_expression                 ',
     2 '_refine_ls_extinction_method                     ',
     3 '_refine_ls_goodness_of_fit_all                   ',
     4 '_refine_ls_goodness_of_fit_obs                   ',
     5 '_refine_ls_hydrogen_treatment                    ',
     6 '_refine_ls_matrix_type                           ',
     7 '_refine_ls_number_constraints                    ',
     8 '_refine_ls_number_parameters                     '/
      DATA (CIFDIR(I), I = 361, 378) /
     1 '_refine_ls_number_reflns                         ',
     2 '_refine_ls_number_restraints                     ',
     3 '_refine_ls_R_factor_all                          ',
     4 '_refine_ls_R_factor_obs                          ',
     5 '_refine_ls_restrained_S_all                      ',
     6 '_refine_ls_restrained_S_obs                      ',
     7 '_refine_ls_shift/esd_max                         ',
     8 '_refine_ls_shift/esd_mean                        ',
     9 '_refine_ls_structure_factor_coef                 ',
     * '_refine_ls_weighting_scheme                      ',
     1 '_refine_ls_wR_factor_all                         ',
     2 '_refine_ls_wR_factor_obs                         ',
     3 '_refine_special_details                          ',
     4 '_refln_A_calc                                    ',
     5 '_refln_A_meas                                    ',
     6 '_refln_B_calc                                    ',
     7 '_refln_B_meas                                    ',
     8 '_refln_crystal_id                                '/
      DATA (CIFDIR(I), I = 379, 396) /
     1 '_refln_F_calc                                    ',
     2 '_refln_F_meas                                    ',
     3 '_refln_F_sigma                                   ',
     4 '_refln_F_squared_calc                            ',
     5 '_refln_F_squared_meas                            ',
     6 '_refln_F_squared_sigma                           ',
     7 '_refln_index_h                                   ',
     8 '_refln_index_k                                   ',
     9 '_refln_index_l                                   ',
     * '_refln_intensity_calc                            ',
     1 '_refln_intensity_meas                            ',
     2 '_refln_intensity_sigma                           ',
     3 '_refln_mean_path_length_tbar                     ',
     4 '_refln_observed_status                           ',
     5 '_refln_phase_calc                                ',
     6 '_refln_phase_meas                                ',
     7 '_refln_refinement_status                         ',
     8 '_refln_scale_group_code                          '/
      DATA (CIFDIR(I), I = 397, 414) /
     1 '_refln_sint/lambda                               ',
     2 '_refln_symmetry_epsilon                          ',
     3 '_refln_symmetry_multiplicity                     ',
     4 '_refln_wavelength                                ',
     5 '_refln_wavelength_id                             ',
     6 '_reflns_d_resolution_high                        ',
     7 '_reflns_d_resolution_low                         ',
     8 '_reflns_limit_h_max                              ',
     9 '_reflns_limit_h_min                              ',
     * '_reflns_limit_k_max                              ',
     1 '_reflns_limit_k_min                              ',
     2 '_reflns_limit_l_max                              ',
     3 '_reflns_limit_l_min                              ',
     4 '_reflns_number_total                             ',
     5 '_reflns_number_observed                          ',
     6 '_reflns_observed_criterion                       ',
     7 '_reflns_scale_group_code                         ',
     8 '_reflns_scale_meas_F                             '/
      DATA (CIFDIR(I), I = 415, 422) /
     1 '_reflns_scale_meas_F_squared                     ',
     2 '_reflns_scale_meas_intensity                     ',
     3 '_reflns_special_details                          ',
     4 '_symmetry_cell_setting                           ',
     5 '_symmetry_equiv_pos_as_xyz                       ',
     6 '_symmetry_Int_Tables_number                      ',
     7 '_symmetry_space_group_name_Hall                  ',
     8 '_symmetry_space_group_name_H-M                   '/
      DATA (CIFDIR(I), I = 423, 440) /
     1 '_atom_site_B_iso_or_equiv                        ',
     2 '_publ_section_exptl_prep                         ',
     3 '_publ_section_exptl_refinement                   ',
     4 '_geom_hbond_atom_site_label_D                    ',
     5 '_geom_hbond_atom_site_label_H                    ',
     6 '_geom_hbond_atom_site_label_A                    ',
     7 '_geom_hbond_distance_DH                          ',
     8 '_geom_hbond_distance_HA                          ',
     9 '_geom_hbond_distance_DA                          ',
     * '_geom_hbond_angle_DHA                            ',
     1 '_geom_hbond_site_symmetry_A                      ',
     2 '_geom_hbond_publ_flag                            ',
     3 '_journal_coden_Cambridge                         ',
     4 '_publ_requested_category                         ',
     5 '_publ_contact_author_name                        ',
     6 '_publ_contact_author_address                     ',
     7 '_publ_section_title_footnote                     ',
     8 '_publ_section_synopsis                           '/
      DATA (CIFDIR(I), I = 441, 458) /
     1 '_diffrn_measurement_device_type                  ',
     2 '_reflns_number_gt                                ',
     3 '_reflns_threshold_expression                     ',
     4 '_diffrn_reflns_theta_full                        ',
     5 '_refine_ls_R_factor_gt                           ',
     6 '_refine_ls_wR_factor_ref                         ',
     7 '_refine_ls_goodness_of_fit_ref                   ',
     8 '_refine_ls_shift/su_max                          ',
     9 '_atom_site_adp_type                              ',
     * '_atom_site_disorder_assembly                     ',
     1 '_refine_ls_weighting_details                     ',
     2 '_atom_site_aniso_B_11                            ',
     3 '_atom_site_aniso_B_12                            ',
     4 '_atom_site_aniso_B_13                            ',
     5 '_atom_site_aniso_B_22                            ',
     6 '_atom_site_aniso_B_23                            ',
     7 '_atom_site_aniso_B_33                            ',
     8 '_diffrn_measured_fraction_theta_max              '/
      DATA (CIFDIR(I), I = 459, 476) /
     1 '_diffrn_measured_fraction_theta_full             ',
     2 '_refine_ls_wR_factor_gt                          ',
     3 '_refine_ls_shift/su_mean                         ',
     4 '_refine_diff_density_rms                         ',
     5 '_diffrn_detector_area_resol_mean                 ',
     6 '_database_code_CSD                               ',
     7 '_iucr_compatibility_tag                          ',
     8 '_geom_hbond_site_symmetry_D                      ',
     9 '_geom_hbond_site_symmetry_H                      ',
     * '_journal_paper_category                          ',
     1 '_publ_author_footnote                            ',
     2 '_geom_extra_table_head_A                         ',
     3 '_geom_extra_tableA_col_1                         ',
     4 '_geom_extra_tableA_col_2                         ',
     5 '_geom_extra_tableA_col_3                         ',
     6 '_geom_extra_tableA_col_4                         ',
     7 '_geom_extra_tableA_col_5                         ',
     8 '_geom_extra_tableA_col_6                         '/
      DATA (CIFDIR(I), I = 477, 494) /
     1 '_vrn_publ_code                                   ',
     2 '_chemical_absolute_configuration                 ',
     3 '_refln_nonius_diffracted_cos_cstar               ',
     4 '_symmetry_equiv_pos_site_id                      ',
     5 '_diffrn_radiation_probe                          ',
     6 '_chemical_formula_iupac                          ',
     7 '_space_group_crystal_system                      ',
     8 '_space_group_id                                  ',
     9 '_space_group_IT_number                           ',
     * '_space_group_name_Hall                           ',
     1 '_space_group_name_H-M                            ',
     2 '_space_group_name_H-M_alt                        ',
     3 '_space_group_symop_id                            ',
     4 '_space_group_symop_operation_xyz                 ',
     5 '_space_group_symop_sg_id                         ',
     6 '_diffrn_source                                   ',
     7 '_diffrn_detector                                 ',
     8 '_diffrn_detector_dtime                           '/
      DATA (CIFDIR(I), I = 495, 513) /
     1 '_diffrn_standards_decay_corr_max                 ',
     2 '_diffrn_standards_decay_corr_min                 ',
     3 '_diffrn_reflns_av_unetI/netI                     ',
     4 '_exptl_absorpt_factor_mur                        ',
     5 '_exptl_absorpt_correction_t_ave                  ',
     6 '_audit_conform_dict_name                         ',
     7 '_audit_conform_dict_version                      ',
     8 '_audit_conform_dict_location                     ',
     9 '_platon_squeeze_void_nr                          ',
     * '_platon_squeeze_void_average_x                   ',
     1 '_platon_squeeze_void_average_y                   ',
     2 '_platon_squeeze_void_average_z                   ',
     3 '_platon_squeeze_void_volume                      ',
     4 '_platon_squeeze_void_count_electrons             ',
     5 '_platon_squeeze_void_content                     ',
     6 '_platon_squeeze_details                          ',
     7 '_refine_ls_shift/su_max_lt                       ',
     8 '_refine_ls_abs_structure_Hooft                   ',
     9 '_iucr_refine_instructions_details                '/
      DATA (CIFDIR(I), I = 514, 532) /
     1 '_refine_ls_goodness_of_fit_gt                    ',
     2 '_refine_ls_restrained_s_gt                       ',
     3 '_publ_section_related_literature                 ',
     4 '_publ_section_exptl_solution                     ',
     5 '_iucr_refine_instruction_details                 ',
     6 '_iucr_refine_instructions_details_restraints     ',
     7 '_iucr_refine_instructions_details_constraints    ',
     8 '_chemical_melting_point_gt                       ',
     9 '_chemical_melting_point_lt                       ',
     * '_diffrn_source_type                              ',
     1 '_diffrn_source_power                             ',
     2 '_diffrn_source_voltage                           ',
     3 '_diffrn_source_current                           ',
     4 '_diffrn_radiation_collimation                    ',
     5 '_diffrn_measurement_details                      ',
     6 '_journal_data_validation_number                  ',
     7 '_database_code_depnum_ccdc_archive               ',
     8 '_iucr_geom_hbonds_special_details                ',
     9 '_publ_author_email                               '/
      DATA (CIFDIR(I), I = 533, 551) /
     1 '_publ_contact_author_id_iucr                     ',
     2 '_chemical_optical_rotation                       ',
     3 '_chemical_properties_physical                    ',
     4 '_chemical_properties_biological                  ',
     5 '_geom_table_footnote_A                           ',
     6 '_geom_table_footnote_B                           ',
     7 '_iucr_compatibility_tag                          ',
     8 '_diffrn_detector_type                            ',
     9 '_geom_table_headnote_A                           ',
     * '_geom_table_headnote_B                           ',
     1 '_exptl_crystal_recrystallization_method          ',
     2 '_pd_meas_2theta_range_min                        ',
     3 '_pd_meas_2theta_range_max                        ',
     4 '_twin_lattice_merohedry                          ',
     5 '_twin_lattice_reticular_merohedry                ',
     6 '_twin_lattice_hybrid                             ',
     7 '_twin_lattice_special_details                    ',
     8 '_twin_individual_number                          ',
     9 '_twin_law_matrix_11                              '/
      DATA (CIFDIR(I), I = 552, 569) /
     1 '_twin_law_matrix_12                              ',
     2 '_twin_law_matrix_13                              ',
     3 '_twin_law_matrix_21                              ',
     4 '_twin_law_matrix_22                              ',
     5 '_twin_law_matrix_23                              ',
     6 '_twin_law_matrix_31                              ',
     7 '_twin_law_matrix_32                              ',
     8 '_twin_law_matrix_33                              ',
     9 '_twin_matrix_11_UB                               ',
     * '_twin_matrix_12_UB                               ',
     1 '_twin_matrix_13_UB                               ',
     2 '_twin_matrix_21_UB                               ',
     3 '_twin_matrix_22_UB                               ',
     4 '_twin_matrix_23_UB                               ',
     5 '_twin_matrix_31_UB                               ',
     6 '_twin_matrix_32_UB                               ',
     7 '_twin_matrix_33_UB                               ',
     8 '_iucr_refine_reflections_details                 '/
      DATA (CIFDIR(I), I = 570, 589) /
     1 '_atom_site_site_symmetry_order                   ',
     2 '_atom_site_site_symmetry_multiplicity            ',
     3 '_reflns_Friedel_fraction_max                     ',
     4 '_reflns_Friedel_fraction_full                    ',
     5 '_shelx_space_group_comment                       ',
     6 '_shelx_estimated_absorpt_t_min                   ',
     7 '_shelx_estimated_absorpt_t_max                   ',
     8 '_shelxl_version_number                           ',
     9 '_shelx_res_file                                  ',
     * '_shelx_res_checksum                              ',
     1 '_shelx_hkl_file                                  ',
     2 '_shelx_hkl_checksum                              ',
     3 '_exptl_transmission_factor_max                   ',
     4 '_exptl_transmission_factor_min                   ',
     5 '_diffrn_reflns_sigmaI/netI                       ',
     6 '_diffrn_reflns_Laue_measured_fraction_max        ',
     7 '_diffrn_reflns_Laue_measured_fraction_full       ',
     8 '_diffrn_reflns_point_group_measured_fraction_max ',
     9 '_diffrn_reflns_point_group_measured_fraction_full',
     * '_reflns_Friedel_coverage                         '/
      DATA (CIFDIR(I), I = 590, 622)/
     1 '_geom_extra_table_head_B                         ',
     2 '_geom_extra_tableB_col_1                         ',
     3 '_geom_extra_tableB_col_2                         ',
     4 '_geom_extra_tableB_col_3                         ',
     5 '_geom_extra_tableB_col_4                         ',
     6 '_geom_extra_tableB_col_5                         ',
     7 '_geom_extra_tableB_col_6                         ',
     8 '_diffrn_source_monochromator                     ',
     9 '_atom_site_refinement_flags_posn                 ',
     * '_atom_site_refinement_flags_adp                  ',
     1 '_atom_site_refinement_flags_occupancy            ',
     2 '_shelx_fab_file                                  ',
     3 '_shelx_fab_checksum                              ',
     4 '_diffrn_reflns_transf_matrix_11                  ',
     5 '_diffrn_reflns_transf_matrix_12                  ',
     6 '_diffrn_reflns_transf_matrix_13                  ',
     7 '_diffrn_reflns_transf_matrix_21                  ',
     8 '_diffrn_reflns_transf_matrix_22                  ',
     9 '_diffrn_reflns_transf_matrix_23                  ',
     * '_diffrn_reflns_transf_matrix_31                  ',
     1 '_diffrn_reflns_transf_matrix_32                  ',
     2 '_diffrn_reflns_transf_matrix_33                  ',
     3 '_diffrn_measurement_specimen_support             ',
     4 '_smtbx_masks_special_details                     ',
     5 '_smtbx_masks_void_nr                             ',
     6 '_smtbx_masks_void_average_x                      ',
     7 '_smtbx_masks_void_average_y                      ',
     8 '_smtbx_masks_void_average_z                      ',
     9 '_smtbx_masks_void_volume                         ',
     * '_smtbx_masks_void_count_electrons                ',
     1 '_smtbx_masks_void_content                        ',
     2 '_ccdc_compound_id                                ',
     3 '_space_group_ssg_name                            '/
      DATA (CIFDIR(I), I = 623, NP34)/
     1 '_publcif_datablock.id                            ',
     2 '_publcif_info_exptl_table_max_cols               ',
     3 '_publcif_info_exptl_table_use_headnotes          ',
     4 '_publcif_info_tables.block_id                    ',
     5 '_publcif_info_tables.reference_item              ',
     6 '_publcif_info_datablock.id                       ',
     7 '_publcif_info_datablock.publ_exptl               ',
     8 '_publcif_info_datablock.publ_geom                ',
     9 '_publcif_info_datablock.structure                ',
     * '_publcif_info_exptl_table_extra_item             ',
     1 '_publcif_info_exptl_table_header_item            ',
     2 '_publ_section_keywords                           ',
     3 '_publ_body_element                               ',
     4 '_publ_body_title                                 ',
     5 '_publ_body_contents                              ',
     6 '_publ_body_element                               ',
     7 '_platon_squeeze_void_probe_radius                ',
     8 '_exptl_absorpt_special_details                   ',
     9 '_shelx_shelxl_version_number                     ',
     * '_platon_missing_refln_index_h                    ',
     1 '_platon_missing_refln_index_k                    ',
     2 '_platon_missing_refln_index_l                    ',
     3 '_platon_missing_refln_theta                      ',
     4 '_citation_database_id_csd                        ',
     5 '_citation_special_details                        '/
C * EXTINCTIONS
      DATA EXTYPE /
     1 'HKL:H+K=2N     C', 'HKL:H+L=2N     B', 'HKL:K+L=2N     A',
     2 'HKL:H+K+L=2N   I', 'HKL:-H+K+L=3N oR', 'HKL:H-K+L=3N  rR',
     3 '0KL:K=2N      bx', '0KL:L=2N      cx', '0KL:K+L=2N    nx',
     4 'H0L:H=2N      ay', 'H0L:L=2N      cy', 'H0L:H+L=2N    ny',
     5 'HK0:H=2N      az', 'HK0:K=2N      bz', 'HK0:H+K=2N    nz',
     6 'H00:H=2N     21x', '0K0:K=2N     21y', '00L:L=2N     21z',
     7 '0KL:K+L=4N    dx', 'H0L:H+L=4N    dy', 'HK0:H+K=4N    dz',
     8 'H00:H=4N     41x', '0K0:K=4N     41y', '00L:L=4N     41z',
     9 'HHL:L=2N     cxy', 'HHL:H=2N        ', 'HHL:H+L=2N      ',
     * 'HHL:2H+L=4N     ', 'H-HL:H+L=3N     ', 'H-HL:-H+L=3N    ',
     1 '00L:L=6N     61z', 'HH0:H=2N        ', 'H-HL:L=2N       ',
     2 'HHL:L=3N        ', 'H-2HL:L=2N      ', '-2HHL:L=2N      ',
     3 'H-2HL:L=3N      ', '-2HHL:L=3N      ', '00L:L=3N     31z',
     4 'H-HL:H=2N       ', 'HKL:H=2N      2X', 'HKL:K=2N      2Y',
     5 'HKL:L=2N      2Z', 'HKL:H=3N      3X', 'HKL:K=3N      3Y',
     6 'HKL:L=3N      3Z', '-HKL, H-KL=3NtwR', '-HKL:K2,KL4P2tw2',
     7 '-HKL:H2,HL4P2tw2', '-HKL:H2,HK4P2tw2', 'HKL:H+2L=3N     ',
     8 'HKL:H+K+L=3N    '/
      DATA NLAUE /
     1 '   -1', '  2/m', '  mmm', '  4/m', '4/mmm', '   -3', ' -3m1',
     2 ' -31m', '  6/m', '6/mmm', '  m-3', ' m-3m', '     '/
      DATA TRTYP /'ABC  ', 'BA-C ', 'CAB  ', '-CBA ', 'BCA  ',
     1            'A-CB ', 'C-BA ', 'A-B-N'/
      DATA (((TRDAT(I, J, K), J = 1, 3), I = 1, 3), K = 1, 8) /
     1 1.0, 0.0, 0.0, 0.0,  1.0, 0.0,  0.0,  0.0,  1.0,
     2 0.0, 1.0, 0.0, 1.0,  0.0, 0.0,  0.0,  0.0, -1.0,
     3 0.0, 1.0, 0.0, 0.0,  0.0, 1.0,  1.0,  0.0,  0.0,
     4 0.0, 0.0, 1.0, 0.0,  1.0, 0.0, -1.0,  0.0,  0.0,
     5 0.0, 0.0, 1.0, 1.0,  0.0, 0.0,  0.0,  1.0,  0.0,
     6 1.0, 0.0, 0.0, 0.0,  0.0, 1.0,  0.0, -1.0,  0.0,
     7 0.0, 0.0, 1.0, 0.0, -1.0, 0.0,  1.0,  0.0,  0.0,
     8 1.0, 0.0, 0.0, 0.0, -1.0, 0.0, -1.0,  0.0, -1.0/
      DATA BWCT/
     1 'CONTOUR   ', 'NET       ', 'SHADE     ', 'SEGMENT   ',
     2 'DOTS      ', 'BLACK     ', 'CROSS     ', 'GLOBE     ',
     3 'PARALLEL  ', 'MERIDIAN  ', 'HORIZONTAL', 'VERTICAL  ',
     4 'MESH      ', 'DIAGONAL  ', 'SLANT     ', 'TEXTILE   ',
     5 'VOID      '/
      DATA COLR/
     1 'BLACK     ', 'RED       ', 'GREEN     ', 'BLUE      ',
     2 'YELLOW    ', 'ORANGE    ', 'VIOLET    ', 'BROWN     ',
     3 'COPPER    ', 'BRASS     ', 'BRONZE    ', 'SILVER    ',
     4 'QUARTZ    ', 'GOLD      ', 'MICA      ', 'STEELBLUE ',
     5 'VOID      '/
      DATA RGB/
     1 0.625,  0.625,  0.625, 0.750,  0.050,  0.050,
     3 0.400,  1.000,  0.400, 0.125,  0.125,  1.000,
     5 1.000,  1.000,  0.000, 0.800,  0.200,  0.200,
     7 0.320,  0.200,  0.320, 0.660,  0.160,  0.160,
     9 0.000,  0.000,  0.000, 0.000,  0.000,  0.000,
     1 0.000,  0.000,  0.000, 0.000,  0.000,  0.000,
     3 0.000,  0.000,  0.000, 0.000,  0.000,  0.000,
     5 0.000,  0.000,  0.000, 0.000,  0.000,  0.000/
C * KEYWORDS (PLUTON)
      DATA (CRD(I), I = 1, NP37) /
     1         'TITL', 'MESS', 'REM ', 'CELL', 'SPGR', 'LATT', 'LIST',
     2 'SYMM', 'ANGS', 'ROD ', 'ATOM', 'JOIN', 'END ', 'UIJ ', 'SUIJ',
     3 'U   ', 'VIEW', 'SOLI', 'STIC', 'LABE', 'UNLA', 'PUT ', 'RADI',
     4 'PACK', 'MOLE', 'INCL', 'EXCL', 'UNIT', 'RETR', 'STER', 'MONO',
     5 'SIZE', 'PLOT', 'RESE', 'SEGM', 'ECHO', 'HP  ', 'CAL ', 'COLO',
     6 'SET ', 'OMIT', 'STOP', 'RESI', 'ANGL', 'DETA', 'SAVE', 'OVER',
     7 'QUIT', 'ORT ', 'BOX ', 'FVAR', 'HELP', 'BIJ ', 'B   ', 'CESD',
     8 'SBIJ', 'CPK ', 'SFAC', 'DFIX', 'AFIX', 'DIST', 'TORS', 'BWC ',
     9 'TRNS', 'WAIT', 'INOR', 'ORGA', 'STRA', 'INFO', 'ARU ', 'CROT',
     * 'XROT', 'YROT', 'ZROT', 'DEFI', 'BLOC', 'RENA', 'GEOM', 'MENU',
     1 'ZERO', 'HKLF', 'L   ', 'PART', 'RTAB', 'SIMU', 'COOR', 'SADI',
     2 'DELE', 'ENTR', 'DIR ', 'HFIX', 'TRMX', 'PLAN', 'GRID', 'FMAP',
     3 'MOVE', 'SWAT', 'WPDB', 'BASF', 'EXTI', 'FRAG', 'FEND', 'TWIN',
     4 'SPEC', 'MERG', 'SUMP', 'SHEL', 'MORE', 'TIME', 'CGLS', 'ACTA',
     5 'DAMP', 'DISP', 'SLIM', 'EQIV', 'EXYZ', 'EADP', 'BOND', 'FREE',
     6 'BIND', 'SAME', 'CONN', 'LAUE', 'BUMP', 'TEMP', 'XXXX', 'ABS ',
     7 'FACE', 'EMPI', 'LAMB', 'HOPE', 'DMAT', 'SKIP', 'ANIS', 'WGHT',
     8 'EXOR', 'ISOR', 'RADN', 'ENDS', 'ZERR', 'DELU', 'NOMO', 'RESD',
     9 'NOSO', 'DEFS', 'HALL', 'FLAT', 'HTAB', 'EXIT', 'MPLA', 'PORT',
     * 'FSUM', 'SCAL', 'CRYS', 'CALC', 'REN ', 'LAB ', 'DEL ', 'CONF',
     1 'VIE ', 'SOL ', 'STI ', 'UNL ', 'INC ', 'EXC ', 'UNI ', 'PAC ',
     2 'SCAT', 'FIT ', 'ABIN', 'ANSC', 'ANSR', 'NEUT', 'PRIG', 'RIGU',
     3 'STIR', 'TWST', 'WIGL', 'XNPD', 'DANG', '    ', '    ', '    ',
     4 '    ', '    ', '    ', '    ', '    ', '    ', '    ', '    '/
      DATA (LABP(I), I = 1, 16) /
     1 '  ', 'AU', 'E ', 'NE', 'N ', 'NW', 'W ', 'SW', 'S ', 'SE',
     2 'NU', '  ', '  ', '  ', '  ', 'MS'/
      DATA NCNT /0/
      DATA MENX /
     1 'ORTEP     1', 'PLUTON    2', 'Contents  3', 'Style     4',
     2 'View      5', 'GeomTy    6', 'Aux       7', 'ORT_SP1   8',
     3 'ORT_SP2   9', 'PLATON   10', 'PLA-SP1  11', 'PLA-SP2  12',
     4 'GEOM     13', 'ASYM     14', 'HELENA   15', 'ABSCOR   16',
     5 'SYSTEM-S 17', 'S-SUB    18', 'S-SHXL   19', 'LEPAGE   20',
     6 'POWDER   21', 'Contour  22', 'CON-Sup  23', 'SOLV     24',
     7 'TwinRoMt 25', 'ADDSYM   26', 'S/EXOR   27', 'RDF      28',
     8 'BIJVOET  29', 'POLYHN   30', 'Flipper  31', 'ANALoVAR 32',
     9 'AnomDisp 33', 'FCF-Comp 34'/
      DATA (CMEN(I), I = 1, 72) /
     1 '           ', 'Incl-HAtoms', 'BWC Res ARU', 'Solid-Style',
     2 'Rod  -Style', 'CPK  +Stick', 'Straw-Style', 'DeleteAtoms',
     3 'RenameAtoms', 'MoveLabel  ', 'Label -Hat+', 'LabelSize >',
     4 'UnitCellBox', 'Resd012..  ', 'H-Bonds-X  ', 'PackRange  ',
     5 'Stereo Opts', 'CRotY >>   ', '<<-RotZ+>> ', '<<-RotY+>> ',
     6 '<<-RotX+>> ', 'ViewOptions', 'Decoration ', 'Met Pov Ras',
     7 '        End', 'NoDisorder ', 'NoMove     ', 'Stick-Style',
     8 'AtomSort   ', 'Organic    ', 'Round      ', 'Parentheses',
     9 'ListRadii  ', 'Mono       ', 'HFIX   ANIS', 'Cell Dimens',
     * 'OptionMenus', 'Probability', 'Raster3D   ', 'Hetero El.s',
     1 'Envelope El', 'Octant El.s', 'ViewMin    ', 'EPS-File   ',
     2 'StyleA     ', 'BwcStyle   ', 'ToMainMenu ', 'DisplayText',
     3 'ENTRY-LIST ', 'NewText    ', 'NewText    ', 'MoveText   ',
     4 'PLUTON  End', 'TextSize   ', 'Distance   ', 'Angle      ',
     5 'Torsion    ', 'GeomCalc   ', 'Reset   End', 'SelPattern ',
     6 'Bonds      ', 'Fo-Fc-Map  ', 'Fo-Map     ', 'Color      ',
     7 'SQUEEZE-Map', 'ZoomCenter ', 'NextRing   ', 'Zoom       ',
     8 'DeleteText ', 'NextPlane  ', 'ViewUnit   ', 'ViewMin    '/
      DATA (CMEN(I), I = 73, 144) /
     1 'ViewXO     ', 'ViewYO     ', 'ViewZO     ', 'ListCell   ',
     2 'ListSymm   ', 'ListAtoms  ', 'ListBonds  ', 'ListTypes  ',
     3 'ListLines  ', 'ListARU    ', 'ViewAFace  ', 'ViewBFace  ',
     4 'ViewCFace  ', 'ViewInvert ', 'ViewLine   ', 'ViewPerp   ',
     5 'ViewBisect ', 'LabelARU   ', 'Auto-Plot  ', 'LabelCell  ',
     6 'OmitOutside', 'LabelAtom  ', 'Resolution>', 'InclZombie ',
     7 '<OverlapMrg', 'SelectColor', 'Col Res ARU', 'ChTextSize ',
     8 'NoSymm     ', 'Newman-Next', 'Up     Down', 'EPS    End ',
     9 'Ch-Cntr-Lev', 'Ch-Step-Siz', 'GlobalPattn', 'Resolution ',
     * 'Zone-H     ', 'Zone-K     ', 'Zone-L     ', 'Axes       ',
     1 'Plane-TNCP ', 'Plane-abcd ', 'PlaneBisect', 'Plane-Perp ',
     2 'VertAngSize', 'Horiz Shift', 'Vert  Shift', 'Z-Rotation ',
     3 'PlaneXYXZYZ', 'OMIT  STH/L', 'OMIT SIG(I)', 'R/S-Determ ',
     4 'MissingRefl', 'Next-Step  ', 'EPS    HPGL', 'Summary    ',
     5 'LabelVert.s', 'Mu     (mm)', 'Radius (mm)', 'T(min) (mm)',
     6 'MuR        ', 'N-Measured ', 'Gauss  Grid', 'FaceAdd(mm)',
     7 'FaceDelete ', 'SHELXL-ATWT', 'PlaneDisTol', 'Norm-H-bond',
     8 'DeleteLabel', 'IncludLabel', 'EPS-Listing', 'Print-Level'/
      DATA (CMEN(I), I = 145, 216) /
     1 'SAVE-InstrS', 'ZoomXtlPlot', 'Browser    ', 'b&w-EPS-col',
     2 'WriteDirCos', 'L0(max)    ', 'L1(max)    ', 'T(max) mm  ',
     3 'Portrait   ', 'List Uij   ', 'No-SCALE   ', 'CheckDirCos',
     4 'BetaPerpPar', 'LSR-MSM-MSA', 'DirCos-ABSP', 'ABST/P/NONE',
     5 'TREE   LIST', 'LOG  RELINK', 'ADDSYM SOLV', 'CELL HELENA',
     6 'TRMX   SPGR', 'FORM Z SX86', 'SHX/S/P/D/T', 'DIRDIF ORNT',
     7 'SIR97/04/11', 'EXOR  /S /D', 'SHELXL-ISO ', 'SHELXL-ANIS',
     8 'MULABS     ', 'HDIF   HFIX', 'SHELXL-HATS', 'SHELXL-WGHT',
     9 'PLUTON RENM', 'PLATON  ADP', 'INVRT HFREE', 'ASYM   VIEW',
     * 'SQUEEZE FCF', 'VALI REPORT', 'LstRES SXPS', 'SKIP ACCEPT',
     1 'LIST-REFL  ', 'AutoMolExpd', 'Fit Res 1&2', '           ',
     2 'RadBndAll  ', 'RadBndNorm ', 'RadBndToMet', 'RadBndToHat',
     3 'Edit-s.ins ', 'PruneS-Tree', 'Browse-lis ', 'Browse-lps ',
     4 'Laser-lps  ', 'Void-Check ', 'AddsymCheck', 'Valid-Check',
     5 'Asym-Residu', 'Browse-ps  ', 'Laser-ps   ', 'OmitOutlier',
     6 'XtalDisplay', 'F0**2-Map  ', '2Fo-Fc-Map ', '54 60 65 MX',
     7 'Ag Mo Cu X ', 'MaxDotProd ', 'ExpErrorDeg', 'Twin-Matrix',
     8 'Edit-s.res ', 'Flipper    ', 'ListFlags  ', 'BondTaper> '/
      DATA (CMEN(I), I = 217, 288) /
     1 'CalcCoordn ', 'LablFullNum', 'DisAnglTors', 'JoinDashDet',
     2 'Include RR1', 'Include RR2', 'Include RR3', 'Include RR4',
     3 'Include RR5', 'Include RR6', 'Include RR7', 'Include RR8',
     4 'Include RR9', 'NFTPercImpl', 'Join-Expand', 'FITbyCLICK ',
     5 'LsplDistEnd', 'ExcludeARU ', 'Def-Cntr-Lv', 'OmitFromSFC',
     6 'MaxRingSize', 'SHELXL-CGLS', 'SHELXL-LS  ', 'Anis    All',
     7 'Label-Alias', 'OvrlpSHADOW', 'X-LineWidth', 'Two-Ax-Crit',
     8 'Sub/SupCell', 'XR  YR  ZR ', 'D-H..H-A   ', 'CalcAbsCorr',
     9 'ReflListing', 'LstCellSymm', 'Prev   Next', 'LstAtomsUij',
     * 'LineWidth  ', '<VertScale>', 'ScaleDegree', 'LstFlagRadi',
     1 'RemoveTree ', 'CSD-Search ', 'R-PLUTO    ', '<HorsScale>',
     2 'AutoRenum  ', 'InclDisCont', 'NoSubCell  ', 'TMA-Hincl  ',
     3 '(UAE)WLSPL ', 'AltLablPack', 'DebugOutput', 'SetWindSize',
     4 'MenuOff    ', 'LabelCg    ', 'DefineToEnd', 'ObsCalcDelt',
     5 'NrLinesNorm', 'NrLinesToMe', 'LstRadBonds', 'Perspective',
     6 'StepSize   ', 'Max2Axis   ', 'LstARU RCel', 'Reverse-B&W',
     7 'Tola       ', 'ADP-PLOT   ', 'Tolm       ', 'Uiso       ',
     8 'Ohashi-Vol ', 'Show-Mol   ', 'Void0123...', 'DotsContour'/
      DATA (CMEN(I), I = 289, 360) /
     1 'MinDistCrit', 'LtReference', 'CoordRadDef', 'UnitFill   ',
     2 'ColorType  ', 'UnitSymPack', 'AutoEXTIref', 'RoundCell  ',
     3 'DspTwinMat1', 'DspTwinMat2', 'DspTwinMat3', 'DspTwinMat4',
     4 'HKLF5-Gener', 'Merg 4     ', 'InputLambda', 'LsplWithEnd',
     5 'PovrayStyle', 'ADDSYM-PLOT', 'ADDSYM-SHX ', 'ADDSYMExact',
     6 'NonFitPerc ', 'TolMetric  ', 'TolRotAxis ', 'TolInvers  ',
     7 'TolTransl  ', 'DeltaI/SigI', 'DeltaTheta ', 'NRefSelMin ',
     8 'HKLF5-CritI', 'MinQPeakHgt', 'MinQPeakDis', 'Q-Peak-Incl',
     9 'KeyInstruct', 'ListDetails', 'ADDSYMElmnt', 'DisplAllLab',
     * 'HorVerRatio', 'PovrayResol', 'EPS-TwinLat', 'FullListing',
     1 'ADDSYMEqual', 'TwinRotMat ', 'HKLF5-CritT', 'MaxIndexUVW',
     1 'KeepMon-I-n', 'Displ-d-val', 'Display-2Th', 'SelectTMat1',
     1 'SelectTMat2', 'SelectTMat3', 'SelectTMat4', 'Normalize  ',
     4 'RDF-radius ', 'RDFwidthPar', 'EPS-TwinLaw', 'RacemicTwin',
     5 'PNG        ', 'Fourier3D  ', 'Nr-Sections', 'Nr+Sections',
     6 'SigmaCriter', 'ExclDisOper', 'Angle2Lines', 'DefineCgEnd',
     7 'UisoMax    ', 'CremerPople', 'MaxNumRings', 'Zone-H,K,L ',
     8 'NpeakFmap  ', 'BondValence', 'ApplySlope ', 'Polyhedra  '/
      DATA (CMEN(I), I = 361, NP40) /
     1 'PolyShade  ', 'FCF-Calc   ', 'InclAtoms  ', 'ResdSort   ',
     2 'VoidAxes   ', 'SirWindow  ', 'ListRefl   ', 'PLATON     ',
     3 'EXOR       ', 'UisoHRadius', 'Exclude H  ', 'PDF-Listing',
     4 'Converged  ', 'IcalFromCIF', 'IcalFromFCF', 'Inc H CH DH',
     5 'OutlierCrit', 'NU-Value   ', 'Gaussian   ', 'LabelHetAts',
     6 'Continue   ', 'NPP-Bijvoet', 'InclWghtPar', 'NorProbPlot',
     7 'ScatterPlot', 'LogLog-Plot', 'Linear-Plot', 's.u.-Bar   ',
     8 'HKL-Display', 'NoExpand   ', 'Show       ', 'Ntry       ',
     9 'Nloop      ', 'Nsolve     ', 'Delta      ', 'Perc       ',
     * 'Uiso       ', 'Structure  ', 'PageHeader ', 'AnomDispPlt',
     1 'MuPlot     ', 'Anom-CuKa  ', 'Anom-MoKa  ', 'Anom-AgKa  ',
     2 'Mu-CuKa    ', 'Mu-MoKa    ', 'Mu-AgKa    ', 'Incl C-H..X',
     3 'GenerRandom', 'TPP-Bijvoet', 'Student-T  ', 'Displ-q-Val',
     4 'CPI-File   ', 'ReducedCell', 'I/s-log(I) ', 'I/sw-log(I)',
     5 'VarAnalysis', 'ParsonsDiff', 'BijvoetDiff', 'BtDiff-Th  ',
     6 'BtDiff-Fc2 ', 'BtDifSig-Th', 'BtDifSigFc2', 's(I)-log(I)',
     7 'log(s)-logI', 'ADDSYMPart#', 'NoMolFitInv', 'GenerSthlMx',
     8 '           ', '           ', '           ', '           '/
      DATA (MENS(I, 1), I = 1, 25) /
     1      4803, 2, 1, 1, 409, 1, 3503, 3603, 5603, 605, 6602, 1502, 1,
     2      508, 1, 1, 100, 9, 10, 10, 10, 2, 1, 2302, 2/
      DATA (MENS(I, 2), I = 1, 25) /
     1      1106, 4, 3, 2405, 1, 2, 1, 1, 203, 605, 6602, 508, 1, 100,
     2      2, 707, 1502, 9, 10, 10, 10, 303, 1, 3, 2/
      DATA (MENS(I, 3), I = 1, 25) /
     1      1106, 1, 1, 1, 1410, 1, 1, 1, 1, 1, 1, 1, 7308, 100,
     2      9002, 605, 1502, 9, 10, 10, 10, 1, 1, 1, 2/
      DATA (MENS(I, 4), I = 1, 25) /
     1      1106, 5102, 1, 2405, 1, 2, 1, 1, 203, 817, 3306, 1003, 904,
     2      1, 1, 1, 1502, 5602, 10, 10, 10, 303, 5603, 3603, 2/
      DATA (MENS(I, 5), I = 1, 25) /
     1      1106, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 100, 1,
     2      1, 1502, 1, 10, 10, 10, 303, 1, 3, 2/
      DATA (MENS(I, 6), I = 1, 25) /
     1      1106, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 100, 1,
     2      1, 1502, 1, 10, 10, 10, 303, 1, 3, 2/
      DATA (MENS(I, 7), I = 1, 25) /
     1      1106, 1, 6007, 1, 1, 1, 1, 1, 1, 1, 1, 4203,
     2      9906, 9102, 7605, 1, 1, 1, 1, 7005, 1, 1, 2, 1, 2/
      DATA (MENS(I, 8), I = 1, 25) /
     1      4803, 1, 1, 1, 1410, 1, 1, 7104, 1, 1, 7208, 5304, 3802, 1,
     2      3802, 1, 100, 5805 ,5905, 2708, 2808, 2908, 3008, 3409, 2/
      DATA (MENS(I, 9), I = 1, 25) /
     1      4803, 1, 1, 1, 1, 1, 1, 3703, 3703, 5203, 1, 1,
     2      2, 2, 2, 1, 100, 1, 10, 10, 10, 1, 7503, 3903, 2/
      DATA (MENS(I, 10), I = 1, 25) /
     1      8603, 1, 1, 1, 2604, 1, 1, 1, 1, 1, 6602, 2, 2,
     2      1, 1, 2, 1, 8705, 8805, 2, 1, 2, 1, 1, 2/
      DATA (MENS(I, 11), I = 1, 25) /
     1      8603, 1, 1, 1, 1, 1, 1, 1, 1, 5203, 1, 1, 1,
     2      1, 1, 1, 7104, 1, 1, 7005, 1, 6504, 6404, 1, 2/
      DATA (MENS(I, 12), I = 1, 25) /
     1      8603, 2105, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 5404, 1, 5, 1, 1202, 1, 1, 1, 1, 2/
      DATA (MENS(I, 13), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2302, 2/
      DATA (MENS(I, 14), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 2507, 1309, 1,
     2      1, 1, 1, 5704, 1, 4102, 1, 1, 1, 1, 1, 1, 2/
      DATA (MENS(I, 15), I = 1, 25) /
     1      1, 1, 4706, 1, 1, 1, 2703, 2803, 2902, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 16), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 2210, 9, 10, 10, 10, 1, 1, 1, 2/
      DATA (MENS(I, 17), I = 1, 25) /
     1      4003, 3, 1, 3, 2, 3, 4, 2, 3, 3, 6, 6,
     2      1, 2, 6, 6, 2, 2, 2, 2, 2, 2, 2, 1, 2/
      DATA (MENS(I, 18), I = 1, 25) /
     1      4003, 3, 2, 1, 1, 2, 1, 10004, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2/
      DATA (MENS(I, 19), I = 1, 25) /
     1      4003, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 2, 1, 10204, 1, 1, 2, 2/
      DATA (MENS(I, 20), I = 1, 25) /
     1   3109, 3204, 4305, 6205, 4407, 7404, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 21), I = 1, 25) /
     1   4904,    1, 4605, 5006, 6105, 4505, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 22), I = 1, 25) /
     1      1   ,6305,6305,6305,6305,1,1,1,1,1603, 2006, 1705,
     2      6, 6, 6, 1, 1502, 1805, 1908, 1, 5503, 1, 1, 2, 2/
      DATA (MENS(I, 23), I = 1, 25) /
     1      1,6304, 1, 1, 1, 1, 1, 9706, 9806, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1805, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 24), I = 1, 25) /
     1      1, 6802, 6902, 1, 1, 1, 1, 1, 1, 100, 1, 6700,
     2      1, 1, 1, 1, 1502, 508, 10, 10, 10, 1, 1, 1, 1/
      DATA (MENS(I, 25), I = 1, 25) /
     1      8406, 8206, 9405, 8305, 1, 1, 1, 1, 1, 1, 1, 9207,
     2      1, 1, 10103, 2, 1, 1,  1, 1, 1, 8506, 9305, 1, 1/
      DATA (MENS(I, 26), I = 1, 25) /
     1      7704, 7806, 7906, 8006, 8106, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 2, 1, 8900, 1, 1, 1, 1/
      DATA (MENS(I, 27), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2/
      DATA (MENS(I, 28), I = 1, 25) /
     1      1, 9505, 9606, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 29), I = 1, 25) /
     1      1, 1, 1, 1, 1, 10410,   1, 10006, 1, 1, 1, 1,
     2      2, 1, 1, 1, 10510, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 30), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 604, 1, 1,
     2      1, 1, 1,10305, 1, 1, 10, 10, 10, 1, 1, 2, 1/
      DATA (MENS(I, 31), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 5, 5,
     2      5, 6, 7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 32), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 33), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENS(I, 34), I = 1, 25) /
     1      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     2      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1/
      DATA (MENU(I, 1), I = 1, 50) /
     1 37, 17,  2,  8, 38,217,219,220,271, 22, 26, 11, 10, 12,141,
     2142, 14, 18, 19, 20, 21,251, 23,148, 53, 37, 34,502,508, 38,
     3717,719,720,771, 22,526,511,510, 32,641,642, 14, 18, 19, 20,
     4 21,251,523,148, 53/
      DATA (MENU(I, 2), I = 1, 50) /
     1 37, 17,376,  4,  5,  6,  7,528,  3, 22, 26, 12, 13, 14, 15,
     2 16, 11, 18, 19, 20, 21, 99, 23, 24, 59, 37, 34,876,504,505,
     3506,507, 28,503, 22,526, 12,513, 14, 15, 16,511, 18, 19, 20,
     4 21,599,523, 24, 59/
      DATA (MENU(I, 3), I = 1, 50) /
     1537, 48, 50, 52, 54, 69,100,  8,  9, 10, 58, 66, 68, 14, 35,
     2 22, 11, 18, 19, 20, 21,234, 93,201, 59, 37,548,550,552, 54,
     3569,600,508,509,510,558,566, 68, 14,535, 22,511, 18, 19, 20,
     4 21,734,593,701, 59/
      DATA (MENU(I, 4), I = 1, 50) /
     1537, 60, 98,  4,  5,  6,  7,528,  3,607,216, 97, 95, 90, 92,
     2 94, 11,352, 19, 20, 21, 99,271,220, 59, 37,560,598,504,505,
     3506,507, 28,503,107,216, 97, 95,590,592,594,511,852, 19, 20,
     4 21,599,771,720, 59/
      DATA (MENU(I, 5), I = 1, 50) /
     1537, 71, 72, 73, 74, 75, 83, 84, 85, 86, 87, 88, 89, 14,  1,
     2  1, 11,  1, 19, 20, 21, 99, 23, 24, 59, 37,571,572,573,574,
     3575,583,584,585,586,587,588,589, 14,  1,  1,511,  1, 19, 20,
     4 21,599,523, 24, 59/
      DATA (MENU(I, 6), I = 1, 50) /
     1537, 55, 56, 57, 58, 80, 81, 82,215, 76, 77, 78, 79, 14,  1,
     2  1, 11, 49, 19, 20, 21, 99, 23, 24, 59, 37,555,556,557,558,
     3 80, 81, 82,215, 76, 77, 78, 79, 14,  1,  1,511, 49, 19, 20,
     4 21,599,523, 24, 59/
      DATA (MENU(I, 7), I = 1, 50) /
     1537,269,276, 30,324,218,241,284, 27,321, 91,242,326,325,305,
     2 32,153,280,243,289, 96,686,251, 49, 59, 37,769,276,530,824,
     3718,741,784,527,  1,591,242,326,325,305,532,653,780,743,289,
     4596,186,251,549, 59/
      DATA (MENU(I, 8), I = 1, 50) /
     1537, 48, 50, 52, 54, 69,100,291,101, 86,293, 39,540, 41, 42,
     2 32, 14,273,274,189,190,191,192,216, 53,537,548,550,552, 54,
     3569,600,291,601,586,793, 39, 40,541,542,532, 14,273,274,189,
     4190,191,192,216, 53/
      DATA (MENU(I, 9), I = 1, 50) /
     1537,243, 64,380,324,270,241,232,187,265,351,275,250,252,256,
     2 82, 14,280, 19, 20, 21,290,304,233, 53,537,743,564,880,824,
     3770,741,732,187,265,851,275,250,252,256, 82, 14,780, 19, 20,
     4 21,790,804,733, 53/
      DATA (MENU(I, 10), I = 1, 50) /
     1 37, 27,231, 30, 31, 32,241,124,140,101, 26,279,250, 78, 79,
     2256,371,318,319,320,321,251,145, 49, 59, 37,527,731,530,531,
     3532,741,624,640,601,526,279,750, 78, 79,256,871,318,319,820,
     4321,251,645,549, 59/
      DATA (MENU(I, 11), I = 1, 50) /
     1537,237,855,247,261,262,264,266,138,265,350,149,156, 29,358,
     2364,291,370,408,289,  1,283,281,  1, 59,537,737,355,747,761,
     3762,764,766,638,265,850,649,656,529,858,864,291,870,908,289,
     4  1,283,281,  1, 59/
      DATA (MENU(I, 12), I = 1, 50) /
     1537,144,143,372,399,  1,  1,  1,427,333,390,362,345,249,267,
     2268,153,428,409,627, 91,243,280,147, 59,537,644,643,872,899,
     3  1,  1,  1,927,833,890,862,845,749,767,768,653,428,909,127,
     4591,743,780,647, 59/
      DATA (MENU(I, 13), I = 1, 50) /
     1  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     2  1,354,282,102, 67, 70, 64, 23,148, 53,  1,  1,  1,  1,  1,
     3  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,282,102, 67,
     4 70,564,523,148, 53/
      DATA (MENU(I, 14), I = 1, 50) /
     1  1,109,110,111,  1,128,108,112,  1,122,123,  1,125,  1,134,
     2272,  1,103,  1,  1,  1,  1, 23,  1,104,  1,609,610,611,  1,
     3628,608,612,  1,122,123,  1,625,  1,634,272,  1,103,  1,  1,
     4  1,  1,523,  1,104/
      DATA (MENU(I, 15), I = 1, 50) /
     1  1,  1,255,  1,185,155,657,658,659,  1,221,222,223,224,225,
     2226,227,228,229,  1,  1,  1,  1,  1,126,  1,  1,255,  1,685,
     3655,657,658,659,  1,721,722,723,724,725,726,727,728,729,  1,
     4  1,  1,  1,  1,126/
      DATA (MENU(I, 16), I = 1, 50) /
     1150,151,132,152,130,131,133,135,136,137,249,149,156, 36,112,
     2129,146, 18, 19, 20, 21,126, 23,248,104,650,651,632,652,630,
     3631,633,635,636,137,749,649,656,536,612,629,146, 18, 19, 20,
     4 21,126,523,248,104/
      DATA (MENU(I, 17), I = 1, 50) /
     1 37,162,173,160,165,166,167,168,169,170,171,172,330,174,175,
     2176,177,178,179,180,181,163,182,261,184, 37,162,  1,160,165,
     3166,167,168,169,170,171,172,330,174,175,176,177,178,179,180,
     4181,163,182,261,184/
      DATA (MENU(I, 18), I = 1, 50) /
     1537,162,161,257,205,164,214,208, 30,198,199,200,258,259,206,
     2 62, 63, 65,203,202,197,196,195,194,184,537,162,161,257,205,
     3164,214,208,530,698,699,700,258,259,206, 62, 63, 65,203,202,
     4197,696,695,194,184/
      DATA (MENU(I, 19), I = 1, 50) /
     1537,193,213,  1,  1,212,  1,302,204,295,853,  1,  1,  1,267,
     2  1,366,280,240,  1,357,238,239,183,184,537,693,213,  1,  1,
     3212,  1,802,704,795,353,  1,  1,  1,767,  1,866,780,240,  1,
     4357,238,239,183,184/
      DATA (MENU(I, 20), I = 1, 50) /
     1210,211,244,278,245,296,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     2  1,  1,  1,  1,  1,  1,  1,  1,126, 25,210,211,244,278,245,
     3296,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     4  1,  1,  1,126, 25/
      DATA (MENU(I, 21), I = 1, 50) /
     1209,303,254,260,277,253,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     2  1,  1,413,367,412,334,335, 23, 44, 25,209,803,254,260,277,
     3253,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,913,367,912,
     4834,835,523, 44, 25/
      DATA (MENU(I, 22), I = 1, 50) /
     1 37, 63,207, 62, 65,613,114,115,116,121,139,117,118,119,120,
     2 61, 11,106,105,235,123,236, 23,103,104, 37,563,707,562,565,
     3113,614,615,616,621,139,117,118,119,120,561,511,106,105,235,
     4246,736,523,103,104/
      DATA (MENU(I, 23), I = 1, 50) /
     1 37,206,  1,  1,  1,  1,  1,347,348,346,  1,  1,  1,  1,  1,
     2  1,  1,106,  1,  1,  1,  1,  1,  1,  1, 37,706,  1,  1,  1,
     3  1,  1,347,348,346,  1,  1,  1,  1,  1,  1,  1,106,  1,  1,
     4  1,  1,  1,  1,  1/
      DATA (MENU(I, 24), I = 1, 50) /
     1  1, 17,288, 73, 74, 75,280,365,294, 14,292,287, 13,286,285,
     2 92, 11, 12, 19, 20, 21, 64, 23, 44, 25,  1,517,288, 73, 74,
     3 75,780,865,794, 14,792,287,513,786,785,592,511, 12, 19, 20,
     4 21,564,523, 44, 25/
      DATA (MENU(I, 25), I = 1, 50) /
     1316,314,332,315,328,343,297,298,299,300,327, 95,374,  1,356,
     2103,344,336,337,338,339,317,331,301, 25,316,314,332,315,828,
     3343,797,798,799,800,327, 95,375,610,611,103,844,836,837,838,
     4839,317,331,301, 25/
      DATA (MENU(I, 26), I = 1, 50) /
     1309,310,311,312,313,230,  1,  1,263,333,  1,  1,  1,  1,  1,
     2  1,  1,322,426,329,323,308,306,307, 25,309,310,311,312,313,
     3730,  1,  1,763,833,  1,  1,  1,  1,  1,  1,  1,822,426,329,
     4323,308,306,307, 25/
      DATA (MENU(I, 27), I = 1, 50) /
     1  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     2  1,  1,  1,  1,  1,  1,  1,  1,  1,184,  1,  1,  1,  1,  1,
     3  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     4  1,  1,  1,  1,184/
      DATA (MENU(I, 28), I = 1, 50) /
     1340,341,342,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     2  1,  1,  1,  1,  1,  1,  1, 23, 44, 25,840,341,342,  1,  1,
     3  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     4  1,  1,523, 44, 25/
      DATA (MENU(I, 29), I = 1, 50) /
     1374,383,  1,  1,  1,377,418,349,420,421,422,423,382,  1,359,
     2  1,378,411,  1,  1,  1,389,388, 44, 25,375,883,  1,  1,  1,
     3377,419, 349,420,421,422,423, 410,  1,859,  1,878,379,  1,  1,
     4  1,889,888, 44, 25/
      DATA (MENU(I, 30), I = 1, 50) /
     1  1, 64,276,  2,  1,  1,  1,  1,  1, 22,360,361, 13,363,  1,
     2 16, 93,  1, 19, 20, 21,  1, 23,148, 25,  1,564,776,502,  1,
     3  1,  1,  1,  1, 22,860,861,513,863,  1, 16,593,  1, 19, 20,
     4 21,  1,523,148, 25/
      DATA (MENU(I, 31), I = 1, 50) /
     1  1,  1,  1,  1,  1,  1,  1,  1,  1,392,393,394,395,396,397,
     2  1,  1,  1,  1,  1,398,391,381,373, 25,  1,  1,  1,  1,  1,
     3  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
     4898,891,381,373, 25/
      DATA (MENU(I, 32), I = 1, 50) /
     1384,415,416,424,425,  1,  1,417,  1,  1,  1,  1,  1,  1,385,
     2386,388,  1,  1,  1,  1,  1,  1, 44, 25,384,415,416,424,  1,
     3  1,417,  1,  1,  1,  1,  1,  1,  1,385,387,888,  1,  1,  1,
     4  1,  1,  1, 44, 25/
      DATA (MENU(I, 33), I = 1, 50) /
     1400,401,402,403,404,405,406,407,  1,  1,  1,  1,  1,  1,  1,
     2  1,  1,  1,  1,  1,  1,  1, 23, 44, 25,400,401,402,403,404,
     3405,406,407,  1,  1,  1,  1,  1,  1,  1,  1,  3,  1,  1,  1,
     4  1,  1,523, 44, 25/
      DATA (MENU(I, 34), I = 1, 50) /
     1384,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,385,
     2386,  1,  1,  1,414,  1,  1,  1, 44, 25,  1,  1,  1,  1,  1,
     3  1,  1,  1,  1,  1,  1,  1,  1,  1,385,387,  1,  1,  1,914,
     4  1,  1,  1, 44, 25/
      DATA (MENA(I, 1), I = 1, 25) /
     1   0, 116, 212, 351,   0, 440, 341, 311, 508,   0,
     2 -59, -75, 349,   0, 327, 328,   0,   0,   0,   0,
     3   0,   1,-103,   0,   0/
      DATA (MENA(I, 2), I = 1, 25) /
     1   0, 116, 212,1004,2004,3004,4004,   4, 345,   0,
     2 -59,   0,  46,   0,   0,   0, -75,   0,   0,   0,
     3   0, 346,-103,   0,   0/
      DATA (MENA(I, 3), I = 1, 25) /
     1   0, 173, 453, 448,   0, 344, 334, 351, 335, 349,
     21341, 343,   0,   0,   0,   0, -75, 105,   0,   0,
     3   0, 213, 141,-128,   0/
      DATA (MENA(I, 4), I = 1, 25) /
     1   0, 348, 338,1004,2004,3004,4004,   4, 345, 345,
     2   0, 339,   0,  63, 339, 452, -75,2508,   0,   0,
     3   0, 346,1508, 311,   0/
      DATA (MENA(I, 5), I = 1, 25) /
     1   0,1150,2150,3150,4150,5150,6150,7150,8150, 330,
     21329,2329,3329,   0,   0,   0, -75,   0,   0,   0,
     3   0, 346,-103,   0,   0/
      DATA (MENA(I, 6), I = 1, 25) /
     1   0,2341,3341,4341,1341,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0, -75,   0,   0,   0,
     3   0, 346,-103,   0,   0/
      DATA (MENA(I, 7), I = 1, 25) /
     1   0, -25,   0, -97, -105,  14, -55, 231, -30,   0,
     2 -35,   0,   0,   0,   0,  71, -46, -68, -69,   0,
     3 166,-127,   0, 462,   0/
      DATA (MENA(I, 8), I = 1, 25) /
     1   0, 173, 453, 448,   0, 344,   0,   0, -52, 330,
     2 536,   0, 211,1211,2211, 350,   0,   0,   0,   0,
     3   0,   0,   0, 341, 476/
      DATA (MENA(I, 9), I = 1, 25) /
     1 414, -69, 346, 618, -105, 506, -55, 312,   0,   0,
     2 341,   0,   0,   0,   0,   0,   0, -68,   0,   0,
     3   0,-104, 552, 476,   0/
      DATA (MENA(I, 10), I = 1, 25) /
     1   0, -30, 110, -97,  68,  71, -55, 324,  87, -52,
     2 -59,   0,   0,   0,   0,   0, 605,   0,   0, -95,
     3   0,   0, -45, 462,   0/
      DATA (MENA(I, 11), I = 1, 25) /
     1   0,  29, 592, -56, 501, 502, 497, -61, 181,   0,
     2 154, 445, 363, -33,-121, 597,   0, 603, 645,   0,
     3   0, 346,-103,   0,   0/
      DATA (MENA(I, 12), I = 1, 25) /
     1   0, 449, -70,-130,-137,   0,   0,   0,  33,-106,
     2-136, 594,-109, -57, -74,   0, -46,   0, 647,   0,
     3 -35, -69, -68, 590,   0/
      DATA (MENA(I, 13), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0, 346,-103,   0,   0/
      DATA (MENA(I, 14), I = 1, 25) /
     1   0,1394,2394,3394,   0, 406, 387, 388,   0,   0,
     2   0,   0, 369,   0, 468,   0,   0,   0,   0,   0,
     3   0,   0,-103,   0,   0/
      DATA (MENA(I, 15), I = 1, 25) /
     1   0,   0,   0,   0, 320, 428, 424, 425, 426,   0,
     2 371, 372, 373, 374, 375, 376, 377, 378, 379,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 16), I = 1, 25) /
     1 539, 540, 541, 542, 441, 442, 443, 444, 451,   0,
     2 -57, 445, 363, 331, 388, -75,   0,   0,   0,   0,
     3   0,   0,-103,   0,   0/
      DATA (MENA(I, 17), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 18), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0, 321, -40,
     2 -41, -34,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0, -42, -43,   0,   0/
      DATA (MENA(I, 19), I = 1, 25) /
     1   0, -44,   0,   0,   0,   0,   0, -91, -51, -96,
     2-125,   0,   0,   0, -74,   0,-122, -68,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 20), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 21), I = 1, 25) /
     1   0, 549,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0, 650,   0, 649,
     3 569, 570,-103,   0,   0/
      DATA (MENA(I, 22), I = 1, 25) /
     15414,1414,2414,3414,4414, 416,1416,2416,3416,4416,
     2   0,   0,   0,   0,   0, 458, -75,   0,   0,   0,
     3 182, 182,-103,   0,   0/
      DATA (MENA(I, 23), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 24), I = 1, 25) /
     1   0, 116,   0,   0,   0,   0, -68, 598, 537,   0,
     2 535,   0, 527, 528, 529, 532, -75,   0,   0,   0,
     3   0, 346,-103,   0,   0/
      DATA (MENA(I, 25), I = 1, 25) /
     1   0,   0,   0,   0, 469,   0,1543,2543,3543,4543,
     2   0,   0, 608,   0,   0,   0, 575, 571, 572, 573,
     3 574,   0,   0,   0,   0/
      DATA (MENA(I, 26), I = 1, 25) /
     1   0,   0,   0,   0,   0, 568,   0,   0, 503,-106,
     2   0,   0,   0,   0,   0,   0,   0,   0, 566,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 27), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 28), I = 1, 25) /
     1 581,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 29), I = 1, 25) /
     1 594, 629,   0,   0,   0,   0, 666,   0,   0,   0,
     2   0,   0, 613,   0, 593,   0, 613, 613,   0,   0,
     3   0, 636, 634,   0,   0/
      DATA (MENA(I, 30), I = 1, 25) /
     1   0, 346, 355, 212,   0,   0,   0,   0,   0,   0,
     2 353, 358, 357, 359,   0,   0, 356,   0,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 31), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3 640, 614,   0,   0,   0/
      DATA (MENA(I, 32), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0, 633, 634,   0,   0,   0,
     3   0,   0,   0,   0,   0/
      DATA (MENA(I, 33), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     3   0,   0,-103,   0,   0/
      DATA (MENA(I, 34), I = 1, 25) /
     1   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
     2   0,   0,   0,   0,   0, 633, 634,   0,   0, 657,
     3   0,   0,   0,   0,   0/
      DATA (OPTS(1, I), I = 1, 7) /
     1 'PlutonAuto', 'Calc All ', 'Calc Solv ', 'Addsym    ',
     2 'MULscanABS', 'Validation', 'System-S  '/
      DATA (IOPT(1, I), I = 1, 7) /1, -2, 1, 1, 2, -1, 2/
      DATA (OPTS(2, I), I = 1, 7) /
     1 'Ortep-Plot', 'Calc Intra', 'Calc K.P.I', 'Addsym-EQL',
     2 'ABSPsiScan', 'Asym-View ', 'fcf2hkl   '/
      DATA (IOPT(2, I), I = 1, 7) /1, -2, 1, -2, 2,  2, 2/
      DATA (OPTS(3, I), I = 1, 7) /
     1 'NewmanPlot', 'Calc Inter', 'Squeeze   ', 'Addsym-EXT',
     2 'ABSTompa  ', 'FCF-Valid ', 'Expand2P1 '/
      DATA (IOPT(3, I), I = 1, 7) /-4, -3, 2, -2, 2, 5, 1/
      DATA (OPTS(4, I), I = 1, 7) /
     1 'Ring-Plots', 'Calc Coord', 'Hybrid    ', 'Addsym-PLT',
     2 'ABSGauss  ', 'DifFourier', 'FCF-Gener '/
      DATA (IOPT(4, I), I = 1, 7) /-4, 1, 2, -2, 2, 2, 1/
      DATA (OPTS(5, I), I = 1, 7) /
     1 'Plane-Plot', 'Calc Metal', 'CalcFCFsqd', 'Addsym-SHX',
     2 'ABSXtal   ', 'ANALofVAR ', 'HKLF-Gener'/
      DATA (IOPT(5, I), I = 1, 7) /-4, 1, 3, -2, 2, 5, -5/
      DATA (OPTS(6, I), I = 1, 7) /
     1 'Polyhedra ', 'Calc Geom ', 'Contoursqd', 'Newsym    ',
     2 'ABSSphere ', 'ByvoetPair', 'HKL-Transf'/
      DATA (IOPT(6, I), I = 1, 7) /1, -2, 1, -2, 2, 5, 2/
      DATA (OPTS(7, I), I = 1, 7) /
     1 'ContourDif', 'Calc Hbond', 'Solv F3D  ', 'Nonsym    ',
     2 'ShxAbs    ', 'Asym-Expct', 'Exor-Res  '/
      DATA (IOPT(7, I), I = 1, 7) /2, -3, 1, -2, 2, 1, 2/
      DATA (OPTS(8, I), I = 1, 7) /
     1 'Contour-Fo', 'Calc TMA  ', 'Solv Plot ', 'LePage    ',
     2 'AnomDisVal', 'Asym-Valid', 'Anis-Res  '/
      DATA (IOPT(8, I), I = 1, 7) /2, -2, 1, 1, 1, 2, -2/
      DATA (OPTS(9, I), I = 1, 7) /
     1 'AutoMolFit', 'L.S.-Plane', 'CavityPlot', 'DelRed    ',
     2 'AnomDisPlt', 'SupplMater', 'Rename-RES'/
      DATA (IOPT(9, I), I = 1, 7) /1,  1, 1, 1, 1, 1, 1/
      DATA (OPTS(10, I), I = 1, 7) /
     1 'hkl2Powder', 'DihedAngle', '          ', 'Molsym    ',
     2 'MuPlot    ', 'Expect-hkl', 'Auto-Renum'/
      DATA (IOPT(10, I), I = 1, 7) /2, 1, 1, -2, 1, 1, -2/
      DATA (OPTS(11, I), I = 1, 7) /
     1 'SimPowderP', 'AngleLines', 'Flip Menu ', 'SPGRfromEX',
     2 '          ', 'CSD-Cell  ', 'Create-spf'/
      DATA (IOPT(11, I), I = 1, 7) /-8, 1, 2, 2, 1, -2, -5/
      DATA (OPTS(12, I), I = 1, 7) /
     1 'RadDistFun', 'AngLsplLin', 'Flip Show ', 'Asym      ',
     2 '          ', 'CSD-Quest ', 'Create-res'/
      DATA (IOPT(12, I), I = 1, 7) /1, 1, 2, 2, 1, -2, -5/
      DATA (OPTS(13, I), I = 1, 7) /
     1 'Patterson ', 'CremerPopl', 'Flip Patt ', 'ASYMaverFR',
     2 '          ', 'StructTidy', 'Create-cif'/
      DATA (IOPT(13, I), I = 1, 7) /2, -4, 2, 2, 1, 1, -2/
      DATA (OPTS(14, I), I = 1, 7) /
     1 'ShelxtPlot', 'BondValenc', 'Flipper 25', 'LePageTwin',
     2 'XtlPlanAgl', 'StrainAnal', 'Create-pdb'/
      DATA (IOPT(14, I), I = 1, 7) /1, -4, 2, 1, 1, 1, -2/
      DATA (OPTS(15, I), I = 1, 7) /
     1 'PlutONativ', 'Hfix - res', 'Structure?', 'TwinRotMat',
     2 'Xtal Habit', 'locCIF-acc', 'cif2shelxl'/
      DATA (IOPT(15, I), I = 1, 7) /1, 1, 2, 5, 1, -2, 2/
      DATA (MANUAL(I), I = 1, 18) /
     1 'NOMOVE                        Keep Coords as Input',
     2 'CALC (ALL)                    Exhaustive Derived Geometry',
     3 'END                           Normal End-of-Program',
     4 'STOP                          Forced End-of-Program',
     5 'QUIT                          Forced End-of-Program',
     6 'EXIT                          Forced End-of-Program',
     7 'ROUND ON/OFF (range)          Round On/Off (Def = ON, 2)',
     8 'PARENTHESES ON/OFF            Parenth. on/off Opt.(Def=ON)',
     9 'INCLUDE el1 (el2 .. )         Include Specified Element(s)',
     * 'EXCLUDE el1 (el2 .. )         Exclude Specified Element(s)',
     1 'INCLUDE METALS                Include Metal(s) Only',
     2 'EXCLUDE METALS                Exclude Metal(s) Only',
     3 'DOAC el1 (el2 ..)             Specify DO/AC Elements',
     4 'HBOND  (NORM) p1 p2 p3        Modify H-Bond Criteria',
     5 'GEOM at1                      Calc Dist and Angles for at1',
     6 'RING at1 at2 at3 (at4 ..)     Explicit ring specification',
     7 'LINE at1 at2                  Explicit Line specification',
     8 'FIT at11 at21 .. at1n at2n    FIT mol1 to Mol2'/
      DATA (MANUAL(I), I = 19, 36) /
     1 'INORG                         Force Inorganic Structure Type',
     2 'ORGA                          Force Organic Structure Type',
     3 'ORMA r11 r12 r13 .. r32 r33   CAD4-Orientation Matrix',
     4 'CALC INTRA                    Calculate Intramolecular Geom.',
     5 '     el1 p1 el2 p2 ..         Use Specified Elemental Radii',
     6 '     (A/U/E)WLSPL             Weighted Least-Squares',
     7 '     TOLA  p1                 Use Specified Tolerance Value',
     8 '     TOLEA p1                 Add Tol for EAlk/Alk-Non-M',
     9 '     TOLM  p1                 Add Tol for Metal-Metal',
     * '     NOTMA                    Do not Analyse Thermal Motion',
     1 '     NOBOND                   Do not Print Bond Data',
     2 '     NOANG                    Do not Print Angle Data',
     3 '     NOTOR                    Do not Print Torson Data',
     4 '     NOLSP                    Do not Print L.S.-planes',
     5 '     NORING                   Do not search for rings',
     6 '     MAXRING P1               Max RingSize ',
     7 '     NOSTD                    Do not Calculate s.u.',
     8 '     NOMOVE                   Do not Move Input Atom'/
      DATA (MANUAL(I), I = 37, 54) /
     1 '     NOSYMM                   Do not Apply any Symmetry',
     2 '     TOLP p1                  Max Dev. for Lspl Include',
     3 '     MAXDEV p1                Max Dev. from LSPL for Listing',
     4 '     NOSORT                   Do not SORT atoms',
     5 'CALC INTER (NOMOVE)           Calc. Inter-Mol. Geom with vdW.',
     6 '     TOLR p1                  Use Specified Tol. value  p1',
     7 '     el1 p1 (el2 p2 ..)       Use Spec. Contact Rad (p1 = 0)',
     8 'CALC HBONDS (NONA) P1 P2 P3   Calculate Hbonds [0.5,-.12,100]',
     9 'LIST RADII/CELL/SYMM          List Radii/Cell/Symm on Display',
     * 'INFO RADII/CELL/SYMM          List Radii/Cell/Symm on Display',
     1 'LIST ATOMS/BONDS (attyp)(res) List ATOMS/BONDS Data on Displ.',
     2 'INFO ATOMS/BONDS (attyp)(res) List ATOMS/BONDS Data on Displ.',
     3 'LIST UIJ                      List UIJ and U1, U2, U3',
     4 'INFO UIJ                      List UIJ and U1, U2, U3',
     5 'LIST IPR/PAR/IGBL (nr1 (nr2)) List Internal Parameters',
     6 'INFO IPR/PAR/IGBL (nr1 (nr2)) List Internal Parameters',
     7 'LIST FLAGS                    List Flag Array (Internal)',
     8 'INFO FLAGS                    List Flag Array (Internal)'/
      DATA (MANUAL(I), I = 55, 72) /
     1 'LIST GRAPHICS                 Display Graphics Status',
     2 'INFO GRAPHICS                 Display Graphics Status',
     3 'CALC GEOM (OMEGA/CSD/   Calc Bonds,Angles,Torsion only',
     4 '     SPF/SHELXL/PDB)       Opt. Generate Specified File',
     5 '     (NOMOVE) (EXPAND)        Output Expanded Molecule',
     6 '     (BOND) (ANGLE) (TORSION) Bonds Angles Torsion',
     7 'CALC TMA (CART)(HINC)         Thermal Motion Analysis only',
     8 '         (Rmax)               Maximum R-value (def. 0.25)',
     9 '         (Atmin)              Min Number of non-H atoms [6]',
     * 'SAVE                          Save instr. to be repeated',
     1 'CALC ADDSYM (el/EQUAL)(SAVE)  Test for Higher Symm. (for el)',
     2 '     (ang d1 d2)              Tolerances',
     3 'CALC NONSYM                   Test for Non-Cryst Symmetry',
     4 'CALC NEWSYM                   Test for additional symmetry',
     5 'LEPAGE                        Check for Higher Metrical Symm.',
     6 'EXPT                          Calc Expd # reflns for resoln',
     7 'CALC COORDN (p1)              Calc non-C,H Coordn with p1',
     8 '     (FIVE (tba))             Analyse for 5-coordn. (TBA)'/
      DATA (MANUAL(I), I = 73, 90) /
     1 '     (el1 p1 el2 p2 ..)       Coordn Calc for Specified Elem.',
     2 '     (NOANG)                  Suppress Angle Calculation',
     3 'CALC COORDN at1 p1 (NOANG)    Calc Coordination for Atom_name',
     4 'CALC METAL (p1)               Me-Me Scan (Def. = 10 Ang.)',
     5 'CALC DIST el (p1)             el-el Scan (Def. = 3 Ang.)',
     6 'DIST at1 at2                  Calc Specified Distance',
     7 'ANGL at1 at2 at3 (at4)        Calc Specified Angle',
     8 'TORS at1 at2 at3 at4          Calculate Spec. Torsion Angle',
     9 'LSPL at1 at2 at3 (at4 ..)     Explicit plane specification',
     * '     (DIST at3 ..)            Optional Additional Dist.',
     1 'PLOT (RING/PLAN/LSPL/RESD)    Gives L.S.-plane plot',
     2 '     (PERP/ALONG)             Perpendicular/Along',
     3 '     (DISPLAY/META)           Plot medium (Default DISPLAY)',
     4 'PLOT ADP                      Displacement Ellipsoid Plot',
     5 '     (COLOR)                  Color O, N and Halogen atoms',
     6 '     (ENVE/HETE/OCTA)         Ellipsoid Styles',
     7 '     (HATOM/NOHATOM)          Hatom/NoHatom Inclusion',
     8 '     (LABEL/NOLABEL)          Label/Nolabel Atoms'/
      DATA (MANUAL(I), I = 91, 108) /
     1 '     (PAREN/NOPAREn)          With/Without Parentheses',
     2 '     (MARGIN marg)            Overlap Margin (cm)',
     3 '     (RESIDUE resd)           Residue Number',
     4 '     (DISPLAY/META)           Plot medium (Default DISPLAY)',
     5 'PLOT NEWMAN (at1 at2)         NEWMAN-plot (Optional Bond)',
     6 '     (DISPLAY/META)(COLR)     Plot medium (Default DISPLAY)',
     7 'BOX (ON/OFF) (RATIO p1)       Outline and Text ON/OFF, ratio',
     8 'VIEW                          Default 0 0 0 setting',
     9 'VIEW (UNIT) XR p1 YR p2 ZR p3 Rot about XP,YP,ZP by p1,p2,p3',
     * 'VIEW MIN                      Minimum Overlap ADP Plot',
     1 'VIEW INVERT                   Invert Image',
     2 'SET PROB (10<-->90)           Set Probability Level (Def=50)',
     3 'SET IPR/PAR/IGBL/GL nr val    Set Parameter Values',
     4 'SET PRINTER LEVEL lev         Set Print Level (0/1/2/3/4)',
     5 'SET LABEL SIZE (size)         Set Label Size (ADP)',
     6 'SET WINDOW fraction           Set X-Window Size',
     7 'CALC SOLV                     Look for Solvent Acc Regions',
     8 '     (LIST)                   Print Sections'/
      DATA (MANUAL(I), I = 109, 125) /
     1 'CALC VOID (PROBE r) (PSTEP n) Look for holes',
     2 '     (LIST)                   Print Sections',
     3 'CALC SQUEEZE (ncyc)           Handle Solvent Area',
     4 'CALC FCF                      Generate Fo^2/Fc^2 CIF',
     6 'ABSG mu (n1 n2 n3) (NOCHECK)  Gaussian Abs. Corr.',
     7 'ABST mu (NOCHECK)             Analytical Abs. Corr.',
     8 'TABLE (SU/CIF/AC/JA/IC)       Generate Publication Tables',
     9 '     (NOHATOM)                Exclude H-Atoms',
     * '     (NORESIDUE)              No Residue Split-up',
     1 'JOIN  at1 at2 (DASH/LDASH)    Add (DASHED) Bond to PLOT List',
     2 'DETACH at1 at2                Delete Bond from PLOT List',
     3 'DEFINE at1 TO at2 ..aTn       Add BOND to Center-of-Grav.',
     4 '    (DASH/LDASH)              (Optionally (long)dashed)',
     5 'RADII BONDS (NORMAL bt r/     Modify Normal Bond radii',
     6 '     TO METAL bt r/           Modify radii to metals',
     7 '     TO H bt r/               Modify radii involving H',
     8 '     ALL bt r/LIST)           Set ALL radii / List Radii'/
      DATA (MANUAL(I), I = 127, 135) /
     1 '                              (-6 < bt < 6, radii in Ang',
     2 'MENU (ON/OFF)                 X-Window Menu On/Off',
     3 'ELLIPSOID (C/H/Other)         Modify ellipsoid plot types',
     4 '          type (lines)        (type = 0/1)',
     5 'CONTOUR (FO/DIFF/SQUEEZE)     Contour Plot (Fo=default)',
     7 '         TNCP                 3 non-collinear points',
     8 '         abcd                 ax + by + cz = d ',
     9 '         BIS                  bisect',
     * '         PERP                 Perp. to the plane 3 points'/
      DATA (PLUMAN(I), I = 1, 18) /
     1 'ANGLE atom-name1 atom-name2 atom-name3',
     2 'ANGSTROM (scale)',
     3 'ARU (color)(aru1 (aru2) ..(resd))',
     4 'ARU NONE/UNIQUE/INTER/RESTORE',
     5 'ATOM atom-name x y z (pop sigx sigy sigz sigpop)',
     6 'BOX  (ON/OFF[ON]) (SHRINK shr)  (RATIO ratio)',
     7 'BWC TYPE atom-type bwc (atom-type bwc ..)',
     8 'BWC (on/off)',
     9 'CELL (wavelength) a b c alpha beta gamma',
     * 'COLOR BLACK/RED/GREEN/BLUE/YELLOW/ORANGE/VIOLET/BROWN',
     1 'COLOR TYPE atom-type col (atom-type col ..)',
     2 'COLOR RESD (ON/OFF)',
     3 'COLOR ARU  (ON/OFF)',
     4 'COLOR (ON/OFF)',
     5 'COORD atom-name',
     6 'CPK   (SHADE (a1 a2 (d))/',
     7 '  COLOR (a1 a2 (d))/NET (nh nv)/CONTOUR (n)/SEGMENT/',
     8 '  BLACK/BWCOL/DOTS/GLOBE/CROSS/PARAL/MERID) (STICK) (SPOT)'/
      DATA (PLUMAN(I), I = 19, 37) /
     1 'CROT(X/Y/Z)(M) (step (nstep)) (COLOR[off])',
     2 'DEFINE Me# TO atom-name1 atom-name2 atom-name3 ...',
     3 'DEFINE TO/CG atom-name1 atom-name2 atom-name3 ...',
     4 'DELETE atom-type/atom-name .../aru',
     5 'DETACH (atom-name/atom-type (TO) atom-name/atom-type)',
     6 'DIR',
     7 'DIST atom-name1 atom-name2 (aru)',
     8 'END/ENDS',
     9 'ENTRY (nr/refcode)',
     * 'EXCLUDE atom-names/atom-types/ALL/NONE/ORIG/UNIQUE/',
     1 '  INTER/ZOMBIES/aru/resd',
     2 'GEOM atom-name',
     3 'INCLUDE atom-names/atom-types/ALL/NONE/ORIG/UNIQUE/',
     4 '  INTER/ZOMBIES/aru/resd',
     5 'INORG',
     6 'JOIN RADII (UNIQUE (EXPAND) (NOMOVE)) (TOLE tole)',
     7 '  ((TOL tol)/(n1 r1 n2 r2 ...))',
     8 'JOIN RADII INTER (HBONDS/XBONDS)(EXPAND)',
     9 '  (TOL tol)/(n1 r1 n2 r2 ...)'/
      DATA (PLUMAN(I), I = 38, 55) /
     1 'JOIN atom-name TO atom-name(s) (aru)',
     2 'JOIN atom-names/atom-types',
     3 'JOIN (NONE/INTRA)',
     4 'LABEL atname1(aru) (atname2(aru)) (...) (attype3(aru)) (..)',
     5 'LABEL (ON/OFF)/ALL/NONE/(UNITCELL) (ATOMS) (ARU) ',
     6 '  ((NO)PARENTHESES) (FULL/NUM)',
     7 'LATT (P/A/B/C/I/F) (C/A)',
     8 'LIST (ATOMS)(BONDS)(GRAPHICS)(LINES)(MATR)(ARU)(STATUS)(TYPES)',
     9 'LIST ATOM (atom-name/atom-type/INTER)/(RESD nr)',
     * 'LIST BOND (atom-name1 atom-name2/INTER)/(RESD nr)',
     1 'LIST CELL/SYMM/FLAGS',
     2 'LIST PAR (nr1 (nr2))',
     3 'LIST IPR (nr1 (nr2))',
     4 'MONO (PERSP d)',
     5 'NOMOVE (OFF)',
     6 'NOSORT',
     7 'OMIT OUTSIDE (xmin xmax ymin ymax zmin zmax/atom-name rad/0)',
     8 'OMIT aru ...(resd)'/
      DATA (PLUMAN(I), I = 56, 73) /
     1 'ORGA',
     2 'OVERLAP (MARGIN mrg) (SHADOW shad)((ON/OFF)/BA/BB[ON])',
     3 'PACK PLAN h k l d1 d2 RANGE xmin .. zmax (atom-name)',
     4 'PACK (RANGE xmin xmax ymin ymax zmin zmax (atom-name))',
     5 'PLOT (DISPLAY/META) (LIST) (3/2)',
     6 'PUT ARU/ATOM/atom-name/atom-type/OR/OA/OB/OC pos.',
     7 '(atom-name/atom-type/OR/OA/OB/OC position .. )',
     8 '  position: N, NE, E, SE, S, SW, W, NW, NUCL, AUTO',
     9 'QUIT/EXIT',
     * 'RADII ATOMS COVALENT/CPK/AUTO/ALL r',
     1 'RADII ATOMS atom-type1 r1 (atom-type2 r2 ... )',
     2 'RADII ATOMS atom-name1 r1 (atom-name2 r2 ... )',
     3 'RADII BONDS (DASH) ALL r n',
     4 'RADII BONDS (DASH) TO atom-name/atom-type r n',
     5 'RADII BONDS (DASH) atom-name1 atom-name2 r n',
     6 'RADII BONDS (DASH) INTER/NORMAL r n',
     7 'RADII BONDS TAPER t',
     8 'RENAME (atom-name/atom-type)/(at1 at2 (at3 at4 ..))'/
      DATA (PLUMAN(I), I = 74, 92) /
     1 'RESET',
     2 'RETRACE LABELS ((n) (d))',
     3 'ROD   (NUCL/SHADE (a1 a2 (d))/',
     4 '  COLOR (a1 a2 (d))/NET (nh nv)/CONTOUR/SEGMENT/',
     5 '  BLACK/BWCOL/DOTS/GLOBE/CROSS/PARAL/MERID) (SPOT)',
     6 'SAVE (AUTO)',
     7 'SEGMENT (plotstep (substep))',
     8 'SET (IPR/PAR) nr val',
     9 'SET WINDOW fraction',
     * 'SIZE sz (RATIO ra) (SCALE sc) (CHAR ch) (TITLE ti)',
     1 'SOLID (NUCL/SHADE (a1 a2 (d))/',
     2 '  COLOR (a1 a2 (d))/NET (nh nv)/CONTOUR (n)/SEGMENT/',
     3 '  BLACK/BWCOL/DOTS/GLOBE/CROSS/PARAL/MERID) (SPOT)',
     4 'SPGR space-group-name',
     5 'STEREO (SMALL) (RG/GR/RB/BR/CROSSED) (PERSP d)',
     6 'STICK (COLOR)',
     7 'STRAW (NUCL/SHADE (a1 a2 (d))/',
     8 '  COLOR (a1 a2 (d))/NET (nh nv)/CONTOUR (n)/SEGMENT/',
     9 'BLACK/BWCOL/DOTS/GLOBE/CROSS/PARAL/MERID) (SPOT)'/
      DATA (PLUMAN(I), I = 93, 110) /
     1 'STOP',
     2 'SYMM symmetry-operator',
     3 'TITL text',
     4 'TORSION atom-name1 atom-name2 atom-name3 atom-name4',
     5 'UNITCELL (OFF/ON) (rbo nli)',
     6 'UNLABEL (atom-names/atom-types/ALL/(UNITCELL) (ATOMS) (ARU)',
     7 'VIEW MATRIX r11,r12, .. ,r33 (rotations)',
     8 'VIEW MIN (rotations)',
     9 'VIEW UNIT (rotations)',
     * 'VIEW XO/YO/ZO (rotations)',
     1 'VIEW AFACE/BFACE/CFACE (rotations)',
     2 'VIEW ALIGN atom-name1 atom-name2 (ARU) WITH XP/YP (rotations)',
     3 'VIEW DIRECTION x y z (rotations)',
     4 'VIEW LINE atom-name1 atom-name2 (ARU/rotations)',
     5 'VIEW BISECT atom-name1 atom-name2 atom-name3 (rotations)',
     6 'VIEW PERP atom-name1 atom-name2 atom-name3 (rotations)',
     7 'VIEW CURRENT (rotations)',
     8 'VIEW INVERT (rotations)'/
      DATA (PLUMAN(I), I = 111, 116) /
     1 '  rotations:',
     2 '  (XROT xr)(YROT yr)(ZROT zr)(LROT lr x y z)(INVERT)',
     3 '  (OROT or x y z)(PROT pr x y z)(BROT br at-name1 at-name2)',
     4 'XROT xr',
     5 'YROT yr',
     6 'ZROT zr'/
      END
      SUBROUTINE PLUTON (MPLUT)
C *====================================================================C
C *                                                                    C
C *                          P L U T O N                               C
C *                       =================                            C
C *                                                                    C
C *         PROGRAM FOR THE AUTOMATED DISPLAY AND ANALYSIS OF          C
C *                                                                    C
C *                  CRYSTAL AND MOLECULAR STRUCTURES                  C
C *                           =========                                C
C *                                                                    C
C * (C) 1979-2014  A.L. SPEK, UTRECHT UNIVERSITY, THE NETHERLANDS.     C
C *                                                                    C
C *                         PROGRAM HISTORY                            C
C *                         ===============                            C
C * CDC NOS/BE        IMPLEMENTATION (PLUTO78/Clegg) & EXTENSION  1979 C
C * MICROVAX-II/VMS   IMPLEMENTATION & EXTENSION ................ 1986 C
C * IBM-PC/AT         IMPLEMENTATION ............................ 1986 C
C * CDC-CYBER -NOS/VE IMPLEMENTATION ............................ 1986 C
C * CONVEX-UNIX       IMPLEMENTATION ............................ 1989 C
C * SILICON-GRAPHICS  IMPLEMENTATION ............................ 1990 C
C * DECstation5000    IMPLEMENTATION & EXTENSION ................ 1990 C
C * IBM-RS/6000       IMPLEMENTATION ............................ 1992 C
C * 80386/Linux       IMPLEMENTATION ............................ 1992 C
C * SG-Challenge      IMPLEMENTATION ............................ 1993 C
C * AXP/OSF           IMPLEMENTATION ............................ 1993 C
C * DEC-Alpha         INTEGRATION within PLATON ................. 1997 C
C * MAC OSX           ........................................... 2009 C
C *                                                                    C
C * THIS VERSION INCLUDES  FEATURES FOR INTERACTIVE USE OF THE PROGRAM C
C * WITH                                             X-Window/UNIX     C
C *                HPGL,POSTSCRIPT                 - META FILE         C
C *                                                                    C
C *====================================================================C
C *                                                                    C
C * Acknowledgement: PLUTON has evolved by an evolutionary proces from C
C *                  the source code of PLUTO-78 (Motherwell & Clegg)  C
C *                  The current version probably doesn't contain any  C
C *                  original code and is several times larger than    C
C *                  the original.                                     C
C *********************************************************************C
C *********************************************************************C
C *====================================================================C
C *                      -------------                                 C
C *                      F  I  L  E  S                                 C
C *                      -------------                                 C
C *  UNIT 1  -  STANDARD PARAMETER INPUTFILE (SPF)                     C
C *  UNIT 2  -  DEFAULT INSTRUCTION FILE                               C
C *  UNIT 3  -  SAVE FILE FOR INSTRUCTIONS                             C
C *  UNIT 5  -  INTERACTIVE INPUT FROM CONSOLE                         C
C *  UNIT 6  -  INTERACTIVE OUTPUT TO  CONSOLE                         C
C *  UNIT 9  -  JOURNAL FILE OF INSTRUCTIONS                           C
C *                                                                    C
C *====================================================================C
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,
     2 NP37=191,NP38=150,NP39=30,NP43=12,NP45=2048,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2,  CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, J215*5, JK13*3, JK12*2, N12*3, LABP*2, BWCT*10,
     1          COLR*10
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /GGT / MEDIUM
      COMMON /PLU99A/ SFC(16)
      COMMON /PLU99B/ NUNIT(16), NSF, NFHAT
      CHARACTER SFC*2, CLR*7
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER BCKG*10, BCOL*10, HCOL*20, IFLNQ*10
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      LOGICAL OPEND
C * MPLUT = -1 - NATIVE, RENAME, HFIX, ANIS FLAGS
C * MPLUT =  0 - S-MODE
C * MPLUT =  1 - FROM PLATON & ADDSYM
      IGBL30 = 0
      IGBL8  = 0
      PAR40  = 0.0
C * MAIN PLUTON ROUTINE
      IF (MPLUT .NE. 0) THEN
        CLOSE (UNIT = LU1)
        IF (MPLUT .EQ. 1) THEN
          IF (IGBL(31) .NE. 0) THEN
            CLOSE (UNIT = LU2, ERR = 10)
   10       IGBL(31) = 0
            IGBL(2)  = 0
          END IF
          IGBL(23) = 0
        END IF
        IF (IABS(IGBL(8)) .EQ. 3) THEN
          IGBL(90) = 1
        ELSE
          IGBL(90) = 0
        END IF
        IGBL30 = IGBL(30)
        IGBL8  = IGBL(8)
        IF (IPR(504) .EQ. 1) IGBL(30) = 0
      ELSE
        INQUIRE (UNIT = LU23, OPENED = OPEND)
        IF (OPEND) CLOSE (UNIT = LU23)
      END IF
      CALL PLUT01 (-1)
C * LOOP: READ AND INTERPRET UNTIL FIRST PLOT INSTRUCTION
   20 IF (IGBL(2) .GT. 0) THEN
        IF (IGBL(50) .EQ. 0) THEN
          CALL PLA013 (0, 1)
          IF (IGGT(1:3) .EQ. 'END') IGBL(2) = -1
        ELSE
          IF (IGBL(3) .EQ. 13) THEN
            CALL PLA280 ('HFIX')
          ELSE IF (IGBL(3) .EQ. 26) THEN
            CALL PLA280 ('ANIS')
          END IF
        END IF
        WRITE (LU6, 99987, IOSTAT = IOST) IGBL(2)
      END IF
      IGBL(2)  = IGBL(2) + 1
      IF (IGBL(2) .EQ. 0) GO TO 340
C * INITIALISE
      ISW = 0
   30 CALL PLUT01 (0)
      IF (IGBL(35) .EQ. 1) GO TO 60
      IGBL(24) = 1
      IF (IGBL(5) .EQ. LU23) IGBL(5) = LU5
C * ALL DATA CARDS READ HERE (UNIT IGBL(5) = LU1, LU23, LU3 OR LU5)
C * LU1  = CRYSTALLOGRAPHIC PARAMETER DATA
C * LU23 = DEFAULT INSTRUCTIONS
C * LU3  = SAVE FILE INSTRUCTIONS
C * LU5  = INTERACTIVE INPUT INSTRUCTIONS
   40 CALL GEN038 (IGGT, 1, 80)
      IF (IGBL(5) * IGBL(24) * IGBL(25) .EQ. LU5) THEN
        IF (IGBL(50) .EQ. 0) THEN
          CALL PLA013 (0, 1)
          IF (IGGT(1:1) .EQ. ' ') GO TO 40
        ELSE
          GO TO 330
        END IF
      END IF
      GO TO 60
   50 IF (IGBL(5) * IGBL(24) * IGBL(25) .EQ. LU5) THEN
        IF (IGBL(35) .NE. 1) GO TO 40
        CALL PLA280 ('PLOT')
      END IF
   60 CALL PLA006 (1, ISW)
      IF (IGBL(8) .EQ. 0) THEN
        IF (ICL(1:1) .EQ. '#') GO TO 60
      END IF
      IPR(170) = 0
      IF (ISW .GT. 1) THEN
        IF (IGBL(5) .EQ. LU5 .AND. IGBL(45) .GT. 0) THEN
          WRITE (LU3, 99965, IOSTAT = IOST) ICL(1:80)
          WRITE (LU6, 99978, IOSTAT = IOST) ICL(1:70)
          IF (ISW .NE. 14) THEN
            IGBL(45) = IGBL(45) + 1
          ELSE
            IGBL(45) = -1
          END IF
        END IF
      ELSE IF (ISW .LT. 1) THEN
        GO TO 290
      END IF
      KL = IPR(220)
      KN = IPR(221)
      IF (KL .EQ. 0 .AND. KN .EQ. 0) GO TO 60
C * ISW = 1:
      IF (ISW .EQ. 1) THEN
        GO TO 160
C * ISW = 2: TITL - TITLE FOR PLOT
      ELSE IF (ISW .EQ. 2) THEN
        JID(1:74) = ICL(5:78)
        GO TO 260
C * ISW = 3: MESS - MESSAGE DISPLAY
      ELSE IF (ISW .EQ. 3) THEN
        WRITE (LU6, 99967, IOSTAT = IOST) ICL(5:80)
        GO TO 260
C * ISW = 4: REMARK
      ELSE IF (ISW .EQ. 4) THEN
        GO TO 260
C * ISW = 5: CELL CONSTANTS
      ELSE IF (ISW .EQ. 5) THEN
        IF (KN .EQ. 1) THEN
          FN(2)    = FN(1)
          FN(3)    = FN(1)
          IPR(221) = 3
          KN       = IPR(221)
        END IF
        IF (KN .EQ. 3) THEN
          FN(4)    = 90.0
          FN(5)    = 90.0
          FN(6)    = 90.0
          IPR(221) = 6
          KN       = IPR(221)
        END IF
        IF (KN .EQ. 6) THEN
          KN7 = 0
        ELSE IF (KN .EQ. 7) THEN
          KN7 = 1
        ELSE
          IPR(72) = 1
          GO TO 260
        END IF
        DO I = 1, 6
          PAR(100 + I) = FN(I + KN7)
        END DO
        IPR(50) = 0
        GO TO 260
C * ISW = 6: SPGR
      ELSE IF (ISW .EQ. 6) THEN
        GO TO 150
C * ISW = 7: LATT
      ELSE IF (ISW .EQ. 7) THEN
        GO TO 150
C * ISW = 8: LIST
      ELSE IF (ISW .EQ. 8) THEN
        GO TO 280
C * ISW = 9: SYMM
      ELSE IF (ISW .EQ. 9) THEN
        GO TO 150
C * ISW = 10: ANGSTROM
      ELSE IF (ISW .EQ. 10) THEN
        IF (KL .EQ. 1) THEN
          IF (IPR(50) .EQ. 0 .AND. PAR(101) .GT. 0.0) THEN
            IPR(156) = 1
          ELSE
            IPR(50) = - 1
            IF (KN .GE. 1) PAR(11) = FN(1)
          END IF
        END IF
        GO TO 260
C * ISW = 11: ROD MODE
      ELSE IF (ISW .EQ. 11) THEN
        IF (IPR(4) .NE. 2 .OR. KL .EQ. 1) THEN
          IPR(4) = 2
          CALL PLUT21 (-1)
        END IF
        GO TO 210
C * ISW = 12: ATOM
      ELSE IF (ISW .EQ. 12) THEN
        GO TO 160
C * ISW = 13: JOIN (CALC)
      ELSE IF (ISW .EQ. 13) THEN
        GO TO 180
C * ISW = 14: END
      ELSE IF (ISW .EQ. 14) THEN
        IF (IGBL(5) .EQ. LU1 .AND. IGBL(8) .EQ. 2 .AND.
     1      IGBL(95) .NE. 0) THEN
          GO TO 40
        ELSE
         GO TO 300
        END IF
C * ISW = 17: U
      ELSE IF (ISW .EQ. 17) THEN
        GO TO 170
C * ISW = 18/161: VIE(W)
      ELSE IF (ISW .EQ. 18 .OR. ISW .EQ. 161) THEN
        CALL PLUT06
        GO TO 260
C * ISW = 19/162: SOL(ID) MODE
      ELSE IF (ISW .EQ. 19 .OR. ISW .EQ. 162) THEN
        IF (IPR(4) .NE. 1 .OR. KL .EQ. 1) THEN
          IPR(4) = 1
          CALL PLUT21 (-1)
        END IF
      GO TO 210
C * ISW = 20/163: STI(CK) MODE
      ELSE IF (ISW .EQ. 20 .OR. ISW .EQ. 163) THEN
        IPR(4) = 0
        CALL PLUT21 (-1)
        GO TO 210
C * ISW = 21/158: LAB(EL) - INSTRUCTION
      ELSE IF (ISW .EQ. 21 .OR. ISW .EQ. 158) THEN
        CALL PLUT04 (2, 0)
        GO TO 260
C * ISW = 22/164: UNL(ABEL) - INSTRUCTION
      ELSE IF (ISW .EQ. 22 .OR. ISW .EQ. 164) THEN
        CALL PLUT04 (3, 0)
        GO TO 260
C * ISW = 23: PUT INSTRUCTION
      ELSE IF (ISW .EQ. 23) THEN
        CALL PLUT04 (4, 0)
        GO TO 260
C * ISW = 24: RADII - INSTRUCTION
      ELSE IF (ISW .EQ. 24) THEN
        CALL PLUT21 (0)
        GO TO 260
C * ISW = 25/168: PAC(KING) DIAGRAM CONTROL
      ELSE IF (ISW .EQ. 25 .OR. ISW .EQ. 168) THEN
        IF (IPR(37) .EQ. IPR(69)) THEN
          WRITE (LU6, 99993, IOSTAT = IOST)
          IPR(72) = 8
        ELSE
          IF (IPR(17) .EQ. 0) THEN
            CALL PLUT05
            IF (IPR(72) .NE. 0) CALL GEN127 ('304')
          END IF
          CALL PLUT39
          IPR(46) = 1
        END IF
        GO TO 260
C * ISW = 26: MOLES/ARU
      ELSE IF (ISW .EQ. 26) THEN
        GO TO 220
C * ISW = 27/165: INC(LUDE)
      ELSE IF (ISW .EQ. 27 .OR. ISW .EQ. 165) THEN
        N = 1
        GO TO 250
C * ISW = 28/166: EXC(LUDE)
      ELSE IF (ISW .EQ. 28 .OR. ISW .EQ. 166) THEN
        N = 0
        GO TO 250
C * ISW = 29/167: UNITCELL TO BE PLOTTED(OR UNIT CARD)
      ELSE IF (ISW .EQ. 29 .OR. ISW .EQ. 167) THEN
        IF (IPR(37) .GT. IPR(69)) THEN
          IF (IPR(50) .EQ. 0) THEN
            IF (KL .GT. 1 .AND. IFL(2)(2:2) .EQ. 'F') THEN
              IPR(46) = 0
            ELSE
              IPR(46) = 1
            END IF
            DO I = 1, 8
              CALL PLUT15 (1, I, 27, IPR(46))
            END DO
            IF (KN .EQ. 2) THEN
              PAR(75)  = FN(1)
              IPR(107) = NINT(FN(2))
            END IF
            IPR(130) = 0
          ELSE
            GO TO 40
          END IF
        ELSE IF (IABS(IGBL(8)) .EQ. 2) THEN
          DO I = 1, KN
            NUNIT(I) = NINT(FN(I))
          END DO
          GO TO 260
        END IF
        GO TO 260
C * ISW = 30: RETRACE INSTRUCTION
      ELSE IF (ISW .EQ. 30) THEN
        IF (KN .GT. 0) THEN
          IF (KL .GT. 1) THEN
            IF (IFL(2)(1:1) .NE. 'L') THEN
              IF (IFL(2)(1:1) .EQ. 'A') THEN
                IPR(5) = NINT(FN(1))
                IF (KN .EQ. 2) PAR(3) = FN(2)
              ELSE
                IPR(72) = 5
              END IF
            ELSE
              IPR(7) = NINT(FN(1))
              IF (KN .GE. 2) PAR(4) = FN(2)
            END IF
          ELSE
            IPR(72) = 6
          END IF
        ELSE
          IPR(72) = 7
        END IF
        GO TO 260
C * ISW = 31: STEREO/MONO INSTRUCTION
      ELSE IF (ISW .EQ. 31) THEN
        PAR(25)  = 1.0
        IPR(130) = 0
        IPR(143) = IPR(19)
        IPR(144) = IPR(19)
        IF (ICL(1:1) .EQ. 'S') THEN
          IPR(116) = -1
          PAR(48)  = PAR(12)
          IPR(6)   = 1
          IF (PAR(18) .LT. 0) PAR(18) = - PAR(50) / 2.0
        ELSE IF (ICL(1:1) .EQ. 'M') THEN
          IPR(346) = IABS(IPR(346))
          IPR(116) = 0
          PAR(48)  = 0.0
          IPR(6)   = 0
          IF (PAR(18) .LT. 0) PAR(18) = - PAR(50)
        END IF
        IF (KL .GT. 1) THEN
          DO II = 2, KL
            IF (IFL(II)(1:1) .EQ. 'R' .OR. IFL(II)(1:1) .EQ. 'G') THEN
              IPR(6)   = 0
              IPR(477) = 0
              IF (IFL(II)(1:1) .EQ. 'R') THEN
                IPR(346)   = - IABS(IPR(346))
                IPR(143)   = 2
                IF (IFL(II)(2:2) .EQ. 'B') THEN
                  IPR(144) = 4
                ELSE
                  IPR(144) = 3
                END IF
              ELSE
                IPR(346)   = - IABS(IPR(346))
                IPR(144)   = 2
                IF (IFL(II)(1:1) .EQ. 'B') THEN
                  IPR(143) = 4
                ELSE
                  IPR(143) = 3
                END IF
              END IF
              IF (PAR(18) .LT. 0) PAR(18) = - PAR(50)
            ELSE IF (IFL(II)(1:1) .EQ. 'C') THEN
              IPR(6)      = -1
            ELSE IF (IFL(II)(1:1) .EQ. 'S') THEN
              PAR(25) = 0.5
            ELSE IF (IFL(II)(1:1) .EQ. 'P') THEN
              PAR(48) = PAR(12)
              IF (KN .GT. 0) THEN
                IF (FN(1) .GT. 0.1) THEN
                  PAR(48) = FN(1)
                  IF (PAR(48) .GE. 10000.0) PAR(48) = 0.0
                END IF
              END IF
            END IF
          END DO
        END IF
        GO TO 260
C * ISW = 33: SIZE CONTROL: SIZE OF DRAWING, SCALE, LABELS,TITLE
      ELSE IF (ISW .EQ. 33) THEN
        IF (IGBL(8) .NE. 2) THEN
          IF (KN .NE. KL) GO TO 70
          IPR(130) = 0
          DO K = 1, KL
            JK13 = IFL(K)(1:3)
            IF (JK13 .EQ. 'SIZ') THEN
              PAR(15) = FN(K)
            ELSE IF (JK13 .EQ. 'RAT') THEN
              PAR(18) = FN(K)
            ELSE IF (JK13 .EQ. 'SCA') THEN
              PAR(16) = FN(K)
            ELSE IF (JK13 .EQ. 'TIT') THEN
              PAR(14) = FN(K)
            ELSE IF (JK13 .EQ. 'CHA') THEN
              PAR(349) = FN(K)
            END IF
          END DO
   70     P15 = - PAR(15)
          WRITE (LU6, 99994, IOSTAT = IOST)
     1      PAR(18), PAR(14), P15, PAR(16), VERT, PAR(349)
          GO TO 260
        END IF
C * ISW = 34: PLOT INSTRUCTION
      ELSE IF (ISW .EQ. 34) THEN
        IPR(151) = 0
        IF (IPR(157) .GT. 0) THEN
          IPR(130) = 0
          IPR(157) = 0
        END IF
        GO TO 320
C * ISW = 35: RESET - SET DEFAULTS AND CLEAR FLAGS
      ELSE IF (ISW .EQ. 35) THEN
        CALL PLUT01 (1)
        GO TO 260
C * ISW = 36: SEGMENT = PLOTSTEP SIZE (CM)
      ELSE IF (ISW .EQ. 36) THEN
        IF (KN .GT. 0) THEN
          PAR(5) = FN(1)
          IF (KN .GT. 1) IPR(111) = NINT(FN(2))
        END IF
        WRITE (LU6, 99999, IOSTAT = IOST) PAR(5), IPR(111)
        GO TO 260
C * ISW = 38: HP MANAGEMENT
      ELSE IF (ISW .EQ. 38) THEN
        IPDC = -2
        IF (KL .GT. 1) THEN
          IF (IFL(1)(3:3) .EQ. 'P') IPDC = -4
          IF (IFL(2)(2:2) .EQ. 'N') IPDC = IABS(IPDC)
          CALL GGIP (-999.0, 0.0, 0.0, IPDC)
        END IF
        GO TO 260
C * ISW = 39: CAL MANAGEMENT
      ELSE IF (ISW .EQ. 39) THEN
        IPDC = -3
        IF (KL .GT. 1) THEN
          IF (IFL(1)(3:3) .EQ. 'P') IPDC = -4
          IF (IFL(2)(2:2) .EQ. 'N') IPDC = IABS(IPDC)
          CALL GGIP (-999.0, 0.0, 0.0, IPDC)
        END IF
        GO TO 260
C * ISW = 40: COLOR/BWC MANAGEMENT
      ELSE IF (ISW .EQ. 40) THEN
        IF (IFL(1)(1:3) .EQ. 'BWC') THEN
          IBWC = 1
        ELSE
          IBWC = 0
        END IF
        IF (KL .GT. 1) THEN
          JK13  = IFL(2)(1:3)
          KSTEP = IBWC + 1
          IF (JK13 .EQ. 'TYP') THEN
            IF (KL .GE. 3 .AND. MOD(KL, KSTEP) .EQ. 0) THEN
              DO K = 3, KL, KSTEP
                CALL PLUT13 (0, -K, N1, XDUM)
                IF (N1 .LT. 0) THEN
                  N1 = - N1
                  IF (IBWC .EQ. 1) THEN
                    DO J = 1, NP10 + 1
                      IF (IFL(K + 1)(1:3) .EQ. BWCT(J)(1:3)) GO TO 80
                    END DO
                    J        = 17
   80               IBCL(N1) = J
                  ELSE
                    IF (KN .GE. K - 2) IACL(N1) = NINT(FN(K - 2))
                    DO J = 1, NP10 + 1
                      IF (IFL(K + 1)(1:3) .EQ. COLR(J)(1:3)) GO TO 90
                    END DO
                    J        = 17
   90               IACL(N1) = J
                  END IF
                ELSE
                  WRITE (LU6, 99981, IOSTAT = IOST) IFL(K)
                END IF
              END DO
              IPR(90) = 256
            END IF
          ELSE IF (JK13 .EQ. 'RES') THEN
            IF (IFL(3)(1:3) .EQ. 'OFF') THEN
              IPR(346 - IBWC) = 0
              IPR(477 + IBWC) = 0
            ELSE
              IPR(346 - IBWC) = 1
              IPR(477 + IBWC) = -1
            END IF
          ELSE IF (JK13 .EQ. 'ARU') THEN
            IF (IFL(3)(1:3) .EQ. 'OFF') THEN
              IPR(346 - IBWC) = 0
              IPR(477 + IBWC) = 0
            ELSE
              IPR(346 - IBWC) = 1
              IPR(477 + IBWC) = 1
            END IF
          ELSE IF (JK13 .EQ. 'ON ') THEN
            IPR(346 - IBWC) = 1
          ELSE IF (JK13 .EQ. 'OFF') THEN
            IPR(346 - IBWC) = 0
          ELSE
            IPR(19) = 1
            IF (JK13 .EQ. 'RED') IPR(19) = 2
            IF (JK13 .EQ. 'GRE') IPR(19) = 3
            IF (JK13 .EQ. 'BLU') IPR(19) = 4
            IF (JK13 .EQ. 'YEL') IPR(19) = 5
            IF (JK13 .EQ. 'ORA') IPR(19) = 6
            IF (JK13 .EQ. 'VIO') IPR(19) = 7
            IF (JK13 .EQ. 'BRO') IPR(19) = 8
          END IF
        ELSE
          IF (IBWC .EQ. 1) THEN
            IPR(345) = 1
          ELSE
            IPR(346) = 1
          END IF
        END IF
        GO TO 260
C * ISW = 41: SET, PARAMETER MANIPULATION
      ELSE IF (ISW .EQ. 41) THEN
        IF (KL .GT. 1) THEN
          JK12 = IFL(2)(1:2)
          IF (IFL(2)(1:3) .EQ. 'IPR' .OR.
     1        IFL(2)(1:3) .EQ. 'PAR' .OR.
     2        IFL(2)(1:3) .EQ. 'IGB' .OR.
     3        IFL(2)(1:3) .EQ. 'RGB') THEN
            CALL PLA206 (1, IFL(2)(1:3))
            GO TO 40
          ELSE IF (JK12 .EQ. 'DI') THEN
            MEDIUM = 1
          ELSE IF (JK12 .EQ. 'ME') THEN
            MEDIUM = 2
          ELSE IF (JK12 .EQ. 'WI') THEN
            CALL GGIP (-999.0, 0.0, FN(1) * 1000.0, 9)
          ELSE IF (JK12 .EQ. 'RE') THEN
            IGBL(68) = MOD(IGBL(68) + 1, 2)
            CALL GGIP (-999.0, FLOAT(IGBL(68)), IGBL(62) * 0.25, 9)
          ELSE
            IPR(72) = 23
          END IF
          IF (IPR(72) .EQ. 0) THEN
            IF (KL .GT. 2) THEN
              CALL GGIP (-999.0, 0.0, 0.0, 6)
            END IF
          END IF
        END IF
        GO TO 260
C * ISW = 42: OMIT
      ELSE IF (ISW .EQ. 42) THEN
        N = 0
        GO TO 250
C * ISW = 43/49/150: QUIT/STOP/EXIT
      ELSE IF (ISW .EQ. 43 .OR. ISW .EQ. 49 .OR. ISW .EQ. 150) THEN
        GO TO 330
C * ISW = 44: RESI
      ELSE IF (ISW .EQ. 44) THEN
        IPR(538) = NINT(FN(1))
        GO TO 260
C * ISW = 45: ANGLE CALCULATION
      ELSE IF (ISW .EQ. 45) THEN
        IF (KL .EQ. 4) THEN
          CALL PLUT24 (3, 0, IDUM)
          GO TO 40
        ELSE
          GO TO 260
        END IF
C * ISW = 46: DETACH
      ELSE IF (ISW .EQ. 46) THEN
        GO TO 190
C * ISW = 47: SAVE COMMAND
      ELSE IF (ISW .EQ. 47) THEN
        IGBL(45) = 1
        CALL GEN108 (LU3, 0)
        GO TO 260
C * ISW = 48: OVERLAP OPTION OFF = 0, BA = 1, BB = 2, ON = 3
      ELSE IF (ISW .EQ. 48) THEN
        IF (KL .GT. 1) THEN
          N = 0
          DO K = 2, KL
            JK12 = IFL(K)(1:2)
            IF (JK12 .EQ. 'SH') THEN
              N = N + 1
              PAR(58) = FN(N)
            ELSE IF (JK12 .EQ. 'MA') THEN
              N = N + 1
              PAR(36) = FN(N)
            ELSE IF (JK12 .EQ. 'ON') THEN
              IPR(77) = 3
            ELSE IF (JK12 .EQ. 'AB') THEN
              IPR(77) = 2
            ELSE IF (JK12 .EQ. 'BA') THEN
              IPR(77) = 1
            ELSE IF (JK12 .EQ. 'OF') THEN
              IPR(77) = 0
            END IF
          END DO
        END IF
        WRITE (LU6, 99984, IOSTAT = IOST) IPR(77), PAR(36), PAR(58)
        GO TO 260
C * ISW = 51: BOX - INSTRUCTION
      ELSE IF (ISW .EQ. 51) THEN
        IF (KL .GT. 1) THEN
          IPR(130) = 0
          N = 0
          DO K = 2, KL
            JK12 = IFL(K)(1:2)
C * BOX OFF
            IF (JK12 .EQ. 'OF') THEN
              IGBL(103) = 0
C * BOX ON
            ELSE IF (JK12 .EQ. 'ON') THEN
              IGBL(103) = 1
C * BOX SHRINK
            ELSE IF (JK12 .EQ. 'SH') THEN
              N = N + 1
              IF (N .GT. KN) THEN
                IPR(72) = 12
                GO TO 260
              ELSE
                IF (FN(N) .LE. 1.0 .AND. FN(N) .GT. 0.01) THEN
                  PAR(13) = FN(N)
                ELSE
                  CALL PLUT38 (6, 0, LU6)
                END IF
              END IF
C * BOX RATIO
            ELSE IF (JK12 .EQ. 'RA') THEN
              N = N + 1
              IF (N .GT. KN) THEN
                IPR(72) = 13
                GO TO 260
              ELSE
                PAR(18) = FN(N)
              END IF
            END IF
          END DO
        END IF
        IF (IGBL(103) .EQ. 1) THEN
          N12 = 'ON '
        ELSE
          N12 = 'OFF'
        END IF
        WRITE (LU6, 99985, IOSTAT = IOST) N12, PAR(13), ABS(PAR(18))
        GO TO 260
C * ISW = 52: FVAR - SHELX76 STYLE
      ELSE IF (ISW .EQ. 52) THEN
        IGBL(8) = 2
        IPR(81) = 1
        IF (IPR(13) + KN .GT. NP14) CALL PLUT38 (7, 1, LU6)
        DO I = 1, KN
          RP(IPR(13) + I) = MOD(FN(I) + 5.0, 10.0) - 5.0
        END DO
        IPR(13) = IPR(13) + KN
        GO TO 260
C * ISW = 53: HELP OPTION
      ELSE IF (ISW .EQ. 53) THEN
        IWIN  = IGBL(25) * IGBL(32)
        CALL PLA299 (2)
        GO TO 260
C * ISW = 55: B-ISO
      ELSE IF (ISW .EQ. 55) THEN
        GO TO 170
C * ISW = 58: CPK STYLE
      ELSE IF (ISW .EQ. 58) THEN
        IF (IABS(IPR(4)) .NE. 3 .OR. KL .EQ. 1) CALL PLUT21 (1)
        GO TO 210
C * ISW = 59: SFAC - SHELX STYLE
      ELSE IF (ISW .EQ. 59) THEN
        IF (IABS(IGBL(8)) .NE. 2) THEN
          IGBL(8) = 2
          NSF     = 0
          NFHAT   = 0
        END IF
        DO I = 2, KL
          NSF = NSF + 1
          SFC(NSF) = IFL(I)(1:2)
          IF (SFC(NSF) .EQ. 'H ') NFHAT = 1
        END DO
        GO TO 260
C * ISW = 62: DISTANCE CALCULATION
      ELSE IF (ISW .EQ. 62) THEN
        CALL PLUT24 (2, 0, IDUM)
        GO TO 40
C * ISW = 63: TORSION CALCULATION
      ELSE IF (ISW .EQ. 63) THEN
        CALL PLUT24 (4, 0, IDUM)
        GO TO 40
C * ISW = 65: TRNS/TRMX INSTRUCTION
      ELSE IF (ISW .EQ. 65) THEN
        IF (KN .NE. 1) THEN
          IF (IPR(37) .LE. IPR(69)) THEN
            CALL GEN074 (XJX, 1, 12, 0.0)
            XJX(1) = 1.0
            XJX(5) = 1.0
            XJX(9) = 1.0
            IF (KN .EQ. 9 .OR. KN .EQ. 12) THEN
              IPR(127) = 1
              K        = 0
              DO I = 1, 3
                DO J = 1, 3
                  K = K + 1
                  TMX(I, J) = FN(K)
                  XJX(K)    = FN(K)
                END DO
              END DO
              CALL GEN003 (TMX, A, DET, 0)
              WRITE (LU6, 99973, IOSTAT = IOST) DET
              CALL GEN005 (A, TMY)
            END IF
            IF (KN .EQ. 3 .OR. KN .EQ. 12) THEN
              IPR(128) = 1
              DO I = 1, 3
                SHFT(I) = - FN(KN - 3 + I)
                XJX(I + 9) = - SHFT(I)
              END DO
            END IF
          ELSE
            WRITE (LU6, 99970, IOSTAT = IOST)
          END IF
        ELSE
          N = INT(ABS(FN(1)))
          IF (N .GT. IPR(48)) THEN
            WRITE (LU6, 99986, IOSTAT = IOST) N, FN(1), IPR(48)
          ELSE
            IF (FN(1) .LT. 0) THEN
              PAR(140) = FN(1)
            ELSE
              PAR(141) = FN(1)
            END IF
          END IF
        END IF
        GO TO 260
C * ISW = 67: INORG - INSTRUCTION
      ELSE IF (ISW .EQ. 67) THEN
        IGBL(97) = 0
        GO TO 260
C * ISW = 68: ORGA - INSTRUCTION
      ELSE IF (ISW .EQ. 68) THEN
        IGBL(97) = 1
        GO TO 260
C * ISW = 69: STRAW STYLE
      ELSE IF (ISW .EQ. 69) THEN
        IF (IPR(4) .NE. 4 .OR. KL .EQ. 1) THEN
          IPR(4) = 4
          CALL PLUT21 (-1)
        END IF
        GO TO 210
C * ISW = 70: INFO
      ELSE IF (ISW .EQ. 70) THEN
        GO TO 280
C * ISW = 72: CROT(X/Y/Z)(M) (STEPS, (NR-STEPS)) (COLOR) INSTRUCTION
      ELSE IF (ISW .EQ. 72) THEN
        IF (KN .GT. 0) PAR(145) = FN(1)
        IF (KN .GT. 1) IPR(152) = NINT(FN(2))
        IPR(346) = - IABS(IPR(346))
        IF (IABS(IPR(4)) .EQ. 3) IPR(4) = -3
        IGBL(35) = 1
        IF (IFL(1)(5:5) .EQ. 'X') THEN
          IPR(155) = 1
        ELSE IF (IFL(1)(5:5) .EQ. 'Z') THEN
          IPR(155) = 3
        ELSE
          IPR(155) = 2
        END IF
        IF (IFL(1)(6:6) .EQ. 'M') THEN
          IPR(164) = -1
        ELSE
          IPR(164) = 1
        END IF
        IPR(336) = 0
        IF (KL .GT. 1 .AND. IFL(2)(1:1) .EQ. 'C') IPR(336) = 1
        IPR(151) = IPR(152)
        IPR(130) = 0
        CALL GGIP (-999.0, 0.0, 0.0, -3)
        IPR(221) = 0
        KN       = IPR(221)
        IPR(220) = 1
        KL       = IPR(220)
        GO TO 320
C * ISW = 73: VIEW DEFINITION  XROT
      ELSE IF (ISW .EQ. 73) THEN
        CALL PLUT06
        GO TO 260
C * ISW = 74: VIEW DEFINITION YROT
      ELSE IF (ISW .EQ. 74) THEN
        CALL PLUT06
        GO TO 260
C * ISW = 75: VIEW DEFINITION ZROT
      ELSE IF (ISW .EQ. 75) THEN
        CALL PLUT06
        GO TO 260
C * ISW = 76: DEFINE INSTRUCTION (CREATE CENTROID PSEUDO-ATOM)
      ELSE IF (ISW .EQ. 76) THEN
        IF (IPR(17) .EQ. 0) THEN
          CALL PLUT05
          IF (IPR(72) .NE. 0) CALL GEN127 ('305')
        END IF
        IPR(130) = 0
        NATX     = IPR(38)  + 1
        NAT6     = NATX * NP43
        DO I = 1, 3
          RA(NAT6 + I) = 0.0
        END DO
        NQ1         = 'CG'//CHAR(IPR(160) + ICHAR('1'))//'    '
        CALL PLA046 (9, NQ1, NED, NQX, NSS, NQSM, INQNR, JNQNR, NIEN)
        RA(NAT6 + 7) = INQNR
        N0           = 0
        IF (KL .LT. 5) THEN
          IPR(72) = 9
          GO TO 260
        END IF
        DO I = 2, KL
          IF (IFL(I)(1:2) .EQ. 'TO') THEN
            IF (I .EQ. 2) THEN
              IPR(161) = -1
            ELSE IF (I .EQ. 3) THEN
              IPR(161) = 1
            ELSE
              IPR(72) = 10
              GO TO 260
            END IF
          ELSE IF (IFL(I)(1:2) .EQ. 'CG') THEN
            IF (I .EQ. 2) THEN
              IPR(161) = -2
            ELSE
              IPR(72) = 10
              GO TO 260
            END IF
          ELSE
            N = I
            CALL PLUT13 (0, N, IAT, XDUM)
            IF (IAT .EQ. 0) THEN
              IPR(72) = 11
              GO TO 260
            END IF
            IF (IPR(161) .NE. 0) THEN
              N0 = N0 + 1
              DO J = 1, 3
                RA(NAT6 + J) = RA(NAT6 + J) + RA(IAT * NP43 + J)
              END DO
              IF (N0 .EQ. 1) JAT = IAT
            END IF
          END IF
        END DO
        IF (N0 .EQ. 0) THEN
          IPR(71) = 0
          GO TO 260
        END IF
        DO I = 1, 3
          RA(NAT6 + I) = RA(NAT6 + I) / N0
        END DO
        IPR(38)  = NATX
        IPR(37)  = NATX
        IPR(160) = IPR(160) + 1
        CALL PLUT23 (NATX)
        RA(NAT6 + 8)  = RA(JAT * NP43 + 8)
        RA(NAT6 + 9)  = RA(JAT * NP43 + 9)
        RA(NAT6 + 10) = RA(JAT * NP43 + 10)
        RA(NAT6 + 11) = -1.0
        RA(NAT6 + 12) = RA(JAT * NP43 + 12)
        CALL PLUT25 (1, NATX, JUNK)
        IFL(KL + 1) = NQ1
        CALL PLUT25 (0, NATX, N1)
        IF (IPR(161) .EQ. -2) THEN
          IPR(161) = 0
          IF (IPR(4) .NE. 0 .AND. RADR(N1, 1) .EQ. 0.0)
     1      CALL PLUT21 (-1)
          GO TO 260
        ELSE
        IVAL = 0
        CALL PLUT15 (1, NATX, 27, IVAL)
          GO TO 190
        END IF
C * ISW = 78/157: REN(AME) ATOM LABELS
      ELSE IF (ISW .EQ. 78 .OR. ISW .EQ. 157) THEN
        IF (MOD(KL, 2) .EQ. 1 .OR. KL .EQ. 2) THEN
          CALL PLUT32
        ELSE
          IPR(72) = 25
        END IF
        GO TO 260
C * ISW = 79: GEOM CALCULATION AROUND ATOM
      ELSE IF (ISW .EQ. 79) THEN
        IPR(163) = 0
        CALL PLUT24 (1, IPR(38), IDUM)
        GO TO 40
C * ISW = 80: MENU (ON/OFF)
      ELSE IF (ISW .EQ. 80) THEN
        IF (KL .EQ. 2 .AND. IFL(2)(1:3) .EQ. 'OFF') THEN
          IGBL(25) = 0
        ELSE
          IGBL(25) = 1
        END IF
      GO TO 260
C * ISW = 84: PART - SHELXL STYLE
      ELSE IF (ISW .EQ. 84) THEN
        IPR(612) = NINT(FN(1))
        GO TO 260
C * ISW = 87: COORDN AROUND ATOM
      ELSE IF (ISW .EQ. 87) THEN
        IPR(163) = 1
        IF (IPR(44) - IPR(43) .EQ. 0) THEN
          IFL(4) = IFL(2)
          IFL(2)(1:5) = 'RADII'
          IFL(3)(1:5) = 'INTER'
          IPR(220) = 3
          KL       = IPR(220)
          CALL PLUT05
          IF (IPR(72) .NE. 0) CALL GEN127 ('306')
          IFL(2) = IFL(4)
          IPR(220) = 2
          KL       = IPR(220)
        END IF
        CALL PLUT24 (1, IPR(37), IDUM)
        GO TO 260
C * ISW = 89/159: DEL(ETE)
      ELSE IF (ISW .EQ. 89 .OR. ISW .EQ. 159) THEN
        N = 0
        GO TO 250
C * ISW = 90: ENTRY - READ UNTIL SPECIFIED FDAT-ENTRY FOR KN .NE. 0
      ELSE IF (ISW .EQ. 90) THEN
        CALL PLA009
        IF (ICL(1:4) .EQ. 'END ') THEN
          GO TO 300
        ELSE
          GO TO 260
        END IF
C * ISW = 91: DIR
      ELSE IF (ISW .EQ. 91) THEN
        CALL PLA009
        IF (ICL(1:4) .EQ. 'END ') THEN
          GO TO 300
        ELSE
          GO TO 260
        END IF
C * ISW = 92: HFIX (SHELXL ONLY)
      ELSE IF (ISW .EQ. 92) THEN
        IF (KN .GT. 0) GO TO 260
        IF (IGBL(50) .GT. 0) THEN
          IGBL(8) = - IABS(IGBL(8))
        END IF
        IF (IGBL(8) .EQ. -2) THEN
          IF (KL .EQ. 1) THEN
            KL0 = 1
          ELSE
            KL0 = 2
          END IF
          NHAUTO = IGBL(50)
          DO 130 KLI = KL0, KL
            IBEG = IPR(69) + 1
            IEND = IPR(39)
            IAT1 = 0
            IF (NHAUTO .EQ. 0) THEN
              IF (KLI .GT. 1) THEN
                CALL PLUT13 (0, KLI, IAT1, XDUM)
                IF (IAT1 .GT. 0) THEN
                  IF (KN .GT. 0) THEN
                    MNFIX = NINT(FN(1))
                    CALL PLUT29 (3, IFL(KLI), NQ2, MNFIX, 0)
                    GO TO 130
                  END IF
                  IBEG = IAT1
                  IEND = IAT1
                ELSE IF (IAT1 .EQ. 0) THEN
                  GO TO 130
                END IF
              END IF
            END IF
            DO 120 I = IBEG, IEND
  100         IAT = I
              IF (IPR(140) .NE. 0) THEN
                CALL PLUT15 (-6, IAT, 5, IVAL)
                IF (IVAL .NE. IPR(140)) GO TO 120
              END IF
              CALL PLUT15 (-1, IAT, 44, IHAT)
              IF (IHAT .EQ. 0) THEN
                CALL PLUT25 (1, IAT, IATK)
                IFL(2) = NQ1
                IF (IAT1 .LT. 0 .AND. -IAT1 .NE. IATK) GO TO 120
                CALL PLA046 (8, NQ1, NEI, NA, NAX, NS, IXPK1, IXPK2,
     1                       NIEN)
                NB = 1
                NE = 7
                CALL GEN039 (1, IFL(2), 1, 7, NB, NE)
                IPR(220) = 2
                CALL PLUT24 (-1, IPR(38), MNFX)
                IF (MNFX .GE. 0) THEN
                  CALL GEN040 (MNFX, NQ2, IP)
                  IF (NHAUTO .EQ. 0) THEN
  110               IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
                      PAR40 = NE * PAR(349) * PAR(19) / 2.0
                      NATL  = IPR(62) + I
                      IASU  = 0
                      CALL PLUT14 (-1, NATL, IASU, NPROP, XL, YL, ZL,
     1                             RL)
                      IFLNQ = IFL(2)(1:NE)//'['//NQ2(1:IP)//']'
                      CALL GGIP09 (0.0, IFLNQ, NE + IP + 2, PAR(349),
     1                  2, 2, XL - PAR40, YL - PAR(28))
                      SBCD      = 'HFIX '//IFL(2)//' mn['
                      SBCD(17:) =
     1                NQ2(1:IP)//'] or -1, AUTO, QUIT or END :'//CHAR(0)
                      CALL PLA013 (0, 1)
                      ICL = IGGT
                    ELSE
                      WRITE (LU6, 99968, IOSTAT = IOST) IFL(2), MNFX
                      READ  (LU5, 99965) ICL(1:80)
                    END IF
                    CALL GEN020 (1, ICL, 1, 4)
                    IF (ICL(1:4) .EQ. 'QUIT' .OR.
     1                  ICL(1:3) .EQ. 'END') THEN
                      GO TO 140
                    ELSE IF (ICL(1:4) .EQ. 'AUTO') THEN
                      NHAUTO = 1
                      MNFIX = MNFX
                    ELSE IF (ICL(1:4) .EQ. 'PLOT') THEN
                      CALL PLUT02
                      GO TO 100
                    ELSE IF (ICL(1:4) .EQ. 'VIEW') THEN
                      CALL PLA006 (1, IS)
                      CALL PLUT06
                      CALL PLUT02
                      GO TO 100
                    ELSE IF (ICL(1:1) .EQ. '!') THEN
                      IF (LRET .EQ. 2) THEN
                        CALL PLUT02
                        GO TO 100
                      ELSE
                        MNFIX = MNFX
                      END IF
                    ELSE
                      IF (ICL(1:4) .EQ. 'HFIX') THEN
                        MNFIX = 0
                      ELSE
                        READ (ICL, 99997, ERR = 110) MNFIX
                      END IF
                      IF (MNFIX .EQ. 0) MNFIX = MNFX
                    END IF
                  ELSE
                    MNFIX = MNFX
                  END IF
                  IF (MNFIX .GT. 0) WRITE (LU22, 99998, IOSTAT = IOST
     1            ) MNFIX, IFL(2)
                  CALL GEN038 (NQ2, 1, 7)
                  CALL PLUT29 (3, IFL(2), NQ2, MNFIX, 0)
                  CALL GGIP09 (0.0, IFLNQ, NE + IP + 2, PAR(349), 0, 2,
     1                XL - PAR40, YL - PAR(28))
                  CALL GGIP09 (0.0, IFL(2), NE, PAR(349), 1, 2,
     1                XL - PAR40, YL - PAR(28))
                END IF
              END IF
  120       CONTINUE
  130     CONTINUE
        END IF
  140   IF (IGBL(50) .EQ. 0) THEN
          CALL PLA280 ('PLOT')
          IF (IGBL(3) .EQ. 13) THEN
            IPR(332) = 1
            CALL PLA015 (332, 1)
          ELSE IF (IGBL(3) .EQ. 26) THEN
            IPR(352) = 1
            CALL PLA015 (352, 1)
          END IF
          IF (IPR(308) .NE. 0) IGBL(3) = 8
          GO TO 260
        ELSE
          IGBL(2) = 0
          CALL GEN038 (IGGT, 1, 80)
          GO TO 340
        END IF
C * ISW = 135: ANIS
      ELSE IF (ISW .EQ. 135) THEN
        WRITE (LU22, 99965, IOSTAT = IOST) ICL(1:80)
        IF (IGBL(8) .EQ. -2) THEN
          IF (KL .EQ. 1) THEN
            KL0 = 1
          ELSE
            KL0 = 2
          END IF
          MSUBST = 0
          CALL PLA281 (1, IFL(KL0), MSUBST)
          DO KLI = KL0, KL
            IAT1 = 0
            IF (KLI .GT. 1) THEN
              CALL PLUT13 (0, KLI, IAT1, XDUM)
              IF (IAT1 .GT. 0) THEN
                CALL PLUT29 (5, IFL(KLI), NQ2, 0, 0)
              END IF
            END IF
          END DO
        END IF
        IF (IGBL(3) .EQ. 26) THEN
          IPR(352) = 1
          CALL PLA015 (352, 1)
        END IF
        GO TO 260
C * ISW = 140: ENDS
      ELSE IF (ISW .EQ. 140) THEN
        GO TO 300
C * ISW = 143: NOMOVE
      ELSE IF (ISW .EQ. 143) THEN
        IF (IPR(17) .EQ. 0 .AND. IPR(127) .EQ. 0) THEN
          IF (KL .GT. 1 .AND. IFL(2)(1:3) .EQ. 'OFF') THEN
            IGBL(30) = 0
          ELSE
            IGBL(30) = 1
          END IF
        END IF
        GO TO 260
C * ISW = 144: RESD
      ELSE IF (ISW .EQ. 144) THEN
        IF (IPR(50) .EQ. 1) THEN
          IPR(135) = NINT(FN(1))
        ELSE
          IF (IPR(136) .NE. 0) THEN
            IPR(136) = NINT(FN(1))
          ELSE IF (IPR(37) .EQ. IPR(69)) THEN
            IPR(136) = NINT(FN(1))
          END IF
        END IF
        GO TO 260
C * ISW = 145: NOSORT OPTION
      ELSE IF (ISW .EQ. 145) THEN
        IGBL(33) = 0
        GO TO 260
C * 147: HALL
      ELSE IF (ISW .EQ. 147) THEN
        GO TO 150
C * ISW = 152: PORTRAIT
      ELSE IF (ISW .EQ. 152) THEN
        IGBL(46) = MOD(IGBL(46) + 1, 2)
        PAR(50)  = (4.0 - IGBL(46)) / 3.0
        PAR(18)  = - PAR(50)
        NN       = 4 - IGBL(46) * 8
        CALL GGIP (-999.0, 0.0, 0.0, NN)
        GO TO  260
C * ISW = 170: FIT => END
      ELSE IF (ISW .EQ. 170) THEN
        GO TO 330
      END IF
      GO TO 60
C * SPGR/LATT/SYMM/HALL - CARD
  150 IF ((ISW .EQ. 6 .OR. ISW .EQ. 9) .AND.
     1 (IGBL(8) .LE. 2) .AND.
     1     KL .EQ. 1 .AND. KN .EQ. 0) THEN
        WRITE (LU6, 99979, IOSTAT = IOST) ICL(1:4)
        GO TO 260
      ELSE IF (KL .EQ. 1 .AND. (KN .EQ. 9 .OR. KN .EQ. 12)) THEN
C * SYMM MATRIX INPUT: R11,R12,..,R33,(T1,T2,T3)
        ITRS = 15
        CALL SGSM (ICL, 0, FN, LU6, ITRS, IERR)
      ELSE
        IF (IPR(127) .EQ. 1 .OR. IPR(128) .EQ. 1) THEN
          ITRS = 16
        ELSE
          ITRS = 0
        END IF
        CALL SGSM (ICL, 0, XJX, LU6, ITRS, IERR)
      END IF
      CALL SGSM (ICL, 0, XXX, LU6, 18, IERR)
      SPGRNM(1) = ICL(1:26)
      IPR(48) = NINT(XXX(9))
      IF (IPR(48) .EQ. 0) THEN
        IPR(11) = 1
        WRITE (LU6, 99974, IOSTAT = IOST)
      END IF
      IF (IPR(48) .GT. 48) THEN
        IF (IPR(134) .NE. 9) WRITE (LU6, 99982, IOSTAT = IOST)
        IPR(134) = 9
        PAR(42)  = 10.0
      END IF
      IF (ICL(12:12) .EQ. 'h') THEN
        PAR(148) = 120.0
      ELSE
        PAR(148) = 90.0
      END IF
      GO TO 260
C * REAL OR POTENTIAL ATOM CARD
  160 IF (IPR(220) .EQ. 0 .AND. IPR(221) .EQ. 0) GO TO 60
      IF (IFL(1)(1:7) .EQ. 'CREATED') GO TO 60
      IF (IGBL(8) .EQ. 2) THEN
      END IF
      CALL PLUT03 (IER)
      IF (IER .NE. 0) IPR(72) = 2
      GO TO 260
C * U/B
  170 IF (KL .EQ. 1) THEN
        GO TO 160
      ELSE
        GO TO 260
      END IF
C * JOIN CARD - SETS UP CONNECTIONS
  180 IF (IPR(37) .GT. IPR(69)) THEN
        IMD      = 1
        IPR(110) = 0
        IF (KL .EQ. 1) THEN
          IF (IPR(17) .EQ. 0) THEN
            IMD = 0
          ELSE
            WRITE (LU6, 99971, IOSTAT = IOST)
            GO TO 260
          END IF
        ELSE IF (KL .EQ. 2) THEN
          J215 = IFL(2)(1:5)
          IF (J215 .EQ. 'INTRA') THEN
            IF (IPR(17) .EQ. 0) IMD = 0
          ELSE IF (J215 .EQ. 'UNIQU') THEN
            IF (IPR(17) .EQ. 0) IMD = 0
          ELSE IF (J215 .EQ. 'NONE ') THEN
            IPR(52) = IPR(68)
            IPR(53) = IPR(68)
            IPR(17) = 1
            IF (IPR(75) .EQ. 0) THEN
              CALL PLUT33
              IPR(75) = 1
              CALL PLUT17 (1555.0 + 1.0 / PAR(42), 0, MADDR, LU6)
              DO III = 1, 3
                RCG(1, III) = RA(NP43 + III)
              END DO
              RCG(1, 4) = IPR(37) - IPR(69)
            END IF
            GO TO 260
          ELSE IF (J215 .EQ. 'HBOND' .OR. J215 .EQ. 'XBOND') THEN
            IFL(2)(1:5) = 'RADII'
            IFL(3)(1:5) = 'INTER'
            IF (J215 .EQ. 'HBOND') THEN
              IFL(4)(1:6) = 'HBONDS'
            ELSE
              IFL(4)(1:6) = 'XBONDS'
            END IF
            IFL(5)(1:6) = 'EXPAND'
            IPR(220) = 5
            KL       = IPR(220)
            GO TO 180
          END IF
        ELSE IF (KL .GE. 3) THEN
          IF (IPR(17) .EQ. 0) THEN
            IF (IFL(3)(1:5) .EQ. 'INTER') THEN
              CALL PLUT05
              IF (IPR(72) .NE. 0) CALL GEN127 ('301')
            END IF
          END IF
        END IF
        GO TO 200
      ELSE
        WRITE (LU6, 99993, IOSTAT = IOST)
        IPR(72) = 3
        GO TO 260
      END IF
C * DETACH CARD
  190 IMD = -1
      IF (KL .EQ. 1) THEN
        IPR(52) = IPR(68)
        IPR(53) = IPR(68)
        IPR(17) = -1
        GO TO 260
      END IF
      IF (IPR(37) .LE. IPR(69)) THEN
        WRITE (LU6, 99993, IOSTAT = IOST)
        IPR(72) = 4
        GO TO 260
      END IF
      IF (IPR(52) .EQ. 0) THEN
        CALL PLUT05
        IF (IPR(72) .NE. 0) THEN
          IPR(72) = 0
          GO TO 60
        END IF
      END IF
  200 IPR(17) = IMD
      CALL PLUT05
      IF (IPR(72) .NE. 0) THEN
        IPR(72) = 0
        GO TO 60
      END IF
      IF (IABS(IPR(161)) .EQ. 1) THEN
        IMD      = 1
        IF (IPR(161) .EQ. -1) THEN
          IFL(2)   = IFL(KL + 1)
        ELSE
          IFL(3)   = IFL(KL + 1)
          IPR(220) = 3
          KL       = IPR(220)
        END IF
        IPR(161) = 0
        IF (IPR(4) .NE. 0 .AND. RADR(N1, 1) .EQ. 0.0) CALL PLUT21 (-1)
        GO TO 200
      END IF
      GO TO 260
  210 IPR(130) = 0
      IF (IPR(100) .EQ. 0) CALL PLUT33
      IPR(8)   = IPR(74)
      IPR(18)  = 0
      IPR(96)  = 0
      IPR(345) = 0
      IPR(346) = 0
      IPR(139) = 0
      PAR(130) = 0.0
      PAR(131) = 0.0
      PAR(125) = 5.25
C * LOOP OVER SUB-KEYWORD OPTIONS
      IF (KL .GT. 1) THEN
        DO K = 2, KL
          JK13 = IFL(K)(1:3)
          IF (JK13 .EQ. 'SPO') THEN
C * SET SPOT ON
            IPR(96) = 1
C * CPK/ROD/SOLID/STRAW GLOBE MODE
          ELSE IF (JK13 .EQ. 'GLO') THEN
            IPR(139) = 8
          ELSE IF (JK13 .EQ. 'CON') THEN
C * CPK/ROD/SOLID/STRAW CONTOUR MODE
            IPR(139) = 1
            IF (KN .EQ. 1) IPR(8) = NINT(FN(1))
          ELSE IF (JK13 .EQ. 'BLA') THEN
C * CPK/ROD/SOLID/STRAW BLACK MODE
            IPR(139) = 6
          ELSE IF (JK13 .EQ. 'SEG') THEN
C * CPK/ROD/SOLID/STRAW SEGMENT MODE
            IPR(139) = 4
C * CPK/ROD/SOLID/STRAW CROSS MODE
          ELSE IF (JK13 .EQ. 'CRO') THEN
            IPR(139) = 7
C * CPK/ROD/SOLID/STRAW PARALLEL MODE
          ELSE IF (JK13 .EQ. 'PAR') THEN
            IPR(139) = 9
C * CPK/ROD/SOLID/STRAW MERIDIAN MODE
          ELSE IF (JK13 .EQ. 'MER') THEN
            IPR(139) = 10
C * CPK/ROD/SOLID/STRAW DOTS
          ELSE IF (JK13 .EQ. 'DOT') THEN
            IPR(139) = 5
          ELSE IF (JK13 .EQ. 'NUC') THEN
C * CPK/ROD/SOLID NUCL MODE
            IPR(18) = 1
          ELSE IF (JK13 .EQ. 'SHA') THEN
C * CPK/ROD/SOLID SHADE MODE
            IPR(139) = 3
            IF (KN .GE. 2) THEN
              PAR(135) = FN(1)
              PAR(136) = FN(2)
              IF (KN .GT. 2)  PAR(134) = FN(3)
            END IF
          ELSE IF (JK13 .EQ. 'STI') THEN
C * CPK STICK MODE
            IF (IABS(IPR(4)) .EQ. 3) THEN
              IPR(4)      = -3
            END IF
          ELSE IF (JK13 .EQ. 'COL') THEN
C * CPK/ROD/SOLID COLOR (SHADE) MODE
            IPR(346) = 1
            IF (K .EQ. 2 .AND. K .EQ. KL) THEN
            END IF
          ELSE IF (JK13 .EQ. 'NET') THEN
C * CPK/ROD/SOLID NET MODE
            IPR(139) = 2
            IF (KN .EQ. 2) THEN
              IPR(85) = NINT(FN(1))
              IPR(86) = NINT(FN(2))
            END IF
          ELSE IF (JK13 .EQ. 'BWC') THEN
C * CPK/ROD/SOLID BWCOL MODE
            IPR(345) = 1
          END IF
        END DO
      END IF
      GO TO 260
C * ARU/MOLES (TO BE PLOTTED) - INSTRUCTION (SKIP MOLE IN SHELXS.RES)
  220 IF (IGBL(8) .NE. 2) THEN
        IF (KN .EQ. 0 .AND. KL .EQ. 1) THEN
          KL = 2
          IFL(1) = 'LIST'
          IFL(2) = 'ARU'
          GO TO 280
        ELSE
          CALL PLUT17 (0.0, 1001, MADDR, LU6)
          MODE = 0
          IF (KL .GT. 1) THEN
            IF (IFL(2)(1:4) .EQ. 'BOND') THEN
              KLM  = 3
              KADD = 64
            ELSE IF (IFL(2)(1:3) .EQ. 'BWC') THEN
              KLM  = 3
              KL   = 3
              KADD = 0
              GO TO 230
            ELSE
              KLM  = 2
              KL   = 2
              KADD = 0
            END IF
            DO K = 1, 9
              IF (IFL(KLM)(1:3) .EQ. COLR(K)(1:3)) THEN
                MODE = K + KADD
                KL   = 1
                GO TO 240
              END IF
            END DO
  230       DO K = 1, 17
              IF (IFL(KLM)(1:7) .EQ. BWCT(K)(1:7)) THEN
                MODE = K + 32 + KADD
                KL   = 1
                GO TO 240
              END IF
            END DO
          END IF
  240     IF (KN .GT. 0 .OR. KL .GT. 1) THEN
            IF (KN .GT. 0) THEN
              DO K = 1, KN
                FNK = FN(K)
                CALL PLUT17 (FNK, MODE, MADDR, LU6)
                IF (IPR(43) .GT. 1) CALL PLUT35 (FNK, 0)
              END DO
            END IF
            IF (KL .GT. 1) THEN
              DO K = 2, KL
                IF (IFL(K)(2:2) .EQ. ' ') THEN
                  CALL GEN105 (1, IFL(K)(1:1), K0)
                  IF (K0 .GT. 0) THEN
                    K0 = IPR(75) + K0 - ICHAR('A')
                    IF (K0 .LT. IPR(42)) THEN
                      XDUM = ABS(MOL(1, K0 + 1) / PAR(42))
                      CALL PLUT17 (XDUM, MODE, MADDR, LU6)
                    END IF
                  END IF
                END IF
              END DO
            END IF
          END IF
        END IF
      END IF
      GO TO 260
C * INCLUDE / EXCLUDE / OMIT / DELETE - INSTRUCTION
  250 IF (IGBL(8) .NE. 2) THEN
        IF (KL .GT. 1) THEN
          CALL PLUT09 (N, ISW)
        ELSE IF (KL .EQ. 1 .AND. KN .GT. 0) THEN
          DO I = 1, KN
            FN(I) = ((N * 2) - 1) * FN(I)
          END DO
          GO TO 220
        END IF
      END IF
C * GENERAL ERROR MESSAGE
  260 IF (IPR(72) .GT. 0) THEN
        IF (IGBL(5) .EQ. LU5)
     1    WRITE (LU6, 99983, IOSTAT = IOST) IPR(72), CHAR(7)
        IF (IPR(72) .EQ. 24) THEN
          ISW = 140
          GO TO 300
        END IF
        IPR(72) = 0
        GO TO 260
      ELSE
        IF (IGBL(5) .EQ. LU5) THEN
          IF (IFL(1)(1:3) .NE. 'REN') THEN
            WRITE (LU22, 99965, IOSTAT = IOST) ICL(1:80)
          END IF
          IF (IFL(1)(2:4) .EQ. 'ROT' .OR. IFL(1)(1:4) .EQ. 'VIEW') THEN
            IF (IGBL(35) .EQ. 1) THEN
              IPR(221) = 0
              KN       = IPR(221)
              IPR(220) = 1
              KL       = IPR(220)
              GO TO 320
            ELSE
              GO TO 40
            END IF
          END IF
        END IF
        IF (IPR(170) .EQ. 2) THEN
          IF (IPR(140) .GT. 0) THEN
            DO I = 1, IPR(39)
              CALL PLUT15 (-6, I,  5, IVAL)
              IF (IVAL .EQ. IPR(140)) THEN
                CALL PLUT15 (-1, I,  27, IVAL)
                IF (IVAL .EQ. 1) THEN
                  IPR(140) = -I
                  GO TO 270
                END IF
              END IF
            END DO
            IPR(140) = 0
          END IF
  270     WRITE (LU6, 99964, IOSTAT = IOST)
          CALL PLUT01 (2)
          CALL PLUT21 (-1)
          IPR(75) = 0
          IPR(17) = 0
          IGBL(5) = LU23
          CALL GEN108 (LU23, 0)
        END IF
      END IF
      GO TO 50
C * LIST/INFO ON DISPLAY OR TRAILER LISTING OF
C * SYMM/ATOM(S)/BOND(S)/ARU/MOLES/LINES LISTS ETC.
  280 IF (KL .GT. 1 .AND.
     1   (IFL(2)(1:3) .EQ. 'PAR' .OR. IFL(2)(1:3) .EQ. 'IPR') .OR.
     2    IPR(37) .GT. IPR(69)) THEN
        IPR(90)  = 510
        IPR(147) = 0
        IF (KL .GE. 2) THEN
          IPR(90)  = 0
          IGBL(31) = 0
          DO I = 2, KL
            JK13 = IFL(I)(1:3)
            IF (JK13 .EQ. 'CEL') THEN
              WRITE (BCD, 99980, IOSTAT = IOST)
     1          (PAR(100 + J), J = 1, 3),
     2          (ACOS(PAR(103 + J)) * RGBL(6), J = 1, 3), PAR(126),
     3          CHAR(0)
              IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
                IGBL(6) = - IABS(IGBL(6))
                CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 78.0, 111)
              ELSE
                WRITE (LU6, 99966, IOSTAT = IOST) BCD
              END IF
              GO TO 40
            ELSE IF (JK13 .EQ. 'INT') THEN
              IGBL(31) = 1
            ELSE IF (JK13 .EQ. 'RES') THEN
              IF (KN .EQ. 1) IPR(147) = NINT(FN(1))
            ELSE IF (JK13 .EQ. 'IPR' .OR.
     1               JK13 .EQ. 'PAR' .OR.
     2               JK13 .EQ. 'IGB' .OR.
     3               JK13 .EQ. 'RGB') THEN
              CALL PLA206 (-1, JK13)
              CALL GGIP(0.0,0.0,0.0,6)
              GO TO 40
            ELSE IF (JK13 .EQ. 'SYM') THEN
              IPR(90) = IPR(90) + 2
            ELSE IF (JK13 .EQ. 'ATO') THEN
              IPR(90) = IPR(90) + 4
            ELSE IF (JK13 .EQ. 'BON') THEN
              IPR(90) = IPR(90) + 8
            ELSE IF (JK13 .EQ. 'LIN') THEN
              IPR(90) = IPR(90) + 16
            ELSE IF (JK13 .EQ. 'ARU') THEN
              IPR(90) = IPR(90) + 32
            ELSE IF (JK13 .EQ. 'MOL') THEN
              IPR(90) = IPR(90) + 32
            ELSE IF (JK13 .EQ. 'MAT') THEN
              IPR(90) = IPR(90) + 64
            ELSE IF (JK13 .EQ. 'STA')  THEN
              IPR(90) = IPR(90) + 128
            ELSE IF (JK13 .EQ. 'TYP') THEN
              IPR(90) = IPR(90) + 256
            ELSE IF (JK13 .EQ. 'FLA') THEN
              IPR(90) = IPR(90) + 512
            ELSE
              CALL PLUT13 (0, -I , IAT, XDUM)
              IF (IAT .EQ. 0) THEN
                IPR(72) = 21
                GO TO 260
              END IF
            END IF
         END DO
        END IF
        CALL PLUT12
      ELSE
        IPR(72) = 22
      END IF
      GO TO 260
C * UNCHECKED EOF OR CTRL_D - HANDLING
  290 IF (IGBL(5) .EQ. LU1) THEN
        IF (IPR(39) .EQ. 0 .AND. IPR(50) .EQ. 1) GO TO 330
        IPR(47)  = IPR(47) + 1
        IF (IPR(47) .GT. 1) GO TO 330
      ELSE IF (IGBL(5) .EQ. LU23) THEN
        CALL GEN108 (LU23, 0)
        IGBL(5) = LU3
        GO TO 60
      ELSE IF (IGBL(5) .EQ. LU3) THEN
        CALL GEN108 (LU3, 0)
        IGBL(5)  = LU5
        IGBL(24) = IABS(IGBL(24))
        IF (IGBL(50) .EQ. 0) THEN
          IF (IGBL(24) * IGBL(25) .NE. 0) CALL PLA280 ('PLOT')
        END IF
        IPR(72) = 0
        GO TO 60
      ELSE IF (IGBL(5) .EQ. LU5) THEN
        GO TO 330
      END IF
C * END / ENDS / EOF - HANDLING
  300 IF (ISW .EQ. 140) THEN
        IF (IGBL(5) .EQ. LU1)
     1    WRITE (LU6, 99989, IOSTAT = IOST) JID(1:19)
        IF (IGBL(5) .EQ. LU5) THEN
          ICL(1:4) = '    '
          GO TO 310
        END IF
      ELSE
        IF (IGBL(5) .EQ. LU5) THEN
          IF (IGBL(8) .NE. 0) THEN
            IGBL(8) = IABS(IGBL(8))
            IF (IGBL(8) .NE. 2) THEN
              IGBL(5) = LU1
              GO TO 310
            END IF
          END IF
          GO TO 330
        END IF
      END IF
      IF (IABS(IGBL(8)) .EQ. 2) THEN
        IPR(47)  = IPR(47) + 1
        IGBL(8)  = 2
      END IF
      IGBL(8) = - IABS(IGBL(8))
      CALL GEN108 (LU3, 0)
      IF (IGBL(5) .EQ. LU1) THEN
        IGBL(5) = LU23
        CALL GEN108 (LU23, 0)
        GO TO 60
      END IF
      IF (ICL(1:4) .NE. 'ENDS') THEN
        IF (IGBL(5) .EQ. LU3 .AND. IPR(47) .EQ. 0) GO TO 310
        IF (IPR(47) .GT. 0) GO TO 330
      END IF
      IF (IGBL(5) .EQ. LU23) THEN
        IGBL(5) = LU3
        GO TO 60
      END IF
      IF (IGBL(5) .EQ. LU3) THEN
        IGBL(5)  = LU5
        IGBL(24) = IABS (IGBL(24))
        GO TO 60
      END IF
  310 IPR(61) = - 1
      GO TO 30
C * ENTRY FROM CROT, XROT, YROT, ZROT
  320 IPR(82)  = 0
      IPR(145) = 0
      IF (KL .GT. 1) THEN
        DO K = 2, KL
          JK13 = IFL(K)(1:3)
          IF (JK13 .EQ. 'LIS') THEN
            IPR(145) = 1
          ELSE IF (JK13 .EQ. 'POV' .OR. JK13 .EQ. 'PDB') THEN
            IPR(130) = 0
            IGBL(67) = 1
            IPR(82)  = 1
            IF (JK13 .EQ. 'PDB') THEN
              OPEN (UNIT = LU60,  FILE = NAMEFIL(1:KNMFIL)//'.ras',
     1                                          STATUS = 'UNKNOWN')
              IPR(10)  = 2
              IGBL(11) = 1
              CALL GEN108 (LU60, 0)
              WRITE (LU60, '(''HEADER'', 3X, A)', IOSTAT = IOST)
     1          JID(1:70)
              IPR(340) = 1
            ELSE
              OPEN (UNIT = LU61,  FILE = NAMEFIL(1:KNMFIL)//'.pov',
     1                                          STATUS = 'UNKNOWN')
              CALL GEN108 (LU61, 0)
              IPR(10)  = 1
              IGBL(98) = 1
              IF (IGBL(101) .EQ. 0) THEN
                BCKG = 'White '
                BCOL = 'Bronze'
                HCOL = 'rgb <0.6,0.6,0.6>'
              ELSE IF (IGBL(101) .EQ. 1) THEN
                BCKG = 'SummerSky '
                BCOL = 'LightGray'
                HCOL = 'White'
              ELSE IF (IGBL(101) .EQ. 2) THEN
                BCKG = 'Black '
                BCOL = 'LightGray'
                HCOL = 'White'
              ELSE IF (IGBL(101) .EQ. 3) THEN
                BCKG = 'Scarlet '
                BCOL = 'LightGray'
                HCOL = 'White'
              ELSE IF (IGBL(101) .EQ. 4) THEN
                BCKG = 'Silver'
                BCOL = 'Bronze'
                HCOL = 'rgb <0.6,0.6,0.6>'
              END IF
              WRITE (LU61, 99992, IOSTAT = IOST)
     1          ABS(PAR(18)), BCOL, HCOL
              WRITE (LU61, 99991, IOSTAT = IOST) BCKG
              DO I = 3, IAN
                ICOL = IACL(I)
                IF (ICOL .GT. 1 .AND. ICOL .LT. 9) THEN
                  CLR = COLR(ICOL)(1:7)
                  CALL GEN020 (0, CLR, 2, 7)
                ELSE
                  CLR = 'Coral  '
                END IF
                N2 = IEL(IEN(I))
                N1 = N2 / 100 + ICHAR('A') - 1
                N2 = MOD(N2, 100)
                IF (N2 .EQ. 0) THEN
                  N2 = ICHAR(' ')
                ELSE
                  N2 = N2 + ICHAR('a') - 1
                END IF
                WRITE (LU61, 99990, IOSTAT = IOST)
     1            CHAR(N1), CHAR(N2), CLR
              END DO
              WRITE (LU61, 99988, IOSTAT = IOST)
            END IF
          ELSE
            IPDC = -3
            IF (IFL(K)(1:1) .EQ. 'M' .OR. IFL(K)(1:1) .EQ. 'C')
     1        IPDC = -2
            CALL GGIP (-999.0, 0.0, 0.0, IPDC)
            IF (IFL(K)(1:1) .EQ. 'D') THEN
              IPDC = 2
              CALL GGIP (-999.0, 0.0, 0.0, IPDC)
            END IF
          END IF
        END DO
      END IF
      IF (IPR(37) .GT. IPR(69)) THEN
        IF (IPR(17) .EQ. 0) THEN
          CALL PLUT05
          IF (IPR(72) .NE. 0) GO TO 260
        END IF
        IF (IGBL(67) .EQ. 0) THEN
          WRITE (LU6, 99996, IOSTAT = IOST)
          IPR(220)    = 2
          KL          = IPR(220)
          IPR(221)    = 0
          KN          = IPR(221)
          IFL(2)(1:2) = 'MI'
          WRITE (LU6, 99996, IOSTAT = IOST)
          CALL PLUT06
        END IF
      ELSE
        WRITE (LU6, 99993, IOSTAT = IOST)
        IPR(72) = 24
      END IF
      IF (IPR(72) .NE. 0) GO TO  260
      GO TO 340
C * END OF JOB (STOP/EXIT)
  330 IGBL(2) = -1
C * EXECUTE THIS PLOT INSTRUCTION / ALL PLOTTING IS DONE IN PLUT02
C * END OF LOOP: TEST (IGBL(2) = 0)
  340 IF (IGBL(2) .GT. 0) THEN
        CALL PLUT02
        GO TO 20
      ELSE
        CALL GGIP (-PAR(64), -PAR(65), 0.0, -3)
        CALL GGIP (-XSH0,       -YSH0, 0.0, -3)
        CALL GGIP (0.0, 0.0, 0.0, 6)
        IPR(308) = 0
        CALL PLA015 (335, 0)
        CALL PLA015 (351, 0)
        CALL PLA015 (349, 0)
        CALL PLA015 (332, 0)
        CALL PLA015 (352, 0)
        IF (IGBL8 .NE. 0) THEN
          IGBL(30) = IGBL30
          IGBL(8)  = IGBL8
        END IF
      END IF
      RETURN
99999 FORMAT (':: PlotStep =', F4.2, ' cm., Number SubSteps =', I3)
99998 FORMAT ('HFIX', I3, 1X, A)
99997 FORMAT (I3)
99996 FORMAT (':: AEX:VIEW MIN')
99994 FORMAT (
     1 45X, ' RATIO', F6.3, ' TITL', F7.2, ' SIZE', F6.2, /,
     2 45X, ' SCALE', F6.2, ' YLIM', F7.2, ' CHAR', F6.2)
99993 FORMAT (':: NO Coordinates given')
99992 FORMAT ('#include "shapes.inc"', /,
     1        '#include "metals.inc"', /,
     2        '#include "colors.inc"', /,
     3        'global_settings {assumed_gamma 2.0}', /,
     4        'camera { location < 0, 0, +15> up < 0, 1, 0>',
     5        ' right <', F8.4, ', 0, 0> look_at < 0, -0.25, 0>',
     6        ' angle 15 }', /,
     7        'light_source  { < -1, 2, +2 > color White }', /,
     8        'light_source  { < 0, 1, +8 > color White }', /,
     9        '#declare color_bond = ', A, ' ;', /,
     *        '#declare finish_all = finish { phong 0.8 }', /,
     1        '#declare color_H = ', A, ' ;', /,
     2        '#declare color_C = rgb < 0.3, 0.3, 0.3 > ;')
99991 FORMAT ('background { color ', A, ' }')
99990 FORMAT ('#declare color_', 2A, ' = ', A, ' ;')
99989 FORMAT ( ':: Data Set : ', A, ' loaded')
99988 FORMAT ('union {' )
99987 FORMAT (/, ':: End Plot nr.', I3)
99986 FORMAT (/, ':: Symmetry # :', I4, ' in TRNS (', F8.3,
     1         ') OUT OF RANGE (', I3, '(Ignored)')
99985 FORMAT (':: BOX ',A, ' SHRINKAGE FACTOR:', F6.2,
     1 ' AND WINDOW RATIO:', F7.3)
99984 FORMAT (':: Overlap (OFF=0,BA=1,BB=2,ON=3)=', I2, ', Margin=',
     1        F5.2, ', Shadow = ', F5.2)
99983 FORMAT (':: Instruction Error(', I4,
     1        ') - Ignored , (see HELP ALL)', A)
99982 FORMAT (':: Note: Max. Number of Residues in limited to 9',/)
99981 FORMAT (':: ', A, 'is NOT an Atom-type (Ignored)')
99980 FORMAT ('CELL ', 3F10.4, 3F10.2, F12.2, A)
99979 FORMAT (/, ':: ', A, ' instruction ignored', /)
99978 FORMAT (':: Saved: ', A)
99974 FORMAT (/, ':: DATA will be SKIPPED until END-OF-SECTION')
99973 FORMAT (':: Transformation on Input Data: Det =', F6.3)
99971 FORMAT (':: JOIN Instruction Ignored')
99970 FORMAT (':: TRNS Instruction NOT ALLOWED here and IGNORED')
99968 FORMAT (/, 'HFIX ', A, ' mn[',I3,'] or Q[uit] :', $)
99967 FORMAT ('** ', A)
99966 FORMAT (/, A, /)
99965 FORMAT (A)
99964 FORMAT (':: RESET executed in view of deleted atom(s)',
     1        ' or change of Element type')
      END SUBROUTINE PLUTON
      SUBROUTINE PLUT01 (IMODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP31=34,NP32=63,
     2 NP35=110,NP38=150,NP39=30,NP43=12,NP45=2048,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /MEN/ MENA(25, NP31), MENS(25, NP31), MENU(50, NP31),
     1   MNH(NP35)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      LOGICAL OPEND
      IF (IMODE .EQ. -1) THEN
        CALL GEN038 (IGGT, 1, 80)
        IGBL(100) = 0
        IGBL(2)   = 0
        IGBL(5)   = 0
        IGBL(12)  = - IABS(IGBL(12))
        IGBL(6)   = 2
        IGBL(24)  = - IABS(IGBL(24))
        IGBL(27)  = 1
        IGBL(32)  = - IABS(IGBL(32))
        IPR(61)   = -1
        SBCD      = CHAR(0)
        IF (IGBL(3) .EQ. 8 .OR. IGBL(3) .EQ. 12 .OR. IGBL(3) .EQ. 13
     1                     .OR. IGBL(3) .EQ. 26) THEN
          IGBL(8)  = IABS(IGBL(8))
          IF (IGBL(8) .EQ. 3 .OR. IGBL(8) .EQ. 2) IPR(683) = 0
          IF (IGBL(3) .EQ. 26) IGBL(75) = 1
          IF (IGBL(20) .EQ. 1) THEN
            NAMEFIL  = 'satom'
            KNMFIL   = 5
            EXTENS   = 'spf'
            KXT      = 3
            IGBL(26) = 0
            INQUIRE (UNIT = LU98, OPENED = OPEND)
            IF (.NOT. OPEND) THEN
              OPEN (UNIT = LU98, STATUS = 'SCRATCH',
     1          FORM = 'FORMATTED')
            ELSE
              REWIND LU98
            END IF
            INQUIRE (UNIT = LU3, OPENED = OPEND)
            IF (.NOT. OPEND) THEN
              OPEN (UNIT = LU3, STATUS = 'SCRATCH',
     1          FORM = 'FORMATTED')
            ELSE
              REWIND LU3
            END IF
            INQUIRE (UNIT = LU23, OPENED = OPEND)
            IF (.NOT. OPEND) THEN
              OPEN (UNIT = LU23, FILE = NAMEFIL(1:KNMFIL)//'.def',
     1                                          STATUS = 'UNKNOWN')
            ELSE
              REWIND LU23
            END IF
            INQUIRE (UNIT = LU21, OPENED = OPEND)
            IF (.NOT. OPEND) THEN
              OPEN (UNIT = LU21,  FILE = NAMEFIL(1:KNMFIL)//'.new',
     1                                           STATUS = 'UNKNOWN')
            ELSE
              REWIND LU21
            END IF
            INQUIRE (UNIT = LU22, OPENED = OPEND)
            IF (.NOT. OPEND) THEN
              OPEN (UNIT = LU22,  FILE = NAMEFIL(1:KNMFIL)//'.pjn',
     1                                           STATUS = 'UNKNOWN')
            ELSE
              REWIND LU22
            END IF
          END IF
          FNLU1 = NAMEFIL(1:KNMFIL)//'.'//EXTENS
          KNMXT = KNMFIL + KXT + 1
          IF (IGBL(3) .EQ. 12 .OR. IGBL(3) .EQ. 13 .OR.
     1        IGBL(3) .EQ. 26) THEN
            IGBL(48) = 1
            IGBL(6)  = 3
          END IF
        ELSE
          IGBL(8) = 1
          FNLU1   = NAMEFIL(1:KNMFIL)//'_p.spf'
          KNMXT   = KNMFIL + 6
        END IF
        IF (IGBL(23) .EQ. 0 .AND. IGBL(3) .NE. 8) THEN
          CALL GEN108 (LU23, 0)
          WRITE (LU23, 99995, IOSTAT = IOST)
          IF (IGBL(75) .EQ. 1) WRITE (LU23, 99997, IOSTAT = IOST)
          IF (IGBL(87) * IGBL(67) .NE. 0) THEN
            WRITE (LU23, 99994, IOSTAT = IOST)
     1        RGBL(28), RGBL(29), RGBL(30)
            IF (IGBL(87) .LT. 0) WRITE (LU23, 99993, IOSTAT = IOST)
          END IF
          IF (IGBL(3) .EQ. 13 .AND. IGBL(50) .GT. 0) THEN
            WRITE (LU23, 99996, IOSTAT = IOST)
          ELSE
            WRITE (LU23, 99992, IOSTAT = IOST)
          END IF
          CALL GEN108 (LU23, 0)
        END IF
        INQUIRE (FILE = FNLU1, OPENED = OPEND)
        IF (OPEND) WRITE (6,'(''LU1 OPEN ALREADY'')', IOSTAT = IOST)
        OPEN (UNIT = LU1, FILE = FNLU1, STATUS = 'OLD', ERR = 10)
        WRITE (LU6, 99991, IOSTAT = IOST) FNLU1(1:KNMXT)
        GO TO 20
   10   WRITE (LU6, 99990, IOSTAT = IOST) FNLU1(1:KNMXT)
        LU1 = LU5
        GO TO 20
      ELSE IF (IMODE .EQ. 0) THEN
        IF (IPR(61) .EQ. 0) GO TO 20
        CALL GEN074 (PAR, 1, NP13, 0.0)
        CALL GEN048 (0, I, 0, I)
        IGBL(5) = LU1
        WRITE (LU6, 99999, IOSTAT = IOST) IGBL(4)
        IGBL(8) = IABS(IGBL(8))
        IAN     = 4
        DO I = 1, NP10
          IACL(I) = JACL(I)
          IF (I .GT. IAN) THEN
            IEN(I) = 0
          ELSE
            IEN(I) = I
            RADR(I, 3) = REL(IEN(I))
            RADR(I, 4) = ABS(VDWR(IEN(I)))
          END IF
          IENLB(I)   = 0
          RADR(I, 2) = 0.0
          RADR(I, 1) = 0.0
        END DO
        CALL GEN097 (MNH, 1, NP35, 0)
        MNH(6) = 2
        MNH(7) = 2
        DO I = 1, 31
          IBT(I) = 2**(I - 1)
        END DO
        CALL GEN097 (IPPR, 1, 3 * 129, 0)
        DO I = 1, 9
          NCRS(I) = I
        END DO
        DO I = 1, 17
          NPRS(I) = I
        END DO
        DO I = 1, 2
          DO J = 1, NP48
            MOL(I, J) = 0
          END DO
        END DO
        DO I = 1, 17
          CALL GEN048 (5, MOL(2, I), 1, I)
        END DO
        DO I = 1, 17
          CALL GEN048 (5, MOL(2, I), 6, I)
          CALL GEN048 (5, MOL(2, I), 11, I)
        END DO
        IPPR(1, 1) = 1000
        IPPR(1, 2) = 0
        IPPR(1, 3) = 1
        PAR(24)    = 0
        IF (IGBL(47) .GT. 0) THEN
          IPR(590) = 1
        ELSE
          IPR(590) = 0
        END IF
        PAR(22) = 0.3
        PAR(45) = 0.1
        PAR(42) = 100.0
        CALL GEN097 (IPR, 1, NP12, 0)
        CALL GEN038 (JID, 1, 80)
        IPR(460) = 3
        IPR(551) = 3
        IPR(9)  = 1
        IPR(50) = 1
        IPR(69) = 8
        IPR(37) = IPR(69)
        CALL SGSM (ICL, 0, XJX, LU6, 1, IERR)
        IPR(48) = 1
        IPR(134) = NP32
        IPR(36) = 0
        IPR(80) = NP49 - 100000
        IPR(76) = 100
        IPR(103) = 4035
        IPR(104) = 3060
        IPR(106) = 2120
        IPR(176) = 1
        CALL GEN038 (ICL, 1, 80)
        CALL PLUT29 (0, ICL, NQ1, 0, 0)
        DO I = 1, 8
          IVAL = 0
          CALL PLUT15 (6, I, 18, IVAL)
          IVAL = 1
          CALL PLUT15 (1, I, 27, IVAL)
          NM0   = I - 1
          IVERM = 8
          DO J = 1, 3
            IVERM            = IVERM / 2
            NMK              = NM0 / IVERM
            NM0              = NM0 - NMK * IVERM
            RA(I * NP43 + J) = FLOAT(NMK)
          END DO
          RA(I * NP43 + 7) = ICHAR(' ')
        END DO
        RA(NP43 + 7)     = ICHAR('O')
        RA(2 * NP43 + 7) = ICHAR('c')
        RA(3 * NP43 + 7) = ICHAR('b')
        RA(5 * NP43 + 7) = ICHAR('a')
      ELSE
        IF (IMODE .EQ. 1) THEN
          WRITE (LU6, 99998, IOSTAT = IOST)
          DO I = IPR(69) + 1, IPR(37)
            IVAL = 0
            CALL PLUT15 (1, I, 42, IVAL)
            IVAL = 0
            CALL PLUT15 (4, I, 37, IVAL)
            IVAL = 1
            CALL PLUT15 (1, I, 27, IVAL)
          END DO
        ELSE IF (IMODE .EQ. 2) THEN
          IPR(37) = IPR(39)
          IPR(38) = IPR(39)
          DO I = IPR(69) + 1, IPR(37)
            IVAL = 0
            CALL PLUT15 (16, I, 1, IVAL)
            IF (IPR(136) .EQ. IPR(69)) THEN
              IVAL = 1
            END IF
            CALL PLUT15 (6,  I, 5, IVAL)
            IVAL = 0
            CALL PLUT15 (3,  I, 24, IVAL)
            IVAL = 0
            CALL PLUT15 (4,  I, 33, IVAL)
          END DO
        END IF
      END IF
      CALL GEN038 (IGGT, 1, 80)
      IPR(142) = 0
      IPR(42)  = 0
      IPR(43)  = 0
      IPR(44)  = 0
      IPR(52)  = IPR(68)
      IPR(53)  = IPR(68)
      IF (IMODE .NE. 2) THEN
        CALL GEN021 (R, 1)
      ELSE IF (IMODE .EQ. 2) THEN
        GO TO 20
      END IF
      PAR(2) = 0.4
      PAR(5)  = 0.09
      PAR(3)  = 0.1
      PAR(4)  = 0.01
      PAR(11) = 1.0
      PAR(21) = 0.5
      PAR(349) = 0.25
      PAR(12) = 60.0
      PAR(13) = 0.9
      PAR(14) = 0.4
      PAR(15) = 0.0
      PAR(16) = 0.0
      PAR(17) = 3.0
      PAR(50) = (4.0 - IGBL(46)) / 3.0
      PAR(18) = - PAR(50)
      PAR(19) = 6.0 / 7.0
      PAR(25) = 1.0
      PAR(23) = 0.0195
      PAR(26) = 0.7
      PAR(36) = 0.1
      PAR(38) = 0.0
      PAR(39) = 0.2
      PAR(44) = 0.25
      PAR(48) = 0.0
      PAR(51) = 25.0
      PAR(52) = 15.0
      PAR(53) = 1.90
      PAR(54) = 0.15
      PAR(58) = 0.10
      PAR(60) = -100.0
      PAR(70) = 0.2
      PAR(75) = 0.01
      PAR(97) = 100.0
      PAR(125) = 5.25
      PAR(127) = - PAR(2)
      PAR(134) = 0.15
      PAR(135) = 120.0
      PAR(136) = -45
      PAR(140) = 0
      PAR(145) = 1.0
      PAR(149) = 0.05
      PAR(150) = 0.001
      PAR(350) = 0.50
      PAR(351) = 0.5
      PAR(352) = 0.5
      PAR(354) = 0.3
      PAR(461) = 2.25
      PAR(541) = 0.20
      PAR(542) = 0.35
      PAR(543) = 0.40
      PAR(544) = 0.20
      PAR(545) = 0.20
      PAR(546) = 0.3
      IPR(46)   = 0
      IPR(116) = 0
      IPR(4)   = 0
      IPR(74)  = 8
      IPR(15)  = 0
      IPR(17)  = 0
      IPR(18)  = 0
      IPR(54)  = 7
      IPR(65) = 1
      IPR(71)  = 0
      IPR(85)  = 24
      IPR(86)  = 24
      IPR(107) = 2
      IPR(109) = 0
      IPR(110) = 0
      IPR(111) = 4
      IPR(112) = 13
      IPR(117) = 0
      IPR(124) = 5000
      IPR(130) = 0
      IPR(131) = 4
      IPR(132) = 24
      IPR(152) = 100000
      IPR(153) = 0
      IPR(154) = 1
      IPR(165) = 2
      IPR(166) = 1
      IPR(171) = 1024
      IPR(172) = 768
      IPR(212) = 1
      IPR(480) = 11
      IPR(19)  = 1
      IPR(5)   = 1
      IPR(6)   = 0
      IPR(7)   = 1
      IF (IGBL(50) .EQ. 0) THEN
        IF (IGBL(20) .NE. 0) IPR(308) = 1
      END IF
   20 RETURN
99999 FORMAT (/, ':: Full Init - PLATON/PLUTON (', I8, ') - ',
     1 'type  HELP for information', /, 42X,
     2 ' or   PLOT for default plot', //,
     3 ' ********************************************************',/
     4 ' >> PLEASE type ''MENU OFF'' when you dont want the      <<',/,
     5 ' >>              MENU feature (X-window only!)         <<',/,
     6 ' ********************************************************',/)
99998 FORMAT (':: Partial Init')
99997 FORMAT ('LABEL')
99996 FORMAT ('PLOT CAL')
99995 FORMAT ('CREATED BY PLATON ', /,
     1        'STRAW COLOR')
99994 FORMAT ('VIEW UNIT XROT', F7.0, ' YROT', F7.0, ' ZROT', F7.0)
99993 FORMAT ('VIEW INVERT')
99992 FORMAT ('PLOT DISPLAY')
99991 FORMAT (/, ':: Data from: ', A, /)
99990 FORMAT (':: File ', A, ' NOT Available,',
     1        ' Interactive INPUT Assumed', /)
      END SUBROUTINE PLUT01
      SUBROUTINE PLUT02
      PARAMETER (NP0=6,NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,
     1 NP14=64,NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,
     2 NP37=191,NP38=150,NP39=30,NP43=12,NP45=2048,NP52=200,
     3 NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /NAMES/ NAMEFIL, EXTENS, PROGNM, FNLU1, FNLU16, RDTYPE,
     1 FILENAMES(2), XLDTP
      CHARACTER NAMEFIL*80, EXTENS*9, PROGNM*28, FNLU1*80, FNLU16*80,
     1 RDTYPE*7, FILENAMES*80, XLDTP*2
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER TXT3*40, PLPATH*255
      CHARACTER TXT2*6, KLEUR*10
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, COLR*10, BWCT*10
      INTEGER FINDEXE
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IF (IPR(140) .LT. 0) THEN
        IVL = - IPR(140)
        CALL PLUT15 (-6, IVL, 5, IPR(140))
        DO I = 1, IPR(42)
          XNM = ABS(MOL(1, I) / PAR(42))
          IRES = IABS(MOL(1, I)) - INT(XNM) * NINT(PAR(42))
          IF (IRES .NE. IPR(140)) THEN
            MOL(1, I) = - NINT(XNM * PAR(42))
          ELSE
            MOL(1, I) =   NINT(XNM * PAR(42))
          END IF
        END DO
      END IF
      IPR(45) = 0
      IF (IGBL(2) .GT. 0) THEN
        IF (IPR(130) .EQ. 0) THEN
          CALL PLUT17 (0.0, 0, MADDR, LU6)
          CALL PLUT17 (0.0, 1002, MADDR, LU6)
          IPR(62) = IPR(142) * (IPR(37) - IPR(69)) + IPR(69)
          IPR(59) = IPR(62) + IPR(37) * IPR(452)
          IF (IPR(63) .EQ. 0) THEN
            IPR(40) = IPR(59)
          ELSE
            IPR(40) = IPR(59) + IPR(42)
          END IF
          IPR(125) = (IPR(37) + 1) * NP43
          IPR(158) = IPR(125) + IPR(62) * IPR(82) * 4
          NSPC     = NP0
          IPR(157) = IPR(158)
          IPR(167) = IPR(158)  + IPR(62) * NP0
          IPR(168) = IPR(158)  + IPR(62) * NP0
          IF (IPR(151) .GT. 0) THEN
            IPR(158) = IPR(158) + IPR(62) * NP0
            NSPC     = 2 * NP0
            IF (IPR(116) .NE. 0) THEN
              IPR(167) = IPR(158) + IPR(62) * NP0
              IPR(168) = IPR(167) + IPR(62) * NP0
              NSPC     = 4 * NP0
            END IF
          END IF
          IF (IPR(157) + NSPC * IPR(40) .GE. IPR(64) - IPR(52) * 2)
     1      THEN
            CALL PLUT38 (5, 0, LU6)
            GO TO 90
          END IF
        END IF
        NAP  = 0
        NAT  = IPR(37)
        NATO = IPR(39)
        NMOL = IPR(42)
        NATL = IPR(62)
        NRES = IPR(75)
        ILPB = IPR(69) + 1
        NAB  = NAT - ILPB + 1
        DISK = PAR(35)**2
   10   IF (IPR(130) .EQ. 0) THEN
          IF (IPR(116) .LE. 0) THEN
            CALL GEN074 (PAR, 61, 63,  1E10)
            CALL GEN074 (PAR, 64, 66, -1E10)
            IF (IPR(49) .NE. 0) WRITE (IPR(49), 99995, IOSTAT = IOST)
            CALL GEN034 (RA, IPR(159) + 1 - IPR(142), IPR(159) - 1)
            NML = IPR(142)
            DO M = 1, NML
              IF (M .EQ. 1) THEN
                I1 = 1
              ELSE
                I1 = ILPB
              END IF
              XNM = NINT(RA(IPR(159) + 1 - M))
              MPM = NINT(XNM * PAR(42))
              CALL GEN098 (MPM, PAR(42), N, ITX, ITY, ITZ, NR)
              TRL(1) = ITX
              TRL(2) = ITY
              TRL(3) = ITZ
              DO J = 1, NRES
                KRS(J) = -1
              END DO
              DO J = 1, NMOL
                YNM = MOL(1, J) / PAR(42)
                ZNM = INT(YNM)
                IF (XNM .EQ. ZNM)
     1              KRS(NINT((YNM - XNM) * PAR(42))) = MOL(2, J)
              END DO
              DO I = I1, NAT
                INCLUDE = - 1
                DO J = 1, 3
                  XJX(J)     = RA(I * NP43 + J)
                  XJX(J + 3) = TRL(J)
                  XJX(J + 6) = XJX(J)
                END DO
                IF (I .GE. ILPB) THEN
                  CALL SGSM (ICL, N, XJX, LU6, 3, IERR)
                  IF (IPR(15) .GT. 0) THEN
                    DO J = 1, 6
                      JJJ  = (J + 1) / 2
                      JJJJ = JJJ * 2 - J
                      DIFF = XJX(JJJ + 6) - PAR(J + 28)
                      IF (DIFF .LT. 0.0) THEN
                        IF (JJJJ .NE. 0) GO TO 30
                      ELSE IF (DIFF .GT. 0.0) THEN
                        IF (JJJJ .EQ. 0) GO TO 30
                      END IF
                    END DO
                  ELSE IF (IPR(15) .LT. 0) THEN
                    GO TO 20
                  END IF
                END IF
                IDIS = 1000
                IF (IGBL(59) .NE. 0 .AND. I .GE. ILPB) THEN
                  CALL PLUT15 (-4, I, 28, IDIS)
                  IDIS   = IPPR(IDIS + 1, 1)
                END IF
                IF (IDIS .LT. 1000) THEN
                  IF (IGBL(88) .EQ. 0) THEN
                    IF (IDIS .GE. 500) INCLUDE = 1
                  ELSE
                    IF (IDIS .LE. 500) INCLUDE = 1
                  END IF
                ELSE
                  INCLUDE = 1
                END IF
   20           DO II = 1, 3
                  RA(II) = XJX(II + 6)
                END DO
                CALL PLUT23 (0)
                IF (IPR(15) .LT. 0) THEN
                  IF (I .GE. ILPB) THEN
                    DIS = 0
                    DO II = 4, 6
                      DIS = DIS +
     1                   (RA( - IPR(15) * NP43 + II) - RA(II))**2
                    END DO
                    IF (DIS .GT. DISK)  GO TO 30
                    INCLUDE = 1
                  END IF
                END IF
                CALL GEN002 (1, R, RA(4), XYZR, XLNG)
                IF (I .LE. NATO) THEN
                  J = I
                ELSE
                  XLAB = RA(I * NP43 + 7)
                  DO J = ILPB, NATO
                    IF (RA(J * NP43 + 7) .EQ. XLAB) GO TO 30
                  END DO
                  GO TO 40
                END IF
   30           CALL PLUT15 (-1, J, 27, NINCL)
                IF (NINCL .EQ. 0) INCLUDE = - 1
   40           IF (IPR(166) .EQ. 0) THEN
                  IF (I .GT. NATO) THEN
                    CALL PLUT15 (-6, I, 11, IRU)
                    MPM = IABS(MOL(1, IRU + 1))
                    CALL GEN098 (MPM, PAR(42), MS2, ITX, ITY, ITZ, MR2)
                    XJX(6) = ITX
                    XJX(7) = ITY
                    XJX(8) = ITZ
                    XJX(1) = N
                    XJX(2) = TRL(1)
                    XJX(3) = TRL(2)
                    XJX(4) = TRL(3)
                    XJX(5) = MS2
                    CALL SGSM (ICL, 0, XJX, LU6, 8, IERR)
                    NMZ = NINT(XJX(9)) * 1000 + NINT(XJX(10)) * 100
     1                  + NINT(XJX(11)) * 10  + NINT(XJX(12)) + 555
                    NMZ = NINT(NMZ * PAR(42)) + MR2
                    DO J = 1, NMOL
                      IF (NMZ .EQ. MOL(1, J)) GO TO 50
                    END DO
                    INCLUDE = -1
                  END IF
                END IF
   50           JOMIT = 0
                IF (IPR(4) .NE. 0 .AND. M .GT. 1 .AND.
     1            INCLUDE .EQ. 1) THEN
                  JO = ILPB - 1
                  II = IPR(158) + JO * NP0
                  DO N0 = ILPB, NAP
                    II = II + NP0
                    JO = JO + 1
                    IF (RA(II) .GT. 0.0) THEN
                      IF (ABS(RA(II - 3) - XYZR(1)) .LT. PAR(150))
     1                  THEN
                        IF (ABS(RA(II - 2) - XYZR(2)) .LT. PAR(150))
     1                    THEN
                          IF (ABS(RA(II - 1) - XYZR(3)) .LT. PAR(150))
     1                      THEN
                            IO = MOD(JO - ILPB, NAB) + ILPB
                            IF (IO .LE. IPR(39)) THEN
                              CALL PLUT15 (-1, IO, 27, NINC)
                              IF (NINC .EQ. 1) THEN
                                JOMIT = 1000
                                GO TO 60
                              END IF
                            END IF
                          END IF
                        END IF
                      END IF
                    END IF
                  END DO
                END IF
   60           NAP = NAP + 1
                IF (I .GE. ILPB) THEN
                  CALL PLUT15 (-6, I, 5, NRS)
                  IF (INCLUDE .EQ. 1 .AND. NRS .GT. 0) THEN
                    IF (I .GT. IPR(38)) THEN
                      CALL PLUT15 (-4, I, 37, ILAB)
                      IF (ILAB .EQ. 0 .OR. M .GT. 1) THEN
                        N2 = IPR(64) - IPR(53) * 2 - 1
                        N1 = IPR(64) - IPR(52) * 2 + 1
                        DO N0 = N1, N2, 2
                          ICMD = NINT(RA(N0))
                          IF (ICMD .LT. 0) THEN
                            CYCLE
                          ELSE
                            JAT = NINT(RA(N0 + 1))
                            IF (I .EQ. JAT) GO TO 70
                          END IF
                        END DO
                        INCLUDE = - 1
                        GO TO 80
                      END IF
                    END IF
   70               IF (KRS(NRS) .LT. 0) INCLUDE = - 1
                  END IF
   80             RA11 = RA(I * NP43 + 11)
                  IF (RA11 .LT. 0.0) THEN
                    IF (IPR(231) .EQ. 0) THEN
                      IATK = INT(RA(I * NP43 + 7) / 64000)
                      RAX  = RADR(IATK + 1, 1)
                    ELSE
                      RAX = ABS(RA11) * 0.35
                    END IF
                  ELSE
                    RAX  = RA11
                  END IF
                  IF (NRS .NE. 0) THEN
                    NPROP = KRS(NRS)
                  ELSE
                    NPROP = 0
                  END IF
                ELSE
                  IF (IPR(46) .EQ. 0) INCLUDE = - 1
                  RAX   = PAR(75)
                  NPROP = 0
                END IF
                IF (IGBL(128) .EQ. 1) THEN
                  IF (M .NE. 1) INCLUDE = -1
                END IF
                IF (INCLUDE .EQ. 1) THEN
                  DO JJ = 1, 3
                    PAR(63 + JJ) = MAX (XYZR(JJ) + RAX, PAR(63 + JJ))
                    PAR(60 + JJ) = MIN (XYZR(JJ) - RAX, PAR(60 + JJ))
                  END DO
                ELSE
                  JOMIT = - 1000
                  IF (RAX .GT. 0.0) THEN
                    RAX = - RAX
                  ELSE
                    RAX = - 1.0
                  END IF
                END IF
                RAX = RAX + JOMIT
                IASU = I * 1000 + M
                CALL PLUT14 (1, NAP, IASU, NPROP, XYZR(1), XYZR(2),
     1                       XYZR(3), RAX)
              END DO
            END DO
            IF (IPR(342) .NE. 0) THEN
              CALL PLUT14 (-1, IPR(342), IASU, NPROP, PAR(67), PAR(68),
     1                         PAR(69), YK)
            END IF
            DO I = 1, 3
              IF (IPR(342) .EQ. 0)
     1        PAR(66 + I) = (PAR(60 + I) + PAR(63 + I)) / 2.0
              IF (I .LT. 3 .OR. IPR(151) .GT. 0) THEN
                PAR(60 + I) = (PAR(60 + I) - PAR(66 + I))
                PAR(63 + I) = (PAR(63 + I) - PAR(66 + I))
              END IF
            END DO
            PAR(15) = VERT * ABS(PAR(18))
            IF (PAR(64) + PAR(65) .LT. 0.0001) THEN
              PAR(64) = 5
              PAR(65) = 5
            END IF
            IF (PAR(16) .EQ. 0.0 .AND. PAR(65) .NE. 0.0) THEN
              IF (PAR(64) / PAR(65) .GT. ABS(PAR(18))) THEN
                PAR(24) = PAR(15) * PAR(13) / (2.0 * PAR(64))
              ELSE
                PAR(24) = VERT * PAR(13) / (2.0 * PAR(65))
              END IF
            ELSE
              PAR(24) = PAR(16)
            END IF
            PAR(61) = - PAR(15) / 2
            PAR(62) = - VERT  / 2
            PAR(64) = - PAR(61)
            PAR(65) = - PAR(62)
            IPR(79) = IPR(64) - IPR(52) * 2 - IPR(142)
            CALL PLUT16 (-6, IDUM1, IDUM2, IDUM3, DUM4, IDUM5)
            IPR(66) = IPR(79) - IPR(97) * 4
          END IF
          NORG = (1 - IPR(46)) * IPR(69)
          II   = IPR(158)
          III  = 0
          IF (IPR(116) .GT. 0) THEN
            IF (IGBL(75) .GT. 0) THEN
              NATL = IPR(40)
            END IF
          END IF
          DO I = 1, NATL
            II = II + NP0
            NPROP = NINT(RA(II - 4))
            XI = RA(II - 3)
            YI = RA(II - 2)
            ZI = RA(II - 1)
            RI = RA(II)
            IF (RI .GE. 0) THEN
              INCLUDE =  1
            ELSE
              RI      =  ABS(RI)
              INCLUDE = -1
            END IF
            IF (RI .GT. 999.9) THEN
              JOMIT = 1000
              RI = RI - JOMIT
            ELSE
              JOMIT = 0
            END IF
            IF (IPR(116) .LE. 0) THEN
              XII = XI
              YII = YI
              ZII = ZI
              XI  = (XI - PAR(67)) * PAR(24)
              YI  = (YI - PAR(68)) * PAR(24)
              IF (IPR(151) .EQ. 0) THEN
                ZI = (ZI - PAR(66)) * PAR(24)
              ELSE
                ZI = (ZI - PAR(69)) * PAR(24)
              END IF
              RI = PAR(24) * RI
              IF (PAR(48) .GT. 0.0)
     1          RI = RI * PAR(48) / (PAR(48) - ZI)
              IF (IPR(82) .NE. 0 .AND. I .LE. IPR(62)
     1          .AND. I .GT. NORG) THEN
                CALL PLUT25 (-1, I, IATK)
                IF (INCLUDE .EQ. 1) THEN
                  IF (I .LE. IPR(69)) THEN
                    NQ1(3:4) = '  '
                    LTYP = NINT(RA(I * NP43 + 7))
                    IF (LTYP .NE. ICHAR(' ')) THEN
                      NQ1(1:2) = 'AR'
                    ELSE
                      NQ1(1:2) = 'NE'
                    END IF
                  END IF
                  III                            = III + 1
                  RA(IPR(125) + (I - 1) * 4 + 1) = III
                  RA(IPR(125) + (I - 1) * 4 + 2) = XII
                  RA(IPR(125) + (I - 1) * 4 + 3) = YII
                  RA(IPR(125) + (I - 1) * 4 + 4) = ZII
                  IF (IPR(10) .EQ. 1) THEN
                    IF (IPR(4) .NE. 0) THEN
                      IO = MOD(I - ILPB, NAB) + ILPB
                      CALL PLUT15 (-1, IO, 27, NINCL)
                      IF (NINCL .GT. 0) THEN
                        IF (IABS(IPR(477)) .NE. 0) THEN
                          IF (IPR(477) .GT. 0) THEN
                            CALL GEN048 (-5, NPROP, 1, ICOL0)
                          ELSE IF (IPR(477) .LT. 0) THEN
                            CALL PLUT15 (-6, IO, 5, NRS)
                            IF (NRS .GT. 0 .AND. NRS .LE. 8) THEN
                              ICOL0 = NRS
                            ELSE
                              ICOL0 = 0
                            END IF
                          END IF
                          IF (ICOL0 .GT. 0 .AND. ICOL0 .LE. 16) THEN
                            KLEUR = COLR(ICOL0)
                            CALL GEN020 (-1, KLEUR, 2, 10)
                            IF (ICOL0 .EQ. 16)
     1                        CALL GEN020 (1, KLEUR, 6, 6)
                          ELSE
                            KLEUR = '  color_C '
                          END IF
                        ELSE
                          NTYP = IEL(IEN(IATK))
                          NTP1 = NTYP / 100
                          NTP2 = NTYP - NTP1 * 100 + ICHAR('a') - 1
                          NTP1 = NTP1 + ICHAR('A') - 1
                          IF (NTP2 .EQ. ICHAR('a') - 1)
     1                      NTP2 = ICHAR(' ')
                          KLEUR = '  color_'//CHAR(NTP1)//CHAR(NTP2)
                        END IF
                        WRITE (LU61, 99996, IOSTAT = IOST)
     1                    NQ1, XII - PAR(67), YII - PAR(68),
     2                    - ZII + PAR(69), RI / PAR(24), KLEUR
                      END IF
                    END IF
                  ELSE IF (IPR(10) .EQ. 2) THEN
                    IO = MOD(I - ILPB, NAB) + ILPB
                    CALL PLUT15 (-1, IO, 27, NINCL)
                    IF (NINCL .GT. 0) THEN
                      WRITE (LU60, 99994, IOSTAT = IOST)
     1                  I, NQ1(1:5), 0, XII - PAR(67), - YII + PAR(68),
     2                  - ZII + PAR(69),  1.0, 0.0
                    END IF
                  END IF
                END IF
              END IF
            END IF
            IF (IPR(151) .EQ. 0) THEN
              Q = 1.0
              IF (PAR(48) .GT. 0.0) Q = PAR(48) / (PAR(48) - ZI)
              IF (IPR(116) .EQ. 0) THEN
                XI = XI * Q
                YI = YI * Q
              ELSE
                IF (IPR(6) .LT. 0) THEN
                  DEYE = - PAR(17)
                ELSE
                  DEYE =   PAR(17)
                END IF
                IF (IPR(116) .LT. 0) THEN
                  XI = (XI + DEYE) * Q - DEYE
                  YI = YI * Q
                ELSE
                  XI = XI + 2.0 * DEYE * (1.0 - Q)
                END IF
              END IF
            END IF
            RA(II - 3) = XI
            RA(II - 2) = YI
            RA(II - 1) = ZI
            RA(II)     = (RI + JOMIT) * INCLUDE
          END DO
        END IF
        IF (IPR(116) .LE. 0) THEN
          IGBL(32) = IABS (IGBL(32))
          IWIN     = IGBL(25) * IGBL(32)
          BCD = 'P.L.U.T.O.N'//CHAR(0)
          IF (IGBL(50) .EQ. 0) THEN
            CALL GGIP ((1 + IABS(IPR(6))) * PAR(15), VERT, PAR(25), 1)
          ELSE
            CALL GGIP (XSH0, YSH0, 0.0, -3)
          END IF
          CALL GGIP (PAR(64), PAR(65), 0.0, -3)
        END IF
        IF (IPR(82) .NE. 0) THEN
        END IF
        CALL GGIP (0.0, FLOAT(IPR(19)), 0.0, 0)
        IF (IPR(6) .EQ. 0) THEN
          IF (IPR(116) .EQ. -1) THEN
            CALL GGIP (0.0, FLOAT(IPR(143)), 0.0, 0)
          ELSE IF (IPR(116) .EQ. 1) THEN
            CALL GGIP (0.0, FLOAT(IPR(144)), 0.0, 0)
          END IF
        END IF
        CALL PLA109 (2, 1, 0.0, 0.0, 0)
        IF (IPR(151) .LE. 0) THEN
          IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
            IF (IGBL(50) .EQ. 0) THEN
              BCD = 'Click HERE to INTERRUPT PLOTTING'//CHAR(0)
              CALL GGIP (-999.0, 2.0, 33.0, 111)
            END IF
            IF (IPR(116) .EQ. 0) THEN
              CLR = IPR(19)
            ELSE IF (IPR(116) .GT. 0) THEN
              CLR = IPR(144)
            ELSE
              CLR = IPR(143)
            END IF
              CALL GGIP (0.0, CLR, 0.0, 0)
          END IF
          IF (IPR(10) .LE. 0) THEN
            CALL PLUT11
            IF (IPR(45) .EQ. 0) CALL PLUT04 (1, 0)
          END IF
        ELSE
          IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
            BCD = 'Click on Window to STOP Rotation'//CHAR(0)
          ELSE
            TXT3 = 'Freeze CROTX Rotation by pressing CTRL-C'
            TXT3(12:12) = CHAR(ICHAR('W') + IPR(155))
          END IF
          IF (IPR(169) .EQ. 0) THEN
            IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
              CALL GGIP (-999.0, 2.0, 33.0, 111)
            ELSE
              CALL GGIP09 (0.0, TXT3, 40, PAR(14) * 1.4, 2, 2, PAR(61),
     1          PAR(62) + PAR(14) * 0.7)
            END IF
          END IF
        END IF
        IF (IPR(45) .EQ. 0) CALL PLUT10
        IF (IPR(45) .EQ. 0 .AND. IGBL(103) .EQ. 1) THEN
          P14  = PAR(14)
          IPM = MIN (NINT((PAR(64) - PAR(61)) / P14) - 15, 74)
          CALL GGIP09 (0.0, JID, IPM, P14, IPR(19), 1,
     1        PAR(61) + 7 * P14, PAR(62) + PAR(54))
          CALL GEN040 (IGBL(4), NQ2, IP)
          CALL GGIP09 (90.0, PROGNM//' - ('//NQ2(1:IP)//')',
     1         IP + 33, P14, IPR(19), 1, PAR(61) + P14 + PAR(54),
     2         PAR(62) + 3 * P14)
          CALL GGIP (PAR(61), PAR(62), 0.0, 3)
          CALL GGIP (PAR(61), PAR(65), 0.0, 2)
          CALL GGIP (PAR(64), PAR(65), 0.0, 2)
          CALL GGIP (PAR(64), PAR(62), 0.0, 2)
          CALL GGIP (PAR(61), PAR(62), 0.0, 2)
          IF (IGBL(23) .EQ. 1) THEN
            CALL GGIP09 (0.0, 'DEF-FILE ACTIVE', 15, P14,
     1        5 + IGBL(68), 1, PAR(64) - 55 * P14,
     2        PAR(65) - PAR(54) - P14)
          END IF
          IF (IGBL(60) .GT. 0) THEN
            CALL GGIP09 (0.0, 'INPUT ATOMS MOVED', 17,
     1        P14, 2, 1, PAR(64) - 41 * P14, PAR(65) - PAR(54) - P14)
          ELSE
            IF (IGBL(30) .EQ. 1) THEN
              CALL GGIP09 (0.0, 'NOMOVE FORCED', 13, P14,
     1          3, 1, PAR(64) - 37 * P14, PAR(65) - PAR(54) - P14)
            END IF
          END IF
          IDPLT = INT(PAR(48))
          IF (IDPLT .GT. 998) IDPLT = 0
          CALL GEN096 (R, IROTX, IROTY, IROTZ, IDET, XYZOR, PHI, ROM)
          IPR(65) = IDET
          IF (IDET .EQ. -1) CALL GGIP09 (0.0, 'INVERT', 6, P14,
     1        3, 2, PAR(64) - 13 * P14, PAR(65) - PAR(54) - P14)
          CALL GEN040 (IPR(140), NQ1, IP)
          TXT2 = 'RES='//NQ1(1:2)
          CALL GGIP09 (0.0, TXT2, 6, P14, 1, 1, PAR(64)
     1              - 21 * P14, PAR(65) - PAR(54) - P14)
          CALL GEN040 (IROTX, NQ1, IP)
          NQ1(IP + 1:IP + 2) = ' X'
          IP                 = IP + 2
          CALL GGIP09 (0.0, NQ1, IP, P14, 1, 1, PAR(64) - IP * P14,
     1         PAR(62) + PAR(54))
          CALL GEN040 (IROTY, NQ1, IP)
          NQ1(IP + 1:IP + 2) = ' Y'
          IP                 = IP + 2
          CALL GGIP09 (90.0, NQ1, IP, P14, 1, 1,
     1         P14 + PAR(54) + PAR(61), PAR(65) - IP * P14)
          CALL GGIP09 (0.0, 'Z', 1, P14, -1, 1, PAR(61) + PAR(54),
     1         PAR(62) + PAR(54))
          CALL GEN040 (IROTZ, NQ1, IP)
          CALL GGIP09 (0.0, NQ1, IP, P14, 1, 1,
     1           PAR(61) + PAR(54) + 2 * P14, PAR(62) + PAR(54))
          CALL GEN040 (IDPLT, NQ1, IP)
          CALL GGIP09 (0.0, NQ1, IP, P14, 1, 1, PAR(64) - IP * P14,
     1         PAR(65) - PAR(54) - P14)
        END IF
        IF (IPR(116) .LT. 0) THEN
          IPR(116) = 1
          IF (IABS(IPR(6)) .GT. 0)
     1        CALL GGIP (ABS(PAR(15)), 0.0, 0.0, -3)
          GO TO 10
        ELSE
          IPR(116) = - IPR(116)
          IF (IPR(130) .EQ. 0 .AND. IPR(145) .EQ. 1) THEN
            IPR(90) = 254
          END IF
          IPR(130) = 1 + IPR(116)
          IF (IPR(340) .NE. 0) THEN
            IF (IGBL(98) .EQ. 1) THEN
              CLOSE (UNIT = LU61)
              XGGIP = -999.0
              YGGIP = 0.0
              ZGGIP = 0.0
              IF (IGBL(123) .EQ. 0) THEN
              CALL GGIP (XGGIP, YGGIP, ZGGIP, -8)
              IPR(172) = MIN (IPR(172), NINT(YGGIP))
              IPR(171) = NINT (IPR(172) * ABS(PAR(18)))
              ELSE
                IPR(172) = 768 * IGBL(123)
                IPR(171) = NINT(IPR(172) * ABS(PAR(18)))
              END IF
              CALL GEN040 (IPR(171), NQ1, IP1)
              CALL GEN040 (IPR(172), NQ2, IP2)
              CALL GEN038 (PLPATH, 1, 255)
C * FIND povray
              NE = FINDEXE ('POVEXE', PLPATH, 'povray')
              IF (NE .GT. 0) THEN
                PLPATH(NE +1:) =
     1 ' +P +D +A0.3 +W'//NQ1//'+H'//NQ2//'+I'//NAMEFIL(1:KNMFIL)//' &'
                KERR = 0
                CALL SPAWN (PLPATH, KERR)
                IPR(340) = 0
              ELSE
                CALL PLA015 (0, 9)
              END IF
              IGBL(98) = -1
            ELSE IF (IGBL(11) .EQ. 1) THEN
              CLOSE (UNIT = LU60)
              CALL GEN038 (PLPATH, 1, 255)
C * FIND rasmol
              NE = FINDEXE ('RASEXE', PLPATH, 'rasmol')
              IF (NE .GT. 0) THEN
                PLPATH(NE + 1:) = ' '//NAMEFIL(1:KNMFIL)//'.ras &'
                KERR = 0
                CALL SPAWN (PLPATH, KERR)
                IPR(340) = 0
              ELSE
                CALL PLA015 (0, 9)
              END IF
              IGBL(11) = -1
            END IF
          END IF
        END IF
      END IF
   90 RETURN
99996 FORMAT ('// ', A, /, 7X, 'sphere {', /,
     1        15X, '< ', F9.4, ',', F9.4, ',', F9.4, ' >,', F5.2, /,
     3        15X, 'texture { pigment { color ',A, '}', /,
     4        15X, 'finish { finish_all } } }')
99995 FORMAT (//, ' NR  NMOL ATNR LABEL     XMOL', 9X, 'X', 9X, 'Y',
     1       9X, 'Z', 9X, 'RAX'/)
99994 FORMAT ('ATOM', 2X, I5, 1X, A, 4X, I5, 4X, 3F8.3, 2F6.2)
      END SUBROUTINE PLUT02
      SUBROUTINE PLUT03 (IER)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,
     2 NP38=150,NP39=30,NP43=12,NP45=2048,NP52=200,NP56=30,
     3 NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION DUMA(3)
      COMMON /PLU99A/ SFC(16)
      CHARACTER SFC*2
      I4 = 0
      KL = IPR(220)
      KN = IPR(221)
      NSYM = IPR(48)
      MULT = NSYM
      IF (KL .EQ. 3 .AND. IFL(3)(1:1) .EQ. 'X') THEN
        IPR(220) = 2
        KL       = IPR(220)
      END IF
      IF (KL .GT. 3 .OR. KL .EQ. 0) THEN
        WRITE (LU6, 99997, IOSTAT = IOST) ICL(1:80)
        GO TO 80
      END IF
      IF (KN .LT. 3) THEN
        WRITE (LU6, 99998, IOSTAT = IOST) ICL(1:70)
        GO TO 80
      END IF
      IF (IABS(IGBL(8)) .EQ. 3) THEN
        NQ1 = IFL(2)
      ELSE
        NQ1 = IFL(KL)
      END IF
      IF (IGBL(8) .EQ. 2) THEN
        IF (IPR(538) .NE. 0) THEN
          N = INDEX (NQ1, ' ')
          IF (N .NE. 0) THEN
            IF (IPR(538) .LT. 10) THEN
              WRITE (NQ1(N:N+1), '(''_'', I1)', IOSTAT = IOST) IPR(538)
            ELSE
              WRITE (NQ1(N:N+2), '(''_'', I2)', IOSTAT = IOST) IPR(538)
            END IF
          END IF
          IFL(KL) = NQ1
        END IF
      END IF
      IF (IGBL(8) .EQ. 1 .AND. KL .EQ. 2) THEN
        IF (IFL(1)(1:4) .NE. 'ATOM' .AND. IFL(1)(1:2) .NE. 'U ' .AND.
     1      IFL(1)(2:3) .NE. 'IJ' .AND. IFL(1)(3:4) .NE. 'IJ') THEN
          IPR(683) = IPR(683) + 1
          CALL PLA282 (IPR(683), IFL(1), IFL(2), LU6)
        END IF
      END IF
      MODE = 9
      LOP  = 0
      NQ4  = NQ1
      CALL GEN020 ( 1, NQ4, 1, 7)
      CALL GEN020 (-1, NQ4, 2, 2)
   10 CALL PLA046 (MODE, NQ1, NED, NQX, NSS, NQSM, INQNR, JNQNR, NIEN)
      IF (NIEN .EQ. -2)
     1  CALL GEN127 ('Stop:: More that 16 atom types !!')
      LOP = LOP + 1
C * CHECK FOR ERROR RETURN
      IF (NIEN .LT. 0) THEN
        IF (IABS(IGBL(8)) .GE. 1 .OR. IABS(IGBL(8)) .LE. 3) THEN
          IF (IABS(IGBL(8)) .EQ. 3 .OR. IABS(IGBL(8)) .EQ. 1) THEN
            IF (ICHAR (NQ1(2:2)) .GE. 48 .AND.
     1          ICHAR (NQ1(2:2)) .LE. 48) THEN
              NQ1(2:) = ' '
            ELSE
              NQ1(3:) = ' '
            END IF
          ELSE
            NQ1 = SFC(NINT(FN(1)))
          END IF
          IF (NQ1(1:1) .EQ. ' ') THEN
            NQ1(1:1) = NQ1(2:2)
            NQ1(2:4) = '999'
          ELSE IF (NQ1(2:2) .EQ. ' ') THEN
            NQ1(2:4) = '999'
          ELSE
            NQ1(3:4) = '99'
          END IF
          MODE = 10
          IF (LOP .EQ. 1) GO TO 10
        END IF
      END IF
      IF (NIEN .LT. 0 .OR. NQSM .GT. 0) THEN
        IF (NIEN .LT. 0 .OR. IPR(50) .EQ. 0) THEN
          WRITE (LU6, 99996, IOSTAT = IOST) NQ1
          GO TO 80
        END IF
      END IF
      IF (IPR(51) .EQ. 0) CALL PLUT23 (-1)
      ICLOSE = 0
      IANIS  = 0
      UISO   = -1.0
      IF (IPR(50) .EQ. 0) THEN
        IF (IABS(IGBL(8)) .EQ. 2) THEN
          IF (KN .EQ. 11) IANIS = 1
          RP(1) = 1
          IF (KN .EQ. 7) THEN
            IPR(221) = 6
            KN       = IPR(221)
          END IF
          DO I = 2, KN
            YY = FN(I)
            IF (ABS(YY) .GT. 5.0) THEN
              J  = NINT (ABS(YY) * 0.1)
              SJ = SIGN (0.5, YY)
              IF (J .NE. 1 .AND. J .GT. IPR(13)) CALL PLUT38 (4, 1, LU6)
              YY = (YY - J * SJ * 20.0) * (RP(J) + SJ - 0.5)
            END IF
            FN(I - 1) = YY
          END DO
          IF (KN .EQ. 6 .AND. FN(6) .GT. 0.0) UISO = - FN(6) / 0.04
          FN(KN)   = 0.0
          IPR(221) = IPR(221) -1
          KN       = IPR(221)
        END IF
        IF (IABS(IGBL(8)) .NE. 2 .AND. KN .EQ. 8 .OR.
     1      IABS(IGBL(8)) .EQ. 2 .AND. KN .GT. 3) THEN
          IF (FN(4) .LT. 0.0001) THEN
            WRITE (LU6, 99995, IOSTAT = IOST) NQ1
            GO TO 80
          END IF
        END IF
        IF (IPR(127) .GT. 0 .OR. IPR(156) .GT. 0) THEN
          IF (IPR(156) .EQ. 1) THEN
            CALL GEN002 (1, ROM, FN, XJX, XLNG)
            DO J = 1, 3
              FN(J) = XJX(J)
            END DO
          ELSE
            CALL GEN002 (1, TMY, FN, XJX, XLNG)
            IGBL(30) = 0
            DO J = 1, 3
              FN(J) = MOD(XJX(J), 1.0)
            END DO
          END IF
        END IF
        I2 = (IPR(37) + 1) * NP43
        I4 = I2 + NP43
        DO J = 1, 3
          XJX(J + 3) = 0.0
          IF (IPR(128) .GT. 0) FN(J) = FN(J) + SHFT(J)
          XJX(J)     = FN(J)
          RA(I2 + J) = FN(J)
          RA(I4 + J) = 0.0
        END DO
        XJX(10) = 0.0
        CALL SGSM (ICL, 0, XJX, LU6, 19, IERR)
        IF (IGBL(8) .EQ. 3) FN(4) = FN(4) * XJX(10)
        IF (ABS(1.0 - FN(4) / XJX(10)) .LT. 0.001) THEN
          PAR22 = PAR(22)
        ELSE
          PAR22 = 0.005
        END IF
        MULT   = 0
        ICLOSE = 0
        DCLOSE = 999.0
        DO J = 1, NSYM
          CALL SGSM (ICL, J, XJX, LU6, 3, IERR)
          I    = IPR(69) * NP43
          II   = IPR(69)
   20     I    = I + NP43
          II   = II + 1
          VERS = 0.0
          DO K = 1, 3
            VRS = RA(I + K) - XJX(K + 6)
   30       IF (VRS .GT. 0.5) THEN
              XJX(K + 6) = XJX(K + 6) + 1.0
              VRS        = VRS - 1.0
              GO TO 30
            END IF
   40       IF (VRS .LE. - 0.5) THEN
              XJX(K + 6) = XJX(K + 6) - 1.0
              VRS        = VRS + 1.0
              GO TO 40
            END IF
            DUMA(K) = VRS
          END DO
          VERS = SQRT((PAR(101) * DUMA(1)) **2
     1      + (PAR(102) * DUMA(2)) **2
     2      + (PAR(103) * DUMA(3)) **2
     3      + 2.0 * PAR(101) * PAR(102) * PAR(106) * DUMA(1) * DUMA(2)
     4      + 2.0 * PAR(101) * PAR(103) * PAR(105) * DUMA(1) * DUMA(3)
     5      + 2.0 * PAR(102) * PAR(103) * PAR(104) * DUMA(2) * DUMA(3))
          IF (VERS .LT. PAR22) THEN
            IF (I .EQ. I2) THEN
              MULT = MULT + 1
              DO K = 1, 3
                RA(I4 + K) = RA(I4 + K) + XJX(K + 6)
              END DO
            ELSE
              CALL PLUT25 (2, II, IDUM)
              ICLOSE = 1
              DCLOSE = VERS
            END IF
          END IF
          IF (I .LT. I2)  GO TO 20
        END DO
      END IF
      IF (IPR(37) .EQ. IPR(69)) THEN
        IPPR(1, 3) = NSYM
      END IF
      NATX = IPR(37) + 1
      I          = NATX * NP43
      RA(I + 6)  = JNQNR
      RA(I + 7)  = INQNR
      RA(I + 8)  = 0.0
      RA(I + 9)  = 0.0
      RA(I + 10) = 0.0
      IF (PAR(141) .GT. 0.0) THEN
        TRNS     = PAR(141)
        PAR(141) = 0.0
      ELSE
        TRNS     = PAR(140)
      END IF
      RA(I + 11) = UISO
      RA(I + 12) = TRNS
      DO II = 1, 3
        IF (IPR(50) .EQ. 1) THEN
          RA(I + II) = FN(II) * PAR(11)
        ELSE
          IF (MULT .EQ. 0) MULT = 1
          RA(I + II) = RA(I4 + II) / MULT
        END IF
      END DO
      NPOP = IPR(9)
        FN(4) = MIN (1.0, FN(4) * MULT)
      IF (NQ1(1:1) .EQ. 'Q' .OR. FN(4) .LT. 0.001) FN(4) = 1.0
      INTPOP = NINT(FN(4) * 1000.0)
      IF (MULT .EQ. 48 .AND. INTPOP .GT. 997) INTPOP = 1000
      IF (INTPOP .EQ. 1000 .AND. ICLOSE .EQ. 1 .AND.
     1  (NQ1(1:1) .NE. 'Q' .OR.
     2  (NQ1(1:1) .EQ. 'Q' .AND. NQ2(1:1) .EQ. 'Q'))) THEN
        WRITE (LU6, 99999, IOSTAT = IOST) NQ1, DCLOSE, NQ2
        GO TO 80
      END IF
      IF (INTPOP .EQ. 500 .AND. MULT .EQ. 1) THEN
        IF (FN(4) .GT. 0.5) INTPOP = 501
        IF (FN(4) .LT. 0.5) INTPOP = 499
      END IF
      IPPR(NPOP + 1, 1) = INTPOP
      IPPR(NPOP + 1, 3) = NSYM / MULT
      IPR(37) = NATX
      IPR(38) = NATX
      IPR(39) = NATX
      IF (IABS(IGBL(8)) .GE. 1 .AND. IABS(IGBL(8)) .LE. 3) THEN
        CALL PLUT25 (2, NATX, IDUM)
        IF (NQ2 .NE. NQ4) THEN
          IPR(683) = IPR(683) + 1
          CALL PLA282 (IPR(683), NQ4, NQ2, LU6)
        END IF
      END IF
      DO II = 1, NPOP
        IF (IPPR(II, 1) .EQ. IPPR(NPOP + 1, 1)) GO TO 50
      END DO
      II = NPOP
      IF (NPOP .LT. 16) IPR(9) = NPOP + 1
      GO TO 60
   50 II = II - 1
   60 CALL PLUT15 (4, NATX, 28, II)
      CALL PLUT15 (6, NATX, 18, MULT)
      IVAL = 1
      CALL PLUT15 (1, NATX, 27, IVAL)
      IVAL = 0
      CALL PLUT15 (4, NATX, 37, IVAL)
      IYUNK = IPR(612) + 16
      CALL PLUT15 (5, NATX, 48, IYUNK)
      CALL PLUT15 (1, NATX, 41, IANIS)
      CALL PLUT25 (0, NATX, N1)
      N2 = IEN(N1)
      IF (N2 .EQ. 2) IGBL(97) = 1
      IF (N1 .GT. 4) RADR(N1, 3) = REL(N2)
      DO II = 1, IPR(480)
        IF (N2 .EQ. IDOAC(II)) THEN
          IVAL = 1
          CALL PLUT15 (1, NATX, 46, IVAL)
          GO TO 70
        END IF
      END DO
   70 IF (IATPR(N2) .GT. 0) THEN
        IWD = 1
      ELSE
        IWD = 0
      END IF
      CALL PLUT15 (1, NATX, 17, IWD)
      IF (N2 .EQ. 1 .OR. N2 .EQ. 33) THEN
        IWD = 1
      ELSE
        IWD = 0
      END IF
      CALL PLUT15 (1, NATX, 44, IWD)
      IF (IPR(136) .EQ. 0) THEN
        IVAL = 0
      ELSE
        IVAL = IPR(136)
      END IF
      CALL PLUT15 (6, NATX, 5, IVAL)
      IER = 0
      IF (IPR(50) * IPR(135) .GT. 0) THEN
        RA(NATX * NP43 + 3) = RA(NATX * NP43 + 3) + IPR(135) * 100.0
      END IF
      RETURN
   80 IER = 1
      RETURN
99999 FORMAT (':: ATOM ', A, ' eliminated. (within', F5.2,' Ang.',
     1 ' from ', A, ')')
99998 FORMAT (':: Less than 3 numbers on ATOM record',
     1        ' (or unrecognized instruction)', /, ':: =>> ', A, /)
99997 FORMAT (':: Inadequate number of text items on ATOM record', /, A)
99996 FORMAT (':: ATOM label ', A, ' not acceptable')
99995 FORMAT (':: (Dummy) Atom ', A, ' with zero population skipped')
      END SUBROUTINE PLUT03
      SUBROUTINE PLUT04 (MODE, NATR)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP49=2000000,NP22=287,NP48=1000,NP37=191,NP38=150,NP39=30,
     2 NP43=12,NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2,  CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER LABP*2
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, NQ0*13, NL123*3, LBPOS*2, COLR*10, BWCT*10
      LOGICAL CC
      COMMON /CTRLC/ CC
      KL      = IPR(220)
      KN      = IPR(221)
      ILPB    = IPR(69) + 1
      NAT     = IPR(37)
      NATO    = IPR(39)
      NAB     = NAT - IPR(69)
      IPR(72) = 0
      XSH     = PAR(39)
      IASU    = 0
      IF (MODE .EQ. 1) THEN
        IF (IGBL(75) .EQ. 0) THEN
          IF (IPR(339) .EQ. 1) THEN
            NATY = IPR(69)
          ELSE
            NATY = 0
          END IF
        ELSE
          NATY = NAT
        END IF
        IF (IPR(63) .EQ. 0) THEN
          NATX = NATY
        ELSE
          NATX = NATY + IPR(42)
        END IF
        IF (NATX .GT. 0) THEN
          PAR(28) = 0.5 * PAR(349)
          IF (IPR(116) .EQ. 1 .OR. IPR(130) .EQ. 1) THEN
            NTM = 1
            NT0 = 1
          ELSE
            NTM = 2
            IF (IPR(117) .EQ. 0) THEN
              NT0 = 2
            ELSE
              NT0 = 1
            END IF
          END IF
          DO NT = NT0, NTM
            NATL = IPR(62)
            IF (NATR .NE. 0) THEN
              IBEG = NATR
              IEND = NATR
              NATL = IPR(62) + NATR - 1
            ELSE
              IBEG = 1
              IEND = NATX
            END IF
            DO 120 I = IBEG, IEND
              NATL = NATL + 1
              IF (I .LE. NATY) THEN
                IF (IPR(4) .GT. 0) THEN
                  CALL PLUT15 (-1, I, 45, IVAL)
                  IF (IVAL .EQ. 0 .AND. I .GE. ILPB) GO TO 120
                END IF
                CALL PLUT15 (-4, I, 37, M)
                IF (M .EQ. 0)  GO TO 120
                CALL PLUT14 (-1, I, IASU, NPROP, XI, YI, ZI, RI)
                IF (RI .LT. 0.0)  GO TO 120
                IF (IPR(4) .LE. 0 .AND. RI .GT. 0.0) RI = 0.0
                IF (I .LT. ILPB) THEN
                  IF (IPR(46) .EQ. 0) THEN
                    GO TO 120
                  ELSE
                    NQ0(1:1) = CHAR(INT(RA(I * NP43 + 7)))
                    KLB      = 1
                    GO TO 60
                  END IF
                END IF
                IAT = I
                IF (I .GE. ILPB .AND. IPR(14) .EQ. 1) IAT = - I
                CALL PLUT25 (2, IAT, IATK)
                NQ0 = NQ2
                CALL GEN020 (-1, NQ0, 2, 2)
              ELSE
                M = IABS(IPR(63))
                XNM = MOL(1, I - NATY) / PAR(42)
                IF (XNM .LT. 0)  GO TO 120
                NM  = NINT(XNM)
                NR  = NINT((XNM - NM) * PAR(42))
                CALL GEN040 (NM, NQ0, IP0)
                IP0 = IP0 + 1
                NQ0(IP0:IP0) = '.'
                IF (NR .LT. 10 .AND. IPR(134) .GT. 9) THEN
                  IP0          = IP0 + 1
                  NQ0(IP0:IP0) = '0'
                END IF
                CALL GEN040 (NR, NQ0(IP0 + 1:IP0 + 1), IP)
                IP  = IP0 + IP
                NML = IPR(142)
                DO JJ = 1, NML
                  INM = NINT(RA(IPR(159) + 1 - JJ))
                  IF (NM .EQ. INM) GO TO 30
                END DO
   30           DO KK = ILPB, NATO
                  CALL PLUT15 (-6, KK, 5, IVAL)
                  IF (IVAL .EQ. NR) THEN
                    CALL PLUT15 (-1, KK, 27, IVAL)
                    IF (IVAL .EQ. 1) GO TO 50
                  END IF
                END DO
   50           KK = (JJ - 1) * NAB + KK
                CALL PLUT14 (-1, KK, IASU, NPROP, XI, YI, ZI, RI)
              END IF
              NB  = 0
              KLB = 0
              CALL GEN039 (1, NQ0, 1, 13, NB, KLB)
   60         PAR(40) = KLB * PAR(349) * PAR(19) / 2.0
              IF (IPR(116) .LE. 0 .AND. IPR(130) .EQ. 0 .AND.
     1            M .NE. 15) THEN
                IF (I .LE. NATY) THEN
                  CALL PLUT15 (-1, I, 42, ILB)
                ELSE
                  IF (IPR(63) .LT. -1) THEN
                    ILB = 1
                  ELSE
                    ILB = 0
                  END IF
                END IF
                XSH = PAR(39)
                IF (NT .EQ. 1) THEN
                  IF (ILB .EQ. 0)  GO TO 120
                  IF (M .EQ. 1)  GO TO 120
                  MM = 0
                ELSE
                  IF (ILB .EQ. 1)  GO TO 120
                  MMIN = 999
                  M0   = 10
                  XSH0 = 0.0
                  XSH = 0.0
   70             XSH = XSH + PAR(39)
                  IF (IPR(116) .NE. 0 .AND. XSH .GT. PAR(39)) GO TO 90
                  IF (XSH .GT. IPR(131) * PAR(39)) GO TO 90
                  M = 10 + IPR(18)
                  IF (PAR(40) .GT. RI * 0.9) M = 10
                  IF (I .GE. ILPB) THEN
                    MSTEP = 1
                  ELSE
                    MSTEP = 2
                    M     = 11
                  END IF
   80             M = M - MSTEP
                  IF (M .LT. 2) GO TO 70
                  CALL PLUT26 (M, NATL, XI, YI, ZI, RI, XL, YL, ZL,
     1                         RL, XSH)
                  IF (XL - PAR(40) .LT. PAR(61) .OR.
     1                XL + PAR(40) .GT. PAR(64) .OR.
     2                YL - PAR(28) .LT. PAR(62) .OR.
     3                YL + PAR(28) .GT. PAR(65)) THEN
                    MM = 999
                    IF (NT .EQ. 2)  GO TO 80
                    IVAL = 1
                    CALL PLUT15 (4, I, 37, IVAL)
                    GO TO 120
                  END IF
                  IPR(67) = 2
                  CALL PLUT18 (NATL, 0)
                  MM = IPR(78)
                  IF (MM .EQ. 0) THEN
                    GO TO 100
                  ELSE IF (MM .GT. 0) THEN
                    IF (MM .LT. MMIN) THEN
                      M0   = M
                      XSH0 = XSH
                      MMIN = MM
                    END IF
                  END IF
                  GO TO 80
   90             M = M0
                  IF (IPR(4) .GT. 0 .AND. MMIN .GT. 0
     1              .AND. I .LE. NATY .AND. I .GE. ILPB) THEN
                    IVAL = 0
                    CALL PLUT15 (1, I, 45, IVAL)
                    IF (IGBL(105) .EQ. 0) GO TO 120
                  END IF
                  XSH = XSH0
                END IF
                CALL PLUT26 (M, NATL, XI, YI, ZI, RI, XL, YL, ZL,
     1                       RL, XSH)
  100           IF (I .LE. NATY) THEN
                  CALL PLUT15 (4, I, 37, M)
                ELSE
                  IF (ILB .EQ. 1) THEN
                    IPR(63) = - M
                  ELSE
                    IPR(63) = 1
                  END IF
                END IF
              ELSE
                IF (I .LE. NATY) THEN
                  CALL PLUT15 (-4, I, 37, M)
                ELSE
                  M = MAX (-IPR(63), 2)
                END IF
                IF (IPR(116) .NE. 0) THEN
                  XSH =  PAR(39)
                  CALL PLUT26 (M, NATL, XI, YI, ZI, RI, XL, YL, ZL,
     1                         RL, XSH)
                ELSE
                  CALL PLUT14 (-1, NATL, IASU, NPROP, XL, YL, ZL, RL)
                END IF
              END IF
              IF (CC) GO TO 230
              LMAX = IPR(7)
              DO LL = 1, LMAX
                IF (I .GT. NATY) THEN
                  ICOL = 6
                ELSE
                  ICOL = -1
                  IF (IPR(116) .EQ. 0) THEN
                    IF (IGBL(3) .EQ. 26 .OR. IPR(352) .EQ. 1) THEN
                      CALL PLUT15 (-1, I, 41, IANIS)
                      IF (IANIS .EQ. 1) ICOL = 2
                    END IF
                    IF (IGBL(3) .EQ. 12) THEN
                      CALL PLUT15 (-1, I, 47, IREN)
                      IF (IREN .EQ. 1) ICOL = 3
                    END IF
                  END IF
                END IF
                CALL GGIP09 (0.0, NQ0, KLB, PAR(349), ICOL, 1,
     1            XL - PAR(40), YL - PAR(28))
                XL = XL + PAR(4)
              END DO
  120       CONTINUE
          END DO
        END IF
      ELSE
        IF (IPR(17) .EQ. 0) THEN
          CALL PLUT05
          IF (IPR(72) .NE. 0) CALL GEN127 ('308')
        END IF
        IF (MODE .EQ. 2 .OR. MODE .EQ. 3) THEN
          IPR(130) = 0
          LABL = 3 - MODE
          IF (KL .EQ. 1) THEN
            KL = 2
            IFL(2)(1:3) = 'ON '
          END IF
          ISET  = 0
          IUNIT = 0
          DO 160 K = 2, KL
            SELECT CASE (IFL(K)(1:3))
              CASE ('ON ')
                IGBL(75) = LABL
                IPR(452) = IGBL(75)
                IPR(63)  = 0
                ISET     = 1
                IUNIT    = 1
              CASE ('OFF')
                IGBL(75) = 1 - LABL
                IPR(452) = IGBL(75)
                IPR(63)  = 0
                ISET     = 1
                IUNIT    = 1
                LABL = MOD(LABL + 1, 2)
              CASE ('NON')
                IPR(63)  = 0
                ISET     = 1
                IUNIT    = 1
                LABL = MOD(LABL + 1, 2)
              CASE ('UNI')
                IUNIT    = 1
              CASE ('ARU')
                IPR(63) = LABL
              CASE ('MOL')
                IPR(63) = LABL
              CASE ('ATO')
                IPR(452) = LABL
                IF (LABL .EQ. 1) IGBL(75) = LABL
                ISET     = 1
              CASE ('ALL')
                IPR(63)  = LABL
                IGBL(75) = LABL
                ISET     = 1
                IUNIT    = 1
              CASE ('PAR')
                IPR(71) = 1
              CASE ('NOP')
                IPR(71) = 0
              CASE ('FUL')
                IPR(14) = 0
              CASE ('NUM')
                IPR(14) = 1
                IPR(71) = 0
              CASE DEFAULT
                CALL PLUT13 (-1, -K, IAT, XMOL)
                IGBL(75) = 1
                IF (IAT .LT. 0) THEN
                  DO I = ILPB, NAT
                    II = I
                    CALL PLUT25 (0, II, IAI)
                    IF (IAI + IAT .EQ. 0) THEN
                      IF (KN .EQ. 1) CALL PLUT28 (0, II, FN(1))
                      CALL PLUT15 (4, II, 37, LABL)
                    END IF
                  END DO
                ELSE IF (IAT .GT. 0) THEN
                  IF (KN .EQ. 1) XMOL = FN(1)
                  CALL PLUT28 (0, IAT, XMOL)
                  CALL PLUT15 (4, IAT, 37, LABL)
                END IF
            END SELECT
  160     CONTINUE
          IF (ISET .EQ. 1) THEN
            DO I = ILPB, NAT
              IF (LABL .EQ. 1) THEN
                IF (IPR(232) .EQ. 1) THEN
                  LABL0 = 1
                ELSE
                  CALL PLUT15 (-1, I, 44, IHA)
                  LABL0 = 1 - IHA
                END IF
              ELSE
                LABL0 = 0
              END IF
              CALL PLUT15 (4, I, 37, LABL0)
              IF (LABL .EQ. 0) THEN
                IVL = 0
                CALL PLUT15 (1, I, 42, IVL)
              END IF
            END DO
          END IF
          IF (IPR(50) .EQ. 0 .AND. IUNIT .EQ. 1) THEN
            IPR(339) = LABL
            DO I = 1, 8
              IF (I .LT. 4 .OR. I .EQ. 5) THEN
                ILB = LABL
              ELSE
                ILB = 0
              END IF
              CALL PLUT15 (4, I, 37, ILB)
            END DO
          END IF
        ELSE IF (MODE .EQ. 4) THEN
          IPR(130) = 0
          L = 2
  180     IF (L .GT. KL)  GO TO 250
          NL123 = IFL(L)(1:3)
          IF (NL123 .EQ. 'ARU') THEN
            LMODE = -1
          ELSE IF (NL123 .EQ. 'MOL') THEN
            LMODE = -1
          ELSE IF (NL123 .EQ. 'ATO') THEN
            IAT   = 0
            LMODE = 1
          ELSE
            CALL PLUT13 (0, -L, IAT, XDUM)
            IF (IAT .EQ. 0) THEN
              L = L + 1
              GO TO 220
            END IF
            LMODE = 1
          END IF
          L = L + 1
          IF (L .GT. KL)  GO TO 220
          LBPOS = IFL(L)(1:2)
          DO I = 1, 10
            IF (LABP(I + 1) .EQ. LBPOS)  GO TO 200
          END DO
          GO TO 220
  200     IF (LMODE .EQ. -1) THEN
            IPR(63) = - MIN (IABS(IPR(63)), 1) * I
          ELSE
            IF (IAT .LE. 0) THEN
              JB = ILPB
              JE = NAT
            ELSE
              JB = IAT
              JE = IAT
            END IF
            DO J = JB, JE
              CALL PLUT25 (0, J, IAJ)
              IAJ = - IAJ
              CALL PLUT15 (-4, J, 37, ILB)
              ILB = MIN (ILB, 1) * I
              IF (IAT .GE. 0 .OR. IAT .EQ. IAJ) THEN
                CALL PLUT15 (4, J, 37, ILB)
                IF (ILB .GT. 1) THEN
                  LFIX = 1
                ELSE
                  LFIX = 0
                END IF
                CALL PLUT15 (1, J, 42, LFIX)
              END IF
            END DO
          END IF
          L = L + 1
          IPR(117) = 1
          GO TO 180
  220     IPR(72) = 26
        END IF
      END IF
  230 IF (MODE .GT. 1) THEN
        IF (IPR(63) .NE. 0) THEN
          ILBO = 1
        ELSE
          ILBO = 0
        END IF
        DO I = 1, NAT
          CALL PLUT15 (-4, I, 37, IVAL)
          IF (IVAL .GT. 0) ILBO = 1
          IF (ILBO .EQ. 0) THEN
          ELSE
            GO TO 250
          END IF
        END DO
      END IF
  250 IF (MODE .EQ. 2 .OR. MODE .EQ. 3) THEN
        IF (IPR(63) + IPR(339) + IGBL(75) .EQ. 0) THEN
          IGBL(75) = 0
        ELSE
          IGBL(75) = 1
        END IF
      END IF
      RETURN
      END SUBROUTINE PLUT04
      SUBROUTINE PLUT05
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP49=2000000,NP22=287,NP48=1000,NP33=15,NP38=150,NP39=30,
     2 NP43=12,NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER J15*5
      IDASH    = 0
      IPR(130) = 0
      KL       = IPR(220)
      KN       = IPR(221)
      PAR(1)   = PAR(2) / 2
      IF (IPR(100) .EQ. 0) CALL PLUT33
      IPR(72) = 0
      IF (IPR(17) .EQ. 0) THEN
        IDASH    = 0
        IPR(35)  = 1 - IPR(50)
        IPR(60)  = 1
        IPR(110) = (1 - IPR(50)) * IGBL(97)
        IF (IPR(9) .GT. 1 .AND. IPR(127) .EQ. 0) THEN
          IGBL(30) = 1
          WRITE (LU6, 99999, IOSTAT = IOST)
        END IF
      ELSE
        IF (KL .LE. 1) GO TO 30
        IF (IFL(2)(1:5) .EQ. 'RADII') THEN
          IPR(35) = 0
          IPR(60) = 1
          N       = 0
          DO I = 1, NP10
             RADR(I, 2) = -1
          END DO
          IF (KL .GT. 2) THEN
            IGBL(30) = IPR(50)
            DO K = 3, KL
               J15 = IFL(K)(1:5)
               IF (J15 .EQ. 'NOMOV') THEN
                  IGBL(30) = 1
               ELSE IF (J15 .EQ. 'UNIQU') THEN
                  IPR(35)  = 1 - IPR(50)
                  IPR(110) = 0
               ELSE IF (J15 .EQ. 'INTER') THEN
                 IPR(35) = - 1
               ELSE IF (J15(1:3) .EQ. 'TOL') THEN
                 N = N + 1
                 IF (N .LE. KN) THEN
                   IF (J15(4:4) .EQ. 'E') THEN
                     PAR(26) = FN(N)
                   ELSE
                     PAR(1) = FN(N)
                   END IF
                   WRITE (LU6, 99998, IOSTAT = IOST)
     1               PAR(1), IGBL(97) * PAR(26)
                 END IF
               ELSE IF (J15 .EQ. 'EXPAN') THEN
                 IPR(110) = 1
               ELSE IF (J15 .EQ. 'HBOND') THEN
                IPR(109) = 1
               ELSE IF (J15 .EQ. 'XBOND') THEN
                IPR(109) = 2
               ELSE
                 CALL PLUT13 (0, -K, IAT, XDUM)
                 IF (IAT .GE. 0) GO TO 30
                 M          = - IAT
                 N          = N + 1
                 RADR(M, 2) = FN(N)
                 IPR(60)    = 0
               END IF
            END DO
            IPR(221) = 0
            KN       = IPR(221)
          END IF
        ELSE IF (IFL(2)(1:5) .EQ. 'INTRA') THEN
          IPR(37) = IPR(38)
          IPR(52) = IPR(53)
          GO TO 40
        ELSE
          IDASH = 0
          IF (IFL(2)(1:4) .EQ. 'DASH' .AND. KL .EQ. 4) THEN
            IDASH    = 1
            IFL(2)   = IFL(3)
            IFL(3)   = IFL(4)
            KL       = 3
            IPR(220) = KL
          END IF
          IF (KL .LT. 3) GO TO 30
          IF (IPR(52) .EQ. (1 - IPR(50)) * 12) THEN
            IPR(75) = 1
            CALL PLUT17 (1555.0 + 1 / PAR(42), 0, MADDR, LU6)
            WRITE (LU6, 99997, IOSTAT = IOST)
            DO I = 1, IPR(37)
              CALL PLUT23 (I)
            END DO
          END IF
          IF (IPR(161) .LT. 0) THEN
            KB = 3
          ELSE
            KB = 2
          END IF
   10     CALL PLUT13 (0, - KB, IAT, XDUM)
          IF (IPR(161) .EQ. 1) THEN
            KL0 = 4
          ELSE
            KL0 = KB + 1
          END IF
          IF (IAT .EQ. 0 .OR. KL .LT. KL0) GO TO 30
          DO K = KL0, KL
            IF (IAT .GT. 0) THEN
              I1 = IAT
              I2 = IAT
            ELSE
              I1 = IPR(69) + 1
              I2 = IPR(37)
            END IF
            IF (KN .EQ. 1) THEN
              M13 = -1
            ELSE
              M13 = 0
            END IF
            CALL PLUT13 (M13, -K, JAT, XMOL)
            IF (JAT .EQ. 0) THEN
              GO TO 30
            ELSE IF (JAT .GT. 0) THEN
              IF (IAT .GT. 0 .AND. KL .EQ. 3) THEN
                IF (KN .EQ. 1) XMOL = FN(1)
                CALL PLUT28 (IAT, JAT, XMOL)
                IFL(K) = NQ1
              END IF
              J1 = JAT
              J2 = JAT
            ELSE
              J1 = IPR(69) + 1
              J2 = IPR(37)
            END IF
            DO I = I1, I2
              IAIO =  - INT(RA(I * NP43 + 7) / 64000) - 1
              IF (IAT .GE. 0 .OR. IAT .EQ. IAIO) THEN
                DO J = J1, J2
                  JAIO = - INT(RA(J * NP43 + 7) / 64000) - 1
                  IF (JAT .GE. 0 .OR. JAT .EQ. JAIO) THEN
                    CALL PLUT16 (IPR(17) - 2, IDUM0, I, J, DUM1, IDUM2)
                    IF (IPR(17) .EQ. 1) THEN
                      CALL PLUT15 (-4, I, 33, IVAL)
                      IF (IVAL .LT. NP33) THEN
                        IVL = IVAL + 1
                        CALL PLUT15 (4, I, 33, IVL)
                      END IF
                      CALL PLUT15 (-4, J, 33, IVAL)
                      IF (IVAL .LT. NP33) THEN
                        IVL = IVAL + 1
                        CALL PLUT15 (4, J, 33, IVL)
                      END IF
                    END IF
                  END IF
                END DO
              END IF
            END DO
          END DO
          IF (IPR(161) .LT. 0) THEN
            KB = KB + 1
            IF (KB .LT. KL) GO TO 10
          END IF
          GO TO 40
        END IF
      END IF
      IF (IPR(60) .NE. 0) THEN
        DO I = 1, IAN
          RADR(I, 2) = RADR(I, 3) + PAR(1)
          IF (IPR(35) .LT. 0) THEN
            RADR(I, 2) = RADR(I, 4)
            IF (IPR(109) .GT. 0) THEN
              DO N = 1, IPR(480)
                IF (IEN(I) .EQ. IDOAC(N)) THEN
                  RADR(I, 2) = RADR(I, 4)
                  GO TO 20
                END IF
              END DO
              IF (MOD(IEN(I), 32) .EQ. 1) THEN
                RADR(1, 2) = VDWR(1)
              ELSE
                RADR(I, 2) = 0.0
              END IF
   20         CONTINUE
            END IF
          END IF
        END DO
      END IF
      CALL PLUT07
      GO TO 40
   30 IPR(72) = 27
      WRITE (LU6, 99995, IOSTAT = IOST)
      CALL PLA015 (0, 48)
   40 IF ((IDASH .EQ. 1 .OR. IPR(221) .GT. 0) .AND. IPR(4) .NE. 0) THEN
        IF (IDASH .EQ. 1) THEN
          IFL(5)   = IFL(3)
          IFL(4)   = IFL(2)
          IFL(3)   = 'DASH '
          IPR(220) = 5
          IF (IPR(221) .LT. 2) THEN
            FN(1) = 0.02
            FN(2) = 5
            IPR(221) = 2
          END IF
        ELSE
          IFL(4)  = IFL(3)
          IFL(3)  = IFL(2)
          IPR(220) = 4
        END IF
        IFL(2) = 'BONDS'
        CALL PLUT21 (0)
        IPR(220) = 5
        IDASH    = 0
      END IF
      IPR(17) = 1
      RETURN
99999 FORMAT (':: Automatic NOMOVE set because of (partial) disorder')
99998 FORMAT (':: Current JOIN RADII INTRA   TOL /ATOM=', F5.2,' Ang.',/
     1       ,'    +(EARTH)ALKALI-NON-METAL) TOLE/BOND=', F5.2,' Ang.')
99997 FORMAT (':: User-Supplied Bonds only mode')
99995 FORMAT (':: Problem/Error in JOIN - routine')
      END SUBROUTINE PLUT05
      SUBROUTINE PLUT06
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30,NP43=12,NP45=2048)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      CHARACTER INVERT*6, N12*2, N1*1
      DIMENSION RSAVE(3, 3), YUNK(3, 3)
      IPR(130) = 0
      IPR(150) = 0
      KL       = IPR(220)
      KN       = IPR(221)
      IF (IPR(17) .EQ. 0) THEN
        KNS = KN
        KLS = KL
        IPR(221) = 0
        IPR(220) = 1
        CALL PLUT05
        IF (IPR(72) .NE. 0) CALL GEN127 ('309')
        IPR(221) = KNS
        KN       = IPR(221)
        IPR(220) = KLS
        KL       = IPR(220)
      END IF
      DO I = 1, 3
        DO J = 1, 3
          RSAVE(I, J) = R(I, J)
        END DO
      END DO
      IF (IPR(51) .EQ. 0 .OR. IPR(37) .EQ. 0) THEN
        WRITE (LU6, 99994, IOSTAT = IOST)
        GO TO 400
      END IF
      IPR(72)  = 0
      N        = 0
      L        = 2
      IGBL(67) = 1
      IF (KL .EQ. 1) THEN
        IPR(220) = 2
        KL       = IPR(220)
        IF (IFL(1)(1:1) .EQ. 'V') THEN
          IFL(2)(1:4) = 'UNIT'
        ELSE
          IFL(2) = IFL(1)
        END IF
      END IF
      N12 = IFL(L)(1:2)
      IF (N12 .EQ. 'IN' .OR. N12 .EQ. 'XR' .OR. N12 .EQ. 'YR' .OR.
     1    N12 .EQ. 'ZR') THEN
         L = 1
         GO TO 200
      END IF
      IF (N12 .EQ. 'AL') THEN
        IF (KL .NE. 6)  GO TO 400
        IF (IFL(5)(1:1) .NE. 'W')  GO TO 400
        IF (IFL(6)(1:1) .EQ. 'X') THEN
          ANG = 0.0
        ELSE IF (IFL(6)(1:1) .EQ. 'Y') THEN
          ANG = -90.0
        ELSE
          GO TO 400
        END IF
        CALL PLUT13 (0, 3, IAT, XDUM)
        CALL PLUT13 (0, 4, JAT, XDUM)
        IF (IAT .LE. 0 .OR. JAT .LE. 0)  GO TO 400
        IF (KN .EQ. 1 .AND. KL .EQ. 6) CALL PLUT28 (IAT, JAT, FN(1))
        DO I = 1, 2
          ZU(I + 9)  = 0.0
          ZU(I + 12) = 0.0
          DO J = 4, 6
            ZU(I + 9)  = R(I, J - 3) * RA(IAT * NP43 + J) + ZU(I + 9)
            ZU(I + 12) = R(I, J - 3) * RA(JAT * NP43 + J) + ZU(I + 12)
          END DO
          ZU(I) = ZU(I + 12) - ZU(I + 9)
        END DO
        IF (ABS(ZU(1)) + ABS(ZU(2)) .LE. 1.0) THEN
          WRITE (LU6, 99998, IOSTAT = IOST)
          GO TO 430
        END IF
        ANG         = ATAN2(ZU(2), ZU(1)) * RGBL(6) + ANG
        N           = 0
        L           = 0
        IPR(220)    = 1
        KL          = IPR(220)
        IPR(221)    = 1
        KN          = IPR(221)
        FN(1)       = ANG
        IFL(1)(1:1) = 'Z'
        IGBL(67)    = 1
      ELSE IF (N12 .EQ. 'MA') THEN
        IF (KN .LT. 9) THEN
          WRITE (LU6, 99991, IOSTAT = IOST)
          GO TO 400
        END IF
        K = 0
        DO I = 1, 3
          DO J = 1, 3
            K = K + 1
            R(I, J) = FN(K)
          END DO
        END DO
        N = 9
      ELSE IF (N12 .EQ. 'MI') THEN
        CALL PLUT08
        L        = 2
        IPR(150) = 2
      ELSE IF (N12 .EQ. 'XO') THEN
        CALL GEN021 (R, 0)
        R(1, 2) = 1.0
        R(2, 3) = 1.0
        R(3, 1) = 1.0
        IPR(150) = 3
      ELSE IF (N12 .EQ. 'YO') THEN
        CALL GEN021 (R, 0)
        R(1, 3) = 1.0
        R(2, 1) = 1.0
        R(3, 2) = 1.0
        IPR(150) = 4
      ELSE IF (N12 .EQ. 'ZO' .OR. N12 .EQ. 'UN') THEN
        CALL GEN021 (R, 1)
        IF (N12 .EQ. 'ZO') THEN
          IPR(150) = 5
        ELSE
          IPR(150) = 1
        END IF
      ELSE IF (N12 .EQ. 'CU') THEN
        GO TO 200
      ELSE
        CALL GEN021 (R, 0)
        CALL GEN074 (RA, 1, 3, 0.5)
        IF (N12(2:2) .EQ. 'F') THEN
          IF (N12(1:1) .EQ. 'B') THEN
            J = 2
          ELSE IF (N12(1:1) .EQ. 'C') THEN
            J = 3
          ELSE
            J = 1
          END IF
          IPR(150) = 5 + J
          ILINE = 1
          RA(J) = 1.0
          GO TO 100
        END IF
        IF (N12 .EQ. 'DI') THEN
          IF (KN .LT. 3) THEN
            WRITE (LU6, 99987, IOSTAT = IOST)
            GO TO 400
          END IF
          DO K = 1, 3
            RA(K) = FN(K)
          END DO
          ILINE = 1
          L = 2
          N = 3
          GO TO 100
        END IF
        IF (N12 .EQ. 'LI') THEN
          ILINE = 1
          IF (KL .LT. 4) THEN
            WRITE (LU6, 99992, IOSTAT = IOST)
            GO TO 400
          END IF
          CALL PLUT13 (0, 3, IAT, XDUM)
          CALL PLUT13 (0, 4, JAT, XDUM)
          IF (IAT .LE. 0 .OR. JAT .LE. 0) THEN
            WRITE (LU6, 99993, IOSTAT = IOST)
            GO TO 400
          END IF
          IF (KN .EQ. 1 .AND. KL .EQ. 4) CALL PLUT28 (IAT, JAT, FN(1))
          DO K = 1, 3
            RA(K) = RA(IAT * NP43 + K) - RA(JAT * NP43 + K)
          END DO
          L = L + 2
          GO TO 100
        END IF
        IF (N12 .EQ. 'PE') THEN
          ILINE = 2
          GO TO 140
        END IF
        IF (N12 .EQ. 'BI') THEN
          ILINE = 3
          GO TO 140
        END IF
        WRITE (LU6, 99986, IOSTAT = IOST)
         GO TO 400
  100   CALL PLUT23 (0)
        XDUM = GEN017 (RA(4))
        DO K = 7, 9
          ZU(K)     = RA(K - 3)
          ZU(K + 6) = 0.0
        END DO
        IF (ABS(ZU(8)) .GT. 0.9999) THEN
          ZU(13) = 1.0
        ELSE
          ZU(14) = 1.0
        END IF
        CALL GEN008 (ZU(13), ZU(7), ZU(1), 1)
        CALL GEN008 (ZU(7), ZU(1), ZU(4), 1)
        GO TO 180
  140   IF (KL .LT. 5) THEN
          WRITE (LU6, 99989, IOSTAT = IOST)
          GO TO 400
        END IF
        CALL PLUT13 (0, 3, J1, XDUM)
        CALL PLUT13 (0, 4, J2, XDUM)
        CALL PLUT13 (0, 5, J3, XDUM)
        IF (J1 .LE. 0 .OR. J2 .LE. 0 .OR. J3 .LE. 0) THEN
          WRITE (LU6, 99988, IOSTAT = IOST)
          GO TO 400
        END IF
        L = L + 3
        DO K = 1, 3
          KKK = K + 3
          ZU(K + 6)  = 0.5 * (RA(J1 * NP43 + KKK)
     1               + RA(J3 * NP43 + KKK)) - RA(J2 * NP43 + KKK)
          ZU(K + 9)  = RA(J1 * NP43 + KKK)  - RA(J2 * NP43 + KKK)
          ZU(K + 12) = RA(J3 * NP43 + KKK)  - RA(J2 * NP43 + KKK)
        END DO
        XDUM = GEN017 (ZU(7))
        XDUM = GEN017 (ZU(10))
        XDUM = GEN017 (ZU(13))
        CALL GEN008 (ZU(7), ZU(13), ZU(4), 1)
        CALL GEN008 (ZU(4), ZU(7), ZU(1), 1)
        IF (ILINE .NE. 3) THEN
          DO K = 1, 3
            TEMP      = ZU(K + 6)
            ZU(K + 6) = ZU(K + 3)
            ZU(K + 3) = ZU(K)
            ZU(K)   = TEMP
          END DO
        END IF
  180   DO I = 1, 9
          J = (I - 1) / 3
          K = I - J * 3
          R(J + 1, K) = ZU(I)
        END DO
      END IF
  200 L = L + 1
      IF (L .GT. KL)  GO TO 370
      N1 = IFL(L)(1:1)
      IF (N1 .EQ. 'I') THEN
        CALL GEN010 (R, -1, -1)
        GO TO 200
      END IF
      N = N + 1
      IF (N .GT. KN) THEN
        WRITE (LU6, 99985, IOSTAT = IOST)
        GO TO 400
      END IF
      CALL GEN021 (A, 1)
      ANG = FN(N) / RGBL(6)
      CA  = COS(ANG)
      SA  = SIN(ANG)
      IF (N1 .EQ. 'B') THEN
        IF ((L + 2) .GT. KL) THEN
          WRITE (LU6, 99985, IOSTAT = IOST)
          GO TO 400
        END IF
        L = L + 1
        CALL PLUT13 (0, L, I, XDUM)
        L = L + 1
        CALL PLUT13 (0, L, J, XDUM)
        IF (I .LE. 0 .OR. J .LE. 0) THEN
          WRITE (LU6, 99988, IOSTAT = IOST)
          GO TO 400
        END IF
        DO K = 1, 3
          RA(K) = RA(I * NP43 + K) - RA(J * NP43 + K)
        END DO
        CALL PLUT23 (0)
        XDUM = GEN017 (RA(4))
        CALL GEN002 (1, R, RA(4), RA(1), XLNG)
        GO TO 340
      ELSE IF (N1 .EQ. 'L') THEN
        IF ((N + 3) .GT. KN)  GO TO 400
        DO I = 1, 3
          N = N + 1
          RA(I) = FN(N)
        END DO
        CALL PLUT23 (0)
        XDUM = GEN017 (RA(4))
        CALL GEN002 (1, R, RA(4), RA(1), XLNG)
        GO TO 340
      ELSE IF (N1 .EQ. 'O') THEN
        IF ((N + 3) .GT. KN)  GO TO 400
        DO I = 1, 3
          N = N + 1
          ZU(I + 6) = FN(N)
        END DO
        XDUM = GEN017 (RA(4))
        CALL GEN002 (1, R, RA(4), RA(1), XLNG)
        GO TO 340
      ELSE IF (N1 .EQ. 'P') THEN
        IF ((N + 3) .GT. KN)  GO TO 400
        DO I = 1, 3
          N = N + 1
          ZU(I + 3) = FN(N)
        END DO
        XDUM = GEN017 (ZU(4))
         GO TO 340
      ELSE IF (N1 .EQ. 'X') THEN
        CALL GEN043 (1, A, ANG)
        CALL GEN004 (A, R, YUNK)
        CALL GEN052 (YUNK, R)
        GO TO 200
      ELSE IF (N1 .EQ. 'Y') THEN
        CALL GEN043 (2, A, ANG)
        CALL GEN004 (A, R, YUNK)
        CALL GEN052 (YUNK, R)
        GO TO 200
      ELSE IF (N1 .EQ. 'Z') THEN
        CALL GEN043 (3, A, ANG)
        CALL GEN004 (A, R, YUNK)
        CALL GEN052 (YUNK, R)
        GO TO 200
      END IF
      GO TO 400
  340 CB = 1.0 - CA
      DO I = 1, 3
        DO J = 1, 3
          A(I, J) = CB * RA(I) * RA(J)
        END DO
      END DO
      A(1, 1) = A(1, 1) + CA
      A(1, 2) = A(1, 2) + RA(3) * SA
      A(1, 3) = A(1, 3) - RA(2) * SA
      A(2, 1) = A(2, 1) - RA(3) * SA
      A(2, 2) = A(2, 2) + CA
      A(2, 3) = A(2, 3) + RA(1) * SA
      A(3, 1) = A(3, 1) + RA(2) * SA
      A(3, 2) = A(3, 2) - RA(1) * SA
      A(3, 3) = A(3, 3) + CA
      CALL GEN004 (A, R, YUNK)
      CALL GEN052 (YUNK, R)
      GO TO 200
  370 CALL GEN096 (R, IROTX, IROTY, IROTZ, IDET, XYZOR, PHI, ROM)
      RGBL(28) = IROTX
      RGBL(29) = IROTY
      RGBL(30) = IROTZ
      IGBL(87) = IDET
      INVERT   = ' '
      IF (IDET .EQ. 0) THEN
        WRITE (LU6, 99997, IOSTAT = IOST)
     1    ((R(I, J), J = 1, 3), I = 1, 3)
        GO TO 400
      ELSE IF (IDET .LT. 0) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
        INVERT = 'INVERT'
      END IF
      IPR(330) = (1 - IDET) / 2
      WRITE (LU6, 99996, IOSTAT = IOST) IROTX, IROTY, IROTZ, INVERT
      WRITE (LU6, 99995, IOSTAT = IOST) (XYZOR(I), I = 1, 3), PHI,
     1  INVERT
      GO TO 430
  400 IPR(72) = 28
      WRITE (LU6, 99984, IOSTAT = IOST)
      DO I = 1, 3
        DO J = 1, 3
          R(I, J) = RSAVE(I, J)
        END DO
      END DO
      WRITE (LU6, 99990, IOSTAT = IOST)
  430 RETURN
99999 FORMAT (':: Absolute Configuration changed !!')
99998 FORMAT (':: ATOMS superimposed in this VIEW: VIEW MATRIX ',
     1        'NOT changed')
99997 FORMAT (/,':: Abs(Determinant) .NE. 1.00', //, 10X, 'Matrix', /,
     1               3(3F10.5,/))
99996 FORMAT (/,':: ORIENTATION     : VIEW UNIT XROT', I5,
     1                            ' YROT', I5, ' ZROT', I5, 2X, A)
99995 FORMAT (':: Equivalent with : VIEW DIR', 3F9.4, ' ZROT',
     1         F7.1, 2X, A)
99994 FORMAT (':: VIEW instruction NOT ALLOWED before',
     1        ' ATOM, CELL or ANGSTROM card')
99993 FORMAT (':: One or both ATOMS unacceptable')
99992 FORMAT (':: Less than 2 ATOMS specified')
99991 FORMAT (':: Less than 9 numbers on MATRIX card')
99990 FORMAT (':: Old VIEW Matrix retained')
99989 FORMAT (':: Less than 3 ATOMS specified')
99988 FORMAT (':: One or more ATOM LABELS unacceptable')
99987 FORMAT (':: Too few direction vector components')
99986 FORMAT (':: VIEW instruction not recognized')
99985 FORMAT (':: Inadequate rotation data')
99984 FORMAT (':: Error in VIEW routine')
      END SUBROUTINE PLUT06
      SUBROUTINE PLUT07
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,NP38=150,
     2 NP39=30,NP43=12,NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /PLXXX/ DLIM(3), T(3), XJS(3), SEP(3), XYZJS(3)
      DIMENSION XTT(96, 3), RAXJX(3)
      ILSTRT = 0
      IT     = 0
C * AUTOMATIC SEARCH FOR CONNECTIONS
      IDUM0 = 0
      IDUM2 = 0
      DUM1  = 0.0
      DO I = 1, 96
        DO J = 1, 3
          XTT(I, J) = 0.0
        END DO
      END DO
      NATO  = IPR(39)
      NSYM  = IPR(48)
      ILPB  = IPR(69) + 1
      NRESM = IPR(134)
      KSHFT = 0
      IF (IPR(35) .GE. 0) THEN
        IF (IPR(35) .EQ. 1) THEN
          KSHFT = 1
          IF (IPR(110) .EQ. 1) THEN
            WRITE (LU6, 99998, IOSTAT = IOST)
          ELSE
            WRITE (LU6, 99993, IOSTAT = IOST)
          END IF
          WRITE (LU22, 99991, IOSTAT = IOST)
        ELSE
          WRITE (LU6, 99996, IOSTAT = IOST)
          IPR(52) = IPR(68)
          IPR(53) = IPR(68)
        END IF
        CALL GEN074 (RCG, 1, NP32 * 4, 0.0)
        IPR(38) = NATO
        IPR(42) = 0
        IPR(43) = 0
        IPR(44) = 0
        IPR(70) = 0
        IVAL = MAX (0, IGBL(30) * 4)
        DO I = ILPB, NATO
          IF (IVAL .GT. 0) RA(I * NP43 + 12) = 1.555
          CALL PLUT15 (4, I, 1, IVAL)
          IF (IPR(50) .EQ. 1) CALL PLUT23 (I)
        END DO
        ILSTRT = ILPB
      ELSE
        IPR(52) = IPR(53)
        KSHFT   = 1 - IPR(50)
        I       = ILPB - 1
      END IF
      IPR(37) = IPR(38)
      IPR(72)  = 0
      IPR(130) = 0
      IPR(55)  = 0
      GO TO 170
   10 DO L = 1, 3
        XYZOR(IPR(120 + L)) = RA(I * NP43 + L)
      END DO
      CALL PLUT15 (-4, I, 28, IDIS)
      IDIS   = IPPR(IDIS + 1, 1)
      CALL PLUT15 (-5, I, 48, IPART)
      IPART  = IPART - 16
      NRI    = INT(RA(I * NP43 + 7) / 64000) + 1
      NELI   = IEN(NRI)
      IATPRX = IATPR(NELI)
      IMETAL = ISIGN (1, IATPRX)
      IF (IATPRX .EQ. 5 .OR. IATPRX .EQ. 6) THEN
        IATPRI = 1
      ELSE IF (IATPRX .LT. 0) THEN
        IATPRI = -1
      ELSE
        IATPRI = 0
      END IF
      NEXT = 0
      CALL PLUT15 (-6, I, 5, NRESI)
      CALL PLUT15 (-1, I, 44, IHAT)
      IF (IPR(35) .LT. 0) THEN
        IF (IPR(109) .GT. 0) THEN
          IF (NELI .EQ. 8) GO TO 170
          IF (NELI .EQ. 10) GO TO 170
          IF (NELI .EQ. 4 .OR. NELI .EQ. 6) THEN
            CALL PLUT15 (-1, I, 46, IVAL)
            IF (IVAL .EQ. 0) GO TO 170
          END IF
        END IF
      ELSE
        IF (IPR(50) .EQ. 0) THEN
          IF (IHAT .EQ. 1) THEN
            J = NATO
            NEXT = 0
            GO TO 160
          END IF
        END IF
      END IF
      J = ILPB
      IF (IPR(50) .EQ. 1 .AND. IPR(35) .GE. 0) J = ILSTRT
   20 IF (IPR(35) .GE. 0 .AND. IPR(50) .EQ. 1 .AND. J .LT. I) THEN
        CALL PLUT15 (-2, J, 1, IVAL)
        IF (IVAL .EQ. 1) GO TO 160
      END IF
      CALL PLUT15 (-4, J, 28, JDIS)
      JDIS = IPPR(JDIS + 1, 1)
      CALL PLUT15 (-5, J, 48, JPART)
      JPART  = JPART - 16
      NRJ    = INT(RA(J * NP43 + 7) / 64000) + 1
      NELJ   = IEN(NRJ)
      IATPRX = IATPR(NELJ)
      JMETAL = ISIGN (1, IATPRX)
      IF (IATPRX .EQ. 5 .OR. IATPRX .EQ. 6) THEN
        IATPRJ = 1
      ELSE IF (IATPRX .LT. 0) THEN
        IATPRJ = -1
      ELSE
        IATPRJ = 0
      END IF
      CALL PLUT15 (-1, J, 44, JHAT)
      IF (IPR(35) .LT. 0) THEN
        IF (IPR(109) .GT. 0) THEN
          IF (NELJ .EQ. 8) GO TO 160
          IF (IHAT .EQ. JHAT) GO TO 160
          IF (NELJ .EQ. 4 .OR. NELJ .EQ. 6) THEN
            CALL PLUT15 (-1, J, 46, IVAL)
            IF (IVAL .EQ. 0) GO TO 160
          END IF
        END IF
      END IF
      CALL PLUT15 (-6, J, 18, NMULT)
      CALL PLUT15 (-6, J, 5, NRESJ)
      DMAX = RADR(NRI, 2) + RADR(NRJ, 2)
      IF (IPR(35) .GE. 0) THEN
        IF (IPR(60) .EQ. 1) THEN
          ITST = NELI * NELJ
          IF (ITST .EQ. 309 .OR. ITST .EQ. 412) THEN
            DMAX = DMAX + PAR(541)
          ELSE IF (ITST .EQ. 30 .OR. ITST .EQ. 40 .OR.
     1      ITST .EQ. 50 .OR. ITST .EQ. 120 .OR. ITST .EQ. 180) THEN
            DMAX = DMAX + PAR(542)
          ELSE IF (ITST .EQ. 177 .OR. ITST .EQ. 236) THEN
            DMAX = DMAX + PAR(543)
          ELSE IF (ITST .EQ. 39 .OR. ITST .EQ. 52) THEN
            DMAX = DMAX + PAR(544)
          ELSE IF (ITST .EQ. 93 .OR. ITST .EQ. 124) THEN
            DMAX = DMAX + PAR(545)
          ELSE IF (ITST .EQ. 285 .OR. ITST .EQ. 380) THEN
            DMAX = DMAX + PAR(546)
          ELSE
            IF (IATPRI * IATPRJ .LT. 0) THEN
              DMAX = DMAX + IGBL(97) * PAR(26)
            END IF
            IF (IMETAL + JMETAL .EQ. 2) THEN
              DMAX = DMAX + PAR(127)
              YUNK = GEN128 (NELI, NELJ)
              IF (YUNK .LT. -9.0) THEN
                DMAX = 2.0
              ELSE
                DMAX = DMAX + YUNK
              END IF
            END IF
          END IF
          IF (NELI .EQ. 1 .OR. NELJ .EQ. 1) DMAX = MIN (DMAX, PAR(461))
        END IF
      ELSE
        IF (IPR(109) .GT. 0) THEN
          DMAX = DMAX - 0.12
        END IF
      END IF
      DMAXSQ = DMAX**2
      NT = 0
      DO JJ = 1, 3
        DLIM(IPR(120 + JJ)) = DMAX / PAR(112 + JJ)
        RAXJX(JJ)           = RA(J * NP43 + JJ)
      END DO
      MOLY = 1555
      DO 150 N = 1, NSYM
        DO JJ = 1, 3
          T(JJ)       = 0.0
          XJX(JJ + 3) = 0.0
          XJX(JJ)     = RAXJX(JJ)
        END DO
        CALL SGSM (ICL, N, XJX, LU6, 3, IERR)
        IF (NMULT .GT. 1) THEN
          IF (N .GT. 1) THEN
            DO 30 KK = 1, NT
              DO JJ = 1, 3
                IF (0.5 - ABS(MOD(10.0 + ABS(XJX(JJ + 6)
     1            - XTT(KK, JJ)), 1.0)
     2            - 0.5) .GT. 0.005) GO TO 30
              END DO
              GO TO 150
   30       CONTINUE
          END IF
          NT = NT + 1
          DO JJ = 1, 3
            XTT(NT, JJ) = XJX(JJ + 6)
          END DO
        END IF
        DO M = 1, 3
          XJS(IPR(120 + M)) = XJX(M + 6)
        END DO
        IF (KSHFT .EQ. 0) THEN
          IF (I .EQ. J)  GO TO 150
          DO K = 1, 3
            SEP(K) = XYZOR(K) - XJS(K)
            IF (ABS(SEP(K)) .GT. DLIM(K))  GO TO 150
          END DO
          GO TO 70
        END IF
        K = 1
   40   IF (XYZOR(K) - XJS(K) .GT. DLIM(K))  GO TO 60
        XJS(K) = XJS(K) - 1.0
        T(K)   = T(K)   - 1.0
        GO TO 40
   50   K = K - 1
        IF (KSHFT .EQ. 0) GO TO 150
   60   XJS(K) = XJS(K) + 1.0
        T(K)   = T(K)   + 1.0
        SEP(K) = XJS(K) - XYZOR(K)
        IF (SEP(K) .LT. - DLIM(K))  GO TO 60
        IF (SEP(K) .GT. DLIM(K)) THEN
          K = K - 1
          IF (K .GT. 0) THEN
            GO TO 60
          ELSE
            GO TO 150
          END IF
        END IF
        K = K + 1
        IF (K .LT. 4)  GO TO 40
        IT = INT(ABS(T(1)) + ABS(T(2)) + ABS(T(3)))
        IF (N .EQ. 1 .AND. IT .EQ. 0 .AND. I .EQ. J) GO TO 50
   70   DO M = 1, 3
          RA(M) = SEP(IPR(120 + M))
        END DO
        CALL PLUT23 (0)
        DIJSQ = GEN009(RA(4), RA(4))
        IF (DIJSQ .LT. DMAXSQ) THEN
          IF (IPR(35) .LT. 0) THEN
            IF (N .EQ. 1) THEN
              IF (NRESI .EQ. NRESJ) THEN
                IF (IPR(109) .EQ. 0) THEN
                  IF (IT .EQ. 0) GO TO 50
                ELSE
                  IF (IHAT .EQ. 1) THEN
                    IF (IT .EQ. 0) GO TO 50
                  END IF
                  CALL PLUT40 (I, J, N, ISW)
                  IF (ISW .LT. 0) GO TO 50
                END IF
              ELSE
                IF (IPR(109) .GT. 0) THEN
                  CALL PLUT40 (I, J, N, ISW)
                  IF (ISW .LT. 0) GO TO 50
                END IF
              END IF
            ELSE
              IF (IPR(109) .GT. 0) THEN
                CALL PLUT40 (I, J, N, ISW)
                IF (ISW .LT. 0) GO TO 50
              END IF
            END IF
          END IF
        ELSE
          GO TO 50
        END IF
        DIJ = SQRT(DIJSQ)
        IF (DIJ .GT. 3.1) THEN
          IF ((NELI .EQ. 63 .AND. NELJ .EQ. 85) .OR.
     1        (NELJ .EQ. 85 .AND. NELI .EQ. 63)) GO TO 50
        END IF
        IF (IPR(109) .GT. 0 .AND. DIJ .LT. 1.25) GO TO 50
        MOLZ = NINT(N * 1000 + T(IPR(121)) * 100 + T(IPR(122)) * 10
     1       + T(IPR(123)) + 555)
        IF (NELJ .EQ. 111) THEN
          IF (DIJ .LT. RGBL(25) .AND. I .NE. J) THEN
            CALL PLUT25 (1, J, JDUM)
            CALL PLUT25 (2, I, IDUM)
            WRITE (LU6, 99992, IOSTAT = IOST) NQ1, NQ2, DIJ
            IVAL = 0
            CALL PLUT15 (6, J, 18, IVAL)
            IVAL = 0
            CALL PLUT15 (1, J, 27, IVAL)
            IVAL = 1
            CALL PLUT15 (2, J,  1, IVAL)
            GO TO 160
          END IF
        END IF
        DO M = 1, 3
          XYZJS(M) = XJS(IPR(120 + M))
        END DO
        IF (DIJ .LT. 0.05 .AND. I .EQ. J) THEN
          IF (J .GT. IPR(37)) GO TO 50
          CALL PLUT15 (-2, J, 3, IVL)
          IVL = MAX (IVL, 1)
          CALL PLUT15 ( 2, J, 3, IVL)
          IVL = 1
          CALL PLUT15 ( 1, J, 1, IVL)
          IF (I .EQ. J) GO TO 50
          IVL = 0
          CALL PLUT15 (1, J, 2, IVL)
          L = IPR(68) + 1
   80     CALL PLUT16 (0, L, IL1, IL2, DUM1, IDUM2)
          IF (IL1 .GT. IPR(38) .OR. IL2 .GT. IPR(38)) THEN
            IF (IL1 .EQ. J) THEN
              GO TO 90
            ELSE IF (IL1 .GT. J) THEN
              GO TO 110
            END IF
            IF (IL2 .NE. J)  GO TO 100
   90       CALL PLUT16 (-3, IDUM0, IL1, IL2, DUM1, IDUM2)
          END IF
  100     L = L + 1
          IF (L .LE. IPR(52))  GO TO 80
  110     IVL = 3
          CALL PLUT15 (2, J, 3, IVL)
          GO TO 150
        END IF
        KAT = J
        NEW = 1
        IF (IPR(35) .LT. 0) THEN
          IF (N .EQ. 1 .AND. IT .EQ. 0 .AND. NRESI .NE. NRESJ) THEN
            GO TO 140
          ELSE
            GO TO 120
          END IF
        ELSE
          IF (JHAT .EQ. 1) THEN
            CALL PLUT15 (-1, I, 46, JDOAC)
            CALL PLUT15 ( 1, J, 32, JDOAC)
          END IF
          CALL PLUT15 (-1, J, 1, IVAL)
          IF (IVAL .EQ. 0) THEN
            IVL = 1
            CALL PLUT15 (1, J, 2, IVL)
            IF (IPR(50) .EQ. 0) THEN
              IF (IATPRI .GE. 0 .AND. IATPRJ .LT. 0) NEXT = 1
            END IF
          END IF
          CALL PLUT15 (-2, J, 3, IVL)
          IF (N .EQ. 1 .AND. IT .EQ. 0) THEN
            ITX = 1
            IF (IVL .GT. 0) GO TO 140
          ELSE
            ITX = 0
          END IF
          IF (IVL .EQ. 0) THEN
            IF (ITX .EQ. 0) THEN
              DO II = 1, 3
                RA(J * NP43 + II) = XYZJS(II)
              END DO
              CALL PLUT23 (J)
              IVL = 2
            ELSE
              IVL = 1
            END IF
            CALL PLUT15 (2, J, 3, IVL)
            GO TO 140
          END IF
          IF (IPR(50) .EQ. 0) THEN
            DO II = 1, 3
              IF (ABS(RA(J * NP43 + II) - XYZJS(II)) * PAR(100 + II)
     1           .GT. PAR(22)) GO TO  120
            END DO
            GO TO 140
          END IF
        END IF
  120   IF (NEW .GT. 0) THEN
          NATC = IPR(38) + IPR(55)
          DO 130 KAT = ILPB, NATC
            DO II = 1, 3
              IF (ABS(RA(KAT * NP43 + II) - XYZJS(II))
     1            * PAR(100 + II) .GE. PAR(22)) GO TO 130
            END DO
            GO TO 140
  130     CONTINUE
          IPR(55) = IPR(55) + 1
          KAT     = IPR(38) + IPR(55)
          IF ((KAT + 1) * NP43 .GT. IPR(64) - IPR(52) * 2) THEN
            IPR(42) = IPR(43)
            IPR(52) = IPR(53)
            IPR(37) = IPR(38)
            IPR(72) = 29
            GO TO 250
          END IF
          DO II = 1, 3
            RA(KAT * NP43 + II) = XYZJS(II)
          END DO
          CALL PLUT23 (KAT)
          RA(KAT * NP43 + 8)  = RA(J * NP43 + 8)
          RA(KAT * NP43 + 9)  = RA(J * NP43 + 9)
          RA(KAT * NP43 + 10) = RA(J * NP43 + 10)
          RA(KAT * NP43 + 11) = RA(J * NP43 + 11)
          XM1                 = RA(J * NP43 + 12) * 1000.0
          XM2 = MOLZ
          CALL PLA270 (XM1, XM2, XM3)
          RA(KAT * NP43 + 12) = XM3 / 1000.0
          IVL = 0
          CALL PLUT15 (2, KAT, 3, IVL)
          IVL = 0
          CALL PLUT15 (2, I,   1, IVL)
            CALL PLUT15 (-6, I,   5, IVAL)
            CALL PLUT15 ( 6, KAT, 5, IVAL)
          IVL = 0
          CALL PLUT15 ( 1, KAT, 27, IVL)
        END IF
        IF (IPR(35) .GE. 0) THEN
          CALL PLUT15 (6, KAT,  5, IPR(70))
          IVL = IPR(70) - 1
          CALL PLUT15 (6, KAT, 11, IVL)
        END IF
        IF (IPR(35) .GE. 0) THEN
          CALL PLUT15 (-6, KAT, 5, NRESJ)
        ELSE
          CALL PLUT15 (-6, J, 5, NRESJ)
        END IF
        XM1  = MOLZ
        XM2  = MOLY
        CALL PLA270 (XM1, XM2, XM3)
        XMOL = INT(XM3) + NRESJ / PAR(42)
        IF (IPR(35) .LT. 0) THEN
          MTYPE = -1
        ELSE
          MTYPE =  0
        END IF
        CALL PLUT17 (XMOL, MTYPE, MADDR, LU6)
        IF (IPR(35) .LT. 0) CALL PLUT35 (XMOL, -1)
        IF (NEW .GT. 0) THEN
          RA(KAT * NP43 + 7) = RA(J * NP43 + 7)
          CALL PLUT15 (6, KAT, 11, MADDR)
        END IF
  140   IF (RA(KAT * NP43 + 12) .LE. 0.0) THEN
          RA(KAT * NP43 + 12) = MOLZ / 1000.0
          IF (KAT .LE. NATO) THEN
            XM1 = MOLZ
            XM2 = 0.0
            CALL PLA270 (XM1, XM2, XM3)
            IF (IPR(2) .NE. 0) THEN
              IPR(72) = 100 + IPR(2)
              GO TO 250
            END IF
            MOLY = INT(XM3)
          END IF
        END IF
        IF (I .LE. KAT) THEN
          IF (IDIS .EQ. 1000 .OR. JDIS .EQ. 1000 .OR.
     1        (ABS(IDIS - JDIS) .LE. 1)) THEN
            IF (IDIS .EQ. 500 .AND. JDIS .EQ. 500) THEN
              IF (ABS(IPART) .NE. ABS(JPART)) GO TO 50
            END IF
            IF (NEW .GT. 0) THEN
              CALL PLUT16 (-1, IDUM0, I, KAT, DUM1, IDUM2)
              IF (IPR(35) .GE. 0) THEN
                CALL PLUT15 (-3, I, 24, IVAL1)
                IF (NELJ .EQ. 3 .AND. IVAL1 .LT. 7) THEN
                  IVL = IVAL1 + 1
                  CALL PLUT15 (3, I, 24, IVL)
                END IF
                CALL PLUT15 (-3, KAT, 24, IVAL2)
                IF (NELI .EQ. 3 .AND. IVAL2 .LT. 7) THEN
                  IVL = IVAL2 + 1
                  CALL PLUT15 (3, KAT, 24, IVL)
                END IF
              END IF
            END IF
          END IF
        END IF
        GO TO 50
  150 CONTINUE
  160 IF (NEXT .EQ. 0) THEN
        J = J + 1
        IF (J .LE. NATO)  GO TO 20
        IF (IPR(35) .GE. 0) THEN
          IVL = 1
          CALL PLUT15 (2, I, 1, IVL)
          DO JJ = 1, 3
            RCG(JJ, NRESI) = RCG(JJ, NRESI) + RA(I * NP43 + JJ)
          END DO
          RCG(4, NRESI) = RCG(4, NRESI) + 1
        END IF
      END IF
  170 IF (IPR(35) .GE. 0) THEN
        IATPRI = 0
        INXT   = 0
        I      = 0
        IL0    = ILSTRT
        DO IL = IL0, NATO
          CALL PLUT15 (-2, IL, 1, IVAL)
          IF (IVAL .NE. 1) THEN
            IF (IPR(50) .EQ. 0)
     1      IATPRI = IATPR(IEN(INT(RA(IL * NP43 + 7) / 64000) + 1))
            IF (IVAL .EQ. 2) THEN
              IF (IATPRI .LT. 0) THEN
                I = IL
                GO TO 180
              ELSE
                IF (I .EQ. 0) I = - IL
              END IF
            END IF
            IF (INXT .LE. 0) THEN
              IF (IVAL .EQ. 0) THEN
                IF (IATPRI .LT. 0) THEN
                  INXT =   IL
                ELSE
                  INXT = - IL
                END IF
              END IF
            END IF
          ELSE
            IF (IL .EQ. ILSTRT) ILSTRT = ILSTRT + 1
          END IF
        END DO
        IF (I .LT. 0) THEN
          I = IABS(I)
          GO TO 180
        END IF
        JJ = IPR(70)
        IF (JJ .GT. 0) THEN
          ICG = IPR(38) + IPR(55) + 1
          ID0 = ICG + 1
          ID1 = ID0 + 1
          DO II = 1, 3
            RCG(II, JJ)        = RCG(II, JJ) / RCG(4, JJ)
            RA(ICG * NP43 + II) = RCG(II, JJ)
            RA(ID0 * NP43 + II) = PAR(141 + II)
          END DO
          RA(ICG * NP43 + 12) = 1.555
          CALL PLUT15 (6, ICG, 5, JJ)
          IF (IGBL(30) .LE. 0) THEN
            CALL PLUT23 (ICG)
            CALL PLUT23 (ID0)
            DUM5 = 99999.0
            IF (PAR(140) .GE. 0.0) THEN
              DO K = 1, NSYM
                DO L = 1, 3
                  XJX(L)     = RA(ICG * NP43 + L)
                  XJX(L + 3) = 0.0
                END DO
                CALL SGSM (ICL, K, XJX, LU6, 3, IERR)
                DO L = 1, 3
                  DUM1 = AMOD(XJX(L + 6), 1.0)
                  IF (DUM1 .LT. 0.0) DUM1 = DUM1 + 1.0
                  RA(ID1 * NP43 + L) = DUM1
                  TRL(L)            = DUM1 - XJX(L + 6)
                END DO
                CALL PLUT23 (ID1)
                CALL PLUT22 (ID0, ID1, DUM4)
                IF (DUM4 .LT. DUM5) THEN
                  DUM5 = DUM4
                  N = K
                  DO L = 1, 3
                    T(L) = TRL(L)
                  END DO
                END IF
              END DO
            ELSE
              YM1  = ABS(PAR(140) * 1000.0)
              N    = INT(YM1 / 1000.0)
              YM1  = YM1 - N * 1000.0
              T(1) = INT(YM1 / 100.0)
              YM1  = YM1 - T(1) * 100.0
              T(1) = T(1) - 5
              T(2) = INT(YM1 / 10.0)
              T(3) = INT(YM1 - T(2) * 10.0)
              T(2) = T(2) - 5
              T(3) = T(3) - 5
            END IF
            YM1 = N * 1000.0 + T(1) * 100.0 + T(2) * 10.0 + T(3)
     1          + 555.0
            CALL PLA270 (YM1, 0.0, YMM1)
            IF (IPR(2) .NE. 0) CALL GEN127 ('105')
            DO I0 = ILPB, ICG
              CALL PLUT15 (-6, I0, 5, I0RES)
              IF (I0RES .EQ. JJ) THEN
                DO L = 1, 3
                  XJX(L)     = RA(I0 * NP43 + L)
                  XJX(L + 3) = T(L)
                END DO
                CALL SGSM (ICL, N, XJX, LU6, 3, IERR)
                DO L = 1, 3
                  RA(I0 * NP43 + L) = XJX(L + 6)
                END DO
                CALL PLUT23 (I0)
                YM2 = RA(I0 * NP43 + 12) * 1000.0
                CALL PLA270 (YM1, YM2, YM3)
                IF (IPR(2) .EQ. 0)
     1          RA(I0 * NP43 + 12) = YM3 / 1000.0
              END IF
            END DO
            DO L = 1, 3
              RCG(L, JJ) = RA(ICG * NP43 + L)
            END DO
            L1 = IPR(42)
            IF (L1 .GT. 0) THEN
              DO L = 1, L1
                YRES = MOD(MOL(1, L) / PAR(42), 1.0)
                JJRES = NINT(YRES * PAR(42))
                IF (JJ .EQ. JJRES) THEN
                  YM3 = INT(MOL(1, L) / PAR(42))
                  CALL PLA270 (YM1, YM3, YM2)
                  IF (IPR(2) .NE. 0) CALL GEN127 ('103')
                  CALL PLA270 (YM2, YMM1, YM3)
                  IF (IPR(2) .NE. 0) CALL GEN127 ('102')
                  MOL(1, L) = NINT((YM3 + YRES) * PAR(42))
                END IF
              END DO
            END IF
          END IF
        END IF
        IF (INXT .EQ. 0) GO TO 190
        I = IABS(INXT)
        IF (IGBL(30) .EQ. 0) THEN
          NTRNS = IABS(NINT(RA(I * NP43 + 12) * 1000))
          IF (NTRNS .GT. 0) THEN
            IGBL(30) = - 1
            N     = NTRNS / 1000
            NTRNS = NTRNS - N * 1000
            K     = NTRNS / 100
            T(1)  = K - 5
            NTRNS = NTRNS - K * 100
            K     = NTRNS / 10
            T(2)  = K - 5
            NTRNS = NTRNS - K * 10
            T(3)  = NTRNS - 5
            DO L = 1, 3
              XJX(L)     = RA(I * NP43 + L)
              XJX(L + 3) = T(L)
            END DO
            CALL SGSM (ICL, N, XJX, LU6, 3, IERR)
            DO L = 1, 3
              RA(I * NP43 + L) = XJX(L + 6)
            END DO
            NTRNS = N * 1000 + NINT(T(1) * 100.0 + T(2) * 10.0 + T(3))
     1            + 555
            IF (NTRNS .NE. 1555) THEN
              IVL = 1
              CALL PLUT15 (1, I, 43, IVL)
            END IF
            XTRNS = NTRNS / 1000.0
          ELSE
            XTRNS = 1.555
          END IF
        ELSE
          XTRNS = 1.555
        END IF
        RA(I * NP43 + 12) = XTRNS
        IVL = 1
        CALL PLUT15 (2, I, 3, IVL)
        IF (IPR(70) .LT. NRESM) THEN
          IF (IPR(136) .EQ. 0) THEN
            IPR(70) = IPR(70) + 1
          ELSE
            CALL PLUT15 (-6, I, 5, IPR(70))
          END IF
          IPR(75) = MAX (IPR(75), IPR(70))
          IF (IPR(70) .EQ. NRESM)
     1      WRITE (LU6, 99999, IOSTAT = IOST) NRESM
        END IF
        XMOL = 1555.0 + IPR(70) / PAR(42)
        CALL PLUT17 (XMOL, 0, MADDR, LU6)
  180   CALL PLUT23 (I)
        CALL PLUT15 (6, I,  5, IPR(70))
        IVL = IPR(75) - 1
        CALL PLUT15 (6, I, 11, IVL)
      ELSE
        I = I + 1
        IF (I .GT. NATO)  GO TO 190
      END IF
      GO TO 10
  190 IPR(37) = IPR(38) + IPR(55)
      IF (IPR(35) .GE. 0) THEN
        IPR(38) = IPR(37)
        IPR(53) = IPR(52)
        IPR(20) = 1
        WRITE (LU6, 99997, IOSTAT = IOST) IPR(75)
        DO I = ILPB, NATO
          CALL PLUT15 (-2, I, 3, IVAL)
          IF (IVAL .EQ. 2) THEN
            IVL = 1
            CALL PLUT15 (1, I, 43, IVL)
          END IF
        END DO
      END IF
      IF (IPR(35) .LT. 0) THEN
        MTYPE = -1
      ELSE
        MTYPE   = 0
        IPR(43) = IPR(42)
        IPR(44) = IPR(42)
      END IF
        DO I = ILPB, IPR(39)
          IF (RA(I * NP43 + 12) .NE. 1.555) IGBL(60) = IGBL(60) + 1
        END DO
      IF (IPR(110) .EQ. 1) THEN
        INFIN = 0
        IF (IPR(42) .GT. 1) THEN
          NML0   = 0
  200     NMOL   = IPR(42)
          MI     = 0
  210     MI     = MI + 1
          IF (MI .GT. NMOL) GO TO 240
          MPM = MOL(1, MI)
          IF (MPM .LT. 0) GO TO 210
          CALL GEN098 (MPM, PAR(42), MS1, MT11, MT21, MT31, MR1)
          IF (MI .GT. NML0) THEN
            MJ = 0
          ELSE
            MJ = NML0
          END IF
  220     MJ = MJ + 1
          IF (MJ .GT. NMOL) GO TO 210
          MPM = MOL(1, MJ)
          IF (MPM .LT. 0) GO TO 220
          CALL GEN098 (MPM, PAR(42), MS2, ITX, ITY, ITZ, MR2)
          IF (MR2 .NE. MR1) GO TO 220
          XJX(1) = MS1
          XJX(2) = MT11
          XJX(3) = MT21
          XJX(4) = MT31
          XJX(5) = MS2
          XJX(6) = ITX
          XJX(7) = ITY
          XJX(8) = ITZ
          CALL SGSM (ICL, 0, XJX, LU6, 8, IERR)
          MS3  = NINT(XJX(9))
          MT13 = NINT(XJX(10))
          MT23 = NINT(XJX(11))
          MT33 = NINT(XJX(12))
          M3   = (MS3 * 1000 + MT13 * 100 + MT23 * 10 + MT33 + 555)
          M3   = NINT(M3 * PAR(42)) + MR1
          XM3  = M3 / PAR(42)
          MK   = 0
  230     MK   = MK + 1
          IF (MK .GT. NMOL) THEN
            CALL PLUT17 (XM3, MTYPE, MADDR, LU6)
            IF (IPR(35) .LT. 0) CALL PLUT35 (XM3, -1)
            GO TO 220
          END IF
          XM4 = MOL(1, MK) / PAR(42)
          IF (XM4 .LT. 0.0) GO TO 220
          IF (XM3 .EQ. XM4) GO TO 220
          M4  = INT(XM4)
          MR4 = NINT((XM4 - M4) * PAR(42))
          IF (MR4 .NE. MR1) GO TO 230
          MS4 = M4 / 1000
          MT4 = M4 - MS4 * 1000
          IF (MS3 .EQ. MS4) THEN
            MT14 = MT4 / 100
            IF (IABS(MT13 - MT14 + 5) .GT. 0) THEN
              INFIN = 1
              GO TO 220
            ELSE
              MT4 = MT4 - MT14 * 100
              MT24 = MT4 / 10
              IF (IABS(MT23 - MT24 + 5) .GT. 0) THEN
                INFIN = 1
                GO TO 220
              ELSE
                MT34 = MT4 - MT24 * 10
                IF (IABS(MT33 - MT34 + 5) .GT. 0) THEN
                  INFIN = 1
                  GO TO 220
                END IF
              END IF
            END IF
          END IF
          GO TO 230
  240     IF (IPR(42) .GT. NMOL) THEN
            NML0 = NMOL
            GO TO 200
          END IF
        END IF
        IF (IPR(35) .GE. 0) THEN
          IPR(43) = IPR(42)
          IPR(44) = IPR(42)
          DO I = 1, IPR(37)
            NRI  = INT(RA(I * NP43 + 7) / 64000) + 1
            NELI = IEN(NRI)
            IF (NELI .EQ. 4) THEN
              CALL PLUT15 (-4, I, 33, IVL)
              IF (IVL .EQ. 2) THEN
                NRBO = 99
              ELSE IF (IVL .EQ. 3) THEN
                NRBO = 2
              ELSE
                NRBO = 1
              END IF
            ELSE IF (NELI .EQ. 6) THEN
              NRBO = 2
            ELSE IF (NELI .EQ. 8) THEN
              NRBO = 4
            ELSE
              NRBO = 99
            END IF
            CALL PLUT15 (-3, I, 24, IVAL)
            IF (IVAL .GE. NRBO) THEN
              IVL = 0
              CALL PLUT15 (1, I, 46, IVL)
              DO J = 1, IPR(37)
                NRJ = INT(RA(J * NP43 + 7) / 64000) + 1
                IATPRJ = IATPR(IEN(NRJ))
                IF (IATPRJ .GT. 0) THEN
                  CALL PLUT16 (-3, IDUM0, I, J, DUM1, IDUM2)
                END IF
              END DO
            END IF
          END DO
          WRITE (LU6, 99995, IOSTAT = IOST) IPR(43)
          IF (INFIN .GT. 0) THEN
            IGBL(127) = 1
            WRITE (LU6, 99994, IOSTAT = IOST)
          END IF
        END IF
      END IF
  250 IF (IPR(50) * IPR(135) .GT. 0) THEN
        DO I = 1, IPR(37)
          ZZ = MOD(RA(I * NP43 + 3), 100.0)
          IF (ZZ .GT. 50.0) ZZ = ZZ - 100.0
          RA(I * NP43 + 3) = ZZ
          RA(I * NP43 + 6) = ZZ
        END DO
      END IF
      RETURN
99999 FORMAT ( ':: Maximum Residue Number(=', I2, ') reached.',
     1         ' (non-fatal)')
99998 FORMAT ( ':: AEX:JOIN RADII UNIQUE EXPAND')
99997 FORMAT ( ':: Structure contains', I3, ' isolated residue(s)')
99996 FORMAT ( ':: AEX:JOIN RADII')
99995 FORMAT (/':: Number of Unique Asymmetric Residue Units:', I5)
99994 FORMAT (/':: Infinite Structure')
99993 FORMAT ( ':: AEX:JOIN RADII UNIQUE')
99992 FORMAT ( ':: ', A, ' Excluded, DIST TO ', A, ' =', F7.2, ' Ang')
99991 FORMAT ('VIEW MIN')
      END SUBROUTINE PLUT07
      SUBROUTINE PLUT08
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30,NP43=12,NP45=2048)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      DIMENSION V(3, 3), XDA(6)
      CALL PLUT17 (0.0, 0, MADDR, LU6)
      NAT  = IPR(37)
      NMOL = IPR(42)
      ILPB = IPR(69) + 1
      CALL GEN074 (PAR, 67, 69, 0.0)
      N  = 0
      K  = (NAT + 1) * NP43
      KM = IPR(64) - IPR(52) * 2 - 3
      DO I = ILPB, NAT
        CALL PLUT15 (-1, I, 27, NINCL)
        IF (NINCL .GT. 0) THEN
          CALL PLUT15 (-6, I, 5, IRES)
          CALL PLUT15 (-6, I, 18, JINC)
          IF (JINC .EQ. 1) THEN
            NM = NMOL
          ELSE
            NM = 1
          END IF
          DO M = 1, NM
            XNM = MOL(1, M) / PAR(42)
            IF (XNM .GT. 0.0) THEN
              MPM = NINT (XNM * PAR(42))
              CALL GEN098 (MPM, PAR(42), NS, ITX, ITY, ITZ, NR)
              TRL(1) = ITX
              TRL(2) = ITY
              TRL(3) = ITZ
              IF (NR .EQ. 0 .OR. IRES .EQ. NR) THEN
                DO II = 1,3
                  XJX(II)     = RA(I * NP43 + II)
                  XJX(II + 3) = TRL(II)
                END DO
                CALL SGSM (ICL, NS, XJX, LU6, 3, IERR)
                DO II = 1, 3
                  RA(II) = XJX(II + 6)
                END DO
                CALL PLUT23 (0)
                IF (K .LT. KM) THEN
                  DO II = 1, 3
                    RA(K + II)   = RA(II + 3)
                    PAR(66 + II) = PAR(66 + II) + RA(II + 3)
                  END DO
                  K = K + 3
                  N = N + 1
                ELSE
                  IPR(101) = IPR(101) + 1
                END IF
              END IF
            END IF
          END DO
        END IF
      END DO
      IF (N .GT. 0) THEN
        IF (N .GT. 1) THEN
          IF (N .EQ. 2) THEN
            DO II = 1, 3
              PAR(66 + II) = PAR(66 + II) + 0.01
            END DO
          END IF
          CALL GEN074 (XDA, 1, 6, 0.0)
          DO II = 1, 3
            PAR(66 + II) = PAR(66 + II) / N
          END DO
          K = (NAT + 1) * NP43
          DO I = 1, N
            XX = RA(K + 1) - PAR(67)
            YY = RA(K + 2) - PAR(68)
            ZZ = RA(K + 3) - PAR(69)
            K   = K + 3
            XSQ = XX * XX
            YSQ = YY * YY
            ZSQ = ZZ * ZZ
            XDA(1) = XDA(1) + (YSQ + ZSQ)
            XDA(2) = XDA(2) - XX * YY
            XDA(4) = XDA(4) - XX * ZZ
            XDA(3) = XDA(3) + (ZSQ + XSQ)
            XDA(5) = XDA(5) - YY * ZZ
            XDA(6) = XDA(6) + (XSQ + YSQ)
          END DO
          CALL GEN023 (XDA, V, 3)
          CALL GEN005 (V, R)
          DO K = 1, 3
            TEMP = R(1, K)
            R(1, K) = -R(3, K)
            R(3, K) = TEMP
          END DO
          CALL GEN010 (R, IDET, 1)
        ELSE
          CALL GEN021 (R, 1)
        END IF
      ELSE
        IPR(72) = 30
      END IF
      RETURN
      END SUBROUTINE PLUT08
      SUBROUTINE PLUT09 (NINCL, ISW)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP49=2000000,NP22=287,NP48=1000,NP38=150,NP39=30,
     2 NP43=12,NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER NTXT*3
      IS = ISW
      IF (IABS(IGBL(8)) .NE. 2) THEN
        IF (IS .EQ. 89 .OR. IS .EQ. 159) THEN
          IS     = 28
          NINCL  = 0
        END IF
      END IF
      IPR(130) = 0
      NAT      = IPR(37)
      NATOS    = IPR(38)
      NATO     = IPR(39)
      ILPB     = IPR(69) + 1
      KL       = IPR(220)
      KN       = IPR(221)
      IPR(72)  = 0
      IF (KL .GT. 1) THEN
        NTXT = IFL(2)(1:3)
      ELSE
        NTXT = 'ALL'
      END IF
      NINC = NINCL
      IF (NTXT .EQ. 'NON') THEN
        NINC = MOD(NINCL + 1, 2)
        NTXT = 'ALL'
      END IF
      IF (NTXT .EQ. 'ALL') THEN
        DO I = ILPB, NAT
          CALL PLUT15 (1, I, 27, NINC)
        END DO
      ELSE IF (NTXT .EQ. 'CH') THEN
        DO I = ILPB, NATO
          CALL PLUT15 (-1, I, 44, IVAL)
          IF (IVAL .EQ. 1) THEN
            CALL PLUT15 (-1, I, 32, IVAL)
            IF (IVAL .EQ. 0) THEN
              CALL PLUT15 (1, I, 27, NINCL)
            END IF
          END IF
        END DO
      ELSE IF (NTXT .EQ. 'DH') THEN
        DO I = ILPB, NATO
          CALL PLUT15 (-1, I, 32, IVAL)
          IF (IVAL .EQ. 1) THEN
            CALL PLUT15 (1, I, 27, NINCL)
          END IF
        END DO
      ELSE IF (NTXT .EQ. 'ZOM') THEN
        IPR(166) = NINC
        IPR(130) = 0
      ELSE IF (NTXT .EQ. 'OUT') THEN
        DO I = 1, 3
          PAR(I * 2 + 28) =  1.01
          PAR(I * 2 + 27) = -0.01
        END DO
        PAR(35) = 4.5
        IF (KL .EQ. 3) THEN
          CALL PLUT13 (0, KL, M, XDUM)
        ELSE
          M = 0
        END IF
        IF (KN .EQ. 0 .AND. M .LE. 0) THEN
          IPR(15) = 1
        ELSE IF (KN .EQ. 1) THEN
          PAR(35) = FN(1)
          IF (PAR(35) .GT. 0.0) THEN
            IPR(15) = - M
          ELSE
            IPR(15) = 0
          END IF
        ELSE IF (KN .EQ. 6) THEN
          DO I = 1, KN
            PAR(I + 28) = FN(I)
          END DO
          IF (M .GT. 0) THEN
            DO I = 1, 3
              DO J = 27, 28
                PAR(I * 2 + J) = PAR(I * 2 + J) + RA(M * NP43 + I)
              END DO
            END DO
          END IF
          IPR(15) = 1
        ELSE
          IPR(72) = 31
        END IF
      ELSE
        DO K = 2, KL
           IF (IFL(K)(1:3) .EQ. 'UNI') THEN
             M = NATO + 1
             IF (M .LE. NATOS) THEN
               DO I = M, NATOS
                  CALL PLUT15 (1, I, 27, NINCL)
               END DO
             END IF
           ELSE IF (IFL(K)(1:3) .EQ. 'INT') THEN
             M = NATOS + 1
             IF (M .LE. NAT) THEN
               DO I = M, NAT
                 CALL PLUT15 (1, I, 27, NINCL)
               END DO
             END IF
           ELSE IF (IFL(K)(1:3) .EQ. 'ORI') THEN
             DO I = ILPB, NATO
               CALL PLUT15 (1, I, 27, NINCL)
             END DO
           ELSE
             IF (IS .EQ. 89 .OR. IS .EQ. 159) THEN
               CALL PLUT13 (0, K, M, XDUM)
             ELSE
               CALL PLUT13 (0, -K, M, XDUM)
             END IF
             IF (M .LT. 0) THEN
               IBEG = ILPB
               IF (NINC .EQ. 0) THEN
                 IEND = NAT
               ELSE
                 IEND = NATO
               END IF
             ELSE
               CALL PLUT25 (0, M, IAI)
               IBEG = M
               IEND = M
               M    = - IAI
             END IF
             DO I = IBEG, IEND
               CALL PLUT25 (0, I, IAI)
               IF (IAI .EQ. - M) THEN
                 IF (IS .EQ. 89 .OR. IS .EQ. 159) THEN
                   IVAL = 0
                   CALL PLUT15 (6, I, 18, IVAL)
                   CALL PLUT25 (1, I, IDUM2)
                   CALL PLUT29 (4, NQ1, NQ2, 0, 0)
                 ELSE
                   CALL PLUT15 (1, I, 27, NINCL)
                 END IF
               END IF
             END DO
           END IF
        END DO
      END IF
      IF (IS .EQ. 89 .OR. IS .EQ. 159) THEN
        L = IPR(69)
        DO I = ILPB, NATO
          CALL PLUT15 (-6, I, 18, IMULT)
          IF (IMULT .GT. 0) THEN
            L = L + 1
            DO K = 1, 12
              RA(L * NP43 + K) = RA(I * NP43 + K)
            END DO
          END IF
        END DO
        IPR(37)  = L
        IPR(38)  = L
        IPR(39)  = L
        IPR(170) = 2
      END IF
      RETURN
      END SUBROUTINE PLUT09
      SUBROUTINE PLUT10
      PARAMETER (NP0=6,NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,NP38=150,
     2 NP39=30,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      LOGICAL CC
      COMMON /CTRLC/ CC
      DIMENSION YUNK(3, 3)
      PAR145  = 0.0
      CPH     = 0.0
      SPH     = 0.0
      IDF     = 0
      IRADR   = 0
      JRADR   = 0
      IND1    = 0
      IND2    = 0
      IND3    = 0
      IDL1    = 0
      NDL1    = 0
      IDR1    = 0
      NDR1    = 0
      ICOL    = 0
      JCOL    = 0
      ISTK2   = 0
      ISTK    = IPR(158) + IPR(40) * NP0
      N       = 0
      NAB     = IPR(37) - IPR(69)
      NATOT   = IPR(62)
      ILPB    = IPR(69) + 1
      PAR(37) = 0
      IPR151 = IPR(151)
      IPR152 = IPR(152)
      IF (IPR151 .GT. 0) THEN
        IF (IPR(116) .NE. 0) IPR(336) = 0
        PAR145   = PAR(145)   * IPR(164)
        CPH      = COS(PAR145 / RGBL(6))
        SPH      = SIN(PAR145 / RGBL(6))
        IDF      = NATOT * NP0
        DELCOL   = IPR(153)
        WRICOL   = IPR(154)
        PAR(146) = 0.0
        IRADR    = IPR(157)
        JRADR    = IPR(167)
        IND1     = IPR(155)
        IND2     = 2
        IND3     = 3
        IF (IND1 .EQ. 2) THEN
          IND2   = 1
          IND3   = 3
          SPH    = - SPH
        ELSE IF (IND1 .EQ. 3) THEN
          IND2   = 1
          IND3   = 2
        END IF
      END IF
      IF (IPR(4) .EQ. 0 .OR. IPR(151) .GT. 0) THEN
        CSS = COS (6.0 / RGBL(6))
        SNS = SIN (6.0 / RGBL(6))
        DO K = 1, NATOT
          IF (IPR(116) .NE. 0) THEN
            I = IPR(158) + K * NP0
            J = IPR(168) + K * NP0
            RA(J - 3) =  CSS * RA(I - 3) + SNS * RA(I - 1)
            RA(J - 2) =  RA(I - 2)
            RA(J - 1) = -SNS * RA(I - 3) + CSS * RA(I - 1)
            RA(J)     =  RA(I)
          END IF
          IO = MOD(K - ILPB, NAB) + ILPB
          CALL PLUT15 (-1, IO, 27, NINCL)
          IF (NINCL .NE. 0) THEN
            CALL PLUT14 (-1, K, NPROP, IUASU, XYZK(1), XYZK(2),
     1                   XYZK(3), XYZK(4))
            IF (XYZK(4) .LT. 0.0 .OR. XYZK(4) .GT. 999.9) CYCLE
            IF (IO .GE. ILPB) THEN
              CALL PLUT15 (-4, IO, 33, NBOND)
            ELSE
              NBOND = 3
            END IF
            IF (NBOND .EQ. 0) THEN
              I = K * NP0 + IPR(158)
              CALL PLUT31 (I - NP0, -1.0)
              IF (IPR(151) .GT. 0) RA(I) = 100000.0
            END IF
          END IF
        END DO
      END IF
   10 IF (IPR(151) .NE. 0 .AND. IGBL(25) .EQ. 1) THEN
        XG = 0.0
        YG = 0.0
        ZG = 0.0
        IG = 9
        CALL GGIP (XG, YG, ZG, IG)
        IF (IG .GT. 0) CC = .TRUE.
      END IF
      IF (CC) THEN
        IF (IPR(116) .EQ. 0) THEN
          IPR(346) =   IABS(IPR(346))
        ELSE
          IPR(346) = - IABS(IPR(346))
        END IF
        IPR(4) = IABS(IPR(4))
        GO TO 50
      END IF
      IPR(56) = 0
      IADR    = IPR(79)
   20 IPR(56) = IPR(56) + 1
      IF (IPR(151) .LE. 0) THEN
        IF (CC) THEN
          IPR(346) = IABS(IPR(346))
          GO TO 50
        END IF
      END IF
      IF (IPR(56) .GT. IPR(97)) THEN
        IPR151 = IPR151 - 1
        IF (IPR151 .LE. 0) THEN
          GO TO 40
        ELSE
          IF (CC) THEN
            IPR(346) = IABS(IPR(346))
            GO TO 50
          END IF
          PAR(146) = PAR(146) + PAR145
          JADR     = IRADR
          KADR     = JADR  + IDF
          JADR1    = JRADR
          KADR1    = JADR1 + IDF
          DO I = 1, NATOT
            RA(JADR + NP0)  = RA(KADR + NP0)
            RA(JADR + IND1 + NP0 - 4) = RA(KADR + IND1 + NP0 - 4)
            RAK2                      = RA(KADR + IND2 + NP0 - 4)
            RAK3                      = RA(KADR + IND3 + NP0 - 4)
            RA(JADR + IND2 + NP0 - 4) =   CPH * RAK2 + SPH * RAK3
            RA(JADR + IND3 + NP0 - 4) = - SPH * RAK2 + CPH * RAK3
            IF (IPR(116) .NE. 0) THEN
              RA(JADR1 + IND1 + NP0 - 4) = RA(KADR1 + IND1 + NP0 - 4)
              RA(JADR1 + NP0)  = RA(KADR1 + NP0)
              RAK2             = RA(KADR1 + IND2 + NP0 - 4)
              RAK3             = RA(KADR1 + IND3 + NP0 - 4)
              RA(JADR1 + IND2 + NP0 - 4) =   CPH * RAK2 + SPH * RAK3
              RA(JADR1 + IND3 + NP0 - 4) = - SPH * RAK2 + CPH * RAK3
            END IF
            IF (RA(KADR + NP0) .GT. 9999.0) THEN
              CALL PLUT31 (KADR, DELCOL)
              IF (IPR(116) .NE. 0) WRICOL = IPR(144)
              CALL PLUT31 (JADR, WRICOL)
              IF (IPR(116) .NE. 0) THEN
                CALL PLUT31 (KADR1, DELCOL)
                CALL PLUT31 (JADR1, FLOAT (IPR(143)))
              END IF
            END IF
            JADR    = JADR + NP0
            KADR    = KADR + NP0
            IF (IPR(116) .NE. 0) THEN
              JADR1  = JADR1 + NP0
              KADR1  = KADR1 + NP0
            END IF
          END DO
          IRADR = IRADR + IDF
          JRADR = JRADR + IDF
          IDF   = - IDF
          GO TO 10
        END IF
      END IF
      IF (IPR151 .GT. 0) THEN
        IADR = IADR - 4
        IDL  = IRADR + NINT(RA(IADR + 1) * NP0)
        NDL  = IRADR + NINT(RA(IADR + 2) * NP0)
        IDR  = IDL   + IDF
        NDR  = NDL   + IDF
        IF (IPR(116) .NE. 0) THEN
          IDL1 = JRADR + NINT(RA(IADR + 1) * NP0)
          NDL1 = JRADR + NINT(RA(IADR + 2) * NP0)
          IDR1 = IDL1 + IDF
          NDR1 = NDL1 + IDF
        END IF
        IF (IPR151 .LT. IPR152) THEN
          CALL GGIP (0.0, DELCOL, 0.0, 0)
          CALL GGIP (RA(IDL - 3), RA(IDL - 2), 0.0, 3)
          RAXPL = RA(NDL - 3)
          RAYPL = RA(NDL - 2)
          IF (IPR(336) .EQ. 1) THEN
            RAXAV = RA(IDL - 3) + (RAXPL - RA(IDL - 3)) / 2
            RAYAV = RA(IDL - 2) + (RAYPL - RA(IDL - 2)) / 2
            CALL GGIP (RAXAV, RAYAV, 0.0, 2)
          END IF
          CALL GGIP (RAXPL, RAYPL, 0.0, 2)
          IF (IPR(116) .NE. 0) THEN
            CALL GGIP (RA(IDL1 - 3), RA(IDL1 - 2), 0.0, 3)
            RAXPL1 = RA(NDL1 - 3)
            RAYPL1 = RA(NDL1 - 2)
            CALL GGIP (RAXPL1, RAYPL1, 0.0, 2)
          END IF
        END IF
        CALL GGIP (RA(IDR - 3), RA(IDR - 2), 0.0, 3)
        RAXPL = RA(NDR - 3)
        RAYPL = RA(NDR - 2)
        IF (IPR(336) .EQ. 0) THEN
          CALL GGIP (0.0, WRICOL, 0.0, 0)
        ELSE
          ICOL = MOD(IABS(INT(RA(IADR + 4))), 1024)
          JCOL = MOD(ICOL, 32)
          IF (JCOL .GT. 0)  JCOL = IACL(JCOL)
          IF (JCOL .EQ. 0 .OR. JCOL .EQ. 17) JCOL = IPR(19)
          ICOL = ICOL / 32
          ICOL = IPR(19)
          IF (ICOL .GT. 0)  ICOL = IACL(ICOL)
          IF (ICOL .EQ. 0 .OR. ICOL .EQ. 17) ICOL = IPR(19)
          CALL GGIP (0.0, FLOAT(ICOL), 0.0, 0)
          RAXAV = RA(IDR - 3) + (RAXPL - RA(IDR - 3)) / 2
          RAYAV = RA(IDR - 2) + (RAYPL - RA(IDR - 2)) / 2
          CALL GGIP (RAXAV, RAYAV, 0.0, 2)
          CALL GGIP (0.0, FLOAT(JCOL), 0.0, 0)
        END IF
        IF (IPR(116) .NE. 0) CALL GGIP (0.0, FLOAT(IPR(144)), 0.0, 0)
        CALL GGIP (RAXPL, RAYPL, 0.0, 2)
        IF (IPR(116) .NE. 0) THEN
          CALL GGIP (RA(IDR1 - 3), RA(IDR1 - 2), 0.0, 3)
          RAXPL1 = RA(NDR1 - 3)
          RAYPL1 = RA(NDR1 - 2)
          CALL GGIP (0.0, FLOAT(IPR(143)), 0.0, 0)
          CALL GGIP (RAXPL1, RAYPL1, 0.0, 2)
        END IF
        GO TO 20
      END IF
      IPR(67) = 0
      CALL PLUT16 (IPR(56), I1, I, N, RBO, NBLNE)
      IF (IPR(56) .GT. IPR(68)) THEN
        IPR120 = IPR(120)
      ELSE
        IPR120 = 1
      END IF
      IF (I .EQ. 0) CALL GEN127 (' KAN NIET GOTO 20')
      IF (NBLNE .LT. 0) THEN
        NBLNE = IABS(NBLNE)
        IDASH = 1
      ELSE
        IDASH = 0
      END IF
      PAR(37) = RBO * PAR(24)
      NN      = I
      IPR(67) = 5
      IF (IPR(82) .NE. 0 .AND. IPR(116) .LE. 0) THEN
        III = IPR(125) + I * 4
        IIN = IPR(125) + N * 4
        IF (IPR(4) .EQ. 0) THEN
          IF (I .LE. IPR(69)) THEN
            CALL GEN040 (I, NQ1, IYANK)
          ELSE
            CALL PLUT25 (1, I, IYANK)
          END IF
          IF (N .LE. IPR(69)) THEN
            CALL GEN040 (N, NQ2, IYANK)
          ELSE
            CALL PLUT25 (2, N, IYANK)
          END IF
          IF (IPR(10) .EQ. 1) THEN
            WRITE (LU61, 99997, IOSTAT = IOST)
     1        NQ1, NQ2, RA(III - 2) - PAR(67),
     2        RA(III - 1) - PAR(68), -RA(III) + PAR(69),
     3        RA(IIN - 2) - PAR(67),  RA(IIN - 1) - PAR(68),
     4        -RA(IIN) + PAR(69), MAX (RBO, 0.05)
          END IF
        END IF
      END IF
      IF (IPR(4) .GT. 0) THEN
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          XG = 0.0
          YG = 0.0
          ZG = 0.0
          IG = 9
          CALL GGIP (XG, YG, ZG, IG)
          IF (IG .EQ. 3) THEN
            IPR(45) = 1
            GO TO 50
          END IF
        END IF
        CALL PLUT18 (IPR(40) + 1, IPR(40) + 2)
        IF (IPR(78) .LT. 0)  GO TO 20
      ELSE
        IPR(78) = 0
      END IF
      IF (NBLNE .GT. 1) THEN
        DELT = RGBL(5) / (2 * FLOAT(NBLNE - 1))
      ELSE
        DELT = 0.0
      END IF
      IF (IPR(4) .EQ. 0) THEN
        IF (IPR(346) .EQ. 1) THEN
          NBLNE = 2
          IF (IPR(477) .EQ. 0 .AND. IPR(120) .NE. 0) THEN
            ICOL = IACL(IPR(120) / 32)
            IF (ICOL .EQ. 17) ICOL = IPR(19)
            JCOL = IACL(MOD(IPR(120), 32))
            IF (JCOL .EQ. 17) JCOL = IPR(19)
          ELSE
            ICOL = IPR(120)
            JCOL = IPR(120)
          END IF
        END IF
      END IF
      ZU(4) = 0.0
      ZU(5) = 0.0
      ZU(6) = 1.0
      CALL GEN008 (ZU(4), ZU(7), ZU(1), 1)
      CALL GEN008 (ZU(7), ZU(1), ZU(4), 1)
      DIST  = 0
      L0    = - 2
      IDELD = 2
      ISTK1 = ISTK
      IF (IDASH .EQ. 1) THEN
        ISTK1 = ISTK + 2 * NP0
        ISTK2 = ISTK + 4 * NP0
        DO L = 1, 3
          L4 = NP0 + L - 4
          DIST = DIST + (RA(ISTK + NP0 + L4)
     1         - RA(ISTK + L4)) ** 2
        END DO
        IDELD = NINT(3.0 * SQRT(DIST) / PAR(24)) * 2 + 1
        DO L = 1, 3
          L4 = NP0 + L - 4
          RA(ISTK2 + L4) = (RA(ISTK + NP0 + L4)
     1                   - RA(ISTK + L4)) / IDELD
        END DO
        RA(ISTK2 + NP0) = (RA(ISTK + 2 * NP0)
     1                  - RA(ISTK + NP0)) / IDELD
      END IF
   30 L0 = L0 + 2
      IF (L0 .GE. IDELD) GO TO 20
      IF (IDASH .EQ. 1) THEN
        DO L = 1, 4
          L4 = NP0 + L - 4
          RA(ISTK1 + L4)       = RA(ISTK  + L4)
     1                         + RA(ISTK2 + L4) *  L0
          RA(ISTK1 + NP0 + L4) = RA(ISTK  + L4)
     1                         + RA(ISTK2 + L4) * (L0 + 1)
        END DO
      END IF
      IF (IPR(10) .EQ. 1 .AND. IPR(4) .NE. 0) THEN
        IF (I .LE. IPR(69)) THEN
          CALL GEN040 (I, NQ1, IYANK)
        ELSE
          CALL PLUT25 (1, I, IYANK)
        END IF
        IF (N .LE. IPR(69)) THEN
          CALL GEN040 (N, NQ2, IYANK)
        ELSE
          CALL PLUT25 (2, N, IYANK)
        END IF
        WRITE (LU61, 99997, IOSTAT = IOST)  NQ1, NQ2,
     1    RA(ISTK1 + NP0 - 3) / PAR(24),
     2    RA(ISTK1 + NP0 - 2) / PAR(24),
     3   -RA(ISTK1 + NP0 - 1) / PAR(24) - PAR(66) + PAR(69),
     4    RA(ISTK1 + 2 * NP0 - 3) / PAR(24),
     5    RA(ISTK1 + 2 * NP0 - 2) / PAR(24),
     6   -RA(ISTK1 + 2 * NP0 - 1) / PAR(24) - PAR(66) + PAR(69),
     7    MAX (RBO, 0.05)
      END IF
      NN    = I
      THETA = 0.0
      NLIN  = 0
      DO
        CT = COS(THETA)
        ST = SIN(THETA)
        DO L = 1, 3
          L4 = NP0 + L - 4
          XYZPL(L)     = (ZU(L) * CT + ZU(3 + L) * ST)
     1                 * RA(ISTK1 + NP0) + RA(ISTK1 + L4)
          XYZPL(L + 3) = (ZU(L) * CT + ZU(3 + L) * ST)
     1                 * RA(ISTK1 + 2 * NP0) + RA(ISTK1 + NP0 + L4)
        END DO
        NLIN = NLIN + 1
        IF (IPR(4) .EQ. 0) THEN
          IF (IPR(346) .EQ. 1) THEN
            IF (NN .GT. 0) THEN
              ICOL1 = ICOL
            ELSE
              ICOL1 = JCOL
            END IF
            IF (ICOL1 .EQ. 0 .OR. ICOL1 .GT. 15) ICOL1 = IPR(19)
            CALL GGIP (0.0, FLOAT(ICOL1), 0.0, 0)
          END IF
        ELSE
          IF (IPR(477) .NE. 0) THEN
            ICOL1 = IPR120
            IF (ICOL1 .LE. 0 .OR. ICOL1 .GT. 15) ICOL1 = IPR(19)
            CALL GGIP (0.0, FLOAT(ICOL1), 0.0, 0)
          END IF
        END IF
        IF (IPR(10) .LE. 0) CALL PLUT19 (0, NN)
        IF (NLIN .GE. NBLNE)  GO TO 30
        NN    = - NN
        THETA = THETA + DELT
      END DO
   40 IF (IPR(82) .NE. 0 .AND. IPR(116) .LE. 0) THEN
        IF (IPR(10) .EQ. 1) THEN
          WRITE (LU61, 99996, IOSTAT = IOST) PAR(24) * 0.16
          IPR(10) = 0
        ELSE IF (IPR(10) .EQ. 2) THEN
          IPR(10) = 0
        END IF
      END IF
   50 IF (PAR(146) .NE. 0) THEN
        CALL GEN043 (IPR(155), A, PAR(146) / RGBL(6))
        CALL GEN004 (A, R, YUNK)
        CALL GEN052 (YUNK, R)
        PAR(146) = 0
        IPR(151) = -1
      END IF
      RETURN
99997 FORMAT ('// bond ', A, 1X, A, ' 1', /,
     1        10X, 'cylinder { ', /, 15X, '<', F9.4, ',', F9.4, ',',
     2        F9.4, ' > , < ', F9.4, ',', F9.4, ',', F9.4, ' >,', /,
     3        F7.3, /,
     4        15X, 'texture { pigment { color color_bond }', /,
     5        15X, 'finish { finish_all } } }')
99996 FORMAT ('scale', F7.3, /, 'rotate y*180', /, 'translate y*-0.25',
     1 /, '}', /, '// End-of-Plot')
      END SUBROUTINE PLUT10
      SUBROUTINE PLUT11
      PARAMETER (NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP48=1000,NP32=63,NP38=150,NP43=12,
     2 NP39=30)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      NAB   = IPR(37) - IPR(69)
      NATOT = IPR(62)
      ILPB  = IPR(69) + 1
      IF (IPR(4) .NE. 0) THEN
        DO 30 K = ILPB, NATOT
          IO = MOD(K - ILPB, NAB) + ILPB
          CALL PLUT15 (-1, IO, 27, NINCL)
          IF (NINCL .NE. 0) THEN
            IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
              XG = 0.0
              YG = 0.0
              ZG = 0.0
              IG = 9
              CALL GGIP (XG, YG, ZG, IG)
              IF (IG .EQ. 3) THEN
                IPR(45) = 1
                GO TO 40
              END IF
            END IF
            IF (K .LE. IPR(37)) THEN
              IF (IPR(130) .EQ. 0) THEN
                IVAL = 1
                CALL PLUT15 (1, K, 45, IVAL)
              END IF
            END IF
            IPR(67) = 0
            CALL PLUT14 (-1, K, IASU, NPROP, XYZK(1), XYZK(2), XYZK(3),
     1                                 XYZK(4))
            IF (XYZK(4) .LT. 0 .OR. XYZK(4) .GT. 999.9)  GO TO 30
            CALL PLUT18 (K, 0)
            IF (IPR(78) .LT. 0) THEN
              IF (K .LE. IPR(37)) THEN
                IVAL = 0
                CALL PLUT15 (1, K, 45, IVAL)
              END IF
            ELSE
              NEL    = INT(RA(IO * NP43 + 7) / 64000) + 1
              ISHADE = 0
              NPRC   = 1
              NPRH   = 0
              NPRV   = 0
              NPRHM  = 0
              NPRVM  = 0
              NDOTS  = 0
              ISEGM  = 0
              PAR(7) = 0.0
              PAR(8) = 0.0
              IF (IPR(346) .EQ. 1) THEN
                ISHADE = 1
                PAR(6) = PAR(23)
                IF (IPR(477) .EQ. 0) THEN
                  ICOL0 = IACL(NEL)
                  IF (ICOL0 .GT. 8) ICOL0 = 0
                ELSE IF (IPR(477) .LT. 0) THEN
                  CALL PLUT15 (-6, IO, 5, NRS)
                  IF (NRS .GT. 0 .AND. NRS .LE. 8) THEN
                    ICOL0 = NCRS(NRS)
                  ELSE
                    ICOL0 = 0
                  END IF
                ELSE
                  CALL GEN048 (-5, NPROP, 1, ICOL0)
                END IF
                IF (ICOL0 .EQ. 0 .OR. ICOL0 .GT. 16) THEN
                  IF (IABS(IPR(477)) .EQ. 1) THEN
                    ICOL0 = IPR(19)
                  ELSE
                    ISHADE = 0
                  END IF
                END IF
                IPR(88) = ICOL0
              END IF
              PAR(130) = 0.0
              PAR(131) = 0.0
              IF (IPR(345) .EQ. 1) THEN
                PAR(6) = 2.0 * XYZK(4) / (IPR(54) + 1)
                IF (IPR(478) .EQ. 0) THEN
                  IF (IPR(461) .EQ. 0) THEN
                    IPR(162) = IBCL(NEL)
                  ELSE
                    IPR(162) = IPR(139)
                  END IF
                ELSE IF (IPR(478) .LT. 0) THEN
                  CALL PLUT15 (-6, IO, 5, NRS)
                  IF (NRS .GT. 0 .AND. NRS .LE. 16) THEN
                    IPR(162) = NPRS(NRS)
                  ELSE
                    IPR(162) = 0
                  END IF
                ELSE
                  CALL GEN048 (-5, NPROP, 6, IPR(162))
                END IF
              ELSE
                IPR(162) = IPR(139)
              END IF
              IF (IPR(162) .EQ. 1) THEN
                NPRC   = NINT(IPR(8) * PAR(24) / 4) + 1
                ISHADE = 0
              END IF
              IF (IPR(162) .EQ. 2) THEN
                IF (IPR(4) .EQ. 3) THEN
                  NPRH = IPR(85) + 10
                  NPRV = IPR(86) + 10
                ELSE
                  NPRH = IPR(85)
                  NPRV = IPR(86)
                END IF
                NPRH = NINT(NPRH * PAR(24) / 4)
                NPRV = NINT(NPRV * PAR(24) / 4)
                ISHADE = 0
              ELSE IF (IPR(162) .EQ. 7) THEN
                NPRH   = 3
                NPRV   = 3
                NPRHM  = 2
                NPRVM  = 2
                ISHADE = 0
              ELSE IF (IPR(162) .EQ. 8) THEN
                IF (IPR(4) .EQ. 3) THEN
                  NPRC = IPR(112) * 2
                  NPRV = IPR(132) * 2
                ELSE
                  NPRC = IPR(112)
                  NPRV = IPR(132)
                END IF
                NPRC     = NINT(NPRC * PAR(24) / 4)
                NPRV     = NINT(NPRV * PAR(24) / 4)
                PAR(130) = -45.0
                PAR(131) = -35.0
                ISHADE   = 0
                IF (IPR(96) .EQ. 1) THEN
                  ISHADE = 1
                  PAR(6) = 0.075
                  PAR(7) = 145.0
                  PAR(8) = -55.0
                END IF
              ELSE IF (IPR(162) .EQ. 9) THEN
                NPRC     = NINT(IPR(112) * PAR(24) / 4)
                NPRV     = 0
                ISHADE   = 0
                PAR(130) = -45.0
                PAR(131) = -35.0
              ELSE IF (IPR(162) .EQ. 10) THEN
                NPRC     = 0
                NPRV     = NINT(IPR(132) * PAR(24) / 4)
                ISHADE   = 0
                PAR(130) = -45.0
                PAR(131) = -35.0
              END IF
              IF (IPR(162) .EQ. 3) THEN
                ISHADE = 1
                PAR(6) = PAR(134)
                PAR(7) = PAR(135)
                PAR(8) = PAR(136)
              ELSE IF (IPR(162) .EQ. 11) THEN
                ISHADE = 1
                PAR(6) = 2.0 * XYZK(4) / (IPR(54) + 1)
                PAR(8) = 0.0
              ELSE IF (IPR(162) .EQ. 12) THEN
                ISHADE = 1
                PAR(6) = 2.0 * XYZK(4) / (IPR(54) + 1)
                PAR(8) = 90.0
              ELSE IF (IPR(162) .EQ. 13) THEN
                ISHADE = 2
                PAR(6) = 2.0 * XYZK(4) / (IPR(54) + 1)
                PAR(8) = 0.0
              ELSE IF (IPR(162) .EQ. 14) THEN
                ISHADE = 1
                PAR(6) = 2.0 * XYZK(4) / (IPR(54) + 1)
                PAR(8) = -45.0
              ELSE IF (IPR(162) .EQ. 15) THEN
                ISHADE = 1
                PAR(6) = 2.0 * XYZK(4) / (IPR(54) + 1)
                PAR(8) = 45.0
              ELSE IF (IPR(162) .EQ. 16) THEN
                ISHADE = 2
                PAR(6) = 2.0 * XYZK(4) / (IPR(54) + 1)
                PAR(8) = -45.0
              ELSE IF (IPR(162) .EQ. 6 .AND. NEL .NE. 1) THEN
                ISHADE = 1
                PAR(6) = PAR(23)
              END IF
              IF (IPR(162) .EQ. 4) THEN
                ISEGM  = 1
                NPRC   = 3
                ISHADE = 0
              END IF
              IF (IPR(162) .EQ. 5) THEN
                NDOTS  = 1
                ISHADE = 0
              END IF
              IF (NEL .EQ. 1) THEN
                IF (IPR(162) .EQ. 0) THEN
                  NPRH  = 0
                  NPRV  = 0
                  NPRC  = 0
                  ISEGM = 0
                  NDOTS = 0
                END IF
              END IF
              IF (NPRH .GT. 0) THEN
                PDTHH = 180.0 / (NPRH * RGBL(6))
              ELSE
                PDTHH = 0.0
              END IF
              IF (NPRV .GT. 0) THEN
                PDTHV = 180.0 / (NPRV * RGBL(6))
              ELSE
                PDTHV = 0.0
              END IF
              IF (NPRC .GT. 0) THEN
                CDTH = 90.0 / (NPRC * RGBL(6))
              ELSE
                CDTH =  0.0
              END IF
              IF (IPR(346) .GT. 0 .OR. NEL .NE. 1 .OR.
     1           IABS(IPR(4)) .GE. 3) THEN
                IF (ISHADE .GT. 0 .AND. IPR(78) .GE. 0) THEN
                  CALL PLUT36 (K, ISHADE)
                END IF
              END IF
              IF (NDOTS .GT. 0) THEN
                NPNT = NINT(IPR(124) * RADR(NEL, 1)**2)
                IF (IPR(346) .EQ. 1 .AND. IPR(139) .EQ. 5) THEN
                  CALL GGIP (0.0, FLOAT(ICOL0), 0.0, 0)
                END IF
                PI    = RGBL(5) / 2.0
                IDUM  = -1
                DO J = 1, NPNT
                  PHI  = GEN036 (IDUM) * 2 * PI
                  CHI  = SQRT(GEN036 (IDUM) * GEN036 (IDUM)) *
     1                   (1.0 + 0.99 * COS((PHI - PI) / 2)) / 2
                  CHI  = ATAN(SQRT(1 - (CHI**2)) / CHI)
                  SCHI = SIN(CHI) * XYZK(4)
                  XPL1 = SCHI * COS(PHI)
                  XPL2 = SCHI * SIN(PHI)
                  XPL3 = SQRT(ABS(XYZK(4)**2 - XPL1**2 - XPL2**2))
                  XYZPL(1) = XYZK(1) + XPL1
                  XYZPL(2) = XYZK(2) + XPL2
                  XYZPL(3) = XYZK(3) + XPL3
                  XYZPL(4) = XYZPL(1)
                  XYZPL(5) = XYZPL(2)
                  XYZPL(6) = XYZPL(3)
                  IF (IPR(346) .EQ. 1 .AND. IPR(139) .EQ. 0) THEN
                    CALL GGIP (0.0, FLOAT(ICOL0), 0.0, 0)
                  END IF
                  NN = 1
                  CALL PLUT19 (K, NN)
                END DO
              END IF
              DO I = 1, 4
                PAR(70 + I) = XYZK(I)
              END DO
              MP = MAX (NINT(PAR(125) * SQRT(PAR(74) * 10.0)), 5)
              IF (IPR(78) .EQ. 0) THEN
                IPR(91) = MP
              ELSE
                IPR(91) = MAX (NINT(RGBL(5) * PAR(74) * IPR(111) /
     1                    (4 * PAR(5)) + 1), 5)
              END IF
              PAR(55) = RGBL(5) / FLOAT(IPR(91) * 2)
              PAR(56) = RGBL(5) / FLOAT(MP * 2)
              IF (ABS(PAR(130)) + ABS(PAR(131)) .LT. 0.001) THEN
                NTRCE = 0
              ELSE
                NTRCE = - NPRC
              END IF
              IPR(87) = 2
              PAR(57) = 0.0
              CALL GEN074 (ZU, 2, 15, 0.0)
              IF (ISEGM .EQ. 1 .AND. NEL .GT. 1) THEN
                PAR(57) = 180.0 / RGBL(6)
                IPR(114) = INT(RGBL(5) / (3.0 * PAR(55)))
              END IF
              DO WHILE (NTRCE .LT. NPRC)
                NTRCE = NTRCE + 1
                IF (IPR(346) .EQ. 1)
     1            CALL GGIP (0.0, FLOAT(ICOL0), 0.0, 0)
                PAR(74) = XYZK(4) * COS(NTRCE * CDTH)
                ZU(10)  = 1.0
                ZU(11)  = 0.0
                ZU(12)  = 0.0
                ZU(13)  = 0.0
                ZU(14)  = 1.0
                ZU(15)  = 0.0
                ANG     = PAR(130)
                IF (IPR(162) .EQ. 8 .OR. IPR(162) .EQ. 9) THEN
                  ANG = ANG + 90.0
                END IF
                CALL GEN043 (1, A, ANG / RGBL(6))
                CALL GEN002 (1, A, ZU(10), ZU(4), XLNG)
                CALL GEN002 (1, A, ZU(13), ZU(7), XLNG)
                ZU(13) = 0.0
                ZU(14) = 0.0
                ZU(15) = XYZK(4) * SIN(NTRCE * CDTH)
                CALL GEN002 (1, A, ZU(13), ZU(10), XLNG)
                CALL GEN043 (2, A, PAR(131) / RGBL(6))
                CALL GEN002 (1, A, ZU(4), ZU(1), XLNG)
                CALL GEN002 (1, A, ZU(7), ZU(4), XLNG)
                CALL GEN002 (1, A, ZU(10), ZU(7), XLNG)
                DO I = 1, 3
                  PAR(70 + I) = XYZK(I) + ZU(6 + I)
                END DO
                CALL PLUT19 (0, 0)
              END DO
              IPR(114) = 0
              DO I = 1, 4
                PAR(70 + I)  = XYZK(I)
              END DO
              IPR(87) = 1
              DO WHILE (NPRV .GT. NPRVM)
                NPRV = NPRV - 1
                IF (NPRV .EQ. 0) THEN
                  IF (ABS(PAR(130)) + ABS(PAR(131)) .LT. 0.001) EXIT
                END IF
                IF (IPR(346) .EQ. 1) THEN
                  CALL GGIP (0.0, FLOAT(ICOL0), 0.0, 0)
                END IF
                ANG    = NPRV * PDTHV - PAR(131) / RGBL(6)
                ZU(10) = COS (ANG)
                ZU(11) = 0.0
                ZU(12) = SIN (ANG)
                ZU(13) = 0.0
                ZU(14) = 1.0
                ZU(15) = 0.0
                CALL GEN043 (1, A, PAR(130) / RGBL(6))
                CALL GEN002 (1, A, ZU(10), ZU(4), XLNG)
                CALL GEN002 (1, A, ZU(13), ZU(7), XLNG)
                CALL GEN043 (2, A, PAR(131) / RGBL(6))
                CALL GEN002 (1, A, ZU(4), ZU(1), XLNG)
                CALL GEN002 (1, A, ZU(7), ZU(4), XLNG)
                CALL GEN008 (ZU(1), ZU(4), ZU(7), 1)
                ZU(10) = 0.0
                ZU(11) = 0.0
                ZU(12) = 1.0
                CALL GEN008 (ZU(7), ZU(10), ZU(13), 1)
                PAR(57) = ACOS(ZU(1) * ZU(13) + ZU(2) * ZU(14)
     1                  + ZU(3) * ZU(15)) - RGBL(5) / 2.0
                CALL PLUT19 (0, 0)
              END DO
              IPR(87) = 1
              DO WHILE (NPRH .GT. NPRHM)
                NPRH = NPRH - 1
                IF (NPRH .EQ. 0) THEN
                  IF (ABS(PAR(130)) + ABS(PAR(131)) .LT. 0.001) EXIT
                END IF
                IF (IPR(346) .EQ. 1) THEN
                  CALL GGIP (0.0, FLOAT(ICOL0), 0.0, 0)
                END IF
                ANG = NPRH * PDTHH + PAR(130) / RGBL(6)
                ZU(10) = 1.0
                ZU(11) = 0.0
                ZU(12) = 0.0
                ZU(13) = 0.0
                ZU(14) = COS (ANG)
                ZU(15) = SIN (ANG)
                CALL GEN043 (1, A, PAR(130) / RGBL(6))
                CALL GEN002 (1, A, ZU(10), ZU(4), XLNG)
                CALL GEN002 (1, A, ZU(13), ZU(7), XLNG)
                CALL GEN043 (2, A, PAR(131) / RGBL(6))
                CALL GEN002 (1, A, ZU(4), ZU(1), XLNG)
                CALL GEN002 (1, A, ZU(7), ZU(4), XLNG)
                CALL GEN008 (ZU(1), ZU(4), ZU(7), 1)
                ZU(10) = 0.0
                ZU(11) = 0.0
                ZU(12) = 1.0
                CALL GEN008 (ZU(7), ZU(10), ZU(13), 1)
                PAR(57) = ACOS(ZU(1) * ZU(13) + ZU(2) * ZU(14)
     1                  + ZU(3) * ZU(15)) - RGBL(5) / 2.0
                CALL PLUT19 (0, 0)
              END DO
              IF (IPR(346) .GT. 0) THEN
                IF (IPR(139) .EQ. 1 .AND. ICOL0 .NE. 0) THEN
                  CALL GGIP (0.0, FLOAT(ICOL0), 0.0, 0)
                ELSE
                  CALL GGIP (0.0, FLOAT(IPR(19)), 0.0, 0)
                END IF
              END IF
              DO I = 1, 4
                PAR(70 + I) = XYZK(I)
              END DO
              IPR(87) = 2
              PAR(57) = 0.0
              CALL GEN074 (ZU, 1, 15, 0.0)
              ZU(1) = 1.0
              ZU(5) = 1.0
              IPR(129) = 0
              CALL PLUT19 (0, 0)
              IF (IPR(129) .EQ. 0) THEN
                IF (K .LE. IPR(37)) THEN
                  IVL = 0
                  CALL PLUT15 (1, K, 45, IVL)
                END IF
              END IF
              MODE = 0
   10         MODE = MODE - 1
              IF (MODE + IPR(78) .LT. 0) GO TO 30
              IPOP = IPR(66) + MODE * 13
              NJ = NINT(RA(IPOP + 1))
              IF (NJ .GT. 0) GO TO 10
              NL = NINT(RA(IPOP + 2))
              DO JJJ = 5, 8
                XYZK(JJJ) = RA(IPOP + JJJ - 2)
              END DO
              DMARG  = RA(IPOP + 13)
              DMG    = 0.0
   20         RJB    = XYZK(8) + DMG
              ZU(10) = 0.0
              ZU(11) = 0.0
              ZU(12) = 1.0
              DSQ    = 0
              DO M = 1, 3
                ZU(6 + M) = XYZK(M + 4) - XYZK(M)
                DSQ       = DSQ + ZU(6 + M)**2
              END DO
              IF (NL .EQ. 0) THEN
                IF (ZU(9) .GT. 0.0)  GO TO 10
              END IF
              DKJ = SQRT(DSQ)
              IF (DKJ .LT. 0.0001) GO TO 10
              RKK = XYZK(4)**2
              RJK = RJB**2
              DIN = (RKK + DSQ - RJK) / (2.0 * DKJ)
              RIN = RKK - DIN**2
              IF (RIN .LT. 0.0) GO TO 10
              PAR(74) = SQRT(RIN)
              DO KK = 7, 9
                ZU(KK)       = ZU(KK) / DKJ
                PAR(64 + KK) = XYZK(KK - 6) + ZU(KK) * DIN
              END DO
              IF (ZU(9) .LT. 0.9999) THEN
                CALL GEN008 (ZU(10), ZU(7), ZU(1), 1)
              ELSE
                ZU(1) = 1.0
                ZU(2) = 0.0
                ZU(3) = 0.0
              END IF
              CALL GEN008 (ZU(7), ZU(1), ZU(4), 1)
              CALL PLUT19 (IABS(NJ), 0)
              IF (IPR(346) .GT. 0 .AND. NL .NE. 0) THEN
                IF (DMARG .GT. 0.0 .AND. IPR(88) .GT. 0) THEN
                  DMG   = DMARG
                  DMARG = 0.0
                  GO TO 20
                END IF
              END IF
              GO TO 10
            END IF
          END IF
   30   CONTINUE
      END IF
   40 IF (IPR(346) .GT. 0 .OR. IPR(477) .LT. 0)
     1        CALL GGIP (0.0, FLOAT(IPR(19)), 0.0, 0)
      RETURN
      END SUBROUTINE PLUT11
      SUBROUTINE PLUT12
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,
     1 NP14=64,NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,
     2 NP37=191,NP38=150,NP39=30,NP43=12,NP52=200,NP56=30,
     3 NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, LFIX*1, JIN*1, J3*1, J5*1, J6*1, J7*1,
     1 COLR*10, BWCT*10, ATPR1*11, ATPR2*5, PARAM*6
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER ICH*1
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IPR(21) = IPR(90)
      NSPEC   = IPR(41)
      NC      = IPR(52)
      NSYM    = IPR(48)
      KL      = IPR(220)
      DO I = 1, 9
        K           = 2**(10 - I)
        IPR(31 - I) = IPR(21) / K
        IPR(21)     = IPR(21) - IPR(31 - I) * K
      END DO
      IF (IPR(22) .EQ. 1 .AND. IPR(50) .EQ. 0) CALL PLA274
      IPV1  = 0
      IPV2  = 0
      IPR90 = IPR(90)
      IF (IGBL(31) .EQ. 1) KL = 2
      IF (IPR(147) .GT. 0) KL = 2
      IF (IABS(IPR90 - 6) .EQ. 2 .AND. KL .GT. 2) THEN
        CALL PLUT13 (0, -3, IPV1, XDUM)
        IF (IPR90 .EQ. 8 .AND. KL .GT. 3) THEN
          CALL PLUT13 (0, -4, IPV2, XDUM)
        END IF
      END IF
      IF (IPR(23) .NE. 0) THEN
        WRITE (LINE, 99991, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          CALL GGIP (HORS, VERT, 0.0, 1)
          VRT = VERT - 0.4
          CALL GGIP09 (0.0, LINE, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
          VRT = VRT - 0.4
        ELSE
          WRITE (LU6, '(//, A, /)', IOSTAT = IOST) LINE
        END IF
        IF (IPV1 .GT. 0) THEN
          I1 = IPV1
          I2 = IPV1
        ELSE
          IF (IGBL(31) .EQ. 0) THEN
            IF (IPR(46) .EQ. 0) THEN
              I1 = IPR(69) + 1
            ELSE
              I1 = 1
            END IF
          ELSE
            I1 = IPR(38) + 1
          END IF
          I2 = IPR(37)
        END IF
        DO 10 I = I1, I2
          CALL PLUT15 (-5, I, 48, IYUNK)
          CALL PLUT15 (-6, I, 5, NRES)
          IF (IPR(147) .GT. 0) THEN
            IF (IPR(147) .NE. NRES) GO TO 10
          END IF
          CALL PLUT25 (1, I, J4)
          IAIO = - J4
          IF (IPV1 .GE. 0 .OR. IAIO .EQ. IPV1) THEN
            CALL PLUT15 (-1, I, 46, JDOAC)
            CALL PLUT15 (-1, I, 32, IDH)
            IF (JDOAC .EQ. 0 .AND. IDH .EQ. 0) THEN
              J6 = ' '
              J7 = ' '
            ELSE
              J6 = 'D'
              IF (IDH .EQ. 1) THEN
                J7 = 'H'
              ELSE
                J7 = 'A'
              END IF
            END IF
            NEL = INT(RA(I * NP43 + 7) / 64000) + 1
            CALL PLUT15 (-6, I, 18, JINC)
            CALL PLUT15 (-1, I, 27, J1)
            IF (J1 .GT. 0) THEN
              JIN = '*'
            ELSE
              JIN  = ' '
            END IF
            IF (JINC .GE.  2) THEN
              J3 = 'S'
            ELSE
              J3 = ' '
            END IF
            CALL PLUT15 (-4, I, 37, ILB)
            J2   = ILB + 1
            CALL PLUT15 (-1, I, 42, JF)
            IF (JF .EQ. 1) THEN
              LFIX = '*'
            ELSE
              LFIX = '-'
            END IF
            CALL PLUT15 (-1, I, 43, IMV)
            IF (IMV .GT. 0) THEN
              J5 = 'M'
            ELSE
              J5 = ' '
            END IF
            XTRF = RA(I * NP43 + 12)
            IF (I .LE. IPR(69)) THEN
              NQ1(1:1) = 'O'
              IF (I .EQ. 1) THEN
                NQ1(2:2) = 'R'
              ELSE IF (I .EQ. 2) THEN
                NQ1(2:2) = 'C'
              ELSE IF (I .EQ. 3) THEN
                NQ1(2:2) = 'B'
              ELSE IF (I .EQ. 5) THEN
                NQ1(2:2) = 'A'
              ELSE
                NQ1(1:2) = '  '
              END IF
              WRITE (LINE, 99981, IOSTAT = IOST) NQ1(1:2),
     1        (RA(I * NP43 + K), K = 1, 3), JIN, LABP(J2), LFIX
            ELSE
              IF (JINC .NE. 0) THEN
                MULT = NSYM / JINC
              ELSE
                MULT = NSYM
              END IF
              WRITE (LINE, 99990, IOSTAT = IOST)
     1          NQ1, (RA(I * NP43 + K), K = 1, 3),
     2          (RADR(J4, 5 - K), K = 1, 4), MULT, J3, JIN, XTRF,
     3          J5, LABP(J2), LFIX, NRES, NEL, J6, J7
            END IF
            IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
              IF (VRT - 0.4 .LT. 0) THEN
                CALL PLA013 (1, 1)
                ICH = IGGT(1:1)
                CALL GGIP (HORS, VERT, 0.0, 1)
                IF (ICH .NE. 'Y' .AND. ICH .NE. '!') GO TO 20
                  VRT = VERT
              END IF
              VRT = VRT - 0.4
              CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
            ELSE
              WRITE (LU6, 99993, IOSTAT = IOST) LINE
            END IF
          END IF
   10   CONTINUE
        GO TO 80
      END IF
   20 IF (IPR(24) .NE. 0) THEN
        IF (NC .GT. IPR(68)) THEN
          WRITE (LINE, 99989, IOSTAT = IOST)
          IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
            CALL GGIP (HORS, VERT, 0.0, 1)
            VRT = VERT - 0.4
            CALL GGIP09 (0.0, LINE, 80, 0.35, 5 + IGBL(68), 2,
     1                   1.0, VRT)
            VRT = VRT - 0.4
          ELSE
            WRITE (LU6, '(//, A, /)', IOSTAT = IOST) LINE
          END IF
          NRBO = 0
          IF (IPV1 .GT. 0) THEN
            I1 = IPV1
            I2 = IPV1
          ELSE
            IF (IPR(46) .EQ. 0) THEN
              I1 = IPR(69) + 1
            ELSE
              I1 = 1
            END IF
            I2 = IPR(39)
          END IF
          DO 40 I0 = I1, I2
            IF (IPV1 .LT. 0) THEN
              I4 = INT(RA(I0 * NP43 + 7) / 64000)
              IF (IPV1 + I4 + 1 .NE. 0)  GO TO 40
            END IF
            IF (IPR(147) .GT. 0) THEN
              CALL PLUT15 (-6, I0, 5, NRES)
              IF (IPR(147) .NE. NRES) GO TO 40
            END IF
            IF (IPV2 .GT. 0) THEN
              J1 = IPV2
              J2 = IPV2
            ELSE
              IF (IGBL(31) .EQ. 0) THEN
                IF (IPV2 .EQ. 0) THEN
                  J1 = I0 + 1
                ELSE
                  J1 = 1
                END IF
              ELSE
                J1 = IPR(38) + 1
              END IF
              J2 = IPR(37)
            END IF
            DO 30 J0 = J1, J2
              IF (IPV2 .LT. 0) THEN
                J4 = INT(RA(J0 * NP43 + 7) / 64000)
                IF (IPV2 + J4 + 1 .NE. 0)  GO TO 30
              END IF
              CALL PLUT16 (-4, K, I0, J0, DUM1, IDUM2)
              IF (K .GT. IPR(68)) THEN
                CALL PLUT16 (0, K, I, J, RBO, NLI)
                IF (NLI .LT. 0) THEN
                  NLI   = IABS(NLI)
                  IDASH = 1
                ELSE
                  IDASH = 0
                END IF
                IF (I .NE. 0) THEN
                  CALL PLUT25 (1, I, IDUM)
                  CALL PLUT25 (2, J, IDUM)
                  CALL PLUT15 (-6, I, 5, NRI)
                  CALL PLUT15 (-6, J, 11, NS2)
                  ARU = MOL(1, NS2 + 1) / PAR(42)
                  CALL PLUT22 (I, J, D)
                  NRBO = NRBO + 1
                  WRITE (LINE, 99988, IOSTAT = IOST)
     1              NRBO, NRI, NQ1, NQ2, ARU, D, RBO, NLI, IDASH
                  IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
                    IF (VRT - 0.4 .LT. 0) THEN
                      CALL PLA013 (1, 1)
                      ICH = IGGT(1:1)
                      CALL GGIP (HORS, VERT, 0.0, 1)
                      IF (ICH .NE. 'Y' .AND. ICH .NE. '!') GO TO 50
                      VRT = VERT
                    END IF
                    VRT = VRT - 0.4
                    CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
                  ELSE
                    WRITE (LU6, 99993, IOSTAT = IOST) LINE
                  END IF
                END IF
              END IF
   30       CONTINUE
   40     CONTINUE
        END IF
        GO TO 80
      END IF
   50 IF (IPR(25) .NE. 0) THEN
        IF (IPR(12) .LT. 0) THEN
          IDASH = 1
        ELSE
          IDASH = 0
        END IF
        WRITE (LINE, 99987, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          CALL GGIP (HORS, VERT, 0.0, 1)
          VRT = VERT - 1.5
          CALL GGIP09 (0.0, LINE, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
          VRT = VRT - 0.8
        ELSE
          WRITE (LU6, 99992, IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99986, IOSTAT = IOST)
     1    PAR(38), IABS(IPR(12)), IDASH
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 0.6
          CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, 99993, IOSTAT = IOST) LINE
        END IF
        DO K = 1, NSPEC
          NRF = IPR(80) - (K - 1) * 3
          L   = NINT(RA(NRF - 2))
          I   = IABS(L) / 1000
          RB  = 0.001 * FLOAT(MOD(IABS(L), 1000))
          N1  = NINT(RA(NRF))
          N2  = NINT(RA(NRF - 1))
          IF (L .LT. 0) THEN
            IDASH = 1
          ELSE
            IDASH = 0
          END IF
          IF (N1 .LT. 0) THEN
            WRITE (LINE, 99985, IOSTAT = IOST) RB, I, IDASH
            IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
              VRT = VRT - 0.6
              CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
            ELSE
              WRITE (LU6, 99993, IOSTAT = IOST) LINE
            END IF
          ELSE IF (N1 .EQ. 0) THEN
            N2 = NINT(RA(NRF - 1))
            IF (N2 .LE. 0) THEN
              N2 = IEL(IEN( - N2))
              N1 = N2 / 100 + ICHAR('A') - 1
              N2 = MOD(N2, 100)
              IF (N2 .EQ. 0) THEN
                N2 = ICHAR(' ')
              ELSE
                N2 = N2 + ICHAR('a') - 1
              END IF
              NQ1 = CHAR(N1)//CHAR(N2)//'     '
            ELSE
              CALL PLUT25 (1, N2, IATK)
            END IF
            WRITE (LINE, 99983, IOSTAT = IOST) NQ1, RB, I, IDASH
            IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
              VRT = VRT - 0.6
              CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
            ELSE
              WRITE (LU6, 99993, IOSTAT = IOST) LINE
            END IF
          ELSE
            CALL PLUT25 (1, N1, IATK)
            CALL PLUT25 (2, N2, IATK)
            WRITE (LINE, 99982, IOSTAT = IOST) NQ1, NQ2, RB, I, IDASH
            IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
              VRT = VRT - 0.6
              CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
            ELSE
              WRITE (LU6, 99993, IOSTAT = IOST) LINE
            END IF
          END IF
        END DO
        WRITE (LINE, 99980, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 1.0
          CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, '(/, A)', IOSTAT = IOST) LINE
        END IF
        GO TO 80
      END IF
      IF (IPR(26) .NE. 0) THEN
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VERT - 0.2
          CALL GGIP (HORS, VERT, 0.0, 1)
          OPEN (LU61, FILE = 'srcsrc', STATUS = 'UNKNOWN')
          CALL PLUT17 (0.0, 1004, MADDR, LU61)
          CALL GEN108 (LU61, 0)
          DO
            READ (LU61, '(A)', IOSTAT = IOST) LINE
            IF (IOST .NE. 0) EXIT
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
          END DO
          CLOSE (UNIT = LU61, STATUS = 'DELETE')
          GO TO 80
        ELSE
          CALL PLUT17 (0.0, 1004, MADDR, LU6)
        END IF
      END IF
      IF (IPR(27) .NE. 0) THEN
        CALL GEN096 (R, IROTX, IROTY, IROTZ, IDET, XYZOR, PHI, ROM)
        WRITE (LU6, 99997, IOSTAT = IOST) IROTX, IROTY, IROTZ, IDET,
     1    ((R(I, J), J = 1, 3), I = 1, 3)
      END IF
      IF (IPR(28) .NE. 0) THEN
        WRITE (LU6, 99996, IOSTAT = IOST)
     1    IPR(39), IPR(38), IPR(37), IPR(53), IPR(52), IPR(75),
     2    IPR(42), IPR(43)
        WRITE (LU6, 99995, IOSTAT = IOST)
     1    IPR(46), IPR(116), NINT(PAR(48)), IPR(4), IPR(9), IGBL(67),
     2    IGBL(75), IPR(77), IPR(346), IPR(19), IPR(63)
        WRITE (LU6, 99994, IOSTAT = IOST)
     1    PAR(24), PAR(15), VERT, PAR(48), PAR(13), PAR(36), PAR(39),
     2    PAR(5), PAR(3), PAR(44)
      END IF
      IF (IPR(29) .NE. 0) THEN
        WRITE (LINE, 99999, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          CALL GGIP (HORS, VERT, 1.0, 1)
          VRT = VERT - 0.8
          CALL GGIP09 (0.0, LINE, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
          VRT = VRT - 0.3
        ELSE
          WRITE (LU6, 99992, IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99977, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 0.4
          CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, 99993, IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99976, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 0.8
          CALL GGIP09 (0.0, LINE, 80, 0.35, 6, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, '(/, A)', IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99975, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 0.8
          CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, '(/, A)', IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99974, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 0.8
          CALL GGIP09 (0.0, LINE, 80, 0.35, 6, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, '(/, A)', IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99973, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 0.8
          CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, 99992, IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99972, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 0.6
          CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
        ELSE
          WRITE (LU6, 99993, IOSTAT = IOST) LINE
        END IF
        WRITE (LINE, 99971, IOSTAT = IOST) PAR(1)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          VRT = VRT - 1.0
          CALL GGIP09 (0.0, LINE, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
          VRT = VRT - 0.2
        ELSE
          WRITE (LU6, 99992, IOSTAT = IOST) LINE
        END IF
        DO I = 1, IAN
          N2 = IEL(IEN(I))
          N1 = N2 / 100 + ICHAR('A') - 1
          N2 = MOD(N2, 100)
          IF (N2 .EQ. 0) THEN
            N2 = ICHAR(' ')
          ELSE
            N2 = N2 + ICHAR('a') - 1
          END IF
          N3 = IATPR(IEN(I))
          ATPR1 = '           '
          IF (N3 .LE. 0) THEN
            N3 = - N3
            ATPR2 = '     '
          ELSE
            ATPR2 = 'Metal'
          END IF
          IF (N3 .EQ. 2) THEN
            ATPR1 = 'Lanthanide '
          ELSE IF (N3 .EQ. 3) THEN
            ATPR1 = 'Actinide   '
          ELSE IF (N3 .EQ. 4) THEN
            ATPR1 = 'Transition '
          ELSE IF (N3 .EQ. 5) THEN
            ATPR1 = 'Alkali     '
          ELSE IF (N3 .EQ. 6) THEN
            ATPR1 = 'AlkaliEarth'
          ELSE IF (N3 .EQ. 7) THEN
            ATPR1 = 'Halogen    '
          END IF
          PARAM = '      '
          IF (BWCT(IBCL(I))(1:3)  .EQ. 'NET') THEN
            WRITE (PARAM, 99984, IOSTAT = IOST) IPR(85), IPR(86)
          ELSE IF (BWCT(IBCL(I))(1:3) .EQ. 'GLO') THEN
            WRITE (PARAM, 99984, IOSTAT = IOST) IPR(112), IPR(132)
          END IF
          WRITE (LINE, 99998, IOSTAT = IOST)
     1      CHAR(N1), CHAR(N2), COLR(IACL(I)), BWCT(IBCL(I)), PARAM,
     2      (RADR(I, 5 - J), J = 1, 4), ATPR1, ATPR2
          IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
            VRT = VRT - 0.6
            CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
          ELSE
            WRITE (LU6, 99993, IOSTAT = IOST) LINE
          END IF
        END DO
        GO TO 80
      END IF
      IF (IPR(30) .EQ. 1) THEN
        WRITE (LINE, 99978, IOSTAT = IOST)
        IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
          CALL GGIP (HORS, VERT, 0.0, 1)
          VRT = VERT - 0.8
          CALL GGIP09 (0.0, LINE, 80, 0.35, 5 + IGBL(68), 2, 1.0, VRT)
          VRT = VRT - 0.3
        ELSE
          WRITE (LU6, 99992, IOSTAT = IOST) LINE
        END IF
        DO I = IPR(69) + 1, IPR(37)
          CALL PLUT25 (1, I, IDUM)
          CALL PLUT15 (-4, I,  1, N1)
          CALL PLUT15 (-6, I,  5, N2)
          CALL PLUT15 (-6, I, 11, N3)
          CALL PLUT15 (-1, I, 17, N6)
          CALL PLUT15 (-6, I, 18, N10)
          CALL PLUT15 (-3, I, 24, N16)
          CALL PLUT15 (-1, I, 27, N11)
          CALL PLUT15 (-4, I, 28, N12)
          CALL PLUT15 (-1, I, 32, N13)
          CALL PLUT15 (-4, I, 33, N14)
          CALL PLUT15 (-4, I, 37, N15)
          CALL PLUT15 (-1, I, 42, N5)
          CALL PLUT15 (-1, I, 43, N4)
          CALL PLUT15 (-1, I, 44, N7)
          CALL PLUT15 (-1, I, 45, N8)
          CALL PLUT15 (-1, I, 46, N9)
          WRITE (LINE, 99979, IOSTAT = IOST)
     1      NQ1, N1, N2, N3, N6, N16, N10, N11, N12, N13, N14, N15, N5,
     2      N4, N7, N8, N9
          IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
            IF (VRT - 0.4 .LT. 0) THEN
              CALL PLA013 (1, 1)
              ICH = IGGT(1:1)
              CALL GGIP (HORS, VERT, 0.0, 1)
              IF (ICH .NE. 'Y' .AND. ICH .NE. '!') GO TO 50
              VRT = VERT
            END IF
            VRT = VRT - 0.4
            CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 1.0, VRT)
          ELSE
            WRITE (LU6, 99993, IOSTAT = IOST) LINE
          END IF
        END DO
        GO TO 80
      END IF
      RETURN
   80 IF (IGBL(25) * IGBL(32) .EQ. 1) CALL PLA297 (1)
      RETURN
99999 FORMAT (20X, ' ATOM TYPES AND PARAMETERS')
99998 FORMAT (2X, 2A, 1X, A, 1X, A, A, F5.2, 3F7.2, 2X, A, 1X, A)
99997 FORMAT (//, 'VIEW ROTATION MATRIX  XROT=', I5, 2X, 'YROT=', I5,
     1 2X, 'ZROT=', I5, 2X, 'IDET=', I5, /, 3(/, 9X, 3F10.5, /), /)
99996 FORMAT (/, 'STATUS REPORT - CONTENTS', // 'ATOMS-A :', I4,
     1 ' ATOMS-B:', I4, ' ATOMS-C  :', I4, /, 13X, ' BONDS-B:', I4,
     2 ' BONDS-C  :', I4, /, 'NR. RES.:', I4, ' MOL-A  :', I4,
     3 ' MOL-B    :', I4, /)
99995 FORMAT (/, 'STATUS REPORT - STYLE', //, 'UNITCELL:', I4,
     1 ' STEREO :', I4, ' PERSPECT :', I4, ' SOLID    :', I4, /,
     2 'SHADE   :', I4, ' V.D.W.R:', I4, ' LABELS   :', I4,
     3 ' OVERL.OP.:', I4, /, 'AT.COLOR:', I4, ' DEF.COL:', I4,
     4 ' MOL LAB  :', I4, /)
99994 FORMAT (/, 'STATUS REPORT - PLOT', //
     1 'SCALE CM/A ', F8.3/'SIZE-X/CM  ', F8.2,
     2 ' SIZE-Y/CM  ', F8.2, ' PERS.D. CM ', F8.1/'SHRINK PERC', F8.2,
     3 ' OVL. MARGIN', F8.2, ' LAB. SHIFT ', F8.2/'PLOT STEP  ', F8.2,
     4 ' TRACE DEF  ', F8.2, ' TAPER', 6X, F8.2,/)
99993 FORMAT (A)
99992 FORMAT (/, A, /)
99991 FORMAT ('Atom', 7X, 'X', 7X, 'Y', 7X, 'Z  VDW',
     1 '  Cov Join Plot', 1X, 'Mul Incl   Move  Lab Res Nel HB')
99990 FORMAT (A, 3F7.3, 4F5.2, I4, A1, 2X, A, F8.3, A, 1X,
     1 A, A1, I4, I4, 1X, 2A)
99989 FORMAT (3X, 'Nr NRES(I)',1X, 'Bonds(I-J)', 7X, '[  ARU(J) ]',
     1          4X, 'Dist (A) Radius  Lines Dash')
99988 FORMAT (2I5, 4X, A, '--', A, ' [',F9.2,'] ', 2F9.3, I7, I5)
99987 FORMAT ('Bond(s)', 12X, 'Radius(Ang) Lines Dash')
99986 FORMAT ('Normal', 17X, F6.3, I7, I5)
99985 FORMAT ('Intermolecular', 6X, F9.3, I7, I5)
99984 FORMAT (2I3)
99983 FORMAT ('To ',  A, 10X, F9.3, I7, I5)
99982 FORMAT (A, '-- ', A, 3X, F9.3, I7, I5)
99981 FORMAT (A, 5X, 3F7.3, 27X, A, 10X, 2A)
99980 FORMAT ('Note: Radii may be changed with RADII BONDS',
     1            ' instruction(s)')
99979 FORMAT (A, I3, 2I3, I2, 2I3, I2, I3, I2, I3, I3, 5I2)
99978 FORMAT ('Atom    MD  R  A M  O  M I  D D  B  P P M H N D')
99977 FORMAT ('( May be Changed with COLOR TYPE, BWC TYPE or ',
     1           'RADII ATOMS instructions)')
99976 FORMAT ('===== COLOR TYPE atom-type col (atom-type col ...)')
99975 FORMAT ('col = BLACK(WHITE), RED, GREEN, BLUE, YELLOW',
     1 ' ORANGE, VIOLET, BROWN, NONE')
99974 FORMAT ('===== BWC TYPE atom-type bwc (atom-type bwc ...)')
99973 FORMAT ('bwc = CONTOUR, NET, SHADE, SEGMENT, DOTS, BLACK,',
     1 ' CROSS, PARALLEL, GLOBE,')
99972 FORMAT ('      MERIDIAN, HORIZONTAL, VERTICAL, MESH, DIAGONAL,',
     1        ' SLANT, TEXTILE, VOID')
99971 FORMAT ('Type Color      BWC', 8X, 'Param  vdW-   COV-  ',
     1 'JOIN- PLOT-RAD (TOL =', F4.1, ' A/at)')
      END SUBROUTINE PLUT12
      SUBROUTINE PLUT13 (MODE, KK, IAT, XMOL)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP49=2000000,NP22=287,NP38=150,NP39=30,NP45=2048,
     2 NP48=1000,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      CHARACTER ICH*1
      NQ1    = IFL(IABS(KK))
      MSUBST = 0
      CALL PLA281 (1, NQ1, MSUBST)
      XMOL = 0.0
      IF (NQ1(1:3) .EQ. 'REN') THEN
        IAT  = 0
        WRITE (LU6, 99999, IOSTAT = IOST) NQ1
        RETURN
      END IF
      N = INDEX(NQ1, '_')
      IF (N .NE. 0) THEN
        ICH = NQ1(N+1:N+1)
        DO I = 1, 10
          IF (ICH .EQ. CHAR(ICHAR('0') + I - 1)) THEN
            N = 0
            GO TO 10
          END IF
        END DO
      END IF
   10 CALL PLA046 (8, NQ1, NE1, NA1, NAX1, NS1, IXPK1, IXPK2, NIEN)
      IF (NE1 .EQ. 0) THEN
        IAT = 0
      ELSE IF (NE1 .LT. NP9 - 3) THEN
        IF (KK .LT. 0) THEN
          IF (NA1 .LT. 0) THEN
            IAT = - NE1
            GO TO 20
          END IF
        END IF
        DO IAT = IPR(69) + 1, IPR(37)
           CALL PLUT25 (2, IAT, IATK)
           CALL PLA046 (8, NQ2, NE2, NA2, NAX2, NS2, IXPK1, IXPK2,
     1       NIEN)
           IF (NE1 .EQ. NE2) THEN
             IF (NA1 .EQ. NA2 .OR. (NA1 .EQ. 0 .AND. NA2 .EQ. -1)) THEN
               IF (NAX1 .EQ. NAX2) THEN
                 IF (MODE .LT. 0) THEN
                   IF (NS1 .GT. 0) XMOL =
     1               MOL(1, NS1 + IPR(75)) / PAR(42)
                   GO TO 20
                 ELSE
                   IF (NS1 .EQ. NS2) GO TO 20
                 END IF
               END IF
             END IF
           END IF
        END DO
        IF (NA1 .GT. 0) THEN
          IAT = 0
          GO TO 20
        END IF
        IAT = - NE1
      ELSE IF (NE1 .EQ. NP9 - 3) THEN
        IAT = 1
      ELSE IF (NE1 .EQ. NP9 - 2) THEN
        IAT = 5
      ELSE IF (NE1 .EQ. NP9 - 1) THEN
        IAT = 3
      ELSE IF (NE1 .EQ. NP9) THEN
        IAT = 2
      ELSE
        IAT = 0
      END IF
   20 IF (MODE .LE. 0 .AND. IAT .EQ. 0 .AND. KK .GT. 0) THEN
        WRITE (LU6, 99999, IOSTAT = IOST) NQ1
      END IF
      RETURN
99999 FORMAT (':: ATOM Name/Type ERROR for: ', A)
      END SUBROUTINE PLUT13
      SUBROUTINE PLUT14 (MODE, J, IASU, NPROP, X, Y, Z, S)
      PARAMETER (NP0=6,NP12=700,NP13=550,NP17=99,NP49=2000000,
     1 NP48=1000,NP38=150,NP39=30)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      I = J * NP0 + IPR(158)
      IF (MODE .LT. 0) THEN
        IASU  = NINT(RA(I - 5))
        NPROP = NINT(RA(I - 4))
        X     = RA(I - 3)
        Y     = RA(I - 2)
        Z     = RA(I - 1)
        S     = RA(I)
      ELSE
        IF (MODE .EQ. 0) THEN
          IPR(67) = IPR(67) + 1
          J       = IPR(40) + IPR(67)
          I       = J * NP0 + IPR(158)
          IF (I .GE. IPR(66) - IPR(78) * 13) THEN
            IPR(101) = IPR(101) + 1
            J        = 0
            IPR(67)  = IPR(67) - 1
            RETURN
          END IF
        END IF
        RA(I - 5) = IASU
        RA(I - 4) = NPROP
        RA(I - 3) = X
        RA(I - 2) = Y
        RA(I - 1) = Z
        RA(I)     = S
      END IF
      RETURN
      END SUBROUTINE PLUT14
      SUBROUTINE PLUT15 (IKEY, IAT, IBITN, IVL)
      PARAMETER (NP14=64,NP49=2000000,NP48=1000,NP32=63,NP43=12)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      IBTN = IBITN
      IX   = IAT * NP43 + 8 + (IBTN - 1) / 23
      IBTN = 1 + MOD(IBTN - 1, 23)
      IFLI = NINT(RA(IX))
      IBIT = IBT(IBTN)
      INH  = MOD(IFLI / IBIT, IBT(IABS(IKEY) + 1))
      IF (IKEY .LT. 0) THEN
        IVL = INH
      ELSE
        RA(IX) = IFLI + (IVL - INH) * IBIT
      END IF
      RETURN
      END SUBROUTINE PLUT15
      SUBROUTINE PLUT16 (MODE, IAJAT, IAT, JAT, RBO, NLI)
      PARAMETER (NP0=6,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP48=1000,NP32=63,NP33=15,NP38=150,
     2 NP39=30,NP43=12)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      RA12   = 0.0
      MD     = MODE
      ILPB   = IPR(69) + 1
      NAB    = IPR(37) - IPR(69)
      IPR158 = IPR(158)
      NSK    = 0
      IF (MD .GT. 0) THEN
        IADR     = IPR(79) - MD * 4
        IAT      = NINT(RA(IADR + 1))
        JAT      = NINT(RA(IADR + 2))
        RBO      = RA(IADR + 3)
        NLN      = NINT(RA(IADR + 4))
        IPR(120) = MOD(IABS(NLN), 1024)
        NLI      = IABS(NLN) / 1024
        I        = IAT * NP0 + IPR158
        J        = JAT * NP0 + IPR158
        IF (IPR(477) .GT. 0) THEN
          NPROP  = MAX (NINT(RA(I - 4)), NINT(RA(J - 4)))
          CALL GEN048 (-5, NPROP, 1, IPR(120))
        ELSE IF (IPR(477) .LT. 0) THEN
          IAT0 = MOD(IAT - ILPB, NAB) + ILPB
          CALL PLUT15 (-6, IAT0, 5, NRS)
          IF (NRS .GT. 0 .AND. NRS .LE. 16) IPR(120) = NRS
        END IF
        ISTK     = IPR158 + (IPR(40) + IPR(67)) * NP0
        IPR(67)  = IPR(67) + 2
        IF (NLN .LT. 0) NLI = - NLI
        IF (RBO .LT. 0.0) RBO = ABS(RBO)
        IF (ISTK + 2 * NP0 .GE. IPR(66) - IPR(78) * 13)
     1    CALL PLUT38 (3, 1, LU6)
        DK = 0
        DO K = 1, 3
          ZU(K + 6) = RA(J + K - 4) - RA(I + K - 4)
          DK        = DK + ZU(K + 6)**2
        END DO
        IF (DK .NE. 0.0) THEN
          DXYZ = SQRT(DK)
        ELSE
          DXYZ = 1.0
        END IF
        RI   = AMOD(ABS(RA(I)), 1000.0)
        RJ   = AMOD(ABS(RA(J)), 1000.0)
        RB   = RBO * PAR(24)
        RA4  = RB
        RA8  = RB
        IF (PAR(48) .EQ. 0.0) THEN
          IF (PAR(44) .NE. 0.0 .AND. IPR(4) .NE. 4) THEN
            RB9 = RB * ABS(PAR(44) * ZU(9) / DXYZ)
            RA4 = RB + RB9
            RA8 = RB - RB9
          END IF
        ELSE
          RA4 = RB * PAR(48) / (PAR(48) - RA(I - 1))
          RA8 = RB * PAR(48) / (PAR(48) - RA(J - 1))
        END IF
        RA4 = MAX (MIN (RA4, RI - 0.001), 0.0)
        RA8 = MAX (MIN (RA8, RJ - 0.001), 0.0)
        IF (IPR(4) .GT. 0) THEN
          RA12   = RA8 - RA4
          QMPK   = RA12**2
          RIK    = RI**2
          RJK    = RJ**2
          RPKPK  = DK * (RIK - RA4**2) + RIK * QMPK
          RQKQK  = DK * (RJK - RA8**2) + RJK * QMPK
          DKQMPK = DK + QMPK
          AL     = (SQRT(RPKPK) - RA4 * RA12) / DKQMPK
          BE     = (SQRT(RQKQK) + RA8 * RA12) / DKQMPK
        ELSE
          AL     = 0.0
          BE     = 0.0
        END IF
        DO K = 1, 3
          RA(ISTK + K +     NP0 - 4) = RA(I + K - 4) + AL * ZU(K + 6)
          RA(ISTK + K + 2 * NP0 - 4) = RA(J + K - 4) - BE * ZU(K + 6)
        END DO
        RA(ISTK + NP0)     = RA4 + AL * RA12
        RA(ISTK + 2 * NP0) = RA8 - BE * RA12
        DO K = 7, 9
          ZU(K) = ZU(K) / DXYZ
        END DO
      ELSE IF (MD .LT. 0) THEN
        IF (MD .EQ. -6) THEN
          IADR    = IPR(79)
          IPR(97) = 0
          NML     = IPR(142)
          NC      = IPR(52)
          NCU     = IPR(53)
          IF (IPR(46) .GT. 0) THEN
            IBNB = 1
          ELSE
            IBNB = IPR(68) + 1
          END IF
          IF (NC .GE. IBNB) THEN
            DO IBN = IBNB, NC
              ICMD = NINT(RA(IPR(64) + 1 - IBN * 2))
              IF (ICMD .GT. 0) THEN
                IAT    = ICMD
                JAT    = NINT(RA(IPR(64) + 2 - IBN * 2))
                NRINCL = 2
                IF (IAT .GE. ILPB) THEN
                  ITYPE = INT(RA(IAT * NP43 + 7) / 64000) + 1
                  IF (IAT .LE. IPR(39)) THEN
                    CALL PLUT15 (-1, IAT, 27, NINCL)
                    NRINCL = NRINCL - 1 + NINCL
                  END IF
                  IENITP = IEN(ITYPE)
                ELSE
                  ITYPE  = 0
                  IENITP = 0
                END IF
                IF (JAT .GE. ILPB) THEN
                  JTYPE = INT(RA(JAT * NP43 + 7) / 64000) + 1
                  IF (JAT .LE. IPR(39)) THEN
                    CALL PLUT15 (-1, JAT, 27, NINCL)
                    NRINCL = NRINCL - 1 + NINCL
                  END IF
                  IENJTP = IEN(JTYPE)
                ELSE
                  JTYPE  = 0
                  IENJTP = 0
                END IF
                IF (NRINCL .GE. IPR(165)) THEN
                  CALL PLUT15 (-6, IAT, 11, IARU)
                  CALL PLUT15 (-6, JAT, 11, JARU)
                  CALL PLUT27 (IBN, IAT, JAT, RBO, NLI)
                  IF (IBN .GT. IPR(68)) THEN
                    MNML = NML
                  ELSE
                    MNML = 1
                  END IF
                  IAT0 = IAT - NAB
                  JAT0 = JAT - NAB
                  DO ML = 1, MNML
                    IAT0 = IAT0 + NAB
                    JAT0 = JAT0 + NAB
                    IF (IBN .GT. NCU) THEN
                      NRJT = 2
                    ELSE
                      NRJT = 3 - IPR(165)
                    END IF
                    I   = IAT0 * NP0 + IPR(158)
                    J   = JAT0 * NP0 + IPR(158)
                    NSK = 2
                    RAI = ABS(RA(I))
                    IF (RAI .GT. 999.9) THEN
                      NSK = NSK - 1
                      RAI = RAI - 1000.0
                    END IF
                    RAJ = ABS(RA(J))
                    IF (RAJ .GT. 999.9) THEN
                      NSK = NSK - 1
                      RAJ = RAJ - 1000.0
                    END IF
                    IF (NSK .LT. 2) THEN
                      IF (IPR(15) .LT. 0) THEN
                        NSK = 0
                      ELSE
                        NSK = 2
                      END IF
                    END IF
                    IF (NSK .GT. 0) THEN
                      IF (ITYPE .NE. 0 .AND. JTYPE .NE. 0) THEN
                        IF (IENITP .NE. 106 .AND.
     1                      IENJTP .NE. 106) THEN
                          IF (IARU .NE. JARU) NRJT = 1
                        ELSE
                          NRJT = 2
                        END IF
                      END IF
                      IF (ITYPE .NE. 0 .AND. JTYPE .NE. 0)THEN
                        IF (RA(I) .LT. 0.0) NRJT = NRJT - 1
                        IF (RA(J) .LT. 0.0) NRJT = NRJT - 1
                      END IF
                      IF (NRJT .GT. 0) THEN
                        IF (NLI .NE. 0) THEN
                          DX = RA(I - 3) - RA(J - 3)
                          DY = RA(I - 2) - RA(J - 2)
                          DZ = RA(I - 1) - RA(J - 1)
                          DK = DX**2 + DY**2 + DZ**2
                          IF (DZ .LT. 0.0) THEN
                            CALL GEN014 (IAT0, JAT0)
                            CALL GEN014 (ITYPE, JTYPE)
                          END IF
                          IF (IPR(4) .GT. 0) DK = DK - RAI**2 - RAJ**2
                          IF (DK .GT. 0.0) THEN
                            RA(IADR - 3) = IAT0
                            RA(IADR - 2) = JAT0
                            RA(IADR - 1) = RBO
                            RA(IADR    ) = ISIGN (IABS(NLI) * 1024
     1                                   + ITYPE * 32 + JTYPE, NLI)
                            IPR(97)      = IPR(97) + 1
                            IADR         = IADR - 4
                          END IF
                        END IF
                      END IF
                    END IF
                  END DO
                END IF
              END IF
            END DO
          END IF
        ELSE IF (MD .EQ. -2) THEN
          DO K = 1, 4
            KK = 2 * ((K - 1) / 2) + K
            RA(IPR(64) - (K - 1) * 2 - 1) = 2 * K - 1
            RA(IPR(64) - (K - 1) * 2)     = 2 * K
            RA(IPR(64) - (K + 3) * 2 - 1) = K
            RA(IPR(64) - (K + 3) * 2)     = K + 4
            RA(IPR(64) - (K + 7) * 2 - 1) = KK
            RA(IPR(64) - (K + 7) * 2)     = KK + 2
          END DO
          IPR(68) = 12
          IPR(52) = IPR(68)
          IPR(53) = IPR(68)
        ELSE
          IAT0 = IAT
          JAT0 = JAT
          IF (MD .EQ. -5) THEN
            JAT0 = MOD(JAT - ILPB, NAB) + ILPB
            IAT0 = MOD(IAT - ILPB, NAB) + ILPB
          END IF
          IF (JAT0 .NE. IAT0) THEN
            IF (JAT0 .LT. IAT0) CALL GEN014 (IAT0, JAT0)
            IF (MD .EQ. -3) THEN
              MDD = -1
            ELSE
              MDD = 1
            END IF
            IJAT = IAT0 * MDD
            NC   = IPR(52)
            NC0  = IPR(68) + 1
            IF (NC .GE. NC0) THEN
              DO I = NC0, NC
                ICI = NINT(ABS(RA(IPR(64) + 1 - I * 2)))
                JCI = NINT(RA(IPR(64) + 2 - I * 2))
                IF (ICI .EQ. IABS(IJAT) .AND. JCI .EQ. JAT0) GO TO 10
              END DO
            END IF
            I = -1
            IF (MD .EQ. -1) THEN
              IPR(52) = IPR(52) + 1
              IF (((IPR(37) + 1) * NP43) .GT. (IPR(64) - IPR(52) * 2))
     1          CALL PLUT38 (3, 1, LU6)
              I   = IPR(52)
              IM2 = I * 2
              IF (IPR(35) .GE. 0) THEN
                IF (JAT0 .LE. IPR(38)) THEN
                  IPR(53)               = IPR(53) + 1
                  RA(IPR(64) + 1 - IM2) = RA(IPR(64) + 1 - IPR(53) * 2)
                  RA(IPR(64) + 2 - IM2) = RA(IPR(64) + 2 - IPR(53) * 2)
                  I                     = IPR(53)
                END IF
                CALL PLUT15 (-4, IAT, 33, IVAL)
                IF (IVAL .LT. NP33) THEN
                  IVAL = IVAL + 1
                  CALL PLUT15 (4, IAT, 33, IVAL)
                END IF
                CALL PLUT15 (-4, JAT, 33, IVAL)
                IF (IVAL .LT. NP33) THEN
                  IVAL = IVAL + 1
                  CALL PLUT15 (4, JAT, 33, IVAL)
                END IF
              END IF
            ELSE
              GO TO 20
            END IF
   10       IF (IABS(MD + 2) .EQ. 1) THEN
              RA(IPR(64) + 1 - I * 2) = IAT0 * MDD
              RA(IPR(64) + 2 - I * 2) = JAT0
            END IF
   20       IAJAT = I
          ELSE
            IAJAT = -1
          END IF
        END IF
      ELSE IF (MD .EQ. 0) THEN
        ICMD = NINT(RA(IPR(64) + 1 - IAJAT * 2))
        IF (ICMD .LT. 0) THEN
          IAT = 0
          JAT = 0
        ELSE
          IAT = ICMD
          JAT = NINT(RA(IPR(64) + 2 - IAJAT * 2))
          CALL PLUT27 (IAJAT, IAT, JAT, RBO, NLI)
          IF (NLI .EQ. 0) THEN
            IAT = 0
            JAT = 0
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE PLUT16
      SUBROUTINE PLUT17 (XMOLE, MODE, MADDR, LUNIT)
      PARAMETER (NP10=16,NP12=700,NP13=550,NP14=64,NP17=99,
     1 NP49=2000000,NP48=1000,NP32=63,NP37=191,NP38=150,NP39=30,
     2 NP45=2048)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /CHDAT/ CRD(NP37), LABP(16), COLR(NP10 + 1), BWCT(NP10 + 1)
      CHARACTER CRD*4, LABP*2, BWCT*10,
     1          COLR*10
      CHARACTER N1*3, ARU1*10, ARU2*10, ARU3*10
      KL    = IPR(220)
      NSYM  = IPR(48)
      NRES  = IPR(75)
      NMOL  = IPR(42)
      MADDR = 0
      IF (IABS(MODE) .LE. 1000) THEN
        IPR(130) = 0
        IF (MODE .GT. 0) THEN
          NMA = MODE / 32
          NMA = NMA * 5 + 1
          NMB = MOD(MODE, 32)
        END IF
        XML = XMOLE
        IF (XML .EQ. 0.0) THEN
          IF (NMOL .GT. 0) THEN
            DO I = 1, NMOL
              IF (MOL(1, I) .GT. 0.0) THEN
                RETURN
              END IF
            END DO
          END IF
          XML = 1555.00
        END IF
        MXL = INT(ABS(XML))
        IF (MXL .LE. NRES) THEN
          IF (NMOL .GT. 0) THEN
            DO L = 1, NMOL
              XMOLL = ABS(MOL(1, L) / PAR(42))
              MPM = NINT (XMOLL * PAR(42))
              CALL GEN098 (MPM, PAR(42), NSL2, ITX, ITY, ITZ, NR2)
              IF (MXL .EQ. NR2) THEN
                MOL(1, L) = NINT(SIGN (XMOLL, XML) * PAR(42))
              END IF
            END DO
          END IF
          IF (MODE .GT. 0) THEN
            IF (NMA .EQ. 1) THEN
              NCRS(NINT(XML)) = NMB
            ELSE
              NPRS(NINT(XML)) = NMB
            END IF
          END IF
          RETURN
        ELSE IF (MXL .LT. 100) THEN
          WRITE (LUNIT, 99992, IOSTAT = IOST)
          RETURN
        END IF
        MPM = NINT (XML * PAR(42))
        CALL GEN098 (MPM, PAR(42), NSLM, ITX, ITY, ITZ, NR)
        IF (NSLM .GT. NSYM .OR. NSLM .EQ. 0) THEN
          WRITE (LUNIT, 99999, IOSTAT = IOST) XML, NSLM
          RETURN
        END IF
        XXX(4) = ITX
        XXX(5) = ITY
        XXX(6) = ITZ
        IF (NR .GT. 0) THEN
          IF (NR .GT. NRES) THEN
            WRITE (LUNIT, 99998, IOSTAT = IOST) XML, NR
            RETURN
          END IF
          NR1 = NR
          NR2 = NR
        ELSE
          NR1 = 1
          NR2 = NRES
        END IF
        DO NR = NR1, NR2
          IF (XML .GT. 0) THEN
            XML =   MXL + NR / PAR(42)
          ELSE
            XML = - MXL - NR / PAR(42)
          END IF
          IF (IPR(20) .GT. 0) THEN
            DO I = 1, 3
              XXX(I) = RCG(I, NR)
            END DO
            CALL SGSM (ICL, NSLM, XXX, LU6, 3, IERR)
            IF (IPR(36) .NE. 0) THEN
              DPLN = - RA(IPR(80) + 4)
              DO I = 1, 3
                DPLN = DPLN + XXX(I + 6) * RA(IPR(80) + I)
              END DO
              IF (DPLN .GT. RA(IPR(80) + 6)) RETURN
              IF (DPLN .LT. RA(IPR(80) + 5)) RETURN
            END IF
          END IF
          NMOL = IPR(42)
          IF (NMOL .GT. 0) THEN
            DO 10 L = 1, NMOL
              XMOLL = ABS(MOL(1, L) / PAR(42))
              IF (ABS(ABS(XML) - XMOLL) .LT. 0.005) GO TO 20
              IF (IPR(20) .GT. 0) THEN
                MPM = NINT (XMOLL * PAR(42))
                CALL GEN098 (MPM, PAR(42), NSL2, ITX, ITY, ITZ, NR2)
                YYY(4) = ITX
                YYY(5) = ITY
                YYY(6) = ITZ
                DO I = 1, 3
                  YYY(I) = RCG(I, NR2)
                END DO
                CALL SGSM (ICL, NSL2, YYY, LU6, 3, IERR)
                DO I = 7, 9
                  IF (ABS(XXX(I) - YYY(I)) .GT. 0.001) GO TO 10
                END DO
                GO TO 20
              END IF
   10       CONTINUE
          END IF
          L       = IPR(42)
          IPR(42) = IPR(42) + 1
          IF (MODE .LT. 0) THEN
            MOL(1, L + 1) = MOL(1, IPR(44) + 1)
            L             = IPR(44)
            IPR(44)       = IPR(44) + 1
          ELSE
            LDIF = IPR(42) - IPR(75)
            IF (LDIF .GT. 0) THEN
              IF (NINT((XML - 1555.0) * PAR(42)) .EQ. IPR(75)) THEN
                DO L0 = 1, LDIF
                  MOL(1, L + 1) = MOL(1, L)
                  L = L - 1
                END DO
                DO L0 = IPR(39) + 1, IPR(37) + IPR(55)
                  CALL PLUT15 (-6, L0, 11, LRES)
                  IF (LRES .GT. IPR(75) - 2) THEN
                    IVAL = LRES + 1
                    CALL PLUT15 (6, L0, 11, IVAL)
                  END IF
                END DO
              END IF
            END IF
          END IF
          MOL(1, L + 1) = NINT(XML * PAR(42))
          IF (MODE .GT. 0) THEN
            CALL GEN048 (5, MOL(2, L + 1), NMA, MAX (0, NMB))
          END IF
          GO TO 30
   20     L    = L - 1
          OXML = MOL(1, L + 1) / PAR(42)
          IF (MODE .LT. 0 .AND. L .GE. IPR(44)) THEN
            MOL(1, L + 1) = MOL(1, IPR(44) + 1)
            L             = IPR(44)
            IPR(44)       = IPR(44) + 1
          END IF
          IF (XML .LT. 0) THEN
            MOL(1, L + 1) = - NINT(ABS(OXML) * PAR(42))
          ELSE
            MOL(1, L + 1) =   NINT(ABS(OXML) * PAR(42))
            IF (MODE .GT. 0)
     1         CALL GEN048 (5, MOL(2, L + 1), NMA, NMB)
          END IF
   30     MADDR = L
        END DO
      ELSE IF (MODE .EQ. 1001) THEN
          IPR(130) = 0
          IF (IPR(17) .EQ. 0) THEN
            CALL PLUT05
          END IF
          IF (KL .GT. 1) THEN
            N1 = IFL(2)(1:3)
C * ARU NONE CASE
            IF (N1 .EQ. 'NON') THEN
              ILAST = 0
C * ARU UNIQUE
            ELSE IF (N1 .EQ. 'UNI') THEN
              ILAST = IPR(43)
C * ARU INTER
            ELSE IF (N1 .EQ. 'INT') THEN
              ILAST = IPR(44)
C * ARU RESTORE
            ELSE IF (N1 .EQ. 'RES') THEN
              ILAST =  NMOL
            ELSE
              RETURN
            END IF
            DO I = 1, NMOL
              XNM = ABS(MOL(1, I) / PAR(42))
              IF (I .GT. ILAST) THEN
                MOL(1, I) = - NINT(XNM * PAR(42))
              ELSE
                MOL(1, I) =   NINT(XNM * PAR(42))
              END IF
            END DO
        END IF
      ELSE IF (MODE .EQ. 1002) THEN
        IPR(159) = IPR(64) - IPR(52) * 2
        NML      = 0
        DO 40 I = 1, NMOL
          XNM = INT(MOL(1, I) / PAR(42))
          IF (XNM .GT. 0) THEN
            RA(IPR(159) - NML) = XNM
            IF (NML .GT. 0) THEN
              DO J = 1, NML
                IF (RA(IPR(159) + 1 - J) .EQ. XNM) GO TO 40
              END DO
            END IF
            NML = NML + 1
          END IF
   40   CONTINUE
        IPR(142) = NML
      ELSE IF (MODE .EQ. 1003) THEN
        IPR(42) = IPR(44)
        NMOL    = IPR(42)
        DO K = 1, NMOL
          MOL(1, K)  = - IABS(MOL(1, K))
        END DO
      ELSE IF (MODE .EQ. 1004) THEN
        WRITE (LUNIT, 99997, IOSTAT = IOST)
     1    IPR(43), IPR(44) - IPR(43), NMOL, NRES
        IF (NMOL .NE. 0) THEN
          DO I = 1, NMOL
            CALL GEN098 (MOL(1, I), PAR(42), NSL2, ITX, ITY, ITZ, NR)
            ARU1 = '-         '
            ARU2 = ARU1
            ARU3 = ARU1
            CALL GEN048 (-5, MOL(2, I),  1, NARU1)
            IF (NARU1 .GT. 0) ARU1 = COLR(NARU1)
            CALL GEN048 (-5, MOL(2, I),  6, NARU2)
            IF (NARU2 .GT. 0) ARU2 = BWCT(NARU2)
            CALL GEN048 (-5, MOL(2, I), 11, NARU3)
            IF (NARU3 .GT. 0) ARU3 = COLR(NARU3)
            CALL GEN048 (-5, MOL(2, I), 15, NARU4)
            IF (I .EQ. 1) WRITE (LUNIT, 99991, IOSTAT = IOST)
            NRESA = 9
            NRESB = 17
            IF (NR .LT. 9)  NRESA = NCRS(NR)
            IF (NR .LT. 17) NRESB = NPRS(NR)
            IF (IPR(134) .GT. 9) THEN
              WRITE (LUNIT, 99996, IOSTAT = IOST)
     1          I, MOL(1, I) / PAR(42), ARU1, ARU2,
     2          ARU3, NARU4, COLR(NRESA), BWCT(NRESB)
            ELSE
              WRITE (LUNIT, 99995, IOSTAT = IOST)
     1          I, MOL(1, I) / PAR(42), ARU1, ARU2,
     2          ARU3, NARU4, COLR(NRESA), BWCT(NRESB)
            END IF
          END DO
          IF (IPR(130) .EQ. 1) THEN
            WRITE (LUNIT, 99993, IOSTAT = IOST) IPR(142)
            IM2 = IPR(159)
            IM1 = IM2 + 1 - IPR(142)
            WRITE (LUNIT, 99994, IOSTAT = IOST)
     1        (RA(IM2 + IM1 - I), I = IM1, IM2)
          END IF
        END IF
      ELSE IF (MODE .EQ. 1005) THEN
        L = NINT(XMOLE)
        IF (L .GT. 0) THEN
          MOL(1, L) = - IABS(MOL(1, L))
        ELSE
          WRITE (LU6, '(''Cannot exclude #'', I3)', IOSTAT = IOST) L
        END IF
      END IF
      RETURN
99999 FORMAT (':: ARU', F10.2, ' NOT Accepted (Check SYMM.Nr=', I3,')')
99998 FORMAT (':: ARU', F10.2, ' NOT Accepted (Check RESD.Nr=', I3,')')
99997 FORMAT (//, 'Asymmetric Residue Units :: UNIQUE =', I5,
     1          ', INTER =', I5, ', TOTAL =', I5, //,
     2          'The first', I3, ' refer(s) to 1555.nn ARU''s, the',
     3          ' next ones to _a, _b etc', /)
99996 FORMAT (I3, F12.2, 3(2X, A), I5, 2X, 2(2X, A))
99995 FORMAT (I3, F12.1, 3(2X, A), I5, 2X, 2(2X, A))
99994 FORMAT (8F9.0)
99993 FORMAT (/, '(Partially) ACTIVE Asymmetric Structure Units =',
     1        I5, /)
99992 FORMAT (':: Residue number out of range')
99991 FORMAT ('  #', 7X, 'ARU', 4X, 'ARUColor', 4X, 'ARUPattern ',
     1        'BondColor', 2X, '#Lines', 3X, 'ResColor',
     2        4X, 'ResPattrn')
      END SUBROUTINE PLUT17
      SUBROUTINE PLUT18 (IAT, JAT)
      PARAMETER (NP0=6,NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      XP12    = 0.0
      YP12    = 0.0
      ZP12    = 0.0
      ZMN     = 0.0
      RMNS    = 0.0
      CPHI    = 0.0
      SPHI    = 0.0
      XN      = 0.0
      YN      = 0.0
      ZN      = 0.0
      ZMIN    = 0.0
      J       = 0
      DMARG   = 0.0
      NDUM    = 0
      ZU7     = 0.0
      ZU8     = 0.0
      ZU9     = 0.0
      MNRB    = 0
      ZRIJ    = 0.0
      ZRMN    = 0.0
      CSPHP   = 0.0
      CSPHQ   = 0.0
      SNPHP   = 0.0
      SNPHQ   = 0.0
      PHIP    = 0.0
      RI      = 0.0
      RJ      = 0.0
      DL1     = 0.0
      NRBD    = 0
      IASU    = 0
      PHIQ    = 0.0
      XQ12    = 0.0
      YQ12    = 0.0
      ZIJMIN  = 0.0
      ZJ      = 0.0
      ZQ12    = 0.0
      XMARG   = PAR(36)
      IPR(78) = 0
      ILPB    = IPR(69) + 1
      NAB     = IPR(37) - IPR(69)
      NPA     = IPR(62)
      JMAX    = NPA
      NP      = IPR(40)
      M       = IAT
      MA      = M
      N       = JAT
      IF (N .GT. 0) THEN
        MODE = 2
      ELSE
        MODE = 1
      END IF
      RTEST = PAR(149) * PAR(24)
      LRET  = 1
      CALL PLUT14 (-1, M, IASU, NPROP, XM, YM, ZM, RM)
      LABI = 0
      IF (M .LE. NP) THEN
        IF (M .GT. NPA) THEN
           LABI  = M - NPA
           XP12  = XM
           YP12  = YM
           ZP12  = ZM
           ZMN   = 0.0
           RMNS  = 2 * RM
           DL2   = RM
           PHIP  = 0.0
           CPHI  = 1.0
           SPHI  = 0.0
           XN    = XM + RM
           XM    = XM - RM
           RM    = PAR(28)
           RN    = RM
           YN    = YM
           ZN    = ZM
           M     = NP + 1
           N     = NP + 2
           MODE  = 2
           JMAX  = NP
           RSV1  = RM
           RSV2  = RN
           ZMIN  = ZM - RM
           XMARG = 0
           GO TO 20
        END IF
      END IF
   10 IF (MODE .GT. 1) THEN
        III  = N * NP0 + IPR(158)
        ZN   = RA(III - 1)
        RN   = RA(III)
        IF (MODE .EQ. 4) THEN
          ZMAX = MAX (ZM + RM, ZN + RN)
          IF (ZMAX .LT. ZIJMIN) GO TO 100
        END IF
        XN   = RA(III - 3)
        YN   = RA(III - 2)
        ZMIN = MIN (ZM - RM, ZN - RN)
        RSV1 = RM
        RSV2 = RN
        XMN  = XM - XN
        YMN  = YM - YN
        ZMN  = ZM - ZN
        ASQ  = XMN**2 + YMN**2
        RMNS = ASQ + ZMN**2
        DL21 = SQRT(ASQ)
        DL2  = DL21 / 2.0
        XP12 = (XM + XN) / 2
        YP12 = (YM + YN) / 2
        ZP12 = (ZM + ZN) / 2
        IF (DL21 .NE. 0.0) THEN
          ZRMN = ZMN * RN / DL21
          PHIP = ATAN2(YMN, XMN)
          CPHI = -XMN / DL21
          SPHI = -YMN / DL21
        ELSE
          ZRMN = RN
          PHIP = 0.0
          CPHI = 1.0
          SPHI = 0.0
        END IF
        CSPHP = COS(PHIP)
        SNPHP = SIN(PHIP)
        IF (MODE .EQ. 4) THEN
          PHIQX =   PHIQ - PHIP
          PHIPX = - PHIQX
          XT12  =   XP12 - XQ12
          YT12  =   YP12 - YQ12
          XT    =   XT12 * CSPHQ + YT12 * SNPHQ
          YT    = - XT12 * SNPHQ + YT12 * CSPHQ
          ZT    =   ZP12 - ZQ12
          CALL PLUT20 (DL1 + ZRIJ , RJ, RI, DL2 + ZRMN, RM, RN,
     1      PHIPX, XT, YT, IT, XMARG)
          IF (IT .EQ. 0) THEN
            GO TO 100
          ELSE
            XTA   = - XT12 * CSPHP - YT12 * SNPHP
            YTA   =   XT12 * SNPHP - YT12 * CSPHP
            CALL PLUT20 (DL2 + ZRMN, RM, RN, DL1 + ZRIJ, RJ, RI,
     1        PHIQX, XTA, YTA, IT, XMARG)
            IF (IT .EQ. 0) GO TO 100
          END IF
          IPHI = MOD(NINT(ABS(PHIQX * RGBL(6) * 10.0)), 1800)
          ALF  = 0.0
          BET  = 0.0
          IF (IPHI .EQ. 0) THEN
            IF (ABS(ZT) .GT. 0.001)  THEN
              IF (ZT .LT. 0.0) THEN
                GO TO 100
              ELSE
                GO TO 50
              END IF
            END IF
            IF (IPR(56) .GE. NRBD)    GO TO 100
            IF (IPR(56) .LE. IPR(68)) GO TO 100
            GO TO 110
          ELSE IF (IPHI .EQ. 900) THEN
            IF (DL2 .GT. 0.0) ALF = -YT / DL2
            IF (DL1 .GT. 0.0) BET =  XT / DL1
          ELSE
            TANP =  TAN(PHIPX)
            XS   =  (XT * TANP - YT) / TANP
            DL2C = DL2 * COS(PHIPX)
            IF (DL2C .GT. 0.0) ALF = (XS - XT) / DL2C
            IF (DL1  .GT. 0.0) BET =  XS / DL1
          END IF
          ZSJI  = (ZJ - ZQ12) * BET
          ZSMN  = (ZM - ZP12) * ALF + ZT
          ZMNJI = ZSMN - ZSJI
          CRADP = (RM + RN) / 2.0
          CRADQ = (RJ + RI) / 2.0
          IF (ABS(ZMNJI) .GT. 0.01) THEN
            IF (ABS(ALF) .LT. 1.0 .AND. ABS(BET) .LT. 1.0) THEN
              IF (ZMNJI .LT. + (CRADP + CRADQ)) GO TO 100
            ELSE
              IF (ZT .LT. (CRADP + CRADQ)) GO TO 100
            END IF
          ELSE
            IF (ZT .LT. 0.0) GO TO 100
          END IF
          GO TO 50
        ELSE IF (MODE .EQ. 3) THEN
          GO TO 40
        END IF
      END IF
   20 NL = 0
      J  = IPR(69)
      IF (LABI .GT. 0) THEN
        IF (IPR(4) .LE. 0) THEN
          J = NPA
        END IF
      END IF
      IF (MODE .EQ. 1) THEN
        IF (IPR(96) .EQ. 1) THEN
          ANG1 = PAR(51) / RGBL(6)
          ANG2 = PAR(52) / RGBL(6)
          CA   = COS(ANG1)
          SA   = SIN(ANG1)
          YJ   = YM + RM * SA / 2
          ZJ   = RM * CA / 2
          RJ   = RM / PAR(53)
          CA   = COS(ANG2)
          SA   = SIN(ANG2)
          ZD   = ZJ
          XJ   = XM + ZD * SA
          ZJ   = ZM + ZD * CA
          NJ   = 0
          CALL PLUT14 (0, NJ, IASU, NPROP, XJ, YJ, ZJ, RJ)
          NJ   = - NJ
          GO TO 50
        END IF
      END IF
   30 J = J + 1
      IF (J .GT. JMAX)  GO TO 80
      IF (MODE .LT. 3) THEN
        IF (J .EQ. MA)  GO TO 30
        IF (LABI .GT. 0) THEN
          IF (IGBL(75) .EQ. 1) THEN
             IF (LABI .LE. IPR(37)) THEN
               IF (LABI .EQ. J) GO TO 30
             ELSE
               IF ((LABI - NAB) .EQ. J) GO TO 30
             END IF
          ELSE
             IF (LABI .EQ. (J - IPR(69))) GO TO 30
          END IF
        END IF
      END IF
      JLAB = J - NPA
      IF (JLAB .LE. 0) THEN
        JO = MOD(J - ILPB, NAB) + ILPB
        CALL PLUT15 (-1, JO, 27, NINCL)
        IF (NINCL .EQ. 0) GO TO 30
      END IF
      III = J * NP0 + IPR(158)
      XJ  = RA(III - 3)
      YJ  = RA(III - 2)
      ZJ  = RA(III - 1)
      RJ  = RA(III    )
      IF (JLAB .GT. 0) THEN
        IF (JLAB .LE. (IPR(37) * IGBL(75))) THEN
          IF (IPR(46) .EQ. 0 .AND. JLAB .LE. IPR(69)) GO TO 30
          CALL PLUT15 (-4, JLAB, 37, IVAL)
          IF (IVAL .LE. 1) GO TO 30
        ELSE
          IF (J .GT. MA) GO TO 30
        END IF
        BX = ABS(XP12 - XJ)
        BY = ABS(YP12 - YJ)
        IF ((BY .LT. 2.0 * PAR(28)) .AND. (BX .LT. DL2 + RJ)) GO TO 110
      END IF
      IF (ABS(RJ - 500.0) .GT. 499.99)  GO TO 30
      RSV1 = RJ
   40 BX   = XJ - XM
      BY   = YJ - YM
      BZ   = ZJ - ZM
      JEQM = 0
      BSQ2 = BX**2 + BY**2
      BSQ3 = BSQ2  + BZ**2
      IF (BSQ3 .LT. RTEST) JEQM = 1
      IF (MODE .EQ. 1) THEN
        IF (JEQM .NE. 0) THEN
          IF (M .LE. J)  GO TO 30
          GO TO 110
        END IF
        IF (BZ .LT. - RJ)  GO TO 30
        RMJ   = RM + RJ
        IF (BSQ2 .LT. PAR(24) * 0.01) THEN
        END IF
        RMJSQ = RMJ**2
        IF (BSQ2 .GT. RMJSQ)  GO TO 30
        IF (BSQ3 .LT. RMJSQ) THEN
          NJ = - J
        ELSE
          NJ = J
        END IF
      ELSE
        CX = XJ - XN
        CY = YJ - YN
        CZ = ZJ - ZN
        JEQN = 0
        CSQ3 = CX**2 + CY**2 + CZ**2
        IF (CSQ3 .LT. RTEST) JEQN = 1
        IF (MODE .EQ. 3) THEN
          IF (BZ .GT. RJ)  GO TO 100
          RSV1 = RN
          IF (JEQN .NE. 0 .OR. JEQM .NE. 0) THEN
            IF (JEQN .NE. 1) THEN
              NJ = - N + 1
              NL = N
              IF (ZMN .GE. 0.0001 .AND. RM .GT. 0.001) THEN
                RATIO = RN * SQRT(RMNS) / (RM * ZMN)
                IF (RATIO .LE. 1)  GO TO 100
              END IF
            ELSE
              NL   = N - 1
              NJ   = - N
              CPHI = - CPHI
              SPHI = - SPHI
            END IF
            GO TO 50
          END IF
        ELSE IF (LABI .LE. 0) THEN
          IF (JEQN .EQ. 1)  GO TO 30
          IF (CZ .LT. 0)  GO TO 30
        END IF
        CALL PLUT20 (-1.0, RJ, 0.0, DL2, RM, RN, PHIP, XP12 - XJ,
     1   YP12 - YJ, IT, XMARG)
        IF (IT .EQ. 0)  THEN
          IF (LRET .EQ. 1) THEN
            GO TO 30
          ELSE IF (LRET .EQ. 2) THEN
            GO TO 100
          END IF
        END IF
        XT12  = XJ - XP12
        YT12  = YJ - YP12
        ZT12  = ZJ - ZP12
        XT    = XT12 * CSPHP + YT12 * SNPHP
        ZTEST = ZT12
        IF (DL2 .GT. 0.0) ZTEST = ZTEST + (ZP12 - ZM) * XT / DL2
        RTST = (RM + RN) / 2.0 + RJ
        IF (MODE .EQ. 2) THEN
          NJ = J
          IF (BSQ3 .LT. RJ**2) THEN
            NJ = - IABS(J)
          ELSE
            IF (JEQN .EQ. 0) THEN
              IF (ZTEST .LT. RTST) GO TO 30
            END IF
          END IF
        ELSE
          IF (JEQN + JEQM .EQ. 0) THEN
            IF (ZTEST + RTST .GE. 0.0) GO TO 100
          END IF
        END IF
      END IF
   50 IABSNJ = IABS(NJ)
      CALL PLUT14 (-1, IABSNJ, IASU, NPROP, X1, Y1, Z1, RSV1)
      NOBSC = IPR(78)
      IPOP  = IPR(66)
      IF (NOBSC .GT. 0) THEN
        DO INOBS = 1, NOBSC
          IPOP = IPOP - 13
          IF (ABS(RA(IPOP + 3) - X1) + ABS(RA(IPOP + 4) - Y1) +
     1          ABS(RA(IPOP + 5) - Z1) .LT. 0.01) GO TO 70
        END DO
      END IF
      IPR(78) = IPR(78) + 1
      IPOP    = IPR(66) - IPR(78) * 13
      IF (IPOP .GE. IPR(158) + (IPR(40) + IPR(67) + 1) * NP0) THEN
        RA(IPOP + 1) = NJ
        RA(IPOP + 2) = NL
        RA(IPOP + 3) = X1
        RA(IPOP + 4) = Y1
        RA(IPOP + 5) = Z1
        RA(IPOP + 6) = RSV1
        IF (NL .NE. 0) THEN
          CALL PLUT14 (-1, NL, IASU, NPROP, X2, Y2, Z2, RSV2)
          RA(IPOP + 7)  = RSV2
          RA(IPOP + 8)  = DL2
          RA(IPOP + 9)  = CPHI
          RA(IPOP + 10) = SPHI
          RA(IPOP + 11) = XP12
          RA(IPOP + 12) = YP12
        END IF
        IF (MODE .LT. 4) THEN
          IF (NJ .GT. 0) THEN
            DMARG = XMARG
          ELSE
            IF (MODE .EQ. 2) THEN
              DMARG = 0.0
            ELSE IF (MODE .EQ. 3) THEN
              IF (Z2 .GT. Z1) THEN
                IF (DL2 .GT. 0.0) THEN
                  ALFA  = ATAN((Z2 - Z1) / (DL2 * 2.0))
                ELSE
                  ALFA  = 90.0 / RGBL(6)
                END IF
                DMARG = PAR(58) * SIN(ALFA)
              ELSE
                DMARG = 0.0
              END IF
            ELSE
              DMARG = XMARG
            END IF
          END IF
        ELSE IF (MODE .EQ. 4) THEN
          DMARG = XMARG
        END IF
        IF (PAR(48) .GT. 0.0) DMARG = DMARG * PAR(48) / (PAR(48) - Z1)
        RA(IPOP + 13) = DMARG
      ELSE
        IPR(78) = IPR(78) - 1
      END IF
      NDUM = 0
   70 IF (LABI .NE. 0) THEN
        IF (IPR(78) .GE. 2) GO TO 120
      END IF
      IF (LRET .EQ. 1) THEN
        GO TO 30
      ELSE IF (LRET .EQ. 2) THEN
        GO TO 100
      END IF
   80 IF (LABI .LE. 0) THEN
        IF (IPR(77) .EQ. 0)  GO TO 120
        IF (MODE .EQ. 2 .AND. IABS(IPR(77)) .GT. 1)  GO TO 90
        IF (IABS(IABS(IPR(77)) - 2) .NE. MODE)  GO TO 120
      END IF
   90 MODE = MODE + 2
      XJ   = XM
      YJ   = YM
      ZJ   = ZM
      RJ   = RM
      LRET = 2
      IF (MODE .EQ. 3) THEN
        J      = M
        RTEST  = RJ**2
      ELSE IF (MODE .EQ. 4) THEN
        RI     = RN
        PHIQ   = PHIP
        CSPHQ  = CSPHP
        SNPHQ  = SNPHP
        DL1    = DL2
        XQ12   = XP12
        YQ12   = YP12
        ZQ12   = ZP12
        ZIJMIN = ZMIN
        ZRIJ   = ZRMN
        ZU7    = ZU(7)
        ZU8    = ZU(8)
        ZU9    = ZU(9)
      END IF
      NRBD = 0
      NDUM = 0
      IF (IPR(4) .GT. 0) THEN
        MNRB = IPR(97)
      ELSE
        MNRB = 0
      END IF
  100 NRBD = NRBD + 1
      IF (NRBD .GT. MNRB) THEN
        IF (MODE .EQ. 4) THEN
          ZU(7) = ZU7
          ZU(8) = ZU8
          ZU(9) = ZU9
        END IF
        GO TO 120
      END IF
      IPR(67) = IPR(67) - NDUM
      CALL PLUT16 (NRBD, II, M, N, RBO, NLI)
      IF (NLI .LT. 0) NLI = IABS(NLI)
      NDUM = 2
      IF (MODE .EQ. 4) THEN
        IF (IPR(56) .EQ. NRBD) GO TO 100
      END IF
      IF (M .EQ. 0) GO TO 100
      N   = IPR(67) + NP
      M   = N - 1
      NJ  = M
      NL  = N
      III = M * NP0 + IPR(158)
      XM  = RA(III - 3)
      YM  = RA(III - 2)
      ZM  = RA(III - 1)
      RM  = RA(III    )
      GO TO 10
  110 IPR(78) = -1
  120 RETURN
      END SUBROUTINE PLUT18
      SUBROUTINE PLUT19 (M, MODE)
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      DELX    = 0.0
      DELY    = 0.0
      DELZ    = 0.0
      DL      = 0.0
      NINC    = 0
      DZS     = 0.0
      RADIUS  = 0.0
      CX      = 0.0
      SX      = 0.0
      CY      = 0.0
      SY      = 0.0
      IUP     = 0
      IPP     = 0
      RNL     = 0.0
      DL2     = 0.0
      CPHI    = 0.0
      SPHI    = 0.0
      XP12    = 0.0
      YP12    = 0.0
      ISLOW   = 0
      DYM     = 0.0
      DXM     = 0.0
      RMS     = 0.0
      ZM      = 0.0
      NOBSC   = IPR(78)
      IPR(98) = 0
      IDOWN   = 3
      LDRAW   = 0
      IDRAW   = 3
      ISTEP   = 1
      IF (MODE .NE. 0) THEN
        IF (MODE .LT. 0) THEN
          NRF  = 3
          NRF1 = 0
        ELSE
          NRF  = 0
          NRF1 = 3
        END IF
        X    = XYZPL(NRF  + 1)
        Y    = XYZPL(NRF  + 2)
        Z    = XYZPL(NRF  + 3)
        DELX = XYZPL(NRF1 + 1) - X
        DELY = XYZPL(NRF1 + 2) - Y
        DELZ = XYZPL(NRF1 + 3) - Z
        IF (IPR(4) .EQ. 0) THEN
          IF (IPR(346) .EQ. 1) THEN
            DELX = DELX / 2.0
            DELY = DELY / 2.0
            DELZ = DELZ / 2.0
          END IF
        END IF
        DL = SQRT(DELX ** 2 + DELY ** 2)
        IF (NOBSC .GT. 0) THEN
          NINC = (INT(DL / PAR(5)) + 1) * IPR(111)
          DELX = DELX / NINC
          DELY = DELY / NINC
          DELZ = DELZ / NINC
        ELSE
          NINC  = 1
        END IF
        IF (NOBSC .GT. 0) THEN
          IF (M .NE. 0) THEN
            XM  = XYZK(1)
            YM  = XYZK(2)
            ZM  = XYZK(3)
            RM  = XYZK(4)
            RMS = RM ** 2
            DXM = X - XM
            DYM = Y - YM
            DZS = (Z - ZM) ** 2
          END IF
        END IF
        GO TO 50
      ELSE
        NPP = IPR(91) * IPR(87)
        IF (NOBSC .EQ. 0 .AND. IPR(139) .EQ. 0 .AND.
     1      IPR(162) .NE. 8 .AND. IPR(162) .NE. 9) THEN
           CALL PLUT30 (0, NPP)
           RETURN
        ELSE
          RADIUS = PAR(74)
          CX     = COS(PAR(55))
          SX     = SIN(PAR(55))
          CY     = COS(PAR(57))
          SY     = SIN(PAR(57))
          IUP    = 1
          ITS    = 0
          ITF    = 0
          IPP    = -1
          GO TO 40
        END IF
      END IF
   10 IF (IUP .EQ. 0) ITF = IPP - 1
      IUP = 1
      GO TO 30
   20 IF (IUP .EQ. 1) THEN
        CALL PLUT30 (ITS, ITF)
        ITS = IPP
      END IF
      ITF = IPP
      IUP = 0
   30 DUM = CY * CX - SY * SX
      SY  = SY * CX + CY * SX
      CY  = DUM
   40 IPP = IPP + 1
      IF (IPP .GT. NPP) THEN
        CALL PLUT30 (ITS, ITF)
        RETURN
      END IF
      XX = CY * RADIUS
      YY = SY * RADIUS
      Z  = ZU(3) * XX + ZU(6) * YY + PAR(73)
      IF (XYZK(3) .GT. Z) GO TO 10
      X = ZU(1) * XX + ZU(4) * YY + PAR(71)
      Y = ZU(2) * XX + ZU(5) * YY + PAR(72)
   50 JMODE = - 1
      IPOP  = IPR(66)
   60 IF (JMODE + NOBSC .GE. 0) THEN
        IPOP  = IPOP  - 13
        JMODE = JMODE - 1
        J     = NINT(RA(IPOP + 1))
        IF (J .GT. 0) THEN
          K   = J
          JNL = 1
        ELSE
          K   = - J
          JNL = 0
        END IF
        NL  = NINT(RA(IPOP + 2))
        XK  = RA(IPOP + 3)
        YK  = RA(IPOP + 4)
        ZK  = RA(IPOP + 5)
        RK  = RA(IPOP + 6)
        RKB = RK
        IF (NL .GT. 0) THEN
          JNL  = JNL + 2
          RNL  = RA(IPOP + 7)
          DL2  = RA(IPOP + 8)
          CPHI = RA(IPOP + 9)
          SPHI = RA(IPOP + 10)
          XP12 = RA(IPOP + 11)
          YP12 = RA(IPOP + 12)
        END IF
        DMARG = RA(IPOP + 13)
        IF (JNL .LT. 3) THEN
          DXK = X - XK
          DYK = Y - YK
          DZK = Z - ZK
          DSQ = DXK**2 + DYK**2
          IF (MODE .EQ. 0) THEN
            IF (JNL .EQ. 1 .AND. M .EQ. 0) THEN
              RK = RK + DMARG
            ELSE IF (JNL .GT. 0) THEN
              IF (M .NE. 0) THEN
                RK = RK + DMARG
              ELSE
                DMARG = 0.0
              END IF
            END IF
          ELSE
            RK = RK + DMARG
          END IF
          RKS = RK**2
          IF (DSQ .LT. RKS) THEN
            IF (MODE .NE. 0 .AND. J .LT. 0) THEN
              IF (DZK .LT. 0.0) GO TO 70
            ELSE IF (J .GT. 0 .OR. MODE .EQ. 0) THEN
              IF (DZK .LE. 0.0)  GO TO 70
            ELSE
              D3SQ = DSQ + DZK**2
              IF (D3SQ .LT. RKS)  GO TO 70
            END IF
          END IF
          IF (MODE .NE. 0) THEN
            IF (M .NE. 0) THEN
              IF (RKS .GE. DSQ) THEN
                IF (DZS .LT. 0)  GO TO 70
                DZK = SQRT(DZS) + ZM - ZK
                DSQ = DSQ + DZK**2
                IF (DSQ .LT. RKS)  GO TO 70
              END IF
            END IF
          ELSE
            IF (J .LT. 0) THEN
              IF (K .NE. M) THEN
                DZK = Z - ZK
                DSQ = DSQ + DZK**2
                IF (DSQ .LT. RKS)  GO TO 70
              END IF
            END IF
          END IF
          IF (NL .EQ. 0)  GO TO 60
        END IF
        IF (M .GT. 0 .OR. J .LT. 0) THEN
          IF (XYZK(3) .GE. ZK)  GO TO 60
        END IF
        X0  = X - XP12
        Y0  = Y - YP12
        XA0 = CPHI * X0 + SPHI * Y0
        IF (ABS(XA0) .GT. DL2)  GO TO 60
        YA0 = -SPHI * X0 + CPHI * Y0
        IF (DL2 .NE. 0) THEN
          RBND = ((RKB + RNL) + (RNL - RKB) * XA0 / DL2) / 2.0 + DMARG
        ELSE
          RBND = DMARG
        END IF
        IF (ABS(YA0) .GT. RBND)  GO TO 60
   70   IF (JMODE .LT. -2) THEN
          IF (M .LE. 0) THEN
            IP1 = IPR(66) - 13
            IP2 = IPR(66) + (JMODE + 1) * 13
            DO JJ = 1, 13
              DUM          = RA(IP1 + JJ)
              RA(IP1 + JJ) = RA(IP2 + JJ)
              RA(IP2 + JJ) = DUM
            END DO
          END IF
        END IF
        IF (MODE .EQ. 0) GO TO 10
        IDRAW = 3
      ELSE
        IF (MODE .EQ. 0) GO TO 20
        IDRAW = 2
      END IF
      IF (LDRAW .NE. IDRAW) THEN
        IF (LDRAW .NE. 0) THEN
          IF (ISTEP .GT. 1) THEN
            ISTEP = 1 - ISTEP
            ISLOW = - ISTEP
            NINC  = NINC - ISTEP
            DELXN = DELX * ISTEP
            DELYN = DELY * ISTEP
            DELZN = DELZ * ISTEP
            GO TO 80
          ELSE
            ISTEP = 1
            IF (ISLOW .GT. 0) ISLOW = ISLOW - 1
          END IF
        ELSE
          LDRAW = IDRAW
          IF (DL .LT. PAR(5)) THEN
            IF (IDRAW .EQ. 3 .AND. ABS(DL) .LT. 0.0001) THEN
              RETURN
            ELSE
              ISLOW = IPR(111) - 1
              ISTEP = 1
            END IF
          ELSE
            ISLOW = 0
            ISTEP = IPR(111)
          END IF
          IF (ISTEP .GT. NINC) ISTEP = NINC
        END IF
      ELSE
        IF (ISLOW .GT. 0) THEN
          ISTEP = 1
          ISLOW = ISLOW -1
        ELSE
          ISTEP = IPR(111)
          IF (ISTEP .GT. NINC) ISTEP = NINC
        END IF
      END IF
      IF (NINC .EQ. 0) IDRAW = 3
      LDRAW = IDRAW
      IF (IDRAW .EQ. 2) THEN
        IF (IDOWN .EQ. 3) THEN
          XA = X
          YA = Y
          IF (MODE .EQ. 0 .OR. M .EQ. 0) THEN
            ZA = Z
          ELSE
            ZA = ZM
          END IF
          IDOWN = 2
        END IF
      ELSE
        IF (IDOWN .EQ. 2) THEN
          CALL GGIP (XA, YA, ZA, 3)
          CALL GGIP (X,  Y,  Z,  2)
          IDOWN = 3
        END IF
        IF (NINC .LE. 0) RETURN
      END IF
      IF (NINC .EQ. 1) THEN
        NINC  = 0
        DELXN = DELX
        DELYN = DELY
        DELZN = DELZ
      ELSE
        NINC  = NINC - ISTEP
        DELXN = DELX * ISTEP
        DELYN = DELY * ISTEP
        DELZN = DELZ * ISTEP
      END IF
   80 X = X + DELXN
      Y = Y + DELYN
      IF (M .NE. 0) THEN
        DXM = DXM + DELXN
        DYM = DYM + DELYN
        DZS = RMS - DXM**2 - DYM**2
        Z   = ZM  + SQRT(ABS(DZS))
      ELSE
        Z = Z + DELZN
      END IF
      GO TO 50
      END SUBROUTINE PLUT19
      SUBROUTINE PLUT20 (XDL1, XRJ, XRI, XDL2, XRM, XRN, XPHI, XXT,
     1                   XYT, IT, XOVRL)
      X0CSPH = 0.0
      X0SNPH = 0.0
      IX     = 0
      IY     = 0
      IT     = 1
      IBX    = 0
      IBY    = 0
      IF (ABS(XPHI) .LT. 0.0001) THEN
        CSPH = 1.0
        SNPH = 0.0
      ELSE
        CSPH = COS(XPHI)
        SNPH = SIN(XPHI)
      END IF
      DO 10 LL = 1, 3, 2
        IF (LL .EQ. 1) THEN
          X0CSPH = -XDL2 * CSPH
          X0SNPH = -XDL2 * SNPH
          Y0CSPH = -XRN  * CSPH
          Y0SNPH = -XRN  * SNPH
        ELSE
          X0CSPH = -X0CSPH
          X0SNPH = -X0SNPH
          Y0CSPH = -XRM * CSPH
          Y0SNPH = -XRM * SNPH
        END IF
        DO KK = 1, 3, 2
          IF (KK .EQ. 1) THEN
            X = X0CSPH - Y0SNPH + XXT
            Y = X0SNPH + Y0CSPH + XYT
          ELSE
            X = X0CSPH + Y0SNPH + XXT
            Y = X0SNPH - Y0CSPH + XYT
          END IF
          IF (XDL1 .LT. 0.0) THEN
            BX = XRJ
            BY = XRJ
            IF (ABS(X) .LT. XRJ .AND. ABS(Y) .LT. XRJ) THEN
              IF (X**2 + Y**2 .GT. XRJ**2) THEN
                IF (X .GT. 0) THEN
                  IBX = 2
                ELSE
                  IBX = -2
                END IF
                IF (Y .GT. 0) THEN
                  IBY = 2
                ELSE
                  IBY = -2
                END IF
              ELSE
                IBX = 0
                IBY = 0
                GO TO 10
              END IF
            END IF
          ELSE
            BX = XDL1
            BY = ((XRJ + XRI) + (XRJ - XRI) * X / XDL1) / 2.0 + XOVRL
            IF (BY .LT. 0.0) BY = 0.0
          END IF
          IF (X .GT. BX) THEN
            IX = IX + 1
          ELSE IF (X + BX .LT. 0.0) THEN
            IX = IX - 1
          END IF
          IF (Y .GT. BY) THEN
            IY = IY + 1
          ELSE IF (Y + BY .LT. 0.0) THEN
            IY = IY - 1
          END IF
        END DO
   10 CONTINUE
      IF (IBX .EQ. 0) THEN
        IF (IABS(IX) .EQ. 4 .OR. IABS(IY) .EQ. 4) IT = 0
      ELSE
        IF (IX .EQ. IBX .AND. IY .EQ. IBY) IT = 0
      END IF
      RETURN
      END SUBROUTINE PLUT20
      SUBROUTINE PLUT21 (MODE)
      PARAMETER (NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP49=2000000,NP48=1000,NP38=150,NP39=30,NP43=12,NP45=2048)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      CHARACTER J212*2, JJ13*3, J313*3
      N1     = 0
      N2     = 0
      ITOH   = 0
      ITOMET = 0
      ITOCG  = 0
      KL = IPR(220)
      KN = IPR(221)
      IPR(72) = 0
      MODR    = MODE
      IF (MODR .EQ. 0) THEN
        IPR(130) = 0
        IF (KL .LT. 3) THEN
          IPR(72) = 32
          RETURN
        END IF
        N = 0
        J212 = IFL(2)(1:2)
        IF (J212 .EQ. 'BO') THEN
          IDASH = 1
          DO 10 J = 3, KL
            JJ13 = IFL(J)(1:3)
            IF (JJ13 .EQ. 'DAS') THEN
              IDASH = -1
              GO TO 10
            END IF
            IF (JJ13 .EQ. 'TAP') THEN
              IF (KN .EQ. 0) THEN
                IPR(72) = 33
              ELSE
                PAR(44) = FN(1)
              END IF
               RETURN
            END IF
            IF (JJ13 .EQ. 'ALL') THEN
              IF (KN .EQ. 0) THEN
                IPR(72) = 34
              ELSE
                IPR(41) = 0
                PAR(38) = FN(1)
                IF (KN .GE. 2) IPR(12) = NINT(ABS(FN(2)) * IDASH)
              END IF
              RETURN
            END IF
            IF (JJ13 .EQ. 'NOR') THEN
              IF (KN .EQ. 0) THEN
                IPR(72) = 35
              ELSE
                PAR(38) = FN(1)
                IF (KN .GE. 2) IPR(12) = NINT(ABS(FN(2)) * IDASH)
              END IF
              RETURN
            END IF
            IF (JJ13 .EQ. 'TO') THEN
              JPL = - J - 1
              CALL PLUT13 (0, JPL, M, XDUM)
              IF (M .EQ. 0) THEN
                IPR(72) = 36
              ELSE
                N1 = 0
                N2 = M
              END IF
              GO TO 20
            ELSE IF (JJ13 .EQ. 'INT') THEN
              N1 = -1
              N2 = 0
              GO TO 20
            ELSE
              JP1 = J + 1
              CALL PLUT13 (0, J ,IAT, XDUM)
              CALL PLUT13 (0, JP1, JAT, XDUM)
              IF (IAT .GT. 0 .AND. JAT .GT. 0) THEN
                N1 = MIN (IAT, JAT)
                N2 = MAX (IAT, JAT)
                GO TO 20
              ELSE
                IPR(72) = 37
              END IF
            END IF
   10     CONTINUE
   20     IF (IPR(72) .EQ. 0) THEN
            IF (KN .GT. 0) THEN
              KNB = 0
              IF (FN(1) .GT. 1.0) THEN
                KNB = 1
                IF (KN .EQ. 1) THEN
                  KN    = 3
                  FN(2) = 0.02
                  FN(3) = 5.0
                END IF
              END IF
              IF (KN .GT. KNB) THEN
                RB = FN(KNB + 1)
              ELSE
                RB = PAR(38)
              END IF
              IF (KN .GT. KNB + 1) THEN
                L = NINT(FN(KNB + 2))
              ELSE
                L = IPR(12)
              END IF
            END IF
            L = IABS(L) * IDASH
            IF (L .EQ. 1) THEN
              IRB = 1
            ELSE
              IRB = NINT(RB * 1000.0)
            END IF
            N3    = ISIGN (1000 * IABS(L) + IRB, L)
            NSPEC = IPR(41)
            NRF   = IPR(80)
            DO I = 1, NSPEC
              N10 = NINT(RA(NRF))
              N20 = NINT(RA(NRF - 1))
              IF (N1 .EQ. N10 .AND. N2 .EQ. N20)  GO TO 30
              NRF = NRF - 3
            END DO
            IF (IPR(41) .GE. IPR(76)) THEN
              WRITE (LU6, 99999, IOSTAT = IOST)
              RETURN
            END IF
            IPR(41)     = IPR(41) + 1
            RA(NRF)     = N1
            RA(NRF - 1) = N2
   30       RA(NRF - 2) = N3
            IF (NRF .EQ. IPR(80)) THEN
              IF (IPR(4) .EQ. 1) THEN
                IPR(103) = N3
              ELSE IF (IPR(4) .EQ. 2) THEN
                IPR(104) = N3
              ELSE IF (IPR(4) .EQ. 4) THEN
                IPR(106) = N3
              END IF
            END IF
          END IF
        ELSE IF (J212 .EQ. 'AT') THEN
          J313  = IFL(3)(1:3)
          IF (KL .LT. 3) THEN
            GO TO 50
          ELSE IF (KL .GT. 3) THEN
            GO TO 40
          END IF
          IF (J313 .EQ. 'ALL') THEN
            IF (KN .EQ. 0) THEN
              IPR(72) = 38
            ELSE
              DO I = 1, IAN
                 IF (KN .GE. 1) THEN
                   RADR(I, 1) = FN(1)
                 ELSE
                   RADR(I, 1) = PAR(70)
                 END IF
              END DO
              IPR(99) = 1
            END IF
            RETURN
          END IF
          IPR(99) = 2
          IF (J313 .EQ. 'AUT') THEN
            IF (IABS(IPR(4)) .EQ. 3) THEN
              MODR   = 1
            ELSE
              MODR   = -1
              IPR(4) = 1
            END IF
             GO TO 50
          ELSE IF (J313 .EQ. 'COV') THEN
            MODR   = -1
            IPR(4) = 1
            GO TO 50
          ELSE IF (J313 .EQ. 'CPK')  THEN
            MODR   = 1
            GO TO 50
          END IF
   40     DO K = 3, KL
            CALL PLUT13 (0, -K, IAT, XDUM)
            IF (IAT .LT. 0) THEN
              M = - IAT
              N = N + 1
              IF (N .GT. KN) THEN
                IPR(72) = 39
                RETURN
              ELSE
                RADR(M, 1) = FN(N)
              END IF
            ELSE
              N = N + 1
              IF (N .GT. KN) THEN
                IPR(72) = 39
                RETURN
              END IF
              RA(IAT * NP43 + 11) = FN(N)
            END IF
          END DO
          IPR(99) = 2
        ELSE
          IPR(72) = 41
        END IF
      END IF
   50 IF (MODR .LT. 0) THEN
        RA(IPR(80)    ) = -1
        RA(IPR(80) - 1) = 0
        RA(IPR(80) - 2) = -5020
        IPR(41)         = 1
        IF (IPR(4) .EQ. 0) THEN
          CALL GEN074 (RADR, 1, IAN, 0.0)
        ELSE
          IF (IPR(4) .EQ. 1) THEN
            PAR(38)     = 0.05
            IPR(12)     = 30
            PAR(21)     = PAR(351)
            ITOH        = IPR(103)
            ITOMET      = 2040
            ITOCG       = -6040
          ELSE IF (IPR(4) .EQ. 2) THEN
            PAR(38)     = 0.2
            IPR(12)     = 8
            PAR(21)     = PAR(352)
            ITOH        = IPR(104)
            ITOMET      = 2040
            ITOCG       = -6040
          ELSE IF (IPR(4) .EQ. 4) THEN
            PAR(38)     = 0.12
            IPR(12)     = 2
            PAR(21)     = PAR(354)
            ITOH        = IPR(106)
            ITOMET      = -6040
            ITOCG       = -6040
          END IF
          RMIN            = MOD(ITOH, 1000) / 1000.0
          DO I = 1, IAN
            IF (IEN(I) .EQ. 106) THEN
              ITO = ITOCG
            ELSE IF (IEN(I) .EQ. 111) THEN
              ITO = 1010
            ELSE IF (IATPR(IEN(I)) .GE. 0) THEN
              ITO = ITOMET
            ELSE
              ITO = 0
            END IF
            IF (ITO .NE. 0) THEN
              RA(IPR(80) - IPR(41) * 3)     = 0
              RA(IPR(80) - IPR(41) * 3 - 1) = -I
              RA(IPR(80) - IPR(41) * 3 - 2) = ITO
              IPR(41)                       = IPR(41) + 1
            END IF
            RADR(I, 1) = MAX (PAR(21) * RADR(I, 3), RMIN)
          END DO
          RA(IPR(80) - IPR(41) * 3)     = 0
          RA(IPR(80) - IPR(41) * 3 - 1) = -1
          RA(IPR(80) - IPR(41) * 3 - 2) = ITOH
          IPR(41)         = IPR(41) + 1
          IPR(94)         = IPR(41)
          IPR(77)         = 3
          WRITE (LU6, 99998, IOSTAT = IOST) PAR(21)
        END IF
      ELSE IF (MODR .GT. 0) THEN
        DO I = 1, IAN
          RADR(I, 1) = ABS(VDWR(IEN(I)))
        END DO
        WRITE (LU6, 99997, IOSTAT = IOST)
        PAR(38) = 0.0
        IPR(12) = 0
        IPR(4)  = 3
        IPR(77) = 3
        IPR(41) = 0
      END IF
      RETURN
99999 FORMAT (':: Not enough storage, Request IGNORED',/)
99998 FORMAT (':: Atom Radii (RE)SET to ', F5.2, ' x Covalent Radii')
99997 FORMAT (':: Atom Radii (RE)SET to van der Waals Radii')
      END SUBROUTINE PLUT21
      SUBROUTINE PLUT22 (I, J, D)
      PARAMETER (NP49=2000000,NP48=1000,NP43=12)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      D = 0
      DO L = 4, 6
        D = D + (RA(I * NP43 + L) - RA(J * NP43 + L))**2
      END DO
      D = SQRT(ABS(D))
      RETURN
      END SUBROUTINE PLUT22
      SUBROUTINE PLUT23 (MODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,NP38=150,NP39=30,
     2 NP43=12,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      IF (MODE .GE. 0) THEN
        I = MODE * NP43
        DO II = 1, 3
          RA(I + II + 3) = 0.0
          DO JJ = II, 3
             RA(I + II + 3) = RA(I + II + 3) + OM(II, JJ) * RA(I + JJ)
          END DO
        END DO
      ELSE
        IF (IABS(IPR(50)) .EQ. 1) THEN
          IF (IPR(50) .EQ. 1) THEN
            WRITE (LU6, 99997, IOSTAT = IOST)
          ELSE
            IPR(50) = 1
          END IF
          IPR(37)  = 0
          IPR(52)  = 0
          IPR(53)  = 0
          IPR(68)  = 0
          IPR(69)  = 0
          IGBL(30) = 1
          IGBL(33) = 0
          CALL GEN074 (PAR, 101, 103, 1.0)
          PAR(148) = 90.0
        END IF
        IPR(51) = 1
        IF (PAR(104) .EQ. 0.0) PAR(104) = 90.0
        IF (PAR(105) .EQ. 0.0) PAR(105) = 90.0
        IF (PAR(106) .EQ. 0.0) PAR(106) = PAR(148)
        CALL GEN026 (1, OM, PAR(101))
        IF (IPR(127) .GT. 0) THEN
          CALL GEN001 (1, TMX, OM, ROM)
          CALL GEN026 (-1, ROM, PAR(101))
          WRITE (LU6, 99998, IOSTAT = IOST) (PAR(II), II = 101, 106)
        END IF
        CALL GEN066 (0, PAR(101), PAR(107), SPGRNM(1)(12:12))
        CALL GEN044 (PAR(101), OM, 1)
        CALL GEN003 (OM, ROM, DET, 0)
        ARG = 1.0
        DO II = 4, 6
          PAR(115 + II) = PAR(100 + II)
          PAR(103 + II) = SIN(PAR(100 + II) / RGBL(6))
          PAR(100 + II) = COS(PAR(100 + II) / RGBL(6))
          ARG           = ARG - PAR(100 + II)**2
        END DO
        PAR(126) = PAR(101) * PAR(102) * PAR(103) *
     1  SQRT(ARG + 2.0 * PAR(104) * PAR(105) * PAR(106))
        PAR(110) = (PAR(105) * PAR(106) - PAR(104)) /
     1             (PAR(108) * PAR(109))
        PAR(111) = (PAR(104) * PAR(106) - PAR(105)) /
     1             (PAR(107) * PAR(109))
        PAR(112) = (PAR(104) * PAR(105) - PAR(106)) /
     1             (PAR(107) * PAR(108))
        PAR(113) = PAR(126) / (PAR(102) * PAR(103) * PAR(107))
        PAR(114) = PAR(126) / (PAR(101) * PAR(103) * PAR(108))
        PAR(115) = PAR(126) / (PAR(101) * PAR(102) * PAR(109))
        PAR(116) = 2.0 * PAR(110) / (PAR(114) * PAR(115))
        PAR(117) = 2.0 * PAR(111) / (PAR(113) * PAR(115))
        PAR(118) = 2.0 * PAR(112) / (PAR(113) * PAR(114))
        DO I = 7, 9
          PAR(100 + I) = 1.0 / PAR(106 + I)**2
        END DO
        DO I = 1, 3
          PAR(97 + I) = PAR(100 + I)
        END DO
        IF (PAR(101) .EQ. PAR(102) .OR. PAR(101) .EQ. PAR(103))
     1    PAR(98) = PAR(101) + 0.0002
        IF (PAR(102) .EQ. PAR(103)) PAR(99) = PAR(102) + 0.0001
        AXHI = MAX (PAR(98), PAR(99), PAR(100))
        AXLO = MIN (PAR(98), PAR(99), PAR(100))
        DO K = 1, 3
          IF (PAR(97 + K) .EQ. AXHI) THEN
            IPR(120 + K) = 1
          ELSE IF (PAR(97 + K) .EQ. AXLO) THEN
            IPR(120 + K) = 3
          ELSE
            IPR(120 + K) = 2
          END IF
        END DO
      END IF
      RETURN
99998 FORMAT (':: New Cell', 3F8.4, 3F7.2)
99997 FORMAT (':: No CELL card given, Angstrom data assumed')
      END SUBROUTINE PLUT23
      SUBROUTINE PLUT24 (MODE, JATM, MNCODE)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,NP38=150,
     2 NP39=30,NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /GEO/ GEOM(10)
      CHARACTER GEOM*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      IF (MODE .EQ. -3) THEN
        DO I = 1, 10
          CALL GGIP09 (0.0, GEOM(I), 80, 0.3, 0, 2, -PAR(64) + 1.0,
     1             PAR(65) - 1.0 - I * 0.5)
        END DO
      ELSE IF (MODE .EQ. -2) THEN
        DO I = 2, 10
          CALL GEN038 (GEOM(I), 1, 80)
        END DO
      ELSE
        IF (IPR(17) .EQ. 0) THEN
          CALL PLUT05
          IF (IPR(72) .NE. 0) CALL GEN127 ('311')
        END IF
        IF (ABS(MODE) .EQ. IPR(220) - 1) THEN
          CALL PLUT13 (0, 2, IAT, XDUM)
          CALL PLUT25 (1, IAT, IATK)
          IF (IAT .GT. 0) THEN
            IF (ABS(MODE) .EQ. 1) THEN
              NB   = 0
              SANG = 0.0
              ANGM = 0.0
              NMET = 0
              WRITE (GEOM(1), 99999, IOSTAT = IOST)
              DO I = 2, 10
                CALL GGIP09 (0.0, GEOM(I), 80, 0.3, 0, 2, -PAR(64)
     1               + 1.0, PAR(65) - 1.0 - I * 0.5)
                CALL GEN038 (GEOM(I), 1, 80)
              END DO
              NG = 1
              DO JAT = IPR(69) + 1, JATM
                CALL PLUT15 (-1, JAT, 27, JNCL)
                IF (JNCL .EQ. 1 .OR. IPR(163) .EQ. 1
     1               .OR. JAT .GT. IPR(39)) THEN
                  CALL PLUT16 (-5, IDUM, IAT, JAT, DUMMY, IDUM1)
                  IF (IDUM .GT. 0) THEN
                    NB = NB + 1
                    CALL PLUT22 (IAT, JAT, D)
                    IF (NB .EQ. 1) D1 = D
                    IF (NB .EQ. 2) THEN
                      D2 = D
                      IF (D2 .LT. D1) CALL GEN018 (D1, D2)
                    END IF
                    CALL PLUT25 (2, JAT, JATK)
                    CALL PLUT15 (-1, JAT, 17, MET)
                    NMET = NMET + MET
                    CALL PLUT15 (-6, JAT, 11, MADDR)
                    XMOL = MOL(1, MADDR + 1) / PAR(42)
                    NA   = 0
                    IF (NB .GT. 1) THEN
                      MJAT = MIN (JAT - 1, IPR(38))
                      DO KAT = IPR(69) + 1, MJAT
                        CALL PLUT15 (-1, KAT, 27, KNCL)
                        IF (KNCL .EQ. 1 .OR. IPR(163) .EQ. 1
     1                      .OR. KAT .GT. IPR(39)) THEN
                          CALL PLUT16 (-5, IDUM, IAT, KAT, DUMMY, IDUM1)
                          IF (IDUM .GT. 0) THEN
                            CALL PLUT37 (KAT, IAT, JAT, 0, ANG)
                            ANGM = MAX (ANGM, ANG)
                            IF (NA .LT. 12) THEN
                              NA      = NA + 1
                              XXX(NA) = ANG
                              SANG    = SANG + ANG
                            END IF
                          END IF
                        END IF
                      END DO
                    END IF
                    IF (NG .LT. 10) THEN
                      NG = NG + 1
                      CALL GEN020 (-1, NQ1, 2, 2)
                      CALL GEN020 (-1, NQ2, 2, 2)
                      WRITE (GEOM(NG), 99998, IOSTAT = IOST)
     1                  NQ1, NQ2, XMOL, D, (XXX(I), I = 1, NA)
                    END IF
                  END IF
                END IF
              END DO
              DO I = 1, NG
                CALL GGIP09 (0.0, GEOM(I), 80, 0.3, 5 + IGBL(68), 2,
     1               - PAR(64) + 1.0, PAR(65) - 1.0 - I * 0.5)
              END DO
C * HFIX (MODE = -1)
              IF (MODE .EQ. -1) THEN
                IF (NB .EQ. 0) THEN
                  MNCODE = -1
                ELSE
                  IATK   = IATNR(IEN(IATK))
                  JATK   = IATNR(IEN(JATK))
                  MNCODE = 0
                  IF (IATK .EQ. 5) THEN
                    IF (NB .EQ. 4) THEN
                      IF (ANGM .LT. 130) THEN
                        MNCODE = -1
                      ELSE
                        MNCODE = 153
                      END IF
                    ELSE IF (NB .EQ. 5) THEN
                      MNCODE = 153
                    END IF
                  ELSE IF (IATK .EQ. 6) THEN
                    IF (NB .EQ. 4) THEN
                      MNCODE = -1
                    ELSE IF (NB .EQ. 3) THEN
                      IF (SANG .LT. 340.0) THEN
                        IF (NMET .EQ. 1) THEN
                          MNCODE = 43
                        ELSE
                          MNCODE = 13
                        END IF
                      ELSE IF (SANG .GT. 350) THEN
                        MNCODE = -1
                      END IF
                    ELSE IF (NB .EQ. 2) THEN
                      IF (SANG .LT. 115) THEN
                        IF (D1 .GT. 1.45) THEN
                          MNCODE = 23
                        ELSE
                          MNCODE = 43
                        END IF
                      ELSE IF (SANG .GT. 150.0) THEN
                        MNCODE = -1
                      ELSE
                        IF (D1 .GT. 1.45 .AND. D2 .GT. 2.0) THEN
                          MNCODE = 23
                        ELSE
                          MNCODE = 43
                        END IF
                      END IF
                    ELSE IF (NB .EQ. 1) THEN
                      IF (D .GT. 1.4) THEN
                        MNCODE = 137
                      ELSE IF (D .GT. 1.25) THEN
                        MNCODE = 93
                      ELSE
                        MNCODE = 163
                      END IF
                    END IF
                  ELSE IF (IATK .EQ. 7) THEN
                    IF (NB .EQ. 1) THEN
                      IF (D .GT. 1.35) MNCODE = 93
                    END IF
                  ELSE IF (IATK .EQ. 8) THEN
                    IF (NB .EQ. 1) THEN
                      IF (JATK .EQ. 15 .OR. JATK .EQ. 16) THEN
                        IF (D .GT. 1.5)  MNCODE = 83
                      ELSE
                        IF (D .GT. 1.27) MNCODE = 83
                      END IF
                    ELSE
                      MNCODE = -1
                    END IF
                  ELSE
                    MNCODE = -1
                  END IF
                END IF
              END IF
            ELSE
              CALL PLUT13 (0, 3, JAT, XDUM)
              IF (JAT .GT. 0) THEN
                IF (MODE .EQ. 2) THEN
                  IF (IPR(221) .EQ. 1) THEN
                    XNM = FN(1)
                    IF (XNM .LT. 0.0) THEN
                      M = - NINT(XNM)
                      XNM = NINT(RA(IPR(159) + 1  - M))
                    END IF
                    CALL PLUT28 (IAT, JAT, XNM)
                    CALL PLUT15 (4, JAT, 37, 1)
                  END IF
                  CALL PLUT22 (IAT, JAT, D)
                  WRITE (SBCD, 99997, IOSTAT = IOST)
     1              (IFL(I), I = 1, 3), D, CHAR(0)
                  IF (IGBL(32) .EQ. 0)
     1              WRITE (LU6, 99994, IOSTAT = IOST) SBCD
                ELSE
                  CALL PLUT13 (0, 4, KAT, XDUM)
                  IF (KAT .GT. 0) THEN
                    IF (MODE .EQ. 3) THEN
                      CALL PLUT37 (IAT, JAT, KAT, 0, ANGLE)
                      WRITE (SBCD, 99996, IOSTAT = IOST)
     1                  (IFL(I), I = 1, 4), ANGLE, CHAR(0)
                      IF (IGBL(32) .EQ. 0)
     1                  WRITE (LU6, 99994, IOSTAT = IOST) SBCD
                    ELSE
                      CALL PLUT13 (0, 5, LAT, XDUM)
                      IF (LAT .GT. 0) THEN
                        IF (MODE .EQ. 4) THEN
                          CALL PLUT37 (IAT, JAT, KAT, LAT, OMEGA)
                          WRITE (SBCD, 99995, IOSTAT = IOST)
     1                      (IFL(I), I = 1, 5), OMEGA * IPR(65), CHAR(0)
                          IF (IGBL(32) .EQ. 0)
     1                      WRITE (LU6, 99994, IOSTAT = IOST) SBCD
                        END IF
                      ELSE
                        IPR(72) = 42
                      END IF
                    END IF
                  ELSE
                    IPR(72) = 43
                  END IF
                END IF
              ELSE
                IPR(72) = 44
              END IF
            END IF
          ELSE
            IPR(72) = 45
          END IF
        ELSE
          IPR(72) = 46
        END IF
        IPR(163) = 0
      END IF
      RETURN
99999 FORMAT ('Geom/Coord', 8X, '[   ARU   ]    Dist Angle(s)')
99998 FORMAT (A, ' - ', A, ' [', F9.2, '] =', F6.3, 8F5.0)
99997 FORMAT (3(A, 1X), ' =', F8.3, A)
99996 FORMAT (4(A, 1X), ' =', F8.2, A)
99995 FORMAT (5(A, 1X), ' =', F8.2, A)
99994 FORMAT (A)
      END SUBROUTINE PLUT24
      SUBROUTINE PLUT25 (MD, IAT, IATK)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP38=150,
     2 NP39=30,NP43=12,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      DIMENSION NUM(4)
      CHARACTER NQ*7
      IF (MD .GE. 0) THEN
        MODE = MD
        NPAR = IPR(71)
      ELSE
        MODE = - MD
        NPAR = 0
      END IF
      NAT = IABS(IAT)
      IF (NAT .GT. IPR(37)) THEN
        N = MOD(NAT - IPR(69) - 1, IPR(37) - IPR(69)) + IPR(69) + 1
      ELSE
        N = NAT
      END IF
      INQNR = NINT(RA(N * NP43 + 7))
      CALL PLUT15 (-6, N, 11, JX3)
      IF (IPR(75) .GT. 0) THEN
        JX3 = JX3 - IPR(75) + 1
      ELSE
        JX3 = 0
      END IF
      IF (MODE .NE. 0) THEN
        KK = 1
        IF (INQNR .GE. 0.0) THEN
          JX1 = INQNR / 64000
          JX2 = INQNR - JX1 * 64000
          NSS = MOD(JX2, 32)
          JX2 = JX2 / 32
          JX0 = JX1 + 1
          JX1 = IEL(IEN(JX0))
          J1  = JX1 / 100
          J2  = JX1 - J1 * 100
          IF (IAT .GT. 0 .OR. JX0 .GT. 2) THEN
            NQ(KK:KK) = CHAR(ICHAR('A') - 1 + J1)
            KK = KK + 1
            IF (J2 .NE. 0) THEN
              NQ(KK:KK) = CHAR(ICHAR('a') - 1 + J2)
              KK = KK + 1
            END IF
          END IF
          IF (JX2 .EQ. 0) NPAR = 0
          IF (NPAR .NE. 0) THEN
            NQ(KK : KK) = '('
            KK = KK + 1
          END IF
          J2 = JX2 / 10
          NUM(4) = MOD(JX2, 10)
          J3     = J2 / 10
          NUM(3) = MOD(J2, 10)
          NUM(1) = J3 / 10
          NUM(2) = MOD(J3, 10)
          J2     = 0
          DO J = 1, 4
            IF (NUM(J) .GT. 0 .OR. J2 .GT. 0) THEN
              NQ(KK : KK) = CHAR(ICHAR('0') + NUM(J))
              KK = KK + 1
              J2 = J2 + 1
            END IF
          END DO
          IF (NSS .NE. 0) THEN
            IF (NSS .EQ. 1) THEN
              NQ(KK : KK) = ''''
            ELSE IF (NSS .EQ. 2) THEN
              NQ(KK : KK) = '"'
            ELSE IF (NSS .EQ. 3) THEN
              NQ(KK : KK) = '#'
            ELSE IF (NSS .GT. 3) THEN
              NQ(KK : KK) = CHAR(ICHAR('A') + NSS - 4)
            END IF
            KK = KK + 1
          END IF
          IF (NPAR .NE. 0) THEN
            NQ(KK : KK) = ')'
            KK = KK + 1
          END IF
          IF (JX3 .GT. 0) THEN
            IF (NPAR .EQ. 0) THEN
              NQ(KK : KK) = '_'
              KK = KK + 1
            END IF
            IF (JX3 .LT. 27) THEN
              NQ(KK : KK) = CHAR(ICHAR('a') - 1 + JX3)
            ELSE IF (JX3 .EQ. 27 .OR. JX3 .GT. 53) THEN
              NQ(KK : KK) = '*'
            ELSE
              NQ(KK : KK) = CHAR(ICHAR('a') + JX3 - 28)
            END IF
            KK = KK + 1
          END IF
        END IF
        IF (KK .LT. 8) THEN
          CALL GEN038 (NQ, KK, 7)
        END IF
        MSUBST = 0
        IF (IGBL(55) .EQ. 0) THEN
          MSUBST = 0
          CALL PLA281 (-1, NQ, MSUBST)
        END IF
        IF (MODE .NE. 2) THEN
          NQ1 = NQ
        ELSE
          NQ2 = NQ
        END IF
      END IF
      IATK = INQNR / 64000 + 1
      RETURN
      END SUBROUTINE PLUT25
      SUBROUTINE PLUT26 (M, NATL, XI, YI, ZI, RI, XL, YL, ZL, RL, XSH)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      XL = XI
      YL = YI
      IF (IPR(116) .NE. 0) THEN
        ZL = ZI
      ELSE
        IF (PAR(48) .NE. 0.0) THEN
          ZL = ZI
        ELSE
          ZL = ZI + PAR(60)
        END IF
      END IF
      RL = MAX (PAR(28), PAR(40))
      IF (M .LT. 10) THEN
        ANG = RGBL(5) * (M - 2) / 8
        CA  = COS(ANG)
        SA  = SIN(ANG)
        RIX = RI + XSH
        XL  = XL + RIX * CA
        YL  = YL + RIX * SA
        IF (ABS(CA) .GT. 0.1) XL = XL + PAR(40) * CA / ABS(CA)
        IF (ABS(SA) .GT. 0.1) YL = YL + PAR(28) * SA / ABS(SA)
      END IF
      NPROP = 0
      IASU  = 0
      CALL PLUT14 (1, NATL, IASU, NPROP, XL, YL, ZL, RL)
      RETURN
      END SUBROUTINE PLUT26
      SUBROUTINE PLUT27 (IAJAT, IAT, JAT, RBO, NLI)
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30,NP43=12)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      IF (IPR(4) .GT. 0) THEN
        IF (IAT .GT. IPR(69)) THEN
          CALL PLUT15 (-6, IAT, 5,  NRESI)
          CALL PLUT15 (-6, JAT, 5,  NRESJ)
          ITYPE = INT(RA(IAT * NP43 + 7) / 64000)
          JTYPE = INT(RA(JAT * NP43 + 7) / 64000)
          CALL PLUT15 (-1, IAT, 44, IHAT)
          CALL PLUT15 (-1, JAT, 44, JHAT)
          IF (IHAT .EQ. 1) ITYPE = 0
          IF (JHAT .EQ. 1) JTYPE = 0
          L     = -1
          NSPEC = IPR(41)
          NRF   = IPR(80) + 1
          DO K = 1, NSPEC
            NRF = NRF - 3
            N1  = NINT(RA(NRF + 2))
            N2  = NINT(RA(NRF + 1))
            N3  = NINT(RA(NRF    ))
            IF (N1 .LT. 0) THEN
              IF (IAJAT .GT. IPR(53)) L = N3
              IF (NRESI .NE. NRESJ)   L = N3
            ELSE IF (N1 .EQ. 0) THEN
              IF (N2 .LT. 0) THEN
                IAIO = - ITYPE - 1
                IAJO = - JTYPE - 1
              ELSE
                IAIO = IAT
                IAJO = JAT
              END IF
              IF (IAIO .EQ. N2 .OR. IAJO .EQ. N2) THEN
                IF (L .EQ. -1) THEN
                  L = N3
                END IF
              END IF
            ELSE
              IF (N1 .EQ. IAT .AND. N2 .EQ. JAT) THEN
                L = N3
              ELSE IF (N1 .EQ. JAT .AND. N2 .EQ. IAT) THEN
                L = N3
              END IF
            END IF
          END DO
          IF (L .NE. -1) THEN
            RBO = 0.001 * FLOAT(MOD(IABS(L), 1000))
            NLI = ISIGN (IABS(L) / 1000, L)
          ELSE
            RBO = PAR(38)
            NLI = IPR(12)
          END IF
          CALL PLUT15 (-4, IAT, 28, IDIS)
          CALL PLUT15 (-4, JAT, 28, JDIS)
          IDIS = IPPR(IDIS + 1, 1)
          JDIS = IPPR(JDIS + 1, 1)
          IF (IDIS .LT. 500 .OR. JDIS .LT. 500) NLI = - IABS(NLI)
        ELSE
          RBO = PAR(75)
          NLI = IPR(107)
        END IF
      ELSE
        NLI = 1
        RBO = 0.0
      END IF
      RETURN
      END SUBROUTINE PLUT27
      SUBROUTINE PLUT28 (IAT, JAT, XML)
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP14=64,
     1 NP17=99,NP49=2000000,NP22=287,NP48=1000,NP32=63,NP38=150,
     2 NP39=30,NP43=12,NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      IF (NINT(XML) .NE. 0) THEN
        CALL PLUT17 (XML, -1, MADDR, LU6)
        MPM = NINT (XML * PAR(42))
        CALL GEN098 (MPM, PAR(42), NS, ITX, ITY, ITZ, NR)
        XJX(4) = ITX
        XJX(5) = ITY
        XJX(6) = ITZ
        DO I = 1, 3
          XJX(I) = RA(JAT * NP43 + I)
        END DO
        CALL SGSM (ICL, NS, XJX, LU6, 3, IERR)
        DO 10 KAT = IPR(69) + 1, IPR(37)
          DO J = 1, 3
            IF (ABS(RA(KAT * NP43 + J) - XJX(6 + J)) *
     1          PAR(100 + J) .GE. PAR(22)) GO TO 10
          END DO
          JAT = KAT
          RETURN
   10   CONTINUE
        IPR(37) = IPR(37) + 1
        IPR(38) = IPR(38) + 1
        KAT     = JAT
        JAT     = IPR(37)
        DO I = 1, 3
          RA(JAT * NP43 + I) = XJX(6 + I)
        END DO
        CALL PLUT23 (JAT)
        DO I = 8, 10
          RA(JAT * NP43 + I)  = RA(KAT * NP43 + I)
        END DO
        IF (IAT .GT. 0) THEN
          CALL PLUT15 (-6, IAT,  5, IVAL)
          CALL PLUT15 ( 6, JAT,  5, IVAL)
        END IF
        IVAL = 0
        CALL PLUT15 ( 1, JAT, 27, IVAL)
        RA(JAT * NP43 + 7) = RA(KAT * NP43 + 7)
        CALL PLUT15 (6, JAT, 11, MADDR)
        CALL PLUT25 (1, JAT, JDUM)
        WRITE (LU6, 99999, IOSTAT = IOST) NQ1
        XM2 = RA(KAT * NP43 + 12) * 1000.0
        CALL PLA270 (XML, XM2, XM3)
        IF (IPR(2) .NE. 0) CALL GEN127 ('101')
        RA(JAT * NP43 + 12) = XM3 / 1000.0
        RA(JAT * NP43 + 11) = RA(IAT * NP43 + 11)
      END IF
      RETURN
99999 FORMAT (':: ', A, ' added to coordinate list.')
      END SUBROUTINE PLUT28
      SUBROUTINE PLUT29 (MODE, LINE, NQ, NRFIX, LU)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP49=2000000,NP48=1000,
     1 NP38=150,NP39=30)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLU99A/ SFC(16)
      COMMON /PLU99B/ NUNIT(16), NSF, NFHAT
      CHARACTER LINE*(*), LIN*80, NQ*(*), SFC*2, LTYPE*2, CRDT*4, SLT*2,
     1 KEY*4, RESD*4
      LENM = MIN (80, LEN(LINE))
      IF (MODE .EQ. 1) THEN
        IF (IPR(201) .GT. IPR(80) + 80) THEN
          LIN = LINE(1:LENM)
          CALL GEN020 (1, LIN, 1, 4)
          NBLK = -1
          DO I = 1, 80
            IPR(201)     = IPR(201) - 1
            RA(IPR(201)) = ICHAR(LIN(I:I))
            IF (LIN(I:I) .NE. ' ') NBLK = 0
          END DO
          IPR(201)     = IPR(201) - 1
          RA(IPR(201)) = 0
          IPR(201)     = IPR(201) - 1
          RA(IPR(201)) = NBLK
          IPR(201)     = IPR(201) - 1
          RA(IPR(201)) = 0
          IF (LIN(1:1) .EQ. 'Q') IGBL(26) = IGBL(26) + IPR(176)
        END IF
C * RENAME - MODE
      ELSE IF (MODE .EQ. 2) THEN
        CALL GEN020 (1, LINE, 2, 2)
        CALL GEN020 (1, NQ, 1, 4)
        I = IPR(200)
   10   IF (I - 83 .GE. IPR(201)) THEN
          WRITE (KEY, 99994, IOSTAT = IOST)
     1      (CHAR(NINT(RA(I - J))), J = 1, 4)
          IF (KEY .EQ. 'SADI') THEN
            DO K = 1, 4
              RA(I - K) = 32.0
            END DO
          END IF
          IF (KEY .NE. LINE(1:4)) THEN
            I = I - 83
            GO TO 10
          END IF
          IGBL(26) = IGBL(26) + 1
          DO J = 1, 4
            RA(I - J) = ICHAR(NQ(J:J))
          END DO
          RA(I - 82) = 0
          CALL GEN020 (1, NQ, 1, 2)
          LTYPE = NQ(1:1)//' '
          DO J =  ICHAR('A'), ICHAR('Z')
            IF (NQ(2:2) .EQ. CHAR(J)) THEN
              LTYPE = NQ(1:2)
              EXIT
            END IF
          END DO
          DO K = 1, NSF
            SLT = SFC(K)
            CALL GEN020 (1, SLT, 1, 2)
            IF (LTYPE .EQ. SLT) GO TO 20
          END DO
          NSF      = NSF + 1
          K        = NSF
          SFC(K)   = LTYPE
          NUNIT(K) = 1
C * REPLACE SCATTERING TYPE
   20     ISF1 = K / 10
          ISF2 = MOD(K, 10)
          DO J = 6, 20
            L = J
            IF (RA(I - J) .NE. ICHAR(' ')) THEN
              IF (RA(I - J - 1) .NE. ICHAR(' ')) THEN
                RA(I - J) = ICHAR(' ')
                L = L + 1
              END IF
              RA(I - L) = ICHAR('0') + ISF2
              IF (ISF1 .NE. 0) RA(I - L + 1) = ICHAR('1')
              GO TO 30
            END IF
          END DO
          GO TO 30
        END IF
C * HFIX MODE
      ELSE IF (MODE .EQ. 3) THEN
        NRES = 0
        I    = IPR(200)
        DO WHILE (I - 83 .GE. IPR(201))
          I = I - 83
          WRITE (KEY, 99994, IOSTAT = IOST)
     1      (CHAR(NINT(RA(I + 83 - J))), J = 1, 4)
          IF (KEY .EQ. 'RESI') THEN
            WRITE (RESD, 99994, IOSTAT = IOST)
     1        (CHAR(NINT(RA(I + 83 - J))), J = 5, 8)
            READ (RESD, *) NRES
            CYCLE
          END IF
          IF (NRES .NE. 0) THEN
            N = INDEX (LINE, '_')
            IF (N .GT. 0) THEN
              READ (LINE(N +1:), *) LRES
              IF (LRES .NE. NRES) CYCLE
              LINE(N:) = ' '
            END IF
          END IF
          IF (KEY .EQ. LINE(1:4)) THEN
            IGBL(26)     = IGBL(26) + 1
            RA(I + 2)   = NRFIX
            IF (NFHAT .EQ. 0) THEN
              NSF        = NSF + 1
              SFC(NSF)   = 'H '
              NUNIT(NSF) = 1
              NFHAT      = 1
            END IF
          END IF
        END DO
C * DELETE ATOMS
      ELSE IF (MODE .EQ. 4) THEN
        CALL GEN020 (1, LINE, 1, 7)
        I = IPR(200)
        DO WHILE (I - 83 .GE. IPR(201))
          I = I - 83
          WRITE (KEY, 99994, IOSTAT = IOST)
     1      (CHAR(NINT(RA(I + 83 - J))), J = 1, 4)
          IF (KEY .EQ. LINE(1:4)) THEN
            IGBL(26)  = IGBL(26) + 1
            RA(I + 1) = -1
C * HANDLE EXTENSIONS (INDICATED BY '=')
            DO J = 1, 80
              IF (RA(I + 83 - J) .EQ. ICHAR('=')) THEN
                I         = I - 83
                RA(I + 1) = -1
                EXIT
              END IF
            END DO
          END IF
        END DO
C * ANIS - MODE
      ELSE IF (MODE .EQ. 5) THEN
        I = IPR(200)
        DO WHILE (I - 83 .GE. IPR(201))
          I = I - 83
          WRITE (KEY, 99994, IOSTAT = IOST)
     1      (CHAR(NINT(RA(I + 83 - J))), J = 1, 4)
          IF (KEY .EQ. LINE(1:4)) THEN
            IGBL(26) = IGBL(26) + 1
            RA(I)    = 1
          END IF
        END DO
      ELSE IF (MODE .EQ. -1) THEN
        IDEL = 0
        NR0  = -1
        I    = IPR(200)
        DO WHILE (I - 83 .GE. IPR(201))
          I = I - 83
          DO J = 1, 80
            LIN(J:J) = CHAR(NINT(RA(I + 83 - J)))
          END DO
          CRDT = LIN(1:4)
          IF (CRDT .EQ. 'SFAC') THEN
            IF (IDEL .EQ. 0)
     1        WRITE (LU, 99999, IOSTAT = IOST) (SFC(K), K = 1, NSF)
            IDEL = 1
          ELSE IF (CRDT .EQ. 'UNIT') THEN
            WRITE (LU, 99998, IOSTAT = IOST) (NUNIT(K), K = 1, NSF)
            IDEL = 0
          ELSE IF (CRDT .EQ. 'AFIX') THEN
            READ (LIN(5:80), *) NR0
          ELSE IF (CRDT .EQ. 'HKLF') THEN
            NR0 = 0
            WRITE (LU, 99996, IOSTAT = IOST) NR0
            WRITE (LU, 99993, IOSTAT = IOST) LIN
            NR0 = -1
          ELSE
            IF (NINT(RA(I + 1)) .NE. 0) CYCLE
            IF (IPR(176) .EQ. 1 .AND. LIN(1:1) .EQ. 'Q') CYCLE
            IF (IDEL .EQ. 0) THEN
              NR = NINT(RA(I))
              IF (NR .NE. 0) THEN
                CALL PLA280 (LIN)
                CALL PLA006 (1, IS)
                WRITE (LIN (6:), 99995, IOSTAT = IOST) NINT(FN(1)),
     1            (FN(K), K = 2, 6), FN(6), FN(6), 0.0, 0.0, 0.0
              END IF
              NR = NINT(RA(I + 2))
              IF (NR .NE. 0)
     1          WRITE (LU, 99997, IOSTAT = IOST) NR, LIN(1:4)
              IF (NR0 .GE. 0) THEN
                WRITE (LU, 99996, IOSTAT = IOST) NR0
                NR0 = -1
              END IF
              WRITE (LU, 99993, IOSTAT = IOST) LIN
            ELSE IF (IDEL .LT. 0) THEN
              IDEL = 0
            END IF
          END IF
        END DO
      ELSE IF (MODE .EQ. 0 .AND. LINE(1:3) .NE. 'END') THEN
        IPR(200) = NP49 - 6
        IPR(201) = IPR(200)
        IGBL(26) = 0
        NSF      = 0
      END IF
   30 IF (IABS(IGBL(8)) .EQ. 2 .AND. IPR(80) .GT. IPR(201)) THEN
        CALL GEN127 ('PLUT29')
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('SFAC', 16(2X, A))
99998 FORMAT ('UNIT', 2I5, 14I4)
99997 FORMAT ('HFIX', I5, 2X, A)
99996 FORMAT ('AFIX', I5)
99995 FORMAT (I3, 7F8.4, 3F4.1)
99994 FORMAT (4A)
99993 FORMAT (A)
      END SUBROUTINE PLUT29
      SUBROUTINE PLUT30 (ITS, ITF)
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP32=63,NP38=150,
     1 NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      IF (IPR(114) .GT. 0) THEN
        ITFF = MIN (ITF, IPR(114))
      ELSE
        ITFF = ITF
      END IF
      IF (ITS .LT. ITFF) THEN
        DTH1     = PAR(57) + ITS  * PAR(55)
        DTH2     = PAR(57) + ITFF * PAR(55)
        N        = MAX (1, NINT((DTH2 - DTH1) / PAR(56)))
        DTHS     = (DTH2 - DTH1) / N
        IPR(129) = IPR(129) + N
        XO       = PAR(71)
        YO       = PAR(72)
        ZO       = PAR(73)
        RO       = PAR(74)
        IUP      = 1
   10   ROC      = RO * COS(DTH1)
        ROS      = RO * SIN(DTH1)
        XP       = XO + ROC * ZU(1) + ROS * ZU(4)
        YP       = YO + ROC * ZU(2) + ROS * ZU(5)
        ZP       = ZO + ROC * ZU(3) + ROS * ZU(6)
        CALL GGIP (XP, YP, ZP, 2 + IUP)
        IUP      = 0
        DTH1     = DTH1 + DTHS
        IF (N .GT. 0) THEN
          N = N - 1
          GO TO 10
        END IF
      END IF
      RETURN
      END SUBROUTINE PLUT30
      SUBROUTINE PLUT31 (K, COLR)
      PARAMETER (NP0=6, NP49=2000000, NP48=1000)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      DSH = 0.15
      K0  = K + NP0
      X   = RA(K0 - 3)
      Y   = RA(K0 - 2)
      Z   = RA(K0 - 1)
      COL = COLR
      IF (COL .GE. 0.0) CALL GGIP (0.0, COL, 0.0, 0)
      CALL GGIP (X,       Y + DSH, Z, 3)
      CALL GGIP (X + DSH, Y,       Z, 2)
      CALL GGIP (X,       Y - DSH, Z, 2)
      CALL GGIP (X - DSH, Y,       Z, 2)
      CALL GGIP (X,       Y + DSH, Z, 2)
      RETURN
      END SUBROUTINE PLUT31
      SUBROUTINE PLUT32
      PARAMETER (NP4=9,NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP49=2000000,NP22=287,NP48=1000,NP38=150,NP39=30,
     2 NP43=12,NP45=2048,NP52=200,NP56=30,NP57=35)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      COMMON /XCH/ LINE, IDM, JID, NAMS, NQ1, NQ2, NQ3, NQ4,
     1 TKST(250), KRAD, JTP(8), LMT(NP10, 2), DATANM, CCIF, RLWS(5),
     2 DISPTYPE(NP10), CHSG, ISWS, PRBUF, SPGRNM, ZSPG, LAUEGR,
     3 KRSYST(3), DTYPE, ELB, UPDATE
       CHARACTER ELB(NP9)*2, NAMS(NP4, 4)*8, NQ1*7, NQ2*7, NQ3*7, NQ4*7,
     1 ICL*(NP45), IDM*80, JTP*2, LMT*2, LINE*80,  ISWS(NP22)*4,
     2 TKST*10, JID*80, DATANM*32, PRBUF*132, IFL*7, DTYPE(5)*5,
     3 KRSYST*12, LAUEGR*5, KRAD*4, CCIF(NP56)*(NP57), RLWS*(NP52),
     4 UPDATE*12, DISPTYPE*2, CHSG*6, ZSPG*7, SPGRNM(4)*26
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /NKEYS/ NCNT
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER RIFL2*10, RIFL3*10
      KL        = IPR(220)
      IGBL(105) = 1
      IF (KL .GT. 1) THEN
        MSUBST = 0
        CALL PLA281 (1, IFL(2), MSUBST)
      END IF
      IF (KL .GT. 2) THEN
        DO I = 3, KL, 2
          CALL PLUT13 (0, I - 1, IAT, XDUM)
          IF (IAT .GT. 0) THEN
            CALL PLA046 (8, IFL(I - 1), NEI, NA, NAX, NS,
     1                   IXPK1, IXPK2, NIEN)
   10       CALL PLUT13 (1, I, JAT, XDUM)
            CALL PLA046 (9, IFL(I), NEE, NQX, NSS, NQSM,
     1                       INQNR, JNQNR, NIEN)
            IF (JAT .LE. 0) THEN
              IF (IFL(I)(1:3) .EQ. 'REN') THEN
                WRITE (LU6, 99997, IOSTAT = IOST) IFL(I)
                RETURN
              ELSE
                IF (NEE .NE. NEI) IPR(170) = 2
                YUNK = RA (IAT * NP43 + 7)
                DO J = 1, IPR(37)
                  IF (RA(J * NP43 + 7) .EQ. YUNK)
     1                RA(J * NP43 + 7) = INQNR
                END DO
                IF (RADR(NEE, 3) .LT. 0.001) RADR(NEE, 3) =
     1              REL(IEN(NEE))
                WRITE (LU22, 99996, IOSTAT = IOST) IFL(I - 1), IFL(I)
                IF (IABS(IGBL(8)) .EQ. 2)
     1            CALL PLUT29 (2, IFL(I - 1), IFL(I), 0, 0)
                CALL PLUT15 (1, IAT, 47, 1)
              END IF
            ELSE
              IER = 0
              CALL PLUT41 (JAT, NEE, IER)
              IF (IER .EQ. 0) GO TO 10
              RETURN
            END IF
          ELSE
            WRITE (LU6, 99998, IOSTAT = IOST) IFL(I)
            RETURN
          END IF
        END DO
      ELSE IF (KL .LE. 2) THEN
        CALL PLUT24 (-2, IPR(38), IDUM)
        NCNT = 0
        IAT1 = 0
        IF (KL .EQ. 2) CALL PLUT13 (0, 2, IAT1, XDUM)
        IF (IAT1 .GT. 0) THEN
          IBEG = IAT1
          IEND = IAT1
        ELSE
          IBEG = IPR(69) + 1
          IEND = IPR(39)
        END IF
        DO 50 I = IBEG, IEND
          CALL PLUT15 (-4, I, 37, M)
          IF (M .GT. 1) THEN
            IF (IPR(140) .NE. 0) THEN
              CALL PLUT15 (-6, I, 5, IVAL)
              IF (IVAL .NE. IPR(140)) GO TO 50
            END IF
            IAT = I
            CALL PLUT25 (1, IAT, IATK)
            IF (IAT1 .GE. 0 .OR. -IAT1 .EQ. IATK) THEN
              IFL(2)   = NQ1
              IFL(3)   = NQ1
              CALL PLA046 (8, NQ1, NEI, NA, NAX, NS,
     1                     IXPK1, IXPK2, NIEN)
              NB       = 1
              NE       = 7
              CALL GEN039 (1, IFL(2), 1, 7, NB, NE)
              IPR(220) = 2
              KL       = IPR(220)
              CALL PLUT24 (1, IPR(38), IDUM)
              IFL(3)   = NQ1
              RIFL2    = IFL(2)
              RIFL3    = IFL(3)
   20         IF (IGBL(25) * IGBL(32) .EQ. 1) THEN
                PAR40 = NE * PAR(349) * PAR(19) / 2.0
                NATL  = IPR(62) + I
                CALL PLUT14 (-1, NATL, IASU, NPROP, XL, YL, ZL, RL)
                CALL GGIP09 (0.0, RIFL2, NE, PAR(349), 2, 2,
     1            XL - PAR40, YL - PAR(28))
                SBCD = 'Rename '//RIFL2(1:NE)//' (NewName/Quit['
                SBCD(23 + NE:) = RIFL3(1:NE)//'])'//CHAR(0)
   30           CALL PLA013 (0, 1)
                SELECT CASE (IGGT(1:4))
                  CASE ('REN ', 'RENA')
                    IF (IGGT(8:8) .NE. ' ') GO TO 30
                    IGGT(1:5)   = '     '
                    IFL(3)(1:1) = IFL(2)(1:1)
                  CASE ('!   ')
                    IF (LRET .EQ. 2) THEN
                      CALL PLUT02
                      GO TO 20
                    END IF
                  CASE ('VIEW')
                    CALL PLA006 (1, IS)
                    CALL PLUT06
                    CALL PLUT02
                    GO TO 20
                  CASE ('PLOT')
                    CALL PLUT02
                    GO TO 20
                  CASE ('LAB ', 'LABL')
                    GO TO 20
                  CASE ('ARU ')
                    GO TO 20
                  CASE ('OMI ', 'OMIT')
                    GO TO 20
                  CASE ('HFI ', 'HFIX')
                    GO TO 20
                  CASE ('END ')
                    IFL(3)(1:4) = 'QUIT'
                  CASE ('EXIT')
                    IFL(3)(1:4) = 'QUIT'
                  CASE DEFAULT
                    CALL GEN105 (3, IGGT(1:1), N)
                    IF (N .LT. 0) THEN
                      IFL(3) = IGGT(1:7)
                    ELSE
                      CALL GEN105 (3, IFL(2)(2:2), N)
                      IF (IFL(2)(2:2) .EQ. ' ' .OR. N .GE. 0) THEN
                        IFL(3) = IFL(2)(1:1)//IGGT(1:6)
                      ELSE
                        IFL(3) = IFL(2)(1:2)//IGGT(1:5)
                      END IF
                    END IF
                    CALL GEN038 (IGGT, 1, 80)
                END SELECT
              ELSE
                WRITE (LU6, 99999, IOSTAT = IOST) IFL(2), IFL(2)
                READ  (LU5, 99995) IFL(3)
              END IF
              CALL GEN020 (1, IFL(3), 1, 7)
              IF (IFL(3)(1:4) .EQ. 'QUIT' .OR. IFL(3)(1:3) .EQ. 'END')
     1          THEN
                CALL PLA280 ('PLOT')
                IPR(335) = 1
                CALL PLA015 (335, 1)
                RETURN
              END IF
              CALL GEN020 (-1, IFL(3), 2, 2)
              NEE = NEI
              IF (IFL(3) .NE. IFL(2) .AND. IFL(3)(1:1) .NE. ' ') THEN
   40           CALL PLUT13 (1, 3, JAT, XDUM)
                CALL PLA046 (9, IFL(3), NEE, NQX, NSS, NQSM,
     1                       INQNR, JNQNR, NIEN)
                IF (JAT .LE. 0) THEN
                  IF (NIEN .GE. 0) THEN
                    IF (NEE .NE. NEI) IPR(170) = 2
                    YUNK = RA (IAT * NP43 + 7)
                    DO J = 1, IPR(37)
                      IF (RA(J * NP43 + 7) .EQ. YUNK)
     1                    RA(J * NP43 + 7) = INQNR
                    END DO
                    IF (RADR(NEE, 3) .LT. 0.001)
     1                  RADR(NEE, 3) = REL(IEN(NEE))
                    WRITE (LU22, 99996, IOSTAT = IOST) IFL(2), IFL(3)
                    IF (IABS(IGBL(8)) .EQ. 2)
     1                CALL PLUT29 (2, IFL(2), IFL(3), 0, 0)
                    CALL GGIP09 (0.0, IFL(2), NE, PAR(349), 0, 2,
     1                XL - PAR40, YL - PAR(28))
                    CALL PLUT15 (1, IAT, 47, 1)
                    CALL GEN039 (1, IFL(3), 1, 7, NB, NE)
                    PAR40 = NE * PAR(349) * PAR(19) / 2.0
                  ELSE
                    CALL PLA015 (0, 28)
                    GO TO 20
                  END IF
                ELSE
                  IER = 0
                  CALL PLUT41 (JAT, NEE, IER)
                  IF (IER .NE. 0) GO TO 20
                  GO TO 40
                END IF
              END IF
              IF (NEE .NE. NEI) THEN
                CALL PLUT02
              ELSE
                CALL GEN020 (-1, IFL(3), 2, 2)
                CALL PLUT15 (-1, IAT, 47, IREN)
                ICOL = 1
                IF (IREN .EQ. 1) ICOL = 3
                CALL GGIP09 (0.0, IFL(3), NE, PAR(349), ICOL, 2,
     1                       XL - PAR40, YL - PAR(28))
              END IF
            END IF
          END IF
   50   CONTINUE
        IF (IEND .GT. IBEG) THEN
          IPR(332)  = 1
          CALL PLA015 (335, 1)
          IF (IPR(308) .NE. 0) IGBL(3) = 8
        END IF
      END IF
      RETURN
99999 FORMAT (/, 'Rename ', A, ' (NewName/Quit[', A, '])', $)
99998 FORMAT (':: No Substitution: Unsuitable Old Label: ', A)
99997 FORMAT (':: No Substitution: Unsuitable New Label: ', A)
99996 FORMAT ('RENAME', 2(1X, A))
99995 FORMAT (A)
      END SUBROUTINE PLUT32
      SUBROUTINE PLUT33
      PARAMETER (NP12=700,NP13=550,NP17=99,NP49=2000000,
     1 NP48=1000,NP38=150,NP39=30,NP43=12)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      DIMENSION YANK(NP43)
      IPR(64)   = IPR(80) - IPR(76) * 3
      IPR(100)  = 1
      ID1       = 0
      ID2       = 0
      IF (IPR(50) .EQ. 0)
     1  CALL PLUT16 (-2, IDUM0, ID1, ID2, DUM1, IDUM2)
      IF (IGBL(33) .EQ. 1) THEN
        N0      = IPR(69) + 1
        N       = IPR(37)
        NEL     = N - N0 + 1
        IF (NEL .LE. 1) RETURN
        NN      = INT(ALOG(FLOAT(NEL)) / ALOG(2.0))
        ND      = 2**NN - 1
   10   IF (ND .LE. 0) RETURN
        I       = N0
   20   J       = I
        DO K = 1, NP43
          YANK(K) = RA((I + ND) * NP43 + K)
        END DO
   30   IF (YANK(6) .GE. RA(J * NP43 + 6)) GO TO 40
        DO K = 1, NP43
          RA((J + ND) * NP43 + K) = RA(J * NP43 + K)
        END DO
        J = J - ND
        IF (J .GE. N0) GO TO 30
   40   DO K = 1, NP43
          RA((J + ND) * NP43 + K) = YANK(K)
        END DO
        I = I + 1
        IF (I + ND .LE. N) GO TO 20
        ND = (ND - 1) / 2
        GO TO 10
      END IF
      RETURN
      END SUBROUTINE PLUT33
      SUBROUTINE PLUT35 (XMOL, MODE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP49=2000000,NP48=1000,
     1 NP38=150,NP39=30,NP45=2048)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      DIMENSION XX(12)
      CHARACTER ICL*(NP45)
      IF (ABS(XMOL) .LE. IPR(75) .OR. IGBL(127) .NE. 0) THEN
        CALL PLUT17 (XMOL, MODE, MADDR, LU6)
        RETURN
      END IF
      IF (XMOL .GT. 0) THEN
        MSGN = 1
      ELSE
        MSGN = -1
      END IF
      NMOL = NINT (ABS(XMOL) * PAR(42))
      CALL GEN098 (NMOL, PAR(42), MS1, MT1, MT2, MT3, MR1)
      IF (MR1 .NE. 0) THEN
        NB = MR1
        NE = MR1
      ELSE
        NB = 1
        NE = IPR(75)
      END IF
      DO MR1 = NB, NE
        DO I = 1, IPR(43)
          MPM = MOL(1, I)
          CALL GEN098 (MPM, PAR(42), MS2, ITX, ITY, ITZ, MR2)
          XX(6) = ITX
          XX(7) = ITY
          XX(8) = ITZ
          IF (MR2 .EQ. MR1) THEN
            XX(1) = MS1
            XX(2) = MT1
            XX(3) = MT2
            XX(4) = MT3
            XX(5) = MS2
            CALL SGSM (ICL, 0, XX, LU6, 8, IERR)
            IF (IERR .NE. 0) THEN
              WRITE (LU6, 99999, IOSTAT = IOST) XMOL
              RETURN
            END IF
            MS3  = NINT(XX(9))
            MT13 = NINT(XX(10))
            MT23 = NINT(XX(11))
            MT33 = NINT(XX(12))
            M3   = (MS3 * 1000 + MT13 * 100 + MT23 * 10 + MT33 + 555)
            M3   = NINT(M3 * PAR(42)) + MR1
            XM3  = (M3 / PAR(42)) * MSGN
            CALL PLUT17 (XM3, MODE, MADDR, LU6)
          END IF
        END DO
      END DO
      RETURN
99999 FORMAT ('Multiply Problem with ARU = ', F10.2)
      END SUBROUTINE PLUT35
      SUBROUTINE PLUT36 (MODE, ISHADE)
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP32=63,NP38=150,
     1 NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      DO ISH = 1, ISHADE
        ICOL2 = MOD(IPR(88), 100)
        IF (ICOL2 .GT. 8) ICOL2 = 0
        IANG2 = IPR(88) / 100
        ANG3  = PAR(8) + MOD(IANG2, 100)
        IANG2 = IANG2 / 100
        IHOR  = 1
        IF (ANG3 .NE. 0.0) THEN
          ANG3 = ANG3 / RGBL(6)
          CB   = COS (ANG3)
          SB   = SIN (ANG3)
          IHOR = 0
        ELSE
          CB   = 1.0
          SB   = 0.0
        END IF
        IF (PAR(7) .NE. 0.0) THEN
          CA   = COS (PAR(7) / RGBL(6))
          IHOR = 0
        ELSE
          CA = 1.0
        END IF
        NN    = 1
        DISP  = PAR(6)
        IF (PAR(48) .GT. 0.0)
     1    DISP = DISP * PAR(48) / (PAR(48) - XYZK(3))
        DISP = MAX (DISP, PAR(23))
        IF (IPR(346) .GT. 0) THEN
          CALL GGIP (0.0, FLOAT(ICOL2), 0.0, 0)
        END IF
        R0  = XYZK(4)
        R0K = R0**2
        YS = - R0
   10   RSQ = R0K - YS**2
        IF (RSQ .GT. 0.0001) THEN
          R1 = SQRT(RSQ)
          IF (IHOR .EQ. 1) THEN
            XPL1 =  R1
            XPL2 =  YS
            XPL4 = -R1
            XPL5 =  YS
          ELSE
            XPL1 =   CB * CA * R1 + SB * YS
            XPL2 = - SB * CA * R1 + CB * YS
            XPL4 = - CB * R1 + SB * YS
            XPL5 =   SB * R1 + CB * YS
          END IF
          XYZPL(1) = XPL1 + XYZK(1)
          XYZPL(2) = XPL2 + XYZK(2)
          XYZPL(3) = SQRT(ABS(R0K - XPL1**2 - XPL2**2))
     1             +   XYZK(3)
          XYZPL(4) = XPL4 + XYZK(1)
          XYZPL(5) = XPL5 + XYZK(2)
          XYZPL(6) = XYZK(3)
          CALL PLUT19 (MODE, NN)
          NN = - NN
        END IF
        YS = YS + DISP
        IF (YS .LT. R0)  GO TO 10
        IF (IPR(346) .GT. 0) CALL GGIP (0.0, FLOAT(IPR(19)), 0.0, 0)
        PAR(8) = PAR(8) + 90.0
      END DO
      RETURN
      END SUBROUTINE PLUT36
      SUBROUTINE PLUT37 (IAT, JAT, KAT, LAT, OMEGA)
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30,NP43=12)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      IF (LAT .EQ. 0) THEN
        DAK = 0
        DBK = 0
        DAB = 0
        DO KK = 4, 6
          VA  = RA(IAT * NP43 + KK) - RA(JAT * NP43 + KK)
          VB  = RA(KAT * NP43 + KK) - RA(JAT * NP43 + KK)
          DAK = DAK + VA**2
          DBK = DBK + VB**2
          DAB = DAB + VA*VB
        END DO
        IF (DAK .LE. 0.0 .OR. DBK .LE. 0.0) THEN
          OMEGA = 0.0
        ELSE
          DAB   = MAX (-1.0, MIN (1.0, DAB / SQRT(DAK * DBK)))
          OMEGA = ACOS(DAB) * RGBL(6)
        END IF
      ELSE
        DO N = 1, 3
          ZU(N)     = RA(JAT * NP43 + N + 3) - RA(IAT * NP43 + N + 3)
          ZU(N + 3) = RA(KAT * NP43 + N + 3) - RA(JAT * NP43 + N + 3)
          ZU(N + 6) = RA(LAT * NP43 + N + 3) - RA(KAT * NP43 + N + 3)
        END DO
        CALL GEN008 (ZU(1),  ZU(4),  ZU(10), 1)
        CALL GEN008 (ZU(4),  ZU(7),  ZU(13), 1)
        CALL GEN008 (ZU(10), ZU(13), ZU(1),  1)
        COSW  = MAX (-1.0, MIN (1.0, GEN009 (ZU(10), ZU(13))))
        OMEGA = ACOS(COSW) * RGBL(6)
        IF (GEN009 (ZU(1), ZU(4)) .LT. 0.0) OMEGA = - OMEGA
      END IF
      RETURN
      END SUBROUTINE PLUT37
      SUBROUTINE PLUT38 (NER, NERR, LU)
      SELECT CASE (NER)
        CASE (1)
          WRITE (LU, 99999, IOSTAT = IOST)
        CASE (2)
        CASE (3)
          WRITE (LU, 99997, IOSTAT = IOST)
        CASE (4)
          WRITE (LU, 99996, IOSTAT = IOST)
          WRITE (LU, 99995, IOSTAT = IOST)
        CASE (5)
          WRITE (LU, 99994, IOSTAT = IOST)
        CASE (6)
          WRITE (LU, 99993, IOSTAT = IOST) CHAR(7)
        CASE (7)
          WRITE (LU, 99992, IOSTAT = IOST)
        CASE (8)
        CASE (9)
        CASE (10)
      END SELECT
      IF (NERR .EQ. 1) CALL GEN127 (' FATAL PROBLEM')
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/'>>> PROBLEM TOO LARGE; INCREASE ARRAY SIZE (NP49) <<<')
99997 FORMAT (/'>>> STACK1 OVERFLOW;  INCREASE ARRAY SIZE (NP49) <<<')
99996 FORMAT (/'>>> PROBLEM WITH SHELX-STYLE INPUT <<<')
99995 FORMAT (/'    CHECK FVAR-FREE VARIABLES CONSISTENCY !')
99994 FORMAT (/':: Problem Too Large to fit in scratch array (Ignored)'
     1        )
99993 FORMAT (/':: Parameter outside acceptable range (ignored)', A)
99992 FORMAT (/':: Too Many FVAR - Parameters')
      END SUBROUTINE PLUT38
      SUBROUTINE PLUT39
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30,NP43=12,NP45=2048)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /PLXXX/ DLIM(3), T(3), XJS(3), SEP(3), XYZJS(3)
      CHARACTER N1*1
      MODE     = 0
      IPR(130) = 0
      NSYM     = IPR(48)
      NRES     = IPR(75)
      KL       = IPR(220)
      KN       = IPR(221)
      CALL GEN074 (PAR, 119, 121, -0.01)
      CALL GEN074 (PAR, 122, 124,  0.01)
      RA(IPR(80) + 5) = -1.5
      RA(IPR(80) + 6) =  1.5
      KKK = 0
      IF (KL .GT. 1) THEN
        DO LL = 2, KL
          N1 = IFL(LL)(1:1)
          IF (N1 .EQ. 'R') THEN
            DO KK = 1, 3
              IF (KKK + 2 .LE. KN) THEN
                PAR(118 + KK) = FN(KKK + 1)
                PAR(121 + KK) = FN(KKK + 2)
              END IF
              KKK = KKK + 2
            END DO
            IPR(126) = 1
          ELSE IF (N1 .EQ. 'P') THEN
            IPR(36) = 1
            IF ((KN - 3) .LT. KKK) CYCLE
            DO K = 1, 3
              KKK = KKK + 1
              IPR(31 + K) = NINT(FN(KKK))
            END DO
            IF ((KN - 2) .LT. KKK) CYCLE
            RA(IPR(80) + 5) = FN(KKK + 1)
            RA(IPR(80) + 6) = FN(KKK + 2)
            KKK = KKK + 2
          ELSE IF (N1 .EQ. 'C') THEN
            IPR(31) = 1
            CALL PLUT13 (0, KL, MODE, XDUM)
            IPR(220) = IPR(220) - 1
            KL       = IPR(220)
            IF (MODE .LE. 0) GO TO 50
          END IF
        END DO
      END IF
      IF (IPR(126) .EQ. 0) THEN
        IF (IPR(36) .GT. 0) THEN
          CMIA = 0
        ELSE
          CMIA = 2
        END IF
        CMIN = -2
        CMAX =  3
        DO K = 1, 3
          PAR(118 + K) = CMIN + CMIA
          PAR(121 + K) = CMAX - CMIA
        END DO
      END IF
      CALL PLUT17 (0.0, 3, MADDR, LU6)
      DO NRS = 1, NRES
        DO K = 1, 3
          XJX(K + 3) = 0.0
          IF (MODE .EQ. 0) THEN
            XJX(K) = RCG(K, NRS)
          ELSE
            XJX(K) = RA(MODE * NP43 + K)
          END IF
          XXX(K) = XJX(K)
        END DO
        IF (IPR(36) .GT. 0) THEN
          DHKL = IPR(32) * IPR(32) * PAR(107)
     1         + IPR(33) * IPR(33) * PAR(108)
     2         + IPR(34) * IPR(34) * PAR(109)
     3         + IPR(32) * IPR(33) * PAR(118)
     4         + IPR(32) * IPR(34) * PAR(117)
     5         + IPR(33) * IPR(34) * PAR(116)
          DHKL = SQRT(DHKL)
          RA(IPR(80) + 4) = 0.0
          DO K = 1, 3
            RA(IPR(80) + K) = FLOAT(IPR(K + 31)) / DHKL
            RA(IPR(80) + 4) = RA(IPR(80) + 4) +
     1                        RA(IPR(80) + K) * XXX(K)
          END DO
        END IF
        DO N = 1, NSYM
          CALL SGSM (ICL, N, XJX, LU6, 3, IERR)
          DO K = 1, 3
            T(K)     = 0.0
            XYZOR(K) = XJX(K + 6)
          END DO
          K = 1
   10     IF (XYZOR(K) .LT. PAR(K + 118))  GO TO 20
          XYZOR(K) = XYZOR(K) - 1.0
          T(K) = T(K) - 1.0
          GO TO 10
   20     XYZOR(K) = XYZOR(K) + 1.0
          T(K)     = T(K) + 1.0
          IF (XYZOR(K) .GT. PAR(K + 121))  GO TO 40
          K = K + 1
          IF (K .LE. 3)  GO TO 10
          DO KK = 1, 3
            ITKK = NINT(T(KK))
            IF (ITKK .GT. 4 .OR. ITKK .LT. -5) GO TO 30
          END DO
          MML = N * 1000 + NINT(T(1)) * 100 + NINT(T(2)) * 10
     1        + NINT(T(3)) + 555
          XML = MML + NRS / PAR(42)
          CALL PLUT35 (XML, 0)
   30     K = K - 1
          GO TO 20
   40     K = K - 1
          IF (K .GT. 0)  GO TO 20
        END DO
      END DO
   50 IPR(36) = 0
      RETURN
      END SUBROUTINE PLUT39
      SUBROUTINE PLUT40 (I, J, N, ISW)
      PARAMETER (NP12=700,NP13=550,NP14=64,NP17=99,NP49=2000000,
     1 NP48=1000,NP32=63,NP38=150,NP39=30,NP43=12,NP45=2048)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTO/ IPPR(129, 3), IBT(32), TRL(3), ROM(3, 3), R(3, 3),
     1 RP(NP14), XJX(12), XXX(12), YYY(12), TMX(3, 3), SHFT(3),
     2 XYZOR(3), XYZR(3),  ZU(15), OM(3, 3), RCG(4, NP32), TMY(3, 3),
     3 XYZPL(6), A(3, 3), XYZK(8), KRS(NP32), NCRS(9), NPRS(17)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /PLXXX/ DLIM(3), T(3), XJS(3), SEP(3), XYZJS(3)
      NATO = IPR(39)
      ISW  = -1
      CALL PLUT15 (-1, I, 44, IHAT)
      IF (IHAT .EQ. 1) THEN
        IF (IPR(109) .EQ. 1) THEN
          CALL PLUT15 (-1, I, 32, IDH)
        ELSE
          IDH = 1
        END IF
        IF (IDH .GT. 0) THEN
          DO K = 1, 3
            XJX(K)     = RA(J * NP43 + K)
            XJX(K + 3) = T(IPR(120 + K))
          END DO
          CALL SGSM (ICL, N, XJX, LU6, 3, IERR)
          DO K = 1, 3
            RA(K) = XJX(K + 6)
          END DO
          CALL PLUT23 (0)
          DO I0 = IPR(69) + 1, NATO
            CALL PLUT22 (I0, I, D)
            IF (D .LT. 1.25) THEN
              CALL PLUT37 (I0, I, 0, 0, ANG)
              IF (ANG .GE. PAR(97)) ISW = 1
              RETURN
            END IF
          END DO
        END IF
      ELSE
        CALL PLUT15 (-1, J, 32, JDH)
        IF (JDH .GT. 0) THEN
          XJX(1) = N
          DO K = 1, 3
            XJX(K + 1) = T(IPR(120 + K))
          END DO
          CALL SGSM (ICL, 0, XJX, LU6, 9, IERR)
          DO K = 1, 3
            XJX(K)     = RA(I * NP43 + K)
            XJX(K + 3) = XJX(9 + K)
          END DO
          M = NINT(XJX(9))
          CALL SGSM (ICL, M, XJX, LU6, 3, IERR)
          DO K = 1, 3
            RA(K) = XJX(6 + K)
          END DO
          CALL PLUT23 (0)
          DO J0 = IPR(69) + 1, NATO
            CALL PLUT22 (J0, J, D)
            IF (D .LT. 1.25) THEN
              CALL PLUT37 (J0, J, 0, 0, ANG)
              IF (ANG .GE. PAR(97)) ISW = 1
              RETURN
            END IF
          END DO
        END IF
      END IF
      RETURN
      END SUBROUTINE PLUT40
      SUBROUTINE PLUT41 (JAT, NEE, IER)
      PARAMETER (NP9=118,NP10=16,NP12=700,NP13=550,NP17=99,
     1 NP49=2000000,NP48=1000,NP38=150,NP39=30,NP43=12,NP45=2048)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /PLUTOSCRATCH/ MOL(2, NP48), RA(NP49)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /ATMDT/ IAN, ICLR, AMR(NP9, 4), IATPR(NP9), IATNR(NP9),
     1 ATWT(NP9), VDWR(NP9), IEL(NP9), REL(NP9), RNSCL(NP9), ATVOL(NP9),
     2 IACL(NP10), IEN(NP10), IBCL(NP10), IENS(NP10), IENLB(NP10),
     3 DISPVAL(NP10, 2), IDOAC(NP10), RADR(NP10, 4), SATWT(NP10),
     4 ANOM(NP10, 3), JACL(NP10), RGB(3, NP10), SFAC(2021)
      NB = 1
      NE = 7
      J1 = IEL(IEN(NEE)) / 100
      J2 = MOD(IEL(IEN(NEE)), 100)
      IF (J2 .EQ. 0) THEN
        JM = 900
      ELSE
        JM = 90
      END IF
      DO J = 1, JM
        IF (J2 .EQ. 0) THEN
          WRITE (IFL(4), 99999, IOSTAT = IOST)
     1      CHAR(ICHAR('A') + J1 - 1), 1000 - J
        ELSE
          WRITE (IFL(4), 99998, IOSTAT = IOST)
     1      CHAR(ICHAR('A') + J1 - 1), CHAR(ICHAR('a') + J2 - 1),
     2      100 - J
        END IF
        CALL PLUT13 (1, 4, KAT, XDUM)
        IF (KAT .LE. 0) THEN
          CALL PLA046 (9, IFL(4), NE4, NQX, NSS, NQSM,
     1                 INQNR, JNQNR, NIEN)
        YUNK = RA (JAT * NP43 + 7)
        DO K = 1, IPR(37)
          IF (RA(K * NP43 + 7) .EQ. YUNK)
     1    RA(K * NP43 + 7) = INQNR
        END DO
        WRITE (LU22, 99997, IOSTAT = IOST) IFL(3), IFL(4)
        IF (IABS(IGBL(8)) .EQ. 2) CALL PLUT29 (2, IFL(3), IFL(4), 0, 0)
          CALL PLA015 (0, 53)
          CALL GEN039 (1, IFL(3), 1, 7, NB, NE)
          PAR40 = NE * PAR(349) * PAR(19) / 2.0
          NATZ  = IPR(62) + JAT
          CALL PLUT14 (-1, NATZ, IASU, NPROP, XLZ, YLZ, ZL, RL)
          CALL GGIP09 (0.0, IFL(3), NE, PAR(349), 0, 2,
     1                 XLZ - PAR40, YLZ - PAR(28))
          CALL GEN039 (1, IFL(4), 1, 7, NB, NE)
          PAR40 = NE * PAR(349) * PAR(19) / 2.0
          CALL GGIP09 (0.0, IFL(4), NE, PAR(349), 1, 2,
     1                 XLZ - PAR40, YLZ - PAR(28))
          RETURN
        END IF
      END DO
      CALL PLA015 (0, 8)
      WRITE (LU6, 99996, IOSTAT = IOST) IFL(3), IFL(2), CHAR(7)
      IER = 1
      RETURN
99999 FORMAT (A, I3)
99998 FORMAT (2A, I2)
99997 FORMAT ('RENAME', 2(1X, A))
99996 FORMAT (':: No Substitution: New Label: ', A, 'for: ', A,
     1        'conflicts with label in list', A)
      END SUBROUTINE PLUT41
      SUBROUTINE S
C*********************************************************************
C *                                                                  *
C *                S . Y . S . T . E . M      S                      *
C *                                                                  *
C *    Single Crystal (Service) Structure Determination Shell        *
C *                                                                  *
C *                  (C) 1991-2014 A.L. Spek                         *
C *           Bijvoet Center for Biomolecular Research               *
C *                  Kristal- en Structuurchemie                     *
C *                     Universiteit Utrecht                         *
C *                       The Netherlands                            *
C *                                                                  *
C*********************************************************************
      ISW  = 0
C * SYSTEM-S STARTUP
      CALL S010 (ISW)
C * SYSTEM-S CENTRAL INSTRUCTION LOOP
      DO WHILE (ISW .EQ. 0)
C * DECIDE ON NEXT STEP PROPOSAL
        CALL S020 (0)
C * GET/EXECUTE NEXT INSTRUCTION LOOP
        CALL S030 (ISW)
      END DO
      RETURN
      END SUBROUTINE S
      SUBROUTINE GET_URL (STRING1, STRING2, IER)
      CHARACTER  STRING1*(*), STRING2*(*)
      IF (STRING1(1:1) .EQ. STRING2(1:1).OR. IER .NE. 0) RETURN
      RETURN
      END SUBROUTINE GET_URL
      SUBROUTINE S010 (ISW)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /LIJNX/ LIJN1, LIJN2, LIJN3, LIJN4, LIJN5
      CHARACTER LIJN1*16, LIJN2*16, LIJN3*16, LIJN4*21, LIJN5*16
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      CHARACTER LIN*256
      INTEGER FINDEXE
      LOGICAL DINQ
C * CHECK FOR NON-ROOT USER
      CALL GETENV ('LOGNAME', LIN)
      IF (LIN(1:4) .EQ. 'root') THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
        WRITE (LU6, 99998, IOSTAT = IOST)
        WRITE (LU6, 99999, IOSTAT = IOST)
        ISW = -1
        RETURN
      END IF
C * CHECK FOR X-WINDOW MODE - IF NOT QUIT  (EXCEPT FOR -F MODE)
      IF (IGBL(50) .LT. 2) THEN
        IF (IGBL(32) .NE. 1) THEN
          WRITE (LU6, 99999, IOSTAT = IOST)
          WRITE (LU6, 99997, IOSTAT = IOST)
          WRITE (LU6, 99999, IOSTAT = IOST)
          ISW = -1
          RETURN
        ELSE
          IWIN = 1
          VRTS = 0.74
          VRT  = VERT
          YVRT = VRTS * VERT
          XSH  = HORS - YVRT
          XSH0 = XSH  - (1.0 - VRTS) * VERT / 2.0
          YSH0 =      - (1.0 - VRTS) * VERT / 2.0
        END IF
      END IF
C * CHECK FOR SHELXL/XL EXECUTABLE - IF NOT: QUIT
      IGBL(110) = IABS(IGBL(110))
      IF (IGBL(110) .EQ. 0) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
        WRITE (LU6, 99996, IOSTAT = IOST)
        WRITE (LU6, 99999, IOSTAT = IOST)
        ISW = -1
        RETURN
      END IF
C * CHECK FOR PLATON EXECUTABLE - IF NOT: QUIT
      IF (IGBL(80) .EQ. 0) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
        WRITE (LU6, 99995, IOSTAT = IOST)
        WRITE (LU6, 99999, IOSTAT = IOST)
        ISW = -1
        RETURN
      END IF
C * CHECK WHETHER THE INVOKED & 'PATH'-PLATON VERSIONS ARE IDENTICAL
C * IF NOT: QUIT.
      JVERS = 0
      KERR  = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -z > version.log', KERR)
      OPEN (LU61, FILE = 'version.log', STATUS = 'UNKNOWN')
      DO
        READ (LU61, 99994, IOSTAT = IOST) LINE
        IF (LINE(1:6) .EQ. 'PLATON') THEN
          READ (LINE, 99993) JVERS
          EXIT
        END IF
      END DO
      CLOSE (UNIT = LU61, STATUS = 'DELETE')
      IF (IGBL(4) .NE. JVERS) THEN
        WRITE (LU6, 99992, IOSTAT = IOST) JVERS, IGBL(4)
        ISW = -1
        RETURN
      END IF
C * CHECK FOR SHELXS/SHELXL,PLATON etc PATH'S
      IGBL(111) = FINDEXE ('SHSEXE', SHSPATH, 'shelxs')
      IF (IGBL(111) .EQ. 0)
     1    IGBL(111) = FINDEXE ('SHSEXE', SHSPATH, 'xs')
      IGBL(112) = FINDEXE ('SHDEXE', SHDPATH, 'shelxd')
      IF (IGBL(112) .EQ. 0)
     1    IGBL(112) = FINDEXE ('SHDEXE', SHDPATH, 'xm')
      IGBL(113) = FINDEXE ('SIREXE', SIR97PATH, 'sir97')
      IGBL(114) = FINDEXE ('SIR04EXE', SIR04PATH, 'sir2004')
      IGBL(120) = FINDEXE ('SIR11EXE', SIR11PATH, 'sir2011')
      IGBL(115) = FINDEXE ('DIREXE', DIRPATH, 'dirdif')
      IGBL(118) = FINDEXE ('QUESTEXE', LINE, 'cqbatch')
C * GENERAL INIT / RESTART IN CONTEXT
      IB        = 1
      IGBL(1)   = 4
      IGBL(6)   = 17
      IGBL(38)  = 1
      IGBL(40)  = 1
      IGBL(41)  = 1
      IGBL(117) = 1
      IGBL(122) = 1
      CPR(105)  = 'START'
      CPR(106)  = CPR(200)
      CALL GEN038 (DATAORG, 1, 80)
      CALL GEN038 (LIJN1, 1, 16)
      CALL GEN038 (LIJN2, 1, 16)
      CALL GEN038 (LIJN3, 1, 16)
      CALL GEN038 (LIJN4, 1, 21)
      CALL GEN038 (LIJN5, 1, 16)
      CALL GEN038 (VALIDATION, 1, 45)
C * LOOK FOR CHECKDEF
      IF (IGBL(12) .EQ. 1) THEN
        CALL GETENV ('CHECKDEF', LINE)
        IF (LINE(1:1) .EQ. CHAR(32)) IGBL(12) = 0
      END IF
C * WHICH EDITOR (LOOK FOR ENVIRONMENT VARIABLE)
      N = FINDEXE ('EDITOR', EDITOR, 'nedit')
      IF (N .EQ. 0) N = FINDEXE ('EDITOR', EDITOR, 'vi')
C * GET LASER PRINTER COMMAND FROM ENVIRONMENT VARIABLE
      CALL GETENV ('PSLASER', PSLASER)
      IF (PSLASER(1:1) .EQ. CHAR(32)) PSLASER = 'laser2x '
C * GET PSVIEWER COMMAND FROM ENVIRONMENT VARIABLE
      N = FINDEXE ('PSVIEWER', PSVIEWER, 'ghostview')
      IF (N .EQ. 0) THEN
        N = FINDEXE ('PSVIEWER', PSVIEWER, 'gv')
        IF (N .NE. 0) PSVIEWER(N+1:) = ' --orientation=seascape'
      ELSE
        PSVIEWER(N+1:) = ' -seascape'
      END IF
C * GET CURRENT WORKING DIRECTORY AND WIDTH = IW
      CALL GETENV ('PWD', WORKDIR)
      IW = 254
      CALL GEN039 (1, WORKDIR, 1, 254, IB, IW)
      IF (IW .LE. 1) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
        WRITE (LU6, 99991, IOSTAT = IOST)
        WRITE (LU6, 99999, IOSTAT = IOST)
        ISW = -1
        RETURN
      END IF
C * GET USERPATH AND WIDTH = IU
      CALL GETENV ('HOME', USRPATH)
      IU = 254
      CALL GEN039 (1, USRPATH, 1, 254, IB, IU)
C * CHECK FOR/CREATE DIR s UNDER USER-ROOT OR WORKDIR (IF NOT)
      FNM = USRPATH(1:IU)//'/s/'
      IF (.NOT.  DINQ (FNM(1:IU + 2))) THEN
        USRPATH = WORKDIR
        IU      = IW
        FNM     = USRPATH(1:IU)//'/s/'
        IF (.NOT. DINQ (FNM(1:IU + 2)) ) THEN
          KERR = 0
          CALL SPAWN ('mkdir '//FNM(1:IU + 2), KERR)
        END IF
      END IF
C * GET COMMAND LINE ARGUMENT COMPOUND NAME (IF ANY)
      JARGB = 0
      JARG  = IARGC()
      IF (JARG .GT. 0) THEN
        CALL GETARG (1, COMPD)
        IF (COMPD(1:2) .EQ. '-s' .OR. COMPD(1:2) .EQ. '-F') THEN
          JARGB = 1
          CALL GEN038 (COMPD, 1, 10)
        END IF
        IF ((JARG - JARGB) .GT. 0) THEN
          CALL GEN038 (COMPD, 1, 10)
          CALL GETARG (1 + JARGB, LINE)
C * SEARCH FOR FILENAME EXTENSION(S) '.ins', '.res', '.fcf' or 'cif'
          IC = 40
          CALL GEN039 (1, LINE, 1, 40, IB, IC)
          ID1 = INDEX (LINE(1:IC), '.ins')
          IF (ID1 .EQ. 0) ID1 = - INDEX (LINE(1:IC), '.res')
          ID2 = INDEX (LINE(1:IC), '.fcf')
          ID3 = INDEX (LINE(1:IC), '.cif')
          ID  = MAX (IABS(ID1), ID2, ID3)
          IF (ID .NE. 0) THEN
            IF (ID .LT. 11) THEN
              IDM1 = ID - 1
              COMPD(1:IDM1) = LINE(1:IDM1)
              CALL GEN020 (-1, COMPD, 1, IDM1)
              IF (COMPD(1:IDM1) .NE. LINE(1:IDM1)) THEN
                WRITE (LU6, 99989, IOSTAT = IOST)
                CALL GEN127 (' ')
              END IF
              IF (ID3 .NE. 0) THEN
                ISPR(340) = 3
              ELSE IF (ID2 .NE. 0) THEN
                ISPR(340) = 2
              ELSE
                ISPR(340) = ISIGN (1, ID1)
              END IF
            ELSE
              WRITE (LU6, 99990, IOSTAT = IOST) LINE(1:ID)
              CALL GEN127 ('NAME > 10 CHAR')
            END IF
          ELSE
            IF (IC .LT. 11) THEN
              COMPD = LINE(1:IC)
            ELSE
              WRITE (LU6, 99990, IOSTAT = IOST) LINE(1:IC)
              CALL GEN127 ('NAME > 10 CHAR')
            END IF
          END IF
        END IF
      END IF
C * CHECK FOR NQA/GUIDED MODE
      IF (IGBL(50) .NE. 2) THEN
        IF ((JARG - JARGB) .GT. 1) THEN
          IGBL(50) = 1
          CALL GETARG (JARGB + 2, LINE)
          CALL GEN020 (1, LINE, 1, 6)
          IF (LINE(1:4) .EQ. 'AUTO' .OR. LINE(1:3) .EQ. 'NQA')
     1      JARG = JARG - 1
          IF (LINE(1:6) .EQ. 'REMOVE') IGBL(50) = -1
        ELSE
          IGBL(50) = 0
        END IF
      END IF
C * SKIP COMPID INPUT DIALOG SECTION WHEN COMPID GIVEN ON CALLING LINE
      IF ((JARG - JARGB) .GT. 0) THEN
        KL     = 0
        KN     = 0
        CPR(1) = 'COMPID'
        CPR(2) = COMPD
        CALL S015
      END IF
      RETURN
99999 FORMAT (6('** S-Abort **'))
99998 FORMAT ('>>> System-S will not run for USER=root !!')
99997 FORMAT ('>>> System-S runs in X-Windows mode only !!')
99996 FORMAT ('>>> No PATH to a SHELXL executable found !!')
99995 FORMAT ('>>> No PATH to a PLATON executable found !!')
99994 FORMAT (A)
99993 FORMAT (15X, I10)
99992 FORMAT (/, 'Spawned PLATON ', I7, ' version differs from that',
     1           ' of Spawner', I7, /)
99991 FORMAT ('>>> No Usable environment variable value for PWD !!')
99990 FORMAT ('UNSUITABLE FILENAME or NAME > 10 CHAR: ', A)
99989 FORMAT (/, '>>> COMPOUND FILENAME SHOULD BE LOWER CASE !!', /)
      END SUBROUTINE S010
      SUBROUTINE S015
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250,NP45=2048,NP54=42)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER VERSION*6, NQ*6
      DIMENSION XYZ(12)
      INTEGER CHANDIR
      LOGICAL EXST, SEXST, SSEXST, DINQ
      COMMON /Q/ ICL, IFL(NP17)
      CHARACTER ICL*(NP45), IFL*7
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER DUM*2
      COMMON /MENTRY/ IENTRY(NP54, 4), CENTRY(NP54)
      CHARACTER CENTRY*75
      COMMON /FILETYPE/FTYPE
      CHARACTER FTYPE(5)*4
      DATA (FTYPE(I), I = 1, 5)/'.res', '    ', '.ins', '.fcf', '.cif'/
C * FILES & INIT ROUTINE
      WRITE (VERSION, 99978, IOSTAT = IOST) IGBL(4)
      EXST  = .FALSE.
      SEXST = .FALSE.
      IERR  = 0
      MODUS = -1
      TITL(1:10) = COMPD
      CALL GEN038 (TITL, 11, 36)
      OPEN (UNIT = LU61, FILE = FNM(1:IU+3)//'.compid',
     1      STATUS = 'UNKNOWN')
      WRITE (LU61, 99979, IOSTAT = IOST) COMPD
      CLOSE (UNIT = LU61)
      IB = 1
      IC = 10
      CALL GEN039 (1, COMPD, 1, 10, IB, IC)
      IN = 4 + IU + IC
      FNM(IU + 3 : IN) = '/'//COMPD(1:IC)//'/'
      IF (IGBL(50) .EQ. -1 .OR. IGBL(50) .EQ. 2) THEN
        IF (DINQ (FNM(1:IU+3)//COMPD(1:IC))) THEN
          KERR = 0
          CALL SPAWN ('rm -r '//FNM(1:IU+3)//COMPD(1:IC), KERR)
          WRITE (LU6, 99977, IOSTAT = IOST) FNM(1:IU+3)//COMPD(1:IC)
        END IF
        IF (CHANDIR (WORKDIR) .NE. 0) CALL GEN127 (' ')
        IF (IGBL(50) .EQ. -1) CALL GEN127 (' ')
      END IF
      SSEXST = DINQ (FNM(1:IN - 1))
      IF (SSEXST) THEN
        IF (CHANDIR(FNM(1:IN-1)) .NE. 0) CALL S925(1)
        CPR(104) = '00/000/000'
        CALL S915
     1  ('General Restart in Context (s-version='//VERSION//')')
      ELSE
C * STARTUP WITH EITHER .RES, .INS, .FCF, OR .CIF DETERMINED FROM EXTENSION ID
        IF (ID .NE. 0) THEN
          IC = ID - 1
          DO I = 1, 6
            IF (I .EQ. 6) THEN
              CALL S925 (3)
              CALL GEN127 (' ')
            END IF
            IF (I .NE. 2) THEN
              J = I - 2
              IF (ISPR(340) .EQ. J) THEN
                INQUIRE (FILE = COMPD(1:IC)//FTYPE(I), EXIST = SEXST)
                IF (SEXST) THEN
                  IF (I .EQ. 4 .OR. I .EQ. 5) THEN
                    OPEN (LU61, FILE = COMPD(1:IC)//FTYPE(I),
     1                STATUS = 'UNKNOWN')
C * CREATE INS,(HKL) FOR CIF & FCF
                    IF (.NOT. SSEXST) THEN
                      OPEN (LU62, FILE = COMPD(1:IC)//'.ins',
     1                  STATUS = 'UNKNOWN')
                      WRITE (LU62, 99986, IOSTAT = IOST) COMPD(1:IC)
                      IGBL(5)  = LU61
                      CALL GEN108 (LU61, 0)
                      IGBL(8)  = 3
                      IPR(499) = 0
                      IPR(39)  = 0
                      ITYPE    = 0
                      DO
     	                CALL PLA006 (0, IS)
                        IF (IS .EQ. -1) EXIT
                        IF (IS .EQ. 30) THEN
                          WRITE (LU62, 99985, IOSTAT = IOST)
     1                      (FN(K), K = 1, 12)
                        ELSE IF (IS .EQ. 71) THEN
                          WRITE (LU62, 99984, IOSTAT = IOST) FN(1)
                        ELSE IF (IS .EQ. 85) THEN
                          WRITE (LU62, 99983, IOSTAT = IOST)
     1                    NINT(FN(1)), NINT(FN(2)), NINT(FN(3)), FN(4)
                        ELSE IF (IS .EQ. 132) THEN
                          WRITE (LU62, 99982, IOSTAT = IOST) FN(1) - 273
                        ELSE IF (IS .EQ. 163) THEN
                          N = INDEX (ICL, '''')
                          IF (N .GT. 2) THEN
                            CALL GEN072 (ICL, JFL, FN, KL, KN, 0, LU6,
     1                        1, 1, N - 1, 10, NP17)
                            DO JJ = 1, KL
                              CALL GEN111 (JFL(JJ), DUM(1:2), 7, M)
                              IF (M .EQ. 0) THEN
                                IF (DUM(2:2) .EQ. ' ') THEN
                                  JFL(JJ) = DUM(1:1)//'1'
                                ELSE
                                  JFL(JJ) = DUM(1:2)//'1'
                                END IF
                              END IF
                            END DO
                            WRITE (LU62, 99981, IOSTAT = IOST)
     1                        (JFL(KK)(1:5),KK = 1, KL)
                          END IF
                        ELSE IF (IS .EQ. -2) THEN
                          IF (ISPR(340) .EQ. 2) EXIT
                          WRITE (LU62, 99991, IOSTAT = IOST)
                          ITYPE = 0
                          DO
                            READ (LU61, 99979, IOSTAT = IOST) ICL(1:80)
                            IF (IOST .NE. 0) THEN
                              WRITE (LU62, '(/)', IOSTAT = IOST)
                              ISPR(340) = 3
                              GO TO 10
                            END IF
                            IF (INDEX(ICL(1:80),
     1                        '_refln_F_squared_sigma')
     2                        .NE. 0) THEN
                              ITYPE = 1
                              CLOSE (UNIT = LU62)
                            ELSE IF (INDEX(ICL(1:80),
     1                        '_diffracted_cos_cstar') .NE. 0) THEN
                              ITYPE = 2
                              CLOSE (UNIT = LU62)
                            ELSE IF (ICL(1:1) .EQ. ' ' .AND.
     1                        ICL(21:21) .EQ. '.') THEN
                              BACKSPACE LU61
                              EXIT
                            END IF
                          END DO
                          OPEN (LU62, FILE = COMPD(1:IC)//'.xxx',
     1                      STATUS = 'UNKNOWN')
                          DO
                            READ (LU61, '(I4, 2I5, 2F9.0, I5)',
     1                        IOSTAT = IOST)
     1                        IH, IK, IL, OBS, SOBS, IBATNR
                            IF (IOST .NE. 0) THEN
                              WRITE (LU62, '(/)', IOSTAT = IOST)
                              ISPR(340) = 3
                              GO TO 10
                            END IF
                            IF (ITYPE .EQ. 2) THEN
                              READ (LU61, '(F8.5,5F9.5)', IOSTAT = IOST)
     1                          DI1, DO1, DI2, DO2, DI3, DO3
                              IF (IOST .NE. 0) THEN
                                WRITE (LU62, '(/)', IOSTAT = IOST)
                                ISPR(340) = 3
                                GO TO 10
                              END IF
                              WRITE (LU62, 99970, IOSTAT = IOST) IH, IK,
     1                        IL, NINT(OBS * 100.0), NINT(SOBS * 100.0),
     2                        IBATNR, DI1, DO1, DI2, DO2, DI3, DO3
                            ELSE
                              WRITE (LU62, 99969, IOSTAT = IOST) IH, IK,
     1                          IL, NINT(OBS * 100.0),
     2                          NINT(SOBS * 100.0), 1
                            END IF
                          END DO
                          WRITE (LU62, '(/)', IOSTAT = IOST)
                          ISPR(340) = 3
                          GO TO 10
                        END IF
                      END DO
                      IF (PAR(304) .GT. 0.0)
     1                  WRITE (LU62, 99992, IOSTAT = IOST)
     2                    (PAR(K), K = 302, 304)
                      WRITE (LU62, 99991, IOSTAT = IOST)
                      CLOSE (UNIT = LU62)
                      CLOSE (UNIT = LU61)
                      IF (ISPR(340) .EQ. 2) THEN
                        OPEN (LU61, FILE = COMPD(1:IC)//'.fcf',
     1                  STATUS = 'UNKNOWN')
                      END IF
                      IF (ISPR(340) .EQ. 3) THEN
                          INQUIRE (FILE = COMPD(1:IC)//'.fcf',
     1                      EXIST = SEXST)
                        IF (SEXST) THEN
                          OPEN (LU61, FILE = COMPD(1:IC)//'.fcf',
     1                      STATUS = 'UNKNOWN')
                        ELSE
                          INQUIRE (FILE = COMPD(1:IC)//'.hkl',
     1                      EXIST = SEXST)
                          IF (SEXST) THEN
                            OPEN (LU61, FILE = COMPD(1:IC)//'.hkl',
     1                        STATUS = 'UNKNOWN')
                          ELSE
                            CALL GEN127 ('No HKL-Data Found')
                          END IF
                        END IF
                      END IF
                      OPEN (LU62, FILE = COMPD(1:IC)//'.xxx',
     1                  STATUS = 'UNKNOWN')
                      IGBL(54) = 1
                      CALL PLA010 (LU61)
                      IENTRY(IGBL(54), 3) = IGBL(9)
                      IENTRY(IGBL(54), 4) = 5
                      CALL PLA134 (LU6, LU61, LU62, IPR(384))
   10                 CLOSE (UNIT = LU62)
                      CLOSE (UNIT = LU61)
                    END IF
                  END IF
                  EXIT
                ELSE
                  WRITE (LU6, 99997, IOSTAT = IOST)
     1              COMPD(1:IC)//FTYPE(I)
                  CALL S925 (3)
                  CALL GEN127 (' ')
                END IF
              END IF
            END IF
          END DO
C * CREATE DIR COMPD UNDER s
          KERR = 0
          CALL SPAWN ('mkdir '//FNM(1:IN - 1), KERR)
          IF (ISPR(340) .EQ. -1) THEN
            KERR = 0
            CALL SPAWN
     1        ('cp '//COMPD(1:IC)//'.res '//FNM(1:IN)//'shelx.ins',
     2        KERR)
          ELSE
            KERR = 0
            CALL SPAWN
     1        ('cp '//COMPD(1:IC)//'.ins '//FNM(1:IN)//'shelx.ins',
     2        KERR)
          END IF
          IF (IABS(ISPR(340)) .EQ. 1) THEN
            INQUIRE (FILE = COMPD(1:IC)//'.hkl', EXIST = SEXST)
            IF (SEXST) THEN
              KERR = 0
              CALL SPAWN
     1        ('cp '//COMPD(1:IC)//'.hkl '//FNM(1:IN)//'shelx.hkl',
     2        KERR)
              DATAORG =
     1     'Shelx-data from '//WORKDIR(1:IW)//'/'//COMPD(1:IC)//'.hkl'
            ELSE
              WRITE (LU6, '(''No HKL data found'')', IOSTAT = IOST)
            END IF
          ELSE IF (ISPR(340) .EQ. 2) THEN
            KERR = 0
            CALL SPAWN
     1        ('cp '//COMPD(1:IC)//'.fcf '//FNM(1:IN)//'shelx.fcf',
     2        KERR)
            KERR = 0
            CALL SPAWN
     1        ('mv '//COMPD(1:IC)//'.xxx '//FNM(1:IN)//'shelx.hkl',
     2        KERR)
            DATAORG =
     1    'Shelx-data from '//WORKDIR(1:IW)//'/'//COMPD(1:IC)//'.fcf'
          ELSE IF (ISPR(340) .EQ. 3) THEN
            KERR = 0
            CALL SPAWN
     1        ('cp '//COMPD(1:IC)//'.cif '//FNM(1:IN)//'shelx.cif',
     2        KERR)
            KERR = 0
            CALL SPAWN
     1        ('mv '//COMPD(1:IC)//'.xxx '//FNM(1:IN)//'shelx.hkl',
     2        KERR)
            DATAORG =
     1    'Shelx-data from '//WORKDIR(1:IW)//'/'//COMPD(1:IC)//'.cif'
          END IF
          IF (CHANDIR (FNM(1:IN - 1)) .NE. 0) CALL S925 (1)
          CPR(104) = '00/000/000'
          CALL S915 (
     1    COMPD(1:IC)//' Create & Init (s-version='//VERSION//')')
          CALL S915 (DATAORG(1:21+IW+IC))
        END IF
      END IF
      INQUIRE (FILE = '.s.dbf', EXIST = EXST)
      IF (.NOT. EXST) THEN
        IF (ISPR(340) .EQ. 3) THEN
          DATAORG = 'Reflection data from '//COMPD(1:IC)//'.cif'
        ELSE IF (ISPR(340) .EQ. 2) THEN
          DATAORG = 'Reflection data from '//COMPD(1:IC)//'.fcf'
        ELSE IF (ISPR(340) .EQ. 1) THEN
          DATAORG = 'Reflection data from '//COMPD(1:IC)//'.hkl'
        END IF
        ISPR(37) = 0
        INQUIRE (FILE = 'shelx.hkl', EXIST = EXST)
        IF (EXST) THEN
          IF (DATAORG(1:1) .EQ. ' ') THEN
            DATAORG = 'Reflection Data from shelx.hkl'
            CALL S915 (DATAORG(1:30))
          END IF
        ELSE
          INQUIRE (FILE = 'shelx.fcf', EXIST = EXST)
          IF (EXST) THEN
            ISPR(1) = 4
            DATAORG = 'Reflection Data from shelx.fcf'
            CALL S915 (DATAORG(1:30))
            OPEN (LU61, FILE = 'shelx.fcf', STATUS = 'UNKNOWN')
            OPEN (LU62, FILE = 'shelx.hkl', STATUS = 'UNKNOWN')
            CALL PLA134 (LU6, LU61, LU62, IPR(384))
            CLOSE (UNIT = LU61)
            CLOSE (UNIT = LU62)
            KERR = 0
          ELSE
            INQUIRE (FILE = 'shelx.cif', EXIST = EXST)
            IF (EXST) THEN
              ISPR(1) = 4
              DATAORG = 'Reflection Data from shelx.cif'
              CALL S915 (DATAORG(1:30))
              OPEN (LU61, FILE = 'shelx.cif', STATUS = 'UNKNOWN')
              OPEN (LU62, FILE = 'shelx.hkl', STATUS = 'UNKNOWN')
              ITYPE = 0
              DO
                READ (LU61, '(A)', END = 20) LINE
                IF (INDEX(LINE, '_refln_F_squared_sigma') .NE. 0)
     1            THEN
                  ITYPE = 1
                ELSE IF (INDEX(LINE, '_diffracted_cos_cstar')
     1          .NE. 0) THEN
                  ITYPE = 2
                ELSE IF (LINE(1:1) .EQ. ' ' .AND.
     1            LINE(21:21) .EQ. '.') THEN
                  BACKSPACE LU61
                  EXIT
                END IF
              END DO
              DO
                READ (LU61, '(I4, 2I5, 2F9.0, I5)', IOSTAT = IOST)
     1          IH, IK, IL, OBS, SOBS, IBATNR
                IF (IOST .NE. 0) EXIT
                IF (ITYPE .EQ. 2) THEN
                  READ (LU61, '(F8.5,5F9.5)', IOSTAT = IOST)
     1              DI1, DO1, DI2, DO2, DI3, DO3
                  IF (IOST .NE. 0) EXIT
                  WRITE (LU62, '(3I4, 2I8, I4, 6F8.5)',
     1            IOSTAT = IOST) IH, IK, IL, NINT(OBS * 100.0),
     2            NINT(SOBS * 100.0), IBATNR, DI1, DO1, DI2, DO2,
     3            DI3, DO3
                ELSE
                  WRITE (LU62, '(3I4, 2I8, I4)', IOSTAT = IOST)
     1            IH, IK, IL, NINT(OBS * 100.0),
     2            NINT(SOBS * 100.0), 1
                END IF
              END DO
   20         WRITE (LU62, '(/)', IOSTAT = IOST)
              CLOSE (UNIT = LU61)
              CLOSE (UNIT = LU62)
            ELSE
              CALL S925 (3)
              CALL GEN127 (' ')
            END IF
          END IF
        END IF
      ELSE
        MODUS = 1
        CALL S920 (-1)
        CALL S927 (0)
        IF (CPR(100) .NE. '          ') THEN
          LINE(1:20)  = 'SPGR '//CPR(100)//'     '
          LINE(21:50) = '                              '
          LINE(51:80) = LINE(21:50)
          CALL SGSM (LINE, 0, XYZ, 6, 0,  IERR)
          CALL SGSM (LINE, 0, XYZ, 6, 18, IERR)
          ISPR(102) = NINT(XYZ(9))
        END IF
      END IF
      IF (MODUS .EQ. -1) THEN
        CALL S915 ('Files & Init')
        KERR = 0
        CALL SPAWN ('mkdir hklf', KERR)
        KERR = 0
        CALL SPAWN ('ln -s /dev/null hklf/shelx.hkl', KERR)
        CALL S932 (1)
        CALL GEN021 (TM, 1)
        DO I = 2, NP2
          ISPR(I) = 0
        END DO
        CALL GEN074 (SPAR, 1, NP1, 0.0)
        DO I = 1, NP3
          CALL GEN038 (CPR(I), 1, 10)
        END DO
        CALL GEN074 (SPAR, 104, 106,  90.0)
        CALL GEN074 (SPAR, 108, 110, 0.001)
        CALL GEN074 (SPAR, 111, 113,  0.01)
        ISPR(119) = 1
        CPR(104) = '00/000/000'
        SPAR(1)   = 0.33
        SPAR(2)   = 0.25
        SPAR(56)  = 0.2
        SPAR(57)  = 0.6
        SPAR(200) = 0.0
        SPAR(225) = -1000.0
        SPAR(227) = -1000.0
        SPAR(228) =     0.0
        SPAR(163) = 1.0
        ISPR(6)  = -1
        ISPR(11) =  1
        ISPR(28)  = 50
        IF (ISPR(1) .EQ. 0 .OR. ISPR(1) .EQ. 4) THEN
          INQUIRE (FILE = 'shelx.ins', EXIST = EXST)
          IF (EXST) THEN
            OPEN (LU61, FILE = 'shelx.ins', STATUS = 'OLD')
            DO
              CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80,
     1                   10, NP17)
              SELECT CASE (JFL(1)(1:4))
                CASE ('CELL')
                  IF (KN .GE. 6) THEN
                    IF (KN .EQ. 7) THEN
                      SPAR(80) = FN(1)
                      IB = 2
                    ELSE
                      IB = 1
                    END IF
                    DO I = IB, KN
                      SPAR(I + 101 - IB) = FN(I)
                    END DO
                    ISPR(38) = 4
                  ELSE
                    WRITE (LU6, 99972, IOSTAT = IOST)
                    EXIT
                  END IF
                CASE ('ZERR')
                  IF (KN .EQ. 7) THEN
                    ISPR(119) = NINT(FN(1))
                    DO I = 2, 7
                      SPAR(106 + I) = FN(I)
                    END DO
                  ELSE IF (KN .EQ. 6) THEN
                    DO I = 1, 6
                      SPAR(107 + I) = FN(I)
                    END DO
                  ELSE
                    WRITE (LU6, 99971, IOSTAT = IOST)
                    CYCLE
                  END IF
                CASE ('SFAC')
                  IB = 1
                  DO I = 2, KL
                    SFC(I - 1) = JFL(I)(1:2)
                    LINE(IB:) = SFC(I - 1)
                    IB        = IB + 1
                    IF (SFC(I - 1)(2:2) .NE. ' ') IB = IB + 1
                    CALL GEN040 (1, NQ, IP)
                    LINE(IB:) = NQ
                    IB        = IB + IP
                  END DO
                  IF (IGBL(50) .NE. 0) THEN
                    OPEN (LU62, FILE = '.formula', STATUS = 'UNKNOWN')
                    WRITE (LU62, 99979, IOSTAT = IOST) LINE
                    CLOSE (UNIT = LU62)
                  END IF
                CASE ('RADN')
                  SPAR(80) = FN(1)
                CASE ('FSUM')
                  OPEN (LU62, FILE = '.formula', STATUS = 'UNKNOWN')
                  WRITE (LU62, 99979, IOSTAT = IOST) LINE(6:80)
                CASE ('UNIT')
                  IB = 1
                  DO I = 1, KN
                    LINE(IB:) = SFC(I)
                    IB        = IB + 1
                    IF (SFC(I)(2:2) .NE. ' ') IB = IB + 1
                    NUM = NINT(FN(I) / ISPR(119))
                    CALL GEN040 (NUM, NQ, IP)
                    LINE(IB:) = NQ
                    IB        = IB + IP
                  END DO
                  OPEN (LU62, FILE = '.formula', STATUS = 'UNKNOWN')
                  WRITE (LU62, 99979, IOSTAT = IOST) LINE
                CASE ('CHIR')
                  ISPR(8) = 1
                CASE ('TEMP')
                  IF (JFL(2)(1:1) .EQ. 'K') THEN
                    SPAR(10) = FN(1)
                  ELSE
                    SPAR(10) = FN(1) + 273
                  END IF
                CASE ('SIZE')
                  IF (KN .EQ. 3) THEN
                    CALL GEN034 (FN, 1, 3)
                    SPAR(11) = FN(1)
                    SPAR(12) = FN(2)
                    SPAR(13) = FN(3)
                  END IF
                CASE ('SET ')
C * SET REVERSE
                  IF (JFL(2)(1:3) .EQ. 'REV') THEN
                    IGBL(68) = MOD (IGBL(68) + 1, 2)
                    CALL GGIP (-999.0, FLOAT(IGBL(68)), IGBL(62) * 0.25,
     1                           9)
C * SET IPR/PAR/IGBL/RGBL
                  ELSE IF (KL .EQ. 2 .AND. KN .EQ. 2) THEN
                    CALL PLA206 (1, JFL(2)(1:3))
                  END IF
                CASE ('FACE')
                  IH = NINT(FN(1))
                  IK = NINT(FN(2))
                  IL = NINT(FN(3))
                  D  = FN(4)
                  CALL S060 (4, IH, IK, IL, D)
                CASE ('MU  ')
                  IF (KN .EQ. 1) THEN
                    D = FN(1)
                    CALL S060 (1, 0, 0, 0, D)
                  END IF
                CASE ('HKLF')
                  IF (KN .EQ. 1 .OR. KN .EQ. 2) ISPR(1) = NINT(FN(1))
                CASE ('ORGA')
                  IGBL(97)  = 1
                CASE ('INOR')
                  IGBL(97)  = 0
                CASE ('SHEL')
                  IF (IGBL(111) .NE. 0) IGBL(73) = 2
                CASE ('SIR ', 'SIR9', 'SIR2')
                  IF (IGBL(113) .NE. 0) IGBL(73) = 3
                CASE ('END')
                  EXIT
                CASE ('EOF')
                  EXIT
              END SELECT
            END DO
            CLOSE (UNIT = LU61)
            CLOSE (UNIT = LU62)
            KERR = 0
            CALL SPAWN ('mv shelx.ins hklf', KERR)
          ELSE
            INQUIRE (FILE = 'scale.out', EXIST = EXST)
            IF (EXST) THEN
              OPEN (LU61, FILE = 'scale.out', STATUS = 'OLD')
              DO
                READ (LU61, '(A)', IOSTAT = IOST) LINE
                IF (IOST .NE. 0) EXIT
                IF (LINE(1:6) .EQ. ' CELL ') THEN
                  READ (LINE,'(5X, 6F9.0)') (SPAR(100 + I), I = 1, 6)
                ELSE IF (LINE(1:4) .EQ. ' A  ') THEN
                  READ (LINE, 99996) SPAR(108)
                ELSE IF (LINE(1:4) .EQ. ' B  ') THEN
                  READ (LINE, 99996) SPAR(109)
                ELSE IF (LINE(1:4) .EQ. ' C  ') THEN
                  READ (LINE, 99996) SPAR(110)
                ELSE IF (LINE(1:6) .EQ. ' ALPHA') THEN
                  READ (LINE, 99980) SPAR(111)
                ELSE IF (LINE(1:6) .EQ. ' BETA ') THEN
                  READ (LINE, 99980) SPAR(112)
                ELSE IF (LINE(1:6) .EQ. ' GAMMA') THEN
                  READ (LINE, 99980) SPAR(113)
                END IF
              END DO
              CLOSE (UNIT = LU61)
              ISPR(38) = 3
            END IF
          END IF
          IF (ISPR(1) .EQ. 0) THEN
            CALL GGIP (-999.0, 0.0, XWIN, 1)
            IF (XWIN .NE. 0.0) THEN
              SBCD =
     1       'SHELX.HKL file found. FORMAT = HKLF 4 (y/n[y])'//CHAR(0)
             CALL PLA013 (0, 1)
             LINE = IGGT
            ELSE
              CALL GEN125 (1, LU6,
     1         'SHELX.HKL file found. FORMAT = HKLF 4 (y/n[y])')
              READ  (LU5, 99979) LINE
            END IF
          ELSE IF (ISPR(1) .EQ. 3) THEN
            LINE(1:1) = 'N'
          ELSE
            LINE(1:1) = 'Y'
          END IF
          CALL GEN020 (1, LINE, 1, 1)
          IF (LINE(1:1) .EQ. 'n' .OR. LINE(1:1) .EQ. 'N') THEN
            WRITE (LU6, 99974, IOSTAT = IOST)
            KERR = 0
            CALL SPAWN ('mv shelx.hkl shelx.hkl3', KERR)
            OPEN (LU61, FILE = 'shelx.hkl3', STATUS = 'UNKNOWN')
            OPEN (LU62, FILE = 'shelx.hkl',  STATUS = 'UNKNOWN')
            NREF   = 0
            FMAX   = 0.0
            SMAX   = 0.0
            NERROR = -1
   30       NERROR = NERROR + 1
            IF (NERROR .LT. 100) THEN
              DO
                READ (LU61, 99973, END = 40, ERR = 30)
     1                IH, IK, IL, FOBS, SFOBS
                IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) EXIT
                IF (SFOBS .GT. 0.0) THEN
                  NREF = NREF + 1
                  FMAX = MAX (FMAX, FOBS ** 2)
                  SMAX = MAX (SMAX, SFOBS * FOBS * 2.0)
                END IF
              END DO
            END IF
   40       CALL GEN108 (LU61, 0)
            SCF =  MIN (9999999.0 / FMAX, 9999999.0 / SMAX)
            DO I = 1, NREF
              READ (LU61, 99987) IH, IK, IL, FOBS, SFOBS
              IF (SFOBS .GT. 0.0) THEN
                IFOBS  = NINT(SCF * FOBS ** 2)
                ISFOBS = NINT(SCF * 2.0 * FOBS * SFOBS)
                IF (ISFOBS .GT. 0) THEN
                  WRITE (LU62, 99989, IOSTAT = IOST)
     1              IH, IK, IL, IFOBS, ISFOBS, 1
                END IF
              END IF
            END DO
            WRITE (LU62, 99990, IOSTAT = IOST)
            CLOSE (UNIT = LU61)
            CLOSE (UNIT = LU62)
          END IF
          ISPR(1) = 4
          KERR = 0
          CALL SPAWN ('mv shelx.hkl hklf', KERR)
        ELSE
          WRITE (LU6, 99999, IOSTAT = IOST)
        END IF
        ISPR(10) = 1
        CPR(105) = 'COMPID'
        CPR(106) = CPR(200)
      END IF
C * FIND OUT ABOUT DIRCOS AND PSI-SCAN DATA
      IF (ISPR(1) .NE. 1 .AND. ISPR(1) .NE. 2) CALL S904
      CALL S915 ('Start Input Cycle')
      RETURN
99999 FORMAT ('No .doc file found.', /)
99997 FORMAT (/, 'The file ', A, ' not found in current directory', /)
99996 FORMAT (18X, F9.0)
99992 FORMAT ('SIZE', 3F10.3)
99991 FORMAT ('HKLF 4')
99990 FORMAT (1X)
99989 FORMAT (3I4, 2I8, I4)
99987 FORMAT (3I4, 2F8.0)
99986 FORMAT ('TITL ', A)
99985 FORMAT ('CELL ', 6F10.5, /, 'ZERR 1', 6F10.5)
99984 FORMAT ('RADN', F10.5)
99983 FORMAT ('FACE', 3I5, F10.4)
99982 FORMAT ('TEMP', F10.1)
99981 FORMAT ('FSUM ', 15A)
99980 FORMAT (22X, F9.0)
99979 FORMAT (A)
99978 FORMAT (I6)
99977 FORMAT (/, 'Current Directory ', A, ' Removed')
99974 FORMAT (/, ':: HKLF 3 converted to HKLF 4 type SHELX.HKL file')
99973 FORMAT (3I4, 2F8.0)
99972 FORMAT ('CELL Record Error')
99971 FORMAT ('ZERR Record Error')
99970 FORMAT (3I4, 2I8, I4, 6F8.5)
99969 FORMAT (3I4, 2I8, I4)
      END SUBROUTINE S015
      SUBROUTINE S020 (ISKIP)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER FROM*10
      LOGICAL EXST
      FROM = CPR(105)
      IF (ISKIP .EQ. 1) THEN
        IF (CPR(1)(1:6) .EQ. 'ABSPSI') THEN
          CPR(1)(1:6) = 'TRMX  '
          GO TO 40
        ELSE IF (CPR(1)(1:6) .EQ. 'MULABS') THEN
          CPR(1)  = 'ADDSYM'
          CPR(2)  = ' '
          ISPR(5) = -1
          GO TO 40
        ELSE IF (CPR(1)(1:6) .EQ. 'ELTREF') THEN
          CPR(1)    = 'ADDSYM'
          CPR(2)    = ' '
          IGBL(117) = 0
        ELSE IF (CPR(1)(1:6) .EQ. 'ADDSYM') THEN
          CPR(1)  = 'SHELXL    '
          CPR(2)  = 'ANISO     '
          ISPR(7) = 1
          GO TO 40
        ELSE IF (CPR(1)(1:4) .EQ. 'TRMX') THEN
          IF (ISPR(6) .GT. 0) THEN
            CPR(1)  = 'SHELXL    '
            CPR(2)  = 'ANISO     '
            ISPR(7) = 1
            GO TO 40
          END IF
        ELSE IF (CPR(1)(1:6) .EQ. 'RENAME') THEN
          IF (ISPR(112) .GT. 0) THEN
            IF (SPAR(3) .LT. 36) THEN
              CPR(1)  = 'HDIF'
            ELSE
              CPR(1)  = 'HFIX'
            END IF
          END IF
          GO TO 40
        ELSE IF (CPR(1)(1:5) .EQ. 'VALID') THEN
          ISPR(6) = 7
          CPR(1)  = ' '
        END IF
      END IF
      CALL GEN038 (CPR(1), 1, 10)
      CALL GEN038 (CPR(2), 1, 10)
   10 IF (FROM(1:5) .EQ. 'START') THEN
        IF (COMPD .EQ. ' ') THEN
          OPEN (LU61, FILE = FNM(1:IU + 3)//'.compid',
     1          STATUS = 'UNKNOWN')
          READ (LU61, 99999, END = 20) COMPD
   20     CLOSE (UNIT = LU61)
        END IF
        CPR(1) = 'COMPID'
        CPR(2) =  COMPD
        GO TO 50
      ELSE IF (FROM(1:6) .EQ. 'COMPID') THEN
        CPR(1) = 'CELL'
      ELSE IF (FROM(1:4) .EQ. 'CELL') THEN
        IF (ISPR(1) .EQ. 1 .OR. ISPR(1) .EQ. 2) THEN
          CPR(1) = 'HELENA'
        ELSE
          IF (ISPR(37) .GT. 1) THEN
            CPR(1) = 'ABSPSI'
          ELSE
            CPR(1) = 'TRMX'
          END IF
        END IF
      ELSE IF (FROM(1:6) .EQ. 'HELENA') THEN
        IF (ISPR(37) .GT. 1) THEN
          CPR(1) = 'ABSPSI'
        ELSE
          CPR(1) = 'TRMX'
        END IF
      ELSE IF (FROM(1:6) .EQ. 'ABSPSI' .OR.
     1         FROM(1:7) .EQ. 'ABSNONE') THEN
        IF (ISPR(6) .LE. 0) THEN
          CPR(1) = 'TRMX'
        ELSE
          CPR(1) = 'SHELXL'
          IF (ISPR(6) .EQ. 1) THEN
            CPR(2) = 'ISO'
          ELSE
            CPR(2) = 'ANISO'
          END IF
        END IF
      ELSE IF (FROM(1:4) .EQ. 'TRMX') THEN
        CPR(1) = 'SPGR'
      ELSE IF (FROM(1:4) .EQ. 'SPGR') THEN
        IF (ISPR(6) .LT. 0) THEN
          CPR(1) = 'FORMULA'
        ELSE IF (ISPR(6) .GT. 0) THEN
          FROM = 'SHELXL'
          GO TO 10
        END IF
      ELSE IF (FROM(1:7) .EQ. 'FORMULA') THEN
        CPR(1) = 'Z'
      ELSE IF (FROM(1:2) .EQ. 'Z ') THEN
        IF (ISPR(11) .LT. 4) THEN
          INQUIRE (FILE = 'tm/sg/.newsym.res', EXIST = EXST)
          IF (EXST) THEN
            KERR = 0
            CALL SPAWN ('mv tm/sg/.newsym.res tm/sg/pn/s.res', KERR)
            ISPR(11) = 4
            CPR(1)   = 'SHELXL'
            CPR(2)   = 'ISO'
            ISPR(97) = 1
            INQUIRE (FILE = 'tm/sg/.newsym.sav', EXIST = EXST)
            IF (EXST) THEN
              OPEN (LU64, FILE = 'tm/sg/.newsym.sav',
     1              STATUS = 'UNKNOWN')
              READ (LU64, 99997) (CPR(I), I = 201, 204)
              CLOSE (UNIT = LU64)
              KERR = 0
              CALL SPAWN ('mv tm/sg/.newsym.sav tm/sg/pn/newsym.sav',
     1          KERR)
            END IF
          ELSE
            CALL S921 (-1)
          END IF
        END IF
      ELSE IF (FROM(1:5) .EQ. 'PHASE') THEN
        IF (ISPR(16) .EQ. 1 .OR. ISPR(16) .EQ. 2 .OR. ISPR(16) .EQ. 6)
     1    THEN
          CPR(1) = 'EXOR'
          CPR(2) = 'REFINE'
        ELSE IF (ISPR(16) .EQ. 3 .OR. ISPR(16) .EQ. 4
     1                           .OR. ISPR(16) .EQ. 5) THEN
          CPR(1) = 'EXOR'
          CPR(2) = ' '
        ELSE
          CPR(1) = 'SHELXL'
          CPR(2) = 'ISO'
        END IF
      ELSE IF (FROM(1:4) .EQ. 'EXOR') THEN
        CPR(1) = 'SHELXL'
        CPR(2) = 'ISO'
        CALL S920 (1)
      ELSE IF (FROM(1:6) .EQ. 'ADDSYM') THEN
        IF (ISPR(98) .EQ. 1) THEN
          CPR(1)    = 'TRMX'
          CPR(2)    = ' '
          ISPR(223) = 0
          ISPR(98)  = 0
        ELSE
          FROM = 'SHELXL'
          GO TO 10
        END IF
      ELSE IF (FROM(1:4) .EQ. 'ANIS') THEN
        CPR(1) = 'SHELXL'
        CPR(2) = ' '
        ISPR(7) = 0
      ELSE IF (FROM(1:6) .EQ. 'SHELXL') THEN
   30   IF (ISPR(6) .EQ. 1) THEN
          IF (SPAR(3) .GT. 8.5 .AND. ISPR(15) .EQ. 0 .AND.
     1        ISPR(5) .EQ. 0 .AND. ISPR(37) .GT. 0 .AND.
     2      (FLOAT(ISPR(70)) / ISPR(71) .GT. 2)) THEN
              CPR(1) = 'MULABS'
          ELSE
            IF (ISPR(97) .EQ. 1) THEN
              ISPR(97) = 0
              CPR(1)   = 'EXOR'
              CPR(2)   = ' '
            ELSE
              IF (IGBL(117) .EQ. 1) THEN
                CPR(1) = 'ELTREF'
                CPR(2) = ' '
              ELSE IF (IGBL(41) .EQ. 1) THEN
                CPR(1) = 'ADDSYM'
                CPR(2) = ' '
              ELSE
                CPR(1)  = 'SHELXL'
                CPR(2)  = 'ANISO'
                ISPR(7) = 1
                IGBL(117) = 1
              END IF
            END IF
          END IF
        ELSE IF (ISPR(6) .EQ. 2) THEN
          IF (IGBL(117) .EQ. 1) THEN
            CPR(1) = 'ELTREF'
            CPR(2) = ' '
          ELSE IF (ISPR(92) .EQ. 0 .AND. IGBL(50) .EQ. 0) THEN
            CPR(1) = 'RENAME'
          ELSE
            IF (ISPR(112) .GT. 0) THEN
              IF (SPAR(3) .LT. 36) THEN
                CPR(1) = 'HDIF'
              ELSE
                CPR(1) = 'HFIX'
              END IF
            ELSE
              ISPR(6) = 3
              GO TO 30
            END IF
          END IF
        ELSE IF (ISPR(6) .EQ. 3) THEN
          IF (ISPR(92) .EQ. 0 .AND. ISPR(93) .EQ. 0) THEN
            ISPR(93) = 1
            CPR(1) = 'RENUM'
            CPR(2) = ' '
          ELSE
            CPR(1)  = 'SHELXL'
            CPR(2)  = 'WEIGHT'
            ISPR(7) = 1
          END IF
        ELSE IF (ISPR(6) .EQ. 4) THEN
          IF (FROM(1:6) .EQ. 'SHELXL' .AND. IABS(IGBL(12)) .EQ. 1) THEN
            CPR(1) = 'VALID'
            CPR(2)  = ' '
          ELSE
            ISPR(6) = 5
            GO TO 30
          END IF
        ELSE IF (ISPR(6) .EQ. 5) THEN
          IF (IGBL(50) .NE. 2) THEN
            CPR(1)  = 'PLATON'
            CPR(2)  = 'ADP'
            ISPR(6) = 6
          ELSE
            CPR(1)  = 'EXIT'
            CPR(2)  = ' '
          END IF
        ELSE IF (ISPR(6) .EQ. 6) THEN
          CPR(1)  = 'PLUTON'
          CPR(2)  = ' '
          ISPR(6) = 7
        ELSE IF (ISPR(6) .EQ. 7) THEN
          CPR(1)  = 'REPORT'
          CPR(2)  = ' '
          ISPR(6) = 8
        ELSE IF (ISPR(6) .EQ. 8) THEN
          CPR(1) = 'EXIT'
          CPR(2) = ' '
        END IF
        ISPR(16)  = 0
      ELSE IF (FROM(1:6) .EQ. 'MULABS') THEN
        CPR(1) = 'SHELXL'
        IF (ISPR(6) .EQ. 1) THEN
          CPR(2) = 'ISO'
        ELSE
          CPR(2) = 'ANISO'
        END IF
      ELSE IF (FROM(1:4) .EQ. 'HDIF' .OR.
     1         FROM(1:4) .EQ. 'HFIX') THEN
        CPR(1)  = 'SHELXL'
        CPR(2)  = 'HATS'
        ISPR(7) = 1
      END IF
      IF (ISKIP .EQ. 0) THEN
        IF (ISPR(6) .GT. 2) THEN
          IF (SPAR(225) .GT. 0.5 .AND. SPAR(226) .LT. 0.5 .AND.
     1        ISPR(14) .NE. 8) THEN
            CPR(1) = 'INVERT'
            CPR(2) = ' '
          END IF
        END IF
      END IF
   40 CALL S920 (1)
   50 IF (IGBL(50) .LT. 2) WRITE (LU6, 99998, IOSTAT = IOST)
     1  FROM, CPR(1)
      RETURN
99999 FORMAT(A)
99998 FORMAT (/, ':: FROM ', A, ' TO ', A)
99997 FORMAT (6X, A)
      END SUBROUTINE S020
      SUBROUTINE S025
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP18=50,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER LIJN*80, TXT(41)*80, ABSTYPE(6)*8
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      CHARACTER PTYPE*5
      LOGICAL EXST
      DATA ABSTYPE /'ABSNONE ', '  ABSPSI', '  MULABS', '        ',
     1              'ABSTOMPA', '        '/
      IB      = 0
      IE      = 0
      TXT(2)  = 'Specify COMPOUND_ID as ''COMPID name'' '
      TXT(3)  = 'Where ''name'' is the compoundname e.g. s999x'
      TXT(4)  = 'Datareduction program HELENA. SHELX(S/L)-style '//
     1          'reflection file is setup.'
      TXT(5)  = 'Options: NOSCALE or MSM or MSA'
      TXT(6)  = 'Begin: Get the Unit Cell Data Corresponding to'//
     1          ' the Input Reflection Dataset'
      TXT(7)  = 'The TRMX keyword allows for pre-transformation of '//
     1          'the reflection data '
      TXT(8)  = 'before the determination of the Spacegroup from'//
     1          ' systematic extinctions'
      TXT(9)  = '(Useful for transformation to a subcell e.g. '//
     1          ' 1 0 0  0 1 0 0 0 0.5)'
      TXT(10) = 'Default: the refln data are analysed for '//
     1          'Lattice Centering & Laue symmetry'
      TXT(11) = 'The SPGR keyword allows explicit space group '//
     1          'specification (e.g. SPGR Ia3d) '
      TXT(12) = 'or automatic determination of the probable '//
     1          'space group(s) [ = Default].'
      TXT(13) = 'FORMULA * Z specifies the unit-cell content.'
      TXT(14) = 'Specify Molecular Formula (e.g. C10H21Hg1Br2 or '//
     1          'a crude approximation C1H2)'
      TXT(15) = 'Get number of Formula units Z in unitcell (E.g. Z 2)'
      TXT(16) = 'Default (RETURN): a reasonable value for Z is '//
     1          'suggested.'
      TXT(17) = 'DIRDIF procedure for structure determination of '
      TXT(18) = 'structures containing atoms with Z .gt. 14'
      TXT(19) = 'Alternatives are: SHELXS97/PATT, SHELXS97/TREF, '//
     1          'SIR, SHELXD'
      TXT(20) = 'The EXOR function performs a population and '//
     1          'difference Fourier refinement.'
      TXT(21) = 'The procedure should complete the '//
     1          'structure and eliminate ghost peaks.'
      TXT(22) = 'Alternatives to expand/complete the model '//
     1          'are : EXORS/D and SHELXL ISO 0 .'
      TXT(23) = 'SHELXS86 TREF Direct Methods (followed by EXOR) is'//
     1          ' used by default'
      TXT(24) = 'for light atom structures (Elem # < 15). '
      TXT(25) = 'Alternatives are the programs SHELXS97 (TREF/PATT),'//
     1          ' SIR97, SHELXD and ORIENT.'
      TXT(26) = 'The SHELXL function initiates a full-matrix '//
     1          'least-squares refinement'
      TXT(27) = '*** RENAME atoms before HFIX with RENAME ***'
      TXT(28) = 'The HDIF function will pickup H-atoms from the'//
     1          ' difference Fourier map'
      TXT(29) = 'Alternative: HFIX H-atoms at calculated positions'
      TXT(30) = ' '
      TXT(31) = 'HFIX H-atoms at calculated positions'
      TXT(32) = 'PLUTON - Display Result'
      TXT(33) = 'Semi-empirical absorption correction'
      TXT(34) = 'Structure Validation'
      TXT(35) = 'Report Generation'
      TXT(36) = 'PLATON/ADP - ORTEP view'
      TXT(37) = 'EXIT from System-S'
      TXT(38) = 'INVERT Structure in Next SHELXL Refinement'
      TXT(39) = 'MULABS multi-scan Absorption Correction Procedure'
      TXT(40) = 'ADDSYM Test for Missed Symmetry'
      TXT(41) = 'ELTREF Refinement of Element Type'
      IF (IGBL(50) .EQ. 2) GO TO 70
      IF (CPR(105)(1:5) .NE. 'START' .AND. IGBL(38) .EQ. 1) CALL S917
      PAR(453) = SIN (SPAR(55) / RGBL(6)) / SPAR(80)
   10 BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      LIJN      = 'S Y S T E M - S'
      CALL GGIP (HORS, VERT, 0.0, 1)
      IF (ISPR(48) .EQ. 0 .AND. IGBL(50) .EQ. 0) THEN
C * OPEN MAIN X-WINDOW, GET INPUT FROM MENU/KEYPRESS
        CALL GGIP09 (0.0,  LIJN, 15, 1.8, 4, 15, 1.8, VERT - 2.4)
        CALL GGIP09 (0.0,  LIJN, 15, 1.8, 2, 15, 1.6, VERT - 2.5)
        LIJN = 'A Crystallographic Shell'
        CALL GGIP09 (0.0,  LIJN, 26, 0.6, 1, 3, 7.0, VERT - 4.0)
        CALL GEN040 (IGBL(4), LIJN, IP)
        LIJN = '(C) 1991-2014 A.L.Spek - Version: '//LIJN(1:7)
        CALL GGIP09 (0.0,  LIJN, 40, 0.4, 3, 2, 6.1, VERT - 5.5)
        LIJN(1:46) = 'Type HELP for more (BROWSER) Information about'
        LIJN(47:76) = ' S Instructions on s[] prompt'
        CALL GGIP09 (0.0, LIJN, 77, 0.375, 1, 2, 0.5, VERT -  7.0)
        LIJN(1:43) = '     LIST to display current status'
        CALL GGIP09 (0.0, LIJN, 43, 0.375, 1, 2, 0.5, VERT - 7.9)
        LIJN(1:42) = '     TREE for Directory and File overview'
        CALL GGIP09 (0.0, LIJN, 42, 0.375, 1, 2, 0.5, VERT -  8.8)
        LIJN(1:42) = '     LOG  for job-history overview'
        CALL GGIP09 (0.0, LIJN, 42, 0.375, 1, 2, 0.5, VERT -  9.7)
        LIJN(1:39) = '     NQA  for "No-Questions-Asked" mode'
        CALL GGIP09 (0.0, LIJN, 39, 0.375, 1, 2, 0.5, VERT - 10.6)
        LIJN(1:45) = '     RELINK # To relink to a previous context'
        CALL GGIP09 (0.0, LIJN, 45, 0.375, 1, 2, 0.5, VERT - 11.5)
        LIJN(1:29) = '     CTRL-L to Refresh Screen'
        CALL GGIP09 (0.0, LIJN, 29, 0.375, 1, 2, 0.5, VERT - 12.4)
        LIJN(1:20) = '     EXIT to quit S'
        CALL GGIP09 (0.0, LIJN, 20, 0.375, 1, 2, 0.5, VERT - 13.3)
        LIJN(1:6) = 'platon'
        MPCOL = 2
        IF (IGBL(80) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 5.5,
     1       VERT -  8.8)
        LIJN(1:17) = 'External Software'
        CALL GGIP09 (0.0, LIJN, 17, 0.375, 5, 2, HORS - 5.5,
     1               VERT - 7.9)
        LIJN(1:6) = 'shelxs'
        MPCOL = 2
        IF (IGBL(111) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 2.5,
     1       VERT -  8.8)
        LIJN(1:6) = 'shelxl'
        MPCOL = 2
        IF (IGBL(110) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 5.5,
     1       VERT - 9.7)
        LIJN(1:6) = 'shelxd'
        MPCOL = 2
        IF (IGBL(112) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 2.5,
     1       VERT - 9.7)
        LIJN(1:6) = 'shelxt'
        MPCOL = 2
        IF (IGBL(119) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 5.5,
     1       VERT - 10.6)
        LIJN(1:6) = 'sir97 '
        MPCOL = 2
        IF (IGBL(113) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 2.5,
     1       VERT - 10.6)
        LIJN(1:7) = 'sir2004'
        MPCOL = 2
        IF (IGBL(114) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 7, 0.375, MPCOL, 2, HORS - 5.5,
     1       VERT - 11.5)
        LIJN(1:7) = 'sir2011'
        MPCOL = 2
        IF (IGBL(114) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 7, 0.375, MPCOL, 2, HORS - 2.5,
     1       VERT - 11.5)
        LIJN(1:6) = 'dirdif'
        MPCOL = 2
        IF (IGBL(115) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 2.5,
     1       VERT - 12.4)
        LIJN(1:6) = 'render'
        MPCOL = 2
        IF (IGBL(77) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 5.5,
     1       VERT - 12.4)
        LIJN(1:7) = 'cqbatch'
        MPCOL = 2
        IF (IGBL(118) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 7, 0.375, MPCOL, 2, HORS - 5.5,
     1       VERT - 13.3)
        LIJN(1:6) = 'povray'
        MPCOL = 2
        IF (IGBL(79) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 2.5,
     1       VERT - 13.3)
        MPCOL = 2
        IF (IGBL(47) .GT. 0) MPCOL = 3
        LIJN(1:7) = 'browser'
        CALL GGIP09 (0.0, LIJN, 7, 0.375, MPCOL, 2, HORS - 5.5,
     1       VERT -  14.2)
        LIJN(1:6) = 'rasmol'
        MPCOL = 2
        IF (IGBL(78) .GT. 0) MPCOL = 3
        CALL GGIP09 (0.0, LIJN, 6, 0.375, MPCOL, 2, HORS - 2.5,
     1       VERT - 14.2)
      ELSE
        CALL GGIP09 (0.0, LIJN, 15, 1.1, 4, 10, 6.5, VERT - 1.8)
        CALL GGIP09 (0.0, LIJN, 15, 1.1, 2, 10, 6.4, VERT - 1.9)
        CALL GGIP (0.0,  1.0,  0.0, 0)
        CALL GGIP (0.0,  17.0, 0.0, 3)
        CALL GGIP (HORS, 17.0, 0.0, 2)
        CALL GGIP (0.0,  16.0, 0.0, 3)
        CALL GGIP (HORS, 16.0, 0.0, 2)
        DO I = 1, ISPR(110)
          IF (SFAC(I)(2:2) .EQ. ' ') THEN
            SFC(I) = ' '//SFAC(I)(1:1)
          ELSE
            SFC(I) = SFAC(I)
            CALL GEN020 (-1, SFC(I), 2, 2)
          END IF
        END DO
        WRITE (LIJN, 99999, IOSTAT = IOST)
     1    SSTAT(ISPR(11)), COMPD, CPR(104),
     2    CPR(105)(1:9), CPR(106)(1:8)
        CALL GGIP09 (0.0,  LIJN, 80, 0.35, 3, 2, 0.5, 16.3)
        VRT = 16.0
        IF (IGBL(50) .EQ. 0) THEN
          IF (ISPR(110) .EQ. 0) THEN
            M80 = 22
          ELSE
            M80 = 80
          END IF
          IF (ISPR(120) .EQ. 0) THEN
            K80 = 22
          ELSE
            K80 = 80
          END IF
          IF (ISPR(3) .EQ. 0) THEN
            N80 = 22
          ELSE
            IF (ISPR(4) .EQ. 0) THEN
              N80 = 58
            ELSE
              N80 = 80
            END IF
          END IF
          L80 = N80
          IF (ISPR(70) .EQ. 0) THEN
            IF (ISPR(350) .EQ. 0) THEN
              L80 = MIN (L80, 22)
            ELSE
              L80 = MIN (L80, 35)
            END IF
          END IF
          IF (ISPR(6) .LT. 1) THEN
            L1 = MIN (N80, 58)
            L2 = MIN (N80, 47)
          ELSE
            L1 = N80
            L2 = N80
          END IF
          WRITE (LIJN, 99973, IOSTAT = IOST)
     1      SPAR(80), (SFC(I), I = 1, ISPR(110))
          CALL GGIP09 (0.0,  LIJN, M80, 0.35, 1, 2, 0.5, 15.5)
          CALL GEN038 (LIJN, 13, 21)
          CALL GGIP09 (0.0,  LIJN, M80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 15.5)
          WRITE (LIJN, 99998, IOSTAT = IOST)
     1          NINT(SPAR(10)), (ISPR(I + 136), I = 1, ISPR(110))
          CALL GGIP09 (0.0,  LIJN, M80, 0.35, 1, 2, 0.5, 15.0)
          CALL GEN038 (LIJN, 15, 21)
          CALL GEN038 (LIJN, 29, 80)
          CALL GGIP09 (0.0,  LIJN, M80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 15.0)
          WRITE (LIJN, 99997, IOSTAT = IOST) SPAR(101), SPAR(108),
     1          (ISPR(I + 120), I = 1, ISPR(110))
          CALL GGIP09 (0.0,  LIJN, K80, 0.35, 1, 2, 0.5, 14.5)
          CALL GEN038 (LIJN, 2, 21)
          CALL GEN038 (LIJN, 29, 80)
          CALL GGIP09 (0.0,  LIJN, K80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 14.5)
          WRITE (LIJN, 99996, IOSTAT = IOST) SPAR(102), SPAR(109),
     1          (ISPR(I + 152), I = 1, ISPR(110))
          CALL GGIP09 (0.0,  LIJN, K80, 0.35, 1, 2, 0.5, 14.0)
          CALL GEN038 (LIJN, 2, 21)
          CALL GEN038 (LIJN, 29, 80)
          CALL GGIP09 (0.0,  LIJN, K80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 14.0)
          WRITE (LIJN, 99995, IOSTAT = IOST)
     1      SPAR(103), SPAR(110), ISPR(350),
     1           SPAR(150), SPAR(151)
          CALL GGIP09 (0.0,  LIJN, L80, 0.35, 1, 2, 0.5, 13.5)
          CALL GEN038 (LIJN, 2,  21)
          CALL GEN038 (LIJN, 30, 35)
          CALL GEN038 (LIJN, 66, 80)
          CALL GGIP09 (0.0,  LIJN, L80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 13.5)
          WRITE (LIJN, 99994, IOSTAT = IOST)
     1      SPAR(104), SPAR(111), SPAR(123), ISPR(70), ISPR(71),
     2      ISPR(72), 2.0
          IF (LIJN(8:21) .EQ. '90.000( 0.000)')
     1        LIJN(8:21) = '    90        '
          CALL GGIP09 (0.0,  LIJN, L80, 0.35, 1, 2, 0.5, 13.0)
          CALL GEN038 (LIJN, 6, 21)
          CALL GEN038 (LIJN, 31, 57)
          CALL GEN038 (LIJN, 66, 69)
          CALL GGIP09 (0.0,  LIJN, L80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 13.0)
          DO I = 1, 7
            IF (CPR(100)(8 - I:8 - I) .NE. ' ') GO TO 20
          END DO
          I = 7
   20     WRITE (LIJN, 99993, IOSTAT = IOST)
     1      SPAR(105), SPAR(112), SPAR(121), CPR(100)(8-I+1:8),
     2      CPR(100)(1:8-I), ISPR(201), ISPR(202)
          IF (LIJN(8:21) .EQ. '90.000( 0.000)')
     1      LIJN(8:21) = '    90        '
          CALL GGIP09 (0.0,  LIJN, L1, 0.35, 1, 2, 0.5, 12.5)
          CALL GEN038 (LIJN, 6, 21)
          CALL GEN038 (LIJN, 29, 35)
          CALL GEN038 (LIJN, 50, 58)
          CALL GEN038 (LIJN, 65, 80)
          CALL GGIP09 (0.0,  LIJN, L1, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 12.5)
          WRITE (LIJN, 99992, IOSTAT = IOST)
     1      SPAR(106), SPAR(113), SPAR(122), ISPR(102), ISPR(203),
     2      SPAR(202), SPAR(203)
          IF (LIJN(8:21) .EQ. '90.000( 0.000)')
     1      LIJN(8:21) =    '    90        '
          IF (LIJN(7:21) .EQ. '120.000( 0.000)')
     1      LIJN(7:21) =    '    120        '
          CALL GGIP09 (0.0,  LIJN, L2, 0.35, 1, 2, 0.5, 12.0)
          CALL GEN038 (LIJN, 6, 21)
          CALL GEN038 (LIJN, 30, 35)
          CALL GEN038 (LIJN, 43, 46)
          CALL GEN038 (LIJN, 53, 57)
          CALL GEN038 (LIJN, 63, 70)
          CALL GEN038 (LIJN, 75, 80)
          CALL GGIP09 (0.0,  LIJN, L2, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 12.0)
          IF (ISPR(11) .LT. 5) THEN
            WRITE (LIJN, 99981, IOSTAT = IOST)
     1       SPAR(107), SPAR(114), ISPR(120)
          ELSE
            WRITE (LIJN, 99991, IOSTAT = IOST)
     1        SPAR(107), SPAR(114), ISPR(120), SPAR(220), SPAR(221),
     2        SPAR(222), SPAR(223)
          END IF
          CALL GGIP09 (0.0,  LIJN, N80, 0.35, 1, 2, 0.5, 11.5)
          CALL GEN038 (LIJN, 4, 21)
          CALL GEN038 (LIJN, 26, 35)
          CALL GEN038 (LIJN, 44, 57)
          CALL GEN038 (LIJN, 67, 80)
          CALL GGIP09 (0.0,  LIJN, N80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 11.5)
          IF (ISPR(6) .GT. 0) THEN
            WRITE (LIJN, 99987, IOSTAT = IOST)
     1        SPAR(129), SPAR(130), SPAR(131), SPAR(132), SPAR(133)
            CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.5, 11.0)
            CALL GEN038 (LIJN, 22, 35)
            CALL GEN038 (LIJN, 61, 72)
            CALL GGIP09 (0.0,  LIJN, 74, 0.35, 5 + IGBL(68), 2, 0.5,
     1                   11.0)
          END IF
          INQUIRE (FILE = 'tm/sg/addsym/addsym.nsg', EXIST = EXST)
          IF (EXST) THEN
            OPEN (LU61, FILE = 'tm/sg/addsym/addsym.nsg',
     1            STATUS = 'UNKNOWN')
            CALL GEN038 (LIJN, 1, 80)
            READ (LU61, '(5X, A)') LIJN (48:54)
            LIJN(39:47) = 'M/P-SPGR '
            ISPR(98)    = 1
            CLOSE (UNIT = LU61)
            CALL GGIP09 (0.0, LIJN, 54, 0.35, 2, 2, 0.5, 10.5)
          END IF
          IF (SPAR(52) .GT. 0.0) THEN
            IF (ISPR(6) .GT. 0) THEN
              IF (ISPR(310) .LE. 0) THEN
                N = 33
              ELSE
                N = 56
              END IF
            ELSE
              N = 23
            END IF
            WRITE (LIJN, 99978, IOSTAT = IOST) (SPAR(I), I = 51, 54)
            CALL GGIP09 (0.0,  LIJN, N, 0.35, 1, 2, 7.7, 10.0)
            CALL GGIP09 (0.0,  LIJN, 13, 0.35, 5 + IGBL(68), 2, 7.7,
     1                   10.0)
            WRITE (LIJN, 99977, IOSTAT = IOST)
     1        ISPR(51), ISPR(52), ISPR(57), ISPR(58), ISPR(311),
     2        ISPR(312), ISPR(313)
            CALL GGIP09 (0.0,  LIJN, N, 0.35, 1, 2, 7.7,  9.5)
            CALL GGIP09 (0.0,  LIJN, 13, 0.35, 5 + IGBL(68), 2, 7.7,
     1                   9.5)
            WRITE (LIJN, 99976, IOSTAT = IOST)
     1        ISPR(53), ISPR(54), ISPR(59), ISPR(60), ISPR(314),
     2        ISPR(315), ISPR(316)
            CALL GGIP09 (0.0,  LIJN, N, 0.35, 1, 2, 7.7,  9.0)
            CALL GEN038 (LIJN, 14, 33)
            N40 = MIN (N, 40)
            CALL GGIP09 (0.0,  LIJN, N40, 0.35, 5 + IGBL(68), 2, 7.7,
     1                   9.0)
            WRITE (LIJN, 99975, IOSTAT = IOST)
     1        ISPR(55), ISPR(56), ISPR(61), ISPR(62), ISPR(317),
     2        ISPR(318), ISPR(319)
            CALL GGIP09 (0.0,  LIJN, N, 0.35, 1, 2, 7.7,  8.5)
            CALL GGIP09 (0.0,  LIJN, 13, 0.35, 5 + IGBL(68), 2, 7.7,
     1                   8.5)
            IF (SPAR(225) .GE. -999.0 .AND. ISPR(310) .GE. 0) THEN
              IF (ISPR(14) .NE. 8) THEN
                WRITE (LIJN, 99985, IOSTAT = IOST)
     1          'Flack-x', SPAR(225), SPAR(226)
              ELSE
                WRITE (LIJN, 99985, IOSTAT = IOST)
     1          'Twin-x ', SPAR(225), SPAR(226)
              END IF
              CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.5, 10.5)
              CALL GGIP09 (0.0,  LIJN, 67, 0.35, 5 + IGBL(68), 2, 0.5,
     1                     10.5)
              IF (ISPR(91) .EQ. 1) THEN
                WRITE (LIJN, '(51X, ''INVERTED'')', IOSTAT = IOST)
                CALL GGIP09 (0.0, LIJN, 60, 0.35, 2, 2, 0.5, 10.5)
              END IF
            END IF
            IF (SPAR(227) .GT. 0.0 .OR. SPAR(228) .GT. 0.0) THEN
              WRITE (LIJN, 99984, IOSTAT = IOST)
     1        'EXTI', SPAR(227), SPAR(228)
              CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.5, 10.0)
              CALL GGIP09 (0.0,  LIJN, 64, 0.35, 5 + IGBL(68), 2, 0.5,
     1                     10.0)
            END IF
          END IF
          IF (NRLT .NE. 0) THEN
            CALL GGIP09 (0.0, CLATT(NRLT)//BLATT(NRLT), 2,
     1         0.35, 1, 1, 0.5, 10.0)
          END IF
          WRITE (LIJN, 99990, IOSTAT = IOST)
     1      ((TM(I, J), J = 1, 3), I = 1, 3),
     1                          ISPR(203)
          CALL GEN065 (0, LIJN, 80, 5)
          CALL GGIP09 (0.0, LIJN(1:12),  12, 0.35, 5 + IGBL(68), 2,
     1                 2.0, 10.0)
          CALL GGIP09 (0.0, LIJN(13:30), 18, 0.35, 1, 2, 0.5, 9.5)
          CALL GGIP09 (0.0, LIJN(31:48), 18, 0.35, 1, 2, 0.5, 9.0)
          CALL GGIP09 (0.0, LIJN(49:66), 18, 0.35, 1, 2, 0.5, 8.5)
          WRITE (LIJN, 99974, IOSTAT = IOST)
     1      (SPAR(I), I = 11, 13), AVIOS,
     1         SPAR(229), SPAR(230)
          IF (ISPR(310) .LT. 0) LIJN(55:59) = 'Flack'
          IF (AVIOS .EQ. 0.0) THEN
            N = 30
          ELSE IF (ISPR(310) .EQ. 0) THEN
            N = 47
          ELSE
            N = 80
          END IF
          CALL GGIP09 (0.0, LIJN, N, 0.35, 1, 2, 0.5, 7.5)
          CALL GEN038 (LIJN, 10, 30)
          CALL GEN038 (LIJN, 43, 47)
          CALL GEN038 (LIJN, 68, 80)
          CALL GGIP09 (0.0, LIJN, N, 0.35, 5 + IGBL(68), 2, 0.5, 7.5)
          IF (SPAR(15) .NE. 0.0) THEN
            IF (ISPR(99) .LT. IGBL(89)) THEN
              PTYPE = 'EQUAL'
            ELSE
              PTYPE = 'HEAVY'
            END IF
            WRITE (LIJN, 99972, IOSTAT = IOST)
     1        SPAR(15), PTYPE, SPAR(16)
            CALL GGIP09 (0.0, LIJN, 48, 0.35, 1, 2, 0.5, 7.0)
            CALL GEN038 (LIJN, 15, 19)
            CALL GEN038 (LIJN, 32, 36)
            CALL GGIP09 (0.0, LIJN, 42, 0.35, 5 + IGBL(68), 2, 0.5, 7.0)
          END IF
          CALL GGIP09 (0.0, PROBLEM, 80, 0.35, 2, 2, 0.5, 6.5)
          IF (ISPR(3) .EQ. 0) THEN
            INQUIRE (FILE = 'latt/latt.lis', EXIST = EXST)
            IF (EXST) THEN
              VRT = 16.0
              N   = 0
              OPEN (LU61, FILE = 'latt/latt.lis', STATUS = 'UNKNOWN')
  30          READ (LU61, 99971, END = 50, ERR = 50) LIJN
              IF (LIJN(1:3) .NE. 'sh ') GO TO 30
              VRT = VRT - 0.5
              CALL GGIP09 (0.0, LIJN, 80, 0.25, -1, 2, 7.7, VRT)
              READ (LU61, 99971, END = 50, ERR = 50)
  40          READ (LU61, 99971, END = 50, ERR = 50) LIJN
              IF (LIJN(1:2) .NE. '  ') THEN
                VRT = VRT - 0.5
                N   = N + 1
                CALL GGIP09 (0.0, LIJN, 80, 0.25, -1, 2, 7.7, VRT)
                IF (N .LT. 22) GO TO 40
              END IF
  50          CONTINUE
            ELSE
              IF (ISPR(15) .EQ. 0) CALL S060 (-1, 0, 0, 0, 0.0)
            END IF
          END IF
        ELSE
          CALL S910
          IF (IGBL(50) .EQ. 0) GO TO 10
        END IF
      END IF
      IF (IGBL(50) .EQ. 0) THEN
        IB = 0
        IE = 0
        SELECT CASE (CPR(1)(1:6))
          CASE ('COMPID')
            IB = 2
            IE = 3
          CASE ('HELENA')
            IB = 4
            IE = 5
          CASE ('CELL  ')
            IB = 6
            IE = 6
          CASE ('ABSPSI')
            IB = 33
            IE = 33
          CASE ('TRMX  ')
            IB = 7
            IE = 10
          CASE ('SPGR  ')
            IB = 11
            IE = 12
          CASE ('FORMUL')
            IB = 13
            IE = 14
          CASE ('Z     ')
            IB = 15
            IE = 16
          CASE ('DIRDIF')
            IB = 17
            IE = 19
          CASE ('EXOR  ')
            IB = 20
            IE = 22
          CASE ('SHELXS')
            IB = 23
            IE = 25
          CASE ('SHELXL')
            IB = 26
            IE = 27
          CASE ('RENAME')
            IB = 27
            IE = 27
          CASE ('HDIF  ')
            IB = 28
            IE = 29
          CASE ('MULABS')
            IB = 39
            IE = 39
          CASE ('HFIX  ')
            IB = 31
            IE = 31
          CASE ('PLUTON')
            IB = 32
            IE = 32
          CASE ('VALID ')
            IB = 34
            IE = 34
          CASE ('REPORT')
            IB = 35
            IE = 35
          CASE ('PLATON')
            IF (CPR(2)(1:3) .EQ. 'ADP')  THEN
              IB = 36
              IE = 36
            END IF
          CASE ('EXIT  ')
            IB = 37
            IE = 37
          CASE ('INVERT')
            IB = 38
            IE = 38
          CASE ('ADDSYM')
            IB = 40
            IE = 40
          CASE ('ELTREF')
            IB = 41
            IE = 41
        END SELECT
        VRT = (IE - IB + 1) * 0.7 + 0.5
        CALL GGIP (0.0, 1.0, 0.0, 0)
        VRT = VRT + 0.6
        CALL GGIP (0.0,  VRT, 0.0, 3)
        CALL GGIP (HORS, VRT, 0.0, 2)
        IF (VALIDATION(1:8) .NE. '        ') THEN
          CALL GGIP09 (0.0, 'VALIDATION :'//VALIDATION, 57, 0.35,
     1                 2, 2, 0.5, 6.0)
        END IF
        IF (CPR(105)(1:5) .NE. 'START') THEN
          DO I = 1, 2
            CALL GGIP09 (0.0, LNKS(I), 80, 0.375, 3, 2, 0.5,
     1                   VRT + 1.4 - I * 0.6)
          END DO
        END IF
        CALL GGIP (0.0,  VRT + 1.3, 0.0, 3)
        CALL GGIP (HORS, VRT + 1.3, 0.0, 2)
        IF (ISPR(48) .EQ. 0) THEN
          CALL GGIP09 (0.0, DATAORG, 80, 0.375, 3, 2, 0.5, VRT + 1.5)
        ELSE
          LIJN(1:42)  = 'DataRed  AbsCorr  Phasing  Workup   Refine'
          LIJN(43:80) = '   H-Atoms  Labels   Solv-Dis Transfer'
          CALL GGIP09 (0.0, LIJN, 80, 0.35, 5 + IGBL(68), 2, 0.5,
     1                 VRT + 2.1)
          WRITE (LIJN, 99986, IOSTAT = IOST)
     1      (CPR(200 + I)(1:9), I = 1, 8), CPR(209)(1:8)
          CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.5, VRT + 1.5)
          CALL GGIP (0.0,  VRT + 2.6, 0.0, 3)
          CALL GGIP (HORS, VRT + 2.6, 0.0, 2)
          IF (ISPR(15) .NE. 0) THEN
            IF (ISPR(15) .EQ. 6) THEN
            ELSE
              WRITE (LIJN, 99989, IOSTAT = IOST)
     1          ABSTYPE(ISPR(15)), SPAR(126), SPAR(127)
            END IF
            CALL GGIP09 (0.0,  LIJN, 80, 0.35, -1, 2, 0.5, VRT + 2.8)
          END IF
          IF (ISPR(223) .GT. 0) THEN
            WRITE (LIJN, 99979, IOSTAT = IOST)
     1        ISPR(223), ISPR(220), ISPR(221),
     1             ISPR(222), SPAR(141), SPAR(142), SPAR(140)
            CALL GGIP09 (0.0,  LIJN, 80, 0.35, 2, 2, 0.5, VRT + 3.3)
          END IF
        END IF
      ELSE
        CALL GGIP (0.0,   1.0, 0.0, 0)
        CALL GGIP (0.0,   0.0, 0.0, 3)
        CALL GGIP (HORS,  0.0, 0.0, 2)
        CALL GGIP (HORS, VERT, 0.0, 2)
        BCD =
     1    'N.Q.A. - M O D E  --  SIT BACK, SEE WHAT HAPPENS'//CHAR(0)
        CALL GGIP (-999.0, 3.0, 60.0, 112)
      END IF
      K  = 1
      KP = 1
      DO I = 1, 2
        DO J = 1, 8
          IF (CPR(I)(9 - J:9 - J) .NE. ' ') THEN
            KP = K + 8 - J
            LINE(K:KP) = CPR(I)(1:9 - J)
            LINE(KP + 1:KP + 1) = ' '
            K = KP + 2
            GO TO 60
          END IF
        END DO
   60   CONTINUE
      END DO
      IF (IGBL(50) .EQ. 0) THEN
        CALL GEN038 (LINE, KP + 1, 80)
        IF (IB .NE. 0) THEN
          SBCD  = 's['//LINE(1:KP)//']'//CHAR(0)
          VRT = VRT - 0.6
          DO I = IB, IE
            CALL GGIP09 (0.0, TXT(I), 77, 0.375, 2, 2, 0.5, VRT)
            VRT = VRT - 0.7
          END DO
          LIJN(1:36)  = 'Click on ACCEPT or Hit ENTER Key to '
          LIJN(37:73) = 'accept suggested default shown in [].'
          CALL GGIP09 (0.0,  LIJN, 73, 0.375, 5 + IGBL(68), 2, 0.5,
     1                 0.5)
        END IF
      ELSE
        CALL GGIP (0.0, 0.0, 0.0, -1)
      END IF
   70 RETURN
99999 FORMAT ('Status = ', A, ' for ', A, 'From tm/sg/pn/ = ', A,
     1 ' - ', A, A)
99998 FORMAT ('Temp(K)', 8X, I6, 3X, 'Form ', 2I4, 14I3)
99997 FORMAT ('a    ', F8.4, '(', F6.4, ')   Unit ', 2I4, 14I3)
99996 FORMAT ('b    ', F8.4, '(', F6.4, ')   Cont ', 2I4, 14I3)
99995 FORMAT ('c    ', F8.4, '(', F6.4, ')   Faces', I6, 3X,
     1        'Nmeas  Nuniq   Nobs', 3X, 'Rint ', F5.3, 5X, F5.3)
99994 FORMAT ('alpha', F8.3, '(', F6.3, ')   mu(mm)', F5.2, I8,
     1 2I7, 3X, 'I gt', F5.1, ' * Sigma(I)')
99993 FORMAT ('beta ', F8.3, '(', F6.3, ')   d(x)', F7.3,
     1 3X, 'Space Group', A, A, 3X, 'Nref', I6, I10)
99992 FORMAT ('gamma', F8.3, '(', F6.3, ')   AtVol', F6.1,
     1 3X, 'Nsym', I4, 2X, 'Npar', I5, 3X, 'R', F9.3, ' wR2', F6.3)
99991 FORMAT ('Vol', F12.2, '(', F4.2, ')', '   Z', I10,
     1 3X, 'OldW:', F7.4, F7.3, 3X, 'Rec.W:', F7.4, F7.3)
99990 FORMAT (' HKLF - TRMX', 9F6.3, 4X, 'Npar', I5)
99989 FORMAT (15X, A, ' Absorption Correction:',
     1 ' - Transm. Min. Max = ', 2F6.3)
99987 FORMAT ('Resid. Dens. Extrema:', 2X, 2F6.2, 2X,
     1        ' Mean & Max Shift/Err: ', F5.3, F7.3, ' S', F6.2)
99986 FORMAT (9A)
99985 FORMAT (60X, A, F7.2, '(', F4.2, ')')
99984 FORMAT (60X, A, F7.4, '(', F7.4, ')')
99981 FORMAT ('Vol', F12.2, '(', F4.2, ')', '   Z', I10)
99979 FORMAT (I3, ' Outliers:MaxH,K,L', 3I3,' Fo^2=',F10.2,
     1        ' Fc^2=', F10.2, ' Del/Sig=',F8.2)
99978 FORMAT ('THmin,THmax =', 4F5.1)
99977 FORMAT ('Hmin, Hmax  =', 4I5, 14X, 3I3)
99976 FORMAT ('Kmin, Kmax  =', 4I5, 3X, 'TWIN', 7X, 3I3)
99975 FORMAT ('Lmin, Lmax  =', 4I5, 14X, 3I3)
99974 FORMAT ('Size (mm) ', F5.2, ' x', F5.2, ' x', F5.2,
     1 2X, 'Mean(I/sig)', F5.1, 13X, 'BASF', F9.3, '(', F5.3, ')')
99973 FORMAT (
     1 'WaveLength ', F10.5, 3X, 'Elem', 1X, 2(2X, A), 14(1X, A))
99972 FORMAT ('Av Abs(E**2-1)', F5.2, 2X, 'PATT TYPE ', A, 2X,
     1        'U =', F6.3)
99971 FORMAT (A)
      END SUBROUTINE S025
      SUBROUTINE S030 (ISW)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      INTEGER CHANDIR
      LOGICAL EXST
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER LIN*256
      IERR = 0
      EXST = .FALSE.
C * LIST CURRENT STATUS
   10   CALL S025
   20 CALL GEN038 (IGGT, 1, 80)
      IF (IGBL(50) .EQ. 0 .AND. ISPR(47) .EQ. 0) THEN
        CALL PLA013 (0, 0)
        LIN = IGGT
        CALL GEN020 (1, IGGT, 1, 80)
        IF (LRET .EQ. 2 .OR. IGGT(1:3) .EQ. 'REF' .OR.
     1      IGGT(1:4) .EQ. 'PLOT') GO TO 10
        IF (IGGT(1:4) .EQ. 'SKIP') THEN
          CALL S020 (1)
          GO TO 10
        END IF
        IF (IGGT(1:1) .NE. CHAR(32) .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        END IF
        CALL GEN020 (1, LINE, 1, 6)
        IF (CPR(1)(1:6) .EQ. 'COMPID' .AND. LINE(1:6) .NE. 'COMPID')
     1    THEN
          IGGT = LINE
          LINE = CPR(1)//LIN(1:70)
          CALL GEN038 (IGGT, 1, 80)
        END IF
        CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 0, 1, 0, 10, NP17)
        IF (JFL(1)(1:6) .EQ. 'COMPID' .AND. KL .GT. 1) THEN
          KL     = 2
          CALL GEN038 (JFL(2), 1, 10)
          NB = 7
          NE = 80
          CALL GEN039 (0, LINE, 7, 80, NB, NE)
          JFL(2) = LINE(NB:NE)
          IF (JFL(2)(1:2) .NE. '-s') THEN
            CPR(2) = JFL(2)
            COMPD  = CPR(2)
          END IF
        ELSE IF (CPR(1)(1:7) .EQ. 'FORMULA' .AND. KL .GT. 0) THEN
          DO I = 2, 3
            CALL GEN105 (3, JFL(1)(I:I), J)
            IF (J .GE. 0) THEN
              DO N = 1, KL
                JFL(KL + 2 - N) = JFL(KL + 1 - N)
              END DO
              JFL(1) = 'FORMULA'
              KL = KL + 1
              GO TO 30
            END IF
          END DO
        END IF
      ELSE
        CALL GGIP (0.0, 0.0, 0.0, -1)
        KL = 0
        KN = 0
        ISPR(47) = 0
      END IF
C * ACCEPT SUGGESTED INSTRUCTION
   30 IPR(221) = KN
      IF (KL .EQ. 0) THEN
        JFL(1) = CPR(1)
        KL     = 1
        IF (CPR(2) .NE. ' ') THEN
          JFL(2) = CPR(2)
          KL     = 2
        END IF
      END IF
      IF (IGBL(50) .EQ. 0) THEN
        LIN = 'EXEC='//JFL(1)
        CALL GGIP09 (0.0, LIN, 17, 0.7, 4, 4, 18.1, 14.6)
        CALL GGIP09 (0.0, LIN, 17, 0.7, 2, 4, 18.0, 14.5)
        CALL GGIP (0.0, 0.0, 0.0, 6)
        SBCD = CHAR(0)
      END IF
C * COMPID SPECIFICATION
      IF (JFL(1)(1:6) .EQ. 'COMPID') THEN
        CALL S015
C * CHECK/GET WAVELENGTH AND UNIT CELL PARAMETERS
      ELSE IF (JFL(1)(1:4) .EQ. 'CELL') THEN
        ISPR(48) = 1
        CALL S040
C * ASYM
      ELSE IF (JFL(1)(1:4) .EQ. 'ASYM') THEN
        CALL S110
C * ABSGAUSS
      ELSE IF (JFL(1)(1:8) .EQ. 'ABSGAUSS') THEN
        CALL S140
C * ABSTOMPA
      ELSE IF (JFL(1)(1:8) .EQ. 'ABSTOMPA') THEN
        CALL S150
C * ABSNONE
      ELSE IF (JFL(1)(1:7) .EQ. 'ABSNONE') THEN
        CALL S155
C * TRMX - SELECT LATTICE
      ELSE IF (JFL(1)(1:4) .EQ. 'TRMX') THEN
        CALL S160
C * SELECT SPACE GROUP SYMMETRY
      ELSE IF (JFL(1)(1:4) .EQ. 'SPGR') THEN
        CALL S170
C * DEFINE UNIT CELL CONTENT (FORMULA)
      ELSE IF (JFL(1)(1:7) .EQ. 'FORMULA') THEN
        CALL S180 (0)
C * Z
      ELSE IF (JFL(1)(1:2) .EQ. 'Z ') THEN
        CALL S190 (0, IER)
C * STRUCTURE DETERMINATION METHODS
C * SHELXS (86/97) (TREF/TEXP/PATT)
      ELSE IF (JFL(1)(1:6) .EQ. 'SHELXS') THEN
        CPR(52) = 'TREF'
        IF (KL .GT. 1) THEN
          IF (JFL(2)(1:4) .EQ. 'PATT') THEN
            CPR(52) = 'PATT'
          ELSE IF (JFL(2)(1:4) .EQ. 'TEXP') THEN
            CPR(52) = 'TEXP'
          END IF
        END IF
        IF (JFL(1)(7:8) .EQ. '86') THEN
          ISPR(16) = 1
        ELSE
          ISPR(16) = 2
        END IF
        CALL S200
C * SIR(97/2004/2011)
      ELSE IF (JFL(1)(1:3) .EQ. 'SIR') THEN
        IF (JFL(1)(4:5) .EQ. '  ' .OR. JFL(1)(4:5) .EQ. '97') THEN
          IF (IGBL(113) .NE. 0) ISPR(16) = 3
        ELSE IF (JFL(1)(4:7) .EQ. '2004') THEN
          IF (IGBL(114) .NE. 0) ISPR(16) = 4
        ELSE IF (JFL(1)(4:7) .EQ. '2011') THEN
          IF (IGBL(120) .NE. 0) ISPR(16) = 9
        END IF
        IF (ISPR(16) .EQ. 3 .OR. ISPR(16) .EQ. 4 .OR. ISPR(16) .EQ. 9)
     1    THEN
          CALL S200
        ELSE
          CALL PLA015 (0, 57)
          IGBL(107) = IGBL(107) -1
          GO TO 10
        END IF
C * DIRDIF08 (PATTY/PHASEX/ORIENT)
      ELSE IF (JFL(1)(1:6) .EQ. 'DIRDIF') THEN
        CPR(62) = 'PATTY'
        IF (KL .GT. 1) THEN
          IF (JFL(2)(1:6) .EQ. 'ORIENT') THEN
            CPR(62) = 'ORIENT'
          ELSE IF (JFL(2)(1:6) .EQ. 'PHASEX') THEN
            CPR(62) = 'PHASEX'
        END IF
        IF (CPR(62)(1:5) .EQ. 'PATTY' .AND. SPAR(3) .LT. 15) THEN
            CALL PLA015 (0, 11)
            GO TO 70
          END IF
        END IF
        IF (IGBL(115) .NE. 0) THEN
          ISPR(16) = 5
          CALL S200
        END IF
C * SHELXD
      ELSE IF (JFL(1)(1:6) .EQ. 'SHELXD') THEN
        IF (IGBL(112) .NE. 0) THEN
          ISPR(16) = 6
          CALL S200
        END IF
C * FLIPPER
      ELSE IF (JFL(1)(1:7) .EQ. 'FLIPPER') THEN
        ISPR(16) = 7
        CALL S200
C * SHELXT
      ELSE IF (JFL(1)(1:6) .EQ. 'SHELXT') THEN
        ISPR(16) = 8
        CALL S200
C * SIR2011
      ELSE IF (JFL(1)(1:7) .EQ. 'SIR2011') THEN
        ISPR(16) = 9
        CALL S200
C * REMOVE GHOSTS AND INTERPRET PEAKLIST (EXOR)
      ELSE IF (JFL(1)(1:5) .EQ. 'EXOR ') THEN
        INQUIRE (FILE = FNM(1:IN)//'s.res', EXIST = EXST)
        IF (.NOT. EXST) THEN
          ISPR(16) = 1
          CALL S200
        END IF
        IF (JFL(2)(1:6) .EQ. 'REFINE') THEN
          IP2 = 4
          IP3 = 3
          IP4 = 2
        ELSE
          IP2 = 5
          IP3 = 4
          IP4 = 0
        END IF
        IF (KN .GT. 0) IP2 = NINT(FN(1))
        IF (KN .GT. 1) IP3 = NINT(FN(2))
        IF (KN .GT. 2) IP4 = NINT(FN(3))
        CALL S300 (IP2, IP3, IP4)
C * REMOVE GHOSTS (USING SIR97) AND INTERPRET   (EXORS)
      ELSE IF (JFL(1)(1:5) .EQ. 'EXORS') THEN
        INQUIRE (FILE = FNM(1:IN)//'s.res', EXIST = EXST)
        IF (.NOT. EXST) THEN
          ISPR(16) = 1
          CALL S200
        END IF
        IF (IGBL(113) .NE. 0) CALL S301 (IERR)
C * REMOVE GOSTS (USING DIRDIF99) AND INTERPRET   (EXORD)
      ELSE IF (JFL(1)(1:5) .EQ. 'EXORD') THEN
        INQUIRE (FILE = FNM(1:IN)//'s.res', EXIST = EXST)
        IF (.NOT. EXST) THEN
          ISPR(16) = 1
          CALL S200
        END IF
        IF (IGBL(115) .NE. 0) CALL S302 (IERR)
C * CHECK ATOM TYPE ASSIGNMENT
      ELSE IF (JFL(1)(1:6) .EQ. 'ELTREF') THEN
        IGBL(117) = 0
        FN(1)     = 0.0
        FN(2)     = 0.0
        CALL S305 (1, 2)
C * REFINE STRUCTURE - SHELXL97
      ELSE IF (JFL(1)(1:6) .EQ. 'SHELXL' .OR.
     1         JFL(1)(1:4) .EQ. 'CGLS') THEN
        IF (JFL(1)(1:4) .EQ. 'CGLS') THEN
          ICGLS = 1
        ELSE
          ICGLS = 0
        END IF
        ISPR(7) = 0
        IF (ISPR(11) .GE. 4) THEN
          IF (KL .GT. 1) THEN
            IF (JFL(2)(1:3) .EQ. 'ISO') THEN
              IF (ISPR(6) .EQ. 0) THEN
                ISPR(7) = 1
              ELSE
                ISPR(6) = 1
                ISPR(7) = 0
              END IF
            ELSE IF (JFL(2)(1:5) .EQ. 'ANISO') THEN
              IF (ISPR(6) .EQ. 1) THEN
                ISPR(7) = 1
              ELSE
                ISPR(6) = 2
                ISPR(7) = 0
              END IF
            ELSE IF (JFL(2)(1:4) .EQ. 'HATS') THEN
              IF (ISPR(6) .EQ. 2) THEN
                ISPR(7) = 1
              ELSE
                ISPR(6) = 3
                ISPR(7) = 0
              END IF
            ELSE IF (JFL(2)(1:6) .EQ. 'WEIGHT') THEN
              IF (ISPR(6) .EQ. 3) THEN
                ISPR(7) = 1
              ELSE
                ISPR(6) = 4
                ISPR(7) = 0
              END IF
            END IF
          END IF
          CALL S310 (ICGLS, IERR)
          CALL S926
        ELSE
          GO TO 40
        END IF
C * ADDSYM
      ELSE IF (JFL(1)(1:6) .EQ. 'ADDSYM') THEN
        CALL S420 ('ADDSYM')
        IGBL(41) = 0
C * INVERT STRUCTURE
      ELSE IF (JFL(1)(1:6) .EQ. 'INVERT') THEN
        CALL S175
C * HFREE
      ELSE IF (JFL(1)(1:5) .EQ. 'HFREE') THEN
        ISPR(90) = 1
        CPR(206) = 'HFREE     '
C * ABSPSI
      ELSE IF (JFL(1)(1:6) .EQ. 'ABSPSI') THEN
        IF (ISPR(37) .GT. 0) THEN
          IF (ISPR(37) .GT. 1) CALL S120
        ELSE
          CALL PLA015 (0, 35)
        END IF
C * MULABS PROCEDURE
      ELSE IF (JFL(1)(1:6) .EQ. 'MULABS') THEN
        IF (ISPR(37) .GT. 0) THEN
          CALL S130
        ELSE
          CALL PLA015 (0, 35)
        END IF
C * SQUEEZE PROCEDURE
      ELSE IF (JFL(1)(1:7) .EQ. 'SQUEEZE') THEN
        IF (ISPR(11) .GE. 4)  THEN
          CALL S340
        ELSE
          GO TO 40
        END IF
C * TWINROTMAT
      ELSE IF (JFL(1)(1:7) .EQ. 'TWINMAT') THEN
        CALL S350
C * H-ATOMS PICKUP PROCEDURE
      ELSE IF (JFL(1)(1:4) .EQ. 'HDIF') THEN
        IF (ISPR(11) .GE. 5) THEN
          ISPR(7) = 1
          CALL S330
        ELSE
          GO TO 40
        END IF
C * SHOW STRUCTURE (PLUTON)
      ELSE IF (JFL(1)(1:6) .EQ. 'PLUTON') THEN
        NDIF = 0
        IF (KN .GT. 0) THEN
          NDIF = NINT(FN(1))
        END IF
        IGBL(50) = 0
        CALL S410 (NDIF)
        CALL S926
C * PLUTON/RENAME
      ELSE IF (JFL(1)(1:6) .EQ. 'RENAME') THEN
        ISPR(92) = 1
        NDIF     = -1
        CALL S410 (NDIF)
        CPR(207) = 'RENAME'
        CALL S926
C * PLUTON/HFIX
      ELSE IF (JFL(1)(1:4) .EQ. 'HFIX') THEN
        NDIF = -2
        CALL S410 (NDIF)
        ISPR(7)  = 1
        CPR(206) = 'HFIX'
        CALL S926
C * PLUTON/ANIS
      ELSE IF (JFL(1)(1:4) .EQ. 'ANIS') THEN
        NDIF = -3
        CALL S410 (NDIF)
        IGBL(6)  = 19
        CPR(105) = 'ANIS'
        CPR(106) = CPR(200)
        CALL S926
C * PLATON/AUTORENUM
      ELSE IF (JFL(1)(1:4) .EQ. 'RENU') THEN
        CALL S937
        CPR(207) = 'RENUM'
C * CALL R-PLUTO FOR RES/CIF
      ELSE IF (JFL(1)(1:6) .EQ. 'RPLUTO') THEN
        CALL S411
C * ANALYSE STRUCTURE - PLATON
      ELSE IF (JFL(1)(1:6) .EQ. 'PLATON') THEN
        IF (KL .EQ. 1) JFL(2)(1:) = ' '
        CALL S420 (JFL(2))
C * CONTOUR PLOTS
      ELSE IF (JFL(1)(1:7) .EQ. 'CONTOUR') THEN
        CALL S430
C * SAVE AND EOF/END/EXIT/QUIT PROCEDURE
      ELSE IF (JFL(1)(1:3) .EQ. 'EOF')  THEN
        GO TO 50
      ELSE IF (JFL(1)(1:3) .EQ. 'END')  THEN
        GO TO 50
      ELSE IF (JFL(1)(1:4) .EQ. 'EXIT') THEN
        GO TO 50
      ELSE IF (JFL(1)(1:4) .EQ. 'QUIT') THEN
        GO TO 50
C * EDIT-RES
      ELSE IF (JFL(1)(1:7) .EQ. 'EDITRES') THEN
        KERR = 0
        CALL SPAWN (EDITOR//' s.res', KERR)
        CALL GEN038 (IGGT, 1, 80)
        CALL GEN038 (LINE, 1, 80)
        GO TO 10
C * UTILITIES
      ELSE IF (JFL(1)(1:3) .EQ. 'SET') THEN
        IF (JFL(2)(1:3) .EQ. 'REV') THEN
          IGBL(68) = MOD(IGBL(68) + 1, 2)
          CALL GGIP (-999.0, FLOAT(IGBL(68)), IGBL(62) * 0.25, 9)
        ELSE
          IND  = NINT(FN(1))
          VAL  = FN(2)
          IVAL = NINT(VAL)
          IF (KL .GT. 1) THEN
            IF (JFL(2)(1:4) .EQ. 'ISPR') THEN
              IF (IND .LT. 1 .OR. IND .GT. NP2) THEN
                WRITE (LU6, 99983, IOSTAT = IOST)
              ELSE
                IVLO     = ISPR(IND)
                ISPR(IND) = IVAL
                WRITE (LU6, 99982, IOSTAT = IOST) IND, IVLO, IVAL
              END IF
            ELSE IF (JFL(2)(1:4) .EQ. 'SPAR') THEN
              IF (IND .LT. 1 .OR. IND .GT. NP1) THEN
                WRITE (LU6, 99983, IOSTAT = IOST)
              ELSE
                VALO     = SPAR(IND)
                SPAR(IND) = VAL
                WRITE (LU6, 99981, IOSTAT = IOST) IND, VALO, VAL
              END IF
            ELSE IF (JFL(2)(1:3) .EQ. 'CPR') THEN
              IF (IND .LT. 1 .OR. IND .GT. NP3) THEN
                WRITE (LU6, 99983, IOSTAT = IOST)
              ELSE
                WRITE (LU6, 99980, IOSTAT = IOST)
     1            IND, CPR(IND), JFL(3)
                CPR(IND) = JFL(3)
              END IF
            ELSE IF (JFL(2)(1:4) .EQ. 'IGBL') THEN
              CALL PLA206 (1, 'IGB')
            ELSE IF (JFL(2)(1:4) .EQ. 'RGBL') THEN
              CALL PLA206 (1, 'RGB')
            ELSE IF (JFL(2)(1:3) .EQ. 'IPR') THEN
              CALL PLA206 (1, 'IPR')
            ELSE IF (JFL(2)(1:4) .EQ. 'PAR') THEN
              CALL PLA206 (1, 'PAR')
            END IF
          END IF
          GO TO 20
        END IF
C * TWIN
      ELSE IF (JFL(1)(1:5) .EQ. 'TWIN ') THEN
        CALL S905
        GO TO 10
      ELSE IF (JFL(1)(1:2) .EQ. 'CD') THEN
        WRITE (LU6, 99999, IOSTAT = IOST) JFL(1)(1:2)
      ELSE IF (JFL(1)(1:3) .EQ. 'LOG') THEN
        CALL S915 ('LOG')
      ELSE IF (JFL(1)(1:4) .EQ. 'LRES') THEN
        CALL S916
      ELSE IF (JFL(1)(1:6) .EQ. 'SHXLPS') THEN
        INQUIRE (FILE = 'tm/sg/shelxl/shelxl.lst', EXIST = EXST)
        IF (EXST) THEN
          OPEN (LU64, FILE = 'tm/sg/shelxl/shelxl.lst',
     1          STATUS = 'UNKNOWN')
          OPEN (LU65, FILE = 'tm/sg/shelxl/shelxl.lps',
     1          STATUS = 'UNKNOWN')
          CALL GEN089 (LU64, LU65, 100, IGBL(102))
          CLOSE (UNIT = LU64)
          CLOSE (UNIT = LU65)
          KERR = 0
          CALL SPAWN (PSVIEWER//'tm/sg/shelxl/shelxl.lps', KERR)
        END IF
      ELSE IF (JFL(1)(1:4) .EQ. 'HELP') THEN
        CALL PLA300 (0, 7, 0)
      ELSE IF (JFL(1)(1:4) .EQ. 'LIST') THEN
        IF (KL .GT. 1 .AND. (JFL(2)(1:4) .EQ. 'ISPR' .OR.
     1    JFL(2)(1:4) .EQ. 'SPAR' .OR. JFL(2)(1:3) .EQ. 'CPR' .OR.
     2    JFL(2)(1:4) .EQ. 'IGBL' .OR. JFL(2)(1:3) .EQ. 'IPR' .OR.
     3    JFL(2)(1:3) .EQ. 'PAR')) THEN
          IF (KN .GE. 1) THEN
            N1 = NINT(FN(1))
          ELSE
            N1 = 1
          END IF
          IF (KN .GE. 2) THEN
            N2 = NINT(FN(2))
          ELSE
            N2 = N1
          END IF
          IF (N2 .LT. N1) N2 = N1
          IF (JFL(2)(1:2) .EQ. 'SP') THEN
            IF (KN .LT. 1) N2 = NP1
            WRITE (LU6, 99996, IOSTAT = IOST)
     1        (' ', I, SPAR(I), I = N1, N2)
          ELSE IF (JFL(2)(1:2) .EQ. 'IS') THEN
            IF (KN .LT. 1) N2 = NP2
            WRITE (LU6, 99995, IOSTAT = IOST)
     1        (' ', I, ISPR(I), I = N1, N2)
          ELSE IF (JFL(2)(1:2) .EQ. 'CP') THEN
            IF (KN .LT. 1) N2 = NP3
            WRITE (LU6, 99994, IOSTAT = IOST)
     1        (' ', I, CPR(I), I = N1, N2)
          ELSE IF (JFL(2)(1:2) .EQ. 'IG') THEN
            CALL PLA206 (-1, 'IGB')
          ELSE IF (JFL(2)(1:2) .EQ. 'RG') THEN
            CALL PLA206 (-1, 'RGB')
          ELSE IF (JFL(2)(1:2) .EQ. 'PA') THEN
            CALL PLA206 (-1, 'PAR')
          ELSE IF (JFL(2)(1:2) .EQ. 'IP') THEN
            CALL PLA206 (-1, 'IPR')
          END IF
          GO TO 20
        ELSE IF (KL .GT. 1 .AND. JFL(2)(1:5) .EQ. 'FACES'
     1            .AND. ISPR(350) .GT.  0) THEN
          DO I = 1, ISPR(350)
            WRITE (LU6, 99989, IOSTAT = IOST)
     1        ISPR(348 + I * 3), ISPR(349 + I * 3),
     2        ISPR(350 + I * 3), SPAR(500 + I)
          END DO
        END IF
        GO TO 10
      ELSE IF (JFL(1)(1:4) .EQ. 'TREE') THEN
        CALL S914
        GO TO 10
      ELSE IF (JFL(1)(1:5) .EQ. 'PRINT') THEN
        CALL S918
      ELSE IF (JFL(1)(1:6) .EQ. 'RELINK') THEN
        CALL S928
      ELSE IF (JFL(1)(1:6) .EQ. 'REPORT') THEN
        CALL S500
      ELSE IF (JFL(1)(1:6) .EQ. 'VALID') THEN
        CALL S520 (1)
C * REMOVE/PRUNE
      ELSE IF (JFL(1)(1:5) .EQ. 'PRUNE' .OR.
     1         JFL(1)(1:6) .EQ. 'REMOVE') THEN
        CALL S934
C * BROWSE
      ELSE IF (JFL(1)(1:6) .EQ. 'BROWSE') THEN
        IF (KL .GT. 1) THEN
          IF (JFL(2)(1:3) .EQ. 'LPS') THEN
            CALL S935 (1)
          ELSE IF (JFL(2)(1:3) .EQ. 'LIS') THEN
            CALL S935 (0)
          ELSE IF (JFL(2)(1:2) .EQ. 'PS') THEN
            CALL S936
          END IF
        ELSE
          CALL S935 (0)
        END IF
C * LASER
      ELSE IF (JFL(1)(1:5) .EQ. 'LASER') THEN
        CALL S935 (-1)
C * BOUNDING FACES
      ELSE IF (JFL(1)(1:4) .EQ. 'FACE') THEN
        IH = NINT(FN(1))
        IK = NINT(FN(2))
        IL = NINT(FN(3))
        D  = FN(4)
        IF (KL .EQ. 4) THEN
          CALL S060 (4, IH, IK, IL, D)
        ELSE
          CALL S060 (0, 0, 0, 0, 0.0)
        END IF
C * MU
      ELSE IF (JFL(1)(1:2) .EQ. 'MU') THEN
        IF (KN .EQ. 1) THEN
          D = FN(1)
          CALL S060 (1, 0, 0, 0, D)
        ELSE
          CALL S060 (0, 0, 0, 0, 0.0)
        END IF
C * THMX
      ELSE IF (JFL(1)(1:4) .EQ. 'THMX') THEN
        SPAR(55) = FN(1)
C * STLM
      ELSE IF (JFL(1)(1:4) .EQ. 'STLM') THEN
        SPAR(55) = ASIN(SPAR(80) * FN(1)) * RGBL(6)
C * CHIRAL
      ELSE IF (JFL(1)(1:4) .EQ. 'CHIR') THEN
        ISPR(8) = 1
C * TEMP ([C]/K)
      ELSE IF (JFL(1)(1:4) .EQ. 'TEMP') THEN
        IF (JFL(2)(1:1) .EQ. 'K') THEN
          SPAR(10) = FN(1)
        ELSE
          SPAR(10) = FN(1) + 273
        END IF
C * SIZE
      ELSE IF (JFL(1)(1:4) .EQ. 'SIZE') THEN
        IF (KN .EQ. 3) THEN
          CALL GEN034 (FN, 1, 3)
          SPAR(11) = FN(1)
          SPAR(12) = FN(2)
          SPAR(13) = FN(3)
        END IF
C * XTAL
      ELSE IF (JFL(1)(1:4) .EQ. 'XTAL') THEN
        CALL S050
C * AUTO
      ELSE IF (JFL(1)(1:4) .EQ. 'AUTO' .OR.
     1         JFL(1)(1:3) .EQ. 'NQA') THEN
        IGBL(50) = 1
        CALL GEN038 (IGGT, 1, 80)
      ELSE
C * EXECUTE NON-s COMMAND
        L1 = 1
        L2 = 80
        IF (LINE(1:1) .EQ. '#' .OR. LINE(1:1) .EQ. '!') L1 = 2
        KERR = 0
        CALL SPAWN('sh -c '''//LINE(L1:L2)//' '' ', KERR)
        GO TO 10
      END IF
      GO TO 70
   40 CALL PLA015 (0, 28)
      GO TO 70
   50 CALL S920 (1)
      IF (CHANDIR (WORKDIR) .NE. 0) GO TO 60
   60 IF (IGBL(50) .EQ. 2) THEN
        FNM(IN + 1: IN + 20) = 'tm/sg/pn/shelxl.cif '
        LIN =
     1 'cp '//FNM(1:IN + 20)//WORKDIR(1:IW)//'/'//COMPD(1:IC)//'_s.cif'
        KERR = 0
        CALL SPAWN (LIN, KERR)
        WRITE (LU6, 99976, IOSTAT = IOST)
     1    WORKDIR(1:IW)//'/'//COMPD(1:IC)//'_s.cif'
        FNM(IN + 1: IN + 6) = 's.res '
        LIN =
     1 'cp '//FNM(1:IN + 6)//WORKDIR(1:IW)//'/'//COMPD(1:IC)//'_s.res'
        KERR = 0
        CALL SPAWN (LIN, KERR)
        WRITE (LU6, 99975, IOSTAT = IOST)
     1    WORKDIR(1:IW)//'/'//COMPD(1:IC)//'_s.res'
        FNM(IN + 1: IN + 22) = 'tm/sg/valid/valid.chk '
        LIN =
     1 'cp '//FNM(1:IN + 22)//WORKDIR(1:IW)//'/'//COMPD(1:IC)//'_s.chk'
        KERR = 0
        CALL SPAWN (LIN, KERR)
        WRITE (LU6, 99973, IOSTAT = IOST)
     1    WORKDIR(1:IW)//'/'//COMPD(1:IC)//'_s.chk'
        WRITE (LU6, 99974, IOSTAT = IOST) FNM(1:IN - 1)
      END IF
      ISW = -1
   70 RETURN
99999 FORMAT ('s: UNIX-SHELL Command ', A, ' not allowed in s')
99996 FORMAT (1(3(A, 'SPAR[', I3, ']=', F10.4, ',')))
99995 FORMAT (1(4(A, 'ISPR[', I3, ']=', I8   , ',')))
99994 FORMAT (1(3(A, 'CPR[', I3, ']=', A    , ',')))
99989 FORMAT ('Face ', 3I5, F10.5)
99983 FORMAT (':: INDEX OUT_OF_RANGE')
99982 FORMAT (':: ISPR(', I3, ') Old value =', I8, ' New value =', I8)
99981 FORMAT (':: SPAR(', I3, ') Old value =', F10.4, ' New value =',
     1        F10.4)
99980 FORMAT (':: CPR(', I3, ') Old value =', A    , ' New value =', A)
99976 FORMAT (/, 'Tentative Result on: ', A)
99975 FORMAT (   '                and: ', A)
99974 FORMAT (/, 'Details may be found in: ', A, /)
99973 FORMAT (   'Validation   Report: ', A)
      END SUBROUTINE S030
      SUBROUTINE S040
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      DIMENSION AA(3, 3)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LIJN*80, CAX(6)*5, SCAX(6)*12
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      LOGICAL DINQ
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DATA CAX /'a    ', 'b    ', 'c    ', 'alpha', 'beta ', 'gamma'/
      DATA SCAX /'sigma(a)    ', 'sigma(b)    ', 'sigma(c)    ',
     1  'sigma(alpha)', 'sigma(beta) ', 'sigma(gamma)'/
   10 BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      IF (IGBL(50) .EQ. 0) CALL GGIP (HORS, VERT, 0.0, 1)
      ICELL = 1
      ICESD = 1
      IF (SPAR(101) .GT. 0.0) THEN
        IF (IGBL(50) .EQ. 0) THEN
   20     LIJN = 'GET CELL PARAMETERS'
          CALL GGIP09 (0.0, LIJN, 71, 1.2, 5 + IGBL(68), 5, 3.0,
     1                 VERT - 2.0)
          LIJN = 'Compound = '//COMPD(1:IC)
          CALL GGIP09 (0.0, LIJN, 11 + IC, 0.5, 3, 2, 8.5, VERT - 3.5)
          CALL GEN038 (LIJN, 1, 80)
          LIJN = 'Cell Data from:'
          IF (ISPR(38) .EQ. 3) THEN
            LIJN(17:) = 'scale.out'
          ELSE IF (ISPR(38) .EQ. 4) THEN
            LIJN(17:) = 'shelx.ins'
          END IF
          CALL GGIP09 (0.0, LIJN, 27, 0.5, 3, 2, 8.5, VERT - 5.0)
          WRITE (LIJN, '(''Lambda = '', F8.5, '' Ang'')',
     1      IOSTAT = IOST) SPAR(80)
          CALL GGIP09 (0.0, LIJN, 21, 0.5, 3, 2, 8.5, VERT - 6.5)
          IF (ISPR(38) .EQ. 4) THEN
            WRITE (LIJN, 99996, IOSTAT = IOST)
     1        'Cell:', (SPAR(100 + I), I = 1, 6)
            CALL GGIP09 (0.0, LIJN, 80, 0.375, 1, 2, 0.5, VERT - 8.0)
            WRITE (LIJN, 99996, IOSTAT = IOST)
     1        ' Esd:', (SPAR(107 + I), I = 1, 6)
            CALL GGIP09 (0.0, LIJN, 80, 0.375, -1, 2, 0.5, Vert - 9.0)
            WRITE (LIJN, 99997, IOSTAT = IOST)
     1        ((TM(I, J), J = 1, 3), I = 1, 3)
            CALL GEN065 (0, LIJN, 80, 5)
            CALL GGIP09 (0.0, LIJN(1:11),  11, 0.35, 5 + IGBL(68), 2,
     1                   5.0, VERT - 12.0)
            CALL GGIP09 (0.0, LIJN(12:29), 18, 0.35, 1, 2,
     1                   9.0, VERT - 11.0)
            CALL GGIP09 (0.0, LIJN(30:47), 18, 0.35, 1, 2,
     1                   9.0, VERT - 12.0)
            CALL GGIP09 (0.0, LIJN(48:65), 18, 0.35, 1, 2,
     1                   9.0, VERT - 13.0)
          END IF
          LIJN = 'Note: Cell Parameters as retrieved may need '//
     1      'modification to better reflect '
          CALL GGIP09 (0.0, LIJN, 80, 0.375, 2, 2, 0.5, 5.0)
          LIJN = 'the proper lattice symmetry.  (Needed for '//
     1      'automatic space group determination)'
          CALL GGIP09 (0.0, LIJN, 80, 0.375, 2, 2, 0.5, 4.0)
          WRITE (LIJN, '(A, 3F8.4, 3F8.3)', IOSTAT = IOST)
     1    'Current Cell:', (SPAR(100 + I), I = 1, 6)
          CALL GGIP09 (0.0, LIJN, 80, 0.375, 1, 2, 0.5, 2.0)
          WRITE (LIJN, '(A, 3F8.4, 3F8.3)', IOSTAT = IOST)
     1    '         Esd:', (SPAR(107 + I), I = 1, 6)
          CALL GGIP09 (0.0, LIJN, 80, 0.375, -1, 2, 0.5, 1.0)
          SBCD = 'Cell and CellEsd O.K. Y/N[Y]'//CHAR(0)
          CALL PLA013 (0, 1)
          IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 20
          IF (IGGT(1:4) .EQ. 'EXIT') GO TO 60
          LINE = IGGT
          IF (LINE(1:1) .EQ. 'N') ICELL = 0
        END IF
      ELSE
        ICELL = 0
      END IF
      IF (SPAR(108) .EQ. 0.0 .AND. IGBL(50) .EQ. 0) ICESD = 0
      IF (ICELL .EQ. 0) THEN
        ICESD = 0
        DO I = 1, 6
   30     CALL GGIP (0.0, 5.0 + FLOAT(IGBL(68)), 0.0, 0)
          WRITE (SBCD, 99998, IOSTAT = IOST)
     1      CAX(I), SPAR(100 + I), CHAR(0)
          CALL PLA013 (0, 1)
          IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 30
          IF (IGGT(1:4) .EQ. 'EXIT') GO TO 60
          IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
            LINE = IGGT
            CALL GEN038 (IGGT, 1, 80)
            CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 0, 1, 80, 10,
     1                   NP17)
            IF (KN .GT. 0) SPAR(100 + I) = FN(1)
          END IF
        END DO
      END IF
      IF (ICESD .EQ. 0) THEN
        DO I = 1, 6
   40     CALL GGIP (0.0, 5.0 + FLOAT(IGBL(68)), 0.0, 0)
          WRITE (SBCD, 99998, IOSTAT = IOST)
     1      SCAX(I), SPAR(107 + I), CHAR(0)
          CALL PLA013 (0, 1)
          IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 40
          IF (IGGT(1:4) .EQ. 'EXIT') GO TO 60
          IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
            LINE = IGGT
            CALL GEN038 (IGGT, 1, 80)
            CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 0, 1, 80, 10,
     1                   NP17)
            IF (KN .GT. 0) SPAR(107 + I) = FN(1)
          END IF
        END DO
        GO TO 10
      END IF
      DO I = 81, 94
        SPAR(I) = SPAR(I + 20)
      END DO
      IF (DINQ ('latt')) THEN
        KERR = 0
        CALL SPAWN ('rm -r latt', KERR)
      END IF
      IF (SPAR(80) .EQ. 0.0) THEN
   50   WRITE (SBCD, 99999, IOSTAT = IOST) CHAR(0)
        CALL PLA013 (0, 1)
        IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 50
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 60
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          WRITE (LINE, '(F10.5)', IOSTAT = IOST) 0.71073
        END IF
        CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10, NP17)
        SPAR(80) = FN(1)
      END IF
      CALL GEN026 (1, AA, SPAR(81))
      CALL GEN003 (AA, RBB, VOL, 0)
      SPAR(87)  = SQRT(VOL)
      SPAR(107) = SQRT(VOL)
      CALL GEN068 (SPAR(101), SPAR(107), SPAR(108), SPAR(114))
      IF (ABS(SPAR(80) - 0.71073) .LT. 0.0005) THEN
        SPAR(55) = 27.5
      ELSE
        SPAR(55) = ASIN(MIN(1.0, SPAR(80) / 1.5418)) * RGBL(6)
      END IF
      CALL S915 ('Cell Data Entry/Verification')
      CPR(105) = 'CELL'
      CPR(106) = CPR(200)
   60 RETURN
99999 FORMAT ('Enter Wavelength [0.71073]: ', A)
99998 FORMAT (A, ' = [', F8.4, '] ', A)
99997 FORMAT (' PRE - TRMX', 9F6.3)
99996 FORMAT (8X, A, 3F8.4, 3F8.3)
      END SUBROUTINE S040
      SUBROUTINE S050
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CALL S915 ('Run XTAL')
      CALL S929 (-1)
      CALL S909 (FNM(1:IN)//'xtal')
      OPEN (LU61, FILE = 'xtal.ins', STATUS = 'UNKNOWN')
      WRITE (LU61, 99999, IOSTAT = IOST)
     1  COMPD, (SPAR(80 + I), I = 1, 6)
      DO I = 1, ISPR(350)
        WRITE (LU61, 99998, IOSTAT = IOST) (FACE(I, J), J = 1, 4)
      END DO
      WRITE (LU61, 99997, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' xtal.ins', KERR)
      IF (CHANDIR(FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CALL S920 (1)
      RETURN
99999 FORMAT ('TITL ', A, /, 'CELL ', 6F10.4)
99998 FORMAT ('FACE ', 3F5.0, F10.5)
99997 FORMAT ('XTAL')
      END SUBROUTINE S050
      SUBROUTINE S060 (MODE, JH, JK, JL, D)
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER LIJN*80
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
C * LOOK FOR STORED FACES IN FILE .faces
      IH = JH
      IK = JK
      IL = JL
      CALL S929 (-1)
      BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
   10 IF (MODE .GE. 0 .AND. IGBL(50) .EQ. 0)
     1  CALL GGIP (HORS, VERT, 0.0, 1)
      IF (MODE .LE. 0 .AND. ISPR(350) .GT. 0) THEN
        WRITE (LIJN, 99998, IOSTAT = IOST) SPAR(123)
        CALL GGIP09 (0.0, LIJN, 30, 0.3, 1, 2, 8.0, 15.5)
        VRT = 14.3
        HRT = 0.0
        VRT = 14.5
        DO I = 1, ISPR(350)
          K = MOD (I - 1, 10)
          IF (K .EQ. 0) THEN
            HRT = HRT + 8.0
            VRT = 14.5
            WRITE (LIJN, 99997, IOSTAT = IOST)
            CALL GGIP09 (0.0, LIJN, 30, 0.3, 5 + IGBL(68), 2,
     1                     HRT, VRT)
            VRT = VRT - 0.2
          END IF
          WRITE (LIJN, 99996, IOSTAT = IOST)
     1      I, (NINT(FACE(I, J)), J = 1, 3), FACE(I, 4)
          VRT = VRT - 0.6
          CALL GGIP09 (0.0, LIJN, 30, 0.3, 1, 2, HRT, VRT)
        END DO
      END IF
      KN = MODE
      IF (KN .EQ. 4) THEN
        FN(1) = IH
        FN(2) = IK
        FN(3) = IL
        FN(4) = D
        GO TO 20
      ELSE IF (KN .EQ. 1) THEN
        SPAR(123) = D
        GO TO 60
      END IF
      GO TO 40
   20 IF (KN .EQ. 4) THEN
        IH = NINT(FN(1))
        IK = NINT(FN(2))
        IL = NINT(FN(3))
        IF (ISPR(350) .GT. 0) THEN
          DO I = 1, ISPR(350)
            IF (NINT(FACE(I, 1)) .EQ. IH .AND.
     1          NINT(FACE(I, 2)) .EQ. IK .AND.
     2          NINT(FACE(I, 3)) .EQ. IL) GO TO 30
          END DO
        END IF
        ISPR(350)  = ISPR(350) + 1
        I          = ISPR(350)
   30   FACE(I, 1) = IH
        FACE(I, 2) = IK
        FACE(I, 3) = IL
        FACE(I, 4) = FN(4)
      END IF
      IF (MODE .EQ. 0) GO TO 10
      IF (MODE .GT. 0) GO TO 60
   40 IF (MODE .LT. 0) GO TO 70
   50 WRITE (SBCD, 99999, IOSTAT = IOST) CHAR(0)
      CALL PLA013 (0, 1)
      IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT' .OR.
     1                     IGGT(1:4) .EQ. 'EXIT') GO TO 10
      IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
        LINE = IGGT
        CALL GEN038 (IGGT, 1, 80)
      ELSE
        GO TO 60
      END IF
      CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10, NP17)
      IF (KN .EQ. 4) THEN
        GO TO 20
      ELSE IF (KN .EQ. 1 .AND. JFL(1)(1:2) .EQ. 'MU') THEN
        SPAR(123) = FN(1)
        GO TO 10
      ELSE
        GO TO 50
      END IF
   60 CALL S929 (1)
   70 RETURN
99999 FORMAT ('MU/FACE [Return = Quit]', A)
99998 FORMAT ('Current Mu =', F8.3, ' mm ^ -1')
99997 FORMAT ('Faces : nr h k l d (mm)')
99996 FORMAT (I4, 3I3, F10.4)
      END SUBROUTINE S060
      SUBROUTINE S110
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP18=50,NP38=150,NP39=30,NP42=250,NSITE=70)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      COMMON /SLAUE/ NLAUE, XSYST, IBVL, SITE
      CHARACTER NLAUE(14)*5, XSYST(8)*12, IBVL(8)*1, SITE(NSITE)*5
      CHARACTER CHSPGR*7
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CALL S915 ('Run Platon/ASYM')
      IF (ISPR(10) .EQ. 3) THEN
        CALL S909 ('tm/sg/asym')
        CHSPGR = CPR(100)(1:7)
      ELSE IF (ISPR(10) .EQ. 2) THEN
        CALL S909 ('tm/asym')
        CHSPGR = BLATT(NRLT)//NLAUE(LLAUE(NRLT))//' '
        IF (CHSPGR(1:6) .EQ. 'R -3m1') CHSPGR(6:6) = ' '
      ELSE IF (ISPR(10) .EQ. 1) THEN
        CALL S909 ('asym')
        CHSPGR = 'P-1    '
      ELSE
        GO TO 10
      END IF
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.hkl asym.hkl', KERR)
      IF (JFL(2)(1:4) .EQ. 'VIEW') THEN
        KERR = 0
        CALL SPAWN ('ln -s -f ../s.res asym.ins', KERR)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -l asym.ins > asym.log',
     1    KERR)
      ELSE
        OPEN (LU61, FILE = 'asym.ins', STATUS = 'UNKNOWN')
        WRITE (LU61, 99998, IOSTAT = IOST)
     1    TITL, ((TM(I, J), J = 1, 3), I = 1, 3),
     2    SPAR(80), (SPAR(80 + I), I = 1, 6), CHSPGR
        CLOSE (UNIT = LU61)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' asym.ins > asym.log',
     1    KERR)
      END IF
      IF (CHANDIR(FNM(1:IN-1)) .NE. 0) CALL S925 (1)
   10 RETURN
99998 FORMAT ('TITL ', A, /,
     1        'TRMX ', 9F6.2, /,
     2        'CELL ', 7F10.4, /,
     3        'SPGR [', A, ']', /,
     4        'ASYM AVF')
      END SUBROUTINE S110
      SUBROUTINE S120
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      LOGICAL EXST
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CALL S915 ('Run Platon/ABSPSI')
      EXST = .FALSE.
      CALL S909 ('absp')
      INQUIRE (FILE = 'absp.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../hklf/shelx.hkl absp.hkl', KERR)
        OPEN (LU61, FILE = 'absp.ins', STATUS = 'UNKNOWN')
        WRITE (LU61, 99998, IOSTAT = IOST)
     1    TITL, SPAR(80), (SPAR(80 + I), I = 1, 6)
        CLOSE (UNIT = LU61)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -o absp.ins > absp.log',
     1    KERR)
        OPEN (LU61, FILE = 'absp.log', STATUS = 'UNKNOWN')
   10   READ (LU61, 99999, END = 20) LINE
        IF (LINE(1:6) .EQ. ':: MIN') THEN
          READ (LINE, 99997) SPAR(126)
        ELSE IF (LINE(1:6) .EQ. ':: MAX') THEN
          READ (LINE, 99997) SPAR(127)
          GO TO 20
        END IF
        GO TO 10
   20   CLOSE (UNIT = LU61)
      ELSE
        SPAR(151) = SPAR(152)
      END IF
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CPR(202) = 'ABSPSI    '
      CPR(105) = 'ABSPSI    '
      CPR(106) = CPR(200)
      ISPR(14) = 2
      ISPR(15) = 2
      CALL S924 (1)
      RETURN
99999 FORMAT (A)
99998 FORMAT ('TITL ', A, /,
     1        'CELL ', 7F10.4, /,
     2        'SET DISPLAY OFF', /,
     3        'ABSPSI')
99997 FORMAT (22X, F8.0)
      END SUBROUTINE S120
      SUBROUTINE S130
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CALL S909 ('tm/sg/mulabs')
      KERR = 0
      CALL SPAWN ('ln -s -f '//'../../../hklf/shelx.hkl s.hkl', KERR)
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.res s.res', KERR)
      OPEN (LU61, FILE = 'mulabs.ins', STATUS = 'UNKNOWN')
      RADIUS = (SPAR(11) * SPAR(12) * SPAR(13)) ** 0.33333
      IF (RADIUS .LT. 0.0001) RADIUS = 0.3
      WRITE (LU61, 99997, IOSTAT = IOST) SPAR(123), RADIUS
      CLOSE (UNIT = LU61)
      KERR = 0
      CALL SPAWN
     1    (PLAPATH(1:IGBL(80))//' -o s.res < mulabs.ins > mulabs.log',
     2     KERR)
      KERR = 0
      CALL SPAWN ('mv s.lis mulabs.lis', KERR)
        OPEN (LU61, FILE = 'mulabs.log', STATUS = 'UNKNOWN')
   10   READ (LU61, 99999, END = 20) LINE
        IF (LINE(1:6) .EQ. ':: MIN') THEN
          READ (LINE, 99998) SPAR(126)
        ELSE IF (LINE(1:6) .EQ. ':: MAX') THEN
          READ (LINE, 99998) SPAR(127)
          GO TO 20
        END IF
        GO TO 10
   20   CLOSE (UNIT = LU61)
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      ISPR(14) = 3
      ISPR(15) = 3
      CPR(202) = 'MULABS    '
      ISPR(5)  = ISPR(6)
      ISPR(7)  = 0
      CPR(105) = 'MULABS'
      CPR(106) = CPR(200)
      CALL S924 (1)
      CALL S915 ('Run PLATON/MULABS')
      RETURN
99999 FORMAT (A)
99998 FORMAT (22X, F8.0)
99997 FORMAT ('MULABS', 2F10.3)
      END SUBROUTINE S130
      SUBROUTINE S140
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      LOGICAL EXST, DINQ
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      EXST = .FALSE.
      CALL S915 ('Run PLATON/ABSGAUSS')
      CALL S929 (-1)
      IF (ISPR(350) .EQ. 0) THEN
        WRITE (LU6, 99995, IOSTAT = IOST)
        GO TO 10
      END IF
      IF (.NOT. DINQ (FNM(1:IN)//'absgauss')) THEN
        CALL SPAWN ('mkdir '//FNM(1:IN)//'absgauss', KERR)
      END IF
      IF (CHANDIR (FNM(1:IN)//'absgauss') .NE. 0) CALL S925 (1)
      INQUIRE (FILE = 'absgauss.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        CALL SPAWN ('ln -s ../hklf/shelx.hkl absgauss.hkl', KERR)
      END IF
      OPEN (LU61, FILE = 'absgauss.ins', STATUS = 'UNKNOWN')
      WRITE (LU61, 99998, IOSTAT = IOST) TITL, (SPAR(80 + I), I = 1, 6)
      DO I = 1, ISPR(350)
        WRITE (LU61, 99997, IOSTAT = IOST) (FACE(I, J), J = 1, 4)
      END DO
      WRITE (LU61, 99996, IOSTAT = IOST) SPAR(123)
      CLOSE (UNIT = LU61)
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' absgauss.ins > absgauss.log',
     1  KERR)
      KERR = 0
      CALL SPAWN ('rm -f ../hklf/shelx.hkl', KERR)
      KERR = 0
      CALL SPAWN ('ln -s ../absgauss/absgauss.hkp ../hklf/shelx.hkl',
     1  KERR)
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CPR(202) = 'ABSGAUSS'
      CALL S924 (1)
   10 RETURN
99998 FORMAT ('TITL ', A, /,
     1        'CELL ', 3F10.4, 3F10.2)
99997 FORMAT ('FACE ', 3F5.0, F10.5)
99996 FORMAT ('ABSG', F10.2)
99995 FORMAT (':: No Crystal Description Available')
      END SUBROUTINE S140
      SUBROUTINE S150
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      LOGICAL EXST, DINQ
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      EXST = .FALSE.
      CALL S915 ('Run PLATON/ABSTOMPA')
      CALL S929 (-1)
      IF (ISPR(350) .EQ. 0) THEN
        CALL PLA015 (0, 19)
        GO TO 20
      END IF
      IF (SPAR(81) .EQ. 0.0) THEN
        CALL PLA015 (0, 20)
        GO TO 20
      END IF
      IF (.NOT. DINQ (FNM(1:IN)//'abst')) THEN
        CALL SPAWN ('mkdir '//FNM(1:IN)//'abst', KERR)
      END IF
      IF (CHANDIR (FNM(1:IN)//'abst') .NE. 0) CALL S925 (1)
      INQUIRE (FILE = 'abst.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../hklf/shelx.hkl abst.hkl', KERR)
      END IF
      OPEN (LU61, FILE = 'abst.ins', STATUS = 'UNKNOWN')
      WRITE (LU61, 99998, IOSTAT = IOST)
     1  TITL, SPAR(80), (SPAR(80 + I), I = 1, 6)
      DO I = 1, ISPR(350)
        WRITE (LU61, 99997, IOSTAT = IOST) (FACE(I, J), J = 1, 4)
      END DO
      WRITE (LU61, 99996, IOSTAT = IOST) SPAR(123)
      CLOSE (UNIT = LU61)
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' abst.ins > abst.log', KERR)
      OPEN (LU61, FILE = 'abst.log', STATUS = 'UNKNOWN')
      DO
        READ (LU61, 99994, END = 10) LINE
        IF (LINE(1:6) .EQ. ':: MIN') THEN
          READ (LINE, 99995) SPAR(126)
        ELSE IF (LINE(1:6) .EQ. ':: MAX') THEN
          READ (LINE, 99995) SPAR(127)
          GO TO 10
        END IF
      END DO
   10 CLOSE (UNIT = LU61)
      ISPR(14) = 5
      ISPR(15) = 5
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CPR(202) = 'ABSTOMPA'
      CALL S924 (1)
   20 RETURN
99998 FORMAT ('TITL ', A, /,
     1        'CELL ', F10.5, 3F10.4, 3F10.2)
99997 FORMAT ('FACE ', 3F5.0, F10.5)
99996 FORMAT ('ABST', F10.2)
99995 FORMAT (22X, F8.0)
99994 FORMAT (A)
      END SUBROUTINE S150
      SUBROUTINE S155
      PARAMETER (NP1=500,NP2=350,NP3=250)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      CALL S915 ('Relink to NoAbsCor')
      ISPR(14)  = 0
      ISPR(15)  = 0
      SPAR(151) = SPAR(150)
      CPR(105)  = 'ABSNONE   '
      CPR(106)  = CPR(200)
      CPR(202)  = 'ABSNONE   '
      CALL S924 (1)
      RETURN
      END SUBROUTINE S155
      SUBROUTINE S160
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP18=50,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER CTR*2
      INTEGER CHANDIR
      LOGICAL EXST, EXST1, DINQ
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      EXST  = .FALSE.
      EXST1 = .FALSE.
      IGBL(34)   = 0
      VALIDATION = ' '
      KNN   = 0
      IF (KN .EQ. 9) KNN = KN
      IF (.NOT. DINQ ('latt')) THEN
        KERR = 0
        CALL SPAWN ('mkdir latt', KERR)
        IF (CHANDIR ('latt') .NE. 0) CALL S925 (1)
        KERR = 0
        CALL SPAWN ('ln -s -f ../tm/s.hkl latt.hkl', KERR)
        OPEN (LU61, FILE = 'latt.ins', STATUS = 'UNKNOWN')
        IF (IGBL(50) .EQ. 0) THEN
          CRMET = 0.4
          CRAXL = 0.4
        ELSE
          CRMET = 0.2
          CRAXL = 0.2
        END IF
        WRITE (LU61, 99999, IOSTAT = IOST)
     1    COMPD, SPAR(80), (SPAR(80 + I), I = 1, 6), CRMET, CRAXL
        CLOSE (UNIT = LU61)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' latt.ins > log', KERR)
        KERR = 0
        CALL SPAWN ('rm log', KERR)
        OPEN (LU61, FILE = 'latt.trm', STATUS = 'UNKNOWN',
     1    FORM = 'UNFORMATTED')
        READ (LU61) NRLT0, NRLT, NREXT, AVIOS, RMAX,
     1        RVL, NTL, TLATT, XCELL, LLAUE, RVAL, CLATT, BLATT, ELATT
        CLOSE (UNIT = LU61)
        IF (CHANDIR (FNM(1 : IN - 1)) .NE. 0) CALL S925 (1)
      ELSE
        KERR = 0
        CALL SPAWN ('rm tm', KERR)
        KERR = 0
        CALL SPAWN ('ln -s 00 tm', KERR)
        CALL S920 (-1)
      END IF
      LRET0 = 0
      OPEN (LU62, FILE = 'latt/latt.par', STATUS = 'UNKNOWN')
      OPEN (LU63, FILE = 'latt/trmx.lis', STATUS = 'UNKNOWN')
      CALL PLA171 (LRET0, TM, LU62, LU63, ISPR(47), SPAR, KNN)
      CLOSE (UNIT = LU62)
      CLOSE (UNIT = LU63)
      IF (LRET0 .NE. 1) THEN
        CALL S920 (1)
        OPEN (LU61, FILE = 'latt/latt.trm', STATUS = 'UNKNOWN',
     1        FORM = 'UNFORMATTED')
        WRITE (LU61) NRLT0, NRLT, NREXT, AVIOS, RMAX,
     1         RVL, NTL, TLATT, XCELL, LLAUE, RVAL, CLATT, BLATT, ELATT
        CLOSE (UNIT = LU61)
        IF (NRLT .GT. 9) THEN
          WRITE (CTR, '(I2)', IOSTAT = IOST) NRLT
        ELSE
          WRITE (CTR, '(''0'', I1)', IOSTAT = IOST) NRLT
        END IF
        CPR(104) = CTR//'/000/000'
        EXST1 = DINQ (CTR)
        IF (.NOT. EXST1) THEN
          KERR = 0
          CALL SPAWN ('mkdir '//CTR, KERR)
          CALL S915 ('Create Transformation Directory # tm = '//CTR)
        END IF
        CALL DLNK (CTR, 'tm')
        INQUIRE (FILE = '.newsym.nsg', EXIST = EXST)
        IF (EXST) THEN
          KERR = 0
          CALL SPAWN ('mv .newsym.nsg tm', KERR)
          KERR = 0
          CALL SPAWN ('mv .newsym.res tm', KERR)
          KERR = 0
          CALL SPAWN ('mv .newsym.sav tm', KERR)
        END IF
        IF (.NOT. EXST1) THEN
          CALL S932 (2)
          INQUIRE (FILE = 'tm/spgr', EXIST = EXST)
          EXST = DINQ ('tm/spgr')
          IF (.NOT. EXST) THEN
            DO I = 1, NP42
              CALL GEN038 (TSPGR(I), 1, 50)
            END DO
            KERR = 0
            CALL SPAWN ('mkdir tm/spgr', KERR)
            OPEN (LU61, FILE = './tm/spgr/.spgr', STATUS = 'UNKNOWN',
     1            FORM = 'UNFORMATTED')
            WRITE (LU61) TSPGR
            CLOSE (UNIT = LU61)
          END IF
          DO I = 1, 9
            K = (I - 1) / 3 + 1
            J = MOD (I - 1, 3) + 1
            TM(K, J) = TLATT(I, NRLT)
          END DO
          CALL S931
        ELSE
          KERR = 0
          CALL SPAWN ('ln -s -f tm/.s.dbf .s.dbf', KERR)
          CALL S920 (-1)
        END IF
        ISPR(10) = 2
        IGBL(38) = 1
        CPR(105) = 'TRMX'
        CPR(106) = CPR(200)
      END IF
      RETURN
99999 FORMAT ('TITL ', A, /,
     1        'CELL', F9.5, 3F8.3, 3F8.2, /,
     2        'SET PAR 441', F10.2, /,
     3        'SET PAR 383', F10.2, /,
     4        'SET IPR 548 1', /,
     5        'SPGR 1')
      END SUBROUTINE S160
      SUBROUTINE S170
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP18=50,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      DIMENSION XYZ(12)
      COMMON /LATICE/ TRNSX(3, 3, 128), ROT(3, 5, 5), TRDAT(3, 3, 8)
      COMMON /CTRNS/ TRTYP
      CHARACTER TRTYP(8)*5
      CHARACTER DSPGR*7
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LIJN*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      LOGICAL EXST, DINQ
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER CHIRAL*1, XCHIR*5
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      DIMENSION YUNK(3, 3)
      EXST  = .FALSE.
      NEWSG = 0
      IGBL(34)   = 0
      VALIDATION = ' '
      CALL DLNK ('000', 'tm/sg')
      INQUIRE (FILE = 'tm/spgr/spgr.par', EXIST = EXST)
      IF (KN .GT. 0) THEN
        ECRIT = FN(1)
        IF (EXST) THEN
          KERR = 0
          CALL SPAWN ('rm tm/spgr/spgr.par', KERR)
          EXST = .FALSE.
        END IF
      ELSE
        ECRIT = 5.0
      END IF
      IF (.NOT. EXST) THEN
        CALL S915 ('Analyse Space Group Extinctions')
        IF (.NOT. DINQ ('tm/spgr')) THEN
          KERR = 0
          CALL SPAWN ('mkdir tm/spgr', KERR)
        ENDIF
        IF (CHANDIR ('tm/spgr') .NE. 0) CALL S925 (1)
        KERR = 0
        CALL SPAWN ('ln -s -f ../s.hkl spgr.hkl', KERR)
        OPEN  (LU61, FILE = 'spgr.ins', STATUS = 'UNKNOWN')
        WRITE (LU61, 99990, IOSTAT = IOST) COMPD
        WRITE (LU61, 99989, IOSTAT = IOST) (TLATT(J, NRLT), J = 1, 9),
     1   CLATT(NRLT), BLATT(NRLT), LLAUE(NRLT), ELATT(NRLT)
        WRITE (LU61, 99988, IOSTAT = IOST)
     1    SPAR(80), (SPAR(80 + I), I = 1, 6), ECRIT
        CLOSE (UNIT = LU61)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' spgr.ins > log', KERR)
        KERR = 0
        CALL SPAWN ('rm log', KERR)
        IF (CHANDIR (FNM(1:IN - 1)) .NE. 0) CALL S925 (1)
      END IF
      JSGNR = 230
      DO J = 231, NP42
        IF (TSPGR(J)(1:2) .NE. '  ') JSGNR = J
      END DO
      GO TO 40
   20 OPEN (LU61, FILE = './tm/spgr/.spgr', STATUS = 'UNKNOWN',
     1      FORM = 'UNFORMATTED')
      WRITE (LU61) TSPGR
      CLOSE (UNIT = LU61)
   30 CALL S920 (-1)
   40 NSPGR = 0
      ISPGR = 0
      ISGNR = 0
      JSGNR = 230
      BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      IF (IGBL(50) .EQ. 0) CALL GGIP (HORS, VERT, 0.0, 1)
      IF (KL .GT. 1) THEN
        CALL GEN020 (1, LINE, 1, 80)
        NX = INDEX (LINE, ':')
        IF (NX .EQ. 0) THEN
          CPR(2) = ' '
          J      = 0
          DO I = 6, 20
            IF (LINE(I:I) .NE. ' ' .AND. J .LT. 10) THEN
              J = J + 1
              CPR(2)(J:J) = LINE(I:I)
            END IF
          END DO
          JFL(2) = 'ABC  '
          NX     = 13
        ELSE
          CPR(2) = LINE(6:NX - 1)
          JFL(2) = LINE(NX+1:NX+5)
        END IF
        CALL GEN038 (LINE, NX, 80)
        CALL GEN020 (-1, CPR(2), 2, 9)
        CALL SGSM (LINE, 0, XYZ, 0, 0,  IERR)
        IF (IERR .EQ. 0) THEN
          CALL SGSM (LINE, 0, XYZ, 0, 18, IERR)
          ISGNR = NINT(XYZ(1))
        END IF
        IF (ISGNR .EQ. 0) THEN
          CALL PLA015 (0, 22)
        ELSE
          TSPGR(JSGNR + 1)(1:14) = CPR(2)(1:8)//':'//JFL(2)(1:5)
          IF (TSPGR(ISGNR)(1:2) .EQ. '  ') THEN
            TSPGR(ISGNR) = TSPGR(JSGNR + 1)(1:14)
            CALL GEN038 (TSPGR(JSGNR + 1), 1, 50)
          ELSE
            DO K = 1, JSGNR
              IF (TSPGR(JSGNR + 1)(1:14) .EQ. TSPGR(K)(1:14)) THEN
                ISGNR = K
                CALL GEN038 (TSPGR(JSGNR + 1), 1, 50)
                GO TO 70
              END IF
            END DO
            JSGNR = JSGNR + 1
          END IF
        END IF
   70   KL    = 1
        ISPGR = ISGNR
        IF (ISPGR .EQ. 0) GO TO 20
        GO TO 180
      END IF
      IF (ISPGR .EQ. 0) THEN
        OPEN (LU61, FILE = 'tm/spgr/spgr.par', STATUS = 'OLD')
        KEXT = 0
        VRT  = 17.0
   80   READ (LU61, 99996, END = 110) LINE
        IF (LINE(1:4) .EQ. 'TRMX') THEN
          CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10,
     1                 NP17)
          TM(1, 1) = FN(1)
          TM(1, 2) = FN(2)
          TM(1, 3) = FN(3)
          TM(2, 1) = FN(4)
          TM(2, 2) = FN(5)
          TM(2, 3) = FN(6)
          TM(3, 1) = FN(7)
          TM(3, 2) = FN(8)
          TM(3, 3) = FN(9)
        ELSE IF (LINE(1:4) .EQ. 'EXTI') THEN
          KEXT = KEXT + 1
          IF (IGBL(50) .EQ. 0) THEN
            IF (KEXT .EQ. 1) THEN
              LIJN =
     1         'Extinction Statistics for (transformed) Reflection file'
              CALL GGIP09 (0.0, LIJN, 80, 0.375, 2, 2, 0.1, 18.8)
              CALL GGIP (0.0, 18.5, 0.0, 3)
              CALL GGIP (HORS, 18.5, 0.0, 2)
              LIJN = '    Ex. Condition    av[I/sig(I)]  Number of '//
     1               'Refl I/sigI             .T./.F.'
              CALL GGIP09 (0.0, LIJN, 80, 0.35, 5 + IGBL(68), 2,
     1                     0.1, 18.0)
              LIJN = '                    .True. .False. .True. '//
     1               '.False.  Max.F    H  K  L   Ratio'
              CALL GGIP09 (0.0, LIJN, 80, 0.35, 5 + IGBL(68), 2,
     1                     0.1, 17.5)
              CALL GGIP (0.0,  17.2, 0.0, 3)
              CALL GGIP (HORS, 17.2, 0.0, 2)
            END IF
            VRT = VRT - 0.45
            WRITE (LIJN, 99996, IOSTAT = IOST) LINE(6:80)
            CALL GGIP09 (0.0, LIJN, 80, 0.375, 1, 2, 0.1, VRT)
          END IF
        ELSE IF (LINE(1:4) .EQ. 'SPGR') THEN
          NSPGR = NSPGR + 1
          READ (LINE, 99999) IP1, IP1, IP1, DSPGR, ISGNR, IFREQ,
     1      TSPGR(JSGNR + 1)(1:14), RAVER, NAVER, IP1, CHIRAL
          IPCNT = IP1
          IF (TSPGR(ISGNR)(1:2) .EQ. '  ') THEN
            TSPGR(ISGNR) = TSPGR(JSGNR + 1)(1:14)
            CALL GEN038 (TSPGR(JSGNR + 1), 1, 50)
          ELSE
            DO K = 1, JSGNR
              IF (TSPGR(JSGNR + 1)(1:14) .EQ. TSPGR(K)(1:14)) THEN
                ISGNR = K
                CALL GEN038 (TSPGR(JSGNR + 1), 1, 50)
                GO TO 100
              END IF
            END DO
            JSGNR = JSGNR + 1
            ISGNR = JSGNR
          END IF
  100     WRITE (TSPGR(ISGNR)(16:24), '(''= '', A)', IOSTAT = IOST)
     1      DSPGR
          WRITE (TSPGR(ISGNR)(25:30), '(F6.2)', IOSTAT = IOST) RAVER
          WRITE (TSPGR(ISGNR)(31:36), '(I6)', IOSTAT = IOST)   NAVER
          WRITE (TSPGR(ISGNR)(37:42), '(I6)', IOSTAT = IOST)   IFREQ
          WRITE (TSPGR(ISGNR)(43:46), '(I4)', IOSTAT = IOST)   IPCNT
          IF (CHIRAL .EQ. 'C') THEN
            WRITE (TSPGR(ISGNR)(47:48), '('' c'')', IOSTAT = IOST)
          END IF
          IF (DSPGR(1:3) .EQ. 'Pn ' .OR.
     1        DSPGR(1:5) .EQ. 'P2/n ' .OR.
     2        DSPGR(1:6) .EQ. 'P21/n ') THEN
            JSGNR              = JSGNR + 1
            TSPGR(JSGNR)       = TSPGR(ISGNR)
            TSPGR(JSGNR)(1:14) = DSPGR//' :ABC'
          END IF
          IF (NSPGR .EQ. 1) ISPGR = ISGNR
        ELSE IF (LINE(1:4) .EQ. 'SGNR') THEN
          READ (LINE, 99998) ISPGRC, ISPGRA, ISPGRH, IPCNTC
        END IF
        GO TO 80
  110   CLOSE (UNIT = LU61)
        IF (ISPR(8) .EQ. 0) THEN
          IF (ISPGRC .NE. 0) THEN
            IF (IPCNTC .GT. 45 .OR. NSPGR .EQ. 1) THEN
              ISPGR = ISPGRC
            ELSE
              ISPGR = ISPGRA
            END IF
          ELSE IF (ISPGRA .NE. 0) THEN
            ISPGR = ISPGRA
          ELSE
            ISPGR = 0
          END IF
        ELSE
          ISPGR = ISPGRH
        END IF
        IF (NSPGR .EQ. 0) THEN
          CALL PLA015 (0, 25)
          IGBL(50) = 0
        END IF
      END IF
      INQUIRE (FILE = 'tm/.newsym.nsg', EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU61, FILE = 'tm/.newsym.nsg', STATUS = 'UNKNOWN')
        READ (LU61, 99996) LINE
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
        LINE(13:16) = ':ABC'
        NEWSG = 1
        KL    = 2
        GO TO 30
      END IF
      SAVEVRT = VRT
  120 IF (IGBL(50) .EQ. 0 .AND. NEWSG .EQ. 0) THEN
        VRT = SAVEVRT
        N = 0
        DO I = 1, NP42
          IF (TSPGR(I)(1:1) .NE. ' ') THEN
            CALL S923 (CPR(104), 2, I)
            EXST = DINQ ('tm/'//CPR(104)(4:6))
            N = N + 1
            IF (N .EQ. 1) THEN
              LIJN = 'Candidate Space Groups '//
     1               ' (defined already by number)'
              VRT = VRT - 1
              CALL GGIP09 (0.0, LIJN, 80, 0.375, 2, 2, 0.1, VRT)
              VRT = VRT - 0.3
              CALL GGIP (0.0, VRT, 0.0, 3)
              CALL GGIP (HORS, VRT, 0.0, 2)
              LIJN = ' #  E StdSet  :Transf  '//
     1        'SpGr    R(av)%  N AbsFreq  A/C-Prob'
              VRT = VRT - 0.5
              CALL GGIP09 (0.0, LIJN, 80, 0.375, 5 + IGBL(68), 2,
     1                     0.1, VRT)
              VRT = VRT - 0.3
              CALL GGIP (0.0,  VRT, 0.0, 3)
              CALL GGIP (HORS, VRT, 0.0, 2)
              PAR(360) = VRT
              PAR(361) = 0.5
            END IF
            IF (TSPGR(I)(48:48) .EQ. 'c') THEN
              XCHIR = 'hiral'
            ELSE
              XCHIR = '     '
            END IF
            IF (EXST) THEN
              WRITE (LIJN, 99995, IOSTAT = IOST)
     1          I, '*', TSPGR(I)(1:48)//XCHIR
            ELSE
              WRITE (LIJN, 99995, IOSTAT = IOST)
     1          I, ' ', TSPGR(I)(1:48)//XCHIR
            END IF
            VRT = VRT - 0.5
            CALL GGIP09 (0.0, LIJN, 80, 0.375, -1, 2, 0.1, VRT)
          END IF
        END DO
  140   WRITE (SBCD, 99992, IOSTAT = IOST) ISPGR, CHAR(0)
        IGBL(28) = 2
        CALL PLA013 (0, 1)
        IGBL(28) = 0
        IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
          KL = 1
          GO TO 20
        END IF
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 220
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          WRITE (LINE, '(I3, 77X)', IOSTAT = IOST) ISPGR
        END IF
        CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10, NP17)
        IF (KL .EQ. 0 .AND. KN .NE. 0) THEN
          ISGNR = NINT(FN(1))
          IF (ISGNR .LT. 0) THEN
            M     = 0
            ISGNR = - ISGNR
            DO I = 1, NP42
              IF (TSPGR(I)(1:1) .NE. ' ') THEN
                M = M + 1
                IF (M .EQ. ISGNR) THEN
                  ISGNR = I
                  GO TO 160
                END IF
              END IF
            END DO
            ISGNR = 0
          END IF
  160     IF (ISGNR .EQ. 0 .OR. ABS(ISGNR) .GT. NP42) THEN
            CALL PLA015 (0, 23)
            GO TO 140
          END IF
          IF (TSPGR(ISGNR) .EQ. '               ') GO TO 140
          ISPGR = ISGNR
        END IF
        IF (KL .NE. 0) THEN
          JFL(3) = LINE(1:4)
          CALL GEN020 (1, JFL(3), 1, 4)
          IF (JFL(3)(1:4) .EQ. 'SPGR') THEN
            JMN = 5
          ELSE
            JMN = 1
          END IF
          NX = INDEX (LINE, ':')
          IF (NX .EQ. 0) THEN
            JMX = 9 + JMN
            JFL(2) = 'ABC  '
          ELSE
            JMX = NX - 1
            JFL(2) = LINE(NX+1:NX+5)
          END IF
          JFL(1) = ' '
          J      = 0
          DO I = JMN, JMX
            IF (LINE(I:I) .NE. ' ') THEN
              J           = J + 1
              JFL(1)(J:J) = LINE(I:I)
            END IF
          END DO
          LINE(1:18)  = 'SPGR '//JFL(1)(1:J)//':'//JFL(2)(1:5)
          KL = 2
          GO TO 20
        END IF
      END IF
  180 CPR(100) = TSPGR(ISPGR)(1:7)//'   '
      DO I = 2, 8
        IF (TSPGR(ISPGR)(10:14) .EQ. TRTYP(I))  GO TO 200
      END DO
      GO TO 210
  200 CALL GEN004 (TRDAT(1, 1, I), TM, YUNK)
      CALL GEN052 (YUNK, TM)
  210 LINE(1:20) = 'SPGR '//CPR(100)
      CALL GEN038 (LINE, 16, 80)
      CALL SGSM (LINE, 0, XYZ, 6, 0, IERR)
      IF (IERR .NE. 0) GO TO 120
      CALL SGSM (LINE, 0, XYZ, 6, 18, IERR)
      ISPR(102) = NINT(XYZ(9))
      CALL S923 (CPR(104), 2, ISPGR)
      CALL DLNK (CPR(104)(4:6), 'tm/sg')
      OPEN (LU61, FILE = './tm/spgr/.spgr', STATUS = 'UNKNOWN',
     1      FORM = 'UNFORMATTED')
      WRITE (LU61) TSPGR
      CLOSE (UNIT = LU61)
      IF (.NOT. DINQ ('tm/'//CPR(104)(4:6))) THEN
        ISPR(11) = 3
        KERR = 0
        CALL SPAWN ('mkdir tm/'//CPR(104)(4:6), KERR)
        CALL S915 ('Select Space Group # sg = '//CPR(104)(4:6))
        CALL S932 (3)
        OPEN (LU61, FILE = 'tm/'//CPR(104)(4:6)//'/.save_nr',
     1      STATUS = 'UNKNOWN')
        WRITE (LU61, '(I3)', IOSTAT = IOST) 0
        CLOSE (UNIT = LU61)
        SPAR(225) = -1000.0
        ISPR(310) = 0
        ISPR(6)   = -1
        ISPR(223) = 0
        IGBL(107) = 0
        VALIDATION = ' '
      ELSE
        CALL S920 (-1)
        GO TO 220
      END IF
      CALL SGSM (LINE, 0, XYZ, 6, 18, IERR)
      CPR(103)  = LINE(12:21)
      ISPR(100) = NINT(XYZ(8))
      ISPR(101) = NINT(XYZ(4))
      ISPR(103) = NINT(XYZ(5))
      ISPR(104) = NINT(XYZ(6))
      ISPR(105) = NINT(XYZ(2))
      CPR(101)  = LINE(15:24)
      CPR(102) = CPR(101)
      CALL GEN020 (-1, CPR(102), 1, 10)
      CALL S931
      IF (NEWSG .EQ. 1) THEN
        CPR(209) = 'ADDSYM    '
        KERR = 0
        CALL SPAWN ('mv tm/.newsym.res tm/sg/.newsym.res', KERR)
        KERR = 0
        CALL SPAWN ('mv tm/.newsym.sav tm/sg/.newsym.sav', KERR)
      END IF
      IGBL(38) = 1
      ISPR(3) = 1
      ISPR(10) = 3
  220 CPR(105) = 'SPGR'
      CPR(106) = CPR(200)
      RETURN
99999 FORMAT (5X, 3I2, 1X, A, I4, I6, 2X, A, F8.0, I6, I5, 2(1X, A))
99998 FORMAT (4X, 6I5)
99996 FORMAT (A)
99995 FORMAT (I3, 1X, A, 1X, A)
99992 FORMAT ('CLICK/ENTER StdSet:Transf, SpGr-name or SPGR number ',
     1         '(when defined above)[', I3, ']:', A)
99990 FORMAT ('TITL ', A)
99989 FORMAT ('TRMX', 9F7.4, 1X, A, A, I3, 1X, A)
99988 FORMAT ('CELL ', F8.4, 3F8.3, 3F8.2, /,
     1        'SET IPR 548 1', /,
     2        'SPGR 2', F10.1 )
      END SUBROUTINE S170
      SUBROUTINE S175
      PARAMETER (NP1=500,NP2=350,NP3=250)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER ESPGR(22)*6, XSPGR*6, LINE*80
      DATA ESPGR/
     1 'P41   ', 'P43   ', 'P4122 ', 'P4322 ',
     2 'P41212', 'P43212', 'P31   ', 'P32   ', 'P3121 ', 'P3221 ',
     3 'P3112 ', 'P3212 ', 'P61   ', 'P65   ', 'P62   ', 'P64   ',
     4 'P6122 ', 'P6522 ', 'P6222 ', 'P6422 ', 'P4132 ', 'P4332 '/
      IF (ISPR(103) .EQ. 1) THEN
        IER = 0
        CALL S929 (-1)
        XSPGR = CPR(100)(1:6)
        DO I = 1, 22
          IF (XSPGR .EQ. ESPGR(I)) THEN
            J = I + 1 - 2 * MOD (I + 1, 2)
            CALL PLA015 (0, 21)
            OPEN (LU61, FILE = 'tm/.newsym.nsg', STATUS = 'UNKNOWN')
            WRITE (LU61, 99999, IOSTAT = IOST) ESPGR(J)
            CLOSE (UNIT = LU61)
            OPEN (LU61, FILE = 's.res',      STATUS = 'UNKNOWN')
            OPEN (LU62, FILE = '.newsym.res', STATUS = 'UNKNOWN')
   10       READ (LU61, 99997, END = 20) LINE
            IF (LINE(1:4) .EQ. 'LATT') THEN
              WRITE (LU62, 99998, IOSTAT = IOST) ESPGR(J)
            ELSE IF (LINE(1:4) .NE. 'SYMM') THEN
              WRITE (LU62, 99997, IOSTAT = IOST) LINE
            END IF
            GO TO 10
   20       CLOSE (UNIT = LU61)
            CLOSE (UNIT = LU62)
            KERR = 0
            CALL SPAWN ('mv .newsym.res tm/.newsym.res', KERR)
            CALL S170
            CALL S180 (1)
            CALL S190 (1, IER)
            GO TO 30
          END IF
        END DO
        SPAR(225) =  1.0 - SPAR(225)
        SPAR(160) =  1.0
        SPAR(161) =  1.0
        SPAR(162) =  1.0
        SPAR(163) = -1.0
        ISPR(91)  = MOD(ISPR(91) + 1, 2)
        SELECT CASE (XSPGR)
          CASE ('Fdd2  ')
            SPAR(160) = 0.25
            SPAR(161) = 0.25
          CASE ('I41   ')
            SPAR(161) = 0.5
          CASE ('I4122 ')
            SPAR(161) = 0.5
            SPAR(162) = 0.25
          CASE ('I41md ')
            SPAR(161) = 0.5
          CASE ('I41cd ')
            SPAR(161) = 0.5
          CASE ('I-42d ')
            SPAR(161) = 0.5
            SPAR(162) = 0.25
          CASE ('F4132 ')
            SPAR(160) = 0.25
            SPAR(161) = 0.25
            SPAR(162) = 0.25
        END SELECT
        CALL S929 (1)
      END IF
   30 RETURN
99999 FORMAT ('SPGR ', A)
99998 FORMAT ('SPGR ', A, ' 1 1 1 -1')
99997 FORMAT (A)
      END SUBROUTINE S175
      SUBROUTINE S180 (MODE)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      CHARACTER DUM*80
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      LOGICAL EXST
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      EXST = .FALSE.
      IF (ISPR(3) .EQ. 0) CALL S170
      NEWCONT = 0
      IF (MODE .EQ. 0) THEN
        IF (ISPR(110) .EQ. 0) THEN
          IF ((JARG - JARGB) .GT. 1) THEN
            L = 0
            CALL GEN038 (LINE, 1, 80)
            DO 10 J = 2 + JARGB, JARG
              CALL GETARG (J, DUM)
              CALL GEN020 (1, DUM, 1, 80)
              IF (DUM(1:3) .EQ. 'NQA' .OR. DUM(1:4) .EQ. 'AUTO')
     1          GO TO 10
              DO K = 1, 80
                IF (DUM(K:K) .EQ. ' ') GO TO 10
                L = L + 1
                LINE(L:L) = DUM(K:K)
              END DO
   10       CONTINUE
            CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 0, 10,
     1                   NP17)
            JARG      = 1
            ISPR(110) = KL
            NEWCONT   = 1
          END IF
        END IF
        IF (JFL(1)(1:7) .EQ. 'FORMULA') THEN
          IF (KL .GT. 1) THEN
            DO I = 2, KL
              JFL(I - 1) = JFL(I)
            END DO
            KL       = KL - 1
            NEWCONT  = 1
            CALL GEN020 (1, LINE, 1, 80)
            IF (LINE(1:4) .EQ. 'FORM') THEN
              DO I = 1, 80
                IF (LINE(I:I) .EQ. ' ') GO TO 20
              END DO
   20         I = I + 1
              DO J = I, 80
                IF (LINE(J:J) .NE. ' ') GO TO 30
              END DO
   30         I = 0
              DO K = J, 80
                I = I + 1
                LINE(I:I) = LINE(K:K)
              END DO
              I = I + 1
              CALL GEN038 (LINE, I, 80)
            END IF
          ELSE
            KL = 0
            NEWCONT = 0
          END IF
          ISPR(110) = KL
        END IF
      END IF
      IF (ISPR(110) .LE. 0) THEN
        IF (ISPR(110) .EQ. 0) THEN
          INQUIRE (FILE = '.formula', EXIST = EXST)
          IF (EXST) THEN
   40       OPEN (LU61, FILE = '.formula', STATUS = 'UNKNOWN')
            READ (LU61, '(A)') LINE
            CLOSE (UNIT = LU61)
            DO I = 1, 80
              IF (LINE(81 - I:81 - I) .NE. ' ') GO TO 50
            END DO
            CALL GEN038 (LINE, 82 - I, 80)
   50       IF (IGBL(50) .EQ. 0 .AND. MODE .EQ. 0) THEN
              WRITE (SBCD, 99999, IOSTAT = IOST)
     1          LINE(1:81 - I), CHAR(0)
              CALL PLA013 (0, 1)
              IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
                CALL S025
                GO TO 40
              END IF
              IF (IGGT(1:4) .EQ. 'EXIT') GO TO 100
              IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
                LINE = IGGT
                CALL GEN038 (IGGT, 1, 80)
              END IF
            ELSE
              KL = 0
            END IF
            CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 0, 10,
     1                   NP17)
            CALL GEN111 (JFL(1), DUM(1:2), 7, M)
            IF (M .EQ. 0) THEN
              BCD = 'Syntax Error in Formula. Try again'//CHAR(0)
              CALL GGIP (-999.0, 2.0, 80.0, 112)
              GO TO 40
            END IF
          ELSE
   60       WRITE (SBCD, 99999, IOSTAT = IOST) 'C1H2', CHAR(0)
            IGBL(50) = 0
            CALL GEN038 (LINE, 1, 80)
            CALL PLA013 (0, 1)
            IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
              CALL S025
              GO TO 60
            END IF
            IF (IGGT(1:4) .EQ. 'EXIT') GO TO 100
            IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
              LINE = IGGT
              CALL GEN038 (IGGT, 1, 80)
            END IF
            CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 0, 10,
     1                   NP17)
          END IF
        ELSE
          KM = IABS(ISPR(110))
          WRITE (BCD, 99998, IOSTAT = IOST)
     1      (SFAC(I), I = 1, KM), CHAR(0)
          CALL GGIP (-999.0, 3.0, 80.0, 112)
          CALL GEN039 (1, LINE, 1, 80, NB, ID0)
          NLOOP = 0
          DUM   = LINE
   70     NLOOP = NLOOP + 1
          WRITE (SBCD, 99999, IOSTAT = IOST) LINE(1:ID0), CHAR(0)
          IF (IGBL(50) .GT. 0) THEN
            IGGT = '!'
          ELSE
            CALL PLA013 (0, 1)
          END IF
          IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
            CALL S025
            GO TO 70
          END IF
          IF (IGGT(1:4) .EQ. 'EXIT') GO TO 100
          IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
            LINE = IGGT
            CALL GEN038 (IGGT, 1, 80)
          END IF
          CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 0, 10, NP17)
          IF (KL .GT. 0 .AND. KN .EQ. 0) THEN
            CALL GEN111 (JFL(1), DUM(1:2), 7, M)
            IF (M .EQ. 0) THEN
              LINE  = DUM
              NLOOP = NLOOP - 1
              GO TO 70
            END IF
          END IF
          IF (KL .EQ. KM .AND. KL .EQ. KN) THEN
            J = 0
            DO I = 1, KL
              IF (FN(I) .GT. 0) THEN
                J      = J + 1
                FN(J)  = FN(I)
                JFL(J) = JFL(I)
              END IF
            END DO
            KL = J
            KM = J
          END IF
          IF (KL .LT. KM) THEN
            CALL PLA015 (0, 26)
            IF (NLOOP .EQ. 1) GO TO 70
          END IF
        END IF
        IF (KL .EQ. 0) THEN
          KL     = 2
          JFL(1) = 'C1'
          JFL(2) = 'H2'
          LINE   = 'C1H2'
        END IF
        ISPR(110) = KL
        NEWCONT   = 1
      END IF
      IF (NEWCONT .GT. 0) THEN
        OPEN (LU61, FILE = '.formula', STATUS = 'UNKNOWN')
        WRITE (LU61, 99994, IOSTAT = IOST) LINE
        CLOSE (UNIT = LU61)
        SPAR(3)   = 0
        ISPR(96)  = 0
        ISPR(111) = 0
        ISPR(112) = 0
        NSCAT     = ISPR(110)
        NSC       = 1
        IGBL(97) = 0
        DO I = 1, NSCAT
          SFAC(NSC)      = '  '
          ISPR(152 + NSC) = 0
          CALL GEN111 (JFL(I), SFC(NSC), 7, ISPR(NSC + 120))
          IF (ISPR(NSC + 120) .NE. 1) ISPR(96) = ISPR(96) + 1
          IF (SFC(NSC) .EQ. 'D ') SFC(NSC) = 'H '
          IF (SFC(NSC) .EQ. 'H ') IGBL(97) = 1
          ISPR(NSC + 120) = MAX (ISPR(NSC + 120), 1)
          IF (SFC(NSC) .NE. 'H ') THEN
            ISPR(111) = ISPR(111) + ISPR(NSC + 120)
          ELSE
            ISPR(112) = ISPR(112) + ISPR(NSC + 120)
          END IF
          SFAC(NSC)  = SFC(NSC)
          IF (NSC .GT. 1) THEN
            DO J = 1, NSC - 1
              IF (SFC(J) .EQ. SFC(NSC)) THEN
                ISPR(J + 120) = ISPR(J + 120) + ISPR(NSC + 120)
                GO TO 80
              END IF
            END DO
          END IF
          J   = NSC
          NSC = NSC + 1
   80     ISPR(J + 136) = ISPR(J + 120)
        END DO
        ISPR(110) = NSC - 1
        OPEN (LU61, FILE = 'sfac.spf', STATUS = 'UNKNOWN')
        WRITE (LU61, 99997, IOSTAT = IOST) SPAR(80)
        DO I = 1, ISPR(110)
          WRITE (LU61, 99996, IOSTAT = IOST) SFAC(I), I * 0.01
        END DO
        WRITE (LU61, 99995, IOSTAT = IOST)
        CLOSE (UNIT = LU61)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' sfac.spf > sfac.log', KERR)
        OPEN (LU61, FILE = 'sfac.res', STATUS = 'UNKNOWN')
        I = 0
   90   CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80, 10,
     1               NP17)
        IF (JFL(1)(1:4) .EQ. 'SFAC') THEN
          I = I + 1
          SFAC(I) = JFL(2)(1:2)
          DO J = 1, 14
            SPAR(235 + J + 15 * I) = FN(J)
          END DO
          J = 235 + 15 * I
          SPAR(15 + J) = SPAR(1 + J) + SPAR(3 + J) + SPAR(5 + J)
     1                + SPAR(7 + J) + SPAR(9 + J)
          SPAR(3) = MAX (SPAR(3), SPAR(15 + J))
          DO J = 1, ISPR(110)
            IF (SFAC(I) .EQ. SFC(J)) THEN
              ISPR(I + 136) = ISPR(J + 120)
              ISPR(J + 120) = 0
            END IF
          END DO
        END IF
        IF (LINE(1:4) .NE. 'UNIT') GO TO 90
        KERR = 0
        CALL SPAWN ('rm sfac.spf', KERR)
        KERR = 0
        CALL SPAWN ('rm sfac.log', KERR)
        CALL SPAWN ('rm sfac.res', KERR)
        CALL SPAWN ('rm sfac.lis', KERR)
      END IF
      CPR(105) = 'FORMULA'
      CPR(106) = CPR(200)
      CALL S915 ('Define Formula')
  100 RETURN
99999 FORMAT ('Enter Formula (e.g. CU1C15H10) [', A, ']:', A)
99998 FORMAT ('New Formula:', 16(1X, A))
99997 FORMAT ('TITL SFAC', /,
     1       'CELL ', F10.5, ' 170.0 10.0 10.0 90.0 90.0 90.0')
99996 FORMAT (A, F10.3, ' 0.0 0.0')
99995 FORMAT ('SET IGBL 70 0', /, 'CALC SHELX', /, 'END')
99994 FORMAT (A)
      END SUBROUTINE S180
      SUBROUTINE S190 (MODE, IER)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      REAL MOLWT
      IMAN = 0
      IER  = 0
      NQ   = 0
      DENS = 0.0
      AV   = 0.60225
      IF (MODE .EQ. 1) THEN
        OPEN (LU61, FILE = '.Z', STATUS = 'UNKNOWN')
        READ (LU61, 99997) Z
        CLOSE (UNIT = LU61)
      ELSE
        IF (KN .EQ. 0) THEN
          IF (IGBL(97) .EQ. 1) THEN
            XATVOL = 18.0
          ELSE
            XATVOL = 15.0
          END IF
          Z  = MAX (1, ISPR(104) * NINT(SPAR(107) /
     1         (XATVOL * ISPR(111) * ISPR(104))))
          IF (Z .NE. 1) THEN
            IF (ABS(ISPR(102) - Z) .LE. MAX(1.0, ISPR(102) / 3.0)) THEN
              Z = ISPR(102)
            END IF
            IF (NINT(Z / ISPR(102)) .EQ. 2) Z = 2 * ISPR(102)
          END IF
        ELSE
          Z    = FN(1)
          NQ   = 1
          IMAN = 1
        END IF
      END IF
   10 MOLWT = 0.0
      XATVOL = 100.0
      IF (Z * ISPR(111) .GT. 0.0) THEN
        XATVOL = SPAR(107) / (ISPR(111) * Z)
      ELSE
        GO TO 30
      END IF
      DO I = 1, ISPR(110)
        ISPR(I + 120) = NINT(ISPR(I + 136) * Z)
        MOLWT         = MOLWT + ISPR(I + 120) * SPAR(249 + 15 * I)
      END DO
      DENS = MOLWT / (SPAR(107) * AV)
      IF (IMAN .EQ. 0) THEN
        IF (SPAR(3) .LT. 40) THEN
          DENSMX = 2.4
        ELSE
          DENSMX = 3.0
        END IF
        IF (DENS .GT. DENSMX .AND. MOD(NINT(Z), 2) .EQ. 0) THEN
          Z = Z / 2.0
          GO TO 10
        END IF
        IF (DENS .LT. 0.8 .AND. Z .EQ. 1 .AND. ISPR(102) .EQ. 1) THEN
          Z = 2.0
          GO TO 10
        END IF
        IF (ISPR(103) .EQ. 2 .AND. MOD(NINT(Z), 2) .EQ. 1) THEN
          IF (Z .GT. 4.0) THEN
            Z = Z + 1.0
            GO TO 10
          END IF
        END IF
      END IF
      SPAR(121) = DENS
      SPAR(122) = XATVOL
      ISPR(120) = MAX (1, NINT(Z))
      IF (IGBL(50) .EQ. 0 .AND. NQ .EQ. 0 .AND. MODE .EQ. 0) THEN
   20   WRITE (BCD, 99999, IOSTAT = IOST) DENS, ISPR(120), CHAR(0)
        CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68)), 60.0, 112)
        WRITE (SBCD, 99998, IOSTAT = IOST) ISPR(120), CHAR(0)
        CALL PLA013 (0, 1)
        IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') THEN
          CALL S025
          GO TO 20
        END IF
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 30
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
          CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10,
     1                 NP17)
          IF (KN .EQ. 1) THEN
            Z    = FN(1)
            IMAN = 1
            GO TO 10
          END IF
        END IF
      END IF
      ISPR(4) = 1
      CALL S915 ('Z - Defined')
      OPEN (LU61, FILE = '.Z', STATUS = 'UNKNOWN')
      WRITE (LU61, 99997, IOSTAT = IOST) Z
      CLOSE (UNIT = LU61)
      CALL S921 (0)
      CALL S922 (IER)
      IF (IER .NE. 0) THEN
        CPR(105) = 'SPGR'
      ELSE
        CPR(105) = 'Z'
      END IF
      CPR(106) = CPR(200)
   30 RETURN
99999 FORMAT ('Density =', F6.3, ' for Z =', I3, A)
99998 FORMAT ('Z[', I3, ' ] ', A)
99997 FORMAT (F10.2)
      END SUBROUTINE S190
      SUBROUTINE S200
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      CHARACTER PHM*80
      INTEGER CHANDIR
      LOGICAL EXST
      EXST = .FALSE.
      MODE = ISPR(16)
      CALL S915 ('Run Phase')
      IF (ISPR(3)  .EQ. 0) CALL S170
      IF (ISPR(4)  .EQ. 0) CALL S180 (0)
      IF (ISPR(12) .EQ. 0) CALL S922 (NER)
      IGBL(34)   = 0
      VALIDATION = ' '
      ISPR(6)  = -1
      ISPR(91) = 0
      DO I = 3, 7
        CALL GEN038 (CPR(200 + I), 1, 10)
      END DO
      IF (ISPR(14) .EQ. 6) THEN
        ISPR(14) = 0
        ISPR(15) = 0
      END IF
      CALL S924 (0)
      INA          = ISTATB(MODE)
      PHM(1 : INA) = SSTATB(MODE)(1 : INA)
      CALL S909 ('tm/sg/'//PHM(1:INA))
      INQUIRE (FILE = 'exor', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('rm -r exor', KERR)
      END IF
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.res s.res', KERR)
      IERR = 0
      SELECT CASE (ISPR(16))
        CASE (1)
          CALL S210 (IERR)
        CASE (2)
          CALL S210 (IERR)
        CASE (3)
          CALL S220 (IERR)
        CASE (4)
          CALL S220 (IERR)
        CASE (5)
          CALL S230 (IERR)
        CASE (6)
          CALL S240 (IERR)
        CASE (7)
          CALL S250 (IERR)
        CASE (8)
          CALL S260 (IERR)
        CASE (9)
          CALL S220 (IERR)
      END SELECT
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      IF (IERR .EQ. 1) THEN
        IF (IGBL(50) .EQ. 0)
     1  WRITE (LU6, '(''ERROR in PHASE SOLUTION STAGE '')',
     2    IOSTAT = IOST)
        CPR(105) ='Z'
        CPR(106) = CPR(200)
      ELSE
        ISPR(6)  = 0
        ISPR(7)  = 1
        CPR(105) = 'PHASE'
        ISPR(11) = 4
        CALL S920 (1)
        IF (IGBL(50) .EQ. 0 .AND. ISPR(50) .EQ. 0) CALL S410 (0)
      END IF
      RETURN
      END SUBROUTINE S200
      SUBROUTINE S210 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER CTREF*9
      DIMENSION XYZ(12)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      IF (KL .EQ. 1) THEN
         CPR(2)(1:4) = 'TREF'
         FN(1)       = 500
         FN(2)       = 2
      END IF
      IF (ISPR(16) .EQ. 2) THEN
        CALL S915 ('Run SHELXS97'//CPR(2))
        CPR(106) = 'SHELXS97'
      ELSE
        IF (CPR(2)(1:4) .EQ. 'TEXP' .OR. CPR(2)(1:4) .EQ. 'PATT')
     1     THEN
             IERR = 1
             GO TO 70
        END IF
        CALL S915 ('Run Stripped SHELXS86/TREF')
        CPR(106) = 'SHELXS86'
      END IF
      CPR(2) = CPR(52)
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.hkl shelxs.hkl', KERR)
      IF (CPR(2)(1:4) .EQ. 'TEXP') THEN
        OPEN (LU62, FILE = 'shelxs.res', STATUS = 'UNKNOWN')
        OPEN (LU61, FILE = 'shelxs.ins', STATUS = 'UNKNOWN')
        NAT = -1
   10   READ (LU62, 99996) LINE
        IF (LINE(1:4) .EQ. 'L.S.') GO TO 10
        IF (LINE(1:4) .EQ. 'BOND') GO TO 10
        IF (LINE(1:4) .EQ. 'FMAP') GO TO 10
        IF (LINE(1:4) .EQ. 'PLAN') THEN
          NAT = 0
          GO TO 10
        END IF
        IF (LINE(1:4) .EQ. 'HKLF') THEN
          WRITE (LU61, 99988, IOSTAT = IOST)  'TEXP', 200, NAT
          WRITE (LU61, 99996, IOSTAT = IOST) LINE
          GO TO 40
        END IF
        IF (NAT .GT. -1 .AND. LINE(1:1) .NE. ' ') NAT = NAT + 1
        WRITE (LU61, 99996, IOSTAT = IOST) LINE
        GO TO 10
      ELSE
        OPEN  (LU61, FILE = 'shelxs.ins', STATUS = 'UNKNOWN')
        WRITE (LU61, 99999, IOSTAT = IOST)
     1    TITL(1:6), CPR(106), CPR(52), SPAR(80), (SPAR(100 + I),
     2      I = 1, 6)
        WRITE (LU61, 99993, IOSTAT = IOST) ISPR(100)
        DO I = 2, ISPR(101)
          NUMS = I
          CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
          WRITE (LU61, 99992, IOSTAT = IOST) LINE(1:60)
        END DO
        DO I = 1, ISPR(110)
          WRITE (LU61, 99991, IOSTAT = IOST) SFAC(I),
     1          (SPAR(235 + J + 15 * I), J = 1, 14)
        END DO
        WRITE (LU61, 99998, IOSTAT = IOST)
     1    (ISPR(I + 120), I = 1, ISPR(110))
        IF (KN .GT. 0 .AND. FN(1) .NE. 0.0) THEN
          WRITE (CTREF, '(I9)', IOSTAT = IOST) NINT(FN(1))
          TNP = FN(1)
        ELSE
          CTREF = ' '
          TNP   = 50
        END IF
        IF (FN(2) .NE. 0.0) THEN
          IOMIT = NINT(FN(2))
        ELSE
          IOMIT = 4
        END IF
        WRITE (LU61, 99997, IOSTAT = IOST) CPR(2)(1:7), CTREF, IOMIT
        IF (GEN135 (TM) .GT. 0.5) THEN
          WRITE (LU61, 99995, IOSTAT = IOST)
        ELSE
          WRITE (LU61, 99994, IOSTAT = IOST)
     1      ((TM(I, J), J = 1, 3), I = 1, 3)
        END IF
        CLOSE (UNIT = LU61)
      END IF
   40 IF (IGBL(50) .EQ. 0) THEN
        WRITE (BCD, 99990, IOSTAT = IOST)
     1    CPR(2)(1:4), CTREF, IOMIT, CHAR(0)
        CALL GGIP (-999.0, 2.0, 80.0, 112)
      END IF
      IF (ISPR(16) .EQ. 2) THEN
        IF (IGBL(44) .EQ. 1) THEN
          KERR = 0
          CALL SPAWN (EDITOR//' shelxl.ins', KERR)
        END IF
        KERR = 0
        CALL SPAWN (SHSPATH//' shelxs > sjob3.log', KERR)
        KERR = 0
        CALL SPAWN ('rm sjob3.log', KERR)
      ELSE
        CALL PLA155 (TNP)
      END IF
      OPEN (LU61, FILE = 'shelxs.res', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 's.res',  STATUS = 'UNKNOWN')
      NR1  = 0
      NR2  = 0
      MOLE = 0
   50 READ (LU61, 99996, END = 60) LINE
      IF (ISPR(16) .EQ. 1 .AND. LINE(1:4) .EQ. 'OMIT' .OR.
     1    ISPR(16) .EQ. 2 .AND. LINE(1:4) .EQ. 'MOLE') THEN
        IF (MOLE .EQ. 0) WRITE (LU62, 99989, IOSTAT = IOST)
        MOLE = 1
        GO TO 50
      END IF
      IF (LINE(1:4) .EQ. 'HKLF') THEN
        WRITE (LU62, 99996, IOSTAT = IOST) LINE
        GO TO 60
      END IF
      IF (LINE(1:4) .EQ. 'OMIT') GO TO 50
      IF (CPR(2)(1:4) .EQ. 'PATT') THEN
        IF (LINE(1:4) .EQ. 'PLAN') THEN
          WRITE (LU62, 99996, IOSTAT = IOST) LINE
          WRITE (LU62,  99989, IOSTAT = IOST)
          GO TO 50
        END IF
      END IF
      IF (LINE(1:3) .EQ. 'END') THEN
        WRITE (LU62, 99996, IOSTAT = IOST) LINE
        GO TO 60
      END IF
      IF (MOLE .EQ. 1) THEN
        CALL GEN105 (3, LINE(2:2), I)
        IF (I .GE. 0) THEN
          LINE(2:2) = ' '
          IF (NR1 .LT. 999) THEN
            NR1 = NR1 + 1
            NR  = NR1
          ELSE
            GO TO 50
          END IF
        ELSE
          IF (NR2 .LT. 99) THEN
            NR2 = NR2 + 1
            NR  = NR2
          ELSE
            GO TO 50
          END IF
        END IF
        NR = NR + 1
        CALL GEN058 (LINE(1:4), NR)
      END IF
      WRITE (LU62, 99996, IOSTAT = IOST) LINE
      GO TO 50
   60 CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      IF (CPR(2) .EQ. 'TREF      ') THEN
        ISPR(18) = 2
      ELSE
        ISPR(18) = 3
      END IF
      IF (ISPR(16) .EQ. 2) THEN
        CPR(203) = 'SHELXS97  '
      ELSE
        CPR(203) = 'SHELXS86  '
      END IF
   70 RETURN
99999 FORMAT ('TITL ', A, 1X, A, 1X, A, /,
     1        'CELL ', F7.5, 6F10.4)
99998 FORMAT ('UNIT ', 2I5, 14I4)
99997 FORMAT (A, 1X, A, /, 'OMIT ', I3)
99996 FORMAT (A)
99995 FORMAT ('HKLF 4')
99994 FORMAT ('HKLF 4 1', 9F8.4)
99993 FORMAT ('LATT ', I3)
99992 FORMAT ('SYMM ', A)
99991 FORMAT ('SFAC ', A, 1X, 5F12.5, ' =', /, 8X, 4F12.5, ' =',
     1 /, 8X, 5F12.5)
99990 FORMAT ('===>> run SHELXS (structure determination)',
     1        ' mode = ', 2A, ' OMIT =', I2, A)
99989 FORMAT ('FVAR 1.0')
99988 FORMAT (A, 2I5)
      END SUBROUTINE S210
      SUBROUTINE S220 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER BUFF*80, WIND*9
      DIMENSION XYZ(12)
      LOGICAL EXST
      EXST = .FALSE.
      IF (ISPR(16) .EQ. 4) THEN
        IF (IGBL(114) .EQ. 0) THEN
          CALL PLA015 (0, 54)
          IERR = 1
          GO TO 50
        END IF
        CALL S915 ('Run SIR2004')
        CPR(106) = 'SIR2004'
      ELSE IF (ISPR(16) .EQ. 9) THEN
        IF (IGBL(120) .EQ. 0) THEN
          CALL PLA015 (0, 60)
          IERR = 1
          GO TO 50
        END IF
        CALL S915 ('Run SIR2011')
        CPR(106) = 'SIR2011'
      ELSE
        IF (IGBL(113) .EQ. 0) THEN
          CALL PLA015 (0, 16)
          IERR = 1
          GO TO 50
        END IF
        CALL S915 ('Run SIR97')
        CPR(106) = 'SIR97'
      END IF
      IF (KL .GT. 1 .AND. JFL(2)(1:6) .EQ. 'RANDOM') THEN
        CPR(72) = 'RANDOM    '
      ELSE
        CPR(72) = 'DEFAULT   '
      END IF
      I = 0
      CALL S930 (0, LINE(1:4), I)
      CPR(2) = CPR(72)
      IF (KN .GT. 0) THEN
        maxtr = NINT(FN(1))
      ELSE
        maxtr  = 100
      END IF
      OPEN (LU61, FILE = 'sir.sir', STATUS = 'UNKNOWN')
      IF (IGBL(50) .EQ. 0 .AND. IGBL(122) .NE. 0) THEN
        WIND = '%Window  '
      ELSE
        WIND = '%Nowindow'
      END IF
      WRITE (LU61, 99999, IOSTAT = IOST)
     1   WIND, TITL, (SPAR(100 + I), I = 1, 6), CPR(102)
      WRITE (BUFF, 99998, IOSTAT = IOST)
     1  (SFAC(I), ISPR(I + 120), I = 1, ISPR(110))
      CALL GEN020 (-1, BUFF, 5, 80)
      WRITE (LU61, 99982, IOSTAT = IOST) BUFF
      WRITE (LU61, 99997, IOSTAT = IOST)
      IF (IGBL(50) .LT. 2) THEN
        IF (CPR(2) .EQ. 'RANDOM    ') THEN
          WRITE (LU61, 99988, IOSTAT = IOST) maxtr
          WRITE (LU6, 99983, IOSTAT = IOST) CPR(2), maxtr
        ELSE
          WRITE (LU6, 99985, IOSTAT = IOST) CPR(2)
        END IF
      END IF
      WRITE (LU61, 99996, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      INQUIRE (FILE = 's.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../s.hkl s.hkl', KERR)
      END IF
      CALL S902 (0, TM, LU61, LU62, 'sir.hkl')
      IF (ISPR(16) .EQ. 3) THEN
        KERR = 0
        CALL SPAWN (SIR97PATH//' sir', KERR)
      ELSE IF (ISPR(16) .EQ. 4) THEN
        CALL SPAWN (SIR04PATH//' sir', KERR)
        KERR = 0
      ELSE IF (ISPR(16) .EQ. 9) THEN
        KERR = 0
        CALL SPAWN (SIR11PATH//' sir', KERR)
      END IF
      IERR = 0
      OPEN (LU61, FILE = 'sir.out', STATUS = 'OLD')
   10 READ (LU61, 99982, END = 20) LINE
      IF (INDEX(LINE, 'ends in error') .NE. 0) THEN
        CALL PLA015 (0, 32)
        IERR = 1
        GO TO 50
      ELSE
        GO TO 10
      END IF
   20 NLINE = 0
      IF (ISPR(16) .EQ. 3) THEN
        OPEN (LU61, FILE = 'sir.ins', STATUS = 'UNKNOWN')
      ELSE
        OPEN (LU61, FILE = 'sir.res', STATUS = 'UNKNOWN')
      END IF
      OPEN (LU62, FILE = 's.res', STATUS = 'UNKNOWN')
      IF (ISPR(16) .EQ. 3) THEN
        WRITE (LU62, 99987, IOSTAT = IOST) TITL(1:6)
      ELSE
        WRITE (LU62, 99986, IOSTAT = IOST) TITL(1:7)
      END IF
      WRITE (LU62, 99995, IOSTAT = IOST)
     1   SPAR(80), (SPAR(100 + I), I = 1, 6)
      WRITE (LU62, 99994, IOSTAT = IOST) ISPR(100)
      DO I = 2, ISPR(101)
        NUMS = I
        CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
        WRITE (LU62, 99993, IOSTAT = IOST) LINE(1:60)
      END DO
      WRITE (LU62, 99990, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
      WRITE (LU62, 99989, IOSTAT = IOST)
     1  (ISPR(I + 120), I = 1, ISPR(110))
      IFVR = 0
   30 READ  (LU61, 99982, END = 40) LINE
      NLINE = NLINE + 1
      CALL GEN020 (1, LINE, 1, 80)
      IF (LINE(1:4) .EQ. 'FVAR') THEN
        WRITE (LU62, 99991, IOSTAT = IOST) LINE(5:80)
        IFVR = 1
        GO TO 30
      END IF
      IF (IFVR .EQ. 0) GO TO 30
      IF (LINE(1:4) .EQ. '    ') GO TO 30
      IF (LINE(1:4) .EQ. 'HKLF') GO TO 40
      IF (LINE(1:4) .EQ. 'OMIT') GO TO 40
      CALL S930 (1, LINE(1:4), I)
      WRITE (LU62, 99982, IOSTAT = IOST) LINE
      GO TO 30
   40 IF (NLINE .EQ. 0) THEN
        IERR = 1
        GO TO 50
      END IF
      WRITE (LU62, 99992, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      KERR = 0
      CALL SPAWN ('rm sir.bin', KERR)
      INQUIRE (FILE = 'sir.plt', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('rm sir.plt', KERR)
      END IF
      CPR(203) = 'SIR       '
      ISPR(6)  = 0
   50 RETURN
99999 FORMAT (A, /,
     1        '%struc sir', /,
     2        '%init', /,
     3        '%job ', A, /,
     4        '%data', /,
     5        'cell ', 6F10.4, /,
     6        'space ', A)
99998 FORMAT ('cont', 11(1X, A, I4))
99997 FORMAT ('fosquare', /,
     1        'refl sir.hkl', /,
     2        'format (3i4, 2f8.0)')
99996 FORMAT ('%continue')
99995 FORMAT ('CELL ', F7.5, 6F10.4)
99994 FORMAT ('LATT ', I3)
99993 FORMAT ('SYMM ', A)
99992 FORMAT ('END')
99991 FORMAT ('FVAR', A)
99990 FORMAT ('SFAC ', 16(A, 1X))
99989 FORMAT ('UNIT ', 2I5, 14I4)
99988 FORMAT ('%normal', /,
     1        '%invar', /,
     2        '%phase', /,
     3        'random', /,
     4        'maxtrial ', I10)
99987 FORMAT ('TITL ', A, ' - SIR97')
99986 FORMAT ('TITL ', A, ' - SIR2004')
99985 FORMAT (/, '===>> run SIR (structure determination)',
     1        ' mode = ', A, /)
99983 FORMAT (/, '===>> run SIR (structure determination)',
     1        ' mode = ', A, ' - maxtr = ', I5, /)
99982 FORMAT (A)
      END SUBROUTINE S220
      SUBROUTINE S230 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER WL*2
      DIMENSION XYZ(12)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      LOGICAL EXST
      EXST = .FALSE.
      IF (IGBL(115) .EQ. 0) THEN
        CALL PLA015 (0, 14)
        IERR = 1
        RETURN
      END IF
      I = 0
      CALL S930 (0, LINE(1:4), I)
      CPR(2) = CPR(62)
      CALL S915 ('Run DIRDIF08')
      CPR(106) = 'DIRDIF'
      OPEN  (LU61, FILE = 'crysin', STATUS = 'UNKNOWN')
      WRITE (LU61, 99999, IOSTAT = IOST)
     1  (SPAR(100 + I), I = 1, 6), (SPAR(107 + I), I = 1, 6), CPR(101)
      WRITE (LU61, 99998, IOSTAT = IOST)
     1  (SFAC(I), ISPR(I + 120), I = 1, ISPR(110))
      IF (SPAR(80) .GT. 1.0) THEN
        WL = 'CU'
      ELSE
        WL = 'MO'
      END IF
      WRITE (LU61, 99997, IOSTAT = IOST)
     1  WL, ((TM(I, J), J = 1, 3), I = 1, 3)
      CLOSE (UNIT = LU61)
      INQUIRE (FILE = 'drdf.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../s.hkl drdf.hkl', KERR)
      END IF
      IF (CPR(2)(1:6) .EQ. 'ORIENT') THEN
        NLIN = 0
        KERR = 0
        CALL SPAWN ('rm -f model', KERR)
        CALL SPAWN ('rm -f atmod', KERR)
        CALL SPAWN ('ln -s ../../../.model model', KERR)
        OPEN (LU61, FILE = 'model', STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 'atmod', STATUS = 'UNKNOWN')
   10   CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80, 10,
     1               NP17)
        IF (JFL(1)(1:3) .EQ. 'EOF') GO TO 20
        WRITE (LU62, 99996, IOSTAT = IOST) LINE
        NLIN = NLIN + 1
        GO TO 10
   20   CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        IF (NLIN .EQ. 0) THEN
          IF (IGBL(50) .EQ. 0) THEN
            WRITE (BCD, '(A, A)', IOSTAT = IOST)
     1          'No Model Found. ORBASE run in ASCII Window', CHAR(0)
            CALL GGIP (-999.0, 2.0, 80.0, 112)
            CALL GGIP (0.0, 0.0, 0.0, 6)
          END IF
          KERR = 0
          CALL SPAWN ('rm -f atmod', KERR)
          CALL SPAWN (DIRPATH//' ORBASE ', KERR)
        END IF
      END IF
      KERR = 0
      CALL SPAWN (DIRPATH//'  '//CPR(2)//' > df.log 2> df.log', KERR)
      OPEN (LU61, FILE = 'df.log', STATUS = 'UNKNOWN')
   30 READ (LU61, 99996, END = 40) LINE
      IF (INDEX (LINE(1:20), 'ERROR') .NE. 0) THEN
        GO TO 40
      ELSE
        IF (INDEX (LINE, 'DRDF.res') .EQ. 0 .AND.
     1     INDEX (LINE, 'drdf.res') .EQ. 0) GO TO 30
        GO TO 50
      END IF
   40 CALL PLA015 (0, 13)
      IERR  = 1
   50 CLOSE (UNIT = LU61)
      IF (IERR .EQ. 0) THEN
        IFVAR = 0
        OPEN (LU61, FILE = 'drdf.res', STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 's.res', STATUS = 'UNKNOWN')
        WRITE (LU62, 99995, IOSTAT = IOST) TITL(1:6), SPAR(80),
     1                      (SPAR(100 + I), I = 1, 6)
        WRITE (LU62, 99986, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
        WRITE (LU62, 99985, IOSTAT = IOST)
     1    (ISPR(I + 120), I = 1, ISPR(110))
        WRITE (LU62, 99994, IOSTAT = IOST) ISPR(100)
        DO I = 2, ISPR(101)
          NUMS = I
          CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
          WRITE (LU62, 99993, IOSTAT = IOST) LINE(1:60)
        END DO
   70   READ  (LU61, 99996, END = 90) LINE
        IF (LINE(1:4) .EQ. 'FVAR') THEN
          IFVAR = 1
          GO TO 80
        END IF
        IF (LINE(1:1) .EQ. ' ') GO TO 70
        IF (LINE(1:4) .EQ. 'HKLF') GO TO 70
        IF (LINE(1:3) .EQ. 'END') THEN
          WRITE (LU62, 99991, IOSTAT = IOST)
     1    ((TM(I, J), J = 1, 3), I = 1, 3)
          GO TO 80
        END IF
        IF (IFVAR .EQ. 1) THEN
          READ (LINE, 99992) IFN1
          IF (SFAC(IFN1) .EQ. 'H ') GO TO 70
          CALL S930 (1, LINE(1:4), I)
        ELSE
          GO TO 70
        END IF
   80   WRITE (LU62, 99996, IOSTAT = IOST) LINE
        GO TO 70
   90   CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        CPR(203) = 'DIRDIF    '
      END IF
      RETURN
99999 FORMAT ('CRYSIN DRDF', /, 'TITLE ', /, 'CELL ', 6F10.4, /,
     1        'CELLSD ', 6F10.4, /, 'SPGR ', A)
99998 FORMAT ('FORMUL', 11(1X, A, I4))
99997 FORMAT ('Z    1', /, 'WAVE ', A, /,
     1        'HKLF 4 1', 9F8.4, /,  'END')
99996 FORMAT (A)
99995 FORMAT ('TITL ', A, ' - DIRDIF  ', /, 'CELL ', F7.5, 6F10.4)
99994 FORMAT ('LATT ', I3)
99993 FORMAT ('SYMM ', A)
99992 FORMAT (7X, I2)
99991 FORMAT ('HKLF 4 1', 9F8.4)
99986 FORMAT ('SFAC ', 16(A, 1X))
99985 FORMAT ('UNIT ', 2I5, 14I4)
      END SUBROUTINE S230
      SUBROUTINE S240 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      DIMENSION XYZ(12)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      LOGICAL EXST
      IF (IGBL(112) .EQ. 0) THEN
        CALL PLA015 (0, 55)
        IGBL(50) = 0
        IERR     = 1
        GO TO 20
      END IF
      IF (KN .GT. 0) ISPR(28) = NINT (FN(1))
      CALL S915 ('Run SHELXD')
      CPR(106) = 'SHELXD'
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.hkl shelxd.hkl', KERR)
      INQUIRE (FILE = 'shelxd.res', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('rm shelxd.res', KERR)
      END IF
      OPEN  (LU61, FILE = 'shelxd.ins', STATUS = 'UNKNOWN')
      WRITE (LU61, 99999, IOSTAT = IOST) TITL(1:6), CPR(106),
     1                    SPAR(80), (SPAR(100 + I), I = 1, 6)
      WRITE (LU61, 99993, IOSTAT = IOST) ISPR(100)
      DO I = 2, ISPR(101)
        NUMS = I
        CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
        WRITE (LU61, 99992, IOSTAT = IOST) LINE(1:60)
      END DO
      WRITE (LU61, 99991, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
      WRITE (LU61, 99998, IOSTAT = IOST)
     1  (ISPR(I + 120), I = 1, ISPR(110))
      AEXP = FLOAT(ISPR(111) * ISPR(120)) / ISPR(102)
      PEXP = 0.20
      WRITE (LU61, 99997, IOSTAT = IOST)
     1  (NINT((1.0 - PEXP) * AEXP)), NINT(AEXP),
     1                    NINT ((1.0 + PEXP) * AEXP), ISPR(28)
      IF (GEN135 (TM) .GT. 0.5) THEN
        WRITE (LU61, 99995, IOSTAT = IOST)
      ELSE
        WRITE (LU61, 99994, IOSTAT = IOST)
     1    ((TM(I, J), J = 1, 3), I = 1, 3)
      END IF
      CLOSE (UNIT = LU61)
      IF (IGBL(50) .EQ. 0) THEN
        WRITE (BCD, 99990, IOSTAT = IOST) CHAR(0)
        CALL GGIP (-999.0, 2.0, 80.0, 112)
      END IF
      IF (IGBL(44) .EQ. 1) THEN
        KERR = 0
        CALL SPAWN (EDITOR//' shelxd.ins', KERR)
      END IF
      KERR = 0
      CALL SPAWN (SHDPATH//' shelxd  > sjob3.log', KERR)
      INQUIRE (FILE = 'shelxd.res', EXIST = EXST)
      IF (.NOT. EXST) THEN
        IERR = 1
        GO TO 20
      END IF
      OPEN (LU61, FILE = 'shelxd.res', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 's.res',  STATUS = 'UNKNOWN')
      NR1  = 0
      NR2  = 0
      DO
        READ (LU61, 99989, END = 10) LINE
        IF (LINE(1:4) .EQ. 'HKLF') THEN
          WRITE (LU62, 99989, IOSTAT = IOST) LINE
          GO TO 10
        END IF
        IF (LINE(1:4) .NE. 'OMIT') THEN
          IF (LINE(1:3) .EQ. 'END') THEN
            WRITE (LU62, 99989, IOSTAT = IOST) LINE
            GO TO 10
          END IF
          CALL GEN105 (3, LINE(3:3), N)
          IF (N .GE. 0) THEN
            CALL GEN105 (3, LINE(2:2), I)
            IF (I .GE. 0) THEN
              LINE(2:2) = ' '
              NR1 = NR1 + 1
              NR  = NR1
            ELSE
              NR2 = NR2 + 1
              NR  = NR2
            END IF
            NR = NR + 1
            CALL GEN058 (LINE(1:4), NR)
          END IF
          WRITE (LU62, 99989, IOSTAT = IOST) LINE
        END IF
      END DO
   10 CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      CPR(203) = 'SHELXD'
   20 RETURN
99999 FORMAT ('TITL ', A, 1X, A, /,
     1        'CELL ', F7.5, 6F10.4)
99998 FORMAT ('UNIT ', 2I5, 14I4)
99997 FORMAT ('FIND', I5, /,
     1        'PLOP', 2I5, /,
     2        'NTRY', I5)
99995 FORMAT ('HKLF 4')
99994 FORMAT ('HKLF 4 1', 9F8.4)
99993 FORMAT ('LATT ', I3)
99992 FORMAT ('SYMM ', A)
99991 FORMAT ('SFAC', 16(1X, A))
99990 FORMAT ('===>> run SHELXD (structure determination)', A)
99989 FORMAT (A)
      END SUBROUTINE S240
      SUBROUTINE S250 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER CTREF*9
      DIMENSION XYZ(12)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CTREF = ' '
      CALL S915 ('Run FLIPPER')
      CPR(106) = 'FLIPPER'
      CPR(2) = CPR(52)
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.hkl flip.hkl', KERR)
      OPEN  (LU61, FILE = 'flip.ins', STATUS = 'UNKNOWN')
      WRITE (LU61, 99999) TITL(1:6), CPR(106), CPR(52),
     1                      SPAR(80), (SPAR(100 + I), I = 1, 6)
      WRITE (LU61, 99993) ISPR(100)
      DO I = 2, ISPR(101)
        NUMS = I
        CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
        WRITE (LU61, 99992) LINE(1:60)
      END DO
      DO I = 1, ISPR(110)
        WRITE (LU61, 99991) SFAC(I),
     1        (SPAR(235 + J + 15 * I), J = 1, 14)
      END DO
      WRITE (LU61, 99998) (ISPR(I + 120), I = 1, ISPR(110))
      IF (GEN135 (TM) .GT. 0.5) THEN
        WRITE (LU61, 99995)
      ELSE
        WRITE (LU61, 99994) ((TM(I, J), J = 1, 3), I = 1, 3)
      END IF
      WRITE (LU61, 99987)
      CLOSE (UNIT = LU61)
      IF (IGBL(50) .EQ. 0) THEN
        WRITE (BCD, 99990) CPR(2)(1:4), CTREF, CHAR(0)
        CALL GGIP (-999.0, 2.0, 80.0, 112)
      END IF
      KERR = 0
      CALL SPAWN (PLAPATH//' flip.ins > sjob3.log', KERR)
      OPEN (LU61, FILE = 'flip.res', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 's.res',  STATUS = 'UNKNOWN')
      NR1  = 0
      NR2  = 0
      MOLE = 0
   10 READ (LU61, 99996, END = 20) LINE
      IF (LINE(1:4) .EQ. 'HKLF') THEN
        WRITE (LU62, 99996) LINE
        GO TO 20
      END IF
      IF (LINE(1:3) .EQ. 'END') THEN
        WRITE (LU62, 99996) LINE
        GO TO 20
      END IF
      IF (MOLE .EQ. 1) THEN
        CALL GEN105 (3, LINE(2:2), I)
        IF (I .GE. 0) THEN
          LINE(2:2) = ' '
          IF (NR1 .LT. 999) THEN
            NR1 = NR1 + 1
            NR  = NR1
          ELSE
            GO TO 10
          END IF
        ELSE
          IF (NR2 .LT. 99) THEN
            NR2 = NR2 + 1
            NR  = NR2
          ELSE
            GO TO 10
          END IF
        END IF
        NR = NR + 1
        CALL GEN058 (LINE(1:4), NR)
      END IF
      WRITE (LU62, 99996) LINE
      GO TO 10
   20 CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      CPR(203) = 'FLIPPER   '
      RETURN
99999 FORMAT ('TITL ', A, 1X, A, 1X, A, /,
     1        'CELL ', F7.5, 6F10.4)
99998 FORMAT ('UNIT ', 2I5, 14I4)
99996 FORMAT (A)
99995 FORMAT ('HKLF 4')
99994 FORMAT ('HKLF 4 1', 9F8.4)
99993 FORMAT ('LATT ', I3)
99992 FORMAT ('SYMM ', A)
99991 FORMAT ('SFAC ', A, 1X, 5F12.5, ' =', /, 8X, 4F12.5, ' =',
     1 /, 8X, 5F12.5)
99990 FORMAT ('===>> run FLIPPER (structure determination)',
     1        ' mode = ', 2A, A)
99987 FORMAT ('FLIP 5 250 2 AUTO')
      END SUBROUTINE S250
      SUBROUTINE S260 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      DIMENSION XYZ(12)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
C * SHELXT
      IF (IGBL(119) .EQ. 0) THEN
        CALL PLA015 (0, 59)
        IGBL(50) = 0
        IERR     = 1
        RETURN
      END IF
      CALL S915 ('Run SHELXT')
      CPR(106) = 'SHELXT'
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.hkl shelxt.hkl', KERR)
      OPEN  (LU61, FILE = 'shelxt.ins', STATUS = 'UNKNOWN')
      WRITE (LU61, 99999, IOSTAT = IOST) TITL(1:6), CPR(106), CPR(52),
     1                    SPAR(80), (SPAR(100 + I), I = 1, 6)
      WRITE (LU61, 99993, IOSTAT = IOST) ISPR(100)
      DO I = 2, ISPR(101)
        NUMS = I
        CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
        WRITE (LU61, 99992, IOSTAT = IOST) LINE(1:60)
      END DO
      WRITE (LU61, 99991, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
      WRITE (LU61, 99998, IOSTAT = IOST)
     1  (ISPR(I + 120), I = 1, ISPR(110))
      IF (GEN135 (TM) .GT. 0.5) THEN
        WRITE (LU61, 99995, IOSTAT = IOST)
      ELSE
        WRITE (LU61, 99994, IOSTAT = IOST)
     1    ((TM(I, J), J = 1, 3), I = 1, 3)
      END IF
      CLOSE (UNIT = LU61)
      IF (IGBL(50) .EQ. 0) THEN
        WRITE (BCD, 99990, IOSTAT = IOST)
        CALL GGIP (-999.0, 2.0, 80.0, 112)
      END IF
      KERR = 0
      CALL SPAWN (SHTPATH//' shelxt > sjob3.log', KERR)
      KERR = 0
      CALL SPAWN ('rm sjob3.log', KERR)
      OPEN (LU61, FILE = 'shelxt_a.res', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 's.res',  STATUS = 'UNKNOWN')
   50 READ (LU61, 99996, END = 60) LINE
      WRITE (LU62, 99996, IOSTAT = IOST) LINE
      GO TO 50
   60 CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      CPR(203) = 'SHELXT    '
      RETURN
99999 FORMAT ('TITL ', A, 1X, A, 1X, A, /,
     1        'CELL ', F7.5, 6F10.4)
99998 FORMAT ('UNIT ', 2I5, 14I4)
99996 FORMAT (A)
99995 FORMAT ('HKLF 4')
99994 FORMAT ('HKLF 4 1', 9F8.4)
99993 FORMAT ('LATT ', I3)
99992 FORMAT ('SYMM ', A)
99991 FORMAT ('SFAC ', 16(A, 1X))
99990 FORMAT ('===>> run SHELXT (structure determination)')
      END SUBROUTINE S260
      SUBROUTINE S300 (IP2, IP3, NEXOR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER AUTO*4
      INTEGER CHANDIR
      LOGICAL EXST
      IF (IGBL(50) .GT. 0) THEN
        AUTO = 'AUTO'
      ELSE
        AUTO = ' '
      END IF
      EXST   = .FALSE.
      P1     = 0.0
      IF (KL .GT. 1 .AND. KL .EQ. KN + 1) THEN
        DO I = 2, KL
          IF (JFL(I)(1:4) .EQ. 'OMIT') THEN
            SPAR(200) = FN(I - 1)
          END IF
        END DO
      END IF
      MODE = ISPR(16)
      IF (MODE .EQ. 0) THEN
        IN2           = IN + 17
        FNM(IN+1:IN2) = 'tm/sg/shelxl/exor'
      ELSE
        IN3           = ISTATB(MODE)
        IN2           = IN + 11 + IN3
        FNM(IN+1:IN2) = 'tm/sg/'//SSTATB(MODE)(1:IN3)//'/exor'
      END IF
      CALL S909 (FNM(1:IN2))
      KERR = 0
      CALL SPAWN ('ln -s -f ../../setup/s.bin s.bin', KERR)
      CALL SPAWN ('ln -s -f ../../s.hkl shelxl.hkl',  KERR)
      OPEN (LU61, FILE = '../s.res', STATUS = 'UNKNOWN')
   20 OPEN (LU62, FILE = 's.ins', STATUS = 'UNKNOWN')
   30 READ (LU61, 99995, END = 40) LINE
      IF (LINE(1:3) .EQ. 'END') THEN
        GO TO 40
      ELSE IF (LINE(1:3) .EQ. 'HKL') THEN
        GO TO 40
      ELSE IF (LINE(1:4) .EQ. 'SFAC') THEN
        BACKSPACE LU61
        CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80, 10,
     1               NP17)
        GO TO 30
      ELSE
        IF (LINE(1:4) .EQ. 'UNIT') WRITE (LU62, 99993, IOSTAT = IOST)
     1   (SFAC(I), I = 1, ISPR(110))
        WRITE (LU62, 99995, IOSTAT = IOST) LINE
        GO TO 30
      END IF
   40 IF (IGBL(68) .EQ. 1) WRITE (LU62, 99999, IOSTAT = IOST) IGBL(82)
      IF (NEXOR .GT. 0) THEN
        IIP3 = -IP3
      ELSE
        IIP3 = IP3
      END IF
      WRITE (LU62, 99992, IOSTAT = IOST)
     1  SPAR(200), SPAR(56), SPAR(57), P1, IP2,
     1                    IIP3, 1, 1, AUTO
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      KERR = 0
      CALL SPAWN
     1  ('sh -c '''//PLAPATH(1:IGBL(80))//' s.ins  '' ', KERR)
      INQUIRE (FILE = 'NEXT', EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU61, FILE = 'NEXT', STATUS = 'UNKNOWN')
        READ (LU61, 99995) LINE
        IF (LINE(1:4) .EQ. 'SKIP') NEXOR = 0
        CLOSE (UNIT = LU61, STATUS = 'DELETE')
      END IF
      INQUIRE (FILE = 's.res', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('mv s.res s.rese', KERR)
        OPEN (LU61, FILE = 's.rese', STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 's.res', STATUS = 'UNKNOWN')
   50   READ (LU61, 99995, END = 60) LINE
        IF (LINE(1:4) .NE. 'HKLF') THEN
          IF (LINE(1:4) .EQ. 'FVAR') WRITE (LU62, 99997, IOSTAT = IOST)
          WRITE (LU62, 99995, IOSTAT = IOST) LINE
          GO TO 50
        END IF
   60   IF (GEN135 (TM) .GT. 0.5) THEN
          WRITE (LU62, 99996, IOSTAT = IOST)
        ELSE
          WRITE (LU62, 99998, IOSTAT = IOST)
     1      ((TM(I, J), J = 1, 3), I = 1, 3)
        END IF
        CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        IF (NEXOR .GT. 0) THEN
          IF (IGBL(25) * IGBL(32) .EQ. 1 .AND. IGBL(50) .EQ. 0) THEN
            CALL GGIP09 (0.0, 'Refine x,y,z,U', 14, 1.5, 2, 8, 3.0,
     1                   8.0)
            CALL GGIP (0.0, 0.0, 0.0, 6)
          END IF
          KERR = 0
          CALL SPAWN ('mv s.res shelxl.ins', KERR)
          CALL SPAWN (SHLPATH//' shelxl > shelxl.log', KERR)
          OPEN (LU61, FILE = 'shelxl.res', STATUS = 'UNKNOWN')
          NEXOR = NEXOR - 1
          GO TO 20
        END IF
        CALL S924 (0)
        KERR = 0
        CALL SPAWN ('cp s.res ../../s.res', KERR)
        CALL SPAWN ('rm s.rese', KERR)
        OPEN (LU61, FILE = 's_log', STATUS = 'UNKNOWN')
   70   READ (LU61, 99995, END = 80) LINE
        IF (LINE(1:7) .NE. ':: RVAL') GO TO 70
        READ (LINE, 99994, ERR = 80) SPAR(202), SPAR(203)
   80   CLOSE(LU61)
        CPR(204) = 'EXOR'
        CALL S915 ('Run PLATON/EXOR')
        ISPR(17) = 1
        ISPR(6)  = 0
        CPR(105) = 'EXOR'
        CPR(106) = CPR(200)
      END IF
      IF (CHANDIR (FNM(1 : IN - 1)) .NE. 0) CALL S925 (1)
      IF (EXST .AND. IGBL(50) .EQ. 0) CALL S410 (0)
      RETURN
99999 FORMAT ('SET IGBL 82', I3, /, 'SET REVERSE')
99998 FORMAT ('HKLF 4 1', 9F8.4, /, 'END')
99997 FORMAT ('L.S. 3')
99996 FORMAT ('HKLF 4', /, 'END')
99995 FORMAT (A)
99994 FORMAT (8X, 2F10.3, 2I10)
99993 FORMAT ('SFAC ', 16(1X, A))
99992 FORMAT ('EXOR', 4F8.2, 4I5, 1X, A )
      END SUBROUTINE S300
      SUBROUTINE S301 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER BUFF*80, WIND*9
      DIMENSION XYZ(12)
      DIMENSION RP(50)
      INTEGER CHANDIR
      LOGICAL EXST
      IF (IGBL(113) .EQ. 0) THEN
        CALL PLA015 (0, 16)
        IERR = 1
        RETURN
      END IF
      CALL S915 ('Run SIR/EXORS')
      EXST    = .FALSE.
      ISPR(17) = 2
      I        = 0
      CALL S930 (0, LINE(1:4), I)
      MODE = ISPR(16)
      IF (MODE .EQ. 0) THEN
        IN2       = IN + 18
        FNM(IN+1:IN2) = 'tm/sg/shelxl/exors'
      ELSE
        IN3 = ISTATB(MODE)
        IN2 = IN + 12 + IN3
        FNM(IN+1:IN2) = 'tm/sg/'//SSTATB(MODE)(1:IN3)//'/exors'
      END IF
      CALL S909 (FNM(1:IN2))
      WRITE (LU6, 99979, IOSTAT = IOST)
      NAT  = 0
      IPAT = 0
      OPEN (LU62, FILE = 'sir.frg', STATUS = 'UNKNOWN')
      OPEN (LU61, FILE = '../s.res', STATUS = 'UNKNOWN')
      IFVAR = 0
   10 CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80, 10,
     1             NP17)
      IF (JFL(1)(1:4) .EQ. 'FVAR') THEN
        DO I = 1, KN
          RP(I) = FN(I)
        END DO
        RP(1) = 1.0
        IFVAR = 1
        GO TO 10
      ELSE IF (JFL(1)(1:4) .EQ. 'TITL') THEN
        IF (LINE(24:27) .EQ. 'PATT') IPAT = 1
        GO TO 10
      ELSE IF (JFL(1)(1:4) .EQ. 'MOLE') THEN
        RP(1) = 1.0
        IFVAR = 1
        GO TO 10
      ELSE IF (JFL(1)(1:3) .EQ. 'END') THEN
        GO TO 20
      ELSE IF (JFL(1)(1:3) .EQ. 'HKL') THEN
        GO TO 20
      ELSE IF (JFL(1)(1:3) .EQ. 'EOF') THEN
        GO TO 20
      ELSE IF (JFL(1)(1:4) .EQ. 'PLAN') THEN
        IF (IPAT .EQ. 1) THEN
          READ (LU61, '(A)') LINE
          IFVAR = 1
        END IF
        GO TO 10
      ELSE IF (IFVAR .EQ. 1 .AND. KN .GE. 4) THEN
        NAT = NAT + 1
        DO K = 2, 4
          YY = FN(K)
          IF (ABS(YY) .GT. 5.0) THEN
            I = NINT(ABS(YY) * 0.1)
            RPI = RP(I)
            SJ = SIGN (0.5, YY)
            YY = (YY - I * SJ * 20.0) * (RPI + SJ - 0.5)
          END IF
          FN(K) = YY
        END DO
        WRITE (LU62, 99969, IOSTAT = IOST) (FN(I), I = 2, 4)
      END IF
      GO TO 10
   20 CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      OPEN (LU61, FILE = 'sir.sir', STATUS = 'UNKNOWN')
      IF (IGBL(50) .EQ. 0) THEN
        WIND = '%Window  '
      ELSE
        WIND = '%Nowindow'
      END IF
      WRITE (LU61, 99999, IOSTAT = IOST)
     1  WIND, TITL, (SPAR(100 + I), I = 1, 6),
     1 CPR(102)
      WRITE (BUFF, 99998, IOSTAT = IOST)
     1  (SFAC(I), ISPR(I + 120), I = 1, ISPR(110))
      CALL GEN020 (-1, BUFF, 5, 80)
      WRITE (LU61, '(A)', IOSTAT = IOST) BUFF
      WRITE (LU61, 99997, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      INQUIRE (FILE = 's.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../../s.hkl s.hkl', KERR)
      END IF
      CALL S902 (0, TM, LU61, LU62, 'sir.hkl')
      KERR = 0
      CALL SPAWN (SIR97PATH//' sir', KERR)
      IERR = 0
      OPEN (LU61, FILE = 'sir.out', STATUS = 'OLD')
      DO
        READ (LU61, '(A)', END = 30) LINE
        IF (LINE(2:18) .EQ. 'sir ends in error') THEN
          WRITE (LU6, '(/, A, /)', IOSTAT = IOST) LINE
          WRITE (LU6, '('' See exors/sir.lis, Acknowledge '')',
     1      IOSTAT = IOST)
          IERR = 1
          READ (LU5, '(A)') LINE
          GO TO 60
        END IF
      END DO
   30 OPEN (LU61, FILE = 'sir.ins', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 's.res', STATUS = 'UNKNOWN')
      WRITE (LU62, 99995, IOSTAT = IOST)
     1  TITL(1:6), SPAR(80), (SPAR(100 + I), I = 1, 6)
      WRITE (LU62, 99994, IOSTAT = IOST) ISPR(100)
      DO I = 2, ISPR(101)
        NUMS = I
        CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
        WRITE (LU62, 99993, IOSTAT = IOST) LINE(1:60)
      END DO
      DO I = 1, ISPR(110)
        WRITE (LU62, 99990, IOSTAT = IOST)
     1    SFAC(I), (SPAR(235 + J + 15 * I), J = 1, 14)
      END DO
      WRITE (LU62, 99989, IOSTAT = IOST)
     1  (ISPR(I + 120), I = 1, ISPR(110))
      IFVR = 0
   40 READ  (LU61, 99992, END = 50) LINE
      CALL GEN020 (1, LINE, 1, 80)
      IF (LINE(1:4) .EQ. 'FVAR') THEN
        WRITE (LU62, 99991, IOSTAT = IOST) LINE(5:80)
        IFVR = 1
        GO TO 40
      END IF
      IF (IFVR .EQ. 1) THEN
        IF (LINE(1:4) .EQ. '    ') GO TO 40
        IF (LINE(1:4) .EQ. 'HKLF') GO TO 50
        CALL S930 (1, LINE(1:4), I)
        WRITE (LU62, 99992, IOSTAT = IOST) LINE
      END IF
      GO TO 40
   50 WRITE (LU62, '(A)', IOSTAT = IOST) LINE
      WRITE (LU62, 99996, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      KERR = 0
      CALL SPAWN ('rm sir.bin', KERR)
      CALL SPAWN ('rm sir.plt', KERR)
      CALL SPAWN ('cp s.res ../../s.res', KERR)
      CPR(204) = 'EXORS'
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      ISPR(6)  = 0
      CPR(105) = 'EXORS'
      CPR(106) = CPR(200)
      IF (IGBL(50) .EQ. 0) CALL S410 (0)
   60 RETURN
99999 FORMAT (A, /,
     1        '%struc sir', /,
     2        '%init', /,
     3        '%job ', A, /,
     4        '%data', /,
     5        'cell ', 6F10.4, /,
     6        'space ', A)
99998 FORMAT ('cont', 11(1X, A, I4))
99997 FORMAT ('fosquare', /,
     1        'refl sir.hkl', /,
     2        'format (3i4, 2f8.0)', /,
     3        '%normal', /,
     3        '%fourier', /
     4        'fragment sir.frg', /,
     5        '%continue')
99996 FORMAT ('END')
99995 FORMAT ('TITL ', A, ' - EXORS', /, 'CELL ', F7.5, 6F10.4)
99994 FORMAT ('LATT ', I3)
99993 FORMAT ('SYMM ', A)
99992 FORMAT (A)
99991 FORMAT ('FVAR', A)
99990 FORMAT ('SFAC ', A, 1X, 5F12.5, ' =', /, 8X, 4F12.5, ' =',
     1        /, 8X, 5F12.5)
99989 FORMAT ('UNIT ', 2I5,14I4)
99979 FORMAT (/, '===>> run exorcise - sir', /)
99969 FORMAT ('C ', 3F10.4)
      END SUBROUTINE S301
      SUBROUTINE S302 (IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      DIMENSION XYZ(12)
      DIMENSION RP(50)
      INTEGER CHANDIR
      LOGICAL EXST
      CHARACTER WL*2
      IF (IGBL(115) .EQ. 0) THEN
        CALL PLA015 (0, 14)
        IERR = 1
        RETURN
      END IF
      CALL S915 ('Run DIRDIF/EXORD')
      EXST     = .FALSE.
      ISPR(17) = 3
      I = 0
      CALL S930 (0, LINE(1:4), I)
      MODE = ISPR(16)
      IF (MODE .EQ. 0) THEN
        IN2       = IN + 18
        FNM(IN+1:IN2) = 'tm/sg/shelxl/exord'
      ELSE
        IN3 = ISTATB(MODE)
        IN2 = IN + 12 + IN3
        FNM(IN+1:IN2) = 'tm/sg/'//SSTATB(MODE)(1:IN3)//'/exord'
      END IF
      CALL S909 (FNM(1:IN2))
      WRITE (LU6, 99979, IOSTAT = IOST)
      NAT  = 0
      IPAT = 0
      NEXPMX = NINT(SPAR(107) / (15.0 * ISPR(102)))
      OPEN (LU61, FILE = '../s.res', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 'atoms', STATUS = 'UNKNOWN')
      WRITE (LU62, 99988, IOSTAT = IOST)
      IFVAR = 0
   10 CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80, 10, NP17)
      IF (JFL(1)(1:4) .EQ. 'FVAR') THEN
        DO I = 1, KN
          RP(I) = FN(I)
        END DO
        RP(1) = 1.0
        IFVAR = 1
        GO TO 10
      ELSE IF (JFL(1)(1:4) .EQ. 'TITL') THEN
        IF (LINE(24:27) .EQ. 'PATT') IPAT = 1
        GO TO 10
      ELSE IF (JFL(1)(1:4) .EQ. 'MOLE') THEN
        RP(1) = 1.0
        IFVAR = 1
        GO TO 10
      ELSE IF (JFL(1)(1:3) .EQ. 'REM') THEN
        GO TO 10
      ELSE IF (JFL(1)(1:4) .EQ. 'AFIX') THEN
        GO TO 10
      ELSE IF (JFL(1)(1:3) .EQ. 'END') THEN
        GO TO 40
      ELSE IF (JFL(1)(1:3) .EQ. 'HKL') THEN
        GO TO 40
      ELSE IF (JFL(1)(1:3) .EQ. 'EOF') THEN
        GO TO 40
      ELSE IF (JFL(1)(1:4) .EQ. 'PLAN') THEN
        IF (IPAT .EQ. 1) THEN
          READ (LU61, '(A)') LINE
          IFVAR = 1
        END IF
        GO TO 10
      ELSE IF (IFVAR .EQ. 1 .AND. KN .GE. 4) THEN
        NAT = NAT + 1
        DO K = 2, 4
          YY = FN(K)
          IF (ABS(YY) .GT. 5.0) THEN
            I = NINT(ABS(YY) * 0.1)
            RPI = RP(I)
            SJ = SIGN (0.5, YY)
            YY = (YY - I * SJ * 20.0) * (RPI + SJ - 0.5)
          END IF
          FN(K) = YY
        END DO
        IF (NAT .LE. NEXPMX) THEN
          IF (JFL(1)(1:1) .EQ. 'Q') JFL(1)(1:1) ='C'
          WRITE (LU62, 99969, IOSTAT = IOST) JFL(1), (FN(I), I = 2, 4)
        END IF
      END IF
      GO TO 10
   40 WRITE (LU62, 99996, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      OPEN  (LU61, FILE = 'crysin', STATUS = 'UNKNOWN')
      WRITE (LU61, 99999, IOSTAT = IOST) (SPAR(100 + I), I = 1, 6),
     1                    (SPAR(107 + I), I = 1, 6), CPR(101)
      WRITE (LU61, 99998, IOSTAT = IOST)
     1  (SFAC(I), ISPR(I + 120), I = 1, ISPR(110))
      IF (SPAR(80) .GT. 1.0) THEN
        WL = 'CU'
      ELSE
        WL = 'MO'
      END IF
      WRITE (LU61, 99997, IOSTAT = IOST)
     1  WL, ((TM(I, J), J = 1, 3), I = 1, 3)
      CLOSE (UNIT = LU61)
      INQUIRE (FILE = 'drdf.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../../s.hkl drdf.hkl', KERR)
      END IF
      KERR = 0
      CALL SPAWN (DIRPATH//' PHASEX > df.log 2> df.log', KERR)
      OPEN (LU61, FILE = 'df.log', STATUS = 'UNKNOWN')
   50 READ (LU61, 99990, END = 60) LINE
      IF (INDEX (LINE(1:20), 'ERROR') .NE. 0) THEN
        GO TO 60
      ELSE
        IF (INDEX (LINE, 'DRDF.res') .EQ. 0 .AND.
     1     INDEX (LINE, 'drdf.res') .EQ. 0) GO TO 50
        GO TO 70
      END IF
   60 CALL PLA015 (0, 13)
      IERR  = 1
   70 CLOSE (UNIT = LU61)
      IF (IERR .EQ. 0) THEN
        IFVAR = 0
        OPEN (LU61, FILE = 'drdf.res', STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 's.res', STATUS = 'UNKNOWN')
        WRITE (LU62, 99995, IOSTAT = IOST) TITL(1:6), SPAR(80),
     1                      (SPAR(100 + I), I = 1, 6)
        WRITE (LU62, 99986, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
        WRITE (LU62, 99989, IOSTAT = IOST)
     1    (ISPR(I + 120), I = 1, ISPR(110))
        WRITE (LU62, 99994, IOSTAT = IOST) ISPR(100)
        DO I = 2, ISPR(101)
          NUMS = I
          CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
          WRITE (LU62, 99993, IOSTAT = IOST) LINE(1:60)
        END DO
   90   READ  (LU61, 99990, END = 110) LINE
        IF (LINE(1:4) .EQ. 'FVAR') THEN
          IFVAR = 1
          GO TO 100
        END IF
        IF (LINE(1:1) .EQ. ' ') GO TO 90
        IF (LINE(1:4) .EQ. 'HKLF') GO TO 90
        IF (LINE(1:3) .EQ. 'END') THEN
          WRITE (LU62, 99992, IOSTAT = IOST)
     1      ((TM(I, J), J = 1, 3), I = 1, 3)
          GO TO 100
        END IF
        IF (IFVAR .EQ. 1) THEN
          READ (LINE, 99991) IFN1
          IF (SFAC(IFN1) .EQ. 'H ') GO TO 90
          CALL S930 (1, LINE(1:4), I)
        ELSE
          GO TO 90
        END IF
  100   WRITE (LU62, 99990, IOSTAT = IOST) LINE
        GO TO 90
  110   CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN ('cp s.res ../../s.res', KERR)
        CPR(204) = 'EXORD'
        IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
        ISPR(6)  = 0
        CPR(105) = 'EXORD'
        CPR(106) = CPR(200)
        IF (IGBL(50) .EQ. 0) CALL S410 (0)
      END IF
      RETURN
99999 FORMAT ('CRYSIN drdf', /, 'TITLE ', /,
     1        'CELL ', 6F10.4, /, 'CELLSD ', 6F10.4, /,
     2 'SPGR ', A)
99998 FORMAT ('FORMUL', 11(1X, A, I4))
99997 FORMAT ('Z    1', /, 'WAVE ', A, /,
     1        'HKLF 4 1', 9F8.4, /,  'END')
99996 FORMAT ('END')
99995 FORMAT ('TITL ', A, ' - EXORD', /, 'CELL ', F7.5, 6F10.4)
99994 FORMAT ('LATT ', I3)
99993 FORMAT ('SYMM ', A)
99992 FORMAT ('HKLF 4 1', 9F8.4)
99991 FORMAT (7X, I2)
99990 FORMAT (A)
99986 FORMAT ('SFAC ', 16(A, 1X))
99989 FORMAT ('UNIT ', 2I5,14I4)
99988 FORMAT ('ATOMS drdf')
99979 FORMAT (/, '===>> run exorcise - dirdif08', /)
99969 FORMAT ('ATOM ', A, 3F10.4)
      END SUBROUTINE S302
      SUBROUTINE S305 (ICTEST, NLOOP)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DIMENSION LPPSCL(3, 16), NATRP(2, 500)
      CHARACTER STEXT(520)*80, TXRES*80, TXRES1*80, OBSSIG*16, TEXT*40,
     1 NEWLAB*4
      CALL S915 ('Run ELTREF')
      TEXT = ' '
      CALL S909 ('tm/sg/eltref')
      STLMN = FN(1)
      DO J = 1, 16
        DO I = 1, 3
          LPPSCL(I, J) = 0
        END DO
      END DO
      DO I = 1, ISPR(110)
        IF (SFAC(I) .EQ. 'C ' .AND. ICTEST .NE. 0) THEN
          NPSCL        = 1
          LPPSCL(1, I) = I
          DO J = 1, ISPR(110)
            IF (SFAC(J) .EQ. 'B ' .OR. SFAC(J) .EQ. 'N ') THEN
              NPSCL            = NPSCL + 1
              LPPSCL(NPSCL, I) = J
            END IF
          END DO
        ELSE IF (SFAC(I) .EQ. 'N ') THEN
          NPSCL        = 1
          LPPSCL(1, I) = I
          DO J = 1, ISPR(110)
            IF (SFAC(J) .EQ. 'O ' .OR. SFAC(J) .EQ. 'C ') THEN
              NPSCL            = NPSCL + 1
              LPPSCL(NPSCL, I) = J
            END IF
          END DO
        ELSE IF (SFAC(I) .EQ. 'O ') THEN
          NPSCL        = 1
          LPPSCL(1, I) = I
          DO J = 1, ISPR(110)
            IF (SFAC(J) .EQ. 'N ' .OR. SFAC(J) .EQ. 'F ') THEN
              NPSCL            = NPSCL + 1
              LPPSCL(NPSCL, I) = J
            END IF
          END DO
        ELSE IF (SFAC(I) .EQ. 'F ') THEN
          NPSCL        = 1
          LPPSCL(1, I) = I
          DO J = 1, ISPR(110)
            IF (SFAC(J) .EQ. 'O ') THEN
              NPSCL            = NPSCL + 1
              LPPSCL(NPSCL, I) = J
            END IF
          END DO
        ELSE IF (SFAC(I) .EQ. 'P ') THEN
          NPSCL        = 1
          LPPSCL(1, I) = I
          DO J = 1, ISPR(110)
            IF (SFAC(J) .EQ. 'SI' .OR. SFAC(J) .EQ. 'S ') THEN
              NPSCL            = NPSCL + 1
              LPPSCL(NPSCL, I) = J
            END IF
          END DO
        ELSE IF (SFAC(I) .EQ. 'S ') THEN
          NPSCL        = 1
          LPPSCL(1, I) = I
          DO J = 1, ISPR(110)
            IF (SFAC(J) .EQ. 'P ' .OR. SFAC(J) .EQ. 'CL') THEN
              NPSCL            = NPSCL + 1
              LPPSCL(NPSCL, I) = J
            END IF
          END DO
        ELSE IF (SFAC(I) .EQ. 'CL') THEN
          NPSCL        = 1
          LPPSCL(1, I) = I
          DO J = 1, ISPR(110)
            IF (SFAC(J) .EQ. 'S ') THEN
              NPSCL            = NPSCL + 1
              LPPSCL(NPSCL, I) = J
            END IF
          END DO
        END IF
      END DO
      IF (STLMN .GT. 0.0) THEN
        KERR = 0
        CALL SPAWN ('ln -s -f ../s.hkl s.hkl', KERR)
        OPEN (LU61, FILE = 's.hkl', STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 'shelxl.hkl', STATUS = 'UNKNOWN')
        DO
          READ (LU61, 99992, ERR = 10, END = 10) IH, IK, IL, OBSSIG
          IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) GO TO 10
          STL = SQRT (GEN095 (SPAR(95), IH, IK, IL))
          IF (STL .GT. STLMN) WRITE (LU62, 99992, IOSTAT = IOST)
     1      IH, IK, IL, OBSSIG
        END DO
   10   WRITE (LU62, 99990, IOSTAT = IOST)
        CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
      ELSE
        KERR = 0
        CALL SPAWN ('ln -s -f ../s.hkl shelxl.hkl', KERR)
      END IF
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.res s.res', KERR)
      DO NLP = 1, NLOOP
        IF (NLP .EQ. 1) THEN
          OPEN (LU61, FILE = 's.res', STATUS = 'UNKNOWN')
        ELSE
          OPEN (LU61, FILE = 'shelxl.res', STATUS = 'UNKNOWN')
        END IF
        NTXT = 1
        NVR  = 0
        NSAT = 0
        NCHG = 0
        DO
          READ (LU61, 99999, END = 20, ERR = 20) STEXT(NTXT)
          IF (STEXT(NTXT)(1:4) .EQ. 'HKLF') GO TO 20
          IF (STEXT(NTXT)(1:4) .NE. 'REM ' .AND.
     1        STEXT(NTXT)(1:4) .NE. 'AFIX' .AND.
     2        STEXT(NTXT)(1:4) .NE. 'BLOC') THEN
            IF (STEXT(NTXT)(1:4) .EQ. 'FVAR') THEN
              NVR = 1
            ELSE IF (NVR .NE. 0) THEN
              IF (STEXT(NTXT)(1:4) .NE. '    ') THEN
                READ (STEXT(NTXT)(6:7), 99993) NSCAT
                IF (LPPSCL(2, NSCAT) .NE. 0) THEN
                  NSAT = NSAT + 1
                  IF (NSAT .GT. 500) GO TO 90
                  NATRP(1, NSAT) = NTXT
                  NATRP(2, NSAT) = NSCAT
                END IF
              END IF
            END IF
            NTXT = NTXT + 1
            IF (NTXT .GT. 520) GO TO 90
          END IF
        END DO
   20   CLOSE (UNIT = LU61)
        IF (NSAT .GT. 0) THEN
          NLAB = 0
          MLAB = 0
          DO I = 1, NSAT
            NTX    = NATRP(1, I)
            NSC    = NATRP(2, I)
            RCOMB1 = 100.0
            RCOMB2 = 100.0
            M0     = 0
            TXRES1 = ' '
            DO J = 1, 3
              M = LPPSCL(J, NSC)
              IF (M .NE. 0) THEN
                WRITE (STEXT(NTX)(6:7), 99993, IOSTAT = IOST) M
                OPEN (LU61, FILE = 'shelxl.ins', STATUS = 'UNKNOWN')
                DO 30 K = 1, NTXT
                  IF (STEXT(K)(1:4) .EQ. 'ACTA') GO TO 30
                  IF (STEXT(K)(1:4) .EQ. 'PLAN') GO TO 30
                  IF (STEXT(K)(1:4) .EQ. 'BLOC') GO TO 30
                  IF (STEXT(K)(1:4) .EQ. 'FVAR')
     1              WRITE (LU61, 99991, IOSTAT = IOST) STEXT(NTX)(1:4)
                  WRITE (LU61, 99999, IOSTAT = IOST) STEXT(K)
   30           CONTINUE
                CLOSE (UNIT = LU61)
                KERR = 0
                CALL SPAWN (SHLPATH//' shelxl > shelxl.log', KERR)
                OPEN (LU61, FILE = 'shelxl.log', STATUS = 'UNKNOWN')
   40           READ (LU61, 99999, END = 60) LINE
                N = INDEX (LINE, 'Fo > 4sig')
                IF (N .EQ. 0) GO TO 40
                READ (LINE(6:13), 99996) R1
                READ (LU61, 99995) WR2
                IF (IGBL(50) .EQ. 1) THEN
                  X = HORS - 13.0
                  Y = VERT - 4.5
                ELSE
                  X = HORS - 11.0
                  Y = 0.3 * VERT
                END IF
                CALL GGIP09 (0.0, TEXT, 40, 0.30, 0, 1, X, Y)
                WRITE (TEXT, 99994, IOSTAT = IOST)
     1            NLP, I, J - 1, STEXT(NTX)(1:4), R1, WR2
                CALL GGIP09 (0.0, TEXT, 40, 0.30, 1, 1, X, Y)
                CALL GGIP (0.0, 0.0, 0.0, 6)
                IF (R1  .LT. RCOMB1 .AND. WR2 .LT. RCOMB2 ) THEN
                  RCOMB1 = R1
                  RCOMB2 = WR2
                  M0     = M
                  OPEN (LU62, FILE = 'shelxl.res', STATUS = 'UNKNOWN')
                  DO
                    READ (LU62, 99999) TXRES
                    N = INDEX (TXRES, '=')
                    IF (N .NE. 0) READ (LU62, 99999) TXRES1
                    IF (STEXT(NTX)(1:4) .EQ. TXRES(1:4)) GO TO 50
                  END DO
   50             CLOSE (UNIT = LU62)
                END IF
   60           CLOSE (UNIT = LU61)
              END IF
            END DO
            STEXT(NTX) = TXRES
            IF (INDEX (TXRES, '=') .NE. 0)  STEXT(NTX + 1) = TXRES1
            IF (M0 .EQ. NATRP(2, I)) THEN
              WRITE (STEXT(NTX)(6:7), 99993, IOSTAT = IOST) M0
            ELSE
   70         IF (SFAC(M0)(2:2) .EQ. ' ') THEN
                NLAB = NLAB + 1
                WRITE (NEWLAB, 99998, IOSTAT = IOST)
     1            SFAC(M0)(1:1), 500 + NLAB
              ELSE
                MLAB = MLAB + 1
                WRITE (NEWLAB, 99997, IOSTAT = IOST)
     1            SFAC(M0)(1:2), 50 + MLAB
              END IF
              DO J = 1, NTXT
                IF (STEXT(J)(1:4) .EQ. NEWLAB) GO TO 70
              END DO
              NCHG = NCHG + 1
              WRITE (STEXT(NTX)(1:7), 99998, IOSTAT = IOST) NEWLAB, M0
            END IF
          END DO
          OPEN (LU61, FILE = 'shelxl.ins', STATUS = 'UNKNOWN')
          DO K = 1, NTXT
            IF (STEXT(K)(1:4) .NE. 'BLOC')
     1        WRITE (LU61, 99999, IOSTAT = IOST) STEXT(K)
          END DO
          CLOSE (UNIT = LU61)
          KERR = 0
          CALL SPAWN (SHLPATH//' shelxl > shelxl.log', KERR)
        ELSE
          GO TO 90
        END IF
        IF (NCHG .EQ. 0) GO TO 80
      END DO
   80 CALL S924 (0)
      KERR = 0
      CALL SPAWN ('cp shelxl.res ../pn/s.res', KERR)
      CALL SPAWN ('cp shelxl.lst ../pn/shelxl.lst', KERR)
      CALL SPAWN ('cp shelxl.cif ../pn/shelxl.cif', KERR)
      CALL SPAWN ('cp shelxl.fcf ../pn/shelxl.fcf', KERR)
   90 IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      IF (IGBL(50) .EQ. 0) CALL S410(0)
      RETURN
99999 FORMAT (A)
99998 FORMAT (A, I3)
99997 FORMAT (A, I2)
99996 FORMAT (F8.0)
99995 FORMAT (6X, F8.0)
99994 FORMAT (I1, ',', I3, ',', I1, 1X, A, 2F10.4)
99993 FORMAT (I2)
99992 FORMAT (3I4, A)
99991 FORMAT ('BLOC 1 -1 ', A)
99990 FORMAT (1X)
      END SUBROUTINE S305
      SUBROUTINE S310 (ICGLS, IERR)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LIJN*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      CHARACTER LTYPE*2, SGXX1*12, SGXX2*17
      DIMENSION XYZ(12)
      INTEGER CHANDIR
      LOGICAL EXST
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      W3 = 0.0
      W4 = 0.0
      IF (IGBL(110) .EQ. 0) THEN
        CALL PLA015 (0, 29)
        IERR = 1
        RETURN
      END IF
      CALL GEN038 (PROBLEM, 1, 80)
      ISPR(11) = 5
      MODE = MAX (1, ISPR(6) + ISPR(7))
      IF (MODE .EQ. 1) THEN
        CPR(106) = 'ISO'
      ELSE IF (MODE .EQ. 2) THEN
        CPR(106) = 'ANISO'
      ELSE IF (MODE .EQ. 3) THEN
        CPR(106)  = 'HATS  '
        ISPR(215) = 0
      ELSE IF (MODE .EQ. 4) THEN
        CPR(106) = 'WEIGHT'
      ELSE
        CPR(106) = CPR(200)
      END IF
      IF (KN .GT. 0) THEN
        NLS = NINT(FN(1))
      ELSE
          NLS = 5
      END IF
      CALL S909 ('tm/sg/shelxl')
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.hkl '//COMPD(1:IC)//'.hkl', KERR)
      CALL SPAWN ('ln -s -f ../s.res s.res', KERR)
      KERR = 0
      CALL SPAWN ('rm -f diff.lis', KERR)
      INQUIRE (FILE = 'shelxl.res', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('diff shelxl.res save.res > diff.lis', KERR)
        OPEN (LU61, FILE = 'diff.lis', STATUS = 'UNKNOWN')
        READ (LU61, 99972, END = 10, ERR = 10) LINE
        WRITE (BCD, 99972, IOSTAT = IOST)
     1 'shelxl.res and s.res differ ! Use shelxl.res (y/n[y]'//CHAR(0)
        CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68) * IGBL(82)), 80.0, 110)
        CALL PLA013 (0, 1)
        IF (IGGT(1:1) .EQ. 'Y') THEN
          KERR = 0
          CALL SPAWN ('cp shelxl.res s.res', KERR)
        END IF
        CLOSE (UNIT = LU61)
        GO TO 20
   10   CLOSE (UNIT = LU61, STATUS = 'DELETE')
      END IF
   20 ITEL = 0
      OPEN (LU61, FILE = 's.res', STATUS = 'UNKNOWN')
      DO
        CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 0, 1, 80, 10,
     1               NP17)
        IF (JFL(1)(1:3) .EQ. 'EOF') THEN
          IF (ITEL .LT. 2) THEN
            PROBLEM = 'FILE s.res EMPTY or INCOMPLETE'
            NDF = 0
            GO TO 200
          ELSE
            EXIT
          END IF
        END IF
        ITEL = ITEL + 1
      END DO
      CLOSE (UNIT = LU61)
      IF (ISPR(6) .EQ. 0 .OR. MODE .EQ. 2) THEN
        OPEN (LU61, FILE = 's.res',      status = 'unknown')
        OPEN (LU62, FILE = 'shelxl.ins', status = 'unknown')
        DO
          READ (LU61, 99972, END = 40, ERR = 40) LINE
          CALL GEN020 (1, LINE, 1, 80)
          IF (LINE(1:4) .EQ. 'SFAC') THEN
   30       IF (INDEX (LINE, '=') .NE. 0) THEN
              READ (LU61, 99972, END = 40, ERR = 40) LINE
              GO TO 30
            END IF
            CYCLE
          END IF
          IF (LINE(1:4) .EQ. 'UNIT') CYCLE
          IF (LINE(1:4) .EQ. 'ZERR') CYCLE
          IF (LINE(1:3) .EQ. 'END')  GO TO 40
          IF (LINE(1:4) .EQ. 'FVAR') THEN
            WRITE (LU62, 99995, IOSTAT = IOST)
            CYCLE
          END IF
          IF (LINE(1:1) .EQ. 'Q') THEN
            CALL GEN072 (LINE, JFL, FN, KL, KN, 0, 0, 1, 1, 0, 10, NP17)
            IF (SFAC(1)(2:2) .EQ. ' ') THEN
              JFL(1)(1:1) = SFAC(1)(1:1)
            ELSE
              JFL(1)(1:2) = SFAC(1)
            END IF
            FN(1) = 1
            WRITE (LU62, '(A, I5, 6F10.4)', IOSTAT = IOST)
     1        JFL(1), NINT(FN(1)),(FN(I), I = 2, KN)
          ELSE
            WRITE (LU62, 99972, IOSTAT = IOST) LINE
          END IF
          IF (LINE(1:4) .EQ. 'CELL') THEN
            WRITE (LU62, 99988, IOSTAT = IOST)
     1        ISPR(120), (SPAR(I), I = 108, 113)
            WRITE (LU62, 99993, IOSTAT = IOST)
     1        (SFAC(I), I = 1, ISPR(110))
            WRITE (LU62, 99992, IOSTAT = IOST)
     1        (ISPR(I + 120), I = 1, ISPR(110))
          END IF
        END DO
   40   WRITE (LU62, 99999, IOSTAT = IOST)
        CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' shelxl.ins > shelxl.log',
     1    KERR)
        CALL SPAWN ('cp shelxl.res s.res', KERR)
        CALL SPAWN ('rm -f shelxl.log', KERR)
        IF (ISPR(6) .EQ. 0) ISPR(6) = 1
      END IF
      W1   = 0.1
      W2   = 0.0
      IF (MODE .EQ. 4) THEN
        IEND = 0
        OPEN (LU61, FILE = 's.res', status = 'unknown')
        DO
          CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 0, 1, 80, 10,
     1                 NP17)
          IF (JFL(1)(1:3) .EQ. 'EOF') EXIT
          IF (LINE(1:3) .EQ. 'END') THEN
            IEND = 1
          ELSE IF (LINE(1:4) .EQ. 'WGHT') THEN
            IF (IEND .EQ. 1) THEN
              W1 = FN(1)
              W2 = FN(2)
              EXIT
            END IF
          END IF
        END DO
        CLOSE (UNIT = LU61)
      END IF
      OPEN (LU61, FILE = 's.res',   status = 'unknown')
      OPEN (LU62, FILE = 'shelxl.ins', status = 'unknown')
      IVAR = 0
   50 READ (LU61, 99972, END = 100, ERR = 100) LINE
      CALL GEN020 (1, LINE, 1, 4)
      IF (LINE(1:4) .EQ. 'TITL') THEN
        WRITE (LU62, 99990, IOSTAT = IOST) TITL(1:6)
        GO TO 50
      ELSE IF (LINE(1:4) .EQ. 'SFAC') THEN
   60   IF (INDEX (LINE, '=') .NE. 0) THEN
          READ (LU61, 99972, END = 100, ERR = 100) LINE
          GO TO 60
        END IF
        GO TO 50
      ELSE IF (LINE(1:4) .EQ. 'UNIT') THEN
        WRITE (LU62, 99993, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
        WRITE (LU62, 99992, IOSTAT = IOST)
     1    (ISPR(I + 120), I = 1, ISPR(110))
        GO TO 50
      ELSE IF (LINE(1:4) .EQ. 'SPGR') THEN
        CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 0, 1, 80, 10, NP17)
        IF (KN .EQ. 4) THEN
          DO I = 1, 4
            SPAR(159 + I) = FN(I)
          END DO
        END IF
        WRITE (LU62, 99986, IOSTAT = IOST) ISPR(100)
        DO I = 2, ISPR(101)
          NUMS = I
          CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
          WRITE (LU62, 99985, IOSTAT = IOST) LINE(1:60)
        END DO
      ELSE IF (LINE(1:4) .EQ. 'FVAR') THEN
        IVAR = 1
        WRITE (LU62, 99989, IOSTAT = IOST) W1, W2
        GO TO 70
      END IF
      IF (IVAR .EQ. 1) THEN
        IF (LINE(1:4) .EQ. 'AFIX') THEN
          IF (ISPR(90) .EQ. 1) THEN
            GO TO 50
          ELSE
            GO TO 90
          END IF
        END IF
        IF (LINE(1:4) .EQ. 'HFIX') GO TO 90
        LTYPE = LINE(1:1)//' '
        IF (LTYPE .NE. '  ') THEN
          CALL GEN105 (1, LINE(2:2), J)
          IF (J .GT. 0) LTYPE = LINE(1:2)
          DO K = 1, ISPR(110)
            IF (LTYPE .EQ. SFAC(K)) EXIT
          END DO
          ISF1 = K / 10
          ISF2 = MOD(K, 10)
          DO J = 6, 20
            IF (LINE(J : J) .NE. ' ') THEN
              J1 = J
              IF (LINE(J + 1:J + 1) .NE. ' ') THEN
                J1 = J1 + 1
                LINE (J : J1) = '  '
              END IF
              LINE(J1 : J1) = CHAR(ICHAR('0') + ISF2)
              IF (ISF1 .NE. 0) LINE(J : J) = '1'
              EXIT
            END IF
          END DO
        END IF
      END IF
   70 SELECT CASE (LINE(1:4))
        CASE ('L.S.', 'CGLS')
          GO TO 50
        CASE ('ZERR')
          WRITE (LU62, 99988, IOSTAT = IOST)
     1      ISPR(120), (SPAR(I), I = 108, 113)
          GO TO 50
        CASE ('FMAP', 'EXTI', 'TEMP', 'SIZE')
          GO TO 50
        CASE ('TWIN', 'BASF', 'MERG')
          GO TO 50
        CASE ('OMIT')
          CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 0, 1, 80, 10,
     1                 NP17)
          IF (KN .LT. 3) THEN
            GO TO 50
          ELSE IF (KN .EQ. 3) THEN
            IF (IGBL(51) .EQ. 0) GO TO 50
          END IF
        CASE ('PLAN', 'ACTA', 'REM ', 'BOND')
          GO TO 50
        CASE ('CONF', 'HTAB')
          GO TO 50
        CASE ('HKLF', 'END ')
          GO TO 100
        CASE ('FVAR')
          IF (IGBL(51) .GT. 0) THEN
            INQUIRE (FILE = 'omit.hkl', EXIST = EXST)
            IF (EXST) THEN
              OPEN (LU63, FILE = 'omit.hkl', STATUS = 'UNKNOWN')
              DO
                READ (LU63, 99972, END = 80, ERR = 80) LIJN
                WRITE (LU62, 99972, IOSTAT = IOST) LIJN
              END DO
   80         CLOSE (UNIT = LU63, STATUS = 'DELETE')
            END IF
          END IF
          IF (SPAR(227) .GT. -1.0 .AND. IGBL(96) .EQ. 1) THEN
            WRITE (LU62, 99982, IOSTAT = IOST) SPAR(227)
          END IF
          IF (ISPR(310) .GT. 0) THEN
            WRITE (LU62, 99980, IOSTAT = IOST)
     1        (ISPR(310 + I), I = 1, 9), SPAR(229)
          ELSE IF (ISPR(310) .LT. 0) THEN
            WRITE (LU62, 99978, IOSTAT = IOST) SPAR(229)
          END IF
          IF (ISPR(14) .EQ. 8) THEN
            WRITE (LU62, 99970, IOSTAT = IOST) 0.0
          END IF
          WRITE (LU62, 99984, IOSTAT = IOST) 2 * SPAR(55)
          IF (SPAR(10) .NE. 0.0)
     1      WRITE (LU62, 99983, IOSTAT = IOST) SPAR(10) - 273
          WRITE (LU62, 99981, IOSTAT = IOST) (SPAR(I), I = 11, 13)
          IF (NLS .GT. 0 .AND. ICGLS .EQ. 0) THEN
            WRITE (LU62, 99994, IOSTAT = IOST) - (IGBL(124) + 1) * 30
          ELSE
            WRITE (LU62, 99991, IOSTAT = IOST)  - (IGBL(124) + 1) * 30
          END IF
          IF (ISPR(14) .EQ. 8) THEN
            N = 0
          ELSE
            N = 2
          END IF
          IF (MODE .GE. 3) THEN
            IF (IGBL(91) .EQ. 1) THEN
              WRITE (LU62, 99971, IOSTAT = IOST) N
              SPAR(225) = -1000.0
            END IF
          END IF
          IF (MODE .GE. 4) THEN
            WRITE (LU62, 99979, IOSTAT = IOST)
          END IF
          IF (ICGLS .EQ. 1) THEN
            WRITE (LU62, 99977, IOSTAT = IOST) NLS
          ELSE
            WRITE (LU62, 99976, IOSTAT = IOST) NLS
          END IF
          WRITE (LU62, 99998, IOSTAT = IOST) SPAR(160), SPAR(161),
     1                        SPAR(162), SPAR(163)
          IF (MODE .EQ. 2) WRITE (LU62, 99996, IOSTAT = IOST) 1000
      END SELECT
   90 WRITE (LU62, 99972, IOSTAT = IOST) LINE
      GO TO 50
  100 IF (ISPR(14) .EQ. 8) THEN
        N = 5
      ELSE
        N = 4
      END IF
      IF (GEN135 (TM) .GT. 0.5 .OR. N .EQ. 5) THEN
        WRITE (LU62, 99973, IOSTAT = IOST) N
      ELSE
        WRITE (LU62, 99997, IOSTAT = IOST)
     1    N, ((TM(I, J), J = 1, 3), I = 1, 3)
      END IF
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      SPAR(160) = 0.0
      SPAR(161) = 0.0
      SPAR(162) = 0.0
      SPAR(163) = 1.0
      IF (IGBL(44) .EQ. 1) THEN
        KERR = 0
        CALL SPAWN (EDITOR//' shelxl.ins', KERR)
      END IF
  110 KERR = 0
      CALL SPAWN ('cp shelxl.ins '//COMPD(1:IC)//'.ins', KERR)
      CALL SPAWN (SHLPATH//' '//COMPD(1:IC)//' > shelxl.log', KERR)
      OPEN (LU61, FILE = 'shelxl.log', status = 'unknown')
      DO
        READ (LU61, 99972, END = 120, ERR = 120) LINE
        IF (LINE(1:4) .EQ. ' ** ') THEN
          CALL GEN020 (1, LINE, 5, 80)
          IF (LINE(5:11) .EQ. 'WARNING' .OR.
     1        LINE(5:12) .EQ. 'ABSOLUTE' .OR.
     2        LINE(5:14) .EQ. 'EXTINCTION') THEN
            CYCLE
          ELSE
            PROBLEM = 'SHELXL WARNING:'//LINE(1:50)
            N = INDEX (LINE, 'REFINEMENT UNSTABLE')
            IF (N .NE. 0) THEN
              IGBL(50) = 0
              IERR     = 1
              NDF      = 0
              GO TO 200
            END IF
            N = INDEX (LINE, 'BAD AFIX')
            IF (N .NE. 0) THEN
              IGBL(50) = 0
              IERR     = 1
              NDF      = 0
              GO TO 200
            END IF
            IF (LINE(5:8) .EQ. 'Exti' .OR.
     1         LINE(14:20) .EQ. 'racemic') THEN
              IF (LINE(14:20) .EQ. 'racemic') THEN
                IF (ISPR(310) .EQ. 0) ISPR(310) = -1
              END IF
              CYCLE
            ELSE
              NDF = 0
              CALL PLA015 (0, 38)
              IF (INDEX(LINE, 'NOT BONDED') .NE. 0) THEN
                ISPR(6) = 5
              END IF
              CLOSE (UNIT = LU61)
              GO TO 200
            END IF
          END IF
        END IF
      END DO
  120 CLOSE (UNIT = LU61)
C *
      KERR = 0
      CALL SPAWN ('mv '//COMPD(1:IC)//'.res shelxl.res', KERR)
      CALL SPAWN ('mv '//COMPD(1:IC)//'.cif shelxl.cif', KERR)
      CALL SPAWN ('mv '//COMPD(1:IC)//'.fcf shelxl.fcf', KERR)
      CALL SPAWN ('mv '//COMPD(1:IC)//'.lst shelxl.lst', KERR)
      CALL SPAWN ('rm -f '//COMPD(1:IC)//'.ins', KERR)
      CALL SPAWN ('ln -s -f ../s.hkl shelxl.hkl', KERR)
      W1   = 0.1
      W2   = 0.0
      ITEL = 0
      IEND = 0
      IVAR = 0
      NDEL = 0
      OPEN (LU61, FILE = 'shelxl.res', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 'shelxl.ins', STATUS = 'UNKNOWN')
      DO
        CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 0, 1, 80, 10,
     1               NP17)
        IF (JFL(1)(1:3) .EQ. 'EOF') THEN
          IF (ITEL .LT. 2) THEN
            PROBLEM = 'FILE shelxl.res EMPTY or INCOMPLETE'
            GO TO 200
          ELSE
            GO TO 140
          END IF
        END IF
        ITEL = ITEL + 1
        IF (LINE(1:3) .EQ. 'END') THEN
          IEND = 1
        ELSE IF (LINE(1:4) .EQ. 'WGHT') THEN
          IF (IEND .EQ. 0) THEN
            W3 = FN(1)
            W4 = FN(2)
            SPAR(220) = W3
            SPAR(221) = W4
          ELSE
            W1 = FN(1)
            W2 = FN(2)
            SPAR(222) = W1
            SPAR(223) = W2
            GO TO 140
          END IF
        ELSE IF (LINE(1:4) .EQ. 'FVAR') THEN
          IVAR = 1
          GO TO 130
        ELSE IF (LINE(1:4) .EQ. 'L.S.') THEN
          LINE = 'L.S. 5'
        ELSE IF (LINE(1:4) .EQ. 'HKLF') THEN
          GO TO 130
        ELSE IF (LINE(1:4) .EQ. '    ') THEN
          CYCLE
        ELSE IF (LINE(1:4) .EQ. 'REM ') THEN
          CYCLE
        END IF
        IF (MODE .EQ. 1 .AND. IVAR .EQ. 1 .AND. IPR(591) .EQ. 0) THEN
          READ (LINE(56:66), 99969) UISO
          IF (UISO .GT. 0.25) THEN
            WRITE (LU6, 99968, IOSTAT = IOST) LINE(1:66)
            NDEL = NDEL + 1
            CYCLE
          END IF
        END IF
  130   IF (MODE .EQ. 1) WRITE (LU62, 99972, IOSTAT = IOST) LINE
      END DO
  140 CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      IF (MODE .EQ. 1 .AND. NDEL .GT. 0) THEN
        NLS = 5
        GO TO 110
      END IF
      IF (MODE .EQ. 4) THEN
        W13 = W1 + W3
        IF (W13 .NE. 0.0) THEN
          IF (2 * ABS(W1 - W3) / W13 .GT. 0.05) GO TO 150
        END IF
        W24 = W2 + W4
        IF (W24 .NE. 0.0) THEN
          IF (2 * ABS(W2 - W4) / W24 .GT. 0.05) GO TO 150
        END IF
        ISPR(215) = 0
        GO TO 160
  150   IF (ISPR(215) .LT. 4) THEN
          ISPR(215) = ISPR(215) + 1
          MODE = 3
        ELSE
          ISPR(215) = 0
        END IF
      END IF
  160 CALL S924 (0)
      ISPR(6) = MODE
      IF (IGBL(50) .EQ. 0 .AND. ISPR(6) .GE. 0) THEN
  170   BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
        IF (IGBL(50) .EQ. 0) CALL GGIP (HORS, VERT, 0.0, 1)
        CALL S927 (1)
        IF (ISPR(6) .LT. 2) THEN
          NDF = ISPR(302)
        ELSE
          NDF = 0
        END IF
        LIJN = 'PERTINENT INFORMATION ON THE CURRENT REFINEMENT'
        CALL GGIP09 (0.0, LIJN, 50, 0.6, 5 + IGBL(68), 2, 1.0, 18.5)
        CALL GGIP (0.0,  1.6, 0.0, 3)
        CALL GGIP (HORS, 1.6, 0.0, 2)
        LIJN =
     1'Peaks from the difference map may be included (RENAME) in .res'
        CALL GGIP09 (0.0, LIJN, 80, 0.375, 2, 2, 0.1, 1.0)
        LIJN = 'Q-Peaks not renamed will be deleted automatically'
        CALL GGIP09 (0.0, LIJN, 80, 0.375, 1, 2, 0.1, 0.3)
        WRITE (SBCD, 99987, IOSTAT = IOST) NDF, CHAR(0)
        CALL PLA013 (0, 1)
        IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 170
        IF (IGGT(1:4) .EQ. 'EXIT') THEN
          NDF = 0
          GO TO 180
        END IF
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
        ELSE
          WRITE (LINE, '(I3, 77X)', IOSTAT = IOST) NDF
        END IF
        CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10, NP17)
        IF (KL .EQ. 0 .AND. KN .GT. 0) NDF = NINT(FN(1))
        IF (KL .EQ. 1 .AND. JFL(1)(1:4) .EQ. 'SKIP') NDF = 0
      ELSE
        CALL S927 (0)
        NDF = 0
      END IF
  180 KERR = 0
      CALL SPAWN ('cp shelxl.res ../pn/s.res', KERR)
      CALL SPAWN ('cp shelxl.res save.res', KERR )
      CALL SPAWN ('cp shelxl.lst ../pn/shelxl.lst', KERR)
      CALL SPAWN ('rm -f '//COMPD(1:IC)//'.hkl', KERR)
      INQUIRE (FILE = 'shelxl.cif', EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU61, FILE = 'shelxl.cif', STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 'new.cif', STATUS = 'UNKNOWN')
        ICOP = 0
        DO
          READ  (LU61, 99972, END = 190, ERR = 190) LINE
          IF (ICOP .EQ. 0) THEN
            N1 = INDEX (LINE, '_symmetry_space_group_name_H-M')
            IF (N1 .NE. 0) THEN
              CALL SGSM (LINE, 0, XYZ, 6, 18, IERR)
              SGXX1 = LINE(15:26)
              IF (LINE(44:44) .EQ. ' ') THEN
                SGXX2 = LINE(45:60)
              ELSE
                SGXX2 = LINE(44:60)
              END IF
              LINE = '_symmetry_space_group_name_H-M '''//SGXX1//''''
              CALL GEN020 (-1, LINE, 34, 47)
              WRITE (LU62, 99972, IOSTAT = IOST) LINE
              LINE = '_symmetry_space_group_name_Hall '''//SGXX2//''''
              WRITE (LU62, 99972, IOSTAT = IOST) LINE
              CYCLE
            END IF
            N1 = INDEX (LINE, '_exptl_absorpt_correction_type')
            IF (N1 .NE. 0) THEN
              IF (CPR(202)(1:4) .EQ. 'ABST') THEN
                LINE = '_exptl_absorpt_correction_type    analytical'
              ELSE IF (CPR(202) .EQ. 'ABSP') THEN
                LINE = '_exptl_absorpt_correction_type    psi-scan'
              ELSE IF (CPR(202) .EQ. 'MULA') THEN
                LINE = '_exptl_absorpt_correction_type    multi-scan'
              ELSE IF (CPR(202) .EQ. 'DELA') THEN
                LINE = '_exptl_absorpt_correction_type    refdelf'
              ELSE
                LINE = '_exptl_absorpt_correction_type    none'
              END IF
              WRITE (LU62, 99972, IOSTAT = IOST) LINE
              CYCLE
            END IF
            N1 = INDEX (LINE, '_computing_structure_solution')
            IF (N1 .NE. 0) THEN
              WRITE (LU62, '(''_computing_structure_solution'',5X, A)',
     1          IOSTAT = IOST)
     1                     CPR(203)
              CYCLE
            END IF
            IF (ISPR(15) .NE. 0) THEN
              N1 = INDEX (LINE, '_exptl_absorpt_correction_T_min')
              IF (N1 .NE. 0) THEN
                WRITE (LU62, 99975, IOSTAT = IOST) SPAR(126)
                CYCLE
              END IF
              N1 = INDEX (LINE, '_exptl_absorpt_correction_T_max')
              IF (N1 .NE. 0) THEN
                WRITE (LU62, 99974, IOSTAT = IOST) SPAR(127)
                CYCLE
              END IF
            END IF
          END IF
          WRITE (LU62, 99972, IOSTAT = IOST) LINE
        END DO
  190   CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN ('rm -f shelxl.cif', KERR)
        CALL SPAWN ('mv new.cif shelxl.cif', KERR)
        CALL SPAWN ('cp shelxl.cif  ../pn/shelxl.cif', KERR)
        CALL SPAWN ('cp shelxl.fcf  ../pn/shelxl.fcf', KERR)
      END IF
      CALL S915 ('Run SHELXL/'//CPR(106))
      CPR(205) = 'SHELXL'
      IF (SPAR(202) .GT. SPAR(2) .AND. IGBL(50) .NE. 0) THEN
        CPR(105) ='Z'
        CPR(106) = CPR(200)
        ISPR(11) = 3
      ELSE
        CPR(105) = 'SHELXL'
      END IF
  200 IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      IF (IABS(IGBL(12)) * IGBL(34) .EQ. 1) THEN
        LIJN    = 'EXEC = VALID'
        CALL GGIP09 (0.0, LIJN, 17, 0.7, 4, 4, 16.5, 6.4)
        CALL GGIP09 (0.0, LIJN, 17, 0.7, 2, 4, 16.4, 6.3)
        CALL GGIP (0.0, 0.0, 0.0, 6)
        CALL S520 (0)
      END IF
      IF (NDF .GT. 0 .AND. IGBL(50) .EQ. 0) CALL S410 (NDF)
      RETURN
99999 FORMAT ('SET IGBL 70  0', /, 'CALC SHELX NOSF', /, 'QUIT')
99998 FORMAT ('MOVE', 4F8.2)
99997 FORMAT ('HKLF', I3, ' 1', 9F8.4, /, 'END')
99996 FORMAT ('ANIS', I5)
99995 FORMAT ('FVAR 1.0')
99994 FORMAT ('ACTA', /, 'PLAN', I5, /, 'BOND $H')
99993 FORMAT ('SFAC ', 16(1X, A))
99992 FORMAT ('UNIT ', 2I5, 14I4)
99991 FORMAT ('FMAP 2', /, 'PLAN', I5, /, 'CONF')
99990 FORMAT ('TITL ', A, ' - SHELXL')
99989 FORMAT ('WGHT', 2F10.3)
99988 FORMAT ('ZERR ', I5, 6F10.4)
99987 FORMAT ('Click SKIP or Enter nr. of diff_map peaks to be ',
     1        'appended for PLUTON [', I3, '] ', A)
99986 FORMAT ('LATT ', I3)
99985 FORMAT ('SYMM ', A)
99984 FORMAT ('OMIT -2', F10.2)
99983 FORMAT ('TEMP ', F6.0)
99982 FORMAT ('EXTI ', F8.5)
99981 FORMAT ('SIZE ', 3F10.3)
99980 FORMAT ('TWIN ', 9I5, /, 'BASF', F10.3)
99979 FORMAT ('CONF', /, 'HTAB')
99978 FORMAT ('TWIN', /, 'BASF', F10.4)
99977 FORMAT ('CGLS ', I5)
99976 FORMAT ('L.S. ', I5)
99975 FORMAT ('_exptl_absorpt_correction_T_min', F8.3)
99974 FORMAT ('_exptl_absorpt_correction_T_max', F8.3)
99973 FORMAT ('HKLF', I5, /, 'END')
99972 FORMAT (A)
99971 FORMAT ('MERG', I5)
99970 FORMAT ('BASF', F10.3, /, 'MERG 0')
99969 FORMAT (F11.0)
99968 FORMAT (':: DELETE ', A, ' <<<')
      END SUBROUTINE S310
      SUBROUTINE S330
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /CPEAK/ PEAK(500, 46), ICON(500, 40), NCON(500), OL(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CHARACTER LABI*4, CATC(500)*4, LIN*133, CKNP1*2
      DIMENSION IATC(500), DATC(500), ATP(500, 5)
      CHARACTER XLINE*80
      INTEGER CHANDIR
      DIMENSION XJX(12)
      CALL S915 ('Run Hdif')
      MHAT = ISPR(122) / ISPR(102)
      CALL S909 ('tm/sg/hdif')
      KERR = 0
      CALL SPAWN ('ln -s -f ../s.hkl shelxl.hkl', KERR)
C * DIFFERENCE MAP /SETUP
      OPEN (LU61, FILE = '../s.res',   STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = 'shelxl.ins', STATUS = 'UNKNOWN')
      IVAR  = 0
      XLINE = 'SFAC'
      NSFC  = 6
      KNP1  = 2
      DO
        READ (LU61, 99994, END = 10, ERR = 10) LINE
        IF (LINE(1:4) .EQ. 'TITL') THEN
          WRITE (LU62, 99979, IOSTAT = IOST) TITL(1:6)
          IVAR = 1
          CYCLE
        ELSE IF (LINE(1:4) .EQ. 'SFAC') THEN
          BACKSPACE LU61
          CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80, 10,
     1                 NP17)
          IF (KN .EQ. 0) THEN
            XLINE = LINE
            DO K = 1, KL
              IF (JFL(K)(1:4) .EQ. 'H   ') KNP1 = K - 1
            END DO
          ELSE
            XLINE(NSFC:) = JFL(2)(1:4)
            NSFC         = NSFC + 4
            IF (JFL(2)(1:2) .EQ. 'H ') KNP1 = (NSFC - 6) / 4
          END IF
          CYCLE
        ELSE IF (LINE(1:4) .EQ. 'UNIT') THEN
          WRITE (LU62, 99994, IOSTAT = IOST) XLINE
          WRITE (LU62, 99994, IOSTAT = IOST) LINE
          TTH = ASIN(0.40 * SPAR(80)) * 90.0 / ATAN(1.0)
          WRITE (LU62, 99983, IOSTAT = IOST) TTH
          IVAR = 0
        ELSE IF (LINE(1:4) .EQ. 'FVAR') THEN
          IVAR = 1
        ELSE IF (LINE(1:3) .EQ. 'END') THEN
          EXIT
        END IF
        IF (IVAR .EQ. 1) WRITE (LU62, 99994, IOSTAT = IOST) LINE
      END DO
   10 LOOP  = 0
      NHAT0 = -1
      NHAT  = 0
   40 LOOP = LOOP + 1
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      KERR = 0
      CALL SPAWN (SHLPATH//' shelxl > shelxl.log', KERR)
      IF (LOOP .LE. 5) THEN
        IF (LOOP .GT. 1) THEN
          IF (NHAT .EQ. NHAT0) GO TO 140
          NHAT0 = NHAT
        END IF
        OPEN (LU61, FILE = 'shelxl.lst', STATUS = 'UNKNOWN')
        N     = 0
        NA    = 0
        NB    = 0
        NHKLF = 0
   50   READ (LU61, 99994, END = 70, ERR = 70) LIN(1:133)
        IF (LIN(2:5) .EQ. 'HKLF') THEN
          NHKLF = 1
        ELSE IF (LIN(2:5) .NE. '    ' .AND. LIN(15:15) .EQ. '.'
     1   .AND. LIN(5:5) .NE. '.' .AND. NHKLF .NE. 0) THEN
          CALL GEN020 (1, LIN, 2, 3)
          IF (LIN(2:2) .NE. 'H' .OR.  LIN(2:3) .EQ. 'HG' .OR.
     1        LIN(2:3) .EQ. 'HF' .OR. LIN(2:3) .EQ. 'HE' .OR.
     2        LIN(2:3) .EQ. 'HO') NA = NA + 1
          NB      = NB + 1
          N       = N  + 1
          NCON(N) = 0
          READ (LIN, 99991) CATC(N), (PEAK(N, J), J = 1, 4)
          XJX(1)  = PEAK(N, 1)
          XJX(2)  = PEAK(N, 2)
          XJX(3)  = PEAK(N, 3)
          XJX(10) = 0.0
          CALL SGSM (LINE, 0, XJX, LU6, 19, IERR)
          PEAK(N, 6) = XJX(10)
          PEAK(N, 4) = PEAK(N, 4) / XJX(10)
          PEAK(N, 5) = 0.0
          CALL GEN020 (1, CATC(N), 1, 2)
          CALL GEN105 (3, CATC(N)(2:2), IYUNK)
          IF (IYUNK .GT. -1) THEN
            IYUNK = 1
          ELSE
            IYUNK = 2
          END IF
          DO J = 1, ISPR(110)
            IF (SFAC(J)(1:IYUNK) .EQ. CATC(N)(1:IYUNK)) THEN
              IATC(N) = NINT(SPAR(250 + J * 15))
              GO TO 50
            END IF
          END DO
        ELSE IF (LIN(2:2) .EQ. 'Q' .AND. LIN(7:9) .EQ. ' 1 ') THEN
          READ (LIN, 99990) (PEAK(N + 1, J), J = 1, 5)
          IF (PEAK(N + 1, 5) .LT. 0.15) GO TO 50
          N          = N + 1
          NCON(N)    = 0
          WRITE (CATC(N), '(A, I3)', IOSTAT = IOST) LIN(2:2), 100 + N
          PEAK(N, 4) = 0.0
          IATC(N)    = 0
        END IF
        GO TO 50
   70   CLOSE (UNIT = LU61)
        CALL S900 (N)
        DO I = 1, N
          IF (PEAK(I, 4) .GT. SPAR(1)) THEN
            IF (NCON(I) .GT. 0) THEN
              DO 100 J = 1, NCON(I)
                K = ICON(I, J)
                IF (K .GT. NB) THEN
                  D = PEAK(I, 6 + J)
                  IF (D .LT. 0.0) GO TO 100
                  IF (D .LT. 1.2 .AND. I .LE. NB .AND. J .GT. 1) THEN
                    DO M = 1, J - 1
                      L   = ICON(I, M)
                      IF (L .LE. NB) THEN
                        ANG = S901(K, I, L)
                        IF (ANG .LT. 90.0) THEN
                          PEAK(I, 6 + J) = - ABS(PEAK(I, 6 + J))
                          PEAK(K, 4) = 0.0
                          GO TO 100
                        END IF
                      END IF
                    END DO
                  END IF
                  NC = 0
                  DO L = 1, NCON(K)
                    D = PEAK(K, 6 + L)
                    IF (D .LT. 0.0) GO TO 100
                    IF (ICON(K, L) .LT. NA) THEN
                      DMAX = 1.5
                    ELSE
                      DMAX = 1.25
                    END IF
                    IF (D .LT. DMAX) THEN
                      IF (ICON(K, L) .LE. NB) NC = NC + 1
                      IF (NC .GT. 1 .OR. IATC(I) .GE. 17) THEN
                        PEAK(I, 6 + L) = - ABS(PEAK(I, 6 + L))
                        PEAK(K, 4)     = 0.0
                        GO TO 100
                      END IF
                    END IF
                  END DO
                  D = PEAK(I, 6 + J)
                  IF (D .LT. 0.0) GO TO 100
                  IF (I .LE. NA) THEN
                    IF (ABS(D - 0.95) .LT. 0.3)
     1                PEAK(K, 4) = PEAK(K, 4) + 1.0
                  ELSE IF (I .LE. NB) THEN
                    IF (D .LT. 1.5) PEAK(K, 4) = 0
                  END IF
                END IF
  100         CONTINUE
            END IF
            IF (I .GT. NB .AND. PEAK(I, 4) .GT. 1.0) PEAK(I, 4) = 0.0
            IF (IGBL(50) .EQ. 0 .AND. ISPR(49) .EQ. 1) THEN
              IF (I .EQ. 1) WRITE (LU6, 99980, IOSTAT = IOST)
              NCONM = MIN (NCON(I), 5)
              WRITE (LU6, 99982, IOSTAT = IOST) I, CATC(I),
     1              (PEAK(I, J), J = 1, 6 + NCONM)
              WRITE (LU6, 99981, IOSTAT = IOST)
     1          (CATC(ICON(I, J)), J = 1, NCONM)
            END IF
          END IF
        END DO
        OPEN (LU61, FILE = 'shelxl.res', status = 'unknown')
        OPEN (LU62, FILE = 'shelxl.ins', status = 'unknown')
        NAT  = -1000
        IVAR = 0
  120   READ (LU61, 99994) LINE
        IF (LINE(1:3) .EQ. 'REM') GO TO 120
        IF (LINE(1:4) .EQ. 'HKLF') THEN
          L = 0
          DO I = NA + 1, N
            IF (PEAK(I, 4) .GT. 0.01) THEN
              L = L + 1
              LABI = 'H   '
              CALL GEN058 (LABI, L)
              WRITE (LU62, 99986, IOSTAT = IOST)
     1          LABI, KNP1, (PEAK(I, J), J = 1, 3), PEAK(I, 4)
            END IF
          END DO
          NHAT = L
          WRITE (LU62, 99997, IOSTAT = IOST) LABI
          WRITE (LU62, 99994, IOSTAT = IOST) LINE
          WRITE (LU62, 99985, IOSTAT = IOST)
          GO TO 40
        ELSE IF (LINE(1:4) .EQ. 'L.S.') THEN
          WRITE (LU62, 99995, IOSTAT = IOST) 3
          GO TO 120
        ELSE IF (LINE(1:4) .EQ. 'FVAR') THEN
          IVAR = 1
        ELSE IF (IVAR .EQ. 1) THEN
          IVAR = 0
          NAT  = 0
        END IF
        IF (LINE(2:5) .NE. '    ') NAT = NAT + 1
        IF (NAT .LT. 0) THEN
          WRITE (LU62, 99994, IOSTAT = IOST) LINE
        ELSE IF (NAT .LE. NA .AND. PEAK(NAT, 4) .GT. SPAR(1)) THEN
          WRITE (LU62, 99994, IOSTAT = IOST) LINE
        END IF
        GO TO 120
      END IF
  140 CALL S924 (0)
      OPEN (LU61, FILE = 'shelxl.res', STATUS = 'UNKNOWN')
      OPEN (LU62, FILE = '../pn/s.res', STATUS = 'UNKNOWN')
      NHAT = 0
      WRITE (CKNP1, 99984, IOSTAT = IOST) KNP1
  150 READ (LU61, 99994) LINE
      IF (LINE(1:1) .EQ. 'H' .AND. LINE(6:7) .EQ. CKNP1) THEN
        BACKSPACE LU61
        CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 0, 1, 80, 10,
     1               NP17)
        NHAT = NHAT + 1
        DO I = 1, 5
          ATP(NHAT, I) = FN(I)
        END DO
        DATC(NHAT) = 1000.0 - FN(5)
        IATC(NHAT) = NHAT
        CATC(NHAT) = LINE(1:4)
        GO TO 150
      ELSE IF (LINE(1:4) .EQ. 'BLOC') THEN
        GO TO 150
      ELSE IF (LINE(1:4) .EQ. 'HKLF') THEN
        GO TO 170
      END IF
      WRITE (LU62, 99994, IOSTAT = IOST) LINE
      GO TO 150
  170 L = 0
      CALL GEN013 (DATC, IATC, 1, NHAT)
      DO I = 1, NHAT
        K = IATC(I)
        IF (ATP(K, 5) .GT. 0.2 .OR. L .LT. MHAT) THEN
          L = L + 1
          LABI = 'H'
          CALL GEN058 (LABI, L)
          WRITE (LU62, 99992, IOSTAT = IOST)
     1      LABI, (ATP(K, J), J = 2, 4)
        ELSE
          IF (IGBL(50) .EQ. 0 .AND. ISPR(49) .EQ. 1)
     1      WRITE (LU6, 99993, IOSTAT = IOST)
     2        CATC(K), (ATP(K, J), J = 2, 5)
        END IF
      END DO
      IF (GEN135 (TM) .GT. 0.5) THEN
        WRITE (LU62, 99999, IOSTAT = IOST)
      ELSE
        WRITE (LU62, 99998, IOSTAT = IOST)
     1    ((TM(I, J), J = 1, 3), I = 1, 3)
      END IF
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      KERR = 0
      CALL SPAWN ('cp ../pn/s.res shelxl.res', KERR)
      CALL SPAWN ('cp ../pn/s.res save.res', KERR)
      IF (CHANDIR (FNM(1 : IN - 1)) .NE. 0) CALL S925 (1)
      CPR(206) = 'HDIF'
      CALL S920 (1)
      IF (IGBL(50) .EQ. 0) CALL S410 (0)
      CPR(105) = 'HDIF'
      CPR(106) = CPR(200)
      RETURN
99999 FORMAT ('HKLF 4', /, 'END')
99998 FORMAT ('HKLF 4 1', 9F8.4, /, 'END')
99997 FORMAT ('BLOC -1 H501 > ', A)
99995 FORMAT ('L.S. ', I5)
99994 FORMAT (A)
99993 FORMAT ('Exorcised: ', A, 4F10.4)
99992 FORMAT (A, '   2', 3F10.4, ' 11.0 0.05')
99991 FORMAT (1X, A, 5X, 3F10.0, F12.0)
99990 FORMAT (9X, 3F8.0, F10.0, 6X, F8.0)
99986 FORMAT (A, I3, 4F10.4, '  10.05')
99985 FORMAT ('END')
99984 FORMAT (I2)
99983 FORMAT ('L.S. 0', /, 'OMIT -3 ', F10.1, /, 'FMAP 2 ', /,
     1        'PLAN 30 ')
99982 FORMAT (I3, 1X, A, 3F7.3, F6.3, F7.2, 9F6.3)
99981 FORMAT (47X, 9(2X, A))
99980 FORMAT (' NR LABEL     X', 6X, 'Y', 6X, 'Z   POP    RHO   SOF',
     1        ' BONDS(D/NR)')
99979 FORMAT ('TITL ', A, ' - HATOM')
      END SUBROUTINE S330
      SUBROUTINE S340
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      LOGICAL EXST
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      EXST = .FALSE.
      CALL S915 ('Run PLATON/SQUEEZE')
      WRITE (LU6, 99975, IOSTAT = IOST)
      CALL S909 ('tm/sg/squeeze')
      INQUIRE (FILE = 'squeeze.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s '//'../s.hkl squeeze.hkl', KERR)
      END IF
      INQUIRE (FILE = '../s.res', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../s.res squeeze.res', KERR)
      ELSE
        WRITE (LU6, 99994, IOSTAT = IOST)
        GO TO 10
      END IF
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -q squeeze.res', KERR)
   10 IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CPR(208) = 'SQUEEZE   '
      ISPR(7)  = 0
      IGBL(38) = 1
      ISPR(14) = 7
      CALL S924  (1)
      RETURN
99994 FORMAT ('Error: File s.res not found in Compound Directory')
99975 FORMAT (/, '>> Automatic PLATON/SQUEEZE procedure', /)
      END SUBROUTINE S340
      SUBROUTINE S350
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      LOGICAL EXST
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      EXST = .FALSE.
      CALL S915 ('Run PLATON/TwinRotMat')
      CALL S909 ('tm/sg/twinrotmat')
      INQUIRE (FILE = 'shelxl.fcf', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s '//'../shelxl/shelxl.fcf', KERR)
      END IF
      INQUIRE (FILE = 'shelxl.cif', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../shelxl/shelxl.cif', KERR)
      END IF
      KERR = 0
      CALL SPAWN ('rm -f shelxl.hkp', KERR)
      IF (IGBL(50) .EQ. 1) THEN
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -M shelxl.cif', KERR)
      ELSE
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -L shelxl.cif', KERR)
      END IF
      INQUIRE (FILE = 'shelxl.hkp', EXIST = EXST)
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      ISPR(7)  = 0
      IGBL(38) = 1
      IF (EXST) ISPR(14) = 8
      CALL S924 (1)
      RETURN
      END SUBROUTINE S350
      SUBROUTINE S410 (NDIFF)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER COLOUR*6, STYLE*5, OVERLAP*3, SAV105*10, SAV106*10,
     1 CONTOUR*6, WGHT*80
      INTEGER CHANDIR, NFC(16)
      LOGICAL EXST
      CHARACTER NQ1*7, XFC(16)*2
      CALL S915 ('Run PLUTON')
      CALL GEN097 (NFC, 1, 16, 0)
      EXST     = .FALSE.
      WGHT     = 'WGHT 1 0'
      NDIF     = 0
      NEW      = 0
      KM0      = 0
      IGBL(20) = 1
      IGBL(3)  = 8
      IGBL(67) = 0
      IF (NDIFF .GT. 0) THEN
        NDIF = NDIFF
        IGBL(50) = 0
      ELSE IF (NDIFF .EQ. -1) THEN
        IGBL(3)  = 12
        IGBL(50) = 0
      ELSE IF (NDIFF .EQ. -2) THEN
        IGBL(3) = 13
      ELSE IF (NDIFF .EQ. -3) THEN
        IGBL(3) = 26
      END IF
      CALL S909 ('tm/sg/pluton')
      NDF     = -99999
      COLOUR  = 'COLOR'
      CONTOUR = 'CONT 0'
      IF (ISPR(6) .GT. -1) THEN
        OPEN (LU61, FILE = '../s.res', STATUS = 'UNKNOWN')
        READ (LU61, 99986, END = 90) LINE
        BACKSPACE LU61
        IF (ISPR(6) .EQ. 0) THEN
        ELSE IF (ISPR(6) .GT. 0) THEN
          IF (IGBL(50) .GT. 0) THEN
            COLOUR = 'COLOR'
          ELSE
            COLOUR = 'COLOR'
          END IF
        END IF
        IF (ISPR(6) .EQ. 0 .OR. NDIF .GT. 0) THEN
          STYLE   = 'SOLID'
          OVERLAP = 'OFF'
        ELSE
          STYLE   = 'STRAW'
          CONTOUR = '      '
          OVERLAP = 'ON '
        END IF
        OPEN (LU62, FILE = 'satom.spf', STATUS = 'UNKNOWN')
        IEND = -1
        NAFIX = 0
   10   READ (LU61, 99986, END = 20) LINE
        IF (LINE(1:4) .EQ. 'HKLF') GO TO 10
        IF (LINE(1:4) .EQ. 'WGHT') THEN
          IF (IEND .GE. 0) THEN
            WGHT = LINE
            GO TO 10
          END IF
        ELSE IF (LINE(1:3) .EQ. 'END') THEN
          IEND = 0
          NDF  = 0
          GO TO 10
        ELSE IF (LINE(1:1) .EQ. 'Q' .AND. IEND .NE. 1) THEN
          IF (NDF .LT. NDIF) THEN
            IF (NDF .EQ. 1 .AND. NAFIX .NE. 0)
     1        WRITE (LU62, 99992, IOSTAT = IOST)
            NDF = NDF + 1
          ELSE
            IF (GEN135 (TM) .GT. 0.5) THEN
              WRITE (LU62, 99987, IOSTAT = IOST)
            ELSE
              WRITE (LU62, 99993, IOSTAT = IOST)
     1          ((TM(I, J), J = 1, 3), I = 1, 3)
            END IF
            WRITE (LU62, 99994, IOSTAT = IOST) WGHT
            IEND = 1
          END IF
        END IF
        IF (LINE(1:4)  .EQ. 'AFIX') READ (LINE (5:80), *) NAFIX
        WRITE (LU62, 99986, IOSTAT = IOST) LINE
        GO TO 10
   20   IF (IEND .NE. 1) THEN
          IF (GEN135 (TM) .GT. 0.5) THEN
            WRITE (LU62, 99987, IOSTAT = IOST)
          ELSE
            WRITE (LU62, 99993, IOSTAT = IOST)
     1        ((TM(I, J), J = 1, 3), I = 1, 3)
          END IF
          WRITE (LU62, 99994, IOSTAT = IOST) WGHT
        END IF
        CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        CHARSIZ = 0.25
        OPEN (LU62, FILE = 'satom.def', STATUS = 'UNKNOWN')
        IF (ISPR(6) .EQ. 0) WRITE (LU62, 99998, IOSTAT = IOST)
        WRITE (LU62, 99988, IOSTAT = IOST)
        IF (ISPR(6) .LT. 1) THEN
          WRITE (LU62, 99999, IOSTAT = IOST)
        ELSE IF (ISPR(6) .LT. 3) THEN
          WRITE (LU62, 99990, IOSTAT = IOST)
        END IF
        WRITE (LU62, 99991, IOSTAT = IOST)
     1    STYLE, COLOUR, CONTOUR, OVERLAP
        IF (IGBL(50) .EQ. 0) WRITE (LU62, 99989, IOSTAT = IOST) CHARSIZ
        IF (ISPR(6)  .LT. 4) WRITE (LU62, 99997, IOSTAT = IOST)
        IF (IGBL(50) .GT. 0) WRITE (LU62, 99996, IOSTAT = IOST)
        WRITE (LU62, 99995, IOSTAT = IOST)
        CLOSE (UNIT = LU62)
        IGBL(8) = 1
        CALL PLUTON (0)
        CALL GEN108 (LU22, 1)
   30   READ (LU22, 99986, END = 40) LINE
        IF (LINE(1:6) .EQ. 'RENAME') ISPR(92) = 1
        GO TO 30
   40   IGBL(6) = 17
        CLOSE (UNIT = LU1)
        CLOSE (UNIT = LU23)
        CALL PLUT29 (-1, LINE, NQ1, 0, LU21)
        IF (IGBL(26) .EQ. 0 .AND. IPR(175) .EQ. 0) THEN
          CLOSE (UNIT = LU21, STATUS = 'DELETE')
        ELSE
          CLOSE (UNIT = LU21)
          EXST = .TRUE.
        END IF
        CLOSE (UNIT = LU22)
      END IF
      NEW = 0
      KM  = ISPR(110)
      IF (EXST) THEN
        CALL S924 (0)
        OPEN (LU61, FILE = 'satom.new', STATUS = 'UNKNOWN')
        IFV = 0
        KM0 = 0
   50   CALL GEN072 (LINE, JFL, FN, KL, KN, LU61, LU6, 1, 1, 80, 10,
     1               NP17)
        IF (JFL(1)(1:3) .EQ. 'EOF') GO TO 80
        IF (IFV .EQ. 0) THEN
          IF (JFL(1)(1:4) .EQ. 'SFAC') THEN
            DO I = 2, KL
              CALL GEN020 (1, JFL(I), 1, 7)
              IF (JFL(I)(1:2) .NE. 'Q ') THEN
                KM0 = KM0 + 1
                XFC(KM0) = JFL(I)(1:2)
              END IF
              IF (KL .GT. KM + 1) NEW = 1
            END DO
          ELSE IF (JFL(1)(1:4) .EQ. 'FVAR') THEN
            IFV = 1
          END IF
        ELSE
          CALL GEN020 (1, JFL(1), 1, 7)
          IF (JFL(1)(1:4) .EQ. 'HFIX') THEN
            GO TO 50
          ELSE IF (JFL(1)(1:4) .EQ. 'AFIX') THEN
            GO TO 50
          ELSE IF (JFL(1)(1:3) .EQ. 'REM') THEN
            GO TO 50
          ELSE IF (JFL(1)(1:4) .EQ. 'HKLF') THEN
            IF (ISPR(6) .GT. 0) THEN
              J = 0
              DO I = 1, KM0
                IF (NFC(I) .GT. 0 .OR. XFC(I)(1:2) .EQ. 'H ') THEN
                  J = J + 1
                  XFC(J) = XFC(I)
                  NFC(J) = NFC(I)
                END IF
              END DO
              IF (J .LT. KM0) THEN
                KM0 = J
                NEW = 1
              END IF
            ELSE
              J = KM0
            END IF
            GO TO 80
          ELSE
            NS = NINT(FN(1))
            NZ = NINT((FN(5) - 10.0) * ISPR(101) * ISPR(103))
            NFC(NS) = NFC(NS) + NZ
            GO TO 50
          END IF
        END IF
        GO TO 50
   80   CLOSE (UNIT = LU61)
        ISPR(7) = 0
        KERR = 0
        CALL SPAWN ('cp satom.new ../s.res', KERR)
        CALL SPAWN ('mv satom.new satom.nw', KERR)
        CPR(106) = 'PLUTON'
      END IF
   90 IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      IF (NEW. EQ. 1) THEN
        ID0 = 1
        NS1 = 1
        DO I = 1, KM0
          IF (MOD(NFC(I), ISPR(101)) .NE. 0) GO TO 110
        END DO
        NS1 = ISPR(101)
  110   NS3 = 1
        DO I = 1, KM0
          IF (MOD(NFC(I), ISPR(103)) .NE. 0) GO TO 130
        END DO
        NS3 = ISPR(103)
  130   NS  = NS1 * NS3
        DO I = 1, KM0
          SFAC(I)    = XFC(I)
          NFC(I)     = NFC(I) / NS
          LINE(ID0:) = SFAC(I)
          ID0        = ID0 + 1
          IF (LINE(ID0:ID0) .NE. ' ') ID0 = ID0 + 1
          IF (NFC(I) .EQ. 0) NFC(I) = 2 * NFC(1)
          CALL GEN040 (NFC(I), LINE(ID0:), IP)
          ID0 = ID0 + IP
        END DO
        ISPR(110) = - KM0
        SAV105 = CPR(105)
        SAV106 = CPR(106)
        CALL S180 (0)
        KN = 0
        CALL S190 (0, IER)
        IF (IER .NE. 0) GO TO 150
        CPR(105) = SAV105
        CPR(106) = SAV106
      END IF
      IF (NDIFF .EQ. -2) THEN
        CPR(105) = 'HFIX  '
        CPR(106) = CPR(200)
      END IF
      IF (ISPR(6) .EQ. 5) ISPR(6) = 6
      CALL S920 (1)
  150 RETURN
99999 FORMAT ('JOIN RADII UNIQUE TOLE 0')
99998 FORMAT ('SET IPR 176 0', /, 'SET IGBL 23 3')
99997 FORMAT ('PUT ATOM S')
99996 FORMAT ('SET PAR 18 1.0', /, 'SET PAR 13 0.65', /,
     1        'BOX OFF')
99995 FORMAT ('PLOT DISPLAY')
99994 FORMAT ('END', /, A)
99993 FORMAT ('HKLF 4 1', 9F8.4)
99992 FORMAT ('AFIX 0')
99991 FORMAT ( A, 1X, A, 1X, A, /,
     1        'OVERLAP ', A, /,
     2        'RADII ATOMS Q 0.1')
99990 FORMAT ('JOIN RADII UNIQUE')
99989 FORMAT ('LABEL', /, 'SIZE 0 CHAR ', F10.2)
99988 FORMAT ('SET RGBL 25 0.5')
99987 FORMAT ('HKLF 4')
99986 FORMAT (A)
      END SUBROUTINE S410
      SUBROUTINE S411
      PARAMETER (NP1=500,NP2=350,NP17=99,NP42=250)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      CALL S915 ('Run RPLUTO')
      CALL S909 ('tm/sg/rpluto')
      IF (ISPR(6) .GT. -1) THEN
        KERR = 0
        CALL SPAWN ('cp ../s.res pluto.dat', KERR)
        CALL SPAWN ('rpluto pluto', KERR)
      END IF
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      RETURN
      END SUBROUTINE S411
      SUBROUTINE S420 (TYP)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      CHARACTER FIL1*19, TYP*(*)
      INTEGER CHANDIR
      LOGICAL EXST
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      EXST = .FALSE.
      CALL S915 ('Run PLATON')
      FIL1 = 'tm/sg/pn/shelxl.cif'
      INQUIRE (FILE = FIL1, EXIST = EXST)
      IF (.NOT. EXST) THEN
        FIL1 = 'tm/sg/pn/s.res     '
      END IF
      IF (ISPR(6) .GT. -1) THEN
        IF (TYP(1:1) .EQ. ' ') THEN
          CALL S909 ('tm/sg/platon')
          KERR = 0
          CALL SPAWN ('cp ../'//FIL1(7:19)//' platon.spf', KERR)
          CALL SPAWN (PLAPATH(1:IGBL(80))//'  platon.spf ', KERR)
          CALL SPAWN (PSVIEWER//'platon.lps', KERR)
        ELSE IF (TYP(1:4) .EQ. 'SOLV') THEN
          CALL S909 ('tm/sg/solv')
          KERR = 0
          CALL SPAWN ('cp ../'//FIL1(7:19)//' solv.spf', KERR)
          CALL SPAWN (PLAPATH(1:IGBL(80))//' -v solv.spf > solv.log ',
     1      KERR)
          OPEN (LU63, FILE = 'solv.log', STATUS = 'UNKNOWN')
          DO
            READ (LU63, 99999, END = 10) LINE
            IF (INDEX (LINE, 'NO Residual') .NE. 0) GO TO 20
          END DO
   10     KERR = 0
          CALL SPAWN (PSVIEWER//'solv.lps', KERR)
   20     CLOSE (UNIT = LU63)
        ELSE IF (TYP(1:6) .EQ. 'ADDSYM') THEN
          CALL S909 ('tm/sg/addsym')
          KERR = 0
          CALL SPAWN ('cp ../s.res addsym.spf', KERR)
          CALL SPAWN (PLAPATH(1:IGBL(80))//' -N addsym.spf > a.log',
     1      KERR)
          OPEN (LU63, FILE = 'addsym.res', STATUS = 'UNKNOWN')
          DO
            READ (LU63, 99999, END = 30) LINE
            IF (LINE(1:8) .EQ. 'REM TRMX') THEN
              OPEN (LU64, FILE = 'addsym.ntr', STATUS = 'UNKNOWN')
              WRITE (LU64, 99999, IOSTAT = IOST) LINE(5:80)
              CLOSE (UNIT = LU64)
              KERR = 0
              CALL SPAWN ('cp addsym.res ../../../.newsym.res', KERR)
              CALL SPAWN ('cp addsym.ntr ../../../.newsym.ntr', KERR)
              OPEN (LU64, FILE = 'addsym.sav', STATUS = 'UNKNOWN')
              WRITE (LU64, 99998, IOSTAT = IOST)
     1          (I, CPR(I), I = 201, 204)
              CLOSE (UNIT = LU64)
              KERR = 0
              CALL SPAWN ('cp addsym.sav ../../../.newsym.sav', KERR)
              ISPR(98) = 1
            ELSE IF (LINE(1:8) .EQ. 'REM SPGR') THEN
              OPEN (LU64, FILE = 'addsym.nsg', STATUS = 'UNKNOWN')
              WRITE (LU64, 99999, IOSTAT = IOST) LINE(5:80)
              CLOSE (UNIT = LU64)
              KERR = 0
              CALL SPAWN ('cp addsym.nsg ../../../.newsym.nsg', KERR)
            END IF
          END DO
   30     CLOSE (UNIT = LU63)
          CPR(105) = 'ADDSYM'
        ELSE IF (TYP(1:4) .EQ. 'CALC') THEN
          CALL S909 ('tm/sg/calc')
          KERR = 0
          CALL SPAWN ('cp ../'//FIL1(7:19)//' calc.spf', KERR)
          CALL SPAWN (PLAPATH(1:IGBL(80))//' -c calc.spf ', KERR)
          CALL SPAWN (PSVIEWER//'calc.lps', KERR)
        ELSE IF (TYP(1:3) .EQ. 'ADP') THEN
          CALL S909 ('tm/sg/adp')
          KERR = 0
          CALL SPAWN ('cp ../'//FIL1(7:19)//' adp.spf', KERR)
          CALL SPAWN (PLAPATH(1:IGBL(80))//' -a adp.spf ', KERR)
        ELSE IF (TYP(1:3) .EQ. 'CSD') THEN
          CALL S909 ('tm/sg/csd')
          KERR = 0
          CALL SPAWN ('cp ../'//FIL1(7:19)//' csd.spf', KERR)
          CALL SPAWN (PLAPATH(1:IGBL(80))//' -b csd.spf ', KERR)
        ELSE IF (TYP(1:4) .EQ. 'ASYM') THEN
          CALL S909 ('tm/sg/asym')
          KERR = 0
          CALL SPAWN ('cp ../s.res  .', KERR)
          CALL SPAWN ('cp ../s.hkl .', KERR)
          CALL SPAWN (PLAPATH(1:IGBL(80))//' -l s.res', KERR)
        END IF
      END IF
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      RETURN
99999 FORMAT (A)
99998 FORMAT ('CPR',I3, A)
      END SUBROUTINE S420
      SUBROUTINE S430
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,NP38=150,
     1 NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      LOGICAL EXST
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      EXST = .FALSE.
      CALL S915 ('Run PLATON/CONTOUR')
      CALL S909 ('tm/sg/contour')
      INQUIRE (FILE = 'contour.hkl', EXIST = EXST)
      IF (.NOT. EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s '//'../s.hkl contour.hkl', KERR)
      END IF
      INQUIRE (FILE = '../s.res', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../s.res contour.res', KERR)
      ELSE
        WRITE (LU6, 99994, IOSTAT = IOST)
        GO TO 10
      END IF
      IF (JFL(2)(1:2) .EQ. 'DF') THEN
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -w contour.res', KERR)
      ELSE IF (JFL(2)(1:2) .EQ. 'FO') THEN
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -x contour.res', KERR)
      ELSE IF (JFL(2)(1:2) .EQ. 'SQ') THEN
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -y contour.res', KERR)
      ELSE IF (JFL(2)(1:2) .EQ. 'PT') THEN
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -i contour.res', KERR)
      END IF
   10 IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      ISPR(7)  = 0
      IGBL(38) = 1
      RETURN
99994 FORMAT ('Error: File s.res not found in Compound Directory')
      END SUBROUTINE S430
      SUBROUTINE S500
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      CALL S909 ('tm/sg/report')
      KERR = 0
      CALL SPAWN ('ln -s -f ../shelxl/shelxl.cif shelxl.cif', KERR)
      KERR = 0
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -t shelxl.cif > tabl.log',
     1  KERR)
       CALL SPAWN ('rm tabl.log', KERR)
      CALL SPAWN ('rm -f shelxl.cif', KERR)
      KERR = 0
      CALL SPAWN ('cp ../shelxl/shelxl.cif '//COMPD(1:IC)//'.cif', KERR)
      CALL SPAWN ('cp ../shelxl/shelxl.hkl '//COMPD(1:IC)//'.hkl', KERR)
      CALL SPAWN ('cp ../shelxl/shelxl.fcf '//COMPD(1:IC)//'.fcf', KERR)
      CALL SPAWN ('cp ../shelxl/shelxl.res '//COMPD(1:IC)//'.res', KERR)
      CALL SPAWN ('mv           shelxl.sup '//COMPD(1:IC)//'.sup', KERR)
      CALL S903
      IF (IGBL(12) .EQ. 1) THEN
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -U shelxl.cif > check.log',
     1    KERR)
        CALL SPAWN ('rm check.log', KERR)
        CALL SPAWN ('mv shelxl.eld '//COMPD(1:IC)//'.spf', KERR)
        CALL SPAWN ('mv shelxl.chk '//COMPD(1:IC)//'.chk', KERR)
      END IF
      IF (ISPR(6) .EQ. 7) ISPR(6) = 8
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CALL S920 (1)
      RETURN
      END SUBROUTINE S500
      SUBROUTINE S520 (MODE)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      LOGICAL EXST
      EXST = .FALSE.
      IF (IGBL(80) .EQ. 0) THEN
        WRITE (LU6, '(/, ''PLATON NOT AVAILABLE'')', IOSTAT = IOST)
        RETURN
      END IF
      CALL S909 ('tm/sg/valid')
      KERR = 0
      CALL SPAWN ('ln -s -f ../pn/shelxl.cif valid.cif', KERR)
      CALL SPAWN ('ln -s -f ../pn/shelxl.fcf valid.fcf', KERR)
      IF (IABS(IGBL(12)) .EQ. 1) THEN
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' -U valid.cif > valid.log ',
     1    KERR)
        IF (MODE .GT. 0 .AND. IGBL(50) .EQ. 0) CALL PLA298 (1)
        IGBL(34) = 1
      END IF
      IF (ISPR(6) .EQ. 4) ISPR(6) = 5
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CALL GEN038 (VALIDATION, 1, 45)
      INQUIRE (FILE = 'tm/sg/valid/valid.log', EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU65, FILE = 'tm/sg/valid/valid.log', STATUS = 'UNKNOWN')
   40   READ (LU65, 99999, END = 30) LINE
        IF (INDEX (LINE, 'Entry') .EQ. 0) GO TO 40
        READ (LINE, '(32X, A)', END = 30) VALIDATION
   30   CLOSE (UNIT = LU65)
      END IF
      RETURN
99999 FORMAT (A)
      END SUBROUTINE S520
      SUBROUTINE S900 (NAT)
      PARAMETER (NP1=500,NP2=350)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CPEAK/ PEAK(500, 46), ICON(500, 40), NCON(500), OL(3, 3)
      CHARACTER LINE*80
      DIMENSION XJX(12), D(3), V(3), W(3)
      DTR  = ATAN(1.0) / 45.0
      NSYM = ISPR(102)
      ALPHA = SPAR(104)
      BETA  = SPAR(105)
      GAMMA = SPAR(106)
      COSA  = COS(ALPHA * DTR)
      COSB  = COS(BETA  * DTR)
      COSG  = COS(GAMMA * DTR)
      SINA  = SIN(ALPHA * DTR)
      SINB  = SIN(BETA  * DTR)
      SING  = SIN(GAMMA * DTR)
      COSGS = (COSA * COSB - COSG) / (SINA * SINB)
      SINGS = SQRT(1.0 - COSGS**2)
      COSBS = (COSG * COSA - COSB) / (SING * SINA)
      SINBS = SQRT(1.0 - COSBS**2)
      COSAS = (COSB * COSG - COSA) / (SINB * SING)
      SINAS = SQRT(1.0 - COSAS**2)
      DMX  = 2.0
      D(1) = DMX / (SPAR(101) * SINB * SINGS)
      D(2) = DMX / (SPAR(102) * SING * SINAS)
      D(3) = DMX / (SPAR(103) * SINA * SINBS)
      CALL GEN044 (SPAR(101), OL, 1)
      CALL GEN097 (NCON, 1, NAT, 0)
      DO I = 1, NAT
        DO J = I, NAT
          DO 120 N = 1, NSYM
            IF (J .EQ. I .AND. N .EQ. 1) GO TO  120
            DO K = 1, 3
              XJX(K) = PEAK(J, K)
              XJX(K + 3) = 0.0
            END DO
            NS = N
            CALL SGSM (LINE, NS, XJX, 6, 3, IERR)
            K = 1
            GO TO 30
   20       XJX(6 + K) = XJX(6 + K) - 1.0
   30       IF ((PEAK(I, K) - XJX(6 + K)) .LE. D(K)) GO TO 20
            GO TO 50
   40       IF (ABS(PEAK(I, K)  - XJX(6 + K)) .LE. D(K)) GO TO 60
   50       XJX(6 + K) = XJX(6 + K) + 1.0
            IF ((PEAK(I, K)  - XJX(6 + K)) .GE. - D(K)) GO TO 40
            K = K - 1
            IF (K .EQ. 0) GO TO 120
            GO TO 50
   60       K = K + 1
            IF (K .GT. 3) THEN
              DO L = 1, 3
                V(L) = PEAK(I, L) - XJX(6 + L)
              END DO
              CALL GEN002 (1, OL, V, W, XLNG)
              DIST = SQRT (GEN009 (W, W))
              IF (DIST .LT. DMX) THEN
                IF (I .NE. J .OR. DIST .GT. 0.05) THEN
                  IF (NCON(I) .GT. 0) THEN
                    DO M = 1, NCON(I)
                      IF (ICON(I, M) .EQ. J) GO TO 90
                    END DO
                  END IF
                  IF (NCON(I) .LT. 40) THEN
                    NCON(I)              = NCON(I) + 1
                    PEAK(I, 6 + NCON(I)) = DIST
                    ICON(I, NCON(I))     = J
                  END IF
   90             IF (NCON(J) .GT. 0) THEN
                    DO M = 1, NCON(J)
                      IF (ICON(J, M) .EQ. I) GO TO 110
                    END DO
                  END IF
                  IF (NCON(J) .LT. 40) THEN
                    NCON(J)              = NCON(J) + 1
                    PEAK(J, 6 + NCON(J)) = DIST
                    ICON(J, NCON(J))     = I
                  END IF
                END IF
              END IF
              GO TO 110
            END IF
            GO TO 30
  110       K = K - 1
            GO TO 50
  120     CONTINUE
        END DO
      END DO
      RETURN
      END SUBROUTINE S900
      FUNCTION S901 (I, J, K)
      COMMON /CPEAK/ PEAK(500, 46), ICON(500, 40), NCON(500), OL(3, 3)
      DIMENSION U(3), V(3), OU(3), OV(3), OLW(3, 3)
      RTD  = 45.0 / ATAN(1.0)
      DO L = 1, 3
        U(L) = PEAK(I, L) - PEAK(J, L)
        V(L) = PEAK(K, L) - PEAK(J, L)
        DO N = 1, 3
          OLW(L, N) = OL(L, N)
        END DO
      END DO
      CALL GEN002 (2, OLW, U, OU, XLNG)
      CALL GEN002 (2, OLW, V, OV, XLNG)
      S901 = GEN027 (OU, OV, RTD)
      RETURN
      END FUNCTION S901
      SUBROUTINE S902 (MODE, TM, LU61, LU62, STRING)
      DIMENSION TM(3, 3)
      CHARACTER STRING*(*), RISI*16
      OPEN (LU61, FILE = 's.hkl', STATUS = 'OLD')
      OPEN (LU62, FILE = STRING,  STATUS = 'UNKNOWN')
      IF (MODE .EQ. 1) WRITE (LU62, 99999, IOSTAT = IOST)
      CALL GEN108 (LU61, 0)
      NERROR = -1
   10 NERROR = NERROR + 1
      IF (NERROR .LT. 100) THEN
   20   READ (LU61, 99994, END = 30, ERR = 10)
     1        JH, JK, JL, RISI
        IF (JH .EQ. 0 .AND. JK .EQ. 0 .AND. JL .EQ. 0) GO TO 20
        XH = TM(1, 1) * JH + TM(1, 2) * JK + TM(1, 3) * JL
        XK = TM(2, 1) * JH + TM(2, 2) * JK + TM(2, 3) * JL
        XL = TM(3, 1) * JH + TM(3, 2) * JK + TM(3, 3) * JL
        IH = NINT(XH)
        IK = NINT(XK)
        IL = NINT(XL)
        IF (ABS(XH - IH) .GT. 0.01) GO TO 20
        IF (ABS(XK - IK) .GT. 0.01) GO TO 20
        IF (ABS(XL - IL) .GT. 0.01) GO TO 20
        WRITE (LU62, 99994, IOSTAT = IOST) IH, IK, IL, RISI
        GO TO 20
      END IF
   30 WRITE (LU62, 99998, IOSTAT = IOST)
      CLOSE (UNIT = LU61)
      CLOSE (UNIT = LU62)
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('HKLF 4')
99998 FORMAT (1X)
99994 FORMAT (3I4, A)
      END SUBROUTINE S902
      SUBROUTINE S903
      PARAMETER (NP17=99,NP42=250)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      OPEN (LU61, FILE = COMPD(1:IC)//'.txt', STATUS = 'UNKNOWN')
      WRITE (LU61, 99999, IOSTAT = IOST) COMPD(1:IC)
C * REFERENCES LIST
      LU = LU61
      WRITE (LU, 99910, IOSTAT = IOST) CHAR(12)
      WRITE (LU, 99911, IOSTAT = IOST)
      WRITE (LU, 99912, IOSTAT = IOST)
      WRITE (LU, 99914, IOSTAT = IOST)
      WRITE (LU, 99915, IOSTAT = IOST)
      WRITE (LU, 99921, IOSTAT = IOST)
      WRITE (LU, 99922, IOSTAT = IOST)
      WRITE (LU, 99924, IOSTAT = IOST)
      WRITE (LU, 99925, IOSTAT = IOST)
      WRITE (LU, 99927, IOSTAT = IOST)
      WRITE (LU, 99928, IOSTAT = IOST)
      WRITE (LU, 99930, IOSTAT = IOST)
      WRITE (LU, 99931, IOSTAT = IOST)
      RETURN
99999 FORMAT ('XRay Structure Determination of ', A, /)
99910 FORMAT (A, 5X, 'References',/)
99911 FORMAT (/, 5X,
     1 'Altomare, A., Cascarano, G., Giacovazzo,C. & Guagliardi, A.', /,
     2 '(1993). J. Appl. Cryst. 26, 343-350.')
99912 FORMAT (/, 5X,
     1 'Boer,J.L. de & Duisenberg,A.J.M.(1984). Acta Cryst. A40,C-410.')
99914 FORMAT (/, 5X,
     1 'Bondi,A.(1964). J. Phys. Chem. 68, 441-451.')
99915 FORMAT (/, 5X,
     1 'Cremer,D. & Pople,J.A.(1975).J.Am.Chem.Soc. 97,1354-1358.')
99921 FORMAT (/, 5X,
     1 'Domenicano, A., Vaciago, A. & Coulson, C.A. (1975). Acta',/,
     2 8X, 'Cryst. B31, 221-234.')
99922 FORMAT (/, 5X,
     1 'Duax, W.L., Weeks, C.M. & Rohrer, D.C. (1976). Topics in',/,
     2 8X, 'Stereochemistry,Vol.9, edited by N.L.Allinger & E.L.Eliel,'/
     3 8X, 'pp.271-383. New York:John Wiley.')
99924 FORMAT (/, 5X,
     1 'Johnson,C.K.(1965). ORTEP. Report ORNL-3794. Oak Ridge',/,
     2 8X, 'National Laboratory, Tennessee.')
99925 FORMAT (/, 5X,
     1 'Le Page,Y.(1982). J.Appl.Cryst. 15, 255-259.')
99927 FORMAT (/, 5X,
     1 'Sheldrick, G.M.(1976). SHELX-76. A Program for Crystal',/,
     2 8X, 'Structure Determination, Univ. of Cambridge, England.')
99928 FORMAT (/, 5X,
     1 'Sheldrick, G.M.(1986). SHELXS-86. A program for Crystal',/,
     2 8X, 'Structure Determination, Univ. of Gottingen, FRG.')
99930 FORMAT (/, 5X,
     1 'Spek, A.L.(1990), Acta Cryst., A46, C34.')
99931 FORMAT (/, 5X,
     1 'Spek, A.L.(1988). J.Appl.Cryst. 21, 578-579.')
      END SUBROUTINE S903
      SUBROUTINE S904
      PARAMETER (NP1=500,NP2=350,NP17=99,NP42=250)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER HKLP*12
      LOGICAL EXST
      EXST = .FALSE.
      ISPR(37) = 0
      INQUIRE (FILE = 'hklf/shelx.hkl', EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU61, FILE = 'hklf/shelx.hkl', STATUS = 'UNKNOWN')
        READ (LU61, 99999, ERR = 10) LINE
        DO K = 1, 48
          IF (LINE(81 - K:81 - K) .NE. ' ' .AND.
     1      LINE(81 - K:81 - K) .NE. CHAR(13)) THEN
            IF (K .LT. 10) THEN
              ISPR(37) = 1
              GO TO 10
            END IF
          END IF
        END DO
   10   IF (ISPR(37) .GT. 0) THEN
   20     READ (LU61, 99999, END = 30) LINE
          IF (LINE(1:5) .NE. '     ') GO TO 20
          N = 0
          DO
            READ (LU61, 99999, END = 30) LINE
            IF (N .EQ. 0) THEN
              N    = 1
              HKLP = LINE(1:12)
            ELSE
              IF (LINE(1:12) .EQ. HKLP) THEN
                N = N + 1
                IF (N .EQ. 36) ISPR(37) = ISPR(37) + 1
              ELSE
                N    = 1
                HKLP = LINE(1:12)
              END IF
            END IF
          END DO
   30     CONTINUE
        END IF
        CLOSE (UNIT = LU61)
      END IF
      RETURN
99999 FORMAT (A)
      END SUBROUTINE S904
      SUBROUTINE S905
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /TWINMAT/ ITWN(9, 4)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IF (KN .NE. 9) THEN
        ISPR(310) = 0
        BCD = 'TWIN-LAWS'//CHAR(0)
   10   CALL GGIP (HORS, VERT, 0.0, 1)
        CALL GGIP09 (0.0,  BCD, 9, 1.0, 4, 8, 8.1, VERT - 1.3)
        CALL GGIP09 (0.0,  BCD, 9, 1.0, 2, 8, 7.9, VERT - 1.4)
        DO I = 1, 4
          WRITE (LINE, 99999, IOSTAT = IOST) I, (ITWN(J, I), J = 1, 9)
          CALL GGIP09 (0.0, LINE, 70, 0.35, 1, 2, 0.1,
     1         VERT - 2.5 - I * 0.5)
        END DO
        SBCD = 'Enter Twin matrix (9 components) or #[0]'//CHAR(0)
        CALL PLA013 (0, 1)
        IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 10
        IF (IGGT(1:4) .EQ. 'EXIT') GO TO 20
        LINE = IGGT
        CALL GEN038 (IGGT, 1, 80)
        CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10, NP17)
        IF (KN .EQ. 1) THEN
          IF (FN(1) .GT. 0 .AND. FN(1) .LE. 3) THEN
            N = NINT(FN(1))
            DO I = 1, 9
              FN(I) = ITWN(I, N)
            END DO
          ELSE
            GO TO 20
          END IF
        ELSE IF (KN .NE. 9) THEN
          GO TO 20
        END IF
      END IF
      CALL GEN010 (FN, IDET, 0)
      IF (IDET .NE. 0) THEN
        ISPR(310) = 1
        DO I = 1, 9
          ISPR(310 + I) = NINT(FN(I))
        END DO
      ELSE
        CALL PLA015 (0, 37)
      END IF
   20 RETURN
99999 FORMAT (I3, ' : ', 9I5)
      END SUBROUTINE S905
      SUBROUTINE S909 (STRING)
      CHARACTER P*256, STRING*(*)
      INTEGER CHANDIR
      LOGICAL DINQ
      L = LEN(STRING)
      P = 'mkdir '//STRING(1:L)
C * INQUIRE WHETHER sub-DIRECTORY 'STRING' EXISTS
C * CREATE sub-DIRECTORY WHEN IT DOES NOT EXIST
      IF (.NOT. DINQ (STRING(1:L))) THEN
        KERR = 0
        CALL SPAWN (P, KERR)
      END IF
C * CHANGE TO sub-DIRECTORY
      IF (CHANDIR (STRING(1:L)) .NE. 0) CALL S925 (1)
      RETURN
      END SUBROUTINE S909
      SUBROUTINE S910
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      COMMON /LIJNX/ LIJN1, LIJN2, LIJN3, LIJN4, LIJN5
      CHARACTER LIJN*80, LIJN1*16, LIJN2*16, LIJN3*16, LIJN4*21,
     1          LIJN5*16
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      YVRT = VRTS * VERT
      XSH  = HORS - YVRT
      CALL GGIP (0.0, 5.0 + FLOAT(IGBL(68)), 0.0, 0)
      CALL GGIP (0.0,         -2.0, 0.0, 0)
      CALL GGIP (XSH,         0.05, 0.0, 3)
      CALL GGIP (XSH,         YVRT, 0.0, 2)
      CALL GGIP (HORS - 0.05, YVRT, 0.0, 2)
      CALL GGIP (HORS - 0.05, 0.05, 0.0, 2)
      CALL GGIP (XSH,   0.05, 0.0, 2)
      CALL GGIP (0.0,   0.0,  0.0, 3)
      IF (ISPR(6) .LT. 0) CALL GGIP09 (0.0, '?', 1, 10.0, 5, 12,
     1                    (HORS + XSH) / 2.0 - 3.0, 3.0)
      VRT = VRT - 0.6
      IF (ISPR(110) .GT. 0) THEN
        WRITE (LIJN, 99999, IOSTAT = IOST) (SFC(I), I = 1, ISPR(110))
        CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.3, VRT)
        VRT = VRT - 0.6
        WRITE (LIJN, 99998, IOSTAT = IOST)
     1    (ISPR(I + 136), I = 1, ISPR(110))
        CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.3, VRT)
        WRITE (LIJN, 99994, IOSTAT = IOST) CPR(1)
        CALL GGIP09 (0.0,  LIJN, 7, 0.5, 2, 2, HORS - 3.2, VRT)
        VRT = VRT - 0.6
        WRITE (LIJN, 99997, IOSTAT = IOST)
     1    (ISPR(I + 120), I = 1, ISPR(110))
        CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.3, VRT)
        VRT = VRT - 0.6
        WRITE (LIJN, 99996, IOSTAT = IOST)
     1    (ISPR(I + 152), I = 1, ISPR(110))
        CALL GGIP09 (0.0,  LIJN, 80, 0.35, 1, 2, 0.3, VRT)
      ELSE
        VRT = VRT - 1.8
      END IF
      VRT  = VRT - 1.0
      LIJN = 'StrDetStage DETAILS '
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 5 + IGBL(68), 3, 0.3, VRT)
      VRT  = VRT - 1.5
      LIJN = 'SpaceGroup  '//CPR(100)
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(1)(1:4) .EQ. 'TRMX' .OR. CPR(1)(1:4) .EQ. 'SPGR') THEN
        ICOL = 2
      ELSE
        ICOL = 5 + IGBL(68)
      END IF
      CALL GGIP09 (0.0, LIJN, 12, 0.45, ICOL, 2, 0.3, VRT)
      VRT  = VRT - 1.0
      IF (ISPR(120) .NE. 0) WRITE (LIJN5, 99993, IOSTAT = IOST)
     1   ISPR(120)
      LIJN = 'Z           '//LIJN5
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(100)(1:6) .NE. '      ' .AND. ISPR(120) .EQ. 0) THEN
        ICOL = 2
      ELSE
        ICOL = 5 + IGBL(68)
      END IF
      CALL GGIP09 (0.0, LIJN, 12, 0.45, ICOL, 2, 0.3, VRT)
      VRT = VRT - 1.0
      LIJN = 'AbsCorrMetd '//CPR(202)
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      ICOL = 5 + IGBL(68)
      NCOL = 12
      CALL GGIP09 (0.0, LIJN, NCOL, 0.45, ICOL, 2, 0.3, VRT)
      VRT  = VRT - 1.0
      LIJN = 'PhasingMetd '//CPR(203)
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(1)(1:6) .EQ. 'SHELXS' .OR.
     1    CPR(1)(1:6) .EQ. 'SHELXD' .OR.
     2    CPR(1)(1:6) .EQ. 'DIRDIF' .OR.
     2    CPR(1)(1:3) .EQ. 'SIR') THEN
        CALL GGIP09 (0.0, LIJN, 40, 0.45, 0, 2, 0.3, VRT)
        ICOL = 2
        LIJN = 'PhasingMetd '//CPR(1)
        NCOL = 40
      ELSE
        ICOL = 5 + IGBL(68)
        NCOL = 12
      END IF
      CALL GGIP09 (0.0, LIJN, NCOL, 0.45, ICOL, 2, 0.3, VRT)
      CALL GGIP (0.0, 0.0, 0.0, 6)
      VRT  = VRT - 1.0
      LIJN = 'Add H-Atoms '//CPR(206)
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(1)(1:4) .EQ. 'HDIF') THEN
        ICOL = 2
        LIJN = 'Add H-Atoms HDIF'
        NCOL = 40
      ELSE IF (CPR(1)(1:4) .EQ. 'HFIX') THEN
        ICOL = 2
        LIJN = 'Add H-Atoms HFIX'
        NCOL = 40
      ELSE
        IF (ISPR(112) .GT. 0 .OR. ISPR(6) .LE. 0) THEN
          ICOL = 5 + IGBL(68)
        ELSE
          ICOL = 4
        END IF
      END IF
      CALL GGIP09 (0.0, LIJN, NCOL, 0.45, 5 + IGBL(68), 2, 0.3, VRT)
      VRT = VRT - 1.0
      CALL GGIP09 (0.0, '                R   wR2    S',
     1             28, 0.45, 5 + IGBL(68), 2, 0.3, VRT)
      VRT = VRT - 1.0
      ICOL = 1
      IF (ISPR(6) .EQ. 1) THEN
        WRITE (LIJN1, 99995, IOSTAT = IOST)
     1    SPAR(202), SPAR(203), SPAR(133)
      ELSE IF (ISPR(6) .EQ. 0) THEN
        ICOL = 0
      END IF
      LIJN = 'Iso   Refin '//LIJN1
      CALL GGIP09 (0.0, LIJN, 40, 0.45, ICOL, 2, 0.3, VRT)
      IF (CPR(2)(1:3) .EQ. 'ISO') THEN
        ICOL = 2
      ELSE
        ICOL = 5 + IGBL(68)
      END IF
      CALL GGIP09 (0.0, LIJN, 12, 0.45, ICOL, 2, 0.3, VRT)
      VRT  = VRT - 1.0
      IF (ISPR(6) .EQ. 2 .OR.
     1 (ISPR(6) .EQ. 3 .AND. LIJN2(1:5) .EQ. '     '))
     2  WRITE (LIJN2, 99995, IOSTAT = IOST)
     3   SPAR(202), SPAR(203), SPAR(133)
      LIJN = 'Aniso Refin '//LIJN2
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(2)(1:5) .EQ. 'ANISO') THEN
        ICOL = 2
      ELSE
        ICOL = 5 + IGBL(68)
      END IF
      CALL GGIP09 (0.0, LIJN, 12, 0.45, ICOL, 2, 0.3, VRT)
      VRT  = VRT - 1.0
      IF (CPR(106)(1:4) .EQ. 'HATS')
     1  WRITE (LIJN3, 99995, IOSTAT = IOST)
     1    SPAR(202), SPAR(203), SPAR(133)
      LIJN = 'H-AtomRefin '//LIJN3
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(2)(1:4) .EQ. 'HATS') THEN
        ICOL = 2
      ELSE
        IF (ISPR(112) .GT. 0 .OR. ISPR(6) .LE. 0) THEN
          ICOL = 5 + IGBL(68)
        ELSE
          ICOL = 4
        END IF
      END IF
      CALL GGIP09 (0.0, LIJN, 12, 0.45, ICOL, 2, 0.3, VRT)
      VRT  = VRT - 1.0
      IF (CPR(106)(1:6) .EQ. 'WEIGHT')
     1  WRITE (LIJN4, 99995, IOSTAT = IOST)
     2    SPAR(202), SPAR(203), SPAR(133)
      LIJN = 'WeightRefin '//LIJN4
      CALL GGIP09 (0.0, LIJN, 40, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(2)(1:6) .EQ. 'WEIGHT') THEN
        ICOL = 2
      ELSE
        ICOL = 5 + IGBL(68)
      END IF
      CALL GGIP09 (0.0, LIJN, 12, 0.45, ICOL, 2, 0.3, VRT)
      VRT  = VRT - 1.5
      LIJN = 'Valid-Alert'//VALIDATION(2:)
      CALL GGIP09 (0.0, LIJN, 29, 0.45, 1, 2, 0.3, VRT)
      IF (CPR(1)(1:5) .EQ. 'VALID') THEN
        ICOL = 2
      ELSE
        IF (IABS(IGBL(12)) .EQ. 1) THEN
          ICOL = 5 + IGBL(68)
        ELSE
          ICOL = 4
        END IF
      END IF
      CALL GGIP09 (0.0, LIJN, 12, 0.45, ICOL, 2, 0.3, VRT)
      CALL GGIP (0.0, 0.0, 0.0, 6)
      IF (ISPR(50) .EQ. 0 .AND. CPR(105)(1:2) .NE. 'Z ') CALL S410 (0)
      IF (ISPR(6) .GE. 5) THEN
        IGBL(50) = 0
   10   CALL PLA297 (2)
        IF (IGGT(1:4) .EQ. 'CALC')  GO TO 10
        IF (IABS(IGBL(12)) .EQ. 1) CALL PLA298 (2)
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('Elem ', 2(2X, A), 14(1X, A))
99998 FORMAT ('Form ', 2I4, 14I3)
99997 FORMAT ('Unit ', 2I4, 14I3)
99996 FORMAT ('Cont ', 2I4, 14I3)
99995 FORMAT (F5.3, F6.3, F5.2)
99994 FORMAT (A)
99993 FORMAT (I5)
      END SUBROUTINE S910
      FUNCTION S913 (LINE)
      CHARACTER LINE*(80)
      N = 0
      K = 0
      J = 0
      I = 0
   10 I = I + 1
      IF (I .LE. 80) THEN
        IF (LINE(I:I) .NE. ' ') THEN
          IF (J .EQ. 0) THEN
            K = K + 1
            IF (K .EQ. 9) THEN
              N = I - 1
              GO TO 20
            END IF
            J = 1
          END IF
        ELSE
          J = 0
        END IF
        GO TO 10
      END IF
   20 S913 = N
      RETURN
      END FUNCTION S913
      SUBROUTINE S914
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER LIN*132
      INTEGER CHANDIR
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LIJN*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      LISDOT = 0
      L1     = 0
      NP000  = 0
      IF (KL .GT. 1) THEN
        IF (JFL(2)(1:3) .EQ. 'ALL') THEN
          LISDOT = 1
        END IF
      ELSE
        LISDOT = 0
      END IF
      LU   = 31
      N00  = 0
      KERR = 0
      CALL SPAWN ('du -s . > du.lis', KERR)
      OPEN (LU, FILE = 'du.lis', STATUS = 'UNKNOWN')
      CALL GEN072 (LINE, JFL, FN, KL, KN, LU, LU6, 1, 1, 80, 10, NP17)
      DSKUSE = FN(1) / 1024.0
      CLOSE (UNIT = LU)
      KERR = 0
      CALL SPAWN ('rm du.lis', KERR)
      OPEN (LU, FILE = 'tree.lis', STATUS = 'UNKNOWN')
      WRITE (LU, 99999, IOSTAT = IOST) FNM(1:IN - 1), DSKUSE
      KERR = 0
      CALL SPAWN ('ls -al | sort -r -k 1,2 > tree.ls0', KERR)
      OPEN (LU61, FILE = 'tree.ls0', STATUS = 'UNKNOWN')
   10 READ (LU61, 99998, END = 20) LIN
      L1 = NINT (S913 (LIN))
      IF (L1 .EQ. 0) GO TO 10
   20 CALL GEN108 (LU61, 0)
   30 READ (LU61, 99998, END = 300) LIN
      L1M  = MIN (132, L1 + 80)
      LINE = LIN(L1 + 1: L1M)
      IF (LISDOT .EQ. 0 .AND. LINE(1:1) .EQ. '.') GO TO 30
      IF (LINE(1:3) .EQ. '.  ') THEN
        GO TO 30
      ELSE IF (LINE(1:3) .EQ. '.. ') THEN
        GO TO 30
      ELSE IF (LINE(1:4) .EQ. 'tree') THEN
        GO TO 30
      ELSE IF (LINE(1:4) .EQ. '    ') THEN
        GO TO 30
      END IF
      IF (LIN(1:1) .NE. 'd') THEN
        WRITE (LU, 99998, IOSTAT = IOST) LINE(1:79)
        GO TO 30
      ELSE
        IF (LINE(1:2) .EQ. '01') N00 = 1
        IF (LINE(1:2) .EQ. '00' .AND. N00 .EQ. 1) GO TO 30
        N000 = 0
        LMX = L1M - L1
        DO I = 1, LMX
          IF (LINE(LMX + 1 - I: LMX + 1 - I) .NE. ' ') GO TO 50
        END DO
   50   NLEN1 = LMX + 1 - I
        WRITE (LU, 99997, IOSTAT = IOST) LINE(1:NLEN1)
        IF (CHANDIR (LINE(1:NLEN1)) .NE. 0) CALL S925 (1)
        KERR = 0
        CALL SPAWN ('ls -al | sort -r -k 1,2 > tree.ls1', KERR)
        OPEN (LU62, FILE = 'tree.ls1', STATUS = 'UNKNOWN')
   60   READ (LU62, 99998, END = 70) LIN
        L2 = NINT (S913 (LIN))
        IF (L2 .EQ. 0) GO TO 60
   70   CALL GEN108 (LU62, 0)
   80   READ (LU62, 99998, END = 290) LIN
        L2M  = MIN (132, L2 + 80)
        LINE = LIN(L2 + 1: L2M)
        IF (LISDOT .EQ. 0 .AND. LINE(1:1) .EQ. '.') GO TO 80
        IF (LINE(1:3) .EQ. '.  ') THEN
          GO TO 80
        ELSE IF (LINE(1:3) .EQ. '.. ') THEN
          GO TO 80
        ELSE IF (LINE(1:4) .EQ. 'tree') THEN
          GO TO 80
        ELSE IF (LINE(1:4) .EQ. '    ') THEN
          GO TO 80
        END IF
        IF (LIN(1:1) .NE. 'd') THEN
          WRITE (LU, '('' I-- '', A)', IOSTAT = IOST) LINE(1:74)
          GO TO 80
        ELSE
          READ (LINE(1:3), '(I3)', ERR = 90) N
          IF (N .NE. 0) N000 = 1
          IF (LINE(1:3) .EQ. '000' .AND. N000 .EQ. 1) GO TO 80
          NP000 = 0
   90     LMX = L2M - L2
          DO I = 1, LMX
            IF (LINE(LMX + 1 - I: LMX + 1 - I) .NE. ' ') GO TO 110
          END DO
  110     NLEN2 = LMX + 1 - I
          WRITE (LU, '('' I-- '', A, ''/'')', IOSTAT = IOST)
     1      LINE(1:NLEN2)
          IF (CHANDIR (LINE(1:NLEN2)) .NE. 0) CALL S925 (1)
          KERR = 0
          CALL SPAWN ('ls -al | sort -r -k 1,2 > tree.ls2', KERR)
          OPEN (LU63, FILE = 'tree.ls2', STATUS = 'UNKNOWN')
  120     READ (LU63, 99998, END = 130) LIN
          L3 = NINT (S913(LIN))
          IF (L3 .EQ. 0) GO TO 120
  130     CALL GEN108 (LU63, 0)
  140     READ (LU63, 99998, END = 280) LIN
          L3M = MIN (132, L3 + 80)
          LINE = LIN(L3 + 1: L3M)
          IF (LISDOT .EQ. 0 .AND. LINE(1:1) .EQ. '.') GO TO 140
          IF (LINE(1:3) .EQ. '.  ') THEN
            GO TO 140
          ELSE IF (LINE(1:3) .EQ. '.. ') THEN
            GO TO 140
          ELSE IF (LINE(1:2) .EQ. '00') THEN
            GO TO 140
          ELSE IF (LINE(1:4) .EQ. '    ') THEN
            GO TO 140
          END IF
          IF (LIN(1:1) .NE. 'd') THEN
            WRITE (LU, '(6X, ''I-- '', A)', IOSTAT = IOST) LINE(1:69)
            GO TO 140
          ELSE
            READ (LINE(1:3), '(I3)', ERR = 150) M
            IF (M .NE. 0) NP000 = 1
            IF (LINE(1:3) .EQ. '000' .AND. NP000 .EQ. 1) GO TO 140
  150       LMX = L3M - L3
            DO I = 1, LMX
              IF (LINE(LMX + 1 - I: LMX + 1 - I) .NE. ' ') GO TO 170
            END DO
  170       NLEN3 = LMX + 1 - I
            WRITE (LU, '(6X, ''I-- '', A, ''/'')', IOSTAT = IOST)
     1        LINE(1:NLEN3)
            IF (CHANDIR (LINE(1:NLEN3)) .NE. 0) CALL S925 (1)
            KERR = 0
            CALL SPAWN ('ls -al | sort -r -k 1,2 > tree.ls3', KERR)
            OPEN (LU64, FILE = 'tree.ls3', STATUS = 'UNKNOWN')
  180       READ (LU64, 99998, END = 190) LIN
            L4 = NINT (S913(LIN))
            IF (L4 .EQ. 0) GO TO 180
  190       CALL GEN108 (LU64, 0)
  200       READ (LU64, 99998, END = 270) LIN
            L4M = MIN (132, L4 + 80)
            LINE = LIN(L4 + 1: L4M)
            IF (LISDOT .EQ. 0 .AND. LINE(1:1) .EQ. '.') GO TO 200
            IF (LINE(1:3) .EQ. '.  ') THEN
              GO TO 200
            ELSE IF (LINE(1:3) .EQ. '.. ') THEN
              GO TO 200
            ELSE IF (LINE(1:4) .EQ. 'tree') THEN
              GO TO 200
            ELSE IF (LINE(1:4) .EQ. '    ') THEN
              GO TO 200
            END IF
            IF (LIN(1:1) .NE. 'd') THEN
              WRITE (LU, '(11X, ''I-- '', A)', IOSTAT = IOST) LINE(1:64)
              GO TO 200
            ELSE
              LMX = L4M - L4
              DO I = 1, LMX
                IF (LINE(LMX + 1 - I:LMX + 1 - I) .NE. ' ') GO TO 220
              END DO
  220         NLEN4 = LMX + 1 - I
              WRITE (LU, '(11X, ''I-- '', A, ''/'')', IOSTAT = IOST)
     1          LINE(1:NLEN4)
              IF (CHANDIR (LINE(1:NLEN4)) .NE. 0) CALL S925 (1)
              KERR = 0
              CALL SPAWN ('ls -al | sort -r -k 1,2 > tree.ls4', KERR)
              OPEN (LU65, FILE = 'tree.ls4', STATUS = 'UNKNOWN')
  230         READ (LU65, 99998, END = 240) LIN
              L5 = NINT (S913(LIN))
              IF (L5 .EQ. 0) GO TO 230
  240         CALL GEN108 (LU65, 0)
  250         READ (LU65, 99998, END = 260) LIN
              L5M = MIN (132, L5 + 80)
              LINE = LIN(L5 + 1: L5M)
              IF (LISDOT .EQ. 0 .AND. LINE(1:1) .EQ. '.') GO TO 250
              IF (LINE(1:3) .EQ. '.  ') THEN
                GO TO 250
              ELSE IF (LINE(1:3) .EQ. '.. ') THEN
                GO TO 250
              ELSE IF (LINE(1:4) .EQ. 'tree') THEN
                GO TO 250
              ELSE IF (LINE(1:4) .EQ. '    ') THEN
                GO TO 250
              END IF
              WRITE (LU, '(16X, ''I-- '', A)', IOSTAT = IOST) LINE(1:59)
              GO TO 250
  260         CLOSE (UNIT = LU65)
              KERR = 0
              CALL SPAWN ('rm tree.ls4', KERR)
              IF (CHANDIR ('..') .NE. 0) CALL S925 (1)
            END IF
            GO TO 200
  270       CLOSE (UNIT = LU64)
            KERR = 0
            CALL SPAWN ('rm tree.ls3', KERR)
            IF (CHANDIR ('..') .NE. 0) CALL S925 (1)
          END IF
          GO TO 140
  280     CLOSE (UNIT = LU63)
          KERR = 0
          CALL SPAWN ('rm tree.ls2', KERR)
          IF (CHANDIR ('..') .NE. 0) CALL S925 (1)
        END IF
        GO TO 80
  290   CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN ('rm tree.ls1', KERR)
        IF (CHANDIR ('..') .NE. 0) CALL S925 (1)
      END IF
      GO TO 30
  300 CLOSE (UNIT = LU61)
      KERR = 0
      CALL SPAWN ('rm tree.ls0', KERR)
      CLOSE (UNIT = LU)
      OPEN (UNIT = LU65, FILE = 'tree.lis',  STATUS = 'UNKNOWN')
  310 VRT = 19.4
      BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      CALL GGIP (HORS, VERT, 0.0, 1)
      IEND = 0
  320 READ (LU65, 99998, END = 330) LIJN
      N = INDEX (LIJN, '->')
      IF (N .NE. 0) LIJN(N:N+1) = 'to'
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LIJN, 80, 0.375, 1, 2, 0.1, VRT)
      IF (VRT .GT. 0.5) GO TO 320
      GO TO 340
  330 IEND = 1
  340 CALL PLA013 (1, 1)
      IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
        IF (LRET .EQ. 2) THEN
          CALL GEN108 (LU65, 0)
          GO TO 310
        END IF
        LINE = IGGT
        CALL GEN038 (IGGT, 1, 80)
        IF (LINE(1:1) .EQ. 'N' .OR. LINE(1:1) .EQ. 'n') GO TO 350
      END IF
      IF (IEND .EQ. 0) GO TO 310
  350 CLOSE (UNIT = LU65)
      KERR = 0
      CALL SPAWN ('rm tree.lis', KERR)
      RETURN
99999 FORMAT ('Directory Structure for : ', A, ' - Disk Use = ',
     1         F6.2, ' Mb', /, 80('='))
99998 FORMAT (A)
99997 FORMAT (A, '/')
      END SUBROUTINE S914
      SUBROUTINE S915 (TEXT)
      PARAMETER (NP3=250,NP12=700,NP13=550,NP17=99,NP38=150,
     1 NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER DATIJD*25, TEXT*(*)
      LOGICAL OPEND
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LIJN*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      IF (TEXT(1:3) .EQ. 'LOG') THEN
        CLOSE (UNIT = LU60)
        OPEN (UNIT = LU60, FILE = FNM(1:IN)//'s.log',
     1        STATUS = 'UNKNOWN')
   10   VRT = 18.8
        BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
        CALL GGIP (HORS, VERT, 0.0, 1)
        IEND = 0
        LIJN = 'Log Date       tm/sg/pn    Action'
        CALL GGIP09 (0.0, LIJN, 33, 0.375, 5 + IGBL(68), 2, 2.5, VRT)
   20   READ (LU60, '(A)', END = 30) LIJN
        VRT = VRT - 0.6
        CALL GGIP09 (0.0, LIJN, 80, 0.375, -1, 2, 0.1, VRT)
        IF (VRT .GT. 0.5) GO TO 20
        GO TO 40
   30   IEND = 1
   40   CALL PLA013 (1, 1)
        IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
          IF (LRET .EQ. 2) THEN
            CALL GEN108 (LU60, 0)
            GO TO 10
          END IF
          LINE = IGGT
          CALL GEN038 (IGGT, 1, 80)
          IF (LINE(1:1) .EQ. 'N') GO TO 100
        END IF
        IF (IEND .EQ. 0) GO TO 10
  100   CLOSE (UNIT = LU60)
        OPEN (UNIT = LU60, FILE = FNM(1:IN)//'s.log',
     1    ACCESS = 'APPEND', FORM = 'FORMATTED', STATUS = 'UNKNOWN')
      ELSE
        CALL ZDATE (DATIJD)
        INQUIRE (LU60, OPENED = OPEND)
        IF (.NOT. OPEND) THEN
          OPEN (UNIT = LU60, FILE = FNM(1:IN)//'s.log',
     1      ACCESS = 'APPEND', FORM = 'FORMATTED', STATUS = 'UNKNOWN')
        END IF
        WRITE (LU60, '(A, 1X, A, '' : '', A)', IOSTAT = IOST)
     1         DATIJD(5:24), CPR(104), TEXT
      END IF
      RETURN
      END SUBROUTINE S915
      SUBROUTINE S916
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LIJN*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      OPEN (UNIT = LU61, FILE = 's.res',  STATUS = 'UNKNOWN')
      READ (LU61, '(A)', END = 100) LIJN
      CALL GEN108 (LU61, 0)
   10 VRT = 18.8
      BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      CALL GGIP (HORS, VERT, 0.0, 1)
      IEND = 0
      LIJN = 'LISTING OF CURRENT s.res CONTENTS'
      CALL GGIP09 (0.0, LIJN, 33, 0.375, 5 + IGBL(68), 2, 6.5, VRT)
   20 READ (LU61, '(A)', END = 30) LIJN
      VRT = VRT - 0.6
      CALL GGIP09 (0.0, LIJN, 80, 0.375, -1, 2, 0.1, VRT)
      IF (VRT .GT. 0.5) GO TO 20
      GO TO 40
   30 IEND = 1
   40 CALL PLA013 (1, 1)
      IF (IGGT(1:1) .NE. ' ' .AND. IGGT(1:1) .NE. '!') THEN
        IF (LRET .EQ. 2) THEN
          CALL GEN108 (LU61, 0)
          GO TO 10
        END IF
        LINE = IGGT
        CALL GEN038 (IGGT, 1, 80)
        IF (LINE(1:1) .EQ. 'N') GO TO 100
      END IF
      IF (IEND .EQ. 0) GO TO 10
  100 CLOSE (UNIT = LU61)
      RETURN
      END SUBROUTINE S916
      SUBROUTINE S917
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER LIN*132, FNAM*30, FNAMA(2)*30
      DIMENSION IFA(2)
      INTEGER CHANDIR
      LOGICAL EXST
      EXST = .FALSE.
      L1   = 0
C * RESOLVE LINKS
      KERR = 0
      CALL SPAWN ('ls -l s.log > lsl.lis', KERR)
      OPEN (LU61, FILE = 'lsl.lis', STATUS = 'UNKNOWN')
      DO
        READ (LU61, 99998, END = 30) LINE
        I = INDEX (LINE, ' s.log')
        IF (I .GT. 0) GO TO 20
      END DO
   20 L1 = I
   30 CLOSE (UNIT = LU61)
      KERR = 0
      CALL SPAWN ('rm lsl.lis', KERR)
      INQUIRE (FILE = FNM(1:IN)//'tm/sg', EXIST = EXST)
      IF (EXST) THEN
        FNAMA(1)(1:5) = 's.res'
        IFA(1) = 5
        FNAMA(2)(1:5) = 's.hkl'
        IFA(2) = 5
        DO 110 J = 1, 2
          IFN  = IFA(J)
          FNAM = FNAMA(J)
          IF (CHANDIR(FNM(1:IN)//'tm/sg') .NE. 0) GO TO 120
   40     INQUIRE (FILE = FNAM(1:IFN), EXIST = EXST)
          IF (.NOT. EXST) GO TO 110
          KERR = 0
          CALL SPAWN
     1     ('ls -l '//FNAM(1:IFN)//' > '//FNM(1:IN)//'lsl.lis', KERR)
          OPEN (LU61, FILE = FNM(1:IN)//'lsl.lis', STATUS = 'UNKNOWN')
          READ (LU61, 99998, END = 110) LIN
          CLOSE (UNIT = LU61)
          KERR = 0
          CALL SPAWN ('rm '//FNM(1:IN)//'lsl.lis', KERR)
          L1M = MIN (132, L1 + 80)
          LINE = LIN(L1 + 1: L1M)
          LMX = L1M - L1
          DO I = 1, LMX
            IF (LINE(LMX + 1 - I: LMX + 1 - I) .NE. ' ') GO TO 60
          END DO
   60     L4 = LMX + 1 - I
          DO I = 1, L4 - 1
            IF (LINE(L4 - I: L4 - I) .EQ. ' ') GO TO 80
          END DO
          I  = L4
   80     L2 = L4 - I + 1
          IF (LIN(1:1) .EQ. 'l') THEN
            DO I = L2 + 1, L4
              IF (LINE(L4 - I + L2:L4 -I + L2) .EQ. '/') GO TO 100
            END DO
  100       L3 = L4 + L2 - I
            IF (CHANDIR(LINE (L2:L3-1)) .NE. 0) GO TO 120
            IFN = L4 - L3
            FNAM(1:IFN) = LINE(L3+1:L4)
            GO TO 40
          ELSE
            KERR = 0
            CALL SPAWN ('pwd > '//FNM(1:IN)//'lsl.lis', KERR)
            OPEN (LU61, FILE = FNM(1:IN)//'lsl.lis', STATUS = 'UNKNOWN')
            READ (LU61, 99998, END = 110) LIN
            CLOSE (UNIT = LU61)
            KERR = 0
            CALL SPAWN ('rm '//FNM(1:IN)//'lsl.lis', KERR)
            IB = 1
            I  = 80
            CALL GEN039 (1, LIN, 1, 80, IB, I)
            L5 = I + 1
            LIN(L5:L5) = '/'
            LNKS(J)(1:1) = ' '
            WRITE (LNKS(J)(2:), 99999, IOSTAT = IOST)
     1        FNAMA(J)(1:IFA(J)), LIN(1:L5)//LINE(L2:L4)
          END IF
  110   CONTINUE
      END IF
  120 IF (CHANDIR (FNM(1:IN - 1)) .NE. 0) CALL S925 (1)
      IGBL(38) = 0
      RETURN
99999 FORMAT (A, ' Resolves to File: ', A)
99998 FORMAT (A)
      END SUBROUTINE S917
      SUBROUTINE S918
      PARAMETER (NP1=500,NP2=350,NP17=99,NP42=250)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CALL GEN125 (1, LU6, 'laser s.log      (y/n[n])')
      READ  (LU5, '(A)') LINE(1:1)
      IF (LINE(1:1) .EQ. 'y' .OR. LINE(1:1) .EQ. 'Y') THEN
        KERR = 0
        CALL SPAWN ('laser s.log', KERR)
      END IF
      RETURN
      END SUBROUTINE S918
      SUBROUTINE S920 (MODE)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP18=50,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /LPLAT/ TLATT(9, NP18), XCELL(7, NP18), LLAUE(NP18),
     1 RVL(12, 3), NTL(12, 3), RVAL(NP18, 3), NRLT0, NRLT, NREXT,
     2 RMAX, AVIOS
      COMMON /LPLATC/ BLATT(NP18), CLATT(NP18), ELATT(NP18)
      CHARACTER BLATT*1, CLATT*1, ELATT*1
      LOGICAL EXST
      IF (MODE .GT. 0) THEN
        OPEN (LU61, FILE = FNM(1:IN)//'.s.dbf', FORM = 'UNFORMATTED',
     1              STATUS = 'UNKNOWN')
        WRITE (LU61) SPAR, ISPR, TM, OM, OX
        WRITE (LU61) TITL, SFAC, CPR, VALIDATION
        WRITE (LU61) IGBL
        CLOSE (UNIT = LU61)
      ELSE
        IGBL50 = IGBL(50)
        OPEN  (LU61, FILE = '.s.dbf', FORM = 'UNFORMATTED',
     1                                STATUS = 'OLD')
        READ  (LU61) SPAR, ISPR, TM, OM, OX
        READ  (LU61) TITL, SFAC, CPR, VALIDATION
        READ  (LU61) IGBL
        CLOSE (UNIT = LU61)
        INQUIRE (FILE = 'tm/spgr/.spgr', EXIST = EXST)
        IF (EXST) THEN
          OPEN (LU61, FILE = 'tm/spgr/.spgr', STATUS = 'UNKNOWN',
     1                FORM = 'UNFORMATTED')
          READ (LU61) TSPGR
          CLOSE (UNIT = LU61)
        END IF
        INQUIRE (FILE = 'latt/latt.trm', EXIST = EXST)
        IF (EXST) THEN
          OPEN (LU61, FILE = 'latt/latt.trm', STATUS = 'UNKNOWN',
     1                FORM = 'UNFORMATTED')
          READ (LU61) NRLT0, NRLT, NREXT, AVIOS, RMAX,
     1     RVL, NTL, TLATT, XCELL, LLAUE, RVAL, CLATT, BLATT, ELATT
          CLOSE (UNIT = LU61)
        END IF
        IGBL(50) = IGBL50
        IGBL(38) = 1
      END IF
      RETURN
      END SUBROUTINE S920
      SUBROUTINE S921 (MODE)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FASE/ METHOD(10)
      IF (MODE .EQ. 0) THEN
          IF (IGBL(73) .LE. 0) THEN
            IGBL(73) = 1
            IF (SPAR(3) .GE. 15.0 .AND. IGBL(115) .NE. 0) THEN
              METHOD(1) = 5
              IGBL(108) = 1
            END IF
            IGBL(108)         = IGBL(108) + 1
            METHOD(IGBL(108)) = 1
            IF (IGBL(113) .NE. 0) THEN
              IGBL(108)         = IGBL(108) + 1
              METHOD(IGBL(108)) = 3
            END IF
            IF (IGBL(111) .NE. 0) THEN
              IGBL(108)         = IGBL(108) + 1
              METHOD(IGBL(108)) = 2
            END IF
            IF (IGBL(114) .NE. 0) THEN
              IGBL(108)         = IGBL(108) + 1
              METHOD(IGBL(108)) = 4
            END IF
            IF (IGBL(112) .NE. 0) THEN
              IGBL(108)         = IGBL(108) + 1
              METHOD(IGBL(108)) = 6
            END IF
          ELSE IF (IGBL(73) .EQ. 2) THEN
            IGBL(108)         = IGBL(108) + 1
            METHOD(IGBL(108)) = 2
          ELSE IF (IGBL(73) .EQ. 3) THEN
            IGBL(108)         = IGBL(108) + 1
            METHOD(IGBL(108)) = 3
          END IF
      ELSE IF (MODE .LT. 0) THEN
        CPR(1) = ' '
        IF (IGBL(107) .LT. IGBL(108)) THEN
          IGBL(107) = IGBL(107) + 1
          IF (METHOD(IGBL(107)) .EQ. 1) THEN
            CPR(1)  = 'SHELXS86'
            CPR(52) = 'TREF'
          ELSE IF (METHOD(IGBL(107)) .EQ. 2) THEN
            CPR(1)  = 'SHELXS'
            CPR(52) = 'TREF'
          ELSE IF (METHOD(IGBL(107)) .EQ. 3) THEN
            CPR(1)  = 'SIR97'
            CPR(72) = 'DEFAULT'
          ELSE IF (METHOD(IGBL(107)) .EQ. 4) THEN
            CPR(1)  = 'SIR2004'
            CPR(72) = 'DEFAULT'
          ELSE IF (METHOD(IGBL(107)) .EQ. 5) THEN
            CPR(1)  = 'DIRDIF'
            CPR(62) = 'PATTY'
          ELSE IF (METHOD(IGBL(107)) .EQ. 6) THEN
            CPR(1)  = 'SHELXD'
          ELSE IF (METHOD(IGBL(107)) .EQ. 8) THEN
            CPR(1)  = 'SHELXT'
          ELSE IF (METHOD(IGBL(107)) .EQ. 9) THEN
            CPR(1)  = 'SIR2011'
            CPR(72) = 'DEFAULT'
          END IF
        END IF
        IF (CPR(1)(1:1) .EQ. ' ') IGBL(50) = 0
      END IF
      RETURN
      END SUBROUTINE S921
      SUBROUTINE S922 (IER)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER AUTO*4, PATT*4
      INTEGER CHANDIR
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      DIMENSION XYZ(12)
      LOGICAL EXST
      IF (IGBL(50) .GT. 0) THEN
        AUTO = 'AUTO'
      ELSE
          AUTO = '    '
      END IF
      INQUIRE (FILE = 'hklf/.patt', EXIST = EXST)
      IF (.NOT. EXST) THEN
        PATT = 'PATR'
      ELSE
        OPEN (LU61, FILE = 'hklf/.patt', STATUS = 'UNKNOWN')
        READ (LU61, 99981) ISPR(99)
        CLOSE (UNIT = LU61)
        PATT = '    '
      END IF
      CALL S909 ('tm/sg/setup')
      IF (ISPR(6) .LT. 0) THEN
        OPEN  (LU61, FILE = 's.res', STATUS = 'UNKNOWN')
        WRITE (LU61, 99997, IOSTAT = IOST) TITL(1:6)
        WRITE (LU61, 99998, IOSTAT = IOST)
     1    SPAR(80), (SPAR(100 + I), I = 1, 6)
        WRITE (LU61, 99999, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
        WRITE (LU61, 99995, IOSTAT = IOST)
     1    (ISPR(I + 120), I = 1, ISPR(110))
        WRITE (LU61, 99991, IOSTAT = IOST) ISPR(100)
        DO I = 2, ISPR(101)
          NUMS = I
          CALL SGSM (LINE, NUMS, XYZ, 0, 17, IERR)
          WRITE (LU61, 99990, IOSTAT = IOST) LINE(1:60)
        END DO
        WRITE (LU61, 99994, IOSTAT = IOST)
     1    ((TM(I, J), J = 1, 3), I = 1, 3)
        CLOSE (UNIT = LU61)
        KERR = 0
        CALL SPAWN ('rm ../pn/s.res', KERR)
        CALL SPAWN ('mv s.res ../pn', KERR)
      END IF
      OPEN  (LU61, FILE = 's.ins', STATUS = 'UNKNOWN')
      WRITE (LU61, 99997, IOSTAT = IOST) TITL(1:6)
      WRITE (LU61, 99998, IOSTAT = IOST)
     1   SPAR(80), (SPAR(100 + I), I = 1, 6)
      WRITE (LU61, 99992, IOSTAT = IOST) CPR(100)
      WRITE (LU61, 99999, IOSTAT = IOST) (SFAC(I), I = 1, ISPR(110))
      WRITE (LU61, 99995, IOSTAT = IOST)
     1   (ISPR(I + 120), I = 1, ISPR(110))
      IF (GEN135 (TM) .GT. 0.5) THEN
        WRITE (LU61, 99989, IOSTAT = IOST)
      ELSE
        WRITE (LU61, 99994, IOSTAT = IOST)
     1   ((TM(I, J), J = 1, 3), I = 1, 3)
      END IF
      WRITE (LU61, 99996, IOSTAT = IOST) 1, AUTO, PATT
      CLOSE (UNIT = LU61)
      INQUIRE (FILE = 's.bin', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('rm s.bin', KERR)
      END IF
      INQUIRE (FILE = 'hklf3.hkl', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('rm hklf3.hkl', KERR)
      END IF
      KERR = 0
      CALL SPAWN
     1     ('sh -c '''//PLAPATH(1:IGBL(80))//' s.ins > setup.lis'' ',
     2     KERR)
      INQUIRE (FILE = 's.hkp', EXIST = EXST)
      IF (EXST) THEN
        KERR = 0
        CALL SPAWN ('mv s.hkp hklf3.hkl', KERR)
      END IF
      OPEN (LU61, FILE = 'setup.lis', STATUS = 'UNKNOWN')
      IER = 0
   10 READ (LU61, 99982, END = 40) LINE(1:80)
      IF (LINE(39:46) .EQ. 'Rejected') THEN
        READ (LINE(1:5), 99988, ERR = 10) ISPR(70)
      ELSE IF (LINE(41:48) .EQ. 'Rejected') THEN
        READ (LINE(1:7), 99984, ERR = 10) ISPR(70)
      ELSE IF (LINE(7:12) .EQ. 'Unique') THEN
        READ (LINE(1:36), 99983, ERR = 10) ISPR(71), SPAR(150)
      ELSE IF (LINE(1:5) .EQ. 'IHMIN') THEN
        READ (LINE(15:24), 99988, ERR = 10) ISPR(51), ISPR(52)
      ELSE IF (LINE(1:5) .EQ. 'IKMIN') THEN
        READ (LINE(15:24), 99988, ERR = 10) ISPR(53), ISPR(54)
      ELSE IF (LINE(1:5) .EQ. 'ILMIN') THEN
        READ (LINE(15:24), 99988, ERR = 10) ISPR(55), ISPR(56)
      ELSE IF (LINE(1:5) .EQ. 'THMIN') THEN
        READ (LINE(15:24), 99987, ERR = 10) SPAR(51), SPAR(52)
      ELSE IF (LINE(1:5) .EQ. 'Aver ') THEN
        READ (LINE(19:23), 99986, ERR = 10) SPAR(15)
      ELSE IF (LINE(1:9) .EQ. 'Estimated') THEN
        READ (LINE(14:19), 99980, ERR = 10) SPAR(16)
      ELSE IF (LINE(1:5) .EQ. 'PATT ') THEN
        READ (LINE(9:11) , 99985, ERR = 10) ISPR(99)
      ELSE IF (LINE(1:6) .EQ. 'E: Unk') THEN
        IER = 1
      ELSE IF (LINE(1:9) .EQ. 'PATTERSON') THEN
        OPEN (LU62, FILE = 'patt.lis', STATUS = 'UNKNOWN')
   20   READ (LU61, 99982, END = 30) LINE(1:80)
        WRITE (LU62, 99982, IOSTAT = IOST) LINE(1:80)
        GO TO 20
   30   CLOSE (UNIT = LU62)
        GO TO 40
      END IF
      GO TO 10
   40 CLOSE (UNIT = LU61)
      IF (ISPR(70) .GT. 0) ISPR(12) = 1
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      OPEN (LU61, FILE = 'hklf/.patt', STATUS = 'UNKNOWN')
      WRITE (LU61, '(''PATT'', I3)', IOSTAT = IOST) ISPR(99)
      CLOSE (UNIT = LU61)
      CALL S915 ('Setup s.bin')
      CALL S920 (1)
      RETURN
99999 FORMAT ('SFAC ', 17(1X, A))
99998 FORMAT ('CELL ', F7.5, 6F10.4)
99997 FORMAT ('TITL ', A)
99996 FORMAT ('SETUP ', I5, 1X, 2A)
99995 FORMAT ('UNIT', 2I5, 14I4)
99994 FORMAT ('HKLF 4 1', 9F8.4)
99992 FORMAT ('SPGR ', A)
99991 FORMAT ('LATT ', I3)
99990 FORMAT ('SYMM ', A)
99989 FORMAT ('HKLF 4')
99988 FORMAT (2I5)
99987 FORMAT (2F5.1)
99986 FORMAT (2F5.2)
99985 FORMAT (I3)
99984 FORMAT (I7)
99983 FORMAT (I5, 23X, F8.0)
99982 FORMAT (A)
99981 FORMAT (4X, I3)
99980 FORMAT (F6.3)
      END SUBROUTINE S922
      SUBROUTINE S923 (C, K, N)
      CHARACTER C*(*)
      I = 0
      J = 0
      IF (K .EQ. 0) THEN
        I = 1
        J = 3
      ELSE IF (K .EQ. 2) THEN
        I = 4
        J = 6
        C(3 : 3) = '/'
      END IF
      WRITE (C(I:J), 99999, IOSTAT = IOST) N
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (I3.3)
      END SUBROUTINE S923
      SUBROUTINE S924 (MODE)
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      CHARACTER CPN*3
      LOGICAL EXST
      NR = 0
      OPEN (LU61, FILE = FNM(1:IN)//'tm/sg/.save_nr',
     1      STATUS = 'UNKNOWN')
      READ (LU61, 99998, END = 10) NR
   10 NR = NR + 1
      CLOSE (UNIT = LU61)
      CALL S923 (CPN, 0, NR)
      KERR = 0
      CALL SPAWN ('mkdir '//FNM(1:IN)//'tm/sg/'//CPN, KERR)
      CALL SPAWN (
     1'cp '//FNM(1:IN)//'tm/sg/pn/.s.dbf '//FNM(1:IN)//'tm/sg/'//CPN,
     2 KERR)
      CALL SPAWN ('touch '//FNM(1:IN)//'tm/sg/'//CPN//'/s.res', KERR)
      KERR = 0
      CALL SPAWN ('rm '//FNM(1:IN)//'tm/sg/pn', KERR)
      CALL SPAWN ('ln -s '//CPN//' '//FNM(1:IN)//'tm/sg/pn', KERR)
      CALL SPAWN ('rm '//FNM(1:IN)//'tm/sg/po', KERR)
      CALL SPAWN
     1   ('ln -s '//CPR(104)(8:10)//' '//FNM(1:IN)//'tm/sg/po', KERR)
      CPR(104)(7 : 10) = '/'//CPN
      CALL S915 ('New save-link pn = '//CPN//' Created')
      OPEN (LU61, FILE = FNM(1:IN)//'tm/sg/.save_nr',
     1      STATUS = 'UNKNOWN')
      WRITE (LU61, 99998, IOSTAT = IOST) NR
      CLOSE (UNIT = LU61)
      CALL S920 (1)
      SELECT CASE (ISPR(14))
        CASE (0)
          CALL SPAWN
     1   ('ln -s ../../../hklf/shelx.hkl '//FNM(1:IN)//'tm/sg/pn/s.hkl',
     2   KERR)
        CASE (1)
        CASE (2)
          KERR = 0
          CALL SPAWN ('ln -s '//FNM(1:IN)//'absp/absp.hkp '//
     1                 FNM(1:IN)//'tm/sg/pn/s.hkl', KERR)
        CASE (3)
          KERR = 0
          CALL SPAWN
     1     ('ln -s ../mulabs/s.hkp '//FNM(1:IN)//'tm/sg/pn/s.hkl', KERR)
        CASE (4)
        CASE (5)
          KERR = 0
          CALL SPAWN ('ln -s '//FNM(1:IN)//'abst/abst.hkp '//
     1                 FNM(1:IN)//'tm/sg/pn/s.hkl', KERR)
        CASE (6)
          KERR = 0
          CALL SPAWN
     1      ('ln -s ../delabs/delabs.hkp '//FNM(1:IN)//'tm/sg/pn/s.hkl',
     2      KERR)
        CASE (7)
          KERR = 0
          CALL SPAWN
     1    ('ln -s ../squeeze/squeeze.hkp '//FNM(1:IN)//'tm/sg/pn/s.hkl',
     2     KERR)
        CASE (8)
          INQUIRE (FILE = 'tm/sg/twinrotmat/shelxl.hkp', EXIST = EXST)
          IF (EXST) THEN
            KERR = 0
            CALL SPAWN
     1  ('ln -s ../twinrotmat/shelxl.hkp '//FNM(1:IN)//'tm/sg/pn/s.hkl',
     2    KERR)
          END IF
      END SELECT
      IGBL(38) = 1
      IF (MODE .EQ. 1) THEN
        OPEN (LU61, FILE = 'tm/sg/po/s.res', STATUS = 'UNKNOWN')
        READ (LU61, 99999, END = 20) LINE
        CLOSE (UNIT = LU61)
        IF (LINE(1:4) .EQ. 'TITL') THEN
          KERR = 0
          CALL SPAWN ('cp tm/sg/po/s.res tm/sg/pn/s.res', KERR)
          GO TO 30
        END IF
   20   KERR = 0
        CALL SPAWN ('rm -f tm/sg/pn/s.res', KERR)
        CALL SPAWN ('ln -s  /dev/null tm/sg/pn/s.res', KERR)
      END IF
   30 RETURN
99999 FORMAT (A)
99998 FORMAT (I3)
      END SUBROUTINE S924
      SUBROUTINE S925 (N)
      PARAMETER (NP17=99,NP42=250)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      IF (N .EQ. 0) THEN
      ELSE IF (N .EQ. 1) THEN
        WRITE (LU6, 99999, IOSTAT = IOST)
      ELSE IF (N .EQ. 2) THEN
        WRITE (LU6, 99998, IOSTAT = IOST) COMPD
      ELSE IF (N .EQ. 3) THEN
        WRITE (LU6, 99997, IOSTAT = IOST)
        KERR = 0
        CALL SPAWN ('ls -l | more', KERR)
      END IF
99999 FORMAT (':: Cannot do CHANGEDIR', /)
99998 FORMAT (' ?? Cannot find any SHELX or CAD4 data for: ',
     1         A, ' in known depositories', /)
99997 FORMAT (/, 3X, 'No .s.dbf or shelx.hkl present;',
     1        ' List Files in Dir:', /, 80('-'), /)
      END SUBROUTINE S925
      SUBROUTINE S926
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1  NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER LIN*132
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      DIMENSION ISFAC(16)
      IF (ISPR(6) .GT. 0) THEN
        OPEN (LU61, FILE = 's.res',   STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 'ipl.spf', STATUS = 'UNKNOWN')
   10   READ (LU61, 99997, END = 20) LINE
        IF (LINE(1:3) .EQ. 'END') THEN
          WRITE (LU62, 99999, IOSTAT = IOST)
          GO TO 20
        ELSE
          WRITE (LU62, 99997, IOSTAT = IOST) LINE
          GO TO 10
        END IF
   20   CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN (PLAPATH(1:IGBL(80))//' ipl.spf > ipl.log', KERR)
        CALL SPAWN ('rm ipl.spf', KERR)
        CALL SPAWN ('rm ipl.log', KERR)
        OPEN (LU61, FILE = 'ipl.lis', STATUS = 'UNKNOWN')
   30   READ (LU61, 99997, END = 50) LIN
        IF (LIN(34:39) .EQ. 'Mol.Wt') THEN
          LINE = 'Z'//LIN(54:132)
          CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10,
     1                 NP17)
          DO 40 I = 2, KL
            DO J = 1, ISPR(110)
              IF (JFL(I)(1:2) .EQ. SFAC(J)) THEN
                ISFAC(I - 1) = J
                GO TO 40
              END IF
            END DO
            WRITE (LU6, 99998, IOSTAT = IOST) JFL(I)(1:2)
            CALL PLA015 (0, 33)
            GO TO 60
   40     CONTINUE
        ELSE IF (LIN(18:24) .EQ. ' Weight') THEN
          LINE = 'Z'//LIN(51:129)
          CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10,
     1                 NP17)
          DO I = 1, KN
            ISPR(152 + ISFAC(I)) = NINT(FN(I))
          END DO
        ELSE IF (LIN(23:25) .EQ. 'mu(') THEN
          READ (LIN(52:59), 99996) SPAR(123)
        END IF
        GO TO 30
   50   CLOSE (UNIT = LU61)
        KERR = 0
        CALL SPAWN ('rm ipl.lis', KERR)
        CALL SPAWN ('rm ipl_p.spf', KERR)
      END IF
      CALL S920 (1)
   60 RETURN
99999 FORMAT ('CALC GEOM NOMOVE', /, 'QUIT')
99998 FORMAT ('Error - SFAC-Element ', A, ' Not in Formula')
99997 FORMAT (A)
99996 FORMAT (F8.0)
      END SUBROUTINE S926
      SUBROUTINE S927 (ISHOW)
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER TXT1*60, TXT2*60, LIJN*80
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      LOGICAL EXST
      EXST = .FALSE.
      R1   = 0.0
      R2   = 0.0
      N1   = 0
      N2   = 0
      NSPL = 0
      MODE = ISPR(6) + ISPR(7)
      ISPR(223) = 0
      SPAR(140) = 0.0
      INQUIRE (FILE = FNM(1:IN)//'tm/sg/shelxl/shelxl.lst',
     1         EXIST = EXST)
      IF (EXST .AND. MODE .GE. 0) THEN
        OPEN (LU61, FILE = FNM(1:IN)//'tm/sg/shelxl/shelxl.lst',
     1        STATUS = 'UNKNOWN')
   10   READ (LU61, '(A)', END = 30) LINE
        IF (LINE(2:11) .EQ. 'Mean shift') THEN
          TXT1 = LINE(1:60)
          READ (LINE(18:), '(F8.0, 13X, F8.0)', ERR = 10)
     1                       SPAR(131), SPAR(132)
        ELSE IF (LINE(2:5) .EQ. 'Max.') THEN
          TXT2 = LINE(1:60)
        ELSE IF (LINE(16:27) .EQ. 'before cycle') THEN
          READ (LINE, '(35X, I7)', ERR = 10) N2
          ISPR(202) = N2
        ELSE IF (LINE(11:26) .EQ. 'Reflections read') THEN
          IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0,  LINE, 80, 0.35, -1, 2, 0.0, 17.4)
          END IF
          READ (LINE, '(I8)', ERR = 10) ISPR(70)
        ELSE IF (LINE(11:28) .EQ. 'Unique reflections') THEN
          IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0,  LINE, 80, 0.35, -1, 2, 0.0, 16.8)
          END IF
          READ (LINE, '(I8)', ERR = 10) ISPR(71)
        ELSE IF (LINE(1:9) .EQ. ' R(int) =') THEN
          IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0,  LINE, 80, 0.35, -1, 2, 0.0, 16.2)
          END IF
          IF (SPAR(126) .EQ. 0.0) THEN
            READ (LINE, '(9X, F6.0)', ERR = 10) SPAR(150)
            SPAR(151) = SPAR(150)
          ELSE
            READ (LINE, '(9X, F6.0)', ERR = 10) SPAR(151)
            IF (ISPR(14) .EQ. 2) SPAR(152) = SPAR(151)
          END IF
        ELSE IF (LINE(5:9) .EQ. ' =< h') THEN
          READ (LINE, '(1X, 3(I3, 8X, I3, 5X), 13X, F8.2)')
     1     (ISPR(56 + I), I = 1, 6), SPAR(54)
           SPAR(54) = SPAR(54) / 2.0
           SPAR(53) = SPAR(51)
          IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0,  LINE, 80, 0.35, -1, 2, 0.0, 15.6)
          END IF
        ELSE IF (LINE(53:59) .EQ. 'for all' .OR.
     1           LINE(54:60) .EQ. 'for all') THEN
          READ (LINE, '(5X, F8.0, 4X, I7)', ERR = 10) R1, N1
          SPAR(202) = R1
          ISPR(201) = N1
          ISPR(72)  = N1
          IF (ISHOW .NE. 0) THEN
            IF (R1 .GE. 0.07) CALL GGIP (0.0, 2.0, 0.0, 0)
            CALL GGIP09 (0.0, LINE, 80, 0.35, -1, 2, 0.0, 14.6)
          END IF
        ELSE IF (LINE(18:27) .EQ. 'GooF = S =') THEN
          READ (LINE, '(6X, F8.0, 13X, F8.0)', ERR = 10) R2, SPAR(133)
          SPAR(203) = R2
          IF (ISHOW .NE. 0) THEN
            IF (R2 .GE. 0.15) CALL GGIP (0.0, 2.0, 0.0, 0)
            CALL GGIP09 (0.0, LINE, 80, 0.35, -1, 2, 0.0, 14.0)
            CALL GGIP09 (0.0, TXT2, 60, 0.35, 1, 2, 0.0, 12.8)
            READ (TXT1(39:46), 99998, ERR = 10) YUNK
            IF (ABS(YUNK) .GE. 0.05) CALL GGIP (0.0, 2.0, 0.0, 0)
            CALL GGIP09 (0.0, TXT1, 60, 0.35, -1, 2, 0.0, 13.4)
          END IF
        ELSE IF (Line(2:7) .EQ. 'Weight') THEN
          IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0, LINE, 65, 0.35, -1, 2, 0.0, 12.2)
          END IF
        ELSE IF (Line(2:12) .EQ. 'Recommended') THEN
          IF (ISHOW .NE. 0) THEN
            IF (ISPR(215) .GT. 0) CALL GGIP (0.0, 2.0, 0.0, 0)
            CALL GGIP09 (0.0, LINE, 80, 0.35, -1, 2, 0.0, 11.6)
          END IF
        ELSE IF (LINE(2:6) .EQ. 'Flack') THEN
          IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0, LINE, 80, 0.35, -1, 2, 0.0, 11.0)
          END IF
          READ (LINE, '(20X, F9.0, 11X, F8.0)', ERR = 10)
     1                  SPAR(225), SPAR(226)
        ELSE IF (LINE(23:32) .EQ. 'parameters') THEN
          READ (LINE, '(34X, I6)', ERR = 10) ISPR(203)
        ELSE IF (LINE(44:47) .EQ. 'BASF') THEN
          IF (ISPR(310) .EQ. 0) THEN
            READ (LINE, '(6X, 2F12.0)', ERR = 10) SPAR(225), SPAR(226)
          ELSE
            READ (LINE, '(6X, 2F12.0)', ERR = 10) SPAR(229), SPAR(230)
          END IF
        ELSE IF (LINE(44:47) .EQ. 'EXTI') THEN
          READ (LINE, '(6X, 2F12.0)', ERR = 10) SPAR(227), SPAR(228)
          IF (SPAR(227) .LT. 3.0 * SPAR(228) .OR. IGBL(96) .EQ. 0) THEN
            SPAR(227) = -1000.0
            SPAR(228) =     0.0
          END IF
        ELSE IF (LINE(6:10) .EQ. 'h   k') THEN
          IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0, LINE, 80, 0.35, 1, 2, 0.0, 10.0)
          END IF
        ELSE IF (LINE(51:51) .EQ. '.' .AND. LINE(54:54) .EQ. ' ') THEN
          READ (LINE(48:53), '(F6.2)', ERR = 10) VAL
          IF (VAL .GT. 8.0) THEN
            ISPR(223) = ISPR(223) + 1
            IF (IGBL(51) .GT. 0) THEN
              IF (ISPR(223) .EQ. 1) THEN
                OPEN (LU63, FILE = 'omit.hkl', STATUS = 'UNKNOWN')
              END IF
              WRITE (LU63, 99997, IOSTAT = IOST) LINE(1:14)
            END IF
            IF (ISPR(223) .LT. 6) THEN
              IF (ISHOW .NE. 0) THEN
                CALL GGIP09 (0.0, LINE, 80, 0.35, 2, 2, 0.0,
     1               (6 - ISPR(223)) * 0.6 + 6.2)
              END IF
            END IF
            IF (VAL .GT. SPAR(140)) THEN
              SPAR(140) = VAL
              READ (LINE, '(I6, 2I4, 2F14.2)', ERR = 10)
     1             (ISPR(I), I = 220, 222),
     1              SPAR(141), SPAR(142)
            END IF
          END IF
        ELSE IF (LINE(2:13) .EQ. 'Highest peak') THEN
          IF (ISHOW .NE. 0) THEN
            READ (LINE(14:21), 99998, ERR = 10) YUNK
            NK0 = 1
            IF (YUNK .GE. 1.0) NK0 = 2
            CALL GGIP09 (0.0, LINE, 80, 0.35, NK0, 2, 0.0, 6.0)
          END IF
          READ (LINE, '(13X, F8.2)', ERR = 10) SPAR(130)
        ELSE IF (LINE(2:13) .EQ. 'Deepest hole') THEN
          IF (ISHOW .NE. 0) THEN
            READ (LINE(14:21), 99998, ERR = 10) YUNK
            NK0 = 1
            IF (YUNK .LT. -1.0) NK0 = 2
            CALL GGIP09 (0.0, LINE, 80, 0.35, NK0, 2, 0.0, 5.4)
          END IF
          READ (LINE, '(13X, F8.2)', ERR = 10) SPAR(129)
        ELSE IF (LINE(5:14) .EQ. 'Extinction') THEN
          IF (IGBL(96) .EQ. 0) THEN
            IF (IGBL(50) .EQ. 0) THEN
              WRITE (BCD, 99999, IOSTAT = IOST)
     1       'Implement Proposed Extinction Refinement (y/n[y]'//CHAR(0)
              CALL GGIP (-999.0, 5.0 + FLOAT(IGBL(68) * IGBL(82)), 80.0,
     1                 110)
              CALL PLA013 (0, 1)
              IF (IGGT(1:1) .NE. 'Y' .AND. IGGT(1:1) .NE. '!') GO TO 20
            END IF
            IGBL(96) = 1
          END IF
          IF (SPAR(227) .LT. 0.0) SPAR(227) = 0.0
   20     IF (ISHOW .NE. 0) THEN
            CALL GGIP09 (0.0, LINE, 80, 0.35, 2, 2, 0.0, 2.0)
          END IF
        ELSE IF (LINE(38:50) .EQ. ' may be split') THEN
          IF (ISHOW .NE. 0) THEN
            LIJN(1:14) = LINE (38:50)//':'
            IF (NSPL .LT. 13) THEN
            NSPL = NSPL + 1
              LIJN (10 + NSPL * 5:) = LINE(30:34)
              CALL GGIP09 (0.0, LIJN, 80, 0.35, 2, 2, 0.0, 2.6)
            END IF
          END IF
        END IF
        GO TO 10
   30   CLOSE (UNIT = LU61)
        IF (IGBL(51) .GT. 0) CLOSE (UNIT = LU63)
        CALL S920 (1)
      END IF
      INQUIRE (FILE = FNM(1:IN)//'tm/sg/shelxl/shelxl.cif',
     1         EXIST = EXST)
      IF (EXST .AND. MODE .GT. 0) THEN
        OPEN (LU61, FILE = FNM(1:IN)//'tm/sg/shelxl/shelxl.cif',
     1        STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 's.cif', STATUS = 'UNKNOWN')
        DO
          READ  (LU61, 99999, IOSTAT = IOST) LINE
          IF (IOST .NE. 0) EXIT
          IF (LINE(1:11) .EQ. 'data_shelxl') LINE(1:15) = 'data_'//COMPD
          WRITE (LU62, 99999, IOSTAT = IOST) LINE
        END DO
        CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN (
     1       'mv s.cif '//FNM(1:IN)//'tm/sg/shelxl/shelxl.cif', KERR)
      END IF
      ISPR(300) = 0
      ISPR(301) = 0
      ISPR(302) = 0
      ISPR(303) = 0
      IF (IGBL(51) * ISPR(223) .GT. 0)
     1    CLOSE (UNIT = LU63, STATUS = 'DELETE')
      INQUIRE (FILE = FNM(1:IN)//'tm/sg/shelxl/shelxl.res',
     1         EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU61, FILE = FNM(1:IN)//'tm/sg/shelxl/shelxl.res',
     1        STATUS = 'UNKNOWN')
        DO
          READ (LU61, 99999, END = 50) LINE
          IF (LINE(1:1) .EQ. 'Q') THEN
            READ (LINE(49:56), '(F8.0)') DENS
            IF (DENS .GT. 0.5) ISPR(300) = ISPR(300) + 1
            IF (DENS .GT. 1.0) ISPR(301) = ISPR(301) + 1
            IF (DENS .GT. 2.0) ISPR(302) = ISPR(302) + 1
            IF (DENS .GT. 5.0) ISPR(303) = ISPR(303) + 1
          END IF
        END DO
   50   CLOSE (UNIT = LU61)
      END IF
      RETURN
99999 FORMAT (A)
99998 FORMAT (F8.0)
99997 FORMAT ('OMIT ', A)
      END  SUBROUTINE S927
      SUBROUTINE S928
      PARAMETER (NP3=250,NP12=700,NP13=550,NP17=99,NP38=150,
     1 NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      CHARACTER CPN*3
      LOGICAL EXST
      EXST = .FALSE.
      INQUIRE (FILE = FNM(1:IN)//'tm/sg/.save_nr',EXIST = EXST)
      IF (EXST) THEN
        OPEN (LU61, FILE = FNM(1:IN)//'tm/sg/.save_nr',
     1        STATUS = 'UNKNOWN')
        READ (LU61, 99999) NR
        CLOSE (UNIT = LU61)
        IF (KN .GT. 0) THEN
          N = NINT(FN(1))
        ELSE
          READ (CPR(104)(8:10), 99998) N
          IF (KL .EQ. 1 .OR.
     1        KL .GT. 1 .AND. JFL(2)(1:4) .EQ. 'BACK') THEN
            N = N - 1
          ELSE
            N = N + 1
          END IF
        END IF
        CALL S923 (CPN, 0, N)
        IF (N .GE. 0 .AND. N .LE. NR) THEN
          CALL DLNK (CPN, 'tm/sg/pn')
          CPR(104)(8 : 10) = CPN
          CALL S920 (-1)
          CALL S915 ('Relink to : '//CPR(104))
        END IF
      END IF
      IGBL(38) = 1
      RETURN
99999 FORMAT (I4)
99998 FORMAT (I3)
      END SUBROUTINE S928
      SUBROUTINE S929 (MODE)
      PARAMETER (NP1=500,NP2=350,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      LOGICAL EXST
      EXST = .FALSE.
      IF (MODE .EQ. -1) THEN
        INQUIRE (FILE = FNM(1:IN)//'.faces',EXIST = EXST)
        I = 0
        IF (EXST) THEN
          OPEN (LU65, FILE = FNM(1:IN)//'.faces', STATUS = 'UNKNOWN')
   10     CALL GEN072 (LINE, JFL, FN, KL, KN, LU65, LU6, 1, 1, 80, 10,
     1                 NP17)
          IF (JFL(1)(1:3) .EQ. 'EOF') THEN
            GO TO 20
          ELSE IF (JFL(1)(1:2) .EQ. 'MU') THEN
            SPAR(123) = FN(1)
          ELSE IF (JFL(1)(1:4) .EQ. 'FACE') THEN
            I = I + 1
            DO J = 1, 4
              FACE(I, J) = FN(J)
            END DO
          END IF
          GO TO 10
   20     CLOSE (UNIT = LU65)
        END IF
        ISPR(350) = I
      ELSE IF (MODE .EQ. 1) THEN
        OPEN  (LU65, FILE = FNM(1:IN)//'.faces', STATUS = 'UNKNOWN')
        WRITE (LU65, '(''MU'', F10.2)', IOSTAT = IOST) SPAR(123)
        DO I = 1, ISPR(350)
          WRITE (LU65, '(''FACE'', 3F5.0, F8.5)', IOSTAT = IOST)
     1      (FACE(I, J), J = 1, 4)
        END DO
        CLOSE (UNIT = LU65)
      END IF
      RETURN
      END SUBROUTINE S929
      SUBROUTINE S930 (MODE, LIN, ISNR)
      PARAMETER (NP1=500,NP2=350,NP3=250)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /C930/ NSFC(16)
      CHARACTER LIN*4
      IF (MODE .GT. 0) THEN
        DO I = 1, ISPR(110)
          CALL GEN105 (3, LIN(2:2), J)
          IF (J .GE. 0) LIN(2:2) = ' '
          IF (LIN(1:2) .EQ. SFAC(I)) THEN
            IF (LIN(2:2) .EQ. ' ') THEN
              IF (NSFC(I) .EQ. 0) NSFC(I) = 500
              JB = 2
            ELSE
              IF (NSFC(I) .EQ. 0) NSFC(I) = 50
              JB = 3
            END IF
            NSFC(I) = NSFC(I) + 1
            ISNR    = I
            IF (JB .EQ. 3) THEN
              WRITE (LIN(JB:4), 99998, IOSTAT = IOST) NSFC(I)
            ELSE
              WRITE (LIN(JB:4), 99999, IOSTAT = IOST) NSFC(I)
            END IF
            IF (IOST .NE. 0) RETURN
            RETURN
          END IF
        END DO
      ELSE
        CALL GEN097 (NSFC, 1, 16, 0)
      END IF
      RETURN
99999 FORMAT (I3)
99998 FORMAT (I2)
      END SUBROUTINE S930
      SUBROUTINE S931
      PARAMETER (NP1=500,NP2=350,NP3=250)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      DIMENSION T(3, 3), AA(3, 3), BB(3, 3)
      CHARACTER KS*1
      CALL GEN026 (1, AA, SPAR(81))
      CALL GEN003 (AA, BB, DET, 0)
      SPAR(95)  = BB(1, 1)
      SPAR(96)  = BB(2, 2)
      SPAR(97)  = BB(3, 3)
      SPAR(98)  = BB(2, 3)
      SPAR(99)  = BB(1, 3)
      SPAR(100) = BB(1, 2)
      CALL GEN001 (1, TM, AA, BB)
      CALL GEN026 (-1, BB, SPAR(101))
      CALL GEN003 (BB, AA, DET, 0)
      SPAR(107) = SQRT(DET)
      CALL GEN067 (TM, SPAR(81), SPAR(101), SPAR(88), SPAR(108))
      CALL GEN068 (SPAR(101), SPAR(107), SPAR(108), SPAR(114))
      CALL GEN003 (TM, T, DET, 0)
      CALL GEN004 (OM, T, OX)
      LKLS = ISPR(105)
      KS   = 'a'
      IF (LKLS .EQ. 2) THEN
        KS = 'm'
      ELSE IF (LKLS .EQ. 3) THEN
        KS = 'o'
      ELSE IF (LKLS .EQ. 4) THEN
        KS = 't'
      ELSE IF (LKLS .EQ. 5 .AND. CPR(103)(1:1) .EQ. 'r') THEN
        KS = 'r'
      ELSE IF (LKLS .EQ. 6 .OR.
     1    (LKLS .EQ. 5 .AND. CPR(103)(1:1) .EQ. 'h')) THEN
        KS = 'h'
      ELSE IF (LKLS .EQ. 7) THEN
        KS = 'c'
      END IF
      CALL GEN066 (2, SPAR(101), SPAR(108), KS)
      RETURN
      END SUBROUTINE S931
      SUBROUTINE S932 (MODE)
      PARAMETER (NP1=500,NP2=350)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      IF (MODE .EQ. 1) THEN
        KERR = 0
        CALL SPAWN ('mkdir 00', KERR)
        CALL SPAWN ('ln -s 00 tm', KERR)
        CALL SPAWN ('ln -s tm/s.res s.res', KERR)
        CALL SPAWN ('ln -s tm/s.hkl s.hkl', KERR)
        CALL SPAWN ('ln -s tm/.s.dbf .s.dbf', KERR)
      END IF
      IF (MODE .LE. 2) THEN
        KERR = 0
        CALL SPAWN ('mkdir tm/000', KERR)
        CALL SPAWN ('ln -s 000 tm/sg', KERR)
        CALL SPAWN ('ln -s sg/s.res tm/s.res', KERR)
        CALL SPAWN ('ln -s sg/s.hkl tm/s.hkl', KERR)
        CALL SPAWN ('ln -s sg/.s.dbf tm/.s.dbf', KERR)
      END IF
      KERR = 0
      CALL SPAWN ('mkdir tm/sg/000', KERR)
      CALL SPAWN ('ln -s 000 tm/sg/po', KERR)
      CALL SPAWN ('ln -s 000 tm/sg/pn', KERR)
      CALL SPAWN ('ln -s pn/.s.dbf tm/sg/.s.dbf', KERR)
      CALL SPAWN ('ln -s pn/s.res  tm/sg/s.res', KERR)
      CALL SPAWN ('ln -s pn/s.hkl  tm/sg/s.hkl', KERR)
      CALL SPAWN ('mkdir tm/sg/setup', KERR)
      IF (ISPR(14) .EQ. 2) THEN
        KERR = 0
        CALL SPAWN ('ln -s ../../../absp/absp.hkp  tm/sg/pn/s.hkl',
     1    KERR)
      ELSE
        KERR = 0
        CALL SPAWN ('ln -s ../../../hklf/shelx.hkl tm/sg/pn/s.hkl',
     1    KERR)
      END IF
      KERR = 0
      CALL SPAWN ('ln -s ../pn/s.hkl tm/sg/setup/s.hkl', KERR)
      CALL SPAWN ('ln -s  /dev/null tm/sg/pn/s.res', KERR)
      RETURN
      END SUBROUTINE S932
      SUBROUTINE S934
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      INTEGER CHANDIR
      CHARACTER LIJN*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      CALL GGIP (HORS, VERT, 0.0, 1)
   10 LIJN = 'PRUNE S-DIRECTORY STRUCTURE'
      CALL GGIP09 (0.0, LIJN, 71, 1.0, 5 + IGBL(68), 5, 1.5,
     1             VERT - 2.5)
      CALL GEN038 (LIJN, 1, 80)
      LIJN =  'Directory = '//FNM(1:IU + 3)//COMPD(1:IC)
      CALL GGIP09 (0.0, LIJN, 65, 0.5, 3, 2, 4.0, 7.0)
      IF (CHANDIR (FNM(1:IU+2)) .NE. 0) GO TO 20
      SBCD = 'Remove '//COMPD(1:IC)//' (y/n[n])'//CHAR(0)
      CALL PLA013 (0, 1)
      IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 10
      IF (IGGT(1:4) .EQ. 'EXIT') GO TO 20
      LINE = IGGT
      CALL GEN038 (IGGT, 1, 80)
      IF (LINE(1:1) .EQ. 'Y') THEN
        KERR = 0
        CALL SPAWN ('rm -r '//COMPD(1:IC), KERR)
        WRITE (LU6, '(''Current Directory '', A, '' Removed'')',
     1    IOSTAT = IOST) FNM(1:IU+3)//COMPD(1:IC)
        IF (CHANDIR (WORKDIR) .NE. 0) CALL GEN127 (' ')
      ELSE
        LINE = '   '
        IF (CHANDIR (FNM(1:IU+3)//COMPD(1:IC)) .NE. 0)
     1    CALL GEN127 (' ')
        IGBL(6) = 17
        GO TO 20
      END IF
      CALL GEN127 (' ')
   20 RETURN
      END SUBROUTINE S934
      SUBROUTINE S935 (MODE)
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP42=250,
     1 NLS=22)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER  LIJN*80, CB(NLS)*50
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      DIMENSION NB(NLS), MB(NLS), LB(NLS)
      LOGICAL EXST
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DATA NB /32, 30, 28, 28, 31, 40, 40, 38, 32, 36, 39, 35, 38, 38,
     1         37, 38, 34, 34, 34, 40, 36, 20/
      DATA (CB(I), I = 1, 10) /
     1 '                                ',
     2 '                              ',
     3 '   - ABSPSI    absp/absp.lis',
     4 '   - LATT      latt/latt.lis',
     5 '   - SPGR      tm/spgr/spgr.lis',
     6 '   - SHELXS86  tm/sg/shelxs86/shelxs.lis',
     7 '   - SHELXS97  tm/sg/shelxs97/shelxs.lst',
     8 '   - SHELXD97  tm/sg/shelxd/shelxd.lst',
     9 '   - SIR97     tm/sg/sir/sir.out',
     * '   - SIR2004   tm/sg/sir2004/sir.out'/
      DATA (CB(I), I = 11, 20) /
     1 '   - DIRDIF08  tm/sg/dirdif08/lis1',
     2 '   -                              ',
     3 '   -                                  ',
     4 '   - SHELXL97  tm/sg/shelxl/shelxl.lst',
     5 '   - PLATON    tm/sg/platon/calc.lis',
     6 '   - ADDSYM    tm/sg/addsym/addsym.lis',
     7 '   - SOLV      tm/sg/solv/solv.lis',
     8 '   - CALC      tm/sg/calc/calc.lis',
     9 '   - ASYM      tm/sg/asym/asym.lis',
     * '   - SQUEEZE   tm/sg/squeeze/squeeze.lis'/
      DATA (CB(I), I = 21, 22) /
     1 '   - VALID     tm/sg/valid/valid.chk',
     2 '   - LOG       s.log'/
      CB(9)(29:) = COMPD(1:IC)//'.lis2'
      NB(9)      = 33 + IC
      KM         = 0
      IGBL(28)   = 1
      DO I = 1, NLS
        INQUIRE (FILE = CB(I)(16:NB(I)), EXIST = EXST)
        IF (EXST) THEN
          MB(I)  = NB(I)
          KM     = KM + 1
          LB(KM) = I
        ELSE
          MB(I)  = 15
        END IF
      END DO
      BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      CALL GGIP (HORS, VERT, 0.0, 1)
   10 IF (MODE .LT. 0) THEN
        LIJN = 'Laser Listing Files'
      ELSE
        LIJN = 'Browse Listing Files'
      END IF
      CALL GGIP09 (0.0, LIJN, 71, 1.0, 5 + IGBL(68), 3, 1.5,
     1             VERT - 1.5)
      DO K = 1, KM
        J = LB(K)
        WRITE (CB(J)(1:2), 99999, IOSTAT = IOST) K
        CALL GGIP09 (0.0, CB(J), MB(J), 0.4, 1, 2, 1.5,
     1       VERT - 2.0 - K)
      END DO
      SBCD = 'Enter #[0]'//CHAR(0)
      CALL PLA013 (0, 1)
      IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 10
      IF (IGGT(1:4) .EQ. 'EXIT') GO TO 20
      LINE = IGGT
      CALL GEN038 (IGGT, 1, 80)
      CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10, NP17)
      IF (KL .GT. 0) THEN
        CALL PLA280 (LINE)
        IGBL(42) = 0
        IGBL(43) = 0
        GO TO 20
      END IF
      N = NINT(FN(1))
      IF (N .GT. 0 .AND. N .LE. KM) THEN
        N = LB(N)
        IF (MB(N) .GT. 15) THEN
          IF (IABS(MODE) .EQ. 1) THEN
            OPEN (LU64, FILE = CB(N)(16:NB(N)), STATUS = 'UNKNOWN')
            OPEN (LU65, FILE = 'lps.lps',STATUS = 'UNKNOWN')
            CALL GEN089 (LU64, LU65, 100, IGBL(102))
            CLOSE (UNIT = LU64)
            CLOSE (UNIT = LU65)
            IF (MODE .GT. 0) THEN
              KERR = 0
              CALL SPAWN (PSVIEWER//'lps.lps', KERR)
            ELSE
              KERR = 0
              CALL SPAWN (PSLASER//'lps.lps', KERR)
            END IF
            KERR = 0
            CALL SPAWN ('rm lps.lps', KERR)
          ELSE
            KERR = 0
            CALL SPAWN (EDITOR//' '//CB(N)(16:NB(N)), KERR)
          END IF
        END IF
        GO TO 10
      ELSE
        LINE    = '   '
        IGBL(6) = 17
        GO TO 20
      END IF
   20 IGBL(28) = 0
      RETURN
99999 FORMAT (I2)
      END SUBROUTINE S935
      SUBROUTINE S936
      PARAMETER (NP12=700,NP13=550,NP17=99,NP38=150,NP39=30,NP42=250,
     1 NLS=6)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      CHARACTER LIJN*80, CB(NLS)*50
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      DIMENSION NB(NLS), MB(NLS), LB(NLS)
      LOGICAL EXST
      COMMON /XWDW/ LRET, IWIN, HORS, VERT, HRT, VRT, VRTS, XSH0, YSH0
      DATA NB /31, 27, 37, 32, 37, 31/
      DATA CB /
     1 '                               ',
     2 '   - ABSPSI    absp/absp.ps',
     2 '   -                                 ',
     3 '   - PLUTON    tm/sg/pluton/s.ps',
     4 '   - PLATON    tm/sg/platon/platon.ps',
     4 '   - ADP       tm/sg/adp/adp.ps'/
      KM       = 0
      IGBL(28) = 1
      DO I = 1, NLS
        INQUIRE (FILE = CB(I)(16:NB(I)), EXIST = EXST)
        IF (EXST) THEN
          MB(I)  = NB(I)
          KM     = KM + 1
          LB(KM) = I
        ELSE
          MB(I)  = 15
        END IF
      END DO
      BCD(1:16) = 'S.Y.S.T.E.M - S'//CHAR(0)
      CALL GGIP (HORS, VERT, 0.0, 1)
   10 LIJN = 'Browse PostScript Plots'
      CALL GGIP09 (0.0, LIJN, 71, 1.0, 5 + IGBL(68), 3, 1.5,
     1             VERT - 1.5)
      DO K = 1, KM
        J = LB(K)
        WRITE (CB(J)(1:2), 99999, IOSTAT = IOST) K
        CALL GGIP09 (0.0, CB(J), MB(J), 0.4, 1, 2, 1.5,
     1       VERT - 2.0 - K)
      END DO
      SBCD = 'Enter #[0]'//CHAR(0)
      CALL PLA013 (0, 1)
      IF (LRET .EQ. 2 .OR. IGGT(1:4) .EQ. 'PLOT') GO TO 10
      IF (IGGT(1:4) .EQ. 'EXIT') GO TO 20
      LINE = IGGT
      CALL GEN038 (IGGT, 1, 80)
      CALL GEN072 (LINE, JFL, FN, KL, KN, 0, LU6, 1, 1, 80, 10, NP17)
      IF (KL .GT. 0) THEN
        CALL PLA280 (LINE)
        IGBL(42) = 0
        IGBL(43) = 0
        GO TO 20
      END IF
      N = NINT(FN(1))
      IF (N .GT. 0) THEN
        N = LB(N)
        IF (MB(N) .GT. 15) THEN
          KERR = 0
          CALL SPAWN (PSVIEWER//CB(N)(16:NB(N)), KERR)
        END IF
        GO TO 10
      ELSE
        LINE    = '   '
        IGBL(6) = 17
        GO TO 20
      END IF
   20 IGBL(28) = 0
      RETURN
99999 FORMAT (I2)
      END SUBROUTINE S936
      SUBROUTINE S937
      PARAMETER (NP1=500,NP2=350,NP3=250,NP12=700,NP13=550,NP17=99,
     1 NP38=150,NP39=30,NP42=250)
      COMMON /P/ IPR(NP12), PAR(NP13), FN(NP17), RGBL(NP39), IGBL(NP38)
      COMMON /DBCOM/ SPAR(NP1), ISPR(NP2), TM(3, 3), OM(3, 3), OX(3, 3)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /FILES/ IOST, KNMFIL, KXT, KNM16,
     1 LU1,  LU2,  LU3,  LU4,  LU5,  LU6,  LU7,  LU8,  LU9,  LU10, LU11,
     2 LU12, LU13, LU14, LU15, LU16, LU17, LU18, LU19, LU20, LU21, LU22,
     3 LU23, LU24, LU25, LU26, LU27, LU60, LU61, LU62, LU63, LU64, LU65,
     4 LU98
      COMMON /CBCOM/ TITL, SFAC, CPR, VALIDATION
      CHARACTER TITL*36, SFAC(16)*2, CPR(NP3)*10, VALIDATION*45
      COMMON /PATHS/ PLAPATH, SHLPATH, SHTPATH, BROWSER, CGETENV,
     1 HTTPSERVER, CURLPATH
      CHARACTER PLAPATH*255, SHLPATH*80, SHTPATH*80, BROWSER*255,
     1 CGETENV*255, CURLPATH*40, HTTPSERVER*40
      INTEGER CHANDIR
      CALL S909 ('tm/sg/renum')
      KERR = 0
      CALL SPAWN ('cp ../s.res renum.ins', KERR)
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -R renum.ins > renum.log',
     1  KERR)
      CALL SPAWN ('cp renum.res sort.ins', KERR)
      CALL SPAWN (PLAPATH(1:IGBL(80))//' -g sort.ins > sort.log',
     1  KERR)
      ISPR(92) = 1
      CALL S924 (0)
      IF (CPR(206)(1:4) .EQ. 'HFIX') THEN
        KERR = 0
        CALL SPAWN ('cp sort.res ../s.res', KERR)
      ELSE
        OPEN (LU61, FILE = 'sort.res', STATUS = 'UNKNOWN')
        OPEN (LU62, FILE = 's.res',    STATUS = 'UNKNOWN')
        DO
          READ (LU61, 99999, IOSTAT = IOST) LINE
          IF (IOST .NE. 0) EXIT
          IF (LINE(1:4) .NE. 'AFIX') THEN
            WRITE (LU62, 99999, IOSTAT = IOST) LINE
          END IF
        END DO
        CLOSE (UNIT = LU61)
        CLOSE (UNIT = LU62)
        KERR = 0
        CALL SPAWN ('cp s.res ../s.res', KERR)
      END IF
      CALL S920 (1)
      IF (CHANDIR (FNM(1:IN-1)) .NE. 0) CALL S925 (1)
      CALL S915 ('Run PLATON/RENUM')
      RETURN
99999 FORMAT (A)
      END SUBROUTINE S937
      LOGICAL FUNCTION DINQ (FNM)
      COMMON /DINQUIRE/ MDNQ
      CHARACTER LINE*255, FNM*(*), ICH*1
      LOGICAL EXST
      LINE = FNM
      DINQ = .FALSE.
      NB   = 1
      NE   = 255
      CALL GEN039 (1, LINE, 1, 255, NB, NE)
      DO
        IF (MDNQ .EQ. 0) THEN
          INQUIRE (FILE = LINE(1:NE), EXIST = DINQ)
          RETURN
        ELSE IF (MDNQ .EQ. 1) THEN
          KER = 0
          CALL SPAWN ('ls -ld '//LINE(1:NE)//' > .exist 2> .error', KER)
          IF (KER .NE. 0) THEN
            OPEN (80, FILE = '.error', STATUS = 'UNKNOWN')
            READ (80, 99999, IOSTAT = IOST) LINE
            IF (IOST .EQ. 0) THEN
              IF (LINE(1:3) .NE. 'ls:')
     1          WRITE (*, 99999, IOSTAT = IOST) LINE(1:80)
            END IF
            CLOSE (UNIT = 80)
          END IF
          OPEN (80, FILE = '.exist', STATUS = 'UNKNOWN')
          READ (80, 99999, IOSTAT = IOST) ICH
          IF (IOST .NE. 0) RETURN
          CLOSE (UNIT = 80, STATUS = 'DELETE')
          IF (ICH .EQ. 'd') DINQ = .TRUE.
          KER = 0
          CALL SPAWN ('rm -f .error', KER)
          RETURN
        ELSE
          INQUIRE (FILE = '/bin', EXIST = EXST)
          IF (EXST) THEN
            MDNQ = 0
          ELSE
            MDNQ = 1
          END IF
        END IF
      END DO
99999 FORMAT (A)
      END FUNCTION DINQ
      SUBROUTINE DLNK (A, B)
      CHARACTER A*(*), B*(*), P*80, Q*80, LINE*10
      COMMON /DLINK/ MLNK
      P = A//' '//B
      Q = B
   10 IF (MLNK .EQ. 0) THEN
        KERR = 0
        CALL SPAWN ('rm -f '//Q, KERR)
        CALL SPAWN ('ln -s '//P, KERR)
      ELSE IF (MLNK .EQ. 1) THEN
        KERR = 0
        CALL SPAWN ('/usr/sbin/unlink '//Q, KERR)
        CALL SPAWN ('ln -s '//P, KERR)
      ELSE
        CALL GETENV ('OSTYPE', LINE)
        IF (LINE(1:4) .EQ. 'osf1') THEN
          MLNK = 1
        ELSE
          MLNK = 0
        END IF
        GO TO 10
      END IF
      RETURN
      END SUBROUTINE DLNK
c S927 - READ/UPDATE FROM SHELXL.LST   MODIFY DATA-name in CIF       *
      BLOCK DATA SDATA
      PARAMETER (NP17=99,NP42=250)
      COMMON /DCOM/ KL, KN, IU, IN, IC, ID, IW, NSPGR,
     1 ISTATB(9), JARGB, JARG, RBB(3, 3), FACE(100, 4)
      COMMON /CCOM/ LINE, JFL, BDAT, FNM, FILE1, FILE3, SSTAT,
     1 SSTATA, SSTATB, SFC, COMPD, TSPGR, USRPATH,
     2 SHSPATH, SHDPATH, SIR04PATH, HELPATH, SIR97PATH,
     3 DIRPATH, CRUPATH, WORKDIR, PROBLEM, PSVIEWER, PSLASER,
     4 SIR11PATH, DATAORG, EDITOR, LNKS
      CHARACTER LINE*80, JFL(NP17)*10, BDAT*58, FNM*254, FILE1*40,
     1 FILE3*50, TSPGR(NP42)*50, PSVIEWER*80,DATAORG*80, SSTAT(6)*8,
     2 SSTATA(4)*10, SSTATB(9)*10, PSLASER*40, LNKS(2)*200, PROBLEM*80,
     3 WORKDIR*254, SFC(16)*2, COMPD*10,
     4 USRPATH*254, SHSPATH*40, SHDPATH*40,
     5 SIR04PATH*40, EDITOR*80, HELPATH*40, SIR97PATH*40, SIR11PATH*40,
     6 DIRPATH*40, CRUPATH*40
      COMMON /TWINMAT/ ITWN(9, 4)
      DATA ITWN /
     1           -1, 0, 0, 0, -1, 0,  0, 0, -1,
     2           -1, 0, 0, 0, -1, 0,  0, 0,  1,
     3            1, 0, 0, 0, -1, 0, -2, 0, -1,
     4            0, 1, 0, 1,  0, 0,  0, 0, -1/
      DATA SSTAT  /'Create  ', 'Data_Red', 'Setup   ',
     1             'PhaseDet', 'Refine  ', 'Finish  '/
      DATA SSTATA /'Isotropic ', 'Aniso     ', 'Hatoms    ',
     1             'Weight_Ref'/
      DATA SSTATB /'shelxs86  ', 'shelxs97  ', 'sir97     ',
     1             'sir2004   ', 'dirdif08  ', 'shelxd    ',
     2             '          ', 'shelxt    ', 'sir2011   '/
      DATA ISTATB /8, 8, 5, 7, 8, 6, 0, 6, 7/
      DATA COMPD /'          '/
      COMMON /DLINK/ MLNK
      DATA MLNK /-1/
      COMMON /DINQUIRE/ MDNQ
      DATA MDNQ /-1/
      END
      SUBROUTINE SGSM (LIN, NRSYM, X, IOUT, ISWITS, IERROR)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
C **********************************************************************
C *                   (C) 1980 - 2013, A.L.Spek                        *
C **********************************************************************
C *                            A.L.SPEK,                               *
C *             BIJVOET CENTRE FOR BIOMOLECULAR RESEARCH,              *
C *         LABORATORIUM VOOR KRISTAL- EN  STRUCTUURCHEMIE,            *
C *                      UNIVERSITEIT UTRECHT,                         *
C *                        THE NETHERLANDS.                            *
C **********************************************************************
C *       SUBROUTINE FOR THE HANDLING OF SPACE GROUP SYMMETRY.         *
C **********************************************************************
C *                CURRENT VERSION  09-10-2013                         *
C **********************************************************************
C *           ------- FORMAL PARAMETER DEFINITION -----------          *
C **********************************************************************
C * LIN   : CONTAINS INFORMATION (A) FOR SPGR, LATT OR SYMM    (INPUT) *
C *         SYMMETRY OPERATION CODE (A)                        (OUTPUT)*
C * NRSYM : REQUESTED NUMBER OF SYMM OPERATION                 (INPUT) *
C *         NRSYM .LT. 0 MEANS ONLY ABS VALUES                         *
C *         (IN LIST MODE: NRSYM = 0    - NO NEWPAGE HANDLING,         *
C *                        NRSYM .LT. 0 - LINE COUNT/NEWPAGE HANDLING) *
C * X(12) : X, Y, Z, TX, TY, TZ, XN, YN, ZN              (INPUT/OUTPUT)*
C * IOUT  : OUTPUT-FILE FOR LIST OPTION AND MESSAGES           (INPUT) *
C *         IOUT = 0 >> NO OUTPUT                                      *
C * ISWITS: SWITCH FOR OPTION SELECTION  (+/-)                 (INPUT) *
C * IERROR: REPORT ERROR                                       (OUTPUT)*
C **********************************************************************
C * ISW = 0  - ACTUAL SWITCH IS DERIVED FROM KEYWORD IN LINE           *
C * ISW = 1  - LATTICE INIT INSTRUCTION "LATT P A"                     *
C * ISW = 2  - LOAD SYMM.CODE IN STRING LINE FOR PRINTING OF SYMM OPER.*
C * ISW = 3  - TRANSFORM X,Y,Z WITH SPECIFIED SYMMETRY OPERATION       *
C * ISW = 4  - RECIPROCAL SPACE SYMMETRY LISTING                       *
C * ISW = 5  - TRANSFORM SPECIFIED H,K,L AND PHI FOLLOWING SYMM. NUMBER*
C *            INPUT:  X(1),X(2),X(3),X(4)                             *
C *            OUTPUT: X(7),X(8),X(9),X(10)                            *
C * ISW = 6  - OUTPUT SYMMETRY OPERATION IN (R/T) FORMAT IN ARRAY X    *
C * ISW = 7  - GET SYMMETRY NUMBER + TRANSLATION FOR THAT SPECIFIED IN *
C *            X(1),X(2),X(3) TO X(9)-RESULT IN X(9),X(10),X(11),X(12) *
C *            e.g. 1 -X, X + Y, 1/2 - z =>> -1 1 3 0 2 0 12 0 6       *
C * ISW = 8  - MULTIPLY SYMM (R'/T') IN X(1),X(2),X(3),X(4)            *
C *            WITH (R/T) IN  X(5),X(6),X(7),X(8)                      *
C *            RESULT IN X(9),X(10),X(11),X(12)                        *
C * ISW = 9  - INVERT SYMM (R/T) IN X(1),X(2),X(3),X(4)                *
C *            RESULT  IN X(9),X(10),X(11),X(12)                       *
C * ISW = 10 - LATT CARD HANDLING                                      *
C * ISW = 11 - SYMM CARD HANDLING                                      *
C * ISW = 12 - SPGR CARD HANDLING                                      *
C * ISW = 13 - GET INFO ABOUT ACENT = 1, CENTRIC = 2 IN FN(1)          *
C * ISW = 14 - HELP + LIST INTERNALLY KNOWN SPACE GROUPS ON UNIT IOUT  *
C * ISW = 15 - INPUT R/T MATRIX TROUGH X (R(1,2) = X(2), T(2) = X(11) )*
C * ISW = 16 - SPGR/LATT/SYMM WITH VALID TRANSFORMATION IN X           *
C * ISW = 17 - SAME AS ISW = 2 APART FROM SHELX-TYPE                   *
C * ISW = 18 - SPACE-GROUP INFO IN X (SG-NUMBER,CRYST-SYST, ..)        *
C *            CHARACTER DATA IN LINE                                  *
C * ISW = 19 - ANALYSE FOR SPECIAL POSITION X(1),X(2),X(3)             *
C * ISW = 20 - ISW(2) + TRANSLATION IN X(4), X(5), X(6)                *
C * ISW = 21 - HALL SYMBOL PARSING                                     *
C * ISW = 22 - SAME AS ISW = 7 BUT WITH SYMM LINE                      *
C * ISW = 23 : GET INFO ABOUT EQUIV NONST ORTHORHOMBIC SPACEGROUP      *
C * ISW = 24 - SAME AS ISW = 18 BUT STANDARD SETTINGS ONLY             *
C * ISW = 25 - SAVE SYMMETRY      ON FILE 'SAVESYMM'                   *
C * ISW = 26 - RESTORE SYMMETRY FROM FILE 'SAVESYMM'                   *
C *                                                                    *
C * ISW =      NEGATIVE: LAUE/PATT SYMMETRY                            *
C **********************************************************************
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, LIN*(*), NONST(NSTD)*9, ICH*1,
     1 NOSTP(6)*4, YSPG*9, ZSPG*13, SGSMC*59,
     2 SHFL(230)*6, TRLTA(NTRL)*13, TRLTB(NTRL)*7, NHLA(NNH)*7,
     3 NHLB(NNH)*15, NHLC(NNH)*11
      COMMON /CSG19/ JB, JE, NIC, NICM, NUMS, NSLP, JS, TRDET
      DIMENSION X(12)
      CHARACTER NONSTA*4
      ILAUE = ISIGN (1, ISWITS)
      ISW   = IABS(ISWITS)
      IUIT  = IOUT
      LINM  = MIN (80, LEN(LIN))
      LINE  = LIN(1:LINM)
      NSM   = NRSYM
      IER   = 0
      NIC   = 3
      NICM  = 3
      N     = 195
      ISWD  = 1
      NSLPM = 1
      ITRNS = 0
      NTRNS = 0
      ISHEL = 0
      ITRL  = 0
      JS    = 0
      NSLP  = 0
      NSGET = 0
      TRDET = 1.0
      ISTO  = 0
      LRET  = 3
C * SWITCH SELECTION (SPECIAL SWITCHES FIRST)
      DO
        SELECT CASE (ISW)
C * ISW = 0 : HANDLE AND ACT UPON KEYWORD (LATT/SYMM/SPGR/HALL) IN LINE
          CASE (0)
            CALL GEN020 (1, LINE, 1, 80)
            SELECT CASE (LINE(1:4))
C * LATT RECORD
              CASE ('LATT')
                CALL GEN038 (SGSMC, 1, 59)
                ISW = 10
C * SYMM RECORD
              CASE ('SYMM')
                CALL GEN047 (LINE,   4, 80)
                CALL GEN038 (SGSMC,  1, 11)
                CALL GEN038 (SGSMC, 15, 59)
                ISW = 11
C * SPGR RECORD
              CASE ('SPGR')
                ISW = 12
C * HALL RECORD
              CASE ('HALL')
                ISW = 21
              CASE DEFAULT
                IF (IUIT .NE. 0)
     1            WRITE (IUIT, 99997, IOSTAT = IOST) LINE(1:40)
                IERROR = IER
                RETURN
            END SELECT
            CYCLE
C * ISW = 1, (GENERAL) LATTICE INIT ETC. - GET TRANSFORMATION MATRIX
          CASE (1)
            CALL SG03 (X, TRDET, 1)
            IERROR = IER
            RETURN
C * ISW = 2 & 4 (& 17 & 20) : PRINT SYMM (X,Y,Z OR H,K,L) LINES
          CASE (2, 4)
            EXIT
C * ISW = 3: COORDINATE TRANSFORMATION
          CASE (3)
            ISWD = 1
            CALL SG09 (X, NSM)
            IERROR = IER
            RETURN
C * ISW = 5: HKL TRANSFORMATION
          CASE (5)
            ISWD = -1
            CALL SG09 (X, NSM)
            IERROR = IER
            RETURN
C * ISW = 6 : LOAD ROTATION MATRIX IN X(1:9) AND TRANSLATION VECTOR
C *           IN X(10:12)
          CASE (6)
            CALL SG15 (X, N, NSM)
            IERROR = IER
            RETURN
C * ISW = 7 : GET SYMMOP NR + UNITCELL TRANSLATIONS FOR GIVEN OPERATOR
          CASE (7)
            CALL SG10 (X)
            IERROR = IER
            RETURN
C * ISW = 8 : MULTIPLY EXTERNALLY SUPPLIED SYMM OP AND RETURN SYMM NR
C *           AND UNIT TRL
          CASE (8)
            CALL SG11 (X)
            IERROR = IER
            RETURN
C * ISW = 9 : CALCULATE INVERSE OPERATION FOR GIVEN OPERATION
C *           IN (X(1), ... X(4))
          CASE (9)
            CALL SG11 (X)
            IERROR = IER
            RETURN
C * ISW = 10 : LATTICE CARD (E.G. LATT -4 or LATT I A)
          CASE (10)
            CALL SG17 (X, TRDET)
            IERROR = IER
            RETURN
C * ISW = 11 : READ SYMM LINE
          CASE (11)
            CALL SG20 (-1, X, NSM, LIN)
            IERROR = IER
            RETURN
C * ISW = 12 : SEARCH FOR GENERATORS FOR SPECIFIED SPACE GROUP
          CASE (12)
            CALL SG14 (X, TRDET)
            IF (IER .EQ. 0) THEN
              IF (LRET .EQ. 2) THEN
                JB = -19
                CALL SG20 (-1, X, NSM, LIN)
              END IF
            END IF
            IERROR = IER
            RETURN
C * ISW = 13 : (A)CENTRIC
          CASE (13)
            X(1) = FLOAT (ICNTRX)
            RETURN
C * ISW = 14 : HELP OPTION
          CASE (14)
            IF (IUIT .NE. 0) WRITE (IUIT, 99993, IOSTAT = IOST)
            IF (NRSYM .GT. 0) THEN
              IF (IUIT .NE. 0) WRITE (IUIT, 99995, IOSTAT = IOST)
              READ  (NRSYM, 99990) LINE
            END IF
            IF (IUIT .NE. 0) THEN
              WRITE (IUIT, 99992, IOSTAT = IOST)
              WRITE (IUIT, 99991, IOSTAT = IOST)
            END IF
            IF (NRSYM .GT. 0) THEN
              IF (IUIT .NE. 0) WRITE (IUIT, 99995, IOSTAT = IOST)
              READ  (NRSYM, 99990) LINE
            END IF
            IF (IUIT .NE. 0) THEN
              WRITE (IUIT, 99996, IOSTAT = IOST)
              WRITE (IUIT, 99994, IOSTAT = IOST)
     1          (SGT(I)(1:12), I = 1, NRSPGR)
            END IF
            IF (NRSYM .GT. 0) THEN
              IF (IUIT .NE. 0) WRITE (IUIT, 99995, IOSTAT = IOST)
              READ  (NRSYM, 99990) LINE
            END IF
            IF (IUIT .NE. 0) THEN
              WRITE (IUIT, 99999, IOSTAT = IOST) (NOSTP(I), I = 1, 6)
              WRITE (IUIT, 99998, IOSTAT = IOST) (NONST(I), I = 1, NSTD)
            END IF
            RETURN
C * ISW = 15 : HANDLE R/T - MATRIX INPUT THROUGH X
          CASE (15)
            CALL SG20 (-1, X, NSM, LIN)
            IERROR = IER
            RETURN
C * ISW = 16 : APPLY TRANSFORMATION IN X ON SYMMETRY IN LINE
          CASE (16)
            ISW   = 0
            ITRNS = 1
            JB    = 5
            JE    = 80
            CYCLE
C * ISW = 17 : SHELX-STYLE SYMM CARDS
          CASE (17)
            ISW   = 2
            ISHEL = 1
            EXIT
C * ISW = 18 : INFO OPTION: SPACE GROUP NUMBER, CRYSTAL SYSTEM,
C *             LAUE GROUP NUMBER, NSYMP, ICNTR, IBV
C *             SPACEGROUP NAME (1:11)
          CASE (18)
            EXIT
C * ISW = 19 : FIND OUT ABOUT SPECIAL POSITION
          CASE (19)
            CALL SG16 (LIN, X)
            IERROR = IER
            RETURN
C * ISW = 20 : PRINT SYMM INCLUDING TRANSLATION
          CASE (20)
            ISW  = 2
            ITRL = 12
            EXIT
C * ISW = 21 : PARSE HALL-SYMBOL
          CASE (21)
            CALL SG03 (X, TRDET, 1)
            CALL GEN038 (ZSPG, 1, 13)
            IF (IER .EQ. 0) THEN
              DO I = 5, 80
                IF (LINE(I:I) .NE. ' ') EXIT
              END DO
              SGSMC(33:) = LINE(I : I + 16)
              CALL GEN020 (-1, SGSMC, 35, 49)
              CALL SG01 (1)
              IF (IER .EQ. 0) THEN
                LRET = 2
                JB   = -19
                CALL SG20 (-1, X, NSM, LIN)
              END IF
            END IF
            IERROR = IER
            RETURN
C * ISW = 22 : GET SYMM NR FOR SYMM
          CASE (22)
            ISW   = 0
            NSGET = 1
            CYCLE
          CASE (23)
            CALL GEN074 (X, 1, 8, 0.0)
            N = NSLOC(ISGNR - 15)
            IF (N .EQ. 0) THEN
              CALL GEN074 (X, 1, 6, 1.0)
            ELSE
              NONSTA = SGSMC(8:11)
              CALL GEN020 (1, NONSTA, 1, 4)
              IF (NONSTA .EQ. '    ') NONSTA = 'ABC '
              DO J = 1, 6
                IF (NOSTP(J) .EQ. NONSTA) EXIT
              END DO
              DO I = 1, 6
                IF (NONST((N - 1) * 6 + I) .EQ.
     1            NONST((N - 1) * 6 + J)) X(I) = 1
              END DO
            END IF
            IERROR = IER
            RETURN
C * ISW = 24 - SAME AS ISW = 18, STANDARD SETTING ONLY
          CASE (24)
            ISTO = 1
            ISW  = 18
            EXIT
C * ISW = 25
          CASE (25)
            CALL SG18 (1, NST)
            IERROR = IER
            RETURN
C * ISW = 26
          CASE (26)
            CALL SG18 (-1, NST)
            IERROR = IER
            RETURN
C * DEFAULT
          CASE DEFAULT
            IERROR = IER
            RETURN
        END SELECT
      END DO
      IF (SGSMC(1:1) .NE. ' ') THEN
        CALL SG13 (LIN, X, NRSYM)
      ELSE
        CALL SG20 (0, X, NSM, LIN)
      END IF
      IERROR = IER
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, 'Nonstandard Settings with Cell Transformations',
     1 ' (see Internat. Tables, Vol A)', /,
     1 46('='), /, 6(A4, 7X), /, 66('-'))
99998 FORMAT (6(1X, A, 1X))
99997 FORMAT (/, 'Line Ignored :', A, /)
99996 FORMAT (/, 4X, 'Space Group Names Known to the Program', //)
99995 FORMAT ('====>> Continue with <CR> <<====')
99994 FORMAT (6(1X, A))
99993 FORMAT (/, 'General Space Group Symmetry Handler - Version:',
     1 ' 15-Apr-2002', //, 'Note: only a subset may be accessible',
     2 //, 'There are Five  Groups of Instructions:', /,
     3 'A - Symmetry Specification with <SPGR>,<LATT>,<SYMM>', /,
     4 'B - Symmetry List Options  with <LIST> and <RLST>', /,
     5 'C - Actual Transformations with <ATOM> and <HKL>', /,
     6 'D - Output of R and T Matrices with <DMAT>', /,
     7 'E - Miscellaneous <TRNS>', //,
     8 '<SPGR> - Symmetry may be Specified as <P21/c>, P21.CAB, etc.'
     9 /,' <LATT> - Contains <P/A/B/C/I/F/R> and <C/A>', /
     * '<SYMM> - e.g. < 1/2-X,1/2+Y,1/2-Z>', /,
     1 '<LIST> - Gives a Listing of the Symmetry in X,Y,Z', /
     2 '<RLST> - Gives a Listing of the Symmetry in H,K,L', /,
     3 '<ATOM> - Specify Three Fractional Coordinates; The', /, 9X,
     4 'Program Generates Symm. Related Positions', /,
     5 '<VECT> - as <ATOM> but with Patterson Symmetry', /,
     6 '<HKL > - Specify H,K,L ; The Program Generates the', /, 9X,
     7 'Symm. Related Set. Specification of a Phase', /, 9X,
     6 'as a Fourth Item Gives Phase Values as Well')
99992 FORMAT ('<DMAT> - Specify Symmetry Number ; The Matrices R '/
     1 '         and T are Returned in Array X(1:12)'/,
     2 '<GSNR> - Specify Coded Symmetry Operation in X(1:9),',/
     3 '         Result: Symmetry Number + Unit Translations',/,
     4 '<MULT> - S1,TX1,TY1,TZ1,S2,TX2,TY2,TZ2',/,
     5 '         RESULT: S3,TX3,TY3,TZ3',/,
     6 '<INVT> - S1,TX1,TY1,TZ1 ; RESULT: S2,TX2,TY2,TZ2',/,
     7 '<TRNS> - T11,T12,..,T33,(S1,S2,S3) : Cell Transform+Shift',/,
     8 '<SITE> - X, Y, Z (Fract. TOL);Output Site Symm Nr in X(12)',/,
     9 '<END> or <STOP> Terminates the Program',/)
99991 FORMAT (/'Remarks:'/'1 - A <LATT> Card Initialises the Number',
     1 ' of Known'/4X,'Symmetry Operations to 1: X,Y,Z'/'2 - A <S',
     2 'YMM> Card is Interpreted as a Generator, so-'/4X,'that at ',
     3 'most 4 <SYMM> Cards are Needed'/'3 - The Program Contains ' ,
     4 'data for all Standard Space'/4X, 'Group Symbols (Including',
     5 ' Some Non-Standard Settings)',/,
     6 '4 - The Sub-word <PATT> Together with <LIST>,<ATOM>',
     7 /14X,'or <LAUE> Together with <RLST>,<HKL>',
     8 /4X,'Generates/Applies the Corresponding Symmetries'/)
99990 FORMAT (A)
      END SUBROUTINE SGSM
      SUBROUTINE SG01 (MODE)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, LNI*1, LN0*1, ICH*1,
     1 NONST(NSTD)*9, NOSTP(6)*4, YSPG*9, ZSPG*13, SGSMC*59,
     2 TRLTA(NTRL)*13, TRLTB(NTRL)*7, SHFL(230)*6,
     4 NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11
      CALL GEN020 (1, LINE, 1, 80)
      IF (MODE .EQ. 1) SGSMC(14:14) = 'A'
      JB    = -19
      JE    = 0
      NLEV  = -1
      ISGN  = 1
      LPAR  = -1
      JLAUE = 8
      ISTAT = 0
      DO L = 1, 4
        DO K = 1, 9
          IHALL(K, L) = 0
        END DO
        IHALL(2, L) = 1
      END DO
      DO 10 I = 5, 80
        LN0 = LINE(I - 1: I - 1)
        LNI = LINE(I : I)
        IF (NLEV .EQ. -1) THEN
          IF (LNI .EQ. '-') THEN
            IF (MODE .EQ. 1) SGSMC(14:14) = 'C'
          ELSE IF (LNI .NE. ' ') THEN
            DO J = 1, 7
              IF (LNI .EQ. ICH(36 + J)) THEN
                IF (ZSPG(1:1) .EQ. ' ' .AND. MODE .EQ. 1)
     1              SGSMC(13:13) = LNI
                NLEV        = 0
                ISTAT       = 1
                IHALL(1, 1) = 10
                GO TO 10
              END IF
            END DO
          END IF
        ELSE
          SELECT CASE (LNI)
            CASE ( '-')
              IF (LPAR .LT. 0) THEN
                NLEV  = NLEV + ISTAT
                IF (NLEV .GT. 4) GO TO 20
                ISTAT          = 0
                IHALL(2, NLEV) = -1
              ELSE
                ISGN = -1
              END IF
            CASE ('(')
              IF (NLEV .LT. 2) GO TO 20
              LPAR = 0
            CASE (')')
            CASE ('0')
              IF (LPAR .GE. 0) LPAR = LPAR + 1
            CASE ('1')
              IF (LPAR .GE. 0) THEN
                LPAR = LPAR + 1
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6 + LPAR, NLEV) = ISGN
                ISGN = 1
              ELSE IF (LN0 .EQ. '3') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) + 4
              ELSE IF (LN0 .EQ. '4') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) + 3
              ELSE IF (LN0 .EQ. '6') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) + 2
              ELSE
                NLEV  = NLEV + ISTAT
                IF (NLEV .GT. 4) GO TO 20
                ISTAT = 1
                IHALL(3, NLEV) = 0
              END IF
            CASE ('2')
              IF (LN0 .EQ. '3') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) + 8
              ELSE IF (LN0 .EQ. '6') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) + 4
              ELSE
                NLEV  = NLEV + ISTAT
                IF (NLEV .GT. 4) GO TO 20
                ISTAT = 1
                IF (NLEV .GT. 1) THEN
                  IHX = IHALL(1, NLEV - 1) + IHALL(3, NLEV - 1)
                ELSE
                  IHX = 0
                END IF
                IF (IHX .EQ. 2 .OR. IHX .EQ. 4) THEN
                  IHALL(1, NLEV) = 15
                  IHALL(3, NLEV) = 0
                ELSE IF (IHX .EQ. 7 .OR. IHX .EQ. 9) THEN
                  IHALL(1, NLEV) = 15
                  IHALL(3, NLEV) = 2
                ELSE IF (IHX .EQ. 12 .OR. IHX .EQ. 14 .OR.
     1                   IHX .EQ. 21) THEN
                  IHALL(1, NLEV) = 15
                  IHALL(3, NLEV) = 4
                ELSE
                  IHALL(3, NLEV) = 1
                END IF
              END IF
            CASE ('3')
              IF (LN0 .EQ. '4') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) + 9
              ELSE
                NLEV  = NLEV + ISTAT
                IF (NLEV .GT. 4) GO TO 20
                ISTAT = 1
                IHALL(3, NLEV) = 2
                IF (NLEV .EQ. 3) THEN
                  IHALL(1, NLEV) = 21
                  IHALL(3, NLEV) = 0
                END IF
              END IF
            CASE ('4')
              IF (LN0 .EQ. '6') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) + 8
              ELSE
                NLEV  = NLEV + ISTAT
                IF (NLEV .GT. 4) GO TO 20
                ISTAT = 1
                IHALL(3, NLEV) = 3
              END IF
            CASE ('5')
              IF (LN0 .EQ. '6') THEN
                IF (NLEV .GT. 4) GO TO 20
                IHALL(6, NLEV) = IHALL(6, NLEV) +  10
              END IF
            CASE ('6')
              NLEV  = NLEV + ISTAT
              IF (NLEV .GT. 4) GO TO 20
              ISTAT = 1
              IHALL(3, NLEV) = 4
            CASE ('X')
              IHALL(1, NLEV) = 0
            CASE ('Y')
              IHALL(1, NLEV) = 5
            CASE ('Z')
              IHALL(1, NLEV) = 10
            CASE ('*')
              IHALL(1, NLEV) = 21
              IHALL(3, NLEV) = 0
            CASE ('''')
              IHALL(1, NLEV) = 15
              IHX = IHALL(1, NLEV - 1)
              IF (IHX .EQ. 0) THEN
                IHALL(3, NLEV) = 0
              ELSE IF (IHX .EQ. 5) THEN
                IHALL(3, NLEV) = 2
              ELSE
                IHALL(3, NLEV) = 4
              END IF
            CASE ('"')
              JLAUE = 7
              IHALL(1, NLEV) = 15
              IF (NLEV .EQ. 1) GO TO 20
              IHX = IHALL(1, NLEV - 1)
              IF (IHX .EQ. 0) THEN
                IHALL(3, NLEV) = 1
              ELSE IF (IHX .EQ. 5) THEN
                IHALL(3, NLEV) = 3
              ELSE
                IHALL(3, NLEV) = 5
              END IF
            CASE ('A')
              IF (NLEV .GT. 4) GO TO 20
              IHALL(4, NLEV) = IHALL(4, NLEV) + 6
            CASE ('B')
              IF (NLEV .GT. 4) GO TO 20
              IHALL(5, NLEV) = IHALL(5, NLEV) + 6
            CASE ('C')
              IF (NLEV .GT. 4) GO TO 20
              IHALL(6, NLEV) = IHALL(6, NLEV) + 6
            CASE ('N')
              IF (NLEV .GT. 4) GO TO 20
              DO J = 4, 6
                IHALL(J, NLEV) = IHALL(J, NLEV) + 6
              END DO
            CASE ('U')
              IHALL(4, NLEV) = IHALL(4, NLEV) + 3
            CASE ('V')
              IHALL(5, NLEV) = IHALL(5, NLEV) + 3
            CASE ('W')
              IHALL(6, NLEV) = IHALL(6, NLEV) + 3
            CASE ('D')
              DO J = 4, 6
                IHALL(J, NLEV) = IHALL(J, NLEV) + 3
              END DO
          END SELECT
        END IF
   10 CONTINUE
      IF (NLEV .GT. 0) THEN
        IF (MODE .EQ. 1) CALL SG04
        IF (IER .EQ. 0) THEN
          CALL GEN038 (LINE, 1, 80)
          DO LH = 1, NLEV
            JB = JB + 20
            JE = JE + 20
            M  = (IHALL(1, LH) + IHALL(3, LH)) * 9
            DO J = 1, 3
              DO I = 1, 3
                K = (J - 1) * 3 + I
                R0(I, J) = NHRM(M + K) * IHALL(2, LH)
              END DO
            END DO
            DO K = 1, 3
              T0(K) = (IHALL(3 + K, LH) + IHALL(6 + K, LH)) / 12.0
            END DO
            DO I = 1, 3
              DO J = 1, 3
                T0(I) = T0(I) - R0(I, J) * IHALL(6 + J, LH) / 12.0
              END DO
            END DO
            NTRNS = ITRNS
            CALL SG02 (JB)
            IF (IER .NE. 0) GO TO 20
          END DO
        END IF
        IF (IER .EQ. 0) RETURN
      END IF
   20 IER = 7
      RETURN
      END SUBROUTINE SG01
      SUBROUTINE SG02 (JB)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, ICH*1,  NONST(NSTD)*9,
     1 NOSTP(6)*4, YSPG*9, ZSPG*13, SGSMC*59, TRLTA(NTRL)*13,
     2 TRLTB(NTRL)*7, SHFL(230)*6, NHLA(NNH)*7, NHLB(NNH)*15,
     3  NHLC(NNH)*11
      CALL GEN038 (LINE, JB, JB + 19)
      K = JB
      DO I = 1, 3
        TRV  = AMOD(T0(I) * 12.0, 12.0)
        NTRV = NINT(TRV)
        IF (ABS(TRV - NTRV) .GT. 0.1) THEN
          IF (IUIT .NE. 0)
     1      WRITE (IUIT, 99999, IOSTAT = IOST) (T0(K), K = 1, 3)
          IER = 8
          RETURN
        END IF
        NTRVN = 12
        IF (NTRV .NE. 0) THEN
          IF (NTRV .LT. 0) NTRV = NTRV + 12
          IF (NTRV .GT. 0) THEN
            DO WHILE (.TRUE.)
              IF (MOD(NTRV, 2) .EQ. 0 .AND. MOD(NTRVN, 2) .EQ. 0) THEN
                NTRV  = NTRV  / 2
                NTRVN = NTRVN / 2
                CYCLE
              ELSE IF (MOD(NTRV, 3) .EQ. 0 .AND. MOD(NTRVN, 3) .EQ. 0)
     1          THEN
                NTRV  = NTRV  / 3
                NTRVN = NTRVN / 3
                CYCLE
              ELSE
                LINE(K:K+2) = ICH(NTRV)//'/'//ICH(NTRVN)
                K = K + 3
                EXIT
              END IF
            END DO
          END IF
        END IF
        DO J = 1, 3
          IF (ABS(R0(I, J)) .GT. 0.9) THEN
            NR0 = NINT(R0(I, J))
            IF (NR0 .GT. 0) THEN
              LINE(K:K) = '+'
            ELSE
              LINE(K:K) = '-'
            END IF
            LINE(K + 1:K + 1) = ICH(11 + J)
            K = K + 2
          END IF
        END DO
        IF (I .LT. 3) THEN
          LINE(K:K) = ','
          K = K + 1
        END IF
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, 'E: SYMM TRANSLATION n/a:', 3F8.3)
      END SUBROUTINE SG02
      SUBROUTINE SG03 (X, DET, ISG04)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, NONST(NSTD)*9, NOSTP(6)*4,
     1 YSPG*9, ICH*1, SGSMC*59, ZSPG*13, TRLTA(NTRL)*13,
     2 TRLTB(NTRL)*7, SHFL(230)*6, NHLA(NNH)*7, NHLB(NNH)*15,
     3 NHLC(NNH)*11
      DIMENSION X(12)
C * (GENERAL) LATTICE INIT ETC. - GET TRANSFORMATION MATRIX
      K = 0
      DO I = 1, 3
        IF (ITRNS .EQ. 0) THEN
          OSFT(I) = 0.0
        ELSE
          OSFT(I) = - X(I + 9)
        END IF
        DO J = 1, 3
          IF (ITRNS .EQ. 0) THEN
            IF (I .EQ. J) THEN
              XVAL = 1.0
            ELSE
              XVAL = 0.0
            END IF
          ELSE
            K    = K   + 1
            XVAL = X(K)
          END IF
          R1(J, I) = XVAL
        END DO
      END DO
      CALL GEN003 (R1, R2, DET, 0)
      IF (NINT (DET) .EQ. 3) THEN
        IF (R1(1, 1) .EQ. -1 .AND. R1(1, 2) .EQ.  0 .AND.
     1      R1(1, 3) .EQ.  1 .AND. R1(2, 1) .EQ.  1 .AND.
     2      R1(2, 2) .EQ. -1 .AND. R1(2, 3) .EQ.  1 .AND.
     3      R1(3, 1) .EQ.  0 .AND. R1(3, 2) .EQ.  1 .AND.
     4      R1(3, 3) .EQ.  1) THEN
          IER = 14
          WRITE (IUIT, 99998, IOSTAT = IOST)
          RETURN
        END IF
      END IF
      IF (IER .NE. 0) RETURN
      IF (ABS(DET) .LT. 0.1) THEN
        IF (IUIT .NE. 0)
     1    WRITE (IUIT, 99999, IOSTAT = IOST)
     2      DET, ((R1(I, J), I = 1, 3), J = 1, 3)
        IER = 11
        RETURN
      END IF
      IF (ISW .NE. 11) THEN
        DO I = 1, 3
          IABC(I)     = 1
          IABC(I + 3) = 1
          JABC(I)     = I
          JABC(I + 3) = I
          DO J = 1, 3
            IF (I .EQ. 1) THEN
              ISS = J
            ELSE
              ISS = 0
            END IF
            IS (I, J, 1) = ISS
            IF (I .EQ. J) THEN
              ISS = I
            ELSE
              ISS = 0
            END IF
            IORG(I, J) = ISS
          END DO
        END DO
        CALL GEN038 (YSPG,  1, 9)
        CALL GEN038 (ZSPG,  1, 13)
        CALL GEN038 (SGSMC, 1, 47)
        SGSMC(13:14) = 'PA'
        NSYMP        = 1
        JSWD         = 0
        IKLS         = 8
        ISGNR        = 0
        IAXM         = 0
        IMPROP       = 1
      END IF
      IF (ISG04 .NE. 0) CALL SG04
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (':: Transformation Matrix with Determinant =', F6.3, //,
     1 3(3F10.3, /))
99998 FORMAT (':: Transformation to Reverse Setting not Allowed', /,
     1        '   Use (1 -1 0 0 1 -1 1 1 1) for rR to hR.', /)
      END SUBROUTINE SG03
      SUBROUTINE SG04
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      COMMON /SLAUE/ NLAUE, XSYST, IBVL, SITE
      CHARACTER SGT(NRSPGR)*33, LINE*80,
     1 NONST(NSTD)*9, NOSTP(6)*4, YSPG*9, NLAUE(14)*5, XSYST(8)*12,
     2 ICH*1, IBVL(8)*1, SGSMC*59, SITE(NSITE)*5, ZSPG*13,
     3 TRLTA(NTRL)*13, TRLTB(NTRL)*7, SHFL(230)*6,
     4 NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11
      IF (SGSMC(14:14) .EQ. 'C') THEN
        ICNTR = 2
      ELSE
        ICNTR = 1
      END IF
      ICNTRX = ICNTR
      NSYMX  = NSYMP
      IF (ICNTR .EQ. 1 .AND. NSYMP .GT. 1) THEN
        DO 10 I = 2, NSYMP
          DO K = 1, 3
            IF (IS(2, K, I) .NE.   0) GO TO 10
            IF (IS(1, K, I) .NE. - K) GO TO 10
            OCNT(K) = FLOAT(IS(3, K, I)) / 24
          END DO
          ICNTRX = 2
          NSYMX  = NSYMP / 2
          EXIT
   10   CONTINUE
      END IF
      DO K = 1, 7
        IF (SGSMC(13:13) .EQ. ICH(K + 29)) THEN
          IBV  = IBV0(K)
          IBVP = IBV1(K)
          DO J = 1, IBV
            DO I = 1, 3
              IF (J .EQ. 1) THEN
                ISBRV(J, I) = 0
              ELSE
                ISBRV(J, I) = IBV2(IBVP)
                IBVP        = IBVP + 1
              END IF
            END DO
          END DO
          IF (ILAUE .LT. 0) THEN
            IINV = 2
          ELSE
            IINV = ICNTR
          END IF
          NST  = NSYMP * IBV * IINV
          IKLS  =  8
          LAUE  = 13
          IF (NSYMX .EQ. 1) THEN
            IKLS = 1
            LAUE = 1
          ELSE IF (NSYMX .EQ. 2) THEN
            IKLS = 2
            LAUE = 2
      ELSE IF (IAXM .EQ. 6) THEN
            IKLS = 6
            IF (NSYMX .EQ. 6) THEN
              LAUE = 9
            ELSE
              LAUE = 10
            END IF
          ELSE IF (NSYMX .GE. 12) THEN
            IKLS = 7
            IF (NSYMX .EQ. 12) THEN
              LAUE = 11
            ELSE
              LAUE = 12
            END IF
          ELSE IF (IAXM .EQ. 4) THEN
            IKLS = 4
            IF (NSYMX .EQ. 4) THEN
              LAUE = 4
            ELSE
              LAUE = 5
            END IF
          ELSE IF (IAXM .EQ. 3) THEN
            IKLS = 5
            IF (NSYMX .EQ. 3) THEN
              LAUE = 6
            ELSE
              LAUE = 14
            END IF
          ELSE IF (NSYMX .EQ. 4) THEN
            IKLS  = 3
            LAUE  = 3
          END IF
          JSMI = NSG(2 * LAUE - 1)
          JSMX = NSG(2 * LAUE)
          IF(IKLS .EQ. 5 .AND. IABS(IS(1, 3, 2)) .EQ. 3) THEN
            SGSMC(12:12) = IBVL(6)
          ELSE
            SGSMC(12:12) = IBVL(IKLS)
          END IF
          GO TO 20
        ENDIF
      END DO
      IF (IUIT .NE. 0) WRITE (IUIT, 99999, IOSTAT = IOST) SGSMC(13:13)
      IER = 10
   20 IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (':: Unknown LATTICE Type:', A)
      END SUBROUTINE SG04
      SUBROUTINE SG05 (N, NSL)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      IF (NSL .EQ. 0) THEN
        IF (IUIT .NE. 0) WRITE (IUIT, 99996, IOSTAT = IOST)
        IER = 9
        RETURN
      END IF
      NS0 = (IABS(NSL) - 1) / NSYMP
      NS  =  IABS(NSL) - NS0 * NSYMP
      IF (NS .LT. 1) THEN
        IF (IUIT .NE. 0)
     1    WRITE (IUIT, 99998, IOSTAT = IOST) NSL, NSYMP, NS0, NS,ISW
        IER = 5
        RETURN
      END IF
      IF (ILAUE .LT. 0) THEN
        IINV = 2
      ELSE
        IINV = ICNTR
      END IF
      NS2 = NS0 / IINV
      NS1 = NS0 + 1 - NS2 * IINV
      NS2 = NS2 + 1
      IF (NS2 .LT. 1 .OR. NS2 .GT. 4) THEN
        IF (IUIT .NE. 0)
     1    WRITE (IUIT, 99999, IOSTAT = IOST) NS0, NS1, NS2, IINV
        IER = 4
        RETURN
      END IF
      IF (N .LT. 1 .OR. N .GT. 195) THEN
        IF (IUIT .NE. 0)
     1    WRITE (IUIT, 99997, IOSTAT = IOST) NS, NS0, NS1, NS2, IINV, N
        IER = 3
        RETURN
      END IF
      DO I = 1, 3
        IR(1, I, N) = 0
        IR(2, I, N) = 0
      END DO
      DO I = 1, 3
        DO K = 1, 3
          INH = IS(K, I, NS)
          IF (NS1 .EQ. 2) INH = - INH
          IF (K .EQ. 3) THEN
            IF (ILAUE .GT. 0) THEN
              INH = MOD(INH + ISBRV(NS2, I), 12)
            ELSE
              INH = MOD(ISBRV(NS2, I), 12)
            END IF
            IF (INH .LT. 0) INH = INH + 12
            IR(K, I, N) = INH
          ELSE IF (ISWD .GT. 0) THEN
            IR(K, I, N) = INH
          ELSE IF (INH .NE. 0) THEN
            IF (INH .LT. 0) THEN
              INHD = - I
              INH  = - INH
            ELSE
              INHD =  I
            END IF
            IF (IR(1, INH, N) .EQ. 0) THEN
              IR(1, INH, N) = INHD
            ELSE
              IR(2, INH, N) = INHD
            END IF
          END IF
        END DO
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('SGSM Problem:NS0,NS1,NS2,IINV = ', 4I10,
     1        'NS2 < 1 OR NS2 > 4')
99998 FORMAT ('NS .LT. 1 ERROR IN (SGSM)', /,
     1        'NSL, NSYMP, NS0, NS, ISW =', 5I10, /)
99997 FORMAT ('E: SPGR-Problem', 6I5, /)
99996 FORMAT ('nsl = 0 in SG05')
      END SUBROUTINE SG05
      SUBROUTINE SG06
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      DO K = 1, 3
        DO M = 1, 3
          ISV(M) = 0
        END DO
        ITS = IR(3, K, 193)
        DO L = 1, 2
          ISJ = IR(L, K, 193)
          IF (ISJ .NE. 0) THEN
            ISS = IR(3, IABS(ISJ), 194)
            IF (ISJ .LT. 0) ISS = - ISS
            ITS = ITS + ISS
            DO M = 1, 2
              ISX = IR(M, IABS(ISJ), 194)
              IF (ISJ .LT. 0) ISX = - ISX
              IF (ISX .NE. 0) THEN
                ISY = IABS(ISX)
                ISV(ISY) = ISV(ISY) + ISX
              END IF
            END DO
          END IF
        END DO
        IR(2, K, 195) = 0
        N = 0
        DO M = 1, 3
          IF (ISV(M) .NE. 0) THEN
            N             = N + 1
            IR(N, K, 195) = ISV(M)
          END IF
        END DO
        IR(3, K, 195) = ITS
      END DO
      RETURN
      END SUBROUTINE SG06
      SUBROUTINE SG07
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      DO K = 1, 3
        ITS = MOD(IR(3, K, 195), 12)
        IF (ITS .LT. 0) ITS = ITS + 12
        IR(3, K, 195) = ITS
      END DO
      NSP  = -1
      CALL SG08 (NSP)
      IF (IER .EQ. 0) THEN
        IF (NSP .LT. 0) THEN
          IF (NSYMP .LT. 48) THEN
            NSYMP = NSYMP + 1
            DO L = 1, 3
              DO K = 1, 3
                ISLK            = IR(L, K, 195)
                IS(L, K, NSYMP) = ISLK
                ISLKA           = IABS (ISLK)
                IF (L .LT. 3 .AND. ISLK .NE. 0) THEN
                  IF (ISLKA .LT. 4)  THEN
                    IORG(ISLKA, K) = IORG(ISLKA, K) + ISLK
                  ELSE
                    IF (IUIT .NE. 0) WRITE (IUIT, 99998, IOSTAT = IOST)
                    IER = 12
                    RETURN
                  END IF
                END IF
              END DO
            END DO
            IF (IS(1, 3, NSYMP) .GT. 0) THEN
              ISN =  100000
            ELSE
              ISN = -100000
            END IF
            ISCOD = 555555
            DO K = 1, 3
              DO L = 1, 2
                ISCOD = ISCOD + ISN * IS(L, K, NSYMP)
                ISN = ISN / 10
              END DO
            END DO
            IF (ISCOD .EQ. 356385 .OR. ISCOD .EQ. 856575) THEN
              IAX = 3
            ELSE IF (ISCOD .EQ. 356585) THEN
              IAX = 4
            ELSE IF (ISCOD .EQ. 636585) THEN
              IAX = 6
            ELSE
              IAX = 0
            END IF
            IAXM = MAX(IAXM, IAX)
          ELSE
            IF (IUIT .NE. 0) WRITE (IUIT, 99999, IOSTAT = IOST)
            IER = 6
            RETURN
          END IF
        ELSE IF (NSP .GT. 0) THEN
          NSM = 1
          DO
            NSM = NSM + 1
            IF (NSM .GT. 1 .AND. NSM .LE. NSYMP) THEN
              NSP = -1
              DO I = 1, 3
                DO J = 1, 3
                  IR(I, J, 195) = IS(I, J, NSM)
                END DO
              END DO
              NSP = -1
              CALL SG08 (NSP)
              IF (NSP .GT. 0) THEN
                IF (NSM .LT. NSYMP) THEN
                  DO I = 1, 3
                    DO J = I, 3
                      IS(I, J, NSM) = IS(I, J, NSYMP)
                    END DO
                  END DO
                END IF
                NSYMP = NSYMP - 1
              END IF
            ELSE
              EXIT
            END IF
          END DO
        END IF
      ENDIF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (':: Attempt to generate more than 48 ''non-LATT'' ',
     1        'operations', /, '   ** Please check symmetry operations'
     2        , /, '   ** No additional operations accepted!')
99998 FORMAT (':: Problem in SG07 - ERR = 12')
      END SUBROUTINE SG07
      SUBROUTINE SG08 (NSP)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80,
     1 NONST(NSTD)*9, NOSTP(6)*4, YSPG*9, ICH*1, SGSMC*59, ZSPG*13,
     3 TRLTA(NTRL)*13, TRLTB(NTRL)*7, SHFL(230)*6,
     4 NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11
      CHARACTER JBRV*1, JCNT*1
      JBRV = SGSMC(13:13)
      JCNT = SGSMC(14:14)
      CALL GEN038 (SGSMC, 1, 11)
      DO NSM = 1, NSYMP
        L = NSM
        DO LL = 1, 3, 2
          ISN  = 2 - LL
          IDIF = 0
          IDT  = 0
          IDT0 = 0
          DO K = 1, 3
            IDIF = IDIF + IABS(IS(1, K, L) - ISN * IR(1, K, 195))
     1                  + IABS(IS(2, K, L) - ISN * IR(2, K, 195))
            IDV  = MOD(IS(3, K, L) - ISN * IR(3, K, 195), 12)
            IF (IDV .LT. 0) IDV = IDV + 12
            IF (IDV .EQ. 4 .OR. IDV .EQ. 8) THEN
              IDT = IDT + IDV * 10**(3 - K)
            ELSE IF (IDV .EQ. 6) THEN
              IDT = IDT + 2**(3 - K)
            END IF
            IDT0 = IDT0 + IDV
          END DO
          IF (IDIF .EQ. 0) THEN
            IF (IDT0 .EQ. 0) THEN
              NSP = 0
              IF (ISN .LT. 0) THEN
                IF (JCNT .EQ. 'A') THEN
                  SGSMC(14:14) = 'C'
                  NSP = 8
                END IF
              END IF
              RETURN
            ELSE IF (IDT .EQ. 3) THEN
              IF (JBRV .EQ. 'A' .OR. JBRV .EQ. 'F') THEN
                NSP = 0
                IF (ISN .LT. 0) THEN
                  SGSMC(14:14) = 'C'
                  NSP = 8
                END IF
                RETURN
              ELSE IF (ISN .GT. 0) THEN
                NSP = 0
                IF (JBRV .EQ. 'P') THEN
                  SGSMC(13:13) = 'A'
                  NSP = 2
                ELSE IF (JBRV .NE. 'F') THEN
                  SGSMC(13:13) = 'F'
                  NSP = 5
                END IF
                RETURN
              END IF
            ELSE  IF (IDT .EQ. 5) THEN
              IF (JBRV .EQ. 'B' .OR. JBRV .EQ. 'F') THEN
                NSP = 0
                IF (ISN .LT. 0) THEN
                  SGSMC(14:14) = 'C'
                  NSP = 8
                END IF
                RETURN
              ELSE IF (ISN .GT. 0) THEN
                NSP = 0
                IF (JBRV .EQ. 'P') THEN
                  SGSMC(13:13) = 'B'
                  NSP = 3
                ELSE IF (JBRV .NE. 'F') THEN
                  SGSMC(13:13) = 'F'
                  NSP = 5
                END IF
                RETURN
              END IF
            ELSE IF (IDT .EQ. 6) THEN
              IF (JBRV .EQ. 'C' .OR. JBRV .EQ. 'F') THEN
                NSP = 0
                IF (ISN .LT. 0) THEN
                  SGSMC(14:14) = 'C'
                  NSP = 8
                END IF
                RETURN
              ELSE IF (ISN .GT. 0) THEN
                NSP = 0
                IF (JBRV .EQ. 'P') THEN
                  SGSMC(13:13) = 'C'
                  NSP = 4
                ELSE IF (JBRV .NE. 'F') THEN
                  SGSMC(13:13) = 'F'
                  NSP = 5
                END IF
                RETURN
              ELSE IF (ISN .LT. 0) THEN
                IF (JBRV .EQ. 'P' .AND. JCNT .EQ. 'C') THEN
                  SGSMC(13:13) = 'C'
                  NSP  = 4
                  RETURN
                ENDIF
              END IF
            ELSE IF (IDT .EQ. 7) THEN
              IF (JBRV .EQ. 'I') THEN
                NSP = 0
                IF (ISN .LT. 1) THEN
                  SGSMC(14:14) = 'C'
                  NSP = 8
                END IF
                RETURN
              ELSE IF (ISN .GT. 0) THEN
                NSP = 0
                IF (JBRV .NE. 'I') THEN
                  SGSMC(13:13) = 'I'
                  NSP = 6
                END IF
                RETURN
              END IF
            ELSE IF (IDT .EQ. 488 .OR. IDT .EQ. 844) THEN
              IF (JBRV .EQ. 'R') THEN
                NSP = 0
                IF (ISN .LT. 0) THEN
                  SGSMC(14:14) = 'C'
                  NSP = 8
                END IF
                RETURN
              ELSE IF (ISN .GT. 0) THEN
                NSP  = 0
                IF (JBRV .NE. 'R') THEN
                  SGSMC(13:13) = 'R'
                  NSP = 7
                END IF
                RETURN
              END IF
            ELSE IF (IDT .EQ. 848 .OR. IDT .EQ. 484) THEN
              IF (IUIT .NE. 0) WRITE (IUIT, 99999, IOSTAT = IOST)
              IER = 14
              RETURN
            END IF
          END IF
        END DO
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (':: (Transformation to) Obverse Setting Not Allowed.')
      END SUBROUTINE SG08
      SUBROUTINE SG09 (X, NSM)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      DIMENSION X(12)
      IF (ILAUE .LT. 0 .AND. ICNTR .EQ. 1) THEN
        NSTT = NST * 2
        JSWD = 0
        ISKP = 0
      ELSE
        NSTT = NST
        ISKP = 1
      END IF
      IF (ISWD .NE. JSWD) THEN
        DO N = 1, NSTT
          NSL = N
          CALL SG05 (NSL, NSL)
          IF (IER .NE. 0) RETURN
        END DO
        JSWD = ISWD * ISKP
      END IF
      N  = IABS(NSM)
      DO J = 1, 3
        IF (NSM .GT. 0) THEN
          IF (ISWD .LT. 0) THEN
            X(J + 6) = 0.0
            IF (J .EQ. 1) X(10) = X(4) / 360.0
            X(10) = X(10) + IR(3, J, N) * X(J) / 12.0
          ELSE
            X(J + 6) = IR(3, J, N) / 12.0 + X(J + 3)
          END IF
        ELSE
          X(J + 6) = 0.0
        END IF
        DO I = 1, 2
          IF (N .GT. 0 .AND. N .LT. 196) THEN
            ISJ = IR(I, J, N)
          ELSE
            ISJ = 0
          END IF
          IF (ISJ .NE. 0) THEN
            XISJ = X(IABS(ISJ))
            IF (ISJ .LT. 0 .AND. NSM .GE. 0) XISJ = - XISJ
            X(J + 6) = X(J + 6) + XISJ
          END IF
        END DO
      END DO
      IF (ISWD .LT. 0) THEN
        X10 = MOD(X(10), 1.0)
        IF (X10 .GT. 0.5) THEN
          X10 = X10 - 1.0
        ELSE IF (X10 .LE. -0.5) THEN
          X10 = X10 + 1.0
        END IF
        X(10) = X10 * 360.0
      END IF
      RETURN
      END SUBROUTINE SG09
      SUBROUTINE SG10 (X)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      DIMENSION X(12)
      NSL = NST
      N   = 195
   10 CALL SG05 (N, NSL)
      IF (IER .EQ. 0) THEN
        IJ = 0
        DO I = 1, 3
          DO J = 1, 3
            IJ = IJ + 1
            IDIF = IFIX(X(IJ)) - IR(I, J, N)
            IF (I .EQ. 3) THEN
              X(9 + J) = FLOAT(IDIF / 12)
              IDIF     = MOD(IDIF, 12)
            END IF
            IF (IDIF .NE. 0) THEN
              NSL = NSL - 1
              IF (NSL .GT. 0) THEN
                GO TO 10
              ELSE
                GO TO 20
              END IF
            END IF
          END DO
        END DO
   20   X(9) = NSL
      END IF
      RETURN
      END SUBROUTINE SG10
      SUBROUTINE SG11 (X)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      DIMENSION X(12)
      IF (ISW .EQ. 9) X(5) = NST
      N   = 193
      NSL = NINT(X(1))
      CALL SG05 (N, NSL)
      IF (IER .EQ. 0) THEN
        DO K = 1, 3
          IR(3, K, 193) = IR(3, K, 193) + NINT(X(K + 1)) * 12
        END DO
        N   = 194
   10   NSL = NINT(X(5))
        CALL SG05 (N, NSL)
        IF (IER .EQ. 0) THEN
          IF (ISW .NE. 9) THEN
            DO K = 1, 3
              IR(3, K, 194) = IR(3, K, 194) + NINT(X(5 + K)) * 12
            END DO
          END IF
          CALL SG06
          IF (ISW .EQ. 9) THEN
            DO K = 1, 3
              IF (IR(1, K, 195) .NE. K) GO TO 20
              IF (IR(2, K, 195) .NE. 0) GO TO 20
              IF (MOD(IABS(IR(3, K, 195)), 12) .NE. 0) GO TO 20
              ITS = - IR(3, K, 194)
              DO I = 1, 2
                ISJ = IR(I, K, 194)
                IF (ISJ .NE. 0) THEN
                  ISS = IR(3, IABS(ISJ), 193)
                  IF (ISJ .LT. 0) ISS = - ISS
                  ITS = ITS - ISS
                END IF
              END DO
              X(9 + K) = FLOAT(ITS / 12)
            END DO
            X(9) = X(5)
            RETURN
   20       X(5) = X(5) - 1
            IF (X(5) .GT. 0) THEN
              GO TO 10
            ELSE
              IF (IUIT .NE. 0)
     1          WRITE (IUIT, 99999, IOSTAT = IOST)
              IER = 1
              RETURN
            END IF
          END IF
          K = 0
          DO I = 1, 3
            DO J = 1, 3
              K = K + 1
              X(K) = IR(I, J, 195)
            END DO
          END DO
          CALL SG10 (X)
        END IF
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('Error at Label 20 in routine SGSM/SG11')
      END SUBROUTINE SG11
      SUBROUTINE SG12 (X, NSM)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      COMMON /SLAUE/ NLAUE, XSYST, IBVL, SITE
      CHARACTER SGT(NRSPGR)*33, LINE*80, NONST(NSTD)*9,
     1 NOSTP(6)*4, YSPG*9, ZSPG*13, NLAUE(14)*5, XSYST(8)*12,
     2 ACENT*2, ICH*1, IBVL(8)*1, SGSMC*59, SITE(NSITE)*5,
     3 TRLTA(NTRL)*13, TRLTB(NTRL)*7, SHFL(230)*6, TXT*13,
     4 NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11, LZSPG*7
      DIMENSION X(12)
      M0   = 0
      NRSM = NSM
      ISWD = 3 - ISW
      IF (ICNTR .EQ. 1 .AND. ILAUE .LT. 0) THEN
        NSTT = NST * 2
      ELSE
        NSTT = NST
      END IF
      IF (ISWD .LT. 0) NSTT = NSTT / IBV
      IF (NRSM .GT. NSTT) NRSM = MOD(NRSM, NSTT)
      NSL = 1
      IF (NRSM .NE. 0) THEN
        NSL  = NRSM
        NSTT = NRSM
        GO TO 10
      END IF
      IF (ICNTRX .EQ. 2 .OR. ILAUE .LT. 0) THEN
        ACENT = ' C'
      ELSE
        ACENT = 'Ac'
      END IF
      IF (LAUE .EQ. 14 .AND. SGSMC(1:1) .NE. 'R') LAUE = JLAUE
      IF (IUIT .NE. 0) THEN
        N = INDEX (SGSMC(1:11), ':')
        IF (N .NE. 0) THEN
          TXT = SGSMC(1:11)
        ELSE IF (SGSMC(8:8) .NE. ' ') THEN
          TXT = SGSMC(1:7)//':'//SGSMC(8:11)
          LZSPG = ZSPG(1:7)
          CALL GEN020 (-1, LZSPG, 2, 7)
          DO J = 1, NNH
            IF (LZSPG .EQ. NHLA(J)) THEN
              SGSMC(33:49) = NHLB(J)
              SGSMC(15:26) = NHLC(J)
            END IF
          END DO
        ELSE
          TXT = SGSMC(1:7)
        END IF
        JUNK = LAUE
        IF (LAUE .EQ. 14 .AND. JLAUE .EQ. 7) JUNK = 7
        WRITE (IUIT, 99999, IOSTAT = IOST) TXT, YSPG, NLAUE(JUNK),
     1    SGSMC(33:49), SGSMC(27:32), SGSMC(12:13), ACENT,
     2    XSYST(IKLS), NSTT, NSYMP, ISGNR
      END IF
      IF (IUIT .EQ. 7) CALL PLA262 (6)
      IF (ICNTR .NE. ICNTRX) THEN
        IF (IUIT .NE. 0)
     1    WRITE (IUIT, 99994, IOSTAT = IOST) OCNT(1), OCNT(2), OCNT(3)
        IF (IUIT .EQ. 7) CALL PLA262 (2)
      END IF
      IF (ILAUE .GT. 0) THEN
        IF (ICNTR .EQ. 1) THEN
          IF (IMPROP .GT. 0) THEN
            IF (IUIT .NE. 0)
     1        WRITE (IUIT, 99995, IOSTAT = IOST) 'CHIRAL '
          ELSE
            IF (IUIT .NE. 0)
     1        WRITE (IUIT, 99995, IOSTAT = IOST) 'ACHIRAL'
          END IF
          IF (IUIT .EQ. 7) CALL PLA262 (2)
        END IF
        IF (IUIT .NE. 0) WRITE (IUIT, 99998, IOSTAT = IOST)
      ELSE
        IF (IUIT .NE. 0) WRITE (IUIT, 99997, IOSTAT = IOST)
      END IF
   10 IF (ISW .EQ. 4) THEN
        ICHS = 26
      ELSE
        ICHS = 11
      END IF
      NSLB = NSL
      DO NSLX = NSLB, NSTT
        NSL = NSLX
        N   = 195
        CALL SG05 (N, NSL)
        IF (IER .NE. 0) GO TO 20
        CALL GEN038 (LINE, 1, 80)
        DO I = 1, 3
          IND = 17 * I - 6 + ISHEL * 4
          IF (I .LT. 3) LINE(IND + 2:IND + 2) = ','
          M = IR(2, I, N)
          IF (M .NE. 0) THEN
            LINE(IND:IND) = ICH(IABS(M) + ICHS)
            IF (M .LT. 0) THEN
              LINE(IND - 2:IND - 2) = '-'
            ELSE
              LINE(IND - 2:IND - 2) = '+'
            END IF
            IND = IND - 4
          END IF
          LINE(IND:IND) = ICH(IABS(IR(1, I, N)) + ICHS)
          IF (IR(1, I, N) .LT. 0) LINE(IND - 2:IND - 2) = '-'
          M = IR(3, I, N)
          IF (ITRL .NE. 0) M = M + ITRL * NINT(X(I + 3))
          IF (M .NE. 0) THEN
            IF (IR(1, I, N) .GT. 0) LINE(IND - 2:IND - 2) = '+'
            IF (ISHEL .EQ. 0) THEN
              IF (M .LT. 0) THEN
                M = - M
                IF (IND .GT. 8) LINE(IND - 8 : IND - 6) = '- -'
              END IF
              IF (MOD(M, 12) .EQ. 0) THEN
                M0 = 12
              ELSE IF (MOD(M, 6) .EQ. 0) THEN
                M0 = 6
              ELSE IF (MOD(M, 4) .EQ. 0) THEN
                M0 = 4
              ELSE IF (MOD(M, 3) .EQ. 0) THEN
                M0 = 3
              ELSE IF (MOD(M, 2) .EQ. 0) THEN
                M0 = 2
              END IF
              IF (M0 .NE. 12) THEN
                LINE(IND - 6:IND - 4) = ICH(M / M0)//'/'//ICH(12 / M0)
              ELSE
                LINE(IND - 4:IND - 4) = ICH(M / M0)
                IF (IND .GT. 8) LINE(IND - 8:IND - 8) = ' '
              END IF
            ELSE
              TRV = FLOAT(IR(3, I, N)) / 12.0
              WRITE (LINE(IND - 10:IND - 4), 99993, IOSTAT = IOST) TRV
            END IF
          END IF
        END DO
        IF (ITRL .NE. 0) CALL GEN047 (LINE, 1, 50)
        IF (IUIT .GT. 0) THEN
          IF (IUIT .EQ. 7) CALL PLA262 (1)
          IF (IUIT .NE. 0)
     1      WRITE (IUIT, 99996, IOSTAT = IOST) NSL, LINE(1:60)
        END IF
      END DO
   20 IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('Space Group  H-M:  ', 2A, 21X, 'Laue:', A, /,
     1 'Space Group Hall: ', A, 16X, '[Schoenflies: ', A, ']', /,
     2 'Lattice Type: ', A, ', ', A, 'entric, ', A, ', Multiplicity: ',
     3 I3, '(', I2, '), No:', I4, /)
99998 FORMAT (2X, 'Nr', 12X, '***** Symmetry Operation(s) *****', /)
99997 FORMAT (2X, 'Nr', 7X, 'Patterson/Laue Symmetry Operation', /)
99996 FORMAT (I4, 5X, A)
99995 FORMAT (A, ' - See P.G. Jones, Acta Cryst. ',
     1        '(1986), A42, 57.', /)
99994 FORMAT ('Shifted Inversion Centre at (', F6.3, ',', F6.3, ',',
     1        F6.3, ')', /)
99993 FORMAT (F7.5)
      END SUBROUTINE SG12
      SUBROUTINE SG13 (LIN, X, NSM)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /SLAUE/ NLAUE, XSYST, IBVL, SITE
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, NONST(NSTD)*9, NOSTP(6)*4,
     1 YSPG*9, ZSPG*13, ICH*1, SGSMC*59,
     2 TRLTA(NTRL)*13, TRLTB(NTRL)*7, SHFL(230)*6,
     3 NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11
      CHARACTER LZSPG*7, XIMP*2, LIN*(*), NLAUE(14)*5, XSYST(8)*12,
     1 IBVL(8)*1, SITE(NSITE)*5
      DIMENSION X(12)
      IF (SGSMC(8:8) .NE. ' ') THEN
        DO I = 2, 6
          IF (SGSMC(8:11) .EQ. NOSTP(I)) THEN
            ZSPG = NONST((NSLOC(ISGNR - 15) - 1) * 6 + I)
            CALL GEN047 (ZSPG, 1, 9)
            YSPG(1:9) = '['//ZSPG(1:7)//']'
            SGSMC(13:13) = ZSPG(1:1)
            GO TO 10
          END IF
        END DO
      END IF
   10 CALL GEN020 (-1, SGSMC, 2, 11)
      CALL GEN020 (-1, YSPG,  3, 8)
      IF (ISW .NE. 18) THEN
        CALL SG12 (X, NSM)
        LIN = LINE
      ELSE
        IF (LAUE .EQ. 14 .AND. SGSMC(1:1) .NE. 'R') LAUE = JLAUE
        X(1) = ISGNR
        X(2) = IKLS
        X(3) = LAUE
        X(4) = NSYMP
        X(5) = ICNTR
        X(6) = IBV
        X(9) = NST
        DO I = 1, 7
          IF (SGSMC(13:13) .EQ. ICH(29 + I)) X(7) = I
          IF (SGSMC(13:13) .EQ. ICH(36 + I)) X(8) = I
        END DO
        IF (SGSMC(14:14) .EQ. 'A') X(8) = - X(8)
        IF (IMPROP .GT. 0 .AND. ICNTR .EQ. 1) THEN
          XIMP = ' C'
        ELSE
          XIMP = '  '
        END IF
        LZSPG = ZSPG(1:7)
        CALL GEN020 (-1, LZSPG, 2, 7)
        IF (SGSMC(9:9) .EQ. ' ') THEN
          ZSPG = SGSMC(1:7)
        ELSE
          DO J = 1, NNH
            IF (LZSPG .EQ. NHLA(J)) THEN
              SGSMC(33:54) = NHLB(J)
              SGSMC(15:26) = NHLC(J)
            END IF
          END DO
        END IF
        LIN =
     1 SGSMC(1:26)//XSYST(IKLS)//NLAUE(LAUE)//SGSMC(33:59)//XIMP//LZSPG
        DO J = 1, 3
          X(J + 9) = 0.0
          IF (ICNTR .EQ. 1) THEN
            DO I = 1, 3
              IF (IORG(I, J) .NE. 0) X(J + 9) = X(J + 9) + 2 ** (I - 1)
            END DO
          END IF
        END DO
      END IF
      RETURN
      END SUBROUTINE SG13
      SUBROUTINE SG14 (X, TRDET)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, NONST(NSTD)*9, NOSTP(6)*4,
     1 YSPG*9, ZSPG*13, XSPG*12, ICH*1, SGSMC*59, NONSTJ*9,
     2 TRLTA(NTRL)*13, TRLTB(NTRL)*7, SHFL(230)*6,
     3 NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11
      DIMENSION X(12)
      CHARACTER CH*1
      ISGN = 0
      LOOP = 0
      DO WHILE (LOOP .EQ. 0)
        LOOP = 1
        DO I = 5, 80
          CH = LINE(I:I)
          IF (CH .EQ. '(' .OR. CH .EQ. ')' .OR.
     1        CH .EQ. '_' .OR. CH .EQ. '~') THEN
            LINE(I:I) = ' '
          ELSE IF (CH .EQ. '[' .OR. CH .EQ. ']') THEN
            LINE(I:I) = ' '
            ITRNS = 0
            NTRNS = 0
          END IF
        END DO
        CALL GEN047 (LINE, 5, 80)
        DO I = 1, NTRL
          J = INDEX (LINE, TRLTA(I))
          IF (J .NE. 0) THEN
            LINE(J:) = TRLTB(I)
            EXIT
          END IF
        END DO
        CALL SG03 (X, TRDET, 1)
        IF (IER .NE. 0) THEN
          LRET = 3
          RETURN
        ELSE
          JJ  = 0
          KK  = 0
          IMD = 0
          CALL GEN038 (SGSMC, 1, 11)
          I = INDEX (LINE, ':')
          IF (I .NE. 0) THEN
            IF (
     1        LINE(I:I+2) .NE. ':1 ' .AND. LINE(I:I+2) .NE. ':2 ' .AND.
     1        LINE(I:I+2) .NE. ':3 ' .AND. LINE(I:I+2) .NE. ':A ' .AND.
     2        LINE(I:I+2) .NE. ':B ' .AND. LINE(I:I+2) .NE. ':C ' .AND.
     3        LINE(I:I+2) .NE. ':N ')  LINE(I:I) = '.'
          END IF
          DO I = 5, 80
            IF (LINE(I:I) .EQ. '.') THEN
              IMD  = 1
              ISGN = 1
            ELSE
              IF (IMD .EQ. 0) THEN
                JJ = JJ + 1
                IF (JJ .GT. 9) EXIT
                SGSMC(JJ:JJ) = LINE(I:I)
                IF (JJ .EQ. 1) THEN
                  SGSMC(13:13) = SGSMC(1:1)
                ELSE
                  IF (SGSMC(JJ:JJ) .EQ. 'R') SGSMC(13:13) = 'P'
                END IF
              ELSE
                KK = KK + 1
                IF (KK .GT. 4) EXIT
                SGSMC(KK + 7:KK + 7) = LINE(I:I)
                IF (LINE(I:I) .EQ. '-') ISGN = -1
                DO L0 = 1, 3
                  IF (LINE(I:I) .EQ. CHAR(ICHAR('A') - 1 + L0)) THEN
                    IABC(L0 + 3) = ISGN
                    JABC(L0 + 3) = IMD
                    IMD          = IMD + 1
                    ISGN         = 1
                  END IF
                END DO
                IF (IMD .EQ. 4) EXIT
              END IF
            END IF
          END DO
        END IF
        IF (IMD .EQ. 0) THEN
          ZSPG = SGSMC(1:9)
        ELSE
          ZSPG = SGSMC(1:7)
        END IF
        IF (ITRNS .EQ. 1) THEN
          CALL GEN038 (SGSMC,  1, 11)
          CALL GEN038 (SGSMC, 15, 32)
          IF (NINT (TRDET) .EQ. 3) THEN
            IF (R1(1, 1) .EQ. -1 .AND. R1(1, 2) .EQ.  1 .AND.
     1          R1(1, 3) .EQ.  0 .AND. R1(2, 1) .EQ.  0 .AND.
     2          R1(2, 2) .EQ. -1 .AND. R1(2, 3) .EQ.  1 .AND.
     3          R1(3, 1) .EQ.  1 .AND. R1(3, 2) .EQ.  1 .AND.
     4          R1(3, 3) .EQ.  1) THEN
              IER = 14
              WRITE (IUIT, 99998, IOSTAT = IOST)
              WRITE (6,    99998, IOSTAT = IOST)
              RETURN
            END IF
          END IF
          CALL SG21 (TRDET)
        ELSE
          IF (SGSMC(1:1) .EQ. 'A') THEN
            SGSMC(13:13) = CHAR(ICHAR('A') + JABC(4) - 1)
          ELSE IF (SGSMC(1:1) .EQ. 'B') THEN
            SGSMC(13:13) = CHAR(ICHAR('A') + JABC(5) - 1)
          ELSE IF (SGSMC(1:1) .EQ. 'C') THEN
            SGSMC(13:13) = CHAR(ICHAR('A') + JABC(6) - 1)
          END IF
        END IF
        DO JJ = 1, NRSPGR
          XSPG = SGT(JJ)(1:12)
          CALL GEN047 (XSPG, 1, 12)
          IF (ZSPG(1:9) .EQ. XSPG(1:9)) THEN
            READ (SGT(JJ)(13:15), 99997) ISGNR
            IF (SGSMC(15:15) .EQ. ' ') THEN
              SGSMC(15:54) = SGT(JJ)(1:12)//SHFL(ISGNR)//SGT(JJ)(16:32)
            ELSE
              SGSMC(38:54) = SGT(JJ)(16:32)
            END IF
            WRITE (SGSMC(55:59), 99996, IOSTAT = IOST) NSGF(ISGNR)
            LINE = '    '//SGT(JJ)(16:32)
            IF (ITRNS .EQ. 1) THEN
              IKLS  = 8
              ISGNR = 0
            END IF
            CALL SG01 (1)
            IF (IER .NE. 0) THEN
              LRET = 3
            ELSE
              LRET = 2
            ENDIF
            RETURN
          END IF
        END DO
        YSPG(1:9) = '['//ZSPG(1:7)//']'
        DO J = 1, NSTD
          NONSTJ = NONST(J)
          CALL GEN047 (NONSTJ, 1, 9)
          IF (ZSPG(1:9) .EQ. NONSTJ) THEN
            SGSMC(15:24) = NONST(J)
            JA = ((J - 1) / 6) * 6
            WRITE (LINE, 99998, IOSTAT = IOST)
     1        NONST(JA + 1), NOSTP(J - JA)
            LOOP = 0
            EXIT
          END IF
        END DO
      END DO
      IF (IUIT .NE. 0) WRITE (IUIT, 99999, IOSTAT = IOST) SGSMC(1:11)
      CALL SG03 (X, TRDET, 1)
      IER  = 5
      NST  = 0
      LRET = 3
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (//, ':: Space Group Symbol not Known ', //,
     1 ':: No GENERATORS for this non-standard Space Group ', A,
     2 ' available ...', //,
     3 ':: Please supply generators explicitly with LATT/SYMM',
     4 ' instructions.', /)
99998 FORMAT ('SPGR ', A, '.', A, 61X)
99997 FORMAT (I3)
99996 FORMAT (I5)
      END SUBROUTINE SG14
      SUBROUTINE SG15 (X, N, NSM)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      DIMENSION X(12)
C * LOAD ROTATION MATRIX FOR NSM IN X(1:9) AND TRANSLATION VECTOR IN X(10:12)
      NSL = NSM
      CALL SG05 (N, NSL)
      IF (IER .EQ. 0) THEN
        DO I = 1, 12
          IF (I .GT. 9) THEN
            X(I) = IR(3, I - 9, N) / 12.0
          ELSE
            X(I) = 0.0
          END IF
        END DO
        DO I = 1, 2
          DO K = 1, 3
            IRIK = IR(I, K, N)
            IF (IRIK .NE. 0) THEN
              ISIK = 1
              IF (IRIK .LT. 0) ISIK = -1
              X((K - 1) * 3 + IABS(IRIK)) = ISIK
            END IF
          END DO
        END DO
      END IF
      RETURN
      END SUBROUTINE SG15
      SUBROUTINE SG16 (LIN, X)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /SLAUE/ NLAUE, XSYST, IBVL, SITE
      DIMENSION X(12), YAV(3)
      CHARACTER IBVL(8)*1, NLAUE(14)*5, XSYST(8)*12, SITE(NSITE)*5,
     1 LIN*(*)
      ISWD = 1
      ISYM = 0
      IF (X(10) .GT. 0.0) THEN
        TOL = X(10)
      ELSE
        TOL = 0.005
      END IF
      DO L = 1, 3
        X(L + 3) = 0.0
        X(L + 6) = 0.0
        YAV(L)   = X(L)
      END DO
      NSP  = 1
      IF (NST .GT. 1) THEN
        DO 10 L = 2, NST
          NSM = L
          CALL SG09 (X, NSM)
          IF (IER .NE. 0) GO TO 30
          DO I = 1, 3
            NDIF = INT (100.0 + X(6 + I) - X(I)) - 100
            X(6 + I) = X(6 + I) - NDIF
            DIFF = X(6 + I) - X(I)
            IF (DIFF .GT. 0.5) THEN
              DIFF = 1.0 - DIFF
              X(6 + I) = X(6 + I) - 1.0
            END IF
            IF (DIFF .GT. TOL) GO TO 10
          END DO
          NSP = NSP + 1
          DO I = 1, 3
            YAV(I) = YAV(I) + X(6 + I)
          END DO
          K   = 0
          IRT = 0
          DO I = 1, 2
            DO J = 1, 3
              IRT = IRT + IR(I, J, NSM) * 7**K
              K   = K + 1
            END DO
          END DO
          DO J = 1, NOPR
            IF (IRT .EQ. IOPR(J)) THEN
              ISYM = ISYM + 2**(J - 1)
              GO TO 10
            END IF
          END DO
   10   CONTINUE
      END IF
      DO I = 1, 3
        YUNK = MOD (100.0 + (YAV(I) / NSP), 1.0)
        X(6 + I) = YUNK - NINT(YUNK - X(I))
      END DO
      DO I = 1, NSITE
        IF (ISYM .EQ. KSITE(I)) GO TO 20
      END DO
      I     = 1
   20 X(12) = I
      X(11) = ISYM
      X(10) = 1.0 / NSP
      IF (IKLS .EQ. 4) THEN
        IF (I .EQ. 3) THEN
          I = 12
        ELSE IF (I .EQ. 4) THEN
          I = 9
        ELSE IF (I .EQ. 5) THEN
          I = 15
        ELSE IF (I .EQ. 12) THEN
          I = 7
        END IF
      END IF
      LIN(1:5) = SITE(I)
   30 RETURN
      END SUBROUTINE SG16
      SUBROUTINE SG17 (X, TRDET)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, NONST(NSTD)*9, ICH*1,
     1 NOSTP(6)*4, YSPG*9, ZSPG*13, SGSMC*59, SHFL(230)*6,
     2 TRLTA(NTRL)*13, TRLTB(NTRL)*7, NHLA(NNH)*7, NHLB(NNH)*15,
     3 NHLC(NNH)*11
      DIMENSION X(12)
      CALL SG03 (X, TRDET, 1)
      IF (IER .EQ. 0) THEN
        J = 0
        DO I = 5, 80
          IF (LINE(I:I) .NE. ' ' .AND. LINE(I:I) .NE. '-') THEN
            DO L = 1, 7
              IF (LINE(I:I) .EQ. CHAR(ICHAR('0') + L)) THEN
                SGSMC(13:13) = ICH(36 + L)
                IF (LINE(I - 1:I - 1) .NE. '-') SGSMC(14:14) = 'C'
                GO TO 10
              END IF
            END DO
            J = J + 1
            SGSMC(J + 12:J + 12) = LINE(I:I)
          END IF
        END DO
   10   IF (ITRNS .NE. 0) CALL SG21 (TRDET)
        CALL SG04
      END IF
      RETURN
      END SUBROUTINE SG17
      SUBROUTINE SG18 (MODE, NST)
      DIMENSION X(12)
      CHARACTER LIN*80
      LU = 80
      OPEN (LU, FILE = 'SAVESYMM', STATUS = 'UNKNOWN')
      IF (MODE .EQ. 1) THEN
        DO I = 1, NST
          NSM = I
          CALL SG15 (X, 195, NSM)
          WRITE (LU, 99999, IOSTAT = IOST)
     1      (X(J), J = 1, 9), (X(K), K = 10, 12)
        END DO
        CLOSE (LU)
      ELSE IF (MODE .EQ. -1) THEN
        NRET = 0
        CALL SG03 (X, TRDET, 1)
        DO
          READ (LU, 99999, END = 10) (X(J), J = 1, 9),
     1                               (X(K), K = 10, 12)
          CALL SG19 (LIN, X, NSM, NRET)
        END DO
   10   CLOSE (LU, STATUS = 'DELETE')
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (9F5.2, 3F10.5)
      END SUBROUTINE SG18
      SUBROUTINE SG19 (LIN, X, NSM, NRET)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, LIN*(*), NONST(NSTD)*9, ICH*1,
     1 NOSTP(6)*4, YSPG*9, ZSPG*13, SGSMC*59,
     2 SHFL(230)*6, TRLTA(NTRL)*13, TRLTB(NTRL)*7, NHLA(NNH)*7,
     3 NHLB(NNH)*15, NHLC(NNH)*11
      COMMON /CSG19/ JB, JE, NIC, NICM, NUMS, NSLP, JS, TRDET
      DIMENSION X(12), XSAV(3)
      CHARACTER OLAT*2
      NRET = 0
      FLT  = 0.0
      IN   = 0
      ISNN = 0
      KTRV = 0
      DO
        IF (ISW .EQ. 11) THEN
          DO I = 4, 6
            IABC(I) = 1
            JABC(I) = I - 3
          END DO
          IF (NST .EQ. 1) THEN
            CALL SG03 (X, TRDET, 0)
            IF (IER .NE. 0) RETURN
          END IF
          JB   = 5
          JE   = 80
          JSWD = 0
        ELSE IF (ISW .EQ. 15 .OR. ISW .EQ. 26) THEN
          DO I = 1, 3
            DO J = 1, 3
              R0(J, I) = X(I + (J - 1) * 3)
            END DO
            T0(I) = X(I + 9)
          END DO
          JB = 1
          JE = 20
          CALL SG02 (JB)
          IF (IER .NE. 0) RETURN
          DO I = 4, 6
            IABC(I) = 1
            JABC(I) = I - 3
          END DO
          JSWD = 0
        ELSE
          JB  = JB + 20
          JE  = JB + 19
          NIC = NICM
          IF (JB .GT. 80 .OR. LINE(JB:JB) .EQ. ' ') THEN
            IF (LRET .EQ. 1) THEN
              ISGNR = NUMS
              SGSMC(15:54) = SGT(JS)(1:12)//SHFL(NUMS)//SGT(JS)(16:32)
              IF (NSLP .GT. 1) SGSMC(8:11) = NOSTP(NSLP)
              JLAUE = 8
              L0    = 0
              DO L = 1, 12
                IF (SGT(JS)(L + 15:L + 15) .EQ. '"') JLAUE = 7
                IF (SGT(JS)(L:L) .NE. ' ') THEN
                  L0           = L0 + 1
                  SGSMC(L0:L0) = SGT(JS)(L:L)
                END IF
              END DO
              CALL SG13 (LIN, X, NSM)
            ELSE IF (LRET .EQ. 2) THEN
              CALL SG04
            END IF
            RETURN
          END IF
        END IF
        NTRNS = ITRNS
   10   IC    = 0
        JL    = JB - 1
        NCOM  = 0
   20   IF (IC .GT. 0) THEN
          KABC = JABC(IC + NIC)
          IF (IN .EQ. 2) THEN
            IR(2, KABC, 195) = 0
          ELSE IF (IN .GT. 2) THEN
            IF (IABS(IR(1, KABC, 195)) .GT. IABS(IR(2, KABC, 195)))
     1        CALL GEN014 (IR(1, KABC, 195), IR(2, KABC, 195))
          END IF
          FFLT0 = ISNN * FLT * 12.0
          FFLT  = MOD (FFLT0, 12.0)
          IF (FFLT .LT. 0.0) FFLT = FFLT + 12.0
          IF (NSGET .EQ. 1) XSAV(IC) = FFLT0 - FFLT
          NFLT = NINT(FFLT)
          IF (NFLT .EQ. 1  .OR. NFLT .EQ. 5 .OR. NFLT .EQ. 7 .OR.
     1        NFLT .EQ. 11 .OR. ABS(FFLT - NFLT) .GT. 0.01) THEN
            IF (IUIT .NE. 0)
     1        WRITE (IUIT, 99999, IOSTAT = IOST) LINE(1:40)
            IER = 2
            RETURN
          END IF
          IR(3, JABC(IC + NIC), 195) = MOD(IABC(IC + NIC)
     1        * NFLT + 12, 12)
        END IF
        IC   =  IC + 1
        IN   =  1
        ITRV = -1
        IFLT =  0
        FLT  =  0.0
        IFRC =  0
        ISNN =  1
        ISN  =  1
   30   IF (JL .LT. JE) THEN
          JL = JL + 1
          DO K = 1, 21
            IF (LINE(JL:JL) .EQ. ICH(K)) THEN
              CALL GEN038 (LINE, JL, JL)
              IF (K .EQ. 20 .OR. K .EQ. 21) THEN
                ITRNS = 0
                NTRNS = 0
              ELSE IF (K .LT. 10) THEN
                IF (IFLT .EQ. 0) THEN
                  IF (ITRV .NE. 0) THEN
                    IF (ITRV .LT. 0) THEN
                      ITRV = K
                      KTRV = K
                      INM  = 1
                    ELSE
                      INM  = K
                    END IF
                    ISNN = ISN
                    IF (KTRV .GT. K .AND. NSGET .EQ. 0)
     1                  ITRV = MOD(KTRV, K)
                    FLT  = FLOAT(ITRV) / FLOAT(INM)
                    IFRC = IFRC + 1
                    IF (IFRC .GT. 2) THEN
                      IF (IUIT .NE. 0)
     1                  WRITE (IUIT, 99999, IOSTAT = IOST) LINE(1:40)
                      IER = 2
                    END IF
                  END IF
                ELSE
                  FLT  = FLT  + K * 10.0**IFLT
                  IFLT = IFLT - 1
                  ISNN = ISN
                END IF
              ELSE IF (K .EQ. 11) THEN
                IFLT = IFLT - 1
                ISNN = ISN
              ELSE IF (K .GT. 11 .AND. K .LT. 15) THEN
                KM11 = K - 11
                IR(IN, JABC(IC + NIC), 195) =
     1            IABC(IC + NIC) * ISN * JABC(KM11 + NIC)
     2            * IABC(KM11 + NIC)
                IN   = IN + 1
                ISN  = 1
              ELSE IF (K .EQ. 16) THEN
                NCOM = NCOM + 1
                GO TO 20
              ELSE IF (K .EQ. 17) THEN
                ISN = 1
              ELSE IF (K .EQ. 18) THEN
                ISN = - 1
              END IF
              GO TO 30
            END IF
          END DO
          IF (IUIT .NE. 0)
     1      WRITE (IUIT, 99999, IOSTAT = IOST) LINE(1:40)
          IER = 2
          RETURN
        ELSE IF (JL .EQ. JE) THEN
          JL = JL + 1
          GO TO 20
        ELSE
          IF (IC .LT. 3 .OR. (IC .EQ. 3 .AND. IN .LT. 2) .OR.
     1        NCOM .NE. 2) THEN
            IF (IUIT .NE. 0)
     1        WRITE (IUIT, 99999, IOSTAT = IOST) LINE(1:40)
            IER = 2
            RETURN
          END IF
          IF (NSGET .EQ. 1) THEN
            DO J = 1, 3
              X(J)     = IR(1, J, 195)
              X(J + 3) = IR(2, J, 195)
              X(J + 6) = IR(3, J, 195) + XSAV(J)
            END DO
            ISW = 7
            CALL SG10 (X)
            RETURN
          END IF
          IF (ISW .EQ. 11 .OR. ISW .EQ. 15 .OR. ISW .EQ. 26) THEN
            N = IR(3, 1, 195) * 100 + IR(3, 2, 195) * 10 + IR(3, 3, 195)
            ISKIP = 0
            SELECT CASE (SGSMC(13:13))
              CASE ('P')
                ISKIP = 1
              CASE ('A')
                IF (N .NE. 66)  ISKIP = 1
              CASE ('B')
                IF (N .NE. 606) ISKIP = 1
              CASE ('C')
                IF (N .NE. 660) ISKIP = 1
              CASE ('I')
                IF (N .NE. 666) ISKIP = 1
              CASE ('F')
                IF (N .NE. 660 .AND. N .NE. 606 .AND. N .NE. 66)
     1            ISKIP = 1
              CASE ('R')
                IF (N .NE. 844 .AND. N .NE. 488) ISKIP = 1
            END SELECT
            IF (ISKIP .EQ. 0) THEN
              DO J = 1, 3
                IR(3, J, 195) = 0
              END DO
            END IF
          END IF
C * CONVERT SYMMETRY OPERATION INTO (R|t) MATRICES
          CALL GEN021 (R3, 0)
          DO I = 1, 3
            DO J = 1, 2
              N = IR(J, I, 195)
              IF (N .NE. 0) R3(I, IABS(N)) = SIGN(1.0, FLOAT(N))
            END DO
            T3(I) = FLOAT(IR(3, I, 195)) / 12.0
          END DO
          IF (ISW .EQ. 11 .OR. ISW .EQ. 12 .OR. ISW .EQ. 15 .OR.
     1        ISW .EQ. 21 .OR. ISW .EQ. 26) THEN
            IMPROP = MIN (IMPROP, NINT(GEN130 (R3)))
          END IF
          IF (NTRNS .GT. 0) THEN
            NTRNS = 0
            CALL GEN132 (R2, R3, R1, R0)
            CALL GEN002 (1, R2, T3, T0, XLNG)
            DO I = 1, 3
              T0(I) = T0(I) + OSFT(I)
              DO J = 1, 3
                T0(I) = T0(I) - R0(I, J) * OSFT(J)
              END DO
            END DO
            NIC = 0
            CALL GEN038 (SGSMC, 1, 1)
            CALL GEN038 (YSPG, 1, 9)
            CALL SG02 (JB)
            IF (IER .NE. 0) RETURN
            JSWD = 0
            GO TO 10
          END IF
          IF (ISW .NE. 2 .AND. ISW .NE. 4 .AND. ISW .NE. 18) THEN
            NSYMO = NSYMP
            OLAT  = SGSMC(13:14)
            CALL SG07
            IF (IER .NE. 0) RETURN
            IF (SGSMC(13:14) .NE. OLAT) THEN
              GO TO 60
            END IF
            IF (NSYMP .GE. 48) THEN
              CALL SG04
              RETURN
            END IF
            IF (NSYMP .GT. 1) THEN
              II = 1
              DO WHILE (II .LT. NSYMP)
                II = II + 1
                I  = II
                JM = 2 * II - 2
                CALL SG05 (194, I)
                IF (IER .NE. 0) RETURN
                DO JJ = 2, JM
                  J = JJ
                  IF (JJ .GT. II) THEN
                    J = II
                    I = 2 * II - JJ
                    CALL SG05 (194, I)
                    IF (IER .NE. 0) RETURN
                  END IF
                  CALL SG05 (193, J)
                  IF (IER .NE. 0) RETURN
                  CALL SG06
                  CALL SG07
                  IF (IER .NE. 0) RETURN
                  IF (SGSMC(13:14) .NE. OLAT) THEN
                    NSYMP = NSYMO
                    GO TO 60
                  END IF
                  IF (NSYMP .GE. 48) THEN
                    CALL SG04
                    RETURN
                  END IF
                END DO
              END DO
            END IF
          ELSE
            DO 50 I = 1, NST
              DO J = 1, 3
                DO K = 1, 3
                  IF (IR(J, K, I) .NE. IR(J, K, 195)) GO TO 50
                END DO
              END DO
              GO TO 60
   50       CONTINUE
            NRET = 1
            RETURN
          END IF
        END IF
   60   IF (ISW .EQ. 11 .OR. ISW .EQ. 15 .OR. ISW .EQ. 26) THEN
          CALL SG04
          RETURN
        END IF
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, ':: Error in SYMM line syntax !!, ',
     1        /, ':: Line ignored: ', A, /)
      END SUBROUTINE SG19
      SUBROUTINE SG20 (NGO, X, NSM, LIN)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80, LIN*(*), NONST(NSTD)*9, ICH*1,
     1 IBRAV*1, NOSTP(6)*4, YSPG*9, ZSPG*13, SGSMC*59, BLT*1, XCHAR*1,
     2 SHFL(230)*6, TRLTA(NTRL)*13, TRLTB(NTRL)*7, NHLA(NNH)*7,
     3 NHLB(NNH)*15, NHLC(NNH)*11
      COMMON /CSG19/ JB, JE, NIC, NICM, NUMS, NSLP, JS, TRDET
      DIMENSION X(12)
      IF (ABS(NGO) .EQ. 1) THEN
        IF (NGO .EQ. -1) THEN
          CALL SG19 (LIN, X, NSM, NRET)
          IF (NRET .EQ. 0) RETURN
        END IF
        GO TO 20
      ELSE
        ISWD  = 1
        JSWD  = 1
        NTRNS = 0
        DO I = 1, NST
          NSL = I
          CALL SG05 (NSL, NSL)
          IF (IER .NE. 0) RETURN
        END DO
      END IF
      JS = JSMX + 1
   10 JS = JS   - 1
      IF (JS .LT. JSMI) THEN
        CALL SG13 (LIN, X, NSM)
        RETURN
      END IF
      IF (ISTO .EQ. 1 .AND. SGT(JS)(33:33) .EQ. ' ') GO TO 10
      NSLP = 0
      NICM = 3
      NIC  = NICM
      N = INDEX (SGT(JS)(16:32), '-1')
      IF (N .GT. 0) THEN
        IF (SGT(JS)(15+N:N+17) .EQ. '-1)') N = 0
      END IF
      IF (SGT(JS)(16:16) .EQ. '-' .OR. N .NE. 0) THEN
        ISGC = 2
      ELSE
        ISGC = 1
      END IF
      IF (ISGC .NE. ICNTRX) GO TO 10
      IBRAV = SGSMC(13:13)
   20 NSLP  = NSLP + 1
      IF (NSLP .EQ. 1) THEN
        NSLPM = 1
        N     = 0
        READ (SGT(JS)(13:15), 99999) NUMS
        IF (NUMS .GT. 15 .AND. NUMS .LT. 75) THEN
          N = INDEX (SGT(JS)(1:12), ':1')
          IF (N .EQ. 0) THEN
            IF (NSLOC(NUMS - 15) .GT. 0) NSLPM = 6
          END IF
        END IF
        BLT = SGT(JS)(1:1)
        IF (BLT .EQ. 'R') THEN
          IF (INDEX (SGT(JS)(2:12), 'R') .NE. 0) BLT = 'P'
        END IF
      ELSE
        IF (NSLP .GT. NSLPM) GO TO 10
        BLT = NONST((NSLOC(NUMS - 15) - 1) * 6 + NSLP)(1:1)
      END IF
      SGSMC(13:13) = IBRAV
      IF (BLT .NE. IBRAV) GO TO 20
      IMD  = 1
      ISGN = 1
      DO KK = 1, 4
        XCHAR = NOSTP(NSLP)(KK:KK)
        IF (XCHAR .EQ. '-') THEN
          ISGN = -1
        ELSE
          DO L0 = 1, 3
            IF (XCHAR .EQ. CHAR(ICHAR('A') - 1 + L0)) THEN
              IABC(L0 + 3) = ISGN
              JABC(L0 + 3) = IMD
              IMD          = IMD + 1
              ISGN         = 1
            END IF
          END DO
        END IF
      END DO
      LINE = '    '//SGT(JS)(16:32)
      CALL SG01 (0)
      IF (IER .EQ. 0) THEN
        LRET = 1
        JB   = -19
        CALL SG19 (LIN, X, NSM, NRET)
        IF (NRET .EQ. 1) GO TO 20
      END IF
      RETURN
99999 FORMAT (I3)
      END SUBROUTINE SG20
      SUBROUTINE SG21 (DET)
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      CHARACTER SGT(NRSPGR)*33, LINE*80,
     1 NONST(NSTD)*9, NOSTP(6)*4, YSPG*9, ICH*1, SGSMC*59, ZSPG*13,
     3 TRLTA(NTRL)*13, TRLTB(NTRL)*7, SHFL(230)*6,
     4 NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11
      K = 0
      DO N = 1, 7
        IF (SGSMC(13:13) .EQ. ICH(N + 29)) THEN
          IDET = NINT(IBV0(N) * DET)
          IF (IDET .EQ. 4) THEN
            SGSMC(13:13) = 'F'
          ELSE IF (IDET .EQ. 3) THEN
            SGSMC(13:13) = 'R'
          ELSE IF (IDET .EQ. 2) THEN
            IBVX = 3
            IF (N .GT. 1) THEN
              IBVP = IBV1(N) - 1
              DO J = 1, 3
                R2(J, 4) = 0.0
                DO K = 1, 3
                  R2(J, 4) = R2(J, 4) + R2(J, K) * IBV2(IBVP + K) / 12.0
                END DO
              END DO
              IBVX = 4
            END IF
            DO J = 1, IBVX
              K = 0
              DO I = 1, 3
                IF (ABS(0.5 - ABS(AMOD(R2(I, J), 1.0))) .LT. 0.1)
     1            K = K + 2**(I - 1)
              END DO
              IF (K .GT. 2 .AND. K .NE. 4) EXIT
            END DO
            IF (K .EQ. 6) THEN
              SGSMC(13:13) = 'A'
            ELSE IF (K .EQ. 5) THEN
              SGSMC(13:13) = 'B'
            ELSE IF (K .EQ. 3) THEN
              SGSMC(13:13) = 'C'
            ELSE IF (K .EQ. 7) THEN
              SGSMC(13:13) = 'I'
            END IF
          ELSE
            SGSMC(13:13) = 'P'
          END IF
          IF (SGSMC(14:14) .EQ. 'C') THEN
            DO I = 1, 3
              L = NINT(AMOD(ABS(2.0 * OSFT(I)), 1.0) * 12.0)
              IF (L .NE. 0 .AND. L .NE. 6) THEN
                IF (IUIT .NE. 0) WRITE (IUIT, 99998, IOSTAT = IOST)
                SGSMC(14:14) = 'A'
              END IF
            END DO
          END IF
          RETURN
        END IF
      END DO
      IF (IUIT .NE. 0) WRITE (IUIT, 99999, IOSTAT = IOST) SGSMC(13:13)
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (':: Cannot Transform Lattice: ', A)
99998 FORMAT (':: Origin shift not compatible with inversion on 0,0,0')
      END SUBROUTINE SG21
      BLOCK DATA SGSMD
      PARAMETER (NANO = 14, NMON = 117, NORT = 74, NTETL = 17,
     1 NTETH = 65, NTRIL = 8, NTRIH = 24, NHEXL = 9, NHEXH = 18,
     2 NCUBL = 15, NCUBH = 28, NRSPGR = NANO + NMON + NORT + NTETL +
     3 NTETH + NTRIL + NTRIH + NHEXL + NHEXH + NCUBL + NCUBH,
     4 NTRL = 202, NOPR = 18, NSITE = 70, NNH = 175, NSTD = 300,
     4 NMONA  = NANO   + 1, NMONB  = NANO   + NMON,
     5 NORTA  = NMONB  + 1, NORTB  = NMONB  + NORT,
     6 NTETLA = NORTB  + 1, NTETLB = NORTB  + NTETL,
     7 NTETHA = NTETLB + 1, NTETHB = NTETLB + NTETH,
     8 NTRILA = NTETHB + 1, NTRILB = NTETHB + NTRIL,
     9 NTRIHA = NTRILB + 1, NTRIHB = NTRILB + NTRIH,
     * NHEXLA = NTRIHB + 1, NHEXLB = NTRIHB + NHEXL,
     1 NHEXHA = NHEXLB + 1, NHEXHB = NHEXLB + NHEXH,
     2 NCUBLA = NHEXHB + 1, NCUBLB = NHEXHB + NCUBL,
     3 NCUBHA = NCUBLB + 1, NCUBHB = NCUBLB + NCUBH)
      COMMON /CSPGR/ IS(3, 3, 48), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6),
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NST, ISWD, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 4),
     6 LRET, NSLOC(59), NSGF(230), NSGET, NTRNS, JLAUE, ISHEL, ITRL,
     7 NSLPM, ISTO, IER
      COMMON /CSGSM/ ICH(43), SGT, NONST, NOSTP, SGSMC, YSPG, ZSPG,
     1 NHLA, NHLB, NHLC, TRLTA, TRLTB, LINE, SHFL
      COMMON /SLAUE/ NLAUE, XSYST, IBVL, SITE
      CHARACTER SGT(NRSPGR)*33, LINE*80, NONST(NSTD)*9, NOSTP(6)*4,
     1 NLAUE(14)*5, XSYST(8)*12, ICH*1, IBVL(8)*1, SGSMC*59, YSPG*9,
     2 SITE(NSITE)*5, ZSPG*13, TRLTA(NTRL)*13, TRLTB(NTRL)*7,
     3 SHFL(230)*6, NHLA(NNH)*7, NHLB(NNH)*15, NHLC(NNH)*11
      DATA NLAUE /
     1  '   -1', '  2/m', '  mmm', '  4/m', '4/mmm', '   -3', ' -3m1',
     2  ' -31m', '  6/m', '6/mmm', '  m-3', ' m-3m', '     ', '  -3m'/
      DATA XSYST /'   Triclinic', '  Monoclinic', 'Orthorhombic',
     1            '  Tetragonal', '    Trigonal', '   Hexagonal',
     2            '       Cubic', '            '/
      DATA SITE /
     1 '    1', '   -1', '  ..2', '  ..m', '..2/m', '  .m.', '  .2.',
     2 '.2/m.', '  m..', '  mm2', '  m2m', '  2..', '  2mm', '  222',
     3 '2/m..', '  mmm', '   m-', '   2-', ' 2/m-', '   m+', 'mm2+-',
     4 ' m2m-', '   2+', ' m2m+', '222+-', ' 2/m+', 'mmm+-', '  4..',
     5 '  4mm', '  422', ' -4..', ' -42m', ' -4m2', '4/m..', '4/mmm',
     6 '  .3.', ' .-3.', '   23', '   m3', '   3m', '  .32', '  -3m',
     7 '  432', ' -43m', '  m3m', '  3..', ' -3..', '  6..', ' -6..',
     8 '  6/m', '  3.m', '  3.2', ' -3.m', '  3m.', '  6mm', ' -6m2',
     9 '  32.', ' -62m', '  622', ' -3m.', '6/mmm', '  .3.', '  .32',
     * ' .-3.', '  .3.', '  .32', ' .-3.', '  .3.', '  .32', ' .-3.'/
      DATA KSITE/
     1      0,       1,       2,       4,       7,       8,      16,
     2     25,      32,      42,      52,      64,      76,      82,
     3     97,     127,     128,     256,     385,     512,     642,
     4    772,    1024,    1156,    1282,    1537,    1927,    2050,
     5   2730,    3410,    4098,    4818,    5418,    6151,    8191,
     6   8192,    8193,    8274,    8319,    8320,    8448,    8577,
     7  11602,   13010,   16383,   16384,   16385,   16386,   16388,
     8  16391,   16512,   16640,   16769,   16896,   17026,   17156,
     9  17408,   17540,   17666,   17921,   18311,   32768,   33024,
     *  32769,   65536,   65792,   65537,  131072,  131328,  131073/
      DATA IOPR /-162,  132, -132,  134, -134,   160, -160, 156, -156,
     1            138, -138,  152, -142,   72, -4650,  -68, -30,   26/
      DATA NOSTP /'ABC ', 'BA-C', 'CAB ', '-CBA', 'BCA ', 'A-CB'/
      DATA IBV0 /1, 2, 2, 2, 4, 2, 3/
      DATA IBV1 /0, 1, 4, 7, 1, 10, 13/
      DATA IBV2 /0, 6, 6, 6, 0, 6, 6, 6, 0, 6, 6, 6, 4, 8, 8, 8, 4, 4/
      DATA IBVL /'a', 'm', 'o', 't', 'r', 'h', 'c', ' '/
      DATA ICH /'1','2','3','4','5','6','7','8','9','0','.','X','Y','Z',
     1  ' ',',','+','-','/','[',']','A',' ','B','C','I','H','K','L','P',
     2  'A','B','C','F','I','R','P','I','R','F','A','B','C'/
      DATA (NHRM(I), I = 1, 198)/
     1  1, 0,  0,  0,  1, 0, 0,  0,  1,  1, 0,  0,  0, -1, 0, 0,  0, -1,
     2  1, 0,  0,  0,  0, 1, 0, -1, -1,  1, 0,  0,  0,  0, 1, 0, -1,  0,
     3  1, 0,  0,  0,  1, 1, 0, -1,  0,  1, 0,  0,  0,  1, 0, 0,  0,  1,
     4 -1, 0,  0,  0,  1, 0, 0,  0, -1, -1, 0, -1,  0,  1, 0, 1,  0,  0,
     5  0, 0, -1,  0,  1, 0, 1,  0,  0,  0, 0, -1,  0,  1, 0, 1,  0,  1,
     6  1, 0,  0,  0,  1, 0, 0,  0,  1, -1, 0,  0,  0, -1, 0, 0,  0,  1,
     7  0, 1,  0, -1, -1, 0, 0,  0,  1,  0, 1,  0, -1,  0, 0, 0,  0,  1,
     8  1, 1,  0, -1,  0, 0, 0,  0,  1, -1, 0,  0,  0,  0,-1, 0, -1,  0,
     9 -1, 0,  0,  0,  0, 1, 0,  1,  0,  0, 0, -1,  0, -1, 0,-1,  0,  0,
     *  0, 0,  1,  0, -1, 0, 1,  0,  0,  0,-1,  0, -1,  0, 0, 0,  0, -1,
     1  0, 1,  0,  1,  0, 0, 0,  0, -1,  0, 1,  0,  0,  0, 1, 1,  0,  0/
      DATA (NSGF(I), I = 1, 230) /
     1   799, 15327,    20,  5116,   763,     3,   325,    53,   844,
     2    15,   596,   471,   434, 30824,  5965,     6,     6,   426,
     3  8608,   185,     7,     3,    18,     3,     1,    31,     5,
     4     1,   636,    13,    76,    25,  1404,    31,     2,   140,
     5    10,     4,     8,    22,    80,    14,   293,    11,    79,
     6    12,     1,     5,     1,     5,     8,    73,    13,    33,
     7    29,   309,   135,    79,    50,   811,  3481,  1465,   127,
     8   160,     6,    11,     4,    30,     9,    68,     9,    57,
     9    22,    11,     7,   187,     8,  -187,    22,    22,    23,
     *   136,     4,    13,    88,   128,    58,   279,     2,     8,
     1    11,   378,     2,    20,   -11,  -378,     3,     3,     0,
     2     0,     2,     5,     0,    12,     1,     7,     7,     6,
     3    10,    36,     3,     0,    42,   139,     2,     3,     7,
     4    24,     8,     4,    31,    42,     4,    15,     1,    16,
     5     6,     5,    18,    34,     3,     1,     4,     6,     6,
     6    24,    16,     6,    18,     6,    15,    40,    27,   144,
     7  -106,   115,    84,   365,     0,     8,     4,   133,    -4,
     8  -133,    35,     1,     2,     8,    15,    37,   101,     2,
     9    31,    11,    41,    32,   102,     2,   106,  -106,     6,
     *    -6,    59,     3,     1,   164,     0,    16,     5,     7,
     1    -7,     4,     2,     0,     4,    24,     0,     0,     4,
     2    13,     3,     7,     1,    20,     0,     2,     6,    58,
     3     1,     3,     3,     4,     3,     9,    88,     8,     2,
     4     0,     2,     1,     0,     5,    -5,     0,     8,     7,
     5    25,    15,     8,    15,    10,     9,     5,     4,    24,
     6     2,    16,     7,    20,     1/
      DATA (SHFL(I), I = 1, 230) /
     1 'C1^1  ', 'Ci^1  ', 'C2^1  ', 'C2^2  ', 'C2^3  ', 'Cs^1  ',
     2 'Cs^2  ', 'Cs^3  ', 'Cs^4  ', 'C2h^1 ', 'C2h^2 ', 'C2h^3 ',
     3 'C2h^4 ', 'C2h^5 ', 'C2h^6 ', 'D2^1  ', 'D2^2  ', 'D2^3  ',
     4 'D2^4  ', 'D2^5  ', 'D2^6  ', 'D2^7  ', 'D2^8  ', 'D2^9  ',
     5 'C2v^1 ', 'C2v^2 ', 'C2v^3 ', 'C2v^4 ', 'C2v^5 ', 'C2v^6 ',
     6 'C2v^7 ', 'C2v^8 ', 'C2v^9 ', 'C2v^10', 'C2v^11', 'C2v^12',
     7 'C2v^13', 'C2v^14', 'C2v^15', 'C2v^16', 'C2v^17', 'C2v^18',
     8 'C2v^19', 'C2v^20', 'C2v^21', 'C2v^22', 'D2h^1 ', 'D2h^2 ',
     9 'D2h^3 ', 'D2h^4 ', 'D2h^5 ', 'D2h^6 ', 'D2h^7 ', 'D2h^8 ',
     * 'D2h^9 ', 'D2h^10', 'D2h^11', 'D2h^12', 'D2h^13', 'D2h^14',
     1 'D2h^15', 'D2h^16', 'D2h^17', 'D2h^18', 'D2h^19', 'D2h^20',
     2 'D2h^21', 'D2h^22', 'D2h^23', 'D2h^24', 'D2h^25', 'D2h^26',
     3 'D2h^27', 'D2h^28', 'C4^1  ', 'C4^2  ', 'C4^3  ', 'C4^4  ',
     4 'C4^5  ', 'C4^6  ', 'S4^1  ', 'S4^2  ', 'C4h^1 ', 'C4h^2 ',
     5 'C4h^3 ', 'C4h^4 ', 'C4h^5 ', 'C4h^6 ', 'D4^1  ', 'D4^2  ',
     6 'D4^3  ', 'D4^4  ', 'D4^5  ', 'D4^6  ', 'D4^7  ', 'D4^8  ',
     7 'D4^9  ', 'D4^10 ', 'C4v^1 ', 'C4v^2 ', 'C4v^3 ', 'C4v^4 ',
     8 'C4v^5 ', 'C4v^6 ', 'C4v^7 ', 'C4v^8 ', 'C4v^9 ', 'C4v^10',
     9 'C4v^11', 'C4v^12', 'D2d^1 ', 'D2d^2 ', 'D2d^3 ', 'D2d^4 ',
     * 'D2d^5 ', 'D2d^6 ', 'D2d^7 ', 'D2d^8 ', 'D2d^9 ', 'D2d^10',
     1 'D2d^11', 'D2d^12', 'D4h^1 ', 'D4h^2 ', 'D4h^3 ', 'D4h^4 ',
     2 'D4h^5 ', 'D4h^6 ', 'D4h^7 ', 'D4h^8 ', 'D4h^9 ', 'D4h^10',
     3 'D4h^11', 'D4h^12', 'D4h^13', 'D4h^14', 'D4h^15', 'D4h^16',
     4 'D4h^17', 'D4h^18', 'D4h^19', 'D4h^20', 'C3^1  ', 'C3^2  ',
     5 'C3^3  ', 'C3^4  ', 'C3i^1 ', 'C3i^2 ', 'D3^1  ', 'D3^2  ',
     6 'D3^3  ', 'D3^4  ', 'D3^5  ', 'D3^6  ', 'D3^7  ', 'C3v^1 ',
     7 'C3v^2 ', 'C3v^3 ', 'C3v^4 ', 'C3v^5 ', 'C3v^6 ', 'D3d^1 ',
     8 'D3d^2 ', 'D3d^3 ', 'D3d^4 ', 'D3d^5 ', 'D3d^6 ', 'C6^1  ',
     9 'C6^2  ', 'C6^3  ', 'C6^4  ', 'C6^5  ', 'C6^6  ', 'C3h^1 ',
     * 'C6h^1 ', 'C6h^2 ', 'D6^1  ', 'D6^2  ', 'D6^3  ', 'D6^4  ',
     1 'D6^5  ', 'D6^6  ', 'C6v^1 ', 'C6v^2 ', 'C6v^3 ', 'C6v^4 ',
     2 'D3h^1 ', 'D3h^2 ', 'D3h^3 ', 'D3h^4 ', 'D6h^1 ', 'D6h^2 ',
     3 'D6h^3 ', 'D6h^4 ', 'T^1   ', 'T^2   ', 'T^3   ', 'T^4   ',
     4 'T^5   ', 'Th^1  ', 'Th^2  ', 'Th^3  ', 'Th^4  ', 'Th^5  ',
     5 'Th^6  ', 'Th^7  ', 'O^1   ', 'O^2   ', 'O^3   ', 'O^4   ',
     6 'O^5   ', 'O^6   ', 'O^7   ', 'O^8   ', 'Td^1  ', 'Td^2  ',
     7 'Td^3  ', 'Td^4  ', 'Td^5  ', 'Td^6  ', 'Oh^1  ', 'Oh^2  ',
     8 'Oh^3  ', 'Oh^4  ', 'Oh^5  ', 'Oh^6  ', 'Oh^7  ', 'Oh^8  ',
     9 'Oh^9  ', 'Oh^10 '/
      DATA (NSG(I), I = 1, 28) /1, NANO, NMONA, NMONB, NORTA, NORTB,
     1 NTETLA, NTETLB, NTETHA, NTETHB, NTRILA, NTRILB, NTRIHA, NTRIHB,
     1 NTRIHA, NTRIHB, NHEXLA, NHEXLB, NHEXHA, NHEXHB, NCUBLA, NCUBLB,
     2 NCUBHA, NRSPGR, 1, NRSPGR, NTRIHA, NTRIHB/
      DATA (SGT(I), I = 1, NANO)/
     1 'P 1           1 P 1             S',
     2 'A 1           1 A 1              ',
     3 'B 1           1 B 1              ',
     4 'C 1           1 C 1              ',
     5 'I 1           1 I 1              ',
     6 'F 1           1 F 1              ',
     7 'R 1           1 R 1              ',
     8 'P -1          2-P 1             S',
     9 'A -1          2-A 1              ',
     * 'B -1          2-B 1              ',
     1 'C -1          2-C 1              ',
     2 'I -1          2-I 1              ',
     3 'F -1          2-F 1              ',
     4 'R -1          2-R 1              '/
      DATA (SGT(I), I = NMONA, NMONB)/
     1 'P 2           3 P 2y            S',
     2 'P 1 1 2       3 P 2              ',
     3 'P 2 1 1       3 P 2x             ',
     4 'P 21          4 P 2yb           S',
     5 'P 21:A        4 P 2yab           ',
     6 'P 21:C        4 P 2ybc           ',
     7 'P 21:N        4 P 2yn            ',
     8 'P 1 1 21      4 P 2c             ',
     9 'P 21 1 1      4 P 2xa            ',
     * 'P 1 1 21:A    4 P 2ac            ',
     1 'P 21 1 1:B    4 P 2xab           ',
     2 'C 2           5 C 2y            S',
     3 'C 2 1 1       5 C 2x             ',
     4 'I 2 1 1       5 I 2x             ',
     5 'C 21          5 C 2yb            ',
     6 'A 2           5 A 2y             ',
     7 'I 2           5 I 2y             ',
     8 'I 21          5 I 2yb            ',
     9 'F 2           5 F 2y             ',
     * 'A 1 1 2       5 A 2              ',
     1 'B 1 1 2       5 B 2              ',
     2 'I 1 1 2       5 I 2              ',
     3 'B 2 1 1       5 B 2x             ',
     4 'C 2 1 1       5 C 2x             ',
     5 'I 2 1 1       5 I 2x             ',
     6 'P M           6 P -2y           S',
     7 'P 1 1 M       6 P -2             ',
     8 'P M 1 1       6 P -2x            ',
     9 'P C           7 P -2yc          S',
     * 'P C S         7 P -2ybc          ',
     1 'P A           7 P -2ya          A',
     2 'P N           7 P -2yac         A',
     3 'P N S         7 P -2yabc         ',
     4 'P 1 1 A       7 P -2a            ',
     5 'P 1 1 B       7 P -2b            ',
     6 'P 1 1 N       7 P -2ab           ',
     7 'P b 1 1       7 P -2xb           ',
     8 'P n 1 1       7 P -2xbc          ',
     9 'P c 1 1       7 P -2xc           ',
     1 'C M           8 C -2y           S',
     2 'A M           8 A -2y            ',
     3 'I M           8 I -2y            ',
     4 'A 1 1 M       8 A -2             ',
     5 'B 1 1 M       8 B -2             ',
     6 'I 1 1 M       8 I -2             ',
     7 'B M 1 1       8 B -2x            ',
     8 'C M 1 1       8 C -2x            ',
     9 'I M 1 1       8 I -2x            ',
     * 'C C           9 C -2yc          S',
     1 'A N           9 A -2yac          ',
     2 'I A           9 I -2ya           ',
     3 'I C           9 I -2yc           ',
     4 'A A           9 A -2ya           ',
     5 'A 1 1 A       9 A -2a            ',
     6 'B 1 1 N       9 B -2bc           ',
     7 'I 1 1 B       9 I -2b            ',
     8 'B 1 1 B       9 B -2b            ',
     9 'A 1 1 N       9 A -2ac           ',
     * 'I 1 1 A       9 I -2a            ',
     1 'B B 1 1       9 B -2xb           ',
     2 'C N 1 1       9 C -2xbc          ',
     3 'I C 1 1       9 I -2xc           ',
     4 'C C 1 1       9 C -2xc           ',
     5 'B N 1 1       9 B -2xbc          ',
     6 'I B 1 1       9 I -2xb           ',
     7 'P 2/M        10-P 2y            S',
     8 'P 1 1 2/M    10-P 2              ',
     9 'P 2/M 1 1    10-P 2x             ',
     * 'P 21/M       11-P 2yb           S',
     1 'P 1 1 21/M   11-P 2c             ',
     2 'P 21/M 1 1   11-P 2xa            ',
     3 'C 2/M        12-C 2y            S',
     4 'A 2/M        12-A 2y             ',
     5 'I 2/M        12-I 2y             ',
     6 'A 1 1 2/M    12-A 2              ',
     7 'B 1 1 2/M    12-B 2              ',
     8 'I 1 1 2/M    12-I 2              ',
     9 'I 1 1 2/B    12-I 2b             ',
     * 'I 1 1 2/A    12-I 2a             ',
     1 'B 2/M 1 1    12-B 2x             ',
     2 'C 2/M 1 1    12-C 2x             ',
     3 'I 2/M 1 1    12-I 2x             ',
     4 'P 2/C        13-P 2yc           S',
     5 'P 2/A        13-P 2ya           A',
     6 'P 2/N        13-P 2yac          A',
     7 'P 1 1 2/A    13-P 2a             ',
     8 'P 1 1 2/N    13-P 2ab            ',
     9 'P 1 1 2/B    13-P 2b             ',
     * 'P 2/b 1 1    13-P 2xb            ',
     1 'P 2/n 1 1    13-P 2xbc           ',
     2 'P 2/c 1 1    13-P 2xc            ',
     3 'P 21/C       14-P 2ybc          S',
     4 'P 21/A       14-P 2yab          A',
     5 'P 21/N       14-P 2yn           A',
     6 'P 1 1 21/A   14-P 2ac            ',
     7 'P 1 1 21/B   14-P 2bc            ',
     8 'P 1 1 21/N   14-P 2n             ',
     9 'P 21/N 1 1   14-P 2xn            ',
     * 'P 21/B 1 1   14-P 2xab           ',
     1 'P 21/C 1 1   14-P 2xac           ',
     2 'B 21/C       14-B 2ybc           ',
     3 'B 21/D       14-B 2ydav          ',
     4 'C 2/C        15-C 2yc           S',
     5 'A 2/N        15-A 2yac           ',
     6 'I 2/A        15-I 2ya            ',
     7 'A 2/A        15-A 2ya            ',
     8 'C 2/N        15-C 2ybc          A',
     9 'I 2/C        15-I 2yc            ',
     * 'A 1 1 2/A    15-A 2a             ',
     1 'B 1 1 2/N    15-B 2bc            ',
     2 'I 1 1 2/B    15-I 2b             ',
     3 'B 1 1 2/B    15-B 2b             ',
     4 'A 1 1 2/N    15-A 2ac            ',
     5 'I 1 1 2/A    15-I 2a             ',
     6 'B 2/B 1 1    15-B 2xb            ',
     7 'C 2/N 1 1    15-C 2xbc           ',
     8 'I 2/C 1 1    15-I 2xc            '/
      DATA (SGT(I), I = NORTA, NORTB)/
     1 'P 2 2 2      16 P 2 2           S',
     2 'P 2 2 21     17 P 2c 2          S',
     3 'P 21 21 2    18 P 2 2ab         S',
     4 'P 21 21 21   19 P 2ac 2ab       S',
     5 'C 2 2 21     20 C 2c 2          S',
     6 'C 2 2 2      21 C 2 2           S',
     7 'F 2 2 2      22 F 2 2           S',
     8 'I 2 2 2      23 I 2 2           S',
     9 'I 21 21 21   24 I 2b 2c         S',
     * 'P M M 2      25 P 2 -2          S',
     1 'P M C 21     26 P 2c -2         S',
     2 'P C C 2      27 P 2 -2c         S',
     3 'P M A 2      28 P 2 -2a         S',
     4 'P C A 21     29 P 2c -2ac       S',
     5 'P N C 2      30 P 2 -2bc        S',
     6 'P M N 21     31 P 2ac -2        S',
     7 'P B A 2      32 P 2 -2ab        S',
     8 'P N A 21     33 P 2c -2n        S',
     9 'P 21 C N:B   33 P -2n 2ab        ',
     9 'P N N 2      34 P 2 -2n         S',
     * 'C M M 2      35 C 2 -2          S',
     1 'C M C 21     36 C 2c -2         S',
     2 'C C C 2      37 C 2 -2c         S',
     3 'A M M 2      38 A 2 -2          S',
     4 'A B M 2      39 A 2 -2c         S',
     5 'A M A 2      40 A 2 -2a         S',
     6 'A B A 2      41 A 2 -2ac        S',
     7 'F M M 2      42 F 2 -2          S',
     8 'F D D 2      43 F 2 -2d         S',
     9 'I M M 2      44 I 2 -2          S',
     * 'I B A 2      45 I 2 -2c         S',
     1 'I M A 2      46 I 2 -2a         S',
     2 'P M M M      47-P 2 2           S',
     3 'P N N N:1    48 P 2 2 -1n        ',
     4 'P N N N      48-P 2ab 2bc       S',
     5 'P C C M      49-P 2 2c          S',
     6 'P B A N:1    50 P 2 2 -1ab       ',
     7 'P N C B:1    50 P 2 2 -1bc       ',
     8 'P C N A:1    50 P 2 2 -1ac       ',
     9 'P B A N      50-P 2ab 2b        S',
     * 'P M M A      51-P 2a 2a         S',
     1 'P N N A      52-P 2a 2bc        S',
     2 'P M N A      53-P 2ac 2         S',
     3 'P C C A      54-P 2a 2ac        S',
     4 'P B A M      55-P 2 2ab         S',
     5 'P C C N      56-P 2ab 2ac       S',
     6 'P B C M      57-P 2c 2b         S',
     7 'P N N M      58-P 2 2n          S',
     8 'P M M N:1    59 P 2 2ab -1ab     ',
     9 'P N M M:1    59 P 2bc 2 -1bc     ',
     * 'P M N M:1    59 P 2ac 2ac -1ac   ',
     1 'P M M N      59-P 2ab 2a        S',
     2 'P B C N      60-P 2n 2ab        S',
     3 'P B C A      61-P 2ac 2ab       S',
     4 'P N M A      62-P 2ac 2n        S',
     5 'C M C M      63-C 2c 2          S',
     6 'C M C A      64-C 2bc 2         S',
     7 'C M M M      65-C 2 2           S',
     8 'C C C M      66-C 2 2c          S',
     9 'C M M A      67-C 2b 2          S',
     * 'C C C A:1    68 C 2 2 -1bc       ',
     1 'C C C B:1    68 C 2 2 -1bc       ',
     2 'A B A A:1    68 A 2 2 -1ac       ',
     3 'A C A A:1    68 A 2 2 -1ac       ',
     4 'B B C B:1    68 B 2 2 -1bc       ',
     5 'B B A B:1    68 B 2 2 -1bc       ',
     6 'C C C A      68-C 2b 2bc        S',
     7 'F M M M      69-F 2 2           S',
     8 'F D D D:1    70 F 2 2 -1d        ',
     9 'F D D D      70-F 2uv 2vw       S',
     * 'I M M M      71-I 2 2           S',
     1 'I B A M      72-I 2 2c          S',
     2 'I B C A      73-I 2b 2c         S',
     3 'I M M A      74-I 2b 2          S'/
      DATA (SGT(I), I = NTETLA, NTETLB)/
     1 'P 4          75 P 4             S',
     2 'P 41         76 P 4w            S',
     3 'P 42         77 P 4c            S',
     4 'P 43         78 P 4cw           S',
     5 'I 4          79 I 4             S',
     6 'I 41         80 I 4bw           S',
     7 'P -4         81 P -4            S',
     8 'I -4         82 I -4            S',
     9 'P 4/M        83-P 4             S',
     * 'P 42/M       84-P 4c            S',
     1 'P 4/N:1      85 P 4ab -1ab       ',
     2 'P 4/N        85-P 4a            S',
     3 'P 42/N:1     86 P 4n -1n         ',
     4 'P 42/N       86-P 4bc           S',
     5 'I 4/M        87-I 4             S',
     6 'I 41/A:1     88 I 4bw -1bw       ',
     7 'I 41/A       88-I 4ad           S'/
      DATA (SGT(I), I = NTETHA, NTETHB)/
     1 'P 4 2 2      89 P 4 2           S',
     2 'P 4 21 2     90 P 4ab 2ab       S',
     3 'P 41 2 2     91 P 4w 2c         S',
     4 'P 41 21 2    92 P 4abw 2nw      S',
     5 'P 42 2 2     93 P 4c 2          S',
     6 'P 42 21 2    94 P 4n 2n         S',
     7 'P 43 2 2     95 P 4cw 2c        S',
     8 'P 43 21 2    96 P 4nw 2abw      S',
     9 'I 4 2 2      97 I 4 2           S',
     * 'I 41 2 2     98 I 4bw 2bw       S',
     1 'P 4 M M      99 P 4 -2          S',
     2 'P 4 B M     100 P 4 -2ab        S',
     3 'P 42 C M    101 P 4c -2c        S',
     4 'P 42 N M    102 P 4n -2n        S',
     5 'P 4 C C     103 P 4 -2c         S',
     6 'P 4 N C     104 P 4 -2n         S',
     7 'P 42 M C    105 P 4c -2         S',
     8 'P 42 B C    106 P 4c -2ab       S',
     9 'I 4 M M     107 I 4 -2          S',
     * 'I 4 C M     108 I 4 -2c         S',
     1 'I 41 M D    109 I 4bw -2        S',
     2 'I 41 C D    110 I 4bw -2c       S',
     3 'P -4 2 M    111 P -4 2          S',
     4 'P -4 2 C    112 P -4 2c         S',
     5 'P -4 21 M   113 P -4 2ab        S',
     6 'P -4 21 C   114 P -4 2n         S',
     7 'P -4 M 2    115 P -4 -2         S',
     8 'P -4 C 2    116 P -4 -2c        S',
     9 'P -4 B 2    117 P -4 -2ab       S',
     * 'P -4 N 2    118 P -4 -2n        S',
     1 'I -4 M 2    119 I -4 -2         S',
     2 'I -4 C 2    120 I -4 -2c        S',
     3 'I -4 2 M    121 I -4 2          S',
     4 'I -4 2 D    122 I -4 2bw        S',
     5 'P 4/M M M   123-P 4 2           S',
     6 'P 4/M C C   124-P 4 2c          S',
     7 'P 4/N B M:1 125 P 4 2 -1ab       ',
     8 'P 4/N B M   125-P 4a 2b         S',
     9 'P 4/N N C:1 126 P 4 2 -1n        ',
     * 'P 4/N N C   126-P 4a 2bc        S',
     1 'P 4/M B M   127-P 4 2ab         S',
     2 'P 4/M N C   128-P 4 2n          S',
     3 'P 4/N M M:1 129 P 4ab 2ab -1ab   ',
     4 'P 4/N M M   129-P 4a 2a         S',
     5 'P 4/N C C:1 130 P 4ab 2n -1ab    ',
     6 'P 4/N C C   130-P 4a 2ac        S',
     7 'P 42/M M C  131-P 4c 2          S',
     8 'P 42/M C M  132-P 4c 2c         S',
     9 'P 42/N B C:1133 P 4n 2c -1n      ',
     * 'P 42/N B C  133-P 4ac 2b        S',
     1 'P 42/N N M:1134 P 4n 2 -1n       ',
     2 'P 42/N N M  134-P 4ac 2bc       S',
     3 'P 42/M B C  135-P 4c 2ab        S',
     4 'P 42/M N M  136-P 4n 2n         S',
     5 'P 42/N M C:1137 P 4n 2n -1n      ',
     6 'P 42/N M C  137-P 4ac 2a        S',
     7 'P 42/N C M:1138 P 4n 2ab -1n     ',
     8 'P 42/N C M  138-P 4ac 2ac       S',
     9 'I 4/M M M   139-I 4 2           S',
     * 'I 4/M C M   140-I 4 2c          S',
     1 'I 41/A M D:1141 I 4bw 2bw -1bw   ',
     2 'I 41/A M D  141-I 4bd 2         S',
     3 'I 41/A C D:1142 I 4bw 2aw -1bw   ',
     4 'I 41/A C D:3142-I 4ad 2c         ',
     5 'I 41/A C D  142-I 4bd 2c        S'/
      DATA (SGT(I), I = NTRILA, NTRILB)/
     2 'P 3         143 P 3             S',
     3 'P 31        144 P 31            S',
     4 'P 32        145 P 32            S',
     5 'R 3         146 R 3             S',
     6 'R 3 R       146 P 3*             ',
     7 'P -3        147-P 3             S',
     8 'R -3        148-R 3             S',
     9 'R -3 R      148-P 3*             '/
      DATA (SGT(I), I = NTRIHA, NTRIHB)/
     1 'P 3 1 2     149 P 3 2           S',
     2 'P 3 2 1     150 P 3 2"          S',
     3 'P 31 1 2    151 P 31 2c (0 0 1) S',
     4 'P 31 2 1    152 P 31 2"         S',
     5 'P 32 1 2    153 P 32 2c (0 0 -1)S',
     6 'P 32 2 1    154 P 32 2"         S',
     7 'R 3 2       155 R 3 2"          S',
     8 'R 3 2 R     155 P 3* 2           ',
     9 'P 3 M 1     156 P 3 -2"         S',
     * 'P 3 1 M     157 P 3 -2          S',
     1 'P 3 C 1     158 P 3 -2"c        S',
     2 'P 3 1 C     159 P 3 -2c         S',
     3 'R 3 M       160 R 3 -2"         S',
     4 'R 3 M R     160 P 3* -2          ',
     5 'R 3 C       161 R 3 -2"c        S',
     6 'R 3 C R     161 P 3* -2n         ',
     7 'P -3 1 M    162-P 3 2           S',
     8 'P -3 1 C    163-P 3 2c          S',
     9 'P -3 M 1    164-P 3 2"          S',
     * 'P -3 C 1    165-P 3 2"c         S',
     1 'R -3 M      166-R 3 2"          S',
     2 'R -3 M R    166-P 3* 2           ',
     3 'R -3 C      167-R 3 2"c         S',
     4 'R -3 C R    167-P 3* 2n          '/
      DATA (SGT(I), I = NHEXLA, NHEXLB)/
     5 'P 6         168 P 6             S',
     6 'P 61        169 P 61            S',
     7 'P 65        170 P 65            S',
     8 'P 62        171 P 62            S',
     9 'P 64        172 P 64            S',
     1 'P 63        173 P 6c            S',
     2 'P -6        174 P -6            S',
     3 'P 6/M       175-P 6             S',
     4 'P 63/M      176-P 6c            S'/
      DATA (SGT(I), I = NHEXHA, NHEXHB)/
     5 'P 6 2 2     177 P 6 2           S',
     6 'P 61 2 2    178 P 61 2 (0 0 -1) S',
     7 'P 65 2 2    179 P 65 2 ( 0 0 1) S',
     8 'P 62 2 2    180 P 62 2c (0 0 1) S',
     9 'P 64 2 2    181 P 64 2c (0 0 -1)S',
     * 'P 63 2 2    182 P 6c 2c         S',
     1 'P 6 M M     183 P 6 -2          S',
     2 'P 6 C C     184 P 6 -2c         S',
     3 'P 63 C M    185 P 6c -2         S',
     4 'P 63 M C    186 P 6c -2c        S',
     5 'P -6 M 2    187 P -6 2          S',
     6 'P -6 C 2    188 P -6c 2         S',
     7 'P -6 2 M    189 P -6 -2         S',
     8 'P -6 2 C    190 P -6c -2c       S',
     9 'P 6/M M M   191-P 6 2           S',
     1 'P 6/M C C   192-P 6 2c          S',
     2 'P 63/M C M  193-P 6c 2          S',
     3 'P 63/M M C  194-P 6c 2c         S'/
      DATA (SGT(I), I = NCUBLA, NCUBLB)/
     1 'P 2 3       195 P 2 2 3         S',
     2 'F 2 3       196 F 2 2 3         S',
     3 'I 2 3       197 I 2 2 3         S',
     4 'P 21 3      198 P 2ac 2ab 3     S',
     5 'I 21 3      199 I 2b 2c 3       S',
     6 'P M -3      200-P 2 2 3         S',
     7 'P N -3:1    201 P 2 2 3 -1n      ',
     8 'P N -3      201-P 2ab 2bc 3     S',
     9 'F M -3      202-F 2 2 3         S',
     * 'F D -3:1    203 F 2 2 3 -1d     S',
     1 'F D -3      203-F 2uv 2vw 3     S',
     2 'I M -3      204-I 2 2 3         S',
     3 'P A -3      205-P 2ac 2ab 3     S',
     4 'P B -3      205-P 2bc 2ac 3     A',
     5 'I A -3      206-I 2b 2c 3       S'/
      DATA (SGT(I), I = NCUBHA, NRSPGR)/
     1 'P 4 3 2     207 P 4 2 3         S',
     2 'P 42 3 2    208 P 4n 2 3        S',
     3 'F 4 3 2     209 F 4 2 3         S',
     4 'F 41 3 2    210 F 4d 2 3        S',
     5 'I 4 3 2     211 I 4 2 3         S',
     6 'P 43 3 2    212 P 4acd 2ab 3    S',
     7 'P 41 3 2    213 P 4bd 2ab 3     S',
     8 'I 41 3 2    214 I 4bd 2c 3      S',
     9 'P -4 3 M    215 P -4 2 3        S',
     * 'F -4 3 M    216 F -4 2 3        S',
     1 'I -4 3 M    217 I -4 2 3        S',
     2 'P -4 3 N    218 P -4n 2 3       S',
     3 'F -4 3 C    219 F -4c 2 3       S',
     4 'I -4 3 D    220 I -4bd 2c 3     S',
     5 'P M -3 M    221-P 4 2 3         S',
     6 'P N -3 N:1  222 P 4 2 3 -1n      ',
     7 'P N -3 N    222-P 4a 2bc 3      S',
     8 'P M -3 N    223-P 4n 2 3        S',
     9 'P N -3 M:1  224 P 4n 2 3 -1n     ',
     * 'P N -3 M    224-P 4bc 2bc 3     S',
     1 'F M -3 M    225-F 4 2 3         S',
     2 'F M -3 C    226-F 4c 2 3        S',
     3 'F D -3 M:1  227 F 4d 2 3 -1d     ',
     4 'F D -3 M    227-F 4vw 2vw 3     S',
     5 'F D -3 C:1  228 F 4d 2 3 -1cd    ',
     6 'F D -3 C    228-F 4cvw 2vw 3    S',
     7 'I M -3 M    229-I 4 2 3         S',
     8 'I A -3 D    230-I 4bd 2c 3      S'/
      DATA (NSLOC(I), I = 1, 59)/
     1  0,  1,  2,  0,  3,  4,  0,  0,  0,  5,  6,  7,  8,  9, 10,
     2 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,
     3 26,  0,  0, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
     4 39, 40, 41, 42, 43, 44, 45, 46,  0,  0,  0, 47, 48, 49/
C * NON-Standard Orthorhombic Settings
      DATA (NONST(I), I = 1, NSTD)/
     1 'P 2 2 21 ', 'P 2221:2 ', 'P 21 2 2 ', 'P 2122:2 ',
     2 'P 2 21 2 ', 'P 2212:2 ', 'P 21 21 2', 'P 21 21 2',
     3 'P 2 21 21', 'P 2 21 21', 'P 21 2 21', 'P 21 2 21',
     4 'C 2 2 21 ', 'C 2221:2 ', 'A 21 2 2 ', 'A 2122:2 ',
     5 'B 2 21 2 ', 'B 2212:2 ', 'C 2 2 2  ', 'C 2 2 2  ',
     6 'A 2 2 2  ', 'A 2 2 2  ', 'B 2 2 2  ', 'B 2 2 2  ',
     7 'P M M 2  ', 'P M M 2  ', 'P 2 M M  ', 'P 2 M M  ',
     8 'P M 2 M  ', 'P M 2 M  ', 'P M C 21 ', 'P C M 21 ',
     9 'P 21 M A ', 'P 21 A M ', 'P B 21 M ', 'P M 21 B ',
     * 'P C C 2  ', 'P C C 2  ', 'P 2 A A  ', 'P 2 A A  ',
     1 'P B 2 B  ', 'P B 2 B  ', 'P M A 2  ', 'P B M 2  ',
     2 'P 2 M B  ', 'P 2 C M  ', 'P C 2 M  ', 'P M 2 A  ',
     3 'P C A 21 ', 'P B C 21 ', 'P 21 A B ', 'P 21 C A ',
     4 'P C 21 B ', 'P B 21 A ', 'P N C 2  ', 'P C N 2  ',
     5 'P 2 N A  ', 'P 2 A N  ', 'P B 2 N  ', 'P N 2 B  ',
     6 'P M N 21 ', 'P N M 21 ', 'P 21 M N ', 'P 21 N M ',
     7 'P N 21 M ', 'P M 21 N ', 'P B A 2  ', 'P B A 2  ',
     8 'P 2 C B  ', 'P 2 C B  ', 'P C 2 A  ', 'P C 2 A  ',
     9 'P N A 21 ', 'P B N 21 ', 'P 21 N B ', 'P 21 C N ',
     1 'P C 21 N ', 'P N 21 A ', 'P N N 2  ', 'P N N 2  ',
     2 'P 2 N N  ', 'P 2 N N  ', 'P N 2 N  ', 'P N 2 N  ',
     3 'C M M 2  ', 'C M M 2  ', 'A 2 M M  ', 'A 2 M M  ',
     4 'B M 2 M  ', 'B M 2 M  ', 'C M C 21 ', 'C C M 21 ',
     5 'A 21 M A ', 'A 21 A M ', 'B B 21 M ', 'B M 21 B ',
     6 'C C C 2  ', 'C C C 2  ', 'A 2 A A  ', 'A 2 A A  ',
     7 'B B 2 B  ', 'B B 2 B  ', 'A M M 2  ', 'B M M 2  ',
     8 'B 2 M M  ', 'C 2 M M  ', 'C M 2 M  ', 'A M 2 M  ',
     9 'A B M 2  ', 'B M A 2  ', 'B 2 C M  ', 'C 2 M B  ',
     * 'C M 2 A  ', 'A C 2 M  ', 'A M A 2  ', 'B B M 2  ',
     1 'B 2 M B  ', 'C 2 C M  ', 'C C 2 M  ', 'A M 2 A  ',
     2 'A B A 2  ', 'B B A 2  ', 'B 2 C B  ', 'C 2 C B  ',
     3 'C C 2 A  ', 'A C 2 A  ', 'F M M 2  ', 'F M M 2  ',
     4 'F 2 M M  ', 'F 2 M M  ', 'F M 2 M  ', 'F M 2 M  ',
     5 'F D D 2  ', 'F D D 2  ', 'F 2 D D  ', 'F 2 D D  ',
     6 'F D 2 D  ', 'F D 2 D  ', 'I M M 2  ', 'I M M 2  ',
     7 'I 2 M M  ', 'I 2 M M  ', 'I M 2 M  ', 'I M 2 M  ',
     8 'I B A 2  ', 'I B A 2  ', 'I 2 C B  ', 'I 2 C B  ',
     9 'I C 2 A  ', 'I C 2 A  ', 'I M A 2  ', 'I B M 2  ',
     1 'I 2 M B  ', 'I 2 C M  ', 'I C 2 M  ', 'I M 2 A  ',
     2 'P C C M  ', 'P C C M  ', 'P M A A  ', 'P M A A  ',
     3 'P B M B  ', 'P B M B  ', 'P B A N  ', 'P B A N  ',
     4 'P N C B  ', 'P N C B  ', 'P C N A  ', 'P C N A  ',
     5 'P M M A  ', 'P M M B  ', 'P B M M  ', 'P C M M  ',
     6 'P M C M  ', 'P M A M  ', 'P N N A  ', 'P N N B  ',
     7 'P B N N  ', 'P C N N  ', 'P N C N  ', 'P N A N  ',
     8 'P M N A  ', 'P N M B  ', 'P B M N  ', 'P C N M  ',
     9 'P N C M  ', 'P M A N  ', 'P C C A  ', 'P C C B  ',
     * 'P B A A  ', 'P C A A  ', 'P B C B  ', 'P B A B  ',
     1 'P B A M  ', 'P B A M  ', 'P M C B  ', 'P M C B  ',
     2 'P C M A  ', 'P C M A  ', 'P C C N  ', 'P C C N  ',
     3 'P N A A  ', 'P N A A  ', 'P B N B  ', 'P B N B  ',
     4 'P B C M  ', 'P C A M  ', 'P M C A  ', 'P M A B  ',
     5 'P B M A  ', 'P C M B  ', 'P N N M  ', 'P N N M  ',
     6 'P M N N  ', 'P M N N  ', 'P N M N  ', 'P N M N  ',
     7 'P M M N  ', 'P M M N  ', 'P N M M  ', 'P N M M  ',
     8 'P M N M  ', 'P M N M  ', 'P B C N  ', 'P C A N  ',
     9 'P N C A  ', 'P N A B  ', 'P B N A  ', 'P C N B  ',
     1 'P B C A  ', 'P C A B  ', 'P B C A  ', 'P C A B  ',
     2 'P B C A  ', 'P C A B  ', 'P N M A  ', 'P M N B  ',
     3 'P B N M  ', 'P C M N  ', 'P M C N  ', 'P N A M  ',
     4 'C M C M  ', 'C C M M  ', 'A M M A  ', 'A M A M  ',
     5 'B B M M  ', 'B M M B  ', 'C M C A  ', 'C C M B  ',
     6 'A B M A  ', 'A C A M  ', 'B B C M  ', 'B M A B  ',
     7 'C M M M  ', 'C M M M  ', 'A M M M  ', 'A M M M  ',
     8 'B M M M  ', 'B M M M  ', 'C C C M  ', 'C C C M  ',
     9 'A M A A  ', 'A M A A  ', 'B B M B  ', 'B B M B  ',
     * 'C M M A  ', 'C M M B  ', 'A B M M  ', 'A C M M  ',
     1 'B M C M  ', 'B M A M  ', 'C C C A  ', 'C C C B  ',
     2 'A B A A  ', 'A C A A  ', 'B B C B  ', 'B B A B  ',
     3 'F D D D  ', 'F D D D:2', 'F D D D  ', 'F D D D:2',
     4 'F D D D  ', 'F D D D:2', 'I B A M  ', 'I B A M  ',
     5 'I M C B  ', 'I M C B  ', 'I C M A  ', 'I C M A  ',
     6 'I B C A  ', 'I C A B  ', 'I B C A  ', 'I C A B  ',
     7 'I B C A  ', 'I C A B  ', 'I M M A  ', 'I M M B  ',
     8 'I B M M  ', 'I C M M  ', 'I M C M  ', 'I M A M  '/
C * EQUIVALENT SPACE-GROUP NAME SUBSTITUTIONS
      DATA (TRLTA(I), TRLTB(I), I = 1, NTRL)/
     1 'P121         ', 'P2     ', 'P1211        ', 'P21    ',
     2 'C121         ', 'C2     ', 'P1M1         ', 'PM     ',
     3 'P1C1         ', 'PC     ', 'C1M1         ', 'CM     ',
     4 'C1C1         ', 'CC     ', 'P12/M1       ', 'P2/M   ',
     5 'P121/M1      ', 'P21/M  ', 'C12/M1       ', 'C2/M   ',
     6 'P12/C1       ', 'P2/C   ', 'P121/C1      ', 'P21/C  ',
     7 'C12/C1       ', 'C2/C   ', 'PM3          ', 'PM-3   ',
     8 'PN3          ', 'PN-3   ', 'FM3          ', 'FM-3   ',
     9 'FD3          ', 'FD-3   ', 'IM3          ', 'IM-3   ',
     * 'PA3          ', 'PA-3   ', 'IA3          ', 'IA-3   ',
     1 'PM3M         ', 'PM-3M  ', 'PN3N         ', 'PN-3N  ',
     2 'PM3N         ', 'PM-3N  ', 'PN3M         ', 'PN-3M  ',
     3 'FM3M         ', 'FM-3M  ', 'FM3C         ', 'FM-3C  ',
     4 'FD3M         ', 'FD-3M  ', 'FD3C         ', 'FD-3C  ',
     5 'IM3M         ', 'IM-3M  ', 'IA3D         ', 'IA-3D  ',
     6 'FM3-M        ', 'FM-3M  ', 'F4-3C        ', 'F-43C  ',
     7 'IA3-         ', 'IA-3   ', 'FD3-         ', 'FD-3   ',
     8 'FM3-         ', 'FM-3   ', 'F4-3M        ', 'F-43M  ',
     9 'IM3-M        ', 'IM-3M  ', 'FM3-C        ', 'FM-3C  ',
     1 'IA3-D        ', 'IA-3D  ', 'IM3-         ', 'IM-3   ',
     2 'I4-C2        ', 'I-4C2  ', 'I4-2M        ', 'I-42M  ',
     3 'PM3-N        ', 'PM-3N  ', 'PN3-M        ', 'PN-3M  ',
     4 'PN3-N        ', 'PN-3N  ', 'P3-M1        ', 'P-3M1  ',
     5 'P4-C2        ', 'P-4C2  ', 'I4-M2        ', 'I-4M2  ',
     6 'I4-3D        ', 'I-43D  ', 'PA3-         ', 'PA-3   ',
     7 'PM3-         ', 'PM-3   ', 'P1-          ', 'P-1    ',
     8 'P3-          ', 'P-3    ', 'P3-1C        ', 'P-31C  ',
     9 'P4-          ', 'P-4    ', 'P4-M2        ', 'P-4M2  ',
     * 'I4-          ', 'I-4    ', 'I4-2D        ', 'I-42D  ',
     1 'I4-3M        ', 'I-43M  ', 'PM3-M        ', 'PM-3M  ',
     2 'PN3-         ', 'PN-3   ', 'P3-C1        ', 'P-3C1  ',
     3 'P3-1M        ', 'P-31M  ', 'P4-B2        ', 'P-4B2  ',
     4 'P4-N2        ', 'P-4N2  ', 'P4-2C        ', 'P-42C  ',
     5 'P4-21M       ', 'P-421M ', 'P6-M2        ', 'P-6M2  ',
     6 'R3-R         ', 'R-3R   ', 'P4-2M        ', 'P-42M  ',
     7 'P4-3M        ', 'P-43M  ', 'P6-          ', 'P-6    ',
     8 'P6-2C        ', 'P-62C  ', 'R3-          ', 'R-3    ',
     9 'R3-C         ', 'R-3C   ', 'R3-MR        ', 'R-3MR  ',
     1 'P4-21C       ', 'P-421C ', 'P4-3N        ', 'P-43N  ',
     2 'P6-C2        ', 'P-6C2  ', 'P6-2M        ', 'P-62M  ',
     3 'P1N1         ', 'PN     ', 'P12/N1       ', 'P2/N   ',
     5 'P121/N1      ', 'P21/N  ', 'P1A1         ', 'PA     ',
     6 'P12/A1       ', 'P2/A   ', 'P121/A1      ', 'P21/A  ',
     7 'PB3          ', 'PB-3   ', 'BBAM         ', 'BBCM   ',
     8 'C2CA         ', 'C2CB   ', 'CC2B         ', 'CC2A   ',
     9 'P4/N:2       ', 'P4/N   ', 'P42/N:2      ', 'P42/N  ',
     * 'I41/A:2      ', 'I41/A  ', 'FD-3C:2      ', 'FD-3C  ',
     1 'FD-3M:2      ', 'FD-3M  ', 'PN-3M:2      ', 'PN-3M  ',
     2 'PN-3N:2      ', 'PN-3N  ', 'FD-3:2       ', 'FD-3   ',
     3 'PN-3:2       ', 'PN-3   ', 'I41/ACD:2    ', 'I41/ACD',
     4 'I41/AMD:2    ', 'I41/AMD', 'P42/NCM:2    ', 'P42/NCM',
     5 'P42/NMC:2    ', 'P42/NMC', 'P42/NNM:2    ', 'P42/NNM',
     6 'P42/NBC:2    ', 'P42/NBC', 'P4/NCC:2     ', 'P4/NCC ',
     7 'P4/NMM:2     ', 'P4/NMM ', 'P4/NNC:2     ', 'P4/NNC ',
     8 'P4/NBM:2     ', 'P4/NBM ', 'R3:H         ', 'R3     ',
     9 'R3:R         ', 'R3R    ', 'R-3:H        ', 'R-3    ',
     1 'R-3:R        ', 'R-3R   ', 'R32:H        ', 'R32    ',
     2 'R32:R        ', 'R32R   ', 'R-3M:H       ', 'R-3M   ',
     3 'R-3M:R       ', 'R-3MR  ', 'R3M:H        ', 'R3M    ',
     4 'R3M:R        ', 'R3MR   ', 'R3C:H        ', 'R3C    ',
     5 'R3C:R        ', 'R3CR   ', 'R-3C:H       ', 'R-3C   ',
     6 'R-3C:R       ', 'R-3CR  ', 'CNNB         ', 'CCCA:1 ',
     7 'IBMA         ', 'ICMA   ', 'I12/M1       ', 'I2/M   ',
     8 'A12/M1       ', 'A2/M   ', 'P2/M2/M2/M   ', 'PMMM   ',
     9 'P2/N2/N2/N   ', 'PNNN   ', 'P2/C2/C2/M   ', 'PCCM   ',
     * 'P2/B2/A2/N   ', 'PBAN   ', 'P21/M2/M2/A  ', 'PMMA   ',
     1 'P2/N21/N2/A  ', 'PNNA   ', 'P2/M2/N21/A  ', 'PMNA   ',
     2 'P21/C2/C2/A  ', 'PCCA   ', 'P21/B21/A2/M ', 'PBAM   ',
     3 'P21/C21/2/N  ', 'PCCN   ', 'P2/B21/C21/M ', 'PBCM   ',
     4 'P21/N21/N2/M ', 'PNNM   ', 'P21/M21/M2/N ', 'PMMN   ',
     5 'P21/M21/M2/N ', 'PMMN   ', 'P21/B2/C21/N ', 'PBCN   ',
     6 'P21/B21/C21/A', 'PBCA   ', 'P21/N21/M21/A', 'PNMA   ',
     7 'C2/M2/C21/M  ', 'CMCM   ', 'C2/M2/C21/A  ', 'CMCA   ',
     8 'C2/M2/M2/M   ', 'CMMM   ', 'C2/C2/C2/M   ', 'CCCM   ',
     9 'C2/M2/M2/A   ', 'CMMA   ', 'C2/C2/C2/A   ', 'CCCA   ',
     1 'F2/M2/M2/M   ', 'FMMM   ', 'F2/D2/D2/D   ', 'FDDD   ',
     2 'I2/M2/M/2/M  ', 'IMMM   ', 'I2/B2/A2/M   ', 'IBAM   ',
     3 'I21/B21/C21/A', 'IBCA   ', 'I21/M21/M21/A', 'IMMA   ',
     4 'H3           ', 'R3     ', 'H-3          ', 'R-3    ',
     5 'H3M          ', 'R3M    ', 'H-3M         ', 'R-3M   ',
     6 'H3C          ', 'R3C    ', 'H-3C         ', 'R-3C   ',
     7 'R3H          ', 'R3     ', 'R-3H         ', 'R-3    ',
     8 'R3MH         ', 'R3M    ', 'R-3MH        ', 'R-3M   ',
     9 'R3CH         ', 'R3C    ', 'R-3CH        ', 'R-3C   ',
     * 'H3-          ', 'R-3    ', 'R3-H         ', 'R-3    ',
     1 'H3-M         ', 'R-3M   ', 'R3-MH        ', 'R-3M   ',
     2 'H3-C         ', 'R-3    ', 'R3-CH        ', 'R-3C   ',
     3 'I121         ', 'I2     ', 'AEM2         ', 'ABM2   ',
     4 'BME2         ', 'BMA2   ', 'B2EM         ', 'B2CM   ',
     5 'C2ME         ', 'C2MB   ', 'CM2E         ', 'CM2A   ',
     6 'AE2M         ', 'AC2M   ', 'BBE2         ', 'BBA2   ',
     7 'B2EB         ', 'B2CB   ', 'C2CE         ', 'C2CB   ',
     8 'CC2E         ', 'CC2A   ', 'AE2A         ', 'AC2A   ',
     9 'CCME         ', 'CCMB   ', 'AEMA         ', 'ABMA   ',
     1 'AEAM         ', 'ACAM   ', 'BBEM         ', 'BBCM   ',
     2 'BMEB         ', 'BMAB   ', 'AEMM         ', 'ABMM   ',
     3 'BMEM         ', 'BMCM   ', 'AEAA         ', 'ABAA   ',
     4 'BBEB         ', 'BBCB   ', 'AEA2         ', 'ABA2   ',
     5 'CMCE         ', 'CMCA   ', 'CMME         ', 'CMMA   ',
     6 'CCCE         ', 'CCCA   ', 'I12/A1       ', 'I2/A   ',
     7 'I12/C1       ', 'I2/C   ', 'ABAM         ', 'ACAM   '/
C * Hall symbols for non-standard orthorhombic settings
      DATA (NHLA(I), NHLC(I), NHLB(I), I = 1, NNH)/
     1 'P2221:2', 'P 2 2 21:2 ', ' P 2c 2c       ',
     2 'P2122  ', 'P 21 2 2   ', ' P 2a 2a       ',
     3 'P2122:2', 'P 21 2 2:2 ', ' P 2 2a        ',
     4 'P2212  ', 'P 2 21 2   ', ' P 2 2b        ',
     5 'P2212:2', 'P 2 21 2:2 ', ' P 2b 2        ',
     6 'P22121 ', 'P 2 21 21  ', ' P 2bc 2       ',
     7 'P21221 ', 'P 21 2 21  ', ' P 2ac 2ac     ',
     8 'A2122  ', 'A 21 2 2   ', ' A 2a 2a       ',
     9 'A2122:2', 'A 21 2 2:2 ', ' A 2 2a        ',
     * 'B2212  ', 'B 2 21 2   ', ' B 2 2b        ',
     1 'B2212:2', 'B 2 21 2:2 ', ' B 2b 2        ',
     2 'C2221:2', 'C 2 2 21:2 ', ' C 2c 2c       ',
     3 'A222   ', 'A 2 2 2    ', ' A 2 2         ',
     4 'B222   ', 'B 2 2 2    ', ' B 2 2         ',
     5 'P2mm   ', 'P 2 m m    ', ' P -2 2        ',
     6 'Pm2m   ', 'P m 2 m    ', ' P -2 -2       ',
     7 'Pcm21  ', 'P c m 21   ', ' P 2c -2c      ',
     8 'P21ma  ', 'P 21 m a   ', ' P -2a 2a      ',
     9 'P21am  ', 'P 21 a m   ', ' P -2 2a       ',
     * 'Pb21m  ', 'P b 21 m   ', ' P -2 -2b      ',
     1 'Pm21b  ', 'P m 21 b   ', ' P -2b -2      ',
     2 'P2aa   ', 'P 2 a a    ', ' P -2a 2       ',
     3 'Pb2b   ', 'P b 2 b    ', ' P -2b -2b     ',
     4 'Pbm2   ', 'P b m 2    ', ' P 2 -2b       ',
     5 'P2mb   ', 'P 2 m b    ', ' P -2b 2       ',
     6 'P2cm   ', 'P 2 c m    ', ' P -2c 2       ',
     7 'Pc2m   ', 'P c 2 m    ', ' P -2c -2c     ',
     8 'Pm2a   ', 'P m 2 a    ', ' P -2a -2a     ',
     9 'Pbc21  ', 'P b c 21   ', ' P 2c -2b      ',
     * 'P21ab  ', 'P 21 a b   ', ' P -2b 2a      ',
     1 'P21ca  ', 'P 21 c a   ', ' P -2ac 2a     ',
     2 'Pc21b  ', 'P c 21 b   ', ' P -2bc -2c    ',
     3 'Pb21a  ', 'P b 21 a   ', ' P -2a -2ab    ',
     4 'Pcn2   ', 'P c n 2    ', ' P 2 -2ac      ',
     5 'P2na   ', 'P 2 n a    ', ' P -2ac 2      ',
     6 'P2an   ', 'P 2 a n    ', ' P -2ab 2      ',
     7 'Pb2n   ', 'P b 2 n    ', ' P -2ab -2ab   ',
     8 'Pn2b   ', 'P n 2 b    ', ' P -2bc -2bc   ',
     9 'Pnm21  ', 'P n m 21   ', ' P 2bc -2bc    ',
     * 'P21mn  ', 'P 21 m n   ', ' P -2ab 2ab    ',
     1 'P21nm  ', 'P 21 n m   ', ' P -2 2ac      ',
     2 'Pn21m  ', 'P n 21 m   ', ' P -2 -2bc     ',
     3 'Pm21n  ', 'P m 21 n   ', ' P -2ab -2     ',
     4 'P2cb   ', 'P 2 c b    ', ' P -2bc 2      ',
     5 'Pc2a   ', 'P c 2 a    ', ' P -2ac -2ac   ',
     6 'Pbn21  ', 'P b n 21   ', ' P 2c -2ab     ',
     7 'P21nb  ', 'P 21 n b   ', ' P -2bc 2a     ',
     8 'P21cn  ', 'P 21 c n   ', ' P -2n 2a      ',
     9 'Pc21n  ', 'P c 21 n   ', ' P -2n -2ac    ',
     * 'Pn21a  ', 'P n 21 a   ', ' P -2ac -2n    ',
     1 'P2nn   ', 'P 2 n n    ', ' P -2n 2       ',
     2 'Pn2n   ', 'P n 2 n    ', ' P -2n -2n     ',
     3 'A2mm   ', 'A 2 m m    ', ' A -2 2        ',
     4 'Bm2m   ', 'B m 2 m    ', ' B -2 -2       ',
     5 'Ccm21  ', 'C c m 21   ', ' C 2c -2c      ',
     6 'A21ma  ', 'A 21 m a   ', ' A -2a 2a      ',
     7 'A21am  ', 'A 21 a m   ', ' A -2 2a       ',
     8 'Bb21m  ', 'B b 21 m   ', ' B -2 -2b      ',
     9 'Bm21b  ', 'B m 21 b   ', ' B -2b -2      ',
     * 'A2aa   ', 'A 2 a a    ', ' A -2a 2       ',
     1 'Bb2b   ', 'B b 2 b    ', ' B -2b -2b     ',
     2 'Bmm2   ', 'B m m 2    ', ' B 2 -2        ',
     3 'B2mm   ', 'B 2 m m    ', ' B -2 2        ',
     4 'C2mm   ', 'C 2 m m    ', ' C -2 2        ',
     5 'Cm2m   ', 'C m 2 m    ', ' C -2 -2       ',
     6 'Am2m   ', 'A m 2 m    ', ' A -2 -2       ',
     7 'Bma2   ', 'B m a 2    ', ' B 2 -2c       ',
     8 'B2cm   ', 'B 2 c m    ', ' B -2c 2       ',
     9 'C2mb   ', 'C 2 m b    ', ' C -2b 2       ',
     * 'Cm2a   ', 'C m 2 a    ', ' C -2b -2b     ',
     1 'Ac2m   ', 'A c 2 m    ', ' A -2c -2c     ',
     2 'Bbm2   ', 'B b m 2    ', ' B 2 -2b       ',
     3 'B2mb   ', 'B 2 m b    ', ' B -2b 2       ',
     4 'C2cm   ', 'C 2 c m    ', ' C -2c 2       ',
     5 'Cc2m   ', 'C c 2 m    ', ' C -2c -2c     ',
     6 'Am2a   ', 'A m 2 a    ', ' A -2a -2a     ',
     7 'Bba2   ', 'B b a 2    ', ' B 2 -2bc      ',
     8 'B2cb   ', 'B 2 c b    ', ' B -2bc 2      ',
     9 'C2cb   ', 'C 2 c b    ', ' C -2bc 2      ',
     * 'Cc2a   ', 'C c 2 a    ', ' C -2bc -2bc   ',
     1 'Ac2a   ', 'A c 2 a    ', ' A -2ac -2ac   ',
     2 'F2mm   ', 'F 2 m m    ', ' F -2 2        ',
     3 'Fm2m   ', 'F m 2 m    ', ' F -2 -2       ',
     4 'F2dd   ', 'F 2 d d    ', ' F -2d 2       ',
     5 'Fd2d   ', 'F d 2 d    ', ' F -2d -2d     ',
     6 'I2mm   ', 'I 2 m m    ', ' I -2 2        ',
     7 'Im2m   ', 'I m 2 m    ', ' I -2 -2       ',
     8 'I2cb   ', 'I 2 c b    ', ' I -2a 2       ',
     9 'Ic2a   ', 'I c 2 a    ', ' I -2b -2b     ',
     * 'Ibm2   ', 'I b m 2    ', ' I 2 -2b       ',
     1 'I2mb   ', 'I 2 m b    ', ' I -2b 2       ',
     2 'I2cm   ', 'I 2 c m    ', ' I -2c 2       ',
     3 'Ic2m   ', 'I c 2 m    ', ' I -2c -2c     ',
     4 'Im2a   ', 'I m 2 a    ', ' I -2a -2a     ',
     5 'Pmaa   ', 'P m a a    ', '-P 2a 2        ',
     6 'Pbmb   ', 'P b m b    ', '-P 2b 2b       ',
     7 'Pncb   ', 'P n c b    ', '-P 2b 2bc      ',
     8 'Pcna   ', 'P c n a    ', '-P 2a 2c       ',
     9 'Pmmb   ', 'P m m b    ', '-P 2b 2        ',
     * 'Pbmm   ', 'P b m m    ', '-P 2 2b        ',
     1 'Pcmm   ', 'P c m m    ', '-P 2c 2c       ',
     2 'Pmcm   ', 'P m c m    ', '-P 2c 2        ',
     3 'Pmam   ', 'P m a m    ', '-P 2 2a        ',
     4 'Pnnb   ', 'P n n b    ', '-P 2b 2n       ',
     5 'Pbnn   ', 'P b n n    ', '-P 2n 2b       ',
     6 'Pcnn   ', 'P c n n    ', '-P 2ab 2c      ',
     7 'Pncn   ', 'P n c n    ', '-P 2ab 2n      ',
     8 'Pnan   ', 'P n a n    ', '-P 2n 2bc      ',
     9 'Pnmb   ', 'P n m b    ', '-P 2bc 2bc     ',
     * 'Pbmn   ', 'P b m n    ', '-P 2ab 2ab     ',
     1 'Pcnm   ', 'P c n m    ', '-P 2 2ac       ',
     2 'Pncm   ', 'P n c m    ', '-P 2 2bc       ',
     3 'Pman   ', 'P m a n    ', '-P 2ab 2       ',
     4 'Pccb   ', 'P c c b    ', '-P 2b 2c       ',
     5 'Pbaa   ', 'P b a a    ', '-P 2a 2b       ',
     6 'Pcaa   ', 'P c a a    ', '-P 2ac 2c      ',
     7 'Pbcb   ', 'P b c b    ', '-P 2bc 2b      ',
     8 'Pbab   ', 'P b a b    ', '-P 2b 2ab      ',
     9 'Pmcb   ', 'P m c b    ', '-P 2bc 2       ',
     * 'Pcma   ', 'P c m a    ', '-P 2ac 2ac     ',
     1 'Pnaa   ', 'P n a a    ', '-P 2ac 2bc     ',
     2 'Pbnb   ', 'P b n b    ', '-P 2bc 2ab     ',
     3 'Pcam   ', 'P c a m    ', '-P 2c 2ac      ',
     4 'Pmca   ', 'P m c a    ', '-P 2ac 2a      ',
     5 'Pmab   ', 'P m a b    ', '-P 2b 2a       ',
     5 'Pbma   ', 'P b m a    ', '-P 2a 2ab      ',
     7 'Pcmb   ', 'P c m b    ', '-P 2bc 2c      ',
     8 'Pmnn   ', 'P m n n    ', '-P 2n 2        ',
     9 'Pnmn   ', 'P n m n    ', '-P 2n 2n       ',
     * 'Pnmm   ', 'P n m m    ', '-P 2c 2bc      ',
     1 'Pmnm   ', 'P m n m    ', '-P 2c 2a       ',
     2 'Pcan   ', 'P c a n    ', '-P 2n 2c       ',
     3 'Pnca   ', 'P n c a    ', '-P 2a 2n       ',
     4 'Pnab   ', 'P n a b    ', '-P 2bc 2n      ',
     5 'Pbna   ', 'P b n a    ', '-P 2ac 2b      ',
     6 'Pcnb   ', 'P c n b    ', '-P 2b 2ac      ',
     7 'Pcab   ', 'P c a b    ', '-P 2bc 2ac     ',
     8 'Pmnb   ', 'P m n b    ', '-P 2bc 2a      ',
     9 'Pbnm   ', 'P b n m    ', '-P 2c 2ab      ',
     * 'Pcmn   ', 'P c m n    ', '-P 2n 2ac      ',
     1 'Pmcn   ', 'P m c n    ', '-P 2n 2a       ',
     2 'Pnam   ', 'P n a m    ', '-P 2c 2n       ',
     3 'Ccmm   ', 'C c m m    ', '-C 2c 2c       ',
     4 'Amma   ', 'A m m a    ', '-A 2a 2a       ',
     5 'Amam   ', 'A m a m    ', '-A 2 2a        ',
     6 'Bbmm   ', 'B b m m    ', '-B 2 2b        ',
     7 'Bmmb   ', 'B m m b    ', '-B 2b 2        ',
     8 'Ccmb   ', 'C c m b    ', '-C 2bc 2bc     ',
     9 'Abma   ', 'A b m a    ', '-A 2ac 2ac     ',
     * 'Acam   ', 'A c a m    ', '-A 2 2ac       ',
     1 'Bbcm   ', 'B b c m    ', '-B 2 2bc       ',
     2 'Bmab   ', 'B m a b    ', '-B 2bc 2       ',
     3 'Ammm   ', 'A m m m    ', '-A 2 2         ',
     4 'Bmmm   ', 'B m m m    ', '-B 2 2         ',
     5 'Amaa   ', 'A m a a    ', '-A 2a 2        ',
     6 'Bbmb   ', 'B b m b    ', '-B 2b 2b       ',
     7 'Cmmb   ', 'C m m b    ', '-C 2b 2b       ',
     8 'Abmm   ', 'A b m m    ', '-A 2c 2c       ',
     9 'Acmm   ', 'A c m m    ', '-A 2 2c        ',
     * 'Bmcm   ', 'B m c m    ', '-B 2 2c        ',
     1 'Bmam   ', 'B m a m    ', '-B 2c 2        ',
     2 'Cccb   ', 'C c c b    ', '-C 2b 2c       ',
     3 'Abaa   ', 'A b a a    ', '-A 2a 2c       ',
     4 'Acaa   ', 'A c a a    ', '-A 2ac 2c      ',
     5 'Bbcb   ', 'B b c b    ', '-B 2bc 2b      ',
     6 'Bbab   ', 'B b a b    ', '-B 2b 2bc      ',
     7 'Imcb   ', 'I m c b    ', '-I 2a 2        ',
     8 'Icma   ', 'I c m a    ', '-I 2b 2b       ',
     9 'Icab   ', 'I c a b    ', '-I 2a 2b       ',
     * 'Immb   ', 'I m m b    ', '-I 2a 2a       ',
     1 'Ibmm   ', 'I b m m    ', '-I 2c 2c       ',
     2 'Icmm   ', 'I c m m    ', '-I 2 2b        ',
     3 'Imcm   ', 'I m c m    ', '-I 2 2a        ',
     4 'Imam   ', 'I m a m    ', '-I 2c 2        ',
     5 'Fddd:2 ', 'F d d d:2  ', '-F 2uv 2cvw    '/
      END
C * GENERAL ROUTINES (21-03-2011)
C * GEN001 - W = Z  * T * Z~  OR  W = Z~ * T * Z
C * GEN002 - MATVEC & NORM OR VECMAT
C * GEN003 - MINV
C * GEN004 - MPRD
C * GEN005 - TRANSPOSE MATRIX
C * GEN006 - VECTOR1 * MATRIX * VECTOR2
C * GEN007 - UNIP
C * GEN008 - VPROD
C * GEN009 - VV
C * GEN010 - DETERMINANT
C * GEN011 - NORM
C * GEN012 - MATRIX INVERSION
C * GEN013 - SORT
C * GEN014 - SWAP INTEGERS
C * GEN015 - Add/Subtract 3-vector B to/from 3-vector A
C * GEN016 - ANGLE BETWEEN TWO VECTORS
C * GEN017 - NORMALIZE VECTOR
C * GEN018 - SWAP REALS
C * GEN019 - AXES
C * GEN020 - UP/LO-CASE
C * GEN021 - ZINIT (INIT MATRIX ON INTEGER VALUE)
C * GEN022 - SORT(N1:N2)
C * GEN023 - EIGEN
C * GEN024 - EWEV
C * GEN025 - M(3, 3) <--> V(6)
C * GEN026 - METRIC TO CELL AND VISA VERSA
C * GEN027 - ANGLE BETWEEN VECTORS
C * GEN028 - FFT
C * GEN029 - EWEV1
C * GEN030 - EWEV2
C * GEN031 - EWEV3
C * GEN032 - EWEV4
C * GEN033 - AMOEBA
C * GEN034 - SORT REAL LARGE --> SMALL
C * GEN035 - SORT READ SMALL --> LARGE
C * GEN036 - RANDOM GEN
C * GEN037 - SORT TABLE
C * GEN038 - BLANK LINE
C * GEN039 - STRIP HEADER/TRAILER BLANKS
C * GEN040 - NUMBER TO STRING
C * GEN041 - ROUND ROUTINE
C * GEN042 - GET NUMERICAL VALUE(S) FROM CHARACTER STRING
C * GEN043 - X,Y,Z ANGLE TO MATRIX
C * GEN044 - ORTHOGONALISATION
C * GEN045 - CALCULATE CELL-VOLUME FROM CELL-PARAMETERS
C * GEN046 - UNPACK HKL
C * GEN047 - ELIMINATE BLANKS
C * GEN048 - BIT MANIPULATION
C * GEN051 - GENERATE RMAT FROM ROTX, ROTY, ROTZ
C * GEN052 - COPY MATRIX
C * GEN053 - SORT (HEAP)
C * GEN054 - JACOBI (DOUBLE PRECISION)
C * GEN055 - YLM - Spherical Harmonics
C * GEN056 - SINTHETA/LAMBDA
C * GEN057 - GAUSS-ELIMINATION METHOD FOR MATRIX INVERSION   A*X=D
C * GEN058 - NR-TO-ATOM LABEL
C * GEN059 - TMUL4
C * GEN060 - TRNSP4
C * GEN061 - TINV4
C * GEN062 - LUDCMP
C * GEN063 - LUBKSB
C * GEN064 - JACOBI (SINGLE PRECISION)
C * GEN065 - MODIFY AND PRINT PRINT-BUFFER
C * GEN066 - APPLY SYMMETRY CONSTRAINTS ON CELL DIMENSIONS
C * GEN067 - TRANSFORM CELL ESD'S
C * GEN068 - CALCULATE CSD IN CELL VOLUME
C * GEN069 - TRFORD
C * GEN070 - POLFIW
C * GEN071 - EVAPOL
C * GEN072 - FREEREAD
C * GEN073 - MOLSYM ROUTINE
C * GEN074 - SET ARRAY TO REAL VALUE
C * GEN075 - MOLSYM ROUTINE
C * GEN076 - MOLSYM ROUTINE
C * GEN077 - MOLSYM ROUTINE
C * GEN078 - MOLSYM ROUTINE
C * GEN079 - COPY MATRIX (INDEX 3)
C * GEN080 - COPY VECTOR
C * GEN081 - MOLSYM ROUTINE
C * GEN082 - MOLSYM ROUTINE
C * GEN083 - PLANE THROUGH THREE POINTS
C * GEN084 - DETERMINANT (,,)
C * GEN085 - COMPACT STRING
C * GEN086 - MOLSYM FUNCTION
C * GEN087 - MOLSYM SUBROUTINE
C * GEN088 - GROUP ORDER
C * GEN089 - ADOBE PS/
C * GEN090 - BITWISE LOGICAL AND
C * GEN091 - SORT IN ORDER OF X(*,ITEM)
C * GEN092 - TEST LATTICE TYPE
C * GEN093 - HYPOTHESES TEST
C * GEN094 - TEST LATTICE TYPE
C * GEN095 - CALCULATE (SIN(THETA) / LAMBDA)**2
C * GEN096 - MAP THE NINE ELEMENTS OF T INTO ROTX, ROTY, ROTZ, IDET
C * GEN097 - SET INTEGER ARRAY ON VALUE
C * GEN098 - SPLIT-UP ARU CODE IN COMPONENTS
C * GEN099 - FORM QUADRATIC FORM
C * GEN100 - TLS MATRIX
C * GEN101 - GENERATE INDEX COMBINATIONS IN +/- N RANGE
C * GEN102 - TRANSFORM KEYWORD TO ENTRYPOINT NUMBER IN ARRAY
C * GEN103 - COMPACT LINE TO ONE BLANK SEPARATOR
C * GEN104 - CHECK FOR TRIVIAL TRANSFORMATIONS
C * GEN105 - SEARCH FOR CHARACTER/NUMERAL
C * GEN106 - CONVERT PSI(H.FLACK) TO DIRECTION COSINES (SHELDRICK)
C * GEN107 - REDUCE VECTOR
C * GEN108 - REWIND/ENDFILE
C * GEN109 - SPHERICAL HARMONICS
C * GEN110 - CHOLESKI
C * GEN111 - MANIPULATE THE CHEMICAL FORMULA
C * GEN112 - CONVERT 3*3 MATRIX to 9 VECTOR AND REVERSE
C * GEN113 - COPY VECTOR WITH N ELEMENTS
C * GEN114 - GET MAIN AXES AND VALUES OF UIJ TENSOR
C * GEN115 - GAUSSIAN INTEGRATION COEFFICIENTS
C * GEN116 - (H)NP ROUTINE-1 - MAIN
C * GEN117 - (H)NP ROUTINE-2
C * GEN118 - (H)NP ROUTINE-3
C * GEN119 - CALCULATE CORRELATION COEFF ETC.
C * GEN120 - (H)NP ROUTINE-4 - PLOT
C * GEN121 - ELIMINATE () FROM STRING
C * GEN122 - BUBBLE SORT
C * GEN123 - SORT ELEMENTS IN FORMULA
C * GEN124 - SHELL-SORT SMALL TO LARGE
C * GEN125 - WRITE SPECIAL STRING
C * GEN126 - BLANK STRING
C * GEN127 - EXIT/STOP
C * GEN128 - CHECK FOR METAL-METAL CONTACTS
C * GEN129 - DELETE FILE (CHECK FOR EXISTANCE)
C * GEN130 - DETERMINANT OF 3*3 MATRIX
C * GEN131 - DETERMINANT OF 3*3 MATRIX FROM EXTENDED ARRAY
C * GEN132 - Z = T1 * X * T2
C * GEN133 - C COPY VECTOR WITH N ELEMENTS
C * GEN134 - COPY FORMULA STRINGS
C * GEN135 - UNIT 3*3 MATRIX ?
C * GEN136 - GAMMA FUNCTION
C * GEN137 - PSI FUNCTION
C * GEN138 - HYPERGEOM FUNCTION
C * GEN139 - CALCULATE CUMULATIVE DISTRIBUTION FUNCTION FOR STUDENT-T PDF
C * GEN140 - INVERSE CUMULATIVE DISTRIBUTION FOR STUDENT-T DISTRIBUTION
C * GEN141 -
C * GEN142 -
C * GEN143 -
C * GEN144 -
C * GEN145 - STANDARDIZE H,K,L (FRIEDEL SYMMETRY APPLIED)
C * GEN146 - Pack Flack,Parsons or Hooft parameter values for listing
C * GEN147 - 3 ITEM SORT
      SUBROUTINE GEN001 (MODE, Z, T, W)
      DIMENSION Z(3, 3), T(3, 3), V(3, 3), W(3, 3), ZTR(3, 3)
      CALL GEN005 (Z, ZTR)
      IF (MODE .EQ. 1) THEN
        CALL GEN004 (Z, T, V)
        CALL GEN004 (V, ZTR, W)
      ELSE
        CALL GEN004 (ZTR, T, V)
        CALL GEN004 (V, Z, W)
      END IF
      RETURN
      END SUBROUTINE GEN001
      SUBROUTINE GEN002 (MODE, A, B, C, XLNG)
      DIMENSION A(3, 3), B(3), C(3), V(3)
      XLNG = 0.0
      DO I = 1, 3
        V(I) = 0.0
        IF (MODE .GT. 0) THEN
          DO J = 1, 3
            V(I) = V(I) + A(I, J) * B(J)
          END DO
        ELSE
          DO J = 1, 3
            V(I) = V(I) + B(J) * A(J, I)
          END DO
        END IF
      END DO
      DO I = 1, 3
        C(I) = V(I)
      END DO
      IF (IABS(MODE) .EQ. 2) THEN
        XLNG = SQRT(GEN009 (C, C))
        IF (XLNG .GT. 1.E-5) THEN
          DO I = 1, 3
            C(I) = C(I) / XLNG
          END DO
        ELSE
          XLNG = 0.0
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN002
      SUBROUTINE GEN003 (A, B, DET, MODE)
      DIMENSION A(3, 3), B(3, 3), C(3, 3)
      CALL GEN008 (A(1, 2), A(1, 3), B(1, 1), 0)
      CALL GEN008 (A(1, 3), A(1, 1), B(1, 2), 0)
      CALL GEN008 (A(1, 1), A(1, 2), B(1, 3), 0)
      DET = GEN009 (A(1, 1), B(1, 1))
      IF (MODE .EQ. 0) THEN
        CALL GEN005 (B, C)
        CALL GEN052 (C, B)
        DEEL = DET
      ELSE IF (MODE .EQ. 1) THEN
        DEEL = B(3, 3)
      ELSE
        DEEL = 0
      END IF
      IF (DEEL .NE. 0.0) THEN
        DO I = 1, 3
          DO J = 1, 3
            B(I, J) = B(I, J) / DEEL
          END DO
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN003
      SUBROUTINE GEN004 (A, B, C)
      DIMENSION A(3, 3), B(3, 3), C(3, 3), V(3, 3)
      DO I = 1, 3
        DO J = 1, 3
          V(I, J) = 0.0
          DO K = 1, 3
            V(I, J) = V(I, J) + A(I, K) * B(K, J)
          END DO
        END DO
      END DO
      DO I = 1, 3
        DO J = 1, 3
          C(I, J) = V(I, J)
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN004
      SUBROUTINE GEN005 (T, TR)
      DIMENSION T(3, 3), TR(3, 3), X(3, 3)
      DO I = 1, 3
        DO J = 1, 3
          X(J, I) = T(I, J)
        END DO
      END DO
      DO I = 1, 3
        DO J = 1, 3
          TR(I, J) = X(I, J)
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN005
      FUNCTION GEN006 (X1, QM, X2)
      DIMENSION X1(3), QM(3, 3), X2(3)
      T1 = 0.0
      DO J = 1, 3
        T1 = T1 + X1(J) * (X2(1) * QM(J, 1) + X2(2) * QM(J, 2)
     1     + X2(3) * QM(J, 3))
      END DO
      GEN006 = T1
      RETURN
      END FUNCTION GEN006
      SUBROUTINE GEN007 (AA, X, Z, ITYPE)
      DIMENSION X(3), Z(3), AA(3,3)
      IF (ITYPE .GT. 0) THEN
        TN = SQRT(GEN009(X, X))
      ELSE
        TN = SQRT(GEN006(X, AA, X))
      END IF
      IF (TN .EQ. 0.0) TN = 1.0
      Z(1) = X(1) / TN
      Z(2) = X(2) / TN
      Z(3) = X(3) / TN
      RETURN
      END SUBROUTINE GEN007
      SUBROUTINE GEN008 (A, B, C, MODE)
      DIMENSION A(3), B(3), C(3)
      C(1) = A(2) * B(3) - A(3) * B(2)
      C(2) = A(3) * B(1) - A(1) * B(3)
      C(3) = A(1) * B(2) - A(2) * B(1)
      IF (MODE .NE. 0) THEN
        DSQ = C(1) * C(1) + C(2) * C(2) + C(3) * C(3)
        IF (MODE .GT. 0) THEN
          IF (DSQ .NE. 0.0) THEN
            D = SQRT(DSQ)
            C(1) = C(1) / D
            C(2) = C(2) / D
            C(3) = C(3) / D
          END IF
        ELSE
          C(1) = DSQ
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN008
      FUNCTION GEN009 (X, Y)
      DIMENSION X(3), Y(3)
      GEN009 = X(1) * Y(1) + X(2) * Y(2) + X(3) * Y(3)
      RETURN
      END FUNCTION GEN009
      SUBROUTINE GEN010 (R, IDET, MODE)
      DIMENSION R(3, 3), V(3)
      IF (MODE .GE. 0) THEN
        CALL GEN008 (R(1, 1), R(1, 2), V, 0)
        DET = GEN009 (R(1, 3), V)
        IF (DET .GT. 0.999) THEN
          IDET = 1
        ELSE IF (DET .LT. -0.999) THEN
          IDET = -1
        ELSE
          IDET = 0
        END IF
      END IF
      IF (MODE .NE. 0) THEN
        DO I = 1, 3
          DO J = 1, 3
            R(I, J) = IDET * R(I, J)
          END DO
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN010
      SUBROUTINE GEN011 (BB, X, Y, Z, ITYPE)
      DIMENSION X(3), Y(3), Z(3), Z1(3), BB(3,3)
      DO I = 1, 3
        I1 = MOD(I + 3, 3) + 1
        I2 = MOD(I + 1, 3) + 1
        T1 = X(I1) * Y(I2) - X(I2) * Y(I1)
        IF (ABS(T1) .LT. 1.E-6) T1 = 0.0
        IF (ITYPE .GT. 0) THEN
          Z(I) = T1
        ELSE
          Z1(I) = T1
        END IF
      END DO
      IF (ITYPE .LE. 0) CALL GEN002 (1, BB, Z1, Z, XLNG)
      RETURN
      END SUBROUTINE GEN011
      SUBROUTINE GEN012 (B, A, NN, DAMP, DA, R)
      DIMENSION B(*), A(*)
      K = 0
      L = 0
      J = NN + 1
      DO NI = 1, NN
        K = K + 2
        I = J - 1
        M = J + 1
        B(J) = 1.0 / AMAX1(B(J) + DA * DAMP, 0.1 * DA, 1.E-10)
        IF (NI .LT. NN) THEN
   10     B(K) = - B(J) * B(M)
          M    = M + 1
          K    = K + 1
          IF (K .GE. J) THEN
            L = J + NI - NN
            J = J + 1
            IF (I .GE. L) THEN
   20         B(M) = B(J) * B(L) + B(M)
              M    = M + 1
              L    = L + 1
              IF (I .LT. L) THEN
                L = J + NI - NN
                J = J + 1
                IF (I .LT. L) CYCLE
              ENDIF
              GO TO 20
            ELSE
              CYCLE
            ENDIF
          ENDIF
          GO TO 10
        END IF
      END DO
      NI   = NN - 1
   30 NI   = NI - 1
      J    = K
      M    = K + NI - NN
      L    = M - 1
      I    = M + 1
      K    = I + NI - NN
   40 B(I) = 0.0
      I    = I + 1
      IF (I .LT. J) GO TO 40
   50 M    = M + 1
      B(M) = B(K) * B(J) + B(M)
      I    = M
      NK   = K + 1
   60 IF (L .GE. NK) THEN
        J    = J + 1
        I    = I + 1
        B(I) = B(K)  * B(J) + B(I)
        B(M) = B(NK) * B(J) + B(M)
        NK   = NK + 1
        GO TO 60
      END IF
      B(NK) = B(K) * B(M) + B(NK)
      J     = J + 1
      K     = K + 1
      IF (L  .GE. K) GO TO 50
      IF (NI .GT. 0) GO TO 30
      CALL GEN074 (B, 1, NN, 0.0)
      L = NN + 1
      DO I = 1, NN
        B(I) = B(I) - B(L) * A(I)
        T = B(L) * R
        DO K = I, NN
          B(I) = B(L) * A(K) + B(I)
          B(K) = B(L) * A(I) + B(K)
          L    = L + 1
        END DO
        A(I) = SQRT(ABS(T))
      END DO
      RETURN
      END SUBROUTINE GEN012
      SUBROUTINE GEN013 (DATC, IATC, N1, N)
      DIMENSION IATC(*), DATC(*)
      NEL = N - N1 + 1
      IF (NEL .GT. 1) THEN
        ND = 2**(INT((ALOG(FLOAT(NEL)) / ALOG(2.0)) + 1.0e-5)) - 1
   10   IF (ND .LE. 0) GO TO 40
        I            = N1
   20   J            = I
        Y            = DATC(I + ND)
        NZ           = IATC(I + ND)
   30   IF (Y .LT. DATC(J)) THEN
          DATC(J + ND) = DATC(J)
          IATC(J + ND) = IATC(J)
          J            = J - ND
          IF (J .GE. N1) GO TO 30
        END IF
        DATC(J + ND) = Y
        IATC(J + ND) = NZ
        I            = I + 1
        IF (I + ND .LE. N) GO TO 20
        ND           = (ND - 1) / 2
        GO TO 10
      END IF
   40 RETURN
      END SUBROUTINE GEN013
      SUBROUTINE GEN014 (I, J)
      K = I
      I = J
      J = K
      RETURN
      END SUBROUTINE GEN014
      SUBROUTINE GEN015 (A, B, C, XMUL)
      DIMENSION A(3), B(3), C(3)
      DO I = 1, 3
        C(I) = A(I) + XMUL * B(I)
      END DO
      RETURN
      END SUBROUTINE GEN015
      FUNCTION GEN016 (X1, QM, X2)
      DIMENSION X1(3), X2(3), QM(3,3)
      RAD    = ATAN2 (1.0, 1.0) / 45.0
      A      = GEN006 (X1, QM, X2)
      B      = GEN006 (X1, QM, X1)
      C      = GEN006 (X2, QM, X2)
      GEN016 = ACOS (A / SQRT (B * C)) / RAD
      RETURN
      END FUNCTION GEN016
      FUNCTION GEN017 (V)
      DIMENSION V(3)
      D = SQRT (V(1) ** 2 + V(2) ** 2 + V(3) ** 2)
      IF (D .LT. 0.00001) THEN
        GEN017 = 0.0
      ELSE
        GEN017 = D
        DO I = 1, 3
          V(I) = V(I) / D
        END DO
      END IF
      RETURN
      END FUNCTION GEN017
      SUBROUTINE GEN018 (A, B)
      C = A
      A = B
      B = C
      RETURN
      END SUBROUTINE GEN018
      SUBROUTINE GEN019 (AA, BB, U, V, X, ITYPE)
      DIMENSION U(3), V(3), W(3, 3), X(3, 3), AA(3, 3), BB(3, 3)
      IT = ITYPE
      DO J = 1, 3
         W(J, 1) = U(J)
      END DO
      CALL GEN011 (BB, U, V, W(1, 2), IT)
      CALL GEN011 (BB, U, W(1, 2), W(1, 3), IT)
      DO I = 1, 3
        CALL GEN007 (AA, W(1, I), X(1, I), IT)
      END DO
      RETURN
      END SUBROUTINE GEN019
      SUBROUTINE GEN020 (MODE, ICL, IMIN, IMAX)
      CHARACTER ICL*(*)
      IF (IMAX .GE. IMIN) THEN
        IF (MODE .GT. 0) THEN
          DO I = IMIN, IMAX
            IF (ICL(I:I) .EQ. CHAR(9)) ICL(I:I) = ' '
            CALL GEN105 (2, ICL(I:I), N)
            IF (N .GT. 0) ICL(I:I) = CHAR(N + ICHAR('A') - ICHAR('a'))
          END DO
        ELSE
          DO I = IMIN, IMAX
            CALL GEN105 (1, ICL(I:I), N)
            IF (N .GT. 0) ICL(I:I) = CHAR(N - ICHAR('A') + ICHAR('a'))
          END DO
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN020
      SUBROUTINE GEN021 (X, MODE)
      DIMENSION X(3, 3)
      DO I = 1, 3
        DO J = 1, 3
          IF (I .EQ. J) THEN
            X(I, I) = MODE
          ELSE
            X(I, J) = 0.0
          END IF
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN021
      SUBROUTINE GEN022 (NA, N0, N)
      DIMENSION NA(*)
      NEL = N - N0 + 1
      IF (NEL .LE. 1) GO TO 50
      ND = 2**(INT((ALOG(FLOAT(NEL)) / ALOG(2.0)) + 1.0E-5)) - 1
   10 IF (ND .LE. 0) GO TO 50
      I = N0
   20 J = I
      NY = NA(I + ND)
   30 IF (NY .GE. NA(J)) GO TO 40
      NA(J + ND) = NA(J)
      J = J - ND
      IF (J .GE. N0) GO TO 30
   40 NA(J + ND) = NY
      I = I + 1
      IF (I + ND .LE. N) GO TO 20
      ND = (ND - 1) / 2
      GO TO 10
   50 RETURN
      END SUBROUTINE GEN022
      SUBROUTINE GEN023 (A, R, N)
      DIMENSION A(*), R(*)
      RANGE = 1.0E-6
      IQ = - N
      DO J = 1, N
        IQ = IQ + N
        DO I = 1, N
          IJ = IQ + I
          IF (I .EQ. J) THEN
            R(IJ) = 1.0
          ELSE
            R(IJ) = 0.0
          END IF
        END DO
      END DO
      ANORM = 0.0
      DO I = 1, N
        DO J = I, N
          IF (I .NE. J) THEN
            IA    = I + (J * J - J) / 2
            ANORM = ANORM + A(IA)**2
          END IF
        END DO
      END DO
      IF (ANORM .GT. 0.0) THEN
        ANORM = 1.414 * SQRT(ANORM)
        ANRMX = ANORM * RANGE / FLOAT(N)
        IND = 0
        THR = ANORM
   10   THR = THR / FLOAT(N)
   20   L   = 1
   30   M   = L + 1
   40   MQ = (M * M - M) / 2
        LQ = (L * L - L) / 2
        LM = L + MQ
        IF (ABS(A(LM)) .GE. THR) THEN
          IND = 1
          LL  = L + LQ
          MM  = M + MQ
          X   = 0.5 * (A(LL) - A(MM))
          Y   = -A(LM) / SQRT(A(LM) * A(LM) + X**2)
          IF (X .LT. 0.0) Y  = - Y
          Y2 = Y**2
          IF (Y2 .LT. 1.0) THEN
            SINX = Y / SQRT(2.0 * (1.0 + (SQRT(1.0 - Y2))))
          ELSE
            SINX = Y / SQRT(2.0)
          END IF
          SINX2 = SINX * SINX
          COSX  = SQRT(1.0 - SINX2)
          COSX2 = COSX**2
          SINCS = SINX * COSX
          ILQ = N * (L - 1)
          IMQ = N * (M - 1)
          DO I = 1, N
            IQ = (I * I - I) / 2
            IF (I .NE. L) THEN
              IF (I .GT. M) THEN
                IM = M + IQ
                GO TO 50
              ELSE IF (I .EQ. M) THEN
                GO TO 70
              END IF
              IM = I + MQ
   50         IF (I .LT. L) THEN
                IL = I + LQ
                GO TO 60
              END IF
              IL = L + IQ
   60         X     = A(IL) * COSX - A(IM) * SINX
              A(IM) = A(IL) * SINX + A(IM) * COSX
              A(IL) = X
            END IF
   70       ILR    = ILQ + I
            IMR    = IMQ + I
            X      = R(ILR) * COSX - R(IMR) * SINX
            R(IMR) = R(ILR) * SINX + R(IMR) * COSX
            R(ILR) = X
          END DO
          X     = 2.0 * A(LM) * SINCS
          Y     = A(LL) * COSX2 + A(MM) * SINX2 - X
          X     = A(LL) * SINX2 + A(MM) * COSX2 + X
          A(LM) = (A(LL) - A(MM)) * SINCS + A(LM) * (COSX2 - SINX2)
          A(LL) = Y
          A(MM) = X
        END IF
        IF (M .NE. N) THEN
          M = M + 1
          GO TO 40
        END IF
        IF (L .NE. (N - 1)) THEN
          L = L + 1
          GO TO 30
        END IF
        IF (IND .EQ. 1) THEN
          IND = 0
          GO TO 20
        END IF
        IF (THR .GT. ANRMX) GO TO 10
      END IF
      IQ = - N
      DO I = 1, N
        IQ = IQ + N
        LL = I + (I * I - I) / 2
        JQ = N * (I - 2)
        DO J = I, N
          JQ = JQ + N
          MM = J + (J * J - J) / 2
          IF (A(LL) .LT. A(MM)) THEN
            X     = A(LL)
            A(LL) = A(MM)
            A(MM) = X
            DO K = 1, N
              ILR    = IQ + K
              IMR    = JQ + K
              X      = R(ILR)
              R(ILR) = R(IMR)
              R(IMR) = X
            END DO
          END IF
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN023
      SUBROUTINE GEN024 (W, EV, EW, DUMV)
      DIMENSION W(3, 3), EV(3, 3), EW(3), DUMA(6), DUMV(3, 3)
      DUMA(1) = W(1, 1)
      DUMA(2) = W(1, 2)
      DUMA(3) = W(2, 2)
      DUMA(4) = W(1, 3)
      DUMA(5) = W(2, 3)
      DUMA(6) = W(3, 3)
      CALL GEN023 (DUMA, DUMV, 3)
      CALL GEN008 (DUMV(1, 1), DUMV(1, 2), DUMV(1, 3), 1)
      CALL GEN005 (DUMV, EV)
      EW(1) = DUMA(1)
      EW(2) = DUMA(3)
      EW(3) = DUMA(6)
      RETURN
      END SUBROUTINE GEN024
      SUBROUTINE GEN025 (A, V, MODE)
      DIMENSION A(3, 3), V(6)
      IF (MODE .GT. 0) THEN
        V(1) = A(1, 1)
        V(2) = A(2, 2)
        V(3) = A(3, 3)
        V(4) = A(2, 3)
        V(5) = A(1, 3)
        V(6) = A(1, 2)
      ELSE
        A(1, 1) = V(1)
        A(2, 2) = V(2)
        A(3, 3) = V(3)
        A(2, 3) = V(4)
        A(3, 2) = V(4)
        A(1, 3) = V(5)
        A(3, 1) = V(5)
        A(1, 2) = V(6)
        A(2, 1) = V(6)
      END IF
      RETURN
      END SUBROUTINE GEN025
      SUBROUTINE GEN026 (MODE, A, V)
      DIMENSION A(3, 3), V(6)
      RAD = ATAN2 (1.0, 1.0) / 45.0
      IF (MODE .EQ. 1) THEN
        A(1, 2) = 0.0
        A(1, 3) = 0.0
        A(2, 3) = 0.0
        A(1, 1) = V(1) * V(1)
        A(2, 2) = V(2) * V(2)
        A(3, 3) = V(3) * V(3)
        IF (ABS(V(6) - 90.0) .GT. 0.00001)
     1    A(1, 2) = V(1) * V(2) * COS(V(6) * RAD)
        A(2, 1) = A(1, 2)
        IF (ABS(V(5) - 90.0) .GT. 0.00001)
     1    A(1, 3) = V(1) * V(3) * COS(V(5) * RAD)
        A(3, 1) = A(1, 3)
        IF (ABS(V(4) - 90.0) .GT. 0.00001)
     1    A(2, 3) = V(2) * V(3) * COS(V(4) * RAD)
        A(3, 2) = A(2, 3)
      ELSE IF (MODE .EQ. -1) THEN
        V(1)   = SQRT(A(1, 1))
        V(2)   = SQRT(A(2, 2))
        V(3)   = SQRT(A(3, 3))
        V(4)   = ACOS(A(2, 3) / (V(2) * V(3))) / RAD
        V(5)   = ACOS(A(1, 3) / (V(1) * V(3))) / RAD
        V(6)   = ACOS(A(1, 2) / (V(1) * V(2))) / RAD
      END IF
      RETURN
      END SUBROUTINE GEN026
      FUNCTION GEN027 (V1, V2, P5)
      DIMENSION V1(*), V2(*)
      ANG = GEN009 (V1, V2)
      IF (ANG .GT.  1.0) ANG =  1.0
      IF (ANG .LT. -1.0) ANG = -1.0
      GEN027 = ACOS(ANG) * P5
      RETURN
      END FUNCTION GEN027
      SUBROUTINE GEN028 (XAR, NN, NDM, ISIGN)
      DOUBLE PRECISION WR, WI, WPR, WPI, WYK, TH
      DIMENSION NN(NDM), XAR(*)
      NPRV = 1
      NTOT = 1
      DO IDM = 1, NDM
        NTOT = NTOT * NN(IDM)
      END DO
      DO IDM = 1, NDM
        N    = NN(IDM)
        NREM = NTOT / (N * NPRV)
        IPA  = 2 * NPRV
        IPB  = IPA * N
        IPC  = IPB * NREM
        IBRV = 1
        DO IB = 1, IPB, IPA
          IF (IB .LT. IBRV) THEN
            DO IA = IB, IB + IPA - 2, 2
              DO IC = IA, IPC, IPB
                ICRV          = IBRV + IC - IB
                YKR           = XAR(IC)
                YKI           = XAR(IC + 1)
                XAR(IC)       = XAR(ICRV)
                XAR(IC + 1)   = XAR(ICRV + 1)
                XAR(ICRV)     = YKR
                XAR(ICRV + 1) = YKI
              END DO
            END DO
          END IF
          IBIT = IPB / 2
   10     IF ((IBIT .GE. IPA) .AND. (IBRV .GT. IBIT)) THEN
            IBRV = IBRV - IBIT
            IBIT = IBIT / 2
            GO TO 10
          END IF
          IBRV = IBRV + IBIT
        END DO
        IFPA = IPA
   20   IF (IFPA .LT. IPB) THEN
          IFPB = 2 * IFPA
          TH   = ISIGN * 6.28318530717959D0 / (IFPB / IPA)
          WPR  = -2.D0 * DSIN(0.5D0 * TH)**2
          WPI  = DSIN(TH)
          WR   = 1.D0
          WI   = 0.D0
          DO IC = 1, IFPA, IPA
            DO IA = IC, IC + IPA - 2, 2
              DO IB = IA, IPC, IFPB
                KA     = IB
                KB     = KA + IFPA
                SWR    = SNGL(WR)
                SWI    = SNGL(WI)
                XARKB  = XAR(KB)
                IF (ABS(XARKB) .LT. 1.0E-15) XARKB = 0.0
                XARKB1 = XAR(KB + 1)
                IF (ABS(XARKB1) .LT. 1.0E-15) XARKB1 = 0.0
                YKR    = SWR * XARKB  - SWI * XARKB1
                YKI    = SWR * XARKB1 + SWI * XARKB
                XAR(KB)     = XAR(KA)     - YKR
                XAR(KB + 1) = XAR(KA + 1) - YKI
                XAR(KA)     = XAR(KA)     + YKR
                XAR(KA + 1) = XAR(KA + 1) + YKI
              END DO
            END DO
            WYK = WR
            WR  = WR * WPR - WI  * WPI + WR
            WI  = WI * WPR + WYK * WPI + WI
          END DO
          IFPA = IFPB
          GO TO 20
        END IF
        NPRV = N * NPRV
      END DO
      RETURN
      END SUBROUTINE GEN028
      SUBROUTINE GEN029 (A, VALUE, VECTOR, M, IA, IV, W)
      DIMENSION A(IA, M), VALUE(M), VECTOR(IV, M), W(*)
      M1   = M + 1
      W(1) = A(1, 1)
      IF (M .EQ. 2) THEN
        W(2) = A(2, 2)
        W(4) = A(2, 1)
      ELSE IF (M .GT. 2) THEN
        CALL GEN030 (A, W, W(M1), M, IA, W(M + M1))
      END IF
      CALL GEN031 (W, W(M1), VALUE, VECTOR, M, IV, W(M + M1))
      IF (M .GT. 2) THEN
        DO L = 1, M
          DO II = 3, M
            I = M - II + 1
            IF (W(M1 + I) .NE. 0.0) THEN
              PP = 0.0
              I1 = I + 1
              DO K = I1, M
                PP = PP + A(I, K) * VECTOR(K, L)
              END DO
              PP = PP / (A(I, I + 1) * W(M1 + I))
              DO K = I1, M
                VECTOR(K, L) = VECTOR(K, L) + PP * A(I, K)
              END DO
            END IF
          END DO
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN029
      SUBROUTINE GEN030 (A, ALPHA, BETA, M, IA, Q)
      DIMENSION A(IA, *), ALPHA(*), BETA(*), Q(*)
      ALPHA(1) = A(1, 1)
      DO J = 2, M
        J1 = J - 1
        DO I = 1, J1
          A(I, J) = A(J, I)
        END DO
        ALPHA(J) = A(J, J)
      END DO
      M2 = M - 2
      DO I = 1, M2
        PP = 0.0
        I1 = I + 1
        DO J = I1, M
          PP = PP + A(I, J)**2
        END DO
        PP1 = SQRT(PP)
        IF (A(I, I + 1) .GE. 0.0) THEN
          BETA(I + 1) = -PP1
        ELSE
          BETA(I + 1) = PP1
        END IF
        IF (PP .GT. 0.0) THEN
          H = PP - BETA(I + 1) * A(I, I + 1)
          A(I, I + 1) = A(I, I + 1) - BETA(I + 1)
          DO KI = I1, M
            QJ = 0.0
            DO KJ = I1, KI
              QJ = QJ + A(KJ, KI) * A(I, KJ)
            END DO
            IF(KI .LT. M) THEN
              I2 = KI + 1
              DO KJ = I2, M
                QJ = QJ + A(KI, KJ) * A(I, KJ)
              END DO
            END IF
            Q(KI) = QJ / H
          END DO
          BIGK = 0.0
          DO KJ = I1, M
            BIGK = BIGK + A(I, KJ) * Q(KJ)
          END DO
          BIGK = BIGK / (2.0 * H)
          DO KJ = I1, M
            Q(KJ) = Q(KJ) - BIGK * A(I, KJ)
          END DO
          DO KI = I1, M
            DO KJ = KI, M
              A(KI, KJ) = A(KI, KJ) - Q(KI) * A(I, KJ)
     1                  - Q(KJ) * A(I, KI)
            END DO
          END DO
        END IF
      END DO
      DO I = 2, M
        H = ALPHA(I)
        ALPHA(I) = A(I, I)
        A(I, I)  = H
      END DO
      BETA(M) = A(M - 1, M)
      RETURN
      END SUBROUTINE GEN030
      SUBROUTINE GEN031 (A, B, VALUE, VEC, M, IV, W)
      REAL A(M), B(M), VALUE(M), VEC(1), W(1)
      DATA EPS/1E-5/, A34/0.0/
      CALL GEN032 (A, B, W(M + 1), M, W)
      DO I = 1, M
        VALUE(I) = A(I)
        W(I) = B(I)
        K = (I - 1) * IV + 1
        L = K + M - 1
        DO J = K, L
          VEC(J) = 0.0
        END DO
        VEC(K + I - 1) = 1.0
      END DO
      ITER = 0
      IF (M .NE. 1) THEN
        N2 = M
   10   DO II = 2, N2
          N1 = 2 + N2 - II
          IF (ABS(W(N1)) .LE. (ABS(VALUE(N1 - 1))
     1              + ABS(VALUE(N1))) * EPS) GO TO 20
        END DO
        N1 = 1
   20   IF (N2 .EQ. N1) THEN
          N2 = N2 - 1
          IF (N2 .LE. 1) THEN
            GO TO 30
          ELSE
            GO TO 10
          END IF
        END IF
        ROOT = W(M + N2)
        ITER = ITER + 1
        N2M1 = N2 - 1
        A22  = VALUE(N1)
        A12  = A22 - ROOT
        A23  = W(N1 + 1)
        A13  = A23
        DO I = N1, N2M1
          A33 = VALUE(I + 1)
          IF (I .NE. N2M1) A34 = W(I + 2)
          S = SIGN (SQRT (A12 * A12 + A13 * A13), A12)
          SI = A13 / S
          CO = A12 / S
          JK = I * IV + 1
          J1 = JK - IV
          J2 = J1 + MIN0(M, I + ITER) - 1
          DO JI = J1, J2
            V1 = VEC(JI)
            V2 = VEC(JK)
            VEC(JI) = V1 * CO + V2 * SI
            VEC(JK) = V2 * CO - V1 * SI
            JK = JK + 1
          END DO
          IF (I .NE. N1) W(I) = S
          A11 = CO * A22 + SI * A23
          A12 = CO * A23 + SI * A33
          A13 = SI * A34
          A21 = CO * A23 - SI * A22
          A22 = CO * A33 - SI * A23
          A23 = CO * A34
          VALUE(I) = A11 * CO + A12 * SI
          A12 = - A11 * SI + A12 * CO
          W(I + 1) = A12
          A22 = A22 * CO - A21 * SI
        END DO
        VALUE(N2) = A22
        GO TO 10
   30   DO J = 1, M
          K = (J - 1) * IV
          XX = VEC(K + 1)**2
          XAX = XX * A(1)
          DO I = 2, M
            XX = XX + VEC(K + I)**2
            XAX = XAX + VEC(K + I) * (2.0 * B(I) * VEC(K + I - 1)
     1          + A(I) * VEC(K + I))
          END DO
          VALUE(J) = XAX / XX
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN031
      SUBROUTINE GEN032 (A, B, VALUE, M, OFF)
      REAL A(M), B(M), VALUE(M), OFF(M)
      DATA A34 /0.0/, EPS /0.6E-7/
      VALUE(1) = A(1)
      IF (M .EQ. 1) RETURN
      DO I = 2, M
        VALUE(I) = A(I)
        OFF(I)   = B(I)
      END DO
      N2 = M
   10 IF (N2 .GT. 1) THEN
        DO II = 2, N2
          N1 = 2 + N2 - II
          IF (ABS(OFF(N1)) .LE. (ABS(VALUE(N1 - 1))
     1       + ABS(VALUE(N1))) * EPS) GO TO 20
        END DO
        N1 = 1
   20   IF (N2 .EQ. N1) THEN
          N2 = N2 - 1
          GO TO 10
        END IF
        BB  = (VALUE(N2) - VALUE(N2 - 1)) * 0.5
        CC  = OFF(N2) * OFF(N2)
        SBB = 1.0
        IF (BB .LT. 0.0) SBB = -1.0
        ROOT = VALUE(N2) + CC / (BB + SBB * SQRT(BB * BB + CC))
        N2M1 = N2 - 1
        A22  = VALUE(N1)
        A12  = A22 - ROOT
        A23  = OFF(N1 + 1)
        A13  = A23
        DO I = N1, N2M1
          A33 = VALUE(I + 1)
          IF (I .NE. N2M1) A34 = OFF(I + 2)
          S = SQRT(A12 * A12 + A13 * A13)
          SI = A13 / S
          CO = A12 / S
          IF (I .NE. N1) OFF(I) = S
          A11 = CO * A22 + SI * A23
          A12 = CO * A23 + SI * A33
          A13 = SI * A34
          A21 = CO * A23 - SI * A22
          A22 = CO * A33 - SI * A23
          A23 = CO * A34
          VALUE(I) = A11 * CO + A12 * SI
          A12 = - A11 * SI + A12 * CO
          OFF(I + 1) = A12
          A22 = A22 * CO - A21 * SI
        END DO
        VALUE(N2) = A22
        GO TO 10
      END IF
      RETURN
      END SUBROUTINE GEN032
      SUBROUTINE GEN033 (P, Y, MP0, NP, NDIM, FTOL, FUNK, ITER)
      PARAMETER (NMAX = 20, ALPHA = 1.0, BETA = 0.5, GAMMA = 2.0,
     1           ITMAX = 500)
      DIMENSION P(MP0, NP), Y(MP0), PR(NMAX), PRR(NMAX), PBAR(NMAX)
      EXTERNAL FUNK
      MPTS = NDIM + 1
      ITER = 0
      DO WHILE (.TRUE.)
        ILO = 1
        IF (Y(1) .GT. Y(2)) THEN
          IHI  = 1
          INHI = 2
        ELSE
          IHI  = 2
          INHI = 1
        END IF
        DO I = 1, MPTS
          IF (Y(I) .LT. Y(ILO)) ILO = I
          IF (Y(I) .GT. Y(IHI)) THEN
            INHI = IHI
            IHI  = I
          ELSE IF (Y(I) .GT. Y(INHI)) THEN
            IF (I .NE. IHI) INHI = I
          END IF
        END DO
        RTOL = 2.0 * ABS(Y(IHI) - Y(ILO)) / (ABS(Y(IHI)) + ABS(Y(ILO)))
        IF (RTOL .LT. FTOL) RETURN
        IF (ITER .EQ. ITMAX) WRITE(6, *, IOSTAT = IOST)
     1      'GEN033 exceeding maximum iterations.'
        ITER = ITER + 1
        CALL GEN074 (PBAR, 1, NDIM, 0.0)
        DO I = 1, MPTS
          IF (I .NE. IHI) THEN
            DO J = 1, NDIM
              PBAR(J) = PBAR(J) + P(I, J)
            END DO
          END IF
        END DO
        DO J = 1, NDIM
          PBAR(J) = PBAR(J) / NDIM
          PR(J)   = (1.0 + ALPHA) * PBAR(J) - ALPHA * P(IHI, J)
        END DO
        YPR = FUNK(PR)
        IF (YPR .LE. Y(ILO)) THEN
          DO J = 1, NDIM
            PRR(J) = GAMMA * PR(J) + (1.0 - GAMMA) * PBAR(J)
          END DO
          YPRR = FUNK(PRR)
          IF (YPRR .LT. Y(ILO)) THEN
            DO J = 1, NDIM
              P(IHI, J) = PRR(J)
            END DO
            Y(IHI) = YPRR
          ELSE
            DO J = 1, NDIM
              P(IHI, J) = PR(J)
            END DO
            Y(IHI) = YPR
          END IF
        ELSE IF (YPR .GE. Y(INHI)) THEN
          IF (YPR .LT. Y(IHI)) THEN
            DO J = 1, NDIM
              P(IHI, J) = PR(J)
            END DO
            Y(IHI) = YPR
          END IF
          DO J = 1, NDIM
            PRR(J) = BETA * P(IHI, J) + (1.0 - BETA) * PBAR(J)
          END DO
          YPRR = FUNK(PRR)
          IF (YPRR .LT. Y(IHI)) THEN
            DO J = 1, NDIM
              P(IHI, J) = PRR(J)
            END DO
            Y(IHI) = YPRR
          ELSE
            DO I = 1, MPTS
              IF(I .NE. ILO) THEN
                DO J = 1, NDIM
                  PR(J) = 0.5 * (P(I, J) + P(ILO, J))
                  P(I, J) = PR(J)
                END DO
                Y(I) = FUNK(PR)
              END IF
            END DO
          END IF
        ELSE
          DO J = 1, NDIM
            P(IHI, J) = PR(J)
          END DO
          Y(IHI) = YPR
        END IF
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
      END SUBROUTINE GEN033
      SUBROUTINE GEN034 (RA, N0, N)
      DIMENSION RA(*)
      NEL = N - N0 + 1
      IF (NEL .GT. 1) THEN
        NN = INT((ALOG(FLOAT(NEL)) / ALOG(2.0)) + 1.0E-5)
        ND = 2**NN - 1
   10   IF (ND .GT. 0) THEN
          I = N0
   20     J = I
          Y = RA(I + ND)
   30     IF (Y .GT. RA(J)) THEN
            RA(J + ND) = RA(J)
            J = J - ND
            IF (J .GE. N0) GO TO 30
          END IF
          RA(J + ND) = Y
          I = I + 1
          IF (I + ND .LE. N) GO TO 20
          ND = (ND - 1) / 2
          GO TO 10
        END IF
      END IF
      CONTINUE
      RETURN
      END SUBROUTINE GEN034
      SUBROUTINE GEN035 (RA, N0, N)
      DIMENSION RA(*)
      NEL = N - N0 + 1
      IF (NEL .GT. 1) THEN
        NN = INT((ALOG(FLOAT(NEL)) / ALOG(2.0)) + 1.0E-5)
        ND = 2**NN - 1
   10   IF (ND .GT. 0) THEN
          I = N0
   20     J = I
          Y = RA(I + ND)
   30     IF (Y .LT. RA(J)) THEN
            RA(J + ND) = RA(J)
            J = J - ND
            IF (J .GE. N0) GO TO 30
          END IF
          RA(J + ND) = Y
          I = I + 1
          IF (I + ND .LE. N) GO TO 20
          ND = (ND - 1) / 2
          GO TO 10
        END IF
      END IF
      CONTINUE
      RETURN
      END SUBROUTINE GEN035
      FUNCTION GEN036 (IDUM)
      PARAMETER (M = 714025, IA = 1366, IC = 150889)
      COMMON /DGEN36/ IR(97), RM, IY
      IF (IDUM .LT. 0) THEN
        RM = 1.0 / M
        IDUM = MOD(IC - IDUM, M)
        DO J = 1, 97
          IDUM  = MOD(IA * IDUM + IC, M)
          IR(J) = IDUM
        END DO
        IDUM = MOD(IA * IDUM + IC, M)
        IY   = IDUM
      END IF
      J = 1 + (97 * IY) / M
      IF (J .GT. 97 .OR. J .LT. 1) STOP 'IN RANDOM'
      IY       = IR(J)
      GEN036   = IY * RM
      IDUM     = MOD(IA * IDUM + IC, M)
      IR(J)    = IDUM
      RETURN
      END FUNCTION GEN036
      SUBROUTINE GEN037 (IA, JL, JU)
      DIMENSION IA(2, *)
      JV = JU - JL + 1
      IF (JV .GT. 1) THEN
        ND = 2**(INT((ALOG(FLOAT(JV)) / ALOG(2.0)) + 1.0E-5)) - 1
        DO
          IF (ND .LE. 0) EXIT
          I  = JL
          DO
            J  = I
            NX = IA(1, I + ND)
            NY = IA(2, I + ND)
   10       IF (NX .LT. IA(1, J)) THEN
              IA(1, J + ND) = IA(1, J)
              IA(2, J + ND) = IA(2, J)
              J             = J - ND
              IF (J .GE. JL) GO TO 10
            END IF
            IA(1, J + ND) = NX
            IA(2, J + ND) = NY
            I             = I + 1
            IF (I + ND .GT. JU) EXIT
          END DO
          ND = (ND - 1) / 2
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN037
      SUBROUTINE GEN038 (LINE, LO, LU)
      CHARACTER LINE*(*)
      IF (LO .GT. 0 .AND. LU .GE. LO) THEN
        DO I = LO, LU
          LINE(I:I) = ' '
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN038
      SUBROUTINE GEN039 (MODE, LINE, LB, LE, NB, NE)
      CHARACTER LINE*(*)
      NB = LB
      NE = LE
      IF (MODE .GE. 0) THEN
        N = LE - LB + 1
        K = LE + 1
        DO I = 1, N
          K = K - 1
          IF (K .GT. 0) THEN
            IF (LINE(K:K) .NE. ' ') EXIT
          ELSE
            EXIT
          END IF
        END DO
        NE = K
      END IF
      IF (MODE .LE. 0) THEN
        N = NE - LB + 1
        K = LB - 1
        DO I = 1, N
          K = K + 1
          IF (LINE(K:K) .NE. ' ') GO TO 10
        END DO
        K  = K + 1
   10   NB = K
      END IF
      RETURN
      END SUBROUTINE GEN039
      SUBROUTINE GEN040 (NR, NQ, IP)
      CHARACTER NQ*(*)
      NQ  = '-       '
      NR1 = IABS(NR)
      ISN = 6
      IF (NR .LT. 0) ISN = 5
      N = 1
      DO I = 1, ISN
        N = N * 10
        IF (N .GT. NR1) GO TO 10
      END DO
      I = ISN
   10 IP = I - ISN + 6
      DO J = 1, I
        ISCR = MOD(NR1, 10)
        NQ(IP + 1 - J:IP + 1 - J) = CHAR(ICHAR('0') + ISCR)
        NR1 = NR1 / 10
      END DO
      RETURN
      END SUBROUTINE GEN040
      SUBROUTINE GEN041 (X, SX, ISX, NDCD, NDEC, IRND)
      NDEC = IABS(NDCD)
      N    = 0
      IF (SX .GT. 0.0) THEN
        IF (IRND .NE. 0) THEN
          SXX = SX
          XM  = 1.0
   10     IF (N .GE. IABS(NDCD)) GO TO 20
          ISX = INT(SXX * XM + 0.051)
          IF (ISX .GE. IRND) GO TO 20
          XM = XM * 10
          N  = N + 1
          GO TO 10
   20     IXX  = NINT(X * XM + SIGN(0.051, X))
          ISX  = MAX(1, NINT(SXX * XM))
          X    = IXX / XM
          SX   = ISX / XM
          NDEC = N
        ELSE
          ISX = NINT(SX * 10**NDEC)
        END IF
      ELSE
        ISX = 0
        IF (NDCD .LT. 0) THEN
   30     IF (ABS(FLOAT(INT(X * 10**N + 0.01)) - X * 10**N)
     1        .GT. 0.0000001 .AND. N .LT. IABS(NDCD)) THEN
            N = N + 1
            GO TO 30
          END IF
          NDEC = N
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN041
      SUBROUTINE GEN042 (NWRD, N, A, NUM)
      DIMENSION A(2)
      CHARACTER NWRD*(*), ICH*1
      A(1) = 0.0
      A(2) = 0.0
      S    = 1.0
      IP   = 0
      NP   = 0
      NUM  = 0
      K    = 1
      FIN  = 0
      IFRC = 0
      DO 20 I = 2, N
        ICH = NWRD(I:I)
        CALL GEN105 (1, ICH, L)
        IF (L .LT. 0) CALL GEN105 (2, ICH, L)
        IF (L .GT. 0) THEN
          NUM = 0
          GO TO 30
        END IF
        IF (ICH .EQ. '''') THEN
          FIN = 1
          GO TO 10
        END IF
        IF (ICH .EQ. '+') THEN
          S   = 1.0
          NUM = 1
        ELSE IF (ICH .EQ. '-') THEN
          S   = -1.0
          NUM = 1
        ELSE IF (ICH .EQ. '_') THEN
          IF (NUM .EQ. 1) IP = 1
        ELSE IF (ICH .EQ. '.') THEN
          IP  = 1
          IF (NUM .EQ. 0) NUM = -1
        ELSE IF (I .EQ. 2 .AND. ICH .EQ. '?') THEN
          NUM = -1
          GO TO 40
        ELSE IF (ICH .EQ. '(') THEN
          GO TO 10
        ELSE IF (ICH .EQ. '/') THEN
          IFRC = 1
          GO TO 10
        ELSE IF (ICH .EQ. ')') THEN
          FIN = 1
          GO TO 10
        ELSE
          CALL GEN105 (3, ICH, M)
          IF (M .GE. 0) THEN
            NUM  = 1
            NP   = NP + IP
            IF (A(K) .GE. 1.0E37) THEN
              A(1) = 0.0
              A(2) = 0.0
              NUM  = -2
              GO TO 40
            END IF
            A(K) = 10.0 * A(K) + M - 1
          END IF
        END IF
        GO TO 20
   10   A(K) = S * A(K) / 10.0**NP
        IF (FIN .EQ. 1) GO TO 30
        IP = 0
        S  = 1.0
        K  = 2
   20 CONTINUE
   30 IF (NUM * IFRC .NE. 0) THEN
        IF (A(1) .NE. 0.0 .AND. A(2) .NE. 0) THEN
          A(1) = A(1) / A(2)
          A(2) = 0.0
        ELSE
          NUM = 0
        END IF
      END IF
   40 RETURN
      END SUBROUTINE GEN042
      SUBROUTINE GEN043 (MODE, A, ANG)
      DIMENSION A(3, 3)
      CA = COS(ANG)
      SA = SIN(ANG)
      CALL GEN074 (A, 1, 9, 0.0)
      IF (MODE .EQ. 3) THEN
        A(1, 1) =  CA
        A(1, 2) =  SA
        A(2, 1) = -SA
        A(2, 2) =  CA
        A(3, 3) = 1.0
      ELSE IF (MODE .EQ. 2) THEN
        A(1, 1) = CA
        A(1, 3) = -SA
        A(2, 2) = 1.0
        A(3, 1) = SA
        A(3, 3) = CA
      ELSE IF (MODE .EQ. 1) THEN
        A(1, 1) = 1.0
        A(2, 2) = CA
        A(2, 3) = SA
        A(3, 2) = -SA
        A(3, 3) = CA
      END IF
      RETURN
      END SUBROUTINE GEN043
      SUBROUTINE GEN044 (P, R, MODE)
      DIMENSION P(6), R(3, 3)
      IF (MODE .GT. 0) THEN
        RAD     = ATAN2 (1.0, 1.0) / 45.0
        CP4RAD  = COS (P(4) * RAD)
        CP5RAD  = COS (P(5) * RAD)
        CP6RAD  = COS (P(6) * RAD)
      ELSE
        CP4RAD = P(4)
        CP5RAD = P(5)
        CP6RAD = P(6)
      END IF
      SP4RAD  = SQRT(1.0 - CP4RAD**2)
      SP6RAD  = SQRT(1.0 - CP6RAD**2)
      UNITVOL = SQRT(1.0 - CP4RAD**2 - CP5RAD**2 - CP6RAD**2
     1        + 2.0  * CP4RAD * CP5RAD * CP6RAD)
      IF (IABS(MODE) .EQ. 1) THEN
        R(1, 1) = P(1)
        R(1, 2) = P(2) * CP6RAD
        R(1, 3) = P(3) * CP5RAD
        R(2, 1) = 0.0
        R(2, 2) = P(2) * SP6RAD
        R(2, 3) = P(3) * (CP4RAD - CP5RAD * CP6RAD) / SP6RAD
        R(3, 1) = 0.0
        R(3, 2) = 0.0
        R(3, 3) = P(3) * UNITVOL / SP6RAD
      ELSE IF (IABS(MODE) .EQ. 2) THEN
        R(1, 1) = P(1) * UNITVOL / SP4RAD
        R(1, 2) = 0.0
        R(1, 3) = 0.0
        R(2, 1) = P(1) * (CP6RAD - CP4RAD * CP5RAD) / SP4RAD
        R(2, 2) = P(2) * SP4RAD
        R(2, 3) = 0.0
        R(3, 1) = P(1) * CP5RAD
        R(3, 2) = P(2) * CP4RAD
        R(3, 3) = P(3)
      END IF
      RETURN
      END SUBROUTINE GEN044
      FUNCTION GEN045 (C)
      REAL C(6)
      DTR = ATAN(1.0) / 45.0
      CA = COS(C(4) * DTR)
      CB = COS(C(5) * DTR)
      CG = COS(C(6) * DTR)
      VOL = (1.0 - CA**2 - CB**2 - CG**2 + 2 * CA * CB * CG)
      IF (VOL .LT. 0.0) STOP 'CELL VOLUME COMPLEX!!'
      GEN045 = C(1) * C(2) * C(3) * SQRT(VOL)
      RETURN
      END FUNCTION GEN045
      SUBROUTINE GEN046 (HKLP, X, Y, Z)
      Z = NINT(HKLP / 40000.0)
      X = (NINT(HKLP) - 40000.0 * Z) / 200.0
      Y = NINT(X)
      X = AINT(201.0 * (X - Y))
      RETURN
      END SUBROUTINE GEN046
      SUBROUTINE GEN047 (LINE, N, M)
      CHARACTER LINE*(*)
C * ELIMINATE BLANKS
      IND = N
      DO I = N, M
        IF (LINE(I:I) .NE. ' ') THEN
          LINE(IND:IND) = LINE(I:I)
          IND = IND + 1
        END IF
      END DO
      CALL GEN038 (LINE, IND, M)
      RETURN
      END SUBROUTINE GEN047
      SUBROUTINE GEN048 (IKEY, IFLI, IBIT, IVAL)
      COMMON /NBIT/ IBT(32)
      JKEY = IABS(IKEY)
      IF (JKEY .EQ. 1) THEN
        KEY = 2
      ELSE IF (JKEY .EQ. 10) THEN
        KEY = 1024
      ELSE IF (JKEY .NE. 0) THEN
        KEY = 2**JKEY
      ELSE
        DO I = 1, 31
          IBT(I) = 2**(I - 1)
        END DO
        GO TO 10
      END IF
      JBIT = IBT(IBIT)
      INH  = MOD(IFLI / JBIT, KEY)
      IF (IKEY .LT. 0) THEN
        IVAL  = INH
      ELSE
        IFLI = IFLI + (IVAL - INH) * JBIT
      END IF
   10 RETURN
      END SUBROUTINE GEN048
      FUNCTION GEN049 (LATC, JH, JK, JL)
      CHARACTER LATC*1
      S = 1.0
      IF (LATC .NE. 'P') THEN
        IF (LATC .EQ. 'A') THEN
          IF (MOD(JK + JL, 2) .NE. 0) S = - 1.0
        ELSE IF (LATC .EQ. 'B') THEN
          IF (MOD(JH + JL, 2) .NE. 0) S = - 1.0
        ELSE IF (LATC .EQ. 'C') THEN
          IF (MOD(JH + JK, 2) .NE. 0) S = - 1.0
        ELSE IF (LATC .EQ. 'F') THEN
          IF (MOD(JH + JK, 2) .NE. 0 .OR. MOD(JH + JL, 2) .NE. 0)
     1        S = - 1.0
        ELSE IF (LATC .EQ. 'I') THEN
          IF (MOD(JH + JK + JL, 2) .NE. 0) S = - 1.0
        ELSE IF (LATC .EQ. 'R') THEN
          IF (MOD(-JH + JK + JL, 3) .NE. 0) S = -1.0
        END IF
      END IF
      GEN049 = S
      RETURN
      END FUNCTION GEN049
      FUNCTION GEN050 (TM, IH, IK, IL, JH, JK, JL)
      DIMENSION TM(3, 3)
      XH = TM(1, 1) * IH + TM(1, 2) * IK + TM(1, 3) * IL
      XK = TM(2, 1) * IH + TM(2, 2) * IK + TM(2, 3) * IL
      XL = TM(3, 1) * IH + TM(3, 2) * IK + TM(3, 3) * IL
      JH = NINT(XH)
      JK = NINT(XK)
      JL = NINT(XL)
      GEN050 = -1.0
      IF (ABS(XH - JH) .LT. 0.01) THEN
        IF (ABS(XK - JK) .LT. 0.01) THEN
          IF (ABS(XL - JL) .LT. 0.01) THEN
            GEN050 = 1.0
          END IF
        END IF
      END IF
      RETURN
      END FUNCTION GEN050
      SUBROUTINE GEN051 (MODE, RV, X, L)
      DIMENSION RM(3, 3), TM(3, 3), RV(3, 3)
      T1         = COS(X)
      T2         = SIN(X)
      I3         = MOD(L + 2, 3) + 1
      I1         = MOD(I3, 3) + 1
      I2         = MOD(I1, 3) + 1
      RM(I1, I1) = T1
      RM(I1, I2) = T2
      RM(I1, I3) = 0.0
      RM(I2, I1) = -T2
      RM(I2, I2) = T1
      RM(I2, I3) = 0.0
      RM(I3, I1) = 0.0
      RM(I3, I2) = 0.0
      RM(I3, I3) = 1.0
      IF (MODE .EQ. 0) THEN
        CALL GEN004 (RV, RM, TM)
      ELSE IF (MODE .EQ. 1) THEN
        CALL GEN004 (RM, RV, TM)
      END IF
      CALL GEN052 (TM, RV)
      RETURN
      END SUBROUTINE GEN051
      SUBROUTINE GEN052 (A, B)
      DIMENSION A(3, 3), B(3, 3)
      DO I = 1, 3
        DO J = 1, 3
          B(I, J) = A(I, J)
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN052
      SUBROUTINE GEN053 (N, DATA, INDEX)
      DIMENSION DATA(N), INDEX(N)
      DO I = 1, N
        INDEX(I) = I
      END DO
      IF (N .GT. 1) THEN
        I = N / 2 + 1
        J = N
   10   IF (I .GT. 1) THEN
          I     = I - 1
          INEXT = INDEX(I)
          T     = DATA(INEXT)
        ELSE
          INEXT    = INDEX(J)
          T        = DATA(INEXT)
          INDEX(J) = INDEX(1)
          J        = J - 1
          IF (J .EQ. 1) THEN
            INDEX(1) = INEXT
            GO TO 30
          END IF
        END IF
        K = I
        L = 2 * I
   20   IF (L .LE. J) THEN
          IF (L .LT. J) THEN
            IF (DATA(INDEX(L)) .LT. DATA(INDEX(L + 1))) L = L + 1
          END IF
          IF (T .LT. DATA(INDEX(L))) THEN
            INDEX(K) = INDEX(L)
            K = L
            L = 2 * L
          ELSE
            L = J + 1
          END IF
          GO TO 20
        END IF
        INDEX(K) = INEXT
        GO TO 10
      END IF
   30 RETURN
      END SUBROUTINE GEN053
      SUBROUTINE GEN054 (N, M, A, U, V)
      PARAMETER (NMAX = 999)
      DIMENSION A(M, M), U(M), V(M, M), B(NMAX), Z(NMAX)
      DOUBLE PRECISION A, U, V, B, Z, T, THRESH, E, AII, AJJ,
     1       THETA, C, S, TAU, P, Q
      DO I = 1, N
        DO J = 1, N
          V(I, J) = 0
        END DO
        V(I, I) = 1
      END DO
      DO I = 1, N
        T    = A(I, I)
        U(I) = T
        B(I) = T
        Z(I) = 0
      END DO
      DO NCYCLE = 1, 50
        T = 0
        DO I = 1, N - 1
          DO J = I + 1, N
            T = T + ABS(A(I, J))
          END DO
        END DO
        IF (T .EQ. 0) RETURN
        IF (NCYCLE .LT. 4) THEN
          THRESH = T / (5 * N**2)
        ELSE
          THRESH = 0
        END IF
        DO I = 1, N - 1
          DO J = I + 1, N
            T   = ABS(A(I, J))
            E   = 100 * T
            AII = ABS(U(I))
            AJJ = ABS(U(J))
            IF (NCYCLE .GT. 4 .AND. AII + E .EQ. AII .AND.
     1                              AJJ + E .EQ. AJJ) THEN
              A(I, J) = 0
            ELSE IF (T .GT. THRESH) THEN
              T = ABS(AJJ - AII)
              IF (T + E .EQ. T) THEN
                T = A(I, J) / (AJJ - AII)
              ELSE
                THETA = (AJJ - AII) / (2 * A(I, J))
                T     = 1 / (ABS(THETA) + SQRT(1 + THETA**2))
                IF (THETA .LT. 0) T = -T
              END IF
              C   = 1 / SQRT(1 + T**2)
              S   = T * C
              TAU = S / (1 + C)
              E       = T * A(I, J)
              Z(I)    = Z(I) - E
              Z(J)    = Z(J) + E
              U(I)    = U(I) - E
              U(J)    = U(J) + E
              A(I, J) = 0
              DO K = 1, I - 1
                P       = A(K, I)
                Q       = A(K, J)
                A(K, I) = P - S * (Q + P * TAU)
                A(K, J) = Q + S * (P - Q * TAU)
              END DO
              DO K = I + 1, J - 1
                P       = A(I, K)
                Q       = A(K, J)
                A(I, K) = P - S * (Q + P * TAU)
                A(K, J) = Q + S * (P - Q * TAU)
              END DO
              DO K = J + 1, N
                P       = A(I, K)
                Q       = A(J, K)
                A(I, K) = P - S * (Q + P * TAU)
                A(J, K) = Q + S * (P - Q * TAU)
              END DO
              DO K = 1, N
                P       = V(K, I)
                Q       = V(K, J)
                V(K, I) = P - S * (Q + P * TAU)
                V(K, J) = Q + S * (P - Q * TAU)
              END DO
            END IF
          END DO
        END DO
        DO I = 1, N
          B(I) = B(I) + Z(I)
          U(I) = B(I)
          Z(I) = 0
        END DO
      END DO
      STOP '50 CYCLES OF JACOBI ROTATIONS SHOULD NEVER BE NECESSARY.'
      END SUBROUTINE GEN054
      SUBROUTINE GEN055 (YLM, XYZ, L0MAX, L1MAX)
      DIMENSION XYZ(3), YLM(80), FCLM(0:44), FNLM(0:44)
      DATA FCLM /
     1 1,
     2 1, 1,
     3 0.5, 3, 3,
     4 0.5, 1.5, 15, 15,
     5 0.125, 2.5, 7.5, 105, 105,
     6 0.125, 1.875, 52.5, 52.5, 945, 945,
     7 0.0625, 2.625, 13.125, 157.5, 472.5, 10395, 10395,
     8 0.0625, 0.4375, 7.875, 39.375, 1732.5, 5197.5, 135135, 135135,
     9 0.0078125, 0.5625, 19.6875, 433.125, 1299.375, 67567.5, 67567.5,
     * 2027025, 2027025/
      DATA FNLM /
     1 0.0795774,
     2 0.3183099, 0.3183099,
     3 0.2067483, 0.7500000, 0.3750000,
     4 0.2448538, 0.3203331, 1.0000000, 0.4244132,
     5 0.0694175, 0.4740025, 0.3305913, 1.2500000, 0.4687500,
     6 0.0767395, 0.3229812, 1.6875000, 0.3451455, 1.5000000, 0.5092958,
     7 0.0417084, 0.4172129, 0.3261107, 0.6513219, 0.3610405, 1.7500000,
     8 0.5468750,
     9 0.0447979, 0.0648780, 0.1573192, 0.1109240, 0.7404370, 0.3772319,
     * 2.0000000, 0.5820523,
     1 0.0059609, 0.0784858, 0.3253786, 0.8780415, 0.3411683, 2.4892756,
     2 0.3933012, 2.2500000, 0.6152344/
      CALL GEN074 (YLM, 1, 80, 0.0)
      IF (L0MAX .EQ. 0 .AND. L1MAX .EQ. 0) RETURN
      X  = XYZ(1)
      Y  = XYZ(2)
      Z  = XYZ(3)
      XK = X ** 2
      YK = Y ** 2
      ZK = Z ** 2
      XQ = X ** 3
      YQ = Y ** 3
      ZQ = Z ** 3
      XV = X ** 4
      YV = Y ** 4
      ZV = Z ** 4
      XP = X ** 5
      YP = Y ** 5
      ZP = Z ** 5
      XS = X ** 6
      YS = Y ** 6
      ZS = Z ** 6
      IF (L1MAX .GE. 1) THEN
        YLM(1) = Z
        YLM(2) = X
        YLM(3) = Y
      END IF
      IF (L0MAX .GE. 2) THEN
        YLM(4) = 3 * ZK - 1
        YLM(5) = Z * X
        YLM(6) = Z * Y
        YLM(7) = XK - YK
        YLM(8) = 2 * X * Y
      END IF
      IF (L1MAX .GE. 3) THEN
        YLM(9)  = 5 * ZQ - 3 * Z
        Q       = 5 * ZK - 1
        YLM(10) = Q * X
        YLM(11) = Q * Y
        YLM(12) = Z * (XK - YK)
        YLM(13) = 2 * X * Y * Z
        YLM(14) = XQ - 3 * X * YK
        YLM(15) = 3 * XK * Y - YQ
      END IF
      IF (L0MAX .GE. 4) THEN
        YLM(16) = 35 * ZV - 30 * ZK + 3
        Q       = 7 * ZQ - 3 * Z
        YLM(17) = Q * X
        YLM(18) = Q * Y
        YLM(19) = (7 * ZK - 1) * (XK - YK)
        YLM(20) = 2 * X * Y * (7 * ZK - 1)
        YLM(21) = Z * (XQ - 3 * X * YK)
        YLM(22) = Z * (3 * XK * Y - YQ)
        YLM(23) = XV - 6 * XK * YK + YV
        YLM(24) = 4 * XQ * Y - 4 * X * YQ
      END IF
      IF (L1MAX .GE. 5) THEN
        YLM(25) = 63 * ZP - 70 * ZQ + 15 * Z
        Q       = 21 * ZV - 14 * ZK + 1
        YLM(26) = Q * X
        YLM(27) = Q * Y
        YLM(28) = (3 * ZQ - Z) * (XK - YK)
        YLM(29) = 2 * X * Y * (3 * ZQ - Z)
        YLM(30) = (9 * ZK - 1) * (XQ - 3 * X * YK)
        YLM(31) = (9 * ZK - 1) * (3 * XK * Y - YQ)
        YLM(32) = Z * (XV - 6 * XK * YK + YV)
        YLM(33) = Z * (4 * XQ * Y - 4 * X * YQ)
        YLM(34) = XP - 10 * XQ * YK + 5 * X * YV
        YLM(35) = 5 * XV * Y - 10 * XK * YQ + YP
      END IF
      IF (L0MAX .GE. 6) THEN
        YLM(36) = 231 * ZS - 315 * ZV + 105 * ZK - 5
        Q       = 33 * ZP - 30 * ZQ + 5 * Z
        YLM(37) = Q * X
        YLM(38) = Q * Y
        YLM(39) = (33 * ZV - 18 * ZK + 1) * (XK - YK)
        YLM(40) = 2 * X * Y * (33 * ZV - 18 * ZK + 1)
        Q       = 11 * ZQ - 3 * Z
        YLM(41) = Q * (XQ - 3 * X * YK)
        YLM(42) = Q * (3 * XK * Y - YQ)
        YLM(43) = (11 * ZK - 1) * (XV - 6 * XK * YK + YV)
        YLM(44) = (11 * ZK - 1) * (4 * XQ * Y - 4 * X * YQ)
        YLM(45) = Z * (XP - 10 * XQ * YK + 5 * X * YV)
        YLM(46) = Z * (5 * XV * Y - 10 * XK * YQ + YP)
        YLM(47) = XS - 15 * XV * YK + 15 * XK * YV - YS
        YLM(48) = 6 * XP * Y - 20 * XQ * YQ + 6 * X * YP
      END IF
      IF (L1MAX .GE. 7) THEN
        YLM(49) = 429 * Z**7 - 639 * ZP + 315 * ZQ - 35 * Z
        Q       = 429 * ZS - 495 * ZV + 135 * ZK - 5
        YLM(50) = Q * X
        YLM(51) = Q * Y
        YLM(52) = (143 * ZP - 110 * ZQ + 15 * Z) * (XK - YK)
        YLM(53) = 2 * X * Y * (143 * ZP - 110 * ZQ + 15 * Z)
        Q       = 143 * ZV - 66 * ZK + 3
        YLM(54) = Q * (XQ - 3 * X * YK)
        YLM(55) = Q * (3 * XK * Y - YQ)
        Q       = 13 * ZQ - 3 * Z
        YLM(56) = Q * (XV - 6 * XK * YK + YV)
        YLM(57) = Q * (4 * XQ * Y - 4 * X * YQ)
        YLM(58) = (13 * ZK - 1) * (XP - 10 * XQ * YK + 5 * X * YV)
        YLM(59) = (13 * ZK - 1) * (5 * XV * Y - 10 * XK * YQ + YP)
        YLM(60) = Z * (XS - 15 * XV * YK + 15 * XK * YV - YS)
        YLM(61) = Z * (6 * XP * Y - 20 * XQ * YQ + 6 * X * YP)
        YLM(62) = X**7 - 21 * XP * YK + 35 * XQ * YV - 7 * X * YS
        YLM(63) = 7 * XS * Y - 35 * XV * YQ + 21 * XK * YP - Y**7
      END IF
      IF (L0MAX .GE. 8) THEN
        YLM(64) = 6435 * Z**8 - 12012 * ZS + 6930 * ZV - 1260 * ZK
     1          + 35
        Q       = 715 * Z**7 - 1001 * ZP + 385 * ZQ - 35 * Z
        YLM(65) = Q * X
        YLM(66) = Q * Y
        Q       = 143 * ZS - 143 * ZV + 33 * ZK - 1
        YLM(67) = Q * (XK - YK)
        YLM(68) = Q * 2 * X * Y
        Q       = 39 * ZP - 26 * ZQ + 3 * Z
        YLM(69) = Q * (XQ - 3 * X * YK)
        YLM(70) = Q * (3 * XK * Y - YQ)
        Q       = 65 * ZV - 26 * ZK + 1
        YLM(71) = Q * (XV - 6 * XK * YK + YV)
        YLM(72) = Q * (4 * XQ * Y - 4 * X * YQ)
        Q       = 5 * ZQ - Z
        YLM(73) = Q * (XP - 10 * XQ * YK + 5 * X * YV)
        YLM(74) = Q * (5 * XV * Y - 10 * XK * YQ + YP)
        Q       = 15 * ZK - 1
        YLM(75) = Q * (XS - 15 * XV * YK + 15 * XK * YV - YS)
        YLM(76) = Q * (6 * XP * Y - 20 * XQ * YQ + 6 * X * YP)
        YLM(77) = Z * (X**7 - 21 * XP * YK + 35 * XQ * YV
     1          - 7 * X * YS)
        YLM(78) = Z * (7 * XS * Y - 35 * XV * YQ + 21 * XK * YP - Y**7)
        YLM(79) = X**8 - 28 * XS * YK + 70 * XV * YV
     1          - 28 * XK * YS + Y**8
        YLM(80) = 8 * X**7 * Y - 56 * XP * YQ + 56 * XQ * YP
     1          - 8 * X * Y**7
      END IF
      I = 0
      J = 0
      LMAX = MAX (L0MAX, L1MAX)
      DO L = 1, LMAX
        DO M = 0, L
          I = I + 1
          F = FCLM(I) * FNLM(I)
          DO IP = 0, MIN(M, 1)
            J = J + 1
            YLM(J) = F * YLM(J)
          END DO
        END DO
      END DO
      I = 0
      N = 0
      DO L = 1, LMAX
        DO M = -L, L
          I = I + 1
          IF ((MOD(L, 2) .EQ. 0 .AND. L .LE. L0MAX) .OR.
     1        (MOD(L, 2) .EQ. 1 .AND. L .LE. L1MAX)) THEN
            N = N + 1
            YLM(N) = YLM(I)
          END IF
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN055
      FUNCTION GEN056 (IH, IK, IL, GINV)
      DIMENSION H(3), GINV(3, 3)
      H(1) = IH
      H(2) = IK
      H(3) = IL
      GEN056 = 0.5 * SQRT(GEN006 (H, GINV, H))
      RETURN
      END FUNCTION GEN056
      SUBROUTINE GEN057 (A, X, D, N)
      DIMENSION A(N, N), X(N), D(N)
      K  = 0
      I  = 1
   10 J  = I
      RL = 0
   20 IF (ABS(A(J, I)) .GT. RL) THEN
        RL = ABS(A(J, I))
        K  = J
      END IF
      J = J + 1
      IF (J .LE. N) GO TO 20
      J = I
      IF (K .NE. I) THEN
   30   Y = A(I, J)
        A(I, J) = A(K, J)
        A(K, J) = Y
        J = J + 1
        IF (J .LE. N) GO TO 30
        Y = D(I)
        D(I) = D(K)
        D(K) = Y
      END IF
      J = I + 1
      IF (I .NE. N) THEN
   40   RM = A(J, I) / A(I, I)
        K  = I
   50   A(J, K) = A(J, K) - RM * A(I, K)
        K = K + 1
        IF (K .LE. N) GO TO 50
        D(J) = D(J) - RM * D(I)
        J = J + 1
        IF (J .LE. N) GO TO 40
        I = I + 1
        IF (I .LE. N) GO TO 10
      END IF
      I = N
   60 E = D(I)
      IF (I .NE. N) THEN
        J = I + 1
   70   E = - A(I, J) * X(J) + E
        J = J + 1
        IF (J .LE. N) GO TO 70
      END IF
      X(I) = E / A(I, I)
      I    = I - 1
      IF (I .NE. 0) GO TO 60
      RETURN
      END SUBROUTINE GEN057
      SUBROUTINE GEN058 (LABI, NR)
      CHARACTER LABI*4
      IF (LABI(2:2) .NE. ' ') THEN
        L0 = 1
        NO = 10 + NR
      ELSE
        L0 = 0
        NO = 500 + NR
      END IF
      IF (NO .LT. 100) THEN
        WRITE (LABI(2+L0:3+L0), 99999, IOSTAT = IOST) NO
      ELSE
        WRITE (LABI(2:4), 99998, IOSTAT = IOST) NO
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (I2)
99998 FORMAT (I3)
      END SUBROUTINE GEN058
      SUBROUTINE GEN059 (A, B, C)
      DIMENSION C(4, 4), A(4, 4), B(4, 4)
      DO I = 1, 4
        DO J = 1, 4
          C(I, J) = A(I, 1) * B(1, J) + A(I, 2) * B(2, J)
     1            + A(I, 3) * B(3, J) + A(I, 4) * B(4, J)
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN059
      SUBROUTINE GEN060 (A, B)
      DIMENSION B(4, 4), A(4, 4)
      DO I = 1, 4
        DO J = 1, 4
          B(I, J) = A(J, I)
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN060
      FUNCTION GEN061 (A, AI)
      DIMENSION AI(4, 4), A(4, 4), TMP(4, 4), INDEX(4)
      DO I = 1, 4
        DO J = 1, 4
          TMP(I, J) = A(I, J)
          AI(I, J) = 0.0
        END DO
        AI(I, I) = 1.0
      END DO
      CALL GEN062 (TMP, 4, INDEX, D)
      GEN061 = D * TMP(1, 1) * TMP(2, 2) * TMP(3, 3) * TMP(4, 4)
      DO J = 1, 4
        CALL GEN063 (TMP, 4, INDEX, AI(1, J))
      END DO
      RETURN
      END FUNCTION GEN061
      SUBROUTINE GEN062 (A, N, INDEX, D)
      PARAMETER (NMAX = 10)
      DIMENSION INDEX(N), A(N, N), VV(NMAX)
C***********************************************************************
C***********************************************************************
      IMAX = 0
      D    = 1.0
      DO I = 1, N
        AAMAX = 0.0
        DO J = 1, N
          IF (ABS(A(I, J)) .GT. AAMAX) AAMAX = ABS(A(I, J))
        END DO
        VV(I) = 1.0 / AAMAX
      END DO
      DO J = 1, N
        IF (J .GT. 1) THEN
          DO I = 1, J - 1
            SUM = A(I, J)
            IF (I .GT. 1) THEN
              DO K = 1, I - 1
                SUM = SUM - A(I, K) * A(K, J)
              END DO
              A(I, J) = SUM
            END IF
          END DO
        END IF
        AAMAX = 0.0
        DO I = J, N
          SUM = A(I, J)
          IF (J .GT. 1) THEN
            DO K = 1, J - 1
              SUM = SUM - A(I, K) * A(K, J)
            END DO
            A(I, J) = SUM
          END IF
          DUM = VV(I) * ABS(SUM)
          IF (DUM .GE. AAMAX) THEN
            IMAX = I
            AAMAX = DUM
          END IF
        END DO
        IF (J .NE. IMAX) THEN
          DO K = 1, N
            DUM = A(IMAX, K)
            A(IMAX, K) = A(J, K)
            A(J, K) = DUM
          END DO
          D = - D
          VV(IMAX) = VV(J)
        END IF
        INDEX(J) = IMAX
        IF (J .NE. N) THEN
          DUM = 1.0 / A(J, J)
          DO I = J + 1, N
            A(I, J) = A(I, J) * DUM
          END DO
        END IF
      END DO
      RETURN
      END SUBROUTINE GEN062
      SUBROUTINE GEN063 (A, N, INDEX, B)
      DIMENSION INDEX(N), A(N, N), B(N)
      II = 0
      DO I = 1, N
        LL = INDEX(I)
        SUM = B(LL)
        B(LL) = B(I)
        IF (II .NE. 0) THEN
          DO J = II, I - 1
            SUM = SUM - A(I, J) * B(J)
          END DO
        ELSE IF (SUM .NE. 0.0) THEN
        II = I
        END IF
        B(I) = SUM
      END DO
      DO I = N, 1, -1
        SUM = B(I)
        IF (I .LT. N) THEN
          DO J = I + 1, N
            SUM = SUM - A(I, J) * B(J)
          END DO
        END IF
        B(I) = SUM / A(I, I)
      END DO
      RETURN
      END SUBROUTINE GEN063
      SUBROUTINE GEN064 (A, N, NP, D, V)
      PARAMETER (NMAX=100)
      PARAMETER (TINY = 1.E-37)
      DIMENSION A(NP, NP), D(NP), V(NP, NP), B(NMAX), Z(NMAX)
C***********************************************************************
C***********************************************************************
      DO IP = 1, N
        DO IQ = 1, N
          V(IP, IQ) = 0.0
        END DO
        V(IP, IP) = 1.0
        B(IP)     = A(IP, IP)
        D(IP)     = B(IP)
        Z(IP)     = 0.0
      END DO
      DO I = 1, 50
        SM = 0.0
        DO IP = 1, N - 1
          DO IQ = IP + 1, N
            SM = SM + ABS(A(IP, IQ))
          END DO
        END DO
        IF (SM .LT. TINY) RETURN
        IF (I .LT. 4) THEN
          THRESH = 0.2 * SM / (N * N)
        ELSE
          THRESH = 0.0
        END IF
        DO IP = 1, N - 1
          DO IQ = IP + 1, N
            G = 100.0 * ABS(A(IP, IQ))
            IF ((I .GT. 4) .AND.
     1         (ABS(D(IP)) + G .EQ. ABS(D(IP))) .AND.
     2         (ABS(D(IQ)) + G .EQ. ABS(D(IQ)))) THEN
              A(IP,IQ) = 0.0
            ELSE IF (ABS(A(IP, IQ)) .GT. THRESH) THEN
              H = D(IQ) - D(IP)
              IF (ABS(H) + G .EQ. ABS(H)) THEN
                T = A(IP, IQ) / H
              ELSE
                THETA = 0.5 * H / A(IP, IQ)
                T = 1.0 / (ABS(THETA) + SQRT(1.0 + THETA * THETA))
                IF (THETA .LT. 0.0) T = -T
              END IF
              C = 1.0 / SQRT(1.0 + T * T)
              S = T * C
              TAU = S / (1.0 + C)
              H = T * A(IP, IQ)
              Z(IP) = Z(IP) - H
              Z(IQ) = Z(IQ) + H
              D(IP) = D(IP) - H
              D(IQ) = D(IQ) + H
              A(IP, IQ) = 0.0
              DO J = 1, IP - 1
                G = A(J, IP)
                H = A(J, IQ)
                A(J, IP) = G - S * (H + G * TAU)
                A(J, IQ) = H + S * (G - H * TAU)
              END DO
              DO J = IP + 1, IQ - 1
                G = A(IP, J)
                H = A(J, IQ)
                A(IP, J) = G - S * (H + G * TAU)
                A(J, IQ) = H + S * (G - H * TAU)
              END DO
              DO J = IQ + 1, N
                G = A(IP, J)
                H = A(IQ, J)
                A(IP, J) = G - S * (H + G * TAU)
                A(IQ, J) = H + S * (G - H * TAU)
              END DO
              DO J = 1, N
                G = V(J, IP)
                H = V(J, IQ)
                V(J, IP) = G - S * (H + G * TAU)
                V(J, IQ) = H + S * (G - H * TAU)
              END DO
            END IF
          END DO
        END DO
        DO IP = 1, N
          B(IP) = B(IP) + Z(IP)
          D(IP) = B(IP)
          Z(IP) = 0.0
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN064
      SUBROUTINE GEN065 (LU, PRBUF, JBUFL, JSUBST)
      CHARACTER PRBUF*(*), PCH*1, PCH0*1, PCH1*1, STR1(56)*8,
     1 STR2(56)*8, STR3(48)*6, STR4(48)*6, STR5(16)*6, STR6(16)*6,
     2 PRB*133
      DATA STR1 /
     1       '-3.00000', '-2.00000', '-1.87500', '-1.83333', '-1.75000',
     2       '-1.66667', '-1.33333', '-1.00000', '-0.87500', '-0.83333',
     3       '-0.75000', '-0.66667', '-0.66666', '-0.62500', '-0.50000',
     4       '-0.37500', '-0.33333', '-0.25000', '-0.16667', '-0.16666',
     5       '-0.12500', '-0.00000', ' 0.00000', ' 0.08333', ' 0.12500',
     6       ' 0.16666', ' 0.16667', ' 0.25000', ' 0.33333', ' 0.37500',
     7       ' 0.50000', ' 0.62500', ' 0.66666', ' 0.66667', ' 0.75000',
     8       ' 0.83333', ' 0.87500', ' 1.00000', ' 1.12500', ' 1.16666',
     9       ' 1.16667', ' 1.25000', ' 1.33333', ' 1.37500', ' 1.50000',
     *       ' 1.62500', ' 1.66666', ' 1.66667', ' 1.75000', ' 1.83333',
     1       ' 1.87500', ' 2.00000', '  0.0000', ' 90.0000', '120.0000',
     2       '180.0000'/
      DATA STR2 /
     1       '      -3', '      -2', '   -15/8', '   -11/6', '    -7/4',
     2       '    -5/3', '    -4/3', '      -1', '    -7/8', '    -5/6',
     3       '    -3/4', '    -2/3', '    -2/3', '    -5/8', '    -1/2',
     4       '    -3/8', '    -1/3', '    -1/4', '    -1/6', '    -1/6',
     5       '    -1/8', '       0', '       0', '    1/12', '     1/8',
     6       '     1/6', '     1/6', '     1/4', '     1/3', '     3/8',
     7       '     1/2', '     5/8', '     2/3', '     2/3', '     3/4',
     8       '     5/6', '     7/8', '       1', '     9/8', '     7/6',
     9       '     7/6', '     5/4', '     4/3', '    11/8', '     3/2',
     *       '    13/8', '     5/3', '     5/3', '     7/4', '    11/6',
     1       '    15/8', '       2', '       0', '      90', '     120',
     2      '     180'/
      DATA STR3 /
     1 ' 2.000', ' 1.875', ' 1.833', ' 1.750', ' 1.667', ' 1.625',
     2 ' 1.500', ' 1.375', ' 1.333', ' 1.250', ' 1.167', ' 1.125',
     3 ' 1.000', ' 0.875', ' 0.833', ' 0.750', ' 0.667', ' 0.625',
     4 ' 0.500', ' 0.375', ' 0.333', ' 0.250', ' 0.167', ' 0.125',
     5 ' 0.000', '-0.000', '-0.250', '-0.333', '-0.375', '-0.500',
     6 '-0.625', '-0.667', '-0.750', '-0.833', '-0.875', '-1.000',
     7 '-1.125', '-1.167', '-1.250', '-1.333', '-1.375', '-1.500',
     8 '-1.625', '-1.667', '-1.750', '-1.833', '-1.875', '-2.000'/
      DATA STR4 /
     1 '     2', '  15/8', '  11/6', '   7/4', '   5/3', '  13/8',
     2 '   3/2', '  11/8', '   4/3', '   5/4', '   7/6', '   9/8',
     3 '     1', '   7/8', '   5/6', '   3/4', '   2/3', '   5/8',
     4 '   1/2', '   3/8', '   1/3', '   1/4', '   1/6', '   1/8',
     5 '     0', '     0', '  -1/4', '  -1/3', '  -3/8', '  -1/2',
     6 '  -5/8', '  -2/3', '  -3/4', '  -5/6', '  -7/8', '    -1',
     7 '  -9/8', '  -7/6', '  -5/4', '  -4/3', ' -11/8', '  -3/2',
     8 ' -13/8', '  -5/3', '  -7/4', ' -11/6', ' -15/8', '    -2'/
      DATA STR5 /
     1 ' 0.00 ', '-0.00 ', ' 0.25 ', '-0.25 ', ' 0.50 ', '-0.50 ',
     2 ' 0.75 ', '-0.75 ', ' 1.00 ', '-1.00 ', ' 1.50 ', '-1.50 ',
     3 ' 2.00 ', '-2.00 ', ' 3.00 ', '-3.00 '/
      DATA STR6 /
     1 '    0 ', '   -0 ', '  1/4 ', ' -1/4 ', '  1/2 ', ' -1/2 ',
     2 '  3/4 ', ' -3/4 ', '    1 ', '   -1 ', '  3/2 ', ' -3/2 ',
     3 '    2 ', '   -2 ', '    3 ', '   -3 '/
      J0  = 0
      J   = 0
      JL  = 0
      PRB = PRBUF(1:JBUFL)//' '
      IBUFL = JBUFL + 1
      IPAR   = 0
      K0     = 0
      JSUBST0 = MOD (JSUBST, 2)
      IF (JSUBST0 .EQ. 1) THEN
        DO I = 2, IBUFL
          PCH = PRB(I : I)
          IF (PCH .EQ. '(') THEN
            I0   = I - 1
            J0   = I0
            PCH0 = PRB(I0 : I0)
            IF (PCH0 .EQ. '.') THEN
              IDOT = 1
            ELSE
              IDOT = 0
            END IF
   10       J0   = J0 - 1
            IF (J0 .EQ. 0) THEN
              PCH0 = ''''
            ELSE
              PCH0 = PRB(J0 : J0)
            END IF
            IF (IDOT .EQ. 1) PRB(J0 + 1 : J0 + 1) = PCH0
            IF (PCH0 .NE. ' ' .AND. PCH0 .NE. ')' .AND.
     1          PCH0 .NE. '''' .AND. PCH0 .NE. '"' .AND.
     2          PCH0 .NE. '-' .AND. J0 .GT. K0) GO TO 10
            IF (IDOT .EQ. 1) PRB(J0 : J0) = ' '
            J0 = J0 - 1 + IDOT
            IF (PCH0 .EQ. '''' .OR. PCH0 .EQ. '"') J0 = J0 + 1
            IPAR = 1
            J    = I
            JL   = I
          ELSE IF (IPAR .GT. 0) THEN
            IF (PCH .EQ. ')') THEN
              K0 = I + 1
              IF (J .GT. JL) THEN
                J            = J + 1
                PRB(J : J) = PCH
              ELSE
                J      = J - 1
              END IF
              IF (J .LT. I) THEN
                KMAX = J - J0
                ITAR = I + 1
                JFRM = J + 1
                DO K = 1, KMAX
                  PCH1 = PRB(JFRM - K : JFRM - K)
                  PRB(ITAR - K : ITAR - K) = PCH1
                END DO
                DO K = J0 + 1, I - KMAX
                  PRB(K : K) = ' '
                END DO
              END IF
              IPAR = 0
            ELSE IF (PCH .NE. ' ') THEN
              IF (PCH .EQ. '0') THEN
                IF (J .GT. JL) THEN
                  J            = J + 1
                  PRB(J : J) = PCH
                END IF
              ELSE
                J            = J + 1
                PRB(J : J) = PCH
              END IF
            END IF
          END IF
        END DO
      END IF
      ISUBST  = JSUBST / 2
      JSUBST1 = MOD (ISUBST, 2)
      IF (JSUBST1 .EQ. 1) THEN
        DO 20 I = 9, IBUFL
          DO K = 1, 56
            IF (PRB(I - 8 : I) .EQ. STR1(K)//' ') THEN
                PRB(I - 8 : I) = STR2(K)//' '
              GO TO 20
            END IF
          END DO
   20   CONTINUE
      END IF
      ISUBST  = ISUBST / 2
      JSUBST2 = MOD (ISUBST, 2)
      IF (JSUBST2 .EQ. 1) THEN
        DO 30 I = 7, IBUFL
          DO K = 1, 48
            IF (PRB(I - 6 : I) .EQ. STR3(K)//' ' .OR.
     1          PRB(I - 6 : I) .EQ. STR3(K)//'-') THEN
                PRB(I - 6 : I - 1) = STR4(K)
              GO TO 30
            END IF
          END DO
   30   CONTINUE
      END IF
      ISUBST  = ISUBST / 2
      JSUBST3 = MOD (ISUBST, 2)
      IF (JSUBST3 .EQ. 1) THEN
        DO I = 8, IBUFL
          IF (PRB(I - 7: I) .EQ. ' 0.0000 ' .OR.
     1        PRB(I - 7: I) .EQ. ' 0.0000-') THEN
              PRB(I - 7: I - 1)  =  '      0'
          ELSE IF (PRB(I - 7: I) .EQ. ' 1.0000 ' .OR.
     1             PRB(I - 7: I) .EQ. ' 1.0000-') THEN
              PRB(I - 7: I - 1)  =  '      1'
          ELSE IF (PRB(I - 7: I) .EQ. '-1.0000 ' .OR.
     1             PRB(I - 7: I) .EQ. '-1.0000-') THEN
              PRB(I - 7: I - 1)  =  '     -1'
          END IF
        END DO
      END IF
      ISUBST  = ISUBST / 2
      JSUBST4 = MOD (ISUBST, 2)
      IF (JSUBST4 .EQ. 1) THEN
        DO I = 6, IBUFL
          DO J = 1, 16
            IF (PRB(I - 5: I) .EQ. STR5(J)) THEN
              PRB(I - 5: I) = STR6(J)
            END IF
          END DO
        END DO
      END IF
      PRBUF = PRB(1:JBUFL)
      IF (LU .NE. 0) WRITE (LU, 99999, IOSTAT = IOST) PRBUF(1 : JBUFL)
      RETURN
99999 FORMAT (A)
      END SUBROUTINE GEN065
      SUBROUTINE GEN066 (MODE, PARA, PARS, KS)
      DIMENSION PARA(6), PARS(6)
      CHARACTER KS*1
      IF (MODE .EQ. 2) THEN
        TOL = 0.5
      ELSE
        TOL = 0.1
      END IF
      IF (KS .EQ. 'm') THEN
        IF (ABS(PARA(4) - 90.0) + ABS(PARA(6) - 90.0) .LT. TOL) THEN
          PARA(4) = 90.0
          PARA(6) = 90.0
          IF (MODE .GT. 0) THEN
            PARS(4) = 0.0
            PARS(6) = 0.0
          END IF
        END IF
      ELSE IF (KS .EQ. 'o') THEN
        PARA(4) = 90.0
        PARA(5) = 90.0
        PARA(6) = 90.0
        IF (MODE .GT. 0) THEN
          PARS(4) = 0.0
          PARS(5) = 0.0
          PARS(6) = 0.0
        END IF
      ELSE IF (KS .EQ. 't') THEN
        AVER    = (PARA(1) + PARA(2)) / 2.0
        PARA(1) = AVER
        PARA(2) = AVER
        PARA(4) = 90.0
        PARA(5) = 90.0
        PARA(6) = 90.0
        IF (MODE .GT. 0) THEN
          AVER    = (PARS(1) + PARS(2)) / 2.0
          PARS(1) = AVER
          PARS(2) = AVER
          PARS(4) = 0.0
          PARS(5) = 0.0
          PARS(6) = 0.0
        END IF
      ELSE IF (KS .EQ. 'r') THEN
        AVER    = (PARA(1) + PARA(2) + PARA(3)) / 3.0
        PARA(1) = AVER
        PARA(2) = AVER
        PARA(3) = AVER
        AVER    = (PARA(4) + PARA(5) + PARA(6)) / 3.0
        PARA(4) = AVER
        PARA(5) = AVER
        PARA(6) = AVER
        IF (MODE .GT. 0) THEN
          AVER    = (PARS(1) + PARS(2) + PARS(3)) / 3.0
          PARS(1) = AVER
          PARS(2) = AVER
          PARS(3) = AVER
          AVER    = (PARS(4) + PARS(5) + PARS(6)) / 3.0
          PARS(4) = AVER
          PARS(5) = AVER
          PARS(6) = AVER
        END IF
      ELSE IF (KS .EQ. 'h') THEN
        AVER    = (PARA(1) + PARA(2)) / 2.0
        PARA(1) = AVER
        PARA(2) = AVER
        PARA(4) = 90.0
        PARA(5) = 90.0
        PARA(6) = 120.0
        IF (MODE .GT. 0) THEN
          AVER    = (PARS(1) + PARS(2)) / 2.0
          PARS(1) = AVER
          PARS(2) = AVER
          PARS(4) = 0.0
          PARS(5) = 0.0
          PARS(6) = 0.0
        END IF
      ELSE IF (KS .EQ. 'c') THEN
        AVER     = (PARA(1) + PARA(2) + PARA(3)) / 3.0
        PARA(1) = AVER
        PARA(2) = AVER
        PARA(3) = AVER
        PARA(4) = 90.0
        PARA(5) = 90.0
        PARA(6) = 90.0
        IF (MODE .GT. 0) THEN
          AVER     = (PARS(1) + PARS(2) + PARS(3)) / 3.0
          PARS(1) = AVER
          PARS(2) = AVER
          PARS(3) = AVER
          PARS(4) = 0.0
          PARS(5) = 0.0
          PARS(6) = 0.0
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN066
      SUBROUTINE GEN067 (TM, CELO, CELN, CSDO, CSDN)
      DIMENSION AA(3, 3), BB(3, 3), C(6), D(6),
     1          TM(3, 3), CELO(6), CELN(6), CSDO(6), CSDN(6)
      DEL = 0.001
      DO J = 1, 6
        D(J) = 0.0
        DO I = 1, 6
          CELO(I) = CELO(I) + DEL
          CALL GEN026 (1, AA, CELO(1))
          CELO(I) = CELO(I) - DEL
          CALL GEN001 (1, TM, AA, BB)
          CALL GEN026 (-1, BB, C(1))
          D(J) = D(J) + ((CELN(J) - C(J)) * CSDO(I) / DEL) ** 2
        END DO
      END DO
      DO J = 1, 6
        CSDN(J) = SQRT (D(J))
      END DO
      RETURN
      END SUBROUTINE GEN067
      SUBROUTINE GEN068 (CELL, V, CESD, SV)
      DIMENSION CELL(6), CESD(6), V1(3), V2(3), V3(3), V4(3)
      DTR = 45.0 / ATAN2 (1.0, 1.0)
      IF (CELL(1) .EQ. CELL(2)) THEN
        IF (CELL(1) .EQ. CELL(3)) THEN
          SV = 3.0 * CELL(1) **2 * CESD(1)
        ELSE
          SV = SQRT ((2.0 * CELL(1) * CELL(3) * CESD(1)) **2 +
     1               (CELL(1) * CELL(1) * CESD(3)) **2)
        END IF
      ELSE
        DO I = 1, 3
          V4(I) = COS(CELL(3 + I) / DTR)
          IF (ABS(V4(I)) .LT. 1E-6) V4(I) = 0.0
          V3(I) = SIN(CELL(3 + I) / DTR)
          R = CESD(I) / CELL(I)
          IF (R .LT. 1E-9) THEN
            V1(I) = 0.0
          ELSE
            V1(I) = R**2
          END IF
        END DO
        R = 1.0 - V4(1)**2 - V4(2)**2 + V4(3) *
     1      (2.0 * V4(1) * V4(2) - V4(3))
        V2(1) = V4(1) - V4(2) * V4(3)
        V2(2) = V4(2) - V4(1) * V4(3)
        V2(3) = V4(3) - V4(1) * V4(2)
        Q1    = 0.0
        Q2    = 0.0
        DO I = 1, 3
          Q1 = Q1 + V1(I)
          Q3 = V3(I) * V2(I) * CESD(3 + I) / DTR
          IF (ABS(Q3) .LT. 1E-8) Q3 = 0.0
          Q2 = Q2 + Q3**2
        END DO
        SV = V * SQRT(Q1 + (Q2 / (R**2)))
      END IF
      RETURN
      END SUBROUTINE GEN068
      SUBROUTINE GEN069 (K, A, B, C, P, SIGMA, D, G)
      DIMENSION A(*), B(*), C(*), P(*), D(*), G(*),
     1 S1(1000), S0(1000)
      IF (K .EQ. 0) THEN
        D(1) = 1.0
        P(1) = C(1)
      ELSE
        S0(1) = 1.0
        S1(2) = 1.0
        S1(1) = -A(1)
        P(1)  = -C(2) * A(1) + C(1)
        P(2)  = C(2)
        D(1)  = A(1)**2 / G(2) + 1.0 / G(1)
        D(2)  = 1.0 / G(2)
        IF (K .GT. 1) THEN
          DO I = 2, K
            D(I + 1) = 0.0
            P(I + 1) = 0.0
          END DO
          K1 = K - 1
          DO J = 1, K1
            S0(J + 2) = 1.0
            S0(J + 1) = S1(J) - A(J + 1)
            IF (J .GT. 1) S0(J) = S1(J - 1) - A(J + 1) * S1(J) - B(J)
            IF (J .GT. 2) THEN
              J1 = J - 2
              DO I1 = 1, J1
                I = J1 - I1 + 1
                S0(I + 1) =
     1            S1(I) - A(J + 1) * S1(I + 1) - B(J) * S0(I + 1)
              END DO
            END IF
            S0(1) = -A(J + 1) * S1(1) - B(J) * S0(1)
            J1 = J + 2
            DO I = 1, J1
              IF (I .NE. J1) THEN
                H     = S1(I)
                S1(I) = S0(I)
                S0(I) = H
              ELSE
                S1(I) = S0(I)
              END IF
              P(I)  = P(I) + C(J + 2) * S1(I)
              D(I)  = D(I) + S1(I)**2 / G(J + 2)
            END DO
          END DO
        END IF
      END IF
      K1 = K + 1
      DO I = 1, K1
        D(I) = SIGMA * SQRT(D(I))
      END DO
      RETURN
      END SUBROUTINE GEN069
      SUBROUTINE GEN070 (N, X, F, W, K, A, B, C, G, V)
      DIMENSION X(*), F(*), W(*), A(*), B(*), C(*), G(*), V(*)
      DELTA = 0.0
      DO J = 1, N
        DELTA = DELTA + W(J) * F(J)**2
      END DO
      K3 = K + 1
      DO I3 = 1, K3, 1
        I = I3 - 1
        XS = 0.0
        FS = 0.0
        S1 = 0.0
        S0 = 0.0
        DO J = 1, N
          G1 = 1.0
          G0 = 0.0
          IF (I .GT. 0) THEN
            DO I1 = 1, I, 1
              S = 0.0
              IF (I1 .NE. 1) S = B(I1 - 1) * G0
              G0 = (X(J) - A(I1)) * G1 - S
              S  = G0
              G0 = G1
              G1 = S
            END DO
          END IF
          S1 = S1 + G1**2 * W(J)
          FS = FS + G1 * F(J) * W(J)
          IF (I .NE. K) THEN
            S0 = S0 + G0**2 * W(J)
            XS = XS + G1**2 * X(J) * W(J)
          END IF
        END DO
        IF (I .NE. K) THEN
          A(I + 1) = XS / S1
          IF (I .NE. 0) B(I) = S1 / S0
        END IF
        C(I + 1) = FS / S1
        G(I + 1) = S1
        IF (I .NE. 0) V(I + 1) = ABS(V(I)  - C(I + 1)**2 * S1)
        IF (I .EQ. 0) V(I + 1) = ABS(DELTA - C(I + 1)**2 * S1)
      END DO
      RETURN
      END SUBROUTINE GEN070
      REAL FUNCTION GEN071 (K, A, B, C, T, DER)
      PARAMETER (IP5=2)
      DIMENSION A(IP5), B(IP5), C(IP5)
      D0  = 0.0
      G0  = 0.0
      S1  = C(1)
      G1  = 1.0
      DER = 0.0
      D1  = 0.0
      IF (K .NE. 0) THEN
        DO I = 1, K
          S = 0.0
          IF (I .NE. 1) S = B(I - 1) * D0
          D0  = (T - A(I)) * D1 - S + G1
          S   = D0
          D0  = D1
          D1  = S
          DER = DER + C(I + 1) * D1
          S   = 0.0
          IF (I .NE. 1) S = B(I - 1) * G0
          G0 = (T - A(I)) * G1 - S
          S  = G0
          G0 = G1
          G1 = S
          S1 = S1 + C(I + 1) * G1
        END DO
      END IF
      GEN071 = S1
      RETURN
      END FUNCTION GEN071
      SUBROUTINE GEN072 (LINE, IFL, FN, KL, KN, LU5, LU6, IUP,
     1 JMIN, JMAX, NCHAR, NP17)
      CHARACTER LINE*80, ICL*80, IFL(*)*(*), ICH*1
      DIMENSION FN(*)
      GO TO 20
   10 IF (LU6 .NE. 0) WRITE (LU6, 99999, IOSTAT = IOST)
   20 KN    = 0
      KL    = 0
      ICONT = 0
      CALL GEN074 (FN, 1, NP17, 0.0)
      DO I = 1, NP17
        CALL GEN038 (IFL(I), 1, NCHAR)
      END DO
   30 IMIN = JMIN
      IMAX = JMAX
      IF (LU5 .NE. 0) READ (LU5, 99998, END = 140, ERR = 10) LINE
      IF (LINE(1:4) .EQ. 'EXTI') IMAX = 4
      IF (LINE(1:4) .EQ. 'TITL') THEN
        N = INDEX (LINE, '=')
        IF (N .NE. 0) IMAX = N - 1
      END IF
      IF (IMAX .EQ. 0) THEN
        IMIN = 1
        INUM = 0
        DO I = JMIN, 80
          ICH  = LINE(I:I)
          CALL GEN105 (3, ICH, J)
          IF (J .GE. 0) THEN
            INUM = 1
            GO TO 40
          END IF
          IF (ICH .EQ. '.') THEN
            INUM = 1
            GO TO 40
          END IF
          IF (INUM .EQ. 1) THEN
            INUM = 0
            IF (ICH .NE. ' ') THEN
              IF (IMAX .LT. 80) THEN
                IMAX = IMAX + 1
                ICL(IMAX:IMAX) = ' '
              END IF
            END IF
          END IF
   40     IF (IMAX .LT. 80) THEN
            IMAX = IMAX + 1
            ICL(IMAX:IMAX) = LINE(I:I)
          END IF
        END DO
      ELSE
        ICL = LINE
      END IF
      DO I = 1, 80
        IF (ICL(I:I) .EQ. CHAR(13)) ICL(I:I) = ' '
      END DO
      IF (IMAX .EQ. 0) GO TO 130
      IF (IUP .EQ. 1) CALL GEN020 (1, ICL, IMIN, IMAX)
      DO I = IMIN, IMAX
        ICH = ICL(I:I)
        IF (ICH .EQ. '=') THEN
          IMAX  = I - 1
          ICONT = 1
          GO TO 50
        END IF
      END DO
      ICONT = 0
   50 I     = IMIN - 1
   60 A     = 0.0
      IP    = 0
      NP    = 0
      L     = 0
      S     = 1.0
   70 I     = I + 1
      IF (I .LE. IMAX) THEN
        ICH = ICL(I:I)
        IF (L .EQ. 0 .AND. ICH .EQ. ' ') GO TO 70
        L     = L + 1
        CALL GEN105 (3, ICH, J)
        IF (J .GE. 0) THEN
          NP = NP + IP
          A  = 10.0 * A + J - 1
          GO TO 70
        END IF
        IF (ICH .EQ. '.') THEN
          IP = 1
        ELSE IF (ICH .EQ. '+') THEN
          IF (L .GT. 1) GO TO 80
          S = 1.0
        ELSE IF (ICH .EQ. '-') THEN
          IF (L .GT. 1) GO TO 80
          S = -1.0
        ELSE IF (ICH .EQ. ')') THEN
          GO TO 80
        ELSE
          IF (L .GT. 1) GO TO 80
          GO TO 90
        END IF
        GO TO 70
      END IF
      IF (L .LE. 0) GO TO 130
C * END OF NUMERIC FIELD
   80 A = S * A / 10.0**NP
      IF (KN .LT. NP17) THEN
        KN     = KN + 1
        FN(KN) = A
      END IF
      IF (ICH .EQ. '+' .OR. ICH .EQ. '-') I = I - 1
      GO TO 60
C * START NEW LITERAL FIELD
   90 KL = KL + 1
  100 IFL(KL)(L:L) = ICH
      L = L + 1
  110 I = I + 1
      IF (I .LE. IMAX) THEN
        ICH = ICL(I:I)
        IF (ICH .NE. ' ' .AND. ICH .NE. ',') THEN
          IF (ICH .NE. '(' .OR. L .LE. 3) THEN
            IF (ICH .EQ. '+' .OR. ICH .EQ. '-' .OR. ICH .EQ. '.')
     1        GO TO 120
            IF (L .GT. NCHAR) THEN
              GO TO 110
            ELSE
              GO TO 100
            END IF
  120       I = I - 1
          END IF
        END IF
      END IF
      GO TO 60
  130 IF (ICONT .EQ. 1) GO TO 30
      RETURN
  140 IFL(1) = 'EOF       '
      KL     = 1
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (/, '** ^C Ignored - s[default]', $)
99998 FORMAT (A)
      END SUBROUTINE GEN072
      SUBROUTINE GEN073 (A, B, C, D, E, I, J, K)
      DIMENSION A(3, *), B(3, *), C(3, *)
      C(1, K) = A(1, I) * D + B(1, J) * E
      C(2, K) = A(2, I) * D + B(2, J) * E
      C(3, K) = A(3, I) * D + B(3, J) * E
      RETURN
      END SUBROUTINE GEN073
      SUBROUTINE GEN074 (A, NB, NE, VALUE)
      DIMENSION A(*)
      DO I = NB, NE
        A(I) = VALUE
      END DO
      RETURN
      END SUBROUTINE GEN074
      SUBROUTINE GEN075 (A, B, C, I, J, K)
      DIMENSION A(3, *),B(3, *)
      X = 0.0
      DO L = 1, 3
        Y = A(L, I)
        Z = B(L, J)
        X = X + Y * Z
      END DO
      IF (K .EQ. 1) THEN
        C = X
      ELSE
        C = SQRT(X)
      END IF
      RETURN
      END SUBROUTINE GEN075
      SUBROUTINE GEN076 (A, B, C, I, J, K)
      DIMENSION A(3, *),B(3, *),C(3, *)
      X1      = A(1, I)
      X2      = A(2, I)
      X3      = A(3, I)
      Y1      = B(1, J)
      Y2      = B(2, J)
      Y3      = B(3, J)
      C(1, K) =  X2 * Y3 - X3 * Y2
      C(2, K) = -X1 * Y3 + X3 * Y1
      C(3, K) =  X1 * Y2 - X2 * Y1
      RETURN
      END SUBROUTINE GEN076
      SUBROUTINE GEN077 (A, B, C, I, J, N)
      DIMENSION A(3, 3, *), B(3, 3, *), C(3, 3, *), X(3, 3)
      DO K = 1, 3
        DO L = 1, 3
          X(K, L) = 0.0
          DO M = 1, 3
            Y = A(K, M, I)
            Z = B(M, L, J)
            X(K, L) = X(K, L) + Y * Z
          END DO
        END DO
      END DO
      DO K = 1, 3
        DO L = 1, 3
          C(K, L, N) = X(K, L)
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN077
      SUBROUTINE GEN078 (A, B, C, I, J, K)
      DIMENSION A(3, 3, *), B(3, *), C(3, *), X(3)
      DO L = 1, 3
        X(L) = 0.0
        DO M = 1, 3
          Y    = A(L, M, I)
          Z    = B(M, J)
          X(L) = X(L) + Y * Z
        END DO
      END DO
      DO L = 1, 3
        C(L, K) = X(L)
      END DO
      RETURN
      END SUBROUTINE GEN078
      SUBROUTINE GEN079 (A, B, I, J)
      DIMENSION A(3, 3, *), B(3, 3, *)
      DO K = 1, 3
        DO L = 1, 3
          B(K, L, J) = A(K, L, I)
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN079
      SUBROUTINE GEN080 (A, B, I, J)
      DIMENSION A(3, *), B(3, *)
      B(1, J) = A(1, I)
      B(2, J) = A(2, I)
      B(3, J) = A(3, I)
      RETURN
      END SUBROUTINE GEN080
      SUBROUTINE GEN081 (A, B, M, N)
      DIMENSION A(3, 3, *), B(3, 3, *), C(3, 3)
      DO I = 1, 3
        DO J = 1, 3
          C(I, J) = A(J, I, M)
        END DO
      END DO
      CALL GEN079 (C, B, 1, N)
      RETURN
      END SUBROUTINE GEN081
      SUBROUTINE GEN082 (A, I)
      DIMENSION A(3, *)
      CALL GEN075 (A, A, B, I, I, 2)
      IF (B .NE. 0.0) THEN
        DO J = 1, 3
          A(J, I) = A(J, I) / B
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN082
      SUBROUTINE GEN083 (T, U, V, A)
      DIMENSION T(3), U(3), V(3), AA(3, 3), DD(3, 3), A(4)
      DD(1, 1) = T(1)
      DD(1, 2) = T(2)
      DD(1, 3) = T(3)
      DD(2, 1) = U(1)
      DD(2, 2) = U(2)
      DD(2, 3) = U(3)
      DD(3, 1) = V(1)
      DD(3, 2) = V(2)
      DD(3, 3) = V(3)
      DO I = 1, 3
        CALL GEN079 (DD, AA, 1, 1)
        CALL GEN074 (AA(1, I), 1, 3, 1.0)
        A(I) = GEN084 (AA, 1)
      END DO
      CALL GEN075 (A, A, DIST, 1, 1, 2)
      A(1) =  A(1) / DIST
      A(2) =  A(2) / DIST
      A(3) =  A(3) / DIST
      A(4) = -GEN084 (DD, 1) / DIST
      RETURN
      END SUBROUTINE GEN083
      FUNCTION GEN084 (X, N)
      DIMENSION X(3, 3, *)
      GEN084 = X(1, 1, N) * X(2, 2, N) * X(3, 3, N)
     1       - X(1, 1, N) * X(2, 3, N) * X(3, 2, N)
     2       + X(1, 2, N) * X(2, 3, N) * X(3, 1, N)
     3       - X(1, 2, N) * X(2, 1, N) * X(3, 3, N)
     4       + X(1, 3, N) * X(2, 1, N) * X(3, 2, N)
     5       - X(1, 3, N) * X(2, 2, N) * X(3, 1, N)
      RETURN
      END FUNCTION GEN084
      SUBROUTINE GEN085 (WORD, L, K)
      CHARACTER WORD*(*)
      K = 0
      DO I = 1, L
        IF (WORD(I:I) .GT. ' ' .AND. WORD(I:I) .LE. '~') THEN
          K = K + 1
          WORD(K:K) = WORD(I:I)
        END IF
      END DO
      N = K + 1
      CALL GEN038 (WORD, N, L)
      RETURN
      END SUBROUTINE GEN085
      FUNCTION GEN086 (A, B, C, M, N)
      DIMENSION A(3, 3, *), B(3, 3, *)
      GEN086 = 0.0
      DO I = 1, 3
        DO J = 1, 3
          IF (ABS(A(I, J, M) - B(I, J, N)) .GT. C) GO TO 10
        END DO
      END DO
      GEN086 = 1.0
   10 RETURN
      END FUNCTION GEN086
      SUBROUTINE GEN087 (LINE, B, C, IA, NB)
      CHARACTER LINE*(*)
      CHARACTER CAR*23, CARA*23
      DIMENSION B(3, 3, *), C(3, *)
      CAR = '1234567890 /,+-xyz[]XYZ'
      IF (NB .EQ. 1) THEN
        MCM = 1
        LR  = LEN(LINE)
        CALL GEN085 (LINE, LR, KM)
        K    = 1
        COST = 1.0
        DO I = 1, 3
          C(I, IA) = 0.0
          DO J = 1, 3
            B(I, J, IA) = 0.0
          END DO
        END DO
        DO 30 I = 1, KM
          CARA = LINE(I:I)
          DO J = 1, 23
            IF (CAR(J:J) .EQ. CARA) GO TO 10
          END DO
          GO TO 60
   10     IF (J .EQ. 11) THEN
            GO TO 30
          ELSE IF (J .GT. 11) THEN
            GO TO 20
          END IF
          IF (J .EQ. 10) J = 0
          IF (MCM .EQ. 1) THEN
            IF (C(K, IA) .NE. 0.0) C(K, IA) = C(K, IA) * 10
            C(K, IA) = C(K, IA) + COST * J
            COST = 1.0
          ELSE IF (MCM .EQ. 2) THEN
            C(K, IA) = C(K, IA) / J
            MCM = 1
          END IF
          GO TO 30
   20     IF (J .GT. 20) J = J - 5
          J = J - 11
          IF (J .EQ. 1) THEN
            MCM = 2
          ELSE IF (J .EQ. 2) THEN
            K = K + 1
          ELSE IF (J .EQ. 3) THEN
            COST = 1.0
          ELSE IF (J .EQ. 4) THEN
            COST = -1.0
          ELSE IF (J .EQ. 5) THEN
            B(K, 1, IA) = COST
            COST = 1.0
          ELSE IF (J .EQ. 6) THEN
            B(K, 2, IA) = COST
            COST = 1.0
          ELSE IF (J .EQ. 7) THEN
            B(K, 3, IA) = COST
            COST = 1.0
          ELSE IF (J .EQ. 8) THEN
          ELSE IF (J .EQ. 9) THEN
            GO TO 60
          END IF
   30   CONTINUE
      ELSE IF (NB .EQ. 2) THEN
        KM = LEN(LINE)
        DO I = 1, KM
          LINE(I:I) = CAR(11:11)
        END DO
        LINE(12:12) = ','
        LINE(23:23) = ','
        DO I = 1, 3
          MCM = 11 * I
          DO J = 1, 3
            L = 4 - J
            IF (NINT(B(I, L, IA)) .NE. 0) THEN
              MA = L + 15
              LINE(MCM:MCM) = CAR(MA:MA)
              K = 14
              IF (B(I, L, IA) .LT. -0.1) K = 15
              MCM = MCM - 1
              LINE(MCM:MCM) = CAR(K:K)
              MCM = MCM - 1
            END IF
          END DO
          MS = 11
          IF (ABS(C(I, IA)) .GE. 0.1) THEN
            IF (C(I, IA) .LT. 0.0) MS = 15
            DO J = 1, 6
              CA = C(I, IA) * J
              K = NINT(CA)
              IF (ABS(FLOAT(K) - CA) .LT. 0.1) GO TO 40
            END DO
   40       IF (J .NE. 1) THEN
              LINE(MCM:MCM) = CAR(J:J)
              MCM = MCM - 1
              LINE(MCM:MCM) = CAR(12:12)
              MCM = MCM - 1
            END IF
   50       J = IABS(MOD(K, 10))
            LINE(MCM:MCM) = CAR(J:J)
            K = K / 10
            MCM = MCM - 1
            IF (K .GT. 0) GO TO 50
            LINE(MCM:MCM) = CAR(MS:MS)
          END IF
        END DO
        KM1 = KM - 1
        CALL GEN085 (LINE(2:KM), KM1, K)
        IF (LINE(2:2) .EQ. '+') LINE(2:2) = ' '
        DO I = 1, 2
          K = INDEX(LINE, ',+')
          K1 = K + 1
          IF (K .NE. 0) LINE(K1:K1) = ' '
        END DO
        CALL GEN085 (LINE(2:KM), KM1, K)
      END IF
   60 RETURN
      END SUBROUTINE GEN087
      SUBROUTINE GEN088 (A, I, M, MSIGN, INVERS, LU)
      DIMENSION A(3, 3, *), B(3, 3), C(3, 3, 2)
      CALL GEN074 (C, 1, 18, 0.0)
      C(1, 1, 1) =  1.0
      C(2, 2, 1) =  1.0
      C(3, 3, 1) =  1.0
      C(1, 1, 2) = -1.0
      C(2, 2, 2) = -1.0
      C(3, 3, 2) = -1.0
      INVERS     = 2
      MSIGN      = NINT(GEN084 (A, I))
      CALL GEN077  (A, C, B, I, 1, 1)
      DO M = 1, 16
        IF (GEN086 (C, B, 1.E-2, 2, 1) .NE. 0.0) INVERS = 1
        IF (GEN086 (C, B, 1.E-2, 1, 1) .NE. 0.0) GO TO 10
        CALL GEN077  (A, B, B, I, 1, 1)
      END DO
   10 IF (M .GE. 6 .AND. MSIGN .NE. 1) THEN
        M1 = (M / 4) * 4
        IF (M1 .NE. M) M = M / INVERS
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
      END SUBROUTINE GEN088
      SUBROUTINE GEN089 (LUA, LUB, NPAG, NLM)
      CHARACTER NULL*1, ICH*1, PRBUF*132, PSBUF*250
      NULL = CHAR(0)
      WRITE (LUB, 99999, IOSTAT = IOST) NPAG
      WRITE (LUB, 99998, IOSTAT = IOST)
      NB = 1
      NE = 132
      NP = 0
      NL = NLM
   10 READ (LUA, 99995, END = 20) PRBUF
      IF (PRBUF(1:1) .EQ. CHAR(12)) THEN
        BACKSPACE LUA
        READ (LUA, 99994, END = 10) PRBUF
        NP = NP + 1
        IF (NP .GT. 1) WRITE (LUB, 99996, IOSTAT = IOST)
        WRITE (LUB, 99997, IOSTAT = IOST) NP, NP
        NL = 0
      END IF
      NL = NL + 1
      IF (NL .GE. NLM) THEN
        NP = NP + 1
        IF (NP .GT. 1) WRITE (LUB, 99996, IOSTAT = IOST)
        WRITE (LUB, 99997, IOSTAT = IOST) NP, NP
        NL = 1
      END IF
      N = 0
      CALL GEN039 (1, PRBUF, 1, 132, NB, NE)
      DO I = 1, NE
        ICH = PRBUF(I:I)
        IF (ICH .NE. NULL) THEN
          IF (ICH .EQ. '(' .OR. ICH .EQ. ')') THEN
            N = N + 1
            PSBUF(N:N) = CHAR(92)
          END IF
          N = N + 1
          PSBUF(N:N) = ICH
        END IF
      END DO
      WRITE (LUB, 99993, IOSTAT = IOST) PSBUF(1:N)
      GO TO 10
   20 WRITE (LUB, 99992, IOSTAT = IOST)
      RETURN
99999 FORMAT ('%!PS-Adobe-2.0', /,'%%Creator: PLATON - A.L.Spek', /,
     1  '%%BoundingBox: 0 0 612 792', /, '%%Pages:', I6, /,
     2  '%%PageOrder: Ascend', /, '%%EndComments', /,
     3  '%%BeginSetup', /,
     3  ' /FONT (Courier) cvn def', /,
     4  ' /FONT_SIZE 9.000000 def', /,
     5  ' /XLMARGIN 25 def', /,
     6  ' /XRMARGIN 10 def', /,
     7  ' /YPAGE 612 def', /,
     8  ' /XPAGE 792 def', /,
     9  ' /YTMARGIN 30 def', /,
     *  ' /YBMARGIN 10 def', /,
     1  ' /PAGENUM 1 def', /,
     2  ' /bd {bind def} bind def', /,
     3  ' /m {moveto} bd ', /,
     4  ' /gs {gsave} bd', /,
     5  ' /gr {grestore} bd',
     6  ' /tr {translate} bd', /,
     7  ' /rt {rotate} bd', /,
     8  ' /PAGES_PER_SHEET 1 def')
99998 FORMAT (
     1  ' /sp {/SAVEOBJ save def gs 0 XPAGE tr -90 rt } bd', /,
     2  ' /np { gr showpage SAVEOBJ restore sp bp} bd', /,
     3  ' FONT findfont FONT_SIZE scalefont setfont', /,
     4  ' /FONT_UPPER currentfont', /,
     5  ' /FontBBox get 3 get 0 exch currentfont', /,
     6  ' /FontMatrix get transform exch pop def', /,
     7  ' /FONT_LOWER currentfont', /,
     8  ' /FontBBox get 1 get 0 exch currentfont', /,
     9  ' /FontMatrix get transform exch pop def', /,
     *  ' /FONT_HT  FONT_UPPER FONT_LOWER sub def', /,
     1  ' FONT_HT 0 eq {/FONT_HT FONT_SIZE def } if', /,
     2  ' /FONT_MOVE FONT_SIZE FONT_HT gt {FONT_SIZE def}',
     3  ' {FONT_HT def} ifelse', /,
     4  ' /FONT_TOL FONT_HT YBMARGIN add def', /,
     4  ' /bp { XLMARGIN YPAGE YTMARGIN sub FONT_UPPER sub m } bd', /,
     5  ' /s { show  currentpoint exch pop dup FONT_TOL',
     6  ' gt {FONT_MOVE sub XLMARGIN  exch m} {np} ifelse}  bd', /,
     7  '%%EndSetup', /, 'sp', /, 'bp')
99997 FORMAT ('%%Page:', 2I7)
99996 FORMAT ('np')
99995 FORMAT (A)
99994 FORMAT (1X, A)
99993 FORMAT ('(', A, ')s')
99992 FORMAT ('np', /, '%%EOF')
      END SUBROUTINE GEN089
      INTEGER FUNCTION GEN090 (I, J)
      I0 = 0
      I1 = I
      I2 = J
      I3 = 1
      N  = 1
   10 IF (MOD(I1, 2) .EQ. 1 .AND. MOD(I2, 2) .EQ. 1) I0 = I0 + I3
      IF (N .LT. 15) THEN
        N  = N  + 1
        I1 = I1 / 2
        I2 = I2 / 2
        I3 = I3 * 2
        GO TO 10
      END IF
      GEN090 = I0
      RETURN
      END FUNCTION GEN090
      SUBROUTINE GEN091 (X, T, KUSER, KUSR, NATO, NAT, ITEM)
      DIMENSION X(KUSER, KUSR), T(KUSR)
      IF (NAT .GT. 1) THEN
        INT  = 2
   10   INT  = 2 * INT
        IF (INT .LT. NAT) GO TO 10
        INT  = MIN0(NAT, (3 * INT) / 4 - 1)
   20   INT  = INT / 2
        IFIN = NAT - INT
        DO II = 1, IFIN
          I = II
          J = I + INT
          IF (X(NATO + I, ITEM) .LT. X(NATO + J, ITEM)) THEN
            DO K = 1, KUSR
              T(K) = X(NATO + J, K)
            END DO
   30       DO K = 1, KUSR
              X(NATO + J, K) = X(NATO + I, K)
            END DO
            J = I
            I = I - INT
            IF (I .GT. 0) THEN
              IF (X(NATO + I, ITEM) .LT. T(ITEM)) GO TO 30
            END IF
            DO K = 1, KUSR
              X(NATO + J, K) = T(K)
            END DO
          END IF
        END DO
        IF (INT .NE. 1) GO TO 20
      END IF
      RETURN
      END SUBROUTINE GEN091
      SUBROUTINE GEN092 (MODL, H, TM, NUM)
      DIMENSION H(3), TM(3, 3)
      NUM = 0
      DO J = 1, 3
        DM = 0.0
        DO I = 1, 3
          DM = DM + H(I) * TM(I, J)
        END DO
        NUM = NUM + MOD(NINT(ABS(DM)), MODL)
      END DO
      RETURN
      END SUBROUTINE GEN092
      SUBROUTINE GEN093 (IDOF, CSQ, IP)
      DIMENSION P95(20), P5(20)
      CHARACTER IP*4
      DATA P95 /
     1 0.0, 0.1, 0.22, 0.71, 1.15, 1.70, 2.20, 2.70, 3.30, 3.94, 4.50,
     2 5.2, 6.0, 6.6, 7.26, 8.0, 8.65, 9.4, 10.1, 10.85/
      DATA P5 /
     1 3.84, 5.99, 7.81, 9.49, 11.07, 12.5, 14.0, 15.5, 17.0, 18.31,
     2 19.8, 21.0, 22.2, 23.75, 25.0, 26.2, 27.5, 29.0, 30.2, 31.41/
      IP = '    '
      IF (IDOF .LE. 20 .AND. IDOF .GT. 0) THEN
        IF (CSQ .LE. P95(IDOF)) IP = 'P>95'
        IF (CSQ .GT. P5(IDOF))  IP = 'P<5 '
      END IF
      RETURN
      END SUBROUTINE GEN093
      SUBROUTINE GEN094 (X, V, IDEV, IDUM)
      DIMENSION X(3, 3), V(3)
      IDUM = 0
      DO J = 1, 3
        DM = 0.0
        DO I = 1, 3
          DM = DM + X(I, J) * V(I)
        END DO
        IDUM = IDUM + MOD(NINT(ABS(DM)), IDEV)
      END DO
      RETURN
      END SUBROUTINE GEN094
      FUNCTION GEN095 (P, IH, IK, IL)
      DIMENSION P(6)
      GEN095 = 0.25 * (IH**2 * P(1) + IK**2 * P(2)
     1       + IL**2 * P(3) + 2.0 * (IK * IL * P(4)
     2       + IH * IL * P(5) + IH * IK * P(6)))
      RETURN
      END FUNCTION GEN095
      SUBROUTINE GEN096 (T, IROTX, IROTY, IROTZ, IDET, U, PHI, ROM)
      DIMENSION T(3, 3), U(3), V(3), Z(15), ROM(3, 3)
      CALL GEN010 (T, IDET, 0)
      RTD = 0.0
      AL  = 0.0
      BE  = 0.0
      GA  = 0.0
      IF (IDET .NE. 0) THEN
        CALL GEN010 (T, IDET, -1)
        RTD = 45.0 / ATAN(1.0)
        IF (ABS(T(1, 1)) + ABS(T(2, 1)) .LT. 0.00001)  GO TO 10
        GA = ATAN2(T(2, 1), T(1, 1))
   10   T11A =  T(1, 1) * COS(GA) + T(2, 1) * SIN(GA)
        T12A =  T(1, 2) * COS(GA) + T(2, 2) * SIN(GA)
        T22A = -T(1, 2) * SIN(GA) + T(2, 2) * COS(GA)
        IF (ABS(T(3, 1)) + ABS(T11A) .LT. 0.00001)  GO TO 20
        BE = ATAN2(-T(3, 1), T11A)
   20   T32A = SIN(BE) * T12A + COS(BE) * T(3, 2)
        IF (ABS(T32A) + ABS(T22A) .LT. 0.00001)  GO TO 30
        AL = ATAN2(T32A, T22A)
   30   DO I = 1, 3
          V(I)      = T(3, I)
          Z(6 + I)  = T(3, I)
          Z(I + 9)  = T(2, I)
          Z(I + 12) = 0.0
        END DO
        IF (ABS(Z(8)) .GT. 0.9999) THEN
          Z(13) = 1.0
        ELSE
          Z(14) = 1.0
        END IF
        CALL GEN008 (Z(13), Z(7), Z(1), 1)
        CALL GEN008 (Z(7), Z(1), Z(4), 1)
        COSPH = MAX(MIN(1.0, Z(4) * Z(10) + Z(5) * Z(11)
     1      + Z(6) * Z(12)), -1.0)
        CALL GEN008 (Z(4), Z(10), Z(13), 1)
        TEKEN = Z(7) * Z(13) + Z(8) * Z(14) + Z(9) * Z(15)
        PHI = SIGN(ACOS(COSPH) * RTD, TEKEN)
        CALL GEN002 (1, ROM, V, U, XLNG)
        XNORM = MAX(ABS(U(1)), ABS(U(2)), ABS(U(3)))
        IF (XNORM .NE. 0) THEN
          DO I = 1, 3
            U(I) = U(I) / XNORM
          END DO
        END IF
        CALL GEN010 (T, IDET, -1)
      END IF
      IROTX = - NINT(AL * RTD)
      IROTY = - NINT(BE * RTD)
      IROTZ = - NINT(GA * RTD)
      RETURN
      END SUBROUTINE GEN096
      SUBROUTINE GEN097 (IA, N1, N2, IVALUE)
      DIMENSION IA(*)
      DO I = N1, N2
        IA(I) = IVALUE
      END DO
      RETURN
      END SUBROUTINE GEN097
      SUBROUTINE GEN098 (M, X, N, ITX, ITY, ITZ, IRES)
      IARU = NINT(X)
      MABS = IABS(M)
      ITX  = MOD(MABS / (100 * IARU), 10) - 5
      ITY  = MOD(MABS / (10  * IARU), 10) - 5
      ITZ  = MOD(MABS / IARU,         10) - 5
      IRES = MOD(MABS,  IARU)
      N    = MABS / (1000 * IARU)
      RETURN
      END SUBROUTINE GEN098
      SUBROUTINE GEN099 (A, B, C)
      DIMENSION A(3, 3), B(3), C(3, 3)
      DO I = 1, 3
        DO J = 1, 3
          C(I, J) = 0.0
          DO K = 1, 3
            C(I, J) = C(I, J) + A(I, K) * A(J, K) * B(K)
          END DO
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN099
      SUBROUTINE GEN100 (AO, J, X, Y, Z)
      DIMENSION AO(20)
      CALL GEN074 (AO, 1, 20, 0.0)
      IF (J .EQ. 1) THEN
        AO(4)  =   Z * Z
        AO(6)  =   Y * Y
        AO(5)  = - 2 * Y * Z
        AO(19) = - 2 * Y
        AO(16) =   2 * Z
        AO(7)  =   1.0
      ELSE IF (J .EQ. 2) THEN
        AO(6)  = - X * Y
        AO(5)  =   X * Z
        AO(3)  =   Y * Z
        AO(2)  = - Z * Z
        AO(13) = - Z
        AO(17) =   Z
        AO(19) =   X
        AO(20) = - Y
        AO(8)  =   1.0
      ELSE IF (J .EQ. 3) THEN
        AO(4)  = - X * Z
        AO(5)  =   X * Y
        AO(3)  = - Y * Y
        AO(2)  =   Y * Z
        AO(13) =   2 * Y
        AO(17) =   Y
        AO(18) =   Z
        AO(16) = - X
        AO(9)  =   1.0
      ELSE IF (J .EQ. 4) THEN
        AO(1)  =   Z * Z
        AO(6)  =   X * X
        AO(3)  = - 2 * X * Z
        AO(14) = - 2 * Z
        AO(20) =   2 * X
        AO(10) =   1.0
      ELSE IF (J .EQ. 5) THEN
        AO(1)  = - Y * Z
        AO(5)  = - X * X
        AO(3)  =   X * Y
        AO(2)  =   X * Z
        AO(13) = - X
        AO(17) = - 2 * X
        AO(14) =   Y
        AO(15) = - Z
        AO(11) =   1.0
      ELSE IF (J .EQ. 6) THEN
        AO(1)  =   Y * Y
        AO(4)  =   X * X
        AO(2)  = - 2 * X * Y
        AO(18) = - 2 * X
        AO(15) =   2 * Y
        AO(12) =   1.0
      END IF
      RETURN
      END SUBROUTINE GEN100
      SUBROUTINE GEN101 (M, N, DHX)
      DIMENSION DHX(3, *)
      N  = 3
      I  = -1
   10 IF (I .LT. M) THEN
        I  = I + 1
        I1 = MOD(I, 2)
        I3 = MOD(I, 3)
        I4 = MOD(I, 5)
        I5 = MOD(I, 7)
        J  = -M -1
   20   J  = J + 1
        IF (J .GT. M) GO TO 10
        J1 = MOD(J, 2)
        J3 = MOD(J, 3)
        J4 = MOD(J, 5)
        J5 = MOD(J, 7)
        K  = -M -1
   30   K  = K + 1
        IF (K .GT. M) GO TO 20
        K1 = MOD(K, 2)
        K3 = MOD(K, 3)
        K4 = MOD(K, 5)
        K5 = MOD(K, 7)
        IF (I * J * K .EQ. 0) THEN
          IF (ABS(I1) + ABS(J1) + ABS(K1) .EQ. 0) GO TO 30
          IF (ABS(I3) + ABS(J3) + ABS(K3) .EQ. 0) GO TO 30
          IF (ABS(I4) + ABS(J4) + ABS(K4) .EQ. 0) GO TO 30
          IF (ABS(I5) + ABS(J5) + ABS(K5) .EQ. 0) GO TO 30
          IF (I .LT. 0) THEN
            GO TO 30
          ELSE IF (I .EQ. 0) THEN
            IF (J .LT. 0) THEN
              GO TO 30
            ELSE IF (J .EQ. 0) THEN
              IF (K .LT. 0) GO TO 30
            END IF
          END IF
        ELSE
          IF (ABS(I1) + ABS(J1) .EQ. 0) GO TO 30
          IF (ABS(I1) + ABS(K1) .EQ. 0) GO TO 30
          IF (ABS(J1) + ABS(K1) .EQ. 0) GO TO 30
          IF (ABS(I3) + ABS(J3) .EQ. 0) GO TO 30
          IF (ABS(I3) + ABS(K3) .EQ. 0) GO TO 30
          IF (ABS(J3) + ABS(K3) .EQ. 0) GO TO 30
          IF (ABS(I4) + ABS(J4) .EQ. 0) GO TO 30
          IF (ABS(I4) + ABS(K4) .EQ. 0) GO TO 30
          IF (ABS(J4) + ABS(K4) .EQ. 0) GO TO 30
          IF (ABS(I5) + ABS(J5) .EQ. 0) GO TO 30
          IF (ABS(I5) + ABS(K5) .EQ. 0) GO TO 30
          IF (ABS(J5) + ABS(K5) .EQ. 0) GO TO 30
        END IF
        IJK = I * 10000 + J * 100 + K
        IF (IJK .EQ. 10000) THEN
          NN = 1
        ELSE IF (IJK .EQ. 100) THEN
          NN = 2
        ELSE IF (IJK .EQ. 1) THEN
          NN = 3
        ELSE
          N  = N + 1
          NN = N
        END IF
        DHX(1, NN) = I
        DHX(2, NN) = J
        DHX(3, NN) = K
        GO TO 30
      END IF
      RETURN
      END SUBROUTINE GEN101
      SUBROUTINE GEN102 (IS, IFL, SWS, NM)
      CHARACTER SWS(*)*4, IFL*7
      IS = 1
      DO N = 1, NM
        IF (IFL(1:4) .EQ. SWS(N)(1:4)) THEN
          IS = N + 1
          GO TO 10
        END IF
      END DO
   10 RETURN
      END SUBROUTINE GEN102
      SUBROUTINE GEN103 (LINE, N)
      CHARACTER LINE*(*), ICH*1
      M   = 0
      NBL = 1
      DO I = 1, N
        ICH = LINE(I:I)
        IF (ICH .EQ. ' ') THEN
          NBL = NBL + 1
          IF (NBL .EQ. 1) THEN
            M = M + 1
            LINE(M:M) = ICH
          ELSE
            GO TO 10
          END IF
        ELSE
          M   = M + 1
          NBL = 0
          LINE(M:M) = ICH
        END IF
   10   CONTINUE
      END DO
      M = M + 1
      IF (M .LE. N) CALL GEN038 (LINE, M, N)
      RETURN
      END SUBROUTINE GEN103
      BLOCKDATA GENRL
      COMMON /G104/ IT(30, 9)
      DATA ((IT (I, J), J = 1, 9), I = 1, 11) /
     1  211, 101, 110, 0, 1, 1, 0, 0, 0,
     2   11, 121, 110, 1, 1, 1, 0, 0, 0,
     3   11, 101, 112, 0, 1, 1, 0, 0, 0,
     4  121, 211, 110, 0, 0, 1, 0, 0, 0,
     5  112, 101, 211, 0, 0, 0, 0, 0, 0,
     6   11, 112, 121, 0, 0, 0, 0, 0, 0,
     7  101,  11, 110, 0, 0, 1, 0, 0, 0,
     8  110, 101,  11, 0, 0, 0, 0, 0, 0,
     9   11, 110, 101, 0, 0, 0, 0, 0, 0,
     *  221, 101, 110, 0, 0, 0, 0, 1, 0,
     1   11, 221, 110, 0, 0, 0, 0, 1, 0/
      DATA ((IT (I, J), J = 1, 9), I = 12, 21) /
     1  121,   1, 112, 0, 0, 0, 1, 1, 0,
     2    1, 211, 112, 0, 0, 0, 1, 1, 0,
     3  121, 112, 211, 0, 0, 0, 0, 0, 1,
     4  112, 211, 121, 0, 0, 0, 0, 0, 1,
     5  110,  11, 121, 0, 0, 0, 0, 0, 1,
     6  101, 112,  11, 0, 0, 0, 0, 0, 1,
     7  112,  11, 101, 0, 0, 0, 0, 0, 1,
     8  101, 110, 211, 0, 0, 0, 0, 0, 1,
     9  110, 211, 101, 0, 0, 0, 0, 0, 1,
     *  121, 110,  11, 0, 0, 0, 0, 0, 1/
      DATA ((IT (I, J), J = 1, 9), I = 22, 27) /
     1  211, 110, 121, 0, 0, 0, 0, 0, 1,
     2  211, 112, 101, 0, 0, 0, 0, 0, 1,
     3  112, 121,  11, 0, 0, 0, 0, 0, 1,
     4  110, 121, 211, 0, 0, 0, 0, 0, 1,
     5  121,  11, 112, 0, 0, 1, 0, 0, 1,
     6  101, 211, 112, 0, 0, 1, 0, 0, 1/
      DATA ((IT (I, J), J = 1, 9), I = 28, 30) /
     1  221,  11, 112, 0, 0, 0, 0, 1, 0,
     2  011, 101, 112, 0, 0, 0, 1, 1, 0,
     3  101, 221, 112, 0, 0, 0, 0, 1, 0/
      END
      SUBROUTINE GEN104 (LAT, C, A)
      COMMON /G104/ IT(30, 9)
      DIMENSION A(3, 3), B(3, 3), C(3, 3)
      CALL GEN021 (A, 1)
      CALL GEN003 (C, B, DET, 0)
      IF (ABS(DET - 1.0) .LT. 0.001 .AND. LAT .GT. 1) THEN
        N1 = NINT(C(1, 1)) * 100 + NINT(C(1, 2)) * 10 + NINT(C(1, 3))
     1     + 111
        N2 = NINT(C(2, 1)) * 100 + NINT(C(2, 2)) * 10 + NINT(C(2, 3))
     1     + 111
        N3 = NINT(C(3, 1)) * 100 + NINT(C(3, 2)) * 10 + NINT(C(3, 3))
     1     + 111
        DO I = 1, 30
          IF (IT (I, LAT + 2) .NE. 0) THEN
            IF (N1 .EQ. IT(I, 1) .AND. N2 .EQ. IT(I, 2) .AND.
     1          N3 .EQ. IT(I, 3)) THEN
              CALL GEN052 (B, A)
              CALL GEN021 (C, 1)
              GO TO 10
            END IF
          END IF
        END DO
      END IF
   10 RETURN
      END SUBROUTINE GEN104
      SUBROUTINE GEN105 (MODE, ICH, N)
      CHARACTER ICH*1
      N = - 1
      IF (MODE .EQ. 1) THEN
        DO I = ICHAR('A'), ICHAR('Z')
          IF (ICH .EQ. CHAR(I)) THEN
            N = I
            GO TO 10
          END IF
        END DO
      ELSE IF (MODE .EQ. 2) THEN
        DO I = ICHAR('a'), ICHAR('z')
          IF (ICH .EQ. CHAR(I)) THEN
            N = I
            GO TO 10
          END IF
        END DO
      ELSE IF (MODE .EQ. 3) THEN
        DO I = 1, 10
          IF (ICH .EQ. CHAR(ICHAR('0') - 1 + I)) THEN
            N = I
            GO TO 10
          END IF
        END DO
      END IF
   10 RETURN
      END SUBROUTINE GEN105
      SUBROUTINE GEN106 (V, STH, PSI, AA, BB, V6, V8, PAR)
      DIMENSION V(3), V1(3), V2(3), V3(3), V4(3), V6(3), V8(3),
     1  AA(3, 3), BB(3, 3), PAR(6)
      CTH = SQRT(1.0 - STH**2)
      CALL GEN002 (-1, BB, V, V6, XLNG)
      CALL GEN007 (AA, V6, V1, -1)
      IF (V(1) .EQ. V(2) .AND. V(2) .EQ. V(3)) THEN
        V6(1) =   V(1)
        V6(2) = - V(1)
        V6(3) =   0.0
      ELSE
        V6(1) = V(2) - V(3)
        V6(2) = V(3) - V(1)
        V6(3) = V(1) - V(2)
      END IF
      CALL GEN007 (AA, V6, V2, -1)
      CALL GEN008 (V1, V2, V6, 0)
      CALL GEN002 (-1, BB, V6, V8, XLNG)
      CALL GEN007 (AA, V8, V3, -1)
      DO K = 1, 3
        V4(K) =  V3(K) * COS(PSI) + V2(K) * SIN(PSI)
        V6(K) = (V1(K) * STH + V4(K) * CTH) / PAR(K)
        V8(K) = (V1(K) * STH - V4(K) * CTH) / PAR(K)
      END DO
      RETURN
      END SUBROUTINE GEN106
      SUBROUTINE GEN107 (IA, N, M)
      DIMENSION IA(*)
      M  = 1
      MN = 99999
      DO I = 1, N
        IF (IA(I) .GT. 0) MN = MIN (MN, IA(I))
      END DO
      DO 10 I = 1, MN
        M = MN + 1 - I
        DO J = 1, N
          IF (MOD (IA(J), M) .NE. 0) GO TO 10
        END DO
        DO J = 1, N
          IA(J) = IA(J) / M
        END DO
        EXIT
   10 CONTINUE
      RETURN
      END SUBROUTINE GEN107
      SUBROUTINE GEN108 (LU, MODE)
      IF (MODE .NE. 0) ENDFILE (LU, ERR = 20)
      REWIND (LU, ERR = 10)
      RETURN
   10 WRITE (6, 99999) LU
      RETURN
   20 WRITE (6, 99998) LU
      RETURN
99999 FORMAT ('W: REWIND  PROBLEM FOR UNIT ', I5)
99998 FORMAT ('W: ENDFILE PROBLEM FOR UNIT ', I5)
      END SUBROUTINE GEN108
      SUBROUTINE GEN109 (M, N, X, Y, Z, F, NP)
      DOUBLE PRECISION F(81)
      XX = X**2
      YY = Y**2
      ZZ = Z**2
      XY = X * Y
      XZ = X * Z
      YZ = Y * Z
      U  = XX - YY
      V  = 3.0 * XX - YY
      W  = XX - 3.0 * YY
      T  = XX * (XX - 6.0 * YY) + YY**2
      NP = 0
      IF (N .GE. 2) THEN
        NP   = 5
        F(1) = 1.5 * ZZ - 0.5
        F(2) = 3.0 * XZ
        F(3) = 3.0 * YZ
        F(4) = 3.0 * U
        F(5) = 6.0 * XY
        IF (N .GE. 4) THEN
          NP    = 14
          F(6)  = ZZ     * (4.375 * ZZ -3.75) + 0.375
          F(7)  = XZ     * (17.5 * ZZ -7.5)
          F(8)  = YZ     * (17.5 * ZZ -7.5)
          F(9)  = (52.5  * ZZ - 7.5) * U
          F(10) = (105.0 * ZZ - 15.0) * XY
          F(11) = 105.0  * XZ * W
          F(12) = 105.0  * YZ * V
          F(13) = 105.0  * T
          F(14) = 420.0  * XY * U
          IF (N .GE. 6) THEN
            NP    = 27
            F(15) = ZZ * (ZZ * (14.4375 * ZZ - 19.6875) + 6.5625)
     1            - 0.3125
            F(16) = XZ * (ZZ * (86.625 * ZZ - 78.75) + 13.125)
            F(17) = YZ * (ZZ * (86.625 * ZZ - 78.75) + 13.125)
            F(18) = (ZZ * (433.125 * ZZ - 236.25) + 13.125) * U
            F(19) = (ZZ * (866.25 * ZZ - 472.5) + 26.25) * XY
            F(20) = XZ * (1732.5 * ZZ - 472.5) * W
            F(21) = YZ * (1732.5 * ZZ - 472.5) * V
            F(22) = (5197.5 * ZZ - 472.5) * T
            F(23) = XY * (20790.0 * ZZ - 1890.0) * U
            F(24) = 10395.0 * XZ * (XX * (XX - 10.0 * YY)
     1            + 5.0 * YY**2)
            F(25) = 10395.0 * YZ * (XX * (5.0 * XX - 10.0 * YY)
     1            + YY**2)
            F(26) = 10395.0 * (XX * (XX * (XX - 15.0) * YY
     1            + 15.0 * YY**2) - YY**3)
            F(27) = 62370.0 * XY * (XX * (XX - 3.333333 * YY) + YY**2)
            IF (N .GE. 8) THEN
              NP    = 44
              F(28) = (((50.2734375 * ZZ - 93.84375) * ZZ
     1              + 54.140625) * ZZ - 9.84375) * ZZ + 0.2734375
              Q     = ((402.1875 * ZZ - 563.0625) * ZZ
     1              + 216.5625) * ZZ - 19.6875
              F(29) = XZ * Q
              F(30) = YZ * Q
              Q     = ((2815.3125 * ZZ - 2815.3125) * ZZ
     1              + 649.6875) * ZZ - 19.6875
              F(31) = U * Q
              F(32) = 2.0 * XY * Q
              Q     = (16891.875 * ZZ - 11261.25) * ZZ + 1299.375
              F(33) = XZ * Q * W
              F(34) = YZ * Q * V
              Q     = (84459.375 * ZZ - 33783.75) * ZZ + 1299.375
              F(35) = Q * T
              F(36) = 4.0 * XY * Q * U
              Q     = 337837.5 * ZZ - 67567.5
              F(37) = XZ * Q * (XX * (XX - 10.0 * YY) + 5.0 * YY**2)
              F(38) = YZ * Q * (XX * (5.0 * XX - 10.0 * YY) + YY**2)
              Q     = 1013512.5 * ZZ - 67567.5
              F(39) = Q * (XX * (XX * (XX - 15.0 * YY)
     1              + 15.0 * YY**2) - YY**3)
              F(40) = Q * XY * (XX * (6.0 * XX - 20.0 * YY)
     1              + 6.0 * YY**2)
              F(41) = 2027025.0 * XZ * (XX * (XX * (XX - 21.0 *YY)
     1              + 35.0 * YY**2) - 7.0 * YY**3)
              F(42) = 2027025.0 * YZ * (XX * (XX * (7.0 * XX
     1              - 35.0 * YY) + 21.0 * YY**2) - YY**3)
              F(43) = 2027025.0 * (XX * (XX * (XX * (XX - 28.0 * YY)
     1              + 70.0 * YY**2) - 28.0 * YY**3) + YY**4)
              F(44) = 16216200.0 * XY * (XX * (XX * (XX - 7.0 * YY)
     1              + 7.0 * YY**2) - YY**3)
            END IF
          END IF
        END IF
      END IF
      IF (M .GE. 1) THEN
        NP        = NP + 3
        F(NP - 2) = Z
        F(NP - 1) = X
        F(NP)     = Y
        IF (M .GE. 3) THEN
          NP        = NP + 7
          F(NP - 6) = Z * (2.5 * ZZ - 1.5)
          Q         = 7.5 * ZZ - 1.5
          F(NP - 5) = X * Q
          F(NP - 4) = Y * Q
          F(NP - 3) = 15.0 * Z * U
          F(NP - 2) = 30.0 * X * YZ
          F(NP - 1) = 15.0 * X * W
          F(NP)     = 15.0 * Y * V
          IF (M .GE. 5) THEN
            NP         = NP + 11
            F(NP - 10) = Z * (ZZ * (ZZ * 7.875 - 8.75) + 1.875)
            Q          = ZZ * (39.375 * ZZ - 26.25) + 1.875
            F(NP -  9) = X * Q
            F(NP -  8) = Y * Q
            Q          = Z * (157.5 * ZZ - 52.5)
            F(NP -  7) = Q * U
            F(NP -  6) = 2.0 * Q * XY
            Q          = 472.5 * ZZ - 52.5
            F(NP -  5) = Q * X * W
            F(NP -  4) = Q * Y * V
            F(NP -  3) = 945.0 * Z * T
            F(NP -  2) = 3780.0 * Z * XY * U
            F(NP -  1) = 945.0 * X * (XX * (XX - 10.0 * YY)
     1                 + 5.0 * YY**2)
            F(NP)      = 945.0 * Y * (XX * (5.0 * XX - 10.0 * YY)
     1                 + YY**2)
            IF (M .GE. 7) THEN
              NP         = NP + 15
              F(NP - 14) = Z * (ZZ * (ZZ * (ZZ * 26.8125 - 43.3125)
     1                   + 19.6875) - 2.1875)
              Q          = ZZ * (ZZ * (ZZ * 187.6875 - 216.5625)
     1                   + 59.0625) - 2.1875
              F(NP - 13) = X * Q
              F(NP - 12) = Y * Q
              Q          = Z * (ZZ * (ZZ * 1126.125 - 866.25)
     1                   + 118.125)
              F(NP - 11) = Q * U
              F(NP - 10) = 2.0 * XY * Q
              Q          = ZZ * (ZZ * 5630.625 - 2598.75) + 118.125
              F(NP -  9) = Q * X * W
              F(NP -  8) = Q * Y * V
              Q          = Z * (22522.5 * ZZ - 5197.5)
              F(NP -  7) = Q * T
              F(NP -  6) = 4.0 * Q * XY * U
              Q          = 67567.5 * ZZ - 5197.5
              F(NP -  5) = Q * X * (XX * (XX - 10.0 *YY) + 5.0 * YY**2)
              F(NP -  4) = Q * Y * (XX * (5.0 * XX -10.0 * YY) + YY**2)
              F(NP -  3) = 135135.0 * Z * (XX * (XX * (XX - 15.0 * YY)
     1                   + 15.0 * YY**2) - YY**3)
              F(NP -  2) = 810810.0 * Z * XY * (XX * (XX
     1                   - 3.333333 * YY)
     1               + YY**2)
              F(NP -  1) = 135135.0 * X * (XX * (XX * (XX - 21.0 * YY)
     1                   + 35.0 * YY**2) - 7.0 * YY**3)
              F(NP)      = 135135.0 * Y * (XX * (XX * (7.0 * XX
     1                   - 35.0 * YY) + 21.0 * YY**2) - YY**3)
            END IF
          END IF
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN109
      SUBROUTINE GEN110 (NP, NN, C, B)
      DOUBLE PRECISION C(NP), B(NN), DT
      M = 0
      I = 0
      DO N = 1, NP
        I = I + 1
        L = I
        M = 1
        J = 1
  10    IF (J .NE. I) THEN
          B(I) = B(I) * B(J)
          C(N) = C(N) - B(I) * C(M)
          M    = M + 1
          NI   = I
          I    = I + 1
          J    = J + 1
          DT   = B(I)
          DO K = L, NI
            DT = DT - B(J) * B(K)
            J  = J  + 1
          END DO
          B(I) = DT
          GO TO 10
        END IF
        B(I) = 1.0 / DSQRT(B(I))
        C(N) = C(N) * B(I)
      END DO
      DT   = C(M)
  20  C(M) = DT * B(I)
      I    = I - M
      M    = M - 1
      IF (M .LT. 1) GO TO 30
      DT   = C(M)
      K    = I + M
      DO N = M + 1, NP
        DT = DT - C(N) * B(K)
        K  = K  + N
      END DO
      GO TO 20
  30  RETURN
      END SUBROUTINE GEN110
      SUBROUTINE GEN111 (A, B, N, M)
      CHARACTER A*(*), B*2
      B = ' '
      M = 0
      L = 0
      DO 10 J = 1, N
        DO K = 48, 122
          IF (A(J:J) .EQ. CHAR(K)) THEN
            IF (K .LT. 58) THEN
              M = M * 10 + K - 48
              GO TO 10
            ELSE IF (K .GT. 64) THEN
              IF (L .LT. 2) THEN
                IF (K .GT. 96) THEN
                  KMOVE = 32
                ELSE
                  KMOVE = 0
                END IF
                L = L + 1
                B(L:L) = CHAR(K - KMOVE)
              END IF
            END IF
          END IF
        END DO
  10  CONTINUE
      RETURN
      END SUBROUTINE GEN111
      SUBROUTINE GEN112 (A, B, MODE)
      DIMENSION A(3, 3), B(*)
      IF (MODE .GT. 0) THEN
        A(1, 1) = B(1)
        A(1, 2) = B(2)
        A(1, 3) = B(3)
        A(2, 1) = B(4)
        A(2, 2) = B(5)
        A(2, 3) = B(6)
        A(3, 1) = B(7)
        A(3, 2) = B(8)
        A(3, 3) = B(9)
      ELSE
        B(1) = A(1, 1)
        B(2) = A(1, 2)
        B(3) = A(1, 3)
        B(4) = A(2, 1)
        B(5) = A(2, 2)
        B(6) = A(2, 3)
        B(7) = A(3, 1)
        B(8) = A(3, 2)
        B(9) = A(3, 3)
      END IF
      RETURN
      END SUBROUTINE GEN112
      SUBROUTINE GEN113 (A, B, N)
      DIMENSION A(*), B(*)
      DO I = 1, N
        B(I) = A(I)
      END DO
      RETURN
      END SUBROUTINE GEN113
      SUBROUTINE GEN114 (PAR, OR, UIJ, UIL, DUMA, RIK, UEQ)
      DIMENSION PAR(*), OR(3, 3), ROR(3, 3), UIJ(3, 3), DUMA(6),
     1 RIK(3, 3), RLJ(3, 3), UKL(3, 3), UIL(3, 3)
      CALL GEN003 (OR, ROR, DET, 0)
      DO K = 1, 3
        DO L = 1, 3
          RLJ(K, L) = 0.0
          IF (K .EQ. L) RLJ(K, K) = PAR(112 + K)
        END DO
      END DO
      CALL GEN004 (OR, RLJ, UKL)
      CALL GEN001 (1, UKL, UIJ, UIL)
      CALL GEN024 (UIL, RIK, DUMA, RLJ)
      CALL GEN018 (DUMA(1), DUMA(3))
      CALL GEN018 (RLJ(1, 1), RLJ(1, 3))
      CALL GEN018 (RLJ(2, 1), RLJ(2, 3))
      CALL GEN018 (RLJ(3, 1), RLJ(3, 3))
      CALL GEN004 (ROR, RLJ, RIK)
      DO J = 1, 3
        SUM = SQRT(RIK(1, J)**2 + RIK(2, J)**2 + RIK(3, J)**2)
        RIK(1, J) = RIK(1, J) / SUM
        RIK(2, J) = RIK(2, J) / SUM
        RIK(3, J) = RIK(3, J) / SUM
      END DO
      UEQ = (DUMA(1) + DUMA(2) + DUMA(3)) / 3.0
      RETURN
      END SUBROUTINE GEN114
      SUBROUTINE GEN115 (X, W, N)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL X(*), W(*)
      M  = (N + 1) / 2
      XM = 0.5D0
      XL = 0.5D0
      DO I = 1, M
        Z = COS(3.141592654D0 * (I - 0.25D0) / (N + 0.5D0))
   10   CONTINUE
        P1 = 1.D0
        P2 = 0.D0
        DO J = 1, N
          P3 = P2
          P2 = P1
          P1 = ((2.0D0 * J - 1.0D0) * Z * P2 - (J - 1.0D0) * P3) / J
        END DO
        PP = N * (Z * P1 - P2) / (Z * Z - 1.0D0)
        Z1 = Z
        Z  = Z1 - P1 / PP
        IF (ABS(Z - Z1) .GT. 3.0D-14) GO TO 10
        X(I)         = REAL(XM - XL * Z)
        X(N + 1 - I) = REAL(XM + XL * Z)
        W(I)         = REAL(2.D0 * XL / ((1.0D0 - Z * Z) * PP * PP))
        W(N + 1 - I) = W(I)
      END DO
      RETURN
      END SUBROUTINE GEN115
      SUBROUTINE GEN116 (MODE, Y, W, N, GRAPH, LU)
C * MODE = 1: SUBROUTINE GENERATES A HALFNORMAL PROBABILITY PLOT.
C * MODE = 2: SUBROUTINE GENERATES A NORMAL (GAUSSIAN) PROBABILITY PLOT
      DIMENSION Y(*), W(*)
      CHARACTER GRAPH(44)*125
      CALL GEN035 (Y, 1, N)
      CALL GEN117 (N, W)
      DO I = 1, N
        Q = W(I)
        IF (MODE .EQ. 1) Q = (Q + 1.0) / 2.0
        CALL GEN118 (Q, W(I))
      END DO
      CALL GEN119 (MODE, Y, W, N)
      CALL GEN120 (MODE, Y, W, N, GRAPH, LU)
      RETURN
      END SUBROUTINE GEN116
      SUBROUTINE GEN117 (N, X)
      DIMENSION X(*)
      X(N) = 0.5 ** (1.0 / FLOAT(N))
      X(1) = 1.0 - X(N)
      IF (N .GT. 2) THEN
        DO I = 2, N - 1
          X(I) = (FLOAT(I) - 0.3175) / (FLOAT(N) + 0.365)
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN117
      SUBROUTINE GEN118 (P, PPF)
      DATA P0, P1, P2, P3, P4, Q0, Q1, Q2, Q3, Q4/
     1 -0.322232431088, -1.0, -0.342242088547, -0.204231210245E-1,
     2 -0.453642210148E-4,  0.993484626060E-1, 0.588581570495,
     C  0.531103462366, 0.103537752850, 0.38560700634E-2/
      IF (P .EQ. 0.5) THEN
        PPF = 0.0
      ELSE
        R = P
        IF (P .GT. 0.5) R = 1.0 - R
        T = SQRT (-2.0 * ALOG(R))
        ANUM = ((((T * P4 + P3) * T + P2) * T + P1) * T + P0)
        ADEN = ((((T * Q4 + Q3) * T + Q2) * T + Q1) * T + Q0)
        PPF  = T + (ANUM / ADEN)
        IF (P .LT. 0.5) PPF = - PPF
      END IF
      RETURN
      END SUBROUTINE GEN118
      SUBROUTINE GEN119 (MODE, Y, X, N)
      COMMON /NPPLOT/ YCC, YINT, YSLOPE
      DIMENSION Y(*), X(*)
      SUM1 = 0.0
      SUM2 = 0.0
      WBAR = 0.0
      DO I = 1, N
        SUM1 = SUM1 + Y(I)
        IF (MODE .EQ. 1) SUM2 = SUM2 + X(I)
      END DO
      YBAR = SUM1 / FLOAT(N)
      IF (MODE .EQ. 1) WBAR = SUM2 / FLOAT(N)
      SUM1 = 0.0
      SUM2 = 0.0
      SUM3 = 0.0
      DO I = 1, N
        IF (MODE .EQ. 1) THEN
          SUM1 = SUM1 + (Y(I) - YBAR) * (Y(I) - YBAR)
          SUM2 = SUM2 + (Y(I) - YBAR) * (X(I) - WBAR)
          SUM3 = SUM3 + (X(I) - WBAR) * (X(I) - WBAR)
        ELSE IF (MODE .EQ. 2) THEN
          SUM1 = SUM1 + (Y(I) - YBAR) * (Y(I) - YBAR)
          SUM2 = SUM2 + X(I) * Y(I)
          SUM3 = SUM3 + X(I) * X(I)
        END IF
      END DO
      IF (SUM1 .NE. 0.0) THEN
        YCC = SUM2 / SQRT(SUM3 * SUM1)
      ELSE
        YCC = 1.0
      END IF
      YSLOPE = SUM2 / SUM3
      YINT   = YBAR - YSLOPE * WBAR
      RETURN
      END SUBROUTINE GEN119
      SUBROUTINE GEN120 (MODE, Y, X, N, GRAPH, LU)
      COMMON /NPPLOT/ YCC, YINT, YSLOPE
      CHARACTER GRAPH(44)*125
      DIMENSION X(*), Y(*)
      DIMENSION YLABLE(11)
      YMIN = Y(1)
      YMAX = Y(N)
      YMAX = MAX ( 3.5, YMAX)
      YMIN = MIN (-3.5, YMIN)
      IF (MODE .EQ. 1) YMIN = 0.0
      DO I = 1, 9
        AIM1 = I - 1
        YLABLE(I) = YMAX - (AIM1 / 8.0) * (YMAX - YMIN)
      END DO
      XMIN = X(1)
      XMAX = X(N)
      XMID = (XMIN + XMAX) / 2.0
      X25  = 0.75 * XMIN + 0.25 * XMAX
      X75  = 0.25 * XMIN + 0.75 * XMAX
      DO I = 1, 44
        GRAPH(I) = ' '
      END DO
      DO I = 2, 42
        GRAPH(I)(20:20)   = 'I'
        GRAPH(I)(124:124) = 'I'
      END DO
      DO I = 2, 42, 5
        GRAPH(I)(20:20)   = '-'
        GRAPH(I)(124:124) = '-'
      END DO
      GRAPH(2)(16:19)   = '=Max'
      GRAPH(22)(16:19)  = '=Mid'
      GRAPH(42)(16:19)  = '=Min'
      GRAPH(42)(64:120) =
     1 'Vertical: Experimental Data, Horizontal: Theoretical Data'
      IF (MODE .EQ. 1) THEN
        GRAPH(3)(22:49) = 'Half-Normal Probability Plot'
      ELSE IF (MODE .EQ. 2) THEN
        GRAPH(3)(22:44) = 'Normal Probability Plot'
      ELSE IF (MODE .EQ. 3) THEN
        GRAPH(3)(22:47) = 'Student-t Probability Plot'
      END IF
      GRAPH(3)(51:111) =
     1 '(S.C.Abrahams and E.T.Keve (1971). Acta Cryst. A27, 157-165.)'
      WRITE (GRAPH(5)(22:47), 99996, IOSTAT = IOST) N
      WRITE (GRAPH(6)(22:47), 99995, IOSTAT = IOST) YCC
      WRITE (GRAPH(7)(22:47), 99994, IOSTAT = IOST) YINT
      WRITE (GRAPH(8)(22:47), 99993, IOSTAT = IOST) YSLOPE
      DO J = 22, 122
        GRAPH(1)(J:J)  = '-'
        GRAPH(43)(J:J) = '-'
      END DO
      DO J = 22, 122, 25
        GRAPH(1)(J:J)  = 'I'
        GRAPH(43)(J:J) = 'I'
      END DO
      DO J = 35, 122, 25
        GRAPH(1)(J:J)  = 'I'
        GRAPH(43)(J:J) = 'I'
      END DO
      RATIOY =  40.0 / (YMAX - YMIN)
      RATIOX = 100.0 / (XMAX - XMIN)
      DO I = 1, N
        MX = NINT(RATIOX * (X(I) - XMIN))
        MX = MX + 22
        MY = NINT(RATIOY * (Y(I) - YMIN))
        MY = 42 - MY
        GRAPH(MY)(MX:MX) = 'x'
      END DO
      DO I = 1, 44
        IF (I .EQ. 44) THEN
          WRITE (GRAPH(44), 99997, IOSTAT = IOST)
     1      XMIN, X25, XMID, X75, XMAX
        ELSE
          IM2   = I - 2
          IFLAG = IM2 - (IM2 / 5) * 5
          K     = IM2 / 5 + 1
          IF (IFLAG .EQ. 0)
     1      WRITE (GRAPH(I)(1:15), 99998, IOSTAT = IOST) YLABLE(K)
        END IF
        IF (LU .NE. 0) WRITE (LU, 99999, IOSTAT = IOST) GRAPH(I)
      END DO
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (A)
99998 FORMAT (F15.3)
99997 FORMAT (5(9X, F16.3))
99996 FORMAT ('Sample Size    =', I10)
99995 FORMAT ('CC             =', F10.4)
99994 FORMAT ('Est. Intercept =', F10.4)
99993 FORMAT ('Est. Slope     =', F10.4)
      END SUBROUTINE GEN120
      SUBROUTINE GEN121 (NQ)
      CHARACTER NQ*7, NQ1*9
      NQ1 = NQ
      N1  = INDEX (NQ1, '(')
      N2  = INDEX (NQ1, ')')
      IF (N1 .NE. 0 .AND. N2 .NE. 0) THEN
        NQ = NQ1(1:N1 -1)//NQ1(N1+1:N2-1)//NQ1(N2+1:9)
      END IF
      RETURN
      END SUBROUTINE GEN121
      SUBROUTINE GEN122 (AXES, NS, ITEL)
      DIMENSION AXES(15, 23)
   10 ICHANGE = 0
      DO J = 1, (ITEL - 1)
        IF (AXES(J, NS) .GT. AXES(J + 1, NS)) THEN
          DO I = 1, 13
            CALL GEN018 (AXES(J, I), AXES(J + 1, I))
          END DO
          CALL GEN018 (AXES(J, 23), AXES(J + 1, 23))
          ICHANGE = 1
        END IF
      END DO
      IF (ICHANGE .NE. 0) GO TO 10
      RETURN
      END SUBROUTINE GEN122
      SUBROUTINE GEN123 (MODE, IEN, IENS, IEL, IAN)
      DIMENSION IEN(*), IENS(*), IEL(*)
      DO I = 1, IAN
        IENI = IEN(I)
        IF (MODE .EQ. 1) THEN
          IF (IENI .EQ. 2) THEN
            IVAL = 0
          ELSE IF (IENI .EQ. 1) THEN
            IVAL = 1
          ELSE IF (IENI .EQ. 33) THEN
            IVAL = 2
          ELSE
            IVAL = IEL(IENI)
          END IF
        ELSE
          IVAL = IEL(IENI)
        END IF
        IENS(I) = IVAL * 100 + I
      END DO
      CALL GEN022 (IENS, 1, IAN)
      DO I = 1, IAN
        IENS(I) = MOD(IENS(I), 100)
      END DO
      RETURN
      END SUBROUTINE GEN123
      SUBROUTINE GEN124 (NA, NB, NE)
      DIMENSION NA(*)
      NEL = (NE - NB + 1) / 2
      IF (NEL .LE. 1) GO TO 50
      ND = 2**(INT((ALOG(FLOAT(NEL)) / ALOG(2.0)) + 1.0E-5)) - 1
   10 IF (ND .LE. 0) GO TO 50
      NDS = ND + ND
      I   = NB
   20 J   = I
      NY = NA(I + NDS)
      NZ = NA(I + NDS + 1)
   30 IF (NY .GE. NA(J)) GO TO 40
      NA(J + NDS)     = NA(J)
      NA(J + NDS + 1) = NA(J + 1)
      J = J - NDS
      IF (J .GE. NB) GO TO 30
   40 NA(J + NDS)     = NY
      NA(J + NDS + 1) = NZ
      I = I + 2
      IF (I + NDS .LE. NE) GO TO 20
      ND = (ND - 1) / 2
      GO TO 10
   50 RETURN
      END SUBROUTINE GEN124
      SUBROUTINE GEN125 (MODE, LO, STR)
      CHARACTER STR*(*)
      IF (MODE .EQ. 0) THEN
        WRITE (LO, 99999, IOSTAT = IOST) STR
      ELSE
        WRITE (LO, 99998, IOSTAT = IOST) STR
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (A, $)
99998 FORMAT (/, A, $)
      END SUBROUTINE GEN125
      SUBROUTINE GEN126 (C, N, M)
      CHARACTER*(*)  C(*)
      DO I = N, M
        C(I) = ' '
      END DO
      RETURN
      END  SUBROUTINE GEN126
      SUBROUTINE GEN127 (C)
      CHARACTER*(*) C
      IF (C(1:1) .NE. ' ') WRITE (6, 99999, IOSTAT = IOST) C
      IF (IOST .NE. 0) CALL EXIT
      CALL EXIT
99999 FORMAT (/, 'STOP: ', A, /)
      END SUBROUTINE GEN127
      FUNCTION GEN128 (NELI, NELJ)
      PARAMETER (N = 17)
      DIMENSION NTAB(2, N), XTAB(N)
      DATA (NTAB(1, I), NTAB(2, I), XTAB(I), I = 1, N) /
     1  10,  10, -9.9,  10,  11, -9.9, 10,  60, -9.9, 11,  11, -9.9,
     2  26,  26, -9.9,  30,  30, -9.9, 54,  85, -9.9, 59,  59, -9.9,
     3  85,  94, -9.9, 103, 103, -9.9, 85, 104, -9.9, 69,  69, -9.9,
     4  10,  99, -9.9,  23,  23, -9.9, 13,  13,  0.2, 39,  39,  0.2,
     5  54,  87, 0.55/
      GEN128 = 0.0
      I      = NELI
      J      = NELJ
      IF (I .GT. J) CALL GEN014 (I, J)
      DO K = 1, N
        IF (NTAB(1, K) .EQ. I .AND. NTAB(2, K) .EQ. J) THEN
          GEN128 = XTAB(K)
          EXIT
        END IF
      END DO
      RETURN
      END FUNCTION GEN128
      SUBROUTINE GEN129 (LU, STRING)
      CHARACTER STRING*(*)
      LOGICAL EXST
      INQUIRE (FILE = STRING, EXIST = EXST)
      IF (EXST) THEN
        OPEN  (LU, FILE = STRING, STATUS = 'UNKNOWN')
        CLOSE (LU, STATUS = 'DELETE')
      END IF
      RETURN
      END SUBROUTINE GEN129
      FUNCTION GEN130 (A)
      DIMENSION A(3, 3)
      GEN130 =
     1        A(1, 1) * (A(2, 2) * A(3, 3) - A(2, 3) * A(3, 2))
     2      - A(1, 2) * (A(2, 1) * A(3, 3) - A(2, 3) * A(3, 1))
     3      + A(1, 3) * (A(2, 1) * A(3, 2) - A(2, 2) * A(3, 1))
      RETURN
      END FUNCTION GEN130
      SUBROUTINE GEN131 (LHNT, I, J, K, L, IDET)
      DIMENSION LHNT(4, 3, 5)
      IDET =  LHNT(I, 1, L)  * (LHNT(J, 2, L)  *  LHNT(K, 3, L)
     1     -  LHNT(K, 2, L)  *  LHNT(J, 3, L)) +  LHNT(I, 2, L)
     2     * (LHNT(J, 3, L)  *  LHNT(K, 1, L)  -  LHNT(J, 1, L)
     3     *  LHNT(K, 3, L)) +  LHNT(I, 3, L)  * (LHNT(J, 1, L)
     4     *  LHNT(K, 2, L)  -  LHNT(J, 2, L)  *  LHNT(K, 1, L))
      IDET = ABS(IDET)
      RETURN
      END SUBROUTINE GEN131
      SUBROUTINE GEN132 (T1, Y, T2, Z)
      DIMENSION T1(3, 3), T2 (3, 3), X(3, 3), Y(3, 3), Z(3, 3)
      CALL GEN004 (Y, T2, X)
      CALL GEN004 (T1, X, Z)
      RETURN
      END SUBROUTINE GEN132
      SUBROUTINE GEN133 (IA, IB, N)
      DIMENSION IA(*), IB(*)
      DO I = 1, N
        IB(I) = IA(I)
      END DO
      RETURN
      END SUBROUTINE GEN133
      SUBROUTINE GEN134 (STR1, STR2, NB, NE)
      CHARACTER ICH*1, STR1*(*), STR2*(*)
      LB = NB
      LE = NE
      CALL GEN039 (0, STR1, NB, NE, LB, LE)
      N = 0
      DO I = LB, LE
        ICH = STR1(I:I)
        CALL GEN105 (1, ICH, M)
        IF (M .GT. 0) THEN
          N = N + 1
        ELSE
          N = 0
        END IF
        IF (N .EQ. 2) THEN
          N = 0
          CALL GEN020 (-1, ICH, 1, 1)
          STR1(I:I) = ICH
        END IF
      END DO
      STR2 = STR1(LB:LE)
      RETURN
      END SUBROUTINE GEN134
      FUNCTION GEN135 (A)
      DIMENSION A(3, 3)
      GEN135 = 0.0
      DO I = 1, 3
        DO J = 1, 3
          IF (I .EQ. J) THEN
            IF (ABS(ABS(A(I, J)) - 1.0) .GT. 0.001) GO TO 10
          ELSE
            IF (ABS(A(I, J)) .GT. 0.001) GO TO 10
          END IF
        END DO
      END DO
      GEN135 = 1.0
   10 RETURN
      END FUNCTION GEN135
      SUBROUTINE GEN136 (X, GA)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION G(26)
      DATA G/
     1 1.0D0, 0.5772156649015329D0, -0.6558780715202538D0,
     2 -0.420026350340952D-1, 0.1665386113822915D0,
     3 -0.421977345555443D-1, -0.96219715278770D-2, 0.72189432466630D-2,
     4 -0.11651675918591D-2, -0.2152416741149D-3, 0.1280502823882D-3,
     5 -0.201348547807D-4, -0.12504934821D-5, 0.11330272320D-5,
     6 -0.2056338417D-6, 0.61160950D-8, 0.50020075D-8, -0.11812746D-8,
     7  0.1043427D-9, 0.77823D-11, -0.36968D-11, 0.51D-12,
     8 -0.206D-13, -0.54D-14, 0.14D-14, 0.1D-15/
      PI = 3.141592653589793D0
      IF (X .EQ. INT(X)) THEN
        IF (X .GT. 0.0D0) THEN
          GA = 1.0D0
          M1 = X - 1
          DO K = 2, M1
            GA = GA * K
          END DO
        ELSE
          GA = 1.0D + 300
        ENDIF
      ELSE
        IF (DABS (X) .GT. 1.0D0) THEN
          Z = DABS (X)
          M = INT (Z)
          R = 1.0D0
          DO K = 1, M
            R = R * (Z - K)
          END DO
          Z = Z - M
        ELSE
          Z = X
        ENDIF
        GR = G(26)
        DO K = 25, 1, -1
          GR = GR * Z + G(K)
        END DO
        GA = 1.0D0 / (GR * Z)
        IF (DABS(X) .GT. 1.0D0) THEN
          GA = GA * R
          IF (X .LT. 0.0D0) GA = - PI / (X * GA * DSIN (PI * X))
        ENDIF
      ENDIF
      RETURN
      END SUBROUTINE GEN136
      SUBROUTINE GEN137 (X, PS)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      XA = DABS(X)
      PI = 3.141592653589793D0
      EL = 0.5772156649015329D0
      S = 0.0D0
      IF (X .EQ. INT (X) .AND. X .LE. 0.0D+0) THEN
        PS = 1.0D + 300
        RETURN
      ELSE IF (XA .EQ. INT (XA)) THEN
        N = XA
        DO K = 1, N - 1
          S = S + 1.0D0 / K
        END DO
        PS = - EL + S
      ELSE IF (XA + 0.5D+0 .EQ. INT (XA + 0.5D+0)) THEN
        N = INT(XA - 0.5D+0)
        DO  K = 1, N
          S = S + 1.0D+0 / (2.0D0 * K - 1.0D0)
        END DO
        PS = - EL + 2.0D0 * S - 1.386294361119891D0
      ELSE
        IF (XA .LT. 10.0D+0) THEN
          N = 10 - INT (XA)
          DO K = 0, N - 1
            S = S + 1.0D0 / (XA + K)
          END DO
          XA = XA + N
        END IF
        X2 = 1.0D0 / (XA * XA)
        A1 = -0.8333333333333D-01
        A2 = 0.83333333333333333D-02
        A3 = -0.39682539682539683D-02
        A4 = 0.41666666666666667D-02
        A5 = -0.75757575757575758D-02
        A6 = 0.21092796092796093D-01
        A7 = -0.83333333333333333D-01
        A8 = 0.4432598039215686D0
        PS = DLOG (XA) - 0.5D0 / XA + X2 * (((((((A8 * X2 + A7) * X2 +
     1        A6) * X2 + A5) * X2 + A4) * X2 + A3) * X2 + A2) * X2 + A1)
        PS = PS - S
      END IF
      IF (X .LT. 0.0D+0)
     1    PS = PS - PI * DCOS (PI * X) / DSIN (PI * X) - 1.0D0 / X
      RETURN
      END SUBROUTINE GEN137
      SUBROUTINE GEN138 (A, B, C, X, HF)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      LOGICAL L0, L1, L2, L3, L4, L5
      HW = 0.0D+0
      PI = 3.141592653589793D0
      EL = 0.5772156649015329D0
      L0 = C .EQ. INT(C) .AND. C .LT. 0.0D+0
      L1 = 1.0D0 - X .LT. 1.0D-15 .AND. C - A - B .LE. 0.0D+0
      L2 = A .EQ. INT (A) .AND. A .LT. 0.0D+0
      L3 = B .EQ. INT (B) .AND. B .LT. 0.0D+0
      L4 = C - A .EQ. INT (C - A) .AND. C - A .LE .0.0D+0
      L5 = C - B .EQ. INT (C - B) .AND. C - B .LE. 0.0D+0
      IF (L0 .OR. L1) THEN
        WRITE (*, 99999, IOSTAT = IOST)
        RETURN
      END IF
      EPS = 1.0D-15
      IF (X .GT. 0.95D+0) EPS = 1.0D-8
      IF (X .EQ. 0.0D+0 .OR. A .EQ. 0.0D+0 .OR. B .EQ. 0.0D+0) THEN
        HF = 1.0D0
        RETURN
      ELSE IF (1.0D0 - X .EQ. EPS .AND. C - A - B .GT. 0.0D+0) THEN
        CALL GEN136 (C, GC)
        CALL GEN136 (C - A -B, GCAB)
        CALL GEN136 (C - A, GCA)
        CALL GEN136 (C - B, GCB)
        HF= GC * GCAB / (GCA * GCB)
        RETURN
      ELSE IF (1.0D0 + X .LE. EPS .AND.
     1         DABS (C - A + B - 1.0D+0) .LE. EPS) THEN
        G0 = DSQRT (PI) * 2.0D0 ** (-A)
        CALL GEN136 (C, G1)
        CALL GEN136 (1.0D0 + A / 2.0D+0 - B, G2)
        CALL GEN136 (0.5D0 + 0.5D+0 * A, G3)
        HF = G0 * G1 / (G2 * G3)
        RETURN
      ELSE IF (L2 .OR. L3) THEN
        IF (L2) NM = INT (ABS (A))
        IF (L3) NM = INT (ABS (B))
        HF = 1.0D0
        R  = 1.0D0
        DO K = 1, NM
          R = R * (A + K - 1.0D0) * (B + K - 1.0D0) /
     1        (K * (C + K -1.0D0)) * X
          HF = HF + R
        END DO
        RETURN
      ELSE IF (L4 .OR. L5) THEN
        IF (L4) NM = INT (ABS (C - A))
        IF (L5) NM = INT (ABS (C - B))
        HF = 1.0D0
        R  = 1.0D0
        DO K = 1, NM
          R = R * (C - A + K - 1.0D0) * (C - B + K - 1.0D0) /
     1       (K * (C + K - 1.0D0)) * X
          HF = HF + R
        END DO
        HF = (1.0D0 - X) ** (C - A - B ) * HF
        RETURN
      END IF
      AA = A
      BB = B
      X1 = X
      IF (X .LT. 0.0D0) THEN
        X = X / (X - 1.0D0)
        IF (C .GT. A .AND. B .LT. A .AND. B .GT. 0.0) THEN
          A = BB
          B = AA
        END IF
        B = C - B
      END IF
      IF (X .GE. 0.75D0) THEN
        GM = 0.0D0
        IF (DABS (C - A - B - INT (C - A - B)) .LT. 1.0D-15) THEN
          M = INT (C - A - B)
          CALL GEN136 (A, GA)
          CALL GEN136 (B, GB)
          CALL GEN136 (C, GC)
          CALL GEN136 (A + M, GAM)
          CALL GEN136 (B + M, GBM)
          CALL GEN137 (A, PA)
          CALL GEN137 (B, PB)
          IF (M .NE. 0) GM = 1.0D0
          DO J = 1, ABS (M) - 1
            GM = GM * J
          END DO
          RM = 1.0D0
          DO J = 1, ABS (M)
            RM = RM * J
          END DO
          F0  = 1.0D0
          R0  = 1.0D0
          R1  = 1.0D0
          SP0 = 0.D0
          SP  = 0.0D0
          IF (M .GE. 0) THEN
            C0 = GM * GC / (GAM * GBM)
            C1 = - GC * (X - 1.0D0) ** M / (GA * GB * RM)
            DO K = 1, M - 1
              R0 = R0 * (A + K - 1.0D0) * (B + K - 1.0) /
     1             (K * (K - M)) * (1.0 - X)
              F0 = F0 + R0
            END DO
            DO K = 1, M
              SP0 = SP0 + 1.0D0 / (A + K - 1.0) + 1.0 /
     1             (B + K - 1.0) - 1.0 / K
            END DO
            F1 = PA + PB + SP0 + 2.0D0 * EL + DLOG (1.0D0 - X)
            DO K = 1, 250
              SP = SP + (1.0D0 - A) / (K * (A + K - 1.0)) +
     1            (1.0 - B) / (K * (B + K - 1.0))
              SM = 0.0D0
              DO J = 1, M
                SM = SM + (1.0D0 - A) / ((J + K) * (A + J + K - 1.0)) +
     1               1.0 / (B + J + K - 1.0)
              END DO
              RP = PA + PB + 2.0D0 * EL + SP + SM + DLOG (1.0D0 - X)
              R1 = R1 * (A + M + K - 1.0D0) * (B + M + K - 1.0) /
     1             (K * (M + K)) * (1.0 - X)
              F1 = F1 + R1 * RP
              IF (DABS (F1 - HW) .LT. DABS (F1) * EPS) EXIT
              HW = F1
            END DO
            HF = F0 * C0 + F1 * C1
          ELSE IF (M .LT. 0) THEN
            M = - M
            C0 = GM * GC / (GA * GB * (1.0D0 - X)**M)
            C1 = - (-1) ** M * GC / (GAM * GBM * RM)
            DO K = 1, M - 1
              R0 = R0 * (A - M + K - 1.0D0) * (B - M + K - 1.0) /
     1             (K * (K - M)) * (1.0 - X)
              F0 = F0 + R0
            END DO
            DO K = 1, M
              SP0 = SP0 + 1.0D0 / K
            END DO
            F1 = PA + PB - SP0 + 2.0D0 * EL + DLOG (1.0D0 - X)
            DO K = 1, 250
              SP = SP + (1.0D0 - A) / (K * (A + K - 1.0)) +
     1             (1.0 - B) / (K * (B + K - 1.0))
              SM = 0.0D0
              DO J = 1, M
                SM = SM + 1.0D0 / (J + K)
              END DO
              RP = PA + PB + 2.0D0 * EL + SP - SM + DLOG (1.0D0 - X)
              R1 = R1 * (A + K - 1.0D0) * (B + K - 1.0) /
     1            (K * (M + K)) * (1.0 - X)
              F1 = F1 + R1 * RP
              IF (DABS (F1 - HW) .LT. DABS (F1) * EPS) EXIT
              HW = F1
            END DO
            HF = F0 * C0 + F1 * C1
          END IF
        ELSE
          CALL GEN136 (A, GA)
          CALL GEN136 (B, GB)
          CALL GEN136 (C, GC)
          CALL GEN136 (C - A, GCA)
          CALL GEN136 (C - B, GCB)
          CALL GEN136 (C - A - B, GCAB)
          CALL GEN136 (A + B - C, GABC)
          C0 = GC * GCAB / (GCA * GCB)
          C1 = GC * GABC / (GA * GB) * (1.0D0 - X) ** (C - A - B)
          HF = 0.0D0
          R0 = C0
          R1 = C1
          DO K = 1, 250
            R0 = R0 * (A + K - 1.0D0) * (B + K - 1.0) /
     1           (K * (A + B - C + K)) * (1.0 - X)
            R1 = R1 * (C - A + K - 1.0D0) * (C - B + K - 1.0) /
     1          (K * (C - A - B + K)) * (1.0 - X)
            HF = HF + R0 + R1
            IF (DABS (HF - HW) .LT. DABS (HF) * EPS) EXIT
            HW = HF
          END DO
          HF = HF + C0 + C1
        END IF
      ELSE
        A0 = 1.0D0
        IF (C .GT. A .AND. C .LT. 2.0D0 * A .AND.
     1    C .GT. B .AND. C .LT. 2.0D0 * B) THEN
          A0 = (1.0D0 - X) ** (C - A - B)
          A = C - A
          B = C - B
        END IF
        HF = 1.0D0
        R  = 1.0D0
        DO K = 1, 250
          R = R * (A + K - 1.0D0) * (B + K - 1.0D0) /
     1       (K * (C + K - 1.0D0)) * X
          HF = HF + R
          IF (DABS (HF - HW) .LE. DABS (HF) * EPS) EXIT
          HW = HF
        END DO
        HF = A0 * HF
      END IF
      IF (X1 .LT. 0.0D0) THEN
        X  = X1
        C0 = 1.0D0 / (1.0D0 - X) ** AA
        HF = C0 * HF
      END IF
      A = AA
      B = BB
      IF (K .GT. 120) WRITE (*, 99998, IOSTAT = IOST)
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT ('The hypergeometric series is divergent')
99998 FORMAT ('Warning! check the accuracy')
      END SUBROUTINE GEN138
      SUBROUTINE GEN139 (X, XNU, CDFT)
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      PI = 3.141592653589793D0
      A  = 0.5D+0
      B  = (XNU + 1) / 2
      C  = 1.5D+0
      D  = - X**2 / XNU
      E  = 0.0D+0
      CALL GEN138 (A, B, C, D, E)
      A  = (XNU + 1) / 2
      F  = 0.0D+0
      CALL GEN136 (A, F)
      A  = XNU / 2
      G  = 0.0D+0
      CALL GEN136 (A, G)
      CDFT = 0.5D+0 + X * F * E / (SQRT (PI * XNU) * G)
      RETURN
      END SUBROUTINE GEN139
      SUBROUTINE GEN140 (X, XNU, CDFTINV)
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      IF (X .LT. 0.0D+0 .OR. X .GE. 1.0D+0) THEN
        WRITE (*, 99999, IOSTAT = IOST)
        RETURN
      END IF
      IF (X .LT. 0.5D+0) THEN
        XHIGH =  0.0D+0
        XLOW  = -1.0D+0
        DO WHILE (.TRUE.)
          CALL GEN139 (XLOW, XNU, A)
          IF (A .LE. X) EXIT
          XHIGH = XLOW
          XLOW  = XLOW * 2.0D+0
        END DO
      ELSE
        XLOW  = 0.0D+0
        XHIGH = 1.0D+0
        DO WHILE (.TRUE.)
          CALL GEN139 (XHIGH, XNU, A)
          IF (A .GE. X) EXIT
          XLOW  = XHIGH
          XHIGH = XHIGH * 2.0D+0
        END DO
      END IF
      DO WHILE (XHIGH - XLOW .GT. 1D-6)
        XMID = (XHIGH + XLOW) / 2.0D+0
        CALL GEN139 (XMID, XNU, A)
        IF (A .LT. X) THEN
          XLOW = XMID
        ELSE
          XHIGH = XMID
        END IF
        CDFTINV = (XHIGH + XLOW) / 2.0D+0
      END DO
      RETURN
99999 FORMAT ('Argument outside 0 to 1 range')
      END SUBROUTINE GEN140
      SUBROUTINE GEN141 (W, RNU, N)
      DOUBLE PRECISION X, XNU, Y
      DIMENSION W(*)
      XNU = RNU
      DO I = 1, N
        X  = (FLOAT (I) - 0.5) / FLOAT(N)
        CALL GEN140 (X, XNU, Y)
        W(I) =  SNGL(Y)
      END DO
      END
      SUBROUTINE GEN142 (Y, W, RNU, N, GRAPH, LU)
      DIMENSION Y(*), W(*)
      CHARACTER GRAPH(44)*125
      M = 5
      CALL GEN035 (Y, 1, N)
      J = 0
      DO I = M + 1, N - M
        J = J + 1
        Y(J) = Y(I)
      END DO
      N = N - 2 * M
      CALL GEN143 (Y, W, N, RNU)
      CALL GEN141 (W, RNU, N)
      CALL GEN119 (2, Y, W, N)
      CALL GEN120 (3, Y, W, N, GRAPH, LU)
      RETURN
      END SUBROUTINE GEN142
      SUBROUTINE GEN143 (Y, W, N, RNU)
      PARAMETER (R = 0.61803399, C = 1.0 - R)
      COMMON /NPPLOT/ YCC, YINT, YSLOPE
      DIMENSION Y(*), W(*)
      IF (RNU .EQ. 0.0) THEN
        TOL = 0.0005
        AX  = 2.0
        BX  = 99.0
        CX  = 100.0
        X0  = AX
        X3  = CX
        IF (ABS(CX - BX) .GT. ABS(BX - AX)) THEN
          X1 = BX
          X2 = BX + C * (CX - BX)
        ELSE
          X2 = BX
          X1 = BX - C * (BX - AX)
        END IF
        CALL GEN141 (W, X1, N)
        CALL GEN119 (2, Y, W, N)
        F1 = 1.0 - YCC
        CALL GEN141 (W, X2, N)
        CALL GEN119 (2, Y, W, N)
        F2 = 1.0 - YCC
        DO WHILE (ABS(X3 - X0) .GT. TOL * (ABS(X1) + ABS(X2)))
          IF (F2 .LT. F1) THEN
            X0 = X1
            X1 = X2
            X2 = R * X1 + C * X3
            F1 = F2
            CALL GEN141 (W, X2, N)
            CALL GEN119 (2, Y, W, N)
            F2 = 1.0 - YCC
          ELSE
            X3 = X2
            X2 = X1
            X1 = R * X2 + C * X0
            F2 = F1
            CALL GEN141 (W, X1, N)
            CALL GEN119 (2, Y, W, N)
            F1 = 1.0 - YCC
          END IF
        END DO
        IF  (F1 .LT. F2) THEN
          RNU = X1
        ELSE
          RNU = X2
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN143
      SUBROUTINE GEN144 (MODE, A, B)
      DIMENSION A(6), B(3)
      IF (MODE .EQ. 1) THEN
        A(1) = A(1) * B(1)**2
        A(2) = A(2) * B(2)**2
        A(3) = A(3) * B(3)**2
        A(4) = A(4) * B(2) * B(3)
        A(5) = A(5) * B(1) * B(3)
        A(6) = A(6) * B(1) * B(2)
      ELSE
        A(1) = A(1) / B(1)**2
        A(2) = A(2) / B(2)**2
        A(3) = A(3) / B(3)**2
        A(4) = A(4) / (B(2) * B(3))
        A(5) = A(5) / (B(1) * B(3))
        A(6) = A(6) / (B(1) * B(2))
      ENDIF
      RETURN
      END SUBROUTINE GEN144
      SUBROUTINE GEN145 (IH, IK, IL)
      IF (IL .LT. 0) THEN
        IH = - IH
        IK = - IK
        IL = - IL
      ELSE IF (IL .EQ. 0) THEN
        IF (IK .LT. 0) THEN
          IK = - IK
          IH = - IH
        ELSE IF (IK .EQ. 0) THEN
          IH = IABS(IH)
        END IF
      END IF
      RETURN
      END SUBROUTINE GEN145
      SUBROUTINE GEN146 (FORM, X, IX, N)
      CHARACTER FORM*10, FORMA*17
      FORMA = '(F7.0,''('',I1,'')'')'
      IF (IX .GE. 10) THEN
        FORMA(3:3)   = CHAR(54)
        FORMA(12:12) = CHAR(50)
      END IF
      FORMA(5:5) = CHAR(N + 48)
      WRITE (FORM, FORMA, IOSTAT = IOST) X, IX
      IF (IOST .NE. 0) RETURN
      RETURN
      END SUBROUTINE GEN146
      SUBROUTINE GEN147 (IA, N, JL, JU)
      DIMENSION IA(N, *), IB(N)
      JV = JU - JL + 1
      IF (JV .GT. 1) THEN
        ND = 2**(INT((ALOG(FLOAT(JV)) / ALOG(2.0)) + 1.0E-5)) - 1
        DO
          IF (ND .LE. 0) EXIT
          I  = JL
          DO
            J  = I
            DO K = 1, N
              IB(K) = IA(K, I + ND)
            END DO
   10       IF (IB(1) .LT. IA(1, J)) THEN
              DO K = 1, N
                IA(K, J + ND) = IA(K, J)
              END DO
              J = J - ND
              IF (J .GE. JL) GO TO 10
            END IF
            DO K = 1, N
              IA(K, J + ND) = IB(K)
            END DO
            I = I + 1
            IF (I + ND .GT. JU) EXIT
          END DO
          ND = (ND - 1) / 2
        END DO
      END IF
      RETURN
      END SUBROUTINE GEN147
      SUBROUTINE GEN148 (LU, IOPER)
      IF (IOPER .EQ. 1) THEN
        WRITE (6, 99999) LU
      END IF
      RETURN
99999 FORMAT ('** Problem with REWIND on UNIT', I4)
      END SUBROUTINE GEN148
      DOUBLE PRECISION FUNCTION GEN149 (XP, N, X, Y)
C * Aitken repeated interpolation
C * XP = abscissa at which interpolation is desired
C * X  = vector of n values of abscissa
C * Y  = vector of n values of ordinate
C * T  = temporary storage vector of 4*(m+1) locations)
      DOUBLE PRECISION T(20), XP, X(N), Y(N), SGN
      INDEX = 0
      IF (N .LE. 2) THEN
        WRITE (*, 99999, IOSTAT = IOST)
        GEN149 = Y(1)
      ELSE
        SGN = SIGN (1.0D0, X(1) - X(2))
        I = 1
        DO WHILE (SGN * X(I) .GT. SGN * XP .AND. I .LE. N)
          INDEX = I
          I     = I + 1
        END DO
        INDEX = INDEX - 1
        INDEX = MAX0 (INDEX, 1)
        INDEX = MIN0 (INDEX, N - 2)
        MEND  = INDEX + 2
        DO I = INDEX, MEND
          K        = I - INDEX + 1
          T(K)     = Y(I)
          T(K + 3) = X(I) - XP
        END DO
        DO I = 1, 2
          K = I + 1
          DO J = K, 3
            T(J) = (T(I) * T(J + 3) - T(J) * T(I + 3)) /
     1       (X(J + INDEX - 1) - X(I + INDEX - 1))
          END DO
        END DO
        GEN149 = T(3)
      END IF
      IF (IOST .NE. 0) RETURN
      RETURN
99999 FORMAT (' Too few points, funct=y(1)')
      END FUNCTION GEN149
      SUBROUTINE GEN150 (N, A, B)
      DOUBLE PRECISION X, Y, A(*), B(*)
      DO I = 1, N - 1
        DO J = I + 1, N
          IF (A(J) .LT. A(I)) THEN
            X    = A(J)
            Y    = A(I)
            A(I) = X
            A(J) = Y
            X    = B(J)
            Y    = B(I)
            B(I) = X
            B(J) = Y
          END IF
        END DO
      END DO
      RETURN
      END SUBROUTINE GEN150
      SUBROUTINE GEN151 (A, N)
      CHARACTER A*(*)
      L = LEN(A)
      DO I = N, L
C * SUBSTITUTE FORWARD SLASH FOR A BACKWARD SLASH
        IF (A(I:I) .EQ. CHAR(92)) A(I:I) = CHAR(47)
C * CHECK FOR HASH CHARACTER AND BLANK COMMENT
        IF (A(I:I) .EQ. CHAR(35)) THEN
          DO J = I, L
            A(J:J) = CHAR(32)
          END DO
          RETURN
        END IF
C * SUBSTITUTE BLANK FOR CARRIAGE RETURN CHARACTER
        IF (A(I:I) .EQ. CHAR(13)) A(I:I) = CHAR(32)
      END DO
      RETURN
      END SUBROUTINE GEN151
      INTEGER FUNCTION FINDEXE (EXE, PAD, PROGRAM)
      COMMON /MSWDS/ DOS
      CHARACTER EXE*(*), PAD*(*), PROGRAM*(*)
      CHARACTER P*1024, FILE*256
      CHARACTER COMPONENT*80
      CHARACTER DELIM1*1, DELIM2*1, SUFFIX*4
      INTEGER I1, I2, L, LC
      LOGICAL E, DOS
      IF (DOS) THEN
        DELIM1 = CHAR (92)
        DELIM2 = CHAR (59)
        SUFFIX = '.exe'
      ELSE
        DELIM1 = CHAR (47)
        DELIM2 = CHAR (58)
        SUFFIX = ' '
      END IF
C * FIND OUT WHETHER 'PROGRAM' IS AVAILABLE
      L  = LEN (PROGRAM)
      LP = LEN (PAD)
      IS = 0
      NB = 1
      CALL GETENV (EXE, PAD)
      IF (PAD(1:1) .NE. ' ') THEN
        INQUIRE (FILE = PAD, EXIST = E)
        CALL GEN039 (1, PAD, 1, LP, NB, IS)
      ELSE
C * Get the executable search path from the environment
        CALL GETENV ('PATH', P)
        LX = LEN(P)
        NB = 0
        LH = LX
        CALL GEN039 (1, P, 1, LX, NB, LH)
        IF (LH .GT. 0) THEN
          I2 = 0
          DO
            I2 = I2 + 1
            I1 = I2
            IF (I2 .GT. LH) EXIT
C * Look for separating ":" .OR. ";" character
            DO
              IF (ICHAR(P(I2:I2)) .EQ. ICHAR(DELIM2) .OR. I2 .GT. LH)
     1          EXIT
              I2 = I2 + 1
            END DO
            IF (I2 .EQ. I1) THEN
C * Empty path component is equal to current directory.
              COMPONENT = '.'
              LC = 1
            ELSE
C * Found path component
              COMPONENT = P(I1:I2-1)
              LC = I2 - I1
            END IF
C * Build file name, and see if it exists
            FILE = COMPONENT(1:LC)//DELIM1//PROGRAM(1:L)//SUFFIX
            INQUIRE (FILE = FILE, EXIST = E)
            IF (E) THEN
              PAD = FILE(1:LP)
              CALL GEN039 (1, PAD, 1, LP, NB, IS)
              EXIT
            END IF
C * Next path component, if any
          END DO
        END IF
      END IF
      FINDEXE = IS
      RETURN
      END FUNCTION FINDEXE
      REAL FUNCTION CPUTIM()
      DIMENSION TARRAY(2)
      TARRAY(1) = 0.0
      TARRAY(2) = 0.0
      T = ELTIME (TARRAY)
      CPUTIM = T
      RETURN
      END FUNCTION CPUTIM
      SUBROUTINE SPAWN (COMMAND, IER)
C * FORMER 'CALL SYSTEM'
      CHARACTER COMMAND*(*)
      INTEGER CALLSYSTEM
      EXTERNAL CALLSYSTEM
      LENGTH = LEN(COMMAND)
      IER    = CALLSYSTEM (COMMAND(1:LENGTH))
      RETURN
      END SUBROUTINE SPAWN
      SUBROUTINE GGIP (X, Y, Z, IVAL)
C *====================================================================C
C *                 ****    G   G   I   P   ****                       C
C *====================================================================C
C *                    (C) 1980 - 2013  A.L. Spek                      C
C *                                                                    C
C *             GENERAL GRAPHICS INTERFACE PACKAGE FOR                 C
C *              HARD-COPY AND DISPLAY SURFACE OUTPUT                  C
C *                                                                    C
C *                          A.L. SPEK,                                C
C *                      UTRECHT UNIVERSITY                            C
C *                       THE NETHERLANDS.                             C
C *                                                                    C
C *                       VERSION 30-Mar-2010                          C
C *                                                                    C
C * GRAPHICS DISPLAYS SUPPORTED      (DISPLAY-MODE)   SHORT NAME       C
C *                                                                    C
C *          X-WINDOW                                 - X11            C
C *                                                                    C
C * GRAPHICS METAFILE CODE              (META-MODE)                    C
C *                                                                    C
C *          POSTSCRIPT                               - PS             C
C *          HPGL - LANGUAGE                          - HPGL           C
C *                                                                    C
C * ALL USER CALLS TO A GRAPHICS MEDIUM SHOULD BE DIRECTED THROUGH     C
C * THIS ROUTINE. ESSENTIALLY ONLY THE CALCOMP "CALL PLOT(X, Y, IPEN)" C
C * IS IMPLEMENTED, WHERE X,Y ARE IN CM AND IPEN = +,-2 OR +,-3.       C
C * ALL OTHER CALLS TO GGIP  SET PARAMETERS WITHIN THIS PACKAGE.       C
C * PLOTFILE ON UNIT LU98 (WHEN "META ON") FOR OFF-LINE DISPLAY/HARD-  C
C * COPY.                                                              C
C * ------------------------------------------------------------------ C
C * GENERAL CALL TO GGIP:  GGIP(X, Y, Z, I) , WHERE FOR                C
C *                                                                    C
C * X = -999.0 =====(SET PACKAGE PARAMETERS, HANDLE REQUESTS)==========C
C *   I                                                                C
C *   I --- I =  1 --> GET (0/1) XWINDOW OPEN STATUS                   C
C *   I --- I =  2 --> DISPLAY ON                                      C
C *   I --- I = -2 --> DISPLAY OFF (IMPLICITLY META ON)                C
C *   I --- I =  3 --> META ON  (PERMANENT FOR Z = -1.0)               C
C *   I --- I = -3 --> META OFF (IMPL.DISPLAY/PLOTTER) ON)             C
C *   I --- I =  4 --> LANDSCAPE POSTSCRIPT                            C
C *   I --- I = -4 --> PORTRAIT  POSTSCRIPT                            C
C *   I --- I =  5 --> BEGIN OF PROGRAM INIT  Y >  0: META-FILE  (EXT) C
C *   I                                       Y =  0: 'PLOT.EXT' (INT) C
C *   I                                       Y = -L: METAF IN IGGT    C
C *   I                                               L = LENGTH NAME  C
C *   I                                       Z >  0: DISPLAY-FILE (E) C
C *   I                                       Z =  0: INTERNAL         C
C *   I --- I = -5 --> END OF PROGRAM CLOSING PROCEDURES               C
C *   I --- I =  6 --> Y =  1 :X-WINDOW       Z =  0                   C
C *   I                                                                C
C *   I                                                                C
C *   I                Y =  0 : META FILE-->  Z =  1 :POSTSCRIPT       C
C *   I                                       Z =  2 :HPGL             C
C *   I --- I =  6     Y =  0, Z =  0 --> INFORMATION IN COMMON /GGT/  C
C *   I                                   MEDIUM, IGGT(16:22)          C
C *   I --- I =  7 --> GRAPHICS HELP OPTION                            C
C *   I --- I =  8 --> INFO GRAPHICS STATUS   Y =  0 :TEK4010          C
C *   I --- I = -8 --> REPORT DISPLAY PARAMETERS                       C
C *   I                X = X-PIXEL, Y = YPIXEL, Z = DEPTH              C
C *   I                                       Y =  1 :X11              C
C *   I --- I =  9 --> Y =  0, IZ =  FRACTION OF DISPLAY SIZE (/1000)  C
C *                                                                    C
C *   X > -999 AND IABS(I) < 7 ===== (GRAPHICS) =======================C
C *                                                                    C
C *         I =  1 --> BEG PLOT X > 0;Y = 0: X = XMAX,YMAX PLOT IN CM. C
C *                             X > 0;Y > 0: X = XMAX, Y = YMAX        C
C *                                          Z = FRACTION XMAX-SIZE    C
C *         I = -1 --> END PLOT X = 0;Y = 0: Z = 0: READ AT E-O-PLOT   C
C *                                          Z = 1: GO   AT E-O-PLOT   C
C *                                          Z > 1: GO AFTER Z SECONDS C
C *                                          Z =-1:  ,, + PLOT INTERR. C
C *                                          Z <-1: GO AFTER Z SECONDS C
C *         I =  0 --> NEWPEN(Y)      Y = 0: BLACK (WHITE)             C
C *                                   Y = 1: WHITE (BLACK)             C
C *                                   Y = 2: RED                       C
C *                                   Y = 3: GREEN                     C
C *                                   Y = 4: BLUE                      C
C *                                                                    C
C *                                   Y < 0: LINEWIDTH                 C
C *                    (Set Default)  Y = -100 : X-Win MinWidth = 1    C
C *                    (Set Default)  Y = -200 : X-Win MinWidth = 2    C
C *                                                                    C
C *         I =  2 --> DRAW(X, Y, Z)                                   C
C *         I =  3 --> MOVE(X, Y, Z)                                   C
C *         I = -3 --> MOVE TO NEW ORIGIN                              C
C *         I =  4 --> CHARACTER PLOT                                  C
C *         I =  5 --> MOUSE EVENTLOOP                                 C
C *         I =  6 --> Flush Buffer   Z = Seconds Sleep                C
C *         I =  7 --> FACTOR         Y = Multiplication fact X,Y,Z    C
C *         I =  9 --> Interruptloop                                   C
C *                                                                    C
C *                                                                    C
C *********************************************************************C
C *                                                                    C
C *               * * * BITMAP PIXEL NUMBERING * * *                   C
C *                                                                    C
C * PIXELS ARE NUMBERED FROM 0 TO IXM  (= IXM + 1 HORIZONTAL PIXELS)   C
C * PIXELS ARE NUMBERED FROM 0 TO IYM  (= IYM + 1 VERTICAL PIXELS)     C
C *                                                                    C
C * ORIGIN (0, 0) IN LOWER LEFT CORNER, X HORIZONTAL, Y VERTICAL       C
C *                                                                    C
C * ===================================================================C
C * THE COMMON GGT HOLDS THE COMMAND LINE ENTERED IN ENDPLT            C
C * ===================================================================C
C *                  GRAPHICS CALLING FRAMEWORK                        C
C *                  ==========================                        C
C *                                                                    C
C *  GENERAL INITIALISATION:                                           C
C *    WITH META-FILE UNIT            CALL GGIP(-999.0, UNIT, 0.0,  5) C
C *  SELECT DISPLAY TYPE (DTYP)                                        C
C *    XWINDOW(=1),                   CALL GGIP(-999.0, DTYP, 0.0,  6) C
C *  SELECT META TYPE  (TYPM)                                          C
C *      HPGL(=1)                     CALL GGIP(-999.0, 0.0,  TYPM, 6) C
C *  SELECT GRAPHICS MEDIUM  (ISEL)                                    C
C *   DISPLAY(=1), META(=2):          CALL GGIP(-999.0, 0.0, 0.0, ISEL)C
C *                                           .........                C
C *  START A NEW PLOT:                CALL GGIP(XMAX,   YMAX, 0.0,  1) C
C *  PLOT INSTRUCTIONS:                       .........                C
C *                                   CALL GGIP(X, Y, Z, IPEN)         C
C *                                           .........                C
C *  SELECT PEN:                      CALL GGIP(0.0, XPEN, 0.0, 0)     C
C *                                           .........                C
C *  END OF A PLOT:                   CALL GGIP(0.0, 0.0, 0.0, -1)     C
C *                                           .........                C
C *  GENERAL GRAPHICS CLOSING:        CALL GGIP(-999.0,PCAL,PLOTS, -5) C
C *                                                                    C
C *********************************************************************C
      PARAMETER (IPDS = 1, IPME = 2)
      COMMON /GGT/ MEDIUM
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      COMMON /CHGGIP/ KME(7), METAF, DCODE, MCODE,
     1 DSCOD(IPDS), MECOD(IPME), PLEXT(IPME)
      CHARACTER KME*1, METAF*80, DCODE*7,
     1 MCODE*7, DSCOD*7, MECOD*7, PLEXT*3
      CHARACTER HPD*3, CAL*3, MED1*7
      COMMON /WINBUF/ BUF
      CHARACTER BUF*132
      LOGICAL EXST
      XX      = X
      YY      = Y
      ZZ      = Z
      II      = IVAL
      ICHANGE = 0
   10 IF (XX .LT. -998.9) THEN
        IF (IABS(II) .LT. 10) THEN
          IF (II .NE. -5) THEN
            IY = NINT(YY)
            IZ = NINT(ZZ)
          END IF
          ISTAT = 1
C * FUNCTION 9: FRACTION WINDOW:DISPLAY SIZE
          IF (II .EQ. 9) THEN
            IBAW = IY
            IF (IZ .GE. 10) ISW = IZ
            IF (IWDO .NE. 0) THEN
              IDUM1 = 0
              IDUM2 = 0
              IDUM3 = 0
              IDUM4 = 0
              CALL GGIP08 (IDUM1, IDUM2, IDUM3, IDUM4)
              IWDO  = 0
            END IF
            WRITE (LU99, 99995) ISW / 1000.0
C * FUNCTION 8: GRAPHICS STATUS INFO
          ELSE IF (II .EQ. 8) THEN
            IF (IGST .EQ. -1) THEN
              IDUM1 = 0
              IDUM2 = 0
              IDUM3 = 0
              IDUM4 = -1
              CALL GGIP08 (IDUM1, IDUM2, IGST, IDUM4)
            END IF
            Y = IGST
            Z = IMETA
          ELSE IF (II .EQ. -8) THEN
            X = IDMX
            Y = IDMY
            Z = IDMZ
C * FUNCTION 7: HELP GRAPHICS
          ELSE IF (II .EQ. 7) THEN
            ISTAT = -1
            WRITE (LU96, 99998)
            WRITE (LU96, 99992) (DSCOD(III), III = 1, IPDS)
            WRITE (LU96, 99993) (MECOD(III), III = 1, IPME)
            WRITE (LU96, 99994)
C * FUNCTION 6: SET TERMINAL, ON-LINE HARDCOPY OR META-FILE TYPE
          ELSE IF (II .EQ. 6) THEN
            IF (IY .EQ. 0 .AND. IZ .EQ. 0) THEN
              MED1 = IGGT(16:22)
              IF (MED1 .EQ. 'ON     ') THEN
                II =  1
              ELSE IF (MED1 .EQ. 'OFF    ') THEN
                CALL GGIP05
                II = -1
              ELSE
                II =  6
              END IF
              IF (MEDIUM .EQ. 0) THEN
              ELSE IF (MEDIUM .EQ. 1) THEN
                IF (II .NE. 6) THEN
                  II = 2 * II
                ELSE
                  DO IY = 1, IPDS
                    IF (MED1 .EQ. DSCOD(IY)) GO TO 20
                  END DO
C * CHAR(7) = ASCII BELL = CTRL-G
                  WRITE (LU96, 99991) MED1, CHAR(7)
                  IY =  ITERM
   20             CONTINUE
                END IF
               ELSE IF (MEDIUM .EQ. 2) THEN
                 IF (II .NE. 6) THEN
                   II = 3 * II
                 ELSE
                   DO IZ = 1, IPME
                     IF (MED1 .EQ. MECOD(IZ)) GO TO 30
                   END DO
C * CHAR(7) = ASCII BELL = CTRL-G
                   WRITE (LU96, 99991) MED1, CHAR(7)
                   IZ = IMETA
   30              CONTINUE
                 END IF
               ELSE
C * CHAR(7) = ASCII BELL = CTRL-G
                 WRITE (LU96, 99990) MEDIUM, CHAR(7)
               END IF
               CALL GEN038 (IGGT, 1, 80)
               IF (II .NE. 6) GO TO 10
             END IF
             IF (IY .GT. 0) THEN
               ITERM = IY
             ELSE
               IF (NPLOT .EQ. 0) THEN
                 IMETA = IZ
               ELSE
                 IF (IMETA .NE. IZ) THEN
                   INQUIRE (LU98, EXIST = EXST)
                   IF (LPLT .LE. 0) THEN
                     IF (EXST) CLOSE (UNIT = LU98, STATUS = 'DELETE')
                   ELSE
                     IF (EXST) CLOSE (UNIT = LU98)
                     WRITE (LU96, 99996) METAF(1:KNM), PLEXT(IMETA),
     1                                   LPLT, NPLOT
                     IMETA = IZ
                     LPLT  = -1
                     NPLOT = 0
                   END IF
                 END IF
               END IF
               CALL GEN038 (IGGT, 1, 80)
             END IF
             IF (ITERM .LT. 99) DCODE = DSCOD(ITERM)
             MCODE = MECOD(IMETA)
             IF (IOMETA .NE. IMETA) THEN
               ICHANGE = 1
               IOMETA = IMETA
             END IF
             IF (IOTERM .NE. ITERM) THEN
               ICHANGE = 1
               IOTERM = ITERM
             END IF
C * FUNCTION 5: HANDLING OF PROGRAM START/FINISH
          ELSE IF (IABS(II) .EQ. 5) THEN
            CALL GGIP06 (II, IY, IZ)
C * FUNCTION  4: LANDSCAPE/PORTRAIT HANDLING (POSTSCRIPT)
          ELSE IF (IABS(II) .EQ. 4) THEN
            IF (II .GT. 0) THEN
              IPSH = 0
              IPSV = 0
              IPSR = 0
            ELSE
              IPSH = 0
              IPSV = 6120
              IPSR = -90
            END IF
C * FUNCTION 3: IS IT A META(ON/OFF) REQUEST
          ELSE IF (IABS(II) .EQ. 3) THEN
            ICAL  = SIGN(1, II)
            IF (ICAL .LT. 0) IHP = 1
            IF (Z .LT. 0) THEN
              METAPL = -1
            ELSE
              METAPL =  1
            END IF
C * FUNCTION 2: IS IT A DISPLAY(ON/OFF) REQUEST
          ELSE IF (IABS(II) .EQ. 2) THEN
            IHPDP = 1
            IHP   = SIGN(1, II)
C * FUNCTION 1: CHECK FOR OPEN WINDOW
          ELSE IF (IABS(II) .EQ. 1) THEN
            IDUM1 = 0
            IDUM2 = 0
            IDUM3 = 0
            IDUM4 = 13
            CALL GGIP08 (IDUM1, IDUM2, IDUM3, IDUM4)
            Z     = IDUM3
          END IF
          IF (IHP .LT. 0) ICAL = 1
          IF (ISTAT .GT. 0) THEN
            IF (IHP .LT. 0) THEN
              HPD = 'off'
            ELSE
              HPD = 'on '
            END IF
            IF (IOHP .NE. IHP) THEN
              ICHANGE = 1
              IOHP = IHP
            END IF
            IF (ICAL .GT. 0) THEN
              CAL = 'on '
            ELSE
              CAL = 'off'
            END IF
            IF (IOCAL .NE. ICAL) THEN
              ICHANGE = 1
              IOCAL = ICAL
            END IF
            IF (ICHANGE .NE. 0) THEN
              WRITE (LU96, 99999) HPD, DCODE
              WRITE (LU96, 99997) CAL, MCODE
              ICHANGE = 0
            END IF
            ISTAT = -1
          END IF
        ELSE IF (II .GT. 9) THEN
          IDUM1 = INDEX(BCD, CHAR(0))
          IDUM2 = NINT(YY)
          IDUM3 = NINT(ZZ)
          IDUM4 = IABS(II) + 90
          BUF   = BCD
          CALL GGIP08 (IDUM1, IDUM2, IDUM3, IDUM4)
        END IF
      ELSE
        IF (IABS(II) .LE. 9) THEN
          IF (IABS(II) .LE. 1) THEN
C * PLOT FUNCTIONS 1, -1, 0: HANDLING OF NAMPLT/ENDPLT/NEWPEN
            IF (II .EQ. 1) THEN
              CALL GGIP01 (XX, YY, ZZ)
              FACTR = 1.0
            ELSE IF (II .EQ. -1) THEN
              CALL GGIP02 (Z)
            ELSE IF (II .EQ. 0) THEN
              XX = 0.0
              IF (YY .GE. 0.0) THEN
                IF (IHP .GT. 0 .OR. ICAL .GT. 0) IPCLN = NINT(YY)
              ELSE
                IF (IHP .GT. 0 .OR. ICAL .GT. 0) THEN
                  IPSN = NINT(ABS(YY))
                  IF (IPSN .GE. 100) THEN
                    IPSX = IPSN / 100
                    IPSN = IPSN - IPSX * 100
                  END IF
                END IF
              END IF
            END IF
          ELSE IF (II .EQ. 4) THEN
            CALL GGIP07 (XX, YY)
          ELSE IF (II .EQ. 5) THEN
            IF (NAMP .GE. 0) THEN
              IF (IHPDP .EQ. 1 .AND. IWDO .EQ. 1) THEN
                IPCLN = IPCLD
                IPSN  = IPSD
                CALL GGIP03
                IBUT  = 0
                CALL GGIP08 (IX, IY, IBUT, II)
                ZZ    = IBUT
                IVENT = II
                IF (II .EQ. 1) THEN
                  XX = IX / (SCF * FACTR)
                  YY = IY / (SCF * FACTR)
                ELSE IF (II .EQ. 5) THEN
                  BCD(1:1) = BUF(1:1)
                ELSE
                  XX    = IX
                  YY    = IY
                END IF
              ELSE
                IVENT = -1
              END IF
            ELSE
              IVENT = 0
            END IF
            X    = XX
            Y    = YY
            Z    = ZZ
            IVAL = IVENT
          ELSE IF (II .EQ. 6) THEN
            IF (IHPDP .EQ. 1 .AND. IWDO .EQ. 1) THEN
              IDUM1 = 0
              IDUM2 = 0
              IDUM3 = 0
              IDUM4 = 7
              BUF(1:1) = CHAR(0)
              CALL GGIP08 (IDUM1, IDUM2, IDUM3, IDUM4)
            END IF
          ELSE IF (II .EQ. 7) THEN
            FACTR = YY
          ELSE IF (II .EQ. 9) THEN
            IF (NAMP .GE. 0) THEN
              IF (IHPDP .EQ. 1 .AND. IWDO .EQ. 1) THEN
                IDUM3 = 0
                CALL GGIP08 (IX, IY, IDUM3, II)
                IVENT = II
              ELSE
                IVENT = -1
              END IF
            ELSE
              IVENT = 0
            END IF
            IVAL = IVENT
          ELSE
C * PLOT FUNCTION 2,3: INSTRUCTION A LA CALCOMP : CALL PLOT(X, Y, I)
            CALL GGIP04 (XX, YY, II)
          END IF
        END IF
      END IF
      RETURN
99999 FORMAT (/, 'Current Graphics Settings: Online Display  >> ',
     1        A, '; DISPLAY ', '  CODE = ', A)
99998 FORMAT (/,
     1 'The graphics drivers provide for 2 types of graphics output:'/
     2 '  DISPLAY - Interactive graphics output on the Display'/
     3 '  META    - A Meta-disk-file with graphics instructions.'//
     4 'The (ON/OFF) status of a graphics medium is managed with',
     5 ' instructions of the', /, 'type: SET DISPLAY ON ',
     6 'and SET META ON  etc.', //, 'The kind of code',
     7 ' that is generated for the various media may be:')
99997 FORMAT ('===(See HELP GRAPHICS)===: Meta File       >> ',
     1        A, '; META FILE  CODE = ', A, /)
99996 FORMAT (/, ':: Meta-Plotfile  on File ', A, '.', A, /,
     1           26X, I6, ' Vector(s),', I6, ' Plot(s)')
99995 FORMAT (/, ':: Window Size (Re)Set to : ', F4.2, /)
99994 FORMAT (/, 'Type to change the current Display code :',
     1 ' e.g. SET DISPLAY X11,', /,
     2 'Similarly the current Metafile code may be set.', /)
99993 FORMAT ('  META    : ',  7(A, ', '), /, 12X, 7(A, ', '))
99992 FORMAT ('  DISPLAY : ',  7(A, ', '), /, 12X, 7(A, ', '))
99991 FORMAT (':: UNKNOWN DRIVER REQUEST (IGNORED)! :', A, A)
99990 FORMAT (':: UNKNOWN MEDIUM REQUEST (IGNORED)! :', I3, A)
      END SUBROUTINE GGIP
      SUBROUTINE GGIP01 (XX, YY, ZZ)
      PARAMETER (IPDS = 1, IPME = 2)
      COMMON /CGGT/ IGGT
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      CHARACTER CMETA*1, IGGT*80, FNLU98*80
      LOGICAL CC
      COMMON /CTRLC/ CC
      COMMON /CHGGIP/ KME(7), METAF, DCODE, MCODE,
     1 DSCOD(IPDS), MECOD(IPME), PLEXT(IPME)
      CHARACTER KME*1, METAF*80, DCODE*7,
     1 MCODE*7, DSCOD*7, MECOD*7, PLEXT*3
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /WINBUF/ BUF
      CHARACTER BUF*132
      BUF  = BCD
      CC = .FALSE.
      CALL SETUPCC
      IF (IHP .GT. 0 .AND. ICAL .GT. 0) THEN
        IF (METAPL .EQ. 0 .AND. IHPDP .EQ. 2) THEN
          WRITE (LU96, 99991)
          READ  (LU95, 99992) CMETA
          IF (CMETA .EQ. 'N' .OR. CMETA .EQ. 'n') ICAL   = -1
          IF (CMETA .EQ. 'A' .OR. CMETA .EQ. 'a') METAPL = -1
        END IF
      END IF
      IF (METAPL .EQ. 1) METAPL = 0
      XMAX   = ABS(XX)
      YMAX   = ABS(YY)
      ZFRC   = ABS(ZZ)
      IF (YMAX .LT. 0.01) YMAX = XMAX
      IF (ZFRC .LT. 0.01) ZFRC = 1.0
      NAMP = 1
      CALL GEN038 (IGGT, 1, 80)
      IPCL  = 0
      IPSW  = 0
      ISK   = 0
      IF (IHP .GT. 0) THEN
        ITEL  = 0
 1000   IHPDP = ITERM
        IPCLN = IPCLD
        IPSN  = IPSD
C * X11 - XLIB GRAPHICS
        IF (IHPDP .EQ. 1) THEN
          IF (IWDO .EQ. 0) THEN
            IDUM1 = 0
            IDUM2 = 0
            CALL GGIP08 (IDUM1, IDUM2, IBAW, 12)
            IXM = ISW
            IYM = 1000
            IMENU = IXVERS
            CALL GGIP08 (IXM, IYM, IMENU, 1)
            IF (IXM .LT. 0) THEN
              ITERM = 2
              DCODE = DSCOD(ITERM)
              GO TO 1000
            ELSE
              IWDO = 1
            END IF
            CALL GGIP08 (IDMX, IDMY, IDMZ, 11)
          END IF
          IDUM1 = 0
          IDUM2 = 0
          IDUM3 = 0
          IDUM4 = 6
          CALL GGIP08 (IDUM1, IDUM2, IDUM3, IDUM4)
        END IF
      END IF
      IF (ICAL .GT. 0) THEN
        IF (LPLT .LT. 0) THEN
          FNLU98 = METAF(1:KNM)//'.'//PLEXT(IMETA)
          OPEN (UNIT = LU98, FILE = FNLU98, STATUS = 'UNKNOWN')
          LPLT = 0
        END IF
        NPLOT = NPLOT + 1
        IF (IMETA .EQ. 1) THEN
          NRPS = NRPS + 1
          IF (NRPS .EQ. 1) THEN
            WRITE (LU98, 99999)
          ELSE
            WRITE (LU98, 99995) NRPS, NRPS
          END IF
          WRITE (LU98, 99994) IPSH, IPSV, IPSR
          JXO    = 7333
          JYO    = 5500
          JTEL   = 0
          KTEL   = -1
          KXE(7) = 0
          KYE(7) = 0
          KME(7) = 'm'
        ELSE IF (IMETA .EQ. 2) THEN
          IF (ISVPLT .EQ. 0) THEN
            ISVPLT = 1
          ELSE
            WRITE (LU98, 99993)
          END IF
          WRITE (LU98, 99998) IPCL
          JXO = 10000
          JYO = 7200
        END IF
      END IF
      SCF = (IYM + 1) * ZFRC / YMAX
      IF (ICAL .GT. 0) THEN
C * SCF FOR TEK4014 -META FILE
        SCFJ  = JYO * ZFRC / YMAX
        SCFJ1 = JXO * ZFRC / XMAX
        SCFJ  = MIN(SCFJ, SCFJ1)
      END IF
      XR = 0.0
      YR = 0.0
      RETURN
99999 FORMAT ('%!PS-Adobe-1.0', /,
     1        '%%Creator GGIP - A.L.Spek', /,
     2        '%%BoundingBox: 0 0 612 792', /,
     3        '%%EndComments', /,
     5        '/m {moveto} def /l {lineto} def /c {setrgbcolor} def ',
     6        '/p {showpage} def', /,
     7        '/w {setlinewidth} def /s {stroke} def /n {newpath} def',
     8        ' /r {rlineto} def', /,
     4        '%%Page: 1 1')
99998 FORMAT ('IN;SP', I5,';')
99995 FORMAT ('%%Page:', 2I5)
99994 FORMAT (' 0.1 0.1 scale n 1 setlinecap',
     1         2I5, ' translate ', I4, ' rotate')
99993 FORMAT ('AF;')
99992 FORMAT (A)
99991 FORMAT ('Should META-file remain opened for this plot?',
     1 '(A/Y/N[Y])', $)
      END SUBROUTINE GGIP01
      SUBROUTINE GGIP02 (Z)
      PARAMETER (IPDS = 1)
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      IF (NAMP .GT. 0) THEN
        CALL GGIP05
        IF (IHP .GT. 0) THEN
          IF (IHPDP .EQ. 1) THEN
            IX   = 0
            IY   = 0
            IZ   = 0
            IWIN = 8
            CALL GGIP08 (IX, IY, IZ, IWIN)
            IWIN = 7
            CALL GGIP08 (IX, IY, IZ, IWIN)
          END IF
          IPCL = 0
        END IF
      END IF
      IF (IHP .GT. 0 .AND. NAMP .GE. 0) THEN
        IF (NAMP .EQ. 1 .AND. Z .EQ. 0) THEN
          IF (IHPDP .NE. 1) THEN
            READ (LU95, 99999, END = 10) IGGT
   10       CONTINUE
          END IF
        ELSE IF (NAMP .EQ. 1 .AND. Z .GT. 0) THEN
          WRITE (LU96, 99997)
          IF (Z .GT. 1) CALL SLAAP (NINT(Z))
        ELSE IF (NAMP .EQ. 1 .AND. Z .LT. -1) THEN
          CALL SLAAP (NINT(-Z))
        END IF
      END IF
      IF (NAMP .EQ. 1) NAMP = 0
      RETURN
99999 FORMAT (A)
99997 FORMAT (/, ':: PLOTTING INTERRUPTED!!', /)
      END SUBROUTINE GGIP02
      SUBROUTINE GGIP03
      PARAMETER (IPDS = 1, IPME = 2)
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      COMMON /CHGGIP/ KME(7), METAF, DCODE, MCODE,
     1 DSCOD(IPDS), MECOD(IPME), PLEXT(IPME)
      CHARACTER KME*1, METAF*80, DCODE*7,
     1 MCODE*7, DSCOD*7, MECOD*7, PLEXT*3
      IF (IPCLN .NE. IPCL) THEN
        IPCL = IPCLN
        IF (IHP .GT. 0) THEN
          IF (IHPDP .EQ. 1) THEN
            IDUM2 = 0
            IDUM3 = 0
            IDUM4 = 99
            CALL GGIP08 (IPCL, IDUM2, IDUM3, IDUM4)
          END IF
        END IF
        IF (ICAL .GT. 0) THEN
          IF (IMETA .EQ. 1) THEN
            IF (KTEL .GT. 0) THEN
              WRITE (LU98, 99989)
     1            (KXE(I), KYE(I), KME(I), I = 1, KTEL)
              KXE(7) = KXE(KTEL)
              KYE(7) = KYE(KTEL)
              KME(7) = 'm'
            ENDIF
            IF (KTEL .GT. -1) THEN
              KXE(1) = KXE(7)
              KYE(1) = KYE(7)
              KME(1) = KME(7)
              KTEL   = 1
            ENDIF
            JTEL   = KTEL
            WRITE (LU98, 99988) IPSM
            IF (IPCL .EQ. 0) THEN
              WRITE (LU98, 99986)
            ELSE IF (IPCL .EQ. 1) THEN
              WRITE (LU98, 99997)
            ELSE IF (IPCL .EQ. 2) THEN
              WRITE (LU98, 99996)
            ELSE IF (IPCL .EQ. 3) THEN
              WRITE (LU98, 99995)
            ELSE IF (IPCL .EQ. 4) THEN
              WRITE (LU98, 99994)
            ELSE IF (IPCL .EQ. 5) THEN
              WRITE (LU98, 99993)
            ELSE IF (IPCL .EQ. 6) THEN
              WRITE (LU98, 99992)
            ELSE IF (IPCL .EQ. 7) THEN
              WRITE (LU98, 99991)
            ELSE IF (IPCL .EQ. 8) THEN
              WRITE (LU98, 99990)
            END IF
          ELSE IF (IMETA .EQ. 2) THEN
            IPCLX = IPCL
            WRITE (LU98, 99998) IPCLX
          END IF
        END IF
      END IF
      IF (IPSN .NE. IPSW) THEN
        IF (IHP .GT. 0) THEN
          IF (IHPDP .EQ. 1) THEN
            IPSY = MAX(IPSN, IPSX)
            IDUM2 = 0
            IDUM3 = 0
            IDUM4 = 10
            CALL GGIP08 (IPSY, IDUM2, IDUM3, IDUM4)
          END IF
        END IF
        IF (ICAL .GT. 0) THEN
          IF (IMETA .EQ. 1) THEN
            IF (KTEL .GT. 0)  THEN
              WRITE (LU98, 99989)
     1          (KXE(I), KYE(I), KME(I), I = 1, KTEL)
              KXE(7) = KXE(KTEL)
              KYE(7) = KYE(KTEL)
              KME(7) = 'm'
            END IF
            IF (KTEL .GT. -1) THEN
              KXE(1) = KXE(7)
              KYE(1) = KYE(7)
              KME(1) = KME(7)
              KTEL   = 1
            END IF
            JTEL   = KTEL
            WRITE (LU98, 99988) IPSM
          END IF
        END IF
        IPSW = IPSN
      END IF
99998 FORMAT ('PU;SP',I5,';')
99997 FORMAT ('0.0 0.0 0.0 c')
99996 FORMAT ('1.0 0.0 0.0 c')
99995 FORMAT ('0.0 1.0 0.0 c')
99994 FORMAT ('0.0 0.0 1.0 c')
99993 FORMAT ('1.0 1.0 0.0 c')
99992 FORMAT ('0.8 0.2 0.2 c')
99991 FORMAT ('0.31 0.18 0.31 c')
99990 FORMAT ('0.65 0.16 0.16 c')
99989 FORMAT (6(2I5, 1X, A1))
99988 FORMAT (I3, ' w s n ')
99986 FORMAT ('1.0 1.0 1.0 c')
      RETURN
      END SUBROUTINE GGIP03
      SUBROUTINE GGIP04 (XXX, YYY, IPUD)
      PARAMETER (IPDS = 1, IPME = 2)
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      COMMON /CHGGIP/ KME(7), METAF, DCODE, MCODE,
     1 DSCOD(IPDS), MECOD(IPME), PLEXT(IPME)
      CHARACTER KME*1, METAF*80, DCODE*7,
     1 MCODE*7, DSCOD*7, MECOD*7, PLEXT*3
      IMOVE = 0
      II = IPUD
      XX = XXX * FACTR
      YY = YYY * FACTR
      XX = XR + XX
      YY = YR + YY
      IF (II .LT. 0) THEN
        II = -II
        XR =  XX
        YR =  YY
      END IF
      DELTA = ABS(XOLD - XX) + ABS(YOLD -YY)
      IF (II .EQ. 3) THEN
        IF (DELTA .GT. 0.001) NPO = 0
      ELSE
   10   IF (NPO .EQ. 0) THEN
          X    = XOLD
          Y    = YOLD
          IPEN = 3
        ELSE
          X    = XX
          Y    = YY
          IPEN = 2
        END IF
        IF (ISK .EQ. 0) CALL GGIP03
        IF (IHP .GT. 0) THEN
          IF (ISK .EQ. 0) THEN
            IX = NINT(X * SCF)
            IY = NINT(Y * SCF)
            IF (IX .LT. 0) IX = 0
            IF (IY .LT. 0) IY = 0
            IF (IX .GT. IXM) IX = IXM
            IF (IY .GT. IYM) IY = IYM
            IF (IHPDP .EQ. 1) THEN
              IDUM3 = 0
              CALL GGIP08 (IX, IY, IDUM3, IPEN)
            END IF
            ITEL = ITEL + 1
            IF (IT .GT. 65) THEN
              ITEL = 0
            END IF
          END IF
        END IF
        IF (ICAL .GT. 0) THEN
          IF (LPLT .EQ. -1) THEN
            WRITE (6, '(''>> LU98-NOT OPEN YET !!'')')
            ICAL = 0
          END IF
          LPLT = LPLT + 1
          JXE  = NINT(X * SCFJ)
          JYE  = NINT(Y * SCFJ)
          IF (JXE .LT. 0) JXE = 0
          IF (JYE .LT. 0) JYE = 0
          IF (JXE .GT. JXO) JXE = JXO
          IF (JYE .GT. JYO) JYE = JYO
          IF (IMETA .EQ. 1) THEN
            IF (KTEL .EQ. -1) KTEL = 0
            KTEL = KTEL + 1
            JTEL = JTEL + 1
            KXE(KTEL) = (JYO - JYE) + 200
            KYE(KTEL) = JXE + 200
            KME(KTEL) = CHAR(106 + IPEN)
            IF (KTEL .EQ. 6) THEN
              WRITE (LU98, 99993) (KXE(I), KYE(I), KME(I), I = 1, 6)
              KXE(7) = KXE(6)
              KYE(7) = KYE(6)
              KME(7) = 'm'
              KTEL   = 0
              IF (JTEL .GE. 150) THEN
                WRITE (LU98, 99999) IPSM
                KXE(1) = KXE(7)
                KYE(1) = KYE(7)
                KME(1) = KME(7)
                JTEL   = 1
                KTEL   = 1
              END IF
            END IF
          ELSE IF (IMETA .EQ. 2) THEN
            IF (IPEN .EQ. 3) THEN
              WRITE (LU98, 99997) JXE, JYE
            ELSE IF (IPEN .EQ. 2) THEN
              WRITE (LU98, 99996) JXE, JYE
            END IF
          END IF
        END IF
        IF (NPO .EQ. 0) THEN
          NPO = 1
          GO TO 10
        END IF
      END IF
      XOLD = XX
      YOLD = YY
      RETURN
99999 FORMAT (I3, ' w s n')
99997 FORMAT ('PU;PA',I5,',',I5,';')
99996 FORMAT ('PD;PA',I5,',',I5,';')
99993 FORMAT (6(2I5, 1X, A1))
      END SUBROUTINE GGIP04
      SUBROUTINE GGIP05
      PARAMETER (IPDS = 1, IPME = 2)
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      COMMON /CHGGIP/ KME(7), METAF, DCODE, MCODE,
     1 DSCOD(IPDS), MECOD(IPME), PLEXT(IPME)
      CHARACTER KME*1, METAF*80, DCODE*7,
     1 MCODE*7, DSCOD*7, MECOD*7, PLEXT*3
      LOGICAL LOPEN
      IF (NAMP .GT. 0) THEN
        IF (ICAL .GT. 0) THEN
          INQUIRE (UNIT = LU98, OPENED = LOPEN)
          IF (LOPEN) THEN
            CALL GGIP04 (0.0, 0.0, 3)
            IF (IMETA .EQ. 1) THEN
              IF (KTEL .GE. 0) THEN
                IF (KTEL .GT. 0) WRITE (LU98, 99992)
     1            (KXE(I), KYE(I), KME(I), I = 1, KTEL)
                WRITE (LU98, 99993) IPSM
                KTEL = -1
              END IF
            ELSE IF (IMETA .EQ. 2) THEN
              WRITE (LU98, 99996)
            END IF
          END IF
        END IF
      END IF
      RETURN
99996 FORMAT ('PU;SP    0;'/'AF;')
99993 FORMAT (I3,' w s p')
99992 FORMAT (6(2I5,1X,A1))
      END SUBROUTINE GGIP05
      SUBROUTINE GGIP06 (IMODE, IY, IZ)
      PARAMETER (IPDS = 1, IPME = 2)
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      COMMON /CHGGIP/ KME(7), METAF, DCODE, MCODE,
     1 DSCOD(IPDS), MECOD(IPME), PLEXT(IPME)
      CHARACTER KME*1, METAF*80, DCODE*7,
     1 MCODE*7, DSCOD*7, MECOD*7, PLEXT*3
      COMMON /CGGT/ IGGT
      CHARACTER IGGT*80
      LOGICAL EXST
C * SUBROUTINE PERFORMES GENERAL OPEN/CLOSE PROCEDURES ON PROGRAM BEGIN/END
      ISTAT = IMODE
C * GENERAL WINDOW OPEN PREAMBLE
      IF (ISTAT .GT. 0) THEN
        ITERM = 1
        IF (IY .GT. 0) THEN
          LPLT = 0
          LU98 = IY
        ELSE IF (IY .LT. 0) THEN
          KNM = - IY
          METAF = IGGT(2:KNM + 1)
        ELSE
          METAF = 'PLOT'
          KNM   = 4
        END IF
        IF (IZ .GT. 0) THEN
          LU99  = IZ
        END IF
        IF (ITERM .LT. 99)  DCODE = DSCOD(ITERM)
        MCODE = MECOD(IMETA)
C * GENERAL WINDOW CLOSE AND REPORT
      ELSE
        IF (IHPDP .EQ. 1) THEN
          IF (IWDO .EQ. 1) THEN
            IDUM1 = 0
            IDUM2 = 0
            IDUM3 = 0
            IDUM4 = 0
            CALL GGIP08 (IDUM1, IDUM2, IDUM3, IDUM4)
          END IF
        END IF
        INQUIRE (LU98, EXIST = EXST)
        IF (LPLT .LE. 0) THEN
          IF (EXST) CLOSE (UNIT = LU98, STATUS = 'DELETE')
        ELSE
          IF (IMETA .EQ. 1) WRITE (LU98, 99999) NRPS
          WRITE (LU96, 99998) METAF(1:KNM), PLEXT(IMETA),
     1                             NPLOT, LPLT
          IF (EXST) CLOSE (UNIT = LU98)
        END IF
      END IF
      RETURN
99999 FORMAT ('%%Pages:', I5, /, '%%EOF')
99998 FORMAT (/, ':: Meta-plotfile on File ', A, '.', A, /,
     1        ':: # Plot(s) =', I5, ', # Vector(s) =', I8, /)
      END SUBROUTINE GGIP06
      SUBROUTINE GGIP07 (X, Y)
      COMMON /PLCHR/ ADR(91), TAB(199)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCD*132, SBCD*132
      COMMON /DGG11/ TH, HT, IE
      INTEGER ADR, TAB
      X0 = X
      Y0 = Y
      THETA = TH * 0.017453294
      COST  = COS(THETA)
      SINT  = SIN(THETA)
      IC   = 3
      IW   = 1
      GRID = 7
      H    = HT / GRID
      XA  = COST * H
      YA  = SINT * H
   10 IYS = 0
      ICH = 0
      I   = ICHAR(BCD(IW:IW)) - 31
      IF (I .GT. 0 .AND. I .LT. 92) THEN
        JCH = ADR(I)
        ICH = JCH / 100
        NR  = MOD(JCH, 100)
      END IF
      DO
        IF (ICH .EQ. 0) THEN
          IC = 3
          X0 = X0 + XA * 6.0
          Y0 = Y0 + YA * 6.0
          IW = IW + 1
          IF (IW .GT. IE) RETURN
          GO TO 10
        ELSE
   20     IWR   = TAB(ICH)
          ICH   = ICH + 1
          IDEEL = 16777216
          IS    = 6
          DO
            IS    = IS - 1
            IF (IS .EQ. 0) GO TO 20
            IWRD  = IWR / IDEEL
            IWR   = MOD (IWR, IDEEL)
            IDEEL = IDEEL / 64
            IX    = IWRD / 8
            IY    = MOD(IWRD, 8)
            IF (IX .EQ. 7) THEN
              IYS = IY
              IC = 3
            ELSE
              W1 = X0 + IX * XA - (IY - IYS) * YA
              W2 = Y0 + IX * YA + (IY - IYS) * XA
              CALL GGIP04 (W1, W2, IC)
              IC = 2
            END IF
            NR = NR - 1
            IF (NR .EQ. 0) EXIT
          END DO
        END IF
        ICH = 0
      END DO
      RETURN
      END SUBROUTINE GGIP07
      SUBROUTINE GGIP08 (IX, IY, IZ, IP)
      COMMON /WINBUF/ BUF
      CHARACTER BUF*132
      CALL XWIN (IX, IY, IZ, IP, BUF)
      RETURN
      END SUBROUTINE GGIP08
      SUBROUTINE GGIP09 (THETA, BCDX, NC, HEIGHT, NK, ITHICK, X, Y)
      COMMON /CGG11/ BCD, SBCD
      CHARACTER BCDX*(*), BCD*132, SBCD*132
      COMMON /DGG11/ TH, HT, IE
      TH  = THETA
      HT  = HEIGHT
      IE  = NC
      BCD = BCDX(1:IE)
      XX  = X
      YY  = Y
      ZZ  = 0.0
      IF (NK .GE. 0) CALL GGIP (0.0, FLOAT(NK), 0.0, 0)
      IF (ITHICK .NE. 0) THEN
        CALL GGIP (0.0, - FLOAT(ITHICK), 0.0, 0)
        CALL GGIP (XX, YY, ZZ, 4)
        CALL GGIP (0.0, -1.0, 0.0, 0)
      ELSE
        CALL GGIP (XX, YY, ZZ, 4)
      END IF
      IF (NK .GE. 0) CALL GGIP (0.0, 1.0, 0.0, 0)
      RETURN
      END SUBROUTINE GGIP09
      SUBROUTINE CTRLCT
      LOGICAL CC
      COMMON /CTRLC/ CC
      CC = .TRUE.
      RETURN
      END
      SUBROUTINE SETUPCC
      EXTERNAL CTRLCT
      RETURN
      END
      BLOCK DATA DGGIP
      PARAMETER (IPDS = 1, IPME = 2)
      COMMON /CGGIP/ ISW, ISK, IHP, ICAL, SCF, IT,  ISTAT, IMETA,
     1 IHPDP, ITERM, ITEL, XR, YR, XOLD, YOLD,
     2 NPO, NAMP, IPCL, IPCLN, LU98, LU99, LPLT,
     3 IXM, IYM, JXO, JYO, INOP, XMAX, YMAX, SCFJ, JTEL,
     4 NPLOT, ISVPLT, LU95, LU96, ZFRC, KNM, KXE(7),
     5 KYE(7), METAPL, IPSW, FACTR, KTEL, IXOHI, IXOLO, IYOHI, IYOLO,
     6 IOMETA, IOTERM, IOHP, IOCAL, IWDO, NRPS, IPSR,
     7 IPSH, IBAW, IPSX, IPSV, IGST, IPCLD, IPSD, IPSN, IPSM, IXVERS,
     8 IDMX, IDMY, IDMZ
      COMMON /CHGGIP/ KME(7), METAF, DCODE, MCODE,
     1 DSCOD(IPDS), MECOD(IPME), PLEXT(IPME)
      CHARACTER KME*1, METAF*80, DCODE*7,
     1 MCODE*7, DSCOD*7, MECOD*7, PLEXT*3
      COMMON /PLCHR/ ADR(91), TAB(199)
      INTEGER ADR, TAB
      LOGICAL CC
      COMMON /CTRLC/ CC
      DATA IWDO / 0/
      DATA CC /.FALSE./
      DATA ADR /
     1    0, 9405, 9209, 8411, 7712, 19714, 9512, 9804, 7504, 7604,
     2 7111, 6905, 8106, 7002, 8305, 7402, 4709, 4905, 5009, 5213, 5504,
     3 5609, 5812, 6105, 6216, 6612, 8911, 10812, 10203, 8005, 10303,
     4 9911, 10415, 109, 312, 608, 807, 1007, 1206, 1410, 1606, 1806,
     5 2006, 2206, 2403, 2505, 2604, 2710, 2907, 3112, 3410, 3612, 3904,
     6 4006, 4203, 4305, 4405, 4505, 4604, 8704, 10702, 8804, 0, 19603,
     7 0, 14211, 14511, 14808, 15011, 15310, 15508, 15714, 16007, 16208,
     8 16406, 16606, 16805, 16910, 17107, 17309, 17511, 17811, 18106,
     9 18310, 18508, 18707, 18903, 19005, 19105, 19211, 19504/
      DATA (TAB(I),I=1,96) /929990,259942400,1964453,470927585,
     1 402653184,645722497,140644352,1964449,402653184,656164612,
     2 8388608,1163527,654311424,645722497,140646611,1853735,536870912,
     3 140576207,520093696,33850913,654311424,1849804,536870912,
     4 117571584,1919456,1968576,496628678,18974822,1964453,470810624,
     5 563737542,18974840,310378496,1964453,470927584,18974819,
     6 472928655,530055168,274495936,117736993,654311424,121794560,
     7 119617063,10453472,122750247,127666176,563737542,18974784,
     8 240976408,85522406,621021184,104724901,473024737,404754432,
     9 410790016,18974819,470841792,53594337,404754831,530055168,
     * 102659152,202117656,562938629,104724901,469762048,18974822,
     1 524050699,462422016,290795747,59506688,290795747,319182021,
     2 553648128,10223616,407201728,138765248,23472348,202697144,
     3 390070272,605257890,138748553,285212672,138482248,76777602,
     4 941940253,419430400,660408320,123535360,153691209,942753101,
     5 201326592,358413688,631109952,273122455,574652482,494498758/
      DATA (TAB(I),I = 97,141) /92274688,494761792,85522406,625815057,
     1 268435456,554586112,25972736,443368138,292170013,219157016,
     2 125829120,138748553,299971852,189530112,307249184,609296384,
     3 307282113,140646620,340262912,307238996,301989888,307299458,
     4 575143936,302138500,541589504,307242018,340262912,306266274,
     5 340262912,302137632,301989888,311445760,536944640,303113234,
     6 608698368,311538372,186909273,543536256,302138516,273172498,
     7 42541056,311445504,301989888,307299456,302654592/
      DATA (TAB(I),I = 142, 199) /559972419,208813604,536870912,
     1 117670092,479073800, 16777216,559972419,208809984,559972419,
     2 208813607,536870912, 40515340, 50628129,137983974,940687360,
     3 990152225,664400838, 70105344,117453596,595591168, 67404825,
     4 940863488,990152225,654311424,117451027,536870912,117736473,
     5  67121939,273533152, 67121948,595591168, 17614627,559972416,
     6 989884815,530204363, 67108864,998406559,253248219,603979776,
     7   1061660,587202560, 18974810,168609571,560005711,940654592,
     8 203752993,612368384, 71450624, 69281316, 75726884,993838299,
     9 614340104, 16777216, 76548096, 990519296,12550998,253287968,
     * 696883200/
      DATA DSCOD /'X11    '/
      DATA MECOD /'PS     ', 'HPGL   '/
      DATA PLEXT /'ps ',     'hpl'/
C * DEFAULT INTERACTIVE READ  UNIT              : LU95   =  5
C * DEFAULT TEXT    OUTPUT TO UNIT              : LU96   =  6
C * DEFAULT META    OUTPUT TO UNIT              : LU98   = 98
C * DEFAULT DISPLAY OUTPUT TO UNIT              : LU99   =  6
C * DEFAULT GRAPHICS OUTPUT TO TERMINAL SET ON  : IHP    =  1
C * DEFAULT GRAPHICS META-FILE OUTPUT   SET OFF : ICAL   = -1
C * DEFAULT TERMINAL         SWITCH ON TERMINAL : IHPDP  =  1
      DATA IXVERS, LU98, LU99, IDMX, IDMY, IDMZ, IHP, IHPDP,
     1 NPLOT, NAMP, IPSD, IT, ICAL, LPLT, ISTAT, ISVPLT,
     2 METAPL, IBAW, ISW, NRPS, LU95, LU96, IOHP, IOCAL, IOTERM,
     3 IOMETA, IPSR, IPSH, IPSV, IPSW, IPSM, IPSX, IGST, IPCLD,
     4 ITERM, IMETA/
     5 70607, 98, 6, 800, 600, 8, 1, 1, 0, -1, 1, 0, -1,
     6 -1, 1, 0, 0, 0, 900, 0, 5, 6,  -9, -9, -1, -1, 0, 0, 0,
     7 0, 9, 1, -1, 1,
C * TERMINAL DEFAULT SET TO X11 CODE            : ITERM
     8  1,
C * METAFILE DEFAULT SET TO PostScript CODE     : IMETA
     *  1/
      END