PartMC 2.1.3
|
00001 ! Copyright (C) 2009-2010 Matthew West 00002 ! Licensed under the GNU General Public License version 2 or (at your 00003 ! option) any later version. See the file COPYING for details. 00004 00005 !> \file 00006 !> The extract_env program. 00007 00008 !> Read NetCDF output files and write out the environment variables in 00009 !> text format. 00010 program extract_env 00011 00012 use netcdf 00013 00014 integer, parameter :: dp = kind(0.d0) 00015 integer, parameter :: out_unit = 64 00016 00017 character(len=1000) :: in_prefix, in_filename, out_filename 00018 integer :: ncid 00019 integer :: varid_time, varid_temp, varid_rh 00020 integer :: varid_pres, varid_height 00021 real(kind=dp) :: time, temp, rh, pres, height 00022 integer :: ios, i_time, status, n_time 00023 character(len=36) :: uuid, run_uuid 00024 00025 ! process commandline arguments 00026 if (command_argument_count() .ne. 2) then 00027 write(6,*) 'Usage: extract_env <netcdf_state_prefix> <output_filename>' 00028 stop 2 00029 endif 00030 call get_command_argument(1, in_prefix) 00031 call get_command_argument(2, out_filename) 00032 00033 ! open output file 00034 open(unit=out_unit, file=out_filename, status='replace', iostat=ios) 00035 if (ios /= 0) then 00036 write(0,'(a,a,a,i4)') 'ERROR: unable to open file ', & 00037 trim(out_filename), ' for writing: ', ios 00038 stop 1 00039 end if 00040 00041 ! write information 00042 write(*,'(a,a)') "Output file: ", trim(out_filename) 00043 write(*,'(a)') " Each row of output is one time." 00044 write(*,'(a)') " The columns of output are:" 00045 write(*,'(a)') " column 1: time (s)" 00046 write(*,'(a)') " column 2: temperature (K)" 00047 write(*,'(a)') " column 3: relative_humidity (1)" 00048 write(*,'(a)') " column 4: pressure (Pa)" 00049 write(*,'(a)') " column 5: mixing height (m)" 00050 00051 ! read NetCDF files 00052 i_time = 0 00053 n_time = 0 00054 do while (.true.) 00055 i_time = i_time + 1 00056 write(in_filename,'(a,i8.8,a)') trim(in_prefix), i_time, ".nc" 00057 status = nf90_open(in_filename, NF90_NOWRITE, ncid) 00058 if (status /= NF90_NOERR) then 00059 exit 00060 end if 00061 n_time = i_time 00062 00063 ! read and check uuid 00064 call nc_check_msg(nf90_get_att(ncid, NF90_GLOBAL, "UUID", uuid), & 00065 "getting global attribute 'UUID'") 00066 if (i_time == 1) then 00067 run_uuid = uuid 00068 else 00069 if (run_uuid /= uuid) then 00070 write(0,*) 'ERROR: UUID mismatch at: ' // trim(in_filename) 00071 stop 1 00072 end if 00073 end if 00074 00075 call nc_check_msg(nf90_inq_varid(ncid, "time", varid_time), & 00076 "getting variable ID for 'time'") 00077 call nc_check_msg(nf90_get_var(ncid, varid_time, time), & 00078 "getting variable 'time'") 00079 00080 call nc_check_msg(nf90_inq_varid(ncid, "temperature", varid_temp), & 00081 "getting variable ID for 'temperature'") 00082 call nc_check_msg(nf90_get_var(ncid, varid_temp, temp), & 00083 "getting variable 'temperature'") 00084 00085 call nc_check_msg(nf90_inq_varid(ncid, "relative_humidity", & 00086 varid_rh), "getting variable ID for 'relative_humidity'") 00087 call nc_check_msg(nf90_get_var(ncid, varid_rh, rh), & 00088 "getting variable 'relative_humidity'") 00089 00090 call nc_check_msg(nf90_inq_varid(ncid, "pressure", varid_pres), & 00091 "getting variable ID for 'pressure'") 00092 call nc_check_msg(nf90_get_var(ncid, varid_pres, pres), & 00093 "getting variable 'pressure'") 00094 00095 call nc_check_msg(nf90_inq_varid(ncid, "height", varid_height), & 00096 "getting variable ID for 'height'") 00097 call nc_check_msg(nf90_get_var(ncid, varid_height, height), & 00098 "getting variable 'height'") 00099 00100 call nc_check_msg(nf90_close(ncid), & 00101 "closing file " // trim(in_filename)) 00102 00103 ! output data 00104 write(out_unit, '(5e30.15e3)') time, temp, rh, pres, height 00105 end do 00106 00107 if (n_time == 0) then 00108 write(*,'(a,a)') 'ERROR: no input file found matching: ', & 00109 trim(in_filename) 00110 stop 1 00111 end if 00112 00113 close(out_unit) 00114 00115 contains 00116 00117 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00118 00119 !> Check return status of NetCDF function calls. 00120 subroutine nc_check_msg(status, error_msg) 00121 00122 !> Status return value. 00123 integer, intent(in) :: status 00124 !> Error message in case of failure. 00125 character(len=*), intent(in) :: error_msg 00126 00127 if (status /= NF90_NOERR) then 00128 write(0,*) trim(error_msg) // " : " // trim(nf90_strerror(status)) 00129 stop 1 00130 end if 00131 00132 end subroutine nc_check_msg 00133 00134 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00135 00136 #ifdef DEFINE_LOCAL_COMMAND_ARGUMENT 00137 integer function command_argument_count() 00138 command_argument_count = iargc() 00139 end function command_argument_count 00140 subroutine get_command_argument(i, arg) 00141 integer, intent(in) :: i 00142 character(len=*), intent(out) :: arg 00143 call getarg(i, arg) 00144 end subroutine get_command_argument 00145 #endif 00146 00147 end program extract_env