******************************************************************************* program fragvec ******************************************************************************* c c This program allows the user to create input car files with c a fragment displaced along one of the bond vectors c c To compile non-graphics programs use : c f77 $(OPT) fragveca.f -o fragveca c real rx(300), ry(300), rz(300) real frx(30), fry(30), frz(30) real dax,day,daz,dhx,dhy,dhz real davec,dhvec,udax,uday,udaz real dstart,disp,prod character*80 record(300) character*80 rec character*80 aform character*40 fname character*40 gname character*40 hname character*4 root character*20 right character*5 left character*2 tchar2 character*1 tchar1 integer i,ia,id,ih integer natom integer ndisp ,nfrag integer j,ij,ji integer ifrag(20) c c print *,'Enter car file name (inside single quotes): ' read(5,*) fname c print *,'Input the number of atoms:' read(5,*) natom c c open(unit=7,file=fname,form='formatted', $ status='old',err=990) c aform = "(a5,3(2x,f13.9),a29)" c read(7,'(a80)',end=997,err=995) record(1) read(7,'(a80)',end=997,err=995) record(2) read(7,'(a80)',end=997,err=995) record(3) read(7,'(a80)',end=997,err=995) record(4) do 200 i=1,natom read(7,'(a80)',end=997,err=995) record(i+4) write(6,'(a80)') record(i+4) read (record(i+4),aform,err=996) left,rx(i), $ ry(i),rz(i),right 200 continue print *,'The fragment is moved along a vector defined by' print *,'an anchor atom and a director atom.' print *,'Input the atom number of the anchor:' read(5,*) ia print *,'Input the atom number of the director:' read(5,*) id print *,'Input the number of atoms in the fragment:' read(5,*) nfrag ifrag(1)=id do 75 i=2,nfrag print *, $ 'Input the numbers of remaining atoms in the fragment:' read(5,*) ifrag(i) 75 continue dax=rx(id)-rx(ia) day=ry(id)-ry(ia) daz=rz(id)-rz(ia) davec=sqrt(dax*dax+day*day+daz*daz) print *,'The anchor-director distance is:',davec do 77 i=1,nfrag ih=ifrag(i) frx(i)=rx(ih)-rx(id) fry(i)=ry(ih)-ry(id) frz(i)=rz(ih)-rz(id) 77 continue udax=dax/davec uday=day/davec udaz=daz/davec c close(7) c print *,'Input the number of displacement steps:' read(5,*) ndisp print *,'Input the initial distance:' read(5,*) dstart print *,'Input the displacement distance per step:' read(5,*) disp c print *,'The fragment will be displaced from' print *, dstart,' to ',dstart+ndisp*disp c print *,'Enter the root name for output files.' print *,'Enter a 4 character string (no single quotes):' read(5,'(a4)') root ierror=0 do i=1,ndisp call int2char(i,tchar1,tchar2) if (i.le.9) then gname = root//tchar1//'.car' else gname = root//tchar2//'.car' endif do 85 k=1,nfrag ih=ifrag(k) rx(ih)=rx(ia)+frx(k)+udax*((i-1)*disp+dstart) ry(ih)=ry(ia)+fry(k)+uday*((i-1)*disp+dstart) rz(ih)=rz(ia)+frz(k)+udaz*((i-1)*disp+dstart) 85 continue junit=7 open(unit=7,file=gname,form='formatted',err=990) do 50 j = 1,4 write(junit,'(a80)') record(j) 50 continue do 100 j = 1,natom rec=record(j+4) write (junit,20) rec(1:8),rx(j),ry(j),rz(j),rec(51:80) 100 continue do 150 j = 1,2 write(junit,'(a3)') 'end' 150 continue close(7) c enddo c 20 format(a7,f13.9,2x,f13.9,2x,f13.9,a30) c hname = root//'.job' open(unit=3,file=hname,form='formatted', $ status='new',err=990) do 250 i=2,ndisp if(i.lt.10) then write(3,35) root,root,i else if(i.ge.10) then write(3,37) root,root,i endif 250 continue do 270 i=1,ndisp if(i.eq.ndisp) then if(i.lt.10) then write(3,41) root,i else if(i.ge.10) then write(3,43) root,i endif else if(i.lt.10) then write(3,45) root,i else if(i.ge.10) then write(3,47) root,i endif 270 continue write(3,49) root,root ij=2 do 290 i=2,ndisp if(ij.eq.1) then ij=2 ji=1 else if(ij.eq.2) then ij=1 ji=2 endif if(i.lt.10) then write(3,55) root,ij,root,i,root,ji else if(i.ge.10) then write(3,57) root,ij,root,i,root,ji endif 290 continue write(3,61) root,ji c 35 format('cp ',a4,'1.input ',a4,i1,'.input') 37 format('cp ',a4,'1.input ',a4,i2,'.input') 41 format('prepq ',a4,i1) 43 format('prepq ',a4,i2) 45 format('prepa ',a4,i1) 47 format('prepa ',a4,i2) 49 format('cp ',a4,'1.job ',a4,'x1.job') 55 format('cat ',a4,'x',i1,'.job ',a4,i1,'.job > 'a4'x',i1,'.job') 57 format('cat ',a4,'x',i1,'.job ',a4,i2,'.job > 'a4'x',i1,'.job') 61 format('chmod +x ',a4,'x',i1,'.job') c print *,'To launch the multiple jobs:' write(6,58) write(6,59) root write(6,63) hname write(6,65) hname 58 format('1. Make sure you have prepa and prepq in the directory') 59 format('2. Create the file ',a4,'1.input') 63 format('3. Type: chmod +x ',a40) 65 format('4. Type: ',a40) c goto 999 990 continue print *,'Error in input file' goto 999 995 continue print *,'Error in format' print *, record goto 999 996 continue print *,'Error parsing format' print *, record print *,left, rx(i), ry(i), rz(i),right goto 999 997 continue print *,'End of file detected' 999 continue c end c *************************************************************************** Subroutine int2char(i,tempchar1,tempchar2) *************************************************************************** ! To convert the integer data to character data Implicit None Integer i Character*1 tempchar1 Character*2 tempchar2 Character*4 record if(i.lt.10) then Write (record,'(i1)') i Read (record,'(a1)') tempchar1 else Write (record,'(i2)') i Read (record,'(a2)') tempchar2 endif Return End