Line data Source code
1 : module polar_avg
2 : !-----------------------------------------------------------------------
3 : !
4 : ! Purpose:
5 : ! These routines are used by the fv dycore to set the collocated
6 : ! pole points at the limits of the latitude dimension to the same
7 : ! value.
8 : !
9 : ! Methods:
10 : ! The reprosum reproducible distributed sum is used for these
11 : ! calculations.
12 : !
13 : ! Author: A. Mirin
14 : !
15 : !-----------------------------------------------------------------------
16 :
17 : !-----------------------------------------------------------------------
18 : !- use statements ------------------------------------------------------
19 : !-----------------------------------------------------------------------
20 : use shr_kind_mod, only: r8 => shr_kind_r8
21 : use dycore, only: dycore_is
22 : use dyn_grid, only: get_dyn_grid_parm
23 : use phys_grid, only: get_ncols_p, get_lat_all_p
24 : use ppgrid, only: begchunk, endchunk, pcols
25 : use shr_reprosum_mod, only: shr_reprosum_calc
26 : #if ( defined SPMD )
27 : use mpishorthand, only: mpicom
28 : #endif
29 :
30 : !-----------------------------------------------------------------------
31 : !- module boilerplate --------------------------------------------------
32 : !-----------------------------------------------------------------------
33 : implicit none
34 : private
35 : save
36 :
37 : !-----------------------------------------------------------------------
38 : ! Public interfaces ----------------------------------------------------
39 : !-----------------------------------------------------------------------
40 : public :: &
41 : polar_average ! support for LR dycore polar averaging
42 :
43 : interface polar_average
44 : module procedure polar_average2d, polar_average3d
45 : end interface
46 :
47 : CONTAINS
48 : !
49 : !========================================================================
50 : !
51 73728 : subroutine polar_average2d(field)
52 : !-----------------------------------------------------------------------
53 : ! Purpose: Set the collocated pole points at the limits of the latitude
54 : ! dimension to the same value.
55 : ! Author: J. Edwards
56 : !-----------------------------------------------------------------------
57 : !
58 : ! Arguments
59 : !
60 : real(r8), intent(inout) :: field(pcols,begchunk:endchunk)
61 : !
62 : ! Local workspace
63 : !
64 : integer :: i, c, ln, ls, ncols
65 : integer :: plat, plon
66 73728 : integer, allocatable :: lats(:)
67 : #if (! defined SPMD)
68 : integer :: mpicom = 0
69 : #endif
70 :
71 : real(r8) :: sum(2)
72 73728 : real(r8), allocatable :: n_pole(:), s_pole(:)
73 : !
74 : !-----------------------------------------------------------------------
75 : !
76 73728 : if(.not. dycore_is('LR')) return
77 :
78 73728 : plon = get_dyn_grid_parm('plon')
79 73728 : plat = get_dyn_grid_parm('plat')
80 294912 : allocate(lats(pcols), n_pole(plon), s_pole(plon))
81 73728 : ln=0
82 73728 : ls=0
83 21307392 : n_pole = 0._r8
84 21307392 : s_pole = 0._r8
85 :
86 442368 : do c=begchunk,endchunk
87 368640 : call get_lat_all_p(c,pcols,lats)
88 368640 : ncols = get_ncols_p(c)
89 :
90 5750784 : do i=1,ncols
91 5677056 : if(lats(i).eq.1) then
92 27648 : ln=ln+1
93 27648 : n_pole(ln) = field(i,c)
94 5280768 : else if(lats(i).eq.plat) then
95 27648 : ls=ls+1
96 27648 : s_pole(ls) = field(i,c)
97 : end if
98 : enddo
99 :
100 : end do
101 :
102 : call shr_reprosum_calc(n_pole, sum(1:1), ln, plon, 1, &
103 73728 : gbl_count=plon, commid=mpicom)
104 :
105 : call shr_reprosum_calc(s_pole, sum(2:2), ls, plon, 1, &
106 73728 : gbl_count=plon, commid=mpicom)
107 :
108 73728 : ln=0
109 73728 : ls=0
110 442368 : do c=begchunk,endchunk
111 368640 : call get_lat_all_p(c,pcols,lats)
112 368640 : ncols = get_ncols_p(c)
113 :
114 5750784 : do i=1,ncols
115 5677056 : if(lats(i).eq.1) then
116 27648 : ln=ln+1
117 27648 : field(i,c) = sum(1)/plon
118 5280768 : else if(lats(i).eq.plat) then
119 27648 : ls=ls+1
120 27648 : field(i,c) = sum(2)/plon
121 : end if
122 : enddo
123 :
124 : end do
125 :
126 73728 : deallocate(lats, n_pole, s_pole)
127 :
128 73728 : end subroutine polar_average2d
129 :
130 : !
131 : !========================================================================
132 : !
133 :
134 15360 : subroutine polar_average3d(nlev, field)
135 : !-----------------------------------------------------------------------
136 : ! Purpose: Set the collocated pole points at the limits of the latitude
137 : ! dimension to the same value.
138 : ! Author: J. Edwards
139 : !-----------------------------------------------------------------------
140 : !
141 : ! Arguments
142 : !
143 : integer, intent(in) :: nlev
144 : real(r8), intent(inout) :: field(pcols,nlev,begchunk:endchunk)
145 : !
146 : ! Local workspace
147 : !
148 : integer :: i, c, ln, ls, ncols, k
149 : integer :: plat, plon
150 15360 : integer, allocatable :: lats(:)
151 : #if (! defined SPMD)
152 : integer :: mpicom = 0
153 : #endif
154 :
155 30720 : real(r8) :: sum(nlev,2)
156 15360 : real(r8), allocatable :: n_pole(:,:), s_pole(:,:)
157 : !
158 : !-----------------------------------------------------------------------
159 : !
160 15360 : if(.not. dycore_is('LR')) return
161 :
162 15360 : plon = get_dyn_grid_parm('plon')
163 15360 : plat = get_dyn_grid_parm('plat')
164 92160 : allocate(lats(pcols), n_pole(plon,nlev), s_pole(plon,nlev))
165 15360 : ln=0
166 15360 : ls=0
167 119869440 : n_pole = 0._r8
168 119869440 : s_pole = 0._r8
169 :
170 92160 : do c=begchunk,endchunk
171 76800 : call get_lat_all_p(c,pcols,lats)
172 76800 : ncols = get_ncols_p(c)
173 :
174 1198080 : do i=1,ncols
175 1182720 : if(lats(i).eq.1) then
176 5760 : ln=ln+1
177 161280 : do k=1,nlev
178 161280 : n_pole(ln,k) = field(i,k,c)
179 : end do
180 1100160 : else if(lats(i).eq.plat) then
181 5760 : ls=ls+1
182 161280 : do k=1,nlev
183 161280 : s_pole(ls,k) = field(i,k,c)
184 : end do
185 : end if
186 : enddo
187 : end do
188 :
189 : call shr_reprosum_calc(n_pole, sum(:,1), ln, plon, nlev, &
190 15360 : gbl_count=plon, commid=mpicom)
191 :
192 : call shr_reprosum_calc(s_pole, sum(:,2), ls, plon, nlev, &
193 15360 : gbl_count=plon, commid=mpicom)
194 :
195 15360 : ln=0
196 15360 : ls=0
197 92160 : do c=begchunk,endchunk
198 76800 : call get_lat_all_p(c,pcols,lats)
199 76800 : ncols = get_ncols_p(c)
200 :
201 1198080 : do i=1,ncols
202 1182720 : if(lats(i).eq.1) then
203 5760 : ln=ln+1
204 161280 : do k=1,nlev
205 161280 : field(i,k,c) = sum(k,1)/plon
206 : end do
207 1100160 : else if(lats(i).eq.plat) then
208 5760 : ls=ls+1
209 161280 : do k=1,nlev
210 161280 : field(i,k,c) = sum(k,2)/plon
211 : end do
212 : end if
213 : enddo
214 :
215 : end do
216 :
217 15360 : deallocate(lats, n_pole, s_pole)
218 :
219 15360 : end subroutine polar_average3d
220 :
221 : end module polar_avg
|
