subroutine da_solve_init(grid & 3,12
#include "dummy_new_args.inc"
)
!-----------------------------------------------------------------------
! Purpose: TBD
!-----------------------------------------------------------------------
implicit none
type(domain), intent(inout) :: grid
#include "dummy_new_decl.inc"
#ifdef DM_PARALLEL
integer :: ii
#endif
integer :: sm31,sm32,sm33,sm31x,sm32x,sm33x,sm31y,sm32y,sm33y
integer :: em31,em32,em33,ep_dim
ep_dim=1
if ( use_4denvar ) ep_dim=num_fgat_time ! 4D-En-Var
! if (dwordsize != rwordsize)
#define true_MSG_XPOSE add_msg_xpose_real
! else
! define true_MSG_XPOSE add_msg_xpose_doubleprecision
! end if
if (trace_use) call da_trace_entry("da_solve_init")
! De-reference dimension information stored in the grid data structure.
call da_copy_dims(grid)
! Compute these starting and stopping locations for each tile and number
! of tiles.
call set_tiles (grid , ids , ide , jds , jde , ips , ipe , jps , jpe)
call da_copy_tile_dims(grid)
sm31 = grid%sm31
sm32 = grid%sm32
sm33 = grid%sm33
sm31x = grid%sm31x
sm32x = grid%sm32x
sm33x = grid%sm33x
sm31y = grid%sm31y
sm32y = grid%sm32y
sm33y = grid%sm33y
em31 = grid%em31
em32 = grid%em32
em33 = grid%em33
#ifdef DM_PARALLEL
#define REGISTER_I1
#include "data_calls.inc"
if (trace_use) call da_trace("da_solve_init", &
Message="Setup halo region communication")
! Define halo region communication.
!-----------------------------------------------------------------------
! Stencils for patch communications
! * * * * *
! * * * * * * * * *
! * + * * + * * * + * *
! * * * * * * * * *
! * * * * *
!ij vp%v1 x
!ij xb%cori x
!ij xb%rho x
!ij xa%u x
!ij xa%v x
!--------------------------------------------------------------
#include "HALO_INIT.inc"
#include "HALO_PSICHI_UV.inc"
#include "HALO_BAL_EQN_ADJ.inc"
#include "HALO_PSICHI_UV_ADJ.inc"
#include "HALO_XA.inc"
#include "HALO_SFC_XA.inc"
#include "HALO_SSMI_XA.inc"
#include "HALO_2D_WORK.inc"
#include "HALO_RADAR_XA_W.inc"
#if (WRF_CHEM == 1)
#include "HALO_CHEM_INIT.inc"
#include "HALO_CHEM_XA.inc"
#endif
if (trace_use) call da_trace("da_solve_init", &
Message="Copy domain and transpose descriptors")
! Copy domain and transpose descriptors.
grid%xp%domdesc = grid%domdesc
do ii = 1, max_comms
grid%xp%comms(ii) = grid%comms(ii)
end do
#endif
! Fill background scalars:
grid%xb%ids = grid%xp%ids
grid%xb%ide = grid%xp%ide
grid%xb%jds = grid%xp%jds
grid%xb%jde = grid%xp%jde
grid%xb%kds = grid%xp%kds
grid%xb%kde = grid%xp%kde
grid%xb%ims = grid%xp%ims
grid%xb%ime = grid%xp%ime
grid%xb%jms = grid%xp%jms
grid%xb%jme = grid%xp%jme
grid%xb%kms = grid%xp%kms
grid%xb%kme = grid%xp%kme
grid%xb%its = grid%xp%its
grid%xb%ite = grid%xp%ite
grid%xb%jts = grid%xp%jts
grid%xb%jte = grid%xp%jte
grid%xb%kts = grid%xp%kts
grid%xb%kte = grid%xp%kte
! if anal_type_hybrid_dual_res,
! grid%ep is already allocated in the call to reallocate_analysis_grid
if ( .not. anal_type_hybrid_dual_res ) then
!
! allocate grid%ep%v1
!
ALLOCATE(grid%ep%v1(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
print *,' Failed to allocate grid%ep%v1(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
endif
grid%ep%v1=0.
!
! allocate grid%ep%v2
!
ALLOCATE(grid%ep%v2(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
print *,' Failed to allocate grid%ep%v2(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
endif
grid%ep%v2=0.
!
! allocate grid%ep%v3
!
ALLOCATE(grid%ep%v3(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
print *,' Failed to allocate grid%ep%v3(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
endif
grid%ep%v3=0.
!
! allocate grid%ep%v4
!
ALLOCATE(grid%ep%v4(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
print *,' Failed to allocate grid%ep%v4(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
endif
grid%ep%v4=0.
!
! allocate grid%ep%v5
!
ALLOCATE(grid%ep%v5(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
print *,' Failed to allocate grid%ep%v5(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
endif
grid%ep%v5=0.
if ( alpha_hydrometeors ) then
!
! allocate grid%ep%cw
!
ALLOCATE(grid%ep%cw(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%cw(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
call da_error(__FILE__,__LINE__,message(1:1))
endif
grid%ep%cw=0.
!
! allocate grid%ep%rn
!
ALLOCATE(grid%ep%rn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%rn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
call da_error(__FILE__,__LINE__,message(1:1))
endif
grid%ep%rn=0.
!
! allocate grid%ep%ci
!
ALLOCATE(grid%ep%ci(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%ci(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
call da_error(__FILE__,__LINE__,message(1:1))
endif
grid%ep%ci=0.
!
! allocate grid%ep%sn
!
ALLOCATE(grid%ep%sn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%sn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
call da_error(__FILE__,__LINE__,message(1:1))
endif
grid%ep%sn=0.
!
! allocate grid%ep%gr
!
ALLOCATE(grid%ep%gr(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
if (ierr.ne.0) then
write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%gr(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
call da_error(__FILE__,__LINE__,message(1:1))
endif
grid%ep%gr=0.
end if ! alpha_hydrometeors
end if !not anal_type_hybrid_dual_res
if (trace_use) call da_trace_exit("da_solve_init")
end subroutine da_solve_init