/[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.7 by dgoldberg, Thu Mar 7 15:23:19 2013 UTC
# Line 62  C Phi_k is equal to 1 at vertex k, and 0 Line 62  C Phi_k is equal to 1 at vertex k, and 0
62    
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,Gi,Gj
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             Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
81             Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
82    
83            IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN            IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN
84             DO iq=1,2             DO iq = 1,2
85              DO jq = 1,2              DO jq = 1,2
86    
87              n = 2*(jq-1)+iq              n = 2*(jq-1)+iq
88    
89    
90              uq = u(i,j,bi,bj) * Xquad(3-iq) * Xquad(3-jq) +              uq = u(i,j,bi,bj) * Xquad(3-iq) * Xquad(3-jq) +
91       &       u(i+1,j,bi,bj) * Xquad(iq) * Xquad(3-jq) +       &       u(i+1,j,bi,bj) * Xquad(iq) * Xquad(3-jq) +
92       &       u(i,j+1,bi,bj) * Xquad(3-iq) * Xquad(jq) +       &       u(i,j+1,bi,bj) * Xquad(3-iq) * Xquad(jq) +
# Line 112  C     == Local variables == Line 121  C     == Local variables ==
121    
122               m = 2*(jnode-1)+inode               m = 2*(jnode-1)+inode
123               ilq = 1               ilq = 1
124                jlq = 1               jlq = 1
125               if (inode.eq.iq) ilq = 2               if (inode.eq.iq) ilq = 2
126               if (jnode.eq.jq) jlq = 2                 if (jnode.eq.jq) jlq = 2
127               phival = Xquad(ilq)*Xquad(jlq)               phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
128    
129               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            
130                  
131                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
132       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
133       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
134       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
135       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
136       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
137    
138    
139                  uret(i-1+inode,j-1+jnode,bi,bj) =
140         &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
141         &         grid_jacq_streamice(i,j,bi,bj,n) *
142         &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
143         &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
144         &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
145    
146    
147                  uret(i-1+inode,j-1+jnode,bi,bj) =
148         &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
149         &         phival(inode,jnode) *
150         &         grid_jacq_streamice(i,j,bi,bj,n) *
151         &         tau_beta_eff_streamice (i,j,bi,bj) * uq
152    
153    
154                 endif
155        
156                 if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
157                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
158       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
159       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
160       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
161       &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +       &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
162       &          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)      
163                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
164       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
165       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
166       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
167       &         (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+
168       &          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  
169                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
170       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
171       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) *
172         &         grid_jacq_streamice(i,j,bi,bj,n) *
173       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
174                                
175               endif               endif
176              enddo              enddo
177              enddo              enddo
178    
179             enddo                         enddo            
180             enddo             enddo
181    c-- STREAMICE_hmask
182            endif            endif
183    
184           enddo           enddo
185          enddo          enddo
186         enddo         enddo
# Line 200  C     is, ie, js, je - starting and endi Line 214  C     is, ie, js, je - starting and endi
214    
215  #ifdef ALLOW_STREAMICE  #ifdef ALLOW_STREAMICE
216    
217    #ifdef STREAMICE_CONSTRUCT_MATRIX
218    
219  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
220  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,
221  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 240  C     !LOCAL VARIABLES:
240  C     == Local variables ==  C     == Local variables ==
241        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
242        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
243        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
244          _RL phival(2,2)
245    
246  !       do i=1,3  !       do i=1,3
247  !        do j=0,2  !        do j=0,2
# Line 267  cc          ENDDO Line 284  cc          ENDDO
284                DO inody = 1,2                DO inody = 1,2
285    
286                 if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)                 if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)
287       &          .eq.1.0)       &          .eq.1.0 .or.
288         &             streamice_vmask(i-1+inodx,j-1+inody,bi,bj).eq.1.0)
289       &          then                   &          then            
290                            
291                  m_i = 2*(inody-1)+inodx                  m_i = 2*(inody-1)+inodx
# Line 276  cc          ENDDO Line 294  cc          ENDDO
294                            
295                  if (inodx.eq.iq) ilqx = 2                  if (inodx.eq.iq) ilqx = 2
296                  if (inody.eq.jq) ilqy = 2                    if (inody.eq.jq) ilqy = 2  
297                  phival = Xquad(ilqx)*Xquad(ilqy)                  phival(inodx,inody) = Xquad(ilqx)*Xquad(ilqy)
298    
299                  DO jnodx = 1,2                  DO jnodx = 1,2
300                   DO jnody = 1,2                   DO jnody = 1,2
301                    if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)                    if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)
302       &             .eq.1.0)       &             .eq.1.0 .or.
303         &             STREAMICE_vmask(i-1+jnodx,j-1+jnody,bi,bj).eq.1.0)
304       &             then                   &             then            
305    
306                     m_j = 2*(jnody-1)+jnodx                     m_j = 2*(jnody-1)+jnodx
# Line 337  c Line 356  c
356       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
357       &              .25 *       &              .25 *
358       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
359       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
360       &             (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)*
361       &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
362    
# Line 347  c Line 366  c
366       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
367       &              .25 *       &              .25 *
368       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
369       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
370       &             (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)*
371       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
372    
# Line 355  c Line 374  c
374       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
375       &             streamice_cg_A1       &             streamice_cg_A1
376       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
377       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
378         &              grid_jacq_streamice(i,j,bi,bj,n) *
379       &              tau_beta_eff_streamice (i,j,bi,bj) * uq       &              tau_beta_eff_streamice (i,j,bi,bj) * uq
380    
381                     streamice_cg_A3                     streamice_cg_A3
382       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
383       &             streamice_cg_A3       &             streamice_cg_A3
384       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
385       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
386         &              grid_jacq_streamice(i,j,bi,bj,n) *
387       &              tau_beta_eff_streamice (i,j,bi,bj) * vq       &              tau_beta_eff_streamice (i,j,bi,bj) * vq
388                                
389  c  c
# Line 405  c Line 426  c
426       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
427       &              .25 *       &              .25 *
428       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
429       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
430       &             (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)*
431       &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
432    
# Line 415  c Line 436  c
436       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
437       &              .25 *       &              .25 *
438       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
439       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
440       &             (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)*
441       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
442    
# Line 423  c Line 444  c
444       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
445       &             streamice_cg_A2       &             streamice_cg_A2
446       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
447       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
448         &              grid_jacq_streamice(i,j,bi,bj,n) *
449       &              tau_beta_eff_streamice (i,j,bi,bj) * uq       &              tau_beta_eff_streamice (i,j,bi,bj) * uq
450    
451                     streamice_cg_A4                     streamice_cg_A4
452       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
453       &             streamice_cg_A4       &             streamice_cg_A4
454       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
455       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
456         &              grid_jacq_streamice(i,j,bi,bj,n) *
457       &              tau_beta_eff_streamice (i,j,bi,bj) * vq       &              tau_beta_eff_streamice (i,j,bi,bj) * vq
458                                        
459                    endif                    endif
# Line 448  c Line 471  c
471        enddo        enddo
472    
473  #endif  #endif
474    #endif
475        RETURN        RETURN
476        END SUBROUTINE        END SUBROUTINE
477    
# Line 504  C Phi_k is equal to 1 at vertex k, and 0 Line 528  C Phi_k is equal to 1 at vertex k, and 0
528  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
529  C     == Local variables ==  C     == Local variables ==
530        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
531        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
532        _RL Ucell (2,2)        _RL Ucell (2,2)
533        _RL Vcell (2,2)        _RL Vcell (2,2)
534        _RL Hcell (2,2)        _RL Hcell (2,2)
535          _RL phival(2,2)
536    
537          uret(1,1,1,1) = uret(1,1,1,1)
538          vret(1,1,1,1) = vret(1,1,1,1)
539    
540        DO j = 0, sNy+1        DO j = 0, sNy+1
541         DO i = 0, sNx+1         DO i = 0, sNx+1
# Line 523  C     == Local variables == Line 551  C     == Local variables ==
551               DO jnode = 1,2               DO jnode = 1,2
552                            
553               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)  
554    
555               ux = DPhi (i,j,bi,bj,m,n,1)               if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0 .or.
556               uy = DPhi (i,j,bi,bj,m,n,2)       &           STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0)
557               vx = 0         &           then
558               vy = 0  
559               uq = Xquad(ilq) * Xquad(jlq)                ilq = 1
560               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  
561                            
562               if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then                            if (inode.eq.iq) ilq = 2
563                                if (jnode.eq.jq) jlq = 2  
564                  phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
565    
566                  ux = DPhi (i,j,bi,bj,m,n,1)
567                  uy = DPhi (i,j,bi,bj,m,n,2)
568                  vx = 0  
569                  vy = 0
570                  uq = Xquad(ilq) * Xquad(jlq)
571                  vq = 0
572    
573                  exx = ux + k1AtC_str(i,j,bi,bj)*vq
574                  eyy = vy + k2AtC_str(i,j,bi,bj)*uq
575                  exy = .5*(uy+vx) +
576         &         k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
577    
578                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
579       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
580       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
# Line 554  C     == Local variables == Line 585  C     == Local variables ==
585                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
586       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
587       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
588       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
589       &         (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+
590       &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
591    
592                                
593                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
594       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
595       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
596       &         tau_beta_eff_streamice (i,j,bi,bj) * uq       &         tau_beta_eff_streamice (i,j,bi,bj) * uq
597                                
598    
# Line 586  C     == Local variables == Line 617  C     == Local variables ==
617                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
618       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
619       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
620       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
621       &         (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+
622       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
623    
624                                
625                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
626       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
627       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
628       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
629                                
630               endif               endif
631    
632              enddo              enddo
633              enddo              enddo
634             enddo             enddo
# Line 664  C Phi_k is equal to 1 at vertex k, and 0 Line 696  C Phi_k is equal to 1 at vertex k, and 0
696  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
697  C     == Local variables ==  C     == Local variables ==
698        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
699        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
700        _RL Ucell (2,2)        _RL Ucell (2,2)
701        _RL Vcell (2,2)        _RL Vcell (2,2)
702        _RL Hcell (2,2)        _RL Hcell (2,2)
703          _RL phival(2,2)
704    
705          uret(1,1,1,1) = uret(1,1,1,1)
706          vret(1,1,1,1) = vret(1,1,1,1)
707    
708        DO j = 0, sNy+1        DO j = 0, sNy+1
709         DO i = 0, sNx+1         DO i = 0, sNx+1
# Line 677  C     == Local variables == Line 713  C     == Local variables ==
713       &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.       &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.
714       &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.       &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.
715       &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.       &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.
716       &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0))) THEN       &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0) .OR.
717         &      (STREAMICE_vmask(i,j,bi,bj).eq.3.0) .OR.
718         &      (STREAMICE_vmask(i,j+1,bi,bj).eq.3.0) .OR.
719         &      (STREAMICE_vmask(i+1,j,bi,bj).eq.3.0) .OR.
720         &      (STREAMICE_vmask(i+1,j+1,bi,bj).eq.3.0))) THEN
721                        
722             DO iq=1,2             DO iq=1,2
723              DO jq = 1,2              DO jq = 1,2
# Line 696  C     == Local variables == Line 736  C     == Local variables ==
736       &       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) +
737       &       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) +
738       &       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)
739              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) +
740       &       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) +
741       &       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) +
742       &       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 744  C     == Local variables ==
744       &       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) +
745       &       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) +
746       &       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)
747              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) +
748       &       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) +
749       &       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) +
750       &       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 753  C     == Local variables ==
753              exy = .5*(uy+vx) +              exy = .5*(uy+vx) +
754       &       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
755    
756    
757              do inode = 1,2              do inode = 1,2
758               do jnode = 1,2               do jnode = 1,2
759    
760               m = 2*(jnode-1)+inode               m = 2*(jnode-1)+inode
761               ilq = 1               ilq = 1
762               ilq = 1               jlq = 1
763               if (inode.eq.iq) ilq = 2               if (inode.eq.iq) ilq = 2
764               if (jnode.eq.jq) jlq = 2                 if (jnode.eq.jq) jlq = 2  
765               phival = Xquad(ilq)*Xquad(jlq)               phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
766    
767                 if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then          
768    
              if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then              
769                                
770                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
771       &         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 773  C     == Local variables ==
773       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
774       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
775       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
776                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))  
777    
778                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
779       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
780       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
781       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
782       &         (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+
783       &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
784                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)  
785    
786  !               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then  !               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then
787                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
788       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
789       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
790       &         tau_beta_eff_streamice (i,j,bi,bj) * uq       &         tau_beta_eff_streamice (i,j,bi,bj) * uq
791    
792    
793    !               endif
794                 endif
795                 if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
796                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
797       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
798       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
799         &         visc_streamice(i,j,bi,bj) * (
800         &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
801         &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
802                  vret(i-1+inode,j-1+jnode,bi,bj) =
803         &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
804         &         grid_jacq_streamice(i,j,bi,bj,n) *
805         &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
806         &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
807         &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
808                  vret(i-1+inode,j-1+jnode,bi,bj) =
809         &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
810         &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
811       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
 !               endif  
812               endif               endif
813              enddo              enddo
814              enddo              enddo
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22