/[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.5 - (show annotations) (download)
Mon Nov 5 19:02:08 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59j
Changes since 1.4: +8 -7 lines
split PTRACERS.h in 2 header files: PTRACERS_FIELDS.h & PTRACERS_PARAMS.h ;
comment out some #include PTRACERS_* that don't seem necessary.

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

  ViewVC Help
Powered by ViewVC 1.1.22