[Thread Prev][Thread Next][Index]
A routine to reverse ascii data order,
Hopefully the new version of Ferret will handle reversed data
order. But if you have data that needs to be reordered, you are
welcome to use this fortran routine that will read in a file, copy any
file header, reverse the line order of the data, and if specified, change
the sign of a column.
cheers
Lev
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
program reverse
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
parameter(NDATMX=20000,NCOLMX=10)
real dat(NDATMX,NCOLMX)
real sdat(NCOLMX)
character*(60) skip
integer iu,iuo,i,j,ncol,nskip,nchangesign,iend,ij
iu=8
iuo=9
call askofil(iu, 'input file')
call asknfil(iuo,'reversed output file')
write(*,*) "header size in # of lines of the beginning of the"
write(*,*) "file that are to be recopied to output as is"
write(*,*) " if column for sign change is < 1, then no signs"
write(*,*) " are reversed"
write(*,*) "enter header size,# columns, column for sign change"
read(*,*) nskip,ncol,nchangesign
if(nchangesign.gt.ncol) then
write(*,*)"nchangesign too big"
stop
endif
if(nskip.gt.0) then
do i=1,nskip
read(iu,'(A)') skip
write(iuo,'(A)') skip
enddo
endif
do i=1,NDATMX
ij=i
call colread(sdat,iend,ncol,iu)
if(iend.eq.1) goto 2
do j=1,ncol
dat(i,j)=sdat(j)
enddo
enddo
write(*,*)"increase NDATMX in code"
stop
2 ij=ij-1
do i=ij,1,-1
if(nchangesign.gt.0) dat(i,nchangesign)=-dat(i,nchangesign)
do j=1,ncol
sdat(j)=dat(i,j)
enddo
call colwrite(sdat,ncol,iuo)
enddo
write(*,*)"file successfully reversed"
stop
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine colread(sdat,iend,ncol,iu)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
real sdat(NCOL)
integer iu,ncol,iend
iend=0
read(iu,*,end=1) sdat
goto 99
1 iend=1
99 return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine colwrite(sdat,ncol,iu)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
real sdat(NCOL)
integer iu,ncol
write(iu,*) sdat
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine asknfil(iu,fdescr)
c open new file
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
character*(40) fname
character*(*) fdescr
write(*,*)"enter name of ",fdescr
read(*,'(A)')fname
open(unit=iu,file=fname,status='new')
write(*,*)fname," is open"
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine askofil(iu,fdescr)
c open old file
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
character*(40) fname
character*(*) fdescr
write(*,*)"enter name of ",fdescr
read(*,'(A)')fname
open(unit=iu,file=fname,status='old')
write(*,*)fname," is open"
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Lev Tarasoff - Dept of Physics, University of Toronto,
60 St. George St., Toronto, Ontario, CANADA, M5S 1A7
Tel (416)-946-3019 Fax (416)-978-8905
email: lev@atmosp.physics.utoronto.ca
[Thread Prev][Thread Next][Index]
Dept of Commerce /
NOAA /
OAR /
PMEL /
TMAP
Contact Us | Privacy Policy | Disclaimer | Accessibility Statement