var/da/da_gpseph/da_gpseph_init.inc

   1 subroutine da_gpseph_init (grid)
   2
   3 ! ---------------------------------------------------------------------------
   4 ! Purpose: Allocate domain-sized arrays for gpseph operator and
   5 !          let every processor have the information of the domain-mean height
   6 !          and refractivity on the mean height.
   7 ! ---------------------------------------------------------------------------
   8
   9    implicit none
  10
  11    type (domain), intent(in)      :: grid       ! first guess state
  12
  13    integer :: i, j, k, ij, ijk
  14    integer :: nk
  15    real    :: temp
  16    real, dimension(kds:kde)   :: tmp_ref
  17    real, dimension(kds:kde)   :: refm
  18    real, dimension(3,kds:kde) :: cc
  19
  20    if (trace_use_dull) call da_trace_entry("da_gpseph_init")
  21
  22    if ( .not. allocated(global_lat) )        allocate ( global_lat (ids:ide,jds:jde) )
  23    if ( .not. allocated(global_lon) )        allocate ( global_lon (ids:ide,jds:jde) )
  24    if ( .not. allocated(global_terr) )       allocate ( global_terr (ids:ide,jds:jde) )
  25    if ( .not. allocated(global_h) )          allocate ( global_h (ids:ide,jds:jde,kds:kde) )
  26    if ( .not. allocated(global_ref) )        allocate ( global_ref (ids:ide,jds:jde,kds:kde) )
  27    if ( .not. allocated(global_xa_ref) )     allocate ( global_xa_ref (ids:ide,jds:jde,kds:kde) )
  28    if ( .not. allocated(global_adj_ref) )    allocate ( global_adj_ref (ids:ide,jds:jde,kds:kde) )
  29    if ( .not. allocated(global_h_mean) )     allocate ( global_h_mean (kds:kde) )
  30    if ( .not. allocated(global_ref_mean_h) ) allocate ( global_ref_mean_h (ids:ide,jds:jde,kds:kde) )
  31    global_lat = 0.0
  32    global_lon = 0.0
  33    global_terr = 0.0
  34    global_h = 0.0
  35    global_ref = 0.0
  36    global_xa_ref = 0.0
  37    global_adj_ref = 0.0
  38    global_h_mean = 0.0
  39    global_ref_mean_h = 0.0
  40
  41    nk = kde-kts+1
  42    ij = ( ide-ids+1)*( jde-jds+1)
  43
  44    ! Gather lat, lon, ref, h and terr for gpseph data
  45 #ifdef DM_PARALLEL
  46    ijk = ( ide-ids+1)*( jde-jds+1)*(kde-kds+1)
  47    !  Collect xb component of h into global buffer.
  48    call da_patch_to_global( grid, grid%xb%h, global_h )
  49    call wrf_dm_bcast_real( global_h, ijk )
  50    !  Collect xb component of ref into global buffer.
  51    call da_patch_to_global( grid, grid%xb%ref, global_ref )
  52    call wrf_dm_bcast_real( global_ref, ijk )
  53    !  Collect xb component of lat into global buffer.
  54    call da_patch_to_global( grid, grid%xb%lat, global_lat )
  55    call wrf_dm_bcast_real( global_lat, ij )
  56    !  Collect xb component of lon into global buffer.
  57    call da_patch_to_global( grid, grid%xb%lon, global_lon )
  58    call wrf_dm_bcast_real( global_lon, ij )
  59    !  Collect xb component of terr into global buffer.
  60    call da_patch_to_global( grid, grid%xb%terr, global_terr )
  61    call wrf_dm_bcast_real( global_terr, ij )
  62 #else
  63    do k = kds, kde
  64       do j = jds, jde
  65          do i = ids, ide
  66             global_h(i,j,k) = grid%xb%h(i,j,k)
  67             global_ref(i,j,k) = grid%xb%ref(i,j,k)
  68          enddo
  69       enddo
  70    enddo
  71    do j = jds, jde
  72       do i = ids, ide
  73          global_lat(i,j) = grid%xb%lat(i,j)
  74          global_lon(i,j) = grid%xb%lon(i,j)
  75          global_terr(i,j) = grid%xb%terr(i,j)
  76       enddo
  77    enddo
  78 #endif
  79
  80    ! Calculate the grid mean altitude
  81    do k = kds, kde
  82       temp = 0.0
  83       do j = jds, jde
  84          do i = ids, ide
  85             temp = temp + global_h(i,j,k)
  86          end do
  87       end do
  88       global_h_mean(k) = temp/float(ij)   ! in m
  89    enddo
  90
  91    ! Interpolate refractivity to be on the grid mean altitude
  92    do j = jds, jde
  93       do i = ids, ide
  94          tmp_ref(kds:kde) = log(global_ref(i,j,kds:kde))
  95          call da_splinx(nk,global_h(i,j,kds:kde),tmp_ref(kds:kde),nk,global_h_mean(kds:kde),cc,refm)
  96          global_ref_mean_h(i,j,kds:kde) = exp(refm(kds:kde))
  97       end do
  98    end do
  99
 100    global_h_mean(:) = global_h_mean * 0.001 !m to km
 101
 102    if (trace_use_dull) call da_trace_exit("da_gpseph_init")
 103
 104 end subroutine da_gpseph_init
 105