program readv3 ! This utility program is written in free-format Fortran 90. ! It requires a Fortran 90 compiler to compile. On a DEC_Alpha ! machine, type the following to compile: ! ! f90 -free -convert big_endian readv3.f ! implicit none integer, dimension(50,20) :: bhi real, dimension(20,20) :: bhr character(len=80), dimension(50,20) :: bhic character(len=80), dimension(20,20) :: bhrc character(len=120) :: flnm integer :: iunit = 10, iunitex=64 integer :: flag integer :: ndim real :: time, sample integer, dimension(4) :: start_index, end_index character (len= 4) :: staggering character (len= 4) :: ordering character (len=24) :: start_date character (len=24) :: current_date character (len= 9) :: name character (len=25) :: units character (len=46) :: description integer :: l real, allocatable, dimension(:,:,:,:) :: data integer :: ierr, ier logical :: newtime = .TRUE. logical :: lmore,imprime !#### Variables introducidas ###### character (len=123) :: flnmex character (len=9), allocatable, dimension(:) :: NomeVar integer :: flagex=1 integer :: NumVar, i1,i2 !############################################### !######## OPCIONES DEL PROGRAMA ########### !############################################### !#### Parametros ########### imprime=.false. NumVar = 17 allocate(NomeVar(NumVar)) !#### Nome variables salva ###### NomeVar(1) = 'U' NomeVar(2) = 'V' NomeVar(3) = 'T' NomeVar(4) = 'PP' NomeVar(5) = 'PSTARCRS' NomeVar(6) = 'RAIN CON' NomeVar(7) = 'RAIN NON' NomeVar(8) = 'T2' NomeVar(9) = 'U10' NomeVar(10) = 'V10' NomeVar(11) = 'TERRAIN' NomeVar(12) = 'LATITCRS' NomeVar(13) = 'LONGICRS' NomeVar(14) = 'MAPFACCR' NomeVar(15) = 'MAPFACDT' NomeVar(16) = 'CORIOLIS' NomeVar(17) = 'SIGMAH' !################################################################# !################################################################# call arguments(flnm, lmore) flnmex = trim(flnm)//'_EX' print*, 'flnm = ', trim(flnm) print*, 'flnmex = ', trim(flnmex) open(iunit, file=flnm, form='unformatted', status='old', action='read') open(iunitex, file=flnmex, form='unformatted', status='replace', action='write') read(iunit, iostat=ierr) flag if(ierr==0) write(iunitex, iostat=ierr) flag do while (ierr == 0) if (flag == 0) then read(iunit,iostat=ier) bhi, bhr, bhic, bhrc write(iunitex,iostat=ier) bhi, bhr, bhic, bhrc if(ier/=0) then write(*,'("Error reading big header")') call abort() endif if(imprime) then call printout_big_header(bhi, bhr, bhic, bhrc) endif elseif (flag == 1) then READ (iunit,iostat=ier) ndim, start_index, end_index, time, staggering, ordering,& current_date, name, units, description ! WRITE (iunitex,iostat=ier) ndim, start_index, end_index, time, staggering, ordering,& ! current_date, name, units, description if(ier/=0) then write(*,'("Error reading subheader")') call abort() endif if (imprime) Then if (lmore) then print*, 'ndim: ', ndim print*, 'start_index: ', start_index print*, 'end_index: ', end_index print*, 'time: ', time print*, 'staggering: #'//staggering//'#' print*, 'ordering: #'//ordering//'#' print*, 'date/time: #'//current_date//'#' print*, 'name: #'//name//'#' print*, 'units: #'//units//'#' print*, 'description: #'//description//'#' endif endif if (newtime) then write(*,'(/,A,2x, F15.5," Hours"/)') current_date, time/60. newtime = .FALSE. endif if (ndim == 1) then allocate(data(end_index(1), 1, 1, 1)) elseif (ndim == 2) then allocate(data(end_index(1), end_index(2), 1, 1)) elseif (ndim == 3) then allocate(data(end_index(1), end_index(2), end_index(3), 1)) endif read(iunit) data data = data do i1=1,NumVar if(NomeVar(i1).eq.name) Then write (iunitex) flagex write (iunitex) ndim, start_index, end_index, time, staggering, ordering, & current_date, name, units, description write (iunitex) data endif enddo if(imprime) then if (ndim == 3) then sample = data( end_index(1)/2,end_index(2)/2,end_index(3)/2,1 ) else if (ndim == 2) then sample = data( end_index(1)/2,end_index(2)/2,1,1) else if (ndim == 1) then sample = data( end_index(1)/2,1,1,1) end if write(*,'(A8,1x,I1,4(1x,I3),1x,A,1x,A," : ", F20.8,1x,A)')& name, ndim, end_index(1), end_index(2), end_index(3), end_index(4),& staggering, ordering, sample, trim(units) endif deallocate(data) elseif (flag == 2) then newtime = .TRUE. else stop endif read(iunit, iostat=ierr) flag if (ierr==0.and.flag==2) write(iunitex, iostat=ierr) flag enddo write(*,'(/,"Hit the end of file of unit ", I3)') iunit end program readv3 subroutine printout_big_header(bhi, bhr, bhic, bhrc) implicit none integer, dimension(50,20) :: bhi real, dimension(20,20) :: bhr character(len=80), dimension(50,20) :: bhic character(len=80), dimension(20,20) :: bhrc integer :: i, j, v3j write(*,'(/)') v3j = bhi(1,1) if (bhi(1,1) == 11) v3j = v3j+5 do j = 1, v3j if (j < 8 .or. j>10) then if (j == 1) write(*, '("TERRAIN Portion of big header:")') if (j == 2) write(*, '(/,"REGRID Portion of big header:")') if (j == 3) write(*, '(/,"RAWINS Portion of big header:")') if (j == 4) write(*, '(/,"SFC RAWINS Portion of big header:")') if (j == 5) write(*, '(/,"INTERP Portion of big header:")') if (j == 11) write(*, '(/,"MM5 Portion of big header:")') if (j == 6) write(*, '(/,"MM5 Substrate Temp File big header:")') if (j == 7) write(*, '(/,"MM5 Boundary File big header:")') if (j == 8) write(*, '(/,"Interpolated MM5 Portion of big header:")') write(*,'(/,"***Integers:"/)') do i = 1, size(bhi,1) if (bhi(i,j) /= -999) then write(*,'("BHI(",I3,",",I2,"):",I8," : ",A)')& i, j, bhi(i,j),trim(bhic(i,j)) endif enddo write(*,'(/,"***Floats:"/)') do i = 1, size(bhr,1) if (bhr(i,j) /= -999.) then write(*,'("BHR(",I3,",",I2,"):",F9.2," : ",A)')& i, j, bhr(i,j),trim(bhrc(i,j)) endif enddo write(*,'(/)') endif enddo end subroutine printout_big_header subroutine arguments(v2file, lmore) implicit none character(len=*) :: v2file character(len=120) :: harg logical :: lmore integer :: ierr, i, numarg ! integer, external :: iargc ! numarg = iargc() numarg = 1 i = 1 lmore = .false. do while ( i < numarg) call getarg(i, harg) print*, 'harg = ', trim(harg) if (harg == "-v") then i = i + 1 lmore = .true. elseif (harg == "-h") then call help endif enddo call getarg(i,harg) v2file = harg end subroutine arguments subroutine help implicit none character(len=120) :: cmd call getarg(0, cmd) write(*,'(/,"Usage: ", A, " [-v] v2file ")') trim(cmd) write(*,'(8x, "-v : Print extra info")') write(*,'(8x, "v3file : MM5v3 file name to read.")') write(*,'(8x, "-h : print this help message and exit.",/)') stop end subroutine help