******************************************************************************* 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) fragvec.f -o fragvec c real rx(300), ry(300), rz(300) real rxn(300) c real frx(30), fry(30), frz(30) c real dax,day,daz,dhx,dhy,dhz c real davec,dhvec,udax,uday,udaz real dstart,disp,prod character*80 record(300) character*80 rec character*80 aform character*80 bform character*40 fname character*40 gname character*40 hname character*4 root character*20 right character*20 r1 character*5 left character*5 l1 character*2 tchar2 character*1 tchar1 integer i,ia,id,ih integer natom integer ndisp ,nfrag integer j,itime integer ifrag(100) c c print *,'Enter car file name: ' read(5,'(a40)') 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)" bform = "(a5,3(f10.5),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) read(7,'(a80)',end=997,err=995) record(5) write(6,'(a80)') record(5) read (record(5),bform,err=996) l1,cx,cy,cz,r1 do 200 i=1,natom read(7,'(a80)',end=997,err=995) record(i+5) write(6,'(a80)') record(i+5) read (record(i+5),aform,err=996) left,rx(i), $ ry(i),rz(i),right 200 continue print *,'The fragment is moved along a unit cell vector' c print *,'an anchor atom and a director atom.' c print *,'Input the atom number of the anchor:' c read(5,*) ia c print *,'Input the atom number of the director:' c read(5,*) id print *,'Input the number of atoms in the fragment:' read(5,*) nfrag c ifrag(1)=id c do 75 i=1,nfrag c print *, c $ 'Input the numbers of the atoms in the fragment:' c read(5,*) ifrag(i) c75 continue c dax=rx(id)-rx(ia) c day=ry(id)-ry(ia) c daz=rz(id)-rz(ia) c davec=sqrt(dax*dax+day*day+daz*daz) c print *,'The anchor-director distance is:',davec c do 77 i=1,nfrag c ih=ifrag(i) c frx(i)=rx(ih)-rx(id) c fry(i)=ry(ih)-ry(id) c frz(i)=rz(ih)-rz(id) c77 continue c udax=dax/davec c uday=day/davec c udaz=daz/davec cc 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 cxn=cx+(i-1)*disp 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 c ih=ifrag(k) c rxn(ih)=rx(ih)-(i-1)*disp rxn(k)=rx(k) 85 continue do 87 ii=nfrag+1,natom rxn(ii)=rx(ii)+(i-1)*disp 87 continue open(unit=7,file=gname,form='formatted',err=990) junit=7 do 50 j = 1,4 write(junit,'(a80)') record(j) 50 continue rec=record(5) write (junit,10) rec(1:5),cxn,cy,cz,rec(36:80) do 100 j = 1,natom rec=record(j+5) write (junit,20) rec(1:8),rxn(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 10 format(a5,3(f10.5),a45) 20 format(a7,f13.9,2x,f13.9,2x,f13.9,a30) c print *,'Enter job file name: ' read(5,'(a40)') hname c print *,'Enter the job CPU time in seconds: ' c read(5,*) itime 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 255 i=2,ndisp if(i.lt.10) then write(3,39) root,root,i else if(i.ge.10) then write(3,41) root,root,i endif 255 continue do 270 i=1,ndisp if(i.lt.10) then write(3,45) root,i else if(i.ge.10) then write(3,47) root,i endif 270 continue c write(3,53) root c do 290 i=2,ndisp c if(i.lt.10) then c write(3,55) (i-1)*itime,root,i c else if(i.ge.10) then c write(3,57) (i-1)*itime,root,i c endif c290 continue c 35 format('cp ',a4,'1.input ',a4,i1,'.input') 37 format('cp ',a4,'1.input ',a4,i2,'.input') 39 format('cp ',a4,'1.tpvec ',a4,i1,'.tpvec') 41 format('cp ',a4,'1.tpvec ',a4,i2,'.tpvec') 45 format('prepq ',a4,i1) 47 format('prepq ',a4,i2) print *,'To launch the multiple jobs:' write(6,58) write(6,59) root write(6,61) hname write(6,63) hname 58 format('1. Make sure you have prepq in the directory') 59 format('2. Create the file',a4,'1.input') 61 format('3. Create an executable script: chmod +x ',a40) 63 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