var/da/da_dynamics/da_uv_to_divergence_adj.inc

   1 subroutine da_uv_to_divergence_adj(grid, u, v, div)
   2
   3    !---------------------------------------------------------------------------
   4    !  Purpose: Adjoint of the subroutine da_uv_to_divergence
   5    !                        d   U      d   V
   6    !           Div = m^2 *[---(---) + ---(---) ]
   7    !                        dx  m      dy  M
   8    !---------------------------------------------------------------------------
   9
  10    implicit none
  11
  12    type (domain), intent(inout) :: grid
  13
  14    real, intent(out)  :: u(ims:ime,jms:jme,kms:kme)   ! u wind comp.
  15    real, intent(out)  :: v(ims:ime,jms:jme,kms:kme)   ! v wind comp.
  16    real, intent(inout):: div(ims:ime,jms:jme,kms:kme) ! Divergence.
  17
  18    integer            :: i, j, k                      ! Loop counters.
  19    integer            :: is, ie                       ! 1st dim. end points.
  20    integer            :: js, je                       ! 2nd dim. end points.
  21    real               :: one_third                    ! 1/3.
  22
  23    real               :: coeff, inv_2ds
  24    real               :: um(ims:ime,jms:jme)          ! Temp. storage of u/m.
  25    real               :: vm(ims:ime,jms:jme)          ! Temp. storage of v/m
  26
  27    if (trace_use) call da_trace_entry("da_uv_to_divergence_adj")
  28
  29    !---------------------------------------------------------------------------
  30    ! [1.0] Initialise:
  31    !---------------------------------------------------------------------------
  32
  33    one_third = 1.0 / 3.0
  34
  35    is = its - 1; ie = ite + 1; js = jts - 1; je = jte + 1
  36
  37    if (.not. global .and. its == ids) is = ids+1
  38    if (.not. global .and. ite == ide) ie = ide-1
  39    if (jts == jds) js = jds+1; if (jte == jde) je = jde-1
  40
  41    !---------------------------------------------------------------------------
  42    ! [2.0] Calculate divergence:
  43    !---------------------------------------------------------------------------
  44
  45    if (.not. global) then
  46       inv_2ds = 0.5 / grid%xb%ds
  47       do k =kds, kde
  48          um(ims:ime,jms:jme) = 0.0
  49          vm(ims:ime,jms:jme) = 0.0
  50          ! [2.2] Impose zero divergence gradient condition at boundaries:
  51
  52          ! [2.2.4] Right boundaries:
  53
  54          if (jte == jde) then
  55             j = jte
  56             do i = its, ite    ! This is different to original
  57                div(i,j-1,k)=div(i,j-1,k)+div(i,j,k)*one_third*4.0
  58                div(i,j-2,k)=div(i,j-2,k)-div(i,j,k)*one_third
  59                div(i,j,k)=0.0
  60             end do
  61          end if
  62
  63          ! [2.2.3] Left boundaries:
  64
  65          if (jts == jds) then
  66             j = jts
  67             do i = its, ite    ! This is different to original
  68                div(i,j+1,k)=div(i,j+1,k)+div(i,j,k)*one_third*4.0
  69                div(i,j+2,k)=div(i,j+2,k)-div(i,j,k)*one_third
  70                div(i,j,k)=0.0
  71             end do
  72          end if
  73
  74          ! [2.2.2] Top boundaries:
  75
  76          if (ite == ide) then
  77             i = ite
  78             do j = jts, jte
  79                div(i-1,j,k)=div(i-1,j,k)+div(i,j,k)*one_third*4.0
  80                div(i-2,j,k)=div(i-2,j,k)-div(i,j,k)*one_third
  81                div(i,j,k)=0.0
  82             end do
  83          end if
  84
  85          ! [2.2.1] Bottom boundaries:
  86
  87          if (its == ids) then
  88             i = its
  89             do j = jts, jte
  90                div(i+1,j,k)=div(i+1,j,k)+div(i,j,k)*one_third*4.0
  91                div(i+2,j,k)=div(i+2,j,k)-div(i,j,k)*one_third
  92                div(i,j,k)=0.0
  93             end do
  94          end if
  95
  96          ! [2.1] Compute fd divergence at interior points:
  97          ! Computation to check for edge of domain:
  98          ! This is only for adjoint, as we have to cross the processor boundary
  99          ! to get the contribution.
 100
 101          grid%xp%vxy(its:ite, jts:jte) = div(its:ite, jts:jte, k)
 102 #ifdef DM_PARALLEL
 103 #include "HALO_2D_WORK.inc"
 104 #endif
 105
 106          div(is, js:je, k) = grid%xp%vxy(is, js:je)
 107          div(ie, js:je, k) = grid%xp%vxy(ie, js:je)
 108          div(is:ie, js, k) = grid%xp%vxy(is:ie, js)
 109          div(is:ie, je, k) = grid%xp%vxy(is:ie, je)
 110
 111          do j = js, je
 112             do i = is, ie
 113                coeff = grid%xb%map_factor(i,j) * grid%xb%map_factor(i,j) * inv_2ds
 114                um(i+1,j)=um(i+1,j)+div(i,j,k)*coeff
 115                um(i-1,j)=um(i-1,j)-div(i,j,k)*coeff
 116                vm(i,j+1)=vm(i,j+1)+div(i,j,k)*coeff
 117                vm(i,j-1)=vm(i,j-1)-div(i,j,k)*coeff
 118             end do
 119          end do
 120
 121          u(is-1:ie+1,js-1:je+1,k) = u(is-1:ie+1,js-1:je+1,k) +um(is-1:ie+1,js-1:je+1) / grid%xb%map_factor(is-1:ie+1,js-1:je+1)
 122          v(is-1:ie+1,js-1:je+1,k) = v(is-1:ie+1,js-1:je+1,k) +vm(is-1:ie+1,js-1:je+1) / grid%xb%map_factor(is-1:ie+1,js-1:je+1)
 123       end do
 124
 125    else ! global
 126       call da_set_boundary_3d(div)
 127
 128       do k =kds, kde
 129          !-------------------------------------------------------------------------
 130          ! [2.1] Compute fd divergence at interior points:
 131          !-------------------------------------------------------------------------
 132
 133          do j = je, js, -1
 134             do i = ie, is, -1
 135                u(i+1,j,k) = u(i+1,j,k) + grid%xb%coefx(i,j) * div(i,j,k)
 136                u(i-1,j,k) = u(i-1,j,k) - grid%xb%coefx(i,j) * div(i,j,k)
 137                v(i,j+1,k) = v(i,j+1,k) + grid%xb%coefy(i,j) * div(i,j,k)
 138                v(i,j-1,k) = v(i,j-1,k) - grid%xb%coefy(i,j) * div(i,j,k)
 139             end do
 140          end do
 141       end do
 142    end if
 143
 144    div = 0.0
 145
 146    if (trace_use) call da_trace_exit("da_uv_to_divergence_adj")
 147
 148 end subroutine da_uv_to_divergence_adj
 149
 150