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

Contents of /MITgcm/pkg/ecco/cost_vwind.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: checkpoint53f_post, checkpoint54a_pre, checkpoint55c_post, checkpoint53b_pre, checkpoint52l_pre, checkpoint52e_pre, hrcube4, hrcube5, checkpoint52j_post, checkpoint52e_post, checkpoint52d_pre, checkpoint53c_post, checkpoint53d_post, checkpoint55d_pre, checkpoint52j_pre, checkpoint54a_post, branch-netcdf, checkpoint52b_pre, checkpoint52n_post, checkpoint54b_post, checkpoint54d_post, checkpoint54e_post, checkpoint55b_post, checkpoint52m_post, checkpoint55, checkpoint53a_post, checkpoint55a_post, checkpoint52l_post, checkpoint52k_post, checkpoint54, checkpoint53b_post, checkpoint53, checkpoint52, checkpoint52d_post, checkpoint52a_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, checkpoint52c_post, ecco_c52_e35, checkpoint54f_post, checkpoint52a_pre, checkpoint53d_pre, checkpoint54c_post, checkpoint52i_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, hrcube_1, 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
2 #include "COST_CPPOPTIONS.h"
3
4
5 subroutine cost_vwind(
6 I myiter,
7 I mytime,
8 I startrec,
9 I endrec,
10 I mythid
11 & )
12
13 c ==================================================================
14 c SUBROUTINE cost_vwind
15 c ==================================================================
16 c
17 c o Calculate merid. wind speed contribution to the cost function.
18 c
19 c ==================================================================
20 c SUBROUTINE cost_vwind
21 c ==================================================================
22
23 implicit none
24
25 c == global variables ==
26
27 #include "EEPARAMS.h"
28 #include "SIZE.h"
29 #include "GRID.h"
30
31 #include "ecco_cost.h"
32 #include "ctrl.h"
33 #include "ctrl_dummy.h"
34 #include "optim.h"
35
36 c == routine arguments ==
37
38 integer myiter
39 _RL mytime
40 integer startrec
41 integer endrec
42 integer mythid
43
44 c == local variables ==
45
46 integer bi,bj
47 integer i,j,kk
48 integer itlo,ithi
49 integer jtlo,jthi
50 integer jmin,jmax
51 integer imin,imax
52 integer nrec
53 integer irec
54 integer ilfld
55
56 _RL fctile
57 _RL fcthread
58 _RL tmpx
59
60 logical doglobalread
61 logical ladinit
62
63 character*(80) fnamefld
64
65 character*(MAX_LEN_MBUF) msgbuf
66
67 c == external functions ==
68
69 integer ilnblnk
70 external ilnblnk
71
72 c == end of interface ==
73
74 jtlo = mybylo(mythid)
75 jthi = mybyhi(mythid)
76 itlo = mybxlo(mythid)
77 ithi = mybxhi(mythid)
78 jmin = 1
79 jmax = sny
80 imin = 1
81 imax = snx
82
83 c-- Read state record from global file.
84 doglobalread = .false.
85 ladinit = .false.
86
87 c Number of records to be used.
88 nrec = endrec-startrec+1
89
90 #ifdef ALLOW_VWIND_COST_CONTRIBUTION
91
92 #ifdef ECCO_VERBOSE
93 _BEGIN_MASTER( mythid )
94 write(msgbuf,'(a)') ' '
95 call print_message( msgbuf, standardmessageunit,
96 & SQUEEZE_RIGHT , mythid)
97 write(msgbuf,'(a)') ' '
98 call print_message( msgbuf, standardmessageunit,
99 & SQUEEZE_RIGHT , mythid)
100 write(msgbuf,'(a,i9.8)')
101 & ' cost_vwind: number of records to process: ',nrec
102 call print_message( msgbuf, standardmessageunit,
103 & SQUEEZE_RIGHT , mythid)
104 write(msgbuf,'(a)') ' '
105 call print_message( msgbuf, standardmessageunit,
106 & SQUEEZE_RIGHT , mythid)
107 _END_MASTER( mythid )
108 #endif
109
110 if (optimcycle .ge. 0) then
111 ilfld=ilnblnk( xx_vwind_file )
112 write(fnamefld(1:80),'(2a,i10.10)')
113 & xx_vwind_file(1:ilfld),'.',optimcycle
114 endif
115
116 fcthread = 0. _d 0
117
118 c-- Loop over records.
119 do irec = 1,nrec
120
121 call active_read_xy_loc( fnamefld, tmpfld2d, irec, doglobalread,
122 & ladinit, optimcycle, mythid
123 & , xx_vwind_dummy )
124
125 c-- Loop over this thread's tiles.
126 do bj = jtlo,jthi
127 do bi = itlo,ithi
128
129 c-- Determine the weights to be used.
130 kk = 1
131 fctile = 0. _d 0
132 do j = jmin,jmax
133 do i = imin,imax
134 if (masks(i,j,kk,bi,bj) .ne. 0.) then
135 tmpx = tmpfld2d(i,j,bi,bj)
136 fctile = fctile
137 & + wvwind(i,j,bi,bj)*cosphi(i,j,bi,bj)
138 & *tmpx*tmpx
139 endif
140 enddo
141 enddo
142
143 objf_vwind(bi,bj) = objf_vwind(bi,bj) + fctile
144 fcthread = fcthread + fctile
145
146 #ifdef ECCO_VERBOSE
147 c-- Print cost function for each tile in each thread.
148 write(msgbuf,'(a)') ' '
149 call print_message( msgbuf, standardmessageunit,
150 & SQUEEZE_RIGHT , mythid)
151 write(msgbuf,'(a,i8.8,1x,i3.3,1x,i3.3)')
152 & ' cost_vwind: irec,bi,bj = ',irec,bi,bj
153 call print_message( msgbuf, standardmessageunit,
154 & SQUEEZE_RIGHT , mythid)
155 write(msgbuf,'(a,d22.15)')
156 & ' cost function (meridional) = ',
157 & fctile
158 call print_message( msgbuf, standardmessageunit,
159 & SQUEEZE_RIGHT , mythid)
160 #endif
161 enddo
162 enddo
163
164 #ifdef ECCO_VERBOSE
165 c-- Print cost function for all tiles.
166 _GLOBAL_SUM_R8( fcthread , myThid )
167 write(msgbuf,'(a)') ' '
168 call print_message( msgbuf, standardmessageunit,
169 & SQUEEZE_RIGHT , mythid)
170 write(msgbuf,'(a,i8.8)')
171 & ' cost_vwind: irec = ',irec
172 call print_message( msgbuf, standardmessageunit,
173 & SQUEEZE_RIGHT , mythid)
174 write(msgbuf,'(a,d22.15)')
175 & ' global cost function value = ',
176 & fcthread
177 call print_message( msgbuf, standardmessageunit,
178 & SQUEEZE_RIGHT , mythid)
179 write(msgbuf,'(a)') ' '
180 call print_message( msgbuf, standardmessageunit,
181 & SQUEEZE_RIGHT , mythid)
182 #endif
183 c-- End of loop over records.
184 enddo
185 #else
186 c-- Do not enter the calculation of the meridional wind stress contribution
187 c-- to the final cost function.
188
189 fctile = 0. _d 0
190 fcthread = 0. _d 0
191
192 _BEGIN_MASTER( mythid )
193 write(msgbuf,'(a)') ' '
194 call print_message( msgbuf, standardmessageunit,
195 & SQUEEZE_RIGHT , mythid)
196 write(msgbuf,'(a,a)')
197 & ' cost_vwind: no contribution of meridional wind stress ',
198 & ' to cost function.'
199 call print_message( msgbuf, standardmessageunit,
200 & SQUEEZE_RIGHT , mythid)
201 write(msgbuf,'(a,a,i9.8)')
202 & ' cost_vwind: number of records that would have',
203 & ' been processed: ',nrec
204 call print_message( msgbuf, standardmessageunit,
205 & SQUEEZE_RIGHT , mythid)
206 write(msgbuf,'(a)') ' '
207 call print_message( msgbuf, standardmessageunit,
208 & SQUEEZE_RIGHT , mythid)
209 _END_MASTER( mythid )
210 #endif
211
212 end
213
  ViewVC Help
Powered by ViewVC 1.1.22