*********************************************************************** program MoveMesh *********************************************************************** c c shifts X, Y, and Z coordinates of TOUGH2 mesh c S. Finsterle, May 1999 c character*5 elem,cmat character*10 caht,cpermmod character*80 line character*40 filein,fileout write(*,*) write(*,*) ' Move Mesh Coordinates' write(*,*) ' *********************' write(*,*) write(*,*) ' Input MESH file : ? ' read(*,'(a)')filein open(1,file=filein, status='old') write(*,*) ' Output MESH file : ? ' read(*,'(a)')fileout open(2,file=fileout,status='unknown') write(*,*) ' dx : ? ' read(*,*) dx write(*,*) ' dy : ? ' read(*,*) dy write(*,*) ' dz : ? ' read(*,*) dz write(*,*) iel=0 2000 continue read(1,7000,end=9000) line 7000 format(a) call lenos(line,ll) if (line(1:5).eq.'ELEME') then write(2,7001) line(1:40),dx,dy,dz 7001 format(a40,' dx/dy/dz ',3e10.4) else write(2,7000) line(:ll) goto 2000 endif 2001 continue c c --- elements iel=iel+1 if (mod(iel,1000).eq.1) & write(*,*) ' Working on element ',max(1,iel-1) read(1,7002) elem,cmat,vol,caht,cpermmod,x,y,z 7002 format(a5,10x,a5,e10.4,2a10,3e10.4) if (elem.eq.' ') goto 2002 read(cpermmod,'(e10.4)',iostat=ios) permmod if (abs(permmod).lt.1.0e-10) cpermmod=' ' read(caht,'(e10.4)',iostat=ios) aht if (abs(aht).lt.1.0e-10) caht=' ' write(2,7002) elem,cmat,vol,caht,cpermmod,x+dx,y+dy,z+dz goto 2001 2002 continue c c --- connections write(2,7000) ' ' icon=0 2003 continue read(1,7000,end=9000) line call lenos(line,ll) write(2,7000) line(:ll) if (line(1:5).eq.' '.or.line(1:5).eq.'+++ ') goto 2004 goto 2003 2004 continue read(1,7000,end=9000) line call lenos(line,ll) write(2,7000) line(:ll) goto 2004 9000 continue close(1) close(2) end c --- end of MoveMesh *********************************************************************** subroutine lenos(string,lstr) *********************************************************************** character string*(*) lstr=1 ilenstr=len(string) if (ilenstr.eq.0) return do 1000 i=ilenstr,1,-1 if (string(i:i).ne.char(9).and.string(i:i).ne.' ') then lstr=i return endif 1000 continue end c --- end of lenos