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

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

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

revision 1.23 by gforget, Sat Oct 4 20:28:20 2014 UTC revision 1.25 by gforget, Tue Oct 7 12:22:55 2014 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "ECCO_OPTIONS.h"  #include "ECCO_OPTIONS.h"
5    
6    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    CBOP
8    C     !ROUTINE: cost_generic
9    C     !INTERFACE:
10        subroutine cost_generic(        subroutine cost_generic(
11       &     nnzbar, localbarfile, localbar, xx_localbar_mean_dummy,       &     nnzbar, localbarfile, localbar, xx_localbar_mean_dummy,
12       &     nnzobs, localobsfile, mult_local,       &     nnzobs, localobsfile, mult_local,
# Line 11  C $Name$ Line 14  C $Name$
14       &     localstartdate, localperiod,       &     localstartdate, localperiod,
15       &     ylocmask, localweight,       &     ylocmask, localweight,
16       &     spminloc, spmaxloc, spzeroloc,       &     spminloc, spmaxloc, spzeroloc,
17       &     preproc, posproc, scalefile,       &     preproc, preproc_c, preproc_i, preproc_r,
18         &     posproc, posproc_c, posproc_i, posproc_r,
19       &     outlev, outname,       &     outlev, outname,
20       &     objf_local, num_local,       &     objf_local, num_local,
21       &     myiter, mytime, mythid )       &     myiter, mytime, mythid )
22    
23  c     ==================================================================  C     !DESCRIPTION: \bv
24  c     SUBROUTINE cost_generic  C     Generic routine for evaluating time-dependent
 c     ==================================================================  
 c  
 c     o Generic routine for evaluating time-dependent  
25  c       cost function contribution  c       cost function contribution
26  c  C     \ev
 c     ==================================================================  
 c     SUBROUTINE cost_generic  
 c     ==================================================================  
27    
28    C     !USES:
29        implicit none        implicit none
30    
31  c     == global variables ==  c     == global variables ==
# Line 47  c     == global variables == Line 46  c     == global variables ==
46    
47  c     == routine arguments ==  c     == routine arguments ==
48    
       integer nnzbar, nnzobs  
       integer nrecloc, nrecobs  
49        integer myiter        integer myiter
50        integer mythid        integer mythid
51          integer nnzbar, nnzobs
52          integer nrecloc, nrecobs
53        integer localstartdate(4)        integer localstartdate(4)
54        integer outlev        integer outlev
55          integer preproc_i(NGENPPROC)
56          integer posproc_i(NGENPPROC)
57    
58          _RL objf_local(nsx,nsy)
59          _RL num_local(nsx,nsy)
60        _RL localbar   (1-olx:snx+olx,1-oly:sny+oly,nnzbar,nsx,nsy)        _RL localbar   (1-olx:snx+olx,1-oly:sny+oly,nnzbar,nsx,nsy)
61        _RL localweight(1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)        _RL localweight(1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)
62        _RL xx_localbar_mean_dummy        _RL xx_localbar_mean_dummy
# Line 63  c     == routine arguments == Line 66  c     == routine arguments ==
66        _RL spminloc        _RL spminloc
67        _RL spmaxloc        _RL spmaxloc
68        _RL spzeroloc        _RL spzeroloc
69        _RL objf_local(nsx,nsy)        _RL preproc_r(NGENPPROC)
70        _RL num_local(nsx,nsy)        _RL posproc_r(NGENPPROC)
71    
72        character*(1) ylocmask        character*(1) ylocmask
73        character*(MAX_LEN_FNAM) localbarfile        character*(MAX_LEN_FNAM) localbarfile
74        character*(MAX_LEN_FNAM) localobsfile        character*(MAX_LEN_FNAM) localobsfile
75        character*(16) preproc        character*(MAX_LEN_FNAM) preproc(NGENPPROC)
76        character*(16) posproc        character*(MAX_LEN_FNAM) preproc_c(NGENPPROC)
77        character*(MAX_LEN_FNAM) scalefile        character*(MAX_LEN_FNAM) posproc(NGENPPROC)
78          character*(MAX_LEN_FNAM) posproc_c(NGENPPROC)
79        character*(MAX_LEN_FNAM) outname        character*(MAX_LEN_FNAM) outname
80    
81  #ifdef ALLOW_ECCO  #ifdef ALLOW_ECCO
# Line 79  c     == routine arguments == Line 83  c     == routine arguments ==
83  c     == local variables ==  c     == local variables ==
84    
85        integer bi,bj        integer bi,bj
       integer i,j,k  
86        integer itlo,ithi        integer itlo,ithi
87        integer jtlo,jthi        integer jtlo,jthi
       integer jmin,jmax  
       integer imin,imax  
88        integer irec        integer irec
89        integer  il        integer  il
90        integer localrec, obsrec        integer localrec, obsrec
# Line 91  c     == local variables == Line 92  c     == local variables ==
92        logical doglobalread        logical doglobalread
93        logical ladinit        logical ladinit
94    
       _RL localwww  
       _RL localcost  
       _RL junk  
   
95        _RL localmask  (1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)        _RL localmask  (1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
96        _RL localobs   (1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)        _RL localobs   (1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)
97        _RL localdif   (1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)        _RL localdif   (1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)
98        _RL difmask  (1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)        _RL difmask    (1-olx:snx+olx,1-oly:sny+oly,nnzobs,nsx,nsy)
99    
100        character*(128) fname1, fname2, fname3        character*(128) fname1, fname2, fname3
101    
# Line 109  c     == external functions == Line 106  c     == external functions ==
106        integer  ilnblnk        integer  ilnblnk
107        external ilnblnk        external ilnblnk
108    
109  c     == end of interface ==  CEOP
110    
111        jtlo = mybylo(mythid)        jtlo = mybylo(mythid)
112        jthi = mybyhi(mythid)        jthi = mybyhi(mythid)
113        itlo = mybxlo(mythid)        itlo = mybxlo(mythid)
114        ithi = mybxhi(mythid)        ithi = mybxhi(mythid)
       jmin = 1  
       jmax = sny  
       imin = 1  
       imax = snx  
115    
116  c--   Initialise local variables.  c--   Initialise local variables.
117    
       localwww = 0. _d 0  
   
118        do bj = jtlo,jthi        do bj = jtlo,jthi
119          do bi = itlo,ithi          do bi = itlo,ithi
120            objf_local(bi,bj) = 0. _d 0            objf_local(bi,bj) = 0. _d 0
# Line 135  c--   Initialise local variables. Line 126  c--   Initialise local variables.
126        call ecco_zero(difmask,nnzobs,zeroRL,myThid)        call ecco_zero(difmask,nnzobs,zeroRL,myThid)
127    
128  c--   Assign mask  c--   Assign mask
       do bj = jtlo,jthi  
         do bi = itlo,ithi  
           do k = 1,Nr  
             do j = 1-oly,sny+oly  
               do i = 1-olx,snx+olx  
129        if ( ylocmask .EQ. 'C' .OR. ylocmask .EQ. 'c' ) then        if ( ylocmask .EQ. 'C' .OR. ylocmask .EQ. 'c' ) then
130           localmask(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)          call ecco_cp(maskC,nr,localmask,nr,myThid)
131        elseif ( ylocmask .EQ. 'S' .OR. ylocmask .EQ. 's' ) then        elseif ( ylocmask .EQ. 'S' .OR. ylocmask .EQ. 's' ) then
132           localmask(i,j,k,bi,bj) = maskS(i,j,k,bi,bj)          call ecco_cp(maskS,nr,localmask,nr,myThid)
133        elseif ( ylocmask .EQ. 'W' .OR. ylocmask .EQ. 'w' ) then        elseif ( ylocmask .EQ. 'W' .OR. ylocmask .EQ. 'w' ) then
134           localmask(i,j,k,bi,bj) = maskW(i,j,k,bi,bj)          call ecco_cp(maskW,nr,localmask,nr,myThid)
135        else        else
136           STOP 'cost_generic: wrong ylocmask'           STOP 'cost_generic: wrong ylocmask'
137        endif        endif
               enddo  
             enddo  
           enddo  
         enddo  
       enddo  
138    
139  c--   First, read tiled data.  c--   First, read tiled data.
140        doglobalread = .false.        doglobalread = .false.
141        ladinit      = .false.        ladinit      = .false.
142    
143  c-- reset nrecloc, if needed, according to preproc  c-- reset nrecloc, if needed, according to preproc
144        if ( preproc .EQ. 'climmon ') nrecloc=MIN(nrecloc,12)        if ( preproc(1) .EQ. 'climmon') nrecloc=MIN(nrecloc,12)
145    
146        if ( .NOT. ( localobsfile.EQ.' ' ) ) then        if ( .NOT. ( localobsfile.EQ.' ' ) ) then
147    
# Line 184  c--     load model average and observed Line 165  c--     load model average and observed
165       &         localobs, localrec, mythid )       &         localobs, localrec, mythid )
166    
167  c--     Compute masked model-data difference  c--     Compute masked model-data difference
168          call cost_gendif( localbar, nnzbar, localobs, nnzobs,          call ecco_diff( localbar, nnzbar, localobs, nnzobs,
169       &     localmask, spminloc, spmaxloc, spzeroloc,       &     localmask, spminloc, spmaxloc, spzeroloc,
170       &     posproc, scalefile, localdif, difmask, myThid )       &     localdif, difmask, myThid )
171    
172  c--     Compute normalized model-obs cost function  c--     Compute normalized model-obs cost function
173          do bj = jtlo,jthi          call ecco_addcost(
174            do bi = itlo,ithi       I                   localdif, localweight, difmask, nnzobs,
175              localcost    = 0. _d 0       I                   objf_local, num_local,
176              do k = 1,nnzobs       I                   myThid
177               do j = jmin,jmax       &                   )
               do i = imin,imax  
                 localwww  = localweight(i,j,k,bi,bj)  
      &                    * difmask(i,j,k,bi,bj)  
                 junk      = localdif(i,j,k,bi,bj)  
                 localcost = localcost + junk*junk*localwww  
                 if ( localwww .ne. 0. )  
      &               num_local(bi,bj) = num_local(bi,bj) + 1. _d 0  
               enddo  
              enddo  
             enddo  
             objf_local(bi,bj) = objf_local(bi,bj) + localcost  
           enddo  
         enddo  
   
   
178    
179  c--     output model-data difference to disk  c--     output model-data difference to disk
180          if ( outlev.GT.0 ) then          if ( outlev.GT.0 ) then
Legend:
Removed from v.1.23  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22