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

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

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

revision 1.2 by heimbach, Wed Dec 3 23:08:40 2003 UTC revision 1.3 by heimbach, Mon Oct 11 16:38:53 2004 UTC
# Line 69  c     == local variables == Line 69  c     == local variables ==
69    
70        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
71    
72    cnew(
73          integer  il
74          integer mody, modm
75          integer iyear, imonth
76          character*(80) fnametmp
77          logical exst
78    cnew)
79    
80  c     == external functions ==  c     == external functions ==
81    
82        integer  ilnblnk        integer  ilnblnk
# Line 87  c     == end of interface == Line 95  c     == end of interface ==
95        imin = 1        imin = 1
96        imax = snx        imax = snx
97                
98        spval = -2.        spval = -1.8
99        ztop  = -.981*1.027        ztop  = -.981*1.027
100        rl_35= 35.0        rl_35= 35.0
101        rl_0  = 0.0        rl_0  = 0.0
# Line 97  c--   Read state record from global file Line 105  c--   Read state record from global file
105                
106  #ifdef ALLOW_ARGO_THETA_COST_CONTRIBUTION  #ifdef ALLOW_ARGO_THETA_COST_CONTRIBUTION
107    
 #ifdef ECCO_VERBOSE  
       write(msgbuf,'(a)') ' '  
       call print_message( msgbuf, standardmessageunit,  
      &                    SQUEEZE_RIGHT , mythid)  
       write(msgbuf,'(a,i8.8)')  
      &  ' cost_ARGO_THETA: number of records to process =', nmonsrec  
       call print_message( msgbuf, standardmessageunit,  
      &                    SQUEEZE_RIGHT , mythid)  
       write(msgbuf,'(a)') ' '  
       call print_message( msgbuf, standardmessageunit,  
      &                    SQUEEZE_RIGHT , mythid)  
 #endif  
   
108        if (optimcycle .ge. 0) then        if (optimcycle .ge. 0) then
109          ilu=ilnblnk( tbarfile )          ilu=ilnblnk( tbarfile )
110          write(fnametheta(1:80),'(2a,i10.10)')          write(fnametheta(1:80),'(2a,i10.10)')
111       &       tbarfile(1:ilu), '.', optimcycle       &       tbarfile(1:ilu),'.',optimcycle
112        endif        endif
113                
114        fcthread_argot = 0. _d 0        fcthread_argot = 0. _d 0
115    
116    cnew(
117          mody = modelstartdate(1)/10000
118          modm = modelstartdate(1)/100 - mody*100
119    cnew)
120    
121  c--   Loop over records.  c--   Loop over records.
122        do irec = 1,nmonsrec        do irec = 1,nmonsrec
123    
# Line 127  c--     Read time averages and the month Line 127  c--     Read time averages and the month
127       &          optimcycle, mythid       &          optimcycle, mythid
128       &   , xx_tbar_mean_dummy )       &   , xx_tbar_mean_dummy )
129        
130  cph        call cost_readargot( irec, mythid )  cnew(
131          call mdsreadfield( argotfile, cost_iprec, 'RL', nr, argotobs,          iyear = mody + INT((modm-1+irec-1)/12)
132       &                    irec, mythid)          imonth = 1 + MOD(modm-1+irec-1,12)
133            il=ilnblnk(argotfile)
134            write(fnametmp(1:80),'(2a,i4)')
135         &       argotfile(1:il), '_', iyear
136            inquire( file=fnametmp, exist=exst )
137            if (.NOT. exst) then
138               write(fnametmp(1:80),'(a)') argotfile(1:il)
139                imonth = irec
140            endif
141    
142            call mdsreadfield( fnametmp, cost_iprec, 'RL', nr, argotobs,
143         &                    imonth, mythid)
144    cnew)
145    
146  c--     Loop over this thread's tiles.  c--     Loop over this thread's tiles.
147          do bj = jtlo,jthi          do bj = jtlo,jthi
# Line 150  cph               to make it independnet Line 162  cph               to make it independnet
162  cph  cph
163  cph               if ( rC(K) .GT. -1000. ) then  cph               if ( rC(K) .GT. -1000. ) then
164  cph)  cph)
 c--               set cmask=0 in areas shallower than 1000m  
165                    if( (argotobs(i,j,k,bi,bj) .ne. 0.).and.                    if( (argotobs(i,j,k,bi,bj) .ne. 0.).and.
166       &             (argotobs(i,j,k,bi,bj) .ge. spval).and.       &             (argotobs(i,j,k,bi,bj) .gt. spval).and.
167       &             (_hFacC(i,j,13,bi,bj) .ne. 0.).and.       &             (_hFacC(i,j,13,bi,bj) .ne. 0.).and.
168       &             (_hFacC(i,j,k,bi,bj) .ne. 0.) )then       &             (_hFacC(i,j,k,bi,bj) .ne. 0.) )then
169                       www(i,j)    = cosphi(i,j,bi,bj)                    www(i,j)    = cosphi(i,j,bi,bj)
170                       tmpobs(i,j) = SW_PTMP(rl_35,                    tmpobs(i,j) = SW_PTMP(rl_35,
171       $                    argotobs(i,j,k,bi,bj),ztop*rc(k),rl_0)       $                 argotobs(i,j,k,bi,bj),ztop*rc(k),rl_0)
172    
173                       fctile_argot = fctile_argot +                    fctile_argot = fctile_argot +
174       &                    wtheta2(i,j,k,bi,bj)*www(i,j)*       &                 wtheta2(i,j,k,bi,bj)*www(i,j)*
175       &                    (tbar(i,j,k,bi,bj)-tmpobs(i,j))*       &                 (tbar(i,j,k,bi,bj)-tmpobs(i,j))*
176       &                    (tbar(i,j,k,bi,bj)-tmpobs(i,j))       &                 (tbar(i,j,k,bi,bj)-tmpobs(i,j))
177                    endif                  endif
178                  enddo                  enddo
179                enddo                enddo
180  c--         End of loop over layers.  c--         End of loop over layers.
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22