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    logical           :: isfile
  12    logical           :: ex
  13
  14
  15    if (trace_use) call da_trace_entry("da_wrfvar_init2")
  16
  17 ! Override the start time with the "analysis_date":
  18       read(analysis_date, fmt='(i4,5(1x,i2))') &
  19            start_year(1), start_month(1), start_day(1), start_hour(1), &
  20            start_minute(1), start_second(1)
  21       model_config_rec% start_year   = start_year
  22       model_config_rec% start_month  = start_month
  23       model_config_rec% start_day    = start_day
  24       model_config_rec% start_hour   = start_hour
  25       model_config_rec% start_minute = start_minute
  26       model_config_rec% start_second = start_second
  27
  28    if (analysis_type(1:6) == "VERIFY" .or. analysis_type(1:6) == "verify") then
  29       anal_type_verify=.true.
  30    else
  31       anal_type_verify=.false.
  32    end if
  33
  34    if (analysis_type(1:8) == "RANDOMCV" .or. analysis_type(1:8) == "randomcv") then
  35       anal_type_randomcv=.true.
  36    else
  37       anal_type_randomcv=.false.
  38    end if
  39
  40    if (analysis_type(1:6) == "QC-OBS" .or. analysis_type(1:6) == "qc-obs") then
  41       anal_type_qcobs=.true.
  42    else
  43       anal_type_qcobs=.false.
  44    end if
  45
  46    if (use_gpspwObs .and. use_gpsztdObs ) then
  47       call da_error(__FILE__,__LINE__, (/'can not assimilate gpspw and gpsztd simultaneously'/))
  48    end if
  49
  50    if (fg_format==fg_format_kma_global .or. fg_format==fg_format_wrf_arw_global) then
  51       global = .true.
  52       nproc_x = 1
  53    else
  54       global = .false.
  55    end if
  56
  57    anal_type_hybrid_dual_res = .false.
  58    if ( hybrid_dual_res ) then
  59       if ( ensdim_alpha >= 1 ) then
  60          if ( max_dom /= 2 ) then
  61             call da_error(__FILE__,__LINE__, (/'max_dom has to be 2 for hybrid_dual_res application'/))
  62          end if
  63          anal_type_hybrid_dual_res = .true.
  64       else
  65          write(unit=message(1),fmt='(A,2(I4))') "ensdim_alpha has to be non-zero for hybrid_dual_res application, resetting hybrid_dual_res=.false."
  66          call da_warning(__FILE__,__LINE__,message(1:1))
  67          anal_type_hybrid_dual_res = .false.
  68       end if
  69    endif
  70
  71    if ( anal_type_hybrid_dual_res ) then
  72       call nl_set_shw( 1 , 0 )
  73       call nl_set_shw( 2 , 0 )
  74       !write(unit=message(1),fmt='(A,2(I4))') "Resetting shw for dual-res hybrid to shw = ",shw(1),shw(2)
  75       write(unit=message(1),fmt='(A,2(I4))') "Running WRFDA in dual-resolution hybrid mode"
  76       call da_message(message(1:1))
  77    endif
  78
  79    if (max_dom > 1 .and. ( .not. anal_type_hybrid_dual_res) ) then
  80       call da_error(__FILE__,__LINE__, (/'WRFDA does not handle nests (max_domain > 1)'/))
  81    end if
  82
  83    if ( var4d ) then
  84       model_config_rec%var4d_used = 1
  85       !mp_physics_4dvar is used for allocating a_moist and g_moist variables
  86       model_config_rec%mp_physics_4dvar = model_config_rec%mp_physics
  87    end if
  88
  89    if ( adj_sens ) then
  90       model_config_rec%adj_sens_used = 1
  91    end if
  92
  93    if ( var4d ) then
  94       model_config_rec%var4d_cloudcv = cloud_cv_options
  95       if ( use_cv_w ) model_config_rec%var4d_w_cv = 1
  96    end if
  97    if ( use_cv_w ) then
  98       model_config_rec%cv_w_used = 1
  99    end if
 100    model_config_rec%alloc_ep = 0
 101    ! ep will be allocated in da_solve_init (not hybrid_dual_res) or
 102    ! reallocate_analysis_grid (hybrid_dual_res)
 103    if ( ensdim_alpha > 0 ) then
 104       model_config_rec%ens_used = 1
 105       if ( anal_type_hybrid_dual_res ) then
 106          ! vp%alpha and vv%alpha will be allocated in reallocate_analysis_grid
 107          model_config_rec%alloc_alphacv = 0
 108       else
 109          model_config_rec%alloc_alphacv = 1
 110       end if
 111    end if
 112    if ( alpha_hydrometeors ) then
 113       model_config_rec%cloud_ens_used = 1
 114    end if
 115    if ( use_wpec ) then
 116       model_config_rec%wpec_used = 1
 117    end if
 118    if ( use_4denvar .and. num_fgat_time > 1 ) then
 119       model_config_rec%alloc_xa_static = 1
 120    end if
 121
 122    !<DESCRIPTION>
 123    ! Among the configuration variables read from the namelist is
 124    ! debug_level. This is retrieved using nl_get_debug_level (Registry
 125    ! generated and defined in frame/module_configure.F).  The value is then
 126    ! used to set the debug-print information level for use by <a
 127    ! href=wrf_debug.html>wrf_debug</a> throughout the code. Debug_level
 128    ! of zero (the default) causes no information to be printed when the
 129    ! model runs. The higher the number (up to 1000) the more information is
 130    ! printed.
 131    !
 132    !</DESCRIPTION>
 133
 134    call nl_get_debug_level (1, debug_level)
 135    call set_wrf_debug_level (debug_level)
 136
 137    nullify(null_domain)
 138
 139    !<DESCRIPTION>
 140    ! The top-most domain in the simulation is then allocated and configured
 141    ! by calling <a href=alloc_and_configure_domain.html>alloc_and_configure_domain</a>.
 142    ! Here, in the case of this root domain, the routine is passed the
 143    ! globally accessible pointer to type(domain), head_grid, defined in
 144    ! frame/module_domain.F.  The parent is null and the child index is given
 145    ! as negative, signifying none.  Afterwards, because the call to
 146    ! alloc_and_configure_domain may modify the model configuration data
 147    ! stored in model_config_rec, the configuration information is again
 148    ! repacked into a buffer, broadcast, and unpacked on each task (for
 149    ! DM_PARALLEL compiles). The call to <a
 150    ! href=setup_timekeeping.html>setup_timekeeping</a> for head_grid relies
 151    ! on this configuration information, and it must occur after the second
 152    ! broadcast of the configuration information.
 153    !
 154    !</DESCRIPTION>
 155
 156    call da_trace("da_wrfvar_init2",message="calling alloc_and_configure_domain")
 157
 158    call alloc_and_configure_domain (domain_id=1, grid=head_grid, parent=null_domain, kid=-1)
 159
 160    call da_trace("da_wrfvar_init2",message="calling model_to_grid_config_rec")
 161    call model_to_grid_config_rec (head_grid%id, model_config_rec, config_flags)
 162
 163    call da_trace("da_wrfvar_init2",message="calling set_scalar_indices_from_config")
 164    call set_scalar_indices_from_config (head_grid%id , idum1, idum2)
 165
 166    call da_trace("da_wrfvar_init2",message="calling init_wrfio")
 167    call init_wrfio
 168
 169 #ifdef DM_PARALLEL
 170    call get_config_as_buffer (configbuf, configbuflen, nbytes)
 171    call wrf_dm_bcast_bytes (configbuf, nbytes)
 172    call set_config_as_buffer (configbuf, configbuflen)
 173 #endif
 174
 175    call setup_timekeeping (head_grid)
 176
 177    if ( anal_type_hybrid_dual_res ) then
 178       ! input_file_ens is 'fg_ens', set in da_control.f90
 179       inquire(file=trim(input_file_ens), exist=isfile)
 180       if ( .not. isfile ) then
 181          write(unit=message(1),fmt='(a,a,a)') 'File ',trim(input_file_ens),' (low-resolution ensemble file) is missing.'
 182          call da_error(__FILE__,__LINE__,message(1:1))
 183       endif
 184       call da_med_initialdata_input (head_grid, config_flags, trim(input_file_ens))
 185       parent_grid => head_grid
 186       call alloc_and_configure_domain (domain_id=2, grid=another_grid, parent=parent_grid, kid=1)
 187       call model_to_grid_config_rec (another_grid%id, model_config_rec, config_flags)
 188       call set_scalar_indices_from_config (another_grid%id , idum1, idum2)
 189       call init_wrfio
 190 #ifdef DM_PARALLEL
 191          call get_config_as_buffer (configbuf, configbuflen, nbytes)
 192          call wrf_dm_bcast_bytes (configbuf, nbytes)
 193          call set_config_as_buffer (configbuf, configbuflen)
 194 #endif
 195       call setup_timekeeping (another_grid)
 196
 197       input_grid => another_grid
 198       ensemble_grid => head_grid
 199    else
 200       input_grid => head_grid
 201       ensemble_grid => head_grid
 202    endif
 203
 204    !<DESCRIPTION>
 205    ! The head grid is initialized with read-in data through the call to <a
 206    ! href=med_initialdata_input.html>med_initialdata_input</a>, which is
 207    ! passed the pointer head_grid and a locally declared configuration data
 208    ! structure, config_flags, that is set by a call to <a
 209    ! href=model_to_grid_config_rec.html>model_to_grid_config_rec</a>.  It is
 210    ! also necessary that the indices into the 4d tracer arrays such as
 211    ! moisture be set with a call to <a
 212    ! href=set_scalar_indices_from_config.html>set_scalar_indices_from_config</a>
 213    ! prior to the call to initialize the domain.  Both of these calls are
 214    ! told which domain they are setting up for by passing in the integer id
 215    ! of the head domain as <tt>head_grid%id</tt>, which is 1 for the
 216    ! top-most domain.
 217    !
 218    ! In the case that write_restart_at_0h is set to true in the namelist,
 219    ! the model simply generates a restart file using the just read-in data
 220    ! and then shuts down. This is used for ensemble breeding, and is not
 221    ! typically enabled.
 222    !
 223    !</DESCRIPTION>
 224
 225    ! call med_initialdata_input(head_grid , config_flags,'fg')
 226
 227    if ((config_flags%real_data_init_type == 1) .or. &
 228        (config_flags%real_data_init_type == 3)) then
 229 #ifdef VAR4D
 230       if ( var4d_lbc ) then
 231          call da_med_initialdata_input (head_grid, config_flags, 'fg02')
 232 !        inquire(file=trim('ana02'), exist=ex)
 233 !        if ( .not. ex ) then
 234 !           write(unit=message(1),fmt='(a)') 'A template of ana02 should be copied from fg02. '
 235 !           call da_message(message(1:1))
 236 !           write(unit=message(1),fmt='(a)') 'ana02 does not exist '
 237 !           call da_error(__FILE__,__LINE__,message(1:1))
 238 !        end if
 239          ALLOCATE(u6_2(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32,head_grid%sm33:head_grid%em33))
 240          ALLOCATE(v6_2(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32,head_grid%sm33:head_grid%em33))
 241          ALLOCATE(w6_2(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32,head_grid%sm33:head_grid%em33))
 242          ALLOCATE(t6_2(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32,head_grid%sm33:head_grid%em33))
 243          ALLOCATE(ph6_2(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32,head_grid%sm33:head_grid%em33))
 244          ALLOCATE(moist6(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32,head_grid%sm33:head_grid%em33,num_moist))
 245          ALLOCATE(p6(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32,head_grid%sm33:head_grid%em33))
 246          ALLOCATE(mu6_2(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32))
 247          ALLOCATE(psfc6(head_grid%sm31:head_grid%em31,head_grid%sm32:head_grid%em32))
 248          u6_2 = head_grid%u_2
 249          v6_2 = head_grid%v_2
 250          w6_2 = head_grid%w_2
 251          t6_2 = head_grid%t_2
 252          ph6_2 = head_grid%ph_2
 253          moist6 = head_grid%moist
 254          p6 = head_grid%p
 255          mu6_2 = head_grid%mu_2
 256          psfc6 = head_grid%psfc
 257       endif
 258 #endif
 259 !     call da_med_initialdata_input (head_grid, config_flags, 'fg')
 260       call da_med_initialdata_input (input_grid, config_flags, 'fg')
 261       if ( var4d ) then
 262          call med_latbound_in ( head_grid, config_flags )
 263          call close_dataset ( head_grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
 264       end if
 265    end if
 266
 267    ! FIX?
 268    ! call da_warning(__FILE__,__LINE__,(/"Fix me"/))
 269    ! head_grid%start_subtime = head_grid%start_time
 270    ! head_grid%stop_subtime = head_grid%stop_time
 271
 272    if (rootproc) then
 273       call da_get_unit (cost_unit)
 274       call da_get_unit (grad_unit)
 275       call da_get_unit (jo_unit)
 276       call da_get_unit (check_max_iv_unit)
 277       call da_get_unit (check_buddy_unit)
 278       open(unit=cost_unit,file="cost_fn",status="replace")
 279       open(unit=grad_unit,file="grad_fn",status="replace")
 280       if (.not. print_detail_outerloop) then
 281          call da_get_unit (stats_unit)
 282          open(unit=stats_unit,file="statistics",status="replace")
 283 #if (WRF_CHEM == 1)
 284          call da_get_unit (stats_unit2)
 285          open(unit=stats_unit2,file="statistics_chem",status="replace")
 286 #endif
 287       end if
 288       open(unit=jo_unit,file="jo",status="replace")
 289       open(unit=check_max_iv_unit,file="check_max_iv",status="replace")
 290       open(unit=check_buddy_unit ,file="buddy_check" ,status="replace")
 291       if (use_varbc_tamdar) then
 292           call da_get_unit (varbc_tamdar_unit)
 293           open(unit=varbc_tamdar_unit,file="varbc_tamdar_detail.log",status="replace")
 294       end if
 295    end if
 296
 297    if (trace_use) call da_trace_exit("da_wrfvar_init2")
 298
 299 end subroutine da_wrfvar_init2
 300
 301