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

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

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


Revision 1.6 - (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.5: +7 -6 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_cost.F,v 1.5 2005/04/06 18:36:47 jmc 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_COST (
11 I myTime,myIter,myThid)
12
13 C /==========================================================\
14 C | SUBROUTINE DIC_COST 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 c#include "PTRACERS_SIZE.h"
25 c#include "PTRACERS_PARAMS.h"
26 c#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 myIter
40 _RL myTime
41 INTEGER myThid
42
43 #ifdef ALLOW_DIC_COST
44
45 C == Local variables ==
46 INTEGER i, j, bi, bj, k, it
47 c
48 _RL po4cost, o2cost, sumvol
49 _RL po4costm, o2costm, sumvolm
50 c
51 c calculate costfunction
52
53 _BEGIN_MASTER(myThid)
54
55 sumvol= 0. _d 0
56 po4cost= 0. _d 0
57 o2cost=0.d0
58 cswdmonth-add--
59 sumvolm=0.d0
60 po4costm=0.d0
61 o2costm=0.d0
62 cswdmonth -- end add --
63
64 DO bj=myByLo(myThid),myByHi(myThid)
65 DO bi=myBxLo(myThid),myBxHi(myThid)
66 DO i=1,sNx
67 DO j=1,sNy
68 do k=1,nR
69 sumvol=sumvol+
70 & rA(i,j,bi,bj)*drF(k)*maskC(i,j,k,bi,bj)
71 po4cost=po4cost+
72 & (po4ann(i,j,k,bi,bj)-po4obs(i,j,k,bi,bj))**2
73 & /po4var(k)
74 & *rA(i,j,bi,bj)*drF(k)*maskC(i,j,k,bi,bj)
75 o2cost=o2cost+
76 & (o2ann(i,j,k,bi,bj)-o2obs(i,j,k,bi,bj))**2
77 & /o2var(k)
78 & *rA(i,j,bi,bj)*drF(k)*maskC(i,j,k,bi,bj)
79 enddo
80 cswdmonth-add--
81 do k=1,4
82 sumvolm=sumvolm+
83 & rA(i,j,bi,bj)*drF(k)*maskC(i,j,k,bi,bj)
84 enddo
85 do it=1,12
86 po4costm=po4costm+
87 & (po4lev1(i,j,it,bi,bj)-po4obsl1(i,j,it,bi,bj))**2
88 & /po4varm(it,1)
89 & *rA(i,j,bi,bj)*drF(1)*maskC(i,j,1,bi,bj) +
90 & (po4lev2(i,j,it,bi,bj)-po4obsl2(i,j,it,bi,bj))**2
91 & /po4varm(it,2)
92 & *rA(i,j,bi,bj)*drF(2)*maskC(i,j,2,bi,bj) +
93 & (po4lev3(i,j,it,bi,bj)-po4obsl3(i,j,it,bi,bj))**2
94 & /po4varm(it,3)
95 & *rA(i,j,bi,bj)*drF(3)*maskC(i,j,3,bi,bj)
96 cQQ & (po4lev4(i,j,it,bi,bj)-po4obsl4(i,j,it,bi,bj))**2
97 cQQ & /po4varm(it,4)
98 cQQ & *rA(i,j,bi,bj)*drF(4)*maskC(i,j,4,bi,bj)
99 o2costm=o2costm+
100 & (o2lev1(i,j,it,bi,bj)-o2obsl1(i,j,it,bi,bj))**2
101 & /o2varm(it,1)
102 & *rA(i,j,bi,bj)*drF(1)*maskC(i,j,1,bi,bj) +
103 & (o2lev2(i,j,it,bi,bj)-o2obsl2(i,j,it,bi,bj))**2
104 & /o2varm(it,2)
105 & *rA(i,j,bi,bj)*drF(2)*maskC(i,j,2,bi,bj) +
106 & (o2lev3(i,j,it,bi,bj)-o2obsl3(i,j,it,bi,bj))**2
107 & /o2varm(it,3)
108 & *rA(i,j,bi,bj)*drF(3)*maskC(i,j,3,bi,bj)
109 cQQ & (O2lev4(i,j,it,bi,bj)-o2obsl4(i,j,it,bi,bj))**2
110 cQQ & /o2varm(it,4)
111 cQQ & *rA(i,j,bi,bj)*drF(4)*maskC(i,j,4,bi,bj)
112
113 enddo
114 cswdmonth -end-
115 ENDDO
116 ENDDO
117 ENDDO
118 ENDDO
119 po4cost=po4cost/sumvol
120 o2cost=o2cost/sumvol
121 cswdmonth-add
122 po4costm=po4costm/sumvolm/12.d0
123 o2costm=o2costm/sumvolm/12.d0
124 cswdmonth-end
125 totcost=po4cost+o2cost+po4costm+o2costm
126
127 print*,'COST ',totcost, po4cost, o2cost,po4costm,o2costm
128
129 _END_MASTER(myThid)
130 c
131 #endif
132 RETURN
133 END
134 cswd -- end added subroutine --

  ViewVC Help
Powered by ViewVC 1.1.22