** 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: Thu, 15 May 2024 05:11:27 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/seaice/seaice_mom_advection.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2022-11-23 06:10:10 UTC

view on githubraw file Latest commit 20dee616 on 2022-11-22 15:45:38 UTC
38c3aa5b85 Mart*0001 #include "SEAICE_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C !ROUTINE: SEAICE_MOM_ADVECTION
                0005 
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE SEAICE_MOM_ADVECTION(
                0008      I        bi,bj,iMin,iMax,jMin,jMax,
                0009      I        uIceLoc, vIceLoc,
                0010      O        gU, gV,
                0011      I        myTime, myIter, myThid )
                0012 C     *==========================================================*
                0013 C     | S/R SEAICE_MOM_ADVECTION                                 |
                0014 C     | o Form the advection of sea ice momentum to be added to  |
                0015 C     |   the right hand-side of the momentum equation.          |
                0016 C     *==========================================================*
                0017 C     | Most of the code is take from S/R MOM_VECINV and reuses  |
                0018 C     | code from mom_vecinv and mom_common                      |
                0019 C     *==========================================================*
                0020       IMPLICIT NONE
                0021 
                0022 C     == Global variables ==
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "GRID.h"
                0027 #include "SEAICE_SIZE.h"
                0028 #include "SEAICE_PARAMS.h"
                0029 
                0030 C     == Routine arguments ==
                0031 C     bi,bj   :: current tile indices
                0032 C     iMin,iMax,jMin,jMax :: loop ranges
                0033 C     uIceLoc ::
                0034 C     vIceLoc ::
                0035 
                0036 C     gU      :: advection tendency (all explicit terms), u component
                0037 C     gV      :: advection tendency (all explicit terms), v component
                0038 C     myTime  :: current time
                0039 C     myIter  :: current time-step number
                0040 C     myThid  :: my Thread Id number
                0041       INTEGER bi,bj
                0042       INTEGER iMin,iMax,jMin,jMax
                0043       _RL uIceLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0044       _RL vIceLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0045       _RL gU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0046       _RL gV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0047       _RL     myTime
                0048       INTEGER myIter
                0049       INTEGER myThid
                0050 CEOP
                0051 
                0052 #ifdef SEAICE_ALLOW_MOM_ADVECTION
                0053 
                0054 C     == Functions ==
                0055       LOGICAL  DIFFERENT_MULTIPLE
                0056       EXTERNAL DIFFERENT_MULTIPLE
                0057 
                0058 C     == Local variables ==
                0059       _RL      uCf(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0060       _RL      vCf(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0061       _RS hFacZ   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0062       _RS r_hFacZ (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0063       _RL uFld    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0064       _RL vFld    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0065       _RL KE      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0066       _RL vort3   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0067 C     i,j    :: Loop counters
                0068 C     k      :: surface level index
                0069       INTEGER i,j,k
                0070 C     later these will be run time parameters
                0071 CML      LOGICAL SEAICEhighOrderVorticity, SEAICEupwindVorticity
                0072 CML      LOGICAL SEAICEuseAbsVorticity,
                0073       LOGICAL vorticityFlag
                0074 
                0075 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0076 
                0077 CML      SEAICEselectKEscheme     = selectKEscheme
                0078 CML      SEAICEselectVortScheme   = selectVortScheme
                0079 CML      SEAICEhighOrderVorticity = highOrderVorticity
                0080 CML      SEAICEupwindVorticity    = upwindVorticity
                0081 CML      SEAICEuseAbsVorticity    = useAbsVorticity
                0082 CML      SEAICEuseJamartMomAdv    = useJamartMomAdv
                0083 
                0084 C--   Initialise intermediate terms
                0085       DO j=1-OLy,sNy+OLy
                0086        DO i=1-OLx,sNx+OLx
                0087         uCf(i,j)   = 0.
                0088         vCf(i,j)   = 0.
                0089         gU(i,j)    = 0.
                0090         gV(i,j)    = 0.
                0091         vort3(i,j) = 0.
                0092         KE(i,j)    = 0.
                0093 #ifdef ALLOW_AUTODIFF
                0094         hFacZ(i,j)   = 0. _d 0
                0095 #endif
                0096        ENDDO
                0097       ENDDO
                0098 
                0099       k = 1
                0100 C--   Calculate open water fraction at vorticity points
                0101       CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
                0102 
                0103 C     Make local copies of horizontal flow field
                0104       DO j=1-OLy,sNy+OLy
                0105        DO i=1-OLx,sNx+OLx
                0106         uFld(i,j) = uIceLoc(i,j,bi,bj)
                0107         vFld(i,j) = vIceLoc(i,j,bi,bj)
                0108        ENDDO
                0109       ENDDO
                0110 
                0111       CALL MOM_CALC_KE(bi,bj,k,SEAICEselectKEscheme,uFld,vFld,KE,myThid)
                0112 
                0113       CALL MOM_CALC_RELVORT3(bi,bj,k,uFld,vFld,hFacZ,vort3,myThid)
                0114 
                0115 CMLC-    calculate absolute vorticity
                0116 CML      IF (useAbsVorticity) THEN
                0117 CML       DO j=1-Oly,sNy+Oly
                0118 CML        DO i=1-Olx,sNx+Olx
                0119 CML         vort3(i,j) = vort3(i,j) + fCoriG(i,j,bi,bj)
                0120 CML        ENDDO
                0121 CML       ENDDO
                0122 CML      ENDIF
                0123 
                0124 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0125 
                0126 C--   Horizontal advection of relative (or absolute) vorticity
                0127       vorticityFlag = SEAICEhighOrderVorticity.OR.SEAICEupwindVorticity
                0128       IF ( vorticityFlag ) THEN
0320e25227 Mart*0129        CALL MOM_VI_U_CORIOLIS_C4(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0130      &                           SEAICEhighOrderVorticity,
                0131      &                           SEAICEupwindVorticity,
                0132      &                           vFld,vort3,r_hFacZ,
                0133      &                           uCf,myThid)
                0134       ELSE
0320e25227 Mart*0135        CALL MOM_VI_U_CORIOLIS(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0136      &                        SEAICEuseJamartMomAdv,
                0137      &                        vFld,vort3,hFacZ,r_hFacZ,
                0138      &                        uCf,myThid)
                0139       ENDIF
                0140       DO j=jMin,jMax
                0141        DO i=iMin,iMax
                0142         gU(i,j) = gU(i,j)+uCf(i,j)
                0143        ENDDO
                0144       ENDDO
                0145       IF ( vorticityFlag ) THEN
0320e25227 Mart*0146        CALL MOM_VI_V_CORIOLIS_C4(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0147      &                           SEAICEhighOrderVorticity,
                0148      &                           SEAICEupwindVorticity,
                0149      &                           uFld,vort3,r_hFacZ,
                0150      &                           vCf,myThid)
                0151       ELSE
0320e25227 Mart*0152        CALL MOM_VI_V_CORIOLIS(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0153      &                        SEAICEuseJamartMomAdv,
                0154      &                        uFld,vort3,hFacZ,r_hFacZ,
                0155      &                        vCf,myThid)
                0156       ENDIF
                0157       DO j=jMin,jMax
                0158        DO i=iMin,iMax
                0159         gV(i,j) = gV(i,j)+vCf(i,j)
                0160        ENDDO
                0161       ENDDO
                0162 
                0163 #ifdef ALLOW_DIAGNOSTICS
                0164       IF ( useDiagnostics ) THEN
                0165        CALL DIAGNOSTICS_FILL(uCf,'SIuAdvZ3',k,1,2,bi,bj,myThid)
                0166        CALL DIAGNOSTICS_FILL(vCf,'SIvAdvZ3',k,1,2,bi,bj,myThid)
                0167       ENDIF
                0168 #endif /* ALLOW_DIAGNOSTICS */
                0169 
                0170 C--   Bernoulli term
                0171       CALL MOM_VI_U_GRAD_KE(bi,bj,k,KE,uCf,myThid)
                0172       DO j=jMin,jMax
                0173        DO i=iMin,iMax
                0174         gU(i,j) = gU(i,j)+uCf(i,j)
                0175        ENDDO
                0176       ENDDO
                0177       CALL MOM_VI_V_GRAD_KE(bi,bj,k,KE,vCf,myThid)
                0178       DO j=jMin,jMax
                0179        DO i=iMin,iMax
                0180         gV(i,j) = gV(i,j)+vCf(i,j)
                0181        ENDDO
                0182       ENDDO
                0183 #ifdef ALLOW_DIAGNOSTICS
                0184       IF ( useDiagnostics ) THEN
                0185        CALL DIAGNOSTICS_FILL(uCf,'SIKEx   ',k,1,2,bi,bj,myThid)
                0186        CALL DIAGNOSTICS_FILL(vCf,'SIKEy   ',k,1,2,bi,bj,myThid)
                0187       ENDIF
                0188 #endif /* ALLOW_DIAGNOSTICS */
                0189 
                0190 C--   Set du/dt & dv/dt on boundaries to zero
                0191 C     apply masks for interior (important when we have open boundaries)
                0192       DO j=jMin,jMax
                0193        DO i=iMin,iMax
                0194         gU(i,j) = gU(i,j)*maskInW(i,j,bi,bj)
                0195         gV(i,j) = gV(i,j)*maskInS(i,j,bi,bj)
                0196        ENDDO
                0197       ENDDO
                0198 
                0199 #ifdef ALLOW_DIAGNOSTICS
                0200       IF ( useDiagnostics ) THEN
                0201        CALL DIAGNOSTICS_FILL(KE,     'SImomKE ',k,1,2,bi,bj,myThid)
                0202        CALL DIAGNOSTICS_FILL(gU,     'SIuMmAdv',k,1,2,bi,bj,myThid)
                0203        CALL DIAGNOSTICS_FILL(gV,     'SIvMmAdv',k,1,2,bi,bj,myThid)
                0204       ENDIF
                0205 #endif /* ALLOW_DIAGNOSTICS */
                0206 
                0207 #endif /* SEAICE_ALLOW_MOM_ADVECTION */
                0208 
                0209       RETURN
                0210       END
[ 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!