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