1 SUBROUTINE MAKPOL(COORD) 2 IMPLICIT DOUBLE PRECISION (A-H, O-Z) 3 INCLUDE 'SIZES' 4 DIMENSION COORD(3,*) 5************************************************************************ 6* 7* MAKPOL TAKES A PRIMITIVE UNIT CELL AND GENERATES A TOTAL OF 'MERS' 8* COPIES. THE RESULTING GEOMETRY IS PLACED IN GEO. ARRAYS LOC, 9* XPARAM, NA, NB, NC, SIMBOL, TXTATM, LABELS, LOCPAR, IDEPFN, AND 10* LOCDEP ARE EXPANDED TO SUIT. ARRAY TVEC IS MODIFIED, AS ARE SCALARS 11* NVAR, NATOMS, AND NDEP. 12* 13* SYMMETRY IS FORCED ON, OR ADDED ON, IN ORDER TO MAKE THE NEW MERS 14* EQUIVALENT TO THE SUPPLIED MER. 15* 16************************************************************************ 17 18 CHARACTER KEYWRD*241, TXTATM*8, SIMBOL*10, LTXT*1 19 COMMON /KEYWRD/ KEYWRD 20 COMMON /GEOVAR/ NVAR, LOC(2,MAXPAR), IDUMY, XPARAM(MAXPAR) 21 COMMON /GEOM / GEO(3,NUMATM), XCOORD(3,NUMATM) 22 COMMON /ATOMTX/ LTXT, TXTATM(NUMATM) 23 COMMON /SIMBOL/ SIMBOL(MAXPAR) 24 COMMON /EULER / TVEC(3,3), ID 25 COMMON /GEOKST/ NATOMS,LABELS(NUMATM), 26 1NA(NUMATM),NB(NUMATM),NC(NUMATM) 27 COMMON /GEOSYM/ NDEP, LOCPAR(MAXPAR), IDEPFN(MAXPAR), 28 1 LOCDEP(MAXPAR) 29 IOFF=0 30 MERS=READA(KEYWRD,INDEX(KEYWRD,' MERS')) 31 DO 270 I=1,NATOMS 32 270 IF(LABELS(I).EQ.99)LABELS(I)=100 33 CALL GMETRY(GEO,COORD) 34 DO 280 I=1,NATOMS 35 280 IF(LABELS(I).EQ.100)LABELS(I)=99 36 NAN=NA(NATOMS-1) 37 NBN=NB(NATOMS-1) 38 NCN=NC(NATOMS-1) 39 DO 330 I=2,MERS+1 40 IM1=IOFF 41 IOFF=IOFF+NATOMS-2 42C 43C FILL THE NA, NB, AND NC ADDRESSES FOR THE NEW ATOMS 44C 45 DO 310 J=1,NATOMS-2 46 IF(J.NE.1.AND.I.GT.MERS)GOTO 310 47 SIMBOL(IOFF+J)=SIMBOL(IM1+J) 48 IF(IOFF+J.NE.NATOMS-1)THEN 49 NA(IOFF+J)=NA(IM1+J)+NATOMS-2 50 NB(IOFF+J)=NB(IM1+J)+NATOMS-2 51 NC(IOFF+J)=NC(IM1+J)+NATOMS-2 52 ENDIF 53 LABELS(IOFF+J)=LABELS(IM1+J) 54 TXTATM(IOFF+J)=TXTATM(IM1+J) 55 DO 300 K=1,3 56 300 COORD(K,IOFF+J)=COORD(K,IM1+J)+TVEC(K,1) 57 310 CONTINUE 58 IF(I.EQ.2)THEN 59C 60C SPECIAL TREATMENT FOR THE FIRST THREE ATOMS OF THE SECOND MER 61C 62 NA(NATOMS-1)=NAN 63 NB(NATOMS-1)=NBN 64 NC(NATOMS-1)=NCN 65 NB(NATOMS+0)=NA(NATOMS-2) 66 NC(NATOMS+0)=NB(NATOMS-2) 67 NC(NATOMS+1)=NA(NATOMS-2) 68 ENDIF 69C# DO 320 J=1,NATOMS-2 70C# 320 WRITE(6,'(3I5,3F12.5,3I4)')I,J,LABELS(IFF+J), 71C# 1(COORD(K,IOFF+J),K=1,3), 72C# 2NA(IOFF+J), NB(IOFF+J), NC(IOFF+J) 73 330 CONTINUE 74C 75C USE ATOMS OF FIRST MER TO DEFINE THE OTHER MERS. FOR ATOMS 1, 2, AND 76C 3, USE DATA FROM THE SECOND MER. 77C 78 DO 360 I=1,NATOMS-2 79 DO 350 K=1,3 80 IF(K.GE.I)THEN 81 KOFF=NATOMS-2 82 JOFF=3 83 ELSE 84 KOFF=0 85 JOFF=2 86 ENDIF 87 DO 340 J=JOFF,MERS+1 88 IF(I.NE.1.AND.J.GT.MERS) GOTO 340 89 NDEP=NDEP+1 90 LOCPAR(NDEP)=I+KOFF 91 IDEPFN(NDEP)=K 92 LOCDEP(NDEP)=(NATOMS-2)*(J-1)+I 93 340 CONTINUE 94 350 CONTINUE 95 360 CONTINUE 96C 97C CARTESIAN COORDINATES OF THE TV 98C 99 LAST=(NATOMS-2)*MERS+2 100 COORD(1,LAST)=COORD(1,IOFF+1) 101 COORD(2,LAST)=COORD(2,IOFF+1) 102 COORD(3,LAST)=COORD(3,IOFF+1) 103C 104C REMOVE OPTIMIZATION FLAGS OF LAST TWO ATOMS SUPPLIED BY THE USER 105C 106 DO 331 I=1,6 107 331 IF(LOC(1,NVAR).GT.NATOMS-2)NVAR=NVAR-1 108C 109C PUT ON OPTIMIZATION FLAGES FOR FIRST THREE ATOMS OF THE SECOND MER 110C 111 LOC(1,NVAR+1)=NATOMS-1 112 LOC(2,NVAR+1)=1 113 LOC(1,NVAR+2)=NATOMS-1 114 LOC(2,NVAR+2)=2 115 LOC(1,NVAR+3)=NATOMS-1 116 LOC(2,NVAR+3)=3 117 LOC(1,NVAR+4)=NATOMS 118 LOC(2,NVAR+4)=2 119 LOC(1,NVAR+5)=NATOMS 120 LOC(2,NVAR+5)=3 121 LOC(1,NVAR+6)=NATOMS+1 122 LOC(2,NVAR+6)=3 123C 124C RE-DO SPECIFICATION OF THE TV 125C 126 LABELS(LAST-1)=99 127 LABELS(LAST)=107 128 TXTATM(LAST-1)=' ' 129 TXTATM(LAST)=' ' 130 NA(LAST)=1 131 NB(LAST)=LAST-1 132 NC(LAST)=LAST-2 133 LOC(1,NVAR+7)=LAST 134 LOC(2,NVAR+7)=1 135C 136C CONVERT TO INTERNAL COORDINATES. USE CONNECTIVITY CREATED HERE 137C 138 DEGREE=1.D0 139 NA(2)=-2 140 CALL XYZINT(COORD,LAST,NA,NB,NC,DEGREE,GEO) 141C 142C RE-SIZE THE TRANSLATION VECTOR 143C 144 TVEC(1,1)=COORD(1,LAST) 145 TVEC(2,1)=COORD(2,LAST) 146 TVEC(3,1)=COORD(3,LAST) 147C 148C THE COORDINATES OF THE FIRST 3 ATOMS NEED TO BE OPTIMIZED 149C 150 XPARAM(NVAR+1)=GEO(1,NATOMS-1) 151 XPARAM(NVAR+2)=GEO(2,NATOMS-1) 152 XPARAM(NVAR+3)=GEO(3,NATOMS-1) 153 XPARAM(NVAR+4)=GEO(2,NATOMS) 154 XPARAM(NVAR+5)=GEO(3,NATOMS) 155 XPARAM(NVAR+6)=GEO(3,NATOMS+1) 156 NATOMS=LAST 157 XPARAM(NVAR+7)=GEO(1,NATOMS) 158 NVAR=NVAR+7 159 WRITE(6,160)(I,(TVEC(J,I),J=1,3),I=1,ID) 160 150 FORMAT(/,' EXPANDED UNIT CELL TRANSLATION VECTORS',/ 161 1/,' X Y Z') 162 160 FORMAT(' T',I1,' = ',F11.7,' ',F11.7,' ',F11.7) 163 WRITE(6,'(/,10X,A)')' EXPANDED POLYMER UNIT CELL' 164 CALL GEOUT(1) 165 RETURN 166 END 167