/[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.1 - (hide annotations) (download)
Mon Oct 6 20:11:10 2003 UTC (20 years, 8 months ago) by stephd
Branch: MAIN
CVS Tags: checkpoint51k_post, checkpoint53f_post, checkpoint53b_pre, checkpoint52l_pre, checkpoint52e_pre, hrcube4, checkpoint52n_post, checkpoint52j_post, checkpoint53d_post, checkpoint54a_pre, checkpoint51o_pre, checkpoint52e_post, checkpoint51n_pre, checkpoint53c_post, checkpoint51l_post, checkpoint51j_post, checkpoint51q_post, checkpoint52j_pre, checkpoint54a_post, branch-netcdf, checkpoint52l_post, checkpoint51r_post, checkpoint52k_post, checkpoint52b_pre, checkpoint54b_post, checkpoint51i_post, checkpoint52d_pre, checkpoint51l_pre, checkpoint52m_post, checkpoint53a_post, checkpoint54, checkpoint53b_post, checkpoint51o_post, checkpoint51p_post, checkpoint53, checkpoint52, checkpoint51f_post, checkpoint52d_post, checkpoint52a_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, checkpoint52c_post, checkpoint51h_pre, ecco_c52_e35, hrcube5, checkpoint52a_pre, checkpoint52i_post, checkpoint51t_post, checkpoint53d_pre, checkpoint51n_post, checkpoint51i_pre, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51m_post, checkpoint51s_post
Branch point for: netcdf-sm0, branch-nonh, tg2-branch, checkpoint51n_branch
changes to keep current with gchem pkg, and to be adjointable

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

  ViewVC Help
Powered by ViewVC 1.1.22