C $Header:
C $Name:
#include "CPP_OPTIONS.h"
SUBROUTINE REMOVE_MEAN_RL(
I myNr, arr, arrMask, arrhFac, arrArea, arrDr,
I arrName,
I myThid )
C /==========================================================\
C | SUBROUTINE REMOVE_MEAN_RL |
C | o Calculate mean of global array "_RL arr" and substract |
C | it from the array |
C |==========================================================|
C \==========================================================/
IMPLICIT NONE
C === Global data ===
#include "SIZE.h"
#include "EEPARAMS.h"
C === Routine arguments ===
INTEGER myNr
_RL arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
_RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
_RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
_RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RS arrDr(myNr)
CHARACTER*(*) arrName
INTEGER myThid
C === Local variables ====
INTEGER bi,bj,I,J,K
_RL tmpVal
_RL theMean
_RL theVol
_RL tmpVol
CHARACTER*(max_len_mbuf) msgbuf
theMean=0.
theVol=0.
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO K=1,myNr
DO J=1,sNy
DO I=1,sNx
tmpVal=arr(I,J,K,bi,bj)
IF (arrMask(I,J,K,bi,bj).NE.0.) THEN
tmpVol = arrArea(I,J,bi,bj)*arrhFac(I,J,K,bi,bj)*arrDr(K)
theVol = theVol + tmpVol
theMean = theMean + tmpVol*tmpVal
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
_GLOBAL_SUM_R8(theVol,myThid)
_GLOBAL_SUM_R8(theMean,myThid)
IF (theVol.GT.0.) THEN
theMean=theMean/theVol
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO K=1,myNr
DO J=1,sNy
DO I=1,sNx
IF (arrMask(I,J,K,bi,bj).NE.0.) THEN
arr(I,J,K,bi,bj) = arr(I,J,K,bi,bj) - theMean
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
C Print the global mean to standard output, this is a measure for
C the drift of the array arr
WRITE(msgbuf,'(a,a,a,e24.17)')
& '%GM: Global mean of ', arrName, ' = ', theMean
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , 1)
RETURN
END