Back to home page

MITgcm
 
 

    

File indexing completed on 2018-12-05 06:10:11 UTC

view on githubraw file Latest commit 04579f76 on 2018-12-04 00:31:44 UTC
e3f5aa37d6 Jean*0001 #include "MONITOR_OPTIONS.h"
                0002 
7633b97660 Ed H*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: MON_STATS_LATBND_RL
                0006 
                0007 C     !INTERFACE:
e3f5aa37d6 Jean*0008       SUBROUTINE MON_STATS_LATBND_RL(
7633b97660 Ed H*0009      I     myNr, mskNr, kLoc, nSepBnd, ySepBnd,
                0010      I     arr, arrMask, arrhFac, arrArea, arrY, arrDr,
                0011      O     theMin,theMax,theMean,theVar,theVol,
                0012      I     myThid )
e3f5aa37d6 Jean*0013 
7633b97660 Ed H*0014 C     !DESCRIPTION:
                0015 C     Calculate bare statistics of global array "\_RL arr" on each
                0016 C     Latitude band (given by \texttt{ySepBnd}).
                0017 
                0018 C     !USES:
                0019       IMPLICIT NONE
e3f5aa37d6 Jean*0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
7633b97660 Ed H*0022       INTEGER  NLATBND
                0023       EXTERNAL NLATBND
e3f5aa37d6 Jean*0024 
7633b97660 Ed H*0025 C     !INPUT PARAMETERS:
e3f5aa37d6 Jean*0026 C     nSepBnd :: Number of latitude bands
1a4d0e5ab1 Jean*0027 C     ySepBnd :: Southern latitude egde (from 2 to nSepBnd, 1 is not used)
a54914c596 Jean*0028       INTEGER myNr, mskNr, kLoc
e3f5aa37d6 Jean*0029       INTEGER nSepBnd
                0030       _RS ySepBnd(nSepBnd)
                0031       _RL arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
a54914c596 Jean*0032       _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mskNr,nSx,nSy)
                0033       _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mskNr,nSx,nSy)
e3f5aa37d6 Jean*0034       _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0035       _RS arrY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0036       _RS arrDr(myNr)
                0037       _RL theMin(nSepBnd)
                0038       _RL theMax(nSepBnd)
                0039       _RL theMean(nSepBnd)
                0040       _RL theVar(nSepBnd)
                0041       _RL theVol(nSepBnd)
                0042       INTEGER myThid
7633b97660 Ed H*0043 CEOP
e3f5aa37d6 Jean*0044 
7633b97660 Ed H*0045 C     !LOCAL VARIABLES:
4d2b0c1389 Jean*0046 C     msgBuf :: Informational/error meesage buffer
                0047       CHARACTER*(MAX_LEN_MBUF) msgBuf
e3f5aa37d6 Jean*0048       INTEGER bi,bj,i,j,k,n
a54914c596 Jean*0049       INTEGER km, k1, k2
2cf110c259 Jean*0050       _RL tmpVal
e3f5aa37d6 Jean*0051       _RL tmpVol
4d2b0c1389 Jean*0052       INTEGER nSepDim
                0053       PARAMETER ( nSepDim = 200 )
                0054       _RL tileVol (nSx,nSy,nSepDim)
                0055       _RL tileMean(nSx,nSy,nSepDim)
                0056       _RL tileVar (nSx,nSy,nSepDim)
04579f7679 Jean*0057       LOGICAL noPnts(nSepDim)
4d2b0c1389 Jean*0058 
                0059 C-    Check local Dim
                0060       IF ( nSepBnd .GT. nSepDim ) THEN
                0061         WRITE(msgBuf,'(A,I6,A)')
                0062      &  'MON_STATS_LATBND_RL: local array Dim (nSepDim=',nSepDim,
                0063      &  ' ) too small'
                0064         CALL PRINT_ERROR( msgBuf , myThid)
                0065         WRITE(msgBuf,'(A,I6)')
                0066      &  'MON_STATS_LATBND_RL: Need nSepDim to be at least =', nSepBnd
                0067         CALL PRINT_ERROR( msgBuf , myThid)
                0068         STOP 'ABNORMAL END: S/R MON_STATS_LATBND_RL'
                0069       ENDIF
e3f5aa37d6 Jean*0070 
a54914c596 Jean*0071       IF ( kLoc.EQ.0 ) THEN
                0072         k1 = 1
                0073         k2 = myNr
                0074       ELSE
                0075         k1 = kLoc
                0076         k2 = kLoc
                0077       ENDIF
                0078 
e3f5aa37d6 Jean*0079       DO n=1,nSepBnd
                0080        noPnts(n)=.TRUE.
                0081        theMin(n)=0.
                0082        theMax(n)=0.
                0083        theMean(n)=0.
                0084        theVar(n)=0.
                0085        theVol(n)=0.
                0086       ENDDO
                0087 
                0088       DO bj=myByLo(myThid),myByHi(myThid)
                0089        DO bi=myBxLo(myThid),myBxHi(myThid)
4d2b0c1389 Jean*0090         DO n=1,nSepBnd
                0091          tileVol (bi,bj,n) = 0.
                0092          tileMean(bi,bj,n) = 0.
                0093          tileVar (bi,bj,n) = 0.
                0094         ENDDO
a54914c596 Jean*0095         DO k=k1,k2
                0096          km = MIN(k,mskNr)
e3f5aa37d6 Jean*0097          DO j=1,sNy
                0098           DO i=1,sNx
                0099            n = NLATBND(nSepBnd, ySepBnd, arrY(i,j,bi,bj) )
                0100            tmpVal=arr(i,j,k,bi,bj)
a54914c596 Jean*0101            IF (arrMask(i,j,km,bi,bj).NE.0. .AND. noPnts(n)) THEN
e3f5aa37d6 Jean*0102             theMin(n)=tmpVal
                0103             theMax(n)=tmpVal
                0104             noPnts(n)=.FALSE.
                0105            ENDIF
a54914c596 Jean*0106            IF (arrMask(i,j,km,bi,bj).NE.0.) THEN
1a4d0e5ab1 Jean*0107             theMin(n)=MIN(theMin(n),tmpVal)
                0108             theMax(n)=MAX(theMax(n),tmpVal)
a54914c596 Jean*0109             tmpVol = arrArea(i,j,bi,bj)*arrhFac(i,j,km,bi,bj)*arrDr(k)
                0110      &                                 *arrMask(i,j,km,bi,bj)
4d2b0c1389 Jean*0111             tileVol (bi,bj,n) = tileVol (bi,bj,n) + tmpVol
                0112             tileMean(bi,bj,n) = tileMean(bi,bj,n) + tmpVol*tmpVal
                0113             tileVar (bi,bj,n) = tileVar (bi,bj,n) + tmpVol*tmpVal*tmpVal
e3f5aa37d6 Jean*0114            ENDIF
                0115           ENDDO
                0116          ENDDO
                0117         ENDDO
                0118        ENDDO
                0119       ENDDO
                0120 
                0121       DO n=1,nSepBnd
4d2b0c1389 Jean*0122        CALL GLOBAL_SUM_TILE_RL( tileVol(1,1,n) , theVol(n) , myThid )
                0123        CALL GLOBAL_SUM_TILE_RL( tileMean(1,1,n), theMean(n), myThid )
                0124        CALL GLOBAL_SUM_TILE_RL( tileVar(1,1,n) , theVar(n) , myThid )
e3f5aa37d6 Jean*0125       ENDDO
                0126 
                0127       DO n=1,nSepBnd
                0128        IF (theVol(n).GT.0.) THEN
                0129         theMean(n)= theMean(n)/theVol(n)
                0130         theVar(n) = theVar(n) /theVol(n)
eaf4c145cc Jean*0131         theVar(n) = theVar(n) -theMean(n)*theMean(n)
                0132         IF ( noPnts(n) ) theMin(n) = theMean(n)
                0133         theMin(n) = -theMin(n)
7163a40534 Jean*0134         _GLOBAL_MAX_RL(theMin(n), myThid)
eaf4c145cc Jean*0135         theMin(n)=-theMin(n)
                0136         IF ( noPnts(n) ) theMax(n) = theMin(n)
7163a40534 Jean*0137         _GLOBAL_MAX_RL(theMax(n), myThid)
e3f5aa37d6 Jean*0138        ENDIF
                0139       ENDDO
                0140 
                0141       RETURN
                0142       END
4d2b0c1389 Jean*0143 
7633b97660 Ed H*0144 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e3f5aa37d6 Jean*0145 CBOP
                0146 C     !ROUTINE: NLATBND
                0147 
                0148 C     !INTERFACE:
                0149       INTEGER FUNCTION NLATBND( nBnd, yBnd, yLoc )
                0150       IMPLICIT NONE
                0151 
                0152 C     !DESCRIPTION:
7633b97660 Ed H*0153 C     Find the latidude band of yLoc in nSep strip
                0154 
e3f5aa37d6 Jean*0155 C     !INPUT PARAMETERS:
1a4d0e5ab1 Jean*0156 C     nBnd :: Number of latitude bands
                0157 C     yBnd :: latitude of southern boundary (for each lat. band)
e3f5aa37d6 Jean*0158 C     yLoc :: current latitude
                0159       INTEGER nBnd
4d2b0c1389 Jean*0160       _RS yBnd(nBnd)
e3f5aa37d6 Jean*0161       _RS yLoc
7633b97660 Ed H*0162 CEOP
e3f5aa37d6 Jean*0163 
                0164 C     !LOCAL VARIABLES:
                0165       INTEGER n
                0166 
1a4d0e5ab1 Jean*0167       NLATBND = 1
                0168       DO n=2,nBnd
                0169        IF (yLoc .GT. yBnd(n)) NLATBND = n
e3f5aa37d6 Jean*0170       ENDDO
                0171 
                0172       RETURN
                0173       END
7633b97660 Ed H*0174 
                0175 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
[ 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!