1 subroutine ana_rdhdr(sgmnam) 2c 3c $Id$ 4c 5 implicit none 6c 7#include "ana_common.fh" 8#include "mafdecls.fh" 9c 10 character*16 sgmnam(msa) 11 character*80 card 12 character*255 fname 13 integer i,lq 14c 15 integer ib,jb,nsb,nwb 16c 17 if(me.eq.0) then 18c 19 iscof=ifrst 20 timoff=0.0d0 21 time=0.0d0 22 timr=0.0d0 23 write(cnum,'(i3.3)') iscof 24c 25 fname=filtrj 26 lq=index(filtrj,'?') 27 if(lq.gt.0) then 28 fname=filtrj(1:lq-1)//cnum//filtrj(lq+1:index(filtrj,' ')-1) 29 endif 30c 31 if(fmttrj.eq.'trj') then 32 write(*,3333) fname(1:index(fname,' ')-1) 33 3333 format(/,' Opening trj file ',a) 34 open(unit=lfntrj,file=fname(1:index(fname,' ')-1), 35 + status='old',err=9999) 36 rewind(lfntrj) 37 if(lrdf) call ana_rdfhdr(int_mb(i_rdf)) 38 1 continue 39 read(lfntrj,1000,err=9998,end=9997) card 40 1000 format(a) 41 if(card(1:6).ne.'header') goto 1 42 open(unit=44,file='.header',form='formatted', 43 + status='unknown') 44 rewind(44) 45 read(lfntrj,1003) nwa,nsa,nsb,nwb 46 write(44,1003) nwa,nsa,nsb,nwb 47 1003 format(4i10) 48 if(nsa.gt.msa) call md_abort('Error in trj',0) 49 if(nwa.gt.0) then 50 do 2 i=1,nwa 51 read(lfntrj,1004) wnam(i) 52 write(44,1004) wnam(i) 53 1004 format(a16) 54 2 continue 55 endif 56 if(nsa.gt.0) then 57 do 3 i=1,nsa 58 read(lfntrj,1005) sgmnam(i) 59 write(44,1005) sgmnam(i) 60 1005 format(a16) 61 3 continue 62 endif 63 if(nsb+nwb.gt.0) then 64 do 4 i=1,nsb+nwb 65 read(lfntrj,1001) ib,jb 66 write(44,1001) ib,jb 67 1001 format(2i8) 68 4 continue 69 endif 70 close(unit=44) 71 elseif(fmttrj.eq.'sco'.or.fmttrj.eq.'coo') then 72 open(unit=lfntrj,file=fname(1:index(fname,' ')-1), 73 + status='old',err=9999) 74 write(*,3333) fname(1:index(fname,' ')-1) 75 11 continue 76 read(lfntrj,1000,err=9998,end=9997) card 77 if(card(1:18).eq.'num_solvent_atoms:')then 78 read(card(19:26),'(i8)') nwa 79 goto 11 80 endif 81 if(card(1:17).eq.'num_solute_atoms:') then 82 read(card(18:25),'(i8)') nsa 83 goto 11 84 endif 85 if(card(1:10).eq.'num_bonds:') then 86 read(card(11:19),'(i9)') nsb 87 else 88 if(card(1:5).ne.'time:') goto 11 89 if(.not.ltop) call md_abort('Format error trajectory file',0) 90 endif 91 rewind(lfntrj) 92 nwa=0 93 if(.not.ltop) then 94 open(unit=44,file='.header',form='formatted', 95 + status='unknown') 96 rewind(44) 97 write(44,1003) nwa,nsa,nsb,0 98 endif 99 if(nsa.gt.msa) call md_abort('Error in trj',0) 100 if(fmttrj.ne.'coo') then 101 12 continue 102 read(lfntrj,1000,err=9998,end=9997) card 103 if(card(1:11).ne.'atom_names:') goto 12 104 do 13 i=1,nsa 105 if(ltop) then 106 read(lfntrj,1000,err=9998,end=9997) card 107 else 108 read(lfntrj,1005) sgmnam(i) 109 write(44,1005) sgmnam(i) 110 endif 111 13 continue 112 if(nsb.gt.0) then 113 14 continue 114 read(lfntrj,1000,err=9998,end=9997) card 115 if(card(1:10).ne.'bond_list:') goto 14 116 do 15 i=1,nsb 117 read(lfntrj,1001) ib,jb 118 if(.not.ltop) write(44,1001) ib,jb 119 15 continue 120 endif 121 endif 122 if(.not.ltop) close(unit=44) 123 else 124 call md_abort('Trajectory file format error',0) 125 endif 126c 127 endif 128c 129 return 130c 131 9997 continue 132 call md_abort('End of file reading trajectory file',0) 133 9998 continue 134 call md_abort('Error reading trajectory file',0) 135 9999 continue 136 call md_abort('Failed to open trajectory file',0) 137 return 138 end 139