[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