1 subroutine argos_diana_wthdr(fmt,sgmnam,tag,isel,logw) 2c 3c $Id$ 4c 5 implicit none 6c 7#include "argos_diana_common.fh" 8c 9 character*16 cwa,sgmnam(msa) 10 integer isel(msa) 11 integer iunit 12 character*3 fmt 13 character*4 cdnum 14 character*255 fname 15 character*24 tag(msa,2) 16 logical logw 17c 18 character*80 label 19c 20 integer i,ib,j,jb,nsb,lq,nwb 21 logical binary 22 character*4 dcdhdr 23 character*80 dcdtit(10) 24 integer*4 icntrl(20),numtit 25c 26 character*1 cdummy 27 character*2 elemnt 28 character*18 name 29c 30 if(me.eq.0) then 31c 32c if(fmt.eq.'pov') then 33c if(iunit.eq.lfncop) filpov=filcop 34c if(iunit.eq.lfnsup) filpov=filsup 35c npov=0 36c return 37c endif 38c 39 binary=fmt(1:1).eq.'b'.or.fmt.eq.'dcd' 40c 41c if(iunit.eq.lfncop) then 42c fname=filcop 43c if(mcopf.gt.0) then 44c lq=index(filcop,'.') 45c write(cdnum,'(a1,i3.3)') '_',icopf 46c fname=filcop(1:lq-1)//cdnum//filcop(lq:index(filcop,' ')-1) 47c endif 48c 49 if(binary) then 50 open(unit=lfncop,file=filcop(1:index(filcop,' ')-1), 51 + form='unformatted',status='unknown',err=9999) 52 else 53 open(unit=lfncop,file=filcop(1:index(filcop,' ')-1), 54 + form='formatted',status='unknown',err=9999) 55 endif 56 write(*,3333) filcop(1:index(filcop,' ')-1) 57 3333 format(/,' Opening copy file ',a,/) 58c 59c endif 60c 61c if(iunit.eq.lfnsup) then 62c fname=filsup 63c if(msupf.gt.0) then 64c lq=index(filsup,'.') 65c write(cdnum,'(a1,i3.3)') '_',isupf 66c fname=filsup(1:lq-1)//cdnum//filsup(lq:index(filsup,' ')-1) 67c endif 68c if(binary) then 69c open(unit=lfnsup,file=fname(1:index(fname,' ')-1), 70c + form='unformatted',status='unknown',err=9999) 71c else 72c open(unit=lfnsup,file=fname(1:index(fname,' ')-1), 73c + form='formatted',status='unknown',err=9999) 74c endif 75c write(*,3333) fname(1:index(fname,' ')-1) 76c 3334 format(/,' Opening super file ',a,/) 77c endif 78c 79c 80 if(fmt.eq.'trj') then 81 write(lfncop,1000) 82 1000 format('header') 83 open(unit=44,file='.header',form='formatted', 84 + status='unknown') 85 rewind(44) 86 read(44,4401) nwa,nsa,nsb,nwb 87 if(logw) then 88 write(lfncop,4401) nwa,nsa,nsb,nwb,nwsel 89 else 90 write(lfncop,4401) nwa,nsa,nsb,nwb,0 91 endif 92 4401 format(5i10) 93 do 1 i=1,nwa 94 read(44,4402) cwa 95 4402 format(a16,i10,i5) 96 write(lfncop,4402) cwa,i 97 1 continue 98 do 2 i=1,nsa 99 read(44,4402) cwa 100 write(lfncop,4402) cwa,i,isel(i) 101 2 continue 102 do 3 i=1,nsb+nwb 103 read(44,4403) ib,jb 104 write(lfncop,4403) ib,jb 105 4403 format(2i8) 106 3 continue 107 close(unit=44) 108 endif 109c 110 if(fmt.eq.'arc') then 111 write(lfncop,2000) 112 2000 format('!BIOSYM archive 3',/,'PBC=OFF') 113 endif 114c 115 if(fmt.eq.'amb') then 116 label='AMBER trajectory file' 117 write(lfncop,3000) label 118 3000 format(a80) 119 endif 120c 121 if(fmt.eq.'crd') then 122 label='AMBER trajectory file' 123 write(lfncop,3000) label 124 endif 125c 126 if(fmt.eq.'bam') then 127 label='AMBER binary trajectory file' 128 write(lfncop) label 129 endif 130c 131 if(fmt.eq.'mvm') then 132 label='ecce mvm trajectory file' 133 write(lfncop,4000) label 134 4000 format('# ',a) 135 write(lfncop,4001) 136 4001 format('type: molecule') 137 write(lfncop,4002) 138 4002 format('centering: 0') 139 write(lfncop,4003) nsa 140 4003 format('num_atoms: ',i7) 141 write(lfncop,4004) 142 4004 format('atom_info: symbol cart') 143 open(unit=44,file='.header',form='formatted', 144 + status='unknown') 145 rewind(44) 146 read(44,4401) nwa,nsa,nsb,nwb 147 do 4 i=1,nwa+nsa 148 read(44,4402) cdummy 149 4 continue 150 write(lfncop,6003) nsb 151 6003 format('num_bonds: ',i7,/,'bond_list:') 152 do 5 i=1,nsb 153 read(44,4403) ib,jb 154 write(lfncop,4403) ib,jb 155 5 continue 156 close(unit=44) 157 endif 158c 159 if(fmt.eq.'eci') then 160 label='EcceImport 1.1' 161 write(lfncop,5000) label 162 5000 format(a,/,' ') 163 endif 164c 165 if(fmt.eq.'frm') then 166 write(lfncop,6001) nsel 167 6001 format('Atoms {',/,i8) 168 do 6 i=1,nsa 169 if(isel(i).ne.0) then 170 elemnt=sgmnam(i)(6:7) 171 name=sgmnam(i)(11:16)//':'//sgmnam(i)(1:5)//':'//sgmnam(i)(6:10) 172 do 7 j=8,14 173 if(name(j:j).eq.' ') name(j:j)='_' 174 7 continue 175 if(elemnt(1:1).eq.'1'.or.elemnt(1:1).eq.'2'.or. 176 + elemnt(1:1).eq.'3'.or.elemnt(1:1).eq.'4') elemnt(1:1)=' ' 177 write(lfncop,6002) elemnt,name,tag(i,1)(1:index(tag(i,1),' ')-1), 178 + tag(i,2)(1:index(tag(i,2),' ')-1) 179 6002 format(a2,1x,a18,1x,a,1x,a) 180 endif 181 6 continue 182 open(unit=44,file='.header',form='formatted', 183 + status='unknown') 184 rewind(44) 185 read(44,4401) nwa,nsa,nsb,nwb 186 do 8 i=1,nwa+nsa 187 read(44,4402) cdummy 188 8 continue 189 if(nsel.eq.nsa) then 190 write(lfncop,6005) nsb 191 else 192 write(lfncop,6005) 0 193 endif 194 6005 format('}',/,'Bonds {',/,i8) 195 if(nsel.eq.nsa) then 196 do 9 i=1,nsb 197 read(44,6006) ib,jb 198 write(lfncop,6006) ib,jb 199 6006 format(2i8) 200 9 continue 201 endif 202 close(unit=44) 203 write(lfncop,6007) 204 6007 format('}') 205 endif 206c 207 if(fmt.eq.'dcd') then 208 dcdhdr='CORD' 209 do 21 i=1,20 210 icntrl(i)=0 211 21 continue 212c number of frames 213 icntrl(1)=(ifrto-ifrfr+1)/ifrsk 214 icntrl(2)=ifrfr 215 icntrl(3)=1 216 icntrl(4)=ifrto-ifrfr+1 217 icntrl(8)=1 218 icntrl(10)=1026003170 219 icntrl(20)=22 220 write(lfncop) dcdhdr,icntrl 221 dcdtit(1)='charmm dcd formatted trajectory file' 222 numtit=1 223 write(lfncop) numtit,dcdtit(1) 224 ldcd=.false. 225 endif 226c 227 endif 228c 229 return 230c 231 9999 continue 232 call md_abort('Failed to open file',lfncop) 233 return 234 end 235