/[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.5 by dgoldberg, Sun Dec 23 21:05:08 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                                
# Line 125  C     == Local variables == Line 130  C     == Local variables ==
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                  uret(i-1+inode,j-1+jnode,bi,bj) =
134         &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
135         &         grid_jacq_streamice(i,j,bi,bj,n) *
136         &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
137         &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
138         &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
139                  uret(i-1+inode,j-1+jnode,bi,bj) =
140         &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
141         &         phival(inode,jnode) *
142         &         grid_jacq_streamice(i,j,bi,bj,n) *
143         &         tau_beta_eff_streamice (i,j,bi,bj) * uq
144    
145                 endif
146        
147                 if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
148                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
149       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
150       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
151       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
152       &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +       &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
153       &          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)      
154                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
155       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
156       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
157       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
158       &         (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+
159       &          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  
160                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
161       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
162       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) *
163         &         grid_jacq_streamice(i,j,bi,bj,n) *
164       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
165                                
166               endif               endif
167              enddo              enddo
168              enddo              enddo
169    
170             enddo                         enddo            
171             enddo             enddo
172    c-- STREAMICE_hmask
173            endif            endif
174    
175           enddo           enddo
176          enddo          enddo
177         enddo         enddo
# Line 200  C     is, ie, js, je - starting and endi Line 205  C     is, ie, js, je - starting and endi
205    
206  #ifdef ALLOW_STREAMICE  #ifdef ALLOW_STREAMICE
207    
208    #ifdef STREAMICE_CONSTRUCT_MATRIX
209    
210  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
211  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,
212  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 231  C     !LOCAL VARIABLES:
231  C     == Local variables ==  C     == Local variables ==
232        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
233        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
234        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
235          _RL phival(2,2)
236    
237  !       do i=1,3  !       do i=1,3
238  !        do j=0,2  !        do j=0,2
# Line 267  cc          ENDDO Line 275  cc          ENDDO
275                DO inody = 1,2                DO inody = 1,2
276    
277                 if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)                 if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)
278       &          .eq.1.0)       &          .eq.1.0 .or.
279         &             streamice_vmask(i-1+inodx,j-1+inody,bi,bj).eq.1.0)
280       &          then                   &          then            
281                            
282                  m_i = 2*(inody-1)+inodx                  m_i = 2*(inody-1)+inodx
# Line 276  cc          ENDDO Line 285  cc          ENDDO
285                            
286                  if (inodx.eq.iq) ilqx = 2                  if (inodx.eq.iq) ilqx = 2
287                  if (inody.eq.jq) ilqy = 2                    if (inody.eq.jq) ilqy = 2  
288                  phival = Xquad(ilqx)*Xquad(ilqy)                  phival(inodx,inody) = Xquad(ilqx)*Xquad(ilqy)
289    
290                  DO jnodx = 1,2                  DO jnodx = 1,2
291                   DO jnody = 1,2                   DO jnody = 1,2
292                    if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)                    if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)
293       &             .eq.1.0)       &             .eq.1.0 .or.
294         &             STREAMICE_vmask(i-1+jnodx,j-1+jnody,bi,bj).eq.1.0)
295       &             then                   &             then            
296    
297                     m_j = 2*(jnody-1)+jnodx                     m_j = 2*(jnody-1)+jnodx
# Line 337  c Line 347  c
347       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
348       &              .25 *       &              .25 *
349       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
350       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
351       &             (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)*
352       &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
353    
# Line 347  c Line 357  c
357       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
358       &              .25 *       &              .25 *
359       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
360       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
361       &             (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)*
362       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
363    
# Line 355  c Line 365  c
365       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
366       &             streamice_cg_A1       &             streamice_cg_A1
367       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
368       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
369         &              grid_jacq_streamice(i,j,bi,bj,n) *
370       &              tau_beta_eff_streamice (i,j,bi,bj) * uq       &              tau_beta_eff_streamice (i,j,bi,bj) * uq
371    
372                     streamice_cg_A3                     streamice_cg_A3
373       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
374       &             streamice_cg_A3       &             streamice_cg_A3
375       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
376       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
377         &              grid_jacq_streamice(i,j,bi,bj,n) *
378       &              tau_beta_eff_streamice (i,j,bi,bj) * vq       &              tau_beta_eff_streamice (i,j,bi,bj) * vq
379                                
380  c  c
# Line 405  c Line 417  c
417       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
418       &              .25 *       &              .25 *
419       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
420       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
421       &             (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)*
422       &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
423    
# Line 415  c Line 427  c
427       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
428       &              .25 *       &              .25 *
429       &              grid_jacq_streamice(i,j,bi,bj,n) *       &              grid_jacq_streamice(i,j,bi,bj,n) *
430       &              visc_streamice(i,j,bi,bj) * phival *       &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
431       &             (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)*
432       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
433    
# Line 423  c Line 435  c
435       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
436       &             streamice_cg_A2       &             streamice_cg_A2
437       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
438       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
439         &              grid_jacq_streamice(i,j,bi,bj,n) *
440       &              tau_beta_eff_streamice (i,j,bi,bj) * uq       &              tau_beta_eff_streamice (i,j,bi,bj) * uq
441    
442                     streamice_cg_A4                     streamice_cg_A4
443       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=                     &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)=              
444       &             streamice_cg_A4       &             streamice_cg_A4
445       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+       &                 (i-1+inodx,j-1+inody,bi,bj,col_x,col_y)+
446       &              .25*phival * grid_jacq_streamice(i,j,bi,bj,n) *       &              .25*phival(inodx,inody) *
447         &              grid_jacq_streamice(i,j,bi,bj,n) *
448       &              tau_beta_eff_streamice (i,j,bi,bj) * vq       &              tau_beta_eff_streamice (i,j,bi,bj) * vq
449                                        
450                    endif                    endif
# Line 448  c Line 462  c
462        enddo        enddo
463    
464  #endif  #endif
465    #endif
466        RETURN        RETURN
467        END SUBROUTINE        END SUBROUTINE
468    
# Line 504  C Phi_k is equal to 1 at vertex k, and 0 Line 519  C Phi_k is equal to 1 at vertex k, and 0
519  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
520  C     == Local variables ==  C     == Local variables ==
521        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
522        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
523        _RL Ucell (2,2)        _RL Ucell (2,2)
524        _RL Vcell (2,2)        _RL Vcell (2,2)
525        _RL Hcell (2,2)        _RL Hcell (2,2)
526          _RL phival(2,2)
527    
528          uret(1,1,1,1) = uret(1,1,1,1)
529          vret(1,1,1,1) = vret(1,1,1,1)
530    
531        DO j = 0, sNy+1        DO j = 0, sNy+1
532         DO i = 0, sNx+1         DO i = 0, sNx+1
# Line 523  C     == Local variables == Line 542  C     == Local variables ==
542               DO jnode = 1,2               DO jnode = 1,2
543                            
544               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)  
545    
546               ux = DPhi (i,j,bi,bj,m,n,1)               if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0 .or.
547               uy = DPhi (i,j,bi,bj,m,n,2)       &           STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0)
548               vx = 0         &           then
549               vy = 0  
550               uq = Xquad(ilq) * Xquad(jlq)                ilq = 1
551               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  
552                            
553               if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then                            if (inode.eq.iq) ilq = 2
554                                if (jnode.eq.jq) jlq = 2  
555                  phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
556    
557                  ux = DPhi (i,j,bi,bj,m,n,1)
558                  uy = DPhi (i,j,bi,bj,m,n,2)
559                  vx = 0  
560                  vy = 0
561                  uq = Xquad(ilq) * Xquad(jlq)
562                  vq = 0
563    
564                  exx = ux + k1AtC_str(i,j,bi,bj)*vq
565                  eyy = vy + k2AtC_str(i,j,bi,bj)*uq
566                  exy = .5*(uy+vx) +
567         &         k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
568    
569                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
570       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
571       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
# Line 554  C     == Local variables == Line 576  C     == Local variables ==
576                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
577       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
578       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
579       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
580       &         (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+
581       &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
582    
583                                
584                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
585       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
586       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
587       &         tau_beta_eff_streamice (i,j,bi,bj) * uq       &         tau_beta_eff_streamice (i,j,bi,bj) * uq
588                                
589    
# Line 586  C     == Local variables == Line 608  C     == Local variables ==
608                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
609       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
610       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
611       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
612       &         (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+
613       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)       &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
614    
615                                
616                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
617       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
618       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
619       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
620                                
621               endif               endif
622    
623              enddo              enddo
624              enddo              enddo
625             enddo             enddo
# Line 664  C Phi_k is equal to 1 at vertex k, and 0 Line 687  C Phi_k is equal to 1 at vertex k, and 0
687  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
688  C     == Local variables ==  C     == Local variables ==
689        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
690        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, phival        _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
691        _RL Ucell (2,2)        _RL Ucell (2,2)
692        _RL Vcell (2,2)        _RL Vcell (2,2)
693        _RL Hcell (2,2)        _RL Hcell (2,2)
694          _RL phival(2,2)
695    
696          uret(1,1,1,1) = uret(1,1,1,1)
697          vret(1,1,1,1) = vret(1,1,1,1)
698    
699        DO j = 0, sNy+1        DO j = 0, sNy+1
700         DO i = 0, sNx+1         DO i = 0, sNx+1
# Line 677  C     == Local variables == Line 704  C     == Local variables ==
704       &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.       &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.
705       &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.       &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.
706       &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.       &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.
707       &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0))) THEN       &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0) .OR.
708         &      (STREAMICE_vmask(i,j,bi,bj).eq.3.0) .OR.
709         &      (STREAMICE_vmask(i,j+1,bi,bj).eq.3.0) .OR.
710         &      (STREAMICE_vmask(i+1,j,bi,bj).eq.3.0) .OR.
711         &      (STREAMICE_vmask(i+1,j+1,bi,bj).eq.3.0))) THEN
712                        
713             DO iq=1,2             DO iq=1,2
714              DO jq = 1,2              DO jq = 1,2
# Line 713  C     == Local variables == Line 744  C     == Local variables ==
744              exy = .5*(uy+vx) +              exy = .5*(uy+vx) +
745       &       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
746    
747    
748              do inode = 1,2              do inode = 1,2
749               do jnode = 1,2               do jnode = 1,2
750    
751               m = 2*(jnode-1)+inode               m = 2*(jnode-1)+inode
752               ilq = 1               ilq = 1
753               ilq = 1               jlq = 1
754               if (inode.eq.iq) ilq = 2               if (inode.eq.iq) ilq = 2
755               if (jnode.eq.jq) jlq = 2                 if (jnode.eq.jq) jlq = 2  
756               phival = Xquad(ilq)*Xquad(jlq)               phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
757    
758               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            
759                                
# Line 731  C     == Local variables == Line 763  C     == Local variables ==
763       &         visc_streamice(i,j,bi,bj) * (       &         visc_streamice(i,j,bi,bj) * (
764       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +       &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
765       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))       &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
766                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))  
767    
768                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
769       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
770       &         grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
771       &         visc_streamice(i,j,bi,bj) * phival *       &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
772       &         (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+
773       &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)           &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)    
774                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)  
775    
776  !               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then  !               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then
777                uret(i-1+inode,j-1+jnode,bi,bj) =                uret(i-1+inode,j-1+jnode,bi,bj) =
778       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
779       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
780       &         tau_beta_eff_streamice (i,j,bi,bj) * uq       &         tau_beta_eff_streamice (i,j,bi,bj) * uq
781    
782    !               endif
783                 endif
784                 if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
785                vret(i-1+inode,j-1+jnode,bi,bj) =                vret(i-1+inode,j-1+jnode,bi,bj) =
786       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *       &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
787       &         phival * grid_jacq_streamice(i,j,bi,bj,n) *       &         grid_jacq_streamice(i,j,bi,bj,n) *
788         &         visc_streamice(i,j,bi,bj) * (
789         &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
790         &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
791                  vret(i-1+inode,j-1+jnode,bi,bj) =
792         &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
793         &         grid_jacq_streamice(i,j,bi,bj,n) *
794         &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
795         &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
796         &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
797                  vret(i-1+inode,j-1+jnode,bi,bj) =
798         &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
799         &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
800       &         tau_beta_eff_streamice (i,j,bi,bj) * vq       &         tau_beta_eff_streamice (i,j,bi,bj) * vq
 !               endif  
801               endif               endif
802              enddo              enddo
803              enddo              enddo
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22