C$$$ MAIN PROGRAM DOCUMENTATION BLOCK C . . . . C MAIN PROGRAM: SATRADDUMP Dump & tutorial program for MADIS SATRAD C PRGMMR: L. BENJAMIN ORG: FSL DATE: 05-10-25 C C ABSTRACT: Dump MADIS satellite radiance metadata, observations, and C quality control (QC) information for a single time, based on the C user's selections specified in a text parameter file. The program C is also meant as a tutorial to demonstrate how a user can use the C MADIS library calls to write his or her own programs. C C PROGRAM HISTORY LOG: C 05-10-25 L. BENJAMIN Original version -- MADIS Version 2.9 C 05-11-18 L. BENJAMIN V3.0 - Changed comment re available datasets C 05-11-25 L. BENJAMIN V3.0 - Changed maximums to correct levels C - 2800000 maximum number of satellite channel records C - 80000 maximum number of satellite station records C 08-07-25 L. BENJAMIN V3.7 - Changed comment re available datasets C C USAGE: C INPUT FILES: (for the entire program) C C satraddump.par Parameter file (in current directory) with C user's selections. C C MADIS initialization files in MADIS_STATIC directory C C MADIS observation files under MADIS_DATA directories C C OUTPUT FILES: C C satraddump.txt Text output of metadata, obs & QC C C standard output Log of what was done, errors C C SUBPROGRAMS CALLED: C LIBRARY: - MADISLIB: MINIT, MSETWIN, MSETSATRADPVDR, MSETDOM, C MSETQC, MTRNTIM, MSATRADSTA, MGETIJ, C MGETSATRAD, M_MKFNAM, MGETVCN C C REMARKS: C C 1) This program can be used to exercise all options included in the C MADIS library for satellite wind data. It is also meant to be C used as a tutorial to demonstrate how a user can write his or C her own programs. C C 2) See the INSTALL.* files in the MADIS doc directory for C instructions on how to install and build the MADIS library and C programs (INSTALL.unix for Unix/Linux, INSTALL.windows for C Windows). C C 3) See the satraddump_usage.txt file in the MADIS doc directory for C instructions on how to set up a parameter file and run the C program. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 + EXTENSIONS C MACHINE: UNIX C C$$$ C---------------------------------------------------------------------- C Declarations notes: C C 1) Key constants: C C - 0 successful status return C - 999999.0 missing data flag C - 2800000 maximum number of satellite channel records C - 80000 maximum number of satellite station records C C 2) Arrays should be dimensioned to 2,100,000 for the maximum C number of satellite channel records C C 3) Arrays should be dimensioned to 60,000, for the maximum number C of satellite station records implicit none integer success_p,satrad_ds_p real miss_p parameter (success_p = 0) parameter (miss_p = 999999.0) parameter (satrad_ds_p = 11) integer istatus,i,line,idb,j,k,m integer nsta,nobs integer nobs_tb character*9 atime character*6 db character*9 timeob(80000) character*10 provdr(80000) real rdata200(35,80000) integer qca200(35,80000),qcr200(35,80000) character*1 qcd200(35,80000) real rdata1(80000) integer qca1(80000),qcr1(80000) character*1 qcd1(80000) logical has_tb,is_tb,read_tb equivalence (rdata200,rdata1) equivalence (qca200,qca1) equivalence (qcr200,qcr1) equivalence (qcd200,qcd1) real lat(80000),lon(80000),elev(80000) integer nchans(80000) integer nchans_tb(80000) character*70 vline character*7 satrp_vn_p parameter (satrp_vn_p = 'P') integer vcn character*7 vcode character*21 vcstr character*1 vtype,c integer minbck,minfwd,recwin,qctyp,ipvd,idmtyp,tform,ctime real dummy,ri(80000),rj(80000) integer idummy,time integer l real rpar(7) integer ipar(2) integer channel character*13 tstr character*10 pvdrnam character*63 twstr(0:4) integer twstrlen(0:4) character*16 qcstr(0:1) character*5 crecnum logical isprofile data twstr/ 1 'Return all records within the file containing nominal time', 2 'N/A','N/A','N/A', 3 'Return all records in window'/ data twstrlen/58,3,3,3,28/ data qcstr/'No Filter','Coarse'/ C---------------------------------------------------------------------- C PROGRAM SETUP C ------------- C C Open an output file for this program. open(unit=1,file='satraddump.txt',status='UNKNOWN') C Open the parameter file that will specify the user's selections. open(unit=2,file='satraddump.par',status='OLD') C---------------------------------------------------------------------- C MANDATORY MADIS INITIALIZATION C ----------------------------- C C Mandatory initialization which must be done before C any other MADIS library calls. C C Initialize the MADIS satellite wind subsystem C --------------------------------------------- C C The user selects the "subsystem" to be initialized by C specifying the following arguments to the MINIT call: C C 1) Name of the subsystem: C C 'SFC' Surface C 'RAOB' Radiosonde C 'NPN' NOAA Profiler Network C 'ACARS' Aircraft data (ACARS, AMDARS, etc.) C 'ACARSP' Aircraft data profiles at airports C 'MAP' Multi-Agency Profilers C 'HYDRO' Hydro C 'RDMTR' Radiometer C 'SATWND' Satellite wind C 'SATSND' Satellite sounding C 'SATRAD' Satellite radiance (used here) C 'SNOW' Snow C 'WISDOM' Wisdom balloon wind C C 2) Error handling (.true./.false.): C C If ".true.", then error messages will be written to standard C output. If ".false.", no error messages will be output (but C ISTATUS will still contain an error code). The error codes C can be found in errors.txt in the doc directory. C The necessary inputs are found in the parameter file, along with C a number of lines of explanation, section delimiters, etc. meant C to aid readability. Throughout this program, we'll be skipping C non-input lines, reading necessary inputs, and checking for I/O C errors. Otherwise, the validity of most of user's choices will C be tested by the affected MADIS library routines. Invalid C choices will be reported to standard output, and in most cases, C the program will then stop. 145 format(a) write(*,500)'MADIS SATRADDUMP Activity Log' 500 format(1x,a) write(*,500)'-----------------------------' 501 format(/,1x,a) 401 format(3x,a) db = 'FSL' CALL MINIT('SATRAD',db,.true.,istatus) if(istatus.ne.success_p)stop idb = 0 C---------------------------------------------------------------------- C OPTIONAL MADIS SETUP CALLS C ------------------------- C C Optional calls to limit which obs MADIS will return. C These can be selected at any time in the code, C and will then take effect upon the next call to C MSATRADSTA (see below). The default behavior (what C happens if you don't call the routine) is described C below. C C Select time window C ------------------ C C The user selects the nominal time of the data to be returned C when using MADIS routines to read obs and station information. C Time "windowing" is used so that the MADIS routines will C know how close in time each station's (i.e., satellite) C observation time needs to be to the nominal time in order to be C included. The time window is specified with the MSETWIN C subroutine, which allows the user to select the number of minutes C before and after the nominal time to be used for the window. C For more details, see msetwin.txt in the doc directory. C C If MSETWIN is not called, the default will be to return all C records in the file containing the nominal time. Each file C contains one hour, with observation times from 29 minutes before C the top of the hour through 30 minutes after the top of the hour. C C The wind products are available on different schedules for the C different satellites, and for the different types of wind C products. The observation times vary, and the latency ranges C from about one and a half to three hours (latency is defined as C the time the data are available minus the observation time). C The following sample MSETWIN call will return all records within C 2.5 hours before and 0.5 hours after the nominal time. C C Sample MSETWIN call: C C minbck = -150 C minfwd = 30 C recwin = 4 C CALL MSETWIN(minbck,minfwd,recwin,istatus) C PAR FILE INPUT: Time window parameters (minbck, minfwd, recwin) C [set all to 0 for default] do i = 1, 3 line = line + 1 read(2,*,err=825,end=850) enddo line = line + 1 read(2,*,err=825,end=850)minbck line = line + 1 read(2,*,err=825,end=850)minfwd line = line + 1 read(2,*,err=825,end=850)recwin write(*,501)'Time Window' if(recwin.ge.0.or.recwin.eq.4)then write(*,401)twstr(recwin)(1:twstrlen(recwin)) if(minbck.ne.0.or.minfwd.ne.0.or.recwin.ne.0)then write(*,502)'Start minute relative to nominal time ',minbck 502 format(3x,a,i4) write(*,502)'End minute relative to nominal time ',minfwd CALL MSETWIN(minbck,minfwd,recwin,istatus) if(istatus.ne.success_p)stop endif else write(*,500)'SATRADDUMP: INVALID WINDOW RECORD TYPE' stop endif C Select a subset of satellite wind datasets C ------------------------------------------ C C Satellite wind datasets are available for different satellites C and even different processing methods for the same satellite. C In MADIS parlance, these are specified by "provider". The C The MSETSATRADPVDR subroutine can be used to select only a C subset of the total by specifying which providers are to be C included or excluded. C C If MSETSATRADPVDR is not called, the default is to enable C all POES operational radiance products. C C Here's the list of provider names recognized by MADIS: C C 'NOAA-15' NOAA-15, operational radiance C 'NOAA-16' NOAA-16, operational radiance C 'NOAA-18' NOAA-18, operational radiance C C Here's an example of how to get only NOAA-16 radiance. C First you disable the providers specified by default, then select C the one(s) you want. C C CALL MSETSATRADPVDR('ALL-POES',.false.,istatus) C CALL MSETSATRADPVDR('NOAA-16',.true.,istatus) C PAR FILE INPUT: Providers (0 - all providers, C N - N lines of provider names follow) do i = 1, 4 line = line + 1 read(2,*,err=825,end=850) enddo line = line + 1 read(2,*,err=825,end=850)ipvd line = line + 1 read(2,*,err=825,end=850) write(*,501)'Providers' if(ipvd.gt.0)then CALL MSETSATRADPVDR('ALL-POES',.false.,istatus) do i = 1, ipvd line = line + 1 read(2,145,err=825,end=850)pvdrnam CALL MSETSATRADPVDR(pvdrnam,.true.,istatus) if(istatus.ne.success_p)stop write(*,401)pvdrnam enddo else if(ipvd.eq.0)then write(*,401)'ALL-POES' else write(*,500)'SATRADDUMP: INVALID PROVIDER SELECTION' stop endif C Select a horizontal domain C -------------------------- C C The horizontal domain can be limited to match one of two map C projections (polar stereographic, Lambert conformal conic) or it C can be limited to a latitude/longitude rectangle. Only stations C within the domain will be returned. If one of the map C projections is selected, any winds (of any form) returned by C subsequent MGETSATRAD calls will be rotated to match the C projection. See msetdom.txt in the doc directory for an C explanation of the parameters needed to define the domains. C C If MSETDOM is not called, all available observations will be C returned, regardless of their location. C C The example given here is for the CONUS 212 Lambert conformal C conic projection. C C CALL MSETDOM(3,40635.25,12.19,-133.459,-95.0,25.0,25.0,dummy, C 1 185,129,istatus) C PAR FILE INPUT: Domain Filter (0 - don't filter, C 1 - lat/lon corners, C 2 - Polar Stereographic grid, C 3 - Lambert Conformal Conic grid) do i = 1, 3 line = line + 1 read(2,*,err=825,end=850) enddo line = line + 1 read(2,*,err=825,end=850)idmtyp C We'll read in the parameters appropriate for the selected C domain filter, and skip over all of the other lines in the C rest of this section of the parameter file. write(*,501)'Domain Filter' if(idmtyp.eq.1)then do i = 1, 6 line = line + 1 read(2,*,err=825,end=850) enddo do i = 1, 4 line = line + 1 read(2,*,err=825,end=850)rpar(i) enddo do i = 1, 23 line = line + 1 read(2,*,err=825,end=850) enddo write(*,401)'Latitude/Longitude Corners' write(*,402)'SW corner latitude (north) ', 1 rpar(1) 402 format(3x,a,f13.6) write(*,402)'SW corner longitude (east) ', 1 rpar(2) write(*,402)'NE corner latitude (north) ', 1 rpar(3) write(*,402)'NE corner longitude (east) ', 1 rpar(4) CALL MSETDOM(idmtyp,rpar(1),rpar(2),rpar(3),rpar(4),dummy, 1 dummy,dummy,idummy,idummy,istatus) else if(idmtyp.eq.2)then do i = 1, 13 line = line + 1 read(2,*,err=825,end=850) enddo do i = 1, 7 line = line + 1 read(2,*,err=825,end=850)rpar(i) enddo do i = 1, 2 line = line + 1 read(2,*,err=825,end=850)ipar(i) enddo do i = 1, 11 line = line + 1 read(2,*,err=825,end=850) enddo write(*,401)'Polar Stereographic Grid' write(*,402)'Grid box size (meters) ', 1 rpar(1) write(*,402)'Latitude (north) of 1st grid point ', 1 rpar(2) write(*,402)'Longitude (east) of 1st grid point ', 1 rpar(3) write(*,402)'Orientation longitude (east) ', 1 rpar(4) write(*,402)'I-coordinate of pole ', 1 rpar(5) write(*,402)'J-coordinate of pole ', 1 rpar(6) write(*,402)'Latitude (north) at which X-Y scale is true', 1 rpar(7) write(*,403)'Number of grid points (X) ', 1 ipar(1) write(*,403)'Number of grid points (Y) ', 1 ipar(2) 403 format(3x,a,i6) CALL MSETDOM(idmtyp,rpar(1),rpar(2),rpar(3),rpar(4),rpar(5), 1 rpar(6),rpar(7),ipar(1),ipar(2),istatus) else if(idmtyp.eq.3)then do i = 1, 25 line = line + 1 read(2,*,err=825,end=850) enddo do i = 1, 6 line = line + 1 read(2,*,err=825,end=850)rpar(i) enddo do i = 1, 2 line = line + 1 read(2,*,err=825,end=850)ipar(i) enddo write(*,401)'Lambert Conformal Conic Grid' write(*,402)'Grid box size (meters) ', 1 rpar(1) write(*,402)'Latitude (north) of 1st grid point ', 1 rpar(2) write(*,402)'Longitude (east) of 1st grid point ', 1 rpar(3) write(*,402)'Orientation longitude (east) ', 1 rpar(4) write(*,402)'Latitude (north) of 1st tangent ', 1 rpar(5) write(*,402)'Latitude (north) of 2nd tangent ', 1 rpar(6) write(*,403)'Number of grid points (X) ', 1 ipar(1) write(*,403)'Number of grid points (Y) ', 1 ipar(2) CALL MSETDOM(idmtyp,rpar(1),rpar(2),rpar(3),rpar(4),rpar(5), 1 rpar(6),dummy,ipar(1),ipar(2),istatus) else if(idmtyp.eq.0)then write(*,401)'No Filter' do i = 1, 33 line = line + 1 read(2,*,err=825,end=850) enddo else write(*,500)'SATRADDUMP: INVALID DOMAIN TYPE' stop endif if(istatus.ne.success_p)stop C Select QC level of data to be returned C -------------------------------------- C C The primary variables in all MADIS datasets have been screened C by automated quality control (QC) checks. Different variables C have different levels of QC, or "stages", applied to them. C In addition to the QC processing done by the satellite provider C (who generally toss observations that are below their own quality C thresholds), currently the satellite winds have a MADIS level 1 C validity check applied to them. See satrad_qc_variable_list.txt C in the doc directory for more information. C C Each call to MGETSATRAD will return obs and associated QC C information. If the user doesn't want to interpret the QC info, C he or she can limit the returned obs to selectable levels of C quality. In that case, obs that don't meet the selected QC level C will be replaced with missing data flags, and the QC information C itself doesn't need to be examined by the calling program. C C If MSETQC is not called, all obs will be returned (along with QC C info). C C There are three ways that the user can request and process the QC C information: C C 1) Don't call MSETQC at all, and examine the QC info before C deciding whether or not to use each observation. This C allows the calling program the maximum amount of control C over what's available. C C 2) If you know ahead of time that the same level of QC is C available for all variables you'll be using, call MSETQC C one time to select the desired QC level. Note that the C level selected by MSETQC will stay in effect until the C next time MSETQC is called. C C 3) To require that all variables pass the highest level C of QC that are specified for them, call MSETQC one time C and select QC level 99. C C User's of MADIS data who want the data filtered by QC results, C but don't want to interpret the QC information themselves, should C call MSETQC one time and select QC level 99. C PAR FILE INPUT: QC level (0-none, 1-coarse, 99-highest possible) do i = 1, 3 line = line + 1 read(2,*,err=825,end=850) enddo line = line + 1 read(2,*,err=825,end=850)qctyp write(*,501)'QC Filter' if(qctyp.ge.0.and.qctyp.le.1)then write(*,401)qcstr(qctyp) else if(qctyp.eq.99)then write(*,401)'Highest Possible' else write(*,500)'SATRADDUMP: INVALID QC TYPE' stop endif C Select the QC level to be returned. CALL MSETQC(qctyp,istatus) if(istatus.ne.success_p)stop C---------------------------------------------------------------------- C SELECT NOMINAL TIME OF DATA TO BE RETURNED C ------------------------------------------ C C The MADIS library's native time zone and format is Universal C Coordinated Time, using a Julian date, in the form of "YYJJJHHMM" C , where: C C YY = 2-digit year (good from 1980 - 2179) C JJJ = Julian date of the year (001-366) C HH = Hour (00-23) C MM = Minute (00-59) C C MADIS also provides support for a "Month/Day" date format, using C "YYYYMMDD_HHMM", where: C C YYYY = 4-digit year (still only good from 1980 - 2179) C MMDD = Month/Day C HHMM = Hour/Minute C C The MADIS library includes a basic set of routines that the C caller can use to: C C - Add & subtract time in the native format. (MCHGTIM) C - Translate the native format to integers representing year, C month, day, hour, and minute. (MINTTIM) C - Translate integers representing year, month, day, hour and C minute into the native format. (MCHRTIM) C - Translate between Julian and Month/Day formats (MTRNTIM) C C See time_routines.txt in the doc directory for details on how C to use these calls. C C Also note that nominal times can be specified at any minute, not C just at the top of the hour (minute 00). C PAR FILE INPUT: Time format to use (0 - Julian, 1 - Month/Day) write(*,501)'Nominal Time' do i = 1, 5 line = line + 1 read(2,*,err=825,end=850) enddo line = line + 1 read(2,*,err=825,end=850)tform if(tform.ne.0.and.tform.ne.1)then write(*,500)'SATRADDUMP: INVALID TIME TRANSLATION FORMAT' stop endif C PAR FILE INPUT: Nominal time (0 - specified in par file, C 1 - use current time) line = line + 1 read(2,*,err=825,end=850) line = line + 1 read(2,*,err=825,end=850)ctime line = line + 1 read(2,*,err=825,end=850) C PAR FILE INPUT: Nominal time (in selected format) line = line + 1 read(2,144,err=825,end=850)tstr 144 format(a) C If the user wants to use the current time, get it and translate C that into the chosen format (via our internal formats). C Otherwise we have the chosen format in TSTR right now. if(ctime.eq.1)then i = TIME() i = i - 1325376000 CALL M_MKFNAM(i,atime,istatus) if(tform.eq.1)then CALL MTRNTIM(atime,2,tstr,istatus) else tstr = atime endif endif if(tform.eq.1)then CALL MTRNTIM(tstr,1,atime,istatus) if(istatus.ne.success_p)stop else atime = tstr endif write(*,401)tstr do i = 1, 3 line = line + 1 read(2,*,err=825,end=850) enddo C---------------------------------------------------------------------- C LOAD IN STATION INFO FOR SELECTED DATA C -------------------------------------- C C Load in the stations for all selected datasets, covering C the selected domain. The MSATRADSTA call needs to be done C as the first call when getting data for a new time, or C whenever any of the optional setup calls are used. Thereafter, C MGETSATRAD can be called as many times as desired in order to C read variables. CALL MSATRADSTA(atime,nsta,provdr,lat,lon,elev,timeob, 1 istatus) if(istatus.ne.success_p)stop C If one of the map projections has been selected for the C horizontal domain, the station latitude and longitude can be C converted to a floating point grid index into the 2-dimensional C grid (RI,RJ). Note that this works for grids laid out this way: C C NE (I=NX,J=NY) C C SW (I=1,J=1) C C If we're to convert LAT/LON to RI,RJ for the user's grid, do C so. Otherwise, fill in 0's so there'll be something in the C output line that isn't too messy. if(idmtyp.eq.2.or.idmtyp.eq.3)then do i = 1, nsta CALL MGETIJ(lat(i),lon(i),ri(i),rj(i),istatus) enddo else do i = 1, nsta ri(i) = 0 rj(i) = 0 enddo endif C---------------------------------------------------------------------- C LOOP THROUGH DESIRED VARIABLES: C ------------------------------- C C Variables are specified by code names. The list of code names C can be found in the first column of satrad_variable_list.txt in C the doc directory. C C This program will read in one variable code per line in the C parameter file, read it, output it, then move on to the next C variable until the end of the parameter file is reached. write(*,501)'Variables' C PAR FILE INPUT: 1 to 4 variable codes (free-formatted) C Set read_tb and has_tb to false to show we have not have any C brightness temperature data. Because the brightness temperature C data is in one array , it is only read once and then stored for C future use. C has_tb flag: data exists status. C read_tb flag: data read status C is_tb flag: is TB variable has_tb = .false. read_tb = .false. 100 read(2,145,end=900)vline C Default, not a TB variable is_tb = .false. C Read code name l = -1 j = l CALL M_FINDWORD(vline,70,j,k,l) if(k.eq.0)then go to 100 else vcode = vline(k:l) if(vline(k:k+1).eq.'tb' .or. vline(k:k+1) .eq.'TB')then is_tb = .true. endif endif C If we are using TB, then get all of channels. We will filter C it later. if(is_tb .and. .not.read_tb)then read_tb = .true. C The MGETSATRAD routine is used to read all numeric variables. C All variables are returned as Fortran REAL type (RDATA200), the C QC data descriptors are always CHARACTER*1 (QCD200), and the C bit masks showing the QC checks that were applied (QCA200) and C their results (QCR200) are always INTEGER. CALL MGETSATRAD(atime,vcode,nsta,nobs_tb,nchans_tb, 1 rdata200(1,1),qcd200(1,1), 2 qca200(1,1),qcr200(1,1),istatus) has_tb = .true. if(istatus.ne.success_p)has_tb = .false. endif C Use internal MADIS routines (MGETVCN, MGENVCN) to translate the C variable code name into the MADIS variable code number, and to C determine the type (numeric or character) of the variable. The C code number is also then used to determine the profile type. C This is needed here because this program is an all-purpose utility C meant to handle any desired profile type. In general, a user's C MADIS program shouldn't have to determine the profile type (as you C would know what variables you're reading). C Profile Type C ------------------- C -20 Profile data C 0 Single-dimensioned (not a profile) CALL MGETVCN(vcode,vcn,vtype,istatus) if(istatus.ne.success_p)stop C Check for non-written code, should not be requested write(*,505)vcode 505 format(3x,'Processing',5x,a) C Read the desired variables and QC info. The returned arrays C will match the records in the station info arrays returned C from MACARSPSTA. If a QC level has been selected, the obs will C only be returned if they meet or exceed the selected QC C level. if(.not.is_tb )then CALL MGETSATRAD(atime,vcode,nsta,nobs,nchans, 1 rdata1(1),qcd1(1),qca1(1), 2 qcr1(1),istatus) write(1,146)'var ',vcode,' total stns ',nsta, 1 ' # non-missing obs ',nobs else write(1,146)'var ',vcode,' total stns ',nsta, 1 ' # non-missing obs ',nobs_tb endif 146 format(/,1x,a,a,a,i5,a,i7) if(istatus.ne.success_p)go to 150 C Put the variable code name into an array that will be used as C a label in header lines in the output file. vcstr = vcode//' QCD QCA QCR' 150 continue C Output the station info, variables and QC. write(1,*) write(1,6001)vcode 6001 format(11x,'Record Elev(m) Lat(N) Lon(E) Grid I', 1 ' Grid J ObTime Provider ',a, 2 ' QCD QCA QCR',/) if(is_tb)then read(vcode(3:4),1002)channel 1002 format(i2) if(channel.lt.1 .or.channel.gt.35)then write(*,*)'Only Channels from 1 to 35 are supported' else do 201 i = 1, nsta write(crecnum,1001)i 1001 format(i5) do m = 1,5 if(crecnum(m:m).eq.' ')crecnum(m:m)='0' enddo C Use the time output format desired by the user. if(tform.eq.0)then tstr = ' '//timeob(i) else if(tform.eq.1)then CALL MTRNTIM(timeob(i),2,tstr,istatus) endif j = channel if(miss_p.ne.rdata200(j,i)) 1 write(1,7001)vcode,crecnum,elev(i),lat(i), 2 lon(i),ri(i),rj(i),tstr,provdr(i),rdata200(j,i), 3 qcd200(j,i),qca200(j,i),qcr200(j,i) 7001 format(1x,'V-',a,1x,'R-',a,1x,f7.2,1x, 1 f6.2,1x,f7.2,1x,2(f8.3,1x),a,1x,a, 2 1x,f13.6,1x,a1,1x,i3,1x,i3) 201 continue endif else crecnum = '00000' j = 1 do 200 i = 1, nsta write(crecnum,1001)i do m = 1,5 if(crecnum(m:m).eq.' ')crecnum(m:m)='0' enddo C Use the time output format desired by the user. if(tform.eq.0)then tstr = ' '//timeob(i) else if(tform.eq.1)then CALL MTRNTIM(timeob(i),2,tstr,istatus) endif if(miss_p.ne.rdata1(i)) 1 write(1,7001)vcode,crecnum,elev(i),lat(i), 2 lon(i),ri(i),rj(i),tstr,provdr(i),rdata1(i),qcd1(i), 3 qca1(i),qcr1(i) 200 continue endif C Process the next line of variables. go to 100 C---------------------------------------------------------------------- C PROGRAM EXIT C ------------ C C Error exits. 825 write(*,503)'SATRADDUMP: READ ERROR IN PARAMETER FILE AT LINE ', 1 line 503 format(1x,a,i4) stop 850 write(*,500)'SATRADDUMP: PREMATURE END OF PARAMETER FILE' C Normal exit. 900 stop end C**--------------------------------------------------------------------- C**REQUIRED STANDARD FSL DISCLAIMER (NOVEMBER 2000) C**--------------------------------------------------------------------- C** OPEN SOURCE LICENSE/DISCLAIMER, FORECAST SYSTEMS LABORATORY C** NOAA/OAR/FSL, 325 BROADWAY BOULDER, CO 80305 C** C** THIS SOFTWARE IS DISTRIBUTED UNDER THE OPEN SOURCE DEFINITION, C** WHICH MAY BE FOUND AT http://www.opensource.org/osd.html. C** C** IN PARTICULAR, REDISTRIBUTION AND USE IN SOURCE AND BINARY FORMS, C** WITH OR WITHOUT MODIFICATION, ARE PERMITTED PROVIDED THAT THE C** FOLLOWING CONDITIONS ARE MET: C** C** - REDISTRIBUTIONS OF SOURCE CODE MUST RETAIN THIS NOTICE, THIS LIST C** OF CONDITIONS AND THE FOLLOWING DISCLAIMER. C** C** - REDISTRIBUTIONS IN BINARY FORM MUST PROVIDE ACCESS TO THIS C** NOTICE, THIS LIST OF CONDITIONS AND THE FOLLOWING DISCLAIMER, AND C** THE UNDERLYING SOURCE CODE. C** C** - ALL MODIFICATIONS TO THIS SOFTWARE MUST BE CLEARLY DOCUMENTED, C** AND ARE SOLELY THE RESPONSIBILITY OF THE AGENT MAKING THE C** MODIFICATIONS. C** C** - IF SIGNIFICANT MODIFICATIONS OR ENHANCEMENTS ARE MADE TO THIS C** SOFTWARE, THE FSL SOFTWARE POLICY MANAGER C** (softwaremgr.fsl@noaa.gov) BE NOTIFIED. C** C** THIS SOFTWARE AND ITS DOCUMENTATION ARE IN THE PUBLIC DOMAIN AND C** ARE FURNISHED "AS IS." THE AUTHORS, THE UNITED STATES GOVERNMENT, C** ITS INSTRUMENTALITIES, OFFICERS, EMPLOYEES, AND AGENTS MAKE NO C** WARRANTY, EXPRESS OR IMPLIED, AS TO THE USEFULNESS OF THE SOFTWARE C** AND DOCUMENTATION FOR ANY PURPOSE. THEY ASSUME NO RESPONSIBILITY C** (1) FOR THE USE OF THE SOFTWARE AND DOCUMENTATION; OR (2) TO C** PROVIDE TECHNICAL SUPPORT TO USERS. C**---------------------------------------------------------------------