dimension zlayer(100000) character id*56,pgm*8 index(i,j,ncol)=(j-1)*ncol+i write(*,100) 100 format(' ncol,nrow,dcol,drow,col1,row1 = ? '$) read(*,*)ncol,nrow,dcol,drow,col1,row1 write(*,101) 101 format(' xbox1,xbox2,ybox1,ybox2,value = ? '$) read(*,*)xbox1,xbox2,ybox1,ybox2,value do 1 j=1,nrow x=(j-1)*drow+row1 do 1 i=1,ncol y=(i-1)*dcol+col1 ij=index(i,j,ncol) if(x.ge.xbox1.and.x.le.xbox2.and.y.ge.ybox1. & and.y.le.ybox2)then zlayer(ij)=value else zlayer(ij)=0. end if 1 continue id='Layer' pgm='Layer' nz=1 dummy=0. ip=0 cm=0. bl=0. call getfile(10,'output file','out','unformatted') write(10)id,pgm,ncol,nrow,nz,col1,dcol,row1,drow,ip,cm,bl do 2 j=1,nrow i1=index(1,j,ncol) i2=index(ncol,j,ncol) 2 write(10)dummy,(zlayer(i),i=i1,i2) stop end c---------------------------------------------------------------------GETFILE subroutine getfile(unit,question,inout,form) c Opens files...filenames not recognized by Sun will generate c an error message and request a second try. c Sample call: c call getfile(21,' Give input file','in','formatted') integer unit character filename*50, status*8 character*(*) question, inout, form c 10 write(*,101) question(1:lentrue(question))//': ' 101 format('$',a,' ') read '(a50)', filename if(inout.eq.'in') then status='old' else status='new' endif open(unit,file=filename,form=form,status=status,err=900) return 900 print *,' ERROR IN OPENING ',filename print *,' try again......' close(unit) go to 10 end c---------------------------------------------------------------------LENTRUE integer function lentrue(string) c Gives position of last non-blank, non-tab, non-null c character in string. c Returns 0 if no such beast in string character*(*) string character*1 blank, tab, null parameter (blank=' ', tab=char('11'O), null=char(0)) lentrue=0 do 100 i=len(string),1,-1 if(string(i:i).ne.blank.and. & string(i:i).ne.tab.and. & string(i:i).ne.null) then lentrue=i return endif 100 continue return end