! $Id: eum2ropp.f90 4169 2014-05-09 13:27:45Z idculv $$ PROGRAM eum2ropp !****x* Programs/eum2ropp * ! ! NAME ! eum2ropp ! ! SYNOPSIS ! Converts a EUMETSAT netCDF4 level 1b file into an ! ROPP netCDF file with optional thinning ! ! > eum2ropp ip_file [ip_file...] [-o op_file] ! [-p thin_file|maxsamp] ! [-r resolution_group] ! [-l lev1a_combi] ! [-m] [-a] [-u] [-h] [-i] [-d] [-v] [-e] [-c] [-x] ! ! ARGUMENTS ! ip_file - one or more EUM netCDF level 1B files ! There is no default for this argument. ! ! OPTIONS ! -o specifies an output file name - mandatory argument if used ! (default: name generated from the file header) ! -p specifies a sampling levels control file for profile thinning ! or a positive integer representing the maximum no. of levels ! for implied SAMPLE mode (default: no thinning) ! -r resolution_group name of level 1B file, default thinned ! -l lev1a_combi takes (cl, cl+rs, cl+ol, or none) level1a data ! and puts it into the ROPP netCDF file; default is none ! -m causes the output into a multifile (i.e., a single ROPP netCDF ! file holding multiple profiles) ! -a appends to an already existing file (default is to ! overwrite an already existing file) (-a implies -m) ! -u leaves profiles untouched (do not sort or thin input data) ! -p option is ignored if -u present. (Default: sort profiles ! into ascending order, thin according to -p option) ! -h (or ?) causes only summary help to be output ! -i thins on impact altitudes (IP - RoC - undulation) ! -d writes additional diagnostic information to stdout ! -v outputs program version ID ! -e get L2 bending angle based on L1-L2 extrapolation ! -c get EUMETSAT's ol/rs navbit-corrected excess phase directly instead of ! reconstructing it from navbit-uncorrected I and Q values ! -x exclude level 1b bending angles (-r and -e will have no effect) ! ! CALLS ! ropp_io_nrec ! ropp_io_read ! ropp_io_write ! ropp_io_occid ! ropp_io_ascend ! ropp_io_thin ! ropp_io_rangecheck ! ropp_io_version ! FileDelete ! message ! message_set_routine ! ! ERRORS ! Program (shell) return codes: ! 0 = OK ! 1 = At least one Warning occurred ! 2 = At least one Error occurred ! 3 = A Fatal error occurred ! ! DESCRIPTION ! Converts a EUMETSAT netCDF 4 level 1B file into an ! ROPP netCDF file with optional thinning ! Only single input profiles can be processed currently but multifiles ! can be written. Also allows thinning of data. Descending profiles ! are made ascending by default. ! ! SEE ALSO ! eum2ropp(1) ! ! NOTES ! This is a trivial sample program showing a simple ROPP file I/O ! interface for illustrative purposes only; it is not intended to be ! a comprehensive or robust tool. ! ! REFERENCES ! 1. ROPP User Guide - Part I ! SAF/ROM/METO/UG/ROPP/002 ! 2. ROPP Thinner Algorithm. ! SAF/GRAS/METO/REP/GSR/008 ! ! AUTHOR ! Met Office, Exeter, UK. ! Please email any comments on this software to: romsaf@metoffice.gov.uk ! ! COPYRIGHT ! (c) EUMETSAT. All rights reserved. ! For further details please refer to the file COPYRIGHT ! which you should have received as part of this distribution. ! !**** ! Modules USE messages USE ropp_io_types, ONLY: ROprof USE ropp_io, ONLY: ropp_io_nrec, & ropp_io_read, & ropp_io_write, & ropp_io_occid, & ropp_io_ascend, & ropp_io_thin, & ropp_io_version USE ropp_utils, ONLY: File_Delete IMPLICIT NONE ! Local variables TYPE(ROprof) :: ROdata CHARACTER (LEN=256), ALLOCATABLE :: ipfile(:) CHARACTER (LEN=256) :: opfile, thfile, arg CHARACTER (LEN=20) :: ocentre = "EUM" CHARACTER (LEN=80) :: outstr ! Formatted output string CHARACTER (LEN=10) :: number ! Number as string LOGICAL :: getlevel1b = .TRUE. ! Get level 1b data as the default LOGICAL :: getextrap = .FALSE. ! Get L2 bending angle based on L1-L2 extrapolation CHARACTER (LEN=256) :: resolution = "thinned" ! Resolution of EUM L1b file to use, default thinned CHARACTER (LEN=256) :: getlevel1a = "none" ! Get also level 1a in ROPP netCDF file (default none) LOGICAL :: getdirect = .FALSE. ! Get EUMETSAT's raw sampling/open loop excess phase directly INTEGER :: i, ierr, narg, iarg, k, istatus INTEGER :: nipf=0, nprf=0, nptot=0 LOGICAL :: multi = .false. LOGICAL :: newfile = .true. LOGICAL :: first = .true. LOGICAL :: exists = .false. LOGICAL :: untouched = .false. LOGICAL :: impactalt = .FALSE. LOGICAL :: ranchk = .TRUE. ! Some compilers may need the following declaration to be commented out INTEGER :: IARGC !------------------------------------------------------------- ! 1. Initialise !------------------------------------------------------------- CALL message_set_routine ( "eum2ropp" ) CALL message(msg_noin, '') CALL message(msg_noin, & '---------------------------------------------------------------------') CALL message(msg_noin, & ' EUMETSAT to ROPP netCDF Converter' ) CALL message(msg_noin, & '---------------------------------------------------------------------') CALL message(msg_noin, '') !------------------------------------------------------------- ! 2. Parse command line options !------------------------------------------------------------- narg = IARGC() ALLOCATE ( ipfile(narg), STAT=istatus ) IF ( istatus /= 0 ) THEN CALL message ( msg_fatal, "Failed to allocate memory for ipfile array" ) END IF nipf = 0 ipfile = " " opfile = " " thfile = "0" iarg = 1 DO WHILE ( iarg <= narg ) CALL GETARG ( iarg, arg ) SELECT CASE (arg) CASE ("-a","-A") newfile = .false. multi = .true. CASE ("-d","-D") msg_MODE = VerboseMode CASE ("-h","-H","--help","?") narg = -1 CASE ("-i") impactalt = .TRUE. CASE ("-m","-M") multi = .true. CASE ("-u","-U") untouched = .true. CASE ("-o","-O") CALL GETARG ( iarg+1, arg ) opfile = arg iarg = iarg + 1 CASE ("-p","-P") CALL GETARG ( iarg+1, arg ) thfile = arg iarg = iarg + 1 CASE ("-v","-V","--version") CALL version_info() CALL EXIT(msg_exit_ok) CASE ("-x","-X") getlevel1b = .FALSE. CASE ("-e","-E") getextrap = .TRUE. CASE ("-r","-R") CALL GETARG ( iarg+1, arg ) resolution = arg iarg = iarg + 1 CASE ("-l","-L") CALL GETARG ( iarg+1, arg ) getlevel1a = arg iarg = iarg + 1 CASE ("-c","-C") getdirect = .TRUE. CASE ("--no-ranchk") ! skip range checking; for expert users only CALL message ( msg_warn, "Range checking is disabled" ) ranchk = .FALSE. ! do not document as a user option. CASE DEFAULT IF ( arg(1:1) /= "-" ) THEN nipf = nipf + 1 ipfile(nipf) = arg END IF END SELECT iarg = iarg + 1 END DO IF ( nipf == 0 .AND. narg /= -1 ) THEN CALL message ( msg_error, "No input file(s) specified" ) narg = 0 END IF IF ( (resolution /= 'thinned') .AND. (resolution /= 'high_resolution') ) THEN CALL message ( msg_warn, 'Invalid resolution ' // TRIM(resolution) // & ' ... defaulting to "thinned".' ) resolution = 'thinned' END IF IF ( narg <= 0 ) THEN CALL Usage CALL EXIT(msg_exit_status) END IF !----------------------------------------------------------- ! 3. Loop over all input files !------------------------------------------------------------- DO k = 1, nipf INQUIRE ( FILE=ipfile(k), EXIST=exists ) IF ( .NOT. exists ) THEN CALL message ( msg_error, "EUMETSAT input file "//TRIM(ipfile(k))// & " not found" ) CYCLE ENDIF ! 3.1 EUMETSAT files should only have one record! ! ------------------------------------------------ CALL message ( msg_info, "Reading file "//TRIM(ipfile(k)) ) ! 3.2 Read singlefiles (Loop over all profiles) ! --------------------------------------------- CALL ropp_io_read ( ROdata, & file=ipfile(k), & rec=i, & centre=ocentre, & ierr=ierr, & getlevel1b=getlevel1b, & getextrap=getextrap, & resolution=resolution, & getlevel1a=getlevel1a, & getdirect=getdirect, & ranchk=ranchk) IF ( ierr /= 0 ) THEN WRITE ( number, FMT="(I6)" ) ierr CALL message ( msg_fatal, "Error - code "//ADJUSTL(number) ) END IF ! 3.2.1 Ensure profile is in ascending order and thin (optional) ! --------------------------------------------------------------- IF ( .NOT. untouched ) THEN CALL message ( msg_diag, "Ensuring all profiles are in "// & "ascending height order." ) CALL ropp_io_ascend ( ROdata ) CALL ropp_io_thin ( ROdata, thfile, impactalt, ranchk=ranchk ) END IF ! 3.2.2 Check/create output file name; explcitly delete any ! existing potential multifile file unless appending ! ------------------------------------------------------------- CALL ropp_io_occid ( ROdata ) IF ( opfile == " " ) THEN opfile = TRIM(ROdata%occ_id) // '.nc' CALL To_Lower(opfile) first = .TRUE. END IF IF ( first ) THEN INQUIRE ( FILE=opfile, EXIST=exists ) IF ( exists ) THEN IF ( newfile .AND. multi ) THEN CALL file_delete ( opfile, ierr ) END IF ELSE newfile = .TRUE. END IF first = .FALSE. END IF ! 3.2.3 Write output file ! ------------------------ WRITE ( outstr, FMT="(A,I5,A)" ) "Profile", k, " : "//ROdata%occ_id CALL message ( msg_info, TRIM(outstr) ) WRITE ( outstr, FMT="(F6.2,',',F7.2)" ) ROdata%GeoRef%Lat, ROdata%GeoRef%Lon CALL message ( msg_diag, " Latitude/Longitude : "//TRIM(outstr) ) WRITE ( number, FMT="(I6)" ) ROdata%Lev1a%Npoints CALL message ( msg_diag, " No. of phase/SNR samples : "//TRIM(number) ) WRITE ( number, FMT="(I6)" ) ROdata%Lev1b%Npoints CALL message ( msg_diag, " No. of bending angle samples : "//TRIM(number) ) WRITE ( number, FMT="(I6)" ) ROdata%Lev2a%Npoints CALL message ( msg_diag, " No. of refractivity samples : "//TRIM(number) ) WRITE ( number, FMT="(I6)" ) ROdata%Lev2b%Npoints CALL message ( msg_diag, " No. of geophysical samples : "//TRIM(number) ) WRITE ( number, FMT="(I6)" ) ROdata%Lev2c%Npoints CALL message ( msg_diag, " No. of surface geo. samples : "//TRIM(number) ) WRITE ( number, FMT="(I6)" ) ROdata%Lev2d%Npoints CALL message ( msg_diag, " No. of model coeff. levels : "//TRIM(number) ) CALL message ( msg_info, "Writing "//TRIM(opfile) ) write(*, *) 'data%Lev1a%Npoints', ROdata%Lev1a%Npoints CALL ropp_io_write ( ROdata, file=opfile, append=multi, ranchk=ranchk ) nptot = nptot + 1 IF ( .NOT. multi ) opfile = " " END DO ! end file loop !-------------------------------------------------------------- ! 4. Show summary of outcome !-------------------------------------------------------------- IF ( nptot > 1 ) THEN WRITE ( number, FMT="(I5)" ) nptot CALL message ( msg_info, number//" profiles processed" ) IF ( .NOT. newfile ) THEN nprf = ropp_io_nrec ( opfile ) WRITE ( number, FMT="(I5)" ) nprf CALL message ( msg_info, number//" profiles now in "//TRIM(opfile) ) END IF END IF !-------------------------------------------------------------- ! 5. Tidy up !-------------------------------------------------------------- IF ( ALLOCATED(ipfile) ) DEALLOCATE ( ipfile ) CALL message ( msg_noin, " " ) CALL EXIT(msg_exit_status) CONTAINS !------------------------------------------------------------------------------- ! 6. Usage (help) information !------------------------------------------------------------------------------- SUBROUTINE Usage() PRINT *, 'Purpose:' PRINT *, ' Convert/thin a EUMETSAT netCDF file to a ROPP netCDF file' PRINT *, 'Usage:' PRINT *, ' > eum2ropp ip_file [ip_file...] [-o op_file]' PRINT *, ' [-p thin_file|maxsamp]' PRINT *, ' [-r resolution_group]' PRINT *, ' [-l lev1a_combi]' PRINT *, ' [-m] [-a] [-u] [-h] [-i] [-d] [-v] [-e] [-c] [-x]' PRINT *, ' where ip_file(s) is/are a/some EUMETSAT netCDF file(s)' PRINT *, 'Options:' PRINT *, ' -o specifies an output file name' PRINT *, ' -p specifies a thinning control file name or max. no. samples' PRINT *, ' -r resolution_group name of level 1b file, default thinned' PRINT *, ' -l lev1a_combi takes (cl, cl+rs, cl+ol, or none) level1a data and' PRINT *, ' puts it into the ROPP netCDF file; default is none' PRINT *, ' -m forces the output into a netCDF multifile' PRINT *, ' (i.e. a single data file holding multiple profiles).' PRINT *, ' -a appends to an already existing file. -a implies -m' PRINT *, ' -u leave profiles untouched (do not sort or thin input data)' PRINT *, ' -h this help' PRINT *, ' -i thins on impact altitudes (IP - RoC - undulation)' PRINT *, ' -d prints out some additional diagnostics to stdout' PRINT *, ' -v version information' PRINT *, ' -e get L2 bending angle based on L1-L2 extrapolation' PRINT *, ' -c get EUMETSATs ol/rs navbit-corrected excess phase directly instead of' PRINT *, ' reconstructing it from navbit-uncorrected I and Q values' PRINT *, ' -x exclude level 1b bending angles (-r and -e will have no effect)' PRINT *, 'Defaults:' PRINT *, ' Input file name : required' PRINT *, ' Output file name : from (first) occultation ID' PRINT *, ' Output mode : one output file per input file' PRINT *, ' Append mode : exising file is overwritten' PRINT *, ' Sorting : descending profiles made ascending' PRINT *, ' Thinning : none' PRINT *, ' Thining on alts : off' PRINT *, ' Level 1a data? : no' PRINT *, ' Level 1b data? : yes' PRINT *, ' BUFR data? : no' PRINT *, ' L2 extrapolated? : no' PRINT *, 'See eum2ropp(1) for details.' PRINT *, '' END SUBROUTINE Usage !------------------------------------------------------------------------------- ! 7. Version information !------------------------------------------------------------------------------- SUBROUTINE version_info() CHARACTER (LEN=40) :: version version = ropp_io_version() PRINT *, 'eum2ropp - convert EUMETSAT netCDF files to ROPP netCDF' PRINT *, '' PRINT *, 'This program is part of ROPP (IO) Release ' // TRIM(version) PRINT *, '' END SUBROUTINE version_info END PROGRAM eum2ropp