/[MITgcm]/MITgcm/pkg/ecco/cost_atlantic.F
ViewVC logotype

Contents of /MITgcm/pkg/ecco/cost_atlantic.F

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

Revision 1.1 - (show annotations) (download)
Thu Nov 6 22:10:07 2003 UTC (20 years, 7 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint52l_pre, checkpoint52e_pre, hrcube4, checkpoint52n_post, checkpoint52j_post, checkpoint53d_post, checkpoint54a_pre, checkpoint55c_post, checkpoint54e_post, checkpoint52e_post, checkpoint53c_post, checkpoint55d_pre, hrcube_1, checkpoint52j_pre, checkpoint54a_post, branch-netcdf, checkpoint52d_pre, checkpoint52l_post, checkpoint52k_post, checkpoint52b_pre, checkpoint54b_post, checkpoint53b_pre, checkpoint55b_post, checkpoint54d_post, checkpoint53f_post, checkpoint52m_post, checkpoint55, checkpoint53a_post, checkpoint54, checkpoint54f_post, checkpoint53b_post, checkpoint53, checkpoint52, checkpoint52d_post, checkpoint52a_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, checkpoint52c_post, ecco_c52_e35, hrcube5, checkpoint52a_pre, checkpoint52i_post, checkpoint55a_post, checkpoint53d_pre, checkpoint54c_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, hrcube_2, hrcube_3
Branch point for: netcdf-sm0 
o merging from ecco-branch
o pkg/ecco now containes ecco-specific part of cost function
o top level routines the_main_loop, forward_step
  supersede those in model/src/
  previous input data.cost now in data.ecco
  (new namelist ecco_cost_nml)
1 C $Header: /u/gcmpack/MITgcm/pkg/cost/Attic/cost_atlantic.F,v 1.1.2.1 2002/02/05 20:23:57 heimbach Exp $
2
3 #include "COST_CPPOPTIONS.h"
4
5
6 subroutine cost_atlantic(
7 I mytime,
8 I myiter,
9 I mythid
10 & )
11
12 c ==================================================================
13 c SUBROUTINE cost_atlantic
14 c ==================================================================
15 c
16 c o Compute meridional heat transport. The counters
17 c are explicitly calculated instead of being incremented. This
18 c reduces dependencies. The latter is useful for the adjoint code
19 c generation.
20 c
21 c started: Armin Koehl akoehl@ucsd.edu 22-Sep-2000
22 c
23 c ==================================================================
24 c SUBROUTINE cost_atlantic
25 c ==================================================================
26
27 implicit none
28
29 c == global variables ==
30 #ifdef ALLOW_COST_ATLANTIC
31
32 #include "EEPARAMS.h"
33 #include "SIZE.h"
34 #include "GRID.h"
35 #include "DYNVARS.h"
36 #include "PARAMS.h"
37 #include "CG2D.h"
38
39 #include "optim.h"
40 #include "ecco_cost.h"
41 #include "ctrl_dummy.h"
42
43 #endif
44
45 c == routine arguments ==
46
47 _RL mytime
48 integer myiter
49 integer mythid
50
51 #ifdef ALLOW_COST_ATLANTIC
52
53 c == local variables ==
54
55 integer bi,bj
56 integer i,j,k
57 integer itlo,ithi
58 integer jtlo,jthi
59 integer jmin,jmax
60 integer imin,imax
61
62 logical first
63 logical startofday
64 logical startofmonth
65 logical inday
66 logical inmonth
67 logical last
68 logical endofday
69 logical endofmonth
70
71 _RL p5
72 parameter( p5 = 0.5 )
73
74 _RL del_y
75 _RL tv
76 _RL ylat,beglon,endlon
77 _RL ylat2,beglon2,endlon2
78 _RL ylat3,beglon3,endlon3
79 c parameter(ylat= 29., beglon=-42., endlon =-2.)
80 c parameter(ylat= 29., beglon=282., endlon =352.)
81 c parameter(ylat= 29., beglon=-82., endlon =-2.)
82 parameter(ylat= 66.75,beglon=-34.5,endlon =-22.5)
83 parameter(ylat2= 63.8,beglon2=-20,endlon2 =-5.)
84 parameter(ylat3= 63.8,beglon3=-98.5,endlon3 =-80.0)
85 c == external functions ==
86
87 integer ilnblnk
88 external ilnblnk
89
90 c == end of interface ==
91
92 jtlo = mybylo(mythid)
93 jthi = mybyhi(mythid)
94 itlo = mybxlo(mythid)
95 ithi = mybxhi(mythid)
96 jmin = 1
97 jmax = sny
98 imin = 1
99 imax = snx
100
101
102
103 c-- Get the time flags and record numbers for the time averaging.
104
105 call cost_AveragesFlags(
106 I myiter, mytime, mythid,
107 O first, startofday, startofmonth,
108 O inday, inmonth,
109 O last, endofday, endofmonth,
110 O sum1day, dayrec,
111 O sum1mon, monrec
112 & )
113
114 ce print*,' cost_AveragesFields: myiter = ', myiter
115 ce print*,' cost_AveragesFields: mytime = ', mytime
116 ce print*,' cost_AveragesFields: first = ', first
117 ce print*,' cost_AveragesFields: startofday = ', startofday
118 ce print*,' cost_AveragesFields: startofmonth = ', startofmonth
119 ce print*,' cost_AveragesFields: inday = ', inday
120 ce print*,' cost_AveragesFields: inmonth = ', inmonth
121 ce print*,' cost_AveragesFields: last = ', last
122 ce print*,' cost_AveragesFields: endofday = ', endofday
123 ce print*,' cost_AveragesFields: endofmonth = ', endofmonth
124 ce print*,' cost_AveragesFields: sum1day = ', sum1day
125 ce print*,' cost_AveragesFields: dayrec = ', dayrec
126 ce print*,' cost_AveragesFields: sum1mon = ', sum1mon
127 ce print*,' cost_AveragesFields: monrec = ', monrec
128
129 ce stop '... cost_AveragesFields stopped after ecco_TimeAverageFlags.'
130
131 c-- Next, do the monthly average for temperature.
132 if (first) then
133 c-- Assign the first value to the array holding the average.
134 do bj = jtlo,jthi
135 do bi = itlo,ithi
136 tv=0.0
137 do k = 1,nr
138 do j = jmin,jmax
139 do i = imin,imax
140 del_y=yc(i,j,bi,bj)-yc(i,j-1,bi,bj)
141 if(yc(i,j,bi,bj) .ge.ylat .and.
142 $ yc(i,j,bi,bj).lt.ylat+del_y.and.
143 $ xc(i,j,bi,bj).ge.beglon.and.
144 $ xc(i,j,bi,bj).le.endlon.or.
145 $ (yc(i,j,bi,bj) .ge.ylat2 .and.
146 $ yc(i,j,bi,bj).lt.ylat2+del_y.and.
147 $ xc(i,j,bi,bj).ge.beglon2.and.
148 $ xc(i,j,bi,bj).le.endlon2).or.
149 $ (yc(i,j,bi,bj) .ge.ylat3 .and.
150 $ yc(i,j,bi,bj).lt.ylat3+del_y.and.
151 $ xc(i,j,bi,bj).ge.beglon3.and.
152 $ xc(i,j,bi,bj).le.endlon3)) then
153 tv = tv+p5*(theta(i,j,k,bi,bj)
154 $ + theta(i,j-1,k,bi,bj))*vVel(i,j,k,bi,bj)
155 $ * _dxG(i,j,bi,bj)
156 & * drF(k)*_hFacS(i,j,k,bi,bj)
157 $ *HeatCapacity_Cp*rhoNil
158 endif
159 enddo
160 enddo
161 enddo
162 objf_atl(bi,bj) = tv
163 enddo
164 enddo
165 else if (last ) then
166 print*,"cost_atlantic last"
167 c-- Add the last value and devide by the number of accumulated
168 c-- records.
169 do bj = jtlo,jthi
170 do bi = itlo,ithi
171 objf_atl(bi,bj) = (objf_atl(bi,bj)
172 & )/float(nTimeSteps)
173 enddo
174 enddo
175 else
176 c-- Accumulate the array holding the average.
177 do bj = jtlo,jthi
178 do bi = itlo,ithi
179 tv=0
180 do k = 1,nr
181 do j = jmin,jmax
182 do i = imin,imax
183 del_y=yc(i,j,bi,bj)-yc(i,j-1,bi,bj)
184 if(yc(i,j,bi,bj) .ge.ylat .and.
185 $ yc(i,j,bi,bj).lt.ylat+del_y.and.
186 $ xc(i,j,bi,bj).ge.beglon.and.
187 $ xc(i,j,bi,bj).le.endlon.or.
188 $ (yc(i,j,bi,bj) .ge.ylat2 .and.
189 $ yc(i,j,bi,bj).lt.ylat2+del_y.and.
190 $ xc(i,j,bi,bj).ge.beglon2.and.
191 $ xc(i,j,bi,bj).le.endlon2).or.
192 $ (yc(i,j,bi,bj) .ge.ylat3 .and.
193 $ yc(i,j,bi,bj).lt.ylat3+del_y.and.
194 $ xc(i,j,bi,bj).ge.beglon3.and.
195 $ xc(i,j,bi,bj).le.endlon3)) then
196 tv = tv
197 $ +p5*(theta(i,j,k,bi,bj)
198 $ + theta(i,j-1,k,bi,bj))*vVel(i,j,k,bi,bj)
199 $ * _dxG(i,j,bi,bj)
200 & * drF(k)*_hFacS(i,j,k,bi,bj)
201 $ *HeatCapacity_Cp*rhoNil
202 endif
203 enddo
204 enddo
205 enddo
206 objf_atl(bi,bj) = objf_atl(bi,bj) +tv
207 enddo
208 enddo
209 endif
210
211 #endif
212
213 end
  ViewVC Help
Powered by ViewVC 1.1.22