var/da/da_test/da_setup_testfield.inc

   1 subroutine da_setup_testfield(grid)
   2
   3    !----------------------------------------------------------------------------
   4    ! Purpose: produce test increment field based on grid%xb field.
   5    !
   6    ! Method:  pass through x=uv transfom to ensure satisfies boundary conditions
   7    !----------------------------------------------------------------------------
   8
   9    implicit none
  10
  11    type (domain), intent(inout)   :: grid
  12
  13    integer :: i, j
  14
  15    if (trace_use) call da_trace_entry("da_setup_testfield")
  16
  17    !-------------------------------------------------------------------------
  18    ! [1.0]: initialise:
  19    !-------------------------------------------------------------------------
  20
  21    write(unit=stdout, fmt='(/a/)') &
  22       'Starting da_setup_testfield ...'
  23
  24    !-------------------------------------------------------------------------
  25    ! [2.0]: set up test increment field structure:
  26    !-------------------------------------------------------------------------
  27
  28    ! [2.1] test wind, temperature, pressure, humidity and cloud parameters
  29
  30    call da_set_tst_trnsf_fld(grid, grid%xa%u, grid%xb%u, typical_u_rms)
  31    call da_set_tst_trnsf_fld(grid, grid%xa%v, grid%xb%v, typical_v_rms)
  32    call da_set_tst_trnsf_fld(grid, grid%xa%w, grid%xb%w, typical_w_rms)
  33    call da_set_tst_trnsf_fld(grid, grid%xa%t, grid%xb%t, typical_t_rms)
  34    call da_set_tst_trnsf_fld(grid, grid%xa%p, grid%xb%p, typical_p_rms)
  35    call da_set_tst_trnsf_fld(grid, grid%xa%q, grid%xb%q, typical_q_rms)
  36    if ( ( use_rad .and. crtm_cloud ) .or. use_radar_rf .or. use_radar_rhv ) then
  37       call da_set_tst_trnsf_fld(grid, grid%xa%qcw, grid%xb%qcw, typical_qcw_rms)
  38       call da_set_tst_trnsf_fld(grid, grid%xa%qrn, grid%xb%qrn, typical_qrn_rms)
  39       call da_set_tst_trnsf_fld(grid, grid%xa%qci, grid%xb%qci, typical_qci_rms)
  40       call da_set_tst_trnsf_fld(grid, grid%xa%qsn, grid%xb%qsn, typical_qsn_rms)
  41       call da_set_tst_trnsf_fld(grid, grid%xa%qgr, grid%xb%qgr, typical_qgr_rms)
  42    end if
  43
  44    ! [2.5] get test density increment from linearised ideal gas law:
  45
  46    call da_pt_to_rho_lin(grid)
  47
  48    grid%xa%psfc(grid%xp%its:grid%xp%ite, grid%xp%jts:grid%xp%jte) = &
  49    grid%xa%p   (grid%xp%its:grid%xp%ite, grid%xp%jts:grid%xp%jte, grid%xp%kts)
  50
  51    if (print_detail_testing) then
  52       write(unit=stdout, fmt='(2a,4x,a,i8)') &
  53          'file:', __FILE__, 'line:', __LINE__
  54
  55       write(unit=stdout, fmt=*) 'grid%xp%its, grid%xp%ite, grid%xp%jts, grid%xp%jte) =', &
  56          grid%xp%its, grid%xp%ite, grid%xp%jts, grid%xp%jte
  57
  58       do j=grid%xp%jts, grid%xp%jte
  59          do i=grid%xp%its, grid%xp%ite
  60             if (i == j) then
  61                write(unit=stdout, fmt='(2(a,i4),a,f14.6)') &
  62                   'grid%xa%psfc(', i, ',', j, ') =', grid%xa%psfc(i, j)
  63             end if
  64          end do
  65       end do
  66    end if
  67
  68 #ifdef A2C
  69   if ((fg_format==fg_format_wrf_arw_regional  .or. &
  70        fg_format==fg_format_wrf_arw_global  ) .and. ide == ipe ) then
  71      ipe = ipe + 1
  72      ide = ide + 1
  73   end if
  74
  75   if ((fg_format==fg_format_wrf_arw_regional  .or. &
  76        fg_format==fg_format_wrf_arw_global  ) .and. jde == jpe ) then
  77      jpe = jpe + 1
  78      jde = jde + 1
  79   end if
  80 #endif
  81
  82 #ifdef DM_PARALLEL
  83 #include "HALO_XA.inc"
  84 #endif
  85
  86
  87 #ifdef A2C
  88   if ((fg_format==fg_format_wrf_arw_regional  .or. &
  89        fg_format==fg_format_wrf_arw_global  ) .and. ide == ipe ) then
  90      ipe = ipe - 1
  91      ide = ide - 1
  92   end if
  93
  94   if ((fg_format==fg_format_wrf_arw_regional  .or. &
  95        fg_format==fg_format_wrf_arw_global  ) .and. jde == jpe ) then
  96      jpe = jpe - 1
  97      jde = jde - 1
  98   end if
  99 #endif
 100
 101    if (sfc_assi_options == 2) then
 102 #ifdef DM_PARALLEL
 103 #include "HALO_SFC_XA.inc"
 104 #endif
 105    end if
 106
 107
 108    if (use_ssmt1obs .or. use_ssmt2obs .or. use_gpspwobs .or. &
 109         use_ssmitbobs .or. use_ssmiretrievalobs) then
 110
 111       ! Now do something for PW
 112       call da_transform_xtotpw(grid)
 113
 114       ! GPS Refractivity:
 115       if (use_gpsrefobs) &
 116          call da_transform_xtogpsref_lin(grid)
 117
 118       if (use_ssmt1obs .or. use_ssmt2obs .or. use_ssmitbobs .or. use_ssmiretrievalobs) then
 119          call da_transform_xtoseasfcwind_lin(grid)
 120       end if
 121
 122 #ifdef DM_PARALLEL
 123 #include "HALO_SSMI_XA.inc"
 124 #endif
 125    end if
 126
 127    write(unit=stdout, fmt='(/a/)') 'End of da_setup_testfield.'
 128
 129    if (trace_use) call da_trace_exit("da_setup_testfield")
 130
 131 end subroutine da_setup_testfield
 132
 133