1 logical function argos_prep_params(lfnpar,lfnout,nparms,mparms, 2 + releps,q14fac,ignore, 3 + latm,catm,matm,natm, 4 + lbnd,rbnd,mbnd,nbnd,lang,rang,mang,nang, 5 + ldih,nfdih,kdih,rdih,mdih,ndih,limp,kimp,rimp,mimp,nimp, 6 + latt,lats,catt,patt,ratt,matt,natt,mats,nats, 7 + lseq,cseq,mseq,nseq,icomb) 8c 9c $Id$ 10c 11 implicit none 12c 13#include "util.fh" 14#include "mafdecls.fh" 15#include "argos_prep_common.fh" 16c 17 logical argos_prep_ffield,argos_prep_parcnv,argos_prep_check, 18 + argos_prep_dummy,argos_prep_multip 19 external argos_prep_ffield,argos_prep_parcnv,argos_prep_check, 20 + argos_prep_dummy,argos_prep_multip 21c 22 integer lfnpar,lfnout,ignore,nparms,mparms 23 integer matm,natm 24 integer latm(11,matm) 25 character*6 catm(mparms,matm) 26 integer mbnd,nbnd 27 integer lbnd(4,mbnd) 28 real*8 rbnd(nparms,2,mbnd) 29 integer mang,nang 30 integer lang(5,mang) 31 real*8 rang(nparms,4,mang) 32 integer mdih,ndih 33 integer ldih(6,mdih),nfdih(nparms,mdih),kdih(6,nparms,mdih) 34 real*8 rdih(6,nparms,2,mdih) 35 integer mimp,nimp 36 integer limp(6,mimp),kimp(nparms,mimp) 37 real*8 rimp(nparms,2,mimp) 38 integer matt,natt,mats,nats 39 integer latt(matt),lats(nparms,mats) 40 character*6 catt(2,matt) 41 real*8 patt(4,2,matt,matt),ratt(matt) 42 integer mseq,nseq 43 integer lseq(6,mseq) 44 character*10 cseq(mseq) 45c 46 integer i,j,k,kk,lp,ld,icomb,len 47 character*255 filnam 48 real*8 releps,q14fac 49c 50c make atom type list 51c ------------------- 52c 53c natt : number of atom types 54c 55 natt=0 56 do 1 i=1,natm 57 do 2 j=1,nparms 58 do 3 k=1,natt 59 if(catm(1+j,i).eq.catt(1,k)) goto 2 60 3 continue 61 natt=natt+1 62 if(natt.gt.matt) call md_abort('increase matt',9999) 63 catt(1,natt)=catm(1+j,i) 64 latt(natt)=0 65 2 continue 66 1 continue 67c 68 nats=0 69 do 5 i=1,natm 70 do 4 j=1,nats 71 kk=0 72 do 44 k=1,nparms 73 if(catm(k+1,i).eq.catt(1,lats(k,j))) kk=kk+1 74 44 continue 75 if(kk.eq.nparms) then 76 latm(3,i)=j 77 goto 5 78 endif 79 4 continue 80 nats=nats+1 81 if(nats.gt.mats) call md_abort('increase mats',9999) 82 do 6 k=1,natt 83 do 66 kk=1,nparms 84 if(catm(kk+1,i).eq.catt(1,k)) lats(kk,nats)=k 85 66 continue 86 6 continue 87 latm(3,i)=nats 88 5 continue 89c 90c substitute parameters parameter files 91c ------------------------------------- 92c 93 icomb=0 94c 95 do 544 i=1,mdirpar 96 do 545 j=1,nfilpar(i) 97 write(filnam,'(a,a)') dirpar(i)(1:index(dirpar(i),' ')-1), 98 + filpar(i,j)(1:index(filpar(i,j),' ')) 99 len=index(filnam,' ')-1 100 if(.not.argos_prep_ffield(1,lfnpar,filnam,lfnout,q14fac,releps, 101 + icomb,latt,catt,patt,ratt,matt,natt,latm,catm,matm,natm, 102 + lbnd,rbnd,mbnd,nbnd,lang,rang,mang,nang, 103 + ldih,nfdih,kdih,rdih,mdih,ndih, 104 + limp,kimp,rimp,mimp,nimp,nparms,mparms)) then 105 endif 106 545 continue 107 544 continue 108c 109 if(util_print('topology',print_default)) then 110 write(lfnout,1000) 111 1000 format(' ') 112 endif 113c 114c convert non-bonded parameters to C6 and C12 115c ------------------------------------------- 116c 117 if(.not.argos_prep_parcnv(icomb,latt,patt,catt,matt,natt)) 118 + call md_abort('argos_prep_parcnv failed',9999) 119c 120c copy bonded parameters for dummy atoms 121c -------------------------------------- 122c 123 if(.not.argos_prep_dummy(lfnout,latt,catt,patt,ratt,matt,natt, 124 + latm,catm,matm,natm,lbnd,rbnd,mbnd,nbnd,lang,rang,mang,nang, 125 + ldih,nfdih,kdih,rdih,mdih,ndih, 126 + limp,kimp,rimp,mimp,nimp,nparms,mparms)) 127 + call md_abort('argos_prep_dummy failed',9999) 128c 129c check if all required parameters have been found 130c ------------------------------------------------ 131c 132 if(.not.argos_prep_check(lfnout,nparms,mparms,ignore, 133 + latt,catt,matt,natt,catm,latm,matm,natm,lbnd,mbnd,nbnd, 134 + lang,mang,nang,ldih,mdih,ndih,limp,mimp,nimp, 135 + lseq,cseq,mseq,nseq)) 136 + call md_abort('argos_prep_check failed',9999) 137c 138c check for angles, dihedrals and impropers that involve more than 2 processors 139c 140 if(.not.argos_prep_multip(lseq,mseq,nseq,latm,matm,natm, 141 + lang,mang,nang,ldih,mdih,ndih,limp,mimp,nimp)) 142 + call md_abort('argos_prep_multip failed',9999) 143c 144 argos_prep_params=.true. 145 return 146 end 147 148