pkg/gmredi/gmredi_calc_urms.F

0d1e4b948d Mich*0001 #include "GMREDI_OPTIONS.h"
                0002
                0003 C     !ROUTINE: EIGENVAL
                0004 C     !INTERFACE:
                0005       SUBROUTINE GMREDI_CALC_URMS(
                0006      I     iMin, iMax, jMin, jMax,
                0007      I     bi, bj, N2, myThid,
5a6ef5c2b4 Mich*0008      U     urms)
0d1e4b948d Mich*0009
                0010 C     !DESCRIPTION: \bv
                0011 C     *==========================================================*
                0012 C     | SUBROUTINE GMREDI_CALC_URMS
4578baf364 Jean*0013 C     | o Calculate the vertical structure of the rms eddy
0d1e4b948d Mich*0014 C     |   velocity based on baroclinic modal decomposition
                0015 C     *==========================================================*
                0016 C     \ev
                0017
                0018       IMPLICIT NONE
                0019
                0020 C     == Global variables ==
                0021 #include "SIZE.h"
                0022 #include "GRID.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "GMREDI.h"
                0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     == Routine arguments ==
                0029 C     bi, bj    :: tile indices
                0030       INTEGER iMin,iMax,jMin,jMax
                0031       INTEGER bi, bj
                0032       INTEGER myThid
4578baf364 Jean*0033       _RL N2(  1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0034       _RL urms(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0035
05118ac017 Jean*0036 #ifdef GM_BATES_K3D
5a6ef5c2b4 Mich*0037
0d1e4b948d Mich*0038 C     !LOCAL VARIABLES:
                0039 C     == Local variables ==
5a6ef5c2b4 Mich*0040       INTEGER i,j,k
                0041 C     bbs   :: bottom boundary condition (set to zero for now)
                0042 C     const :: a constant for each water column
4578baf364 Jean*0043       _RL bbc(   1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0044       _RL const( 1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0d1e4b948d Mich*0045
                0046 C     Constant zero bottom boundary condition
4578baf364 Jean*0047       DO j=1-OLy,sNy+OLy
                0048        DO i=1-OLx,sNx+OLx
0d1e4b948d Mich*0049         bbc(i,j) = zeroRL
                0050        ENDDO
                0051       ENDDO
                0052
                0053 C     Fit urms to the first baroclinic mode using the SBC and BBC
                0054 C     We need at least two cells to do this
4578baf364 Jean*0055       DO j=1-OLy,sNy+OLy
                0056        DO i=1-OLx,sNx+OLx
0d1e4b948d Mich*0057         k = kLowC(i,j,bi,bj)
                0058         IF (k.GT.2) THEN
                0059           const(i,j) = (urms(i,j,k)-urms(i,j,1))
5a6ef5c2b4 Mich*0060      &         /(modesC(1,i,j,k,bi,bj)-modesC(1,i,j,1,bi,bj))
0d1e4b948d Mich*0061         ELSE
                0062           const(i,j) = zeroRL
                0063         ENDIF
                0064        ENDDO
4578baf364 Jean*0065       ENDDO
0d1e4b948d Mich*0066
                0067       DO k=2,Nr
4578baf364 Jean*0068        DO j=1-OLy,sNy+OLy
                0069         DO i=1-OLx,sNx+OLx
0d1e4b948d Mich*0070          IF (k.LT.kLowC(i,j,bi,bj)) THEN
4578baf364 Jean*0071            urms(i,j,k) = urms(i,j,1) +
5a6ef5c2b4 Mich*0072      &          const(i,j)*(modesC(1,i,j,k,bi,bj)-modesC(1,i,j,1,bi,bj))
0d1e4b948d Mich*0073          ELSE
                0074            urms(i,j,k)=zeroRL
                0075          ENDIF
                0076         ENDDO
                0077        ENDDO
                0078       ENDDO
                0079
                0080 C     Land, so, we fill with zeros
4578baf364 Jean*0081       DO j=1-OLy,sNy+OLy
                0082        DO i=1-OLx,sNx+OLx
0d1e4b948d Mich*0083         if (kLowC(i,j,bi,bj).EQ.0) urms(i,j,1) = zeroRL
                0084        ENDDO
                0085       ENDDO
                0086
05118ac017 Jean*0087 #endif /* GM_BATES_K3D */
0d1e4b948d Mich*0088
5a6ef5c2b4 Mich*0089       RETURN
0d1e4b948d Mich*0090       END