wrfv2_fire/var/da/da_main/da_wrfvar_init2.inc

   1 subroutine da_wrfvar_init2
   2
   3    !-------------------------------------------------------------------------
   4    ! Purpose: WRFVAR initialization routine, part 2
   5    !-------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    integer :: i
  10    character(len=80) :: filename
  11
  12    if (trace_use) call da_trace_entry("da_wrfvar_init2")
  13
  14 ! Override the start time with the "analysis_date":
  15       read(analysis_date, fmt='(i4,5(1x,i2))') &
  16            start_year(1), start_month(1), start_day(1), start_hour(1), &
  17            start_minute(1), start_second(1)
  18       model_config_rec% start_year   = start_year
  19       model_config_rec% start_month  = start_month
  20       model_config_rec% start_day    = start_day
  21       model_config_rec% start_hour   = start_hour
  22       model_config_rec% start_minute = start_minute
  23       model_config_rec% start_second = start_second
  24
  25    if (analysis_type(1:6) == "VERIFY" .or. analysis_type(1:6) == "verify") then
  26       anal_type_verify=.true.
  27    else
  28       anal_type_verify=.false.
  29    end if
  30
  31    if (analysis_type(1:8) == "RANDOMCV" .or. analysis_type(1:8) == "randomcv") then
  32       anal_type_randomcv=.true.
  33    else
  34       anal_type_randomcv=.false.
  35    end if
  36
  37    if (analysis_type(1:6) == "QC-OBS" .or. analysis_type(1:6) == "qc-obs") then
  38       anal_type_qcobs=.true.
  39    else
  40       anal_type_qcobs=.false.
  41    end if
  42
  43    if (use_gpspwObs .and. use_gpsztdObs ) then
  44       call da_error(__FILE__,__LINE__, (/'can not assimilate gpspw and gpsztd simultaneously'/))
  45    end if
  46
  47    if (fg_format==fg_format_kma_global .or. fg_format==fg_format_wrf_arw_global) then
  48       global = .true.
  49       nproc_x = 1
  50    else
  51       global = .false.
  52    end if
  53
  54    !<DESCRIPTION>
  55    ! Among the configuration variables read from the namelist is
  56    ! debug_level. This is retrieved using nl_get_debug_level (Registry
  57    ! generated and defined in frame/module_configure.F).  The value is then
  58    ! used to set the debug-print information level for use by <a
  59    ! href=wrf_debug.html>wrf_debug</a> throughout the code. Debug_level
  60    ! of zero (the default) causes no information to be printed when the
  61    ! model runs. The higher the number (up to 1000) the more information is
  62    ! printed.
  63    !
  64    !</DESCRIPTION>
  65
  66    call nl_get_debug_level (1, debug_level)
  67    call set_wrf_debug_level (debug_level)
  68
  69    nullify(null_domain)
  70
  71
  72    if (max_dom > 1) then
  73       call da_error(__FILE__,__LINE__, (/'nesting not available for wrfvar'/))
  74    end if
  75
  76    !<DESCRIPTION>
  77    ! The top-most domain in the simulation is then allocated and configured
  78    ! by calling <a href=alloc_and_configure_domain.html>alloc_and_configure_domain</a>.
  79    ! Here, in the case of this root domain, the routine is passed the
  80    ! globally accessible pointer to type(domain), head_grid, defined in
  81    ! frame/module_domain.F.  The parent is null and the child index is given
  82    ! as negative, signifying none.  Afterwards, because the call to
  83    ! alloc_and_configure_domain may modify the model configuration data
  84    ! stored in model_config_rec, the configuration information is again
  85    ! repacked into a buffer, broadcast, and unpacked on each task (for
  86    ! DM_PARALLEL compiles). The call to <a
  87    ! href=setup_timekeeping.html>setup_timekeeping</a> for head_grid relies
  88    ! on this configuration information, and it must occur after the second
  89    ! broadcast of the configuration information.
  90    !
  91    !</DESCRIPTION>
  92
  93    call da_trace("da_wrfvar_init2",message="calling alloc_and_configure_domain")
  94
  95    call alloc_and_configure_domain (domain_id=1, grid=head_grid, parent=null_domain, kid=-1)
  96
  97    call da_trace("da_wrfvar_init2",message="calling model_to_grid_config_rec")
  98    call model_to_grid_config_rec (head_grid%id, model_config_rec, config_flags)
  99
 100    call da_trace("da_wrfvar_init2",message="calling set_scalar_indices_from_config")
 101    call set_scalar_indices_from_config (head_grid%id , idum1, idum2)
 102
 103    call da_trace("da_wrfvar_init2",message="calling init_wrfio")
 104    call init_wrfio
 105
 106 #ifdef DM_PARALLEL
 107    call get_config_as_buffer (configbuf, configbuflen, nbytes)
 108    call wrf_dm_bcast_bytes (configbuf, nbytes)
 109    call set_config_as_buffer (configbuf, configbuflen)
 110 #endif
 111
 112    call setup_timekeeping (head_grid)
 113
 114    !<DESCRIPTION>
 115    ! The head grid is initialized with read-in data through the call to <a
 116    ! href=med_initialdata_input.html>med_initialdata_input</a>, which is
 117    ! passed the pointer head_grid and a locally declared configuration data
 118    ! structure, config_flags, that is set by a call to <a
 119    ! href=model_to_grid_config_rec.html>model_to_grid_config_rec</a>.  It is
 120    ! also necessary that the indices into the 4d tracer arrays such as
 121    ! moisture be set with a call to <a
 122    ! href=set_scalar_indices_from_config.html>set_scalar_indices_from_config</a>
 123    ! prior to the call to initialize the domain.  Both of these calls are
 124    ! told which domain they are setting up for by passing in the integer id
 125    ! of the head domain as <tt>head_grid%id</tt>, which is 1 for the
 126    ! top-most domain.
 127    !
 128    ! In the case that write_restart_at_0h is set to true in the namelist,
 129    ! the model simply generates a restart file using the just read-in data
 130    ! and then shuts down. This is used for ensemble breeding, and is not
 131    ! typically enabled.
 132    !
 133    !</DESCRIPTION>
 134
 135    ! call med_initialdata_input(head_grid , config_flags,'fg')
 136
 137    if ((config_flags%real_data_init_type == 1) .or. &
 138        (config_flags%real_data_init_type == 3)) then
 139       call da_med_initialdata_input (head_grid, config_flags, 'fg')
 140    end if
 141
 142    ! FIX?
 143    ! call da_warning(__FILE__,__LINE__,(/"Fix me"/))
 144    ! head_grid%start_subtime = head_grid%start_time
 145    ! head_grid%stop_subtime = head_grid%stop_time
 146
 147    if (rootproc) then
 148       call da_get_unit (cost_unit)
 149       call da_get_unit (grad_unit)
 150       call da_get_unit (jo_unit)
 151       call da_get_unit (check_max_iv_unit)
 152       call da_get_unit (check_buddy_unit)
 153       open(unit=cost_unit,file="cost_fn",status="replace")
 154       open(unit=grad_unit,file="grad_fn",status="replace")
 155       if (.not. print_detail_outerloop) then
 156          call da_get_unit (stats_unit)
 157          open(unit=stats_unit,file="statistics",status="replace")
 158       end if
 159       open(unit=jo_unit,file="jo",status="replace")
 160       open(unit=check_max_iv_unit,file="check_max_iv",status="replace")
 161       open(unit=check_buddy_unit ,file="buddy_check" ,status="replace")
 162    end if
 163
 164    if (trace_use) call da_trace_exit("da_wrfvar_init2")
 165
 166 end subroutine da_wrfvar_init2
 167
 168