/[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.1 - (show annotations) (download)
Fri Feb 10 09:09:19 2006 UTC (18 years, 3 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58a_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post 
o add file that does the balancing of EmPmR and/or Qnet
1 C$Header: $
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_R8(theVol,myThid)
74 _GLOBAL_SUM_R8(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_R8(theVol,myThid)
179 _GLOBAL_SUM_R8(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
215
  ViewVC Help
Powered by ViewVC 1.1.22