da_chgvres.inc
References to this file elsewhere.
1 subroutine da_chgvres(nlath,nsig,kz,sigmah,sigma_avn,&
2 corz_avn,cord_avn,corh_avn,corq_avn,hwll_avn,vztdq_avn,agv_avn,bv_avn,wgv_avn,&
3 corz_kz, cord_kz, corh_kz, corq_kz, hwll_kz, vztdq_kz, agv_kz, bv_kz, wgv_kz)
4
5 !---------------------------------------------------------------------------
6 ! Purpose: Change vertical resolution of background stats for cv_options=3
7 !---------------------------------------------------------------------------
8
9 implicit none
10
11 integer, intent(in) :: nlath,nsig,kz
12 real, intent(in) :: sigmah(kz),sigma_avn(1:nsig)
13
14 real, intent(out) :: corz_kz(1:2*nlath+1,1:kz),cord_kz(1:2*nlath+1,1:kz)
15 real, intent(out) :: corh_kz(1:2*nlath+1,1:kz),corq_kz(1:2*nlath+1,1:kz)
16 real, intent(out) :: hwll_kz(0:nlath*2+1,1:kz,1:4)
17 real, intent(out) :: vztdq_kz(1:kz,0:nlath*2+1,1:4)
18 real, intent(out) :: agv_kz(0:nlath*2+1,1:kz,1:kz)
19 real, intent(out) :: bv_kz(0:nlath*2+1,1:kz),wgv_kz(0:nlath*2+1,1:kz)
20
21 real, intent(in) :: corz_avn(1:2*nlath+1,1:nsig),cord_avn(1:2*nlath+1,1:nsig)
22 real, intent(in) :: corh_avn(1:2*nlath+1,1:nsig),corq_avn(1:2*nlath+1,1:nsig)
23 real, intent(in) :: hwll_avn(0:nlath*2+1,1:nsig,1:4)
24 real, intent(in) :: vztdq_avn(1:nsig,0:nlath*2+1,1:4)
25 real, intent(in) :: agv_avn(0:nlath*2+1,1:nsig,1:nsig)
26 real, intent(in) :: bv_avn(0:nlath*2+1,1:nsig),wgv_avn(0:nlath*2+1,1:nsig)
27
28 integer :: i,j,k,m,l,l1,m1,n
29 real :: rsigo(nsig),rsig(kz)
30 real :: coef1(kz),coef2(kz)
31 integer :: lsig(kz)
32
33 if (trace_use) call da_trace_entry("da_chgvres")
34
35 if (kz==nsig) then
36 corz_kz=corz_avn
37 cord_kz=cord_avn
38 corh_kz=corh_avn
39 corq_kz=corq_avn
40 hwll_kz=hwll_avn
41 vztdq_kz=vztdq_avn
42 agv_kz=agv_avn
43 bv_kz=bv_avn
44 wgv_kz=wgv_avn
45 return
46 end if
47
48 do k=1,kz
49 rsig(k)=log(sigmah(k))
50 end do
51 do k=1,nsig
52 rsigo(k)=log(sigma_avn(k))
53 end do
54
55 do k=1,kz
56 if (rsig(k).ge.rsigo(1)) then
57 m=1
58 m1=2
59 lsig(k)=1
60 coef1(k)=1.0
61 coef2(k)=0.0
62 else if (rsig(k).lt.rsigo(nsig)) then
63 m=nsig-1
64 m1=nsig
65 lsig(k)=nsig-1
66 coef1(k)=0.0
67 coef2(k)=1.0
68 else
69 do m=1,nsig
70 m1=m+1
71 if ((rsig(k).le.rsigo(m)) .and. &
72 (rsig(k).gt.rsigo(m1)) )then
73 lsig(k)=m
74 go to 2345
75 end if
76 end do
77 2345 continue
78 coef1(k)=(rsigo(m1)-rsig(k))/(rsigo(m1)-rsigo(m))
79 coef2(k)=1.0-coef1(k)
80 if (lsig(k)==nsig) then
81 lsig(k)=nsig-1
82 coef2(k)=1.0
83 coef1(k)=0.0
84 end if
85 end if
86 end do
87
88 ! agv wgv bv
89 do k=1,kz
90 m=lsig(k)
91 m1=m+1
92 do i=1,nlath*2
93 wgv_kz(i,k)=wgv_avn(i,m)*coef1(k)+wgv_avn(i,m1)*coef2(k)
94 bv_kz(i,k)=bv_avn(i,m)*coef1(k)+bv_avn(i,m1)*coef2(k)
95 end do
96
97 do j=1,kz
98 l=lsig(j)
99 l1=l+1
100 do i=1,nlath*2
101 agv_kz(i,j,k)=(agv_avn(i,l,m)*coef1(j)+agv_avn(i,l1,m)*coef2(j))*coef1(k) &
102 +(agv_avn(i,l,m1)*coef1(j)+agv_avn(i,l1,m1)*coef2(j))*coef2(k)
103 end do
104 end do
105 end do
106
107 agv_kz(0,:,:)=agv_kz(1,:,:)
108 wgv_kz(0,:)=wgv_kz(1,:)
109 bv_kz(0,:)=bv_kz(1,:)
110 agv_kz(nlath*2+1,:,:)=agv_kz(nlath*2,:,:)
111 wgv_kz(nlath*2+1,:)=wgv_kz(nlath*2,:)
112 bv_kz(nlath*2+1,:)=bv_kz(nlath*2,:)
113
114 do k=1,kz
115 m=lsig(k)
116 m1=m+1
117
118 ! corz,cord,corh,corq
119 do i=1,nlath*2
120 corz_kz(i,k)=corz_avn(i,m)*coef1(k)+corz_avn(i,m1)*coef2(k)
121 cord_kz(i,k)=cord_avn(i,m)*coef1(k)+cord_avn(i,m1)*coef2(k)
122 corh_kz(i,k)=corh_avn(i,m)*coef1(k)+corh_avn(i,m1)*coef2(k)
123 corq_kz(i,k)=corq_avn(i,m)*coef1(k)+corq_avn(i,m1)*coef2(k)
124 end do
125
126 do n=1,4
127 do i=1,nlath*2
128 ! hwll
129 hwll_kz(i,k,n)=hwll_avn(i,m,n)*coef1(k)+hwll_avn(i,m1,n)*coef2(k)
130 ! vztdq
131 vztdq_kz(k,i,n)=vztdq_avn(m,i,n)*coef1(k)+vztdq_avn(m1,i,n)*coef2(k)
132 end do
133 end do
134 end do
135
136 if (trace_use) call da_trace_exit("da_chgvres")
137
138 end subroutine da_chgvres
139
140