Back to home page

MITgcm
 
 

    

File indexing completed on 2023-09-21 05:10:48 UTC

view on githubraw file Latest commit 96b00645 on 2023-09-20 15:15:14 UTC
5ca83cd8f7 Dani*0001 #include "STREAMICE_OPTIONS.h"
                0002 
96b006450c dngo*0003 C--   File streamice_cg_functions.F:
                0004 C--    Contents:
                0005 C--    o STREAMICE_CG_ACTION
                0006 C--    o STREAMICE_CG_MAKE_A
                0007 C--    o STREAMICE_CG_ADIAG
                0008 C--    o STREAMICE_CG_BOUND_VALS
                0009 
5ca83cd8f7 Dani*0010 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0011 
                0012 CBOP
96b006450c dngo*0013       SUBROUTINE STREAMICE_CG_ACTION( myThid,
                0014      O    uret,
                0015      O    vret,
                0016      I    u,
                0017      I    v,
5ca83cd8f7 Dani*0018      I    is, ie, js, je )
                0019 C     /============================================================\
96b006450c dngo*0020 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0021 C     | o                                                          |
                0022 C     |============================================================|
                0023 C     |                                                            |
                0024 C     \============================================================/
                0025       IMPLICIT NONE
                0026 
                0027 C     === Global variables ===
                0028 #include "SIZE.h"
                0029 #include "EEPARAMS.h"
                0030 #include "PARAMS.h"
                0031 #include "GRID.h"
96b006450c dngo*0032 #include "STREAMICE.h"
                0033 #include "STREAMICE_CG.h"
5ca83cd8f7 Dani*0034 
                0035 C     !INPUT/OUTPUT ARGUMENTS
                0036 C     uret, vret - result of matrix operating on u, v
                0037 C     is, ie, js, je - starting and ending cells
                0038       INTEGER myThid
                0039       _RL uret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0040       _RL vret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0041       _RL u (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0042       _RL v (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0043       INTEGER is, ie, js, je
                0044 
                0045 #ifdef ALLOW_STREAMICE
                0046 
                0047 C the linear action of the matrix on (u,v) with triangular finite elements
                0048 C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
                0049 C but this may change pursuant to conversations with others
                0050 C
                0051 C is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
                0052 C     in order to make less frequent halo updates
                0053 C isym = 1 if grid is symmetric, 0 o.w.
                0054 
                0055 C the linear action of the matrix on (u,v) with triangular finite elements
                0056 C Phi has the form
                0057 C Phi (i,j,k,q) - applies to cell i,j
                0058 
                0059 C      3 - 4
                0060 C      |   |
                0061 C      1 - 2
                0062 
96b006450c dngo*0063 C Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q
5ca83cd8f7 Dani*0064 C Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q
                0065 C Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear
                0066 
                0067 C     !LOCAL VARIABLES:
96b006450c dngo*0068 C     == Local variables ==
5ca83cd8f7 Dani*0069       INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n,Gi,Gj
                0070       _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
                0071       _RL phival(2,2)
                0072 
                0073       uret(1,1,1,1) = uret(1,1,1,1)
                0074       vret(1,1,1,1) = vret(1,1,1,1)
                0075 
                0076       DO j = js, je
                0077        DO i = is, ie
                0078         DO bj = myByLo(myThid), myByHi(myThid)
                0079          DO bi = myBxLo(myThid), myBxHi(myThid)
                0080 
                0081          Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
                0082          Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
                0083 
                0084           IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN
96b006450c dngo*0085            DO iq = 1,2
5ca83cd8f7 Dani*0086             DO jq = 1,2
                0087 
                0088             n = 2*(jq-1)+iq
                0089 
96b006450c dngo*0090             uq = u(i,j,bi,bj) * Xquad(3-iq) * Xquad(3-jq) +
                0091      &       u(i+1,j,bi,bj) * Xquad(iq) * Xquad(3-jq) +
                0092      &       u(i,j+1,bi,bj) * Xquad(3-iq) * Xquad(jq) +
5ca83cd8f7 Dani*0093      &       u(i+1,j+1,bi,bj) * Xquad(iq) * Xquad(jq)
96b006450c dngo*0094             vq = v(i,j,bi,bj) * Xquad(3-iq) * Xquad(3-jq) +
                0095      &       v(i+1,j,bi,bj) * Xquad(iq) * Xquad(3-jq) +
                0096      &       v(i,j+1,bi,bj) * Xquad(3-iq) * Xquad(jq) +
5ca83cd8f7 Dani*0097      &       v(i+1,j+1,bi,bj) * Xquad(iq) * Xquad(jq)
96b006450c dngo*0098             ux = u(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +
                0099      &       u(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
                0100      &       u(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
5ca83cd8f7 Dani*0101      &       u(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
96b006450c dngo*0102             uy = u(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
                0103      &       u(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
                0104      &       u(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
5ca83cd8f7 Dani*0105      &       u(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
96b006450c dngo*0106             vx = v(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +
                0107      &       v(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
                0108      &       v(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
5ca83cd8f7 Dani*0109      &       v(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
96b006450c dngo*0110             vy = v(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
                0111      &       v(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
                0112      &       v(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
5ca83cd8f7 Dani*0113      &       v(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
                0114             exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0115             eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0116             exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0117      &       k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0118 
96b006450c dngo*0119             do inode = 1,2
5ca83cd8f7 Dani*0120              do jnode = 1,2
                0121 
                0122              m = 2*(jnode-1)+inode
96b006450c dngo*0123              ilq = 1
5ca83cd8f7 Dani*0124              jlq = 1
                0125              if (inode.eq.iq) ilq = 2
96b006450c dngo*0126              if (jnode.eq.jq) jlq = 2
5ca83cd8f7 Dani*0127              phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
                0128 
96b006450c dngo*0129              if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
5ca83cd8f7 Dani*0130 
96b006450c dngo*0131               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0132      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0133      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0134      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0135      &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0136      &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
                0137 
96b006450c dngo*0138               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0139      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0140      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0141      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0142      &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
                0143      &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
                0144 
96b006450c dngo*0145               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0146      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0147      &         phival(inode,jnode) *
                0148      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0149      &         tau_beta_eff_streamice (i,j,bi,bj) * uq
                0150 
                0151              endif
96b006450c dngo*0152 
5ca83cd8f7 Dani*0153              if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
96b006450c dngo*0154               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0155      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0156      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0157      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0158      &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0159      &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
96b006450c dngo*0160               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0161      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0162      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0163      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0164      &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
                0165      &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
96b006450c dngo*0166               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0167      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0168      &         phival(inode,jnode) *
                0169      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0170      &         tau_beta_eff_streamice (i,j,bi,bj) * vq
96b006450c dngo*0171 
5ca83cd8f7 Dani*0172              endif
96b006450c dngo*0173             enddo
5ca83cd8f7 Dani*0174             enddo
                0175 
96b006450c dngo*0176            enddo
5ca83cd8f7 Dani*0177            enddo
                0178 c-- STREAMICE_hmask
                0179           endif
                0180 
                0181          enddo
                0182         enddo
                0183        enddo
                0184       enddo
                0185 
                0186 #endif
                0187       RETURN
                0188       END SUBROUTINE
                0189 
                0190       SUBROUTINE STREAMICE_CG_MAKE_A( myThid )
                0191 C     /============================================================\
96b006450c dngo*0192 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0193 C     | o                                                          |
                0194 C     |============================================================|
                0195 C     |                                                            |
                0196 C     \============================================================/
                0197       IMPLICIT NONE
                0198 
                0199 C     === Global variables ===
                0200 #include "SIZE.h"
                0201 #include "EEPARAMS.h"
                0202 #include "PARAMS.h"
                0203 #include "GRID.h"
96b006450c dngo*0204 #include "STREAMICE.h"
                0205 #include "STREAMICE_CG.h"
5ca83cd8f7 Dani*0206 
                0207 C     !INPUT/OUTPUT ARGUMENTS
                0208 C     uret, vret - result of matrix operating on u, v
                0209 C     is, ie, js, je - starting and ending cells
                0210       INTEGER myThid
                0211 
                0212 #ifdef ALLOW_STREAMICE
                0213 
                0214 #ifdef STREAMICE_CONSTRUCT_MATRIX
                0215 
                0216 C the linear action of the matrix on (u,v) with triangular finite elements
                0217 C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
                0218 C but this may change pursuant to conversations with others
                0219 C
                0220 C is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
                0221 C     in order to make less frequent halo updates
                0222 C isym = 1 if grid is symmetric, 0 o.w.
                0223 
                0224 C the linear action of the matrix on (u,v) with triangular finite elements
                0225 C Phi has the form
                0226 C Phi (i,j,k,q) - applies to cell i,j
                0227 
                0228 C      3 - 4
                0229 C      |   |
                0230 C      1 - 2
                0231 
96b006450c dngo*0232 C Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q
5ca83cd8f7 Dani*0233 C Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q
                0234 C Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear
                0235 
                0236 C     !LOCAL VARIABLES:
96b006450c dngo*0237 C     == Local variables ==
5ca83cd8f7 Dani*0238       INTEGER iq, jq, inodx, inody, i, j, bi, bj, ilqx, ilqy, m_i, n
96b006450c dngo*0239       INTEGER jnodx,jnody, m_j, col_y, col_x, cg_halo
ddf49ceb53 Dani*0240       INTEGER colx_rev, coly_rev
                0241       _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy, tmpval
5ca83cd8f7 Dani*0242       _RL phival(2,2)
                0243 
96b006450c dngo*0244 c       do i=1,3
                0245 c        do j=0,2
                0246 c         col_index_a = i + j*3
                0247 c        enddo
                0248 c       enddo
5ca83cd8f7 Dani*0249 
                0250       cg_halo = min(OLx-1,OLy-1)
                0251 
                0252       DO j = 1-cg_halo, sNy+cg_halo
                0253        DO i = 1-cg_halo, sNx+cg_halo
                0254         DO bj = myByLo(myThid), myByHi(myThid)
                0255          DO bi = myBxLo(myThid), myBxHi(myThid)
                0256 cc          DO k=1,4
                0257            DO col_x=-1,1
                0258             DO col_y=-1,1
                0259              streamice_cg_A1(i,j,bi,bj,col_x,col_y)=0.0
                0260              streamice_cg_A2(i,j,bi,bj,col_x,col_y)=0.0
                0261              streamice_cg_A3(i,j,bi,bj,col_x,col_y)=0.0
                0262              streamice_cg_A4(i,j,bi,bj,col_x,col_y)=0.0
                0263             ENDDO
                0264            ENDDO
                0265 cc          ENDDO
                0266          ENDDO
                0267         ENDDO
                0268        ENDDO
                0269       ENDDO
                0270 
28bae0294d Dani*0271 c$openad xxx simple loop
5ca83cd8f7 Dani*0272       DO j = 1-cg_halo, sNy+cg_halo
                0273        DO i = 1-cg_halo, sNx+cg_halo
                0274         DO bj = myByLo(myThid), myByHi(myThid)
                0275          DO bi = myBxLo(myThid), myBxHi(myThid)
                0276           IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN
96b006450c dngo*0277            DO iq=1,2
5ca83cd8f7 Dani*0278             DO jq = 1,2
96b006450c dngo*0279 
5ca83cd8f7 Dani*0280              n = 2*(jq-1)+iq
96b006450c dngo*0281 
                0282              DO inodx = 1,2
5ca83cd8f7 Dani*0283               DO inody = 1,2
                0284 
                0285                if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)
96b006450c dngo*0286      &          .eq.1.0 .or.
5ca83cd8f7 Dani*0287      &             streamice_vmask(i-1+inodx,j-1+inody,bi,bj).eq.1.0)
96b006450c dngo*0288      &          then
                0289 
5ca83cd8f7 Dani*0290                 m_i = 2*(inody-1)+inodx
96b006450c dngo*0291                 ilqx = 1
5ca83cd8f7 Dani*0292                 ilqy = 1
96b006450c dngo*0293 
5ca83cd8f7 Dani*0294                 if (inodx.eq.iq) ilqx = 2
96b006450c dngo*0295                 if (inody.eq.jq) ilqy = 2
5ca83cd8f7 Dani*0296                 phival(inodx,inody) = Xquad(ilqx)*Xquad(ilqy)
                0297 
                0298                 DO jnodx = 1,2
96b006450c dngo*0299                  DO jnody = 1,2
5ca83cd8f7 Dani*0300                   if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)
                0301      &             .eq.1.0 .or.
96b006450c dngo*0302      &             STREAMICE_vmask(i-1+jnodx,j-1+jnody,bi,bj).eq.1.0)
                0303      &             then
5ca83cd8f7 Dani*0304 
                0305                    m_j = 2*(jnody-1)+jnodx
96b006450c dngo*0306                    ilqx = 1
5ca83cd8f7 Dani*0307                    ilqy = 1
                0308                    if (jnodx.eq.iq) ilqx = 2
96b006450c dngo*0309                    if (jnody.eq.jq) ilqy = 2
5ca83cd8f7 Dani*0310 
96b006450c dngo*0311 c                    col_j = col_index_a (
                0312 c      &              jnodx+mod(inodx,2),
                0313 c      &              jnody+mod(inody,2) )
5ca83cd8f7 Dani*0314 
                0315                    col_x = mod(inodx,2)+jnodx-2
ddf49ceb53 Dani*0316                    colx_rev = mod(jnodx,2)+inodx-2
5ca83cd8f7 Dani*0317                    col_y = mod(inody,2)+jnody-2
ddf49ceb53 Dani*0318                    coly_rev = mod(jnody,2)+inody-2
5ca83cd8f7 Dani*0319 c
                0320 
ddf49ceb53 Dani*0321                    IF ( (inodx.eq.jnodx .and. inody.eq.jnody) .or.
                0322      &                  (inodx.eq.1 .and. inody.eq.1) .or.
                0323      &                  (jnody.eq.2 .and. inody.eq.1) .or.
                0324      &                  (jnody.eq.2 .and. jnodx.eq.2)) THEN
                0325 
5ca83cd8f7 Dani*0326                    ux = DPhi (i,j,bi,bj,m_j,n,1)
                0327                    uy = DPhi (i,j,bi,bj,m_j,n,2)
96b006450c dngo*0328                    vx = 0
5ca83cd8f7 Dani*0329                    vy = 0
96b006450c dngo*0330                    uq = Xquad(ilqx) * Xquad(ilqy)
5ca83cd8f7 Dani*0331                    vq = 0
                0332 
                0333                    exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0334                    eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0335                    exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0336      &              k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
96b006450c dngo*0337 
ddf49ceb53 Dani*0338                     tmpval = .25 *
96b006450c dngo*0339      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0340      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0341      &              DPhi(i,j,bi,bj,m_i,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0342      &              DPhi(i,j,bi,bj,m_i,n,2)*(2*exy))
                0343 
ddf49ceb53 Dani*0344                    streamice_cg_A1
28bae0294d Dani*0345      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0346      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0347      &             streamice_cg_A1
28bae0294d Dani*0348      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0349      &                  mod(inody,2)+jnody-2)+tmpval
ddf49ceb53 Dani*0350 
                0351                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0352                     streamice_cg_A1
28bae0294d Dani*0353      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0354      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0355      &              streamice_cg_A1
28bae0294d Dani*0356      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0357      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0358      &               tmpval
                0359                    ENDIF
                0360 
96b006450c dngo*0361 c!!
ddf49ceb53 Dani*0362 
                0363                     tmpval = .25 *
96b006450c dngo*0364      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0365      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0366      &              DPhi(i,j,bi,bj,m_i,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0367      &              DPhi(i,j,bi,bj,m_i,n,1)*(2*exy))
                0368 
ddf49ceb53 Dani*0369                    streamice_cg_A3
28bae0294d Dani*0370      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0371      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0372      &             streamice_cg_A3
28bae0294d Dani*0373      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0374      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0375 
                0376                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
ddf49ceb53 Dani*0377                     streamice_cg_A2
28bae0294d Dani*0378      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0379      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0380      &              streamice_cg_A2
28bae0294d Dani*0381      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0382      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0383      &               tmpval
                0384                    ENDIF
                0385 
96b006450c dngo*0386 c!!
ddf49ceb53 Dani*0387 
                0388                     tmpval = .25 *
96b006450c dngo*0389      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0390      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0391      &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*
96b006450c dngo*0392      &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0393 
ddf49ceb53 Dani*0394                    streamice_cg_A1
28bae0294d Dani*0395      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0396      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0397      &             streamice_cg_A1
28bae0294d Dani*0398      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0399      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0400 
ddf49ceb53 Dani*0401                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0402                     streamice_cg_A1
28bae0294d Dani*0403      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0404      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0405      &              streamice_cg_A1
28bae0294d Dani*0406      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0407      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0408      &               tmpval
                0409                    ENDIF
                0410 
96b006450c dngo*0411 c!!
ddf49ceb53 Dani*0412 
96b006450c dngo*0413                    tmpval = .25 *
                0414      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0415      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0416      &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*
                0417      &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
                0418 
ddf49ceb53 Dani*0419                    streamice_cg_A3
28bae0294d Dani*0420      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0421      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0422      &             streamice_cg_A3
28bae0294d Dani*0423      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0424      &                  mod(inody,2)+jnody-2)+tmpval
ddf49ceb53 Dani*0425 
                0426                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0427                     streamice_cg_A2
28bae0294d Dani*0428      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0429      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0430      &              streamice_cg_A2
28bae0294d Dani*0431      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0432      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0433      &               tmpval
                0434                    ENDIF
                0435 
96b006450c dngo*0436 c!!
ddf49ceb53 Dani*0437 
96b006450c dngo*0438                     tmpval = .25*phival(inodx,inody) *
                0439      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0440      &              tau_beta_eff_streamice (i,j,bi,bj) * uq
                0441 
5ca83cd8f7 Dani*0442                    streamice_cg_A1
28bae0294d Dani*0443      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0444      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0445      &             streamice_cg_A1
28bae0294d Dani*0446      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0447      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0448 
ddf49ceb53 Dani*0449                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0450                     streamice_cg_A1
28bae0294d Dani*0451      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0452      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0453      &              streamice_cg_A1
28bae0294d Dani*0454      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0455      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0456      &               tmpval
                0457                    ENDIF
                0458 
96b006450c dngo*0459 c!!
                0460                     tmpval = .25*phival(inodx,inody) *
                0461      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0462      &              tau_beta_eff_streamice (i,j,bi,bj) * vq
5ca83cd8f7 Dani*0463 
                0464                    streamice_cg_A3
28bae0294d Dani*0465      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0466      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0467      &             streamice_cg_A3
28bae0294d Dani*0468      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0469      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0470 
                0471                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
ddf49ceb53 Dani*0472                     streamice_cg_A2
28bae0294d Dani*0473      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0474      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0475      &              streamice_cg_A2
28bae0294d Dani*0476      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0477      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0478      &               tmpval
                0479                    ENDIF
                0480 
96b006450c dngo*0481 c!!
5ca83cd8f7 Dani*0482 
                0483                    vx = DPhi (i,j,bi,bj,m_j,n,1)
                0484                    vy = DPhi (i,j,bi,bj,m_j,n,2)
96b006450c dngo*0485                    ux = 0
5ca83cd8f7 Dani*0486                    uy = 0
96b006450c dngo*0487                    vq = Xquad(ilqx) * Xquad(ilqy)
5ca83cd8f7 Dani*0488                    uq = 0
                0489 
                0490                    exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0491                    eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0492                    exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0493      &              k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0494 
ddf49ceb53 Dani*0495                     tmpval = .25 *
96b006450c dngo*0496      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0497      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0498      &              DPhi(i,j,bi,bj,m_i,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0499      &              DPhi(i,j,bi,bj,m_i,n,2)*(2*exy))
                0500 
ddf49ceb53 Dani*0501                    streamice_cg_A2
28bae0294d Dani*0502      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0503      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0504      &             streamice_cg_A2
28bae0294d Dani*0505      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0506      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0507 
ddf49ceb53 Dani*0508                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0509                     streamice_cg_A3
28bae0294d Dani*0510      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0511      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0512      &              streamice_cg_A3
28bae0294d Dani*0513      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0514      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0515      &               tmpval
                0516                    ENDIF
                0517 
                0518                     tmpval = .25 *
96b006450c dngo*0519      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0520      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0521      &              DPhi(i,j,bi,bj,m_i,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0522      &              DPhi(i,j,bi,bj,m_i,n,1)*(2*exy))
                0523 
ddf49ceb53 Dani*0524                    streamice_cg_A4
28bae0294d Dani*0525      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0526      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0527      &             streamice_cg_A4
28bae0294d Dani*0528      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0529      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0530 
ddf49ceb53 Dani*0531                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0532                     streamice_cg_A4
28bae0294d Dani*0533      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0534      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0535      &              streamice_cg_A4
28bae0294d Dani*0536      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0537      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0538      &               tmpval
                0539                    ENDIF
                0540 
                0541                    tmpval = .25 *
96b006450c dngo*0542      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0543      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0544      &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*
96b006450c dngo*0545      &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0546 
ddf49ceb53 Dani*0547                    streamice_cg_A2
28bae0294d Dani*0548      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0549      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0550      &             streamice_cg_A2
28bae0294d Dani*0551      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0552      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0553 
ddf49ceb53 Dani*0554                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0555                     streamice_cg_A3
28bae0294d Dani*0556      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0557      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0558      &              streamice_cg_A3
28bae0294d Dani*0559      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0560      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0561      &               tmpval
                0562                    ENDIF
                0563 
96b006450c dngo*0564                    tmpval = .25 *
                0565      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0566      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0567      &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*
                0568      &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
                0569 
ddf49ceb53 Dani*0570                    streamice_cg_A4
28bae0294d Dani*0571      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0572      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0573      &             streamice_cg_A4
28bae0294d Dani*0574      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0575      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0576 
ddf49ceb53 Dani*0577                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0578                     streamice_cg_A4
28bae0294d Dani*0579      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0580      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0581      &              streamice_cg_A4
28bae0294d Dani*0582      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0583      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0584      &               tmpval
                0585                    ENDIF
                0586 
96b006450c dngo*0587                     tmpval = .25*phival(inodx,inody) *
                0588      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0589      &              tau_beta_eff_streamice (i,j,bi,bj) * uq
                0590 
5ca83cd8f7 Dani*0591                    streamice_cg_A2
28bae0294d Dani*0592      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0593      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0594      &             streamice_cg_A2
28bae0294d Dani*0595      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0596      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0597 
ddf49ceb53 Dani*0598                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0599                     streamice_cg_A3
28bae0294d Dani*0600      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0601      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0602      &              streamice_cg_A3
28bae0294d Dani*0603      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0604      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0605      &               tmpval
                0606                    ENDIF
                0607 
96b006450c dngo*0608                     tmpval = .25*phival(inodx,inody) *
                0609      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0610      &              tau_beta_eff_streamice (i,j,bi,bj) * vq
5ca83cd8f7 Dani*0611 
                0612                    streamice_cg_A4
28bae0294d Dani*0613      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0614      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0615      &             streamice_cg_A4
28bae0294d Dani*0616      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0617      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0618 
ddf49ceb53 Dani*0619                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0620                     streamice_cg_A4
28bae0294d Dani*0621      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0622      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0623      &              streamice_cg_A4
28bae0294d Dani*0624      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0625      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0626      &               tmpval
                0627                    ENDIF
                0628 
                0629                    endif
96b006450c dngo*0630                   endif
5ca83cd8f7 Dani*0631                  enddo
                0632                 enddo
                0633                endif
                0634               enddo
                0635              enddo
                0636             enddo
                0637            enddo
                0638           endif
                0639          enddo
                0640         enddo
                0641        enddo
                0642       enddo
                0643 
                0644 #endif
                0645 #endif
                0646       RETURN
                0647       END SUBROUTINE
96b006450c dngo*0648 c END MAKE_A
5ca83cd8f7 Dani*0649 
96b006450c dngo*0650       SUBROUTINE STREAMICE_CG_ADIAG( myThid,
                0651      O      uret,
5ca83cd8f7 Dani*0652      O      vret)
96b006450c dngo*0653 
5ca83cd8f7 Dani*0654 C     /============================================================\
96b006450c dngo*0655 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0656 C     | o                                                          |
                0657 C     |============================================================|
                0658 C     |                                                            |
                0659 C     \============================================================/
                0660       IMPLICIT NONE
                0661 
                0662 C     === Global variables ===
                0663 #include "SIZE.h"
                0664 #include "EEPARAMS.h"
                0665 #include "PARAMS.h"
                0666 #include "GRID.h"
                0667 #include "STREAMICE.h"
96b006450c dngo*0668 #include "STREAMICE_CG.h"
5ca83cd8f7 Dani*0669 
                0670 C     !INPUT/OUTPUT ARGUMENTS
                0671 C     uret, vret - result of matrix operating on u, v
                0672 C     is, ie, js, je - starting and ending cells
                0673       INTEGER myThid
                0674       _RL uret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0675       _RL vret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0676 
                0677 #ifdef ALLOW_STREAMICE
                0678 
                0679 C the linear action of the matrix on (u,v) with triangular finite elements
                0680 C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
                0681 C but this may change pursuant to conversations with others
                0682 C
                0683 C is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
                0684 C     in order to make less frequent halo updates
                0685 C isym = 1 if grid is symmetric, 0 o.w.
                0686 
                0687 C the linear action of the matrix on (u,v) with triangular finite elements
                0688 C Phi has the form
                0689 C Phi (i,j,k,q) - applies to cell i,j
                0690 
                0691 C      3 - 4
                0692 C      |   |
                0693 C      1 - 2
                0694 
96b006450c dngo*0695 C Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q
5ca83cd8f7 Dani*0696 C Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q
                0697 C Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear
                0698 
                0699 C     !LOCAL VARIABLES:
96b006450c dngo*0700 C     == Local variables ==
5ca83cd8f7 Dani*0701       INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n
                0702       _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
                0703       _RL phival(2,2)
                0704 
                0705       uret(1,1,1,1) = uret(1,1,1,1)
                0706       vret(1,1,1,1) = vret(1,1,1,1)
                0707 
                0708       DO j = 0, sNy+1
                0709        DO i = 0, sNx+1
                0710         DO bj = myByLo(myThid), myByHi(myThid)
                0711          DO bi = myBxLo(myThid), myBxHi(myThid)
                0712           IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN
96b006450c dngo*0713            DO iq=1,2
5ca83cd8f7 Dani*0714             DO jq = 1,2
96b006450c dngo*0715 
5ca83cd8f7 Dani*0716             n = 2*(jq-1)+iq
96b006450c dngo*0717 
                0718             DO inode = 1,2
5ca83cd8f7 Dani*0719              DO jnode = 1,2
96b006450c dngo*0720 
5ca83cd8f7 Dani*0721              m = 2*(jnode-1)+inode
                0722 
                0723              if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0 .or.
96b006450c dngo*0724      &           STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0)
5ca83cd8f7 Dani*0725      &           then
                0726 
96b006450c dngo*0727               ilq = 1
5ca83cd8f7 Dani*0728               jlq = 1
96b006450c dngo*0729 
5ca83cd8f7 Dani*0730               if (inode.eq.iq) ilq = 2
96b006450c dngo*0731               if (jnode.eq.jq) jlq = 2
5ca83cd8f7 Dani*0732               phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
                0733 
                0734               ux = DPhi (i,j,bi,bj,m,n,1)
                0735               uy = DPhi (i,j,bi,bj,m,n,2)
96b006450c dngo*0736               vx = 0
5ca83cd8f7 Dani*0737               vy = 0
96b006450c dngo*0738               uq = Xquad(ilq) * Xquad(jlq)
5ca83cd8f7 Dani*0739               vq = 0
                0740 
                0741               exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0742               eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0743               exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0744      &         k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0745 
96b006450c dngo*0746               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0747      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0748      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0749      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0750      &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0751      &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
                0752 
96b006450c dngo*0753               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0754      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0755      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0756      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0757      &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
96b006450c dngo*0758      &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0759 
96b006450c dngo*0760               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0761      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0762      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0763      &         tau_beta_eff_streamice (i,j,bi,bj) * uq
                0764 
                0765               vx = DPhi (i,j,bi,bj,m,n,1)
                0766               vy = DPhi (i,j,bi,bj,m,n,2)
96b006450c dngo*0767               ux = 0
5ca83cd8f7 Dani*0768               uy = 0
96b006450c dngo*0769               vq = Xquad(ilq) * Xquad(jlq)
5ca83cd8f7 Dani*0770               uq = 0
                0771 
                0772               exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0773               eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0774               exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0775      &         k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0776 
96b006450c dngo*0777               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0778      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0779      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0780      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0781      &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0782      &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
96b006450c dngo*0783               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0784      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0785      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0786      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0787      &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
                0788      &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
                0789 
96b006450c dngo*0790               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0791      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0792      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0793      &         tau_beta_eff_streamice (i,j,bi,bj) * vq
96b006450c dngo*0794 
5ca83cd8f7 Dani*0795              endif
                0796 
                0797             enddo
96b006450c dngo*0798             enddo
                0799            enddo
5ca83cd8f7 Dani*0800            enddo
                0801           endif
                0802          enddo
                0803         enddo
                0804        enddo
                0805       enddo
                0806 
                0807 #endif
                0808       RETURN
                0809       END SUBROUTINE
                0810 
96b006450c dngo*0811       SUBROUTINE STREAMICE_CG_BOUND_VALS( myThid,
                0812      O    uret,
5ca83cd8f7 Dani*0813      O    vret)
                0814 C     /============================================================\
96b006450c dngo*0815 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0816 C     | o                                                          |
                0817 C     |============================================================|
                0818 C     |                                                            |
                0819 C     \============================================================/
                0820       IMPLICIT NONE
                0821 
                0822 C     === Global variables ===
                0823 #include "SIZE.h"
                0824 #include "EEPARAMS.h"
                0825 #include "PARAMS.h"
                0826 #include "GRID.h"
96b006450c dngo*0827 #include "STREAMICE.h"
5ca83cd8f7 Dani*0828 #include "STREAMICE_CG.h"
                0829 
                0830 C     !INPUT/OUTPUT ARGUMENTS
                0831 C     uret, vret - result of matrix operating on u, v
                0832 C     is, ie, js, je - starting and ending cells
                0833       INTEGER myThid
                0834       _RL uret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0835       _RL vret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
96b006450c dngo*0836 
5ca83cd8f7 Dani*0837 #ifdef ALLOW_STREAMICE
                0838 
                0839 C the linear action of the matrix on (u,v) with triangular finite elements
                0840 C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
                0841 C but this may change pursuant to conversations with others
                0842 C
                0843 C is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
                0844 C     in order to make less frequent halo updates
                0845 C isym = 1 if grid is symmetric, 0 o.w.
                0846 
                0847 C the linear action of the matrix on (u,v) with triangular finite elements
                0848 C Phi has the form
                0849 C Phi (i,j,k,q) - applies to cell i,j
                0850 
                0851 C      3 - 4
                0852 C      |   |
                0853 C      1 - 2
                0854 
96b006450c dngo*0855 C Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q
5ca83cd8f7 Dani*0856 C Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q
                0857 C Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear
                0858 
                0859 C     !LOCAL VARIABLES:
96b006450c dngo*0860 C     == Local variables ==
5ca83cd8f7 Dani*0861       INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n
                0862       _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
                0863       _RL phival(2,2)
                0864 
                0865       uret(1,1,1,1) = uret(1,1,1,1)
                0866       vret(1,1,1,1) = vret(1,1,1,1)
                0867 
                0868       DO j = 0, sNy+1
                0869        DO i = 0, sNx+1
                0870         DO bj = myByLo(myThid), myByHi(myThid)
                0871          DO bi = myBxLo(myThid), myBxHi(myThid)
                0872           IF ((STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) .AND.
                0873      &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.
                0874      &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.
                0875      &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.
                0876      &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0) .OR.
                0877      &      (STREAMICE_vmask(i,j,bi,bj).eq.3.0) .OR.
                0878      &      (STREAMICE_vmask(i,j+1,bi,bj).eq.3.0) .OR.
                0879      &      (STREAMICE_vmask(i+1,j,bi,bj).eq.3.0) .OR.
                0880      &      (STREAMICE_vmask(i+1,j+1,bi,bj).eq.3.0))) THEN
96b006450c dngo*0881 
                0882            DO iq=1,2
5ca83cd8f7 Dani*0883             DO jq = 1,2
                0884 
                0885             n = 2*(jq-1)+iq
                0886 
96b006450c dngo*0887             uq = u_bdry_values_SI(i,j,bi,bj)*Xquad(3-iq)*Xquad(3-jq)+
                0888      &       u_bdry_values_SI(i+1,j,bi,bj)*Xquad(iq)*Xquad(3-jq)+
                0889      &       u_bdry_values_SI(i,j+1,bi,bj)*Xquad(3-iq)*Xquad(jq)+
5ca83cd8f7 Dani*0890      &       u_bdry_values_SI(i+1,j+1,bi,bj)*Xquad(iq)*Xquad(jq)
96b006450c dngo*0891             vq = v_bdry_values_SI(i,j,bi,bj)*Xquad(3-iq)*Xquad(3-jq)+
                0892      &       v_bdry_values_SI(i+1,j,bi,bj)*Xquad(iq)*Xquad(3-jq)+
                0893      &       v_bdry_values_SI(i,j+1,bi,bj)*Xquad(3-iq)*Xquad(jq)+
5ca83cd8f7 Dani*0894      &       v_bdry_values_SI(i+1,j+1,bi,bj)*Xquad(iq)*Xquad(jq)
96b006450c dngo*0895             ux = u_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +
                0896      &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
                0897      &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
5ca83cd8f7 Dani*0898      &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
                0899             uy = u_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
96b006450c dngo*0900      &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
                0901      &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
5ca83cd8f7 Dani*0902      &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
96b006450c dngo*0903             vx = v_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +
                0904      &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
                0905      &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
5ca83cd8f7 Dani*0906      &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
96b006450c dngo*0907             vy = v_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
                0908      &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
                0909      &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
5ca83cd8f7 Dani*0910      &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
                0911             exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0912             eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0913             exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0914      &       k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0915 
96b006450c dngo*0916             do inode = 1,2
5ca83cd8f7 Dani*0917              do jnode = 1,2
                0918 
                0919              m = 2*(jnode-1)+inode
96b006450c dngo*0920              ilq = 1
5ca83cd8f7 Dani*0921              jlq = 1
                0922              if (inode.eq.iq) ilq = 2
96b006450c dngo*0923              if (jnode.eq.jq) jlq = 2
5ca83cd8f7 Dani*0924              phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
                0925 
96b006450c dngo*0926              if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
5ca83cd8f7 Dani*0927 
96b006450c dngo*0928               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0929      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0930      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0931      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0932      &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0933      &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
                0934 
96b006450c dngo*0935               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0936      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0937      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0938      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0939      &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
96b006450c dngo*0940      &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0941 
96b006450c dngo*0942 c               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then
                0943               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0944      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0945      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0946      &         tau_beta_eff_streamice (i,j,bi,bj) * uq
                0947 
96b006450c dngo*0948 c               endif
5ca83cd8f7 Dani*0949              endif
96b006450c dngo*0950              if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
                0951               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0952      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0953      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0954      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0955      &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0956      &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
96b006450c dngo*0957               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0958      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0959      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0960      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0961      &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
                0962      &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
96b006450c dngo*0963               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0964      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0965      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0966      &         tau_beta_eff_streamice (i,j,bi,bj) * vq
                0967              endif
                0968             enddo
96b006450c dngo*0969             enddo
                0970            enddo
5ca83cd8f7 Dani*0971            enddo
                0972           endif
                0973          enddo
                0974         enddo
                0975        enddo
                0976       enddo
                0977 
                0978 #endif
                0979       RETURN
                0980       END SUBROUTINE
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!