1      logical function argos_prepare_atype(lfnout,lfnpar,
2     + latm,catm,matm,lbnd,mbnd,nbnd,
3     + jlo,ilo,ihi,jhi,ltyp,mtyp,lring,aring,mring,
4     + nring3,nring4,nring5,nring6,
5     + latmt,matmt,natmt,lbndt,mbndt,nbndt)
6c
7c $Id$
8c
9      implicit none
10c
11#include "util.fh"
12#include "mafdecls.fh"
13#include "argos_prepare_common.fh"
14c
15c     in  : lfnpar            = atom types file number
16c           filtyp            = atom types file name
17c           latm(2,matm)      = atomic number
18c                3            = number of bonds
19c                4            = center type
20c           catm(1,matm)      = atom name
21c                2            = atom name (corrected)
22c           matm              = dimension atom list
23c           natm              = length atom list
24c           lbnd(1:2,mbnd)    = bond indices
25c           mbnd              = dimension bond list
26c           nbnd              = length bond list
27c           lring(1:6,mring)  = ring indices
28c           aring(mring)      = logical true if aromatic ring
29c
30c     out : catm(3,matm)      = atom type
31c           ltyp(1,mtyp)      = saturation
32c                2            = aliphatic ring
33c                3            = aromatic ring
34c                4            = number of hydrogen neigbors
35c                5            = number of neighbors
36c                5+i          = index of i-th neighbor
37c
38      integer maty
39      parameter (maty=1000)
40c
41      integer lfnpar,lfnout
42      character*255 filnam
43      integer matm,matmt,mtyp,natmt
44      integer latm(5,matm),latmt(5,matmt)
45      character*6 catm(3,matm)
46      integer mbnd,nbnd,mbndt,nbndt
47      integer lbnd(2,mbnd),lbndt(2,mbndt)
48      integer jlo,ilo,ihi,jhi
49      integer ltyp(15,jlo:jlo+mtyp-1)
50      integer mring,nring3,nring4,nring5,nring6
51      integer lring(6,mring)
52      logical aring(mring)
53c
54      integer i,j,k,kk,l,ll,m,ntype,lt,ld,nadd,len
55      character*4 atype(maty)
56      integer itype(20,maty)
57      character*100 card
58      integer iatnum,nhydr,nonh,irng,ifr,ito
59      logical skipa(5),skipt(5),skipaa(5),skiptt(5)
60c
61c     setup typ array with latm data
62c     ------------------------------
63c
64      do 101 i=1,mtyp
65      do 102 j=1,5
66      ltyp(j,i)=0
67  102 continue
68  101 continue
69c
70      do 1 i=jlo,jhi
71      ltyp(1,i)=latm(2,i)
72    1 continue
73c
74c     find index for each neighbor
75c     ----------------------------
76c
77      do 2 i=1,nbnd
78      if(lbnd(1,i).ge.jlo.and.lbnd(1,i).le.jhi) then
79      ltyp(5,lbnd(1,i))=ltyp(5,lbnd(1,i))+1
80      ltyp(5+ltyp(5,lbnd(1,i)),lbnd(1,i))=lbnd(2,i)
81      if(latm(2,lbnd(2,i)).eq.1) ltyp(4,lbnd(1,i))=ltyp(4,lbnd(1,i))+1
82      endif
83      if(lbnd(2,i).ge.jlo.and.lbnd(2,i).le.jhi) then
84      ltyp(5,lbnd(2,i))=ltyp(5,lbnd(2,i))+1
85      ltyp(5+ltyp(5,lbnd(2,i)),lbnd(2,i))=lbnd(1,i)
86      if(latm(2,lbnd(1,i)).eq.1) ltyp(4,lbnd(2,i))=ltyp(4,lbnd(2,i))+1
87      endif
88    2 continue
89c
90      ntype=jhi
91      ifr=jlo
92      ito=jhi
93c
94      do 103 i=ifr,ito
95      if(latm(1,i).gt.0) then
96      ntype=ntype+1
97      ltyp(5,i)=ltyp(5,i)+1
98      ltyp(5+ltyp(5,i),i)=ntype
99      ltyp(1,ntype)=latmt(2,latm(1,i))
100      latm(2,ntype)=latmt(2,latm(1,i))
101      nadd=0
102      do 104 j=1,nbndt
103      if(lbndt(1,j).eq.latm(1,i)) then
104      nadd=nadd+1
105      ltyp(5,ntype)=ltyp(5,ntype)+1
106      ltyp(5+ltyp(5,ntype),ntype)=ntype+nadd
107      ltyp(1,ntype+nadd)=latmt(2,lbndt(2,j))
108      latm(2,ntype+nadd)=latmt(2,lbndt(2,j))
109      if(latmt(2,lbndt(2,j)).eq.1) ltyp(4,ntype)=ltyp(4,ntype)+1
110      elseif(lbndt(2,j).eq.latm(1,i)) then
111      nadd=nadd+1
112      ltyp(5,ntype)=ltyp(5,ntype)+1
113      ltyp(5+ltyp(5,ntype),ntype)=ntype+nadd
114      ltyp(1,ntype+nadd)=latmt(2,lbndt(1,j))
115      latm(2,ntype+nadd)=latmt(2,lbndt(1,j))
116      if(latmt(2,lbndt(1,j)).eq.1) ltyp(4,ntype)=ltyp(4,ntype)+1
117      endif
118  104 continue
119      ntype=ntype+nadd
120      if(ltyp(1,i).eq.6.and.ltyp(5,i).eq.3.and.latm(4,i).eq.0) then
121      latm(4,i)=1
122      if(latm(5,i).eq.4) then
123      do 107 j=1,3
124      do 108 k=1,3
125      if(ltyp(1,ltyp(5+j,i)).eq.7.and.ltyp(1,ltyp(5+k,i)).eq.8)
126     + latm(5,i)=2
127  108 continue
128  107 continue
129      endif
130      endif
131      if(ltyp(1,i).eq.7.and.ltyp(5,i).eq.3.and.latm(4,i).eq.0) then
132      do 105 j=1,3
133      if(ltyp(1,ltyp(5+j,i)).eq.6.and.ltyp(5,ltyp(5+j,i)).eq.3) then
134      do 106 k=1,3
135      if(ltyp(1,ltyp(5+k,ltyp(5+j,i))).eq.8) then
136      latm(4,i)=1
137      if(latm(5,i).eq.3) latm(5,i)=1
138      endif
139  106 continue
140      endif
141  105 continue
142      endif
143      endif
144  103 continue
145c
146c     order each neighbor list
147c     ------------------------
148c
149      do 3 i=jlo,jhi
150      do 4 j=1,ltyp(5,i)-1
151      do 5 k=j+1,ltyp(5,i)
152      if(ltyp(5+j,i).gt.ltyp(5+k,i)) then
153      l=ltyp(5+j,i)
154      ltyp(5+j,i)=ltyp(5+k,i)
155      ltyp(5+k,i)=l
156      endif
157    5 continue
158    4 continue
159    3 continue
160c
161c     saturation
162c     ----------
163c
164c     C sp2     : 3
165c     C in C=O  : 2
166c     N sp2     : 3
167c     O in =O   : 2
168c
169      do 6 i=jlo,jhi
170      ltyp(1,i)=0
171      if(latm(2,i).eq.6.and.ltyp(5,i).eq.3) then
172      ltyp(1,i)=3
173      do 7 j=1,ltyp(5,i)
174      if(latm(2,ltyp(5+j,i)).eq.8.and.ltyp(5,ltyp(5+j,i)).eq.1) then
175      ltyp(1,i)=2
176      endif
177    7 continue
178      endif
179      if(latm(2,i).eq.7.and.ltyp(5,i).eq.3) then
180      ltyp(1,i)=3
181      endif
182      if(latm(2,i).eq.8.and.ltyp(5,i).eq.1) then
183      ltyp(1,i)=2
184      endif
185    6 continue
186c
187c     C=C in aromatic 6-ring with 2 sp2 N : 2
188c
189      do 8 i=nring5+1,nring6
190      if(aring(i)) then
191      k=0
192      do 9 j=1,6
193      if(latm(2,i).eq.7) k=k+1
194    9 continue
195      if(k.eq.2) then
196      do 10 j=1,nbnd
197      k=0
198      do 11 l=1,6
199      if(latm(2,lring(l,i)).eq.6) then
200      if(lbnd(1,j).eq.lring(l,i).or.lbnd(2,j).eq.lring(l,i)) k=k+1
201      endif
202   11 continue
203      if(k.eq.2) then
204      ltyp(1,lbnd(1,j))=2
205      ltyp(1,lbnd(2,j))=2
206      goto 8
207      endif
208   10 continue
209      endif
210      endif
211    8 continue
212c
213c     ring types
214c     ----------
215c
216      do 40 i=1,nring3
217      do 41 j=1,3
218      if(aring(i)) then
219      ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+3
220      else
221      ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+3
222      endif
223   41 continue
224   40 continue
225      do 42 i=nring3+1,nring4
226      do 43 j=1,4
227      if(aring(i)) then
228      ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+4
229      else
230      ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+4
231      endif
232   43 continue
233   42 continue
234      do 12 i=nring4+1,nring5
235      do 13 j=1,5
236      if(aring(i)) then
237      ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+5
238      else
239      ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+5
240      endif
241   13 continue
242   12 continue
243      do 14 i=nring5+1,nring6
244      do 15 j=1,6
245      if(aring(i)) then
246      ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+6
247      else
248      ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+6
249      endif
250   15 continue
251   14 continue
252c
253      do 39 i=jlo,jhi
254      if(ltyp(1,i).eq.3) then
255      if(ltyp(3,i).eq.0) then
256      ltyp(1,i)=2
257      else
258      ltyp(1,i)=0
259      endif
260      endif
261   39 continue
262c
263c     read the atom type data
264c     -----------------------
265c
266      ntype=0
267      do 900 i=1,mdirpar
268      do 901 j=1,nfilpar(i)
269      write(filnam,'(a,a)') dirpar(i)(1:index(dirpar(i),' ')-1),
270     + filpar(i,j)(1:index(filpar(i,j),' '))
271      len=index(filnam,' ')-1
272      open(unit=lfnpar,file=filnam(1:len),status='old',
273     + form='formatted',err=901)
274   18 continue
275      read(lfnpar,1000,end=17,err=9999) card
276      if(card(1:10).ne.'Atom types') goto 18
277      if(util_print('files',print_medium)) then
278      write(lfnout,2000) filnam(1:len)
279 2000 format(' Atom type definitions',t40,a)
280      endif
281   16 continue
282      read(lfnpar,1000,end=17,err=9999) card
283 1000 format(a)
284      if(card(1:3).eq.'End') goto 17
285      if(card(1:1).eq.'#'.or.card(1:4).eq.'    ') goto 16
286      ntype=ntype+1
287      if(ntype.gt.maty) call md_abort('increase maty',9999)
288      read(card,1001) atype(ntype),(itype(k,ntype),k=1,10)
289 1001 format(a4,i7,i3,2i5,i3,i7,i3,3i7)
290      read(lfnpar,1002) (itype(k,ntype),k=11,15)
291      read(lfnpar,1002) (itype(k,ntype),k=16,20)
292 1002 format(27x,i7,i3,3i7)
293      goto 16
294   17 continue
295      close(unit=lfnpar)
296      if(util_print('where',print_debug)) then
297      write(lfnout,'(a,a)') filnam(1:len),' closed'
298      endif
299  901 continue
300  900 continue
301c
302c     determine the atom types
303c     ------------------------
304c
305      if(util_print('atomtypes',print_debug)) then
306      write(lfnout,3000) (i,i=1,7)
307 3000 format(///,' ATOM LIST ',//,
308     + ' 1: Atom number',/,
309     + ' 2: Atom name',/,
310     + ' 3: Atomic number',/,
311     + ' 4: Aliphatic ring',/,
312     + ' 5: Aromatic ring',/,
313     + ' 6: Number of neighboring hydrogen atoms',/,
314     + ' 7: Number of neighboring atoms',//,i5,i4,5i5,//)
315      write(lfnout,'(i5,a4,5i5)')
316     +  (i,catm(2,i),(ltyp(j,i),j=1,5),i=ilo,ihi)
317      endif
318c
319      if(util_print('atomtypes',print_debug)) then
320      write(lfnout,3001)
321 3001 format(//,' ATOM TYPING',//,
322     + ' 1: Atom name',/,
323     + ' 2: Atomic number',/,
324     + ' 3: Saturation',/,
325     + ' 4: Aliphatic ring',/,
326     + ' 5: Aromatic ring',/,
327     + ' 6: Number of neighboring hydrogen atoms',/,
328     + ' 7: Number of neighboring atoms',//)
329      endif
330c
331      do 38 i=ilo,ihi
332      if(util_print('atomtypes',print_debug)) then
333      write(lfnout,3002) (j,j=1,7),
334     + 'Atom ',catm(2,i),latm(2,i),(ltyp(j,i),j=1,5)
335 3002 format(/,5x,i4,6i5,//,a,a4,6i5,/)
336      endif
337      if(latm(2,i).gt.0) then
338c
339      if(util_print('atomtypes',print_debug)) then
340      write(lfnout,3003) (j,j=1,7),'ABCDEF'
341 3003 format(//,' ATOM TYPES',//,
342     + ' 1: Atom type',/,
343     + ' 2: Atomic number',/,
344     + ' 3: Saturation',/,
345     + ' 4: Aliphatic ring',/,
346     + ' 5: Aromatic ring',/,
347     + ' 6: Number of neighboring hydrogen atoms',/,
348     + ' 7: Number of neighboring atoms',/,
349     + ' A: Matching atomic number',/,
350     + ' B: Matching explicit saturation',/,
351     + ' C: Matching aliphatic ring',/,
352     + ' D: Matching aromatic ring',/,
353     + ' E: Matching number of neighboring hydrogen atoms',/,
354     + ' F: Matching number of neighboring atoms',//,
355     + 5x,i2,2x,6i5,1x,a,//)
356      endif
357c
358      do 19 j=1,ntype
359      iatnum=itype(1,j)
360      irng=0
361      if(iatnum.ge.60000) then
362      irng=6
363      iatnum=iatnum-60000
364      endif
365      if(iatnum.ge.50000) then
366      irng=5
367      iatnum=iatnum-50000
368      endif
369      nonh=0
370      do 20 k=1,4
371      if(iatnum.ge.1000)  then
372      nonh=nonh+1
373      iatnum=iatnum-1000
374      endif
375   20 continue
376      nhydr=0
377      do 21 k=1,4
378      if(iatnum.ge.200)  then
379      nhydr=nhydr+1
380      iatnum=iatnum-200
381      endif
382      if(nhydr.eq.4) nhydr=5
383   21 continue
384c
385c     itype(1,*) match atom number
386c           2    match explicit saturation
387c           3    match aliphatic ring
388c           4    match aromatic ring
389c           5    match explicit number of neighbors
390c
391      if(util_print('atomtypes',print_debug)) then
392      write(lfnout,'(a,a4,6i5,1x,6l1)') 'Type ',atype(j)(1:4),iatnum,
393     + itype(2,j),itype(3,j),itype(4,j),nhydr,itype(5,j),
394     + iatnum.eq.latm(2,i),
395     + (itype(2,j).eq.0.or.itype(2,j).eq.ltyp(1,i)),
396     + (itype(3,j).eq.0.or.itype(3,j).eq.ltyp(2,i).or.
397     +   (itype(3,j).eq.1.and.ltyp(2,i).gt.0)),
398     + (itype(4,j).eq.0.or.itype(4,j).eq.ltyp(3,i).or.
399     +   (itype(4,j).eq.1.and.ltyp(3,i).gt.0)),
400     + (nhydr.eq.0.or.(nhydr.eq.5.and.ltyp(4,i).eq.0).or.
401     +   nhydr.eq.ltyp(4,i)),
402     + (itype(5,j).eq.0.or.itype(5,j).eq.ltyp(5,i))
403      endif
404c
405      if(iatnum.eq.latm(2,i).and.
406     + (nhydr.eq.0.or.(nhydr.eq.5.and.ltyp(4,i).eq.0).or.
407     +   nhydr.eq.ltyp(4,i)).and.
408     + (itype(2,j).eq.0.or.itype(2,j).eq.ltyp(1,i)).and.
409     + (itype(3,j).eq.0.or.itype(3,j).eq.ltyp(2,i).or.
410     +   (itype(3,j).eq.1.and.ltyp(2,i).gt.0)).and.
411     + (itype(4,j).eq.0.or.itype(4,j).eq.ltyp(3,i).or.
412     +   (itype(4,j).eq.1.and.ltyp(3,i).gt.0)).and.
413     + (itype(5,j).eq.0.or.itype(5,j).eq.ltyp(5,i))) then
414c
415      if(util_print('atomtypes',print_debug)) then
416      write(lfnout,'(10x,a)') 'try'
417      endif
418c
419c     initialize skip vectors for neighbor atoms : skipa(1:neighbors)
420c     ----------------------- for atom type cond : skipt(1:3)
421c
422      do 22 k=1,5
423      skipa(k)=.false.
424   22 continue
425      do 23 l=1,3
426      skipt(l)=.false.
427      if(itype(1+l*5,j).eq.0.and.itype(2+l*5,j).eq.0) skipt(l)=.true.
428   23 continue
429c
430c     loop over neighbor conditions for the current atom type : l (1:3)
431c     -------------------------------------------------------
432c
433      do 24 l=1,3
434      if(.not.skipt(l)) then
435      if(util_print('atomtypes',print_debug)) then
436      write(lfnout,'(5x,a,i5)') 'neighbor condition ',itype(1+l*5,j)
437      endif
438c
439c     loop over neighbor atoms for the current atom : k (1:neighbors)
440c     ---------------------------------------------
441c
442      do 25 k=1,ltyp(5,i)
443      if(.not.skipa(k).and..not.skipt(l)) then
444      if(util_print('atomtypes',print_debug)) then
445      write(lfnout,'(5x,a,i5)') 'neighbor atom      ',
446     + latm(2,ltyp(5+k,i))
447      endif
448      iatnum=itype(1+l*5,j)
449      irng=0
450      if(iatnum.ge.60000) then
451      irng=6
452      iatnum=iatnum-60000
453      endif
454      if(iatnum.ge.50000) then
455      irng=5
456      iatnum=iatnum-50000
457      endif
458      nonh=0
459      do 26 m=1,4
460      if(iatnum.ge.1000)  then
461      nonh=nonh+1
462      iatnum=iatnum-1000
463      endif
464   26 continue
465      nhydr=0
466      do 27 m=1,4
467      if(iatnum.ge.200)  then
468      nhydr=nhydr+1
469      iatnum=iatnum-200
470      endif
471      if(nhydr.eq.4) nhydr=5
472   27 continue
473c
474c     check atomic number of neighbor k
475c     ---------------------------------
476c
477      if(iatnum.gt.0.and.iatnum.ne.latm(2,ltyp(5+k,i))) goto 25
478c
479c     check bonded hydrogens to neighbor k
480c     ------------------------------------
481c
482      if(nhydr.gt.0) then
483      if(nhydr.eq.5) then
484      if(ltyp(4,ltyp(5+k,i)).gt.0) goto 25
485      else
486      if(nhydr.ne.ltyp(4,ltyp(5+k,i))) goto 25
487      endif
488      endif
489c
490c     check bonded nonh-hydrogens to neighbor k
491c     -----------------------------------------
492c
493      if(nonh.gt.0) then
494      if(nonh.ne.ltyp(5,ltyp(5+k,i))-ltyp(4,ltyp(5+k,i))) goto 25
495      endif
496c
497c     check number of neighbors
498c     -------------------------
499c
500      if(itype(2+l*5,j).gt.0.and.
501     + itype(2+l*5,j).ne.ltyp(5,ltyp(5+k,i))) goto 25
502c
503c     check if neighbor in ring
504c     -------------------------
505c
506      if(irng.gt.0) then
507      if(irng.ne.ltyp(3,ltyp(5+k,i))) goto 25
508      endif
509c
510      if(util_print('atomtypes',print_debug)) then
511      write(lfnout,'(5x,a,2i5)') 'neighbor accepted ',
512     + itype(1+l*5,j),latm(2,ltyp(5+k,i))
513      endif
514c
515c     set skip vectors
516c     ----------------
517c
518      do 28 kk=1,ltyp(5,ltyp(5+k,i))
519      skipaa(kk)=ltyp(5+kk,ltyp(5+k,i)).eq.i
520   28 continue
521      do 29 ll=1,3
522      skiptt(ll)=itype(2+l*5+ll,j).eq.0
523   29 continue
524c
525c     loop over the neighbor of neighbor conditions
526c     ---------------------------------------------
527c
528      do 30 ll=1,3
529      if(.not.skiptt(ll)) then
530      if(util_print('atomtypes',print_debug)) then
531      write(lfnout,'(10x,a,i5)') 'neighbor condition ',
532     + itype(2+l*5+ll,j)
533      endif
534c
535c     loop over neighbor of neighbor atoms
536c     ------------------------------------
537c
538      do 31 kk=1,ltyp(5,ltyp(5+k,i))
539      if(.not.skipaa(kk).and..not.skiptt(ll)) then
540      if(util_print('atomtypes',print_debug)) then
541      write(lfnout,'(10x,a,i5)') 'neighbor atom      ',
542     + latm(2,ltyp(5+kk,ltyp(5+k,i)))
543      endif
544c
545      iatnum=itype(2+l*5+ll,j)
546      irng=0
547      if(iatnum.ge.60000) then
548      irng=6
549      iatnum=iatnum-60000
550      endif
551      if(iatnum.ge.50000) then
552      irng=5
553      iatnum=iatnum-50000
554      endif
555      nonh=0
556      do 32 m=1,4
557      if(iatnum.ge.1000)  then
558      nonh=nonh+1
559      iatnum=iatnum-1000
560      endif
561   32 continue
562      nhydr=0
563      do 33 m=1,4
564      if(iatnum.ge.200) then
565      nhydr=nhydr+1
566      iatnum=iatnum-200
567      endif
568      if(nhydr.eq.4) nhydr=5
569   33 continue
570      if(util_print('atomtypes',print_debug)) then
571      write(lfnout,'(30x,a,3i5)') 'condition ia nn nh ',
572     + iatnum,nonh,nhydr
573      write(lfnout,'(30x,a,3i5)') 'found     ia nn nh ',
574     + latm(2,ltyp(5+kk,ltyp(5+k,i))),
575     + ltyp(5,ltyp(5+kk,ltyp(5+k,i)))-ltyp(4,ltyp(5+kk,ltyp(5+k,i))),
576     + ltyp(4,ltyp(5+kk,ltyp(5+k,i)))
577      endif
578c
579c     check atomic number of neighbor of neighbor k
580c     ---------------------------------------------
581c
582      if(iatnum.gt.0.and.iatnum.ne.latm(2,ltyp(5+kk,ltyp(5+k,i))))
583     +  goto 31
584c
585c     check bonded hydrogens to neighbor k
586c     ------------------------------------
587c
588      if(nhydr.gt.0) then
589      if(nhydr.eq.5) then
590      if(ltyp(4,ltyp(5+kk,ltyp(5+k,i))).gt.0) goto 31
591      else
592      if(nhydr.ne.ltyp(4,ltyp(5+kk,ltyp(5+k,i)))) goto 31
593      endif
594      endif
595c
596c     check bonded nonh-hydrogens to neighbor k
597c     -----------------------------------------
598c
599      if(nonh.gt.0) then
600      if(nonh.ne.ltyp(5,ltyp(5+kk,ltyp(5+k,i)))-
601     + ltyp(4,ltyp(5+kk,ltyp(5+k,i)))) goto 31
602      endif
603c
604c     check if neighbor of neighbor in ring
605c     -------------------------------------
606c
607      if(irng.gt.0) then
608      if(irng.ne.ltyp(3,ltyp(5+kk,ltyp(5+k,i)))) goto 31
609      endif
610c
611      if(util_print('atomtypes',print_debug)) then
612      write(lfnout,'(10x,a,4i5)') 'neighbor accepted ',
613     + itype(2+l*5+ll,j),latm(2,ltyp(5+kk,ltyp(5+k,i))),kk,ll
614      endif
615c
616c     neighbor of neighbor condition satisfied
617c     ----------------------------------------
618c
619      skipaa(kk)=.true.
620      skiptt(ll)=.true.
621      endif
622   31 continue
623      endif
624   30 continue
625c
626c     test if all neighbor of neighbor conditions are satisfied
627c     ---------------------------------------------------------
628c
629      do 34 ll=1,3
630      if(.not.skiptt(ll)) goto 25
631   34 continue
632      if(util_print('atomtypes',print_debug)) then
633      write(lfnout,'(20x,a)') 'neighbors of neighbor accepted'
634      endif
635c
636c     neighbor condition satisfied
637c     ----------------------------
638c
639      skipa(k)=.true.
640      skipt(l)=.true.
641      endif
642   25 continue
643      endif
644   24 continue
645c
646c     test if all neighbor conditions are satisfied
647c     ---------------------------------------------
648c
649      do 35 l=1,3
650      if(.not.skipt(l)) goto 19
651   35 continue
652      if(util_print('atomtypes',print_debug)) then
653      write(lfnout,'(30x,a)') 'neighbor accepted'
654      endif
655c
656      catm(3,i)(1:4)=atype(j)
657      if(util_print('atomtypes',print_debug)) then
658       write(lfnout,'(a,a,a,a)') ' Accepted for atom ',catm(1,i),
659     + ' type ',catm(3,i)
660      endif
661c
662      endif
663   19 continue
664      endif
665   38 continue
666c
667      argos_prepare_atype=.true.
668      return
669c
670 9999 argos_prepare_atype=.false.
671      return
672      end
673