PartMC 2.1.4
extract_env.F90
Go to the documentation of this file.
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