[Dart-dev] [5713] DART/branches/development/observations: Preliminary program to create three flux observations from the AmeriFlux
nancy at ucar.edu
nancy at ucar.edu
Tue May 8 14:27:20 MDT 2012
Revision: 5713
Author: thoar
Date: 2012-05-08 14:27:20 -0600 (Tue, 08 May 2012)
Log Message:
-----------
Preliminary program to create three flux observations from the AmeriFlux
Level 4 data. The three observation types are:
LE_f (Latent Heat Flux) TOWER_LATENT_HEAT_FLUX
H_f (Sensible Heat Flux) TOWER_SENSIBLE_HEAT_FLUX
NEE_or_fMDS (Net Ecosystem Production) TOWER_NETC_ECO_EXCHANGE
It is possible, perhaps even desirable, to rewrite these to include
more metadata. There are tower-site-specific attributes like
land cover, land use, plant functional type available from the
FLUXNET sites ... e.g. http://fluxnet.ornl.gov/site/886
This could then be used to inform the observation operator to
only query the appropriate PFTs from a grid cell ...
Added Paths:
-----------
DART/branches/development/observations/Ameriflux/
DART/branches/development/observations/Ameriflux/level4_to_obs.f90
DART/branches/development/observations/Ameriflux/level4_to_obs.html
DART/branches/development/observations/Ameriflux/level4_to_obs.nml
DART/branches/development/observations/Ameriflux/shell_scripts/
DART/branches/development/observations/Ameriflux/work/
DART/branches/development/observations/Ameriflux/work/input.nml
DART/branches/development/observations/Ameriflux/work/mkmf_level4_to_obs
DART/branches/development/observations/Ameriflux/work/mkmf_obs_sequence_tool
DART/branches/development/observations/Ameriflux/work/mkmf_preprocess
DART/branches/development/observations/Ameriflux/work/path_names_level4_to_obs
DART/branches/development/observations/Ameriflux/work/path_names_obs_sequence_tool
DART/branches/development/observations/Ameriflux/work/path_names_preprocess
DART/branches/development/observations/Ameriflux/work/quickbuild.csh
-------------- next part --------------
Added: DART/branches/development/observations/Ameriflux/level4_to_obs.f90
===================================================================
--- DART/branches/development/observations/Ameriflux/level4_to_obs.f90 (rev 0)
+++ DART/branches/development/observations/Ameriflux/level4_to_obs.f90 2012-05-08 20:27:20 UTC (rev 5713)
@@ -0,0 +1,602 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+program level4_to_obs
+
+! <next few lines under version control, do not edit>
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! level4_to_obs - a program that only needs minor customization to read
+! in a text-based dataset - either white-space separated values or
+! fixed-width column data.
+!
+! created 3 May 2012 Tim Hoar NCAR/IMAGe
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+use types_mod, only : r8, MISSING_R8
+
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
+ register_module, error_handler, E_MSG, E_ERR, &
+ open_file, close_file, do_nml_file, do_nml_term, &
+ check_namelist_read, find_namelist_in_file
+
+use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
+ set_date, set_time, get_time, print_time, &
+ print_date, operator(-), operator(+)
+
+use location_mod, only : VERTISHEIGHT
+
+use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
+ static_init_obs_sequence, init_obs, write_obs_seq, &
+ init_obs_sequence, get_num_obs, &
+ set_copy_meta_data, set_qc_meta_data
+
+use obs_kind_mod, only : TOWER_SENSIBLE_HEAT_FLUX, &
+ TOWER_NETC_ECO_EXCHANGE, &
+ TOWER_LATENT_HEAT_FLUX
+
+implicit none
+
+!-----------------------------------------------------------------------
+! version controlled file description for error handling, do not edit
+!-----------------------------------------------------------------------
+
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+!-----------------------------------------------------------------------
+! Namelist with default values
+!-----------------------------------------------------------------------
+
+character(len=128) :: text_input_file = 'textdata.input'
+character(len=128) :: obs_out_file = 'obs_seq.out'
+integer :: year
+real(r8) :: timezoneoffset
+real(r8) :: latitude
+real(r8) :: longitude
+real(r8) :: elevation
+real(r8) :: flux_height
+real(r8) :: maxgoodqc = 3
+logical :: verbose = .false.
+
+namelist /level4_to_obs_nml/ text_input_file, obs_out_file, year, &
+ timezoneoffset, latitude, longitude, elevation, &
+ flux_height, maxgoodqc, verbose
+
+!-----------------------------------------------------------------------
+! globally-scoped variables
+!-----------------------------------------------------------------------
+
+character(len=256) :: input_line, string1, string2, string3
+integer :: nmlfileunit, iline, nlines
+logical :: file_exist, first_obs
+integer :: n, i, oday, osec, rcio, iunit
+integer :: num_copies, num_qc, max_obs
+real(r8) :: oerr, qc
+type(obs_sequence_type) :: obs_seq
+type(obs_type) :: obs, prev_obs
+type(time_type) :: time_obs, prev_time, offset
+
+type towerdata
+ type(time_type) :: time_obs
+ character(len=20) :: monthstring = 'month'
+ character(len=20) :: daystring = 'day'
+ character(len=20) :: hourstring = 'hour'
+ character(len=20) :: doystring = 'doy'
+ character(len=20) :: neestring = 'nee_or_fmds'
+ character(len=20) :: neeQCstring = 'nee_or_fmdsqc'
+ character(len=20) :: lestring = 'le_f'
+ character(len=20) :: leQCstring = 'le_fqc'
+ character(len=20) :: hstring = 'h_f'
+ character(len=20) :: hQCstring = 'h_fqc'
+ integer :: monthindex
+ integer :: dayindex
+ integer :: hourindex
+ integer :: doyindex
+ integer :: neeindex
+ integer :: neeQCindex
+ integer :: leindex
+ integer :: leQCindex
+ integer :: hindex
+ integer :: hQCindex
+ integer :: month
+ integer :: day
+ real(r8) :: hour
+ real(r8) :: doy
+ real(r8) :: nee
+ integer :: neeQC
+ real(r8) :: le
+ integer :: leQC
+ real(r8) :: h
+ integer :: hQC
+end type towerdata
+
+type(towerdata) :: tower
+
+!-----------------------------------------------------------------------
+! start of executable code
+!-----------------------------------------------------------------------
+
+call initialize_utilities('level4_to_obs')
+
+! Print module information to log file and stdout.
+call register_module(source, revision, revdate)
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "level4_to_obs_nml", iunit)
+read(iunit, nml = level4_to_obs_nml, iostat = rcio)
+call check_namelist_read(iunit, rcio, "level4_to_obs_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=level4_to_obs_nml)
+if (do_nml_term()) write( * , nml=level4_to_obs_nml)
+
+! time setup
+call set_calendar_type(GREGORIAN)
+offset = set_time(nint(abs(timezoneoffset)*3600.0_r8),0)
+
+if (verbose) print *, 'tower located at lat, lon, elev =', latitude, longitude, elevation
+if (verbose) print *, 'flux observations taken at =', flux_height,'m'
+
+! check the lat/lon values to see if they are ok
+if (longitude < 0.0_r8) longitude = longitude + 360.0_r8
+
+if (( latitude > 90.0_r8 .or. latitude < -90.0_r8 ) .or. &
+ (longitude < 0.0_r8 .or. longitude > 360.0_r8 )) then
+
+ write (string2,*)'latitude should be [-90, 90] but is ',latitude
+ write (string3,*)'longitude should be [ 0,360] but is ',longitude
+
+ string1 ='tower location error in input.nml&level4_to_obs_nml'
+ call error_handler(E_ERR,'level4_to_obs', string1, source, revision, &
+ revdate, text2=string2,text3=string3)
+
+endif
+
+! We need to know the maximum number of observations in the input file.
+! Each line has info for the 3 observations we want.
+! The max possible number of obs needs to be specified but it
+! will only write out the actual number created.
+! Each observation in this series will have a single
+! observation value and a quality control flag.
+! Initialize two empty observations - one to track location
+! in observation sequence - the other is for the new observation.
+
+iunit = open_file(text_input_file, 'formatted', 'read')
+if (verbose) print *, 'opened input file ' // trim(text_input_file)
+
+nlines = count_file_lines(iunit)
+max_obs = 3*nlines
+num_copies = 1
+num_qc = 1
+first_obs = .true.
+
+call static_init_obs_sequence()
+call init_obs(obs, num_copies, num_qc)
+call init_obs(prev_obs, num_copies, num_qc)
+call init_obs_sequence(obs_seq, num_copies, num_qc, max_obs)
+
+! the first one needs to contain the string 'observation' and the
+! second needs the string 'QC'.
+call set_copy_meta_data(obs_seq, 1, 'observation')
+call set_qc_meta_data( obs_seq, 1, 'Ameriflux QC')
+
+! The first line describes all the fields ... column headers, if you will
+
+rewind(iunit)
+call decode_header(iunit)
+
+obsloop: do iline = 2,nlines
+
+ ! read in entire text line into a buffer
+ read(iunit,'(A)',iostat=rcio) input_line
+ if (rcio < 0) exit obsloop
+ if (rcio > 0) then
+ write (string1,'(''Cannot read (error '',i3,'') line '',i8,'' in '',A)') &
+ rcio, iline, trim(text_input_file)
+ call error_handler(E_ERR,'count_file_lines', string1, source, revision, revdate)
+ endif
+
+ ! parse the line into the tower structure (including the observation time)
+ call stringparse(input_line,iline)
+
+ if (iline <= 2) then
+ write(*,*)''
+ write(*,*)'Check of the first observation: (column,string,value)'
+ write(*,*)tower%monthindex, tower%monthstring , tower%month
+ write(*,*)tower%dayindex , tower%daystring , tower%day
+ write(*,*)tower%hourindex , tower%hourstring , tower%hour
+ write(*,*)tower%doyindex , tower%doystring , tower%doy
+ write(*,*)tower%hindex , tower%hstring , tower%h
+ write(*,*)tower%hQCindex , tower%hQCstring , tower%hQC
+ write(*,*)tower%leindex , tower%lestring , tower%le
+ write(*,*)tower%leQCindex , tower%leQCstring , tower%leQC
+ write(*,*)tower%neeindex , tower%neestring , tower%nee
+ write(*,*)tower%neeQCindex, tower%neeQCstring , tower%neeQC
+ call print_date(tower%time_obs, 'observation date is')
+ call print_time(tower%time_obs, 'observation time is')
+ end if
+
+ if (verbose) call print_date(tower%time_obs, 'obs time is')
+
+ call get_time(tower%time_obs, osec, oday)
+
+ ! make an obs derived type, and then add it to the sequence
+ ! If the QC value is good, use the observation.
+ ! Increasingly larger QC values are more questionable quality data.
+
+ if (tower%hQC <= maxgoodqc) then
+ oerr = tower%h * 0.1_r8 ! total guess
+ qc = real(tower%hQC,r8)
+ call create_3d_obs(latitude, longitude, flux_height, VERTISHEIGHT, tower%h, &
+ TOWER_LATENT_HEAT_FLUX, oerr, oday, osec, qc, obs)
+ call add_obs_to_seq(obs_seq, obs, tower%time_obs, prev_obs, prev_time, first_obs)
+ endif
+
+ if (tower%leQC <= maxgoodqc) then
+ oerr = tower%le * 0.1_r8 ! total guess
+ qc = real(tower%leQC,r8)
+ call create_3d_obs(latitude, longitude, flux_height, VERTISHEIGHT, tower%le, &
+ TOWER_SENSIBLE_HEAT_FLUX, oerr, oday, osec, qc, obs)
+ call add_obs_to_seq(obs_seq, obs, tower%time_obs, prev_obs, prev_time, first_obs)
+ endif
+
+ if (tower%neeQC <= maxgoodqc) then
+ oerr = tower%NEE * 0.1_r8 ! total guess
+ qc = real(tower%neeQC,r8)
+ call create_3d_obs(latitude, longitude, flux_height, VERTISHEIGHT, tower%Nee, &
+ TOWER_NETC_ECO_EXCHANGE, oerr, oday, osec, qc, obs)
+ call add_obs_to_seq(obs_seq, obs, tower%time_obs, prev_obs, prev_time, first_obs)
+ endif
+
+end do obsloop
+
+! if we added any obs to the sequence, write it out to a file now.
+if ( get_num_obs(obs_seq) > 0 ) then
+ if (verbose) print *, 'writing obs_seq, obs_count = ', get_num_obs(obs_seq)
+ call write_obs_seq(obs_seq, obs_out_file)
+endif
+
+! end of main program
+call finalize_utilities()
+
+contains
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! create_3d_obs - subroutine that is used to create an observation
+! type from observation data.
+!
+! NOTE: assumes the code is using the threed_sphere locations module,
+! that the observation has a single data value and a single
+! qc value, and that this obs type has no additional required
+! data (e.g. gps and radar obs need additional data per obs)
+!
+! lat - latitude of observation
+! lon - longitude of observation
+! vval - vertical coordinate
+! vkind - kind of vertical coordinate (pressure, level, etc)
+! obsv - observation value
+! okind - observation kind
+! oerr - observation error
+! day - gregorian day
+! sec - gregorian second
+! qc - quality control value
+! obs - observation type
+!
+! created Oct. 2007 Ryan Torn, NCAR/MMM
+! adapted for more generic use 11 Mar 2010, nancy collins, ncar/image
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine create_3d_obs(lat, lon, vval, vkind, obsv, okind, oerr, day, sec, qc, obs)
+use obs_def_mod, only : obs_def_type, set_obs_def_time, set_obs_def_kind, &
+ set_obs_def_error_variance, set_obs_def_location
+use obs_sequence_mod, only : obs_type, set_obs_values, set_qc, set_obs_def
+use time_manager_mod, only : time_type, set_time
+use location_mod, only : set_location
+
+ integer, intent(in) :: okind, vkind, day, sec
+ real(r8), intent(in) :: lat, lon, vval, obsv, oerr, qc
+ type(obs_type), intent(inout) :: obs
+
+real(r8) :: obs_val(1), qc_val(1)
+type(obs_def_type) :: obs_def
+
+call set_obs_def_location(obs_def, set_location(lon, lat, vval, vkind))
+call set_obs_def_kind(obs_def, okind)
+call set_obs_def_time(obs_def, set_time(sec, day))
+call set_obs_def_error_variance(obs_def, oerr * oerr)
+call set_obs_def(obs, obs_def)
+
+obs_val(1) = obsv
+call set_obs_values(obs, obs_val)
+qc_val(1) = qc
+call set_qc(obs, qc_val)
+
+end subroutine create_3d_obs
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! add_obs_to_seq -- adds an observation to a sequence. inserts if first
+! obs, inserts with a prev obs to save searching if that's possible.
+!
+! seq - observation sequence to add obs to
+! obs - observation, already filled in, ready to add
+! obs_time - time of this observation, in dart time_type format
+! prev_obs - the previous observation that was added to this sequence
+! (will be updated by this routine)
+! prev_time - the time of the previously added observation (will also
+! be updated by this routine)
+! first_obs - should be initialized to be .true., and then will be
+! updated by this routine to be .false. after the first obs
+! has been added to this sequence.
+!
+! created Mar 8, 2010 nancy collins, ncar/image
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine add_obs_to_seq(seq, obs, obs_time, prev_obs, prev_time, first_obs)
+
+use obs_sequence_mod, only : obs_sequence_type, obs_type, insert_obs_in_seq
+use time_manager_mod, only : time_type, operator(>=)
+
+type(obs_sequence_type), intent(inout) :: seq
+type(obs_type), intent(inout) :: obs, prev_obs
+type(time_type), intent(in) :: obs_time
+type(time_type), intent(inout) :: prev_time
+logical, intent(inout) :: first_obs
+
+! insert(seq,obs) always works (i.e. it inserts the obs in
+! proper time format) but it can be slow with a long file.
+! supplying a previous observation that is older (or the same
+! time) as the new one speeds up the searching a lot.
+
+if(first_obs) then ! for the first observation, no prev_obs
+ call insert_obs_in_seq(seq, obs)
+ first_obs = .false.
+else
+ if(obs_time >= prev_time) then ! same time or later than previous obs
+ call insert_obs_in_seq(seq, obs, prev_obs)
+ else ! earlier, search from start of seq
+ call insert_obs_in_seq(seq, obs)
+ endif
+endif
+
+! update for next time
+prev_obs = obs
+prev_time = obs_time
+
+end subroutine add_obs_to_seq
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! count_file_lines --
+! count the lines in a text file.
+! rewinds the unit after counting.
+!
+! iunit - handle to the already-open text file
+!
+! created May 2, 2012 Tim Hoar, NCAR/IMAGe
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function count_file_lines(iunit)
+
+integer, intent(in) :: iunit
+integer :: count_file_lines
+
+integer :: i
+character(len=128) :: oneline
+
+integer, parameter :: tenmillion = 10000000
+rewind(iunit)
+
+count_file_lines = 0
+countloop : do i = 1,tenmillion
+
+ read(iunit,'(A)',iostat=rcio) oneline
+
+ if (rcio < 0) exit countloop ! end of file
+ if (rcio > 0) then
+ write (string1,'('' read around line '',i8)')i
+ call error_handler(E_ERR,'count_file_lines', string1, &
+ source, revision, revdate)
+ endif
+ count_file_lines = count_file_lines + 1
+
+enddo countloop
+rewind(iunit)
+
+if (count_file_lines >= tenmillion) then
+ write (string1,'('' suspiciously large number of lines '',i8)')count_file_lines
+ call error_handler(E_MSG,'count_file_lines', string1, &
+ source, revision, revdate)
+endif
+
+end function count_file_lines
+
+
+
+
+subroutine decode_header(iunit)
+! Reads the first line of the header and parses the information.
+integer, intent(in) :: iunit
+
+read(iunit,'(A)',iostat=rcio) input_line
+if (rcio /= 0) then
+ write(string1,*)'Cannot parse header. Begins <',trim(input_line(1:40)),'>'
+ call error_handler(E_ERR,'decode_header',string1, source, revision, revdate)
+endif
+
+call error_handler(E_MSG,'decode_header','hardcoding values for now ... dangerous', &
+ source, revision, revdate)
+
+tower%monthindex = 1
+tower%dayindex = 2
+tower%hourindex = 3
+tower%doyindex = 4
+tower%hindex = 15
+tower%hQCindex = 16
+tower%leindex = 17
+tower%leQCindex = 18
+tower%neeindex = 26
+tower%neeQCindex = 27
+
+end subroutine decode_header
+
+
+
+subroutine stringparse(str1,linenum)
+! just declare everything as reals and see how it falls out
+
+character(len=*), intent(in) :: str1
+integer , intent(in) :: linenum
+
+real(r8), dimension(34) :: values
+integer :: ihour, imin, isec, seconds
+
+values = MISSING_R8
+
+read(str1,*,iostat=rcio) values
+if (rcio /= 0) then
+ write(string1,*)'Cannot parse line',linenum,'. Begins <',trim(str1(1:40)),'>'
+ call error_handler(E_ERR,'stringparse',string1, source, revision, revdate)
+endif
+
+! Stuff what we want into the tower structure
+!
+! Convert to 'CLM-friendly' units.
+! NEE_or_fMDS has units [umolCO2 m-2 s-1]
+! H_f has units [W m-2]
+! LE_f has units [W m-2]
+!
+! (CLM) NEE has units [gC m-2 s-1]
+
+tower%month = nint(values(tower%monthindex))
+tower%day = nint(values(tower%dayindex ))
+tower%hour = values(tower%hourindex )
+tower%doy = values(tower%doyindex )
+tower%nee = values(tower%neeindex ) * 12.0_r8 * 1000000.0_r8
+tower%neeQC = nint(values(tower%neeQCindex))
+tower%le = values(tower%leindex )
+tower%leQC = nint(values(tower%leQCindex ))
+tower%h = values(tower%hindex )
+tower%hQC = nint(values(tower%hQCindex ))
+
+! put observation time/date into a dart time format
+
+ihour = int(tower%hour)
+seconds = nint((tower%hour - real(ihour,r8))*3600)
+imin = seconds / 60
+isec = seconds - imin * 60
+
+tower%time_obs = set_date(year, tower%month, tower%day, ihour, imin, isec)
+
+if (timezoneoffset < 0.0_r8) then
+ tower%time_obs = tower%time_obs - offset
+else
+ tower%time_obs = tower%time_obs + offset
+endif
+
+
+end subroutine stringparse
+
+
+
+end program level4_to_obs
+
+
+! LEVEL 4 VARIABLE DESCRIPTION
+!
+! Variables description:
+! Level 4 data are obtained from the level 3 products, data are ustar filtered,
+! gap-filled using different methods and partitioned.
+! Datasets are also aggregated from daily to monthly.
+! Flags with information regarding quality of the original and gapfilled data are added.
+!
+! Half hourly dataset variables description:
+!
+! - Month : from 1 to 12
+! - Day : day of the month
+! - Hour : from 0 to 23.5, indicates the end of the half hour of measurement
+! - DoY : decimal day of the year
+! - Rg_f : global radiation filled [W m-2]
+! - Rg_fqc : global radiation quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - Ta_f : air temperature filled [\xB0C]
+! - Ta_fqc : air temperature quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - VPD_f : vapour pressure deficit [hPa]
+! - VPD_fqc : vapour pressure deficit quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - Ts_f : soil temperature filled [\xB0C]
+! - Ts_fqc : soil temperature quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - Precip : precipitation [mm]
+! - SWC : soil water content [%vol]
+! - H_f : sensible heat flux filled [W m-2]
+! - H_fqc : sensible heat flux quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - LE_f : latent heat flux filled [W m-2]
+! - LE_fqc : latent heat flux quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - qf_NEE_st : fluxes quality flags as defined in the Level3 product
+! - qf_NEE_or : fluxes quality flags as defined in the Level3 product
+! - Reco_st : Estimated ecosystem respiration according to the short-term temperature
+! response of night-time fluxes based on NEE_st
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! [umolCO2 m-2 s-1]
+! - Reco_or : Estimated ecosystem respiration according to the short-term temperature
+! response of night-time fluxes based on NEE_or
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! [umolCO2 m-2 s-1]
+! - NEE_st_fMDS : NEE_st filled using the Marginal Distribution Sampling method
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! [umolCO2 m-2 s-1]
+! - NEE_st_fMDSqc : NEE_st_fMDS quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - GPP_st_MDS : Gross Primary Production calculated as GPP_st_MDS = Reco_st - NEE_st_MDS
+! [umolCO2 m-2 s-1]
+! - NEE_or_fMDS : NEE_or filled using the Marginal Distribution Sampling method
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! [umolCO2 m-2 s-1]
+! - NEE_or_fMDSqc : NEE_or_fMDS quality flags:
+! 0 = original, 1 = A (most reliable), 2 = B (medium), 3 = C (least reliable).
+! (Refer to Reichstein et al. 2005 Global Change Biology )
+! - GPP_or_MDS : Gross Primary Production calculated as GPP_or_MDS = Reco_or - NEE_or_MDS
+! [umolCO2 m-2 s-1]
+! - NEE_st_fANN : NEE_st filled using the Artificial Neural Network method
+! (Refer to Papale et al. 2003 Global Change Biology and to the Other Information section in this document)
+! [umolCO2 m-2 s-1]
+! - NEE_st_fANNqc : NEE_st_fANN quality flags:
+! 0 = original, 1 = filled using original meteorological inputs or filled with qc=1,
+! 2 = filled using filled meteorological inputs with qc=2 or 3,
+! 3 = not filled using ANN due to one or more input missed but filled with the MDS method
+! - GPP_st_ANN : Gross Primary Production calculated as GPP_st_ ANN = Reco_st - NEE_st_ ANN
+! [umolCO2 m-2 s-1]
+! - NEE_or_f ANN : NEE_or filled using the Artificial Neural Network method
+! (Refer to Papale et al. 2003 Global Change Biology and to the Other Information section in this document)
+! [umolCO2 m-2 s-1]
+! - NEE_or_f ANNqc : NEE_or_fANN quality flags:
+! 0 = original, 1 = filled using original meteorological inputs or filled with qc=1,
+! 2 = filled using filled meteorological inputs with qc=2 or 3,
+! 3 = not filled using ANN due to one or more input missed but filled with the MDS method
+! - GPP_or_ ANN : Gross Primary Production calculated as GPP_or_ ANN = Reco_or - NEE_or_ ANN
+! [umolCO2 m-2 s-1]
Property changes on: DART/branches/development/observations/Ameriflux/level4_to_obs.f90
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Date Rev Author HeadURL Id
Added: svn:eol-style
+ native
Added: DART/branches/development/observations/Ameriflux/level4_to_obs.html
===================================================================
--- DART/branches/development/observations/Ameriflux/level4_to_obs.html (rev 0)
+++ DART/branches/development/observations/Ameriflux/level4_to_obs.html 2012-05-08 20:27:20 UTC (rev 5713)
@@ -0,0 +1,380 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
+ "http://www.w3.org/TR/html4/strict.dtd">
+<HTML>
+<HEAD>
+<TITLE>program level4_to_obs</TITLE>
+<link rel="stylesheet" type="text/css" href="../../doc/html/doc.css">
+<link href="../../doc/html/dart.ico" rel="shortcut icon" />
+</HEAD>
+<BODY>
+<A NAME="TOP"></A>
+
+<H1>PROGRAM <em class=program>level4_to_obs</em></H1>
+
+<table border=0 summary="" cellpadding=5>
+<tr>
+ <td valign=middle>
+ <img src="../../doc/html/Dartboard7.png" alt="DART project logo" height=70 />
+ </td>
+ <td>
+ <P>Jump to <a href="../../index.html">DART Documentation Main Index</a><br />
+ <small><small>version information for this file: <br />
+ <!-- version tag follows, do not edit -->
+ $Id$</small></small>
+ </P></td>
+</tr>
+</table>
+
+<A HREF="#Namelist">NAMELIST</A> /
+<A HREF="#DataSources">DATA SOURCES</A> /
+<A HREF="#Programs">PROGRAMS</A> /
+<A HREF="#Decisions">DECISIONS</A> /
+<A HREF="#References">REFERENCES</A> /
+<A HREF="#Errors">ERRORS</A> /
+<A HREF="#FuturePlans">PLANS</A> /
+<A HREF="#Legalese">TERMS OF USE</A>
+
+<H1>Overview</H1>
+
+<H4>AmeriFlux Level 4 data to DART Observation Sequence Converter</H4>
+
+<P>This routine is designed to convert the flux tower Level 4 data
+from the <a href="http://public.ornl.gov/ameriflux/">AmeriFlux</a>
+network of observations from micrometeorological tower sites.
+AmeriFlux is part of <a href="http://daac.ornl.gov/FLUXNET/fluxnet.shtml">FLUXNET</a>
+and the converter is hoped to be a suitable starting point for the conversion
+of observations from FLUXNET. As of May 2012, I have not yet tried to work with
+any other observations from FLUXNET.
+<br />
+<br />
+The AmeriFlux Level 4 products are recorded using the local time.
+DART observation sequence files use GMT. For more information about
+AmeriFlux data products, go to
+<a href=" http://public.ornl.gov/ameriflux/dataproducts.shtml">
+http://public.ornl.gov/ameriflux/dataproducts.shtml</a>.
+</P>
+
+<P>
+The workflow is usually:
+</P>
+<ol>
+<li>download the Level 4 data for the towers and years in question
+ (<a href="#DataSources">see DATA SOURCES below</a>)
+<li>record the TIME ZONE, latitude, longitude, and elevation for each tower
+<li>build the DART executables with support for the tower observations.
+ This is done by running <em class=program>preprocess</em> with
+ <em class=file>obs_def_tower_mod.f90</em> in the list of <em class=code>input_files</em>
+ for <em class=code>preprocess_nml</em>.
+<li>provide basic tower information via the <em class=code>level4_to_obs_nml</em> namelist
+ since this information is not contained in the Level 4 data file</li>
+<li>convert each Level 4 data file individually using <em class=program>level4_to_obs</em></li>
+<li>combine all output files for the region and timeframe of interest into one file
+ using <a href="../../obs_sequence/obs_sequence_tool.html ">obs_sequence_tool</a></li>
+</ol>
+
+<P>
+For some models (CLM, for example), it is required to reorganize the observation sequence
+files into a series of files that contains ONLY the observations for each assimilation.
+This can be achieved with the <a href="makedaily.sh">makedaily.sh</a> script.
+</P>
+
+<!--==================================================================-->
+<!--=================== DESCRIPTION OF A NAMELIST ===================-->
+<!--==================================================================-->
+
+<A NAME="Namelist"></A>
+<HR>
+<H2>NAMELIST</H2>
+<P>We adhere to the F90 standard of starting a namelist with an ampersand
+'&' and terminating with a slash '/' for all our namelist input.
+</P>
+<div class=namelist>
+<pre>
+<em class=call>namelist /level4_to_obs_nml/ </em> text_input_file, obs_out_file, year, &
+ timezoneoffset, latitude, longitude, elevation, inst_height, maxgoodqc, verbose
+</pre>
+</div>
+
+<H3 class=indent1>Discussion</H3>
+
+<P>This namelist is read in a file called <em class=file>input.nml</em>.
+</P>
+
+<TABLE border=0 cellspacing=10 width=100%>
+<TR><TH align=left>Contents </TH>
+ <TH align=left>Type </TH>
+ <TH align=left>Description </TH></TR>
+
+<TR><!--contents--><TD valign=top> text_input_file </TD>
+ <!-- type --><TD valign=top> character(len=128) </TD>
+ <!--descript--><TD>Name of the Level 4 ASCII file of comma-separated values.
+ This may be a relative or absolute filename.<br />
+ Default: 'textdata.input'</TD></TR>
+
+<TR><!--contents--><TD valign=top> obs_out_file </TD>
+ <!-- type --><TD valign=top> character(len=128) </TD>
+ <!--descript--><TD>Name of the output observation sequence file.<br />
+ Default: 'obs_seq.out'</TD></TR>
+
+<TR><!--contents--><TD valign=top> year </TD>
+ <!-- type --><TD valign=top> integer </TD>
+ <!--descript--><TD>The year of the observations in the Level 4 text file.<br />
+ Default: none </TD></TR>
+
+<TR><!--contents--><TD valign=top> timezoneoffset </TD>
+ <!-- type --><TD valign=top> real </TD>
+ <!--descript--><TD>the time zone offset (in hours) of the station.
+ The tower observation times are local time, we need to convert them
+ to GMT.<br />
+ Default: none </TD></TR>
+
+<TR><!--contents--><TD valign=top> latitude </TD>
+ <!-- type --><TD valign=top> real </TD>
+ <!--descript--><TD>Latitude (in degrees N) of the tower.<br />
+ Default: none</TD></TR>
+
+<TR><!--contents--><TD valign=top> longitude </TD>
+ <!-- type --><TD valign=top> real </TD>
+ <!--descript--><TD>Longitude (in degrees E) of the tower.
+ For internal consistency, DART uses longitudes in the range [0,360].
+ An input value of -90 will be converted to 270.<br />
+ Default: none</TD></TR>
+
+<TR><!--contents--><TD valign=top> elevation </TD>
+ <!-- type --><TD valign=top> real </TD>
+ <!--descript--><TD>surface elevation (in meters) of the tower.<br />
+ Default: none</TD></TR>
+
+<TR><!--contents--><TD valign=top> flux_height </TD>
+ <!-- type --><TD valign=top> real </TD>
+ <!--descript--><TD>height (in meters) of the flux instrument on the tower.<br />
+ Default: none</TD></TR>
+
+<TR><!--contents--><TD valign=top> maxgoodqc </TD>
+ <!-- type --><TD valign=top> real </TD>
+ <!--descript--><TD>maximum value of any observation quality control flag to
+ pass through to the output observation sequence. Keep in mind that
+ <em class=program>filter</em> has the ability to discriminate on the
+ value, so there is really little to be gained by rejecting them
+ during the conversion.<br />
+ Default: 3</TD></TR>
+
+<TR><!--contents--><TD valign=top> verbose </TD>
+ <!-- type --><TD valign=top> logical </TD>
+ <!--descript--><TD>Print extra information about the level4_to_obs run.<br />
+ Default: .false. </TD></TR>
+
+</TABLE>
+
+
+<!--==================================================================-->
+
+<A NAME="DataSources"></A>
+<HR />
+<H2>DATA SOURCES</H2>
+
+<P>
+The data was acquired from
+<a href="http://public.ornl.gov/ameriflux/dataproducts.shtm">
+http://public.ornl.gov/ameriflux/dataproducts.shtm</a><br />
+<br />
+The Level 4 products in question are ASCII files of comma-separated values taken
+every 30 minutes for an entire year. The first line is a comma-separated list of
+column descriptors, all subsequent lines are comma-separated numerical values.
+The converter presently searches for the columns pertaining to <em>NEE_or_fMDS</em>,
+<em>H_f</em>, <em>LE_f</em>, their corresponding quality control fields,
+and those columns pertaining to the time of the observation.
+These values are mapped as follows:
+</P>
+
+<table width=100% cellpadding=10>
+<tr><th align=left>Level 4 units </th>
+ <th align=left>Level 4 variable</th>
+ <th align=left>description </th>
+ <th align=left>DART type </th>
+ <th align=left>DART kind </th>
+ <th align=left>DART units </th></tr>
+<tr><td colspan=6><hr></td></tr>
+
+<tr><!-- >Level 4 units <--><td> W/m^2 </td>
+ <!-- >Level 4 variable<--><td> LE_f </td>
+ <!-- >description <--><td> Latent Heat Flux </td>
+ <!-- >DART type <--><td> TOWER_LATENT_HEAT_FLUX </td>
+ <!-- >DART kind <--><td> KIND_LATENT_HEAT_FLUX </td>
+ <!-- >DART units <--><td> W/m^2 </td></tr>
+
+<tr><!-- >Level 4 units <--><td> [0-3] </td>
+ <!-- >Level 4 variable<--><td> LE_fqc </td>
+ <!-- >description <--><td> QC for LE_f </td>
+ <!-- >DART type <--><td> N/A </td>
+ <!-- >DART kind <--><td> N/A </td>
+ <!-- >DART units <--><td> same </td></tr>
+<tr><td colspan=6><hr></td></tr>
+
+<tr><!-- >Level 4 units <--><td> W/m^2 </td>
+ <!-- >Level 4 variable<--><td> H_f </td>
+ <!-- >description <--><td> Sensible Heat Flux </td>
+ <!-- >DART type <--><td> TOWER_SENSIBLE_HEAT_FLUX</td>
+ <!-- >DART kind <--><td> KIND_SENSIBLE_HEAT_FLUX </td>
+ <!-- >DART units <--><td> W/m^2 </td></tr>
+
+<tr><!-- >Level 4 units <--><td> [0-3] </td>
+ <!-- >Level 4 variable<--><td> H_fqc </td>
+ <!-- >description <--><td> QC for H_f</td>
+ <!-- >DART type <--><td> N/A </td>
+ <!-- >DART kind <--><td> N/A </td>
+ <!-- >DART units <--><td> same </td></tr>
+<tr><td colspan=6><hr></td></tr>
+
+<tr><!-- >Level 4 units <--><td> umolCO2/m^2/s</td>
+ <!-- >Level 4 variable<--><td> NEE_or_fMDS </td>
+ <!-- >description <--><td> Net Ecosystem Production </td>
+ <!-- >DART type <--><td> TOWER_NETC_ECO_EXCHANGE </td>
+ <!-- >DART kind <--><td> KIND_NET_CARBON_PRODUCTION</td>
+ <!-- >DART units <--><td> gC/m^2/s </td></tr>
+
+<tr><!-- >Level 4 units <--><td> [0-3] </td>
+ <!-- >Level 4 variable<--><td> NEE_or_fMDSqc </td>
+ <!-- >description <--><td> QC for NEE_or_fMDS</td>
+ <!-- >DART type <--><td> N/A </td>
+ <!-- >DART kind <--><td> N/A </td>
+ <!-- >DART units <--><td> same </td></tr>
+</table>
+
+<P>The <em class=code>LE_fqc</em>, <em class=code>H_fqc</em>, and <em class=code>NEE_or_fMDSqc</em> variables use the following convention:<br />
+<blockquote>
+0 = original, 1 = category A (most reliable), 2 = category B (medium), 3 = category C (least reliable). (Refer to Reichstein et al. 2005 Global Change Biology for more information)</blockquote>
+<br />
+<br />
+I am repeating the AmeriFlux <a href="http://public.ornl.gov/ameriflux/data-fair-use.shtml">
+Data Fair-Use Policy</a> because I believe it is important to be a good scientific citizen:
+
+<blockquote>
+The AmeriFlux data ... are freely available and were furnished by
+individual AmeriFlux scientists who encourage their use. Please kindly inform in
+writing (or e-mail) the appropriate AmeriFlux scientist(s) of how you intend to use
+the data and of any publication plans. It is also important to contact the AmeriFlux
+investigator to assure you are downloading the latest revision of the data and to
+prevent potential misuse or misinterpretation of the data. Please acknowledge the
+data source as a citation or in the acknowledgments if no citation is available.
+If the AmeriFlux Principal Investigators (PIs) feel that they should be
+acknowledged or offered participation as authors, they will let you know and we
+assume that an agreement on such matters will be reached before publishing and/or
+use of the data for publication. If your work directly competes with the PI's
+analysis they may ask that they have the opportunity to submit a manuscript before
+you submit one that uses unpublished data. In addition, when publishing please
+acknowledge the agency that supported the research. Lastly, we kindly request that
+those publishing papers using AmeriFlux data provide reprints to the PIs providing
+the data and to the data archive at the Carbon Dioxide Information Analysis Center
+(CDIAC).</blockquote>
+</P>
+
+<!--==================================================================-->
+
+<A NAME="Programs"></A>
+<HR />
+<H2>PROGRAMS</H2>
+<P>
+The <em class=file>level4_to_obs.f90</em> file is the source
+for the main converter program.
+Look at the source code where it reads the example data file. You will
+almost certainly need to change the "read" statement to match your data
+format. The example code
+reads each text line into a character buffer
+and then reads from that buffer to parse up the data items.
+</P> <P>
+To compile and test,
+go into the work subdirectory and run the <em class=file>quickbuild.csh</em>
+script to build the converter and a couple of general purpose utilities.
+<em class=file>advance_time</em> helps with calendar and time computations,
+and the
+<em class=file>obs_sequence_tool</em> manipulates DART observation files
+once they have been created.
+</P>
+<P>
+To change the observation types, look in the
+<em class=file>DART/obs_def</em> directory. If you can
+find an obs_def_XXX_mod.f90 file with an appropriate set
+of observation types, change the 'use' lines in the converter
+source to include those types. Then add that filename in the
+<em class=file>input.nml</em> namelist file
+to the &preprocess_nml namelist, the 'input_files' variable.
+Multiple files can be listed. Then run quickbuild.csh again.
+It remakes the table of supported observation types before
+trying to recompile the source code.
+</P>
+<P>
+An example script for converting batches of files is
+in the <em class=file>shell_scripts</em> directory. A tiny example
+data file is in the <em class=file>data</em> directory.
+These are <em>NOT</em> intended to be turnkey scripts; they will
+certainly need to be customized for your use. There are comments
+at the top of the script saying what options they include, and
+should be commented enough to indicate where changes will be
+likely to need to be made.
+</P>
+
+<!--==================================================================-->
+
+<A NAME="Decisions"></A>
+<HR />
+<H2>DECISIONS YOU MIGHT NEED TO MAKE</H2>
+
+<P>
+See the discussion in the
+<a href="../observations.html#Decisions">observations introduction</a>
+page about what options are available for the things you need to
+specify. These include setting a time, specifying an expected error,
+setting a location, and an observation type.
+</P>
+
+<!--==================================================================-->
+<!-- Describe the bugs. -->
+<!--==================================================================-->
+
+<A NAME="KnownBugs"></A>
+<HR />
+<H2>KNOWN BUGS</H2>
+<P>
+none
+</P>
+
+<!--==================================================================-->
+<!-- Describe Future Plans. -->
+<!--==================================================================-->
+
+<A NAME="FuturePlans"></A>
+<HR />
+<H2>FUTURE PLANS</H2>
+<P>
+none
+</P>
+
+<!--==================================================================-->
+<!-- Legalese & Metadata -->
+<!--==================================================================-->
+
+<A NAME="Legalese"></A>
@@ Diff output truncated at 40000 characters. @@
More information about the Dart-dev
mailing list