C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_others_calc.F,v 1.4 2014/08/25 22:13:51 jmc Exp $
C $Name: $
#include "DIAG_OPTIONS.h"
C-- File diagstats_others_calc.F: Routines to calculate regional statistics
C and dealing with special type of fields
C-- o DIAGSTATS_LM_CALC :: for fields on FIZHI-grid (parse(10)='L' or 'M')
C-- o DIAGSTATS_G_CALC :: for land-type fields (parse(10)='G')
CBOP
C !ROUTINE: DIAGSTATS_LM_CALC
C !INTERFACE:
SUBROUTINE DIAGSTATS_LM_CALC(
O statArr,
I inpArr, frcArr, scaleFact, power, useFract,
I useReg, regMskVal,
I nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
I regMask, arrMask, arrArea,
I specialVal, exclSpVal,
I k,bi,bj, parsFld, myThid )
C !DESCRIPTION:
C Compute statistics for this tile, level, region
C using FIZHI level thickness
C !USES:
IMPLICIT NONE
#include "EEPARAMS.h"
#include "SIZE.h"
#ifdef ALLOW_FIZHI
#include "fizhi_SIZE.h"
#include "gridalt_mapping.h"
#endif
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 nStats :: size of output 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 arrArea :: Area weighting factor
C specialVal :: special value in input array (to exclude if exclSpVal=T)
C exclSpVal :: if T, exclude "specialVal" in input array
C k,bi,bj :: level and tile indices used for weighting (mask,area ...)
C 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 arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
_RL specialVal
LOGICAL exclSpVal
INTEGER k, bi, bj
CHARACTER*16 parsFld
INTEGER myThid
CEOP
#ifdef ALLOW_FIZHI
C !LOCAL VARIABLES:
LOGICAL useWeight
INTEGER kl
_RL drLoc
#ifndef REAL4_IS_SLOW
INTEGER i,j
_RS tmp_hFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
#endif
c IF ( useFIZHI ) THEN
IF ( parsFld(10:10).EQ.'L' ) THEN
kl = 1 + Nrphys - k
useWeight = .TRUE.
ELSE
kl = 1
useWeight = .FALSE.
ENDIF
drLoc = 1. _d 0
#ifdef REAL4_IS_SLOW
CALL DIAGSTATS_CALC(
O statArr,
I inpArr, frcArr, scaleFact, power, useFract,
I useReg, regMskVal,
I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
I regMask, arrMask,
I dpphys(1-OLx,1-OLy,kl,bi,bj), arrArea,
I drLoc, specialVal, exclSpVal, useWeight, myThid )
#else /* REAL4_IS_SLOW */
C make local copy of dpphys (RL type) into RS array tmp_hFac
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
tmp_hFac(i,j) = dpphys(i,j,kl,bi,bj)
ENDDO
ENDDO
CALL DIAGSTATS_CALC(
O statArr,
I inpArr, frcArr, scaleFact, power, useFract,
I useReg, regMskVal,
I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
I regMask, arrMask, tmp_hFac, arrArea,
I drLoc, specialVal, exclSpVal, useWeight, myThid )
#endif /* REAL4_IS_SLOW */
c ENDIF
#endif /* ALLOW_FIZHI */
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: DIAGSTATS_G_CALC
C !INTERFACE:
SUBROUTINE DIAGSTATS_G_CALC(
O statArr,
I inpArr, frcArr, scaleFact, power, useFract,
I useReg, regMskVal,
I nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
I regMask, arrArea,
I specialVal, exclSpVal,
I k,bi,bj, parsFld, myThid )
C !DESCRIPTION:
C Compute statistics for this tile, level, region
C using "ground" (land) type fraction
C !USES:
IMPLICIT NONE
#include "EEPARAMS.h"
#ifdef ALLOW_LAND
# include "LAND_SIZE.h"
# include "LAND_PARAMS.h"
# ifdef ALLOW_AIM
# include "AIM_FFIELDS.h"
# endif
#else
# include "SIZE.h"
#endif
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 nStats :: size of output 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 arrArea :: Area weighting factor
C specialVal :: special value in input array (to exclude if exclSpVal=T)
C exclSpVal :: if T, exclude "specialVal" in input array
C k,bi,bj :: level and tile indices used for weighting (mask,area ...)
C 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 arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
_RL specialVal
LOGICAL exclSpVal
INTEGER k, bi, bj
CHARACTER*16 parsFld
INTEGER myThid
CEOP
#ifdef ALLOW_LAND
C !LOCAL VARIABLES:
LOGICAL useWeight
INTEGER kl
_RL drLoc
c IF ( useLand ) THEN
IF ( parsFld(10:10).EQ.'G' ) THEN
kl = MIN(k,land_nLev)
drLoc = land_dzF(kl)
ELSE
drLoc = 1. _d 0
ENDIF
useWeight = .TRUE.
CALL DIAGSTATS_CALC(
O statArr,
I inpArr, frcArr, scaleFact, power, useFract,
I useReg, regMskVal,
I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
I regMask, aim_landFr(1-OLx,1-OLy,bi,bj),
I aim_landFr(1-OLx,1-OLy,bi,bj), arrArea,
I drLoc, specialVal, exclSpVal, useWeight, myThid )
c ENDIF
#endif /* ALLOW_LAND */
RETURN
END