***s/r statf_dm - calcule la moyenne, la variance, le minimum et
* le maximum d un champs et imprime le resultat.
*
subroutine statf_dm ( F_field, F_nv_S, F_no, F_from_S, F_r8stat_L, 26
$ lminx,lmaxx,lminy,lmaxy,lnk,
$ F_i0,F_j0,F_k0,F_in,F_jn,F_kn)
implicit none
*
character*(*) F_nv_S , F_from_S
logical F_r8stat_L
integer lminx,lmaxx,lminy,lmaxy,lnk,
$ F_i0,F_j0,F_k0,F_in,F_jn,F_kn,F_no,unf
real F_field(lminx:lmaxx,lminy:lmaxy,lnk)
*
*author
* M. Desgagne
*
*revision
* v2_00 - Desgagne M. - initial MPI version (from MC2)
* v3_00 - Desgagne & Lee - Lam configuration
*
*object
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_field I Field to be operated on
* F_nv_S I User provided string to define F_field
* F_no I Usually the timestep #
* F_from_S I Usually the name of the calling subroutine
* F_i0,F_j0 I Global lower-left indexes of the sub-domain
* on which to perform statistics
* F_in,F_jn I Global upper-right indexes of the sub-domain
* on which to perform statistics
* F_k0,F_kn I Range of levels on which to perform statistics
*----------------------------------------------------------------
*
*implicits
#include "lcldim.cdk"
#include "partopo.cdk"
include 'mpif.h'
*
logical done
integer i,j,k,imin,jmin,kmin,imax,jmax,kmax,err,
$ nijk(8,numproc),tnijk(8,numproc),nw,i0,in,j0,jn,
$ bnd_w,bnd_e,bnd_s,bnd_n
real*8 sum,sumd2,moy,var,mind,maxd,fijk,npt_8,
$ minmax(3,max(2,numproc)),tminmax(3,max(2,numproc))
data done /.false./
save done,bnd_w,bnd_e,bnd_s,bnd_n
*
*--------------------------------------------------------------------
*
nijk (:,:) = 0
minmax(:,:) = 0.0d0
*
if (.not.done) then
bnd_w = 1 - west *hx
bnd_e = ldni + east *hx
bnd_s = 1 - south*hy
bnd_n = ldnj + north*hy
endif
*
i0 = max(F_i0 - gc_ld(1,myproc) + 1, bnd_w)
in = min(F_in - gc_ld(1,myproc) + 1, bnd_e)
j0 = max(F_j0 - gc_ld(3,myproc) + 1, bnd_s)
jn = min(F_jn - gc_ld(3,myproc) + 1, bnd_n)
nijk(8,myproc+1) = 0
if ((i0.le.bnd_e).and.(in.ge.bnd_w).and.
$ (j0.le.bnd_n).and.(jn.ge.bnd_s) ) nijk(8,myproc+1) = 1
*
if (nijk(8,myproc+1).gt.0) then
sum = 0.0
sumd2 = 0.0
imin = i0
jmin = j0
kmin = F_k0
imax = i0
jmax = j0
kmax = F_k0
maxd = F_field(i0,j0,F_k0)
mind = F_field(i0,j0,F_k0)
*
do k=F_k0,F_kn
do j=j0,jn
do i=i0,in
fijk = F_field(i,j,k)
sum = sum + fijk
sumd2 = sumd2 + fijk*fijk
if (fijk .gt. maxd) then
maxd = fijk
imax = i
jmax = j
kmax = k
endif
if (fijk .lt. mind) then
mind = fijk
imin = i
jmin = j
kmin = k
endif
end do
end do
end do
*
minmax(1,myproc+1) = maxd
minmax(2,myproc+1) = mind
minmax(3,1) = sum
minmax(3,2) = sumd2
*
nijk (1,myproc+1) = imax + gc_ld(1,myproc) - 1
nijk (2,myproc+1) = jmax + gc_ld(3,myproc) - 1
nijk (3,myproc+1) = kmax
nijk (4,myproc+1) = imin + gc_ld(1,myproc) - 1
nijk (5,myproc+1) = jmin + gc_ld(3,myproc) - 1
nijk (6,myproc+1) = kmin
nijk (7,1) = (in-i0+1)*(jn-j0+1)*(F_kn-F_k0+1)
*
endif
*
nw = 3*max(2,numproc)
call MPI_REDUCE ( nijk , tnijk , 8*numproc,MPI_INTEGER,
$ MPI_SUM, 0, MPI_COMM_WORLD, err )
call MPI_REDUCE ( minmax, tminmax, nw,MPI_DOUBLE_PRECISION,
$ MPI_SUM, 0, MPI_COMM_WORLD, err )
*
if (myproc.eq.0) then
*
imax = tnijk (1,1)
jmax = tnijk (2,1)
kmax = tnijk (3,1)
imin = tnijk (4,1)
jmin = tnijk (5,1)
kmin = tnijk (6,1)
maxd = tminmax(1,1)
mind = tminmax(2,1)
*
do i=1,numproc
if ( tnijk (8,i) .gt. 0 ) then
fijk = tminmax(1,i)
if (fijk .gt. maxd) then
maxd = fijk
imax = tnijk (1,i)
jmax = tnijk (2,i)
kmax = tnijk (3,i)
endif
fijk = tminmax(2,i)
if (fijk .lt. mind) then
mind = fijk
imin = tnijk (4,i)
jmin = tnijk (5,i)
kmin = tnijk (6,i)
endif
endif
end do
*
npt_8 = dble(tnijk(7,1))
sum = tminmax(3,1)
sumd2 = tminmax(3,2)
moy = sum / npt_8
var = max(0.d0,(sumd2 + moy*moy*npt_8 - 2*moy*sum) / npt_8)
var = sqrt(var)
*
if (F_r8stat_L) then
write(6,99) F_no,F_nv_S,moy,var,imin,jmin,kmin,mind,
$ imax,jmax,kmax,maxd
else
write(6,98) F_no,F_nv_S,moy,var,imin,jmin,kmin,mind,
$ imax,jmax,kmax,maxd
endif
*
endif
*
done = .true.
*
98 format (i5,a7,' Mean:',e14.7,' Var:',e14.7,
$ ' Min:[(',i5,',',i5,',',i5,')',
$ e14.7,']',' Max:[(',i5,',',i5,',',i5,')',
$ e14.7,']')
99 format (i5,a7,' Mean:',e22.14,' Var:',e22.14,/
$ ' Min:[(',i5,',',i5,',',i5,')',
$ e22.14,']',' Max:[(',i5,',',i5,',',i5,')',
$ e22.14,']')
*
*----------------------------------------------------------------
*
return
end