1      logical function pre_check(lfnout,nparms,mparms,ignore,
2     + latt,catt,matt,natt,catm,latm,matm,natm,lbnd,mbnd,nbnd,
3     + lang,mang,nang,ldih,mdih,ndih,limp,mimp,nimp,
4     + lseq,cseq,mseq,nseq)
5c
6c $Id$
7c
8      implicit none
9c
10#include "util.fh"
11#include "pre_common.fh"
12c
13      integer lfnout,matm,natm,nparms,mparms,ignore
14      integer matt,natt,mbnd,nbnd,mang,nang,mdih,ndih,mimp,nimp
15      integer latt(3,matt),lbnd(4,mbnd),lang(5,mang),ldih(6,mdih)
16      integer limp(6,mimp),latm(11,matm)
17      character*6 catt(2,matt),catm(mparms,matm)
18      integer mseq,nseq
19      integer lseq(6,mseq)
20      character*10 cseq(mseq)
21c
22      integer i,j,k,ii,jj,kk,mask
23c
24      pre_check=.true.
25c
26      mask=0
27      do 123 j=1,nparms
28      mask=ior(mask,2**(j-1))
29  123 continue
30c
31c     check the atom types
32c     --------------------
33c
34 1000 format(/,' Undetermined force field parameters',/)
35c
36      do 1 i=1,natt
37      if(latt(1,i).le.0) then
38      do 11 j=1,i-1
39      if(latt(1,j).le.0.and.catt(1,i).eq.catt(1,j)) goto 1
40   11 continue
41      if(util_print('topology',print_none)) then
42      if(pre_check) write(lfnout,1000)
43      write(lfnout,1001) catt(1,i)
44 1001 format(' Parameters could not be found for atom type     ',
45     + a6)
46      endif
47      pre_check=.false.
48      endif
49    1 continue
50c
51      do 2 i=1,nbnd
52      if(lbnd(3,i).le.0.and.lbnd(3,i).gt.-mask.and.lbnd(4,i).eq.0) then
53      k=-lbnd(3,i)
54      do 3 j=1,nparms
55      if((catm(1+j,lbnd(1,i))(6:6).eq.'Q'.or.
56     + catm(1+j,lbnd(1,i))(6:6).eq.'H').and.
57     + (catm(1+j,lbnd(2,i))(6:6).eq.'Q'.or.
58     + catm(1+j,lbnd(2,i))(6:6).eq.'H').and.ignore.ne.0) goto 3
59      if(j.eq.1.and.(k.eq.1.or.k.eq.3.or.k.eq.5)) goto 3
60      if(j.eq.2.and.(k.eq.2.or.k.eq.3.or.k.eq.6)) goto 3
61      if(j.eq.3.and.(k.eq.4.or.k.eq.5.or.k.eq.6)) goto 3
62      do 12 ii=1,i
63      if(lbnd(3,ii).le.0.and.lbnd(3,ii).gt.-mask) then
64      kk=-lbnd(3,i)
65      do 13 jj=1,nparms
66      if(jj.eq.1.and.(kk.eq.1.or.kk.eq.3.or.kk.eq.5)) goto 13
67      if(jj.eq.2.and.(kk.eq.2.or.kk.eq.3.or.kk.eq.6)) goto 13
68      if(jj.eq.3.and.(kk.eq.4.or.kk.eq.5.or.kk.eq.6)) goto 13
69      if(i.eq.ii.and.j.eq.jj) goto 12
70      if((catm(1+j,lbnd(1,i)).eq.catm(1+jj,lbnd(1,ii)).and.
71     + catm(1+j,lbnd(2,i)).eq.catm(1+jj,lbnd(2,ii))).or.
72     + (catm(1+j,lbnd(1,i)).eq.catm(1+jj,lbnd(2,ii)).and.
73     + catm(1+j,lbnd(2,i)).eq.catm(1+jj,lbnd(1,ii)))) goto 3
74   13 continue
75      endif
76   12 continue
77      if(util_print('topology',print_none)) then
78      if(pre_check) write(lfnout,1000)
79      write(lfnout,1002)
80     + catm(1+j,lbnd(1,i)),catm(1+j,lbnd(2,i)),
81     + catm(1,lbnd(1,i)),catm(1,lbnd(2,i)),
82     + cseq(latm(5,lbnd(1,i))),lseq(1,latm(5,lbnd(1,i))),
83     + lbnd(1,i),lbnd(2,i),i,j,k
84 1002 format(' Parameters could not be found for bond type     ',
85     + a6,'-',a6,' (',a6,'-',a6,')',a6,i6,2i7,i7,2i3)
86      endif
87      pre_check=.false.
88    3 continue
89      endif
90    2 continue
91c
92      do 4 i=1,nang
93      if(lang(4,i).le.0.and.lang(4,i).gt.-mask.and.lang(5,i).eq.0) then
94      k=-lang(4,i)
95      do 5 j=1,nparms
96      if((catm(1+j,lang(1,i))(6:6).eq.'Q'.or.
97     + catm(1+j,lang(1,i))(6:6).eq.'H').and.
98     + (catm(1+j,lang(2,i))(6:6).eq.'Q'.or.
99     + catm(1+j,lang(2,i))(6:6).eq.'H').and.
100     + (catm(1+j,lang(3,i))(6:6).eq.'Q'.or.
101     + catm(1+j,lang(3,i))(6:6).eq.'H').and.ignore.ne.0) goto 5
102      if(j.eq.1.and.(k.eq.1.or.k.eq.3.or.k.eq.5)) goto 5
103      if(j.eq.2.and.(k.eq.2.or.k.eq.3.or.k.eq.6)) goto 5
104      if(j.eq.3.and.(k.eq.4.or.k.eq.5.or.k.eq.6)) goto 5
105      do 14 ii=1,i
106      if(lang(4,ii).le.0.and.lang(4,ii).gt.-mask) then
107      kk=-lang(4,i)
108      do 15 jj=1,nparms
109      if(jj.eq.1.and.(kk.eq.1.or.kk.eq.3.or.kk.eq.5)) goto 15
110      if(jj.eq.2.and.(kk.eq.2.or.kk.eq.3.or.kk.eq.6)) goto 15
111      if(jj.eq.3.and.(kk.eq.4.or.kk.eq.5.or.kk.eq.6)) goto 15
112      if(i.eq.ii.and.j.eq.jj) goto 14
113      if(catm(1+j,lang(2,i)).eq.catm(1+jj,lang(2,ii)).and.
114     + ((catm(1+j,lang(1,i)).eq.catm(1+jj,lang(1,ii)).and.
115     + catm(1+j,lang(3,i)).eq.catm(1+jj,lang(3,ii))).or.
116     + (catm(1+j,lang(1,i)).eq.catm(1+jj,lang(3,ii)).and.
117     + catm(1+j,lang(3,i)).eq.catm(1+jj,lang(1,ii))))) goto 5
118   15 continue
119      endif
120   14 continue
121      if(util_print('topology',print_none)) then
122      if(pre_check) write(lfnout,1000)
123      write(lfnout,1003)
124     + catm(1+j,lang(1,i)),catm(1+j,lang(2,i)),catm(1+j,lang(3,i)),
125     + catm(1,lang(1,i)),catm(1,lang(2,i)),catm(1,lang(3,i)),
126     + cseq(latm(5,lang(1,i))),lseq(1,latm(5,lang(1,i))),
127     + lang(1,i),lang(2,i),lang(3,i),i,j,k
128 1003 format(' Parameters could not be found for angle type    ',
129     + a6,'-',a6,'-',a6,' (',a6,'-',a6,'-',a6,')',a6,i6,3i7,i7,2i3)
130      endif
131      pre_check=.false.
132    5 continue
133      endif
134    4 continue
135c
136      do 6 i=1,ndih
137      if(ldih(5,i).le.0.and.ldih(5,i).gt.-mask.and.ldih(6,i).eq.0) then
138      k=-ldih(5,i)
139      do 7 j=1,nparms
140      if((catm(1+j,ldih(1,i))(6:6).eq.'Q'.or.
141     + catm(1+j,ldih(1,i))(6:6).eq.'H').and.
142     + (catm(1+j,ldih(2,i))(6:6).eq.'Q'.or.
143     + catm(1+j,ldih(2,i))(6:6).eq.'H').and.
144     + (catm(1+j,ldih(3,i))(6:6).eq.'Q'.or.
145     + catm(1+j,ldih(3,i))(6:6).eq.'H').and.
146     + (catm(1+j,ldih(4,i))(6:6).eq.'Q'.or.
147     + catm(1+j,ldih(4,i))(6:6).eq.'H').and.ignore.ne.0) goto 7
148      if(j.eq.1.and.(k.eq.1.or.k.eq.3.or.k.eq.5)) goto 7
149      if(j.eq.2.and.(k.eq.2.or.k.eq.3.or.k.eq.6)) goto 7
150      if(j.eq.3.and.(k.eq.4.or.k.eq.5.or.k.eq.6)) goto 7
151      do 16 ii=1,i
152      if(ldih(5,ii).le.0.and.ldih(5,ii).gt.-mask) then
153      kk=-ldih(5,i)
154      do 17 jj=1,nparms
155      if(jj.eq.1.and.(kk.eq.1.or.kk.eq.3.or.kk.eq.5)) goto 17
156      if(jj.eq.2.and.(kk.eq.2.or.kk.eq.3.or.kk.eq.6)) goto 17
157      if(jj.eq.3.and.(kk.eq.4.or.kk.eq.5.or.kk.eq.6)) goto 17
158      if(i.eq.ii.and.j.eq.jj) goto 16
159      if((catm(1+j,ldih(1,i)).eq.catm(1+jj,ldih(1,ii)).and.
160     + catm(1+j,ldih(2,i)).eq.catm(1+jj,ldih(2,ii)).and.
161     + catm(1+j,ldih(3,i)).eq.catm(1+jj,ldih(3,ii)).and.
162     + catm(1+j,ldih(4,i)).eq.catm(1+jj,ldih(4,ii))).or.
163     + (catm(1+j,ldih(1,i)).eq.catm(1+jj,ldih(4,ii)).and.
164     + catm(1+j,ldih(2,i)).eq.catm(1+jj,ldih(3,ii)).and.
165     + catm(1+j,ldih(3,i)).eq.catm(1+jj,ldih(2,ii)).and.
166     + catm(1+j,ldih(4,i)).eq.catm(1+jj,ldih(1,ii)))) goto 7
167   17 continue
168      endif
169   16 continue
170      if(util_print('topology',print_none)) then
171      if(pre_check) write(lfnout,1000)
172      write(lfnout,1004) catm(1+j,ldih(1,i)),catm(1+j,ldih(2,i)),
173     + catm(1+j,ldih(3,i)),catm(1+j,ldih(4,i)),catm(1,ldih(1,i)),
174     + catm(1,ldih(2,i)),catm(1,ldih(3,i)),catm(1,ldih(4,i)),
175     + cseq(latm(5,ldih(1,i))),lseq(1,latm(5,ldih(1,i))),
176     + ldih(1,i),ldih(2,i),ldih(3,i),ldih(4,i),i,j,k
177 1004 format(' Parameters could not be found for dihedral type ',
178     + a6,'-',a6,'-',a6,'-',a6,' (',a6,'-',a6,'-',a6,'-',a6,')',
179     + a6,i6,4i7,i7,2i3)
180      endif
181      pre_check=.false.
182    7 continue
183      endif
184    6 continue
185c
186      do 8 i=1,nimp
187      if(limp(5,i).le.0.and.limp(5,i).gt.-mask.and.limp(6,i).eq.0) then
188      k=-limp(5,i)
189      do 9 j=1,nparms
190      if((catm(1+j,limp(1,i))(6:6).eq.'Q'.or.
191     + catm(1+j,limp(1,i))(6:6).eq.'H').and.
192     + (catm(1+j,limp(2,i))(6:6).eq.'Q'.or.
193     + catm(1+j,limp(2,i))(6:6).eq.'H').and.
194     + (catm(1+j,limp(3,i))(6:6).eq.'Q'.or.
195     + catm(1+j,limp(3,i))(6:6).eq.'H').and.
196     + (catm(1+j,limp(4,i))(6:6).eq.'Q'.or.
197     + catm(1+j,limp(4,i))(6:6).eq.'H').and.ignore.ne.0) goto 9
198      if(j.eq.1.and.(k.eq.1.or.k.eq.3.or.k.eq.5)) goto 9
199      if(j.eq.2.and.(k.eq.2.or.k.eq.3.or.k.eq.6)) goto 9
200      if(j.eq.3.and.(k.eq.4.or.k.eq.5.or.k.eq.6)) goto 9
201      do 18 ii=1,i
202      if(limp(5,ii).le.0.and.limp(5,ii).gt.-mask) then
203      kk=-limp(5,i)
204      do 19 jj=1,nparms
205      if(jj.eq.1.and.(kk.eq.1.or.kk.eq.3.or.kk.eq.5)) goto 19
206      if(jj.eq.2.and.(kk.eq.2.or.kk.eq.3.or.kk.eq.6)) goto 19
207      if(jj.eq.3.and.(kk.eq.4.or.kk.eq.5.or.kk.eq.6)) goto 19
208      if(i.eq.ii.and.j.eq.jj) goto 18
209      if(catm(1+j,limp(1,i)).eq.catm(1+jj,limp(1,ii)).and.
210     + ((catm(1+j,limp(2,i)).eq.catm(1+jj,limp(2,ii)).and.
211     + catm(1+j,limp(3,i)).eq.catm(1+jj,limp(3,ii)).and.
212     + catm(1+j,limp(4,i)).eq.catm(1+jj,limp(4,ii))).or.
213     + (catm(1+j,limp(2,i)).eq.catm(1+jj,limp(2,ii)).and.
214     + catm(1+j,limp(3,i)).eq.catm(1+jj,limp(4,ii)).and.
215     + catm(1+j,limp(4,i)).eq.catm(1+jj,limp(3,ii))).or.
216     + (catm(1+j,limp(2,i)).eq.catm(1+jj,limp(3,ii)).and.
217     + catm(1+j,limp(3,i)).eq.catm(1+jj,limp(2,ii)).and.
218     + catm(1+j,limp(4,i)).eq.catm(1+jj,limp(4,ii))).or.
219     + (catm(1+j,limp(2,i)).eq.catm(1+jj,limp(3,ii)).and.
220     + catm(1+j,limp(3,i)).eq.catm(1+jj,limp(4,ii)).and.
221     + catm(1+j,limp(4,i)).eq.catm(1+jj,limp(2,ii))).or.
222     + (catm(1+j,limp(2,i)).eq.catm(1+jj,limp(4,ii)).and.
223     + catm(1+j,limp(3,i)).eq.catm(1+jj,limp(2,ii)).and.
224     + catm(1+j,limp(4,i)).eq.catm(1+jj,limp(3,ii))).or.
225     + (catm(1+j,limp(2,i)).eq.catm(1+jj,limp(4,ii)).and.
226     + catm(1+j,limp(3,i)).eq.catm(1+jj,limp(3,ii)).and.
227     + catm(1+j,limp(4,i)).eq.catm(1+jj,limp(2,ii))))) goto 9
228   19 continue
229      endif
230   18 continue
231      if(util_print('topology',print_none)) then
232      if(pre_check) write(lfnout,1000)
233      if(ffield(1:5).eq.'amber') then
234      write(lfnout,1005) catm(1+j,limp(2,i)),catm(1+j,limp(3,i)),
235     + catm(1+j,limp(1,i)),catm(1+j,limp(4,i)),
236     + catm(1,limp(2,i)),catm(1,limp(3,i)),
237     + catm(1,limp(1,i)),catm(1,limp(4,i)),
238     + cseq(latm(5,limp(1,i))),lseq(1,latm(5,limp(1,i))),
239     + limp(2,i),limp(3,i),limp(1,i),limp(4,i),i,j,k
240      else
241      write(lfnout,1005) catm(1+j,limp(1,i)),catm(1+j,limp(2,i)),
242     + catm(1+j,limp(3,i)),catm(1+j,limp(4,i)),
243     + catm(1,limp(1,i)),catm(1,limp(2,i)),
244     + catm(1,limp(3,i)),catm(1,limp(4,i)),
245     + cseq(latm(5,limp(1,i))),lseq(1,latm(5,limp(1,i))),
246     + limp(1,i),limp(2,i),limp(3,i),limp(4,i),i,j,k
247      endif
248 1005 format(' Parameters could not be found for improper type ',
249     + a6,'-',a6,'-',a6,'-',a6,' (',a6,'-',a6,'-',a6,'-',a6,')',
250     + a6,i6,4i7,i7,2i3)
251      endif
252      pre_check=.false.
253    9 continue
254      endif
255    8 continue
256c
257      return
258      end
259
260