[Dart-dev] [4841] DART/trunk/models/cam: New program that converts a cam initial file (caminput.nc) to
nancy at ucar.edu
nancy at ucar.edu
Mon Apr 4 15:13:21 MDT 2011
Revision: 4841
Author: thoar
Date: 2011-04-04 15:13:20 -0600 (Mon, 04 Apr 2011)
Log Message:
-----------
New program that converts a cam initial file (caminput.nc) to
a DART ics file and uses the time from the netCDF file
as opposed to some external source. The input and output
filenames for cam_to_dart.f90 are namelist controlled, so there
is a new namelist (cam_to_dart_nml) in input.nml. There is still
a model_mod:static_init_model() dependency on cam_phis.nc,
the name of which is now part of the model_nml namelist.
Modified Paths:
--------------
DART/trunk/models/cam/model_mod.f90
DART/trunk/models/cam/work/input.nml
Added Paths:
-----------
DART/trunk/models/cam/cam_to_dart.f90
DART/trunk/models/cam/work/mkmf_cam_to_dart
DART/trunk/models/cam/work/path_names_cam_to_dart
-------------- next part --------------
Added: DART/trunk/models/cam/cam_to_dart.f90
===================================================================
--- DART/trunk/models/cam/cam_to_dart.f90 (rev 0)
+++ DART/trunk/models/cam/cam_to_dart.f90 2011-04-04 21:13:20 UTC (rev 4841)
@@ -0,0 +1,95 @@
+! DART software - Copyright \xA9 2004 - 2010 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 cam_to_dart
+
+! <next few lines under version control, do not edit>
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+!----------------------------------------------------------------------
+! purpose: interface between CAM and DART
+!
+! method: Read CAM 'initial' file (netCDF format) for model state and time.
+! Reform fields into a DART state vector.
+! Write out state vector in "proprietary" format for DART
+!
+! author: Tim Hoar 4/4/2011
+!
+!----------------------------------------------------------------------
+
+use types_mod, only : r8
+use utilities_mod, only : initialize_utilities, finalize_utilities, do_output, &
+ check_namelist_read, find_namelist_in_file, nmlfileunit
+use model_mod, only : model_type, init_model_instance, end_model_instance, &
+ prog_var_to_vector, read_cam_init
+use assim_model_mod, only : static_init_assim_model, get_model_size, &
+ open_restart_write, awrite_state_restart, close_restart
+use time_manager_mod, only : time_type
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+
+!-----------------------------------------------------------------------
+! namelist parameters with default values.
+!-----------------------------------------------------------------------
+
+character (len = 128) :: cam_to_dart_input_file = 'caminput.nc'
+character (len = 128) :: cam_to_dart_output_file = 'temp_ud'
+
+namelist /cam_to_dart_nml/ cam_to_dart_input_file, cam_to_dart_output_file
+
+! allocatable storage to read in a native format for cam state
+real(r8), allocatable :: statevector(:)
+type(model_type) :: var
+type(time_type) :: model_time
+integer :: iunit, x_size, io
+
+call initialize_utilities('cam_to_dart')
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "cam_to_dart_nml", iunit)
+read(iunit, nml = cam_to_dart_nml, iostat = io)
+call check_namelist_read(iunit, io, "cam_to_dart_nml")
+
+! Record the namelist values
+if (do_output()) write(nmlfileunit, nml=cam_to_dart_nml)
+if (do_output()) write( * , nml=cam_to_dart_nml)
+
+! Static init assim model sets the output file format (binary/ascii)
+! and calls static_init_model
+call static_init_assim_model()
+
+! Allocate the local state vector
+x_size = get_model_size()
+allocate(statevector(x_size))
+
+! Allocate the instance of the cam model type for storage
+! I'll just point to the space I need, not;
+call init_model_instance(var)
+
+! Read the file cam state fragments into var;
+! transform fields into state vector for DART
+
+call read_cam_init(cam_to_dart_input_file, var, model_time)
+
+call prog_var_to_vector(var, statevector)
+call end_model_instance(var)
+
+! write out state vector in "proprietary" format
+iunit = open_restart_write(cam_to_dart_output_file)
+call awrite_state_restart(model_time, statevector, iunit)
+call close_restart(iunit)
+
+call finalize_utilities()
+
+end program cam_to_dart
Property changes on: DART/trunk/models/cam/cam_to_dart.f90
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Date Rev Author HeadURL Id
Added: svn:eol-style
+ native
Modified: DART/trunk/models/cam/model_mod.f90
===================================================================
--- DART/trunk/models/cam/model_mod.f90 2011-04-01 22:53:29 UTC (rev 4840)
+++ DART/trunk/models/cam/model_mod.f90 2011-04-04 21:13:20 UTC (rev 4841)
@@ -244,11 +244,10 @@
use types_mod, only : r8, MISSING_I, MISSING_R8, gravity_const => gravity
! add after verification against Hui's tests; gas_constant_v,gas_constant,ps0,PI,DEG2RAD
-use time_manager_mod, only : time_type, set_time, print_time, set_calendar_type, &
- THIRTY_DAY_MONTHS, JULIAN, GREGORIAN, NOLEAP, NO_CALENDAR
+use time_manager_mod, only : time_type, set_time, set_date, print_time, print_date, set_calendar_type
use utilities_mod, only : open_file, close_file, find_namelist_in_file, check_namelist_read, &
register_module, error_handler, file_exist, E_ERR, E_WARN, E_MSG, &
- logfileunit, nmlfileunit, do_output, nc_check
+ logfileunit, nmlfileunit, do_output, nc_check, get_unit
use mpi_utilities_mod, only : my_task_id, task_count
!-------------------------------------------------------------------------
@@ -526,7 +525,7 @@
! by numerical stability concerns for repeated restarting in leapfrog.
integer :: Time_step_seconds = 21600, Time_step_days = 0
-namelist /model_nml/ output_state_vector , model_version , model_config_file &
+namelist /model_nml/ output_state_vector , model_version , cam_phis, model_config_file &
,state_num_0d ,state_num_1d ,state_num_2d ,state_num_3d &
,state_names_0d ,state_names_1d ,state_names_2d ,state_names_3d &
, which_vert_1d ,which_vert_2d ,which_vert_3d &
@@ -556,8 +555,8 @@
data ens_member /0/
logical :: do_out
-! common error string used by many subroutines
-character(len=129) :: errstring
+! common message string used by many subroutines
+character(len=129) :: msgstring
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
integer :: nflds ! # fields to read
@@ -657,17 +656,15 @@
! name netcdf file.
integer :: iunit, io, topog_lons, topog_lats, i, num_lons, num_lats, ncfileid
-! calendar types listed in time_manager_mod.f90
-integer :: calendar_type = GREGORIAN
integer :: max_levs
-
! Register the module
call register_module(source, revision, revdate)
! setting calendar type
+! calendar types listed in time_manager_mod.f90
! this information is NOT passed to CAM; it must be set in the CAM namelist
-call set_calendar_type(calendar_type)
+call set_calendar_type('GREGORIAN')
! Read the namelist entry
call find_namelist_in_file("input.nml", "model_nml", iunit)
@@ -677,14 +674,14 @@
! set the printed output logical variable to reduce printed output;
! depends on whether this is being called by trans_... (read ens member # from file 'element' )
! or by filter (multiple processes, printout controlled by do_output())
+
if (file_exist('element')) then
-! debug; fix this ugliness
- open(unit = 99, file='element', form = 'formatted')
- read(99,*) ens_member
- close(99)
+ iunit = get_unit()
+ open(unit = iunit, file='element', form = 'formatted')
+ read(iunit,*) ens_member
+ close(iunit)
do_out = .false.
if (ens_member == 1) do_out = .true.
- !write(*,*) 'do_out = ',do_out
else
do_out = do_output()
!write(*,*) 'do_out = ',do_out
@@ -786,20 +783,20 @@
if (do_out) write(*, *) 'file_name for surface geopotential height is ', trim(cam_phis)
call read_topog_size(ncfileid, topog_lons, topog_lats)
- ! debug
+
if (do_out) write(*,*) 'topog_lons, _lats = ',topog_lons, topog_lats
num_lons = dim_sizes(find_name('lon ',dim_names))
num_lats = dim_sizes(find_name('lat ',dim_names))
if (topog_lons /= num_lons .or. topog_lats /= num_lats) then
- write(errstring,'(A,4I4)') 'horizontal dimensions mismatch of initial files and topog ' &
+ write(msgstring,'(A,4I4)') 'horizontal dimensions mismatch of initial files and topog ' &
,num_lons, topog_lons, num_lats, topog_lats
- call error_handler(E_ERR, 'static_init_model', trim(errstring), source, revision, revdate)
+ call error_handler(E_ERR, 'static_init_model', trim(msgstring), source, revision, revdate)
end if
else
- write(errstring,'(2A)') trim(cam_phis),' is missing; find a CAM history file (h0) to provide PHIS'
- call error_handler(E_ERR, 'static_init_model', trim(errstring), source, revision, revdate)
+ write(msgstring,'(2A)') trim(cam_phis),' is missing; find a CAM history file (h0) to provide PHIS'
+ call error_handler(E_ERR, 'static_init_model', trim(msgstring), source, revision, revdate)
end if
! Read surface geopotential from cam_phis for use in vertical interpolation in height.
@@ -1106,8 +1103,8 @@
end do Alldim1
if ( s_dim_1d(i) == 0 ) then
- write(errstring, '(A,I3,A)') ' state 1d dimension(',i,') was not assigned and = 0'
- call error_handler(E_ERR, 'trans_coord',trim(errstring), source, revision, revdate)
+ write(msgstring, '(A,I3,A)') ' state 1d dimension(',i,') was not assigned and = 0'
+ call error_handler(E_ERR, 'trans_coord',trim(msgstring), source, revision, revdate)
end if
end do
@@ -1481,8 +1478,8 @@
end do
if (nfld .ne. nflds) then
- write(errstring, *) 'nfld = ',nfld,', nflds = ',nflds,' must be equal '
- call error_handler(E_ERR, 'order_state_fields', errstring, source, revision, revdate)
+ write(msgstring, *) 'nfld = ',nfld,', nflds = ',nflds,' must be equal '
+ call error_handler(E_ERR, 'order_state_fields', msgstring, source, revision, revdate)
elseif (do_out) then
write(logfileunit,'(/A/)') 'State vector is composed of '
! write(logfileunit,'((8(A8,1X)))') (cflds(i),i=1,nflds)
@@ -1588,19 +1585,23 @@
! Module I/O to/from DART and files
- subroutine read_cam_init(file_name, var)
+ subroutine read_cam_init(file_name, var, model_time)
!=======================================================================
-! subroutine read_cam_init(file_name, var)
+! subroutine read_cam_init(file_name, var, model_time)
!
-character(len = *), intent(in) :: file_name
-type(model_type), intent(out) :: var
+character(len = *), intent(in) :: file_name
+type(model_type), intent(out) :: var
+type(time_type), optional, intent(out) :: model_time
! Local workspace
integer :: i, k, n, m, ifld ! grid and constituent indices
-integer :: ncfileid, ncfldid
+integer :: ncfileid, ncfldid, dimid, varid, dimlen
real(r8), allocatable :: temp_3d(:,:,:), temp_2d(:,:)
+integer :: iyear, imonth, iday, ihour, imin, isec, rem
+integer, allocatable, dimension(:) :: datetmp, datesec
+
!----------------------------------------------------------------------
! read CAM 'initial' file domain info
call nc_check(nf90_open(path = trim(file_name), mode = nf90_write, ncid = ncfileid), &
@@ -1720,6 +1721,58 @@
end if
end do
+! Read the time of the current state.
+! All the caminput.nc files I have seen have two variables of
+! length 'time' (the unlimited dimension): date, datesec
+! The rest of the routine presumes there is but one time in the file -
+! print warning message if this is not the case.
+
+if (present( model_time)) then
+
+ call nc_check(nf90_inq_dimid(ncfileid, 'time', dimid), &
+ 'read_cam_init', 'inq_dimid time '//trim(file_name))
+ call nc_check(nf90_inquire_dimension(ncfileid, dimid, len=dimlen), &
+ 'read_cam_init', 'inquire_dimension time '//trim(file_name))
+
+ if (dimlen /= 1) then
+ write(msgstring,*)'UNUSUAL - ',trim(file_name),' has',dimlen,'times. Expected 1.'
+ call error_handler(E_MSG, 'read_cam_init', msgstring, source, revision, revdate)
+ endif
+
+ allocate(datetmp(dimlen), datesec(dimlen))
+
+ call nc_check(nf90_inq_varid(ncfileid, 'date', varid), &
+ 'read_cam_init', 'inq_varid date '//trim(file_name))
+ call nc_check(nf90_get_var(ncfileid, varid, values=datetmp), &
+ 'read_cam_init', 'get_var date '//trim(file_name))
+
+ call nc_check(nf90_inq_varid(ncfileid, 'datesec', varid), &
+ 'read_cam_init', 'inq_varid datesec '//trim(file_name))
+ call nc_check(nf90_get_var(ncfileid, varid, values=datesec), &
+ 'read_cam_init', 'get_var datesec '//trim(file_name))
+
+ ! The 'date' is YYYYMMDD ... datesec is 'current seconds of current day'
+ iyear = datetmp(dimlen) / 10000
+ rem = datetmp(dimlen) - iyear*10000
+ imonth = rem / 100
+ iday = rem - imonth*100
+
+ ihour = datesec(dimlen) / 3600
+ rem = datesec(dimlen) - ihour*3600
+ imin = rem / 60
+ isec = rem - imin*60
+
+ model_time = set_date(iyear,imonth,iday,ihour,imin,isec)
+
+ if (do_out) then
+ call print_date(model_time,'read_cam_init:CAM input date')
+ call print_time(model_time,'read_cam_init:CAM input time')
+ endif
+
+ deallocate(datetmp, datesec)
+
+endif
+
call nc_check(nf90_close(ncfileid), 'read_cam_init', 'closing '//trim(file_name))
deallocate (temp_3d,temp_2d)
@@ -2047,9 +2100,9 @@
! This will malfunction for fields that are filled with MISSING_r8 for lat_val or lon_val.
if (lon_val == MISSING_r8 .or. lat_val == MISSING_r8 ) then
- write(errstring, *) 'Field ',cflds(nfld),' has no lon or lat dimension. ', &
+ write(msgstring, *) 'Field ',cflds(nfld),' has no lon or lat dimension. ', &
'What should be specified for it in the call to location?'
- call error_handler(E_ERR, 'get_state_meta_data', errstring, source, revision, revdate)
+ call error_handler(E_ERR, 'get_state_meta_data', msgstring, source, revision, revdate)
else
location = set_location(lon_val, lat_val, lev_val, which_vert)
endif
@@ -2152,10 +2205,10 @@
! More dimensions, variables and attributes will be added in this routine.
!-------------------------------------------------------------------------------
-write(errstring,*) 'ncFileID', ncFileID
+write(msgstring,*) 'ncFileID', ncFileID
call nc_check(nf90_Inquire(ncFileID, nDimensions, nVariables, nAttributes, unlimitedDimID), &
- 'nc_write_model_atts', 'Inquire '//trim(errstring))
-call nc_check(nf90_Redef(ncFileID), 'nc_write_model_atts', 'Redef '//trim(errstring))
+ 'nc_write_model_atts', 'Inquire '//trim(msgstring))
+call nc_check(nf90_Redef(ncFileID), 'nc_write_model_atts', 'Redef '//trim(msgstring))
!-------------------------------------------------------------------------------
! We need the dimension ID for the number of copies
@@ -2167,8 +2220,8 @@
'nc_write_model_atts', 'inq_dimid time')
if ( TimeDimID /= unlimitedDimId ) then
- write(errstring,*)'Time dimension ID ',TimeDimID,'must match Unlimited Dimension ID ',unlimitedDimId
- call error_handler(E_ERR,'nc_write_model_atts', errstring, source, revision, revdate)
+ write(msgstring,*)'Time dimension ID ',TimeDimID,'must match Unlimited Dimension ID ',unlimitedDimId
+ call error_handler(E_ERR,'nc_write_model_atts', msgstring, source, revision, revdate)
end if
!-------------------------------------------------------------------------------
@@ -3070,8 +3123,8 @@
! if (abs((val - pressure)/val) > 1.0E-12) then
! ! We're looking for a pressure on a model level, which is exactly what p_col provides,
!! NOT HERE; that happens in get_val_level
-! write(errstring, *) 'val /= pressure = ',val,pressure,' when val is a P obs '
-! call error_handler(E_WARN, 'get_val_pressure', errstring, source, revision, revdate)
+! write(msgstring, *) 'val /= pressure = ',val,pressure,' when val is a P obs '
+! call error_handler(E_WARN, 'get_val_pressure', msgstring, source, revision, revdate)
! end if
else
! Pobs end
@@ -3326,9 +3379,9 @@
do nf= 1, state_num_3d
! if (do_out) then
-! write(errstring, '(A,4I5)') 'fld, nlons, nlats, nlevs ',nf &
+! write(msgstring, '(A,4I5)') 'fld, nlons, nlats, nlevs ',nf &
! ,s_dim_3d(2,nf),s_dim_3d(3,nf),s_dim_3d(1,nf)
-! call error_handler(E_MSG, 'prog_var_to_vector', errstring, source, revision, revdate)
+! call error_handler(E_MSG, 'prog_var_to_vector', msgstring, source, revision, revdate)
! endif
do i=1,s_dim_3d(3,nf) !lats
@@ -3343,8 +3396,8 @@
! Temporary check
if (indx /= model_size) then
- write(errstring, *) 'indx ',indx,' model_size ',model_size,' must be equal '
- call error_handler(E_ERR, 'prog_var_to_vector', errstring, source, revision, revdate)
+ write(msgstring, *) 'indx ',indx,' model_size ',model_size,' must be equal '
+ call error_handler(E_ERR, 'prog_var_to_vector', msgstring, source, revision, revdate)
end if
end subroutine prog_var_to_vector
@@ -3392,9 +3445,9 @@
! 3D fields; see comments in prog_var_to_vect
do nf = 1, state_num_3d
! if (do_out) then
-! write(errstring, '(A,4I5)') 'fld, nlons, nlats, nlevs ',nf &
+! write(msgstring, '(A,4I5)') 'fld, nlons, nlats, nlevs ',nf &
! ,s_dim_3d(2,nf),s_dim_3d(3,nf),s_dim_3d(1,nf)
-! call error_handler(E_MSG, 'vector_to_prog_var', errstring, source, revision, revdate)
+! call error_handler(E_MSG, 'vector_to_prog_var', msgstring, source, revision, revdate)
! end if
do i = 1, s_dim_3d(3,nf)
do j = 1, s_dim_3d(2,nf)
@@ -3408,8 +3461,8 @@
! Temporary check
if (indx /= model_size) then
- write(errstring, *) 'indx ',indx,' model_size ',model_size,' must be equal '
- call error_handler(E_ERR, 'vector_to_prog_var', errstring, source, revision, revdate)
+ write(msgstring, *) 'indx ',indx,' model_size ',model_size,' must be equal '
+ call error_handler(E_ERR, 'vector_to_prog_var', msgstring, source, revision, revdate)
end if
end subroutine vector_to_prog_var
@@ -3599,9 +3652,9 @@
! proceed
else
! make this a fatal error - there should be no other options for vert.
- write(errstring,'(''obs at '',3(F9.5,1x),I2,'' has bad vertical type'')') &
+ write(msgstring,'(''obs at '',3(F9.5,1x),I2,'' has bad vertical type'')') &
old_array, old_which
- call error_handler(E_ERR, 'convert_vert', errstring,source,revision,revdate)
+ call error_handler(E_ERR, 'convert_vert', msgstring,source,revision,revdate)
end if
! Find the nfld of this dart-KIND
@@ -3785,26 +3838,26 @@
if (top_lev == 1 .and. old_array(3) > model_h(1)) then
! above top of model
frac = 1.0_r8
- write(errstring, *) 'ob height ',old_array(3),' above CAM levels at ' &
+ write(msgstring, *) 'ob height ',old_array(3),' above CAM levels at ' &
,old_array(1) ,old_array(2) ,' for ob type',dart_kind
- call error_handler(E_MSG, 'convert_vert', errstring,source,revision,revdate)
+ call error_handler(E_MSG, 'convert_vert', msgstring,source,revision,revdate)
else if (bot_lev <= num_levs) then
! within model levels
frac = (old_array(3) - model_h(bot_lev)) / (model_h(top_lev) - model_h(bot_lev))
else
! below bottom of model
frac = 0.0_r8
- write(errstring, *) 'ob height ',old_array(3),' below CAM levels at ' &
+ write(msgstring, *) 'ob height ',old_array(3),' below CAM levels at ' &
,old_array(1) ,old_array(2) ,' for ob type',dart_kind
- call error_handler(E_MSG, 'convert_vert', errstring,source,revision,revdate)
+ call error_handler(E_MSG, 'convert_vert', msgstring,source,revision,revdate)
endif
new_array(3) = (1.0_r8 - frac) * p_col(bot_lev) + frac * p_col(top_lev)
new_which = 2
else
- write(errstring, *) 'model which_vert = ',old_which,' not handled in convert_vert '
- call error_handler(E_ERR, 'convert_vert', errstring,source,revision,revdate)
+ write(msgstring, *) 'model which_vert = ',old_which,' not handled in convert_vert '
+ call error_handler(E_ERR, 'convert_vert', msgstring,source,revision,revdate)
end if
return
@@ -4204,8 +4257,8 @@
resol = ilev%resolution
else
! should not happen; fatal error.
- write(errstring, *) 'unexpected dim_name, ', trim(dim_name)
- call error_handler(E_ERR, 'coord_index', errstring,source,revision,revdate)
+ write(msgstring, *) 'unexpected dim_name, ', trim(dim_name)
+ call error_handler(E_ERR, 'coord_index', msgstring,source,revision,revdate)
end if
! further check? for blunders check that coord(1) - val is smaller than coord(2) - coord(1), etc.
Modified: DART/trunk/models/cam/work/input.nml
===================================================================
--- DART/trunk/models/cam/work/input.nml 2011-04-01 22:53:29 UTC (rev 4840)
+++ DART/trunk/models/cam/work/input.nml 2011-04-04 21:13:20 UTC (rev 4841)
@@ -81,21 +81,28 @@
&assim_model_nml
write_binary_restart_files = .true.,
netCDF_large_file_support = .false.
- /
+ /
+&cam_to_dart_nml
+ /
+
+
# also a common setup:
-# model_version = '3.5.06',
-# state_names_3d = 'T','US','VS','Q','CLDLIQ','CLDICE'
+# model_version = '3.5.06',
+# model_version = '4.0.1',
+# state_names_3d = 'T','US','VS','Q','CLDLIQ','CLDICE'
+# model_version = '3.1',
+# state_names_3d = 'T','U','V','Q','CLDLIQ','CLDICE'
&model_nml
output_state_vector = .false.,
- model_version = '3.1',
+ model_version = '4.0.1',
model_config_file = 'caminput.nc',
state_num_0d = 0,
state_num_1d = 0,
state_num_2d = 1,
state_num_3d = 6,
state_names_2d = 'PS'
- state_names_3d = 'T','U','V','Q','CLDLIQ','CLDICE'
+ state_names_3d = 'T','US','VS','Q','CLDLIQ','CLDICE'
which_vert_1d = 0,
which_vert_2d = -1,
which_vert_3d = 6*1,
@@ -134,8 +141,6 @@
input_obs_def_mod_file = '../../../obs_def/DEFAULT_obs_def_mod.F90',
output_obs_def_mod_file = '../../../obs_def/obs_def_mod.f90',
input_files = '../../../obs_def/obs_def_gps_mod.f90',
- '../../../obs_def/obs_def_QuikSCAT_mod.f90',
- '../../../obs_def/obs_def_GWD_mod.f90',
'../../../obs_def/obs_def_altimeter_mod.f90',
'../../../obs_def/obs_def_reanalysis_bufr_mod.f90'
/
Added: DART/trunk/models/cam/work/mkmf_cam_to_dart
===================================================================
--- DART/trunk/models/cam/work/mkmf_cam_to_dart (rev 0)
+++ DART/trunk/models/cam/work/mkmf_cam_to_dart 2011-04-04 21:13:20 UTC (rev 4841)
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# DART software - Copyright \xA9 2004 - 2010 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
+#
+# $Id$
+
+../../../mkmf/mkmf -p cam_to_dart -t ../../../mkmf/mkmf.template -c "-Duse_netCDF" \
+ -a "../../.." path_names_cam_to_dart
+
+exit $status
+
+# <next few lines under version control, do not edit>
+# $URL$
+# $Revision$
+# $Date$
+
Property changes on: DART/trunk/models/cam/work/mkmf_cam_to_dart
___________________________________________________________________
Added: svn:executable
+ *
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Date Rev Author HeadURL Id
Added: svn:eol-style
+ native
Added: DART/trunk/models/cam/work/path_names_cam_to_dart
===================================================================
--- DART/trunk/models/cam/work/path_names_cam_to_dart (rev 0)
+++ DART/trunk/models/cam/work/path_names_cam_to_dart 2011-04-04 21:13:20 UTC (rev 4841)
@@ -0,0 +1,11 @@
+assim_model/assim_model_mod.f90
+common/types_mod.f90
+location/threed_sphere/location_mod.f90
+models/cam/cam_to_dart.f90
+models/cam/model_mod.f90
+mpi_utilities/null_mpi_utilities_mod.f90
+obs_kind/obs_kind_mod.f90
+random_nr/random_nr_mod.f90
+random_seq/random_seq_mod.f90
+time_manager/time_manager_mod.f90
+utilities/utilities_mod.f90
More information about the Dart-dev
mailing list