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

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

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

revision 1.2 by heimbach, Mon Oct 11 16:38:53 2004 UTC revision 1.15 by heimbach, Mon Aug 6 20:41:55 2012 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "COST_CPPOPTIONS.h"  #include "COST_CPPOPTIONS.h"
5    
# Line 32  c     == global variables == Line 34  c     == global variables ==
34    
35  #include "cal.h"  #include "cal.h"
36  #include "ecco_cost.h"  #include "ecco_cost.h"
37    #include "CTRL_SIZE.h"
38  #include "ctrl.h"  #include "ctrl.h"
39  #include "ctrl_dummy.h"  #include "ctrl_dummy.h"
40  #include "optim.h"  #include "optim.h"
# Line 55  c     == local variables == Line 58  c     == local variables ==
58        integer levoff        integer levoff
59        integer ilsalt        integer ilsalt
60    
       _RL fctilemm  
       _RL fcthreadmm  
61        _RL tmpx        _RL tmpx
62        _RL sumcos        _RL sumtot
63          _RL fctiletot
64    
65    
66        character*(80) fnamesflux        character*(80) fnamesflux
# Line 91  c--   Read tiled data. Line 93  c--   Read tiled data.
93  #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION  #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
94    
95        if (optimcycle .ge. 0) then        if (optimcycle .ge. 0) then
96          ilsalt = ilnblnk( sfluxbarfile )          ilsalt = ilnblnk( sfluxmeanbarfile )
97          write(fnamesflux(1:80),'(2a,i10.10)')          write(fnamesflux(1:80),'(2a,i10.10)')
98       &    sfluxbarfile(1:ilsalt),'.',optimcycle       &    sfluxmeanbarfile(1:ilsalt),'.',optimcycle
99        endif        endif
100    
101        fcthreadmm       = 0. _d 0        do irec = 1, MAX(1,nyearsrec)
   
       irec = 1  
102    
103  c--     Read time averages and the monthly mean data.  c--     Read time averages and the monthly mean data.
104          call active_read_xy( fnamesflux, tmpfld2d, irec,          call active_read_xy( fnamesflux, tmpfld2d, irec,
# Line 106  c--     Read time averages and the month Line 106  c--     Read time averages and the month
106       &                        optimcycle, mythid,       &                        optimcycle, mythid,
107       &                        xx_sflux_mean_dummy )       &                        xx_sflux_mean_dummy )
108    
109            sumtot    = 0.
110            fctiletot = 0.
111          do bj = jtlo,jthi          do bj = jtlo,jthi
112            do bi = itlo,ithi            do bi = itlo,ithi
113              kk = 1              kk = 1
             fctilemm = 0. _d 0  
             sumcos   = 0. _d 0  
114              do j = jmin,jmax              do j = jmin,jmax
115                do i = imin,imax                do i = imin,imax
116                  tmpx=tmpfld2d(i,j,bi,bj)                  tmpx=tmpfld2d(i,j,bi,bj)
117                  if (maskC(i,j,kk,bi,bj) .ne. 0.) then                  if (maskC(i,j,kk,bi,bj) .ne. 0.) then
118                     fctilemm = fctilemm+tmpx*cos(yc(i,j,bi,bj)*deg2rad)                     fctiletot = fctiletot
119                    sumcos = sumcos + cos(yc(i,j,bi,bj)*deg2rad)       &                + tmpx* _rA(i,j,bi,bj)/rhoConstFresh
120                       sumtot = sumtot
121         &                + _rA(i,j,bi,bj)
122                       num_sfluxmm(bi,bj) = num_sfluxmm(bi,bj) + 1
123                  endif                  endif
124                enddo                enddo
125              enddo              enddo
   
             if(sumcos.eq.0) sumcos=1.0  
             fctilemm = (fctilemm / sumcos)  
             fctilemm = wsfluxmm(bi,bj) * (fctilemm )  
   
             objf_sfluxmm(bi,bj) = fctilemm  
             fcthreadmm          = fcthreadmm + fctilemm  
   
 #ifdef ECCO_VERBOSE  
 c--     Print cost function for all tiles.  
         _GLOBAL_SUM_R8( fcthreadmm , myThid )  
         write(msgbuf,'(a)') ' '  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
         write(msgbuf,'(a,i8.8)')  
      &    ' cost_saltflux:                       irec =  ',irec  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
         write(msgbuf,'(a,d22.15)')  
      &    '                 global cost function value = ',  
      &    fcthreadmm  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
         write(msgbuf,'(a)') ' '  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
 #endif  
   
126            enddo            enddo
127          enddo          enddo
128    
129           _GLOBAL_SUM_RL( sumtot , myThid )
130           _GLOBAL_SUM_RL( fctiletot , myThid )
131    
132  #ifdef ECCO_VERBOSE         if (sumtot.eq.0.) sumtot = 1.
133  c--     Print cost function for all tiles.  
134          _GLOBAL_SUM_R8( fcthreadmm       , myThid )         if ( wmean_sflux .NE. 0. ) then
135          write(msgbuf,'(a)') ' '            objf_sfluxmm = objf_sfluxmm
136          call print_message( msgbuf, standardmessageunit,       &        + ( (fctiletot/sumtot)/wmean_sflux )**2
137       &                      SQUEEZE_RIGHT , mythid)         else
138          write(msgbuf,'(a,i8.8)')            objf_sfluxmm = 0. _d 0
139       &    ' cost_: irec = ',irec         endif
140          call print_message( msgbuf, standardmessageunit,  
141       &                      SQUEEZE_RIGHT , mythid)  c-- diagnostic: imbalance per year:
142          write(msgbuf,'(a,a,d22.15)')         write(standardmessageunit,'(A,I5,2(X,D22.14))')
143       &    ' global cost function value',       &      ' --> bal_sfluxmm    =', irec,
144       &    ' (        ) = ',fcthreadmm           &      fctiletot/sumtot,
145          call print_message( msgbuf, standardmessageunit,       &      objf_sfluxmm
146       &                      SQUEEZE_RIGHT , mythid)  
147          write(msgbuf,'(a)') ' '        enddo
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
 #endif  
148    
 #else  
 c--   Do not enter the calculation of the temperature contribution to  
 c--   the final cost function.  
   
       fctilemm         = 0. _d 0  
       fcthreadmm       = 0. _d 0  
   
       _BEGIN_MASTER( mythid )  
         write(msgbuf,'(a)') ' '  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
         write(msgbuf,'(a,a)')  
      &    ' cost_: no contribution of temperature field ',  
      &                 'to cost function.'  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
         write(msgbuf,'(a,a,i9.8)')  
      &    ' cost_: number of records that would have',  
      &                ' been processed: ',nmonsrec  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
         write(msgbuf,'(a)') ' '  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
       _END_MASTER( mythid )  
149  #endif  #endif
150    
151        return        return
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22