var/da/da_test/da_check_cvtovv_adjoint.inc

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