10 use mom_domains,
only : sum_across_pes, min_across_pes, max_across_pes
17 implicit none ;
private
20 public mom_state_stats, mom_surface_chksum
24 module procedure mom_state_chksum_5arg
25 module procedure mom_state_chksum_3arg
28 #include <MOM_memory.h>
32 real :: minimum = 1.e34
33 real :: maximum = -1.e34
42 subroutine mom_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmetric)
47 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
49 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
51 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
53 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
56 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
59 integer,
optional,
intent(in) :: haloshift
60 logical,
optional,
intent(in) :: symmetric
63 integer :: is, ie, js, je, nz, hs
65 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
70 hs=1;
if (
present(haloshift)) hs=haloshift
71 sym=.false.;
if (
present(symmetric)) sym=symmetric
72 call uvchksum(mesg//
" [uv]", u, v, g%HI, haloshift=hs, symmetric=sym)
73 call hchksum(h, mesg//
" h", g%HI, haloshift=hs, scale=gv%H_to_m)
74 call uvchksum(mesg//
" [uv]h", uh, vh, g%HI, haloshift=hs, &
75 symmetric=sym, scale=gv%H_to_m)
76 end subroutine mom_state_chksum_5arg
81 subroutine mom_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric)
82 character(len=*),
intent(in) :: mesg
85 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
87 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
89 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
91 integer,
optional,
intent(in) :: haloshift
92 logical,
optional,
intent(in) :: symmetric
95 integer :: is, ie, js, je, nz, hs
97 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
102 hs=1;
if (
present(haloshift)) hs=haloshift
103 sym=.false.;
if (
present(symmetric)) sym=symmetric
104 call uvchksum(mesg//
" u", u, v, g%HI,haloshift=hs, symmetric=sym)
105 call hchksum(h, mesg//
" h",g%HI, haloshift=hs, scale=gv%H_to_m)
106 end subroutine mom_state_chksum_3arg
111 subroutine mom_thermo_chksum(mesg, tv, G, haloshift)
112 character(len=*),
intent(in) :: mesg
116 integer,
optional,
intent(in) :: haloshift
118 integer :: is, ie, js, je, nz, hs
119 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
120 hs=1;
if (
present(haloshift)) hs=haloshift
122 if (
associated(tv%T))
call hchksum(tv%T, mesg//
" T",g%HI,haloshift=hs)
123 if (
associated(tv%S))
call hchksum(tv%S, mesg//
" S",g%HI,haloshift=hs)
124 if (
associated(tv%frazil))
call hchksum(tv%frazil, mesg//
" frazil",g%HI,haloshift=hs)
125 if (
associated(tv%salt_deficit))
call hchksum(tv%salt_deficit, mesg//
" salt deficit",g%HI,haloshift=hs)
127 end subroutine mom_thermo_chksum
132 subroutine mom_surface_chksum(mesg, sfc, G, haloshift, symmetric)
133 character(len=*),
intent(in) :: mesg
134 type(
surface),
intent(inout) :: sfc
138 integer,
optional,
intent(in) :: haloshift
139 logical,
optional,
intent(in) :: symmetric
145 sym = .false. ;
if (
present(symmetric)) sym = symmetric
146 hs = 1 ;
if (
present(haloshift)) hs = haloshift
148 if (
allocated(sfc%SST))
call hchksum(sfc%SST, mesg//
" SST",g%HI,haloshift=hs)
149 if (
allocated(sfc%SSS))
call hchksum(sfc%SSS, mesg//
" SSS",g%HI,haloshift=hs)
150 if (
allocated(sfc%sea_lev))
call hchksum(sfc%sea_lev, mesg//
" sea_lev",g%HI,haloshift=hs)
151 if (
allocated(sfc%Hml))
call hchksum(sfc%Hml, mesg//
" Hml",g%HI,haloshift=hs)
152 if (
allocated(sfc%u) .and.
allocated(sfc%v)) &
153 call uvchksum(mesg//
" SSU", sfc%u, sfc%v, g%HI, haloshift=hs, symmetric=sym)
155 if (
associated(sfc%frazil))
call hchksum(sfc%frazil, mesg//
" frazil",g%HI,haloshift=hs)
157 end subroutine mom_surface_chksum
162 subroutine mom_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, pbce, &
163 u_accel_bt, v_accel_bt, symmetric)
164 character(len=*),
intent(in) :: mesg
167 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
170 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
173 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
176 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
179 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
182 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
186 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
187 optional,
intent(in) :: pbce
190 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
191 optional,
intent(in) :: u_accel_bt
193 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
194 optional,
intent(in) :: v_accel_bt
196 logical,
optional,
intent(in) :: symmetric
199 integer :: is, ie, js, je, nz
202 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
203 sym=.false.;
if (
present(symmetric)) sym=symmetric
208 call uvchksum(mesg//
" CA[uv]", cau, cav, g%HI, haloshift=0, symmetric=sym)
209 call uvchksum(mesg//
" PF[uv]", pfu, pfv, g%HI, haloshift=0, symmetric=sym)
210 call uvchksum(mesg//
" diffu", diffu, diffv, g%HI,haloshift=0, symmetric=sym, scale=us%s_to_T)
212 call hchksum(pbce, mesg//
" pbce",g%HI,haloshift=0, scale=gv%m_to_H*us%L_T_to_m_s**2)
213 if (
present(u_accel_bt) .and.
present(v_accel_bt)) &
214 call uvchksum(mesg//
" [uv]_accel_bt", u_accel_bt, v_accel_bt, g%HI,haloshift=0, symmetric=sym)
215 end subroutine mom_accel_chksum
220 subroutine mom_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDiminishing)
222 character(len=*),
intent(in) :: mesg
223 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
225 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
227 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
229 real,
pointer,
dimension(:,:,:), &
231 real,
pointer,
dimension(:,:,:), &
233 logical,
optional,
intent(in) :: allowchange
235 logical,
optional,
intent(in) :: permitdiminishing
238 integer :: is, ie, js, je, nz, i, j, k
239 real :: vol, dv, area, h_minimum
240 type(
stats) :: t, s, delt, dels
241 type(
stats),
save :: oldt, olds
242 logical,
save :: firstcall = .true.
245 character(len=80) :: lmsg
246 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
248 do_ts =
associated(temp) .and.
associated(salt)
252 do j = js, je ;
do i = is, ie
253 area = area + g%areaT(i,j)
255 t%minimum = 1.e34 ; t%maximum = -1.e34 ; t%average = 0.
256 s%minimum = 1.e34 ; s%maximum = -1.e34 ; s%average = 0.
258 do k = 1, nz ;
do j = js, je ;
do i = is, ie
259 if (g%mask2dT(i,j)>0.)
then
260 dv = g%areaT(i,j)*h(i,j,k) ; vol = vol + dv
261 if (do_ts .and. h(i,j,k)>0.)
then
262 t%minimum = min( t%minimum, temp(i,j,k) ) ; t%maximum = max( t%maximum, temp(i,j,k) )
263 t%average = t%average + dv*temp(i,j,k)
264 s%minimum = min( s%minimum, salt(i,j,k) ) ; s%maximum = max( s%maximum, salt(i,j,k) )
265 s%average = s%average + dv*salt(i,j,k)
267 if (h_minimum > h(i,j,k)) h_minimum = h(i,j,k)
269 enddo ;
enddo ;
enddo
270 call sum_across_pes( area ) ;
call sum_across_pes( vol )
272 call min_across_pes( t%minimum ) ;
call max_across_pes( t%maximum ) ;
call sum_across_pes( t%average )
273 call min_across_pes( s%minimum ) ;
call max_across_pes( s%maximum ) ;
call sum_across_pes( s%average )
274 t%average = t%average / vol ; s%average = s%average / vol
276 if (is_root_pe())
then
277 if (.not.firstcall)
then
279 delt%minimum = t%minimum - oldt%minimum ; delt%maximum = t%maximum - oldt%maximum
280 delt%average = t%average - oldt%average
281 dels%minimum = s%minimum - olds%minimum ; dels%maximum = s%maximum - olds%maximum
282 dels%average = s%average - olds%average
283 write(lmsg(1:80),
'(2(a,es12.4))')
'Mean thickness =',vol/area,
' frac. delta=',dv/vol
284 call mom_mesg(lmsg//trim(mesg))
286 write(lmsg(1:80),
'(a,3es12.4)')
'Temp min/mean/max =',t%minimum,t%average,t%maximum
287 call mom_mesg(lmsg//trim(mesg))
288 write(lmsg(1:80),
'(a,3es12.4)')
'delT min/mean/max =',delt%minimum,delt%average,delt%maximum
289 call mom_mesg(lmsg//trim(mesg))
290 write(lmsg(1:80),
'(a,3es12.4)')
'Salt min/mean/max =',s%minimum,s%average,s%maximum
291 call mom_mesg(lmsg//trim(mesg))
292 write(lmsg(1:80),
'(a,3es12.4)')
'delS min/mean/max =',dels%minimum,dels%average,dels%maximum
293 call mom_mesg(lmsg//trim(mesg))
296 write(lmsg(1:80),
'(a,es12.4)')
'Mean thickness =',vol/area
297 call mom_mesg(lmsg//trim(mesg))
299 write(lmsg(1:80),
'(a,3es12.4)')
'Temp min/mean/max =',t%minimum,t%average,t%maximum
300 call mom_mesg(lmsg//trim(mesg))
301 write(lmsg(1:80),
'(a,3es12.4)')
'Salt min/mean/max =',s%minimum,s%average,s%maximum
302 call mom_mesg(lmsg//trim(mesg))
306 firstcall = .false. ; oldvol = vol
307 oldt%minimum = t%minimum ; oldt%maximum = t%maximum ; oldt%average = t%average
308 olds%minimum = s%minimum ; olds%maximum = s%maximum ; olds%average = s%average
310 if (do_ts .and. t%minimum<-5.0)
then
311 do j = js, je ;
do i = is, ie
312 if (minval(temp(i,j,:)) == t%minimum)
then
313 write(0,
'(a,2f12.5)')
'x,y=',g%geoLonT(i,j),g%geoLatT(i,j)
314 write(0,
'(a3,3a12)')
'k',
'h',
'Temp',
'Salt'
316 write(0,
'(i3,3es12.4)') k,h(i,j,k),temp(i,j,k),salt(i,j,k)
318 stop
'Extremum detected'
323 if (h_minimum<0.0)
then
324 do j = js, je ;
do i = is, ie
325 if (minval(h(i,j,:)) == h_minimum)
then
326 write(0,
'(a,2f12.5)')
'x,y=',g%geoLonT(i,j),g%geoLatT(i,j)
327 write(0,
'(a3,3a12)')
'k',
'h',
'Temp',
'Salt'
329 write(0,
'(i3,3es12.4)') k,h(i,j,k),temp(i,j,k),salt(i,j,k)
331 stop
'Negative thickness detected'
336 end subroutine mom_state_stats