** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Fri, 16 May 2024 05:11:24 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/streamice/streamice_velmask_upd.F
Back to home page

MITgcm

 
 

    


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

view on githubraw file Latest commit 96b00645 on 2023-09-20 15:15:14 UTC
5ca83cd8f7 Dani*0001 #include "STREAMICE_OPTIONS.h"
9d8b0af494 Jean*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
5ca83cd8f7 Dani*0005 
                0006 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0007 
                0008 CBOP
                0009       SUBROUTINE STREAMICE_VELMASK_UPD ( myThid )
                0010 
                0011 C     /============================================================\
a786b53e82 Jean*0012 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0013 C     | o                                                          |
                0014 C     |============================================================|
                0015 C     |                                                            |
                0016 C     \============================================================/
                0017       IMPLICIT NONE
                0018 
                0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "GRID.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
                0024 #include "STREAMICE.h"
96b006450c dngo*0025 c#ifdef ALLOW_PETSC
                0026 c# ifdef ALLOW_USE_MPI
                0027 c#  include "EESUPPORT.h"
                0028 c# endif
                0029 c#endif
                0030 c #include "STREAMICE_ADV.h"
5ca83cd8f7 Dani*0031 
9ffe7276d5 Dani*0032 #ifdef ALLOW_AUTODIFF_TAMC
                0033 # include "tamc.h"
                0034 #endif
                0035 
5ca83cd8f7 Dani*0036       INTEGER myThid
                0037 
                0038 #ifdef ALLOW_STREAMICE
                0039 
                0040       INTEGER i, j, bi, bj, ki, kj
96b006450c dngo*0041       INTEGER maskFlag
5ca83cd8f7 Dani*0042 #ifdef ALLOW_USE_MPI
                0043       integer mpiRC, mpiMyWid
                0044 #endif
                0045 #ifdef ALLOW_PETSC
96b006450c dngo*0046       INTEGER myThidCopy
5ca83cd8f7 Dani*0047       _RS DoFCount
                0048       integer n_dofs_proc_loc (0:nPx*nPy-1)
                0049       integer n_dofs_cum_sum (0:nPx*nPy-1)
                0050 #endif
                0051 
                0052       _EXCH_XY_RL( H_streamice, myThid )
                0053       _EXCH_XY_RL( area_shelf_streamice, myThid )
f1d1cc05cd Dani*0054       _EXCH_XY_RS( STREAMICE_hmask, myThid )
5ca83cd8f7 Dani*0055 
                0056       DO bj=myByLo(myThid),myByHi(myThid)
                0057        DO bi=myBxLo(myThid),myBxHi(myThid)
                0058         DO j=1-OLy,sNy+OLy
                0059          DO i=1-OLx,sNx+OLx
bdd8102d3e Dani*0060           STREAMICE_umask(i,j,bi,bj) = -1. _d 0
                0061           STREAMICE_vmask(i,j,bi,bj) = -1. _d 0
5ca83cd8f7 Dani*0062           STREAMICE_ufacemask(i,j,bi,bj) = 0. _d 0
                0063           STREAMICE_vfacemask(i,j,bi,bj) = 0. _d 0
                0064          ENDDO
                0065         ENDDO
                0066        ENDDO
                0067       ENDDO
                0068 
                0069       DO bj=myByLo(myThid),myByHi(myThid)
                0070        DO bi=myBxLo(myThid),myBxHi(myThid)
                0071         DO j=0,sNy+1
                0072          DO i=0,sNx+1
bdd8102d3e Dani*0073           IF (STREAMICE_hmask(i,j,bi,bj) .eq. 1.0) THEN
5ca83cd8f7 Dani*0074 
                0075            DO kj=0,1
                0076             DO ki=0,1
bdd8102d3e Dani*0077              if (STREAMICE_umask(i+ki,j+kj,bi,bj).eq.-1.0) then
                0078               STREAMICE_umask (i+ki,j+kj,bi,bj) = 1.0
                0079              endif
                0080              if (STREAMICE_vmask(i+ki,j+kj,bi,bj).eq.-1.0) then
                0081               STREAMICE_vmask (i+ki,j+kj,bi,bj) = 1.0
                0082              endif
5ca83cd8f7 Dani*0083             ENDDO
                0084            ENDDO
                0085 
                0086            DO ki=0,1
                0087             maskFlag=INT(STREAMICE_ufacemask_bdry(i+ki,j,bi,bj))
                0088              IF (maskFlag.EQ.3) THEN
                0089               DO kj=0,1
bdd8102d3e Dani*0090                if (STREAMICE_umask(i+ki,j+kj,bi,bj).ne.0.0) then
                0091                 STREAMICE_umask(i+ki,j+kj,bi,bj) = 3.0
                0092                endif
                0093                if(STREAMICE_vmask(i+ki,j+kj,bi,bj).ne.0.0) then
                0094                 STREAMICE_vmask(i+ki,j+kj,bi,bj) = 3.0
                0095                endif
5ca83cd8f7 Dani*0096               ENDDO
                0097               STREAMICE_ufacemask(i+ki,j,bi,bj) = 3.0
                0098              ELSE IF (maskFlag.EQ.2) THEN
96b006450c dngo*0099 c             DO kj=0,1
5ca83cd8f7 Dani*0100                STREAMICE_ufacemask(i+ki,j,bi,bj) = 2.0
96b006450c dngo*0101 c             ENDDO
5ca83cd8f7 Dani*0102              ELSE IF (maskFlag.EQ.4) THEN
                0103               DO kj=0,1
                0104                STREAMICE_umask(i+ki,j+kj,bi,bj) = 0.0
a786b53e82 Jean*0105                STREAMICE_vmask(i+ki,j+kj,bi,bj) = 0.0
5ca83cd8f7 Dani*0106               ENDDO
                0107               STREAMICE_ufacemask(i+ki,j,bi,bj) = 4.0
                0108              ELSE IF (maskFlag.EQ.0) THEN
                0109               DO kj=0,1
                0110                STREAMICE_umask(i+ki,j+kj,bi,bj) = 0.0
a786b53e82 Jean*0111                STREAMICE_vmask(i+ki,j+kj,bi,bj) = 0.0
5ca83cd8f7 Dani*0112               ENDDO
                0113               STREAMICE_ufacemask(i+ki,j,bi,bj) = 0.0
                0114              ELSE IF (maskFlag.EQ.1) THEN
                0115               DO kj=0,1
                0116                STREAMICE_umask(i+ki,j+kj,bi,bj) = 0.0
                0117               ENDDO
                0118             END IF
                0119            ENDDO
                0120 
                0121            DO kj=0,1
                0122             maskFlag=INT(STREAMICE_vfacemask_bdry(i,j+kj,bi,bj))
                0123             IF (maskFlag.EQ.3) THEN
                0124               DO ki=0,1
bdd8102d3e Dani*0125                if(STREAMICE_vmask(i+ki,j+kj,bi,bj).ne.0.0) then
                0126                 STREAMICE_vmask(i+ki,j+kj,bi,bj) = 3.0
                0127                endif
                0128                if(STREAMICE_umask(i+ki,j+kj,bi,bj).ne.0.0) then
                0129                 STREAMICE_umask(i+ki,j+kj,bi,bj) = 3.0
                0130                endif
5ca83cd8f7 Dani*0131               ENDDO
                0132               STREAMICE_vfacemask(i,j+kj,bi,bj) = 3.0
                0133            ELSE IF (maskFlag.EQ.2) THEN
96b006450c dngo*0134 c             DO ki=0,1
5ca83cd8f7 Dani*0135                STREAMICE_vfacemask(i,j+kj,bi,bj) = 2.0
96b006450c dngo*0136 c             ENDDO
5ca83cd8f7 Dani*0137            ELSE IF (maskFlag.EQ.4) THEN
                0138               DO ki=0,1
                0139                STREAMICE_umask(i+ki,j+kj,bi,bj) = 0.0
a786b53e82 Jean*0140                STREAMICE_vmask(i+ki,j+kj,bi,bj) = 0.0
5ca83cd8f7 Dani*0141               ENDDO
                0142               STREAMICE_vfacemask(i,j+kj,bi,bj) = 4.0
                0143            ELSE IF (maskFlag.EQ.0) THEN
                0144               DO ki=0,1
                0145                STREAMICE_umask(i+ki,j+kj,bi,bj) = 0.0
a786b53e82 Jean*0146                STREAMICE_vmask(i+ki,j+kj,bi,bj) = 0.0
5ca83cd8f7 Dani*0147               ENDDO
                0148               STREAMICE_vfacemask(i+ki,j,bi,bj) = 0.0
                0149            ELSE IF (maskFlag.EQ.1) THEN
                0150               DO ki=0,1
                0151                STREAMICE_vmask(i+ki,j+kj,bi,bj) = 0.0
                0152               ENDDO
                0153             ENDIF
                0154            ENDDO
                0155 
                0156            IF (i .lt. sNx+OLx) THEN
                0157             IF ((STREAMICE_hmask(i+1,j,bi,bj) .eq. 0.0) .OR.
                0158      &          (STREAMICE_hmask(i+1,j,bi,bj) .eq. 2.0))  THEN
96b006450c dngo*0159 C           right boundary or adjacent to unfilled cell
5ca83cd8f7 Dani*0160              STREAMICE_ufacemask(i+1,j,bi,bj) = 2.0
                0161             ENDIF
                0162            ENDIF
                0163 
                0164            IF (i .gt. 1-OLx) THEN
                0165             IF ((STREAMICE_hmask(i-1,j,bi,bj) .eq. 0.0) .OR.
                0166      &          (STREAMICE_hmask(i-1,j,bi,bj) .eq. 2.0))  THEN
96b006450c dngo*0167 C           left boundary or adjacent to unfilled cell
5ca83cd8f7 Dani*0168              STREAMICE_ufacemask(i,j,bi,bj) = 2
                0169             ENDIF
                0170            ENDIF
                0171 
                0172            IF (j .lt. sNy+OLy) THEN
                0173             IF ((STREAMICE_hmask(i,j+1,bi,bj) .eq. 0.0) .OR.
                0174      &          (STREAMICE_hmask(i,j+1,bi,bj) .eq. 2.0))  THEN
96b006450c dngo*0175 C           top boundary or adjacent to unfilled cell
5ca83cd8f7 Dani*0176              STREAMICE_vfacemask(i,j+1,bi,bj) = 2
                0177             ENDIF
                0178            ENDIF
                0179 
                0180            IF (j .gt. 1-OLy) THEN
                0181             IF ((STREAMICE_hmask(i,j-1,bi,bj) .eq. 0.0) .OR.
                0182      &          (STREAMICE_hmask(i,j-1,bi,bj) .eq. 2.0))  THEN
96b006450c dngo*0183 C           bot boundary or adjacent to unfilled cell
5ca83cd8f7 Dani*0184              STREAMICE_vfacemask(i,j,bi,bj) = 2.0
                0185             ENDIF
                0186            ENDIF
                0187 
                0188           ENDIF
                0189          ENDDO
                0190         ENDDO
                0191        ENDDO
                0192       ENDDO
                0193 
96b006450c dngo*0194 c!$TAF STORE streamice_umask = comlev1, key=ikey_dynamics
                0195 c!$TAF STORE streamice_vmask = comlev1, key=ikey_dynamics
9ffe7276d5 Dani*0196 
bdd8102d3e Dani*0197       DO bj=myByLo(myThid),myByHi(myThid)
                0198        DO bi=myBxLo(myThid),myBxHi(myThid)
9ffe7276d5 Dani*0199         DO j=1,sNy
                0200          DO i=1,sNx
bdd8102d3e Dani*0201           IF(streamice_umask(i,j,bi,bj).eq.-1.0) THEN
9ffe7276d5 Dani*0202            streamice_umask(i,j,bi,bj)=0.0
bdd8102d3e Dani*0203           ENDIF
                0204           IF(streamice_vmask(i,j,bi,bj).eq.-1.0) THEN
9ffe7276d5 Dani*0205            streamice_vmask(i,j,bi,bj)=0.0
bdd8102d3e Dani*0206           ENDIF
                0207          ENDDO
                0208         ENDDO
                0209        ENDDO
                0210       ENDDO
                0211 
f1d1cc05cd Dani*0212       _EXCH_XY_RS( STREAMICE_ufacemask, myThid )
                0213       _EXCH_XY_RS( STREAMICE_vfacemask, myThid )
                0214       _EXCH_XY_RS( STREAMICE_umask, myThid )
                0215       _EXCH_XY_RS( STREAMICE_vmask, myThid )
5ca83cd8f7 Dani*0216 
96b006450c dngo*0217 c       CALL WRITE_FULLARRAY_RL ("umask",STREAMICE_umask,
                0218 c      c   1,0,0,1,0,myThid)
                0219 c      CALL WRITE_FLD_XY_RL ("umask","",STREAMICE_umask,0,myThid)
                0220 c      CALL WRITE_FLD_XY_RL ("vmask","",STREAMICE_vmask,0,myThid)
                0221 c      CALL WRITE_FLD_XY_RL ("ufacemask","",STREAMICE_ufacemask,0,myThid)
                0222 c      CALL WRITE_FLD_XY_RL ("vfacemask","",STREAMICE_vfacemask,0,myThid)
5ca83cd8f7 Dani*0223 
                0224 #ifdef ALLOW_PETSC
8514c76b91 Dani*0225       myThidCopy = myThid
18a089944d Dani*0226       if (streamice_use_petsc) then
8514c76b91 Dani*0227       call streamice_petsc_numerate (myThidCopy)
18a089944d Dani*0228       endif
67b4a2b594 Dani*0229 #endif
5ca83cd8f7 Dani*0230 
                0231 #endif
                0232       RETURN
                0233       END