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

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

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

Revision 1.4 - (hide annotations) (download)
Thu Aug 18 18:24:29 2005 UTC (18 years, 10 months ago) by stephd
Branch: MAIN
CVS Tags: checkpoint57t_post, checkpoint58l_post, checkpoint58e_post, checkpoint57v_post, checkpoint58u_post, checkpoint57s_post, checkpoint58r_post, checkpoint57y_post, checkpoint58g_post, checkpoint57x_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58w_post, checkpoint58j_post, checkpoint57y_pre, checkpoint58q_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59i, checkpoint59h, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post
Changes since 1.3: +2 -2 lines 
o add new calcium carbonate dissolution scheme (from Karsten Friis and
  Mick Follows)
o some cleaning up of code
1 stephd 1.4 C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_aver_init.F,v 1.3 2005/04/06 18:36:47 jmc Exp $
2 jmc 1.2 C $Name: $
3    
4 stephd 1.1 cswdcost -- add sunroutine ---
5 stephd 1.4 #include "DIC_OPTIONS.h"
6 stephd 1.1 #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 jmc 1.2 #include "PTRACERS_SIZE.h"
25 stephd 1.1 #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