da_allocate_background_errors.inc
References to this file elsewhere.
1 subroutine da_allocate_background_errors (jy, kz, l, e, be_eval_loc, &
2 be_evec_loc, be_sub)
3
4 !---------------------------------------------------------------------------
5 ! Purpose: Allocate components of wrfvar background errors.
6 !---------------------------------------------------------------------------
7
8 implicit none
9
10 integer, intent(in) :: jy ! i/y dimension.
11 integer, intent(in) :: kz ! k/z dimension.
12 real, intent(in) :: l(:) ! Global eigenvalue.
13 real, intent(in) :: e(:,:) ! Global eigenvectors.
14 real, intent(in) :: be_eval_loc(:,:) ! Std dev/local evalue.
15 real, intent(in) :: be_evec_loc(:,:,:) ! Local eigenvectors.
16 type (be_subtype), intent(inout) :: be_sub ! Backgrd error struct.
17
18 integer :: mz ! Vertical truncation.
19 integer :: j, m, k ! Loop counter.
20
21 if (trace_use_dull) call da_trace_entry("da_allocate_background_errors")
22
23 !--------------------------------------------------------------------------
24 ! [1.0] Initialise:
25 !--------------------------------------------------------------------------
26
27 mz = be_sub % mz
28
29 !--------------------------------------------------------------------------
30 ! [2.0] Allocate components of be_sub structure:
31 !--------------------------------------------------------------------------
32
33 if (mz > 0) then
34 allocate (be_sub % val(1:jy,1:mz))
35
36 if (vert_corr == vert_corr_2) then
37
38 !--------------------------------------------------------------------
39 ! [3.0] Allocate eigenvalues of vertical error covariance matrix:
40 !--------------------------------------------------------------------
41
42 if (vert_evalue == vert_evalue_global) then
43 ! use global eigenvalues:
44 do m = 1, mz
45 be_sub % val(1:jy,m) = sqrt (l(m))
46 end do
47 else
48 ! use eigenvalues varying with j-direction.
49 do j = 1, jy
50 do k = 1, mz
51 if (be_eval_loc(j,k) <=0) then
52 write (unit=message(1),fmt='(A,I5,A,I5,A,F10.2)') &
53 "At lat= ",j," For mode = ",k," local eigen value= ",be_eval_loc(j,k)
54 call da_error(__FILE__,__LINE__,message(1:1))
55 end if
56 end do
57 end do
58 be_sub % val(1:jy,1:mz) = sqrt (be_eval_loc(1:jy,1:mz))
59 end if
60
61 if (print_detail_be) then
62 write(unit=message(1),fmt='(A,A)') 'j*k Eigenvalues for ', be_sub % name
63 call da_array_print(2, be_sub % val(1:jy,1:mz), message(1))
64 end if
65
66 !-----------------------------------------------------------------------
67 ! [4.0] Allocate global eigenvectors of vertical error cov.:
68 !-----------------------------------------------------------------------
69
70 allocate (be_sub % evec(1:jy,1:kz,1:mz))
71
72 if (vert_evalue == vert_evalue_global) then
73 ! use global eigenvectors:
74 do j = 1, jy
75 be_sub % evec(j,1:kz,1:mz) = e(1:kz,1:mz)
76 end do
77 else
78 ! use eigenvectors varying with i-direction.
79 be_sub % evec(1:jy,1:kz,1:mz) = be_evec_loc(1:jy,1:kz,1:mz)
80 end if
81
82 if (print_detail_be) then
83 write(unit=message(1),fmt='(A,A)') 'k*k Eigenvectors for j = 1 ', be_sub % name
84 call da_array_print (2, be_sub % evec(1,1:kz,1:mz), message(1))
85
86 write(unit=message(1),fmt='(A,A)') 'k*k Eigenvectors for j = jy ', be_sub % name
87 call da_array_print (2, be_sub % evec(jy,1:kz,1:mz), message(1))
88 end if
89
90 allocate (be_sub%val_g(1:mz))
91 allocate (be_sub%evec_g(1:kz,1:mz))
92
93 be_sub % val_g(1:mz) = l(1:mz)
94 be_sub % evec_g(1:kz,1:mz) = e(1:kz,1:mz)
95 else if (vert_corr == vert_corr_1) then
96 if (print_detail_be) then
97 write(unit=stdout,fmt='(A)') &
98 'Change be std dev to variance in NMC code'
99 end if
100 if (vert_evalue == vert_evalue_global) then
101 ! use global eigenvalues:
102 do m = 1, mz
103 be_sub % val(1:jy,m) = l(m)
104 end do
105 else
106 be_sub % val(1:jy,1:mz) = be_eval_loc(1:jy,1:mz)
107 end if
108 end if
109
110 !-----------------------------------------------------------------------
111 ! [2.2] Allocate recursive filter lengthscales and variance scaling factors:
112 !-----------------------------------------------------------------------
113
114 allocate (be_sub % rf_alpha(1:mz))
115
116 be_sub % rf_alpha(1:mz) = 1.0
117 end if
118
119 if (trace_use_dull) call da_trace_exit("da_allocate_background_errors")
120
121 end subroutine da_allocate_background_errors
122
123