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