pkg/diagnostics/diagstats_others_calc.F

b614ad87ad Jean*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 C--  File diagstats_others_calc.F: Routines to calculate regional statistics
                0004 C                                  and dealing with special type of fields
                0005 C--   o DIAGSTATS_LM_CALC :: for fields on FIZHI-grid (parse(10)='L' or 'M')
                0006 C--   o DIAGSTATS_G_CALC  :: for land-type fields     (parse(10)='G')
                0007
                0008 CBOP
                0009 C     !ROUTINE: DIAGSTATS_LM_CALC
                0010 C     !INTERFACE:
                0011       SUBROUTINE DIAGSTATS_LM_CALC(
                0012      O                  statArr,
                0013      I                  inpArr, frcArr, scaleFact, power, useFract,
c8eb4002b4 Jean*0014      I                  useReg, regMskVal,
b614ad87ad Jean*0015      I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
                0016      I                  regMask, arrMask, arrArea,
                0017      I                  specialVal, exclSpVal,
                0018      I                  k,bi,bj, parsFld, myThid )
                0019
                0020 C     !DESCRIPTION:
                0021 C     Compute statistics for this tile, level, region
                0022 C     using FIZHI level thickness
                0023
                0024 C     !USES:
                0025       IMPLICIT NONE
                0026
                0027 #include "EEPARAMS.h"
                0028 #include "SIZE.h"
                0029 #ifdef ALLOW_FIZHI
                0030 #include "fizhi_SIZE.h"
                0031 #include "gridalt_mapping.h"
                0032 #endif
                0033
                0034 C     !INPUT/OUTPUT PARAMETERS:
                0035 C     == Routine Arguments ==
                0036 C     statArr     :: output statistics array
                0037 C     inpArr      :: input field array to process (compute stats & add to statFld)
                0038 C     frcArr      :: fraction used for weighted-average diagnostics
                0039 C     scaleFact   :: scaling factor
                0040 C     power       :: option to fill-in with the field square (power=2)
                0041 C     useFract    :: if True, use fraction-weight
c8eb4002b4 Jean*0042 C     useReg      :: how to use region-mask: =0 : not used ;
                0043 C                    =1 : grid-center location ; =2 : U location ; =3 : V location
b614ad87ad Jean*0044 C     regMskVal   :: region-mask identificator value
                0045 C     nStats      :: size of output statArr
                0046 C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
                0047 C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)
                0048 C     iRun,jRun   :: range of 1rst & 2nd index to process
                0049 C     regMask     :: regional mask
                0050 C     arrMask     :: mask for this input array
                0051 C     arrArea     :: Area weighting factor
                0052 C     specialVal  :: special value in input array (to exclude if exclSpVal=T)
                0053 C     exclSpVal   :: if T, exclude "specialVal" in input array
                0054 C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
                0055 C     parsFld     :: parser field with characteristics of the diagnostics
                0056 C     myThid      :: my Thread Id number
                0057       INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
                0058       INTEGER iRun, jRun
                0059       _RL statArr(0:nStats)
                0060       _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
                0061       _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
                0062       _RL scaleFact
                0063       INTEGER power
                0064       LOGICAL useFract
c8eb4002b4 Jean*0065       INTEGER useReg
b614ad87ad Jean*0066       _RS regMskVal
                0067       _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0068       _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0069       _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0070       _RL specialVal
                0071       LOGICAL exclSpVal
                0072       INTEGER k, bi, bj
                0073       CHARACTER*16 parsFld
                0074       INTEGER myThid
                0075 CEOP
                0076
                0077 #ifdef ALLOW_FIZHI
                0078 C     !LOCAL VARIABLES:
                0079       LOGICAL useWeight
                0080       INTEGER kl
                0081       _RL drLoc
c605a819b3 Jean*0082 #ifndef REAL4_IS_SLOW
                0083       INTEGER i,j
                0084       _RS tmp_hFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0085 #endif
b614ad87ad Jean*0086
                0087 c     IF ( useFIZHI ) THEN
                0088
                0089         IF ( parsFld(10:10).EQ.'L' ) THEN
                0090           kl = 1 + Nrphys - k
                0091           useWeight = .TRUE.
                0092         ELSE
                0093           kl = 1
                0094           useWeight = .FALSE.
                0095         ENDIF
                0096         drLoc = 1. _d 0
                0097
c605a819b3 Jean*0098 #ifdef REAL4_IS_SLOW
cfc143f431 Jean*0099         CALL DIAGSTATS_CALC(
b614ad87ad Jean*0100      O            statArr,
                0101      I            inpArr, frcArr, scaleFact, power, useFract,
c8eb4002b4 Jean*0102      I            useReg, regMskVal,
b614ad87ad Jean*0103      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
                0104      I            regMask, arrMask,
cfc143f431 Jean*0105      I            dpphys(1-OLx,1-OLy,kl,bi,bj), arrArea,
b614ad87ad Jean*0106      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
c605a819b3 Jean*0107 #else /* REAL4_IS_SLOW */
                0108 C    make local copy of dpphys (RL type) into RS array tmp_hFac
                0109         DO j=1-OLy,sNy+OLy
                0110          DO i=1-OLx,sNx+OLx
                0111           tmp_hFac(i,j) = dpphys(i,j,kl,bi,bj)
                0112          ENDDO
                0113         ENDDO
cfc143f431 Jean*0114         CALL DIAGSTATS_CALC(
c605a819b3 Jean*0115      O            statArr,
                0116      I            inpArr, frcArr, scaleFact, power, useFract,
c8eb4002b4 Jean*0117      I            useReg, regMskVal,
c605a819b3 Jean*0118      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
                0119      I            regMask, arrMask, tmp_hFac, arrArea,
                0120      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0121 #endif /* REAL4_IS_SLOW */
b614ad87ad Jean*0122
                0123 c     ENDIF
                0124 #endif /* ALLOW_FIZHI */
                0125
                0126       RETURN
                0127       END
                0128
                0129 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0130
                0131 CBOP
                0132 C     !ROUTINE: DIAGSTATS_G_CALC
                0133 C     !INTERFACE:
                0134       SUBROUTINE DIAGSTATS_G_CALC(
                0135      O                  statArr,
                0136      I                  inpArr, frcArr, scaleFact, power, useFract,
c8eb4002b4 Jean*0137      I                  useReg, regMskVal,
b614ad87ad Jean*0138      I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
                0139      I                  regMask, arrArea,
                0140      I                  specialVal, exclSpVal,
                0141      I                  k,bi,bj, parsFld, myThid )
                0142
                0143 C     !DESCRIPTION:
                0144 C     Compute statistics for this tile, level, region
                0145 C     using "ground" (land) type fraction
                0146
                0147 C     !USES:
                0148       IMPLICIT NONE
                0149
                0150 #include "EEPARAMS.h"
                0151 #ifdef ALLOW_LAND
                0152 # include "LAND_SIZE.h"
                0153 # include "LAND_PARAMS.h"
                0154 # ifdef ALLOW_AIM
                0155 #  include "AIM_FFIELDS.h"
                0156 # endif
                0157 #else
                0158 # include "SIZE.h"
                0159 #endif
                0160
                0161 C     !INPUT/OUTPUT PARAMETERS:
                0162 C     == Routine Arguments ==
                0163 C     statArr     :: output statistics array
                0164 C     inpArr      :: input field array to process (compute stats & add to statFld)
                0165 C     frcArr      :: fraction used for weighted-average diagnostics
                0166 C     scaleFact   :: scaling factor
                0167 C     power       :: option to fill-in with the field square (power=2)
                0168 C     useFract    :: if True, use fraction-weight
c8eb4002b4 Jean*0169 C     useReg      :: how to use region-mask: =0 : not used ;
                0170 C                    =1 : grid-center location ; =2 : U location ; =3 : V location
b614ad87ad Jean*0171 C     regMskVal   :: region-mask identificator value
                0172 C     nStats      :: size of output statArr
                0173 C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
                0174 C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)
                0175 C     iRun,jRun   :: range of 1rst & 2nd index to process
                0176 C     regMask     :: regional mask
                0177 C     arrArea     :: Area weighting factor
                0178 C     specialVal  :: special value in input array (to exclude if exclSpVal=T)
                0179 C     exclSpVal   :: if T, exclude "specialVal" in input array
                0180 C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
                0181 C     parsFld     :: parser field with characteristics of the diagnostics
                0182 C     myThid      :: my Thread Id number
                0183       INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
                0184       INTEGER iRun, jRun
                0185       _RL statArr(0:nStats)
                0186       _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
                0187       _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
                0188       _RL scaleFact
                0189       INTEGER power
                0190       LOGICAL useFract
c8eb4002b4 Jean*0191       INTEGER useReg
b614ad87ad Jean*0192       _RS regMskVal
                0193       _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0194       _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0195       _RL specialVal
                0196       LOGICAL exclSpVal
                0197       INTEGER k, bi, bj
                0198       CHARACTER*16 parsFld
                0199       INTEGER myThid
                0200 CEOP
                0201
                0202 #ifdef ALLOW_LAND
                0203 C     !LOCAL VARIABLES:
                0204       LOGICAL useWeight
                0205       INTEGER kl
                0206       _RL drLoc
                0207
                0208 c     IF ( useLand ) THEN
                0209
                0210         IF ( parsFld(10:10).EQ.'G' ) THEN
                0211           kl = MIN(k,land_nLev)
                0212           drLoc = land_dzF(kl)
                0213         ELSE
                0214           drLoc = 1. _d 0
                0215         ENDIF
                0216         useWeight = .TRUE.
                0217
cfc143f431 Jean*0218         CALL DIAGSTATS_CALC(
b614ad87ad Jean*0219      O            statArr,
                0220      I            inpArr, frcArr, scaleFact, power, useFract,
c8eb4002b4 Jean*0221      I            useReg, regMskVal,
b614ad87ad Jean*0222      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0223      I            regMask, aim_landFr(1-OLx,1-OLy,bi,bj),
                0224      I            aim_landFr(1-OLx,1-OLy,bi,bj), arrArea,
b614ad87ad Jean*0225      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0226
                0227 c     ENDIF
                0228 #endif /* ALLOW_LAND */
                0229
                0230       RETURN
                0231       END