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

Annotation of /MITgcm/pkg/ecco/cost_vwind.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:08 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, 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 heimbach 1.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