/[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.6 by heimbach, Mon Oct 30 17:01:21 2006 UTC
# Line 55  c     == local variables == Line 55  c     == local variables ==
55        integer levoff        integer levoff
56        integer ilsalt        integer ilsalt
57    
58        _RL fctilemm        _RL tmpx, tmpx2
59        _RL fcthreadmm        _RL fctilemm(nSx,nSy)
60        _RL tmpx        _RL sumcos(nSx,nSy)
61        _RL sumcos        _RL sumtot
62          _RL fctiletot
63    
64    
65        character*(80) fnamesflux        character*(80) fnamesflux
# Line 96  c--   Read tiled data. Line 97  c--   Read tiled data.
97       &    sfluxbarfile(1:ilsalt),'.',optimcycle       &    sfluxbarfile(1:ilsalt),'.',optimcycle
98        endif        endif
99    
100        fcthreadmm       = 0. _d 0        do irec = 1, MAX(1,nyearsrec)
   
       irec = 1  
101    
102  c--     Read time averages and the monthly mean data.  c--     Read time averages and the monthly mean data.
103          call active_read_xy( fnamesflux, tmpfld2d, irec,          call active_read_xy( fnamesflux, tmpfld2d, irec,
# Line 109  c--     Read time averages and the month Line 108  c--     Read time averages and the month
108          do bj = jtlo,jthi          do bj = jtlo,jthi
109            do bi = itlo,ithi            do bi = itlo,ithi
110              kk = 1              kk = 1
111              fctilemm = 0. _d 0              fctilemm(bi,bj) = 0. _d 0
112              sumcos   = 0. _d 0              sumcos(bi,bj)   = 0. _d 0
113              do j = jmin,jmax              do j = jmin,jmax
114                do i = imin,imax                do i = imin,imax
115                  tmpx=tmpfld2d(i,j,bi,bj)                  tmpx=tmpfld2d(i,j,bi,bj)
116                  if (maskC(i,j,kk,bi,bj) .ne. 0.) then                  if (maskC(i,j,kk,bi,bj) .ne. 0.) then
117                     fctilemm = fctilemm+tmpx*cos(yc(i,j,bi,bj)*deg2rad)                     fctilemm(bi,bj) = fctilemm(bi,bj) + tmpx
118                    sumcos = sumcos + cos(yc(i,j,bi,bj)*deg2rad)       &                  *cos(yc(i,j,bi,bj)*deg2rad)
119                       sumcos(bi,bj) = sumcos(bi,bj)
120         &                  + cos(yc(i,j,bi,bj)*deg2rad)
121                       num_sfluxmm(bi,bj) = num_sfluxmm(bi,bj) + 1
122                  endif                  endif
123                enddo                enddo
124              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  
   
125            enddo            enddo
126          enddo          enddo
127    
128            sumtot    = 0.
129            fctiletot = 0.
130            do bj = jtlo,jthi
131               do bi = itlo,ithi
132                  sumtot    = sumtot + sumcos(bi,bj)
133                  fctiletot = fctiletot + fctilemm(bi,bj)
134               enddo
135            enddo
136           _GLOBAL_SUM_R8( sumtot , myThid )
137           _GLOBAL_SUM_R8( fctiletot , myThid )
138          
139           if (sumtot.eq.0.) sumtot = 1.
140    
141           if ( wmean_sflux .NE. 0. ) then
142             do bj = jtlo,jthi
143               do bi = itlo,ithi
144                 fctilemm(bi,bj) = fctilemm(bi,bj) / sumtot
145                 objf_sfluxmm(bi,bj) = objf_sfluxmm(bi,bj)
146         &           + (fctilemm(bi,bj)/wmean_sflux/nyearsrec)**2
147               enddo
148             enddo
149           endif
150    
151    c-- diagnostic: imbalance per year:
152           tmpx2 =  wsfluxmm(1,1) * fctiletot / sumtot
153           write(standardmessageunit,'(A,I5,D22.15)')
154         &      ' --> bal_sfluxmm    =', irec, tmpx2
155    
156  #ifdef ECCO_VERBOSE        enddo
 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_: irec = ',irec  
         call print_message( msgbuf, standardmessageunit,  
      &                      SQUEEZE_RIGHT , mythid)  
         write(msgbuf,'(a,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  
157    
 #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 )  
158  #endif  #endif
159    
160        return        return
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22