! !################################################################## !################################################################## !###### ###### !###### SUBROUTINE MKRADFNM ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! SUBROUTINE mkradfnm(dmpfmt,dir,ldir,radar,iyr,imo,ida,ihr,imin,isec, & 1,2 fname,lfnm) ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! !----------------------------------------------------------------------- ! ! Input arguments ! !----------------------------------------------------------------------- ! CHARACTER (LEN=120) :: dir INTEGER :: ldir CHARACTER (LEN=4) :: radar INTEGER :: iyr INTEGER :: imo INTEGER :: ida INTEGER :: ihr INTEGER :: imin INTEGER :: isec INTEGER :: dmpfmt ! !----------------------------------------------------------------------- ! ! Output arguments ! !----------------------------------------------------------------------- ! CHARACTER (LEN=100) :: fname INTEGER :: lfnm ! INTEGER :: rdtime,jyr,jmo,jda,jhr,jmin,jsec ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! !----------------------------------------------------------------------- ! ! Round to nearest minute ! !----------------------------------------------------------------------- ! jyr=iyr+1900 IF(iyr < 50) jyr=jyr+100 CALL ctim2abss( jyr,imo,ida,ihr,imin,isec, rdtime ) IF(isec >= 30) rdtime=rdtime+(60-isec) CALL abss2ctim( rdtime, jyr, jmo, jda, jhr, jmin, jsec ) jyr=MOD(jyr,100) IF(dmpfmt==1)THEN WRITE(fname,'(a,a4,a1,3(i2.2),a1,2(i2.2))') & dir(1:ldir),radar,'.', & jyr,jmo,jda,'.',jhr,jmin lfnm=ldir+16 ELSE WRITE(fname,'(a,a4,a1,3(i2.2),a1,2(i2.2),a5)') & dir(1:ldir),radar,'.', & jyr,jmo,jda,'.',jhr,jmin,'.hdf4' lfnm=ldir+21 ENDIF RETURN END SUBROUTINE mkradfnm ! !################################################################## !################################################################## !###### ###### !###### SUBROUTINE WRTRAD88 ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! SUBROUTINE wrtrad88(nx,ny,nz, &,2 iradfmt,rfname,radid,radlat,radlon,radelv, & iyr,imon,iday,ihr,imin,isec,vcpnum, & xsc,ysc,zpsc,gridvel,gridref,gridnyq,gridtim) ! !----------------------------------------------------------------------- ! ! Writes gridded radar data to a file ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! INTEGER :: nx,ny,nz ! INTEGER :: iradfmt CHARACTER (LEN=100) :: rfname CHARACTER (LEN=4) :: radid REAL :: radlat REAL :: radlon REAL :: radelv INTEGER :: iyr,imon,iday,ihr,imin,isec INTEGER :: vcpnum ! REAL :: xsc(nx) REAL :: ysc(ny) REAL :: zpsc(nx,ny,nz) ! ! ARPS radar arrays ! REAL :: gridvel(nx,ny,nz) REAL :: gridref(nx,ny,nz) REAL :: gridnyq(nx,ny,nz) REAL :: gridtim(nx,ny,nz) ! INCLUDE 'globcst.inc' INCLUDE 'remap.inc' INCLUDE 'grid.inc' ! !----------------------------------------------------------------------- ! ! Misc local variables ! !----------------------------------------------------------------------- ! INTEGER :: iunit,myr,itime INTEGER :: idummy REAL :: rdummy ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! myr=1900+iyr IF(myr < 1960) myr=myr+100 CALL ctim2abss(myr,imon,iday,ihr,imin,isec,itime) ! CALL getunit(iunit) ! !----------------------------------------------------------------------- ! ! Open file for output ! !----------------------------------------------------------------------- ! OPEN(iunit,FILE=rfname,STATUS='unknown', & FORM='unformatted') ! !----------------------------------------------------------------------- ! ! Write radar description variables ! !----------------------------------------------------------------------- ! WRITE(iunit) radid WRITE(iunit) ireftim,itime,vcpnum,idummy,idummy, & idummy,idummy,idummy,idummy,idummy ! !----------------------------------------------------------------------- ! ! Write grid description variables ! This should provide enough info to verify that the ! proper grid has been chosen. To recreate the grid, ! icluding elevation information, ! the reading program should get a grid-base-file ! named runname.grdbasfil ! !----------------------------------------------------------------------- ! idummy=0 rdummy=0. WRITE(iunit) runname WRITE(iunit) iradfmt,strhopt,mapproj,idummy,idummy, & idummy,idummy,idummy,idummy,idummy WRITE(iunit) dx,dy,dz,dzmin,ctrlat, & ctrlon,trulat1,trulat2,trulon,sclfct, & rdummy,rdummy,rdummy,rdummy,rdummy ! WRITE(iunit) gridref WRITE(iunit) gridvel WRITE(iunit) gridnyq WRITE(iunit) gridtim CLOSE(iunit) CALL retunit(iunit) ! RETURN END SUBROUTINE wrtrad88 ! !################################################################## !################################################################## !###### ###### !###### SUBROUTINE WTRADCOL ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! SUBROUTINE wtradcol(nx,ny,nz,dmpfmt,iradfmt,hdf4cmpr, & 2,37 rfname,radid,latrad,lonrad,elvrad, & iyr,imon,iday,ihr,imin,isec,vcpnum,isource, & xsc,ysc,zpsc,gridvel,gridref,gridnyq,gridtim, & outk,outhgt,outref,outvel,outnyq,outtim) ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Writes gridded radar data to a file as columns with ! individual lat,lons. ! !----------------------------------------------------------------------- ! ! AUTHOR: Keith Brewster ! 06/22/95 ! ! MODIFICATION HISTORY: ! ! 2000/09/11 (Gene Bassett) ! Use only reflectivity to accept or reject a column (thus allowing one ! to output nids columns without processing velocity data). ! ! 04/29/02 Leilei Wang and Keith Brewster ! Added hdf option, including two new variables in the argument list. ! !----------------------------------------------------------------------- ! ! INPUT: ! dmpfmt file format (1:binary, 2:hdf) ! iradfmt binary format ! hdf4cmpr hdf4 compression level ! rfname radar file name (character*80) ! radid radar id (character*4) ! latrad latitude of radar (degrees N) ! lonrad longitude of radar (degrees E) ! elvrad elevation of radar (m MSL) ! iyr year ! imon month ! iday day ! ihr hour ! imin min ! isec sec ! vcpnum VCP (scan type) number ! isource) source number ! 1= WSR-88D raw ! 2= WSR-88D NIDS ! ! OUTPUT: ! data are written to file ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! INTEGER :: nx,ny,nz ! INTEGER :: dmpfmt INTEGER :: iradfmt INTEGER :: hdf4cmpr CHARACTER (LEN=100) :: rfname CHARACTER (LEN=4) :: radid REAL :: latrad REAL :: lonrad REAL :: elvrad INTEGER :: iyr,imon,iday,ihr,imin,isec INTEGER :: vcpnum INTEGER :: isource ! REAL :: xsc(nx) REAL :: ysc(ny) REAL :: zpsc(nx,ny,nz) REAL :: gridref(nx,ny,nz) REAL :: gridvel(nx,ny,nz) REAL :: gridnyq(nx,ny,nz) REAL :: gridtim(nx,ny,nz) ! REAL :: outk(nz) REAL :: outhgt(nz) REAL :: outref(nz) REAL :: outvel(nz) REAL :: outnyq(nz) REAL :: outtim(nz) ! !----------------------------------------------------------------------- ! ! Include files ! !----------------------------------------------------------------------- ! INCLUDE 'globcst.inc' INCLUDE 'grid.inc' INCLUDE 'remap.inc' ! !----------------------------------------------------------------------- ! ! Radar output descriptors ! !----------------------------------------------------------------------- ! INTEGER :: mxradvr,nradvr PARAMETER(mxradvr=10,nradvr=6) INTEGER :: iradvr(mxradvr) DATA iradvr /1,2,3,4,5,6,0,0,0,0/ ! !----------------------------------------------------------------------- ! ! Radar output thresholds ! !----------------------------------------------------------------------- ! REAL :: refmin,refmax,velmin,velmax PARAMETER(refmin=-5.0, refmax=100., & velmin=-200.,velmax=200.) REAL :: misval PARAMETER(misval=-999.0) ! !----------------------------------------------------------------------- ! ! Radar output variables ! !----------------------------------------------------------------------- ! REAL :: outarray(nz,6) REAL :: grdlatc(nx,ny) REAL :: grdlonc(nx,ny) ! !----------------------------------------------------------------------- ! ! Misc local variables ! !----------------------------------------------------------------------- ! INTEGER :: iunit,myr,itime INTEGER :: i,j,k,klev,kk,kntcol,nn INTEGER :: idummy INTEGER :: istat,sd_id REAL :: gridlat,gridlon,elev,rdummy INTEGER(2), allocatable :: itmp(:,:,:) ! Temporary array REAL, allocatable :: hmax(:), hmin(:) ! Temporary array ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! IF (dmpfmt > 1 .AND. hdf4cmpr > 3) THEN ALLOCATE (itmp(nx,ny,nz),stat=istat) IF (istat /= 0) THEN WRITE (6,*) "HDFDUMP: ERROR allocating itmp, returning" RETURN END IF ALLOCATE (hmax(nz),stat=istat) IF (istat /= 0) THEN WRITE (6,*) "HDFDUMP: ERROR allocating hmax, returning" RETURN END IF ALLOCATE (hmin(nz),stat=istat) IF (istat /= 0) THEN WRITE (6,*) "HDFDUMP: ERROR allocating hmin, returning" RETURN END IF ENDIF myr=1900+iyr IF(myr < 1960) myr=myr+100 CALL ctim2abss(myr,imon,iday,ihr,imin,isec,itime) ! IF(dmpfmt == 1)THEN CALL getunit(iunit) ! !----------------------------------------------------------------------- ! ! Open file for output ! !----------------------------------------------------------------------- ! OPEN(iunit,FILE=rfname,STATUS='unknown', & FORM='unformatted') ! !----------------------------------------------------------------------- ! ! Write radar description variables ! !----------------------------------------------------------------------- ! WRITE(iunit) radid WRITE(iunit) ireftim,itime,vcpnum,isource,idummy, & idummy,idummy,idummy,idummy,idummy ! !----------------------------------------------------------------------- ! ! Write grid description variables ! This should provide enough info to verify that the ! proper grid has been chosen. To recreate the grid, ! icluding elevation information, ! the reading program should get a grid-base-file ! named runname.grdbasfil ! !----------------------------------------------------------------------- ! idummy=0 rdummy=0. WRITE(iunit) runname WRITE(iunit) iradfmt,strhopt,mapproj,idummy,idummy, & idummy,idummy,idummy,idummy,idummy WRITE(iunit) dx,dy,dz,dzmin,ctrlat, & ctrlon,trulat1,trulat2,trulon,sclfct, & latrad,lonrad,elvrad,rdummy,rdummy WRITE(iunit) nradvr,iradvr ELSE !HDF4 format ! !----------------------------------------------------------------------- ! ! Open file for output ! !----------------------------------------------------------------------- ! CALL hdfopen(trim(rfname), 2, sd_id) IF (sd_id < 0) THEN WRITE (6,*) "WTRADCOL: ERROR opening ", & trim(rfname)," for writing." istat = 1 STOP END IF ! !----------------------------------------------------------------------- ! ! Write radar description variables ! !----------------------------------------------------------------------- ! CALL hdfwrtc(sd_id, 4, 'radid', radid, istat) CALL hdfwrti(sd_id, 'ireftim', ireftim, istat) CALL hdfwrti(sd_id, 'itime', itime, istat) CALL hdfwrti(sd_id, 'vcpnum', vcpnum, istat) CALL hdfwrti(sd_id, 'isource', isource, istat) ! !----------------------------------------------------------------------- ! ! Write grid description variables ! This should provide enough info to verify that the ! proper grid has been chosen. To recreate the grid, ! icluding elevation information, ! the reading program should get a grid-base-file ! named runname.grdbasfil ! !----------------------------------------------------------------------- ! CALL hdfwrtc(sd_id, 4, 'runname', runname, istat) CALL hdfwrti(sd_id, 'iradfmt', iradfmt, istat) CALL hdfwrti(sd_id, 'strhopt', strhopt, istat) CALL hdfwrti(sd_id, 'mapproj', mapproj, istat) CALL hdfwrtr(sd_id, 'dx', dx, istat) CALL hdfwrtr(sd_id, 'dy', dy, istat) CALL hdfwrtr(sd_id, 'dz', dz, istat) CALL hdfwrtr(sd_id, 'dzmin', dzmin, istat) CALL hdfwrtr(sd_id, 'ctrlat', ctrlat, istat) CALL hdfwrtr(sd_id, 'ctrlon', ctrlon, istat) CALL hdfwrtr(sd_id, 'trulat1', trulat1, istat) CALL hdfwrtr(sd_id, 'trulat2', trulat2, istat) CALL hdfwrtr(sd_id, 'trulon', trulon, istat) CALL hdfwrtr(sd_id, 'sclfct', sclfct, istat) CALL hdfwrtr(sd_id, 'latrad', latrad, istat) CALL hdfwrtr(sd_id, 'lonrad', lonrad, istat) CALL hdfwrtr(sd_id, 'elvrad', elvrad, istat) CALL hdfwrti(sd_id, 'nradvr', nradvr, istat) CALL hdfwrt1d(iradvr,mxradvr,sd_id,'iradvr', 'iradvr','') print*,'hdfwrt iradvr' ENDIF ! !----------------------------------------------------------------------- ! ! For each horizontal grid point form a column of remapped ! data containing the non-missing grid points ! !----------------------------------------------------------------------- ! IF(dmpfmt==1)THEN kntcol=0 DO j=1,ny DO i=1,nx DO k=1,nz outk(k)=misval outhgt(k)=misval outref(k)=misval outvel(k)=misval outnyq(k)=misval outtim(k)=misval END DO klev=0 DO k=1,nz-1 IF((gridref(i,j,k)>refmin .AND. gridref(i,j,k)<refmax) .OR. & (gridvel(i,j,k)>velmin .AND. gridvel(i,j,k)<velmax))THEN klev=klev+1 outk(klev)=FLOAT(k) outhgt(klev)=zpsc(i,j,k) outref(klev)=gridref(i,j,k) outvel(klev)=gridvel(i,j,k) outnyq(klev)=gridnyq(i,j,k) outtim(klev)=gridtim(i,j,k) END IF END DO ! !----------------------------------------------------------------------- ! ! If there are data in this column, write them to the file. ! !----------------------------------------------------------------------- ! IF(klev > 0) THEN kntcol=kntcol+1 CALL xytoll(1,1,xsc(i),ysc(j),gridlat,gridlon) elev=0.5*(zpsc(i,j,1)+zpsc(i,j,2)) WRITE(iunit) i,j,xsc(i),ysc(j), & gridlat,gridlon,elev,klev WRITE(iunit) (outk(k),k=1,klev) WRITE(iunit) (outhgt(k),k=1,klev) WRITE(iunit) (outref(k),k=1,klev) WRITE(iunit) (outvel(k),k=1,klev) WRITE(iunit) (outnyq(k),k=1,klev) WRITE(iunit) (outtim(k),k=1,klev) END IF END DO END DO ELSE !HDF4 format CALL xytoll(nx,ny,xsc,ysc,grdlatc,grdlonc) CALL hdfwrt2d(grdlatc,nx,ny,sd_id,0,hdf4cmpr, & 'grdlatc','grid latitude','degree',itmp) CALL hdfwrt2d(grdlonc,nx,ny,sd_id,0,hdf4cmpr, & 'grdlonc','grid lontitude','degree',itmp) ! write(19,'(10f10.1)') gridref CALL hdfwrt3d(zpsc,nx,ny,nz,sd_id,0,hdf4cmpr, & 'hgtrad','height','m', & itmp,hmax,hmin) CALL hdfwrt3d(gridref,nx,ny,nz,sd_id,0,hdf4cmpr, & 'gridref','reflectivity','dbz', & itmp,hmax,hmin) CALL hdfwrt3d(gridvel,nx,ny,nz,sd_id,0,hdf4cmpr, & 'gridvel','radial velocity','m/s', & itmp,hmax,hmin) CALL hdfwrt3d(gridnyq,nx,ny,nz,sd_id,0,hdf4cmpr, & 'gridnyq','nyquist velocity','m/s', & itmp,hmax,hmin) CALL hdfwrt3d(gridtim,nx,ny,nz,sd_id,0,hdf4cmpr, & 'gridtim','time','', & itmp,hmax,hmin) ! ! Although all columns are actually written, find the non-missing ! data columns for statistics reporting purposes. ! kntcol=0 DO j=1,ny DO i=1,nx klev=0 DO k=1,nz IF(gridref(i,j,k) > refmin .AND. gridref(i,j,k) < refmax) & klev=klev+1 END DO IF(klev > 0) kntcol=kntcol+1 END DO END DO ENDIF ! IF(dmpfmt==1)THEN CLOSE(iunit) CALL retunit(iunit) ELSE CALL hdfclose(sd_id,istat) IF (istat /= 0) THEN WRITE (6,*) "HDFDUMP: ERROR on closing file ",trim(rfname), & " (status",istat,")" END IF IF (hdf4cmpr > 3) THEN DEALLOCATE (itmp,stat=istat) DEALLOCATE (hmax,stat=istat) DEALLOCATE (hmin,stat=istat) END IF ENDIF ! !----------------------------------------------------------------------- ! ! Report on what data were written ! !----------------------------------------------------------------------- ! WRITE(6,'(//a,i2.2,i2.2,i2.2,a1,i2.2,a1,i2.2)') & ' Output statistics for time ', & iyr,imon,iday,' ',ihr,':',imin WRITE(6,'(a,i6,a,/a,i6,a//)') & ' There were ',kntcol,' columns written ', & ' of a total ',(nx*ny),' possible.' ! RETURN END SUBROUTINE wtradcol