/[MITgcm]/MITgcm/model/src/remove_mean.F
ViewVC logotype

Contents of /MITgcm/model/src/remove_mean.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.3 - (show annotations) (download)
Tue Apr 28 18:30:33 2009 UTC (15 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint62, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint61n, checkpoint61o, checkpoint61m, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Changes since 1.2: +11 -12 lines 
fix wrong type of GLOBAL_SUM in REMOVE_MEAN_RS ;
+ change macros (EXCH & GLOBAL_SUM/MAX) sufix _R4/_R8 to _RS/_RL
  when applied to _RS/_RL variable
1 C $Header: /u/gcmpack/MITgcm/model/src/remove_mean.F,v 1.2 2007/07/31 22:50:24 ce107 Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: REMOVE_MEAN_RL
8 C !INTERFACE:
9 SUBROUTINE REMOVE_MEAN_RL(
10 I myNr, arr, arrMask, arrhFac, arrArea, arrDr,
11 I arrName, myTime,
12 I myThid )
13 C !DESCRIPTION: \bv
14 C /==========================================================\
15 C | SUBROUTINE REMOVE_MEAN_RL |
16 C | o Calculate mean of global array "_RL arr" and substract |
17 C | it from the array |
18 C \==========================================================/
19 C \ev
20
21 IMPLICIT NONE
22
23 C === Global data ===
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27
28 C === Functions ====
29 LOGICAL DIFFERENT_MULTIPLE
30 EXTERNAL DIFFERENT_MULTIPLE
31
32 C === Routine arguments ===
33 INTEGER myNr
34 _RL arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
35 _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
36 _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
37 _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
38 _RS arrDr(myNr)
39 CHARACTER*(*) arrName
40 _RL myTime
41 INTEGER myThid
42
43 C#ifdef ALLOW_BALANCE_FLUXES
44 C === Local variables ====
45 INTEGER bi,bj,I,J,K
46 _RL tmpVal
47 _RL theMean
48 _RL theVol
49 _RL tmpVol
50 CHARACTER*(max_len_mbuf) msgbuf
51 CEOP
52
53 theMean=0.
54 theVol=0.
55
56 DO bj=myByLo(myThid),myByHi(myThid)
57 DO bi=myBxLo(myThid),myBxHi(myThid)
58 DO K=1,myNr
59 DO J=1,sNy
60 DO I=1,sNx
61 tmpVal=arr(I,J,K,bi,bj)
62 IF (arrMask(I,J,K,bi,bj).NE.0.) THEN
63 tmpVol = arrArea(I,J,bi,bj)*arrhFac(I,J,K,bi,bj)*arrDr(K)
64 theVol = theVol + tmpVol
65 theMean = theMean + tmpVol*tmpVal
66 ENDIF
67 ENDDO
68 ENDDO
69 ENDDO
70 ENDDO
71 ENDDO
72
73 _GLOBAL_SUM_RL(theVol,myThid)
74 _GLOBAL_SUM_RL(theMean,myThid)
75
76 IF (theVol.GT.0.) THEN
77 theMean=theMean/theVol
78
79 DO bj=myByLo(myThid),myByHi(myThid)
80 DO bi=myBxLo(myThid),myBxHi(myThid)
81 DO K=1,myNr
82 DO J=1,sNy
83 DO I=1,sNx
84 IF (arrMask(I,J,K,bi,bj).NE.0.) THEN
85 arr(I,J,K,bi,bj) = arr(I,J,K,bi,bj) - theMean
86 ENDIF
87 ENDDO
88 ENDDO
89 ENDDO
90 ENDDO
91 ENDDO
92
93 ENDIF
94
95 C Print the global mean to standard output, this is a measure for
96 C the drift of the array arr
97 IF ( balancePrintMean ) THEN
98 _BEGIN_MASTER( myThid )
99 WRITE(msgbuf,'(a,a,a,e24.17)')
100 & 'REMOVE_MEAN_RL: Global mean of ',
101 & arrName, ' = ', theMean
102 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
103 & SQUEEZE_RIGHT , 1)
104 _END_MASTER( myThid )
105 ENDIF
106
107 C#endif /* ALLOW_BALANCE_FLUXES */
108 RETURN
109 END
110
111 CBOP
112 C !ROUTINE: REMOVE_MEAN_RS
113 C !INTERFACE:
114 SUBROUTINE REMOVE_MEAN_RS(
115 I myNr, arr, arrMask, arrhFac, arrArea, arrDr,
116 I arrName, myTime,
117 I myThid )
118 C !DESCRIPTION: \bv
119 C /==========================================================\
120 C | SUBROUTINE REMOVE_MEAN_RS |
121 C | o Calculate mean of global array "_RS arr" and substract |
122 C | it from the array |
123 C \==========================================================/
124 C \ev
125
126 IMPLICIT NONE
127
128 C === Global data ===
129 #include "SIZE.h"
130 #include "EEPARAMS.h"
131 #include "PARAMS.h"
132
133 C === Functions ====
134 LOGICAL DIFFERENT_MULTIPLE
135 EXTERNAL DIFFERENT_MULTIPLE
136
137 C === Routine arguments ===
138 INTEGER myNr
139 _RS arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
140 _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
141 _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
142 _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
143 _RS arrDr(myNr)
144 CHARACTER*(*) arrName
145 _RL myTime
146 INTEGER myThid
147
148 C#ifdef ALLOW_BALANCE_FLUXES
149 C === Local variables ====
150 INTEGER bi,bj,I,J,K
151 _RS tmpVal
152 _RS theMean
153 _RS theVol
154 _RS tmpVol
155 CHARACTER*(max_len_mbuf) msgbuf
156 CEOP
157
158 theMean=0.
159 theVol=0.
160
161 DO bj=myByLo(myThid),myByHi(myThid)
162 DO bi=myBxLo(myThid),myBxHi(myThid)
163 DO K=1,myNr
164 DO J=1,sNy
165 DO I=1,sNx
166 tmpVal=arr(I,J,K,bi,bj)
167 IF (arrMask(I,J,K,bi,bj).NE.0.) THEN
168 tmpVol = arrArea(I,J,bi,bj)*arrhFac(I,J,K,bi,bj)*arrDr(K)
169 theVol = theVol + tmpVol
170 theMean = theMean + tmpVol*tmpVal
171 ENDIF
172 ENDDO
173 ENDDO
174 ENDDO
175 ENDDO
176 ENDDO
177
178 _GLOBAL_SUM_RS(theVol,myThid)
179 _GLOBAL_SUM_RS(theMean,myThid)
180
181 IF (theVol.GT.0.) THEN
182 theMean=theMean/theVol
183
184 DO bj=myByLo(myThid),myByHi(myThid)
185 DO bi=myBxLo(myThid),myBxHi(myThid)
186 DO K=1,myNr
187 DO J=1,sNy
188 DO I=1,sNx
189 IF (arrMask(I,J,K,bi,bj).NE.0.) THEN
190 arr(I,J,K,bi,bj) = arr(I,J,K,bi,bj) - theMean
191 ENDIF
192 ENDDO
193 ENDDO
194 ENDDO
195 ENDDO
196 ENDDO
197
198 ENDIF
199
200 C Print the global mean to standard output, this is a measure for
201 C the drift of the array arr
202 IF ( balancePrintMean ) THEN
203 _BEGIN_MASTER( myThid )
204 WRITE(msgbuf,'(a,a,a,e24.17)')
205 & 'REMOVE_MEAN_RS: Global mean of ',
206 & arrName, ' = ', theMean
207 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
208 & SQUEEZE_RIGHT , 1)
209 _END_MASTER( myThid )
210 ENDIF
211
212 C#endif /* ALLOW_BALANCE_FLUXES */
213 RETURN
214 END
  ViewVC Help
Powered by ViewVC 1.1.22