program read_eol c c program to read hires sounding data in EOL format c c gfortran read_upaL2_eol.f -o read_upaL2_eol.x c parameter (m=11000) real xlon, xlat, alt integer iyr, mon, idy, ihr, min integer imm, idd, ihh common /header/ xlon, xlat, alt, iyr, mon, idy, ihr, min common /info/ project_id, stn_id, sonde_type, sonde_id real time, p0, z0, t0, rh, d0, u0, v0, wspd, wdir, xlt, xln common /data/ time(m), p0(m), z0(m), t0(m), rh(m), d0(m), 2 u0(m), v0(m), wspd(m), wdir(m), xlt(m), xln(m) character stn_id*5, project_id*7, sonde_id*8, sonde_type*12 character fname*35, cid*5, fout*12, resp*1 c ************************************************************ c contains list of files to be processed open(2, file='files_hires', form='formatted', status='old') nf = 0 c read in file do read(2,'(a)',iostat=ier1)fname if(ier1 .ne. 0) exit nf = nf + 1 print *, 'reading data for ', nf, fname c open data files c file 8 contain input hi-res data open(8, file=fname, form='formatted', status='old') c c read in one data for one time from file 8 c call readeol(8, nl) c print *, 'project ID:', project_id c print *, 'stn ID:', stn_id c print *, 'sonde type:',sonde_type c print *, 'sonde ID:', sonde_id c print *, 'lon./lat./alt ', xlon, xlat, alt print *, 'date/time ', iyr, mon, idy, ihr, min print *, 'number of data lines ', nl c do l=1,nl c print *, time(l), p0(l), z0(l), t0(l), rh(l), wspd(l), c 2 wdir(l), xln(l), xlt(l) c enddo enddo print *, 'number of soundings read in ', nf end subroutine readeol(iun, lvl) c c read in data for one time c assuming data is in NCAR CLass EOL c c time - time from launch (s) c ih - UTC hr c im - min c sec - second c p0 - pressure (hPa) c t0 - temperature (C) c d0 - dew-point temperature (C) c rh - relative humidity (% wrt to water) c u0 - zonal wind speed (m/s) c v0 - meridional wind speed (m/s) c wspd - wind speed (m/s) c wdir - wind direction c dz - ascent rate (m/s) c z0 - alt (m) c xln - longitude c xlt - latitude c gpalt- altitude from gps measurement parameter (m=11000, pmis=-999., xmis=-999.) integer iyr, mon, idy, ihr, min, ih, im, pos, ipos real sec, gpsalt common /header/ xlon, xlat, alt, iyr, mon, idy, ihr, min common /info/ project_id, stn_id, sonde_type, sonde_id real time, p0, z0, t0, rh, d0, u0, v0, wspd, wdir, xlt, xln common /data/ time(m), p0(m), z0(m), t0(m), rh(m), d0(m), 2 u0(m), v0(m), wspd(m), wdir(m), xlt(m), xln(m) character hline*100, dline*135, stn_id*5 character project_id*7, sonde_id*8, sonde_type*12 c ************************************************************* c c routine to read in uncorrected souding data c 10 read (iun,'(a100)') hline if (hline(1:4) .eq. 'Data') then read(iun, '(a100)') hline c read in project ID read (iun,'(a100)') hline read (hline(44:50), '(a)') project_id c read in stn_id read(iun, '(a100)') hline read(hline(44:48),'(a)') stn_id c read in lon, lat, alt info read(iun, '(a100)') hline call find_char(hline(44:94), 'W', pos, ifnd) ipos = pos + 44 read (hline(ipos+1:ipos+8),*) xlon call find_char(hline(44:94), 'N', pos, ifnd) if(ifnd .ne. 1) then call find_char(hline(44:94), 'S', pos, ifnd) if(ifnd .ne. 1) then return endif endif ipos = pos + 44 read (hline(ipos+1:ipos+8),*) xlat read (hline(ipos+14:ipos+19),*) alt write(39,*) xlon, xlat, alt c read in date / time information read (iun,'(a100)') hline read (hline(46:47),*) iyr read (hline(50:51),*) mon read (hline(54:55),*) idy read (hline(58:59),*) ihr read (hline(61:62),*) min c read remainder of header lines c read in sonde type and serial number read (iun,'(a100)') hline call find_char(hline(44:66), '/', pos, ifnd) ipos = pos + 43 read (hline(ipos-8:ipos-1), '(a)') sonde_id read (hline(ipos+1:ipos+12), '(a)') sonde_type read (iun,'(a100)') hline c read remainder of header lines do i=1,6 read (iun,'(a82)') hline enddo else go to 10 endif C------- read in data --------------------------------------------------- lvl = 0 do read (iun,'(a133)',iostat=ier2) dline if(ier2 .ne. 0) exit lvl = lvl + 1 if(lvl .gt. m) then print *, 'array size too small' stop endif read (dline,*) time(lvl), ih, im, sec, p0(lvl), t0(lvl), 2 d0(lvl), rh(lvl), u0(lvl), v0(lvl), wspd(lvl), wdir(lvl), 3 dz, z0(lvl), xln(lvl), xlt(lvl), gpsalt enddo return end subroutine find_char(string, char, pos, ifnd) c find position of a character in a string character string*(*), char*1 integer truelen, len, pos, ifnd len = truelen(string) ifnd = 0 do i=1,len if(string(i:i) .eq. char) then pos = i ifnd = 1 return endif enddo print *, 'string not found ', char return end function truelen(str) c integer truelen character str*(*) c c======================================================================= c truelen.f (rktf library) Rick Taft (02-08-1996) c----------------------------------------------------------------------- c Returns the "true" length of the indicated string. The "true" length c of a string is the length of the string up thru the last non-space c character (i.e., any trailing spaces are ignored). c c Input Parameters: c ---------------- c str = string whose "true" length is to be determined c c Return Value: c ------------ c "true" length of str (0 means that str was all spaces) c======================================================================= c integer j c c----------------------------------------------------------------------- c c find position of last non-space character in str c j = len(str) 100 if (j.gt.1 .and. str(j:j).eq.' ') then j = j-1 goto 100 endif c c check if str is an empty string c if (j.eq.1 .and. str(1:1).eq.' ') then truelen = 0 else truelen = j endif return end