Line data Source code
1 : !-----------------------------------------------------------------------
2 : !BOP
3 : ! !ROUTINE: uv3s_update -- update u3s, v3s (XY decomposition)
4 : !
5 : ! !INTERFACE:
6 :
7 7296 : subroutine uv3s_update(grid, dua, u3s, dva, v3s, dt5, &
8 : am_geom_crrct)
9 :
10 : ! !USES:
11 :
12 : use shr_kind_mod, only: r8 => shr_kind_r8
13 :
14 : #if defined( SPMD )
15 : use parutilitiesmodule, only : pargatherreal
16 : use mod_comm, only : mp_send3d, mp_recv3d
17 : #endif
18 : use cam_history, only: outfld
19 :
20 : use dynamics_vars, only: T_FVDYCORE_GRID
21 :
22 : implicit none
23 : ! !INPUT PARAMETERS:
24 : type (T_FVDYCORE_GRID), intent(in) :: grid
25 : ! dudt on A-grid
26 : real(r8),intent(in) :: dua(grid%ifirstxy:grid%ilastxy,grid%km,grid%jfirstxy:grid%jlastxy)
27 : ! dvdt on A-grid
28 : real(r8),intent(in) :: dva(grid%ifirstxy:grid%ilastxy,grid%km,grid%jfirstxy:grid%jlastxy)
29 : real(r8),intent(in) :: dt5 ! weighting factor
30 : logical, intent(in) :: am_geom_crrct
31 :
32 : ! !INPUT/OUTPUT PARAMETERS:
33 : real(r8), intent(inout) :: u3s(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, &
34 : grid%km) ! U-Wind on D Grid
35 : real(r8), intent(inout) :: v3s(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, &
36 : grid%km) ! V-Wind on D Grid
37 :
38 : ! !DESCRIPTION:
39 : !
40 : ! This routine performs the update for the N-S staggered u-wind
41 : ! and the E-W staggered v-wind
42 : !
43 : ! !REVISION HISTORY:
44 : ! WS 00.12.22 : Creation from d2a3d
45 : ! SJL 01.01.20 : modifications
46 : ! AAM 01.06.08 : Name change; folding in of v3s update and outfld calls
47 : ! WS 02.04.25 : New mod_comm interfaces
48 : ! WS 02.07.04 : Fixed 2D decomposition bug dest/src for mp_send3d
49 : ! WS 03.07.22 : Removed strip3zatyt4 from use list (no longer used)
50 : ! WS 05.07.14 : Simplified interface with grid argument
51 : ! WS 05.09.23 : Modified for XY decomposition
52 : !
53 : !EOP
54 : !-----------------------------------------------------------------------
55 : !BOC
56 :
57 : integer :: i, j, k
58 : integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy, idim
59 :
60 : #if defined( SPMD )
61 14592 : real(r8) :: duasouth(grid%ifirstxy:grid%ilastxy,grid%km)
62 14592 : real(r8) :: dvawest(grid%km,grid%jfirstxy:grid%jlastxy)
63 : integer :: dest, src
64 : integer :: iam, nprxy_x, myidxy_y
65 : #endif
66 : real(r8) :: tmp
67 14592 : real(r8) :: u3s_tmp (grid%ifirstxy:grid%ilastxy,grid%km)
68 14592 : real(r8) :: v3s_tmp (grid%ifirstxy:grid%ilastxy,grid%km)
69 14592 : real(r8) :: fu3s (grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km)
70 14592 : real(r8) :: fv3s (grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km)
71 14592 : real(r8) :: fu3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km)
72 14592 : real(r8) :: fv3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km)
73 :
74 : ! AM correction
75 7296 : real(r8), pointer :: cosp(:), cose(:)
76 :
77 7296 : cosp => grid%cosp
78 7296 : cose => grid%cose
79 :
80 37946496 : fu3s(:,:,:) = 0._r8
81 37946496 : fv3s(:,:,:) = 0._r8
82 :
83 7296 : im = grid%im
84 7296 : jm = grid%jm
85 7296 : km = grid%km
86 :
87 7296 : ifirstxy = grid%ifirstxy
88 7296 : ilastxy = grid%ilastxy
89 7296 : jfirstxy = grid%jfirstxy
90 7296 : jlastxy = grid%jlastxy
91 :
92 : #if defined( SPMD )
93 7296 : iam = grid%iam
94 7296 : nprxy_x = grid%nprxy_x
95 7296 : myidxy_y = grid%myidxy_y
96 : !
97 : ! Transfer dua(:,jlast) to the node directly to the north; dva(ifirst, to east)
98 : !
99 : call mp_send3d( grid%commxy, iam+nprxy_x, iam-nprxy_x, im, km, jm, &
100 : ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, &
101 7296 : ifirstxy, ilastxy, 1, km, jlastxy, jlastxy, dua )
102 : call mp_recv3d( grid%commxy, iam-nprxy_x, im, km, jm, &
103 : ifirstxy, ilastxy, 1, km, jfirstxy-1, jfirstxy-1, &
104 7296 : ifirstxy, ilastxy, 1, km, jfirstxy-1, jfirstxy-1, duasouth )
105 :
106 7296 : dest = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x)
107 7296 : src = myidxy_y*nprxy_x + MOD(iam+nprxy_x-1,nprxy_x)
108 : call mp_send3d( grid%commxy, dest, src, im, km, jm, &
109 : ifirstxy, ilastxy, 1, km, jfirstxy, jlastxy, &
110 7296 : ilastxy, ilastxy, 1, km, jfirstxy, jlastxy, dva )
111 : call mp_recv3d( grid%commxy, src, im, km, jm, &
112 : ifirstxy-1, ifirstxy-1, 1, km, jfirstxy, jlastxy, &
113 7296 : ifirstxy-1, ifirstxy-1, 1, km, jfirstxy, jlastxy, dvawest )
114 : #endif
115 :
116 : !$omp parallel do private (i, j, k)
117 :
118 955776 : do k = 1, km
119 :
120 : !
121 : ! Adjust D-grid winds by interpolating A-grid tendencies.
122 : !
123 :
124 948480 : if (am_geom_crrct) then
125 0 : do j = jfirstxy+1, jlastxy
126 0 : do i = ifirstxy, ilastxy
127 0 : tmp = u3s(i,j,k)
128 0 : u3s (i,j,k) = u3s(i,j,k) + dt5*(dua(i,k,j)*cosp(j) + &
129 0 : dua(i,k,j-1)*cosp(j-1))/cose(j) ! torque
130 0 : fu3s(i,j,k) = (u3s(i,j,k) - tmp)/(2._r8*dt5)
131 : end do
132 : end do
133 : else
134 2845440 : do j = jfirstxy+1, jlastxy
135 25608960 : do i = ifirstxy, ilastxy
136 22763520 : tmp = u3s(i,j,k)
137 22763520 : u3s (i,j,k) = u3s(i,j,k) + dt5*(dua(i,k,j) + dua(i,k,j-1)) ! force
138 24660480 : fu3s(i,j,k) = (u3s(i,j,k) - tmp)/(2._r8*dt5)
139 : end do
140 : end do
141 : end if
142 :
143 3734640 : do j = max(jfirstxy,2), min(jlastxy,jm-1)
144 34382400 : do i=ifirstxy+1,ilastxy
145 30647760 : tmp = v3s(i,j,k)
146 30647760 : v3s (i,j,k) = v3s(i,j,k) + dt5*(dva(i,k,j)+dva(i-1,k,j))
147 33433920 : fv3s(i,j,k) = (v3s(i,j,k) - tmp)/(2._r8*dt5)
148 : enddo
149 : enddo
150 :
151 : #if defined( SPMD )
152 948480 : if (am_geom_crrct) then
153 0 : if ( jfirstxy .gt. 1 ) then
154 0 : do i = ifirstxy, ilastxy
155 0 : tmp = u3s(i,jfirstxy,k)
156 : u3s (i,jfirstxy,k) = u3s(i,jfirstxy,k) + &
157 0 : dt5*( dua(i,k,jfirstxy)*cosp(jfirstxy) + &
158 0 : duasouth(i,k)*cosp(jfirstxy-1))/cose(jfirstxy)
159 0 : fu3s(i,jfirstxy,k) = (u3s(i,jfirstxy,k) - tmp)/(2._r8*dt5)
160 : end do
161 : end if
162 : else
163 948480 : if ( jfirstxy .gt. 1 ) then
164 11944920 : do i = ifirstxy, ilastxy
165 11026080 : tmp = u3s(i,jfirstxy,k)
166 : u3s (i,jfirstxy,k) = u3s(i,jfirstxy,k) + &
167 11026080 : dt5*( dua(i,k,jfirstxy) + duasouth(i,k) )
168 11944920 : fu3s(i,jfirstxy,k) = (u3s(i,jfirstxy,k) - tmp)/(2._r8*dt5)
169 : end do
170 : end if
171 : end if
172 :
173 3741936 : do j = max(jfirstxy,2), min(jlastxy,jm-1)
174 2786160 : tmp = v3s(ifirstxy,j,k)
175 2786160 : v3s (ifirstxy,j,k) = v3s(ifirstxy,j,k) + dt5*(dva(ifirstxy,k,j)+dvawest(k,j))
176 3734640 : fv3s(ifirstxy,j,k) = (v3s(ifirstxy,j,k) - tmp)/(2._r8*dt5)
177 : enddo
178 : #else
179 : do j = max(jfirstxy,2), min(jlastxy,jm-1)
180 : tmp = v3s(1,j,k)
181 : v3s (1,j,k) = v3s(1,j,k) + dt5*(dva(1,k,j)+dva(im,k,j))
182 : fv3s(1,j,k) = (v3s(1,j,k) - tmp)/(2._r8*dt5)
183 : enddo
184 : #endif
185 :
186 : enddo
187 :
188 7296 : idim = ilastxy - ifirstxy + 1
189 :
190 : !$omp parallel do private (i, j, k, u3s_tmp, v3s_tmp, fu3s_tmp, fv3s_tmp)
191 :
192 29184 : do j = jfirstxy, jlastxy
193 2867328 : do k = 1, km
194 37012608 : do i = ifirstxy, ilastxy
195 34145280 : u3s_tmp (i,k) = u3s (i,j,k)
196 34145280 : v3s_tmp (i,k) = v3s (i,j,k)
197 34145280 : fu3s_tmp(i,k) = fu3s(i,j,k)
198 36990720 : fv3s_tmp(i,k) = fv3s(i,j,k)
199 : enddo
200 : enddo
201 :
202 21888 : call outfld ('FU ', dua(:,:,j), idim, j )
203 21888 : call outfld ('FV ', dva(:,:,j), idim, j )
204 21888 : call outfld ('US ', u3s_tmp , idim, j )
205 21888 : call outfld ('VS ', v3s_tmp , idim, j )
206 21888 : call outfld ('FU_S ', fu3s_tmp , idim, j )
207 29184 : call outfld ('FV_S ', fv3s_tmp , idim, j )
208 :
209 : enddo
210 :
211 7296 : return
212 : !EOC
213 14592 : end subroutine uv3s_update
214 : !-----------------------------------------------------------------------
|
