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

Annotation of /MITgcm/pkg/ecco/cost_mean_saltflux.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
2     #include "COST_CPPOPTIONS.h"
3    
4    
5     subroutine cost_mean_saltflux(
6     I myiter,
7     I mytime,
8     I mythid
9     & )
10    
11     c ==================================================================
12     c SUBROUTINE cost_mean_saltflux
13     c ==================================================================
14     c
15     c o Evaluate cost function contribution of sea surface salinity.
16     c
17     c started: Elisabeth Remy 19-mar-2001 copy from cost_sst.F
18     c
19     c ==================================================================
20     c SUBROUTINE cost_mean_saltflux
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     #include "DYNVARS.h"
31     #include "PARAMS.h"
32    
33     #include "cal.h"
34     #include "ecco_cost.h"
35     #include "ctrl.h"
36     #include "ctrl_dummy.h"
37     #include "optim.h"
38    
39     c == routine arguments ==
40    
41     integer myiter
42     _RL mytime
43     integer mythid
44    
45     c == local variables ==
46    
47     integer bi,bj
48     integer i,j,k,kk
49     integer itlo,ithi
50     integer jtlo,jthi
51     integer jmin,jmax
52     integer imin,imax
53     integer irec
54     integer levmon
55     integer levoff
56     integer ilsalt
57    
58     _RL fctilemm
59     _RL fcthreadmm
60     _RL tmpx
61     _RL sumcos
62    
63    
64     character*(80) fnamesflux
65    
66     logical doglobalread
67     logical ladinit
68    
69     character*(MAX_LEN_MBUF) msgbuf
70    
71     c == external functions ==
72    
73     integer ilnblnk
74     external ilnblnk
75    
76     c == end of interface ==
77    
78     jtlo = mybylo(mythid)
79     jthi = mybyhi(mythid)
80     itlo = mybxlo(mythid)
81     ithi = mybxhi(mythid)
82     jmin = 1
83     jmax = sny
84     imin = 1
85     imax = snx
86    
87     c-- Read tiled data.
88     doglobalread = .false.
89     ladinit = .false.
90    
91     #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
92    
93     #ifdef ECCO_VERBOSE
94     _BEGIN_MASTER( mythid )
95     write(msgbuf,'(a)') ' '
96     call print_message( msgbuf, standardmessageunit,
97     & SQUEEZE_RIGHT , mythid)
98     write(msgbuf,'(a,i8.8)')
99     & ' cost_mean_saltflux: no. of records to process = ',nmonsrec
100     call print_message( msgbuf, standardmessageunit,
101     & SQUEEZE_RIGHT , mythid)
102     write(msgbuf,'(a)') ' '
103     call print_message( msgbuf, standardmessageunit,
104     & SQUEEZE_RIGHT , mythid)
105     _END_MASTER( mythid )
106     #endif
107    
108     if (optimcycle .ge. 0) then
109     ilsalt = ilnblnk( sfluxbarfile )
110     write(fnamesflux(1:80),'(2a,i10.10)')
111     & sfluxbarfile(1:ilsalt),'.',optimcycle
112     endif
113    
114     fcthreadmm = 0. _d 0
115    
116     irec = 1
117    
118     c-- Read time averages and the monthly mean data.
119     call active_read_xy( fnamesflux, tmpfld2d, irec,
120     & doglobalread, ladinit,
121     & optimcycle, mythid,
122     & xx_sflux_mean_dummy )
123    
124     do bj = jtlo,jthi
125     do bi = itlo,ithi
126     kk = 1
127     fctilemm = 0. _d 0
128     sumcos = 0. _d 0
129     do j = jmin,jmax
130     do i = imin,imax
131     tmpx=tmpfld2d(i,j,bi,bj)
132     if (maskw(i,j,kk,bi,bj) .ne. 0.) then
133     fctilemm = fctilemm + tmpx*cos(yc(i,j,bi,bj)*deg2rad)
134     sumcos = sumcos + cos(yc(i,j,bi,bj)*deg2rad)
135     endif
136     enddo
137     enddo
138    
139     if(sumcos .eq. 0.) sumcos = 1.
140     fctilemm = (fctilemm / sumcos)
141     fctilemm = wsfluxmm(bi,bj)*fctilemm
142    
143     objf_sfluxmm(bi,bj) = fctilemm
144     fcthreadmm = fcthreadmm + fctilemm
145    
146     #ifdef ECCO_VERBOSE
147     c-- Print cost function for all tiles.
148     _GLOBAL_SUM_R8( fcthreadmm , myThid )
149     write(msgbuf,'(a)') ' '
150     call print_message( msgbuf, standardmessageunit,
151     & SQUEEZE_RIGHT , mythid)
152     write(msgbuf,'(a,i8.8)')
153     & ' cost_saltflux: irec = ',irec
154     call print_message( msgbuf, standardmessageunit,
155     & SQUEEZE_RIGHT , mythid)
156     write(msgbuf,'(a,d22.15)')
157     & ' global cost function value = ',
158     & fcthreadmm
159     call print_message( msgbuf, standardmessageunit,
160     & SQUEEZE_RIGHT , mythid)
161     write(msgbuf,'(a)') ' '
162     call print_message( msgbuf, standardmessageunit,
163     & SQUEEZE_RIGHT , mythid)
164     #endif
165    
166     enddo
167     enddo
168    
169    
170     #ifdef ECCO_VERBOSE
171     c-- Print cost function for all tiles.
172     _GLOBAL_SUM_R8( fcthreadmm , myThid )
173     write(msgbuf,'(a)') ' '
174     call print_message( msgbuf, standardmessageunit,
175     & SQUEEZE_RIGHT , mythid)
176     write(msgbuf,'(a,i8.8)')
177     & ' cost_: irec = ',irec
178     call print_message( msgbuf, standardmessageunit,
179     & SQUEEZE_RIGHT , mythid)
180     write(msgbuf,'(a,a,d22.15)')
181     & ' global cost function value',
182     & ' ( ) = ',fcthreadmm
183     call print_message( msgbuf, standardmessageunit,
184     & SQUEEZE_RIGHT , mythid)
185     write(msgbuf,'(a)') ' '
186     call print_message( msgbuf, standardmessageunit,
187     & SQUEEZE_RIGHT , mythid)
188     #endif
189    
190     #else
191     c-- Do not enter the calculation of the temperature contribution to
192     c-- the final cost function.
193    
194     fctilemm = 0. _d 0
195     fcthreadmm = 0. _d 0
196    
197     _BEGIN_MASTER( mythid )
198     write(msgbuf,'(a)') ' '
199     call print_message( msgbuf, standardmessageunit,
200     & SQUEEZE_RIGHT , mythid)
201     write(msgbuf,'(a,a)')
202     & ' cost_: no contribution of temperature field ',
203     & 'to cost function.'
204     call print_message( msgbuf, standardmessageunit,
205     & SQUEEZE_RIGHT , mythid)
206     write(msgbuf,'(a,a,i9.8)')
207     & ' cost_: number of records that would have',
208     & ' been processed: ',nmonsrec
209     call print_message( msgbuf, standardmessageunit,
210     & SQUEEZE_RIGHT , mythid)
211     write(msgbuf,'(a)') ' '
212     call print_message( msgbuf, standardmessageunit,
213     & SQUEEZE_RIGHT , mythid)
214     _END_MASTER( mythid )
215     #endif
216    
217     return
218     end
219    

  ViewVC Help
Powered by ViewVC 1.1.22