1      SUBROUTINE GEOUT(MODE1)
2      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
3      INCLUDE 'SIZES'
4**********************************************************************
5*
6*   GEOUT PRINTS THE CURRENT GEOMETRY.  IT CAN BE CALLED ANY TIME,
7*         FROM ANY POINT IN THE PROGRAM AND DOES NOT AFFECT ANYTHING.
8*
9**********************************************************************
10      COMMON /GEOM  / GEO(3,NUMATM), XCOORD(3,NUMATM)
11      COMMON /GEOKST/ NATOMS,LABELS(NUMATM),
12     1NA(NUMATM),NB(NUMATM),NC(NUMATM)
13      COMMON /GEOVAR/ NVAR,LOC(2,MAXPAR),IDUMY,XPARAM(MAXPAR)
14      COMMON /PATH  / LATOM,LPARAM,REACT(200)
15      COMMON /DENSTY/ P(MPACK),PA(MPACK),PB(MPACK)
16      COMMON /CORE  / CORE(107)
17      COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
18     1                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
19     2                NCLOSE,NOPEN,NDUMY,FRACT
20      COMMON /KEYWRD/ KEYWRD
21      COMMON /TITLES/ KOMENT,TITLE
22      COMMON /ATOMTX/ LTXT, TXTATM(NUMATM)
23      COMMON /GEOSYM/ NDEP,LOCPAR(MAXPAR),IDEPFN(MAXPAR),
24     1                     LOCDEP(MAXPAR)
25      COMMON /ELEMTS/ ELEMNT(107)
26      DIMENSION COORD(3,NUMATM), Q2(NUMATM), LOCTMP(2,MAXPAR)
27      CHARACTER Q(3)*2, ELEMNT*2, FLAG1*2, FLAG0*2, FLAGN*2, TXTATM*8
28      CHARACTER KEYWRD*241, KOMENT*81, TITLE*81, BLANK*80, LTXT*1
29      LOGICAL CART
30      MODE=MODE1
31      IF(MODE.EQ.1)THEN
32         FLAG1=' *'
33         FLAG0='  '
34         FLAGN=' +'
35         IPRT=6
36      ELSE
37         FLAG1=' 1'
38         FLAG0=' 0'
39         FLAGN='-1'
40         IPRT=ABS(MODE)
41      ENDIF
42C
43C *** OUTPUT THE PARAMETER DATA.
44C
45      CART=.FALSE.
46      IF(NA(1).NE.0) THEN
47         CART=.TRUE.
48         CALL XYZINT(GEO,NATOMS,NA,NB,NC,1.D0,COORD)
49         LOCTMP(1,1)=2
50         LOCTMP(2,1)=1
51         LOCTMP(1,2)=3
52         LOCTMP(2,2)=1
53         LOCTMP(1,3)=3
54         LOCTMP(2,3)=2
55         NVARTM=0
56         DO 10 I=4,NATOMS
57            NVARTM=NVARTM+3
58            DO 10 J=1,3
59               LOCTMP(1,NVARTM+J)=I
60   10    LOCTMP(2,NVARTM+J)=J
61         NVARTM=NVARTM+3
62      ELSE
63         DO 20 I=1,NVAR
64            LOCTMP(1,I)=LOC(1,I)
65   20    LOCTMP(2,I)=LOC(2,I)
66         NVARTM=NVAR
67         DO 30 J=1,3
68C$DOUT VBEST
69            DO 30 I=1,NATOMS
70   30    COORD(J,I)=GEO(J,I)
71      ENDIF
72      DEGREE=57.29577951D00
73      MAXTXT=ICHAR(LTXT)
74      BLANK=' '
75      IF(MODE.EQ.1)THEN
76         WRITE (6,40)BLANK(:MAX(2,MAXTXT-4)),
77     1               BLANK(:MAX(4,MAXTXT-2)),
78     2               BLANK(:MAX(18,MAXTXT+12))
79   40    FORMAT (/4X,'ATOM',3X,'CHEMICAL',A ,'BOND LENGTH',4X,'BOND ANGL
80     1E',4X ,' TWIST ANGLE',/3X,'NUMBER',2X,'SYMBOL', A,'(ANGSTROMS)',5
81     2X,'(DEGREES)',5X,' (DEGREES)',/4X,'(I)',A,'NA:I',10X,'NB:NA:I',5
82     3X,' NC:NB:NA:I',5X,'NA',3X,'NB',3X,'NC',/)
83      ELSE
84         IF(MODE.GT.0)CALL WRTTXT(IPRT)
85      ENDIF
86      IF(MODE.NE.1)THEN
87         CALL CHRGE(P,Q2)
88         DO 50 I=1,NUMAT
89            L=NAT(I)
90   50    Q2(I)=CORE(L) - Q2(I)
91      ENDIF
92      N=1
93      IA=LOCTMP(1,1)
94      II=0
95      DO 80 I=1,NATOMS
96         DO 60 J=1,3
97            Q(J)=FLAG0
98            IF (IA.NE.I) GO TO 60
99            IF (J.NE.LOCTMP(2,N).OR.N.GT.NVARTM) GO TO 60
100            Q(J)=FLAG1
101            N=N+1
102            IA=LOCTMP(1,N)
103   60    CONTINUE
104         W = COORD(2,I) * DEGREE
105         X = COORD(3,I) * DEGREE
106C
107C  CONSTRAIN ANGLE TO DOMAIN 0 - 180 DEGREES
108C
109         W=W - AINT(W/360.D0)*360.D0
110         IF(W.LT.0)W=W+360.D0
111         IF(W .GT. 180.D0) THEN
112            X=X+180.D0
113            W=360.D0-W
114         ENDIF
115C
116C  CONSTRAIN DIHEDRAL TO DOMAIN -180 - 180 DEGREES
117C
118         X=X - AINT(X/360.D0+SIGN(0.5D0-1.D-9,X)-1.D-9)*360.D0
119         IF (LATOM.NE.I) GO TO 70
120         J=LPARAM
121         Q(J)=FLAGN
122   70    CONTINUE
123         BLANK=ELEMNT(LABELS(I))//TXTATM(I)//'  '
124         IF(MODE.NE.1)THEN
125            J=MAX(4,MAXTXT+2)
126            K=MAX(0,8-J)
127         ELSE
128            J=MAX(9,MAXTXT+3)
129         ENDIF
130         IF(LABELS(I).NE.0)THEN
131            IF(MODE.NE.1)THEN
132               IF(LABELS(I).NE.99.AND.LABELS(I).NE.107)THEN
133                  II=II+1
134                  WRITE (IPRT,'(1X,A,F11.7,1X,A2,F14.6,1X,A2,F14.6,1X,
135     1A2,3I5,A,F7.4)') BLANK(:J),COORD(1,I),Q(1),W,Q(2),X,Q(3),
136     2NA(I),NB(I),NC(I),BLANK(20:20+K),Q2(II)
137               ELSE
138                  WRITE (IPRT,'(1X,A,F11.7,1X,A2,F14.6,1X,A2,F14.6,1X,
139     1A2,3I5)') BLANK(:J),COORD(1,I),Q(1),W,Q(2),X,Q(3),
140     2NA(I),NB(I),NC(I)
141               ENDIF
142            ELSEIF(I.GT.3)THEN
143               WRITE (6,'(3X,I4 ,5X,A,F9.5,1X,A2,F14.5,1X,A2,F11.5,1X,
144     1A2,I4,2I5)') I,BLANK(:J),COORD(1,I),Q(1),W,Q(2),X,Q(3),
145     2NA(I),NB(I),NC(I)
146            ELSEIF(I.EQ.3)THEN
147               WRITE (6,'(''      3'',5X,A,F9.5,1X,A2,F14.5,1X,A2,13X,
148     12I5)') BLANK(:J),COORD(1,3),Q(1),W,Q(2),NA(3),NB(3)
149            ELSEIF(I.EQ.2)THEN
150               WRITE (6,'(''      2'',5X,A,F9.5,1X,A2,30X,I5)')
151     1 BLANK(:J),COORD(1,2),Q(1),NA(2)
152            ELSE
153               WRITE (6,'(''      1'',5X,A)') BLANK(:J)
154            ENDIF
155         ENDIF
156   80 CONTINUE
157      IF(CART) NA(1)=99
158      IF(MODE.EQ.1) RETURN
159      WRITE (IPRT,*)
160      IF(NDEP.EQ.0) RETURN
161C
162C   OUTPUT SYMMETRY DATA.
163C
164      I=1
165   90 J=I
166  100 IF(J.EQ.NDEP) GOTO 110
167      IF(LOCPAR(J).EQ.LOCPAR(J+1).AND.IDEPFN(J).EQ.IDEPFN(J+1)
168     1.AND.J-I.LT.15)THEN
169         J=J+1
170         GOTO 100
171      ELSE
172         WRITE(IPRT,'(I4,I3,I5,15I4)')
173     1LOCPAR(I),IDEPFN(I),(LOCDEP(K),K=I,J)
174      ENDIF
175      I=J+1
176      GOTO 90
177  110 CONTINUE
178      WRITE(IPRT,'(I4,I3,I5,15I4)')
179     1LOCPAR(I),IDEPFN(I),(LOCDEP(K),K=I,J)
180      RETURN
181      END
182