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