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

Contents of /MITgcm/pkg/ecco/cost_ice.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, 8 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint53f_post, checkpoint54a_pre, checkpoint55c_post, checkpoint53b_pre, checkpoint52l_pre, checkpoint52e_pre, hrcube4, hrcube5, checkpoint57g_pre, checkpoint52j_post, checkpoint57f_post, checkpoint52e_post, checkpoint57b_post, checkpoint52d_pre, checkpoint53c_post, checkpoint53d_post, checkpoint57f_pre, checkpoint55d_pre, checkpoint57g_post, checkpoint57a_post, checkpoint55j_post, checkpoint56b_post, checkpoint52j_pre, checkpoint54a_post, branch-netcdf, checkpoint55h_post, checkpoint52b_pre, checkpoint52n_post, checkpoint54b_post, checkpoint57e_post, checkpoint54d_post, checkpoint56c_post, checkpoint54e_post, checkpoint55b_post, checkpoint52m_post, checkpoint55, checkpoint53a_post, checkpoint55a_post, checkpoint57c_pre, checkpoint56, checkpoint55g_post, checkpoint57d_post, checkpoint55f_post, checkpoint52l_post, checkpoint52k_post, checkpoint57a_pre, checkpoint54, checkpoint57, checkpoint53b_post, checkpoint53, checkpoint52, checkpoint52d_post, checkpoint52a_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, checkpoint52c_post, ecco_c52_e35, checkpoint54f_post, eckpoint57e_pre, checkpoint57c_post, checkpoint52a_pre, checkpoint53d_pre, checkpoint55e_post, checkpoint54c_post, checkpoint52i_post, checkpoint55i_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint56a_post, checkpoint55d_post
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_ice.F,v 1.1.2.3 2003/06/17 20:48:22 dimitri Exp $
2
3 #include "COST_CPPOPTIONS.h"
4
5 subroutine cost_ice (
6 I mytime,
7 I myiter,
8 I mythid
9 & )
10
11 c ==================================================================
12 c SUBROUTINE cost_ice
13 c ==================================================================
14 c
15 c o Compute sea-ice cost function. The following options can
16 c be selected with data.cost variable cost_ice_flag:
17 c
18 c cost_ice_flag = 1
19 c - compute mean sea-ice volume
20 c costIceStart < mytime < costIceEnd
21 c
22 c cost_ice_flag = 2
23 c - compute mean sea-ice area
24 c costIceStart < mytime < costIceEnd
25 c
26 c cost_ice_flag = 3
27 c - heat content of top level plus latent heat of sea-ice
28 c costIceStart < mytime < costIceEnd
29 c
30 c cost_ice_flag = 4
31 c - heat content of top level
32 c costIceStart < mytime < costIceEnd
33 c
34 c cost_ice_flag = 5
35 c - heat content of top level plus sea-ice plus latent heat of snow
36 c costIceStart < mytime < costIceEnd
37 c
38 c cost_ice_flag = 6
39 c - quadratic cost function measuring difference between pkg/seaice
40 c AREA variable and simulated sea-ice measurements at every time
41 c step.
42 c
43 c ==================================================================
44 c
45 c started: menemenlis@jpl.nasa.gov 26-Feb-2003
46 c
47 c ==================================================================
48 c SUBROUTINE cost_ice
49 c ==================================================================
50
51 implicit none
52
53 c == global variables ==
54 #ifdef ALLOW_COST_ICE
55 #include "EEPARAMS.h"
56 #include "SIZE.h"
57 #include "GRID.h"
58 #include "PARAMS.h"
59 #include "ecco_cost.h"
60 #include "SEAICE.h"
61 #include "DYNVARS.h"
62 #endif /* ALLOW_COST_ICE */
63
64 c == routine arguments ==
65
66 _RL mytime
67 integer myiter
68 integer mythid
69
70 #ifdef ALLOW_COST_ICE
71
72 c == local variables ==
73
74 c msgBuf - Informational/error message buffer
75 CHARACTER*(MAX_LEN_MBUF) msgBuf
76 integer bi,bj,i,j
77 _RL tempVar
78
79 c == external functions ==
80
81 integer ilnblnk
82 external ilnblnk
83
84 c == end of interface ==
85
86 if ( mytime .ge. costIceStart .and. mytime .le. costIceEnd ) then
87 tempVar = 1. / ( 1. + int( ( min ( endtime, costIceEnd ) -
88 & max ( starttime, costIceStart ) ) / deltaTClock ) )
89
90 if ( cost_ice_flag .eq. 1 ) then
91 c sea-ice volume
92 do bj=myByLo(myThid),myByHi(myThid)
93 do bi=myBxLo(myThid),myBxHi(myThid)
94 do j = 1,sny
95 do i = 1,snx
96 objf_ice(bi,bj) = objf_ice(bi,bj) +
97 & tempVar * rA(i,j,bi,bj) * HEFF(i,j,1,bi,bj)
98 enddo
99 enddo
100 enddo
101 enddo
102
103 elseif ( cost_ice_flag .eq. 2 ) then
104 c sea-ice area
105 do bj=myByLo(myThid),myByHi(myThid)
106 do bi=myBxLo(myThid),myBxHi(myThid)
107 do j = 1,sny
108 do i = 1,snx
109 objf_ice(bi,bj) = objf_ice(bi,bj) +
110 & tempVar * rA(i,j,bi,bj) * AREA(i,j,1,bi,bj)
111 enddo
112 enddo
113 enddo
114 enddo
115
116 c heat content of top level:
117 c theta * delZ * (sea water heat capacity = 3996 J/kg/K)
118 c * (density of sea-water = 1026 kg/m^3)
119 c
120 c heat content of sea-ice:
121 c tice * heff * (sea ice heat capacity = 2090 J/kg/K)
122 c * (density of sea-ice = 910 kg/m^3)
123 c
124 c note: to remove mass contribution to heat content,
125 c which is not properly accounted for by volume converving
126 c ocean model, theta and tice are referenced to freezing
127 c temperature of sea-ice, here -1.96 deg C
128 c
129 c latent heat content of sea-ice:
130 c - heff * (latent heat of fusion = 334000 J/kg)
131 c * (density of sea-ice = 910 kg/m^3)
132 c
133 c latent heat content of snow:
134 c - hsnow * (latent heat of fusion = 334000 J/kg)
135 c * (density of snow = 330 kg/m^3)
136
137 elseif ( cost_ice_flag .eq. 3 ) then
138 c heat content of top level plus latent heat of sea-ice
139 do bj=myByLo(myThid),myByHi(myThid)
140 do bi=myBxLo(myThid),myBxHi(myThid)
141 do j = 1,sny
142 do i = 1,snx
143 objf_ice(bi,bj) = objf_ice(bi,bj) +
144 & tempVar * rA(i,j,bi,bj) * (
145 & (THETA(i,j,1,bi,bj) + 1.96 ) *
146 & drF(1) * 3996 * 1026 -
147 & HEFF(i,j,1,bi,bj) * 334000 * 910 )
148 enddo
149 enddo
150 enddo
151 enddo
152
153 elseif ( cost_ice_flag .eq. 4 ) then
154 c heat content of top level
155 do bj=myByLo(myThid),myByHi(myThid)
156 do bi=myBxLo(myThid),myBxHi(myThid)
157 do j = 1,sny
158 do i = 1,snx
159 objf_ice(bi,bj) = objf_ice(bi,bj) +
160 & tempVar * rA(i,j,bi,bj) * (
161 & (THETA(i,j,1,bi,bj) + 1.96 ) *
162 & drF(1) * 3996 * 1026 )
163 enddo
164 enddo
165 enddo
166 enddo
167
168 elseif ( cost_ice_flag .eq. 5 ) then
169 c heat content of top level plus sea-ice plus latent heat of snow
170 do bj=myByLo(myThid),myByHi(myThid)
171 do bi=myBxLo(myThid),myBxHi(myThid)
172 do j = 1,sny
173 do i = 1,snx
174 objf_ice(bi,bj) = objf_ice(bi,bj) +
175 & tempVar * rA(i,j,bi,bj) * (
176 & (THETA(i,j,1,bi,bj) + 1.96 ) *
177 & drF(1) * 3996 * 1026 +
178 & (TICE(i,j,bi,bj) - 273.15 + 1.96 ) *
179 & HEFF(I,J,1,bi,bj) * 2090 * 910 -
180 & HEFF(i,j,1,bi,bj) * 334000 * 910 -
181 & HSNOW(I,J,bi,bj) * 334000 * 330 )
182 enddo
183 enddo
184 enddo
185 enddo
186
187 elseif ( cost_ice_flag .eq. 6 ) then
188 c Qadratic cost function measuring difference between pkg/seaice
189 c AREA variable and simulated sea-ice measurements at every time
190 c step. For time being no measurements are read-in. It is
191 c assumed that measurements are AREA=0.5 at all times everywhere.
192 do bj=myByLo(myThid),myByHi(myThid)
193 do bi=myBxLo(myThid),myBxHi(myThid)
194 do j = 1,sny
195 do i = 1,snx
196 objf_ice(bi,bj) = objf_ice(bi,bj) +
197 & ( AREA(i,j,1,bi,bj) - 0.5 ) *
198 & ( AREA(i,j,1,bi,bj) - 0.5 )
199 enddo
200 enddo
201 enddo
202 enddo
203
204 else
205 WRITE(msgBuf,'(A)')
206 & 'COST_ICE: invalid cost_ice_flag'
207 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
208 & SQUEEZE_RIGHT , myThid )
209 STOP 'ABNORMAL END: S/R COST_ICE'
210 endif
211 endif
212
213 #endif /* ALLOW_COST_ICE */
214
215 end

  ViewVC Help
Powered by ViewVC 1.1.22