!------------------------------------------------------------------------------ ! ! NAME: etl_sounding ! ! PURPOSE: Module containing read and write routines for ! processing etl formatted soundings ! ! LANGUAGE: IDL ! ! CALLING SEQUENCE: USE etl_sounding ! ! INPUTS: ! ! INPUT KEYWORD PARAMETERS: ! ! OUTPUTS: ! ! OUTPUT KEYWORD PARAMETERS: ! ! FUNCTION RESULT: ! ! MODULES: ! ! CONTAINS: read_etl_sounding -> reads etl formatted sounding ! nlevels_etl_sounding -> retrieves number of levels in sounding file ! (not yet) write_etl_sounding -> writes etl sounding ! INCLUDE FILES: ! ! EXTERNALS: ! ! SIDE EFFECTS: ! ! RESTRICTIONS: ! ! CREATION HISTORY: Darren Jackson CIRES/ETL Feb 2002 ! !--------------------------------------------------------------------- ! MODULE etl_sounding IMPLICIT NONE CONTAINS !-------------------------------------------------------------------------------- ! ! NAME: read_etl_sounding ! ! PURPOSE: Subroutine that reads etl-formatted sounding files ! ! LANGUAGE: Fortran 90 ! ! CALLING SEQUENCE: CALL read_etl_sounding( & ! (ifile, & ! pres, & ! temp, & ! h2omx, & ! stat_id=stat_id & ! stat_desc=stat_desc, & ! mmddyy=mmddyy & ! hhmmss=hhmmss & ! lat=lat & ! lon=lon & ! dptemp=dptemp & ! wspeed=wspeed & ! wdir=wdir & ! rh=rh & ! alt=alt, & ! o3=o3, & ! mnames=mnames, & ! mol1_5=mol1_5 ) ! ! INPUTS: ! variable | description | type | dimens. | units ! ----------------------------------------------------------- ! ifile | input file name | string | scalar | N/A ! ! OUTPUTS: ! variable | description | type | dimens. | units ! ----------------------------------------------------------- ! pres | pressure | float | M * 1 | mb ! temp | temperature | float | M * 1 | Celcius ! h2o | h2o mixing ratio | float | M * 1 | g/kg ! OUTPUT KEYWORDS: ! stat_id | station ID | long | scalar | N/A ! stat_desc| station descrip. | string | scalar | N/A ! mmddyy | date | string | scalar | month/day/year ! hhmmss | time | string | M * 1 | hour/min/sec ! lat | latitude | float | scalar | -90 to 90 ! lon | longitude | float | scalar | 0 to 360 ! alt | altitude | float | M * 1 | km ! dptemp | dew pnt. temp. | float | M * 1 | Celcius ! wspeed | wind speed | float | M * 1 | meters/sec ! wdir | wind direction | float | M * 1 | azimuth in deg. ! o3 | ozone mixing ratio | float | M * 1 | ppmv ! rh | relative humidity | float | M * 1 | % ! molnames | names of molecules | string | N * 1 | N/A ! mol1_5 | user specified mol.| float | M * N | ppmv ! ! MODULES: ! ! CONTAINS: read_etl_sounding -> reads etl formatted sounding ! write_etl_sounding -> writes etl sounding ! ! RESTRICTIONS: Requires that vector arguments be defined in calling program ! and have a number of levels that equals or exceeds that read ! into the subroutine. ! ! CREATION HISTORY: Darren Jackson CIRES/ETL Feb 2002 ! !--------------------------------------------------------------------- ! SUBROUTINE read_etl_sounding( ifile, & nlev, & pres, & temp, & h2omx, & stat_id, & stat_desc, & mmddyy, & hhmmss, & lat, & lon, & dptemp, & wspeed, & wdir, & rh, & alt, & o3, & molnames, & mol1_5 ) !------------------------------- ! Declare assumed-shape arrays !------------------------------- USE parkind1, Only: jprb CHARACTER( * ), INTENT(IN) :: ifile INTEGER, INTENT(IN) :: nlev REAL(Kind=jprb), DIMENSION( : ), INTENT(OUT) :: pres REAL(Kind=jprb), DIMENSION( : ), INTENT(OUT) :: temp REAL(Kind=jprb), DIMENSION( : ), INTENT(OUT) :: h2omx INTEGER, OPTIONAL, INTENT(OUT) :: stat_id CHARACTER( * ), OPTIONAL, INTENT(OUT) :: stat_desc INTEGER, OPTIONAL, INTENT(OUT) :: mmddyy REAL, OPTIONAL, INTENT(OUT) :: lon REAL, OPTIONAL, INTENT(OUT) :: lat INTEGER, OPTIONAL,DIMENSION( : ), INTENT(OUT) :: hhmmss REAL, OPTIONAL,DIMENSION( : ), INTENT(OUT) :: alt REAL, OPTIONAL,DIMENSION( : ), INTENT(OUT) :: dptemp REAL, OPTIONAL,DIMENSION( : ), INTENT(OUT) :: wspeed REAL, OPTIONAL,DIMENSION( : ), INTENT(OUT) :: wdir REAL(Kind=jprb),OPTIONAL,DIMENSION( : ), INTENT(OUT) :: o3 REAL, OPTIONAL,DIMENSION( : ), INTENT(OUT) :: rh CHARACTER( 5 ), OPTIONAL,DIMENSION( : ), INTENT(OUT) :: molnames REAL, OPTIONAL,DIMENSION( : , : ), INTENT(OUT) :: mol1_5 !------------------------------ ! Declare allocatable arrays !------------------------------ INTEGER, ALLOCATABLE, DIMENSION( : ) :: hms REAL, ALLOCATABLE, DIMENSION( : , : ) :: xdata INTEGER :: allocate_status,stat,ip,irec,l,reclen !------------------------------------------------------------ ! Declare header structure for ETL sounding !------------------------------------------------------------ TYPE header_etl_sounding INTEGER :: nlev INTEGER :: stat_id CHARACTER( 80 ) :: stat_desc INTEGER :: mmddyy REAL :: lat REAL :: lon INTEGER :: nmol CHARACTER( 5 ), DIMENSION( 5 ) :: molnames CHARACTER( 71 ) :: fill END TYPE header_etl_sounding TYPE(header_etl_sounding) :: header !--------------------------------------- ! Determine record length of sounding !-------------------------------------- reclen = 200 + (nlev * 4 * 15) !-------------------------------- ! Allocate space for data record !-------------------------------- ALLOCATE( xdata(nlev,14), & hms(nlev), & STAT = allocate_status) IF( allocate_status /= 0) THEN WRITE(*,*) 'Error allocating data arrays xdata/hms' WRITE(*,*) 'STAT = ',STAT STOP ENDIF !---------------------------------------- ! Open the atmospheric profile data !---------------------------------------- OPEN(10,FILE=ifile,STATUS='OLD',ACCESS='DIRECT',RECL=reclen) !---------------------------- ! Read header and data information !---------------------------- write(*,*) 'nlev = ',nlev READ(10,REC=1) header,hms,xdata CLOSE(10) !---------------------------------- ! Move data into proper array names !---------------------------------- pres(1:nlev) = xdata(1:nlev,1) temp(1:nlev) = xdata(1:nlev,3) h2omx(1:nlev) = xdata(1:nlev,6) IF(PRESENT(stat_id)) stat_id = header%stat_id IF(PRESENT(stat_desc)) stat_desc = header%stat_desc IF(PRESENT(mmddyy)) mmddyy = header%mmddyy IF(PRESENT(lon)) lon = header%lon IF(PRESENT(lat)) lat = header%lat IF(PRESENT(hhmmss)) hhmmss(1:nlev) = hms(1:nlev) IF(PRESENT(alt)) alt(1:nlev) = xdata(1:nlev,2) IF(PRESENT(dptemp)) dptemp(1:nlev) = xdata(1:nlev,3) IF(PRESENT(rh)) rh(1:nlev) = xdata(1:nlev,4) IF(PRESENT(wspeed)) wspeed(1:nlev) = xdata(1:nlev,7) IF(PRESENT(wdir)) wdir(1:nlev) = xdata(1:nlev,8) IF(PRESENT(o3)) o3(1:nlev) = xdata(1:nlev,9) IF(PRESENT(mol1_5)) mol1_5(1:nlev,:) = xdata(1:nlev,10:14) !------------------------------- ! Deallocate data array !------------------------------- DEALLOCATE( xdata, & hms, & STAT = allocate_status) IF(allocate_status /= 0) THEN WRITE(*,*) 'Error deallocating data arrays xdata,hms' ENDIF END SUBROUTINE read_etl_sounding !-------------------------------------------------------------------------------- ! ! NAME: nlevels_etl_sounding ! ! PURPOSE: Function retrieves number of levels in ETL sounding file ! ! LANGUAGE: Fortran 90 ! ! CALLING SEQUENCE: nlev = nlevels_etl_sounding(ifile) ! ! INPUTS: ! variable | description | type | dimens. | units ! ----------------------------------------------------------- ! ifile | input file name | string | scalar | N/A ! ! OUTPUTS: ! nlev | # of profile levels| long | scalar | N/A ! ! SIDE EFFECTS: nlev = -1 for open error ! nlev = -2 for read error ! ! CREATION HISTORY: Darren Jackson CIRES/ETL Feb 2002 ! !--------------------------------------------------------------------- ! FUNCTION nlevels_etl_sounding(ifile) !------------------------------- ! Declare assumed-shape arrays !------------------------------- CHARACTER( * ), INTENT(IN) :: ifile INTEGER :: nlevels_etl_sounding INTEGER :: ios,nlev !----------------------------------- ! Open the atmospheric profile data !----------------------------------- write(*,*) 'ifile = ',ifile OPEN(10,FILE=ifile,STATUS='OLD',ACCESS='DIRECT',RECL=4,IOSTAT=ios) !---------------------------- ! Check for Open error !--------------------------- IF(ios /= 0) THEN nlevels_etl_sounding = -1 RETURN ENDIF !---------------------------- ! Read header information !---------------------------- READ(10,REC=1,ERR=99) nlev nlevels_etl_sounding = nlev CLOSE(10) RETURN !----------------- ! Read error !----------------- 99 nlevels_etl_sounding = -2 CLOSE(10) RETURN END FUNCTION nlevels_etl_sounding END MODULE etl_sounding