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