wrfv2_fire/var/da/da_transfer_model/da_transfer_xatowrf.inc

   1 subroutine da_transfer_xatowrf(grid)
   2
   3    !---------------------------------------------------------------------------
   4    !  Purpose: Convert analysis increments into WRF increments
   5    !    Updated for Analysis on Arakawa-C grid
   6    !    Author: Syed RH Rizvi,  MMM/ESSL/NCAR,  Date: 10/22/2008
   7    !
   8    !  The following WRF fields are modified:
   9    !    grid%u_2
  10    !    grid%v_2
  11    !    grid%w_2
  12    !    grid%mu_2
  13    !    grid%ph_2
  14    !    grid%t_2
  15    !    grid%moist
  16    !    grid%p
  17    !    grid%psfc
  18    !    grid%t2, grid%q2, grid%u10, grid%v10, grid%th2
  19    !
  20    !---------------------------------------------------------------------------
  21
  22    implicit none
  23
  24    type(domain), intent(inout)        :: grid
  25
  26    integer :: i, j, k
  27
  28    real    :: sdmd, s1md
  29
  30    ! arrays to hold wrf increments on the c-grid
  31
  32 #ifdef A2C
  33    real, dimension(ims:ime,jms:jme, kms:kme) :: q_cgrid, ph_cgrid
  34 #else
  35    real, dimension(ims:ime,jms:jme, kms:kme) :: &
  36       u_cgrid, v_cgrid, q_cgrid, ph_cgrid
  37 #endif
  38
  39    real, dimension(ims:ime,jms:jme) :: mu_cgrid
  40
  41    real    :: t_full  , p_full, rho_dry, q_full, ph_full , ph_xb_hd, &
  42               qvf1, qvf2, qvf1_b, qvf2_b
  43
  44    real :: uu, vv, ps1, ps2, ts1, ts2, qv1, qv2, height
  45
  46    if (trace_use) call da_trace_entry("da_transfer_xatowrf")
  47
  48    ! To keep the background PH perturbation:
  49
  50    do j=jts,jte
  51       do i=its,ite
  52          do k=kts, kte+1
  53             ph_cgrid(i,j,k) = grid%ph_2(i,j,k)
  54          end do
  55       end do
  56    end do
  57
  58    !---------------------------------------------------------------------------
  59    ! [1.0] Get the mixing ratio of moisture first, as it its easy.
  60    !---------------------------------------------------------------------------
  61
  62    do k=kts,kte
  63       do j=jts,jte
  64          do i=its,ite
  65             if ((grid%xb%q(i,j,k)+grid%xa%q(i,j,k)) < 0.0) then
  66                q_cgrid(i,j,k) =-grid%xb%q(i,j,k)/(1.0 - grid%xb%q(i,j,k))**2
  67             else
  68                q_cgrid(i,j,k) = grid%xa%q(i,j,k)/(1.0 - grid%xb%q(i,j,k))**2
  69             end if
  70          end do
  71       end do
  72    end do
  73
  74    !---------------------------------------------------------------------------
  75    ! [2.0] compute increments of dry-column air mass per unit area
  76    !---------------------------------------------------------------------------
  77
  78    do j=jts,jte
  79       do i=its,ite
  80          sdmd=0.0
  81          s1md=0.0
  82          do k=kts,kte
  83             sdmd=sdmd+q_cgrid(i,j,k)*grid%dnw(k)
  84             s1md=s1md+(1.0+grid%moist(i,j,k,P_QV))*grid%dnw(k)
  85          end do
  86
  87          mu_cgrid(i,j)=-(grid%xa%psfc(i,j)+grid%xb%psac(i,j)*sdmd)/s1md
  88       end do
  89    end do
  90
  91    !---------------------------------------------------------------------------
  92    ! [3.0] compute pressure increments
  93    !---------------------------------------------------------------------------
  94
  95    ! Tangent linear code for grid%xa%p (based on WRF "real.init.code")
  96    ! developed by Y.-R. Guo 05/13/2004:
  97
  98    do j=jts,jte
  99       do i=its,ite
 100          k = kte
 101          qvf1   = 0.5*(q_cgrid(i,j,k)+q_cgrid(i,j,k))
 102          qvf1_b = 0.5*(grid%moist(i,j,k,P_QV)+grid%moist(i,j,k,P_QV))
 103          qvf2   = - qvf1 / ((1.0+qvf1_b)*(1.0+qvf1_b))
 104          qvf2_b = 1.0/(1.0+qvf1_b)
 105          qvf1   = qvf1*qvf2_b + qvf1_b*qvf2
 106          qvf1_b = qvf1_b*qvf2_b
 107          grid%xa%p(i,j,k) = (-0.5/grid%rdnw(k)) * &
 108                     ((mu_cgrid(i,j)+qvf1*grid%mub(i,j)) / qvf2_b &
 109                      -(grid%mu_2(i,j)+qvf1_b*grid%mub(i,j))*qvf2/(qvf2_b*qvf2_b))
 110
 111          do k = kte-1,1,-1
 112             qvf1   = 0.5*(q_cgrid(i,j,k)+q_cgrid(i,j,k+1))
 113             qvf1_b = 0.5*(grid%moist(i,j,k,P_QV)+grid%moist(i,j,k+1,P_QV))
 114             qvf2   = - qvf1 / ((1.0+qvf1_b)*(1.0+qvf1_b))
 115             qvf2_b = 1.0/(1.0+qvf1_b)
 116             qvf1   = qvf1*qvf2_b + qvf1_b*qvf2
 117             qvf1_b = qvf1_b*qvf2_b
 118             grid%xa%p(i,j,k) = grid%xa%p(i,j,k+1)  &
 119                        - (1.0/grid%rdn(k+1)) * &
 120                        ((mu_cgrid(i,j)+qvf1*grid%mub(i,j)) / qvf2_b &
 121                         -(grid%mu_2(i,j)+qvf1_b*grid%mub(i,j))*qvf2/(qvf2_b*qvf2_b))
 122          end do
 123       end do
 124    end do
 125
 126    ! update perturbation pressure
 127
 128    do k=kts, kte
 129      do j=jts,jte
 130         do i=its,ite
 131            grid%p(i,j,k) = grid%p(i,j,k) + grid%xa%p(i,j,k)
 132         end do
 133      end do
 134    end do
 135
 136    ! Adjust grid%xa%q to makte grid%xb%q + grid%xa%q > 0.0
 137
 138    if (check_rh == check_rh_tpw) then
 139       ! Shu-Hua~s TPW conservation:
 140       call da_check_rh(grid)
 141    else if (check_rh == check_rh_simple) then
 142       ! Simple resetting to max/min values:
 143       call da_check_rh_simple(grid)
 144    end if
 145
 146    do k=kts,kte
 147       do j=jts,jte
 148          do i=its,ite
 149             q_cgrid(i,j,k) = grid%xa%q(i,j,k)/(1.0 - grid%xb%q(i,j,k))**2
 150          end do
 151       end do
 152    end do
 153
 154    !---------------------------------------------------------------------------
 155    ! [4.0] Convert temperature increments into theta increments
 156    !       Evaluate also the increments of (1/rho) and geopotential
 157    !---------------------------------------------------------------------------
 158
 159    if (print_detail_xa) then
 160       write(unit=stdout, fmt='(a, e24.12)') &
 161          'sum(abs(grid%xa%t(its:ite,jts:jte,kts:kte)))=', &
 162          sum(abs(grid%xa%t(its:ite,jts:jte,kts:kte))), &
 163          'sum(abs(grid%xa%p(its:ite,jts:jte,kts:kte)))=', &
 164          sum(abs(grid%xa%p(its:ite,jts:jte,kts:kte))), &
 165          'sum(abs(grid%xb%t(its:ite,jts:jte,kts:kte)))=', &
 166          sum(abs(grid%xb%t(its:ite,jts:jte,kts:kte))), &
 167          'sum(abs(grid%xb%p(its:ite,jts:jte,kts:kte)))=', &
 168          sum(abs(grid%xb%p(its:ite,jts:jte,kts:kte))), &
 169          'sum(abs(grid%t_2 (its:ite,jts:jte,kts:kte)))=', &
 170          sum(abs(grid%t_2 (its:ite,jts:jte,kts:kte)))
 171
 172        write(unit=stdout, fmt='(2(2x, a, e20.12))') &
 173           'maxval(grid%xa%u(its:ite,jts:jte,kts:kte))=', &
 174           maxval(grid%xa%u(its:ite,jts:jte,kts:kte)), &
 175           'minval(grid%xa%u(its:ite,jts:jte,kts:kte))=', &
 176           minval(grid%xa%u(its:ite,jts:jte,kts:kte)), &
 177           'maxval(grid%xa%v(its:ite,jts:jte,kts:kte))=', &
 178           maxval(grid%xa%v(its:ite,jts:jte,kts:kte)), &
 179           'minval(grid%xa%v(its:ite,jts:jte,kts:kte))=', &
 180           minval(grid%xa%v(its:ite,jts:jte,kts:kte)), &
 181           'maxval(grid%xa%t(its:ite,jts:jte,kts:kte))=', &
 182           maxval(grid%xa%t(its:ite,jts:jte,kts:kte)), &
 183           'minval(grid%xa%t(its:ite,jts:jte,kts:kte))=', &
 184           minval(grid%xa%t(its:ite,jts:jte,kts:kte)), &
 185           'maxval(grid%xa%q(its:ite,jts:jte,kts:kte))=', &
 186           maxval(grid%xa%q(its:ite,jts:jte,kts:kte)), &
 187           'minval(grid%xa%q(its:ite,jts:jte,kts:kte))=', &
 188           minval(grid%xa%q(its:ite,jts:jte,kts:kte)), &
 189           'maxval(grid%xa%p(its:ite,jts:jte,kts:kte))=', &
 190           maxval(grid%xa%p(its:ite,jts:jte,kts:kte)), &
 191           'minval(grid%xa%p(its:ite,jts:jte,kts:kte))=', &
 192           minval(grid%xa%p(its:ite,jts:jte,kts:kte)), &
 193           'maxval(grid%xa%psfc(its:ite,jts:jte))   =', &
 194           maxval(grid%xa%psfc(its:ite,jts:jte)), &
 195           'minval(grid%xa%psfc(its:ite,jts:jte))   =', &
 196           minval(grid%xa%psfc(its:ite,jts:jte))
 197    end if
 198
 199    do j=jts,jte
 200       do i=its,ite
 201
 202          ph_full  = grid%ht(i,j) * gravity
 203          ph_xb_hd = grid%ht(i,j) * gravity
 204          do k = kts, kte
 205             ! To obtain all of the full fitelds: t, p, q(mixing ratio), rho
 206             t_full   = grid%xa%t(i,j,k) + grid%xb%t(i,j,k)
 207             p_full   = grid%xa%p(i,j,k) + grid%xb%p(i,j,k)
 208             q_full   = grid%moist(i,j,k,P_QV) + q_cgrid(i,j,k)
 209
 210             ! Note: According to WRF, this is the dry air density used to
 211             !       compute the geopotential height:
 212             rho_dry = p_full / (gas_constant*t_full*(1.0+q_full/rd_over_rv))
 213
 214             ! To compute the theta increment with the full fitelds:
 215             grid%t_2(i,j,k) = t_full*(base_pres/p_full)**kappa - t0
 216
 217             ! The full fiteld of analysis ph:
 218             ph_full  = ph_full  &
 219                        - grid%xb%dnw(k) * (grid%xb%psac(i,j)+mu_cgrid(i,j)) / rho_dry
 220
 221             ! background hydrostatic phi:
 222             ph_xb_hd  = ph_xb_hd  &
 223                        - grid%xb%dnw(k) * grid%xb%psac(i,j) / grid%xb%rho(i,j,k)
 224
 225             ! The analysis perturbation = Hydro_ph - base_ph + nonhydro_xb_ph:
 226             grid%ph_2(i,j,k+1) = ph_full - grid%phb(i,j,k+1) &
 227                             + (grid%xb%hf(i,j,k+1)*gravity - ph_xb_hd)
 228          end do
 229       end do
 230    end do
 231
 232    ! To compute the geopotential height increment:
 233
 234    do k=kts, kte+1
 235      do j=jts,jte
 236         do i=its,ite
 237            ph_cgrid(i,j,k) = grid%ph_2(i,j,k) - ph_cgrid(i,j,k)
 238         end do
 239      end do
 240    end do
 241
 242
 243    ! ========================
 244    ! Write out the increment:
 245    ! ========================
 246
 247    if (write_increments) then
 248       write(unit=stdout,fmt='(/"Write out increment for plotting......")')
 249       call da_write_increments (grid, q_cgrid, mu_cgrid, ph_cgrid)
 250    end if
 251
 252 #ifdef A2C
 253
 254    !TBH:  NOTE that grid%xp%halo_id3 = HALO_PSICHI_UV_ADJ which its currently defined
 255    !TBH:  in the Regitstry as "dyn_em 24:grid%xa%u,grid%xa%v,grid%xa%psfc".  Clearly it its not
 256    !TBH:  necessary to update halos in grid%xa%psfc here!
 257
 258 !rizvi's update
 259   if ((fg_format==fg_format_wrf_arw_regional  .or. &
 260        fg_format==fg_format_wrf_arw_global  ) .and. ide == ipe ) then
 261      ipe = ipe + 1
 262      ide = ide + 1
 263   end if
 264
 265   if ((fg_format==fg_format_wrf_arw_regional  .or. &
 266        fg_format==fg_format_wrf_arw_global  ) .and. jde == jpe ) then
 267      jpe = jpe + 1
 268      jde = jde + 1
 269   end if
 270 #else
 271    ! CONVERT FROM A-GRID TO C-GRID
 272
 273
 274    !TBH:  NOTE that grid%xp%halo_id3 = HALO_PSICHI_UV_ADJ which its currently defined
 275    !TBH:  in the Regitstry as "dyn_em 24:grid%xa%u,grid%xa%v,grid%xa%psfc".  Clearly it its not
 276    !TBH:  necessary to update halos in grid%xa%psfc here!  Also, 24-point stencil its
 277    !TBH:  too thick, 9-point should suffice.  Apparently, grid%xp%halo_id3 its used
 278    !TBH:  in many places!  Thits needs to be fixed.
 279 #endif
 280
 281 #ifdef DM_PARALLEL
 282 #include "HALO_PSICHI_UV_ADJ.inc"
 283 #endif
 284
 285 #ifdef A2C
 286   if ((fg_format==fg_format_wrf_arw_regional  .or. &
 287        fg_format==fg_format_wrf_arw_global  ) .and. ide == ipe ) then
 288      ipe = ipe - 1
 289      ide = ide - 1
 290   end if
 291
 292   if ((fg_format==fg_format_wrf_arw_regional  .or. &
 293        fg_format==fg_format_wrf_arw_global  ) .and. jde == jpe ) then
 294      jpe = jpe - 1
 295      jde = jde - 1
 296   end if
 297 #else
 298    ! Fill the boundary
 299
 300    ! The southern boundary
 301    if (jts == jds) then
 302       grid%xa%v(its:ite,jts-1,kts:kte)=2.0*grid%xa%v(its:ite,jts  ,kts:kte) &
 303                             -    grid%xa%v(its:ite,jts+1,kts:kte)
 304    end if
 305
 306    ! The northern boundary
 307    if (jte == jde) then
 308       grid%xa%v(its:ite,jte+1,kts:kte)=2.0*grid%xa%v(its:ite,jte  ,kts:kte) &
 309                             -    grid%xa%v(its:ite,jte-1,kts:kte)
 310    end if
 311
 312    ! The western boundary
 313    if (its == ids) then
 314       grid%xa%u(its-1,jts:jte,kts:kte)=2.0*grid%xa%u(its  ,jts:jte,kts:kte) &
 315                             -    grid%xa%u(its+1,jts:jte,kts:kte)
 316    end if
 317
 318    ! The eastern boundary
 319    if (ite == ide) then
 320       grid%xa%u(ite+1,jts:jte,kts:kte)=2.0*grid%xa%u(ite  ,jts:jte,kts:kte) &
 321                             -    grid%xa%u(ite-1,jts:jte,kts:kte)
 322    end if
 323
 324    do k=kts,kte
 325       do j=jts,jte+1
 326          do i=its,ite+1
 327             u_cgrid(i,j,k)=0.5*(grid%xa%u(i-1,j  ,k)+grid%xa%u(i,j,k))
 328             v_cgrid(i,j,k)=0.5*(grid%xa%v(i  ,j-1,k)+grid%xa%v(i,j,k))
 329          end do
 330       end do
 331    end do
 332
 333    !------------------------------------------------------------------------
 334    ! For later plot and comparation Purpose only, zero out the unused var.
 335    !------------------------------------------------------------------------
 336
 337    ! The northern boundary
 338    if (jte == jde) then
 339       u_cgrid(its:ite+1,jte+1,kts:kte)=0.0
 340    end if
 341
 342    ! The eastern boundary
 343    if (ite == ide) then
 344       v_cgrid(ite+1,jts:jte+1,kts:kte)=0.0
 345    end if
 346 #endif
 347    !---------------------------------------------------------------------------
 348    ! [5.0] add increment to the original guess and update "grid"
 349    !---------------------------------------------------------------------------
 350
 351    do j=jts,jte
 352       do i=its,ite
 353          grid%mu_2(i,j) = grid%mu_2(i,j) + mu_cgrid(i,j)
 354          grid%w_2(i,j,kte+1)=  grid%w_2(i,j,kte+1) + grid%xa%w(i,j,kte+1)
 355          grid%psfc(i,j) = grid%psfc(i,j) + grid%xa%psfc(i,j)
 356       end do
 357
 358       do k=kts,kte
 359          do i=its,ite
 360 #ifndef A2C
 361             grid%u_2(i,j,k) = grid%u_2(i,j,k) + u_cgrid(i,j,k)
 362             grid%v_2(i,j,k) = grid%v_2(i,j,k) + v_cgrid(i,j,k)
 363 #endif
 364             grid%w_2(i,j,k) = grid%w_2(i,j,k) + grid%xa%w(i,j,k)
 365             grid%moist(i,j,k,P_QV) = grid%moist(i,j,k,P_QV) + q_cgrid(i,j,k)
 366
 367             if (size(grid%moist,dim=4) >= 4) then
 368                grid%moist(i,j,k,p_qc) = grid%moist(i,j,k,p_qc) + grid%xa%qcw(i,j,k)
 369                grid%moist(i,j,k,p_qr) = grid%moist(i,j,k,p_qr) + grid%xa%qrn(i,j,k)
 370                if (grid%moist(i,j,k,p_qc) < 0.0) grid%moist(i,j,k,p_qc) = 0.0
 371                if (grid%moist(i,j,k,p_qr) < 0.0) grid%moist(i,j,k,p_qr) = 0.0
 372             end if
 373
 374             if (size(grid%moist,dim=4) >= 6) then
 375                grid%moist(i,j,k,p_qi) = grid%moist(i,j,k,p_qi) + grid%xa%qci(i,j,k)
 376                grid%moist(i,j,k,p_qs) = grid%moist(i,j,k,p_qs) + grid%xa%qsn(i,j,k)
 377                if (grid%moist(i,j,k,p_qi) < 0.0) grid%moist(i,j,k,p_qi) = 0.0
 378                if (grid%moist(i,j,k,p_qs) < 0.0) grid%moist(i,j,k,p_qs) = 0.0
 379             end if
 380
 381             if (size(grid%moist,dim=4) >= 7) then
 382                grid%moist(i,j,k,p_qg) = grid%moist(i,j,k,p_qg) + grid%xa%qgr(i,j,k)
 383                if (grid%moist(i,j,k,p_qg) < 0.0) grid%moist(i,j,k,p_qg) = 0.0
 384             end if
 385          end do
 386       end do
 387    end do
 388
 389 #ifdef A2C
 390    do j=jts,jte
 391       do k=kts,kte
 392          do i=its,ite+1
 393           grid%u_2(i,j,k) = grid%u_2(i,j,k) + grid%xa%u(i,j,k)
 394          end do
 395       end do
 396    end do
 397
 398    do j=jts,jte+1
 399       do k=kts,kte
 400          do i=its,ite
 401           grid%v_2(i,j,k) = grid%v_2(i,j,k) + grid%xa%v(i,j,k)
 402          end do
 403       end do
 404    end do
 405 #else
 406    ! The northern boundary
 407    if (jte == jde) then
 408       j=jte+1
 409       do k=kts,kte
 410          do i=its,ite
 411             grid%v_2(i,j,k) = grid%v_2(i,j,k) + v_cgrid(i,j,k)
 412          end do
 413       end do
 414    end if
 415
 416    ! The eastern boundary
 417    if (ite == ide) then
 418       i=ite+1
 419       do k=kts,kte
 420          do j=jts,jte
 421             grid%u_2(i,j,k) = grid%u_2(i,j,k) + u_cgrid(i,j,k)
 422          end do
 423       end do
 424    end if
 425 #endif
 426
 427 #ifdef DM_PARALLEL
 428 #include "HALO_EM_C.inc"
 429 #endif
 430 ! re-calculate T2, Q2, U10, V10, TH2 using updated fields
 431
 432    do j=jts,jte
 433       do i=its,ite
 434          uu = 0.5*(grid%u_2(i,j,kts)+grid%u_2(i+1,j,kts) )
 435          vv = 0.5*(grid%v_2(i,j,kts)+grid%v_2(i,j+1,kts) )
 436          ps1 = grid%p(i,j,kts)   + grid%pb(i,j,kts)
 437          ps2 = grid%p(i,j,kts+1) + grid%pb(i,j,kts+1)
 438          ts1 = (t0+grid%t_2(i,j,kts))*(ps1/base_pres)**kappa
 439          ts2 = (t0+grid%t_2(i,j,kts+1))*(ps2/base_pres)**kappa
 440          qv1 = grid%moist(i,j,kts, p_qv)/(1.0+grid%moist(i,j,kts,p_qv))
 441          qv2 = grid%moist(i,j,kts+1, p_qv)/(1.0+grid%moist(i,j,kts+1,p_qv))
 442          height = 0.5*(grid%phb(i,j,kts)+grid%ph_2(i,j,kts)+ &
 443                        grid%phb(i,j,kts+1)+grid%ph_2(i,j,kts+1))/gravity
 444          height = height - grid%ht(i,j)
 445          if (height <= 0.0) then
 446             message(1) = "Negative height found"
 447             write (unit=message(2),FMT='(2I6,A,F10.2,A,F10.2)') &
 448                i,j,' ht = ',height ,' terr =  ',grid%ht(i,j)
 449             call da_error(__FILE__,__LINE__, message(1:2))
 450          end if
 451          call da_sfc_wtq(grid%psfc(i,j), grid%tsk(i,j), &
 452             ps1, ts1, qv1, uu, vv, &
 453             ps2, ts2, qv2, &
 454             height,  grid%xb%rough(i,j),grid%xb%xland(i,j), &
 455             grid%u10(i,j), grid%v10(i,j), grid%t2(i,j), &
 456             grid%q2(i,j), grid%xb%regime(i,j))
 457          grid%th2(i,j) = grid%t2(i,j)*(base_pres/ps1)**kappa
 458       end do
 459    end do
 460
 461    if (print_detail_xa) then
 462       write(unit=stdout, fmt=*) 'simple variables:'
 463
 464       if (ite == ide) then
 465          write (unit=stdout,fmt=*)  ' '
 466
 467          do k=kts+5,kte,10
 468             do j=jts,jte,10
 469                write(unit=stdout, fmt=*) &
 470                     '  grid%u_2(', ide+1, ',', j, ',', k, ')=', &
 471                        grid%u_2(ide+1,j,k)
 472             end do
 473             write(unit=stdout, fmt=*) ' '
 474          end do
 475       end if
 476
 477       if (jte == jde) then
 478          write(unit=stdout, fmt=*) ' '
 479
 480          do k=kts+5,kte,10
 481             do i=its,ite,10
 482                write(unit=stdout, fmt=*) &
 483                     '  grid%v_2(', i, ',', jde+1, ',', k, ')=', &
 484                        grid%v_2(i, jde+1,k)
 485             end do
 486             write(unit=stdout, fmt=*) ' '
 487          end do
 488       end if
 489
 490 #ifdef A2C
 491       write(unit=stdout, fmt='(2(2x, a, e20.12))') &
 492          'maxval(mu_cgrid(its:ite,jts:jte))       =', &
 493          maxval(mu_cgrid(its:ite,jts:jte)), &
 494          'minval(mu_cgrid(its:ite,jts:jte))       =', &
 495          minval(mu_cgrid(its:ite,jts:jte)), &
 496          'maxval(q_cgrid(its:ite,jts:jte,kts:kte))  =', &
 497          maxval(q_cgrid(its:ite,jts:jte,kts:kte)), &
 498          'minval(q_cgrid(its:ite,jts:jte,kts:kte))  =', &
 499          minval(q_cgrid(its:ite,jts:jte,kts:kte))
 500 #else
 501       write(unit=stdout, fmt='(2(2x, a, e20.12))') &
 502          'maxval(mu_cgrid(its:ite,jts:jte))       =', &
 503          maxval(mu_cgrid(its:ite,jts:jte)), &
 504          'minval(mu_cgrid(its:ite,jts:jte))       =', &
 505          minval(mu_cgrid(its:ite,jts:jte)), &
 506         'maxval(u_cgrid(its:ite,jts:jte,kts:kte))  =', &
 507          maxval(u_cgrid(its:ite,jts:jte,kts:kte)), &
 508          'minval(u_cgrid(its:ite,jts:jte,kts:kte))  =', &
 509          minval(u_cgrid(its:ite,jts:jte,kts:kte)), &
 510          'maxval(v_cgrid(its:ite,jts:jte,kts:kte))  =', &
 511          maxval(v_cgrid(its:ite,jts:jte,kts:kte)), &
 512          'minval(v_cgrid(its:ite,jts:jte,kts:kte))  =', &
 513          minval(v_cgrid(its:ite,jts:jte,kts:kte)), &
 514          'maxval(q_cgrid(its:ite,jts:jte,kts:kte))  =', &
 515          maxval(q_cgrid(its:ite,jts:jte,kts:kte)), &
 516          'minval(q_cgrid(its:ite,jts:jte,kts:kte))  =', &
 517          minval(q_cgrid(its:ite,jts:jte,kts:kte))
 518 #endif
 519
 520       do k=kts,kte
 521          write(unit=stdout, fmt='(a, i3)') 'k=', k
 522
 523 #ifdef A2C
 524          write(unit=stdout, fmt='(2(2x, a, e20.12))') &
 525             'maxval(q_cgrid(its:ite,jts:jte,k))  =', maxval(q_cgrid(its:ite,jts:jte,k)), &
 526             'minval(q_cgrid(its:ite,jts:jte,k))  =', minval(q_cgrid(its:ite,jts:jte,k))
 527 #else
 528          write(unit=stdout, fmt='(2(2x, a, e20.12))') &
 529             'maxval(u_cgrid(its:ite,jts:jte,k))  =', maxval(u_cgrid(its:ite,jts:jte,k)), &
 530             'minval(u_cgrid(its:ite,jts:jte,k))  =', minval(u_cgrid(its:ite,jts:jte,k)), &
 531             'maxval(v_cgrid(its:ite,jts:jte,k))  =', maxval(v_cgrid(its:ite,jts:jte,k)), &
 532             'minval(v_cgrid(its:ite,jts:jte,k))  =', minval(v_cgrid(its:ite,jts:jte,k)), &
 533             'maxval(q_cgrid(its:ite,jts:jte,k))  =', maxval(q_cgrid(its:ite,jts:jte,k)), &
 534             'minval(q_cgrid(its:ite,jts:jte,k))  =', minval(q_cgrid(its:ite,jts:jte,k))
 535 #endif
 536       end do
 537    end if
 538
 539    if (trace_use) call da_trace_exit("da_transfer_xatowrf")
 540
 541 end subroutine da_transfer_xatowrf
 542
 543