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

Contents of /MITgcm/pkg/ecco/cost_theta_ini_fin.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:08 2003 UTC (20 years, 6 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint57o_post, checkpoint52l_pre, checkpoint52e_pre, hrcube4, checkpoint58e_post, checkpoint57v_post, checkpoint52n_post, checkpoint52j_post, checkpoint53d_post, checkpoint58u_post, checkpoint54a_pre, checkpoint57f_post, checkpoint55c_post, checkpoint54e_post, checkpoint52e_post, checkpoint57s_post, checkpoint53c_post, checkpoint57k_post, checkpoint55d_pre, checkpoint57d_post, checkpoint57g_post, checkpoint57b_post, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint56b_post, checkpoint57i_post, checkpoint57y_post, hrcube_1, checkpoint58g_post, checkpoint57x_post, checkpoint52j_pre, checkpoint54a_post, checkpoint57m_post, branch-netcdf, checkpoint52d_pre, checkpoint52l_post, checkpoint55h_post, checkpoint58n_post, checkpoint58x_post, checkpoint52k_post, checkpoint52b_pre, checkpoint57g_pre, checkpoint54b_post, checkpoint53b_pre, checkpoint55b_post, checkpoint58t_post, checkpoint58h_post, checkpoint57e_post, checkpoint58w_post, checkpoint54d_post, checkpoint53f_post, checkpoint56c_post, checkpoint52m_post, checkpoint57y_pre, checkpoint55, checkpoint53a_post, checkpoint57f_pre, checkpoint57a_post, checkpoint54, checkpoint58q_post, checkpoint54f_post, checkpoint53b_post, checkpoint55g_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59h, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, checkpoint53, checkpoint52, checkpoint52d_post, eckpoint57e_pre, checkpoint52a_post, checkpoint57h_done, checkpoint58f_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, checkpoint57n_post, checkpoint52c_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, ecco_c52_e35, hrcube5, checkpoint58o_post, checkpoint57z_post, checkpoint57c_post, checkpoint58y_post, checkpoint55e_post, checkpoint52a_pre, checkpoint58k_post, checkpoint52i_post, checkpoint58v_post, checkpoint55a_post, checkpoint53d_pre, checkpoint54c_post, checkpoint58s_post, checkpoint58p_post, checkpoint57j_post, checkpoint58b_post, checkpoint57h_pre, checkpoint58m_post, checkpoint57l_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, checkpoint57h_post, 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_theta_ini_fin.F,v 1.1.2.1 2003/05/23 16:26:26 heimbach Exp $
2
3 #include "COST_CPPOPTIONS.h"
4
5
6 subroutine cost_theta_ini_fin(
7 I myiter,
8 I mytime,
9 I mythid
10 & )
11
12 c ==================================================================
13 c SUBROUTINE cost_theta_ini_fin
14 c ==================================================================
15 c
16 c ==================================================================
17 c SUBROUTINE cost_theta_ini_fin
18 c ==================================================================
19
20 implicit none
21
22 c == global variables ==
23
24 #include "EEPARAMS.h"
25 #include "SIZE.h"
26 #include "GRID.h"
27 #include "DYNVARS.h"
28
29 #include "ecco_cost.h"
30 #include "ctrl.h"
31 #include "ctrl_dummy.h"
32 #include "optim.h"
33
34 c == routine arguments ==
35
36 integer myiter
37 _RL mytime
38 integer mythid
39
40 c == local variables ==
41
42 integer bi,bj
43 integer i,j,k
44 integer itlo,ithi
45 integer jtlo,jthi
46 integer jmin,jmax
47 integer imin,imax
48 integer nrec
49 integer irec
50 integer ilfld
51
52 _RL fctile
53 _RL fcthread
54 _RL tmpx
55
56 logical doglobalread
57 logical ladinit
58
59 character*(80) fnamefld
60
61 character*(MAX_LEN_MBUF) msgbuf
62
63 c == external functions ==
64
65 integer ilnblnk
66 external ilnblnk
67
68 c == end of interface ==
69
70 jtlo = mybylo(mythid)
71 jthi = mybyhi(mythid)
72 itlo = mybxlo(mythid)
73 ithi = mybxhi(mythid)
74 jmin = 1
75 jmax = sny
76 imin = 1
77 imax = snx
78
79 c-- Read state record from global file.
80 doglobalread = .false.
81 ladinit = .false.
82
83 irec = 1
84
85 #ifdef ALLOW_COST_INI_FIN
86
87 ilfld = ilnblnk( xx_theta_ini_fin_file )
88 write(fnamefld(1:80),'(2a,i10.10)')
89 & xx_theta_ini_fin_file(1:ilfld),'.',optimcycle
90
91 fcthread = 0. _d 0
92
93 call active_read_xyz( fnamefld, tmpfld3d, irec, doglobalread,
94 & ladinit, optimcycle, mythid,
95 & xx_theta_ini_fin_dummy )
96
97 c-- Loop over this thread's tiles.
98 do bj = jtlo,jthi
99 do bi = itlo,ithi
100
101 c-- Determine the weights to be used.
102
103 fctile = 0. _d 0
104 do k = 1,nr
105 do j = jmin,jmax
106 do i = imin,imax
107 if (_hFacC(i,j,k,bi,bj) .ne. 0.) then
108 tmpx = tmpfld3d(i,j,k,bi,bj) - theta(i,j,k,bi,bj)
109 fctile = fctile
110 & + wtheta(k,bi,bj)*cosphi(i,j,bi,bj)
111 & *tmpx*tmpx
112 endif
113 enddo
114 enddo
115 enddo
116
117 objf_theta_ini_fin(bi,bj) =
118 & objf_theta_ini_fin(bi,bj) + fctile
119 fcthread = fcthread + fctile
120
121 #ifdef ECCO_VERBOSE
122 c-- Print cost function for each tile in each thread.
123 write(msgbuf,'(a)') ' '
124 call print_message( msgbuf, standardmessageunit,
125 & SQUEEZE_RIGHT , mythid)
126 write(msgbuf,'(a,i8.8,1x,i3.3,1x,i3.3)')
127 & ' cost_theta_ini_fin: irec,bi,bj = ',irec,bi,bj
128 call print_message( msgbuf, standardmessageunit,
129 & SQUEEZE_RIGHT , mythid)
130 write(msgbuf,'(a,d22.15)')
131 & ' cost_theta_ini_fin: irec,bi,bj = ',
132 & fctile
133 call print_message( msgbuf, standardmessageunit,
134 & SQUEEZE_RIGHT , mythid)
135 #endif
136 enddo
137 enddo
138
139 #ifdef ECCO_VERBOSE
140 c-- Print cost function for all tiles.
141 _GLOBAL_SUM_R8( fcthread , myThid )
142 write(msgbuf,'(a)') ' '
143 call print_message( msgbuf, standardmessageunit,
144 & SQUEEZE_RIGHT , mythid)
145 write(msgbuf,'(a,i8.8)')
146 & ' cost_: irec = ',irec
147 call print_message( msgbuf, standardmessageunit,
148 & SQUEEZE_RIGHT , mythid)
149 write(msgbuf,'(a,d22.15)')
150 & ' global cost function value = ',
151 & fcthread
152 call print_message( msgbuf, standardmessageunit,
153 & SQUEEZE_RIGHT , mythid)
154 write(msgbuf,'(a)') ' '
155 call print_message( msgbuf, standardmessageunit,
156 & SQUEEZE_RIGHT , mythid)
157 #endif
158
159 #else
160 c-- Do not enter the calculation of the salinity increment
161 c-- contribution to the final cost function.
162
163 fctile = 0. _d 0
164 fcthread = 0. _d 0
165
166 #ifdef ECCO_VERBOSE
167 _BEGIN_MASTER( mythid )
168 write(msgbuf,'(a)') ' '
169 call print_message( msgbuf, standardmessageunit,
170 & SQUEEZE_RIGHT , mythid)
171 write(msgbuf,'(a,a)')
172 & ' cost_theta_ini_fin : no contribution of the IC in salin. ',
173 & ' to cost function.'
174 call print_message( msgbuf, standardmessageunit,
175 & SQUEEZE_RIGHT , mythid)
176 write(msgbuf,'(a)') ' '
177 call print_message( msgbuf, standardmessageunit,
178 & SQUEEZE_RIGHT , mythid)
179 _END_MASTER( mythid )
180 #endif
181
182 #endif
183
184 return
185 end
186
187
  ViewVC Help
Powered by ViewVC 1.1.22