/[MITgcm]/MITgcm/pkg/dic/dic_aver_init.F
ViewVC logotype

Contents of /MITgcm/pkg/dic/dic_aver_init.F

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


Revision 1.3 - (show annotations) (download)
Wed Apr 6 18:36:47 2005 UTC (19 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57o_post, checkpoint57f_post, checkpoint57k_post, checkpoint57g_post, checkpoint57i_post, checkpoint57m_post, checkpoint57g_pre, checkpoint57h_post, checkpoint57h_done, checkpoint57n_post, checkpoint57p_post, checkpoint57j_post, checkpoint57h_pre, checkpoint57l_post
Changes since 1.2: +1 -3 lines
use baseTime as time origin ; DIFF_BASE_MULTIPLE replaces DIFFERENT_MULTIPLE

1 C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_aver_init.F,v 1.2 2004/07/13 18:03:31 jmc Exp $
2 C $Name: $
3
4 cswdcost -- add sunroutine ---
5 #include "CPP_OPTIONS.h"
6 #include "GCHEM_OPTIONS.h"
7
8
9 CStartOfInterFace
10 SUBROUTINE DIC_AVER_INIT(
11 I myThid)
12
13 C /==========================================================\
14 C | SUBROUTINE DIC_AVER_INIT i |
15 C |==========================================================|
16 IMPLICIT NONE
17
18 C == GLobal variables ==
19 #include "SIZE.h"
20 #include "DYNVARS.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "GRID.h"
24 #include "PTRACERS_SIZE.h"
25 #include "PTRACERS.h"
26 #include "GCHEM.h"
27 #include "DIC_ABIOTIC.h"
28 #ifdef DIC_BIOTIC
29 #include "DIC_BIOTIC.h"
30 #include "DIC_DIAGS.h"
31 #include "DIC_COST.h"
32 #endif
33 #ifdef ALLOW_SEAICE
34 #include "ICE.h"
35 #endif
36
37 C == Routine arguments ==
38 INTEGER myThid
39
40 #ifdef ALLOW_DIC_COST
41
42 C == Local variables ==
43 INTEGER i, j, bi, bj, k, it
44 _RL po4av(nR)
45 _RL o2av(nR)
46 _RL volvar(nR)
47 cswdmonth -add-
48 _RL po4avm(12,4)
49 _RL o2avm(12,4)
50 _RL rdt
51 INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
52
53 cswddmonth -- end-
54 c
55 c initialize to zero
56 totcost=0.d0
57 DO bj = myByLo(myThid), myByHi(myThid)
58 DO bi = myBxLo(myThid), myBxHi(myThid)
59 CALL TIMEAVE_RESET(PO4obs, Nr, bi, bj, myThid)
60 CALL TIMEAVE_RESET(O2obs, Nr, bi, bj, myThid)
61 cswdmonth
62 CALL TIMEAVE_RESET(PO4obsl1, Nr, bi, bj, myThid)
63 CALL TIMEAVE_RESET(PO4obsl2, Nr, bi, bj, myThid)
64 CALL TIMEAVE_RESET(PO4obsl3, Nr, bi, bj, myThid)
65 cQQ CALL TIMEAVE_RESET(PO4obsl4, Nr, bi, bj, myThid)
66 CALL TIMEAVE_RESET(O2obsl1, Nr, bi, bj, myThid)
67 CALL TIMEAVE_RESET(O2obsl2, Nr, bi, bj, myThid)
68 CALL TIMEAVE_RESET(O2obsl3, Nr, bi, bj, myThid)
69 cQQ CALL TIMEAVE_RESET(O2obsl4, Nr, bi, bj, myThid)
70 cswdmonth -end-
71 do k=1,Nr
72 OBS_Timetave(bi,bj,k)=0.d0
73 po4av(k)=0.d0
74 o2av(k)=0.d0
75 po4var(k)=0.d0
76 o2var(k)=0.d0
77 volvar(k)=0.d0
78 enddo
79 cswdmonth
80 do k=1,3
81 do it=1,12
82 OBSM_Timetave(bi,bj,it)=0.d0
83 po4avm(it,k)=0.d0
84 o2avm(it,k)=0.d0
85 po4varm(it,k)=0.d0
86 o2varm(it,k)=0.d0
87 enddo
88 enddo
89 ENDDO
90 ENDDO
91 _BEGIN_MASTER( myThid )
92 CALL READ_FLD_XYZ_RL( 'input/po4obs.bin', ' ',
93 & po4obs, 0, myThid )
94 CALL READ_FLD_XYZ_RL( 'input/o2obs.bin', ' ',
95 & o2obs, 0, myThid )
96 cswdmonth
97 CALL READ_FLD_XYZ_RL( 'input/po4lev1.bin', ' ',
98 & po4obsl1, 0, myThid )
99 CALL READ_FLD_XYZ_RL( 'input/po4lev2.bin', ' ',
100 & po4obsl2, 0, myThid )
101 CALL READ_FLD_XYZ_RL( 'input/po4lev3.bin', ' ',
102 & po4obsl3, 0, myThid )
103 cQQ CALL READ_FLD_XYZ_RL( 'input/po4lev4.bin', ' ',
104 cQQ & po4obsl4, 0, myThid )
105 CALL READ_FLD_XYZ_RL( 'input/o2lev1.bin', ' ',
106 & o2obsl1, 0, myThid )
107 CALL READ_FLD_XYZ_RL( 'input/o2lev2.bin', ' ',
108 & o2obsl2, 0, myThid )
109 CALL READ_FLD_XYZ_RL( 'input/o2lev3.bin', ' ',
110 & o2obsl3, 0, myThid )
111 cQQ CALL READ_FLD_XYZ_RL( 'input/o2lev4.bin', ' ',
112 cQQ & o2obsl4, 0, myThid )
113 cswdmonth -end-
114 _END_MASTER(myThid)
115 _EXCH_XYZ_R8(po4obs , myThid )
116 _EXCH_XYZ_R8(o2obs , myThid )
117 cswdmonth -add-
118 _EXCH_XYZ_R8(po4obsl1 , myThid )
119 _EXCH_XYZ_R8(po4obsl2 , myThid )
120 _EXCH_XYZ_R8(po4obsl3 , myThid )
121 cQQ _EXCH_XYZ_R8(po4obsl4 , myThid )
122 _EXCH_XYZ_R8(o2obsl1 , myThid )
123 _EXCH_XYZ_R8(o2obsl2 , myThid )
124 _EXCH_XYZ_R8(o2obsl3 , myThid )
125 cQQ _EXCH_XYZ_R8(o2obsl4 , myThid )
126 cswdmonth -end-
127
128 _BARRIER
129 c calculate layer means
130 _BEGIN_MASTER( mythid )
131 do k=1,Nr
132 call tracer_meanarea(myThid,po4obs, k,
133 & po4av(k))
134 call tracer_meanarea(myThid,o2obs, k,
135 & o2av(k))
136 c print*,po4av(k), o2av(k)
137 enddo
138 cswdmonth -add-
139 do it=1,12
140 call tracer_meanarea(myThid,po4obsl1,it,
141 & po4avm(it,1))
142 call tracer_meanarea(myThid,po4obsl2,it,
143 & po4avm(it,2))
144 call tracer_meanarea(myThid,po4obsl3,it,
145 & po4avm(it,3))
146 cQQ call tracer_meanarea(myThid,po4obsl4,it,
147 cQQ & po4avm(it,4))
148 call tracer_meanarea(myThid,o2obsl1,it,
149 & o2avm(it,1))
150 call tracer_meanarea(myThid,o2obsl2,it,
151 & o2avm(it,2))
152 call tracer_meanarea(myThid,o2obsl3,it,
153 & o2avm(it,3))
154 cQQ call tracer_meanarea(myThid,o2obsl4,it,
155 cQQ & o2avm(it,4))
156
157 enddo
158 _END_MASTER(myThid)
159 c calculate layer variance
160 _BEGIN_MASTER( mythid )
161 DO bj = myByLo(myThid), myByHi(myThid)
162 DO bi = myBxLo(myThid), myBxHi(myThid)
163 DO j=1-OLy,sNy+OLy
164 DO i=1-OLx,sNx+OLx
165 DO k=1,Nr
166 volvar(k)=volvar(k)+
167 & rA(i,j,bi,bj)*drF(k)*maskC(i,j,k,bi,bj)
168 po4var(k)=po4var(k)+(po4obs(i,j,k,bi,bj)-po4av(k))**2
169 & *rA(i,j,bi,bj)*drF(k)*maskC(i,j,k,bi,bj)
170 o2var(k)=o2var(k)+(o2obs(i,j,k,bi,bj)-o2av(k))**2
171 & *rA(i,j,bi,bj)*drF(k)*maskC(i,j,k,bi,bj)
172 ENDDO
173 cswdmonth -add-
174 DO it=1,12
175 po4varm(it,1)=po4varm(it,1)+
176 & (po4obsl1(i,j,it,bi,bj)-po4avm(it,1))**2
177 & *rA(i,j,bi,bj)*drF(1)*maskC(i,j,1,bi,bj)
178 po4varm(it,2)=po4varm(it,2)+
179 & (po4obsl2(i,j,it,bi,bj)-po4avm(it,2))**2
180 & *rA(i,j,bi,bj)*drF(2)*maskC(i,j,2,bi,bj)
181 po4varm(it,3)=po4varm(it,3)+
182 & (po4obsl3(i,j,it,bi,bj)-po4avm(it,3))**2
183 & *rA(i,j,bi,bj)*drF(3)*maskC(i,j,3,bi,bj)
184 cQQ po4varm(it,4)=po4varm(it,4)+
185 cQQ & (po4obsl4(i,j,it,bi,bj)-po4avm(it,4))**2
186 cQQ & *rA(i,j,bi,bj)*drF(4)*maskC(i,j,4,bi,bj)
187 o2varm(it,1)=o2varm(it,1)+
188 & (o2obsl1(i,j,it,bi,bj)-o2avm(it,1))**2
189 & *rA(i,j,bi,bj)*drF(1)*maskC(i,j,1,bi,bj)
190 o2varm(it,2)=o2varm(it,2)+
191 & (o2obsl2(i,j,it,bi,bj)-o2avm(it,2))**2
192 & *rA(i,j,bi,bj)*drF(2)*maskC(i,j,2,bi,bj)
193 o2varm(it,3)=o2varm(it,3)+
194 & (o2obsl3(i,j,it,bi,bj)-o2avm(it,3))**2
195 & *rA(i,j,bi,bj)*drF(3)*maskC(i,j,3,bi,bj)
196 cQQ o2varm(it,4)=o2varm(it,4)+
197 cQQ & (o2obsl4(i,j,it,bi,bj)-o2avm(it,4))**2
198 cQQ & *rA(i,j,bi,bj)*drF(4)*maskC(i,j,4,bi,bj)
199
200 ENDDO
201 ENDDO
202 ENDDO
203 ENDDO
204 ENDDO
205 DO k=1,Nr
206 po4var(k)=po4var(k)/volvar(k)
207 o2var(k)=o2var(k)/volvar(k)
208 cQQ print*,po4var(k),o2var(k)
209 ENDDO
210 cswdmonth- add-
211 DO k=1,3
212 Do it=1,12
213 po4varm(it,k)=po4varm(it,k)/volvar(k)
214 o2varm(it,k)=o2varm(it,k)/volvar(k)
215 ENDDO
216 ENDDO
217 cswdmonth -end-
218 _END_MASTER(myThid)
219 C
220 C Reset averages to zero
221 print*,'QQ dic_diags, set to zero, gchem_init'
222 DO bj = myByLo(myThid), myByHi(myThid)
223 DO bi = myBxLo(myThid), myBxHi(myThid)
224 CALL TIMEAVE_RESET(PO4ann,Nr,bi,bj,myThid)
225 CALL TIMEAVE_RESET(O2ann,Nr,bi,bj,myThid)
226 CALL TIMEAVE_RESET(PO4lev1, 12, bi, bj, myThid)
227 CALL TIMEAVE_RESET(PO4lev2, 12, bi, bj, myThid)
228 CALL TIMEAVE_RESET(PO4lev3, 12, bi, bj, myThid)
229 cQQ CALL TIMEAVE_RESET(PO4lev4, 12, bi, bj, myThid)
230 CALL TIMEAVE_RESET(O2lev1, 12, bi, bj, myThid)
231 CALL TIMEAVE_RESET(O2lev2, 12, bi, bj, myThid)
232 CALL TIMEAVE_RESET(O2lev3, 12, bi, bj, myThid)
233 cQQ CALL TIMEAVE_RESET(O2lev4, 12, bi, bj, myThid)
234
235 do k=1,Nr
236 OBS_Timetave(bi,bj,k)=0.d0
237 enddo
238 do it=1,12
239 OBSM_Timetave(bi,bj,it)=0.d0
240 enddo
241 ENDDO
242 ENDDO
243 c
244 #endif
245 c
246 RETURN
247 END
248 cswd -- end added subroutine --

  ViewVC Help
Powered by ViewVC 1.1.22