Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:39:06 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
3e5de6a370 Jean*0001 #include "DIAG_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: DIAGSTATS_LOCAL
                0005 C     !INTERFACE:
                0006       SUBROUTINE DIAGSTATS_LOCAL(
                0007      U                  statFld,
662c087d92 Jean*0008      I                  inpFld, frcFld,
                0009      I                  scaleFact, power, useFract, sizF,
3e5de6a370 Jean*0010      I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
                0011      I                  iRun,jRun,kIn,biIn,bjIn,
c9169fbe09 Jean*0012      I                  k,bi,bj, bibjFlg, region2fill,
                0013      I                  ndId, parsFld, myThid )
3e5de6a370 Jean*0014 
                0015 C     !DESCRIPTION:
8c547beaff Jean*0016 C     Update array statFld
3e5de6a370 Jean*0017 C     by adding statistics over the range [1:iRun],[1:jRun]
                0018 C     from input field array inpFld
8c547beaff Jean*0019 C- note:
3e5de6a370 Jean*0020 C   a) this S/R should not see DIAGNOSTICS pkg commons blocks (in DIAGNOSTICS.h)
                0021 C   b) for main grid variables, get area & weigting factors (to compute global mean)
                0022 C      from the main common blocks.
8c547beaff Jean*0023 C   c) for other type of grids, call a specifics S/R which include its own
3e5de6a370 Jean*0024 C      grid common blocks
                0025 
                0026 C     !USES:
                0027       IMPLICIT NONE
                0028 
                0029 #include "EEPARAMS.h"
                0030 #include "SIZE.h"
                0031 #include "DIAGNOSTICS_SIZE.h"
b614ad87ad Jean*0032 #include "DIAGSTATS_REGIONS.h"
3e5de6a370 Jean*0033 #include "PARAMS.h"
                0034 #include "GRID.h"
8c547beaff Jean*0035 c #include "SURFACE.h"
3e5de6a370 Jean*0036 
                0037 C     !INPUT/OUTPUT PARAMETERS:
                0038 C     == Routine Arguments ==
                0039 C     statFld     :: cumulative statistics array (updated)
                0040 C     inpFld      :: input field array to process (compute stats & add to statFld)
8c4f953ef4 Jean*0041 C     frcFld      :: fraction used for weighted-average diagnostics
                0042 C     scaleFact   :: scaling factor
662c087d92 Jean*0043 C     power       :: option to fill-in with the field square (power=2)
8c4f953ef4 Jean*0044 C     useFract    :: if True, use fraction-weight
                0045 C     sizF        :: size of frcFld array: 3rd  dimension
3e5de6a370 Jean*0046 C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
                0047 C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)
                0048 C     sizK        :: size of inpFld array: 3rd  dimension
                0049 C     sizTx,sizTy :: size of inpFld array: tile dimensions
                0050 C     iRun,jRun   :: range of 1rst & 2nd index
705dd4a478 Jean*0051 C     kIn         :: level index of inpFld array to process
8c4f953ef4 Jean*0052 C     biIn,bjIn   :: tile indices of inpFld array to process
3e5de6a370 Jean*0053 C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
c9169fbe09 Jean*0054 C     bibjFlg     :: passed from calling S/R (see diagstats_fill.F)
3e5de6a370 Jean*0055 C     region2fill :: indicates whether to compute statistics over this region
                0056 C     ndId        :: Diagnostics Id Number (in available diag. list)
                0057 C     parsFld     :: parser field with characteristics of the diagnostics
                0058 C     myThid      :: my Thread Id number
                0059       _RL     statFld(0:nStats,0:nRegions)
                0060       INTEGER sizI1,sizI2,sizJ1,sizJ2
8c4f953ef4 Jean*0061       INTEGER sizF,sizK,sizTx,sizTy
3e5de6a370 Jean*0062       _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
8c4f953ef4 Jean*0063       _RL     frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
                0064       _RL     scaleFact
662c087d92 Jean*0065       INTEGER power
8c4f953ef4 Jean*0066       LOGICAL useFract
3e5de6a370 Jean*0067       INTEGER iRun, jRun, kIn, biIn, bjIn
c9169fbe09 Jean*0068       INTEGER k, bi, bj, bibjFlg
3e5de6a370 Jean*0069       INTEGER region2fill(0:nRegions)
c9169fbe09 Jean*0070       INTEGER ndId
3e5de6a370 Jean*0071       CHARACTER*16 parsFld
                0072       INTEGER myThid
                0073 CEOP
                0074 
f8e6aa21ed Jean*0075 C     !FUNCTIONS:
                0076 #ifdef ALLOW_FIZHI
                0077       _RL   getcon
                0078       EXTERNAL getcon
                0079 #endif
                0080 
3e5de6a370 Jean*0081 C     !LOCAL VARIABLES:
                0082 C     i,j    :: loop indices
d071c4ad7c Jean*0083       INTEGER i, n, kFr, kRegMsk, lReg
3e5de6a370 Jean*0084       INTEGER im, ix, iv
                0085       PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
                0086       LOGICAL exclSpVal
                0087       LOGICAL useWeight
                0088       _RL statLoc(0:nStats)
                0089       _RL drLoc
                0090       _RL specialVal
                0091 
                0092 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0093 
                0094       useWeight = .FALSE.
                0095       exclSpVal = .FALSE.
                0096       specialVal = 0.
f8e6aa21ed Jean*0097 #ifdef ALLOW_FIZHI
3e5de6a370 Jean*0098       IF ( useFIZHI ) THEN
                0099         exclSpVal = .TRUE.
8c547beaff Jean*0100         specialVal = getcon('UNDEF')
3e5de6a370 Jean*0101       ENDIF
f8e6aa21ed Jean*0102 #endif
8c4f953ef4 Jean*0103       kFr = MIN(kIn,sizF)
8c547beaff Jean*0104 
3e5de6a370 Jean*0105       DO n=0,nRegions
                0106        IF (region2fill(n).NE.0) THEN
                0107 C---   Compute statistics for this tile, level and region:
8c547beaff Jean*0108 
b614ad87ad Jean*0109          kRegMsk = diagSt_kRegMsk(n)
d071c4ad7c Jean*0110          lReg = 0
                0111          IF ( n.GE.1 ) THEN
                0112            lReg = 1
                0113            IF ( parsFld(2:2).EQ.'U' ) lReg = 2
                0114            IF ( parsFld(2:2).EQ.'V' ) lReg = 3
                0115          ENDIF
3e5de6a370 Jean*0116 
                0117          IF ( parsFld(10:10) .EQ. 'R' ) THEN
                0118 
                0119           drLoc = drF(k)
                0120           IF ( parsFld(9:9).EQ.'L') drLoc = drC(k)
                0121           IF ( parsFld(9:9).EQ.'U') drLoc = drC(MIN(k+1,Nr))
                0122           IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.
                0123 
                0124           IF     ( parsFld(2:2).EQ.'U' ) THEN
cfc143f431 Jean*0125            CALL DIAGSTATS_CALC(
3e5de6a370 Jean*0126      O            statLoc,
                0127      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0128      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0129      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0130      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0131      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
d071c4ad7c Jean*0132      I            maskInW(1-OLx,1-OLy,bi,bj),
cfc143f431 Jean*0133      I            hFacW(1-OLx,1-OLy,k,bi,bj), rAw(1-OLx,1-OLy,bi,bj),
3e5de6a370 Jean*0134      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0135 c    I            drLoc, k,bi,bj, parsFld, myThid )
                0136           ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
cfc143f431 Jean*0137            CALL DIAGSTATS_CALC(
3e5de6a370 Jean*0138      O            statLoc,
                0139      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0140      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0141      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0142      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0143      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
d071c4ad7c Jean*0144      I            maskInS(1-OLx,1-OLy,bi,bj),
cfc143f431 Jean*0145      I            hFacS(1-OLx,1-OLy,k,bi,bj), rAs(1-OLx,1-OLy,bi,bj),
3e5de6a370 Jean*0146      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0147           ELSE
cfc143f431 Jean*0148            CALL DIAGSTATS_CALC(
3e5de6a370 Jean*0149      O            statLoc,
                0150      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0151      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0152      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0153      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0154      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
d071c4ad7c Jean*0155      I            maskInC(1-OLx,1-OLy,bi,bj),
cfc143f431 Jean*0156      I            hFacC(1-OLx,1-OLy,k,bi,bj), rA(1-OLx,1-OLy,bi,bj),
3e5de6a370 Jean*0157      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0158           ENDIF
                0159 
8c547beaff Jean*0160          ELSEIF ( useFIZHI .AND.
                0161      &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')
                0162      &          ) THEN
cfc143f431 Jean*0163            CALL DIAGSTATS_LM_CALC(
3e5de6a370 Jean*0164      O            statLoc,
                0165      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0166      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0167      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0168      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0169      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
                0170      I            maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
8c547beaff Jean*0171      I            specialVal, exclSpVal,
                0172      I            k,bi,bj, parsFld, myThid )
                0173          ELSEIF ( useLand .AND.
                0174      &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')
                0175      &          ) THEN
cfc143f431 Jean*0176            CALL DIAGSTATS_G_CALC(
8c547beaff Jean*0177      O            statLoc,
                0178      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0179      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0180      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0181      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0182      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
                0183      I            rA(1-OLx,1-OLy,bi,bj),
8c547beaff Jean*0184      I            specialVal, exclSpVal,
                0185      I            k,bi,bj, parsFld, myThid )
3e5de6a370 Jean*0186 c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN
                0187 c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN
                0188          ELSE
                0189 
                0190           drLoc = 1. _d 0
                0191           IF     ( parsFld(2:2).EQ.'U' ) THEN
cfc143f431 Jean*0192            CALL DIAGSTATS_CALC(
3e5de6a370 Jean*0193      O            statLoc,
                0194      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0195      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0196      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0197      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0198      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
                0199      I            maskInW(1-OLx,1-OLy,bi,bj),
                0200      I            maskInW(1-OLx,1-OLy,bi,bj),rAw(1-OLx,1-OLy,bi,bj),
3e5de6a370 Jean*0201      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0202           ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
cfc143f431 Jean*0203            CALL DIAGSTATS_CALC(
3e5de6a370 Jean*0204      O            statLoc,
                0205      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0206      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0207      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0208      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0209      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
                0210      I            maskInS(1-OLx,1-OLy,bi,bj),
                0211      I            maskInS(1-OLx,1-OLy,bi,bj),rAs(1-OLx,1-OLy,bi,bj),
3e5de6a370 Jean*0212      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0213           ELSE
cfc143f431 Jean*0214            CALL DIAGSTATS_CALC(
3e5de6a370 Jean*0215      O            statLoc,
                0216      I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
8c4f953ef4 Jean*0217      I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
d071c4ad7c Jean*0218      I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
8c547beaff Jean*0219      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
cfc143f431 Jean*0220      I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
                0221      I            maskInC(1-OLx,1-OLy,bi,bj),
                0222      I            maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
3e5de6a370 Jean*0223      I            drLoc, specialVal, exclSpVal, useWeight, myThid )
                0224           ENDIF
                0225 
                0226          ENDIF
                0227 
                0228 C     Update cumulative statistics array
b614ad87ad Jean*0229          IF ( statLoc(0).GT.0. ) THEN
c9169fbe09 Jean*0230            IF ( statFld(0,n).LE.0. ) THEN
                0231              statFld(im,n) = statLoc(im)
                0232              statFld(ix,n) = statLoc(ix)
                0233            ELSE
                0234              statFld(im,n) = MIN( statFld(im,n), statLoc(im) )
                0235              statFld(ix,n) = MAX( statFld(ix,n), statLoc(ix) )
                0236            ENDIF
                0237            IF ( bibjFlg.GE.0 ) THEN
3e5de6a370 Jean*0238             DO i=0,iv
c9169fbe09 Jean*0239              statFld(i,n) = statFld(i,n) + statLoc(i)
3e5de6a370 Jean*0240             ENDDO
c9169fbe09 Jean*0241            ELSE
                0242             DO i=1,iv
                0243              statFld(i,n) = statFld(i,n) + statLoc(i)
                0244             ENDDO
                0245            ENDIF
b614ad87ad Jean*0246          ENDIF
3e5de6a370 Jean*0247 
                0248 C---   processing region "n" ends here.
                0249        ENDIF
                0250       ENDDO
                0251 
8c547beaff Jean*0252       RETURN
                0253       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!