/[MITgcm]/MITgcm_contrib/dgoldberg/streamice/streamice_cg_functions.F
ViewVC logotype

Diff of /MITgcm_contrib/dgoldberg/streamice/streamice_cg_functions.F

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

revision 1.1 by heimbach, Thu Mar 29 15:59:21 2012 UTC revision 1.6 by dgoldberg, Fri Dec 28 23:54:02 2012 UTC
# Line 63  C Phi_k is equal to 1 at vertex k, and 0 Line 63  C Phi_k is equal to 1 at vertex k, and 0
63  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
64  C     == Local variables ==  C     == Local variables ==
65        INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n        INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n
66        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
67        _RL Ucell (2,2)        _RL Ucell (2,2)
68        _RL Vcell (2,2)        _RL Vcell (2,2)
69        _RL Hcell (2,2)        _RL Hcell (2,2)
70          _RL phival(2,2)
71    
72          uret(1,1,1,1) = uret(1,1,1,1)
73          vret(1,1,1,1) = vret(1,1,1,1)
74    
75        DO j = js, je        DO j = js, je
76         DO i = is, ie         DO i = is, ie
77          DO bj = myByLo(myThid), myByHi(myThid)          DO bj = myByLo(myThid), myByHi(myThid)
78           DO bi = myBxLo(myThid), myBxHi(myThid)           DO bi = myBxLo(myThid), myBxHi(myThid)
79    
80            IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN            IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN
81             DO iq=1,2             DO iq = 1,2
82              DO jq = 1,2              DO jq = 1,2
83    
84              n = 2*(jq-1)+iq              n = 2*(jq-1)+iq
# Line 112  C     == Local variables == Line 117  C     == Local variables ==
117    
118               m = 2*(jnode-1)+inode               m = 2*(jnode-1)+inode
119               ilq = 1               ilq = 1
120                jlq = 1               jlq = 1
121               if (inode.eq.iq) ilq = 2               if (inode.eq.iq) ilq = 2
122               if (jnode.eq.jq) jlq = 2                 if (jnode.eq.jq) jlq = 2
123               phival = Xquad(ilq)*Xquad(jlq)               phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
124    
125               if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then                           if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then            
126                  
127                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
128       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
129       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
130       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
131       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
132       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
133    
134    
135                  uret(i-1+inode,j-1+jnode,bi,bj) =
136         &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
137         &         grid_jacq_streamice(i,j,bi,bj,n) *
138         &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
139         &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
140         &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
141    
142    
143                  uret(i-1+inode,j-1+jnode,bi,bj) =
144         &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
145         &         phival(inode,jnode) *
146         &         grid_jacq_streamice(i,j,bi,bj,n) *
147         &         tau_beta_eff_streamice (i,j,bi,bj) * uq
148    
149    
150                 endif
151        
152                 if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
153                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
154       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
155       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
156       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
157       &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +       &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
158       &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))       &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
   
               uret(i-1+inode,j-1+jnode,bi,bj) =  
      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *  
      &         grid_jacq_streamice(i,j,bi,bj,n) *  
      &         visc_streamice(i,j,bi,bj) * phival *  
      &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+  
      &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)      
159                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
160       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
161       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
162       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
163       &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+       &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
164       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
   
 !               IF (bi.eq.2.and.bj.eq.2.and.i.eq.15.and.  
 !      &         (exx.ne.0.0 .or. eyy.ne.0.0 .or. exy.ne.0.0)) THEN  
 !                PRINT *, "CG_FUNCTION", j, v(i,j,bi,bj),v(i+1,j,bi,bj),  
 !      &           v(i,j+1,bi,bj),v(i+1,j+1,bi,bj)  
 !               ENDIF  
   
                 
               uret(i-1+inode,j-1+jnode,bi,bj) =  
      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *  
      &         phival * grid_jacq_streamice(i,j,bi,bj,n) *  
      &         tau_beta_eff_streamice (i,j,bi,bj) * uq  
165                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
166       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
167       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) *
168         &         grid_jacq_streamice(i,j,bi,bj,n) *
169       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
170                                
171               endif               endif
172              enddo              enddo
173              enddo              enddo
174    
175             enddo                         enddo            
176             enddo             enddo
177    c-- STREAMICE_hmask
178            endif            endif
179    
180           enddo           enddo
181          enddo          enddo
182         enddo         enddo
# Line 200  C     is, ie, js, je - starting and endi Line 210  C     is, ie, js, je - starting and endi
210    
211  #ifdef ALLOW_STREAMICE  #ifdef ALLOW_STREAMICE
212    
213    #ifdef STREAMICE_CONSTRUCT_MATRIX
214    
215  C the linear action of the matrix on (u,v) with triangular finite elements  C the linear action of the matrix on (u,v) with triangular finite elements
216  C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,  C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
217  C but this may change pursuant to conversations with others  C but this may change pursuant to conversations with others
# Line 224  C     !LOCAL VARIABLES: Line 236  C     !LOCAL VARIABLES:
236  C     == Local variables ==  C     == Local variables ==
237        INTEGER iq, jq, inodx, inody, i, j, bi, bj, ilqx, ilqy, m_i, n        INTEGER iq, jq, inodx, inody, i, j, bi, bj, ilqx, ilqy, m_i, n
238        INTEGER jlqx, jlqy, jnodx,jnody, m_j, col_y, col_x, cg_halo, k        INTEGER jlqx, jlqy, jnodx,jnody, m_j, col_y, col_x, cg_halo, k
239        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
240          _RL phival(2,2)
241    
242  !       do i=1,3  !       do i=1,3
243  !        do j=0,2  !        do j=0,2
# Line 267  cc          ENDDO Line 280  cc          ENDDO
280                DO inody = 1,2                DO inody = 1,2
281    
282                 if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)                 if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)
283       &          .eq.1.0)       &          .eq.1.0 .or.
284         &             streamice_vmask(i-1+inodx,j-1+inody,bi,bj).eq.1.0)
285       &          then                   &          then            
286                            
287                  m_i = 2*(inody-1)+inodx                  m_i = 2*(inody-1)+inodx
# Line 276  cc          ENDDO Line 290  cc          ENDDO
290                            
291                  if (inodx.eq.iq) ilqx = 2                  if (inodx.eq.iq) ilqx = 2
292                  if (inody.eq.jq) ilqy = 2                    if (inody.eq.jq) ilqy = 2  
293                  phival = Xquad(ilqx)*Xquad(ilqy)                  phival(inodx,inody) = Xquad(ilqx)*Xquad(ilqy)
294    
295                  DO jnodx = 1,2                  DO jnodx = 1,2
296                   DO jnody = 1,2                   DO jnody = 1,2
297                    if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)                    if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)
298       &             .eq.1.0)       &             .eq.1.0 .or.
299         &             STREAMICE_vmask(i-1+jnodx,j-1+jnody,bi,bj).eq.1.0)
300       &             then                   &             then            
301    
302                     m_j = 2*(jnody-1)+jnodx                     m_j = 2*(jnody-1)+jnodx
# Line 337  c Line 352  c
352       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
353       &              .25 *       &              .25 *
354       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
355       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
356       &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*       &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*
357       &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
358    
# Line 347  c Line 362  c
362       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
363       &              .25 *       &              .25 *
364       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
365       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
366       &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*       &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*
367       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
368    
# Line 355  c Line 370  c
370       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
371       &             streamice_cg_A1       &             streamice_cg_A1
372       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
373       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
374         &              grid_jacq_streamice(i,j,bi,bj,n) *
375       &              tau_beta_eff_streamice (i,j,bi,bj) * uq       &              tau_beta_eff_streamice (i,j,bi,bj) * uq
376    
377                     streamice_cg_A3                     streamice_cg_A3
378       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
379       &             streamice_cg_A3       &             streamice_cg_A3
380       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
381       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
382         &              grid_jacq_streamice(i,j,bi,bj,n) *
383       &              tau_beta_eff_streamice (i,j,bi,bj) * vq       &              tau_beta_eff_streamice (i,j,bi,bj) * vq
384                                
385  c  c
# Line 405  c Line 422  c
422       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
423       &              .25 *       &              .25 *
424       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
425       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
426       &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*       &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*
427       &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
428    
# Line 415  c Line 432  c
432       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
433       &              .25 *       &              .25 *
434       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
435       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
436       &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*       &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*
437       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
438    
# Line 423  c Line 440  c
440       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
441       &             streamice_cg_A2       &             streamice_cg_A2
442       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
443       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
444         &              grid_jacq_streamice(i,j,bi,bj,n) *
445       &              tau_beta_eff_streamice (i,j,bi,bj) * uq       &              tau_beta_eff_streamice (i,j,bi,bj) * uq
446    
447                     streamice_cg_A4                     streamice_cg_A4
448       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
449       &             streamice_cg_A4       &             streamice_cg_A4
450       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
451       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
452         &              grid_jacq_streamice(i,j,bi,bj,n) *
453       &              tau_beta_eff_streamice (i,j,bi,bj) * vq       &              tau_beta_eff_streamice (i,j,bi,bj) * vq
454                                        
455                    endif                    endif
# Line 448  c Line 467  c
467        enddo        enddo
468    
469  #endif  #endif
470    #endif
471        RETURN        RETURN
472        END SUBROUTINE        END SUBROUTINE
473    
# Line 504  C Phi_k is equal to 1 at vertex k, and 0 Line 524  C Phi_k is equal to 1 at vertex k, and 0
524  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
525  C     == Local variables ==  C     == Local variables ==
526        INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n        INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n
527        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
528        _RL Ucell (2,2)        _RL Ucell (2,2)
529        _RL Vcell (2,2)        _RL Vcell (2,2)
530        _RL Hcell (2,2)        _RL Hcell (2,2)
531          _RL phival(2,2)
532    
533          uret(1,1,1,1) = uret(1,1,1,1)
534          vret(1,1,1,1) = vret(1,1,1,1)
535    
536        DO j = 0, sNy+1        DO j = 0, sNy+1
537         DO i = 0, sNx+1         DO i = 0, sNx+1
# Line 523  C     == Local variables == Line 547  C     == Local variables ==
547               DO jnode = 1,2               DO jnode = 1,2
548                            
549               m = 2*(jnode-1)+inode               m = 2*(jnode-1)+inode
              ilq = 1  
              jlq = 1  
               
              if (inode.eq.iq) ilq = 2  
              if (jnode.eq.jq) jlq = 2    
              phival = Xquad(ilq)*Xquad(jlq)  
550    
551               ux = DPhi (i,j,bi,bj,m,n,1)               if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0 .or.
552               uy = DPhi (i,j,bi,bj,m,n,2)       &           STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0)
553               vx = 0         &           then
554               vy = 0  
555               uq = Xquad(ilq) * Xquad(jlq)                ilq = 1
556               vq = 0                jlq = 1
   
              exx = ux + k1AtC_str(i,j,bi,bj)*vq  
              eyy = vy + k2AtC_str(i,j,bi,bj)*uq  
              exy = .5*(uy+vx) +  
      &        k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq  
557                            
558               if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then                            if (inode.eq.iq) ilq = 2
559                                if (jnode.eq.jq) jlq = 2  
560                  phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
561    
562                  ux = DPhi (i,j,bi,bj,m,n,1)
563                  uy = DPhi (i,j,bi,bj,m,n,2)
564                  vx = 0  
565                  vy = 0
566                  uq = Xquad(ilq) * Xquad(jlq)
567                  vq = 0
568    
569                  exx = ux + k1AtC_str(i,j,bi,bj)*vq
570                  eyy = vy + k2AtC_str(i,j,bi,bj)*uq
571                  exy = .5*(uy+vx) +
572         &         k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
573    
574                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
575       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
576       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
# Line 554  C     == Local variables == Line 581  C     == Local variables ==
581                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
582       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
583       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
584       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
585       &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+       &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
586       &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
587    
588                                
589                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
590       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
591       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
592       &         tau_beta_eff_streamice (i,j,bi,bj) * uq       &         tau_beta_eff_streamice (i,j,bi,bj) * uq
593                                
594    
# Line 586  C     == Local variables == Line 613  C     == Local variables ==
613                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
614       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
615       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
616       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
617       &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+       &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
618       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
619    
620                                
621                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
622       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
623       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
624       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
625                                
626               endif               endif
627    
628              enddo              enddo
629              enddo              enddo
630             enddo             enddo
# Line 664  C Phi_k is equal to 1 at vertex k, and 0 Line 692  C Phi_k is equal to 1 at vertex k, and 0
692  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
693  C     == Local variables ==  C     == Local variables ==
694        INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n        INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n
695        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
696        _RL Ucell (2,2)        _RL Ucell (2,2)
697        _RL Vcell (2,2)        _RL Vcell (2,2)
698        _RL Hcell (2,2)        _RL Hcell (2,2)
699          _RL phival(2,2)
700    
701          uret(1,1,1,1) = uret(1,1,1,1)
702          vret(1,1,1,1) = vret(1,1,1,1)
703    
704        DO j = 0, sNy+1        DO j = 0, sNy+1
705         DO i = 0, sNx+1         DO i = 0, sNx+1
# Line 677  C     == Local variables == Line 709  C     == Local variables ==
709       &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.       &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.
710       &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.       &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.
711       &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.       &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.
712       &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0))) THEN       &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0) .OR.
713         &      (STREAMICE_vmask(i,j,bi,bj).eq.3.0) .OR.
714         &      (STREAMICE_vmask(i,j+1,bi,bj).eq.3.0) .OR.
715         &      (STREAMICE_vmask(i+1,j,bi,bj).eq.3.0) .OR.
716         &      (STREAMICE_vmask(i+1,j+1,bi,bj).eq.3.0))) THEN
717                        
718             DO iq=1,2             DO iq=1,2
719              DO jq = 1,2              DO jq = 1,2
# Line 696  C     == Local variables == Line 732  C     == Local variables ==
732       &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +       &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
733       &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +       &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
734       &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)       &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
735              uy = u_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +              uy = u_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
736       &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +       &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
737       &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +       &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
738       &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)       &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
# Line 704  C     == Local variables == Line 740  C     == Local variables ==
740       &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +       &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
741       &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +       &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
742       &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)       &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
743              vy = v_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +              vy = v_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
744       &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +       &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
745       &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +       &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
746       &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)       &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
# Line 713  C     == Local variables == Line 749  C     == Local variables ==
749              exy = .5*(uy+vx) +              exy = .5*(uy+vx) +
750       &       k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq       &       k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
751    
752    
753              do inode = 1,2              do inode = 1,2
754               do jnode = 1,2               do jnode = 1,2
755    
756               m = 2*(jnode-1)+inode               m = 2*(jnode-1)+inode
757               ilq = 1               ilq = 1
758               ilq = 1               jlq = 1
759               if (inode.eq.iq) ilq = 2               if (inode.eq.iq) ilq = 2
760               if (jnode.eq.jq) jlq = 2                 if (jnode.eq.jq) jlq = 2  
761               phival = Xquad(ilq)*Xquad(jlq)               phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
762    
763                 if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then          
764    
              if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then              
765                                
766                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
767       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
# Line 731  C     == Local variables == Line 769  C     == Local variables ==
769       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
770       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
771       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
772                vret(i-1+inode,j-1+jnode,bi,bj) =  
      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *  
      &         grid_jacq_streamice(i,j,bi,bj,n) *  
      &         visc_streamice(i,j,bi,bj) * (  
      &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +  
      &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))  
773    
774                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
775       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
776       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
777       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
778       &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+       &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
779       &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
780                vret(i-1+inode,j-1+jnode,bi,bj) =              
      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *  
      &         grid_jacq_streamice(i,j,bi,bj,n) *  
      &         visc_streamice(i,j,bi,bj) * phival *  
      &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+  
      &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)  
781    
782  !               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then  !               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then
783                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
784       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
785       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
786       &         tau_beta_eff_streamice (i,j,bi,bj) * uq       &         tau_beta_eff_streamice (i,j,bi,bj) * uq
787    
788    
789    !               endif
790                 endif
791                 if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
792                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
793       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
794       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
795         &         visc_streamice(i,j,bi,bj) * (
796         &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
797         &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
798                  vret(i-1+inode,j-1+jnode,bi,bj) =
799         &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
800         &         grid_jacq_streamice(i,j,bi,bj,n) *
801         &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
802         &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
803         &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
804                  vret(i-1+inode,j-1+jnode,bi,bj) =
805         &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
806         &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
807       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
 !               endif  
808               endif               endif
809              enddo              enddo
810              enddo              enddo
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22