Back to home page

darwin3
 
 

    

File indexing completed on 2024-12-17 18:34:18 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 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGSTATS_GLOBAL
                0006 
                0007 C     !INTERFACE:
                0008       SUBROUTINE DIAGSTATS_GLOBAL(
                0009      O                    qtmp1, qtmp2,
                0010      I                    undef, nLev, jReg,
3ae5f90260 Jean*0011      I                    ndId, mate, iSp, iSm, myThid )
3e5de6a370 Jean*0012 
                0013 C     !DESCRIPTION:
                0014 C     Retrieve averaged model diagnostic
                0015 
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 #include "EEPARAMS.h"
                0019 #include "SIZE.h"
                0020 #include "DIAGNOSTICS_SIZE.h"
                0021 #include "DIAGNOSTICS.h"
                0022 
                0023 C     !INPUT PARAMETERS:
3ae5f90260 Jean*0024 C     undef     :: Undefined value
                0025 C     nLev      :: 2nd Dimension (max Nb of levels) of qtmp1,2 arrays
                0026 C     jReg      :: region Index to be process.
                0027 C     ndId      :: diagnostic Id number (in available diagnostics list)
                0028 C     mate      :: counter mate Id number if any ; 0 otherwise
                0029 C     iSp       :: diagnostics  pointer to storage array
                0030 C     iSm       :: counter-mate pointer to storage array
                0031 C     myThid    :: my thread Id number
3e5de6a370 Jean*0032       _RL undef
3ae5f90260 Jean*0033       INTEGER nLev, jReg, ndId, mate, iSp, iSm
3e5de6a370 Jean*0034       INTEGER myThid
                0035 
                0036 C     !OUTPUT PARAMETERS:
                0037 C     qtmp1    ..... AVERAGED DIAGNOSTIC QUANTITY
                0038 C     qtmp2    ..... working array (used for counter mate statistics)
                0039       _RL qtmp1(0:nStats,0:nLev)
                0040       _RL qtmp2(0:nStats,0:nLev)
                0041 CEOP
                0042 
                0043 C     !LOCAL VARIABLES:
                0044       INTEGER im, ix, iv
                0045       PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
                0046       INTEGER bi, bj
                0047       INTEGER i, k, kd, kCnt, klev, kMlev
c152e05bad Jean*0048       _RL     tmpMin, tmpMax, tmpVol
3e5de6a370 Jean*0049 
                0050 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0051 
                0052 C--   Initialize to zero :
                0053       DO k=0,nLev
                0054         DO i=0,nStats
                0055           qtmp1(i,k) = 0.
                0056           qtmp2(i,k) = 0.
                0057         ENDDO
                0058       ENDDO
                0059 
                0060       klev = kdiag(ndId)
                0061       IF ( mate.GT.0 ) kMlev = kdiag(mate)
                0062 
                0063       IF (klev.LE.nLev) THEN
                0064 C---    Compute global statistics :
                0065 
                0066 C--     Retrieve tile statistics first
                0067         DO bj=myByLo(myThid),myByHi(myThid)
                0068          DO bi=myBxLo(myThid),myBxHi(myThid)
                0069 
                0070           DO k=1,klev
3ae5f90260 Jean*0071             kd = iSp + k - 1
3e5de6a370 Jean*0072             IF ( qSdiag(0,jReg,kd,bi,bj).GT.0. ) THEN
                0073              IF ( qtmp1(0,k).LE.0. ) THEN
                0074               DO i=0,nStats
                0075                 qtmp1(i,k) = qSdiag(i,jReg,kd,bi,bj)
                0076               ENDDO
                0077              ELSE
                0078               DO i=0,iv
                0079                 qtmp1(i,k) = qtmp1(i,k) + qSdiag(i,jReg,kd,bi,bj)
                0080               ENDDO
                0081               qtmp1(im,k) = MIN( qtmp1(im,k),qSdiag(im,jReg,kd,bi,bj) )
                0082               qtmp1(ix,k) = MAX( qtmp1(ix,k),qSdiag(ix,jReg,kd,bi,bj) )
                0083              ENDIF
                0084             ENDIF
                0085           ENDDO
                0086           IF ( mate.GT.0 ) THEN
                0087            DO k=1,kMlev
3ae5f90260 Jean*0088             kd = iSm + k - 1
3e5de6a370 Jean*0089             IF ( qSdiag(0,jReg,kd,bi,bj).GT.0. ) THEN
bb07131fcb Jean*0090              IF ( qtmp2(0,k).LE.0. ) THEN
c152e05bad Jean*0091               DO i=0,1
3e5de6a370 Jean*0092                 qtmp2(i,k) = qSdiag(i,jReg,kd,bi,bj)
                0093               ENDDO
                0094              ELSE
c152e05bad Jean*0095               DO i=0,1
3e5de6a370 Jean*0096                 qtmp2(i,k) = qtmp2(i,k) + qSdiag(i,jReg,kd,bi,bj)
                0097               ENDDO
                0098              ENDIF
                0099             ENDIF
                0100            ENDDO
                0101           ENDIF
                0102 
                0103 C-       end tile index loops
                0104          ENDDO
                0105         ENDDO
                0106 
                0107 C--     Global min,max & sum (at each level) over all thread & processors :
                0108         DO k=1,klev
c152e05bad Jean*0109            tmpVol = qtmp1(0,k)
3e5de6a370 Jean*0110            DO i=0,iv
6637358eea Jean*0111             _GLOBAL_SUM_RL(qtmp1(i,k),myThid)
3e5de6a370 Jean*0112            ENDDO
c152e05bad Jean*0113            IF ( qtmp1(0,k).GT.0. .AND. tmpVol.LE.0. ) THEN
                0114 C-      In case 1 processor has only empty tiles:
                0115              tmpMax = qtmp1(1,k)/qtmp1(0,k)
                0116              tmpmin = -tmpMax
                0117            ELSE
                0118              tmpMin = -qtmp1(im,k)
                0119              tmpMax =  qtmp1(ix,k)
                0120            ENDIF
6637358eea Jean*0121            _GLOBAL_MAX_RL(tmpMin,myThid)
                0122            _GLOBAL_MAX_RL(tmpMax,myThid)
c152e05bad Jean*0123            qtmp1(im,k) = -tmpMin
                0124            qtmp1(ix,k) =  tmpMax
3e5de6a370 Jean*0125         ENDDO
                0126         IF ( mate.GT.0 ) THEN
                0127          DO k=1,kMlev
c152e05bad Jean*0128            DO i=0,1
6637358eea Jean*0129             _GLOBAL_SUM_RL(qtmp2(i,k),myThid)
3e5de6a370 Jean*0130            ENDDO
                0131          ENDDO
                0132         ENDIF
                0133 
                0134 C--     Vertical integral, min & max :
                0135         DO k=1,klev
c152e05bad Jean*0136           IF ( qtmp1(0,k).GT.0. ) THEN
3e5de6a370 Jean*0137            IF ( qtmp1(0,0).LE.0. ) THEN
                0138              DO i=0,nStats
                0139               qtmp1(i,0) = qtmp1(i,k)
                0140              ENDDO
                0141            ELSE
                0142              DO i=0,iv
                0143               qtmp1(i,0) = qtmp1(i,0) + qtmp1(i,k)
                0144              ENDDO
                0145               qtmp1(im,0) = MIN(qtmp1(im,0),qtmp1(im,k))
                0146               qtmp1(ix,0) = MAX(qtmp1(ix,0),qtmp1(ix,k))
                0147            ENDIF
c152e05bad Jean*0148           ENDIF
3e5de6a370 Jean*0149         ENDDO
                0150         IF ( mate.GT.0 ) THEN
                0151          DO k=1,kMlev
c152e05bad Jean*0152           IF ( qtmp2(0,k).GT.0. ) THEN
3e5de6a370 Jean*0153            IF ( qtmp2(0,0).LE.0. ) THEN
c152e05bad Jean*0154              DO i=0,1
3e5de6a370 Jean*0155               qtmp2(i,0) = qtmp2(i,k)
                0156              ENDDO
                0157            ELSE
c152e05bad Jean*0158              DO i=0,1
3e5de6a370 Jean*0159               qtmp2(i,0) = qtmp2(i,0) + qtmp2(i,k)
                0160              ENDDO
                0161            ENDIF
c152e05bad Jean*0162           ENDIF
3e5de6a370 Jean*0163          ENDDO
                0164         ENDIF
                0165 
                0166 C--     Average, Standard.Dev.:
                0167 C-      no counter diagnostics => average = Sum / vol :
                0168         IF ( mate.EQ.0 ) THEN
                0169           DO k=0,klev
                0170            IF ( qtmp1(0,k).LE.0. ) THEN
                0171              DO i=1,nStats
                0172               qtmp1(i,k) = undef
                0173              ENDDO
                0174            ELSE
                0175              DO i=1,iv
                0176               qtmp1(i,k) = qtmp1(i,k) / qtmp1(0,k)
                0177              ENDDO
                0178 C            Variance :
                0179              qtmp1(iv,k) = qtmp1(iv,k) - qtmp1(1,k)*qtmp1(1,k)
                0180 C            Standard deviation :
                0181              IF (qtmp1(iv,k).GT.0.) qtmp1(iv,k) = SQRT(qtmp1(iv,k))
                0182            ENDIF
                0183           ENDDO
bb07131fcb Jean*0184 C         return global (& vertically integrated) volume in qtmp2(0,0):
                0185           qtmp2(0,0) = qtmp1(0,0)
3e5de6a370 Jean*0186         ELSE
                0187 C       With counter diagnostics => average = Sum / Sum(counter) :
                0188           DO k=0,klev
                0189            kCnt = min(k,kMlev)
                0190            IF ( qtmp2(0,kCnt).LE.0. ) THEN
                0191              DO i=1,nStats
                0192               qtmp1(i,k) = undef
                0193              ENDDO
                0194            ELSEIF ( qtmp2(1,kCnt).LE.0. ) THEN
                0195              DO i=1,iv
                0196               qtmp1(i,k) = undef
                0197              ENDDO
                0198            ELSE
                0199              DO i=1,iv
                0200               qtmp1(i,k) = qtmp1(i,k) / qtmp2(1,kCnt)
                0201              ENDDO
                0202 C jmc: looks like there is a Pb with how Variance is computed
                0203 C            Variance :
                0204              qtmp1(iv,k) = qtmp1(iv,k) - qtmp1(1,k)*qtmp1(1,k)
                0205 C            Standard deviation :
                0206              IF (qtmp1(iv,k).GT.0.) qtmp1(iv,k) = SQRT(qtmp1(iv,k))
                0207            ENDIF
                0208           ENDDO
                0209         ENDIF
                0210 
                0211       ENDIF
                0212 
                0213 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0214 
                0215       RETURN
                0216       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

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

The LXR team
Valid CSS 2.1! Valid HTML 4.01!