var/da/da_vtox_transforms/da_dual_res_c2n_ad.inc

   1 subroutine da_dual_res_c2n_ad( input_fld, output_fld,  &
   2                    nims, nime, njms, njme, nkms, nkme, &
   3                    nits, nite, njts, njte, nkts, nkte, &
   4                    cids, cide, cjds, cjde, ckds, ckde, &
   5                    cims, cime, cjms, cjme, ckms, ckme, &
   6                    cits, cite, cjts, cjte, ckts, ckte)
   7
   8    ! adjoint of bilinear interpolation from low-res to high-res
   9    ! input_fld  is high-res on nest grid
  10    ! output_fld is low-res on coarse grid
  11
  12    implicit none
  13
  14    integer, intent(in) :: cids, cide, ckds, ckde, cjds, cjde, &
  15                           cims, cime, ckms, ckme, cjms, cjme, &
  16                           cits, cite, ckts, ckte, cjts, cjte
  17    integer, intent(in) :: nims, nime, nkms, nkme, njms, njme, &
  18                           nits, nite, nkts, nkte, njts, njte
  19    real, intent(in)    :: input_fld (nims:nime,njms:njme,nkms:nkme)
  20    real, intent(inout) :: output_fld(cims:cime,cjms:cjme,ckms:ckme)
  21
  22    ! local variables
  23    real                :: output_loc(cids:cide,cjds:cjde,ckds:ckde)
  24    real                :: output_g  (cids:cide,cjds:cjde,ckds:ckde)
  25    integer             :: i, j, k, ijk, ierr
  26
  27    if (trace_use) call da_trace_entry("da_dual_res_c2n_ad")
  28
  29    output_loc = 0.0
  30    output_g   = 0.0
  31
  32    do k = nkts, nkte
  33       do j = njts, njte
  34          do i = nits, nite
  35             output_loc(aens_locs(i,j)%i  ,aens_locs(i,j)%j,k)   =  &
  36                aens_locs(i,j)%dym * aens_locs(i,j)%dxm  * input_fld(i,j,k) + output_loc(aens_locs(i,j)%i  ,aens_locs(i,j)%j,k)
  37             output_loc(aens_locs(i,j)%i+1,aens_locs(i,j)%j,k)   =  &
  38                aens_locs(i,j)%dym * aens_locs(i,j)%dx   * input_fld(i,j,k) + output_loc(aens_locs(i,j)%i+1,aens_locs(i,j)%j,k)
  39             output_loc(aens_locs(i,j)%i  ,aens_locs(i,j)%j+1,k) =  &
  40                aens_locs(i,j)%dy  * aens_locs(i,j)%dxm  * input_fld(i,j,k) + output_loc(aens_locs(i,j)%i  ,aens_locs(i,j)%j+1,k)
  41             output_loc(aens_locs(i,j)%i+1,aens_locs(i,j)%j+1,k) =  &
  42                aens_locs(i,j)%dy  * aens_locs(i,j)%dx   * input_fld(i,j,k) + output_loc(aens_locs(i,j)%i+1,aens_locs(i,j)%j+1,k)
  43          end do
  44       end do
  45    end do
  46
  47 #ifdef DM_PARALLEL
  48    ijk = (cide-cids+1)*(cjde-cjds+1)*(ckde-ckds+1)
  49    call mpi_allreduce(output_loc(:,:,:), output_g(:,:,:), ijk, &
  50                       true_mpi_real, mpi_sum, comm, ierr)
  51    if ( ierr /= 0 ) then
  52       write(message(1), '(a, i3)') 'Error mpi_allreduce on proc', myproc
  53       call da_error(__FILE__,__LINE__,message(1:1))
  54    end if
  55 #else
  56    output_g(:,:,:) = output_loc(:,:,:)
  57 #endif
  58
  59    output_fld(cits:cite,cjts:cjte,ckts:ckte) = output_g(cits:cite,cjts:cjte,ckts:ckte)
  60
  61    if (trace_use) call da_trace_exit("da_dual_res_c2n_ad")
  62
  63 end subroutine da_dual_res_c2n_ad
  64