Back to home page

MITgcm
 
 

    

File indexing completed on 2026-10-08 05:08:59 UTC

view on githubraw file Latest commit 27256b2d on 2026-10-07 21:35:21 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 
                0271       DO j = 1-cg_halo, sNy+cg_halo
                0272        DO i = 1-cg_halo, sNx+cg_halo
                0273         DO bj = myByLo(myThid), myByHi(myThid)
                0274          DO bi = myBxLo(myThid), myBxHi(myThid)
                0275           IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN
96b006450c dngo*0276            DO iq=1,2
5ca83cd8f7 Dani*0277             DO jq = 1,2
96b006450c dngo*0278 
5ca83cd8f7 Dani*0279              n = 2*(jq-1)+iq
96b006450c dngo*0280 
                0281              DO inodx = 1,2
5ca83cd8f7 Dani*0282               DO inody = 1,2
                0283 
                0284                if (STREAMICE_umask(i-1+inodx,j-1+inody,bi,bj)
96b006450c dngo*0285      &          .eq.1.0 .or.
5ca83cd8f7 Dani*0286      &             streamice_vmask(i-1+inodx,j-1+inody,bi,bj).eq.1.0)
96b006450c dngo*0287      &          then
                0288 
5ca83cd8f7 Dani*0289                 m_i = 2*(inody-1)+inodx
96b006450c dngo*0290                 ilqx = 1
5ca83cd8f7 Dani*0291                 ilqy = 1
96b006450c dngo*0292 
5ca83cd8f7 Dani*0293                 if (inodx.eq.iq) ilqx = 2
96b006450c dngo*0294                 if (inody.eq.jq) ilqy = 2
5ca83cd8f7 Dani*0295                 phival(inodx,inody) = Xquad(ilqx)*Xquad(ilqy)
                0296 
                0297                 DO jnodx = 1,2
96b006450c dngo*0298                  DO jnody = 1,2
5ca83cd8f7 Dani*0299                   if (STREAMICE_umask(i-1+jnodx,j-1+jnody,bi,bj)
                0300      &             .eq.1.0 .or.
96b006450c dngo*0301      &             STREAMICE_vmask(i-1+jnodx,j-1+jnody,bi,bj).eq.1.0)
                0302      &             then
5ca83cd8f7 Dani*0303 
                0304                    m_j = 2*(jnody-1)+jnodx
96b006450c dngo*0305                    ilqx = 1
5ca83cd8f7 Dani*0306                    ilqy = 1
                0307                    if (jnodx.eq.iq) ilqx = 2
96b006450c dngo*0308                    if (jnody.eq.jq) ilqy = 2
5ca83cd8f7 Dani*0309 
96b006450c dngo*0310 c                    col_j = col_index_a (
                0311 c      &              jnodx+mod(inodx,2),
                0312 c      &              jnody+mod(inody,2) )
5ca83cd8f7 Dani*0313 
                0314                    col_x = mod(inodx,2)+jnodx-2
ddf49ceb53 Dani*0315                    colx_rev = mod(jnodx,2)+inodx-2
5ca83cd8f7 Dani*0316                    col_y = mod(inody,2)+jnody-2
ddf49ceb53 Dani*0317                    coly_rev = mod(jnody,2)+inody-2
5ca83cd8f7 Dani*0318 c
                0319 
ddf49ceb53 Dani*0320                    IF ( (inodx.eq.jnodx .and. inody.eq.jnody) .or.
                0321      &                  (inodx.eq.1 .and. inody.eq.1) .or.
                0322      &                  (jnody.eq.2 .and. inody.eq.1) .or.
                0323      &                  (jnody.eq.2 .and. jnodx.eq.2)) THEN
                0324 
5ca83cd8f7 Dani*0325                    ux = DPhi (i,j,bi,bj,m_j,n,1)
                0326                    uy = DPhi (i,j,bi,bj,m_j,n,2)
96b006450c dngo*0327                    vx = 0
5ca83cd8f7 Dani*0328                    vy = 0
96b006450c dngo*0329                    uq = Xquad(ilqx) * Xquad(ilqy)
5ca83cd8f7 Dani*0330                    vq = 0
                0331 
                0332                    exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0333                    eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0334                    exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0335      &              k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
96b006450c dngo*0336 
ddf49ceb53 Dani*0337                     tmpval = .25 *
96b006450c dngo*0338      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0339      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0340      &              DPhi(i,j,bi,bj,m_i,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0341      &              DPhi(i,j,bi,bj,m_i,n,2)*(2*exy))
                0342 
ddf49ceb53 Dani*0343                    streamice_cg_A1
28bae0294d Dani*0344      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0345      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0346      &             streamice_cg_A1
28bae0294d Dani*0347      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0348      &                  mod(inody,2)+jnody-2)+tmpval
ddf49ceb53 Dani*0349 
                0350                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0351                     streamice_cg_A1
28bae0294d Dani*0352      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0353      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0354      &              streamice_cg_A1
28bae0294d Dani*0355      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0356      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0357      &               tmpval
                0358                    ENDIF
                0359 
96b006450c dngo*0360 c!!
ddf49ceb53 Dani*0361 
                0362                     tmpval = .25 *
96b006450c dngo*0363      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0364      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0365      &              DPhi(i,j,bi,bj,m_i,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0366      &              DPhi(i,j,bi,bj,m_i,n,1)*(2*exy))
                0367 
ddf49ceb53 Dani*0368                    streamice_cg_A3
28bae0294d Dani*0369      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0370      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0371      &             streamice_cg_A3
28bae0294d Dani*0372      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0373      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0374 
                0375                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
ddf49ceb53 Dani*0376                     streamice_cg_A2
28bae0294d Dani*0377      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0378      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0379      &              streamice_cg_A2
28bae0294d Dani*0380      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0381      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0382      &               tmpval
                0383                    ENDIF
                0384 
96b006450c dngo*0385 c!!
ddf49ceb53 Dani*0386 
                0387                     tmpval = .25 *
96b006450c dngo*0388      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0389      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0390      &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*
96b006450c dngo*0391      &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0392 
ddf49ceb53 Dani*0393                    streamice_cg_A1
28bae0294d Dani*0394      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0395      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0396      &             streamice_cg_A1
28bae0294d Dani*0397      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0398      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0399 
ddf49ceb53 Dani*0400                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0401                     streamice_cg_A1
28bae0294d Dani*0402      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0403      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0404      &              streamice_cg_A1
28bae0294d Dani*0405      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0406      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0407      &               tmpval
                0408                    ENDIF
                0409 
96b006450c dngo*0410 c!!
ddf49ceb53 Dani*0411 
96b006450c dngo*0412                    tmpval = .25 *
                0413      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0414      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0415      &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*
                0416      &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
                0417 
ddf49ceb53 Dani*0418                    streamice_cg_A3
28bae0294d Dani*0419      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0420      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0421      &             streamice_cg_A3
28bae0294d Dani*0422      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0423      &                  mod(inody,2)+jnody-2)+tmpval
ddf49ceb53 Dani*0424 
                0425                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0426                     streamice_cg_A2
28bae0294d Dani*0427      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0428      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0429      &              streamice_cg_A2
28bae0294d Dani*0430      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0431      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0432      &               tmpval
                0433                    ENDIF
                0434 
96b006450c dngo*0435 c!!
ddf49ceb53 Dani*0436 
96b006450c dngo*0437                     tmpval = .25*phival(inodx,inody) *
                0438      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0439      &              tau_beta_eff_streamice (i,j,bi,bj) * uq
                0440 
5ca83cd8f7 Dani*0441                    streamice_cg_A1
28bae0294d Dani*0442      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0443      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0444      &             streamice_cg_A1
28bae0294d Dani*0445      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0446      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0447 
ddf49ceb53 Dani*0448                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0449                     streamice_cg_A1
28bae0294d Dani*0450      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0451      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0452      &              streamice_cg_A1
28bae0294d Dani*0453      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0454      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0455      &               tmpval
                0456                    ENDIF
                0457 
96b006450c dngo*0458 c!!
                0459                     tmpval = .25*phival(inodx,inody) *
                0460      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0461      &              tau_beta_eff_streamice (i,j,bi,bj) * vq
5ca83cd8f7 Dani*0462 
                0463                    streamice_cg_A3
28bae0294d Dani*0464      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0465      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0466      &             streamice_cg_A3
28bae0294d Dani*0467      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0468      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0469 
                0470                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
ddf49ceb53 Dani*0471                     streamice_cg_A2
28bae0294d Dani*0472      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0473      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0474      &              streamice_cg_A2
28bae0294d Dani*0475      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0476      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0477      &               tmpval
                0478                    ENDIF
                0479 
96b006450c dngo*0480 c!!
5ca83cd8f7 Dani*0481 
                0482                    vx = DPhi (i,j,bi,bj,m_j,n,1)
                0483                    vy = DPhi (i,j,bi,bj,m_j,n,2)
96b006450c dngo*0484                    ux = 0
5ca83cd8f7 Dani*0485                    uy = 0
96b006450c dngo*0486                    vq = Xquad(ilqx) * Xquad(ilqy)
5ca83cd8f7 Dani*0487                    uq = 0
                0488 
                0489                    exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0490                    eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0491                    exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0492      &              k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0493 
ddf49ceb53 Dani*0494                     tmpval = .25 *
96b006450c dngo*0495      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0496      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0497      &              DPhi(i,j,bi,bj,m_i,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0498      &              DPhi(i,j,bi,bj,m_i,n,2)*(2*exy))
                0499 
ddf49ceb53 Dani*0500                    streamice_cg_A2
28bae0294d Dani*0501      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0502      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0503      &             streamice_cg_A2
28bae0294d Dani*0504      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0505      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0506 
ddf49ceb53 Dani*0507                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0508                     streamice_cg_A3
28bae0294d Dani*0509      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0510      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0511      &              streamice_cg_A3
28bae0294d Dani*0512      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0513      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0514      &               tmpval
                0515                    ENDIF
                0516 
                0517                     tmpval = .25 *
96b006450c dngo*0518      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0519      &              visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0520      &              DPhi(i,j,bi,bj,m_i,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0521      &              DPhi(i,j,bi,bj,m_i,n,1)*(2*exy))
                0522 
ddf49ceb53 Dani*0523                    streamice_cg_A4
28bae0294d Dani*0524      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0525      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0526      &             streamice_cg_A4
28bae0294d Dani*0527      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0528      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0529 
ddf49ceb53 Dani*0530                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0531                     streamice_cg_A4
28bae0294d Dani*0532      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0533      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0534      &              streamice_cg_A4
28bae0294d Dani*0535      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0536      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0537      &               tmpval
                0538                    ENDIF
                0539 
                0540                    tmpval = .25 *
96b006450c dngo*0541      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0542      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0543      &             (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*
96b006450c dngo*0544      &              exx+4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0545 
ddf49ceb53 Dani*0546                    streamice_cg_A2
28bae0294d Dani*0547      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0548      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0549      &             streamice_cg_A2
28bae0294d Dani*0550      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0551      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0552 
ddf49ceb53 Dani*0553                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0554                     streamice_cg_A3
28bae0294d Dani*0555      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0556      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0557      &              streamice_cg_A3
28bae0294d Dani*0558      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0559      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0560      &               tmpval
                0561                    ENDIF
                0562 
96b006450c dngo*0563                    tmpval = .25 *
                0564      &              grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0565      &              visc_streamice(i,j,bi,bj) * phival(inodx,inody) *
                0566      &             (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*
                0567      &              eyy+4*0.5*k2AtC_str(i,j,bi,bj)*exy)
                0568 
ddf49ceb53 Dani*0569                    streamice_cg_A4
28bae0294d Dani*0570      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0571      &                  mod(inody,2)+jnody-2)=
ddf49ceb53 Dani*0572      &             streamice_cg_A4
28bae0294d Dani*0573      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0574      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0575 
ddf49ceb53 Dani*0576                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0577                     streamice_cg_A4
28bae0294d Dani*0578      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0579      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0580      &              streamice_cg_A4
28bae0294d Dani*0581      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0582      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0583      &               tmpval
                0584                    ENDIF
                0585 
96b006450c dngo*0586                     tmpval = .25*phival(inodx,inody) *
                0587      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0588      &              tau_beta_eff_streamice (i,j,bi,bj) * uq
                0589 
5ca83cd8f7 Dani*0590                    streamice_cg_A2
28bae0294d Dani*0591      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0592      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0593      &             streamice_cg_A2
28bae0294d Dani*0594      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0595      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0596 
ddf49ceb53 Dani*0597                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0598                     streamice_cg_A3
28bae0294d Dani*0599      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0600      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0601      &              streamice_cg_A3
28bae0294d Dani*0602      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0603      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0604      &               tmpval
                0605                    ENDIF
                0606 
96b006450c dngo*0607                     tmpval = .25*phival(inodx,inody) *
                0608      &              grid_jacq_streamice(i,j,bi,bj,n) *
ddf49ceb53 Dani*0609      &              tau_beta_eff_streamice (i,j,bi,bj) * vq
5ca83cd8f7 Dani*0610 
                0611                    streamice_cg_A4
28bae0294d Dani*0612      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0613      &                  mod(inody,2)+jnody-2)=
5ca83cd8f7 Dani*0614      &             streamice_cg_A4
28bae0294d Dani*0615      &                 (i-1+inodx,j-1+inody,bi,bj,mod(inodx,2)+jnodx-2,
                0616      &                  mod(inody,2)+jnody-2)+tmpval
96b006450c dngo*0617 
ddf49ceb53 Dani*0618                    IF (.not. (inodx.eq.jnodx .and. inody.eq.jnody)) THEN
                0619                     streamice_cg_A4
28bae0294d Dani*0620      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0621      &                mod(jnody,2)+inody-2)=
ddf49ceb53 Dani*0622      &              streamice_cg_A4
28bae0294d Dani*0623      &               (i-1+jnodx,j-1+jnody,bi,bj,mod(jnodx,2)+inodx-2,
                0624      &                mod(jnody,2)+inody-2)+
ddf49ceb53 Dani*0625      &               tmpval
                0626                    ENDIF
                0627 
                0628                    endif
96b006450c dngo*0629                   endif
5ca83cd8f7 Dani*0630                  enddo
                0631                 enddo
                0632                endif
                0633               enddo
                0634              enddo
                0635             enddo
                0636            enddo
                0637           endif
                0638          enddo
                0639         enddo
                0640        enddo
                0641       enddo
                0642 
                0643 #endif
                0644 #endif
                0645       RETURN
                0646       END SUBROUTINE
96b006450c dngo*0647 c END MAKE_A
5ca83cd8f7 Dani*0648 
96b006450c dngo*0649       SUBROUTINE STREAMICE_CG_ADIAG( myThid,
                0650      O      uret,
5ca83cd8f7 Dani*0651      O      vret)
96b006450c dngo*0652 
5ca83cd8f7 Dani*0653 C     /============================================================\
96b006450c dngo*0654 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0655 C     | o                                                          |
                0656 C     |============================================================|
                0657 C     |                                                            |
                0658 C     \============================================================/
                0659       IMPLICIT NONE
                0660 
                0661 C     === Global variables ===
                0662 #include "SIZE.h"
                0663 #include "EEPARAMS.h"
                0664 #include "PARAMS.h"
                0665 #include "GRID.h"
                0666 #include "STREAMICE.h"
96b006450c dngo*0667 #include "STREAMICE_CG.h"
5ca83cd8f7 Dani*0668 
                0669 C     !INPUT/OUTPUT ARGUMENTS
                0670 C     uret, vret - result of matrix operating on u, v
                0671 C     is, ie, js, je - starting and ending cells
                0672       INTEGER myThid
                0673       _RL uret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0674       _RL vret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0675 
                0676 #ifdef ALLOW_STREAMICE
                0677 
                0678 C the linear action of the matrix on (u,v) with triangular finite elements
                0679 C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
                0680 C but this may change pursuant to conversations with others
                0681 C
                0682 C is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
                0683 C     in order to make less frequent halo updates
                0684 C isym = 1 if grid is symmetric, 0 o.w.
                0685 
                0686 C the linear action of the matrix on (u,v) with triangular finite elements
                0687 C Phi has the form
                0688 C Phi (i,j,k,q) - applies to cell i,j
                0689 
                0690 C      3 - 4
                0691 C      |   |
                0692 C      1 - 2
                0693 
96b006450c dngo*0694 C Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q
5ca83cd8f7 Dani*0695 C Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q
                0696 C Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear
                0697 
                0698 C     !LOCAL VARIABLES:
96b006450c dngo*0699 C     == Local variables ==
5ca83cd8f7 Dani*0700       INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n
                0701       _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
                0702       _RL phival(2,2)
                0703 
                0704       uret(1,1,1,1) = uret(1,1,1,1)
                0705       vret(1,1,1,1) = vret(1,1,1,1)
                0706 
                0707       DO j = 0, sNy+1
                0708        DO i = 0, sNx+1
                0709         DO bj = myByLo(myThid), myByHi(myThid)
                0710          DO bi = myBxLo(myThid), myBxHi(myThid)
                0711           IF (STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) THEN
96b006450c dngo*0712            DO iq=1,2
5ca83cd8f7 Dani*0713             DO jq = 1,2
96b006450c dngo*0714 
5ca83cd8f7 Dani*0715             n = 2*(jq-1)+iq
96b006450c dngo*0716 
                0717             DO inode = 1,2
5ca83cd8f7 Dani*0718              DO jnode = 1,2
96b006450c dngo*0719 
5ca83cd8f7 Dani*0720              m = 2*(jnode-1)+inode
                0721 
                0722              if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0 .or.
96b006450c dngo*0723      &           STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0)
5ca83cd8f7 Dani*0724      &           then
                0725 
96b006450c dngo*0726               ilq = 1
5ca83cd8f7 Dani*0727               jlq = 1
96b006450c dngo*0728 
5ca83cd8f7 Dani*0729               if (inode.eq.iq) ilq = 2
96b006450c dngo*0730               if (jnode.eq.jq) jlq = 2
5ca83cd8f7 Dani*0731               phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
                0732 
                0733               ux = DPhi (i,j,bi,bj,m,n,1)
                0734               uy = DPhi (i,j,bi,bj,m,n,2)
96b006450c dngo*0735               vx = 0
5ca83cd8f7 Dani*0736               vy = 0
96b006450c dngo*0737               uq = Xquad(ilq) * Xquad(jlq)
5ca83cd8f7 Dani*0738               vq = 0
                0739 
                0740               exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0741               eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0742               exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0743      &         k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0744 
96b006450c dngo*0745               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0746      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0747      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0748      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0749      &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0750      &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
                0751 
96b006450c dngo*0752               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0753      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0754      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0755      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0756      &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
96b006450c dngo*0757      &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0758 
96b006450c dngo*0759               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0760      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0761      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0762      &         tau_beta_eff_streamice (i,j,bi,bj) * uq
                0763 
                0764               vx = DPhi (i,j,bi,bj,m,n,1)
                0765               vy = DPhi (i,j,bi,bj,m,n,2)
96b006450c dngo*0766               ux = 0
5ca83cd8f7 Dani*0767               uy = 0
96b006450c dngo*0768               vq = Xquad(ilq) * Xquad(jlq)
5ca83cd8f7 Dani*0769               uq = 0
                0770 
                0771               exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0772               eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0773               exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0774      &         k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0775 
96b006450c dngo*0776               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0777      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0778      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0779      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0780      &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0781      &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
96b006450c dngo*0782               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0783      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0784      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0785      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0786      &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
                0787      &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
                0788 
96b006450c dngo*0789               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0790      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0791      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0792      &         tau_beta_eff_streamice (i,j,bi,bj) * vq
96b006450c dngo*0793 
5ca83cd8f7 Dani*0794              endif
                0795 
                0796             enddo
96b006450c dngo*0797             enddo
                0798            enddo
5ca83cd8f7 Dani*0799            enddo
                0800           endif
                0801          enddo
                0802         enddo
                0803        enddo
                0804       enddo
                0805 
                0806 #endif
                0807       RETURN
                0808       END SUBROUTINE
                0809 
96b006450c dngo*0810       SUBROUTINE STREAMICE_CG_BOUND_VALS( myThid,
                0811      O    uret,
5ca83cd8f7 Dani*0812      O    vret)
                0813 C     /============================================================\
96b006450c dngo*0814 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0815 C     | o                                                          |
                0816 C     |============================================================|
                0817 C     |                                                            |
                0818 C     \============================================================/
                0819       IMPLICIT NONE
                0820 
                0821 C     === Global variables ===
                0822 #include "SIZE.h"
                0823 #include "EEPARAMS.h"
                0824 #include "PARAMS.h"
                0825 #include "GRID.h"
96b006450c dngo*0826 #include "STREAMICE.h"
5ca83cd8f7 Dani*0827 #include "STREAMICE_CG.h"
                0828 
                0829 C     !INPUT/OUTPUT ARGUMENTS
                0830 C     uret, vret - result of matrix operating on u, v
                0831 C     is, ie, js, je - starting and ending cells
                0832       INTEGER myThid
                0833       _RL uret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0834       _RL vret (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
96b006450c dngo*0835 
5ca83cd8f7 Dani*0836 #ifdef ALLOW_STREAMICE
                0837 
                0838 C the linear action of the matrix on (u,v) with triangular finite elements
                0839 C as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
                0840 C but this may change pursuant to conversations with others
                0841 C
                0842 C is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
                0843 C     in order to make less frequent halo updates
                0844 C isym = 1 if grid is symmetric, 0 o.w.
                0845 
                0846 C the linear action of the matrix on (u,v) with triangular finite elements
                0847 C Phi has the form
                0848 C Phi (i,j,k,q) - applies to cell i,j
                0849 
                0850 C      3 - 4
                0851 C      |   |
                0852 C      1 - 2
                0853 
96b006450c dngo*0854 C Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q
5ca83cd8f7 Dani*0855 C Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q
                0856 C Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear
                0857 
                0858 C     !LOCAL VARIABLES:
96b006450c dngo*0859 C     == Local variables ==
5ca83cd8f7 Dani*0860       INTEGER iq, jq, inode, jnode, i, j, bi, bj, ilq, jlq, m, n
                0861       _RL ux, vx, uy, vy, uq, vq, exx, eyy, exy
                0862       _RL phival(2,2)
                0863 
                0864       uret(1,1,1,1) = uret(1,1,1,1)
                0865       vret(1,1,1,1) = vret(1,1,1,1)
                0866 
                0867       DO j = 0, sNy+1
                0868        DO i = 0, sNx+1
                0869         DO bj = myByLo(myThid), myByHi(myThid)
                0870          DO bi = myBxLo(myThid), myBxHi(myThid)
                0871           IF ((STREAMICE_hmask (i,j,bi,bj) .eq. 1.0) .AND.
                0872      &     ((STREAMICE_umask(i,j,bi,bj).eq.3.0) .OR.
                0873      &      (STREAMICE_umask(i,j+1,bi,bj).eq.3.0) .OR.
                0874      &      (STREAMICE_umask(i+1,j,bi,bj).eq.3.0) .OR.
                0875      &      (STREAMICE_umask(i+1,j+1,bi,bj).eq.3.0) .OR.
                0876      &      (STREAMICE_vmask(i,j,bi,bj).eq.3.0) .OR.
                0877      &      (STREAMICE_vmask(i,j+1,bi,bj).eq.3.0) .OR.
                0878      &      (STREAMICE_vmask(i+1,j,bi,bj).eq.3.0) .OR.
                0879      &      (STREAMICE_vmask(i+1,j+1,bi,bj).eq.3.0))) THEN
96b006450c dngo*0880 
                0881            DO iq=1,2
5ca83cd8f7 Dani*0882             DO jq = 1,2
                0883 
                0884             n = 2*(jq-1)+iq
                0885 
96b006450c dngo*0886             uq = u_bdry_values_SI(i,j,bi,bj)*Xquad(3-iq)*Xquad(3-jq)+
                0887      &       u_bdry_values_SI(i+1,j,bi,bj)*Xquad(iq)*Xquad(3-jq)+
                0888      &       u_bdry_values_SI(i,j+1,bi,bj)*Xquad(3-iq)*Xquad(jq)+
5ca83cd8f7 Dani*0889      &       u_bdry_values_SI(i+1,j+1,bi,bj)*Xquad(iq)*Xquad(jq)
96b006450c dngo*0890             vq = v_bdry_values_SI(i,j,bi,bj)*Xquad(3-iq)*Xquad(3-jq)+
                0891      &       v_bdry_values_SI(i+1,j,bi,bj)*Xquad(iq)*Xquad(3-jq)+
                0892      &       v_bdry_values_SI(i,j+1,bi,bj)*Xquad(3-iq)*Xquad(jq)+
5ca83cd8f7 Dani*0893      &       v_bdry_values_SI(i+1,j+1,bi,bj)*Xquad(iq)*Xquad(jq)
96b006450c dngo*0894             ux = u_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +
                0895      &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
                0896      &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
5ca83cd8f7 Dani*0897      &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
                0898             uy = u_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
96b006450c dngo*0899      &       u_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
                0900      &       u_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
5ca83cd8f7 Dani*0901      &       u_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
96b006450c dngo*0902             vx = v_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,1) +
                0903      &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,1) +
                0904      &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,1) +
5ca83cd8f7 Dani*0905      &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,1)
96b006450c dngo*0906             vy = v_bdry_values_SI(i,j,bi,bj) * DPhi(i,j,bi,bj,1,n,2) +
                0907      &       v_bdry_values_SI(i+1,j,bi,bj) * DPhi(i,j,bi,bj,2,n,2) +
                0908      &       v_bdry_values_SI(i,j+1,bi,bj) * DPhi(i,j,bi,bj,3,n,2) +
5ca83cd8f7 Dani*0909      &       v_bdry_values_SI(i+1,j+1,bi,bj) * DPhi(i,j,bi,bj,4,n,2)
                0910             exx = ux + k1AtC_str(i,j,bi,bj)*vq
                0911             eyy = vy + k2AtC_str(i,j,bi,bj)*uq
96b006450c dngo*0912             exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0913      &       k1AtC_str(i,j,bi,bj)*uq + k2AtC_str(i,j,bi,bj)*vq
                0914 
96b006450c dngo*0915             do inode = 1,2
5ca83cd8f7 Dani*0916              do jnode = 1,2
                0917 
                0918              m = 2*(jnode-1)+inode
96b006450c dngo*0919              ilq = 1
5ca83cd8f7 Dani*0920              jlq = 1
                0921              if (inode.eq.iq) ilq = 2
96b006450c dngo*0922              if (jnode.eq.jq) jlq = 2
5ca83cd8f7 Dani*0923              phival(inode,jnode) = Xquad(ilq)*Xquad(jlq)
                0924 
96b006450c dngo*0925              if (STREAMICE_umask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
5ca83cd8f7 Dani*0926 
96b006450c dngo*0927               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0928      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0929      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0930      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0931      &          DPhi(i,j,bi,bj,m,n,1)*(4*exx+2*eyy) +
5ca83cd8f7 Dani*0932      &          DPhi(i,j,bi,bj,m,n,2)*(2*exy))
                0933 
96b006450c dngo*0934               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0935      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0936      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0937      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0938      &         (4*k2AtC_str(i,j,bi,bj)*eyy+2*k2AtC_str(i,j,bi,bj)*exx+
96b006450c dngo*0939      &          4*0.5*k1AtC_str(i,j,bi,bj)*exy)
5ca83cd8f7 Dani*0940 
96b006450c dngo*0941 c               if (STREAMICE_float_cond(i,j,bi,bj) .eq. 1) then
                0942               uret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0943      &         uret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0944      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0945      &         tau_beta_eff_streamice (i,j,bi,bj) * uq
                0946 
96b006450c dngo*0947 c               endif
5ca83cd8f7 Dani*0948              endif
96b006450c dngo*0949              if (STREAMICE_vmask(i-1+inode,j-1+jnode,bi,bj).eq.1.0) then
                0950               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0951      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0952      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0953      &         visc_streamice(i,j,bi,bj) * (
96b006450c dngo*0954      &          DPhi(i,j,bi,bj,m,n,2)*(4*eyy+2*exx) +
5ca83cd8f7 Dani*0955      &          DPhi(i,j,bi,bj,m,n,1)*(2*exy))
96b006450c dngo*0956               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0957      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0958      &         grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0959      &         visc_streamice(i,j,bi,bj) * phival(inode,jnode) *
                0960      &         (4*k1AtC_str(i,j,bi,bj)*exx+2*k1AtC_str(i,j,bi,bj)*eyy+
                0961      &          4*0.5*k2AtC_str(i,j,bi,bj)*exy)
96b006450c dngo*0962               vret(i-1+inode,j-1+jnode,bi,bj) =
5ca83cd8f7 Dani*0963      &         vret(i-1+inode,j-1+jnode,bi,bj) + .25 *
96b006450c dngo*0964      &         phival(inode,jnode) * grid_jacq_streamice(i,j,bi,bj,n) *
5ca83cd8f7 Dani*0965      &         tau_beta_eff_streamice (i,j,bi,bj) * vq
                0966              endif
                0967             enddo
96b006450c dngo*0968             enddo
                0969            enddo
5ca83cd8f7 Dani*0970            enddo
                0971           endif
                0972          enddo
                0973         enddo
                0974        enddo
                0975       enddo
                0976 
                0977 #endif
                0978       RETURN
                0979       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!