Back to home page

MITgcm

 
 

    


File indexing completed on 2024-05-19 05:10:55 UTC

view on githubraw file Latest commit 672b8226 on 2024-05-18 15:32:33 UTC
6f4cf52d27 Dimi*0001 #include "OBCS_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: OBCS_ADD_TIDES
                0006 
                0007 C     !INTERFACE:
                0008       SUBROUTINE OBCS_ADD_TIDES( myTime, myIter, myThid )
                0009 
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
                0012 C     | SUBROUTINE OBCS_ADD_TIDES
672b822630 Jean*0013 C     | o Add barotropic tidal velocity to OB value
6f4cf52d27 Dimi*0014 C     *==========================================================*
                0015 
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 
                0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
                0024 #include "OBCS_PARAMS.h"
                0025 #include "OBCS_GRID.h"
                0026 #include "OBCS_FIELDS.h"
                0027 
                0028 C     !INPUT/OUTPUT PARAMETERS:
                0029       _RL myTime
                0030       INTEGER myIter
                0031       INTEGER myThid
                0032 CEOP
                0033 
                0034 #ifdef ALLOW_OBCS
beb3b14177 Dimi*0035 #ifdef ALLOW_OBCS_TIDES
6f4cf52d27 Dimi*0036 C     !FUNCTIONS:
                0037 
                0038 C     !LOCAL VARIABLES:
                0039 C     bi, bj       :: tile indices
                0040 C     i,j,k        :: loop indices
                0041 C     iB, jB       :: local index of open boundary
                0042 C     msgBuf       :: Informational/error message buffer
                0043       INTEGER bi, bj
                0044       INTEGER i, j, k, iB, jB
                0045       INTEGER td
672b822630 Jean*0046       _RL  timePhase, timeCos, timeSin
                0047       _RL  uTide, vTide
6f4cf52d27 Dimi*0048 
                0049 #ifdef ALLOW_DEBUG
                0050       IF (debugMode) CALL DEBUG_ENTER('OBCS_ADD_TIDES',myThid)
                0051 #endif
                0052 
                0053 C--   Add tidal currents:
672b822630 Jean*0054       DO td=1,OBCS_nTidalComp
                0055        IF ( OBCS_tidalPeriod(td) .NE. zeroRL ) THEN
                0056 
                0057         timePhase = myTime * twoRL * PI / OBCS_tidalPeriod(td)
                0058         timeCos = COS( timePhase )
                0059         timeSin = SIN( timePhase )
4676ff26c7 ndet*0060         DO bj=myByLo(myThid),myByHi(myThid)
                0061          DO bi=myBxLo(myThid),myBxHi(myThid)
6f4cf52d27 Dimi*0062 
                0063 #ifdef ALLOW_OBCS_EAST
4676ff26c7 ndet*0064           IF ( tileHasOBE(bi,bj) ) THEN
672b822630 Jean*0065            DO j=1-OLy,sNy+OLy
                0066             iB = OB_Ie(j,bi,bj)
                0067             IF ( iB.NE.OB_indexNone ) THEN
                0068              uTide = OBE_uTideCs(j,td,bi,bj) * timeCos
                0069      &             + OBE_uTideSn(j,td,bi,bj) * timeSin
                0070              vTide = OBE_vTideCs(j,td,bi,bj) * timeCos
                0071      &             + OBE_vTideSn(j,td,bi,bj) * timeSin
                0072              DO k=1,Nr
                0073               OBEu(j,k,bi,bj) = OBEu(j,k,bi,bj)
                0074      &                        + uTide * maskW(iB,j,k,bi,bj)
                0075               OBEv(j,k,bi,bj) = OBEv(j,k,bi,bj)
                0076      &                        + vTide * maskS(iB,j,k,bi,bj)
                0077              ENDDO
                0078             ENDIF
4676ff26c7 ndet*0079            ENDDO
                0080           ENDIF
6f4cf52d27 Dimi*0081 #endif /* ALLOW_OBCS_EAST */
                0082 
                0083 #ifdef ALLOW_OBCS_WEST
4676ff26c7 ndet*0084           IF ( tileHasOBW(bi,bj) ) THEN
672b822630 Jean*0085            DO j=1-OLy,sNy+OLy
                0086             iB = OB_Iw(j,bi,bj)
                0087             IF ( iB.NE.OB_indexNone ) THEN
                0088              uTide = OBW_uTideCs(j,td,bi,bj) * timeCos
                0089      &             + OBW_uTideSn(j,td,bi,bj) * timeSin
                0090              vTide = OBW_vTideCs(j,td,bi,bj) * timeCos
                0091      &             + OBW_vTideSn(j,td,bi,bj) * timeSin
                0092              DO k=1,Nr
                0093               OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj)
                0094      &                        + uTide * maskW(1+iB,j,k,bi,bj)
                0095               OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj)
                0096      &                        + vTide * maskS(iB,j,k,bi,bj)
                0097              ENDDO
                0098             ENDIF
4676ff26c7 ndet*0099            ENDDO
                0100           ENDIF
6f4cf52d27 Dimi*0101 #endif /* ALLOW_OBCS_WEST */
                0102 
                0103 #ifdef ALLOW_OBCS_NORTH
4676ff26c7 ndet*0104           IF ( tileHasOBN(bi,bj) ) THEN
672b822630 Jean*0105            DO i=1-OLx,sNx+OLx
                0106             jB = OB_Jn(i,bi,bj)
                0107             IF ( jB.NE.OB_indexNone ) THEN
                0108              uTide = OBN_uTideCs(i,td,bi,bj) * timeCos
                0109      &             + OBN_uTideSn(i,td,bi,bj) * timeSin
                0110              vTide = OBN_vTideCs(i,td,bi,bj) * timeCos
                0111      &             + OBN_vTideSn(i,td,bi,bj) * timeSin
                0112              DO k=1,Nr
                0113               OBNu(i,k,bi,bj) = OBNu(i,k,bi,bj)
                0114      &                        + uTide * maskW(i,jB,k,bi,bj)
                0115               OBNv(i,k,bi,bj) = OBNv(i,k,bi,bj)
                0116      &                        + vTide * maskS(i,jB,k,bi,bj)
                0117              ENDDO
                0118             ENDIF
4676ff26c7 ndet*0119            ENDDO
                0120           ENDIF
6f4cf52d27 Dimi*0121 #endif /* ALLOW_OBCS_NORTH */
                0122 
                0123 #ifdef ALLOW_OBCS_SOUTH
4676ff26c7 ndet*0124           IF ( tileHasOBS(bi,bj) ) THEN
672b822630 Jean*0125            DO i=1-OLx,sNx+OLx
                0126             jB = OB_Js(i,bi,bj)
                0127             IF ( jB.NE.OB_indexNone ) THEN
                0128              uTide = OBS_uTideCs(i,td,bi,bj) * timeCos
                0129      &             + OBS_uTideSn(i,td,bi,bj) * timeSin
                0130              vTide = OBS_vTideCs(i,td,bi,bj) * timeCos
                0131      &             + OBS_vTideSn(i,td,bi,bj) * timeSin
                0132              DO k=1,Nr
                0133               OBSu(i,k,bi,bj) = OBSu(i,k,bi,bj)
                0134      &                        + uTide * maskW(i,jB,k,bi,bj)
                0135               OBSv(i,k,bi,bj) = OBSv(i,k,bi,bj)
                0136      &                        + vTide * maskS(i,1+jB,k,bi,bj)
                0137              ENDDO
                0138             ENDIF
4676ff26c7 ndet*0139            ENDDO
                0140           ENDIF
6f4cf52d27 Dimi*0141 #endif /* ALLOW_OBCS_SOUTH */
                0142 
672b822630 Jean*0143 C    end bi,bj loops
4676ff26c7 ndet*0144          ENDDO
                0145         ENDDO
672b822630 Jean*0146 
                0147 C    end if (tidalPeriod <> 0) and end loop on td (= tidal comp. index)
4676ff26c7 ndet*0148        ENDIF
6f4cf52d27 Dimi*0149       ENDDO
                0150 
                0151 #ifdef ALLOW_DEBUG
                0152       IF (debugMode) CALL DEBUG_LEAVE('OBCS_ADD_TIDES',myThid)
                0153 #endif
                0154 
                0155 #endif /* ALLOW_OBCS_TIDES */
                0156 #endif /* ALLOW_OBCS */
                0157 
                0158       RETURN
                0159       END