C-----Release January 1997
C************************************************************************
C*                           Program PARSTCIF                           *
C*                                                                      *
C*                            by M. Nardelli                            *
C*                                                                      *
C* Dipartimento di Chimica Generale ed Inorganica, Chimica Analitica,   *
C*        Chimica Fisica della Universita' degli Studi di Parma         *
C* Centro di Studio per la Strutturistica Diffrattometrica, CNR (Parma) *
C*             Viale delle Scienze 78, 43100 Parma (Italy)              *
C*                E-mail: nardelli@ipruniv.cce.unipr.it                 *
C*                                                                      *
C* This routine creates a CIF file from the output of PARST [Comput.    *
C* Chem. (1983).7,95-98; J. Appl. Cryst. (1995). 28, 659], according to *
C* the rules explained by S.R. Hall, F.H. Allen and I.D. Brown in:      *
C*                                                                      *
C* "The Crystallographic Information File (CIF): a New Standard Archive *
C*  File for Crystallography" [Acta Cryst.(1991). A47, 655-685]         *
C*                                                                      *
C* The file can be used for submitting structural papers to Acta Cryst. *
C* by Electronic mail according to the instructions given in Acta Cryst.*
C* (1997). C53, 147-162.                                                *
C*                                                                      *
C* Standard editing should be used to introduce missing information and *
C* to correct some points, like to eliminate white space with s.u.      *
C* [e.g. 0.004( 9) or 0.004 (9) must be given as 0.004(9)]. S.U.'s in   *
C* parentheses must be given as integer. For the names of the authors   *
C* put first the family name, then a comma and the first name, e.g.     *
C* Smith, Arthur J.K.                                                   *
C*                                                                      *
C* '.....' should be substituted by the pertinent information, or, when *
C* this is missing, by a ?.                                             *
C* Check that character data are between apices.                        *
C*                                                                      *
C* The "no" for a geometric parameter (distance or angle) should be     *
C* changed as "yes" only when the value is really worthy to be published*
C* according to the criterion explained in NOTES FOR AUTHORS.           *
C*                                                                      *
C* In the table of hydrogen bonds the equivalent positions are encoded  *
C* according to a rule explained in the article of Hall, Allen & Brown  *
C* at page 676 at the entry _geom_angle_site_symmetry_1.                *
C*                                                                      *
C* Careful reading of the above articles is STRONGLY recommended.       *
C*                                                                      *
C* Copyright of the STAR specifications is held by the International    *
C* Union of Crystallography, 5 Abbey Square, Chester, U.K., and a       *
C* patent has been applied for to cover the STAR file process.          *
C*                                                                      *
C* NB - In using program PARST use must be made of the options giving   *
C*      an output compatible as input for this program, i.e. crystal    *
C*      data must be printed (KY=1), anisotropic atomic displacements   *
C*      must be considered (KOR=2).                                     *
C*    - The first 15 characters of the second card must be devoted to   *
C*      the Hermann-Mauguin space group symbol                          *
C*    - The anisotropic atoms must be grouped and come before the iso-  *
C*      tropic ones; the hydrogen must be isotropic and come last.      *
C*    - Check the numbers of the atoms of each type in the unit cell,   *
C*      as the program calculates them from the table of the atomic     *
C*      coordinates and the number of asymmetric units in the unit cell;*
C*      so, if some atoms were not found or disordered atoms are        *
C*      present, the values given by the program can be inconsistent.   *
C* -------------------------------------------------------------------- *
C*    EXTRA TABLE option to be added if accepted by the CIF Core        *
C*    Dictionary                                                        *
C-----Geom. extra table (max 10 columns)                                *
C     WRITE(IO,123)                                                     *
C123  FORMAT(' loop_'/' _publ_manuscript_incl_extra_item'/              *
C    1 ''' _geom_extra_tableA_col_1'''/''' _geom_extra_tableA_col_2'''/ *
C    2 ''' _geom_extra_tableA_col_3'''/''' _geom_extra_tableA_col_4'''/ *
C    3 ''' _geom_extra_tableA_col_5'''/''' _geom_extra_tableA_col_6'''/ *
C    4 ''' _geom_extra_tableA_col_7'''/''' _geom_extra_tableA_col_8'''/ *
C    5 ''' _geom_extra_tableA_col_9'''/''' _geom_extra_tableA_col_10'''/*
C    6 ''' _geom_extra_table_head_A'''/''' _geom_table_footnote_A'''//  *
C    8 ' _geom_extra_table_head_A'/';'/' .......... '/';'/' loop_'/     *
C    9 ' _geom_extra_tableA_col_1'/' _geom_extra_tableA_col_2'/         *
C    1 ' _geom_extra_tableA_col_3'/' _geom_extra_tableA_col_4'/         *
C    2 ' _geom_extra_tableA_col_5'/' _geom_extra_tableA_col_6'/         *
C    3 ' _geom_extra_tableA_col_7'/' _geom_extra_tableA_col_8'/         *
C    4 ' _geom_extra_tableA_col_9'/' _geom_extra_tableA_col_10'/        *
C    5 ' ?  ?  ?  ?  ?  ?  ?  ?  ?  ?'//                                *
C    6 '_geom_table_footnote_A'/';'/' ..........'/';')                  *
C*                                                                      *
C************************************************************************
      CHARACTER*1 FRM(80),DUM(10),SPG(15),ATM(500,6),STR1(7),STR2(4),
     1 ATP(4,6),ATM1(6),ATM2(6),ATMH(500,6),STR3(11),AAM,STR6(10),
     2 ABH1(500,6),ABH2(500,6),AAAA(6),ABB(4),ABH(4),TYP(2),AA(2),
     3 SAT(20,2),QS,SPC(20,2),STR7(4),ATM3(6),LA1(2,20),STR8(6),BRV,
     4 EQP(38,192),TIT(80),STR9(4)
      CHARACTER*2 LA(20)
      CHARACTER*3 SSTR
      CHARACTER*4 STR4,STR5
      CHARACTER*12 NMT
      CHARACTER*29 SC1
      DIMENSION AC(500,3),ISA(500,3),C(3),SC(3),A(3),SA(3),U(500,6),
     1 ISU(500,6),IU(6),UQ(500),ISUQ(500),RR(500),X(3),ISX(3),
     2 ACH(500,3),ISAH(500,3),ICDU(500),ISAP(3),NSP(20),B(500),SB(500),
     3 UU(6),IUS(6),FA(20)
      EQUIVALENCE (LA(1),LA1(1,1))
      COMMON/DEP1/ATMH,ABH1,ABH2
     2      /DEP3/AC,ISA
     3      /DEP4/U
     4      /DEP5/ISU
     5      /DEP6/UQ,ISUQ,RR,DST,ISDS,ICDU
     6      /DEP7/ACH,ISAH
     7      /DEP8/B,SB
      COMMON/GRP1/ATM
     1      /GRP2/STR3
     2      /EDAT/IC,NE
     3      /INPOU/IN,IO
     4      /INS1/STR8
      DATA STR1/' ','D','I','S','P','L','A'/
      DATA STR2/' ','N','U','M'/
      DATA STR6/' ','I','N','T','E','R','A','T','O','M'/
      DATA STR7/' ','T','H','E'/
      DATA STR9/'P','L','U','S'/
      SC1='Int. Tab. C, 4.2.6.8, 6.1.1.4'
      IN=13
      IO=15
      CALL INPOUT
      DO 90 I=1,20
90    LA(I)='  '
C-----CIF text for publication
      WRITE(IO,100)
100   FORMAT('data_global'//'_audit_creation_date',16X,'?'/
     1 '_audit_creation_method',10X,'''PARSTCIF'''/
     2 '_audit_update_record',16X,'?'//
     3 '# PROCESSING SUMMARY (IUCr Office Use Only)'//
     4 '_journal_date_recd_electronic       ?'//
     5 '_journal_date_to_coeditor           ?'/
     6 '_journal_date_from_coeditor         ?'/
     7 '_journal_date_accepted              ?'//
     8 '_journal_date_printers_first        ?'/
     9 '_journal_date_printers_final        ?'/
     1 '_journal_date_proofs_out            ?'/
     2 '_journal_date_proofs_in             ?'//
     3 '_journal_coeditor_name              ?'/
     4 '_journal_coeditor_code              ?'/
     5 '_journal_coeditor_notes             ?'//
     6 '_journal_techeditor_code            ?'/
     7 '_iucr_compatibility_tag             ?'/
     8 '_journal_techeditor_notes           ?'//
     9 '_journal_coden_ASTM                 ?'/
     1 '_journal_name_full                  ?'/
     2 '_journal_year                       ?'/
     3 '_journal_volume                     ?'/
     4 '_journal_issue                      ?'/
     5 '_journal_page_first                 ?'/
     6 '_journal_page_last                  ?'//
     7 '_journal_suppl_publ_number          ?'/
     8 '_journal_suppl_publ_pages           ?'//
     9 '# SUBMISSION DETAILS'//
     1 '_publ_contact_author_name',4X,'''Prof. Mario Nardelli'''/
     2 '_publ_contact_author_address'/
     3 '; Dipartimento di Chimica Generale ed Inorganica,'/
     4 '  Chimica Analitica, Chimica Fisica'/2X,
     5 12HUniversit\`a,' degli Studi di Parma'/
     6 '  Viale delle Scienze 78'/'  I-43100 Parma'/'  Italy'/';')
      WRITE(IO,101)
101   FORMAT('_publ_contact_author_email',10X,'''nardelli@ipruniv.cce.'
     1 ,'unipr.it'''/'_publ_contact_author_fax  ',10X,
     2 '''[01039]521 905 557'''/'_publ_contact_author_phone',10X,
     3 '''[01039]521 905 433'''/'_publ_contact_letter'/';'/5X,'Date'//
     4 5X,'Mr. Peter R. Strickland'/5X,'Managing Editor'/
     5 5X,'Acta Crystallographica'/5X,'IUCr Office'/
     6 5X,'5 Abbey Square'/5X,'Chester    CH1 2HU'/5X,'U. K.'//
     7 5X,'Re: Paper submitted to Acta Cryst.'//
     8 5X,'Dear Mr. Strickland,'/
     9 18X,'Attached is a manuscript with the after-mentioned title'/
     1 5X,'and authors, submitted for publication in Acta ',
     2 'Crystallographica C.'/18X,'The requested hard copy material ',
     3 'will be sent by'/5X,'ordinary mail.'//35X,'Yours Sincerely'/
     4 35X,'Mario Nardelli'//';'/'_publ_requested_journal',
     5 13X,'''Acta Cryst. C'''/'_publ_requested_category',19X,'?'/
     6 '_publ_requested_coeditor_name',14X,'?')
      WRITE(IO,102)
102   FORMAT(/'# AUTHOR LIST'//'loop_'/'_publ_author_name'/
     1 '_publ_author_footnote'/'_publ_author_address'/1X,
     2 '''Nardelli, Mario'' .'/'; Dipartimento di Chimica Generale ',
     3 'ed Inorganica, '/'  Chimica Analitica, Chimica Fisica'/2X,
     4 12HUniversit\`a,' degli Studi di Parma'/2X,'Centro di Studio ',
     5 'per la Strutturistica Diffrattometrica del CNR'/
     6 '  Viale delle Scienze 78'/'  I-43100 Parma'/'  Italy'/';')
      WRITE(IO,103)
103   FORMAT(/'# TITLE'//'_publ_section_title'/'; ......'/';'/
     1 '_publ_section_title_footnote'/'; ......'/';'//'# TEXT'//
     2 '_publ_section_abstract'/'; ......'/';'//'_publ_',
     3 'section_comment'/'; ......'/';'//
     4 '_publ_section_acknowledgements'/'; ......'/';'//
     5 '_publ_section_references'/';'/
     6 'Nardelli, M.(1983). Comput. Chem. 7, 95-98.'//
     7 'Nardelli, M.(1991). PARSTCIF. Program for Creating a CIF ',
     8 'from the Output'/'of PARST. University of Parma, Italy.'//
     9 'Nardelli, M.(1995). J. Appl. Cryst. 28, 659.'/';'//
     1 '_publ_section_figure_captions'/'; ......'/';'//
     2 '_publ_section_exptl_prep'/'; ......'/';'//
     3 '_publ_section_exptl_refinement'/'; ......'/';'/
     4 '_computing_data_collection',22X,'?'/
     5 '_computing_cell_refinement',22X,'?'/
     6 '_computing_data_reduction',23X,'?'/
     7 '_computing_structure_solution',19X,'?'/
     8 '_computing_structure_refinement',17X,'?'/
     9 '_computing_molecular_graphics',19X,'?'/
     1 '_computing_publication_material'/';',
     2 ' PARST (Nardelli, 1983, 1995); PARSTCIF (Nardelli, 1991)'/';'/)
C-----Read name of compound and formula
      READ(IN,'(80A1/15A1/10A1/10A1)')TIT,SPG,DUM,DUM
      BRV=SPG(2)
C-----Read lattice constants with e.s.d.'s
      READ(IN,106)C(1),SC(1),A(1),SA(1),C(2),SC(2),A(2),SA(2),
     1 C(3),SC(3),A(3),SA(3),V,SV
106   FORMAT(5X,F8.4,1X,F6.4,33X,F6.2,1X,F4.2/5X,F8.4,1X,F6.4,33X,
     1 F6.2,1X,F4.2/5X,F8.4,1X,F6.4,33X,F6.2,1X,F4.2/5X,F9.2,1X,F5.2)
      DO 1 I=1,9
1     READ(IN,'(10A1)')DUM
C-----Read chemical species and their numbers
      READ(IN,'(20(1X,A2,F4.0))',ERR=87)(LA(L),FA(L),L=1,20)
      GO TO 88
87    BACKSPACE(IN)
      READ(IN,'(20(1X,A2,F6.3,1X))')(LA(L),FA(L),L=1,20)
88    NNS=0
      DO 75 L=1,20
      IF(LA(L).EQ.'  ')GO TO 76
75    NNS=NNS+1
76    BACKSPACE(13)
      READ(IN,'(80A1)')FRM
      CALL FORM(FRM,NCRT)
      CALL FORSUM(NCRT,FRM,NCRT1)
C-----Read M, Z, Dx, F000, mu, lambda, N=number of atoms
      READ(IN,107)AM,Z,DX,F000,AMU,ALA,DUM,N
107   FORMAT(10X,F10.3/13X,F6.2/12X,F9.4/10X,F8.1/12X,F8.3/15X,F9.7/
     1 10A1/20X,I4)
      AMU=AMU*0.1
      DO 2 I=1,3
2     READ(IN,'(10A1)')DUM
C-----Read atomic coordinates with e.s.d.s
      NP=0
      NH=0
      DO 3 I=1,N
      READ(IN,'(1X,6A1,6X,3(F8.5,1X,I5,1X,5X))')ATM1,(X(K),ISX(K),
     1 K=1,3)
C-----Separate non-H from H atoms
      CALL HDR(ATM1,LA1,KD)
      IF(KD.EQ.0)THEN
      NP=NP+1
      DO 16 J=1,3
      ATM(NP,J)=ATM1(J)
      AC(NP,J)=X(J)
16    ISA(NP,J)=ISX(J)
      ATM(NP,4)=ATM1(4)
      ATM(NP,5)=ATM1(5)
      ATM(NP,6)=ATM1(6)
      ELSE
      NH=NH+1
      DO 17 J=1,3
      ATMH(NH,J)=ATM1(J)
      ACH(NH,J)=X(J)
17    ISAH(NH,J)=ISX(J)
      ATMH(NH,4)=ATM1(4)
      ATMH(NH,5)=ATM1(5)
      ATMH(NH,6)=ATM1(6)
      ENDIF
3     CONTINUE
C-----Choose the atomic species
      NS=0
      DO 63 I=1,NP
      DO 59 L=1,6
59    AAAA(L)=ATM(I,L)
      CALL ATTYP(AAAA,NNS,LA1,AA)
60    IF(NS.GT.0) GO TO 66
      NS=NS+1
      SAT(NS,1)=ATM(I,1)
      SAT(NS,2)=AA(2)
      GO TO 63
66    DO 61 J=1,NS
      IF(SAT(J,1).NE.ATM(I,1).OR.SAT(J,2).NE.AA(2)) GO TO 61
      GO TO 63
61    CONTINUE
62    NS=NS+1
      SAT(NS,1)=ATM(I,1)
      SAT(NS,2)=AA(2)
63    CONTINUE
      IF(NH.EQ.0) GO TO 64
      NS=NS+1
      SAT(NS,1)='H'
      SAT(NS,2)=' '
C-----Read dummy lines
64    NN=7
4     READ(IN,'(10A1)',ERR=91,END=91)DUM
      CALL MINUMA1(NN,DUM)
      DO 5 J=1,NN
      IF(DUM(J).NE.STR1(J))GO TO 4
5     CONTINUE
      GO TO 92
91    WRITE(IO,'(/60(''#'')/'' #  Displacement parameters are '',
     1 ''missing in your PARST''/ '' #  CIF cannot be created.''/
     2 60(''#'')/)')
      STOP
92    READ(IN,'(10A1)')DUM
      READ(IN,'(10A1)')DUM
C-----Read atomic anisotropic displacement parameters with e.s.d.s
      NPP=0
      DO 6 I=1,N
      READ(IN,'(7X,6(I5,1X,I4,1X))')(IU(J),ISU(I,J),J=1,6)
      IF(IU(2).EQ.0)THEN
      ICDU(I)=0
      ELSE
      ICDU(I)=1
      NPP=NPP+1
      ENDIF
      DO 6 J=1,6
      IF(IU(J).EQ.0)THEN
      U(I,J)=0.0
      ELSE
      U(I,J)=IU(J)*1E-4
      ENDIF
6     CONTINUE
      DO 7 I=1,4
7     READ(IN,'(10A1)')DUM
C-----Read Ueq, sigma(Ueq), Beq, sigma(Beq), Rmax./Rmin.
      DO 8 I=1,NPP
      READ(IN,120)IUQ,ISUQ(I),B(I),SB(I),RR(I)
120   FORMAT(41X,2(I4,1X),F6.2,1X,F4.2,1X,F7.2)
8     UQ(I)=IUQ*1E-4
      IF(NPP.EQ.NP)GO TO 71
      DO 69 I=NPP+1,NP
      UQ(I)=U(I,1)
69    ISUQ(I)=ISU(I,1)
71    CONTINUE
C-----Print CIF data
      WRITE(IO,104)
104   FORMAT('#',26('-'),' data section of block ',27('-')/'data_(I)'//
     1 '# ATOMIC COORDINATES AND DISPLACEMENT PARAMETERS'/)
C-----Print the anomalous dispersion coefficients
      WRITE(IO,117)
117   FORMAT('loop_'/1X,'_atom_type_symbol'/1X,'_atom_type_number_',
     1 'in_cell'/1X,'_atom_type_description'/1X,'_atom_type_scat_',
     2 'dispersion_real'/1X,'_atom_type_scat_dispersion_imag'/
     3 1X,'_atom_type_scat_source'/'#'/'# symbol number description',
     4 3X,'f''',5X,'f''''',8X,'source'/'#')
C-----Prepare for the table of atomic coordinates
      WRITE(*,156)
156   FORMAT(/' Key in the number of asymmetric units in the unit ',
     1 'cell'/' ?>')
      READ(*,*)Z1
      DO 65 I=1,NS
      AA(1)=SAT(I,1)
      AA(2)=SAT(I,2)
      CALL ANOMDIS(AA,ALA,F1,F2,NMT)
      CALL NUMAT(NP,NH,Z1,SPC,NSP)
      DO 67 J=1,20
      IF(AA(1).NE.SPC(J,1).OR.AA(2).NE.SPC(J,2))GO TO 67
      NUM=NSP(J)
      GO TO 68
67    CONTINUE
68    CALL MINUSC(AA(2))
65    WRITE(IO,138)AA,NUM,NMT,F1,F2,SC1
138   FORMAT('''',2A1,'''',1X,I5,2X,'''',A12,'''',2(F8.4),1X,
     1 '''',A29,'''')
      WRITE(IO,118)
118   FORMAT(/'loop_'/4X,'_atom_site_label'/4X,'_atom_site_fract_x'/
     1 4X,'_atom_site_fract_y'/4X,'_atom_site_fract_z'/
     2 4X,'_atom_site_U_iso_or_equiv'/4X,'_atom_site_adp_type'/
     3 4X,'_atom_site_type_symbol'/4X,'_atom_site_calc_flag'/
     4 4X,'_atom_site_occupancy'/4X,'_atom_site_disorder_group'/'#')
      WRITE(IO,122)
122   FORMAT('#',21X,'Table of coordinates'/'#',21X,20('-')/
     3 '#'/'#label',4X,'x/a',9X,'y/b',9X,'z/c',8X,'Ueq',8X,'tmf',1X,
     4 'typ',1X,'calc sof dis'/)
C-----Print the atomic coordinate table (anisotropic non-H atoms)
      DO 18 I=1,NP
      DO 50 L=1,6
50    AAAA(L)=ATM(I,L)
      CALL ATTYP(AAAA,NNS,LA1,TYP)
      STR4='Uani'
      IF(ICDU(I).EQ.0)STR4='Uiso'
      STR5=' .  '
      IF(ISA(I,1).EQ.0.AND.ISA(I,2).EQ.0.AND.ISA(I,3).EQ.0)STR5='calc'
      DO 54 L=1,4
      ABB(L)=' '
54    AAAA(L)=ATM(I,L)
      AAAA(5)=ATM(I,5)
      AAAA(6)=ATM(I,6)
      ABB(1)='.'
      DO 55 K=1,3
      X(K)=AC(I,K)
      ISX(K)=ISA(I,K)
      IF(ISA(I,K).GE.95.AND.ISA(I,K).LT.100)ISA(I,K)=100
      IF(ISA(I,K).GE.995.AND.ISA(I,K).LT.1000)ISA(I,K)=1000
55    CONTINUE
      UE=UQ(I)
      ISE=ISUQ(I)
      DO 58 K=1,3
      IF(ISX(K).LT.10)GO TO 58
      AAA=ISX(K)
      IF(ISX(K).GE.10.AND.ISX(K).LT.995)ISX(K)=AAA/10+0.5
      IF(ISX(K).GE.995)ISX(K)=AAA/100+0.5
58    CONTINUE
      IF(ISE.LT.10)KDC=2
      IF(ISE.GE.10.AND.ISE.LT.100)KDC=0
      IF(ISE.GE.100.AND.ISE.LT.1000)KDC=1
      IF(ISE.GE.1000)KDC=3
      IF(KDC.EQ.1.OR.KDC.EQ.3)ISE=(ISE+5)/10
      RR1=RR(I)
C     WRITE(IO,'(''TYP= '',2A1)')TYP
      CALL TABCOOR(I,RR1,KDC,ISA,AAAA,X,ISX,UE,ISE,STR4,TYP,STR5,ABB)
18    CONTINUE
C-----Print the atomic coordinate table (H atoms)
      DO 19 I=1,NH
      STR4='Uani'
      IF(ICDU(I+NP).EQ.0)STR4='Uiso'
      STR5=' .  '
      IF(ISAH(I,1).EQ.0.AND.ISAH(I,2).EQ.0.AND.ISAH(I,3).EQ.0)
     1 STR5='calc'
53    DO 56 L=1,4
      ABH(L)=' '
56    AAAA(L)=ATMH(I,L)
      AAAA(5)=ATMH(I,5)
      AAAA(6)=ATMH(I,6)
      ABH(1)='.'
      DO 52 K=1,3
      X(K)=ACH(I,K)
      ISX(K)=ISAH(I,K)
      IF(ISAH(I,K).GE.95.AND.ISAH(I,K).LT.100)ISAH(I,K)=100
      IF(ISAH(I,K).GE.995.AND.ISAH(I,K).LT.1000)ISAH(I,K)=1000
      IF(ISX(K).LT.10)GO TO 52
      AAA=ISX(K)
      IF(ISX(K).GE.10.AND.ISX(K).LT.995)ISX(K)=AAA/10+0.5
      IF(ISX(K).GE.995)ISX(K)=AAA/100+0.5
52    CONTINUE
      UE=U(I+NP,1)
      ISE=ISU(I+NP,1)
      TYP(1)=ATMH(I,1)
      TYP(2)=' '
      IF(ISE.LT.10)KDC=2
      IF(ISE.GE.10.AND.ISE.LT.100)KDC=0
      IF(ISE.GE.100.AND.ISE.LT.1000)KDC=1
      IF(ISE.GE.1000)KDC=3
      IF(KDC.EQ.1.OR.KDC.EQ.3)ISE=(ISE+5)/10
      RR1=1.0
      CALL TABCOOR(I,RR1,KDC,ISAH,AAAA,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
19    CONTINUE
C-----Print anisotropic displacement parameters
      WRITE(IO,125)
125   FORMAT('loop_'/4X,'_atom_site_aniso_label'/4X,'_atom_site_',
     1 'aniso_U_11'/4X,'_atom_site_aniso_U_22'/4X,'_atom_site_aniso_',
     2 'U_33'/4X,'_atom_site_aniso_U_23'/4X,'_atom_site_aniso_U_13'/
     3 4X,'_atom_site_aniso_U_12'//'#label',3X,'U11',9X,'U22',9X,
     4 'U33',9X,'U23',9X,'U13',9X,'U12'/)
      DO 23 I=1,N
      IF(U(I,2).EQ.0.0.AND.U(I,3).EQ.0.0) GO TO 23
      DO 32 K=1,6
32    AAAA(K)=ATM(I,K)
      DO 33 L=1,6
      UU(L)=U(I,L)
33    IUS(L)=ISU(I,L)
      CALL WRTU(AAAA,UU,IUS)
23    CONTINUE
C-----Read bond distances with e.s.d.'s
      WRITE(IO,119)
119   FORMAT(/'# MOLECULAR GEOMETRY'//
     1 'loop_'/'_geom_bond_atom_site_label_1'/
     2 '_geom_bond_atom_site_label_2'/'_geom_bond_distance'/
     3 '_geom_bond_site_symmetry_1'/'_geom_bond_site_symmetry_2'/
     4 '_geom_bond_publ_flag')
      DO 9 I=1,5
9     READ(IN,'(10A1)')DUM
      ND=0
10    READ(IN,'(4A1)')(DUM(K),K=1,4)
      NN=4
      CALL MINUMA1(NN,DUM)
      DO 12 J=1,NN
      IF(DUM(J).NE.STR2(J))GO TO 48
12    CONTINUE
      GO TO 14
48    DO 57 J=1,NN
      IF(DUM(J).NE.STR7(J))GO TO 13
57    CONTINUE
      GO TO 10
13    ND=ND+1
      BACKSPACE(13)
      READ(IN,'(1X,6A1,3X,6A1,1X,F6.4,1X,I4)')((ATP(K,L),L=1,6),
     1 K=1,2),DST,ISDS
C-----Print the table of bond distances
      NAH=0
      DO 11 L=1,6
      ATM1(L)=ATP(1,L)
11    ATM2(L)=ATP(2,L)
      CALL HDR(ATM1,LA1,KD)
      SSTR=' no'
      IF(KD.EQ.0)GO TO 40
      NAH=NAH+1
      DO 45 K=1,6
      ABH1(NAH,K)=ATP(1,K)
45    ABH2(NAH,K)=ATP(2,K)
      IF(ISDS.LT.10)THEN
      WRITE(IO,131)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
131   FORMAT(6A1,1X,6A1,1X,F6.4,'(',I1,')','  .  .  ',A3)
      ELSEIF(ISDS.GE.10.AND.ISDS.LT.94)THEN
      ISDS=(ISDS+5)/10
      WRITE(IO,132)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
132   FORMAT(6A1,1X,6A1,1X,F5.3,'(',I1,')','   .  .  ',A3)
      ELSE
      ISDS=(ISDS+5)/100
      WRITE(IO,133)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
133   FORMAT(6A1,1X,6A1,1X,F4.2,'(',I1,')','    .  .  ',A3)
      ENDIF
40    CALL HDR(ATM2,LA1,KD)
      IF(KD.EQ.0)GO TO 41
C     SSTR='yes'
      NAH=NAH+1
      DO 46 K=1,6
      ABH1(NAH,K)=ATP(2,K)
46    ABH2(NAH,K)=ATP(1,K)
      IF(ISDS.LT.10)THEN
      WRITE(IO,131)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
      ELSEIF(ISDS.LT.94)THEN
      ISDS=(ISDS+5)/10
      WRITE(IO,132)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
      ELSE
      ISDS=(ISDS+5)/100
      WRITE(IO,133)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
      ENDIF
      GO TO 34
41    SSTR=' no'
      IF(ISDS.LT.10)THEN
      WRITE(IO,131)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
      ELSEIF(ISDS.LT.94)THEN
      ISDS=(ISDS+5)/10
      WRITE(IO,132)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
      ELSE
      ISDS=(ISDS+5)/100
      WRITE(IO,133)((ATP(K,L),L=1,6),K=1,2),DST,ISDS,SSTR
      ENDIF
34    CONTINUE
      GO TO 10
14    CONTINUE
C-----Read and print the table of bond angles
      WRITE(IO,137)
137   FORMAT('loop_'/'_geom_angle_atom_site_label_1'/
     1 '_geom_angle_atom_site_label_2'/'_geom_angle_atom_site_label_3'/
     2 '_geom_angle'/'_geom_angle_site_symmetry_1'/
     3 '_geom_angle_site_symmetry_2'/'_geom_angle_site_symmetry_3'/
     4 '_geom_angle_publ_flag')
      DO 35 I=1,5
35    READ(IN,'(10A1)')DUM
      NAN=0
36    READ(IN,'(6A1)')(DUM(K),K=1,6)
      NN=4
      CALL MINUMA1(NN,DUM)
      DO 37 J=1,NN
      IF(DUM(J).NE.STR2(J))GO TO 38
37    CONTINUE
      GO TO 39
38    NAN=NAN+1
      BACKSPACE(13)
C-----Read bond angles with e.s.d.'s
      READ(IN,'(1X,2(6A1,2X),6A1,11X,F6.2,3X,F6.2)')((ATP(K,L),
     1 L=1,6),K=1,3),ANG,SANG
      DO 15 L=1,6
      ATM1(L)=ATP(1,L)
      ATM2(L)=ATP(2,L)
      ATM3(L)=ATP(3,L)
      CALL HDR(ATM1,LA1,KD1)
      CALL HDR(ATM2,LA1,KD2)
15    CALL HDR(ATM3,LA1,KD3)
      SSTR=' no'
C     IF(KD1.EQ.0.AND.KD2.EQ.0.AND.KD3.EQ.0) SSTR='yes'
      IF((SANG+0.05).LT.1.0)THEN
      ISANG=SANG*10+0.5
      WRITE(IO,135)((ATP(K,L),L=1,6),K=1,3),ANG,ISANG,SSTR
135   FORMAT(6A1,1X,6A1,1X,6A1,1X,F5.1,'(',I1,')','  .  .  .  ',A3)
      ELSE
      IANG=ANG+0.5
      ISANG=SANG+0.5
      WRITE(IO,136)((ATP(K,L),L=1,6),K=1,3),IANG,ISANG,SSTR
136   FORMAT(6A1,1X,6A1,1X,6A1,1X,I3,'(',I1,')','    .  .  .  ',A3)
      ENDIF
C42   CONTINUE
      GO TO 36
39    CONTINUE
C-----Read and write the table of torsion angles
      WRITE(IO,124)
124   FORMAT('loop_'/'_geom_torsion_atom_site_label_1'/
     1 '_geom_torsion_atom_site_label_2'/
     2 '_geom_torsion_atom_site_label_3'/
     3 '_geom_torsion_atom_site_label_4'/'_geom_torsion'/
     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 '_geom_torsion_publ_flag')
      DO 24 I=1,5
24    READ(IN,'(10A1)')DUM
      NTR=0
43    READ(IN,'(4A1)')(DUM(K),K=1,4)
      NN=4
      CALL MINUMA1(NN,DUM)
      DO 44 J=1,NN
      IF(DUM(J).NE.STR2(J))GO TO 47
44    CONTINUE
      GO TO 73
47    NTR=NTR+1
      BACKSPACE(13)
C-----Read torsion angles with e.s.d.'s
      READ(IN,'(4(1X,6A1),7X,F7.2,4X,F5.2)')((ATP(K,L),L=1,6),K=1,4),
     1 TOR,STOR
      SSTR=' no'
      IF((STOR+0.05).LT.1.0)THEN
      ISTOR=STOR*10+0.5
      WRITE(IO,141)((ATP(K,L),L=1,6),K=1,4),TOR,ISTOR,SSTR
141   FORMAT(4(6A1,1X),1X,F6.1,'(',I1,')','  .  .  .  .  ',A3)
      ELSE
      ITOR=TOR+0.5
      ISTOR=STOR+0.5
      WRITE(IO,146)((ATP(K,L),L=1,6),K=1,4),ITOR,ISTOR,SSTR
146   FORMAT(4(6A1,1X),1X,I6,'(',I1,')','  .  .  .  .  ',A3)
      ENDIF
      GO TO 43
73    CONTINUE
      WRITE(IO,109)(FRM(L),L=1,80),AM
109   FORMAT(/'# CHEMICAL DATA'//'_chemical_name_systematic'/
     1 '; .....'/';'/'_chemical_formula_analytical',20X,'?'/
     2 '_chemical_formula_moiety',24X,'?'/
     3 '_chemical_formula_structural',20X,'?'/
     3 '_chemical_formula_sum'/80A1/
     4 '_chemical_formula_weight',18X,F9.2/
     5 '_chemical_melting_point',25X,'?'/
     6 '_chemical_compound_source'/'; ......'/';'//'# CRYSTAL DATA'/)
      DO 70 I=1,3
      KKD1=1
      KKD2=I
      XX=C(I)
      SXX=SC(I)
70    CALL ROUNDOFF(KKD1,KKD2,XX,SXX)
      DO 72 I=1,3
      KKD1=2
      KKD2=I
      XX=A(I)
      SXX=SA(I)
72    CALL ROUNDOFF(KKD1,KKD2,XX,SXX)
      KKD1=3
      KKD2=0
      CALL ROUNDOFF(KKD1,KKD2,V,SV)
      WRITE(IO,110)Z
110   FORMAT('_cell_formula_units_Z',25X,F5.2/
     1 '_cell_measurement_temperature',19X,'?'/
     2 '_cell_measurement_radiation',21X,'?'/
     3 '_cell_measurement_wavelength',20X,'?'/
     4 '_cell_measurement_reflns_used',19X,'?'/
     5 '_cell_measurement_theta_min',21X,'?'/
     6 '_cell_measurement_theta_max',21X,'?'/)
      WRITE(IO,111)SPG
111   FORMAT('_symmetry_cell_setting',26X,'?'/
     1 '_symmetry_space_group_name_H-M',15X,'''',15A1,''''/
     2 '_symmetry_Int_Tables_number',21X,'?'/)
      WRITE(IO,112)DX,F000
112   FORMAT(
     1 '_exptl_crystal_description'/'; ......'/';'/'_exptl_crystal_',
     2 'colour',27X,'?'/'_exptl_crystal_size_max',25X,'?'/
     3 '_exptl_crystal_size_mid',25X,'?'/
     4 '_exptl_crystal_size_min',25X,'?'/
     5 '_exptl_crystal_density_diffrn',14X,F9.4/
     6 '_exptl_crystal_density_meas',21X,'?'/
     7 '_exptl_crystal_density_method',19X,'?'/
     8 '_exptl_crystal_F_000',24X,F8.1/)
      WRITE(IO,113)AMU
113   FORMAT('_exptl_absorpt_coefficient_mu',14X,F8.4/
     1 '_exptl_absorpt_correction_type',18X,'?'/
     2 '_exptl_absorpt_process_details',18X,'?'/
     2 '_exptl_absorpt_correction_T_min',17X,'?'/
     3 '_exptl_absorpt_correction_T_max',17X,'?'//
     4 '# EXPERIMENTAL DATA'/)
      WRITE(IO,114)ALA
114   FORMAT('_diffrn_special_details'/'; .......'/';'/
     1 '_diffrn_ambient_temperature',21X,'?'/
     2 '_diffrn_radiation_wavelength',17X,F7.5/
     3 '_diffrn_radiation_type',26X,'?'/
     4 '_diffrn_radiation_source',24X,'?'/
     3 '_diffrn_radiation_monochromator',17X,'?'/
     4 '_diffrn_radiation_detector',22X,'?'/
     5 '_diffrn_measurement_device_type',17X,'?'/
     6 '_diffrn_measurement_method',22X,'?'/
     7 '_diffrn_detector_area_resol_mean',16X,'?'/)
      WRITE(IO,115)
115   FORMAT('_diffrn_standards_number',24X,'?'/
     1 '_diffrn_standards_interval_count',16X,'?'/
     2 '_diffrn_standards_interval_time',17X,'?'/
     3 '_diffrn_standards_decay_%',23X,'?'//'loop_'/4X,
     4 '_diffrn_standard_refln_index_h'/4X,'_diffrn_standard_refln_',
     5 'index_k'/4X,'_diffrn_standard_refln_index_l'/12X,'?  ?  ?'/)
      WRITE(IO,116)
116   FORMAT('_reflns_number_total',28X,'?'/
     1 '_reflns_number_gt',31X,'?'/
     2 '_reflns_threshold_expression',20X,'?'/
     3 '_diffrn_reflns_av_R_equivalents',17X,'?'/
     4 '_diffrn_reflns_av_sigmaI/netI',19X,'?'/
     5 '_diffrn_reflns_limit_h_min',22X,'?'/
     6 '_diffrn_reflns_limit_h_max',22X,'?'/
     7 '_diffrn_reflns_limit_k_min',22X,'?'/
     8 '_diffrn_reflns_limit_k_max',22X,'?'/
     9 '_diffrn_reflns_limit_l_min',22X,'?'/
     1 '_diffrn_reflns_limit_l_max',22X,'?'/
     2 '_diffrn_reflns_number',27X,'?'/
     3 '_diffrn_reflns_theta_min',24X,'?'/
     4 '_diffrn_reflns_theta_max',24X,'?'/
     5 '_diffrn_reflns_theta_full',23X,'?'/
     6 '_diffrn_measured_fraction_theta_max',13X,'?'/
     7 '_diffrn_measured_fraction_theta_full',12X,'?'/
     8 '_reflns_d_resolution_high',23X,'?'/
     9 '_reflns_d_resolution_low',24X,'?'//
     1 '_diffrn_reflns_reduction_process'/'; ......'/';'/)
C-----Details of refinement
      WRITE(IO,127)
127   FORMAT('# REFINEMENT DATA'//
     1 '_refine_special_details'/'; ......'/';'/
     2 '_atom_sites_solution_primary',20X,'?'/
     3 '_atom_sites_solution_secondary',18X,'?'/
     4 '_atom_sites_solution_hydrogens',18X,'?'/
     5 '_refine_ls_hydrogen_treatment',19X,'?'/
     6 '_refine_ls_structure_factor_coef',16X,'?'/
     7 '_refine_ls_matrix_type',26X,'?'/
     8 '_refine_ls_weighting_scheme',21X,'?'/
     9 '_refine_ls_weighting_details',20X,'?'/
     1 '_refine_ls_extinction_method',20X,'?'/
     2 '_refine_ls_extinction_expression',16X,'?'/
     3 '_refine_ls_extinction_coef',22X,'?'/)
C-----Absolute structure
      WRITE(*,153)
153   FORMAT(/' Is the space group acentric ? Y/N'/)
      READ(*,'(A1)')QS
      IF(QS.EQ.'Y'.OR.QS.EQ.'y')WRITE(IO,154)
154   FORMAT('_refine_ls_abs_structure_Flack',18X,'?'/
     1 '_refine_ls_abs_structure_Rogers',17X,'?'//
     2 '_refine_ls_abs_structure_details'/'; ......'/';'/)
      WRITE(IO,155)
155   FORMAT('_refine_ls_number_reflns',24X,'?'/
     1 '_refine_ls_number_parameters',20X,'?'/
     2 '_refine_ls_number_restraints',20X,'?'/
     3 '_refine_ls_number_constraints',19X,'?'/
     4 '_refine_ls_R_factor_all',25X,'?'/
     5 '_refine_ls_R_factor_gt',26X,'?'/
     6 '_refine_ls_wR_factor_all',24X,'?'/
     7 '_refine_ls_wR_factor_ref',24X,'?'/
     8 '_refine_ls_goodness_of_fit_all',18X,'?'/
     9 '_refine_ls_goodness_of_fit_ref',18X,'?'/
     1 '_refine_ls_restrained_S_all',21X,'?'/
     2 '_refine_ls_restrained_S_obs',21X,'?'/
     3 '_refine_ls_shift/su_max',25X,'?'/
     4 '_refine_ls_shift/su_mean',24X,'?'/
     5 '_refine_diff_density_max',24X,'?'/
     6 '_refine_diff_density_min',24X,'?'/
     7 '_refine_diff_density_rms',24X,'?'/)
C-----Print intramolecular contacts less than a given distance
      WRITE(*,147)
147   FORMAT(/' Do you want intramolecular contacts ?'/
     1 ' If yes, key in the maximum value of the distance'/
     2 ' If no,  key in 0'/' ?>')
      READ(*,*)DSTN
      IF(DSTN.LT.1E-1)GO TO 31
      WRITE(*,142)
142   FORMAT(/' Do you want contacts involving hydrogens ? Y/N'/)
      READ(*,'(A1)')QS
      WRITE(IO,128)
128   FORMAT('loop_'/'_geom_contact_atom_site_label_1'/
     1 '_geom_contact_atom_site_label_2'/'_geom_contact_distance'/
     2 '#'/'#',3X,'This is the complete list of first-neighbour ',
     3 'intramolecular distances')
      IF(QS.EQ.'N'.OR.QS.EQ.'n')THEN
      WRITE(IO,144)DSTN
144   FORMAT('#',3X,'less than ',F4.2,' Angstrom for non-H atoms.')
      ELSE
      WRITE(IO,143)DSTN
143   FORMAT('#',3X,'less than ',F4.2,' Angstrom.')
      ENDIF
      WRITE(IO,145)
145   FORMAT('#'/'#',5X,'lab1',4X,'lab2',8X,'distance'/)
      NN=10
25    READ(IN,'(10A1)')DUM
      CALL MINUMA1(NN,DUM)
      DO 26 J=1,NN
      IF(DUM(J).NE.STR6(J))GO TO 25
26    CONTINUE
      DO 27 I=1,4
27    READ(IN,'(10A1)')DUM
28    READ(IN,'(4A1)')(DUM(K),K=1,4)
      NN=4
      CALL MINUMA1(NN,DUM)
      DO 29 J=1,NN
      IF(DUM(J).NE.STR2(J))GO TO 30
29    CONTINUE
      GO TO 31
30    BACKSPACE(13)
      READ(IN,129)ATM1,ATM2,DD,ISDD
129   FORMAT(1X,6A1,3X,6A1,1X,F6.4,1X,I4)
      IF(DD.GT.DSTN)GO TO 28
      ISDD=(ISDD+5)/10
      IF((QS.EQ.'N'.OR.QS.EQ.'n').AND.(ATM1(1).EQ.'H'.OR.ATM2(1).
     1 EQ.'H'))GO TO 28
      IF(ISDD.LT.10)THEN
      WRITE(IO,126)ATM1,ATM2,DD,ISDD
126   FORMAT(6X,6A1,4X,6A1,4X,F5.3,'(',I1,')')
      ELSEIF(ISDD.GE.10.AND.ISDD.LT.100)THEN
      WRITE(IO,130)ATM1,ATM2,DD,ISDD
130   FORMAT(6X,6A1,4X,6A1,4X,F5.3,'(',I2,')')
      ELSEIF(ISDD.GE.100)THEN
      WRITE(IO,148)ATM1,ATM2,DD,ISDD
148   FORMAT(6X,6A1,4X,6A1,4X,F5.3,'(',I3,')')
      ENDIF
      GO TO 28
31    CONTINUE
C-----Read equivalent positions
      WRITE(IO,105)
105   FORMAT('loop_'/'_symmetry_equiv_pos_as_xyz')
      NE=0
      IC=1
77    READ(IN,'(6A1)')(DUM(K),K=1,6)
      NN=6
      CALL MINUMA1(NN,DUM)
      DO 78 J=1,NN
      IF(DUM(J).NE.STR8(J))GO TO 77
78    CONTINUE
79    READ(IN,'(1X,38A1)')(TIT(L),L=1,38)
      DO 86 I=1,4
86    DUM(I)=TIT(I)
      NN=38
      CALL MINUMA1(NN,DUM)
      DO 80 I=1,4
      IF(DUM(I).NE.STR9(I))GO TO 81
80    CONTINUE
      IC=-1
      GO TO 85
81    DO 82 I=1,5
      IF(TIT(I).NE.' ')GO TO 83
82    CONTINUE
      GO TO 85
83    NE=NE+1
      DO 84 I=1,38
84    EQP(I,NE)=TIT(I)
      GO TO 79
85    CONTINUE
C-----Generate the strings of all the equivalent positions
      CALL EQVPS(BRV,EQP,NEP)
C-----Hydrogen bonds
      CALL HYDRCIF(NEP,EQP)
      STOP
      END
 
      SUBROUTINE INPOUT
C-----Assignes the input and output files
      CHARACTER*10 STR1
      CHARACTER*8,STR2
      CHARACTER*14 FILIN
      COMMON/INPOU/IN,IO
      STR1='Key in the'
      STR2='put file'
      WRITE(*,'(1X,A10,'' in'',A8/'' ?>'')')STR1,STR2
      READ(*,'(A14)')FILIN
      OPEN(UNIT=IN,FILE=FILIN,FORM='FORMATTED')
      REWIND(UNIT=IN)
      WRITE(*,'(1X,A10,'' out'',A8/'' ?>'')')STR1,STR2
      READ(*,'(A14)')FILIN
      OPEN(UNIT=IO,FILE=FILIN,FORM='FORMATTED')
      REWIND(UNIT=IO)
      RETURN
      END
 
      SUBROUTINE MINUMA1(NN,STR)
C-----This routine transforms the lower case characters into upper
C-----case characters in a string of NN characters
      CHARACTER*1 MINU(26),MAIU(26),STR(NN)
      COMMON/GRP3/MINU
     1      /GRP4/MAIU
      DO 2 I=1,NN
      DO 1 J=1,26
      IF(STR(I).NE.MINU(J))GO TO 1
      STR(I)=MAIU(J)
      GO TO 2
1     CONTINUE
2     CONTINUE
      RETURN
      END
 
      SUBROUTINE ATTYP(AAAA,NNS,LA1,AA)
C-----This routine finds the atom type from the atom label
      CHARACTER*1 AAAA(6),AA(2),LA1(2,20)
      DO 2 I=1,NNS
      IF(AAAA(1).NE.LA1(1,I))GO TO 2
      AA(1)=AAAA(1)
      DO 1 J=1,NNS
      IF(AAAA(2).NE.LA1(2,J))GO TO 1
      AA(2)=AAAA(2)
      GO TO 3
1     CONTINUE
      AA(2)=' '
      GO TO 3
2     CONTINUE
3     RETURN
      END
 
      SUBROUTINE TABCOOR(I,RR1,KDC,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,
     1 ABH)
C-----Print the Table of the atomic coordinates
      CHARACTER*1 ATM(6),ABH(4),TYP(2)
      CHARACTER*4 STR4,STR5
      DIMENSION X(3),ISX(3),ISA(500,3)
      COMMON/INPOU/IN,IO
      IF(KDC.EQ.1) THEN
      CALL TAB1(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
      RETURN
      ELSEIF(KDC.EQ.2) THEN
      CALL TAB2(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
      RETURN
      ELSEIF(KDC.EQ.3) THEN
      CALL TAB3(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
      RETURN
      ENDIF
      CALL TAB0(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
      RETURN
      END
 
      SUBROUTINE TAB0(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
C-----Print the Table of the atomic coordinates
      CHARACTER*1 ATM(6),ABH(4),TYP(2)
      CHARACTER*4 STR4,STR5
      DIMENSION X(3),ISX(3),ISA(500,3)
      COMMON/INPOU/IN,IO
C-----Sigma(x)<10      sigma(y)<10     sigma(z)<10
      IF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,100)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
100   FORMAT(1X,6A1,1X,3(1X,F8.5,'(',I1,')'),1X,F6.4,'(',I2,')',1X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>10<100      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND.
     1 ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,101)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
101   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I1,')',1X),1X,F6.4,'(',I2,')',1X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)<10      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,102)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
102   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>10<100      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,103)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
103   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F8.5,'(',I1,')',1X,
     1 F7.4,'(',I1,')',2X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>10<100      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,104)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
104   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F8.5,'(',I1,')',
     1 1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>10<100      sigma(y)<10     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,105)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
105   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X ,2(1X,F8.5,'(',I1,')'),
     1 1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)<10      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,106)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
106   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',1X,F7.4,'(',I1,')',2X,
     1 F8.5,'(',I1,')',1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)<10      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).GE.10.
     1 AND.ISA(I,3).LT.100) THEN
      WRITE(IO,107)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
107   FORMAT(1X,6A1,1X,2(1X,F8.5,'(',I1,')'),1X,F7.4,'(',I1,')',2X,
     1 F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     2 THEN
      WRITE(IO,109)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
109   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I2,')'),1X,F6.4,'(',I2,')',1X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>100<1000     sigma(y)>10<100    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,110)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
110   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.AND
     1 .ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,111)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
111   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,F7.4,'(',
     1 I1,')',2X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>10<100     sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND
     1 .ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)THEN
      WRITE(IO,112)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
112   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F7.4,'(',I2,')',
     1 1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>100<1000     sigma(y)>100<1000    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)
     1 THEN
      WRITE(IO,113)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
113   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F7.4,'(',I1,')',2X,
     1 F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>100<1000     sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,1).LT.1000)
     1 THEN
      WRITE(IO,114)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
114   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     1 THEN
      WRITE(IO,115)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
115   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X,2(1X,F7.4,'(',I2,')'),
     1 1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,156)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
156   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',1X,2(1X,F7.4,'(',I2,')'),1X,
     1 F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,157)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
157   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F6.3,'(',I2,')',2X,F7.4,'(',
     1 I2,')',1X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>100<1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,158)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
158   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F6.3,'(',I2,')',2X,
     1 F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.100.
     1 AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,159)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
159   FORMAT(1X,6A1,1X,2(1X,F6.3,'(',I2,')',1X),1X,F7.4,'(',I2,')',1X,
     1 F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,160)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
160   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',2X,F7.4,'(',I2,')',1X,F6.3,'(',
     1 I2,')',2X,F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,161)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
161   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F6.3,'(',I2,')',1X),1X,
     1 F6.4,'(',I2,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C-----Sigma(x)>1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.1000)
     1 THEN
      WRITE(IO,162)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
162   FORMAT(1X,6A1,1X,3(1X,F6.3,'(',I2,')',1X),1X,F6.4,'(',I2,')',1X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      ENDIF
1     RETURN
      END
 
      SUBROUTINE TAB1(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
C-----Print the Table of the atomic coordinates
      CHARACTER*1 ATM(6),ABH(4),TYP(2)
      CHARACTER*4 STR4,STR5
      DIMENSION X(3),ISX(3),ISA(500,3)
      COMMON/INPOU/IN,IO
C*----Sigma(x)<10      sigma(y)<10     sigma(z)<10
      IF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,116)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
116   FORMAT(1X,6A1,1X,3(1X,F8.5,'(',I1,')'),1X,F5.3,'(',I2,')',2X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND.
     1 ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,117)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
117   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I1,')',1X),1X,F5.3,'(',I2,')',2X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)<10      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,118)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
118   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,119)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
119   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F8.5,'(',I1,')',1X,
     1 F7.4,'(',I1,')',2X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,120)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
120   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F8.5,'(',I1,')',
     1 1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)<10     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,121)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
121   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X ,2(1X,F8.5,'(',I1,')'),
     1 1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)<10      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,122)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
122   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',1X,F7.4,'(',I1,')',2X,
     1 F8.5,'(',I1,')',1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)<10      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).GE.10.
     1 AND.ISA(I,3).LT.100) THEN
      WRITE(IO,123)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
123   FORMAT(1X,6A1,1X,2(1X,F8.5,'(',I1,')'),1X,F7.4,'(',I1,')',2X,
     1 F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000   sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     2 THEN
      WRITE(IO,125)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
125   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I2,')'),1X,F5.3,'(',I2,')',2X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000   sigma(y)>10<100    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,126)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
126   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,127)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
127   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,F7.4,'(',
     1 I1,')',2X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100     sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND.
     1 ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,128)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
128   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F7.4,'(',I2,')',
     1 1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000   sigma(y)>100<1000   sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,129)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
129   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F7.4,'(',I1,')',2X,
     1 F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)THEN
      WRITE(IO,130)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
130   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     2 THEN
      WRITE(IO,131)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
131   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X,2(1X,F7.4,'(',I2,')'),
     1 1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,163)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
163   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',1X,2(1X,F7.4,'(',I2,')'),1X,
     1 F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,164)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
164   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F6.3,'(',I2,')',2X,F7.4,'(',
     1 I2,')',1X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,165)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
165   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F6.3,'(',I2,')',2X,
     1 F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.100.
     1 AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,166)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
166   FORMAT(1X,6A1,1X,2(1X,F6.3,'(',I2,')',1X),1X,F7.4,'(',I2,')',1X,
     1 F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,167)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
167   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',2X,F7.4,'(',I2,')',1X,F6.3,'(',
     1 I2,')',2X,F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,168)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
168   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F6.3,'(',I2,')',1X),1X,
     1 F5.3,'(',I2,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.1000)
     1 THEN
      WRITE(IO,169)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
169   FORMAT(1X,6A1,1X,3(1X,F6.3,'(',I2,')',1X),1X,F5.3,'(',I2,')',2X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      ENDIF
1     RETURN
      END
 
      SUBROUTINE TAB2(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
C-----Print the Table of the atomic coordinates
      CHARACTER*1 ATM(6),ABH(4),TYP(2)
      CHARACTER*4 STR4,STR5
      DIMENSION X(3),ISX(3),ISA(500,3)
      COMMON/INPOU/IN,IO
C**---Sigma(x)<10      sigma(y)<10     sigma(z)<10
      IF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,132)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
132   FORMAT(1X,6A1,1X,3(1X,F8.5,'(',I1,')'),1X,F6.4,'(',I1,')',2X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>10<100      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND.
     1 ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,133)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
133   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I1,')',1X),1X,F6.4,'(',I1,')',2X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)<10      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,134)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
134   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>10<100      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,135)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
135   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F8.5,'(',I1,')',1X,
     1 F7.4,'(',I1,')',2X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>10<100      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,136)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
136   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F8.5,'(',I1,')',
     1 1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>10<100      sigma(y)<10     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,137)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
137   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X ,2(1X,F8.5,'(',I1,')'),
     1 1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)<10      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,138)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
138   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',1X,F7.4,'(',I1,')',2X,
     1 F8.5,'(',I1,')',1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)<10      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).GE.10.
     1 AND.ISA(I,3).LT.100) THEN
      WRITE(IO,139)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
139   FORMAT(1X,6A1,1X,2(1X,F8.5,'(',I1,')'),1X,F7.4,'(',I1,')',2X,
     1 F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>100<1000    sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     2 THEN
      WRITE(IO,140)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
140   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I2,')'),1X,F6.4,'(',I1,')',2X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>100<1000     sigma(y)>10<100    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,141)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
141   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.AND
     1 .ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,142)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
142   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,F7.4,'(',
     1 I1,')',2X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>10<100     sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND
     1 .ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)THEN
      WRITE(IO,143)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
143   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F7.4,'(',I2,')',
     1 1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>100<1000    sigma(y)>100<1000    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)
     1 THEN
      WRITE(IO,144)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
144   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F7.4,'(',I1,')',2X,
     1 F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>100<1000   sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     1 THEN
      WRITE(IO,145)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
145   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I1,')',2X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     2 THEN
      WRITE(IO,146)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
146   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X,2(1X,F7.4,'(',I2,')'),
     1 1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,170)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
170   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',1X,2(1X,F7.4,'(',I2,')'),1X,
     1 F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,171)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
171   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F6.3,'(',I2,')',2X,F7.4,'(',
     1 I2,')',1X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>100<1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,172)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
172   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F6.3,'(',I2,')',2X,
     1 F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.100.
     1 AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,173)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
173   FORMAT(1X,6A1,1X,2(1X,F6.3,'(',I2,')',1X),1X,F7.4,'(',I2,')',1X,
     1 F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,174)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
174   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',2X,F7.4,'(',I2,')',1X,F6.3,'(',
     1 I2,')',2X,F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,175)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
175   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F6.3,'(',I2,')',1X),1X,
     1 F6.4,'(',I1,')',2X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C**---Sigma(x)>1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.1000)
     1 THEN
      WRITE(IO,176)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
176   FORMAT(1X,6A1,1X,3(1X,F6.3,'(',I2,')',1X),1X,F6.4,'(',I1,')',2X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      ENDIF
1     RETURN
      END
 
      SUBROUTINE TAB3(I,RR1,ISA,ATM,X,ISX,UE,ISE,STR4,TYP,STR5,ABH)
C-----Print the Table of the atomic coordinates
      CHARACTER*1 ATM(6),ABH(4),TYP(2)
      CHARACTER*4 STR4,STR5
      DIMENSION X(3),ISX(3),ISA(500,3)
      COMMON/INPOU/IN,IO
C*----Sigma(x)<10      sigma(y)<10     sigma(z)<10
      IF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,177)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
177   FORMAT(1X,6A1,1X,3(1X,F8.5,'(',I1,')'),1X,F5.3,'(',I3,')',1X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND.
     1 ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,178)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
178   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I1,')',1X),1X,F5.3,'(',I3,')',1X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)<10      sigma(y)>10<100     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,179)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
179   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100) THEN
      WRITE(IO,180)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
180   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F8.5,'(',I1,')',1X,
     1 F7.4,'(',I1,')',2X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).LT.10) THEN
      WRITE(IO,181)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
181   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F8.5,'(',I1,')',
     1 1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100      sigma(y)<10     sigma(z)<10
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).LT.10.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,182)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
182   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X ,2(1X,F8.5,'(',I1,')'),
     1 1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)<10      sigma(y)>10<100     sigma(z)<10
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).GE.10.AND.ISA(I,2).LT.100.
     1 AND.ISA(I,3).LT.10) THEN
      WRITE(IO,183)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
183   FORMAT(1X,6A1,2X,F8.5,'(',I1,')',1X,F7.4,'(',I1,')',2X,
     1 F8.5,'(',I1,')',1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)<10      sigma(y)<10     sigma(z)>10<100
      ELSEIF(ISA(I,1).LT.10.AND.ISA(I,2).LT.10.AND.ISA(I,3).GE.10.
     1 AND.ISA(I,3).LT.100) THEN
      WRITE(IO,184)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
184   FORMAT(1X,6A1,1X,2(1X,F8.5,'(',I1,')'),1X,F7.4,'(',I1,')',2X,
     1 F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000   sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     2 THEN
      WRITE(IO,185)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
185   FORMAT(1X,6A1,1X,3(1X,F7.4,'(',I2,')'),1X,F5.3,'(',I3,')',1X,A4,
     1 1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000   sigma(y)>10<100    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,186)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
186   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F7.4,'(',I1,')',1X),
     1 1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,187)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
187   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,F7.4,'(',
     1 I1,')',2X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100     sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.10.AND.
     1 ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,188)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
188   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I1,')',1X),1X,F7.4,'(',I2,')',
     1 1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000   sigma(y)>100<1000   sigma(z)>10<100
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.10.AND.ISA(I,3).LT.100)THEN
      WRITE(IO,189)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
189   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F7.4,'(',I1,')',2X,
     1 F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>10<100    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.10.
     1 AND.ISA(I,2).LT.100.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)THEN
      WRITE(IO,190)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
190   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>10<100     sigma(y)>100<1000    sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.10.AND.ISA(I,1).LT.100.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000)
     2 THEN
      WRITE(IO,191)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
191   FORMAT(1X,6A1,2X,F7.4,'(',I1,')',1X,2(1X,F7.4,'(',I2,')'),
     1 1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,192)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
192   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',1X,2(1X,F7.4,'(',I2,')'),1X,
     1 F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.100.AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,193)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
193   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',1X,F6.3,'(',I2,')',2X,F7.4,'(',
     1 I2,')',1X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.100.
     1 AND.ISA(I,2).LT.1000.AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,194)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
194   FORMAT(1X,6A1,1X,2(1X,F7.4,'(',I2,')'),1X,F6.3,'(',I2,')',2X,
     1 F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>1000   sigma(z)>100<1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.100.
     1 AND.ISA(I,3).LT.1000) THEN
      WRITE(IO,195)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
195   FORMAT(1X,6A1,1X,2(1X,F6.3,'(',I2,')',1X),1X,F7.4,'(',I2,')',1X,
     1 F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>100<1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.100.AND.ISA(I,2).LT.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,196)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
196   FORMAT(1X,6A1,2X,F6.3,'(',I2,')',2X,F7.4,'(',I2,')',1X,F6.3,'(',
     1 I2,')',2X,F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>100<1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.100.AND.ISA(I,1).LT.1000.AND.ISA(I,2).GE.1000.
     1 AND.ISA(I,3).GE.1000) THEN
      WRITE(IO,197)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
197   FORMAT(1X,6A1,2X,F7.4,'(',I2,')',2(1X,F6.3,'(',I2,')',1X),1X,
     1 F5.3,'(',I3,')',1X,A4,1X,2A1,1X,A4,2(1X,4A1))
      GO TO 1
C*----Sigma(x)>1000     sigma(y)>1000   sigma(z)>1000
      ELSEIF(ISA(I,1).GE.1000.AND.ISA(I,2).GE.1000.AND.ISA(I,3).GE.1000)
     1 THEN
      WRITE(IO,198)(ATM(K),K=1,6),(X(K),ISX(K),K=1,3),UE,ISE,STR4,TYP,
     1 STR5,(ABH(K),K=1,4),(ABH(K),K=1,4)
198   FORMAT(1X,6A1,1X,3(1X,F6.3,'(',I2,')',1X),1X,F5.3,'(',I3,')',1X,
     1 A4,1X,2A1,1X,A4,2(1X,4A1))
      ENDIF
1     RETURN
      END
 
      SUBROUTINE WRTU(AAAA,UU,IUS)
      CHARACTER*1 AAAA(6)
      DIMENSION UU(6),IUS(6)
      COMMON/INPOU/IN,IO
C-----One sigma(U) > 100
      IF(IUS(1).GE.100.OR.IUS(2).GE.100.OR.IUS(3).GE.100.OR.
     1 IUS(4).GE.100.OR.IUS(5).GE.100.OR.IUS(6).GE.100)THEN
      DO 1 L=1,6
1     IUS(L)=(IUS(L)+5)/10
      CALL WRTU1(AAAA,UU,IUS)
      GO TO 2
      ENDIF
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13<10, sU12<10
      IF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,100)AAAA,(UU(L),IUS(L),L=1,6)
100   FORMAT(6A1,1X,6(F7.4,'(',I1,')',2X))
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,101)AAAA,(UU(L),IUS(L),L=1,6)
101   FORMAT(6A1,1X,6(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,102)AAAA,(UU(L),IUS(L),L=1,6)
102   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,5(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,103)AAAA,(UU(L),IUS(L),L=1,6)
103   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 4(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,104)AAAA,(UU(L),IUS(L),L=1,6)
104   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,
     1 3(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,105)AAAA,(UU(L),IUS(L),L=1,6)
105   FORMAT(6A1,1X,3(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,
     1 2(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,106)AAAA,(UU(L),IUS(L),L=1,6)
106   FORMAT(6A1,1X,4(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')')
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,107)AAAA,(UU(L),IUS(L),L=1,6)
107   FORMAT(6A1,1X,5(F7.4,'(',I2,')',1X),F7.4,'(',I1,')')
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,108)AAAA,(UU(L),IUS(L),L=1,6)
108   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),4(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,109)AAAA,(UU(L),IUS(L),L=1,6)
109   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,
     1 F7.4,'(',I1,')',2X,3(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,110)AAAA,(UU(L),IUS(L),L=1,6)
110   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,111)AAAA,(UU(L),IUS(L),L=1,6)
111   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,3(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')',2X,F7.4,'(',I2,')')
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,112)AAAA,(UU(L),IUS(L),L=1,6)
112   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,4(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')')
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,113)AAAA,(UU(L),IUS(L),L=1,6)
113   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X),
     1 3(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,114)AAAA,(UU(L),IUS(L),L=1,6)
114   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,115)AAAA,(UU(L),IUS(L),L=1,6)
115   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 2(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,F7.4,'(',I2,')')
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,116)AAAA,(UU(L),IUS(L),L=1,6)
116   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 3(F7.4,'(',I2,')',1X),F7.4,'(',I1,')')
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,117)AAAA,(UU(L),IUS(L),L=1,6)
117   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),2(F7.4,'(',I1,')',2X),
     1 2(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,118)AAAA,(UU(L),IUS(L),L=1,6)
118   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')')
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,119)AAAA,(UU(L),IUS(L),L=1,6)
119   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,
     1 2(F7.4,'(',I2,')',1X),F7.4,'(',I1,')')
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,120)AAAA,(UU(L),IUS(L),L=1,6)
120   FORMAT(6A1,1X,3(F7.4,'(',I2,')',1X),2(F7.4,'(',I1,')',2X),
     1 F7.4,'(',I2,')')
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,121)AAAA,(UU(L),IUS(L),L=1,6)
121   FORMAT(6A1,1X,3(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')')
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,122)AAAA,(UU(L),IUS(L),L=1,6)
122   FORMAT(6A1,1X,4(F7.4,'(',I2,')',1X),2(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,123)AAAA,(UU(L),IUS(L),L=1,6)
123   FORMAT(6A1,1X,3(F7.4,'(',I1,')',2X),3(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,124)AAAA,(UU(L),IUS(L),L=1,6)
124   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,
     1 F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,125)AAAA,(UU(L),IUS(L),L=1,6)
125   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),2(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')',2X,F7.4,'(',I2,')')
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,126)AAAA,(UU(L),IUS(L),L=1,6)
126   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),3(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')')
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,127)AAAA,(UU(L),IUS(L),L=1,6)
127   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,
     1 2(F7.4,'(',I1,')',2X),2(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,128)AAAA,(UU(L),IUS(L),L=1,6)
128   FORMAT(6A1,1X,3(F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,129)AAAA,(UU(L),IUS(L),L=1,6)
129   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X),
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')')
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,130)AAAA,(UU(L),IUS(L),L=1,6)
130   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X),
     1 2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')')
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,131)AAAA,(UU(L),IUS(L),L=1,6)
131   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')')
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,132)AAAA,(UU(L),IUS(L),L=1,6)
132   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')')
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,133)AAAA,(UU(L),IUS(L),L=1,6)
133   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,3(F7.4,'(',I1,')',2X),
     1 2(F7.4,'(',I2,')',1X))
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,134)AAAA,(UU(L),IUS(L),L=1,6)
134   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X),
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')')
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,135)AAAA,(UU(L),IUS(L),L=1,6)
135   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X),
     1 2(F7.4,'(',I2,')',1X),F7.4,'(',I1,')')
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,136)AAAA,(UU(L),IUS(L),L=1,6)
136   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')')
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,137)AAAA,(UU(L),IUS(L),L=1,6)
137   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,
     2 F7.4,'(',I1,')')
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,138)AAAA,(UU(L),IUS(L),L=1,6)
138   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 2(F7.4,'(',I2,')',1X),2(F7.4,'(',I1,')',2X))
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,139)AAAA,(UU(L),IUS(L),L=1,6)
139   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),3(F7.4,'(',I1,')',2X),
     1 F7.4,'(',I2,')')
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,140)AAAA,(UU(L),IUS(L),L=1,6)
140   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),2(F7.4,'(',I1,')',2X),
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')')
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,141)AAAA,(UU(L),IUS(L),L=1,6)
141   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X))
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,142)AAAA,(UU(L),IUS(L),L=1,6)
142   FORMAT(6A1,1X,3(F7.4,'(',I2,')',1X),3(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,143)AAAA,(UU(L),IUS(L),L=1,6)
143   FORMAT(6A1,1X,4(F7.4,'(',I1,')',2X),2(F7.4,'(',I2,')',1X))
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,144)AAAA,(UU(L),IUS(L),L=1,6)
144   FORMAT(6A1,1X,3(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,
     1 F7.4,'(',I1,')',2X,F7.4,'(',I2,')')
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,145)AAAA,(UU(L),IUS(L),L=1,6)
145   FORMAT(6A1,1X,3(F7.4,'(',I1,')',2X),2(F7.4,'(',I2,')',1X),
     1 F7.4,'(',I1,')')
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,146)AAAA,(UU(L),IUS(L),L=1,6)
146   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,4(F7.4,'(',I1,')',2X),
     1 F7.4,'(',I2,')')
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,147)AAAA,(UU(L),IUS(L),L=1,6)
147   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,3(F7.4,'(',I1,')',2X),
     1 F7.4,'(',I2,')',1X,F7.4,'(',I1,')')
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,148)AAAA,(UU(L),IUS(L),L=1,6)
148   FORMAT(6A1,1X,2(F7.4,'(',I2,')',1X),4(F7.4,'(',I1,')',2X))
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,149)AAAA,(UU(L),IUS(L),L=1,6)
149   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X,
     1 F7.4,'(',I2,')',1X,3(F7.4,'(',I1,')',2X))
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,150)AAAA,(UU(L),IUS(L),L=1,6)
150   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X),
     1 F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,151)AAAA,(UU(L),IUS(L),L=1,6)
151   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,2(F7.4,'(',I2,')',1X),
     1 3(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,152)AAAA,(UU(L),IUS(L),L=1,6)
152   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,
     1 F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,2(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,153)AAAA,(UU(L),IUS(L),L=1,6)
153   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,
     1 2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,F7.4,'(',I1,')',2X)
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,154)AAAA,(UU(L),IUS(L),L=1,6)
154   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,
     1 3(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X)
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,155)AAAA,(UU(L),IUS(L),L=1,6)
155   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),2(F7.4,'(',I2,')',1X),
     1 2(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,156)AAAA,(UU(L),IUS(L),L=1,6)
156   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,
     1 F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,F7.4,'(',I1,')')
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,157)AAAA,(UU(L),IUS(L),L=1,6)
157   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,
     1 2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X)
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,158)AAAA,(UU(L),IUS(L),L=1,6)
158   FORMAT(6A1,1X,5(F7.4,'(',I1,')',2X),F7.4,'(',I2,')')
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,159)AAAA,(UU(L),IUS(L),L=1,6)
159   FORMAT(6A1,1X,4(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,
     1 F7.4,'(',I1,')')
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,160)AAAA,(UU(L),IUS(L),L=1,6)
160   FORMAT(6A1,1X,3(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,
     1 2(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,161)AAAA,(UU(L),IUS(L),L=1,6)
161   FORMAT(6A1,1X,2(F7.4,'(',I1,')',2X),F7.4,'(',I2,')',1X,
     1 3(F7.4,'(',I1,')',2X))
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,162)AAAA,(UU(L),IUS(L),L=1,6)
162   FORMAT(6A1,1X,F7.4,'(',I1,')',2X,F7.4,'(',I2,')',1X,
     1 4(F7.4,'(',I1,')',2X))
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,163)AAAA,(UU(L),IUS(L),L=1,6)
163   FORMAT(6A1,1X,F7.4,'(',I2,')',1X,5(F7.4,'(',I1,')',2X))
      ENDIF
2     RETURN
      END
 
      SUBROUTINE WRTU1(AAAA,UU,IUS)
C-----Print atomic displacement parameters
C-----One sigma(U) > 100
      CHARACTER*1 AAAA(6)
      DIMENSION UU(6),IUS(6)
      COMMON/INPOU/IN,IO
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13<10, sU12<10
      IF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,100)AAAA,(UU(L),IUS(L),L=1,6)
100   FORMAT(6A1,1X,6(F6.3,'(',I1,')',3X))
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,101)AAAA,(UU(L),IUS(L),L=1,6)
101   FORMAT(6A1,1X,6(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,102)AAAA,(UU(L),IUS(L),L=1,6)
102   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,5(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,103)AAAA,(UU(L),IUS(L),L=1,6)
103   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 4(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,104)AAAA,(UU(L),IUS(L),L=1,6)
104   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,
     1 3(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,105)AAAA,(UU(L),IUS(L),L=1,6)
105   FORMAT(6A1,1X,3(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,
     1 2(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,106)AAAA,(UU(L),IUS(L),L=1,6)
106   FORMAT(6A1,1X,4(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')')
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,107)AAAA,(UU(L),IUS(L),L=1,6)
107   FORMAT(6A1,1X,5(F6.3,'(',I2,')',2X),F6.3,'(',I1,')')
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,108)AAAA,(UU(L),IUS(L),L=1,6)
108   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),4(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,109)AAAA,(UU(L),IUS(L),L=1,6)
109   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,
     1 F6.3,'(',I1,')',3X,3(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,110)AAAA,(UU(L),IUS(L),L=1,6)
110   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,111)AAAA,(UU(L),IUS(L),L=1,6)
111   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,3(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')',3X,F6.3,'(',I2,')')
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,112)AAAA,(UU(L),IUS(L),L=1,6)
112   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,4(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')')
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,113)AAAA,(UU(L),IUS(L),L=1,6)
113   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X),
     1 3(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,114)AAAA,(UU(L),IUS(L),L=1,6)
114   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,115)AAAA,(UU(L),IUS(L),L=1,6)
115   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 2(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,F6.3,'(',I2,')')
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,116)AAAA,(UU(L),IUS(L),L=1,6)
116   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 3(F6.3,'(',I2,')',2X),F6.3,'(',I1,')')
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,117)AAAA,(UU(L),IUS(L),L=1,6)
117   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),2(F6.3,'(',I1,')',3X),
     1 2(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,118)AAAA,(UU(L),IUS(L),L=1,6)
118   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')')
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,119)AAAA,(UU(L),IUS(L),L=1,6)
119   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,
     1 2(F6.3,'(',I2,')',2X),F6.3,'(',I1,')')
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,120)AAAA,(UU(L),IUS(L),L=1,6)
120   FORMAT(6A1,1X,3(F6.3,'(',I2,')',2X),2(F6.3,'(',I1,')',3X),
     1 F6.3,'(',I2,')')
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,121)AAAA,(UU(L),IUS(L),L=1,6)
121   FORMAT(6A1,1X,3(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')')
C-----sU11>10, sU22>10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,122)AAAA,(UU(L),IUS(L),L=1,6)
122   FORMAT(6A1,1X,4(F6.3,'(',I2,')',2X),2(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,123)AAAA,(UU(L),IUS(L),L=1,6)
123   FORMAT(6A1,1X,3(F6.3,'(',I1,')',3X),3(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,124)AAAA,(UU(L),IUS(L),L=1,6)
124   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,
     1 F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,125)AAAA,(UU(L),IUS(L),L=1,6)
125   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),2(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')',3X,F6.3,'(',I2,')')
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,126)AAAA,(UU(L),IUS(L),L=1,6)
126   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),3(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')')
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,127)AAAA,(UU(L),IUS(L),L=1,6)
127   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,
     1 2(F6.3,'(',I1,')',3X),2(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,128)AAAA,(UU(L),IUS(L),L=1,6)
128   FORMAT(6A1,1X,3(F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,129)AAAA,(UU(L),IUS(L),L=1,6)
129   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X),
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')')
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,130)AAAA,(UU(L),IUS(L),L=1,6)
130   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X),
     1 2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')')
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,131)AAAA,(UU(L),IUS(L),L=1,6)
131   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')')
C-----sU11<10, sU22>10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,132)AAAA,(UU(L),IUS(L),L=1,6)
132   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')')
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,133)AAAA,(UU(L),IUS(L),L=1,6)
133   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,3(F6.3,'(',I1,')',3X),
     1 2(F6.3,'(',I2,')',2X))
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,134)AAAA,(UU(L),IUS(L),L=1,6)
134   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X),
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')')
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,135)AAAA,(UU(L),IUS(L),L=1,6)
135   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X),
     1 2(F6.3,'(',I2,')',2X),F6.3,'(',I1,')')
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,136)AAAA,(UU(L),IUS(L),L=1,6)
136   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')')
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,137)AAAA,(UU(L),IUS(L),L=1,6)
137   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,
     2 F6.3,'(',I1,')')
C-----sU11>10, sU22<10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,138)AAAA,(UU(L),IUS(L),L=1,6)
138   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 2(F6.3,'(',I2,')',2X),2(F6.3,'(',I1,')',3X))
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,139)AAAA,(UU(L),IUS(L),L=1,6)
139   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),3(F6.3,'(',I1,')',3X),
     1 F6.3,'(',I2,')')
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,140)AAAA,(UU(L),IUS(L),L=1,6)
140   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),2(F6.3,'(',I1,')',3X),
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')')
C-----sU11>10, sU22>10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,141)AAAA,(UU(L),IUS(L),L=1,6)
141   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X))
C-----sU11>10, sU22>10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,142)AAAA,(UU(L),IUS(L),L=1,6)
142   FORMAT(6A1,1X,3(F6.3,'(',I2,')',2X),3(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13>10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,143)AAAA,(UU(L),IUS(L),L=1,6)
143   FORMAT(6A1,1X,4(F6.3,'(',I1,')',3X),2(F6.3,'(',I2,')',2X))
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,144)AAAA,(UU(L),IUS(L),L=1,6)
144   FORMAT(6A1,1X,3(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,
     1 F6.3,'(',I1,')',3X,F6.3,'(',I2,')')
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,145)AAAA,(UU(L),IUS(L),L=1,6)
145   FORMAT(6A1,1X,3(F6.3,'(',I1,')',3X),2(F6.3,'(',I2,')',2X),
     1 F6.3,'(',I1,')')
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,146)AAAA,(UU(L),IUS(L),L=1,6)
146   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,4(F6.3,'(',I1,')',3X),
     1 F6.3,'(',I2,')')
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,147)AAAA,(UU(L),IUS(L),L=1,6)
147   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,3(F6.3,'(',I1,')',3X),
     1 F6.3,'(',I2,')',2X,F6.3,'(',I1,')')
C-----sU11>10, sU22>10, sU33<10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,148)AAAA,(UU(L),IUS(L),L=1,6)
148   FORMAT(6A1,1X,2(F6.3,'(',I2,')',2X),4(F6.3,'(',I1,')',3X))
C-----sU11>10, sU22<10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,149)AAAA,(UU(L),IUS(L),L=1,6)
149   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X,
     1 F6.3,'(',I2,')',2X,3(F6.3,'(',I1,')',3X))
C-----sU11>10, sU22<10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,150)AAAA,(UU(L),IUS(L),L=1,6)
150   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X),
     1 F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22>10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,151)AAAA,(UU(L),IUS(L),L=1,6)
151   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,2(F6.3,'(',I2,')',2X),
     1 3(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22>10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,152)AAAA,(UU(L),IUS(L),L=1,6)
152   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,
     1 F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,2(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,153)AAAA,(UU(L),IUS(L),L=1,6)
153   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,
     1 2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,F6.3,'(',I1,')',3X)
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,154)AAAA,(UU(L),IUS(L),L=1,6)
154   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,
     1 3(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X)
C-----sU11<10, sU22<10, sU33>10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,155)AAAA,(UU(L),IUS(L),L=1,6)
155   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),2(F6.3,'(',I2,')',2X),
     1 2(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,156)AAAA,(UU(L),IUS(L),L=1,6)
156   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,
     1 F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,F6.3,'(',I1,')')
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,157)AAAA,(UU(L),IUS(L),L=1,6)
157   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,
     1 2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')')
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13<10, sU12>10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).GE.10)THEN
      WRITE(IO,158)AAAA,(UU(L),IUS(L),L=1,6)
158   FORMAT(6A1,1X,5(F6.3,'(',I1,')',3X),F6.3,'(',I2,')')
C-----sU11<10, sU22<10, sU33<10, sU23<10, sU13>10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).GE.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,159)AAAA,(UU(L),IUS(L),L=1,6)
159   FORMAT(6A1,1X,4(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,
     1 F6.3,'(',I1,')')
C-----sU11<10, sU22<10, sU33<10, sU23>10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).GE.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,160)AAAA,(UU(L),IUS(L),L=1,6)
160   FORMAT(6A1,1X,3(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,
     1 2(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22<10, sU33>10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).LT.10.AND.IUS(3).GE.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,161)AAAA,(UU(L),IUS(L),L=1,6)
161   FORMAT(6A1,1X,2(F6.3,'(',I1,')',3X),F6.3,'(',I2,')',2X,
     1 3(F6.3,'(',I1,')',3X))
C-----sU11<10, sU22>10, sU33<10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).LT.10.AND.IUS(2).GE.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,162)AAAA,(UU(L),IUS(L),L=1,6)
162   FORMAT(6A1,1X,F6.3,'(',I1,')',3X,F6.3,'(',I2,')',2X,
     1 4(F6.3,'(',I1,')',3X))
C-----sU11>10, sU22<10, sU33<10, sU23<10, sU13<10, sU12<10
      ELSEIF(IUS(1).GE.10.AND.IUS(2).LT.10.AND.IUS(3).LT.10.AND.
     1 IUS(4).LT.10.AND.IUS(5).LT.10.AND.IUS(6).LT.10)THEN
      WRITE(IO,163)AAAA,(UU(L),IUS(L),L=1,6)
163   FORMAT(6A1,1X,F6.3,'(',I2,')',2X,5(F6.3,'(',I1,')',3X))
      ENDIF
2     RETURN
      END
 
      SUBROUTINE ANOMDIS(AA,ALA,F1,F2,NMT)
C-----Find the anomalous dispersion coefficients, f' and f", for the
C-----atom AA  (2A1)
      CHARACTER*1 AA(2),ATM(98,2),AA2
      CHARACTER*12 NOMAT(98),NMT
      DIMENSION FCU(98,2),FMO(98,2)
      DATA ((FCU(I,J),J=1,2),I=1,52)/.0,.0,.0,.0,.0008,.0003,.0038,
     1 .0014,.0090,.0039,.0181,.0091,.0311,.0180,.0492,.0322,.0727,
     2 .0534,.1019,.0833,.1353,.1239,.1719,.1771,.2130,.2455,.2541,
     3 .3302,.2955,.4335,.3331,.5567,.3639,.7018,.3843,.8717,.3868,
     4 1.0657,.3641,1.2855,.3119,1.5331,.2191,1.8069,.0687,2.1097,
     5 -.1635,2.4439,-.5299,2.8052,-1.1336,3.1974,-2.3653,3.6143,
     6 -3.0029,.5091,-1.9646,.5888,-1.5491,.6778,-1.2846,.7763,-1.0885,
     7 .8855,-0.9300,1.0051,-.7943,1.1372,-.6763,1.2805,-.5657,1.4385,
     8 -.4688,1.6079,-.3528,1.8200,-.2670,2.0244,-.1862,2.2449,-.1121,
     9 2.4826,-.0483,2.7339,.0057,3.0049,.0552,3.2960,.0927,3.6045,
     1 .1215,3.9337,.1306,4.2820,.1185,4.6533,.0822,5.0449,.0259,
     2 5.4591,-.0562,5.8946,-.1759,6.3531/
      DATA ((FCU(I,J),J=1,2),I=53,96)/-.3257,6.8362,-.5179,7.3500,
     1 -0.7457,7.9052,-1.0456,8.4617,-1.4094,9.0376,-1.8482,9.6596,
     2 -2.4164,10.2820,-3.1807,10.9079,-4.0598,11.5523,-5.3236,12.2178,
     3 -8.9294,11.1857,-8.8380,11.9157,-9.1472,9.1891,-9.8046,9.8477,
     4 -14.9734,3.7046,-9.4367,3.9380,-8.0393,4.1821,-7.2108,4.4329,
     5 -6.6179,4.6937,-6.1794,4.9776,-5.7959,5.2718,-5.4734,5.5774,
     6 -5.2083,5.8923,-4.9801,6.2216,-4.7710,6.5667,-4.5932,6.9264,
     7 -4.4197,7.2980,-4.2923,7.6849,-4.1627,8.0900,-4.0753,8.5060,
     8 -4.0111,8.9310,-3.9670,9.3834,-3.9588,9.8433,-3.9487,10.3181,
     9 -3.9689,10.8038,-4.0088,11.2969,-4.0794,11.7994,-4.1491,12.3296,
     1 -4.2473,12.8681,-4.3638,13.4090,-4.5053,13.9666,-4.6563,14.3729,
     2 -4.8483,15.0877,-5.0611,15.6355/
      DATA ((FCU(I,J),J=1,2),I=97,98)/-5.3481,16.3190,-5.5545,16.7428/
      DATA ((FMO(I,J),J=1,2),I=1,52)/.0,.0,.0,.0,-.0003,.0001,.0005,
     1 .0002,.0013,.0007,.0033,.0016,.0061,.0033,.0106,.0060,.0171,
     2 .0103,.0259,.0164,.0362,.0249,.0486,.0363,.0645,.0514,.0817,
     3 .0704,.1023,.0942,.1246,.1234,.1484,.1585,.1743,.2003,.2009,
     4 .2494,.2262,.3064,.2519,.3716,.2776,.4457,.3005,.5294,.3209,
     5 .6236,.3368,.7283,.3463,.8444,.3494,.9721,.3393,1.1124,.3201,
     6 1.2651,.2839,1.4301,.2307,1.6083,.1547,1.8001,.0499,2.0058,
     7 -.0929,2.2259,-.2901,2.4595,-.5574,2.7079,-.9393,2.9676,-1.5307,
     8 3.2498,-2.7962,3.5667,-2.9673,.5597,-2.0727,.6215,-1.6832,.6857,
     9 -1.4390,.7593,-1.2594,.8363,-1.1178,.9187,-.9988,1.0072,-.8971,
     1 1.1015,-.8075,1.2024,-.7276,1.3100,-.6537,1.4246,-.5866,1.5461,
     2 -.5308,1.6751/
      DATA ((FMO(I,J),J=1,2),I=53,98)/-.4742,1.8119,-.4205,1.9578,
     1 -.3680,2.1192,-.3244,2.2819,-.2871,2.4523,-.2486,2.6331,-.2180,
     2 2.8214,-.1943,3.0179,-.1753,3.2249,-.1638,3.4418,-.1578,3.6682,
     3 -.1653,3.9035,-.1723,4.1537,-.1892,4.4098,-.2175,4.6783,-.2586,
     4 4.9576,-.3139,5.2483,-.3850,5.5486,-.4720,5.8584,-.5830,6.1852,
     5 -.7052,6.5227,-.8490,6.8722,-1.0185,7.2310,-1.2165,7.6030,
     6 -1.4442,7.9887,-1.7033,8.3905,-2.0133,8.8022,-2.3894,9.2266,
     7 -2.8358,9.6688,-3.3944,10.1111,-4.1077,10.2566,-5.1210,11.0496,
     7 -7.9122,9.9777,-8.0659,10.4580,-7.2224,7.7847,-6.7704,8.1435,
     8 -6.8494,8.5178,-7.2400,8.8979,-8.0334,9.2807,-9.6767,9.6646,
     9 -11.4937,4.1493,-9.4100,4.3056,-7.8986,4.5125,-7.3248,4.6980,
     1 -6.8498,4.9086,-6.6561,5.0785/
      DATA ((ATM(I,J),J=1,2),I=1,52)/'H',' ','H','E','L','I','B','E',
     1 'B',' ','C',' ','N',' ','O',' ','F',' ','N','E','N','A','M','G',
     2 'A','L','S','I','P',' ','S',' ','C','L','A','R','K',' ','C','A',
     3 'S','C','T','I','V',' ','C','R','M','N','F','E','C','O','N','I',
     4 'C','U','Z','N','G','A','G','E','A','S','S','E','B','R','K','R',
     5 'R','B','S','R','Y',' ','Z','R','N','B','M','O','T','C','R','U',
     6 'R','H','P','D','A','G','C','D','I','N','S','N','S','B','T','E'/
      DATA ((ATM(I,J),J=1,2),I=53,98)/'I',' ','X','E','C','S','B','A',
     1 'L','A','C','E','P','R','N','D','P','M','S','M','E','U','G','D',
     2 'T','B','D','Y','H','O','E','R','T','M','Y','B','L','U','H','F',
     3 'T','A','W',' ','R','E','O','S','I','R','P','T','A','U','H','G',
     4 'T','L','P','B','B','I','P','O','A','T','R','N','F','R','R','A',
     5 'A','C','T','H','P','A','U',' ','N','P','P','U','A','M','C','M',
     6 'B','K','C','F'/
      DATA (NOMAT(I),I=1,38)/'Hydrogen    ','Helium      ',
     1 'Lithium     ','Berillium   ','Boron       ','Carbon      ',
     2 'Nitrogen    ','Oxygen      ','Fluorine    ','Neon        ',
     3 'Sodium      ','Magnesium   ','Aluminium   ','Silicium    ',
     4 'Phosphorus  ','Sulphur     ','Chlorine    ','Argon       ',
     5 'Potassium   ','Calcium     ','Scandium    ','Titanium    ',
     6 'Vanadium    ','Chromium    ','Manganese   ','Iron        ',
     7 'Cobalt      ','Nickel      ','Copper      ','Zinc        ',
     8 'Gallium     ','Germanium   ','Arsenic     ','Selenium    ',
     9 'Bromine     ','Krypton     ','Rubidium    ','Strontium   '/
      DATA (NOMAT(I),I=39,76)/'Yttrium     ','Zirconium   ',
     1 'Niobium     ','Molibdenum  ','Technetium  ','Ruthenium   ',
     2 'Rhodium     ','Palladium   ','Siver       ','Cadmium     ',
     3 'Indium      ','Tin         ','Antimony    ','Tellurium   ',
     4 'Iodine      ','Xenon       ','Caesium     ','Barium      ',
     5 'Lanthanum   ','Cerium      ','Praseodymium','Neodimium   ',
     6 'Promethium  ','Samarium    ','Europium    ','Gadolinium  ',
     7 'Terbium     ','Dysprosium  ','Holmium     ','Erbium      ',
     8 'Thulium     ','Ytterbium   ','Lutetium    ','Hafnium     ',
     9 'Tantalum    ','Tungsten    ','Rhenium     ','Osmium      '/
      DATA (NOMAT(I),I=77,98)/'Iridium     ','Platinum    ',
     1 'Gold        ','Mercury     ','Thallium    ','Lead        ',
     2 'Bismuth     ','Polonium    ','Astatine    ','Radon       ',
     3 'Francium    ','Radium      ','Actinium    ','Thorium     ',
     4 'Protactinium','Uranium     ','Neptunium   ','Plutonium   ',
     5 'Americium   ','Curium      ','Berkelium   ','Californium '/
      AA2=AA(2)
      CALL MINUMA1(1,AA2)
      DO 1 I=1,98
      IF(AA(1).NE.ATM(I,1))GO TO 1
      IF(AA2.NE.ATM(I,2))GO TO 1
      NMT=NOMAT(I)
      IF(ALA.GT.1.0)THEN
      F1=FCU(I,1)
      F2=FCU(I,2)
      ELSE
      F1=FMO(I,1)
      F2=FMO(I,2)
      ENDIF
      GO TO 2
1     CONTINUE
2     RETURN
      END
 
      SUBROUTINE NUMAT(NP,NH,Z,SPC,NSP)
C-----Count the number of atoms of each species in the unit cell
      CHARACTER*1 ATM(500,6),STR3(11),BP(500,2),SPC(20,2)
      DIMENSION NSP(20)
      COMMON/GRP1/ATM
     1      /GRP2/STR3
      DO 2 I=1,NP
      BP(I,1)=ATM(I,1)
      DO 1 J=1,11
      IF(ATM(I,2).NE.STR3(J))GO TO 1
      BP(I,2)=' '
      GO TO 2
1     CONTINUE
      BP(I,2)=ATM(I,2)
2     CONTINUE
      SPC(1,1)=BP(1,1)
      SPC(1,2)=BP(1,2)
      NS=1
      DO 5 I=2,NP
      DO 4 J=1,NS
      IF(BP(I,1).NE.SPC(J,1).OR.BP(I,2).NE.SPC(J,2))GO TO 4
      GO TO 5
4     CONTINUE
      NS=NS+1
      SPC(NS,1)=BP(I,1)
      SPC(NS,2)=BP(I,2)
5     CONTINUE
      DO 6 I=1,NS
      NSP(I)=0
      DO 6 J=1,NP
      IF(SPC(I,1).NE.BP(J,1).OR.SPC(I,2).NE.BP(J,2))GO TO 6
      NSP(I)=NSP(I)+1
6     CONTINUE
      DO 7 I=1,NS
7     NSP(I)=NSP(I)*Z
      SPC(NS+1,1)='H'
      SPC(NS+1,2)=' '
      NSP(NS+1)=NH*Z
      RETURN
      END
 
      BLOCK DATA
      CHARACTER*1 STR3(11),MINU(26),MAIU(26),STR8(6)
      COMMON/GRP2/STR3
     1      /GRP3/MINU
     2      /GRP4/MAIU
     3      /INS1/STR8
      DATA MINU/'a','b','c','d','e','f','g','h','i','j','k','l','m',
     1 'n','o','p','q','r','s','t','u','v','w','x','y','z'/
      DATA MAIU/'A','B','C','D','E','F','G','H','I','J','K','L','M',
     1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/
      DATA STR3/'0','1','2','3','4','5','6','7','8','9',' '/
      DATA STR8/' ','E','Q','U','I','V'/
      END
 
      SUBROUTINE MINUSC(AA)
      CHARACTER*1 AA,MINU(26),MAIU(26)
      COMMON/GRP3/MINU
     1      /GRP4/MAIU
      DO 1 I=1,26
      IF(AA.NE.MAIU(I))GO TO 1
      AA=MINU(I)
      GO TO 2
1     CONTINUE
2     RETURN
      END
 
      SUBROUTINE HDR(ATM,LA1,KD)
C-----This subroutine sets KD=0 for a non-H atom
      CHARACTER*1 ATM(6),LA1(2,20),AA2,AAL
      KD=0
      AA2=ATM(2)
      CALL MINUMA1(1,AA2)
      IF(ATM(1).NE.'H') GO TO 3
      DO 1 I=1,20
      AAL=LA1(2,I)
      CALL MINUMA1(1,AAL)
      IF(ATM(1).EQ.LA1(1,I).AND.AA2.EQ.AAL) GO TO 2
1     CONTINUE
      KD=1
      GO TO 3
2     IF(AAL.NE.' ') GO TO 3
      KD=1
3     RETURN
      END
 
      SUBROUTINE ROUNDOFF(KD1,KD2,X,SX)
C-----Write the cell constants and volume with rounded off e.s.d.'s
      CHARACTER*1 AA
      CHARACTER*5 BB
      DIMENSION N(5)
      COMMON/INPOU/IN,IO
      DO 1 I=1,5
      SS=(10.0)**I/10.0
      N(I)=SX*SS+0.000005
1     CONTINUE
      IF(N(1).NE.0)THEN
      IS=(SX+0.5)
      KK=1
      GO TO 6
      ELSEIF(N(2).NE.0)THEN
      IS=(SX+0.05)*10
      KK=2
      GO TO 6
      ELSEIF(N(3).NE.0)THEN
      IS=(SX+0.005)*100
      KK=3
      GO TO 6
      ELSEIF(N(4).NE.0)THEN
      IS=(SX+0.0005)*1000
      KK=4
      GO TO 6
      ELSEIF(N(5).NE.0)THEN
      IS=(SX+0.00005)*10000
      KK=5
6     ENDIF
      IF(KD1.EQ.3)GO TO 4
      IF(KD1.EQ.2)GO TO 2
C-----Cell lengths
      IF(KD2.EQ.1)AA='a'
      IF(KD2.EQ.2)AA='b'
      IF(KD2.EQ.3)AA='c'
      IF(KK.EQ.1)WRITE(IO,100)AA,X,IS
100   FORMAT(/'_cell_length_',A1,34X,F4.0,'(',I1,')')
      IF(KK.EQ.2)WRITE(IO,101)AA,X,IS
101   FORMAT('_cell_length_',A1,31X,F5.1,'(',I1,')')
      IF(KK.EQ.3)WRITE(IO,102)AA,X,IS
102   FORMAT('_cell_length_',A1,31X,F6.2,'(',I1,')')
      IF(KK.EQ.4)WRITE(IO,103)AA,X,IS
103   FORMAT('_cell_length_',A1,31X,F7.3,'(',I1,')')
      IF(KK.EQ.5)WRITE(IO,104)AA,X,IS
104   FORMAT('_cell_length_',A1,31X,F8.4,'(',I1,')')
      GO TO 5
C-----Cell angles
2     IF(KD2.EQ.1)BB='alpha'
      IF(KD2.EQ.2)BB='beta '
      IF(KD2.EQ.3)BB='gamma'
      IF(SX.LT.0.005)IS=0
      IF(SX.GE.0.005.AND.SX.LE.0.01)IS=1
      IF(KK.GT.3) KK=3
      IF(KK.EQ.1)WRITE(IO,105)BB,X,IS
105   FORMAT('_cell_angle_',A5,28X,F4.0,'(',I1,')')
      IF(KK.EQ.2)WRITE(IO,106)BB,X,IS
106   FORMAT('_cell_angle_',A5,28X,F5.1,'(',I1,')')
      IF(KK.EQ.3)WRITE(IO,107)BB,X,IS
107   FORMAT('_cell_angle_',A5,28X,F6.2,'(',I1,')')
      GO TO 5
C-----Cell volume
4     IF(SX.LT.0.001)IS=0
      IF(KK.GT.3) KK=3
      IF(KK.EQ.1)WRITE(IO,108)X,IS
108   FORMAT('_cell_volume',30X,F7.0,'(',I1,')')
      IF(KK.EQ.2)WRITE(IO,109)X,IS
109   FORMAT('_cell_volume',30X,F8.1,'(',I1,')')
      IF(KK.EQ.3)WRITE(IO,110)X,IS
110   FORMAT('_cell_volume',30X,F9.2,'(',I1,')')
5     RETURN
      END
 
      SUBROUTINE FORM(STR,NCRT)
C-----Eliminates blanks from the chemical formula string
      CHARACTER*1 STR(80)
      DO 1 I=1,79
1     IF(STR(I).EQ.'.'.AND.STR(I+1).EQ.' ')STR(I)=' '
      DO 3 K=1,4
      DO 3 I=1,80
      IF(STR(I).EQ.' ')THEN
      DO 2 J=I,79
      STR(J)=STR(J+1)
2     STR(J+1)=' '
      ENDIF
3     CONTINUE
      NN=0
      DO 4 I=1,80
4     IF(STR(I).NE.' ')NN=NN+1
      DO 5 I=1,80
5     STR(80-I+1)=STR(80-I)
      STR(1)=''''
      STR(NN+2)=''''
      NCRT=NN+2
      RETURN
      END
 
      SUBROUTINE LABCOO(N,STR,STR1)
C-----Transforms X,Y,Z upper case to x,y,z low case in a N character
C-----string
      CHARACTER*1 STR(N),STR1(N)
      DO 1 I=1,N
      STR1(I)=STR(I)
      IF(STR(I).EQ.'X')THEN
      STR1(I)='x'
      ELSEIF(STR(I).EQ.'Y')THEN
      STR1(I)='y'
      ELSEIF(STR(I).EQ.'Z')THEN
      STR1(I)='z'
      ENDIF
1     CONTINUE
      RETURN
      END
 
      SUBROUTINE EQVPS(BRV,EQP,NEP)
C-----This routine generates the equivalent positions
      CHARACTER*1 STR(38),BRV,EQP(38,192),STR1(38)
      INTEGER LE1(192,3,3),LE(3,3)
      DIMENSION B(3,3),F1(192,3),F(3),FB(3)
      COMMON/EQVP/LE1,F1,FB
     3      /INPOU/IN,IO
     4      /EDAT/IC,NE
     5      /BRAV/KB,B
      DO 16 I=1,192
      DO 16 J=1,3
      F1(I,J)=0.0
      DO 16 K=1,3
16    LE1(I,J,K)=0
      IF(NE.EQ.1)GO TO 12
      DO 1 I=2,NE
      DO 8 L=1,38
8     STR(L)=EQP(L,I)
      CALL DECEQP(STR,LE,F)
      NST=38
      CALL LABCOO(NST,STR,STR1)
      DO 1 J=1,3
      F1(I,J)=F(J)
      LE1(1,J,J)=1
      DO 1 K=1,3
1     LE1(I,J,K)=LE(J,K)
      GO TO 14
12    DO 13 J=1,3
13    LE1(1,J,J)=1
14    CONTINUE
      DO 19 I=1,3
      DO 19 J=1,3
19    B(I,J)=0.0
      KB=0
      IF(BRV.EQ.'P') GO TO 7
      IF(BRV.NE.'A') GO TO 2
      B(1,2)=1./2.
      B(1,3)=1./2.
      KB=1
      GO TO 7
2     IF(BRV.NE.'B') GO TO 3
      B(1,1)=1./2.
      B(1,3)=1./2.
      KB=1
      GO TO 7
3     IF(BRV.NE.'C') GO TO 4
      B(1,1)=1./2.
      B(1,2)=1./2.
      KB=1
      GO TO 7
4     IF(BRV.NE.'I') GO TO 5
      B(1,1)=1./2.
      B(1,2)=1./2.
      B(1,3)=1./2.
      KB=1
      GO TO 7
5     IF(BRV.NE.'R') GO TO 6
      B(1,1)=1./3.
      B(2,2)=1./3.
      B(2,3)=1./3.
      B(1,2)=2*B(1,1)
      B(1,3)=2*B(1,1)
      B(2,1)=2*B(1,1)
      KB=2
      GO TO 7
6     B(1,2)=1./2.
      B(1,3)=1./2.
      B(2,1)=1./2.
      B(2,3)=1./2.
      B(3,1)=1./2.
      B(3,2)=1./2.
      KB=3
7     CONTINUE
      DO 17 L=1,3
17    FB(L)=0.0
      CALL DISCON(NEP,EQP)
      IF(KB.EQ.0)GO TO 11
      DO 10 L=1,KB
      DO 9  K=1,3
9     FB(K)=B(L,K)
      CALL DISCON(NEP,EQP)
10    CONTINUE
11    CONTINUE
      RETURN
      END
 
      SUBROUTINE DISCON(NEP,EQP)
C-----Add lattice translations to the equivalent positions
      CHARACTER*1 EQP(38,192),STR(38)
      INTEGER LE1(192,3,3),FT(3),LE(3,3)
      DIMENSION F1(192,3),FB(3),F(3)
      COMMON/EQVP/LE1,F1,FB
     1      /EDAT/IC,NE
      NEP=0
      DO 3 I=1,NE
      DO 1 J=1,3
      F(J)=F1(I,J)+FB(J)
      DO 1 K=1,3
1     LE(J,K)=LE1(I,J,K)
      CALL PEQV(LE,F,STR)
      NEP=NEP+1
      DO 4 L=1,38
4     EQP(L,NEP)=STR(L)
      IF(IC.NE.-1) GO TO 3
      DO 2 J=1,3
      F(J)=-F1(I,J)+FB(J)
      DO 2 K=1,3
2     LE(J,K)=-LE1(I,J,K)
      CALL PEQV(LE,F,STR)
      NEP=NEP+1
      DO 5 L=1,38
5     EQP(L,NEP)=STR(L)
3     CONTINUE
      RETURN
      END
 
      SUBROUTINE PEQV(LE,F,STR)
C-----This routine prints a string of an equivalent position
      CHARACTER*1 STR(38),STR1(38)
      INTEGER LE(3,3)
      DIMENSION F(3)
      COMMON/INPOU/IN,IO
      CALL EQPDEC(LE,F,STR)
      NST=38
      CALL LABCOO(NST,STR,STR1)
      IF(STR1(1).EQ.'+')STR1(1)=' '
      DO 1 I=1,38
C---- -1/2 > +1/2
      IF(STR1(I).EQ.'-'.AND.STR1(I+1).EQ.'1'.AND.STR1(I+2).EQ.'/'
     1 .AND.STR1(I+3).EQ.'2')STR1(I)='+'
C---- -1/3 > +2/3
      IF(STR1(I).EQ.'-'.AND.STR1(I+1).EQ.'1'.AND.STR1(I+2).EQ.'/'
     1 .AND.STR1(I+3).EQ.'3')THEN
      STR1(I)='+'
      STR1(I+1)='2'
      ENDIF
C---- -2/3 > +1/3
      IF(STR1(I).EQ.'-'.AND.STR1(I+1).EQ.'2'.AND.STR1(I+2).EQ.'/'
     1 .AND.STR1(I+3).EQ.'3')THEN
      STR1(I)='+'
      STR1(I+1)='1'
      ENDIF
C---- -1/4 > +3/4
      IF(STR1(I).EQ.'-'.AND.STR1(I+1).EQ.'1'.AND.STR1(I+2).EQ.'/'
     1 .AND.STR1(I+3).EQ.'4')THEN
      STR1(I)='+'
      STR1(I+1)='3'
      ENDIF
C---- -3/4 > +1/4
      IF(STR1(I).EQ.'-'.AND.STR1(I+1).EQ.'3'.AND.STR1(I+2).EQ.'/'
     1 .AND.STR1(I+3).EQ.'4')THEN
      STR1(I)='+'
      STR1(I+1)='1'
      ENDIF
C---- -1/6 > +5/6
      IF(STR1(I).EQ.'-'.AND.STR1(I+1).EQ.'1'.AND.STR1(I+2).EQ.'/'
     1 .AND.STR1(I+3).EQ.'6')THEN
      STR1(I)='+'
      STR1(I+1)='5'
      ENDIF
C---- -5/6 > +1/6
      IF(STR1(I).EQ.'-'.AND.STR1(I+1).EQ.'5'.AND.STR1(I+2).EQ.'/'
     1 .AND.STR1(I+3).EQ.'6')THEN
      STR1(I)='+'
      STR1(I+1)='1'
      ENDIF
C---- +1, > bb, ;  +1b > bbb
      IF((STR1(I).EQ.'+'.AND.STR1(I+1).EQ.'1'.AND.STR1(I+2).EQ.',').OR
     1 .(STR1(I).EQ.'+'.AND.STR1(I+1).EQ.'1'.AND.STR1(I+2).EQ.' '))
     2 THEN
      STR1(I)=' '
      STR1(I+1)=' '
      ENDIF
C---- ,+ > ,b
      IF(STR1(I).EQ.','.AND. STR1(I+1).EQ.'+')STR1(I+1)=' '
1     CONTINUE
      DO 3 K=1,5
      DO 3 I=1,37
      IF(STR1(I).EQ.' ')THEN
      DO 2 J=I,37
2     STR1(J)=STR1(J+1)
      ENDIF
3     CONTINUE
      DO 8 I=1,38
8     STR(I)=STR1(I)
      IF(STR1(1).NE.' ')THEN
      DO 4 I=1,37
4     STR1(38-I+1)=STR1(38-I)
      ENDIF
      STR1(1)=''''
      DO 5 I=1,38
      IF(STR1(I).EQ.' '.AND.STR1(I+1).EQ.' ')THEN
      STR1(I)=''''
      GO TO 6
      ENDIF
5     CONTINUE
6     WRITE(IO,'(38A1)')STR1
7     RETURN
      END
 
      SUBROUTINE DECEQP(STR,LE,F)
C-----This routine decodes a string of an equivalent position
      CHARACTER*1 STR(38),COO(13)
      DIMENSION LE(3,3),NN(3),F(3),AA(3)
      COMMON/INPOU/IN,IO
      DATA COO/'X','Y','Z',',','/','+','-','1','2','3','4','5','6'/
      DO 18 I=1,3
      NN(I)=0
      F(I)=0.0
      DO 18 J=1,3
18    LE(I,J)=0
      NCS=38
      CALL MINUMA1(NCS,STR)
      N=0
      DO 1 I=1,38
      IF(STR(I).EQ.' '.AND.STR(I+1).EQ.' ')GO TO 2
      NN(3)=NN(3)+1
      IF(STR(I).NE.COO(4))GO TO 1
      N=N+1
      IF(N.EQ.1)NN(1)=I
      IF(N.EQ.2)NN(2)=I
1     CONTINUE
2     DO 16 K=1,3
      GO TO (4,5,6),K
4     N1=1
      N2=NN(1)-1
      GO TO 7
5     N1=NN(1)+1
      N2=NN(2)-1
      GO TO 7
6     N1=NN(2)+1
      N2=38
7     KS=1
      KD=0
      KK=0
      DO 15 I=N1,N2
      IF(STR(I).EQ.' '.AND.STR(I+1).EQ.' ')GO TO 17
      IF(STR(I).EQ.' ')GO TO 15
      DO 8 J=1,13
      IF(STR(I).EQ.COO(J))GO TO 9
8     CONTINUE
      GO TO 15
9     IF(J.EQ.4)GO TO 15
      IF(J.EQ.7)KS=-1
      IF(J.EQ.5)KD=1
      IF(J.GT.3)GO TO 11
      DO 10 L=1,3
10    IF(K.EQ.L)LE(L,J)=1*KS
      KK=1
      KS=1
      GO TO 15
11    IF(J.LT.8)GO TO 15
      IF(KD.EQ.1)GO TO 13
      DO 12 L=1,3
12    IF(K.EQ.L)F(L)=(J-7)*KS
      KS=1
      GO TO 15
13    DO 14 L=1,3
      IF(K.EQ.L)F(L)=F(L)/(J-7)
14    CONTINUE
      KD=0
      IF(KK.EQ.1)GO TO 16
15    CONTINUE
16    CONTINUE
17    NN(3)=NN(3)+1
      DO 19 K=1,3
      IF(ABS(F(K)).GE.1)F(K)=0.0
      AA(K)=0.0
      IF(STR(NN(K)-2).EQ.COO(6))THEN
      IF(STR(NN(K)-1).EQ.COO(8))AA(K)=1.0
      IF(STR(NN(K)-1).EQ.COO(9))AA(K)=2.0
      ELSEIF(STR(NN(K)-2).EQ.COO(7))THEN
      IF(STR(NN(K)-1).EQ.COO(8))AA(K)=-1.0
      IF(STR(NN(K)-1).EQ.COO(9))AA(K)=-2.0
      ENDIF
19    F(K)=F(K)+AA(K)
      RETURN
      END
 
      SUBROUTINE EQPDEC(LE,F,STR)
C-----This routine encodes the matrix and the vector describing
C-----an equivalent position into an alphanumeric string
      CHARACTER*1 STR(38),COO(6)
      INTEGER NT(3),LE(3,3),LE1(3)
      DIMENSION F(3),F1(3)
      DATA COO/'X','Y','Z','1','2','3'/
      DO 12 I=1,38
12    STR(I)=' '
      STR(13)=','
      STR(26)=','
      DO 1 I=1,3
      NT(I)=F(I)
1     F1(I)=F(I)-NT(I)
      DO 8 I=1,3
      IF(I.EQ.1) N=0
      IF(I.EQ.2) N=13
      IF(I.EQ.3) N=26
      DO 2 J=1,3
      LE1(J)=LE(I,J)
      IF(LE1(J).LT.0)STR(2*J-1+N)='-'
      IF(LE1(J).GT.0)STR(2*J-1+N)='+'
      IF(IABS(LE1(J)).EQ.1)STR(2*J+N)=COO(J)
2     CONTINUE
      IF(ABS(F(I)).LT.1E-4) GO TO 8
      IF(ABS(F1(I)).LT.1E-4) GO TO 6
      IF(F(I).LT.0.)STR(7+N)='-'
      IF(F(I).LT.0.)STR(11+N)='-'
      IF(F(I).GT.0.)STR(7+N)='+'
      IF(F(I).GT.0.)STR(11+N)='+'
      STR(9+N)='/'
      IF(ABS(F1(I)).GT.0.6) GO TO 3
      STR(8+N)='1'
      IF(ABS(F1(I)).LT.0.2)STR(10+N)='6'
      IF(ABS(F1(I)).LT.0.3.AND.ABS(F1(I)).GT.0.2)STR(10+N)='4'
      IF(ABS(F1(I)).LT.0.4.AND.ABS(F1(I)).GT.0.3)STR(10+N)='3'
      IF(ABS(F1(I)).LT.0.6.AND.ABS(F1(I)).GT.0.4)STR(10+N)='2'
      GO TO 6
3     IF(ABS(F1(I)).GT.0.7) GO TO 4
      STR(8+N)='2'
      STR(10+N)='3'
      GO TO 6
4     IF(ABS(F1(I)).GT.0.8) GO TO 5
      STR(8+N)='3'
      STR(10+N)='4'
      GO TO 6
5     STR(8+N)='5'
      STR(10+N)='6'
6     IF(NT(I).EQ.0) GO TO 8
      DO 7 J=1,3
      IF(IABS(NT(I)).EQ.J.AND.NT(I).GT.0)STR(11+N)='+'
      IF(IABS(NT(I)).EQ.J.AND.NT(I).LT.0)STR(11+N)='-'
7     IF(IABS(NT(I)).EQ.J)STR(12+N)=COO(J+3)
8     CONTINUE
      IF(STR(12).EQ.' ') STR(11)=' '
      IF(STR(25).EQ.' ') STR(24)=' '
      IF(STR(38).EQ.' ') STR(37)=' '
      DO 11 K=1,4
      DO 10 I=1,37
      IF(STR(I).NE.' ') GO TO 10
      DO 9 J=I,37
9     STR(J)=STR(J+1)
      STR(38)=' '
10    CONTINUE
11    CONTINUE
      RETURN
      END
 
      SUBROUTINE HYDRCIF(NEP,EQP)
C-----This routine read from the output of PARST the hydrogen bonds and
C-----sets up the table for CIF
      CHARACTER*1 TIT(80),STR1(8),DUM(8),EQP(38,192),PE(38,50),
     1 PECD(7,50),DU1(6),STR8(6),SSR(6)
      CHARACTER*6 ATM(3,50),AAA0
      DIMENSION NER(50),X(4,50),SX(4,50),KX(4),KK(50),NPE(50)
      COMMON/INPOU/IN,IO
     1      /EDAT/IC,NE
     2      /INS1/STR8
      DATA (STR1(I),I=1,8)/'H','Y','D','R','O','G','E','N'/
      DATA (SSR(I),I=1,6)/' ','P','O','S','S','I'/
1     READ(IN,'(80A1)',END=22)TIT
      DO 24 I=1,8
24    DUM(I)=TIT(20+I)
      NN=8
      CALL MINUMA1(NN,DUM)
      DO 2 I=1,8
      IF(DUM(I).NE.STR1(I))GO TO 1
2     CONTINUE
      BACKSPACE (13,ERR=20)
      READ(IN,'(34X,I4)')N
      IF(N.EQ.0)GO TO 22
3     READ(IN,'(80A1)')TIT
      DO 26 I=1,6
26    DU1(I)=TIT(I)
      NN=6
      CALL MINUMA1(NN,DU1)
      DO 27 I=1,6
      IF(DU1(I).NE.STR8(I))GO TO 3
27    CONTINUE
      NP=0
4     CONTINUE
      READ(IN,'(80A1)')TIT
      IF(TIT(2).NE.'(')GO TO 5
      BACKSPACE(13)
      NP=NP+1
      READ(IN,'(2X,I2,4X,38A1)')NER(NP),(PE(L,NP),L=1,38)
      GO TO 4
5     CONTINUE
      CALL EQVCOD(NEP,EQP,NP,PE,PECD)
28    BACKSPACE (13,ERR=21)
      READ(IN,'(6A1)')DU1
      NN=6
      CALL MINUMA1(NN,DU1)
      DO 6 I=1,6
      IF(DU1(I).NE.SSR(I))THEN
      BACKSPACE (13,ERR=21)
      GO TO 28
      ENDIF
6     CONTINUE
      READ(IN,'(80A1)')TIT
      READ(IN,'(80A1)')TIT
C-----Choose possible hydrogen bonds
      NH=0
      DO 9 I=1,N
      NH=NH+1
      READ(IN,100)(ATM(J,NH),J=1,3),NPE(NH)
100   FORMAT(1X,A6,1X,A6,12X,A6,1X,I2)
      READ(IN,101)(X(K,NH),SX(K,NH),K=1,4)
101   FORMAT(F6.3,1X,F4.3,6X,F5.3,1X,F4.3,12X,F5.3,1X,F4.3,12X,F6.2,
     1 1X,F5.2)
      DP=X(2,NH)
      X(2,NH)=X(3,NH)
      X(3,NH)=DP
      DP=SX(2,NH)
      SX(2,NH)=SX(3,NH)
      SX(3,NH)=DP
      AAA0=ATM(1,NH)
      READ(IN,'(80A1)')TIT
      IF(AAA0(1:1).EQ.'C'.OR.AAA0(1:1).EQ.'N'.OR.AAA0(1:1).EQ.'O')
     1 READ(IN,'(80A1)')TIT
      IF(AAA0(1:1).EQ.'C'.AND.X(2,NH).GT.2.4.OR.X(4,NH).LT.100.0)THEN
      NH=NH-1
      GO TO 8
      ELSE
      DO 7 L=1,NP
      KK(NH)=L
      IF(NPE(NH).EQ.NER(L))GO TO 8
7     CONTINUE
      WRITE(IO,'(''Error in equivalent positions'')')
      RETURN
8     ENDIF
9     CONTINUE
      IF(NH.EQ.0)GO TO 22
      WRITE(IO,109)
109   FORMAT(/'loop_'/
     1 2X,'_geom_hbond_atom_site_label_D'/
     2 2X,'_geom_hbond_atom_site_label_H'/
     3 2X,'_geom_hbond_atom_site_label_A'/
     4 2X,'_geom_hbond_distance_DH'/
     6 2X,'_geom_hbond_distance_HA'/
     6 2X,'_geom_hbond_distance_DA'/
     7 2X,'_geom_hbond_angle_DHA'/
     6 2X,'_geom_hbond_site_symmetry_A'/
     8 2X,'_geom_hbond_publ_flag'/
     9 '#D',4X,'H',5X,'A',7X,'D-H',6X,'H..A',5X,'D..A',5X,'D-H..A',
     1 2X,'A site sym',2X,'Flg')
      DO 23 I=1,NH
C-----sigma(D-H)<0.01, sigma(H...A)<0.01, sigma(D...A)<0.01,
C-----sigma(D-H...A)<1.0
      IF(SX(1,I).LT..01.AND.SX(2,I).LT..01.AND.SX(3,I).LT..01.AND.
     1 SX(4,I).LT.1.) THEN
      KX(1)=(SX(1,I)+0.0005)*1000
      KX(2)=(SX(2,I)+0.0005)*1000
      KX(3)=(SX(3,I)+0.0005)*1000
      KX(4)=(SX(4,I)+0.05)*10
      WRITE(IO,102)(ATM(J,I),J=1,3),(X(K,I),KX(K),K=1,4),
     1 (PECD(L,KK(I)),L=1,7)
102   FORMAT(3A6,F6.3,'(',I1,')',F7.3,'(',I1,')',
     1 F6.3,'(',I1,')',F6.1,'(',I1,')',2X,7A1,'      ?')
      GO TO 10
C-----sigma(D-H)>=0.01,  sigma(H...A)>=0.01,  sigma(D...A)<0.01,
C-----sigma(D-H...A)<1.0
      ELSEIF(SX(1,I).GE..01.AND.SX(2,I).GE..01.AND.SX(3,I).LT..01.AND.
     1 SX(4,I).LT.1.) THEN
      KX(1)=(SX(1,I)+0.005)*100
      KX(2)=(SX(2,I)+0.005)*100
      KX(3)=(SX(3,I)+0.0005)*1000
      KX(4)=(SX(4,I)+0.05)*10
      WRITE(IO,103)(ATM(J,I),J=1,3),(X(K,I),KX(K),K=1,4),
     1 (PECD(L,KK(I)),L=1,7)
103   FORMAT(3A6,F5.2,'(',I1,')',F7.3,'(',I1,')',
     1 F6.2,'(',I1,')',F7.1,'(',I1,')',2X,7A1,'      ?')
      GO TO 10
C-----sigma(D-H)>=0.01,  sigma(H...A)>=0.01  sigma(D...A)<0.01,,
C-----sigma(D-H...A)>=1.0
      ELSEIF(SX(1,I).GE..01.AND.SX(2,I).GE..01.AND.SX(3,I).LT..01.AND.
     1 SX(4,I).GE.1.) THEN
      KA=(X(4,I)+0.5)
      KX(1)=(SX(1,I)+0.005)*100
      KX(2)=(SX(2,I)+0.005)*100
      KX(3)=(SX(3,I)+0.0005)*1000
      KX(4)=(SX(4,I)+0.5)
      WRITE(IO,104)(ATM(J,I),J=1,3),(X(K,I),KX(K),K=1,3),KA,KX(4),
     1 (PECD(L,KK(I)),L=1,7)
104   FORMAT(3A6,F5.2,'(',I1,')',F6.2,'(',I1,')',
     1 F7.3,'(',I1,')',I5,'(',I1,')',2X,7A1,'      ?')
      GO TO 10
C-----sigma(D-H)>=0.01,  sigma(H...A)>=0.01,  sigma(D...A)>=0.01,
C-----sigma(D-H...A)<1.0
      ELSEIF(SX(1,I).GE..01.AND.SX(2,I).GE..01.AND.SX(3,I).GE..01.AND.
     1 SX(4,I).LT.1.) THEN
      KX(1)=(SX(1,I)+0.005)*100
      KX(2)=(SX(2,I)+0.005)*100
      KX(3)=(SX(3,I)+0.005)*100
      KX(4)=(SX(4,I)+0.05)*10
      WRITE(IO,105)(ATM(J,I),J=1,3),(X(K,I),KX(K),K=1,4),
     1 (PECD(L,KK(I)),L=1,7)
105   FORMAT(3A6,F5.2,'(',I1,')',F7.2,'(',I1,')',
     1 F6.2,'(',I1,')',F7.1,'(',I1,')',2X,7A1,'      ?')
      GO TO 10
C-----sigma(D-H)>=0.01,  sigma(H...A)>=0.01,  sigma(D...A)>=0.01,
C-----sigma(D-H...A)>=1.0
      ELSEIF(SX(1,I).GE..01.AND.SX(2,I).GE..01.AND.SX(3,I).GE..01.AND.
     1 SX(4,I).GE.1.) THEN
      KA=(X(4,I)+0.5)
      KX(1)=(SX(1,I)+0.005)*100
      KX(2)=(SX(2,I)+0.005)*100
      KX(3)=(SX(3,I)+0.005)*100
      KX(4)=(SX(4,I)+0.5)
      WRITE(IO,106)(ATM(J,I),J=1,3),(X(K,I),KX(K),K=1,3),KA,KX(4),
     1 (PECD(L,KK(I)),L=1,7)
106   FORMAT(3A6,F5.2,'(',I1,')',F6.2,'(',I1,')',
     1 F6.2,'(',I1,')',I6,'(',I1,')',2X,7A1,'      ?')
      GO TO 10
      ELSE
      WRITE(IO,107)(ATM(J,I),J=1,3),(X(K,I),SX(K,I),K=1,4),
     1 (PECD(L,KK(I)),L=1,7)
107   FORMAT(3A6,3(F6.3,'(',F4.3,')'),F6.1,'(',F3.1,')',2X,
     1 7A1,'      ?')
10    ENDIF
23    CONTINUE
      DO 25 I=1,NH
      DO 25 J=1,NP
25    IF(NPE(I).EQ.NER(J)) WRITE(IO,'(''#  '',38A1)')(PE(L,J),L=1,38)
      GO TO 22
20    WRITE(IO,'(''Error in first backspace'')')
      GO TO 22
21    WRITE(IO,'(''Error in second backspace'')')
22    RETURN
      END
 
      SUBROUTINE EQVCOD(N1,EQP1,N2,EQP2,PECD)
C-----Codify the equivalent positions of the acceptor atom A as
C-----requested by CIF
      CHARACTER*1 STR(38),EQP1(38,192),EQP2(38,50),PECD(7,50),ST1(3)
      DIMENSION LE(3,3),F(3),LE1(192,3,3),LE2(50,3,3),F1(192,3),
     1 F2(50,3),ID(3)
      COMMON/INPOU/IN,IO
      DO 3 I=1,N1
      DO 1 L=1,38
1     STR(L)=EQP1(L,I)
      CALL DECEQP(STR,LE,F)
      DO 2 L=1,3
      F1(I,L)=F(L)
      DO 2 J=1,3
2     LE1(I,L,J)=LE(L,J)
C     WRITE(IO,'(I2,3X,38A1)')I,(EQP1(L,I),L=1,38)
3     CONTINUE
      DO 6 I=1,N2
      DO 4 L=1,38
4     STR(L)=EQP2(L,I)
      CALL DECEQP(STR,LE,F)
      DO 5 L=1,3
      F2(I,L)=F(L)
      DO 5 J=1,3
5     LE2(I,L,J)=LE(L,J)
C     WRITE(IO,'(38A1))')(EQP2(L,I),L=1,38)
6     CONTINUE
      DO 11 I=1,N2
      DO 10 J=1,N1
      DO 7 K=1,3
      DO 7 L=1,3
      IF(LE2(I,K,L).NE.LE1(J,K,L))GO TO 10
7     CONTINUE
      DO 8 L=1,N1
8     IF(J.EQ.L)CALL ALNU(J,ST1)
      DO 12 L=1,3
12    PECD(L,I)=ST1(L)
      PECD(4,I)='_'
      DO 9 K=1,3
      ID(K)=(F2(I,K)-F1(J,K))
      IF(ID(K).EQ.0) PECD(K+4,I)='5'
      IF(ID(K).EQ.1) PECD(K+4,I)='6'
      IF(ID(K).EQ.-1)PECD(K+4,I)='4'
      IF(ID(K).EQ.2) PECD(K+4,I)='7'
9     IF(ID(K).EQ.-2)PECD(K+4,I)='3'
      GO TO 11
10    CONTINUE
11    CONTINUE
      RETURN
      END
 
      SUBROUTINE ALNU(NN,STR)
C-----This routine transforms an integer <999 into an alphanumeric
C-----string
      CHARACTER*1 STR(3),NSTR(9)
      INTEGER N(3)
      DATA NSTR/'1','2','3','4','5','6','7','8','9'/
      N(1)=NN/100
      N(2)=(NN-N(1)*100)/10
      N(3)= NN-N(1)*100-N(2)*10
      DO 1 I=1,3
      DO 2 L=1,9
      IF(N(I).NE.L) GO TO 2
      STR(I)=NSTR(L)
      GO TO 1
2     CONTINUE
      STR(I)='0'
1     CONTINUE
      IF(STR(1).NE.'0') GO TO 3
      STR(1)=' '
      IF(STR(2).EQ.'0') STR(2)=' '
3     RETURN
      END
 
      SUBROUTINE FORSUM(N,STR,NN)
C-----Separate with blanks atom symbols in a formula sum string
      CHARACTER*1 STR(80),STR1(80),NUM(11),ALPHA(27),AA
      DATA NUM/'0','1','2','3','4','5','6','7','8','9','.'/
      DATA ALPHA/'A','B','C','D','E','F','G','H','I','J','K','L','M',
     1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',''''/
      DO 3 I=1,N
      DO 1 J=1,11
      IF(STR(I).EQ.NUM(J))THEN
      STR1(I)='N'
      GO TO 3
      ENDIF
1     CONTINUE
      DO 2 J=1,27
      IF(STR(I).EQ.ALPHA(J))THEN
      STR1(I)='A'
      GO TO 3
      ENDIF
2     CONTINUE
3     CONTINUE
      N1=0
      NN=N
      DO 6 L=1,80
      DO 5 I=1,NN-1
      IF(STR1(I).EQ.'N'.AND.STR1(I+1).EQ.'A')THEN
      DO 4 J=1,NN-I
      STR(NN-J+2)=STR(NN-J+1)
4     STR1(NN-J+2)=STR1(NN-J+1)
      STR(I+1)=' '
      STR1(I+1)=' '
      N1=N1+1
      NN=N+N1
      GO TO 6
      ENDIF
      IF(NN.GT.80)GO TO 7
5     CONTINUE
6     CONTINUE
7     RETURN
      END
