/[MITgcm]/MITgcm/pkg/profiles/profiles_interp.F
ViewVC logotype

Diff of /MITgcm/pkg/profiles/profiles_interp.F

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

revision 1.4 by heimbach, Sat May 6 15:14:01 2006 UTC revision 1.5 by gforget, Fri Jul 14 20:19:36 2006 UTC
# Line 17  C     o================================= Line 17  C     o=================================
17       I type_cur,       I type_cur,
18       I file_cur,       I file_cur,
19       I mytime,       I mytime,
20         I bi,
21         I bj,
22       I myThid       I myThid
23       & )       & )
24    
# Line 55  C ==================== Local Variables = Line 57  C ==================== Local Variables =
57        _RL lon_tmp1,lon_tmp2,lon_1,lon_2,lat_1,lat_2,tmp_coeff        _RL lon_tmp1,lon_tmp2,lon_1,lon_2,lat_1,lat_2,tmp_coeff
58  c--   == end of interface ==  c--   == end of interface ==
59    
       DO bi = myBxLo(myThid), myBxHi(myThid)  
       DO bj = myByLo(myThid), myByHi(myThid)  
   
60         prof_i=-10         prof_i=-10
61         prof_j=-10         prof_j=-10
62         lon_1=-10         lon_1=-10
# Line 221  cgf) spatial interpolation Line 220  cgf) spatial interpolation
220  cgf vertical interpolation:  cgf vertical interpolation:
221        do kk=1,NLEVELMAX        do kk=1,NLEVELMAX
222           traj_cur_out(kk)=0           traj_cur_out(kk)=0
223           prof_mask1D_cur(kk)=0           prof_mask1D_cur(kk,bi,bj)=0
224        enddo        enddo
225        do kk=1,profdepthno(file_cur)        do kk=1,ProfDepthNo(file_cur,bi,bj)
226  c case 1: above first grid center=> first grid center value  c case 1: above first grid center=> first grid center value
227          if (prof_depth(file_cur,kk).LT.-rC(1)) then          if (prof_depth(file_cur,kk,bi,bj).LT.-rC(1)) then
228            traj_cur_out(kk)=traj_cur(1)            traj_cur_out(kk)=traj_cur(1)
229            prof_mask1D_cur(kk)=mask_cur(1)            prof_mask1D_cur(kk,bi,bj)=mask_cur(1)
230  c case 2: just below last grid center=> last cell value  c case 2: just below last grid center=> last cell value
231          elseif (prof_depth(file_cur,kk).GE.-rC(nr)) then          elseif (prof_depth(file_cur,kk,bi,bj).GE.-rC(nr)) then
232            if ( prof_depth(file_cur,kk) .LT.            if ( prof_depth(file_cur,kk,bi,bj) .LT.
233       &    (-rC(nr)+drC(nr)/2) ) then         &    (-rC(nr)+drC(nr)/2) ) then  
234              traj_cur_out(kk)=traj_cur(nr)              traj_cur_out(kk)=traj_cur(nr)
235              prof_mask1D_cur(kk)=mask_cur(nr)              prof_mask1D_cur(kk,bi,bj)=mask_cur(nr)
236            endif            endif
237  c case 3: between two grid centers  c case 3: between two grid centers
238          else          else
239            kcur=0            kcur=0
240            do k=1,nr-1            do k=1,nr-1
241              if ((prof_depth(file_cur,kk).GE.-rC(k)).AND.              if ((prof_depth(file_cur,kk,bi,bj).GE.-rC(k)).AND.
242       &      (prof_depth(file_cur,kk).LT.-rC(k+1))) then       &      (prof_depth(file_cur,kk,bi,bj).LT.-rC(k+1))) then
243                kcur=k                kcur=k
244              endif              endif
245            enddo            enddo
# Line 250  c case 3: between two grid centers Line 249  c case 3: between two grid centers
249            endif            endif
250            if (mask_cur(kcur+1).EQ.1.) then            if (mask_cur(kcur+1).EQ.1.) then
251  c  subcase 1: 2 wet points=>linear interpolation  c  subcase 1: 2 wet points=>linear interpolation
252              tmp_coeff=(prof_depth(file_cur,kk)+rC(kcur))/              tmp_coeff=(prof_depth(file_cur,kk,bi,bj)+rC(kcur))/
253       &      (-rC(kcur+1)+rC(kcur))       &      (-rC(kcur+1)+rC(kcur))
254              traj_cur_out(kk)=(1-tmp_coeff)*traj_cur(kcur)              traj_cur_out(kk)=(1-tmp_coeff)*traj_cur(kcur)
255       &      +tmp_coeff*traj_cur(kcur+1)       &      +tmp_coeff*traj_cur(kcur+1)
256              prof_mask1D_cur(kk)=1              prof_mask1D_cur(kk,bi,bj)=1
257              if (mask_cur(kcur).EQ.0.) then              if (mask_cur(kcur).EQ.0.) then
258        print*,"profiles_interp unexpected case: stop 2"        print*,"profiles_interp unexpected case: stop 2"
259        stop        stop
260              endif              endif
261            elseif (prof_depth(file_cur,kk).LT.-rF(kcur+1)) then            elseif (prof_depth(file_cur,kk,bi,bj).LT.-rF(kcur+1)) then
262  c  subcase 2: only 1 wet point just above=>upper cell value  c  subcase 2: only 1 wet point just above=>upper cell value
263              traj_cur_out(kk)=traj_cur(kcur)              traj_cur_out(kk)=traj_cur(kcur)
264              prof_mask1D_cur(kk)=mask_cur(kcur)              prof_mask1D_cur(kk,bi,bj)=mask_cur(kcur)
265            endif            endif
266          endif          endif
267        enddo        enddo
268    
       ENDDO  
       ENDDO  
269    
270  #endif  #endif
271    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22