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

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

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

Revision 1.1 - (hide 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 heimbach 1.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