pkg/diagnostics/diagstats_calc.F

C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_calc.F,v 1.5 2012/01/20 14:24:08 mlosch Exp $
C $Name:  $

#include "DIAG_OPTIONS.h"

CBOP
C     !ROUTINE: DIAGSTATS_CALC
C     !INTERFACE:
      SUBROUTINE DIAGSTATS_CALC(
     O                  statArr,
     I                  inpArr, frcArr, scaleFact, power, useFract,
     I                  useReg, regMskVal,
     I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
     I                  regMask, arrMask, arrhFac, arrArea,
     I                  arrDr, specialVal, exclSpVal, useWeight,
     I                  myThid )

C     !DESCRIPTION:
C     Compute statistics for this tile, level, region

C     !USES:
      IMPLICIT NONE

#include "EEPARAMS.h"
#include "SIZE.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine Arguments ==
C     statArr     :: output statistics array
C     inpArr      :: input field array to process (compute stats & add to statFld)
C     frcArr      :: fraction used for weighted-average diagnostics
C     scaleFact   :: scaling factor
C     power       :: option to fill-in with the field square (power=2)
C     useFract    :: if True, use fraction-weight
C     useReg      :: how to use region-mask: =0 : not used ;
C                    =1 : grid-center location ; =2 : U location ; =3 : V location
C     regMskVal   :: region-mask identificator value
C                    (point i,j belong to region <=> regMask(i,j) = regMskVal)
C     nStats      :: size of output array: statArr
C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)
C     iRun,jRun   :: range of 1rst & 2nd index to process
C     regMask     :: regional mask
C     arrMask     :: mask for this input array
C     arrhFac     :: weight factor (horizontally varying)
C     arrArea     :: Area weighting factor
C     arrDr       :: uniform weighting factor
C     specialVal  :: special value in input array (to exclude if exclSpVal=T)
C     exclSpVal   :: if T, exclude "specialVal" in input array
C     useWeight   :: use weight factor "arrhFac"
Cc    k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
Cc    parsFld     :: parser field with characteristics of the diagnostics
C     myThid      :: my Thread Id number
      INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
      INTEGER iRun, jRun
      _RL statArr(0:nStats)
      _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
      _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
      _RL scaleFact
      INTEGER power
      LOGICAL useFract
      INTEGER useReg
      _RS regMskVal
      _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL arrDr
      _RL specialVal
      LOGICAL exclSpVal
      LOGICAL useWeight
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C     i,j    :: loop indices
      INTEGER i, j, n
      INTEGER im, ix
#ifndef TARGET_NEC_SX
      LOGICAL inside(sNx+1,sNy+1)
      _RL     tmpFld(sNx+1,sNy+1)
      _RL     tmpVol(sNx+1,sNy+1)
#else
C     Extra variables and fields to support vectorization.
C     This code also uses the intrinsic F90 routines SUM, MINVAL, MAXVAL
C     and thus will not compile with a F77 compiler.
      _RL     arrMaskL(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     tmpFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     tmpVol  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
#endif

      im = nStats - 1
      ix = nStats
      DO n=0,nStats
        statArr(n) = 0.
      ENDDO

#ifndef TARGET_NEC_SX

C-    Apply Scaling Factor and power option to Input Field (-> tmpFld):
      IF ( power.EQ.2 ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          tmpFld(i,j) = scaleFact*inpArr(i,j)
          tmpFld(i,j) = tmpFld(i,j)*tmpFld(i,j)
        ENDDO
       ENDDO
      ELSE
       DO j = 1,jRun
        DO i = 1,iRun
          tmpFld(i,j) = scaleFact*inpArr(i,j)
        ENDDO
       ENDDO
      ENDIF

C-    Set weight factor "tmpVol" (area and hFac and/or fraction field)
C     and part of domain (=inside) where to compute stats
      IF ( useFract .AND. useWeight ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = arrMask(i,j).NE.0.
     &            .AND. arrhFac(i,j).NE.0.
     &            .AND. frcArr(i,j) .NE.0.
          tmpVol(i,j) = arrArea(i,j)*arrhFac(i,j)*frcArr(i,j)
        ENDDO
       ENDDO
      ELSEIF ( useFract ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = arrMask(i,j).NE.0.
     &            .AND. arrhFac(i,j).NE.0.
     &            .AND. frcArr(i,j) .NE.0.
          tmpVol(i,j) = arrArea(i,j)*frcArr(i,j)
        ENDDO
       ENDDO
      ELSEIF ( useWeight ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = arrMask(i,j).NE.0.
     &            .AND. arrhFac(i,j).NE.0.
          tmpVol(i,j) = arrArea(i,j)*arrhFac(i,j)
        ENDDO
       ENDDO
      ELSE
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = arrMask(i,j).NE.0.
     &            .AND. arrhFac(i,j).NE.0.
          tmpVol(i,j) = arrArea(i,j)
        ENDDO
       ENDDO
      ENDIF

C-    Exclude (setting inside=F) Special Value:
      IF ( exclSpVal ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = inside(i,j) .AND. inpArr(i,j).NE.specialVal
        ENDDO
       ENDDO
      ENDIF
C-    Account for Region-mask (refine "inside"):
      IF ( useReg.EQ.1 ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = inside(i,j) .AND. regMask(i,j).EQ.regMskVal
        ENDDO
       ENDDO
      ELSEIF ( useReg.EQ.2 ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = inside(i,j) .AND.( regMask(i,j).EQ.regMskVal
     &                              .OR. regMask(i-1,j).EQ.regMskVal )
        ENDDO
       ENDDO
      ELSEIF ( useReg.EQ.3 ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          inside(i,j) = inside(i,j) .AND.( regMask(i,j).EQ.regMskVal
     &                              .OR. regMask(i,j-1).EQ.regMskVal )
        ENDDO
       ENDDO
      ENDIF

C-    Calculate Stats
      DO j = 1,jRun
       DO i = 1,iRun
        IF ( inside(i,j) ) THEN
          statArr(im) = tmpFld(i,j)
          statArr(0) = statArr(0) + tmpVol(i,j)
          statArr(1) = statArr(1) + tmpVol(i,j)*tmpFld(i,j)
          statArr(2) = statArr(2) + tmpVol(i,j)*tmpFld(i,j)*tmpFld(i,j)
        ENDIF
       ENDDO
      ENDDO
      statArr(ix) = statArr(im)
      DO j = 1,jRun
       DO i = 1,iRun
        IF ( inside(i,j) ) THEN
          statArr(im) = MIN(tmpFld(i,j),statArr(im))
          statArr(ix) = MAX(tmpFld(i,j),statArr(ix))
        ENDIF
       ENDDO
      ENDDO
      statArr(0) = statArr(0)*arrDr
      statArr(1) = statArr(1)*arrDr
      statArr(2) = statArr(2)*arrDr

#else /* TARGET_NEC_SX defined */

      arrMaskL = 0. _d 0

      IF ( useFract .AND. exclSpVal ) THEN

       DO j = 1,jRun
        DO i = 1,iRun
         IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
     &             .AND. arrhFac(i,j).NE.0.
     &             .AND. inpArr(i,j).NE.specialVal )
     &        arrMaskL(i,j) = 1. _d 0
        ENDDO
       ENDDO
       IF ( useWeight ) THEN
        tmpVol = arrhFac*arrArea*frcArr
       ELSE
        tmpVol = arrArea*frcArr
       ENDIF

      ELSEIF ( useFract ) THEN

       DO j = 1,jRun
        DO i = 1,iRun
         IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
     &             .AND. arrhFac(i,j).NE.0. )
     &        arrMaskL(i,j) = 1. _d 0
        ENDDO
       ENDDO
       IF ( useWeight ) THEN
        tmpVol = arrhFac*arrArea*frcArr
       ELSE
        tmpVol = arrArea*frcArr
       ENDIF

      ELSEIF ( exclSpVal ) THEN

       DO j = 1,jRun
        DO i = 1,iRun
         IF ( arrMask(i,j).NE.0.
     &             .AND. arrhFac(i,j).NE.0.
     &             .AND. inpArr(i,j).NE.specialVal )
     &        arrMaskL(i,j) = 1. _d 0
        ENDDO
       ENDDO
       IF ( useWeight ) THEN
        tmpVol = arrhFac*arrArea
       ELSE
        tmpVol = arrArea
       ENDIF

      ELSE

       DO j = 1,jRun
        DO i = 1,iRun
         IF ( arrMask(i,j).NE.0.
     &             .AND. arrhFac(i,j).NE.0. )
     &        arrMaskL(i,j) = 1. _d 0
        ENDDO
       ENDDO
       IF ( useWeight ) THEN
        tmpVol = arrhFac*arrArea
       ELSE
        tmpVol = arrArea
       ENDIF

      ENDIF

C-    Account for Region-mask:
      IF ( useReg.EQ.1 ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          IF ( regMask(i,j).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
        ENDDO
       ENDDO
      ELSEIF ( useReg.EQ.2 ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          IF ( regMask(i,j).NE.regMskVal .AND.
     &       regMask(i-1,j).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
        ENDDO
       ENDDO
      ELSEIF ( useReg.EQ.3 ) THEN
       DO j = 1,jRun
        DO i = 1,iRun
          IF ( regMask(i,j).NE.regMskVal .AND.
     &       regMask(i,j-1).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
        ENDDO
       ENDDO
      ENDIF

C     inpArr can be undefined/non-initialised in overlaps, so we need
C     to clean this fields first by copying the defined range to tmpFld
      tmpFld = 0. _d 0
      DO j = 1,jRun
       DO i = 1,iRun
        tmpFld(i,j) = inpArr(i,j)*scaleFact
       ENDDO
      ENDDO
      IF ( power.EQ.2) THEN
       tmpFld = tmpFld*tmpFld
      ENDIF
C     sum up the volume
      tmpVol = tmpVol*arrMaskL
      statArr(0)  = SUM(tmpVol)*arrDr
C     compute and sum up volume*field
      tmpVol = tmpVol*tmpFld
      statArr(1)  = SUM(tmpVol)*arrDr
C     compute and sum up volume*field**2
      tmpVol = tmpVol*tmpFld
      statArr(2)  = SUM(tmpVol)*arrDr
      statArr(im) = MINVAL(tmpFld, MASK = arrMaskL>0.)
      statArr(ix) = MAXVAL(tmpFld, MASK = arrMaskL>0.)

#endif /* TARGET_NEC_SX */

      RETURN
      END
1	jmc	1.6	C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_calc.F,v 1.5 2012/01/20 14:24:08 mlosch Exp $
2	jmc	1.1	C $Name: $
3
4			#include "DIAG_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: DIAGSTATS_CALC
8			C !INTERFACE:
9			SUBROUTINE DIAGSTATS_CALC(
10			O statArr,
11			I inpArr, frcArr, scaleFact, power, useFract,
12	jmc	1.6	I useReg, regMskVal,
13	jmc	1.1	I nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
14			I regMask, arrMask, arrhFac, arrArea,
15			I arrDr, specialVal, exclSpVal, useWeight,
16			I myThid )
17
18			C !DESCRIPTION:
19			C Compute statistics for this tile, level, region
20
21			C !USES:
22			IMPLICIT NONE
23
24			#include "EEPARAMS.h"
25			#include "SIZE.h"
26
27			C !INPUT/OUTPUT PARAMETERS:
28			C == Routine Arguments ==
29			C statArr :: output statistics array
30			C inpArr :: input field array to process (compute stats & add to statFld)
31			C frcArr :: fraction used for weighted-average diagnostics
32			C scaleFact :: scaling factor
33			C power :: option to fill-in with the field square (power=2)
34			C useFract :: if True, use fraction-weight
35	jmc	1.6	C useReg :: how to use region-mask: =0 : not used ;
36			C =1 : grid-center location ; =2 : U location ; =3 : V location
37	jmc	1.1	C regMskVal :: region-mask identificator value
38	jmc	1.6	C (point i,j belong to region <=> regMask(i,j) = regMskVal)
39	jmc	1.1	C nStats :: size of output array: statArr
40			C sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
41			C sizJ1,sizJ2 :: size of inpArr array: 2nd index range (min,max)
42			C iRun,jRun :: range of 1rst & 2nd index to process
43			C regMask :: regional mask
44			C arrMask :: mask for this input array
45			C arrhFac :: weight factor (horizontally varying)
46			C arrArea :: Area weighting factor
47			C arrDr :: uniform weighting factor
48			C specialVal :: special value in input array (to exclude if exclSpVal=T)
49			C exclSpVal :: if T, exclude "specialVal" in input array
50			C useWeight :: use weight factor "arrhFac"
51			Cc k,bi,bj :: level and tile indices used for weighting (mask,area ...)
52			Cc parsFld :: parser field with characteristics of the diagnostics
53			C myThid :: my Thread Id number
54			INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
55			INTEGER iRun, jRun
56			_RL statArr(0:nStats)
57			_RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
58			_RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
59			_RL scaleFact
60			INTEGER power
61			LOGICAL useFract
62	jmc	1.6	INTEGER useReg
63	jmc	1.1	_RS regMskVal
64			_RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65			_RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
66			_RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
67			_RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68			_RL arrDr
69			_RL specialVal
70			LOGICAL exclSpVal
71			LOGICAL useWeight
72			INTEGER myThid
73			CEOP
74
75			C !LOCAL VARIABLES:
76			C i,j :: loop indices
77			INTEGER i, j, n
78			INTEGER im, ix
79	mlosch	1.2	#ifndef TARGET_NEC_SX
80	jmc	1.6	LOGICAL inside(sNx+1,sNy+1)
81			_RL tmpFld(sNx+1,sNy+1)
82			_RL tmpVol(sNx+1,sNy+1)
83	mlosch	1.2	#else
84			C Extra variables and fields to support vectorization.
85			C This code also uses the intrinsic F90 routines SUM, MINVAL, MAXVAL
86			C and thus will not compile with a F77 compiler.
87			_RL arrMaskL(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
88			_RL tmpFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
89			_RL tmpVol (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
90			#endif
91	jmc	1.1
92			im = nStats - 1
93			ix = nStats
94			DO n=0,nStats
95			statArr(n) = 0.
96			ENDDO
97
98	mlosch	1.2	#ifndef TARGET_NEC_SX
99	jmc	1.1
100	jmc	1.6	C- Apply Scaling Factor and power option to Input Field (-> tmpFld):
101			IF ( power.EQ.2 ) THEN
102	jmc	1.1	DO j = 1,jRun
103			DO i = 1,iRun
104	jmc	1.6	tmpFld(i,j) = scaleFact*inpArr(i,j)
105			tmpFld(i,j) = tmpFld(i,j)*tmpFld(i,j)
106	jmc	1.1	ENDDO
107			ENDDO
108	jmc	1.6	ELSE
109			DO j = 1,jRun
110			DO i = 1,iRun
111			tmpFld(i,j) = scaleFact*inpArr(i,j)
112			ENDDO
113			ENDDO
114			ENDIF
115	jmc	1.1
116	jmc	1.6	C- Set weight factor "tmpVol" (area and hFac and/or fraction field)
117			C and part of domain (=inside) where to compute stats
118			IF ( useFract .AND. useWeight ) THEN
119			DO j = 1,jRun
120			DO i = 1,iRun
121			inside(i,j) = arrMask(i,j).NE.0.
122			& .AND. arrhFac(i,j).NE.0.
123			& .AND. frcArr(i,j) .NE.0.
124			tmpVol(i,j) = arrArea(i,j)arrhFac(i,j)frcArr(i,j)
125			ENDDO
126			ENDDO
127	jmc	1.1	ELSEIF ( useFract ) THEN
128			DO j = 1,jRun
129			DO i = 1,iRun
130	jmc	1.6	inside(i,j) = arrMask(i,j).NE.0.
131			& .AND. arrhFac(i,j).NE.0.
132			& .AND. frcArr(i,j) .NE.0.
133			tmpVol(i,j) = arrArea(i,j)*frcArr(i,j)
134	jmc	1.1	ENDDO
135			ENDDO
136	jmc	1.6	ELSEIF ( useWeight ) THEN
137	jmc	1.1	DO j = 1,jRun
138			DO i = 1,iRun
139	jmc	1.6	inside(i,j) = arrMask(i,j).NE.0.
140			& .AND. arrhFac(i,j).NE.0.
141			tmpVol(i,j) = arrArea(i,j)*arrhFac(i,j)
142	jmc	1.1	ENDDO
143			ENDDO
144			ELSE
145			DO j = 1,jRun
146			DO i = 1,iRun
147	jmc	1.6	inside(i,j) = arrMask(i,j).NE.0.
148			& .AND. arrhFac(i,j).NE.0.
149			tmpVol(i,j) = arrArea(i,j)
150	jmc	1.1	ENDDO
151			ENDDO
152			ENDIF
153
154	jmc	1.6	C- Exclude (setting inside=F) Special Value:
155			IF ( exclSpVal ) THEN
156	mlosch	1.2	DO j = 1,jRun
157			DO i = 1,iRun
158	jmc	1.6	inside(i,j) = inside(i,j) .AND. inpArr(i,j).NE.specialVal
159	mlosch	1.2	ENDDO
160			ENDDO
161	jmc	1.6	ENDIF
162			C- Account for Region-mask (refine "inside"):
163			IF ( useReg.EQ.1 ) THEN
164	mlosch	1.2	DO j = 1,jRun
165			DO i = 1,iRun
166	jmc	1.6	inside(i,j) = inside(i,j) .AND. regMask(i,j).EQ.regMskVal
167	mlosch	1.2	ENDDO
168			ENDDO
169	jmc	1.6	ELSEIF ( useReg.EQ.2 ) THEN
170	mlosch	1.2	DO j = 1,jRun
171			DO i = 1,iRun
172	jmc	1.6	inside(i,j) = inside(i,j) .AND.( regMask(i,j).EQ.regMskVal
173			& .OR. regMask(i-1,j).EQ.regMskVal )
174	mlosch	1.2	ENDDO
175			ENDDO
176	jmc	1.6	ELSEIF ( useReg.EQ.3 ) THEN
177	mlosch	1.2	DO j = 1,jRun
178			DO i = 1,iRun
179	jmc	1.6	inside(i,j) = inside(i,j) .AND.( regMask(i,j).EQ.regMskVal
180			& .OR. regMask(i,j-1).EQ.regMskVal )
181	mlosch	1.2	ENDDO
182			ENDDO
183	jmc	1.6	ENDIF
184
185			C- Calculate Stats
186			DO j = 1,jRun
187			DO i = 1,iRun
188			IF ( inside(i,j) ) THEN
189			statArr(im) = tmpFld(i,j)
190			statArr(0) = statArr(0) + tmpVol(i,j)
191			statArr(1) = statArr(1) + tmpVol(i,j)*tmpFld(i,j)
192			statArr(2) = statArr(2) + tmpVol(i,j)tmpFld(i,j)tmpFld(i,j)
193			ENDIF
194			ENDDO
195			ENDDO
196			statArr(ix) = statArr(im)
197			DO j = 1,jRun
198			DO i = 1,iRun
199			IF ( inside(i,j) ) THEN
200			statArr(im) = MIN(tmpFld(i,j),statArr(im))
201			statArr(ix) = MAX(tmpFld(i,j),statArr(ix))
202			ENDIF
203			ENDDO
204			ENDDO
205			statArr(0) = statArr(0)*arrDr
206			statArr(1) = statArr(1)*arrDr
207			statArr(2) = statArr(2)*arrDr
208
209			#else /* TARGET_NEC_SX defined */
210
211			arrMaskL = 0. _d 0
212	mlosch	1.2
213	jmc	1.6	IF ( useFract .AND. exclSpVal ) THEN
214	mlosch	1.2
215			DO j = 1,jRun
216			DO i = 1,iRun
217			IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
218	jmc	1.6	& .AND. arrhFac(i,j).NE.0.
219			& .AND. inpArr(i,j).NE.specialVal )
220	mlosch	1.2	& arrMaskL(i,j) = 1. _d 0
221			ENDDO
222			ENDDO
223			IF ( useWeight ) THEN
224	mlosch	1.3	tmpVol = arrhFacarrAreafrcArr
225	mlosch	1.2	ELSE
226	mlosch	1.3	tmpVol = arrArea*frcArr
227	mlosch	1.2	ENDIF
228
229			ELSEIF ( useFract ) THEN
230
231			DO j = 1,jRun
232			DO i = 1,iRun
233			IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
234	jmc	1.6	& .AND. arrhFac(i,j).NE.0. )
235	mlosch	1.2	& arrMaskL(i,j) = 1. _d 0
236			ENDDO
237			ENDDO
238			IF ( useWeight ) THEN
239	mlosch	1.3	tmpVol = arrhFacarrAreafrcArr
240	mlosch	1.2	ELSE
241	mlosch	1.3	tmpVol = arrArea*frcArr
242	mlosch	1.2	ENDIF
243
244			ELSEIF ( exclSpVal ) THEN
245
246			DO j = 1,jRun
247			DO i = 1,iRun
248			IF ( arrMask(i,j).NE.0.
249	jmc	1.6	& .AND. arrhFac(i,j).NE.0.
250			& .AND. inpArr(i,j).NE.specialVal )
251	mlosch	1.2	& arrMaskL(i,j) = 1. _d 0
252			ENDDO
253			ENDDO
254			IF ( useWeight ) THEN
255	mlosch	1.3	tmpVol = arrhFac*arrArea
256	mlosch	1.2	ELSE
257	mlosch	1.3	tmpVol = arrArea
258	mlosch	1.2	ENDIF
259
260			ELSE
261
262			DO j = 1,jRun
263			DO i = 1,iRun
264			IF ( arrMask(i,j).NE.0.
265	jmc	1.6	& .AND. arrhFac(i,j).NE.0. )
266	mlosch	1.2	& arrMaskL(i,j) = 1. _d 0
267			ENDDO
268			ENDDO
269			IF ( useWeight ) THEN
270	mlosch	1.3	tmpVol = arrhFac*arrArea
271	mlosch	1.2	ELSE
272	mlosch	1.3	tmpVol = arrArea
273	mlosch	1.2	ENDIF
274
275			ENDIF
276	jmc	1.6
277			C- Account for Region-mask:
278			IF ( useReg.EQ.1 ) THEN
279			DO j = 1,jRun
280			DO i = 1,iRun
281			IF ( regMask(i,j).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
282			ENDDO
283			ENDDO
284			ELSEIF ( useReg.EQ.2 ) THEN
285			DO j = 1,jRun
286			DO i = 1,iRun
287			IF ( regMask(i,j).NE.regMskVal .AND.
288			& regMask(i-1,j).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
289			ENDDO
290			ENDDO
291			ELSEIF ( useReg.EQ.3 ) THEN
292			DO j = 1,jRun
293			DO i = 1,iRun
294			IF ( regMask(i,j).NE.regMskVal .AND.
295			& regMask(i,j-1).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
296			ENDDO
297			ENDDO
298			ENDIF
299
300	mlosch	1.4	C inpArr can be undefined/non-initialised in overlaps, so we need
301			C to clean this fields first by copying the defined range to tmpFld
302			tmpFld = 0. _d 0
303			DO j = 1,jRun
304			DO i = 1,iRun
305	jmc	1.6	tmpFld(i,j) = inpArr(i,j)*scaleFact
306	mlosch	1.4	ENDDO
307			ENDDO
308	mlosch	1.2	IF ( power.EQ.2) THEN
309	mlosch	1.4	tmpFld = tmpFld*tmpFld
310	mlosch	1.2	ENDIF
311			C sum up the volume
312			tmpVol = tmpVol*arrMaskL
313	mlosch	1.3	statArr(0) = SUM(tmpVol)*arrDr
314	mlosch	1.2	C compute and sum up volume*field
315			tmpVol = tmpVol*tmpFld
316	mlosch	1.5	statArr(1) = SUM(tmpVol)*arrDr
317	mlosch	1.2	C compute and sum up volumefield*2
318			tmpVol = tmpVol*tmpFld
319	mlosch	1.5	statArr(2) = SUM(tmpVol)*arrDr
320			statArr(im) = MINVAL(tmpFld, MASK = arrMaskL>0.)
321			statArr(ix) = MAXVAL(tmpFld, MASK = arrMaskL>0.)
322	mlosch	1.2
323			#endif /* TARGET_NEC_SX */
324
325	jmc	1.1	RETURN
326			END