var/da/da_test/da_check_cvtovv_adjoint_chem.inc

   1 subroutine da_check_cvtovv_adjoint_chem(grid, cv_size, xbx, be, cv, vv, vchem)
   2
   3    !---------------------------------------------------------------------------
   4    ! Purpose: Test vtovv routine and adjoint for compatibility.
   5    !
   6    ! Method:  Standard adjoint test: < vv, vv > = < cv_adj, cv >.
   7    !---------------------------------------------------------------------------
   8
   9    use module_state_description, only : num_chem, PARAM_FIRST_SCALAR
  10    use module_domain, only : xchem_type
  11
  12    implicit none
  13
  14    type(domain), intent(inout)               :: grid
  15
  16    integer, intent(in)               :: cv_size ! Size of cv array.
  17    type (xbx_type),intent(in)        :: xbx   ! Header & non-gridded vars.
  18    type (be_type), intent(in)        :: be    ! background error structure.
  19    real, intent(in)                  :: cv(1:cv_size) ! control variable.
  20    type (vp_type), intent(inout)     :: vv    ! CV(i,j,m).
  21    type(xchem_type), intent(out) :: vchem   ! CHEM_IC CV
  22    real                              :: adj_par_lhs ! < Vv, Vv >
  23    real                              :: adj_par_rhs ! < cv_adj, cv >
  24    real                              :: adj_sum_lhs ! < Vv, Vv >
  25    real                              :: adj_sum_rhs ! < cv_adj, cv >
  26    real                              :: cv2(1:cv_size)! control variable.
  27    integer                           :: cv_size_tmp, ic
  28
  29    !-------------------------------------------------------------------------
  30    ! [1.0] Initialise:
  31    !-------------------------------------------------------------------------
  32
  33    if (trace_use) call da_trace_entry("da_check_cvtovv_adjoint_chem")
  34
  35    if (cv_options == 3 ) then
  36       write(unit=stdout, fmt='(/a,i2,a/)') 'cv_options =',cv_options, &
  37                      '   no da_check_cvtovv_adjoint_chem check...'
  38       goto 1234
  39    end if
  40
  41    write(unit=stdout, fmt='(/a/)') 'da_check_cvtovv_adjoint_chem: Test Results:'
  42
  43    !-------------------------------------------------------------------------
  44    ! [2.0] Perform Vp = U_v Vv transform:
  45    !-------------------------------------------------------------------------
  46
  47    if (global) then
  48       call da_transform_vtovv_global(cv_size, xbx, be, cv, vv)
  49    else
  50       call da_transform_vtovv(grid, cv_size, be, cv, vv, vchem=vchem)
  51    end if
  52
  53    !----------------------------------------------------------------------
  54    ! [3.0] Calculate LHS of adjoint test equation:
  55    !----------------------------------------------------------------------
  56    adj_par_lhs = sum(vv % v1(its:ite,jts:jte,1:be%v1%mz)**2) &
  57                + sum(vv % v2(its:ite,jts:jte,1:be%v2%mz)**2) &
  58                + sum(vv % v3(its:ite,jts:jte,1:be%v3%mz)**2) &
  59                + sum(vv % v4(its:ite,jts:jte,1:be%v4%mz)**2) &
  60                + sum(vv % v5(its:ite,jts:jte,1:be%v5%mz)**2)
  61
  62    if ( cloud_cv_options >= 2 ) then
  63       adj_par_lhs = adj_par_lhs                                   &
  64                   + sum(vv % v6(its:ite,jts:jte,1:be%v6%mz)**2)   &
  65                   + sum(vv % v7(its:ite,jts:jte,1:be%v7%mz)**2)   &
  66                   + sum(vv % v8(its:ite,jts:jte,1:be%v8%mz)**2)   &
  67                   + sum(vv % v9(its:ite,jts:jte,1:be%v9%mz)**2)   &
  68                   + sum(vv % v10(its:ite,jts:jte,1:be%v10%mz)**2)
  69    end if
  70
  71    if ( use_cv_w ) then
  72       adj_par_lhs = adj_par_lhs                                   &
  73                   + sum(vv % v11(its:ite,jts:jte,1:be%v11%mz)**2)
  74    end if
  75
  76    do ic = PARAM_FIRST_SCALAR ,num_chem
  77      adj_par_lhs = adj_par_lhs + sum(vchem % chem_ic(its:ite,jts:jte,1:be%v12(ic-1)%mz,ic)**2)
  78    end do
  79
  80    if (be % ne > 0) then
  81 !     adj_par_lhs = adj_par_lhs + sum(vv % alpha(its:ite,jts:jte,1:be%alpha%mz,1:be%ne)**2)
  82       adj_par_lhs = adj_par_lhs + sum(vv % alpha(its_int:ite_int,jts_int:jte_int,1:be%alpha%mz,1:be%ne)**2)
  83    end if
  84
  85    !----------------------------------------------------------------------
  86    ! [4.0] Calculate RHS of adjoint test equation:
  87    !----------------------------------------------------------------------
  88
  89 !!!   cv2 = 0.0
  90
  91    if (global) then
  92       call da_transform_vtovv_global_adj(cv_size, xbx, be, cv2, vv)
  93    else
  94       call da_transform_vtovv_adj(grid, cv_size, be, cv2, vv, vchem=vchem)
  95    end if
  96
  97    cv_size_tmp = cv_size - be%cv%size_jp - be%cv%size_js - be%cv%size_jl
  98    adj_par_rhs = sum(cv(1:cv_size_tmp) * cv2(1:cv_size_tmp))
  99
 100    !----------------------------------------------------------------------
 101    ! [5.0] Print output:
 102    !----------------------------------------------------------------------
 103
 104    if (.not. global ) then
 105     if( num_procs == 1) then
 106       write(unit=stdout, fmt='(a,e22.14)') &
 107          'Single Domain: < Vv, Vv >     = ', adj_par_lhs, &
 108          'Single Domain: < cv_adj, cv > = ', adj_par_rhs
 109     else
 110       write(unit=stdout, fmt='(/a/,a/)')&
 111         'It is Multi Processor Run: ',&
 112         'For Single Domain: da_check_cvtovv_adjoint_chem Test: Not Performed'
 113     endif
 114    end if
 115
 116    adj_sum_lhs = wrf_dm_sum_real(adj_par_lhs)
 117
 118    if (global) then
 119       adj_sum_rhs = adj_par_rhs
 120    else
 121       adj_sum_rhs = wrf_dm_sum_real(adj_par_rhs)
 122    end if
 123
 124    if (rootproc) then
 125       write(unit=stdout, fmt='(/)')
 126       write(unit=stdout, fmt='(a,1pe22.14)') &
 127            'Whole  Domain: < Vv, Vv >     = ', adj_sum_lhs, &
 128            'Whole  Domain: < cv_adj, cv > = ', adj_sum_rhs
 129    end if
 130
 131    write(unit=stdout, fmt='(/a/)') &
 132       'da_check_cvtovv_adjoint_chem: Test Finished.'
 133
 134 1234 continue
 135
 136    if (trace_use) call da_trace_exit("da_check_cvtovv_adjoint_chem")
 137
 138 end subroutine da_check_cvtovv_adjoint_chem
 139
 140