var/da/da_dynamics/da_balance_cycloterm_adj.inc

   1 subroutine da_balance_cycloterm_adj (rho, ub, vb, u, v, coefx, coefy, term_x, term_y)
   2
   3    !---------------------------------------------------------------------------
   4    ! Purpose: Adjoint of da_balance_cycloterm
   5    !---------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    real, intent(in)    :: rho(ims:ime,jms:jme)    ! Density.
  10    real, intent(in)    :: ub(ims:ime,jms:jme)     ! Background u wind
  11    real, intent(in)    :: vb(ims:ime,jms:jme)     ! Background u wind
  12    real, intent(in)    :: term_x(ims:ime,jms:jme) ! x component of term
  13    real, intent(in)    :: term_y(ims:ime,jms:jme) ! y component of term
  14    real, intent(in)    :: coefx(ims:ime,jms:jme)
  15    real, intent(in)    :: coefy(ims:ime,jms:jme)  ! Mulplicative coeff.
  16
  17    real, intent(inout) :: u(ims:ime,jms:jme)      ! u wind increment
  18    real, intent(inout) :: v(ims:ime,jms:jme)      ! v wind increment
  19
  20    integer              :: i, j                         ! Loop counters.
  21    integer              :: is, ie                       ! 1st dim. end points.
  22    integer              :: js, je                       ! 2nd dim. end points.
  23    real                 :: data(ims:ime,jms:jme)        ! Work array.
  24
  25    real                 :: var, varb, uar
  26
  27    if (trace_use) call da_trace_entry("da_balance_cycloterm_adj")
  28
  29    !---------------------------------------------------------------------------
  30    ! [1.0] Initialise:
  31    !---------------------------------------------------------------------------
  32
  33    ! Computation to check for edge of domain:
  34    is = its; ie = ite; js = jts; je = jte
  35    if (.not. global .and. its == ids) is = ids+1
  36    if (.not. global .and. ite == ide) ie = ide-1
  37    if (jts == jds) js = jds+1
  38    if (jte == jde) je = jde-1
  39
  40    !---------------------------------------------------------------------------
  41    ! [3.0] Calculate term_y = rho M ( u'dv/dx + v'dv/dy + udv'/dx + vdv'/dy ):
  42    !---------------------------------------------------------------------------
  43
  44    ! [3.7] Multiply by rho and add to term_y
  45
  46    data(its:ite,jts:jte) = rho(its:ite,jts:jte) * term_y(its:ite,jts:jte)
  47
  48    if (.NOT. global) then
  49
  50       ! [3.6] Corner points:
  51
  52       if (its == ids .AND. jts == jds ) then
  53          data(its,jts+1) = data(its,jts+1) + 0.5 * data(its,jts)
  54          data(its+1,jts) = data(its+1,jts) + 0.5 * data(its,jts)
  55       end if
  56
  57       if (ite == ide .AND. jts == jds ) then
  58          data(ite-1,jts) = data(ite-1,jts) + 0.5 * data(ite,jts)
  59          data(ite,jts+1) = data(ite,jts+1) + 0.5 * data(ite,jts)
  60       end if
  61
  62       if (its == ids .AND. jte == jde ) then
  63          data(its,jde-1) = data(its,jde-1) + 0.5 * data(its,jde)
  64          data(its+1,jde) = data(its+1,jde) + 0.5 * data(its,jde)
  65       end if
  66
  67       if (ite == ide .AND. jte == jde ) then
  68          data(ite-1,jte) = data(ite-1,jte) + 0.5 * data(ite,jte)
  69          data(ite,jte-1) = data(ite,jte-1) + 0.5 * data(ite,jte)
  70       end if
  71
  72       ! [3.5] Right boundaries:
  73
  74       if (jte == jde ) then
  75          j = jte
  76
  77          do i = is, ie
  78             varb = 3.0*vb(i,j)-4.0*vb(i,j-1)+vb(i,j-2)
  79
  80             var = coefy(i,j)* vb(i,j) * data(i,j)
  81             uar = coefx(i,j)* data(i,j) * ub(i,j)
  82
  83             u(i,j)   = u(i,j) + coefx(i,j)*data(i,j) * ( vb(i+1,j) - vb(i-1,j) )
  84             v(i,j)   = v(i,j) + coefy(i,j)*data(i,j) * varb
  85             v(i+1,j) = v(i+1,j) + uar
  86             v(i-1,j) = v(i-1,j) - uar
  87
  88             v(i,j) = v(i,j) + 3.0*var
  89             v(i,j-1) = v(i,j-1) -4.0*var
  90             v(i,j-2) = v(i,j-2) + var
  91          end do
  92       end if
  93
  94       ! [3.4] Left boundaries:
  95
  96       if (jts == jds ) then
  97          j = jts
  98
  99          do i = is, ie
 100             varb = -3.0*vb(i,j)+4.0*vb(i,j+1)-vb(i,j+2)
 101
 102             var = coefy(i,j)*vb(i,j) * data(i,j)
 103             uar = coefx(i,j)*ub(i,j) * data(i,j)
 104
 105             v(i,j)   = v(i,j) + coefy(i,j)*data(i,j) * varb
 106             v(i+1,j) = v(i+1,j) + uar
 107             v(i-1,j) = v(i-1,j) - uar
 108
 109             v(i,j) = v(i,j) - 3.0*var
 110             v(i,j+1) = v(i,j+1) +4.0*var
 111             v(i,j+2) = v(i,j+2) - var
 112          end do
 113       end if
 114
 115       ! [3.3] Top boundaries:
 116
 117       if (ite == ide ) then
 118          i = ite
 119
 120          do j = js, je
 121             varb = 3.0*vb(i,j)-4.0*vb(i-1,j)+vb(i-2,j)
 122
 123             var = coefx(i,j)* ub(i,j) * data(i,j)
 124             uar = coefy(i,j)* vb(i,j) * data(i,j)
 125
 126             u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
 127             v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( vb(i,j+1) - vb(i,j-1) )
 128             v(i,j+1) = v(i,j+1) + uar
 129             v(i,j-1) = v(i,j-1) - uar
 130
 131             v(i,j) = v(i,j) + 3.0*var
 132             v(i-1,j) = v(i-1,j) -4.0**var
 133             v(i-2,j) = v(i-2,j) + var
 134          end do
 135       end if
 136
 137       ! [3.2] Bottom boundaries:
 138
 139       if (its == ids ) then
 140          i = its
 141
 142          do j = js, je
 143             varb = -3.0*vb(i,j)+4.0*vb(i+1,j)-vb(i+2,j)
 144
 145             var = coefx(i,j)* ub(i,j) * data(i,j)
 146             uar = coefy(i,j)* vb(i,j) * data(i,j)
 147
 148             u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
 149             v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( vb(i,j+1) - vb(i,j-1) )
 150             v(i,j+1) = v(i,j+1) + uar
 151             v(i,j-1) = v(i,j-1) - uar
 152
 153             v(i,j) = v(i,j) - 3.0*var
 154             v(i+1,j) = v(i+1,j) +4.0**var
 155             v(i+2,j) = v(i+2,j) - var
 156          end do
 157       end if
 158    end if ! not global
 159
 160    !  [3.1] Interior points:
 161
 162    do j = je, js, -1
 163       do i = ie, is, -1
 164          uar = coefx(i,j) * ub(i,j) * data(i,j)
 165          var = coefy(i,j) * vb(i,j) * data(i,j)
 166
 167          u(i,j) = u(i,j) + coefx(i,j)*data(i,j)*( vb(i+1,j) - vb(i-1,j) )
 168          v(i,j) = v(i,j) + coefy(i,j)*data(i,j)*( vb(i,j+1) - vb(i,j-1) )
 169          v(i+1,j) = v(i+1,j) + uar
 170          v(i-1,j) = v(i-1,j) - uar
 171          v(i,j+1) = v(i,j+1) + var
 172          v(i,j-1) = v(i,j-1) - var
 173       end do
 174    end do
 175
 176    !---------------------------------------------------------------------------
 177    ! [2.0] Calculate term_x = rho M ( u'du/dx + v'du/dy + udu'/dx + vdu'/dy ):
 178    !---------------------------------------------------------------------------
 179
 180    ! [2.7] Multiply by rho and add to term_x:
 181
 182    data(its:ite,jts:jte) = rho(its:ite,jts:jte) * term_x(its:ite,jts:jte)
 183
 184    if( .NOT. global) then
 185       ! [2.6] Corner points:
 186
 187       if (its == ids .AND. jts == jds ) then
 188          data(its,jts+1) = data(its,jts+1) + 0.5 * data(its,jts)
 189          data(its+1,jts) = data(its+1,jts) + 0.5 * data(its,jts)
 190       end if
 191
 192       if (ite == ide .AND. jts == jds ) then
 193          data(ite-1,jts) = data(ite-1,jts) + 0.5 * data(ite,jts)
 194          data(ite,jts+1) = data(ite,jts+1) + 0.5 * data(ite,jts)
 195       end if
 196
 197       if (its == ids .AND. jte == jde ) then
 198          data(its,jde-1) = data(its,jde-1) + 0.5 * data(its,jde)
 199          data(its+1,jde) = data(its+1,jde) + 0.5 * data(its,jde)
 200       end if
 201
 202       if (ite == ide .AND. jte == jde ) then
 203          data(ite-1,jte) = data(ite-1,jte) + 0.5 * data(ite,jte)
 204          data(ite,jte-1) = data(ite,jte-1) + 0.5 * data(ite,jte)
 205       end if
 206
 207       ! [2.5] Right boundaries:
 208
 209       if (jte == jde ) then
 210          j = jte
 211
 212          do i = is, ie
 213             varb = 3.0*ub(i,j)-4.0*ub(i,j-1)+ub(i,j-2)
 214             var  = coefy(i,j) * vb(i,j) * data(i,j)
 215             uar  = coefx(i,j) * ub(i,j) * data(i,j)
 216
 217             u(i+1,j) = u(i+1,j) + uar
 218             u(i-1,j) = u(i-1,j) - uar
 219             v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * varb
 220             u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * ( ub(i+1,j) - ub(i-1,j) )
 221
 222             u(i,j) = u(i,j) + 3.0*var
 223             u(i,j-1) = u(i,j-1) -4.0*var
 224             u(i,j-2) = u(i,j-2) + var
 225          end do
 226       end if
 227
 228       ! [2.4] Left boundaries:
 229
 230       if (jts == jds ) then
 231          j = jts
 232
 233          do i = is, ie
 234             varb = -3.0*ub(i,j)+4.0*ub(i,j+1)-ub(i,j+2)
 235             var = coefy(i,j)*vb(i,j) * data(i,j)
 236             uar = coefx(i,j)*ub(i,j) * data(i,j)
 237
 238             u(i+1,j) = u(i+1,j) + uar
 239             u(i-1,j) = u(i-1,j) - uar
 240             v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * varb
 241             u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * ( ub(i+1,j) - ub(i-1,j) )
 242
 243             u(i,j) = u(i,j) - 3.0*var
 244             u(i,j+1) = u(i,j+1) +4.0*var
 245             u(i,j+2) = u(i,j+2) - var
 246          end do
 247       end if
 248
 249       ! [2.3] Top boundaries:
 250
 251       if (ite == ide ) then
 252          i = ite
 253
 254          do j = js, je
 255             varb = 3.0*ub(i,j)-4.0*ub(i-1,j)+ub(i-2,j)
 256             var = coefx(i,j)*ub(i,j) * data(i,j)
 257             uar = coefy(i,j)*vb(i,j) * data(i,j)
 258
 259             u(i,j+1) = u(i,j+1) + uar
 260             u(i,j-1) = u(i,j-1) - uar
 261             v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( ub(i,j+1) - ub(i,j-1) )
 262             u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
 263
 264             u(i,j)   = u(i,j) + 3.0*var
 265             u(i-1,j) =  u(i-1,j) - 4.0*var
 266             u(i-2,j) =  u(i-2,j) + var
 267          end do
 268       end if
 269
 270       ! [2.2] Bottom boundaries:
 271
 272       if (its == ids ) then
 273          i = its
 274
 275          do j = js, je
 276             varb = -3.0*ub(i,j)+4.0*ub(i+1,j)-ub(i+2,j)
 277             var = coefy(i,j)*ub(i,j) * data(i,j)
 278             uar = coefy(i,j)*vb(i,j) * data(i,j)
 279
 280             u(i,j+1) = u(i,j+1) + uar
 281             u(i,j-1) = u(i,j-1) - uar
 282             v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( ub(i,j+1) - ub(i,j-1) )
 283             u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
 284
 285             u(i,j) = u(i,j) - 3.0*var
 286             u(i+1,j) =  u(i+1,j) + 4.0*var
 287             u(i+2,j) =  u(i+2,j) - var
 288          end do
 289       end if
 290    end if ! not global
 291
 292    ! [2.1] Interior points:
 293
 294    do j = je, js, -1
 295       do i = ie, is, -1
 296          uar = coefx(i,j) * ub(i,j) * data(i,j)
 297          var = coefy(i,j) * vb(i,j) * data(i,j)
 298
 299          u(i,j) = u(i,j) + coefx(i,j)*( ub(i+1,j) - ub(i-1,j) ) * data(i,j)
 300          v(i,j) = v(i,j) + coefy(i,j)*( ub(i,j+1) - ub(i,j-1) ) * data(i,j)
 301          u(i+1,j) = u(i+1,j) + uar
 302          u(i-1,j) = u(i-1,j) - uar
 303          u(i,j+1) = u(i,j+1) + var
 304          u(i,j-1) = u(i,j-1) - var
 305       end do
 306    end do
 307
 308    if (trace_use) call da_trace_exit("da_balance_cycloterm_adj")
 309
 310 end subroutine da_balance_cycloterm_adj
 311
 312