[Dart-dev] [3818] DART/trunk/models/wrf/WRF_DART_utilities: Remove the outdated dart_tf_wrf.f90 source (replaced by
nancy at ucar.edu
nancy at ucar.edu
Thu Apr 16 10:42:53 MDT 2009
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20090416/3937c3b2/attachment-0001.html
-------------- next part --------------
Deleted: DART/trunk/models/wrf/WRF_DART_utilities/dart_tf_wrf.f90
===================================================================
--- DART/trunk/models/wrf/WRF_DART_utilities/dart_tf_wrf.f90 2009-04-16 14:56:05 UTC (rev 3817)
+++ DART/trunk/models/wrf/WRF_DART_utilities/dart_tf_wrf.f90 2009-04-16 16:42:53 UTC (rev 3818)
@@ -1,597 +0,0 @@
-! Data Assimilation Research Testbed -- DART
-! Copyright 2004-2007, Data Assimilation Research Section
-! University Corporation for Atmospheric Research
-! Licensed under the GPL -- www.gpl.org/licenses/gpl.html
-
-PROGRAM dart_tf_wrf
-
-! <next few lines under version control, do not edit>
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
-use types_mod, only : r8
-use time_manager_mod, only : time_type, write_time, read_time, get_date, set_date, operator(-), &
- get_time, print_time, set_calendar_type, GREGORIAN, julian_day
-use utilities_mod, only : get_unit, file_exist, open_file, close_file, &
- error_handler, E_ERR, E_MSG, initialize_utilities, &
- register_module, logfileunit, nmlfileunit, timestamp, &
- find_namelist_in_file, check_namelist_read
-use wrf_data_module, only : wrf_data, wrf_open_and_alloc, wrf_dealloc, wrf_io, set_wrf_date, &
- get_wrf_date
-use assim_model_mod, only : open_restart_read, open_restart_write, aread_state_restart, &
- awrite_state_restart
-use netcdf
-
-implicit none
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-type wrf_dom
- type(wrf_data), pointer :: dom(:)
-end type wrf_dom
-
-!-----------------------------------------------------------------------
-! Model namelist parameters with default values.
-!-----------------------------------------------------------------------
-
-logical :: output_state_vector = .false. ! state vs. prognostic format
-integer :: num_moist_vars = 3
-integer :: num_domains = 1
-integer :: calendar_type = GREGORIAN
-integer :: assimilation_period_seconds = 21600
-logical :: surf_obs = .true.
-logical :: soil_data = .true.
-logical :: h_diab = .false.
-logical :: allow_obs_below_vol = .false.
-character(len = 72) :: adv_mod_command = './wrf.exe'
-real (kind=r8) :: center_search_half_length = 500000.0_r8
-integer :: center_spline_grid_scale = 10
-integer :: vert_localization_coord = 3 ! 1,2,3 == level,pressure,height
-! candidates for including in the WRF netcdf files:
-logical :: polar = .false. ! wrap over the poles
-logical :: periodic_x = .false. ! wrap in longitude or x
-logical :: periodic_y = .false. ! used for single column model, wrap in y
-!JPH -- single column model flag
-logical :: scm = .false. ! using the single column model
-
-
-namelist /model_nml/ output_state_vector, num_moist_vars, &
- num_domains, calendar_type, surf_obs, soil_data, h_diab, &
- adv_mod_command, assimilation_period_seconds, &
- allow_obs_below_vol, vert_localization_coord, &
- center_search_half_length, center_spline_grid_scale, &
- polar, periodic_x, periodic_y, scm
-
-!-------------------------------------------------------------
-
-type(wrf_dom) :: wrf
-
-real(r8), pointer :: dart(:)
-type(time_type) :: dart_time(2)
-integer :: number_dart_values, ndays, &
- year, month, day, hour, minute, second
-integer :: ndims, idims(2), dimids(2)
-integer :: i, ivtype
-character(len=80) :: varname
-character(len=19) :: timestring
-character(len=1) :: idom
-
-logical, parameter :: debug = .false.
-integer :: mode, io, var_id, id, iunit, dart_unit
-
-logical :: dart_to_wrf
-
-write(*,*) 'DART to WRF (.true./T) or WRF to DART (.false./F)?'
-
-read(*,*) dart_to_wrf
-
-call initialize_utilities('dart_tf_wrf')
-call register_module(source, revision, revdate)
-
-! Begin by reading the namelist input
-call find_namelist_in_file("input.nml", "model_nml", iunit)
-read(iunit, nml = model_nml, iostat = io)
-call check_namelist_read(iunit, io, "model_nml")
-
-! Record the namelist values used for the run ...
-write(nmlfileunit, nml=model_nml)
-write( * , nml=model_nml)
-
-call set_calendar_type(calendar_type)
-
-if ( dart_to_wrf ) then
- call error_handler(E_MSG,'dart_to_wrf', &
- 'Converting a dart state vector to a WRF netcdf file', &
- source, revision, revdate)
-else
- call error_handler(E_MSG,'dart_to_wrf', &
- 'Converting a WRF netcdf file to a dart state vector', &
- source, revision, revdate)
-endif
-
-allocate(wrf%dom(num_domains))
-
-wrf%dom(:)%n_moist = num_moist_vars
-wrf%dom(:)%surf_obs = surf_obs
-wrf%dom(:)%soil_data = soil_data
-wrf%dom(:)%h_diab = h_diab
-
-! open wrf data netCDF file 'wrfinput_d0x'
-! we get sizes of the WRF geometry and resolution
-
-mode = NF90_NOWRITE ! read the netcdf file
-if( dart_to_wrf ) mode = NF90_WRITE ! write to the netcdf file
-
-if(debug) write(*,*) ' wrf_open_and_alloc '
-do id=1,num_domains
- write( idom , '(I1)') id
- call wrf_open_and_alloc( wrf%dom(id), 'wrfinput_d0'//idom, mode, debug )
-enddo
-if(debug) write(*,*) ' returned from wrf_open_and_alloc '
-
-!---
-! allocate space for DART data
-
-if(debug) write(*,*) ' dart_open_and_alloc '
-
-call dart_open_and_alloc( wrf, dart, number_dart_values, dart_unit, dart_to_wrf, &
- debug )
-if(debug) write(*,*) ' returned from dart_open_and_alloc '
-
-!----------------------------------------------------------------------
-! get DART or WRF data
-
-if(debug) write(*,*) ' state input '
-
-if( dart_to_wrf ) then
-
- call aread_state_restart(dart_time(2), dart, dart_unit, dart_time(1))
-
- iunit = get_unit()
- open(unit = iunit, file = 'wrf.info')
- call write_time(iunit, dart_time(1))
- call write_time(iunit, dart_time(2))
- call get_date(dart_time(2), year, month, day, hour, minute, second)
- write (iunit,FMT='(I4,5I3.2)') year, month, day, hour, minute, second
-
- write (iunit,*) num_domains
- write (iunit,*) adv_mod_command
- close(iunit)
-
-else
-
- do id=1,num_domains
- call WRF_IO( wrf%dom(id), "INPUT ", debug )
- enddo
-
-end if
-if(debug) write(*,*) ' returned from state input '
-
-!---
-! translate from DART to WRF, or WRF to DART
-
-if(debug) write(*,*) ' transfer data to_from dart-wrf '
-
-call transfer_dart_wrf ( dart_to_wrf, dart, wrf, &
- number_dart_values )
-
-if(debug) write(*,*) ' transfer complete '
-
-!---
-! output
-
-if(debug) write(*,*) ' state output '
-if( dart_to_wrf ) then
-
-!!$ call get_date(dart_time(2), year, month, day, hour, minute, second)
- call set_wrf_date(timestring, year, month, day, hour, minute, second)
- ndays = julian_day(year, month, day)
-
- do id=1,num_domains
- call check( nf90_inq_varid(wrf%dom(id)%ncid, "Times", var_id) )
- call check( nf90_put_var(wrf%dom(id)%ncid, var_id, timestring) )
- call check( nf90_put_att(wrf%dom(id)%ncid, nf90_global, "START_DATE", timestring) )
- call check( nf90_put_att(wrf%dom(id)%ncid, nf90_global, "JULYR", year) )
- call check( nf90_put_att(wrf%dom(id)%ncid, nf90_global, "JULDAY", ndays) )
- call WRF_IO( wrf%dom(id), "OUTPUT", debug )
- enddo
-
-else
- iunit = get_unit()
- call check( nf90_inq_varid(wrf%dom(1)%ncid, "Times", var_id) )
- call check( nf90_Inquire_Variable(wrf%dom(1)%ncid, var_id, varname, xtype=ivtype, &
- ndims=ndims, dimids=dimids) )
- do i=1,ndims
- call check( nf90_inquire_dimension(wrf%dom(1)%ncid, dimids(i), len=idims(i)) )
- if(debug) write(*,*) ' dimension ',i,idims(i)
- enddo
-
- call check( nf90_get_var(wrf%dom(1)%ncid, var_id, timestring, start = (/ 1, idims(2) /)) )
- call get_wrf_date(timestring, year, month, day, hour, minute, second)
- dart_time(1) = set_date(year, month, day, hour, minute, second)
-
- call print_time(dart_time(1),str='Time from wrfinput_d0x:')
-
- if(file_exist('wrf.info')) then
- open(unit = iunit, file = 'wrf.info')
- dart_time(1) = read_time(iunit)
- close(iunit)
- endif
-
- call print_time(dart_time(1),str='Time written to dart vector file:')
-
- call awrite_state_restart(dart_time(1), dart, dart_unit)
-
-end if
-if(debug) write(*,*) ' returned from state output '
-
-do id=1,num_domains
- call check ( nf90_sync(wrf%dom(id)%ncid) )
- call check ( nf90_close(wrf%dom(id)%ncid) )
-enddo
-
-do id=1,num_domains
- call wrf_dealloc(wrf%dom(id))
-enddo
-deallocate(dart)
-
-write(logfileunit,*)'FINISHED dart_tf_wrf.'
-write(logfileunit,*)
-
-call timestamp(source,revision,revdate,'end') ! That closes the log file, too.
-
-contains
-
- ! Internal subroutine - checks error status after each netcdf, prints
- ! text message each time an error code is returned.
- subroutine check(istatus)
- integer, intent ( in) :: istatus
- if(istatus /= nf90_noerr) call error_handler(E_ERR,'dart_tf_wrf', &
- trim(nf90_strerror(istatus)), source, revision, revdate)
- end subroutine check
-
-!*****************************************************************************
-
-subroutine dart_open_and_alloc( wrf, dart, n_values, dart_unit, dart_to_wrf, &
- debug )
-
-implicit none
-
-integer, intent(out) :: dart_unit
-
-logical, intent(in) :: dart_to_wrf, debug
-
-type(wrf_dom), intent(in) :: wrf
-real(r8), pointer :: dart(:)
-
-integer, intent(out) :: n_values
-
-integer :: id
-
-character(len=80) :: stringerror
-
-! compute number of values in 1D vector
-
-n_values = 0
-
-do id=1,num_domains
-
-! dry dynamics conponents
-
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we+1) ! u
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn+1)*(wrf%dom(id)%we ) ! v
- n_values = n_values + (wrf%dom(id)%bt+1)*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! w
- n_values = n_values + (wrf%dom(id)%bt+1)*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! geopotential
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! t
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! dry surf. press.
-
-! moist variables. Order is qv, qc, qr, qi, qs, qg, qnice.
-
- if(wrf%dom(id)%n_moist > 7) then
- write(stringerror,*) 'n_moist = ',wrf%dom(id)%n_moist,' is too large.'
- call error_handler(E_ERR, 'dart_open_and_alloc', &
- stringerror, source, revision, revdate)
- else
- n_values = n_values + wrf%dom(id)%n_moist*(wrf%dom(id)%bt)*(wrf%dom(id)%sn)*(wrf%dom(id)%we)
- endif
-
- if( wrf%dom(id)%surf_obs ) then
- n_values = n_values + 6 * wrf%dom(id)%sn * wrf%dom(id)%we
- endif
-
- if( wrf%dom(id)%soil_data ) then
- n_values = n_values + 3 * (wrf%dom(id)%sls )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! tslb, smois, sh2o
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! skin temperature
- endif
-
- if( wrf%dom(id)%h_diab ) then
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we )
- endif
-
-enddo
-
-if(debug) write(*,*) ' dart vector length is ',n_values
-
-allocate(dart(n_values))
-
-! open DART data file
-
-if(dart_to_wrf) then ! DART data file should exist, open it
- dart_unit = open_restart_read("dart_wrf_vector")
-else
- dart_unit = open_restart_write("dart_wrf_vector")
-end if
-
-end subroutine dart_open_and_alloc
-
-!*****************************************************************************
-
-subroutine transfer_dart_wrf ( dart_to_wrf, dart, wrf, n_values_in)
-
-implicit none
-
-logical, intent(in) :: dart_to_wrf
-
-type(wrf_dom), intent(inout) :: wrf
-real(r8), pointer :: dart(:)
-
-integer, intent(in) :: n_values_in
-
-!---
-
-integer :: in, n_values,id, end_moist
-character(len=80) :: stringerror
-
-!---
-
-n_values = 0
-
-do id=1,num_domains
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%u,wrf%dom(id)%we+1,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we+1) ! u
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%v,wrf%dom(id)%we,wrf%dom(id)%sn+1,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn+1)*(wrf%dom(id)%we ) ! v
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%w,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt+1)
- n_values = n_values + (wrf%dom(id)%bt+1)*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! w
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%ph,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt+1)
- n_values = n_values + (wrf%dom(id)%bt+1)*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! geopotential
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%t,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! t
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%mu,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! dry surf. press.
-
-! moist variables
-
- if(wrf%dom(id)%n_moist >= 1) then
- in = n_values+1
-
-!--------Make sure that microphysics variables are not negatives.
-
- end_moist = n_values + (wrf%dom(id)%n_moist)*(wrf%dom(id)%bt)*(wrf%dom(id)%sn)*(wrf%dom(id)%we)
- dart(in:end_moist) = max(0.0_r8,dart(in:end_moist))
-
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%qv,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! qv
- endif
- if(wrf%dom(id)%n_moist >= 2) then
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%qc,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! qc
- endif
- if(wrf%dom(id)%n_moist >= 3) then
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%qr,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! qr
- endif
- if(wrf%dom(id)%n_moist >= 4) then
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%qi,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! qi
- endif
- if(wrf%dom(id)%n_moist >= 5) then
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%qs,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! qs
- endif
- if(wrf%dom(id)%n_moist >= 6) then
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%qg,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! qg
- endif
- if(wrf%dom(id)%n_moist == 7) then
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%qnice,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! qnice
- endif
- if(wrf%dom(id)%n_moist > 7) then
- write(stringerror,*) 'n_moist = ',wrf%dom(id)%n_moist,' is too large.'
- call error_handler(E_ERR, 'transfer_dart_wrf', &
- stringerror, source, revision, revdate)
- endif
-
- if( wrf%dom(id)%surf_obs ) then
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%u10,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! u10
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%v10,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! v10
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%t2,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! t2
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%th2,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! th2
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%q2,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! q2
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%ps,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! ps
-
- endif
-
- if( wrf%dom(id)%soil_data ) then
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%tslb,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%sls)
- n_values = n_values + (wrf%dom(id)%sls )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! tslb
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%smois,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%sls)
- n_values = n_values + (wrf%dom(id)%sls )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! smois
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%sh2o,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%sls)
- n_values = n_values + (wrf%dom(id)%sls )*(wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! sh2o
-
- in = n_values+1
- call trans_2d( dart_to_wrf, dart(in:),wrf%dom(id)%tsk,wrf%dom(id)%we,wrf%dom(id)%sn)
- n_values = n_values + (wrf%dom(id)%sn )*(wrf%dom(id)%we ) ! skin temperature
-
- endif
-
- if( wrf%dom(id)%h_diab ) then
-
- in = n_values+1
- call trans_3d( dart_to_wrf, dart(in:),wrf%dom(id)%hdiab,wrf%dom(id)%we,wrf%dom(id)%sn,wrf%dom(id)%bt)
- n_values = n_values + (wrf%dom(id)%bt )*(wrf%dom(id)%sn )*(wrf%dom(id)%we )
-
- endif
-
-enddo
-
-if(n_values /= n_values_in ) then
- write(stringerror,*)' n_values differ in transfer ',n_values, n_values_in
- call error_handler(E_ERR, 'transfer_dart_wrf', &
- stringerror, source, revision, revdate)
-endif
-
-end subroutine transfer_dart_wrf
-
-!*********************************************************************
-
-subroutine trans_2d( one_to_two, a1d, a2d, nx, ny )
-
-implicit none
-
-integer, intent(in) :: nx,ny
-real(r8), intent(inout) :: a1d(:)
-real(r8), intent(inout) :: a2d(nx,ny)
-logical, intent(in) :: one_to_two
-
-!---
-
-integer :: i,j,m
-character(len=129) :: errstring
-
-i=size(a2d,1)
-j=size(a2d,2)
-m=size(a1d)
-
-if ( i /= nx .or. &
- j /= ny .or. &
- m < nx*ny) then
- write(errstring,*)'nx, ny, not compatible ',i,j,nx,ny
- call error_handler(E_ERR,'trans_2d',errstring,source,revision,revdate)
-endif
-
-
-if (one_to_two) then
-
- do j=1,ny
- do i=1,nx
- a2d(i,j) = a1d(i + nx*(j-1))
- enddo
- enddo
-
-else
-
- do j=1,ny
- do i=1,nx
- a1d(i + nx*(j-1)) = a2d(i,j)
- enddo
- enddo
-
-end if
-
-end subroutine trans_2d
-
-!*********************************************************************
-
-subroutine trans_3d( one_to_three, a1d, a3d, nx, ny, nz )
-
-implicit none
-
-integer, intent(in) :: nx,ny,nz
-real(r8), intent(inout) :: a1d(:)
-real(r8), intent(inout) :: a3d(:,:,:)
-logical, intent(in) :: one_to_three
-
-!---
-
-integer :: i,j,k,m
-character(len=129) :: errstring
-
-i=size(a3d,1)
-j=size(a3d,2)
-k=size(a3d,3)
-m=size(a1d)
-
-if ( i /= nx .or. &
- j /= ny .or. &
- k /= nz .or. &
- m < nx*ny*nz) then
- write(errstring,*)'nx, ny, nz, not compatible ',i,j,k,nx,ny,nz,m
- call error_handler(E_ERR,'trans_3d',errstring,source,revision,revdate)
-endif
-
-if (one_to_three) then
-
- do k=1,nz
- do j=1,ny
- do i=1,nx
- a3d(i,j,k) = a1d(i + nx*(j-1) + nx*ny*(k-1) )
- enddo
- enddo
- enddo
-
-else
-
- do k=1,nz
- do j=1,ny
- do i=1,nx
- a1d(i + nx*(j-1) + nx*ny*(k-1) ) = a3d(i,j,k)
- enddo
- enddo
- enddo
-
-end if
-
-end subroutine trans_3d
-
-END PROGRAM dart_tf_wrf
Deleted: DART/trunk/models/wrf/WRF_DART_utilities/dart_tf_wrf.html
===================================================================
--- DART/trunk/models/wrf/WRF_DART_utilities/dart_tf_wrf.html 2009-04-16 14:56:05 UTC (rev 3817)
+++ DART/trunk/models/wrf/WRF_DART_utilities/dart_tf_wrf.html 2009-04-16 16:42:53 UTC (rev 3818)
@@ -1,308 +0,0 @@
-<HTML>
-<HEAD>
-<TITLE>program dart_tf_wrf</TITLE>
-<link rel="stylesheet" type="text/css" href="../../../doc/html/doc.css"></link>
-</HEAD>
-<BODY>
-<!--
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! !!
-!! GNU General Public License !!
-!! !!
-!! This file is part of the Data Assimilation Research Testbed (DART). !!
-!! !!
-!! DART is free software; you can redistribute it and/or modify !!
-!! it and are expected to follow the terms of the GNU General Public !!
-!! License as published by the Free Software Foundation. !!
-!! !!
-!! DART is distributed in the hope that it will be useful, !!
-!! but WITHOUT ANY WARRANTY; without even the implied warranty of !!
-!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !!
-!! GNU General Public License for more details. !!
-!! !!
-!! You should have received a copy of the GNU General Public License !!
-!! along with DART; if not, write to: !!
-!! Free Software Foundation, Inc. !!
-!! 59 Temple Place, Suite 330 !!
-!! Boston, MA 02111-1307 USA !!
-!! or see: !!
-!! http://www.gnu.org/licenses/gpl.txt !!
-!! !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
--->
-
-<DIV ALIGN=CENTER>
-<A HREF="#Modules">MODULES</A> /
-<A HREF="#Namelist">NAMELIST</A> /
-<A HREF="#FilesUsed">FILES</A> /
-<A HREF="#References">REFERENCES</A> /
-<A HREF="#Errors">ERRORS</A> /
-<A HREF="#KnownBugs">BUGS</A> /
-<A HREF="#FuturePlans">PLANS</A>
-<A HREF="#PrivateComponents">PRIVATE COMPONENTS</A>
-</DIV>
-
-<!--==================================================================-->
-
-<H1>PROGRAM dart_tf_wrf</H1>
-<A NAME="HEADER"></A>
-<TABLE summary="">
-<TR><TD>Contact: </TD><TD> Hui Liu, David Dowell </TD></TR>
-<TR><TD>Revision: </TD><TD> $Revision$ </TD></TR>
-<TR><TD>Source: </TD><TD> $URL$ </TD></TR>
-<TR><TD>Change Date: </TD><TD> $Date$ </TD></TR>
-<TR><TD>Change history:</TD><TD> try "svn log" or "svn diff" </TD></TR>
-</TABLE>
-
-<!--==================================================================-->
-
-<A NAME="OVERVIEW"></A>
-<HR>
-<H2>OVERVIEW</H2>
-
-<P>
- Program to convert WRF netCDF input files into DART format, and vice versa.
-</P>
-
-<!--==================================================================-->
-
-<A NAME="Modules"></A>
-<BR><HR><BR>
-<H2>MODULES DIRECTLY USED</H2>
-<PRE>
-types_mod
-time_manager_mod
-utilities_mod
-models/wrf/WRF_DART_utilities/wrf_data_module
-assim_model_mod
-</PRE>
-
-<H2>MODULES INDIRECTLY USED</H2>
-<PRE>
-models/wrf/model_mod
-models/wrf/module_map_utils
-obs_kind_mod
-location/threed_sphere/location_mod
-random_seq_mod
-random_nr_mod
-</PRE>
-
-<!--==================================================================-->
-<!--=================== DESCRIPTION OF A NAMELIST ===================-->
-
-<A NAME="Namelist"></A>
-<BR><HR><BR>
-<H2>NAMELIST</H2>
-<P>We adhere to the F90 standard of starting a namelist with an ampersand
-'&' and terminating with a slash '/'.
-<div class=namelist>
-<pre>
-<em class=call>namelist / model_nml / </em> &
- output_state_vector, num_moist_vars, num_domains, calendar_type, &
- surf_obs, soil_data, h_diab, adv_mod_command, assimilation_period_seconds, &
- vert_localization_coord, center_search_half_length, center_spline_grid_scale
-
-</pre>
-</div>
-</P>
-
-<H3 class=indent1>Discussion</H3>
-
-<P>The program uses the model_nml. See the description in <em
-class=file>model_mod.html</em>
-</P>
-
-<!--==================================================================-->
-<!-- Describe the Files Used by this module. -->
-<!--==================================================================-->
-
-<A NAME="FilesUsed"></A>
-<BR><HR><BR>
-<H2>FILES</H2>
-<UL>
- <LI>input namelist ; <em class=file>input.nml</em>
- <LI>Input - output WRF state netCDF files; <em class=file>wrfinput_d01,
- wrfinput_d02, ...</em>
- <LI>Input - output dart state vector format files ; <em
- class=file>dart_wrf_vector</em>
- <LI>Input - output: <em class=file>wrf.info</em>
-</UL>
-
-<H3>File formats</H3>
-
-<P>In the conversion from dart to WRF, the <em class=file>dart_wrf_vector</em>
-file is usually one of the <em class=file>assim_model_state_ic#</em> that the
-filter writes out to advance the ensemble. As input, the dart_wrf_vector
-includes the target time in addition to the valid time at the beginning of the
-file. As output, the dart_wrf_vector includes only the valid time at the
-beginning of the file and is usually renamed as <em
-class=file>assim_model_state_ud#</em> as input to the filter for the next
-assimilation cycle.
-</P>
-
-<P>The file <em class=file>wrf.info</em> contains the target dart time, the valid
-dart time, the valid date, the number of domains, and the command used to
-executed the WRF model. The file <em class=file>wrf.info</em> is created in the
-conversion from dart to WRF. In the conversion from WRF back to dart, the
-target time is read from the file <em class=file>wrf.info</em>, which should
-then be the valid time. This will be the time written to the dart vector
-file. The rest of the information in the file <em class=file>wrf.info</em> is
-only used by the program ensemble_init and by the script advance_model.csh.
-
-<!--==================================================================-->
-<!-- Cite references, if need be. -->
-<!--==================================================================-->
-
-<A NAME="References"></A>
-<BR><HR><BR>
-<H2>REFERENCES</H2>
-<UL>
-</UL>
-
-<!--==================================================================-->
-<!-- Describe all the error conditions and codes. -->
-<!-- Putting a <BR> after the synopsis creates a nice effect. -->
-<!--==================================================================-->
-
-<A NAME="Errors"></A>
-<HR>
-<H2>ERROR CODES and CONDITIONS</H2>
-<div class="errors">
-<TABLE border=1 cellspacing=1 cellpadding=10 width=100%>
-<TR><TH>Routine</TH><TH>Message</TH><TH>Comment</TH></TR>
-
-<TR><!-- routine --><TD VALIGN=top>dart_open_and_alloc, transfer_dart_wrf</TD>
- <!-- message --><TD VALIGN=top>n_moist = is too large.</TD>
- <!-- comment --><TD VALIGN=top>The maximum number of moist variables is
- 7. In order, they are [qv, qc, qr, qi, qs, qg, qnice]</TD>
-</TR>
-<TR><!-- routine --><TD VALIGN=top>transfer_dart_wrf</TD>
- <!-- message --><TD VALIGN=top>n_values differ in transfer</TD>
- <!-- comment --><TD VALIGN=top>If you get to this point, there would an
- inconsistency between subroutines dart_open_and_alloc and transfer_dart_wrf.</TD>
-</TR>
-<TR><!-- routine --><TD VALIGN=top>trans_2d</TD>
- <!-- message --><TD VALIGN=top>nx, ny, not compatible</TD>
- <!-- comment --><TD VALIGN=top>Dimensions nx, ny incompatible with incoming
- array a2d.</TD>
-</TR>
-<TR><!-- routine --><TD VALIGN=top>trans_3d</TD>
- <!-- message --><TD VALIGN=top>nx, ny, nz, not compatible</TD>
- <!-- comment --><TD VALIGN=top>Dimensions nx, ny, nz incompatible with incoming
- array a3d.</TD>
-</TR>
-
-</TABLE>
-</div>
-
-<!--==================================================================-->
-<!-- Describe the bugs. -->
-<!--==================================================================-->
-
-<A NAME="KnownBugs"></A>
-<BR><HR><BR>
-<H2>KNOWN BUGS</H2>
-<P>
-</P>
-
-<!--==================================================================-->
-<!-- Describe Future Plans. -->
-<!--==================================================================-->
-
-<A NAME="FuturePlans"></A>
-<BR><HR><BR>
-<H2>FUTURE PLANS</H2>
-<P>
-<LI>This program has to be updated when new prognostic variables are included
-in the state vector, e.g. when tracers or chemical species are evolved
-in WRF. The program will also need to be updated to add parameters to be estimated.
-</P>
-
-<!--==================================================================-->
-<!-- Declare all private entities. -->
-<!--==================================================================-->
-
-<A NAME="PrivateComponents"></A>
-<BR><HR><BR>
-<H2>PRIVATE COMPONENTS</H2>
-
-<!--=================== DESCRIPTION OF SUBROUTINE ====================-->
-
-<P></P><HR><P></P>
-<div class=routine>
-<em class=call> call dart_open_and_alloc( wrf, dart, n_values, dart_unit,
-dart_to_wrf, debug )</em>
-<pre>
-integer, intent(out) :: <em class=code> dart_unit </em>
-logical, intent(in) :: <em class=code> dart_to_wrf, debug </em>
-type(wrf_dom), intent(in) :: <em class=code> wrf </em>
-real(r8), pointer :: <em class=code> dart(:) </em>
-integer, intent(out) :: <em class=code> n_values </em>
-</pre></div>
-
-<H3 class=indent1>Description</H3>
-
-<P>
-Open a dart state vector file, determine the lenght of the dart
-state vector, and allocate the dart state vector variable.
-</P>
-
-<!--=================== DESCRIPTION OF SUBROUTINE ====================-->
-
-<P></P><HR><P></P>
-<div class=routine>
-<em class=call> call transfer_dart_wrf ( dart_to_wrf, dart, wrf, n_values_in)</em>
-<pre>
-logical, intent(in) :: <em class=code> dart_to_wrf </em>
-type(wrf_dom), intent(in) :: <em class=code> wrf </em>
-real(r8), pointer :: <em class=code> dart(:) </em>
-integer, intent(in) :: <em class=code> n_values_in </em>
-</pre></div>
-
-<H3 class=indent1>Description</H3>
-
-<P>
-Transfert from dart state vector to a wrf structure, or vice versa.
-</P>
-
-<!--=================== DESCRIPTION OF SUBROUTINE ====================-->
-
-<P></P><HR><P></P>
-<div class=routine>
-<em class=call> call trans_2d( one_to_two, a1d, a2d, nx, ny )</em>
-<pre>
-integer, intent(in) :: <em class=code> nx,ny </em>
-real(r8), intent(in) :: <em class=code> a1d(:) </em>
-real(r8), intent(in) :: <em class=code> a2d(nx,ny) </em>
-logical, intent(in) :: <em class=code> one_to_two </em>
-</pre></div>
-
-<H3 class=indent1>Description</H3>
-
-<P>
-Transfert data from a 2D array into a 1D array, or vice versa.
-</P>
-
-<!--=================== DESCRIPTION OF SUBROUTINE ====================-->
-
-<P></P><HR><P></P>
-<div class=routine>
-<em class=call> call trans_3d( one_to_three, a1d, a3d, nx, ny, nz )</em>
-<pre>
-integer, intent(in) :: <em class=code> nx,ny,nz </em>
-real(r8), intent(in) :: <em class=code> a1d(:) </em>
-real(r8), intent(in) :: <em class=code> a3d(:,:,:) </em>
-logical, intent(in) :: <em class=code> one_to_three </em>
-</pre></div>
-
-<H3 class=indent1>Description</H3>
-
-<P>
-Transfert data from a 3D array into a 1D array, or vice versa.
-</P>
-
-<!--==================================================================-->
-
-<HR>
-</BODY>
-</HTML>
Copied: DART/trunk/models/wrf/WRF_DART_utilities/dart_to_wrf.html (from rev 3817, DART/trunk/models/wrf/WRF_DART_utilities/dart_tf_wrf.html)
===================================================================
--- DART/trunk/models/wrf/WRF_DART_utilities/dart_to_wrf.html (rev 0)
+++ DART/trunk/models/wrf/WRF_DART_utilities/dart_to_wrf.html 2009-04-16 16:42:53 UTC (rev 3818)
@@ -0,0 +1,309 @@
+<HTML>
+<HEAD>
+<TITLE>program dart_to_wrf</TITLE>
+<link rel="stylesheet" type="text/css" href="../../../doc/html/doc.css"></link>
+</HEAD>
+<BODY>
+<!--
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! !!
+!! GNU General Public License !!
+!! !!
+!! This file is part of the Data Assimilation Research Testbed (DART). !!
+!! !!
+!! DART is free software; you can redistribute it and/or modify !!
+!! it and are expected to follow the terms of the GNU General Public !!
+!! License as published by the Free Software Foundation. !!
+!! !!
+!! DART is distributed in the hope that it will be useful, !!
+!! but WITHOUT ANY WARRANTY; without even the implied warranty of !!
+!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !!
+!! GNU General Public License for more details. !!
+!! !!
+!! You should have received a copy of the GNU General Public License !!
+!! along with DART; if not, write to: !!
+!! Free Software Foundation, Inc. !!
+!! 59 Temple Place, Suite 330 !!
+!! Boston, MA 02111-1307 USA !!
+!! or see: !!
+!! http://www.gnu.org/licenses/gpl.txt !!
+!! !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+-->
+
+<DIV ALIGN=CENTER>
+<A HREF="#Modules">MODULES</A> /
+<A HREF="#Namelist">NAMELIST</A> /
+<A HREF="#FilesUsed">FILES</A> /
+<A HREF="#References">REFERENCES</A> /
+<A HREF="#Errors">ERRORS</A> /
+<A HREF="#KnownBugs">BUGS</A> /
+<A HREF="#FuturePlans">PLANS</A>
+<A HREF="#PrivateComponents">PRIVATE COMPONENTS</A>
+</DIV>
+
+<!--==================================================================-->
+
+<H1>PROGRAM dart_to_wrf</H1>
+<H1>PROGRAM wrf_to_dart</H1>
+<A NAME="HEADER"></A>
+<TABLE summary="">
+<TR><TD>Contact: </TD><TD> Hui Liu, David Dowell </TD></TR>
+<TR><TD>Revision: </TD><TD> $Revision$ </TD></TR>
+<TR><TD>Source: </TD><TD> $URL$ </TD></TR>
+<TR><TD>Change Date: </TD><TD> $Date$ </TD></TR>
+<TR><TD>Change history:</TD><TD> try "svn log" or "svn diff" </TD></TR>
+</TABLE>
+
+<!--==================================================================-->
+
+<A NAME="OVERVIEW"></A>
+<HR>
+<H2>OVERVIEW</H2>
+
+<P>
+ Programs to convert WRF netCDF input files into DART format, and vice versa.
+</P>
+
+<!--==================================================================-->
+
+<A NAME="Modules"></A>
+<BR><HR><BR>
+<H2>MODULES DIRECTLY USED</H2>
+<PRE>
+types_mod
+time_manager_mod
+utilities_mod
+models/wrf/WRF_DART_utilities/wrf_data_module
+assim_model_mod
+</PRE>
+
+<H2>MODULES INDIRECTLY USED</H2>
+<PRE>
+models/wrf/model_mod
+models/wrf/module_map_utils
+obs_kind_mod
+location/threed_sphere/location_mod
+random_seq_mod
+random_nr_mod
+</PRE>
+
+<!--==================================================================-->
+<!--=================== DESCRIPTION OF A NAMELIST ===================-->
+
+<A NAME="Namelist"></A>
+<BR><HR><BR>
+<H2>NAMELIST</H2>
+<P>We adhere to the F90 standard of starting a namelist with an ampersand
+'&' and terminating with a slash '/'.
+<div class=namelist>
+<pre>
+<em class=call>namelist / model_nml / </em> &
+ output_state_vector, num_moist_vars, num_domains, calendar_type, &
+ surf_obs, soil_data, h_diab, adv_mod_command, assimilation_period_seconds, &
+ vert_localization_coord, center_search_half_length, center_spline_grid_scale
+
+</pre>
+</div>
+</P>
+
+<H3 class=indent1>Discussion</H3>
+
+<P>The program uses the model_nml. See the description in
+<em class=file>model_mod.html</em>
+</P>
+
+<!--==================================================================-->
+<!-- Describe the Files Used by this module. -->
+<!--==================================================================-->
+
+<A NAME="FilesUsed"></A>
+<BR><HR><BR>
+<H2>FILES</H2>
+<UL>
+ <LI>input namelist ; <em class=file>input.nml</em>
+ <LI>Input - output WRF state netCDF files; <em class=file>wrfinput_d01,
+ wrfinput_d02, ...</em>
+ <LI>Input - output dart state vector format files ; <em
+ class=file>dart_wrf_vector</em>
+ <LI>Input - output: <em class=file>wrf.info</em>
+</UL>
+
+<H3>File formats</H3>
+
+<P>In the conversion from dart to WRF, the <em class=file>dart_wrf_vector</em>
+file is usually one of the <em class=file>assim_model_state_ic#</em> that the
+filter writes out to advance the ensemble. As input, the dart_wrf_vector
+includes the target time in addition to the valid time at the beginning of the
+file. As output, the dart_wrf_vector includes only the valid time at the
+beginning of the file and is usually renamed as <em
+class=file>assim_model_state_ud#</em> as input to the filter for the next
+assimilation cycle.
+</P>
+
+<P>The file <em class=file>wrf.info</em> contains the target dart time, the valid
+dart time, the valid date, the number of domains, and the command used to
+executed the WRF model. The file <em class=file>wrf.info</em> is created in the
+conversion from dart to WRF. In the conversion from WRF back to dart, the
+target time is read from the file <em class=file>wrf.info</em>, which should
+then be the valid time. This will be the time written to the dart vector
+file. The rest of the information in the file <em class=file>wrf.info</em> is
+only used by the program ensemble_init and by the script advance_model.csh.
+
+<!--==================================================================-->
+<!-- Cite references, if need be. -->
+<!--==================================================================-->
+
+<A NAME="References"></A>
+<BR><HR><BR>
+<H2>REFERENCES</H2>
+<UL>
+</UL>
+
+<!--==================================================================-->
+<!-- Describe all the error conditions and codes. -->
+<!-- Putting a <BR> after the synopsis creates a nice effect. -->
+<!--==================================================================-->
+
+<A NAME="Errors"></A>
+<HR>
+<H2>ERROR CODES and CONDITIONS</H2>
+<div class="errors">
+<TABLE border=1 cellspacing=1 cellpadding=10 width=100%>
+<TR><TH>Routine</TH><TH>Message</TH><TH>Comment</TH></TR>
+
+<TR><!-- routine --><TD VALIGN=top>dart_open_and_alloc, transfer_dart_wrf</TD>
+ <!-- message --><TD VALIGN=top>n_moist = is too large.</TD>
+ <!-- comment --><TD VALIGN=top>The maximum number of moist variables is
+ 7. In order, they are [qv, qc, qr, qi, qs, qg, qnice]</TD>
+</TR>
+<TR><!-- routine --><TD VALIGN=top>transfer_dart_wrf</TD>
+ <!-- message --><TD VALIGN=top>n_values differ in transfer</TD>
+ <!-- comment --><TD VALIGN=top>If you get to this point, there would an
+ inconsistency between subroutines dart_open_and_alloc and transfer_dart_wrf.</TD>
+</TR>
+<TR><!-- routine --><TD VALIGN=top>trans_2d</TD>
+ <!-- message --><TD VALIGN=top>nx, ny, not compatible</TD>
+ <!-- comment --><TD VALIGN=top>Dimensions nx, ny incompatible with incoming
+ array a2d.</TD>
+</TR>
+<TR><!-- routine --><TD VALIGN=top>trans_3d</TD>
+ <!-- message --><TD VALIGN=top>nx, ny, nz, not compatible</TD>
+ <!-- comment --><TD VALIGN=top>Dimensions nx, ny, nz incompatible with incoming
+ array a3d.</TD>
+</TR>
+
+</TABLE>
+</div>
+
+<!--==================================================================-->
@@ Diff output truncated at 40000 characters. @@
More information about the Dart-dev
mailing list