da_set_tst_trnsf_fld.inc

1 subroutine da_set_tst_trnsf_fld(xp, va, vb, typical_rms)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6 
7    implicit none
8 
9    type (xpose_type), intent(in) :: xp   ! Dimensions and xpose buffers.
10 
11    real, dimension(xp%ims:xp%ime, xp%jms:xp%jme, xp%kms:xp%kme), intent(out) :: va
12    real, dimension(xp%ims:xp%ime, xp%jms:xp%jme, xp%kms:xp%kme), intent(in)  :: vb
13 
14    real, intent(in)  :: typical_rms
15 
16    real, dimension(xp%ids:xp%ide, xp%jds:xp%jde, xp%kds:xp%kde) :: gbuf
17 
18    integer                    :: size3d
19    integer                    :: k             ! loop counter.
20    real                       :: scale         ! scale factor.
21    real                       :: xy_dim_inv    ! 1 / real(iy * jx)
22    real                       :: field_mean    ! mean field.
23    real                       :: field_rms     ! rms field.
24 
25    size3d = (xp%ide-xp%ids+1)*(xp%jde-xp%jds+1)*(xp%kde-xp%kds+1)
26 
27    call da_local_to_global(xp, vb, gbuf, 3)
28    call wrf_dm_bcast_real(gbuf, size3d)
29 
30    xy_dim_inv  = 1.0 / real((xp%ide-xp%ids+1)*(xp%jde-xp%jds+1))
31 
32    do k = xp%kts,xp%kte
33       field_mean = sum(gbuf(xp%ids:xp%ide, xp%jds:xp%jde, k)) * xy_dim_inv
34 
35       gbuf(xp%ids:xp%ide, xp%jds:xp%jde, k) = &
36          gbuf(xp%ids:xp%ide, xp%jds:xp%jde, k) - field_mean
37 
38       field_rms = sqrt(1.0e-6+sum( &
39          gbuf(xp%ids:xp%ide, xp%jds:xp%jde, k)**2) * xy_dim_inv)
40 
41       scale = typical_rms / field_rms
42 
43       va(xp%its:xp%ite, xp%jts:xp%jte, k) = scale * &
44          gbuf(xp%its:xp%ite, xp%jts:xp%jte, k)
45    end do
46 
47 end subroutine da_set_tst_trnsf_fld
48 
49