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 236544 : 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 236544 : integer, allocatable :: lats(:)
67 : #if (! defined SPMD)
68 : integer :: mpicom = 0
69 : #endif
70 :
71 : real(r8) :: sum(2)
72 236544 : real(r8), allocatable :: n_pole(:), s_pole(:)
73 : !
74 : !-----------------------------------------------------------------------
75 : !
76 236544 : if(.not. dycore_is('LR')) return
77 :
78 236544 : plon = get_dyn_grid_parm('plon')
79 236544 : plat = get_dyn_grid_parm('plat')
80 946176 : allocate(lats(pcols), n_pole(plon), s_pole(plon))
81 236544 : ln=0
82 236544 : ls=0
83 68361216 : n_pole = 0._r8
84 68361216 : s_pole = 0._r8
85 :
86 1419264 : do c=begchunk,endchunk
87 1182720 : call get_lat_all_p(c,pcols,lats)
88 1182720 : ncols = get_ncols_p(c)
89 :
90 18450432 : do i=1,ncols
91 18213888 : if(lats(i).eq.1) then
92 88704 : ln=ln+1
93 88704 : n_pole(ln) = field(i,c)
94 16942464 : else if(lats(i).eq.plat) then
95 88704 : ls=ls+1
96 88704 : 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 236544 : gbl_count=plon, commid=mpicom)
104 :
105 : call shr_reprosum_calc(s_pole, sum(2:2), ls, plon, 1, &
106 236544 : gbl_count=plon, commid=mpicom)
107 :
108 236544 : ln=0
109 236544 : ls=0
110 1419264 : do c=begchunk,endchunk
111 1182720 : call get_lat_all_p(c,pcols,lats)
112 1182720 : ncols = get_ncols_p(c)
113 :
114 18450432 : do i=1,ncols
115 18213888 : if(lats(i).eq.1) then
116 88704 : ln=ln+1
117 88704 : field(i,c) = sum(1)/plon
118 16942464 : else if(lats(i).eq.plat) then
119 88704 : ls=ls+1
120 88704 : field(i,c) = sum(2)/plon
121 : end if
122 : enddo
123 :
124 : end do
125 :
126 236544 : deallocate(lats, n_pole, s_pole)
127 :
128 236544 : end subroutine polar_average2d
129 :
130 : !
131 : !========================================================================
132 : !
133 :
134 12288 : 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 12288 : integer, allocatable :: lats(:)
151 : #if (! defined SPMD)
152 : integer :: mpicom = 0
153 : #endif
154 :
155 24576 : real(r8) :: sum(nlev,2)
156 12288 : real(r8), allocatable :: n_pole(:,:), s_pole(:,:)
157 : !
158 : !-----------------------------------------------------------------------
159 : !
160 12288 : if(.not. dycore_is('LR')) return
161 :
162 12288 : plon = get_dyn_grid_parm('plon')
163 12288 : plat = get_dyn_grid_parm('plat')
164 73728 : allocate(lats(pcols), n_pole(plon,nlev), s_pole(plon,nlev))
165 12288 : ln=0
166 12288 : ls=0
167 79915008 : n_pole = 0._r8
168 79915008 : s_pole = 0._r8
169 :
170 73728 : do c=begchunk,endchunk
171 61440 : call get_lat_all_p(c,pcols,lats)
172 61440 : ncols = get_ncols_p(c)
173 :
174 958464 : do i=1,ncols
175 946176 : if(lats(i).eq.1) then
176 4608 : ln=ln+1
177 108288 : do k=1,nlev
178 108288 : n_pole(ln,k) = field(i,k,c)
179 : end do
180 880128 : else if(lats(i).eq.plat) then
181 4608 : ls=ls+1
182 108288 : do k=1,nlev
183 108288 : 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 12288 : gbl_count=plon, commid=mpicom)
191 :
192 : call shr_reprosum_calc(s_pole, sum(:,2), ls, plon, nlev, &
193 12288 : gbl_count=plon, commid=mpicom)
194 :
195 12288 : ln=0
196 12288 : ls=0
197 73728 : do c=begchunk,endchunk
198 61440 : call get_lat_all_p(c,pcols,lats)
199 61440 : ncols = get_ncols_p(c)
200 :
201 958464 : do i=1,ncols
202 946176 : if(lats(i).eq.1) then
203 4608 : ln=ln+1
204 108288 : do k=1,nlev
205 108288 : field(i,k,c) = sum(k,1)/plon
206 : end do
207 880128 : else if(lats(i).eq.plat) then
208 4608 : ls=ls+1
209 108288 : do k=1,nlev
210 108288 : field(i,k,c) = sum(k,2)/plon
211 : end do
212 : end if
213 : enddo
214 :
215 : end do
216 :
217 12288 : deallocate(lats, n_pole, s_pole)
218 :
219 12288 : end subroutine polar_average3d
220 :
221 : end module polar_avg
|