[Dart-dev] [4323] DART/trunk/models/rose: Methodological cleanup.

nancy at ucar.edu nancy at ucar.edu
Mon Mar 22 22:43:20 MDT 2010


Revision: 4323
Author:   thoar
Date:     2010-03-22 22:43:20 -0600 (Mon, 22 Mar 2010)
Log Message:
-----------
Methodological cleanup.
1) use get_model_size from model_mod.f90 (not assim_model_mod - simpler)
2) removed need for 'trans_time' and 'nmbld' programs by incorporating
   these functions into dart_to_model. This required a new routine
   model_mod:update_ROSE_namelist and the valid_time of the model state
   is now part of the model_type declaration. The rose namelist now 
   only exists in model_mod.f90. 
3) removed need for 'trans_perfect_ics' as it is exactly the same as
   model_to_dart.f90 except for a different output filename.
4) the new model_mod:*_ROSE_restart routines are believed to be working.
5) the advance_model.csh script reflects the simpler time management and
   rose.nml namelist (written by dart_to_model).
6) the run_perfect_model_obs.csh script reflects the fact that model_to_dart
   can do what trans_perfect_ics used to do.

After I chat with Tomoko, I will delete the superfluous routines.
 

Modified Paths:
--------------
    DART/trunk/models/rose/README
    DART/trunk/models/rose/dart_to_model.f90
    DART/trunk/models/rose/model_mod.f90
    DART/trunk/models/rose/model_to_dart.f90
    DART/trunk/models/rose/shell_scripts/advance_model.csh
    DART/trunk/models/rose/shell_scripts/run_perfect_model_obs.csh

-------------- next part --------------
Modified: DART/trunk/models/rose/README
===================================================================
--- DART/trunk/models/rose/README	2010-03-18 19:14:11 UTC (rev 4322)
+++ DART/trunk/models/rose/README	2010-03-23 04:43:20 UTC (rev 4323)
@@ -15,3 +15,9 @@
 does not contain the rose source code ...
 
 Tim Hoar 9 April 2007
+
+
+Mon Mar 22 17:23:20 MDT 2010 : the rose project has been subtantially streamlined.
+There is no need for the trans_time and build_nml routines. dart_to_model  has
+assumed those responsibilities.
+

Modified: DART/trunk/models/rose/dart_to_model.f90
===================================================================
--- DART/trunk/models/rose/dart_to_model.f90	2010-03-18 19:14:11 UTC (rev 4322)
+++ DART/trunk/models/rose/dart_to_model.f90	2010-03-23 04:43:20 UTC (rev 4323)
@@ -16,19 +16,25 @@
 ! method: Read DART state vector ("proprietary" format)
 !         Reform state vector back into ROSE fields.
 !         Replace those fields on the ROSE restart file with the new values,
-!         preserving all other information on the file.
+!         Replace the 'mtime' variable in the ROSE restart file with
+!         the 'valid time' of the DART state vector.
+!         Write a new 'ROSE_NML' namelist in file 'rose.nml'.
 !
-!         based on prog_var_to_vector and vector_to_prog_var for CAM
-!
+!         Compiler note: Rather curiously, the PG compiler reads 
+!         a namelist called 'rose_nml' and then, when writing the
+!         namelist - uses uppercase 'ROSE_NML'. Then, the next time
+!         you need to read the 'rose_nml' ... it fails! So - we 
+!         adopted the uppercase convention from the get-go. TJH
 !----------------------------------------------------------------------
 
-use       types_mod, only : r8
-use   utilities_mod, only : get_unit, initialize_utilities
-use       model_mod, only : model_type, init_model_instance, &
-                            vector_to_prog_var, update_ROSE_restart 
-use assim_model_mod, only : assim_model_type, static_init_assim_model, &
-                            init_assim_model, get_model_size, get_model_state_vector, &
-                            read_state_restart, open_restart_read, close_restart
+use        types_mod, only : r8
+use    utilities_mod, only : get_unit, initialize_utilities, E_ERR, &
+                             error_handler, timestamp
+use        model_mod, only : model_type, get_model_size, init_model_instance, &
+                             vector_to_prog_var, update_ROSE_restart, &
+                             update_ROSE_namelist, static_init_model
+use  assim_model_mod, only : assim_model_type, aread_state_restart, &
+                             open_restart_read, close_restart
 use time_manager_mod, only : time_type, read_time
 
 implicit none
@@ -39,47 +45,53 @@
    revision = "$Revision$", &
    revdate  = "$Date$"
 
-type(assim_model_type) :: x
 type(model_type)       :: var
-type(time_type)        :: adv_to_time
+type(time_type)        :: model_time, adv_to_time
 real(r8), allocatable  :: x_state(:)
-integer                :: file_unit, x_size
+integer                :: file_unit, x_size, ens_member, io
 character (len = 128)  :: file_name = 'rose_restart.nc', file_in = 'temp_ic'
 
+!----------------------------------------------------------------------
+! This program has one input argument that is read from STDIN ... 
+!----------------------------------------------------------------------
+
+read(*, *, iostat = io )  ens_member
+if (io /= 0 )then
+   call error_handler(E_ERR,'dart_to_model:','cannot read ens_member from STDIN', &
+         source,revision,revdate)
+endif
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+
 call initialize_utilities(progname='dart_to_model', output_flag=.true.)
 
-! Static init assim model calls static_init_model
-PRINT*,'static_init_assim_model in dart_to_model'
+call static_init_model()        ! reads input.nml, etc., sets the table 
+x_size = get_model_size()       ! now that we know how big state vector is ...
+allocate(x_state(x_size))       ! allocate space for the (empty) state vector
 
-call static_init_assim_model()
-call init_assim_model(x)
+! Open the DART model state ... 
+! Read in the time to which ROSE must advance.  
+! Read in the valid time for the model state
+! Read in state vector from DART
 
-! Allocate the instance of the rose model type for storage
-call init_model_instance(var)
-
 file_unit = open_restart_read(file_in)
-PRINT*,'In dart_to_model file_in unit  = ',file_unit
-PRINT*,' '
 
-! Read in time to which ROSE must advance.  
-! Neither this, nor time in x (x%time) is used in this program
-! read in state vector from DART
-call read_state_restart(x, file_unit, adv_to_time)
+call aread_state_restart(model_time, x_state, file_unit, adv_to_time)
 call close_restart(file_unit)
 
-! Get the state part of the assim_model type x
-x_size = get_model_size()
-allocate(x_state(x_size))
-PRINT*,'(dart_to_model) getting model state vector of length ',x_size
-x_state = get_model_state_vector(x)
+! Parse the vector into ROSE fields (prognostic variables)
+call init_model_instance(var, model_time)
+call vector_to_prog_var(x_state, var)
+deallocate(x_state)
 
-! decompose vector back into ROSE fields
-PRINT*,'(dart_to_model) converting vector to prog_var'
-call vector_to_prog_var (x_state, var)
-deallocate (x_state)
-
 ! write fields to the binary ROSE restart file
-PRINT*,'(dart_to_model) updating ',trim(file_name)
 call update_ROSE_restart(file_name, var)
+call update_ROSE_namelist('rose.nml', model_time, adv_to_time, ens_member)
 
+!----------------------------------------------------------------------
+! When called with 'end', timestamp will also call finalize_utilities()
+!----------------------------------------------------------------------
+call timestamp(string1=source, pos='end')
+
 end program dart_to_model

Modified: DART/trunk/models/rose/model_mod.f90
===================================================================
--- DART/trunk/models/rose/model_mod.f90	2010-03-18 19:14:11 UTC (rev 4322)
+++ DART/trunk/models/rose/model_mod.f90	2010-03-23 04:43:20 UTC (rev 4323)
@@ -17,8 +17,11 @@
 !-----------------------------------------------------------------------
 
 ! DART Modules 
-use        types_mod, only : r8, pi
-use time_manager_mod, only : time_type,set_time,print_time
+use        types_mod, only : r8, digits12, pi
+use time_manager_mod, only : time_type, set_time, print_time, get_time, &
+                             operator(<), operator(>), operator(+), &
+                             operator(-), operator(/), operator(*), &
+                             operator(==), operator(/=), set_time_missing
 use     location_mod, only : location_type, get_close_maxdist_init, &
                              get_close_obs_init, get_close_obs, &
                              set_location, get_location, query_location, &
@@ -64,6 +67,7 @@
           vector_to_prog_var, &
           read_ROSE_restart, &
           update_ROSE_restart, &
+          update_ROSE_namelist, &
           read_ROSE_tref,&
           init_model_instance, &
           end_model_instance
@@ -72,6 +76,7 @@
 
 type model_type
   real(r8), pointer :: vars_3d(:,:,:,:)
+  type(time_type)   :: valid_time
 end type model_type
 
 integer, parameter :: TYPE_local_U0 = 0, &
@@ -104,16 +109,16 @@
 integer :: state_num_3d = 6             ! # of 3d fields to read from file
 namelist /model_nml/ state_num_3d
 
-logical :: output_prog_diag = .false.                          !NOT USED
-character (len=50) :: input_dir = '../input_current/'          !NOT USED
-character (len=50) :: out_dir   = '/ptmp/tmatsuo/rose/'        !NOT USED
-character (len=30) :: restart_file = 'dyn_restart_001-1999.nc' !NOT USED
-real(kind=r8) :: amp_tune = 1.                                 !NOT USED  
-real(kind=r8) :: pha_tune = 0.                                 !NOT USED
-real(kind=r8) :: target_time = 0.125 ! [hr]                    !NOT USED
-integer       :: ens_element = 1                               !NOT USED
+logical :: output_prog_diag = .false.
+character(len=128)   :: input_dir = '../input_current/'
+character(len=50)   :: out_dir   = '/ptmp/tmatsuo/rose/'
+character(len=30)   :: restart_file = 'dyn_restart_001-1999.nc'
+real(kind=r8)       :: amp_tune = 1.
+real(kind=r8)       :: pha_tune = 0.
+real(kind=digits12) :: target_time = 0.125 ! [hr] 
+integer             :: ens_element = 1
 
-namelist /rose_nml/ target_time, &
+namelist /ROSE_NML/ target_time, &
                     input_dir, out_dir, restart_file,&
                     output_prog_diag, &
                     amp_tune, pha_tune, &
@@ -154,13 +159,13 @@
 real(r8) :: z_m
 real(r8) :: dz = 2100.0_r8, zbot = 16800.0_r8
 
-! Read the namelist rose_nml from the file rose.nml
-call find_namelist_in_file("rose.nml", "rose_nml", iunit)
-read(iunit, nml = rose_nml, iostat = io)
-call check_namelist_read(iunit, io, "rose_nml")
+! Read the namelist ROSE_NML from the file rose.nml
+call find_namelist_in_file("rose.nml", "ROSE_NML", iunit)
+read(iunit, nml = ROSE_NML, iostat = io)
+call check_namelist_read(iunit, io, "ROSE_NML")
 
-if (do_nml_file()) write(nmlfileunit, nml=rose_nml)
-if (do_nml_term()) write(     *     , nml=rose_nml)
+if (do_nml_file()) write(nmlfileunit, nml=ROSE_NML)
+if (do_nml_term()) write(     *     , nml=ROSE_NML)
 
 ! Read the namelist entry for model_mod from file input.nml
 call find_namelist_in_file("input.nml", "model_nml", iunit)
@@ -185,7 +190,7 @@
 endif
 Time_step_ROSE = set_time(Time_step_seconds, Time_step_days)
 
-call print_time(Time_step_ROSE)
+if (do_output()) call print_time(Time_step_ROSE,'ROSE time step')
 
 ! lon: long_name = "geographic longitude", units = "degrees" ;
 d_lon = 360.0_r8/real(nx)
@@ -895,9 +900,9 @@
 ! call nc_check(nf90_put_var( ncFileID,  qnOVarId, var%vars_3d(:,:,:, 9), &
 !            start=(/ 1, 1, 1, copyindex, timeindex /) ),'nc_write_model_vars','put_var qnH')
 
-write (*,*)'Finished filling variables ...'
+if (do_output()) write (*,*)'Finished filling variables ...'
 call nc_check(nf90_sync(ncFileID),'nc_write_model_vars','sync')
-write (*,*)'netCDF file is synched ...'
+if (do_output()) write (*,*)'netCDF file is synched ...'
 
 call end_model_instance(Var)   ! should avoid any memory leaking
 
@@ -1030,13 +1035,14 @@
 
 
 
-subroutine init_model_instance(var)
+subroutine init_model_instance(var, valid_time)
 !=======================================================================
 ! subroutine init_model_instance(var)
 !
 ! Initializes an instance of a ROSE model state variable
 
-type(model_type), intent(out) :: var
+type(model_type),          intent(out) :: var
+type(time_type), optional, intent( in) :: valid_time
 
 if ( .not. module_initialized ) call static_init_model
 
@@ -1047,6 +1053,12 @@
 
 allocate(var%vars_3d(nz, nx, ny, state_num_3d))
 
+if (present(valid_time)) then
+   var%valid_time = valid_time
+else
+   var%valid_time = set_time_missing()
+endif
+
 end subroutine init_model_instance
 
 
@@ -1070,7 +1082,6 @@
 subroutine update_ROSE_restart(file_name, var)
 !=======================================================================
 ! update ROSE restart file fields
-!
 
   character (len = *), intent(in) :: file_name
   type(model_type),    intent(in) :: var
@@ -1085,6 +1096,8 @@
   integer :: idd
   integer :: ncerr,  nlons, nlats, nlevs
   integer :: var_id 
+  integer, dimension(3) :: mtime
+  integer :: seconds, days
 
 !====================================================================
 
@@ -1095,11 +1108,10 @@
   call error_handler(E_ERR,'update_ROSE_restart',msgstring,source,revision,revdate)
 endif
 
-!! error_handler !!!!!!!   
-   print *, 'update_ROSE_restart: reading restart'
-   ncerr = nf90_open( file_name, NF90_WRITE, restart_id )
-   print *, 'update_ROSE_restart: opening with'//trim(nf90_strerror(ncerr))
-!!!!!!!!!!!!!!!!!!!!!!!!
+if (do_output()) print *, 'update_ROSE_restart: reading restart'
+ncerr = nf90_open( file_name, NF90_WRITE, restart_id )
+call nc_check(ncerr, 'update_ROSE_restart','open')  ! will die if error
+if (do_output()) print *, 'update_ROSE_restart: opened with '//trim(nf90_strerror(ncerr))
 
 !... check for matching dimensions
 
@@ -1136,6 +1148,8 @@
 ! unpack the variables into something familiar and then stuff them
 ! into the existing netCDF variables. 
 
+  call get_time(var%valid_time, seconds, days)
+
   un1 = var%vars_3d(:,:,:, 1)
   vn1 = var%vars_3d(:,:,:, 2)
   tn1 = var%vars_3d(:,:,:, 3)
@@ -1176,6 +1190,23 @@
   call nc_check(  nf90_put_var(restart_id, var_id, values=tn0), &
          'update_rose_restart', 'put_var tn0')
 
+  ! FIXME - since we're not handling the year correctly in rose,
+  ! we need to capture the existing one and reuse it.
+
+  call nc_check(  nf90_inq_varid(restart_id, 'mtime', var_id), &
+            'update_rose_restart','inq_varid mtime')
+  call nc_check(nf90_get_var( restart_id, var_id, mtime) , &
+                     'update_rose_restart','get_var mtime')
+
+!  mtime(1) = cal_year  FIXME ... this is that I'm talking about
+   mtime(2) = days
+   mtime(3) = seconds
+
+  call nc_check(nf90_put_var( restart_id, var_id, mtime) , &
+                     'update_rose_restart','get_var mtime')
+
+if (do_output()) print *, 'update_ROSE_restart: mtime (year/doy/seconds):', mtime
+
   call nc_check( nf90_sync( restart_id), 'update_rose_restart', 'sync')
   call nc_check( nf90_close(restart_id), 'update_rose_restart', 'close')
 
@@ -1214,13 +1245,10 @@
    call error_handler(E_ERR,'read_ROSE_restart',msgstring,source,revision,revdate)
 endif
 
-!! error_handler !!!!!!!   
-   print *, 'read_ROSE_restart:reading restart:', file_name
-   ncerr = nf90_open( file_name, NF90_NOWRITE, restart_id )
-   call nc_check(ncerr, 'read_ROSE_restart', 'open')
-   print *, 'read_ROSE_restart:opening with '//trim(nf90_strerror(ncerr))
-   print *, 'read_ROSE_restart:restart_id is ', restart_id
-!!!!!!!!!!!!!!!!!!!!!!!!
+if (do_output()) print *, 'read_ROSE_restart:reading restart:', file_name
+ncerr = nf90_open( file_name, NF90_NOWRITE, restart_id )
+call nc_check(ncerr, 'read_ROSE_restart', 'open')
+if (do_output()) print *, 'read_ROSE_restart:opened with '//trim(nf90_strerror(ncerr))
 
 !... check for matching dimensions
 
@@ -1313,7 +1341,7 @@
 
    call nc_check(nf90_close( restart_id),'read_rose_restart','close')
 
-   print *, 'restart mtime:', mtime
+   if (do_output()) print *, 'read_ROSE_restart: mtime (year/doy/seconds):', mtime
    cal_year = mtime(1)
    doy      = mtime(2)
    utsec    = mtime(3)
@@ -1330,14 +1358,55 @@
    !var%vars_3d(:,:,:,8) = qn1(:,:,:,8)  ! OH
    !var%vars_3d(:,:,:,9) = qn1(:,:,:,18) ! O
 
-   print*, "read_ROSE_restart: BEFORE model_time: utsec = ", utsec," doy = ", doy
+   ! FIXME ... this ignores years - no calendar
    model_time = set_time(utsec, doy)
-   print*, "read_ROSE_restart: AFTER model_time :"
-   call print_time(model_time)
 
+   var%valid_time = model_time
+
+   if (do_output()) call print_time(model_time, str=" read_ROSE_restart: model_time ")
+
 end subroutine read_ROSE_restart
 
 
+subroutine update_ROSE_namelist(file_name, time1, timeN, ens_member, &
+       atune, ptune )
+!=======================================================================
+! Update the ROSE namelist - especially the new target_time.
+! The target_time is actually an offset - so we need to calculate that.
+!=======================================================================
+
+character(len=*),   intent(in) :: file_name
+type(time_type),    intent(in) :: time1, timeN
+integer,            intent(in) :: ens_member
+real(r8), optional, intent(in) :: atune, ptune
+
+type(time_type) :: forecast_length
+integer :: second, day
+integer :: iunit
+
+forecast_length = timeN - time1
+call get_time(forecast_length, second, day)
+target_time = real(   day,digits12)*24.0_digits12 + &
+              real(second,digits12)/3600.0_digits12
+
+if (do_output()) then
+   PRINT*,'update_ROSE_namelist: forecast length [days seconds] ', &
+                 day, second, ' = hours ', target_time
+endif
+
+! Update the other namelist parameters 
+ens_element     = ens_member
+if (present(atune)) amp_tune = atune 
+if (present(ptune)) pha_tune = ptune 
+
+iunit = open_file(file_name, action='write')
+write(iunit, nml=ROSE_NML)
+call close_file(iunit)
+
+end subroutine update_ROSE_namelist
+
+
+
 subroutine read_ROSE_tref(file_name)
 !=======================================================================
 ! read the reference temperature from a ROSE restart file

Modified: DART/trunk/models/rose/model_to_dart.f90
===================================================================
--- DART/trunk/models/rose/model_to_dart.f90	2010-03-18 19:14:11 UTC (rev 4322)
+++ DART/trunk/models/rose/model_to_dart.f90	2010-03-23 04:43:20 UTC (rev 4323)
@@ -13,23 +13,18 @@
 !----------------------------------------------------------------------
 ! purpose: interface between ROSE and DART
 !
-! method: Read ROSE restart file (binary format).
-!         Reform fields into a state vector.
+! method: Read ROSE restart file (netCDF format).
+!         Reform fields into a DART state vector.
 !         Write out state vector in "proprietary" format for DART
 !
-!         based on model_to_dart for CAM
-!
 !----------------------------------------------------------------------
 
 use        types_mod, only : r8
-use    utilities_mod, only : get_unit, initialize_utilities
-use        model_mod, only : model_type, init_model_instance, read_ROSE_restart, &
-                             prog_var_to_vector
-use  assim_model_mod, only : assim_model_type, static_init_assim_model, &
-                             init_assim_model, get_model_size , &
-                             set_model_state_vector, write_state_restart, &
-                             set_model_time, open_restart_read, &
-                             open_restart_write, close_restart, aread_state_restart
+use    utilities_mod, only : get_unit, initialize_utilities, timestamp
+use        model_mod, only : model_type, static_init_model, get_model_size, &
+                             init_model_instance, read_ROSE_restart, &
+                             prog_var_to_vector, 
+use  assim_model_mod, only : open_restart_write, awrite_state_restart, close_restart
 use time_manager_mod, only : time_type
 
 implicit none
@@ -45,7 +40,6 @@
    file_out  = 'temp_ud'
 
 ! Temporary allocatable storage to read in a native format for ROSE state
-type(assim_model_type) :: x
 type(model_type)       :: var
 type(time_type)        :: model_time
 real(r8), allocatable  :: x_state(:)
@@ -53,35 +47,32 @@
 
 call initialize_utilities(progname='model_to_dart', output_flag=.true.)
 
-! Static init assim model calls static_init_model
-PRINT*,'static_init_assim_model in model_to_dart'
-call static_init_assim_model()
+! static_init_model reads input.nml, sets the geometry, model size, etc.
+call static_init_model()
 
-! Initialize the assim_model instance
-call init_assim_model(x)
-
 ! Allocate the local state vector
 x_size = get_model_size()
 allocate(x_state(x_size))
 
-! Allocate the instance of the ROSE model type for storage
+! Allocate an empty instance of the ROSE model type for storage
+! This is needed because read_ROSE_restart() requires it.  
 call init_model_instance(var)
 
-! Read the file ROSE state fragments into var
+! Read the ROSE state variables into var and set the model_time
+! to reflect the valid time of the ROSE state.
 call read_ROSE_restart(file_name, var, model_time)
 
 ! transform fields into state vector for DART
 call prog_var_to_vector(var, x_state)
 
-call set_model_state_vector(x, x_state)
-
-call set_model_time(x, model_time)
-
-file_unit = open_restart_write(file_out)
-PRINT*,'In model_to_dart file_out unit = ',file_unit
-PRINT*,' '
 ! write out state vector in "proprietary" format
-call write_state_restart(x, file_unit)
+file_unit = open_restart_write(file_out)
+call awrite_state_restart(model_time, x_state, file_unit)
 call close_restart(file_unit)
 
+!----------------------------------------------------------------------
+! When called with 'end', timestamp will also call finalize_utilities()
+!----------------------------------------------------------------------
+call timestamp(string1=source, pos='end')
+
 end program model_to_dart

Modified: DART/trunk/models/rose/shell_scripts/advance_model.csh
===================================================================
--- DART/trunk/models/rose/shell_scripts/advance_model.csh	2010-03-18 19:14:11 UTC (rev 4322)
+++ DART/trunk/models/rose/shell_scripts/advance_model.csh	2010-03-23 04:43:20 UTC (rev 4323)
@@ -39,7 +39,7 @@
 # Get the data files needed to run rose. One directory up is 'CENTRALDIR'
 
 cp ../input.nml .
-cp ../rose.nml rose.nml_default
+cp ../rose.nml  .
 
 # Loop through each state
 set state_copy = 1
@@ -55,9 +55,9 @@
 
    #----------------------------------------------------------------------
    # Block 2: Convert the DART output file to form needed by model.
-   # We are going to take a POP netCDF restart file and simply overwrite the
+   # We are going to take a ROSE netCDF restart file and simply overwrite the
    # appropriate variables. The DART output file also has the 'advance_to'
-   # time - which must be communicated to the model ...
+   # time - which must be communicated to the model ... through the rose namelist
    #----------------------------------------------------------------------
 
    # The EXPECTED input DART 'initial conditions' file name is 'temp_ic'
@@ -66,32 +66,25 @@
    ln -sfv ../$input_file temp_ic || exit 2
    cp -p   ../rose_restart.nc  .  || exit 2
 
-   ../dart_to_model || exit 2
+#  echo "ensemble member $ensemble_member : before dart_to_model"
+#  ncdump -v mtime rose_restart.nc
 
-   # Convey the new 'advance_to' time to rose via the namelist
-   # trans_time creates a teeny file called 'times' that contains
-   # the 'advance_to' time from DART in the rose format
-   # The program nmlbld_rose takes the rose template namelist and
-   # inserts the proper time and ensemble member bits.
+   echo $ensemble_member | ../dart_to_model || exit 2
 
-   ../trans_time
+#  ls -lrt   
 
-   echo `cat times`        >! namelist.in
-   echo $ensemble_member   >> namelist.in
-#  echo `cat a_tunes`      >> namelist.in
-#  echo `cat p_tunes`      >> namelist.in
-
-   ../nmlbld_rose  < namelist.in
-   echo "advance_model: after nmlbld_rose"
-
-   ls -lrt   
-
    #----------------------------------------------------------------------
    # Block 3: Run the model
    #----------------------------------------------------------------------
 
+#  echo "ensemble member $ensemble_member : before rose"
+#  ncdump -v mtime rose_restart.nc
+
    ../rose |& tee rose_out_$ensemble_member
 
+#  echo "ensemble member $ensemble_member : after rose"
+#  ncdump -v mtime rose_restart.nc
+
    ls -lrt
 
    #----------------------------------------------------------------------

Modified: DART/trunk/models/rose/shell_scripts/run_perfect_model_obs.csh
===================================================================
--- DART/trunk/models/rose/shell_scripts/run_perfect_model_obs.csh	2010-03-18 19:14:11 UTC (rev 4322)
+++ DART/trunk/models/rose/shell_scripts/run_perfect_model_obs.csh	2010-03-23 04:43:20 UTC (rev 4323)
@@ -35,8 +35,8 @@
 #BSUB -J rose_OSSE
 #BSUB -o rose_OSSE.%J.log
 #BSUB -N -u ${USER}@ucar.edu
-#BSUB -q economy
-#BSUB -n 16
+#BSUB -q standby
+#BSUB -n 1
 #BSUB -R "span[ptile=2]"
 #BSUB -W 2:00
 
@@ -119,7 +119,8 @@
 # Set variables containing various directory names where we will GET things
 #-----------------------------------------------------------------------------
 
-set DARTDIR = /home/coral/tmatsuo/DART/models/rose
+set DARTDIR = /fs/image/home/thoar/SVN/DART/models/rose
+set ROSEDIR = /home/coral/tmatsuo/DART/models/rose
 
 #-----------------------------------------------------------------------------
 # Get the DART executables, scripts, and input files
@@ -127,12 +128,9 @@
 
 # executables
 
- ${COPY} ${DARTDIR}/work/trans_perfect_ics          .
  ${COPY} ${DARTDIR}/work/perfect_model_obs          .
  ${COPY} ${DARTDIR}/work/dart_to_model              .
  ${COPY} ${DARTDIR}/work/model_to_dart              .
- ${COPY} ${DARTDIR}/work/trans_time                 .
- ${COPY} ${DARTDIR}/work/nmlbld_rose                .
 
 # shell scripts
  ${COPY} ${DARTDIR}/shell_scripts/advance_model.csh .
@@ -153,9 +151,11 @@
 #-----------------------------------------------------------------------------
 # Check that everything moved OK, and the table is set.
 # Convert a ROSE file 'rose_restart.nc' to a DART ics file 'perfect_ics'
+# 'model_to_dart' has a hardwired output filename of 'temp_ud' ...
 #-----------------------------------------------------------------------------
 
- ./trans_perfect_ics
+./model_to_dart || exit 1
+mv temp_ud perfect_ics
 
 #-----------------------------------------------------------------------------
 # Run perfect_model_obs ... harvest the observations to populate obs_seq.out


More information about the Dart-dev mailing list