var/da/da_main/da_solve_init.inc

   1 subroutine da_solve_init(grid &
   2 #include "dummy_new_args.inc"
   3 )
   4
   5    !-----------------------------------------------------------------------
   6    ! Purpose: TBD
   7    !-----------------------------------------------------------------------
   8
   9    implicit none
  10
  11    type(domain), intent(inout)      :: grid
  12
  13 #include "dummy_new_decl.inc"
  14
  15 #ifdef DM_PARALLEL
  16    integer :: ii
  17 #endif
  18
  19    integer :: sm31,sm32,sm33,sm31x,sm32x,sm33x,sm31y,sm32y,sm33y
  20    integer :: em31,em32,em33,ep_dim
  21    ep_dim=1
  22    if ( use_4denvar ) ep_dim=num_fgat_time   !  4D-En-Var
  23    ! if (dwordsize != rwordsize)
  24 #define true_MSG_XPOSE add_msg_xpose_real
  25    ! else
  26    !    define true_MSG_XPOSE add_msg_xpose_doubleprecision
  27    ! end if
  28
  29    if (trace_use) call da_trace_entry("da_solve_init")
  30
  31    ! De-reference dimension information stored in the grid data structure.
  32
  33    call da_copy_dims(grid)
  34
  35    ! Compute these starting and stopping locations for each tile and number
  36    ! of tiles.
  37
  38    call set_tiles (grid , ids , ide , jds , jde , ips , ipe , jps , jpe)
  39
  40    call da_copy_tile_dims(grid)
  41
  42    sm31             = grid%sm31
  43    sm32             = grid%sm32
  44    sm33             = grid%sm33
  45    sm31x            = grid%sm31x
  46    sm32x            = grid%sm32x
  47    sm33x            = grid%sm33x
  48    sm31y            = grid%sm31y
  49    sm32y            = grid%sm32y
  50    sm33y            = grid%sm33y
  51
  52    em31             = grid%em31
  53    em32             = grid%em32
  54    em33             = grid%em33
  55
  56 #ifdef DM_PARALLEL
  57 #define REGISTER_I1
  58 #include "data_calls.inc"
  59
  60    if (trace_use) call da_trace("da_solve_init", &
  61       Message="Setup halo region communication")
  62
  63    ! Define halo region communication.
  64    !-----------------------------------------------------------------------
  65    !  Stencils for patch communications
  66    !                           * * * * *
  67    !         *        * * *    * * * * *
  68    !       * + *      * + *    * * + * *
  69    !         *        * * *    * * * * *
  70    !                           * * * * *
  71    !ij vp%v1            x
  72    !ij xb%cori          x
  73    !ij xb%rho           x
  74    !ij xa%u             x
  75    !ij xa%v             x
  76    !--------------------------------------------------------------
  77 #include "HALO_INIT.inc"
  78 #include "HALO_PSICHI_UV.inc"
  79 #include "HALO_BAL_EQN_ADJ.inc"
  80 #include "HALO_PSICHI_UV_ADJ.inc"
  81 #include "HALO_XA.inc"
  82 #include "HALO_SFC_XA.inc"
  83 #include "HALO_SSMI_XA.inc"
  84 #include "HALO_2D_WORK.inc"
  85 #include "HALO_RADAR_XA_W.inc"
  86
  87 #if (WRF_CHEM == 1)
  88 #include "HALO_CHEM_INIT.inc"
  89 #include "HALO_CHEM_XA.inc"
  90 #endif
  91
  92    if (trace_use) call da_trace("da_solve_init", &
  93       Message="Copy domain and transpose descriptors")
  94
  95    ! Copy domain and transpose descriptors.
  96
  97    grid%xp%domdesc = grid%domdesc
  98    do ii = 1, max_comms
  99      grid%xp%comms(ii) = grid%comms(ii)
 100    end do
 101
 102 #endif
 103
 104    ! Fill background scalars:
 105
 106    grid%xb%ids = grid%xp%ids
 107    grid%xb%ide = grid%xp%ide
 108    grid%xb%jds = grid%xp%jds
 109    grid%xb%jde = grid%xp%jde
 110    grid%xb%kds = grid%xp%kds
 111    grid%xb%kde = grid%xp%kde
 112
 113    grid%xb%ims = grid%xp%ims
 114    grid%xb%ime = grid%xp%ime
 115    grid%xb%jms = grid%xp%jms
 116    grid%xb%jme = grid%xp%jme
 117    grid%xb%kms = grid%xp%kms
 118    grid%xb%kme = grid%xp%kme
 119
 120    grid%xb%its = grid%xp%its
 121    grid%xb%ite = grid%xp%ite
 122    grid%xb%jts = grid%xp%jts
 123    grid%xb%jte = grid%xp%jte
 124    grid%xb%kts = grid%xp%kts
 125    grid%xb%kte = grid%xp%kte
 126
 127 ! if anal_type_hybrid_dual_res,
 128 ! grid%ep is already allocated in the call to reallocate_analysis_grid
 129 if ( .not. anal_type_hybrid_dual_res ) then
 130    !
 131    ! allocate grid%ep%v1
 132    !
 133    ALLOCATE(grid%ep%v1(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 134    if (ierr.ne.0) then
 135      print *,' Failed to allocate grid%ep%v1(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 136    endif
 137    grid%ep%v1=0.
 138
 139    !
 140    ! allocate grid%ep%v2
 141    !
 142    ALLOCATE(grid%ep%v2(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 143    if (ierr.ne.0) then
 144      print *,' Failed to allocate grid%ep%v2(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 145    endif
 146    grid%ep%v2=0.
 147
 148    !
 149    ! allocate grid%ep%v3
 150    !
 151    ALLOCATE(grid%ep%v3(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 152    if (ierr.ne.0) then
 153      print *,' Failed to allocate grid%ep%v3(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 154    endif
 155    grid%ep%v3=0.
 156
 157    !
 158    ! allocate grid%ep%v4
 159    !
 160    ALLOCATE(grid%ep%v4(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 161    if (ierr.ne.0) then
 162      print *,' Failed to allocate grid%ep%v4(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 163    endif
 164    grid%ep%v4=0.
 165
 166    !
 167    ! allocate grid%ep%v5
 168    !
 169    ALLOCATE(grid%ep%v5(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 170    if (ierr.ne.0) then
 171      print *,' Failed to allocate grid%ep%v5(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 172    endif
 173    grid%ep%v5=0.
 174
 175  if ( alpha_hydrometeors ) then
 176    !
 177    ! allocate grid%ep%cw
 178    !
 179    ALLOCATE(grid%ep%cw(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 180    if (ierr.ne.0) then
 181       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%cw(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 182       call da_error(__FILE__,__LINE__,message(1:1))
 183    endif
 184    grid%ep%cw=0.
 185    !
 186    ! allocate grid%ep%rn
 187    !
 188    ALLOCATE(grid%ep%rn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 189    if (ierr.ne.0) then
 190       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%rn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 191       call da_error(__FILE__,__LINE__,message(1:1))
 192    endif
 193    grid%ep%rn=0.
 194    !
 195    ! allocate grid%ep%ci
 196    !
 197    ALLOCATE(grid%ep%ci(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 198    if (ierr.ne.0) then
 199       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%ci(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 200       call da_error(__FILE__,__LINE__,message(1:1))
 201    endif
 202    grid%ep%ci=0.
 203    !
 204    ! allocate grid%ep%sn
 205    !
 206    ALLOCATE(grid%ep%sn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 207    if (ierr.ne.0) then
 208       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%sn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 209       call da_error(__FILE__,__LINE__,message(1:1))
 210    endif
 211    grid%ep%sn=0.
 212    !
 213    ! allocate grid%ep%gr
 214    !
 215    ALLOCATE(grid%ep%gr(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 216    if (ierr.ne.0) then
 217       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%gr(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 218       call da_error(__FILE__,__LINE__,message(1:1))
 219    endif
 220    grid%ep%gr=0.
 221  end if ! alpha_hydrometeors
 222
 223 end if !not anal_type_hybrid_dual_res
 224
 225    if (trace_use) call da_trace_exit("da_solve_init")
 226
 227 end subroutine da_solve_init
 228
 229