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

Annotation of /MITgcm/pkg/ecco/cost_generic.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.38 - (hide annotations) (download)
Tue Mar 1 23:05:15 2016 UTC (8 years, 3 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint65u
Changes since 1.37: +9 -2 lines
- cost_gencal.F: fix case when localstartdate.NE.modelstartdate; when
  yearly files are NOT found but one file without extension IS found
  then always assume that it is a climatology (thus retiring unused
  and confusing COST_GENERIC_ASSUME_CYCLIC cpp switch and allowing
  for daily climatogy case).
- cost_generic.F: add output of weight when outlev.GT.1
- ecco_cost_final.F: bypass display of profile costs when usePROFILES is false.

1 gforget 1.38 C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_generic.F,v 1.37 2015/11/08 03:12:56 atn Exp $
2 jmc 1.8 C $Name: $
3 heimbach 1.1
4 jmc 1.18 #include "ECCO_OPTIONS.h"
5 heimbach 1.1
6 gforget 1.25 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP
8     C !ROUTINE: cost_generic
9     C !INTERFACE:
10 jmc 1.8 subroutine cost_generic(
11 gforget 1.33 & nnzbar, localbarfile, dummy,
12 gforget 1.32 & nnzobs, localobsfile, localerrfile,
13     & mult_local, nrecloc, nrecobs,
14 gforget 1.21 & localstartdate, localperiod,
15 gforget 1.33 & ylocmask, spminloc, spmaxloc, spzeroloc,
16 gforget 1.24 & preproc, preproc_c, preproc_i, preproc_r,
17     & posproc, posproc_c, posproc_i, posproc_r,
18 gforget 1.22 & outlev, outname,
19 heimbach 1.1 & objf_local, num_local,
20     & myiter, mytime, mythid )
21    
22 gforget 1.25 C !DESCRIPTION: \bv
23     C Generic routine for evaluating time-dependent
24 heimbach 1.1 c cost function contribution
25 gforget 1.25 C \ev
26 heimbach 1.1
27 gforget 1.25 C !USES:
28 heimbach 1.1 implicit none
29    
30     c == global variables ==
31    
32     #include "EEPARAMS.h"
33     #include "SIZE.h"
34     #include "PARAMS.h"
35 heimbach 1.10 #include "GRID.h"
36 heimbach 1.1 #ifdef ALLOW_CAL
37     # include "cal.h"
38     #endif
39 gforget 1.19 #ifdef ALLOW_ECCO
40     # include "ecco.h"
41 gforget 1.17 #endif
42     #ifdef ALLOW_SEAICE
43     # include "SEAICE_COST.h"
44 heimbach 1.1 #endif
45    
46     c == routine arguments ==
47    
48 gforget 1.24 integer myiter
49     integer mythid
50 gforget 1.21 integer nnzbar, nnzobs
51     integer nrecloc, nrecobs
52 heimbach 1.1 integer localstartdate(4)
53 gforget 1.21 integer outlev
54 gforget 1.24 integer preproc_i(NGENPPROC)
55     integer posproc_i(NGENPPROC)
56 heimbach 1.1
57 gforget 1.24 _RL objf_local(nsx,nsy)
58     _RL num_local(nsx,nsy)
59 gforget 1.26 _RL dummy
60 heimbach 1.2 _RL mult_local
61 heimbach 1.1 _RL mytime
62     _RL localperiod
63     _RL spminloc
64     _RL spmaxloc
65     _RL spzeroloc
66 gforget 1.24 _RL preproc_r(NGENPPROC)
67     _RL posproc_r(NGENPPROC)
68 heimbach 1.1
69 heimbach 1.10 character*(1) ylocmask
70 heimbach 1.1 character*(MAX_LEN_FNAM) localbarfile
71     character*(MAX_LEN_FNAM) localobsfile
72 gforget 1.32 character*(MAX_LEN_FNAM) localerrfile
73 gforget 1.24 character*(MAX_LEN_FNAM) preproc(NGENPPROC)
74     character*(MAX_LEN_FNAM) preproc_c(NGENPPROC)
75     character*(MAX_LEN_FNAM) posproc(NGENPPROC)
76     character*(MAX_LEN_FNAM) posproc_c(NGENPPROC)
77 gforget 1.22 character*(MAX_LEN_FNAM) outname
78 gforget 1.21
79     #ifdef ALLOW_ECCO
80 heimbach 1.1
81     c == local variables ==
82    
83 gforget 1.36 integer bi,bj,k2
84 heimbach 1.1 integer itlo,ithi
85     integer jtlo,jthi
86 gforget 1.36 logical domean, doanom
87 heimbach 1.1
88 gforget 1.35 _RL localdifmean1 (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
89     _RL localdifmean2 (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
90 heimbach 1.1
91 gforget 1.25 CEOP
92 heimbach 1.1
93     jtlo = mybylo(mythid)
94     jthi = mybyhi(mythid)
95     itlo = mybxlo(mythid)
96     ithi = mybxhi(mythid)
97    
98     c-- Initialise local variables.
99    
100 heimbach 1.2 do bj = jtlo,jthi
101     do bi = itlo,ithi
102     objf_local(bi,bj) = 0. _d 0
103     num_local(bi,bj) = 0. _d 0
104     enddo
105     enddo
106 gforget 1.32
107 gforget 1.35 call ecco_zero(localdifmean1,Nr,zeroRL,myThid)
108     call ecco_zero(localdifmean2,Nr,zeroRL,myThid)
109 gforget 1.34
110 gforget 1.36 domean=.FALSE.
111     doanom=.FALSE.
112     do k2 = 1, NGENPPROC
113     if (preproc(k2).EQ.'mean') domean=.TRUE.
114     if (preproc(k2).EQ.'anom') doanom=.TRUE.
115     enddo
116    
117 gforget 1.34 C Extra time loop to compute time-mean fields and costs
118     if ( (.NOT. ( localobsfile.EQ.' ' ) )
119 gforget 1.36 & .AND. ( domean .OR. doanom ) ) then
120 gforget 1.34 call cost_genloop(
121 gforget 1.35 & localdifmean1,localdifmean2,.FALSE.,
122 gforget 1.34 & nnzbar, localbarfile, dummy,
123     & nnzobs, localobsfile, localerrfile,
124     & mult_local, nrecloc, nrecobs,
125     & localstartdate, localperiod,
126     & ylocmask, spminloc, spmaxloc, spzeroloc,
127     & preproc, preproc_c, preproc_i, preproc_r,
128     & posproc, posproc_c, posproc_i, posproc_r,
129     & outlev, outname,
130     & objf_local, num_local,
131     & myiter, mytime, mythid )
132     endif
133    
134 gforget 1.35 call ecco_zero(localdifmean1,Nr,zeroRL,myThid)
135    
136 gforget 1.36 if ((.NOT.(localobsfile.EQ.' ')).AND.(.NOT.domean)) then
137 gforget 1.34 call cost_genloop(
138 gforget 1.35 & localdifmean2,localdifmean1,.TRUE.,
139 gforget 1.34 & nnzbar, localbarfile, dummy,
140     & nnzobs, localobsfile, localerrfile,
141     & mult_local, nrecloc, nrecobs,
142     & localstartdate, localperiod,
143     & ylocmask, spminloc, spmaxloc, spzeroloc,
144     & preproc, preproc_c, preproc_i, preproc_r,
145     & posproc, posproc_c, posproc_i, posproc_r,
146     & outlev, outname,
147     & objf_local, num_local,
148     & myiter, mytime, mythid )
149     endif
150    
151     #endif /* ALLOW_ECCO */
152    
153     return
154     end
155    
156     C--------------
157    
158     subroutine cost_genloop(
159 gforget 1.35 & localdifmeanIn,localdifmeanOut, addVariaCost,
160 gforget 1.34 & nnzbar, localbarfile, dummy,
161     & nnzobs, localobsfile, localerrfile,
162     & mult_local, nrecloc, nrecobs,
163     & localstartdate, localperiod,
164     & ylocmask, spminloc, spmaxloc, spzeroloc,
165     & preproc, preproc_c, preproc_i, preproc_r,
166     & posproc, posproc_c, posproc_i, posproc_r,
167     & outlev, outname,
168     & objf_local, num_local,
169     & myiter, mytime, mythid )
170    
171     C !DESCRIPTION: \bv
172     C Generic routine for evaluating time-dependent
173     c cost function contribution
174     C \ev
175    
176     C !USES:
177     implicit none
178    
179     c == global variables ==
180    
181     #include "EEPARAMS.h"
182     #include "SIZE.h"
183     #include "PARAMS.h"
184     #include "GRID.h"
185     #ifdef ALLOW_CAL
186     # include "cal.h"
187     #endif
188     #ifdef ALLOW_ECCO
189     # include "ecco.h"
190     #endif
191     #ifdef ALLOW_SEAICE
192     # include "SEAICE_COST.h"
193     #endif
194    
195     c == routine arguments ==
196    
197     integer myiter
198     integer mythid
199     integer nnzbar, nnzobs
200     integer nrecloc, nrecobs
201     integer localstartdate(4)
202     integer outlev
203     integer preproc_i(NGENPPROC)
204     integer posproc_i(NGENPPROC)
205    
206     _RL objf_local(nsx,nsy)
207     _RL num_local(nsx,nsy)
208     _RL dummy
209     _RL mult_local
210     _RL mytime
211     _RL localperiod
212     _RL spminloc
213     _RL spmaxloc
214     _RL spzeroloc
215     _RL preproc_r(NGENPPROC)
216     _RL posproc_r(NGENPPROC)
217    
218     character*(1) ylocmask
219     character*(MAX_LEN_FNAM) localbarfile
220     character*(MAX_LEN_FNAM) localobsfile
221     character*(MAX_LEN_FNAM) localerrfile
222     character*(MAX_LEN_FNAM) preproc(NGENPPROC)
223     character*(MAX_LEN_FNAM) preproc_c(NGENPPROC)
224     character*(MAX_LEN_FNAM) posproc(NGENPPROC)
225     character*(MAX_LEN_FNAM) posproc_c(NGENPPROC)
226     character*(MAX_LEN_FNAM) outname
227    
228     logical addVariaCost
229 gforget 1.35 _RL localdifmeanIn (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
230     _RL localdifmeanOut (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
231 gforget 1.34
232     #ifdef ALLOW_ECCO
233    
234     c == local variables ==
235    
236     integer bi,bj
237     integer itlo,ithi
238     integer jtlo,jthi
239     integer irec, jrec
240 gforget 1.36 integer il, k2
241 gforget 1.34 integer localrec, obsrec
242 gforget 1.36 integer nrecloop, nrecclim, k2smooth
243 atn 1.37 logical domean, doanom, dovarwei, doclim, dosmooth, dosumsq
244 gforget 1.34
245     _RL localmask (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
246    
247     _RL localbar (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
248     _RL localweight(1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
249     _RL localtmp (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
250     _RL localobs (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
251     _RL localdif (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
252     _RL difmask (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
253    
254     _RL localdifmsk (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
255     _RL localdifsum (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
256     _RL localdifnum (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
257    
258     character*(128) fname1, fname2, fname3
259     character*200 msgbuf
260    
261     logical exst
262    
263     c == external functions ==
264    
265     integer ilnblnk
266     external ilnblnk
267    
268     CEOP
269    
270     call ecco_zero(localbar,Nr,zeroRL,myThid)
271     call ecco_zero(localweight,Nr,zeroRL,myThid)
272 gforget 1.29 call ecco_zero(localtmp,Nr,zeroRL,myThid)
273 gforget 1.34 call ecco_zero(localmask,Nr,zeroRL,myThid)
274    
275 gforget 1.29 call ecco_zero(localobs,Nr,zeroRL,myThid)
276     call ecco_zero(localdif,Nr,zeroRL,myThid)
277     call ecco_zero(difmask,Nr,zeroRL,myThid)
278 heimbach 1.2
279 gforget 1.34 call ecco_zero(localdifmsk,Nr,zeroRL,myThid)
280     call ecco_zero(localdifsum,Nr,zeroRL,myThid)
281     call ecco_zero(localdifnum,Nr,zeroRL,myThid)
282 gforget 1.30
283 atn 1.37 dosumsq=.TRUE.
284 gforget 1.36 domean=.FALSE.
285     doanom=.FALSE.
286     dovarwei=.FALSE.
287     dosmooth=.FALSE.
288     k2smooth=1
289     doclim=.FALSE.
290     nrecclim=nrecloc
291     do k2 = 1, NGENPPROC
292     if (preproc(k2).EQ.'mean') domean=.TRUE.
293     if (preproc(k2).EQ.'anom') doanom=.TRUE.
294     if (preproc(k2).EQ.'variaweight') dovarwei=.TRUE.
295 atn 1.37 if (preproc(k2).EQ.'nosumsq') dosumsq=.FALSE.
296 gforget 1.36 if (posproc(k2).EQ.'smooth') then
297     dosmooth=.TRUE.
298     k2smooth=k2
299     endif
300     if (preproc(k2).EQ.'clim') then
301     doclim=.TRUE.
302     nrecclim=preproc_i(k2)
303     endif
304     enddo
305    
306 heimbach 1.10 c-- Assign mask
307     if ( ylocmask .EQ. 'C' .OR. ylocmask .EQ. 'c' ) then
308 gforget 1.26 call ecco_cprsrl(maskC,nr,localmask,nr,myThid)
309 heimbach 1.10 elseif ( ylocmask .EQ. 'S' .OR. ylocmask .EQ. 's' ) then
310 gforget 1.26 call ecco_cprsrl(maskS,nr,localmask,nr,myThid)
311 heimbach 1.10 elseif ( ylocmask .EQ. 'W' .OR. ylocmask .EQ. 'w' ) then
312 gforget 1.26 call ecco_cprsrl(maskW,nr,localmask,nr,myThid)
313 heimbach 1.10 else
314     STOP 'cost_generic: wrong ylocmask'
315     endif
316    
317 gforget 1.28 c-- set nrecloop to nrecloc
318     nrecloop=nrecloc
319    
320 gforget 1.34 c-- reset nrecloop, if needed, according to preproc
321 gforget 1.36 if ( doclim ) nrecloop=MIN(nrecloop,nrecclim)
322 gforget 1.34
323 gforget 1.30 c-- loop over obsfile records
324     do irec = 1, nrecloop
325    
326 gforget 1.32 c-- load weights
327     exst=.FALSE.
328     jrec=1
329 gforget 1.36 if( dovarwei ) jrec = irec
330 gforget 1.32 call cost_gencal(localbarfile, localerrfile,
331     & jrec, localstartdate, localperiod, fname1,
332     & fname3, localrec, obsrec, exst, mythid )
333     call ecco_zero(localweight,nnzobs,zeroRL,myThid)
334     if ( (localrec .GT. 0).AND.(obsrec .GT. 0).AND.(exst) )
335     & call ecco_readwei(fname3,localweight,localrec,nnzobs,mythid)
336    
337 gforget 1.30 c-- determine records and file names
338     exst=.FALSE.
339     call cost_gencal(localbarfile, localobsfile,
340     & irec, localstartdate, localperiod, fname1,
341     & fname2, localrec, obsrec, exst, mythid )
342    
343     c-- load model average and observed average
344     call ecco_zero(localbar,nnzbar,zeroRL,myThid)
345     call cost_genread( fname1, localbar, localtmp, irec, nnzbar,
346 gforget 1.34 & nrecloc, preproc, preproc_c, preproc_i, preproc_r,
347 gforget 1.30 & dummy, mythid )
348    
349 gforget 1.34 call ecco_zero(localobs,nnzobs,spzeroloc,myThid)
350 gforget 1.30 if ( (localrec .GT. 0).AND.(obsrec .GT. 0).AND.(exst) )
351     & call mdsreadfield( fname2, cost_iprec, cost_yftype, nnzobs,
352     & localobs, localrec, mythid )
353    
354 gforget 1.34 c-- Compute masked model-data difference
355     call ecco_diffmsk( localbar, nnzbar, localobs, nnzobs,
356 gforget 1.30 & localmask, spminloc, spmaxloc, spzeroloc,
357     & localdif, difmask, myThid )
358    
359 gforget 1.36 if ( doanom ) call ecco_subtract( localdifmeanIn,
360 gforget 1.34 & nnzobs, localdif, nnzobs, myThid )
361    
362 gforget 1.36 if ( domean.OR.doanom )
363 gforget 1.34 & call ecco_addmask(localdif,difmask, nnzobs,localdifsum,
364     & localdifnum, nnzobs,myThid)
365 gforget 1.30
366 gforget 1.34 if (addVariaCost) then
367 gforget 1.30
368     #ifdef ALLOW_SMOOTH
369 gforget 1.36 if ( useSMOOTH.AND.dosmooth.AND.
370 gforget 1.30 & (nnzbar.EQ.1).AND.(nnzobs.EQ.1) )
371     & call smooth_hetero2d(localdif,maskc,
372 gforget 1.36 & posproc_c(k2smooth),posproc_i(k2smooth),mythid)
373 gforget 1.30 #endif
374    
375     c-- Compute normalized model-obs cost function
376     call ecco_addcost(
377 atn 1.37 I localdif, localweight, difmask, nnzobs, dosumsq,
378     U objf_local, num_local,
379     I myThid
380     & )
381 gforget 1.30 c-- output model-data difference to disk
382     if ( outlev.GT.0 ) then
383     il=ilnblnk(outname)
384     write(fname3(1:128),'(2a)') 'misfit_', outname(1:il)
385     if ( nnzobs.EQ.1 ) CALL
386 gforget 1.34 & WRITE_REC_XY_RL( fname3, localdif,irec, eccoiter, mythid )
387 gforget 1.30 if ( nnzobs.EQ.nr ) CALL
388 gforget 1.34 & WRITE_REC_XYZ_RL( fname3, localdif,irec, eccoiter, mythid )
389 gforget 1.30 endif
390 gforget 1.20
391 gforget 1.36 endif
392 heimbach 1.2
393 gforget 1.34 enddo
394     c-- End of loop over obsfile records.
395 gforget 1.32
396 gforget 1.35 call ecco_zero(localdifmeanOut,Nr,zeroRL,myThid)
397     call ecco_cp(localdifsum,nnzobs,localdifmeanOut,nnzobs,myThid)
398     call ecco_divfield(localdifmeanOut,nnzobs,localdifnum,myThid)
399 gforget 1.34 call ecco_cp(localdifnum,nnzobs,localdifmsk,nnzobs,myThid)
400     call ecco_divfield(localdifmsk,nnzobs,localdifnum,myThid)
401 gforget 1.27
402 gforget 1.36 if ( domean ) then
403 gforget 1.22 c-- Compute normalized model-obs cost function
404 gforget 1.25 call ecco_addcost(
405 atn 1.37 I localdifmeanOut, localweight, localdifmsk, nnzobs, dosumsq,
406     U objf_local, num_local, myThid)
407 gforget 1.22
408 gforget 1.23 c-- output model-data difference to disk
409     if ( outlev.GT.0 ) then
410     il=ilnblnk(outname)
411     write(fname3(1:128),'(2a)') 'misfit_', outname(1:il)
412     if ( nnzobs.EQ.1 ) CALL
413 gforget 1.35 & WRITE_REC_XY_RL(fname3,localdifmeanOut,1,eccoiter,mythid)
414 gforget 1.23 if ( nnzobs.EQ.nr ) CALL
415 gforget 1.35 & WRITE_REC_XYZ_RL(fname3,localdifmeanOut,1,eccoiter,mythid)
416 gforget 1.23 endif
417 gforget 1.34 endif
418 gforget 1.38 if ( outlev.GT.1 ) then
419     il=ilnblnk(outname)
420     write(fname3(1:128),'(2a)') 'weight_', outname(1:il)
421     if ( nnzobs.EQ.1 ) CALL
422     & WRITE_REC_XY_RL( fname3, localweight,irec, eccoiter, mythid )
423     if ( nnzobs.EQ.nr ) CALL
424     & WRITE_REC_XYZ_RL( fname3, localweight,irec, eccoiter, mythid )
425     endif
426 heimbach 1.1
427 heimbach 1.2
428 gforget 1.21 #endif /* ALLOW_ECCO */
429    
430 gforget 1.34 return
431 heimbach 1.1 end
432 gforget 1.34
433    

  ViewVC Help
Powered by ViewVC 1.1.22