real, allocatable,dimension(:,:) :: input1 ! input data
real, allocatable,dimension(:,:) :: output ! output data
real :: bad,bad1 ! missing/bad value flags
real :: earth_radius ! radius of the earth in the files
real :: nlats ! Number of latitudes north of equator
real :: xfcst ! Forecast hour of data
real :: xlvl ! Vertical level of data in 2-d array
real :: startlat, startlon ! Lat/lon of point in array indicated by startloc
real :: deltalat, deltalon ! Grid spacing, degrees
real :: dx, dy ! Grid spacing, km
real :: xlonc ! Standard longitude of projection
real :: tlat1, tlat2 ! True latitudes of projection
real :: startlat2, startlon2, deltalat2, deltalon2
real :: dx2, dy2, xlonc2, tlat12, tlat22, nlats2
logical :: ok
logical :: debug = .false. ! set to .true. to debug
logical :: is_wind_grid_rel ! Flag indicating whether winds are
! relative to source grid (TRUE) or
! relative to earth (FALSE)
character (len=8) :: startloc ! Which point in array is given by
! startlat/startlon; set either
! to 'SWCORNER' or 'CENTER '
character (len=8) :: startloc2
character (len=9) :: field ! Name of the field
character (len=24) :: hdate ! Valid date for data YYYY:MM:DD_HH:00:00
character (len=25) :: units ! Units of data
character (len=32) :: map_source ! Source model / originating center
character (len=46) :: desc ! Short description of data
! Make sure the file exists and open it
inquire(file=infile1, exist=ok)
if (.not. ok) then
write(*,*) "Error: file not found: ",trim(infile1)
stop
endif
open(10,file=infile1,form='unformatted',convert='big_endian', &
status='old',err=99)
! Open the output file
open(12,file=outfile,form='unformatted',convert='big_endian',err=99)
!*********************************************************************
! LOOP OVER FIELDS FOUND IN INPUT FILES
!*********************************************************************
ios = 0 ! a leap of faith
do while (ios == 0)
! Read the 1st input file
read(10, iostat=ios) version
if (ios /= 0) exit ! should be triggered by end-of-file
if (version /= 5) then
write(*,*) "This code only works for Intermediate files version 5 (WPS)."
write(*,*) trim(infile1)," is version ",version
stop
endif
read(10) hdate,xfcst,map_source,field,units,desc,xlvl,xdim,ydim,iproj
if (iproj .eq. 0) then ! Cylindrical equidistant
read(10) startloc,startlat,startlon,deltalat,deltalon,earth_radius
else if (iproj .eq. 1) then ! Mercator
read(10) startloc,startlat,startlon,dx,dy,tlat1,earth_radius
else if (iproj .eq. 3) then ! Lambert conformal
read(10) startloc,startlat,startlon,dx,dy,xlonc,tlat1,tlat2,earth_radius
else if (iproj .eq. 4) then ! Gaussian
read(10) startloc,startlat,startlon,nlats,deltalon,earth_radius
else if (iproj .eq. 5) then ! Polar stereographic
read(10) startloc,startlat,startlon,dx,dy,xlonc,tlat1,earth_radius
end if
read(10) is_wind_grid_rel ! rotation flag
if (debug) then
write(*,*) "Read infile:"
write(*,*) " hdate = ",hdate
write(*,*) " field = ",field
write(*,*) " units = ",units
write(*,*) " desc = ",desc
write(*,*) " dims = ",xdim,ydim
write(*,*) " iproj = ",iproj
endif
if (.not. allocated(input1)) allocate( input1(xdim,ydim) )
read(10) input1 ! array of data
### INSERT FIXER CODE HERE ###
! Write the output file
write(12) version
write(12) hdate,xfcst,map_source,field,units,desc,xlvl,xdim,ydim,iproj
if (iproj .eq. 0) then ! Cylindrical equidistant
write(12) startloc,startlat,startlon,deltalat,deltalon,earth_radius
else if (iproj .eq. 1) then ! Mercator
write(12) startloc,startlat,startlon,dx,dy,tlat1,earth_radius
else if (iproj .eq. 3) then ! Lambert conformal
write(12) startloc,startlat,startlon,dx,dy,xlonc,tlat1,tlat2,earth_radius
else if (iproj .eq. 4) then ! Gaussian
write(12) startloc,startlat,startlon,nlats,deltalon,earth_radius
else if (iproj .eq. 5) then ! Polar stereographic
write(12) startloc,startlat,startlon,dx,dy,xlonc,tlat1,earth_radius
end if
write(12) is_wind_grid_rel ! 3) WRITE WIND ROTATION FLAG
if (debug) then
write(*,*) "Writing to outfile:"
write(*,*) " hdate = ",hdate
write(*,*) " field = ",field
write(*,*) " units = ",units
write(*,*) " desc = ",desc
write(*,*) " dims = ",xdim,ydim
write(*,*) " iproj = ",iproj
endif
write(12) output ! 4) WRITE 2-D ARRAY OF DATA
end do ! main loop over blocks in the input files
close(10) ! infile1
close(12) ! outfile
deallocate( input1, input2, output )