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