var/da/da_test/da_check.inc

   1 subroutine da_check(grid, config_flags, cv_size, xbx, be, ep, iv, vv, vp, y  &
   2 #if (WRF_CHEM == 1)
   3                         , vchem &
   4 #endif
   5                         )
   6
   7 #if (WRF_CHEM == 1)
   8    use module_domain, only : xchem_type
   9    use da_control, only : test_transformsch
  10 #endif
  11
  12    !-----------------------------------------------------------------------
  13    ! Purpose: TBD
  14    !-----------------------------------------------------------------------
  15
  16    implicit none
  17
  18    type(domain),               intent(inout) :: grid
  19    type(grid_config_rec_type), intent(inout) :: config_flags
  20
  21    integer, intent(in)              :: cv_size ! Size of cv array.
  22    type (xbx_type),   intent(inout) :: xbx   ! Header & non-gridded vars.
  23    type (be_type),    intent(in)    :: be    ! background error structure.
  24    type (ep_type),    intent(in)    :: ep    ! Ensemble perturbation structure.
  25    type (iv_type),    intent(inout) :: iv    ! ob. increment vector.
  26    type (vp_type),    intent(inout) :: vv    ! Grdipt/EOF CV.
  27    type (vp_type),    intent(inout) :: vp    ! Grdipt/level CV.
  28    type (y_type),     intent(inout) :: y             ! y = h (xa)
  29
  30 #if (WRF_CHEM == 1)
  31    type(xchem_type), optional, intent(out) :: vchem   ! CHEM_IC CV
  32 #endif
  33
  34    integer :: sizec
  35    real    :: cvtest(1:cv_size)    ! background error structure.
  36    real    :: field(its:ite,jts:jte) ! Field for spectral transform test.
  37
  38    call da_trace_entry("da_check")
  39
  40    !----------------------------------------------------------------------------
  41    ! [1] Set up test data:
  42    !----------------------------------------------------------------------------
  43
  44    ! Initialize cv values with random data:
  45    call random_number(cvtest(:))
  46    cvtest(:) = cvtest(:) - 0.5
  47
  48    ! vv arrays initialized already.
  49    ! vp arrays initialized already.
  50
  51    !----------------------------------------------------------------------------
  52    ! [2] Perform vtox adjoint tests:
  53    !----------------------------------------------------------------------------
  54
  55    call da_message((/"Performing vtox adjoint tests"/))
  56
  57    ! v_to_vv adjoint test:
  58
  59    call da_check_cvtovv_adjoint(grid, cv_size, xbx, be, cvtest, vv)
  60
  61 #if (WRF_CHEM == 1)
  62    if (test_transformsch) then
  63      call da_check_cvtovv_adjoint_chem(grid, cv_size, xbx, be, cvtest, vv, vchem=grid%vchem)
  64    end if
  65 #endif
  66
  67    !-------------------------------------------------------------------------
  68    ! vv_to_vp adjoint test:
  69    !-------------------------------------------------------------------------
  70
  71    call da_check_vvtovp_adjoint(grid, be % ne, grid%xb, be, vv, vp)
  72
  73    !-------------------------------------------------------------------------
  74    ! vptox adjoint test:
  75    !-------------------------------------------------------------------------
  76
  77    call da_check_vptox_adjoint(grid, be % ne, be, ep, vp, cv_size)
  78
  79    !-------------------------------------------------------------------------
  80    ! vtox adjoint test: <x,x> = <v_adj,v>
  81    !-------------------------------------------------------------------------
  82
  83    call da_check_vtox_adjoint(grid, cv_size, xbx, be, ep, cvtest, vv, vp)
  84
  85 #if (WRF_CHEM == 1)
  86    if (test_transformsch) then
  87       call da_check_vchemtox_adjoint(grid, grid%vchem, be, grid%vchem2)
  88       call da_check_vtox_adjoint_chem(grid, cv_size, xbx, be, ep, cvtest, vv, vp)
  89    end if
  90 #endif
  91
  92    !----------------------------------------------------------------------------
  93    ! [2] Perform xtoy adjoint tests:
  94    !----------------------------------------------------------------------------
  95
  96    call da_message((/"Performing xtoy adjoint tests"/))
  97
  98    call da_allocate_y(iv, y)
  99    call da_zero_x(grid%xa)
 100
 101    call da_setup_testfield(grid)
 102
 103    ! WHY?
 104    ! Make cv_array random.
 105
 106    ! call random_number(cvtest(1:cv_size))
 107    ! cvtest(1:cv_size) = cvtest(1:cv_size) - 0.5
 108
 109    ! call da_transform_vtox(grid, cv_size, xbx, be, ep, cvtest, vv, vp)
 110
 111    call da_check_xtoy_adjoint(cv_size, cvtest, xbx, be, grid, config_flags, iv, y)
 112
 113    call da_deallocate_y(y)
 114
 115    !----------------------------------------------------------------------------
 116    ! [3] Perform dynamical constraint test:
 117    !----------------------------------------------------------------------------
 118    call da_message((/"Performing dynamical constraint adjoint tests"/))
 119    call da_zero_x(grid%xa)
 120    call da_setup_testfield(grid)
 121    call da_check_dynamics_adjoint(cv_size, cvtest, xbx, be, grid, config_flags)
 122
 123    !----------------------------------------------------------------------------
 124    ! [4] Perform spectral test:
 125    !----------------------------------------------------------------------------
 126
 127    if (global) then
 128
 129       call da_message((/"Performing spectral tests"/))
 130
 131       call random_number(field(:,:))
 132       field(:,:) = field(:,:) - 0.5
 133
 134       sizec = (be % max_wave+1) * (be % max_wave+2)/2
 135       call da_test_spectral(be % max_wave, sizec, xbx, field)
 136
 137    end if
 138
 139    call da_trace_exit("da_check")
 140
 141 end subroutine da_check
 142
 143