1 subroutine ana_index(card,sgmnam,ia,ja) 2c 3 implicit none 4c 5#include "ana_common.fh" 6#include "global.fh" 7#include "mafdecls.fh" 8#include "msgids.fh" 9#include "rtdb.fh" 10c 11 character*80 card,atom 12 character*16 sgmnam(nsa) 13 character*10 word 14 integer ia,ja 15c 16 integer i,j,k,isgm 17c 18 ia=0 19 ja=0 20c 21 if(card(1:1).ne.'W'.and.card(1:1).ne.'w') then 22c 23 i=index(card,':')-1 24 if(i.le.0.or.i.gt.10) call md_abort('Error in atom name',0) 25 word=' ' 26 word(11-i:10)=card(1:i) 27 read(word,'(i10)') isgm 28 atom=card(i+2:80) 29 j=index(atom,' ')-1 30 if(atom(1:1).eq.'_') atom(1:1)=' ' 31c 32 do 1 i=1,nsa 33 read(sgmnam(i)(12:16),'(i5)') k 34 if(isgm.eq.k) then 35 if(sgmnam(i)(6:10).eq.atom(1:5)) then 36 ia=i 37 return 38 endif 39 endif 40 1 continue 41c 42 else 43c 44 i=index(card,':')-1 45 if(i.le.1) call md_abort('Error in atom name',0) 46 if(i.eq.2) then 47 read(card(2:i),'(i1)') ia 48 elseif(i.eq.3) then 49 read(card(2:i),'(i2)') ia 50 elseif(i.eq.4) then 51 read(card(2:i),'(i3)') ia 52 elseif(i.eq.5) then 53 read(card(2:i),'(i4)') ia 54 elseif(i.eq.6) then 55 read(card(2:i),'(i5)') ia 56 else 57 call md_abort('Error in ana_index',me) 58 endif 59 ia=ia-nsgm 60 if(ia.le.0) call md_abort('Error in ana_index',me) 61 atom=card(i+2:80) 62 j=index(atom,' ')-1 63 if(atom(1:1).eq.'_') atom(1:1)=' ' 64c 65 do 2 i=1,nwa 66 if(wnam(i)(6:10).eq.atom(1:5)) then 67 ja=i 68 return 69 endif 70 2 continue 71c 72 endif 73c 74 write(atom,'(a,a,a)') 'Atom ',card(1:index(card,' ')-1), 75 + ' could not be found' 76c 77 call md_abort(atom,0) 78c 79 return 80 end 81c $Id$ 82