Line data Source code
1 : !-----------------------------------------------------------------------
2 : !BOP
3 : ! !ROUTINE: uv3s_update -- update u3s, v3s (XY decomposition)
4 : !
5 : ! !INTERFACE:
6 :
7 14592 : 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 29184 : real(r8) :: duasouth(grid%ifirstxy:grid%ilastxy,grid%km)
62 29184 : 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 29184 : real(r8) :: u3s_tmp (grid%ifirstxy:grid%ilastxy,grid%km)
68 29184 : real(r8) :: v3s_tmp (grid%ifirstxy:grid%ilastxy,grid%km)
69 29184 : real(r8) :: fu3s (grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km)
70 29184 : real(r8) :: fv3s (grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km)
71 29184 : real(r8) :: fu3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km)
72 29184 : real(r8) :: fv3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km)
73 :
74 : ! AM correction
75 14592 : real(r8), pointer :: cosp(:), cose(:)
76 :
77 14592 : cosp => grid%cosp
78 14592 : cose => grid%cose
79 :
80 62118144 : fu3s(:,:,:) = 0._r8
81 62118144 : fv3s(:,:,:) = 0._r8
82 :
83 14592 : im = grid%im
84 14592 : jm = grid%jm
85 14592 : km = grid%km
86 :
87 14592 : ifirstxy = grid%ifirstxy
88 14592 : ilastxy = grid%ilastxy
89 14592 : jfirstxy = grid%jfirstxy
90 14592 : jlastxy = grid%jlastxy
91 :
92 : #if defined( SPMD )
93 14592 : iam = grid%iam
94 14592 : nprxy_x = grid%nprxy_x
95 14592 : 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 14592 : 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 14592 : ifirstxy, ilastxy, 1, km, jfirstxy-1, jfirstxy-1, duasouth )
105 :
106 14592 : dest = myidxy_y*nprxy_x + MOD(iam+1,nprxy_x)
107 14592 : 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 14592 : 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 14592 : ifirstxy-1, ifirstxy-1, 1, km, jfirstxy, jlastxy, dvawest )
114 : #endif
115 :
116 : !$omp parallel do private (i, j, k)
117 :
118 831744 : do k = 1, km
119 :
120 : !
121 : ! Adjust D-grid winds by interpolating A-grid tendencies.
122 : !
123 :
124 817152 : 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 2451456 : do j = jfirstxy+1, jlastxy
135 41674752 : do i = ifirstxy, ilastxy
136 39223296 : tmp = u3s(i,j,k)
137 39223296 : u3s (i,j,k) = u3s(i,j,k) + dt5*(dua(i,k,j) + dua(i,k,j-1)) ! force
138 40857600 : fu3s(i,j,k) = (u3s(i,j,k) - tmp)/(2._r8*dt5)
139 : end do
140 : end do
141 : end if
142 :
143 3243072 : do j = max(jfirstxy,2), min(jlastxy,jm-1)
144 59039232 : do i=ifirstxy+1,ilastxy
145 55796160 : tmp = v3s(i,j,k)
146 55796160 : v3s (i,j,k) = v3s(i,j,k) + dt5*(dva(i,k,j)+dva(i-1,k,j))
147 58222080 : fv3s(i,j,k) = (v3s(i,j,k) - tmp)/(2._r8*dt5)
148 : enddo
149 : enddo
150 :
151 : #if defined( SPMD )
152 817152 : 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 817152 : if ( jfirstxy .gt. 1 ) then
164 20109600 : do i = ifirstxy, ilastxy
165 19305216 : tmp = u3s(i,jfirstxy,k)
166 : u3s (i,jfirstxy,k) = u3s(i,jfirstxy,k) + &
167 19305216 : dt5*( dua(i,k,jfirstxy) + duasouth(i,k) )
168 20109600 : fu3s(i,jfirstxy,k) = (u3s(i,jfirstxy,k) - tmp)/(2._r8*dt5)
169 : end do
170 : end if
171 : end if
172 :
173 3257664 : do j = max(jfirstxy,2), min(jlastxy,jm-1)
174 2425920 : tmp = v3s(ifirstxy,j,k)
175 2425920 : v3s (ifirstxy,j,k) = v3s(ifirstxy,j,k) + dt5*(dva(ifirstxy,k,j)+dvawest(k,j))
176 3243072 : 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 14592 : idim = ilastxy - ifirstxy + 1
189 :
190 : !$omp parallel do private (i, j, k, u3s_tmp, v3s_tmp, fu3s_tmp, fv3s_tmp)
191 :
192 58368 : do j = jfirstxy, jlastxy
193 2495232 : do k = 1, km
194 61330176 : do i = ifirstxy, ilastxy
195 58834944 : u3s_tmp (i,k) = u3s (i,j,k)
196 58834944 : v3s_tmp (i,k) = v3s (i,j,k)
197 58834944 : fu3s_tmp(i,k) = fu3s(i,j,k)
198 61286400 : fv3s_tmp(i,k) = fv3s(i,j,k)
199 : enddo
200 : enddo
201 :
202 43776 : call outfld ('FU ', dua(:,:,j), idim, j )
203 43776 : call outfld ('FV ', dva(:,:,j), idim, j )
204 43776 : call outfld ('US ', u3s_tmp , idim, j )
205 43776 : call outfld ('VS ', v3s_tmp , idim, j )
206 43776 : call outfld ('FU_S ', fu3s_tmp , idim, j )
207 58368 : call outfld ('FV_S ', fv3s_tmp , idim, j )
208 :
209 : enddo
210 :
211 14592 : return
212 : !EOC
213 29184 : end subroutine uv3s_update
214 : !-----------------------------------------------------------------------
|
