Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:39:16 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
b6bbe8cccf Jean*0001 #include "DWNSLP_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: DWNSLP_INIT_FIXED
                0005 C     !INTERFACE:
                0006       SUBROUTINE DWNSLP_INIT_FIXED( myThid )
bb79aa40f5 Jean*0007 
b6bbe8cccf Jean*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE DWNSLP_INIT_FIXED
                0011 C     | o Routine to initialize Down-Sloping arrays ;
                0012 C     |   find potential location of Down-Sloping flow.
                0013 C     *==========================================================*
                0014 C     \ev
                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 "DWNSLP_SIZE.h"
                0025 #include "DWNSLP_PARAMS.h"
                0026 #include "DWNSLP_VARS.h"
                0027 
                0028 C     !INPUT/OUTPUT PARAMETERS:
                0029 C     === Routine arguments ===
                0030       INTEGER myThid
                0031 
                0032 #ifdef ALLOW_DOWN_SLOPE
                0033 
                0034 C     !LOCAL VARIABLES:
                0035 C     === Local variables ===
0884a363a5 Jean*0036 C     msgBuf     :: Informational/error message buffer
b6bbe8cccf Jean*0037 C     logFname,STATUS='UNKNOWN')
                0038       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0039       CHARACTER*(19) logFname
                0040       INTEGER i, j, k
                0041       INTEGER bi, bj
                0042       INTEGER n, ncount, ijd, ijr
                0043       INTEGER ideep, jdeep, kdeep, dkMx
                0044       INTEGER ishelf,jshelf,kshelf
                0045       INTEGER downward
                0046       _RL     dz_bottom
                0047       _RL     drFlowMin
                0048 CEOP
                0049 
                0050       DO bj = myByLo(myThid), myByHi(myThid)
                0051        DO bi = myBxLo(myThid), myBxHi(myThid)
                0052 
                0053 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0054 
                0055 C-    Initialize common bloc arrays :
                0056 
                0057         DWNSLP_NbSite(bi,bj) = 0
                0058         DO n=1,DWNSLP_size
                0059          DWNSLP_ijDeep(n,bi,bj) = 0
                0060          DWNSLP_shVsD(n,bi,bj)  = 0
                0061          DWNSLP_deepK(n,bi,bj)  = 0
                0062          DWNSLP_Gamma(n,bi,bj)  = 0.
                0063          DWNSLP_Transp(n,bi,bj) = 0.
                0064         ENDDO
                0065 
                0066 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0067 
                0068 C---- set list of bathymetric step (= potential location of Down-Sloping flow)
                0069         ncount = 0
                0070 
                0071         IF ( gravitySign.GT.0. ) THEN
                0072 C--   gravity > 0 (p-Coord)
                0073 
                0074 C-    in X direction (U-flow):
                0075          DO j=1,sNy
                0076           DO i=1,sNx+1
                0077            IF ( kSurfW(i,j,bi,bj).LE.Nr ) THEN
                0078 
                0079             IF ( kSurfC(i,j,bi,bj).LT.kSurfC(i-1,j,bi,bj) ) THEN
                0080              ncount = ncount + 1
                0081              IF ( ncount.LE.DWNSLP_size ) THEN
                0082               DWNSLP_ijDeep(ncount,bi,bj) =
                0083      &          1 + (i+OLx-1) + (j+OLy-1)*xSize
                0084               DWNSLP_shVsD(ncount,bi,bj) = -1
                0085              ENDIF
                0086             ENDIF
                0087 
                0088             IF ( kSurfC(i,j,bi,bj).GT.kSurfC(i-1,j,bi,bj) ) THEN
                0089              ncount = ncount + 1
                0090              IF ( ncount.LE.DWNSLP_size ) THEN
                0091               DWNSLP_ijDeep(ncount,bi,bj) =
                0092      &          1 + (i-1+OLx-1) + (j+OLy-1)*xSize
                0093               DWNSLP_shVsD(ncount,bi,bj) = 1
                0094              ENDIF
                0095             ENDIF
                0096 
                0097            ENDIF
                0098           ENDDO
                0099          ENDDO
                0100 
                0101 C-    in Y direction (V-flow):
                0102 
                0103          DO j=1,sNy+1
                0104           DO i=1,sNx
                0105            IF (  kSurfS(i,j,bi,bj).LE.Nr ) THEN
                0106 
                0107             IF ( kSurfC(i,j,bi,bj).LT.kSurfC(i,j-1,bi,bj) ) THEN
                0108              ncount = ncount + 1
                0109              IF ( ncount.LE.DWNSLP_size ) THEN
                0110               DWNSLP_ijDeep(ncount,bi,bj) =
                0111      &          1 + (i+OLx-1) + (j+OLy-1)*xSize
                0112               DWNSLP_shVsD(ncount,bi,bj) = -xSize
                0113              ENDIF
                0114             ENDIF
                0115 
                0116             IF ( kSurfC(i,j,bi,bj).GT.kSurfC(i,j-1,bi,bj) ) THEN
                0117              ncount = ncount + 1
                0118              IF ( ncount.LE.DWNSLP_size ) THEN
                0119               DWNSLP_ijDeep(ncount,bi,bj) =
                0120      &          1 + (i+OLx-1) + (j-1+OLy-1)*xSize
                0121               DWNSLP_shVsD(ncount,bi,bj) = xSize
                0122              ENDIF
                0123             ENDIF
                0124 
                0125            ENDIF
                0126           ENDDO
                0127          ENDDO
                0128 
                0129         ELSE
                0130 C--   gravity < 0 (z-Coord)
                0131 
                0132 C-    in X direction (U-flow):
                0133 
                0134          DO j=1,sNy
                0135           DO i=1,sNx+1
                0136            IF ( kSurfW(i,j,bi,bj).LE.Nr ) THEN
                0137 
                0138             IF ( kLowC(i,j,bi,bj).GT.kLowC(i-1,j,bi,bj) ) THEN
                0139              ncount = ncount + 1
                0140              IF ( ncount.LE.DWNSLP_size ) THEN
                0141               DWNSLP_ijDeep(ncount,bi,bj) =
                0142      &          1 + (i+OLx-1) + (j+OLy-1)*xSize
                0143               DWNSLP_shVsD(ncount,bi,bj) = -1
                0144              ENDIF
                0145             ENDIF
                0146 
                0147             IF ( kLowC(i,j,bi,bj).LT.kLowC(i-1,j,bi,bj) ) THEN
                0148              ncount = ncount + 1
                0149              IF ( ncount.LE.DWNSLP_size ) THEN
                0150               DWNSLP_ijDeep(ncount,bi,bj) =
                0151      &          1 + (i-1+OLx-1) + (j+OLy-1)*xSize
                0152               DWNSLP_shVsD(ncount,bi,bj) = 1
                0153              ENDIF
                0154             ENDIF
                0155 
                0156            ENDIF
                0157           ENDDO
                0158          ENDDO
                0159 
                0160 C-    in Y direction (V-flow):
                0161 
                0162          DO j=1,sNy+1
                0163           DO i=1,sNx
                0164            IF (  kSurfS(i,j,bi,bj).LE.Nr ) THEN
                0165 
                0166             IF ( kLowC(i,j,bi,bj).GT.kLowC(i,j-1,bi,bj) ) THEN
                0167              ncount = ncount + 1
                0168              IF ( ncount.LE.DWNSLP_size ) THEN
                0169               DWNSLP_ijDeep(ncount,bi,bj) =
                0170      &          1 + (i+OLx-1) + (j+OLy-1)*xSize
                0171               DWNSLP_shVsD(ncount,bi,bj) = -xSize
                0172              ENDIF
                0173             ENDIF
                0174 
                0175             IF ( kLowC(i,j,bi,bj).LT.kLowC(i,j-1,bi,bj) ) THEN
                0176              ncount = ncount + 1
                0177              IF ( ncount.LE.DWNSLP_size ) THEN
                0178               DWNSLP_ijDeep(ncount,bi,bj) =
                0179      &          1 + (i+OLx-1) + (j-1+OLy-1)*xSize
                0180               DWNSLP_shVsD(ncount,bi,bj) = xSize
                0181              ENDIF
                0182             ENDIF
                0183 
                0184            ENDIF
                0185           ENDDO
                0186          ENDDO
                0187 
                0188 C--     end if gravitySign block
                0189         ENDIF
                0190 
                0191 C-    Store the Nb of bathymetric steps (=maximum Nb of Downsloping-flow site)
                0192         DWNSLP_NbSite(bi,bj) = ncount
                0193 
                0194 C-    Check dimension :
                0195         IF (ncount.GT.DWNSLP_size) THEN
                0196           WRITE(msgBuf,'(A,I8,A)')
                0197      &      ' DWNSLP_INIT: DWNSLP_size=',DWNSLP_size,' too small !'
                0198           CALL PRINT_ERROR( msgBuf, myThid )
                0199           WRITE(msgBuf,'(A,2I4,A,I8)')
                0200      &      ' DWNSLP_INIT: min needed for tile',bi,bj,' :', ncount
                0201           CALL PRINT_ERROR( msgBuf, myThid )
                0202           STOP 'ABNORMAL END: S/R DWNSLP_INIT'
                0203         ENDIF
                0204 
                0205 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0206 C-    Compute geometric factor Gamma = slope * effective cross section area
                0207         DO n=1,DWNSLP_NbSite(bi,bj)
                0208 
                0209           ijd = DWNSLP_ijDeep(n,bi,bj)
                0210           ideep = 1-OLx + MOD(ijd-1,xSize)
                0211           jdeep = 1-Oly + (ijd-1)/xSize
                0212           ijr = DWNSLP_shVsD(n,bi,bj)
                0213           ishelf = ideep + MOD(ijr,xSize)
                0214           jshelf = jdeep + ijr/xSize
                0215           IF ( usingPCoords ) THEN
                0216             kdeep  = kSurfC(ideep, jdeep, bi,bj)
                0217             kshelf = kSurfC(ishelf,jshelf,bi,bj)
                0218             downward = -1
                0219           ELSE
                0220             kdeep  = kLowC (ideep, jdeep, bi,bj)
                0221             kshelf = kLowC (ishelf,jshelf,bi,bj)
                0222             downward = 1
                0223           ENDIF
                0224 
                0225           i= MAX(ideep,ishelf)
                0226           j= MAX(jdeep,jshelf)
                0227 
                0228 C--   calculate the minimum level thickness between kshelf & kdeep:
                0229           drFlowMin = DWNSLP_drFlow
                0230           DO k = kshelf,kdeep,downward
                0231             drFlowMin = MIN( drFlowMin,
                0232      &                       drF(k)*hFacC(ideep,jdeep,k,bi,bj) )
                0233           ENDDO
                0234 
                0235           IF (DWNSLP_slope.NE.0.) THEN
                0236 C--   Use fixed slope = DWNSLP_slope :
                0237            IF (ABS(ijr).EQ.1) THEN
                0238 C-    slope along X dir:
                0239             DWNSLP_Gamma(n,bi,bj) = DWNSLP_slope*dyG(i,j,bi,bj)
                0240      &       *MIN( drF(kshelf)*hFacW(i,j,kshelf,bi,bj), drFlowMin )
                0241            ELSE
                0242 C-    slope along Y dir:
                0243             DWNSLP_Gamma(n,bi,bj) = DWNSLP_slope*dxG(i,j,bi,bj)
                0244      &       *MIN( drF(kshelf)*hFacS(i,j,kshelf,bi,bj), drFlowMin )
                0245            ENDIF
                0246           ELSE
                0247 C--   Compute and use the local slope :
                0248            IF ( usingPCoords ) THEN
                0249             dz_bottom = Ro_surf(ideep,jdeep,bi,bj)
                0250      &                - Ro_surf(ishelf,jshelf,bi,bj)
                0251 C     a quick way to convert Delta.P to Delta.Z :
                0252             dz_bottom = dz_bottom*recip_gravity*recip_rhoConst
                0253            ELSE
                0254             dz_bottom = R_low(ishelf,jshelf,bi,bj)
                0255      &                - R_low(ideep,jdeep,bi,bj)
                0256            ENDIF
                0257            IF (ABS(ijr).EQ.1) THEN
                0258 C-    slope along X dir:
                0259             DWNSLP_Gamma(n,bi,bj) = dz_bottom*recip_dxC(i,j,bi,bj)
                0260      &       *dyG(i,j,bi,bj)
                0261      &       *MIN( drF(kshelf)*hFacW(i,j,kshelf,bi,bj), drFlowMin )
                0262            ELSE
                0263 C-    slope along Y dir:
                0264             DWNSLP_Gamma(n,bi,bj) = dz_bottom*recip_dyC(i,j,bi,bj)
                0265      &       *dxG(i,j,bi,bj)
                0266      &       *MIN( drF(kshelf)*hFacS(i,j,kshelf,bi,bj), drFlowMin )
                0267            ENDIF
                0268 
                0269           ENDIF
                0270 
                0271         ENDDO
                0272 
                0273 C-    end bi,bj loops.
                0274        ENDDO
                0275       ENDDO
                0276 
                0277 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0278 C- Print usefull variables :
                0279       _BARRIER
                0280       _BEGIN_MASTER(myThid)
                0281 
bb79aa40f5 Jean*0282       DWNSLP_ioUnit = 0
                0283       IF ( debugLevel.GE.debLevA ) THEN
                0284         CALL MDSFINDUNIT( DWNSLP_ioUnit, myThid )
                0285       ENDIF
                0286       IF ( DWNSLP_ioUnit.GT.0 ) THEN
                0287         WRITE(logFname,'(A11,I4.4,A4)') 'down_slope.',myProcId,'.log'
                0288         OPEN(DWNSLP_ioUnit,FILE=logFname,STATUS='UNKNOWN')
b6bbe8cccf Jean*0289       ENDIF
                0290 
                0291       DO bj = 1,nSy
                0292        DO bi = 1,nSx
                0293 
                0294         WRITE(msgBuf,'(A,2I4,I8)')
                0295      &      'DWNSLP_INIT: DWNSLP_NbSite=',bi,bj,DWNSLP_NbSite(bi,bj)
                0296         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
bb79aa40f5 Jean*0297      &                      SQUEEZE_RIGHT, myThid )
b6bbe8cccf Jean*0298 C---
bb79aa40f5 Jean*0299         IF ( DWNSLP_ioUnit.GT.0 ) THEN
b6bbe8cccf Jean*0300          WRITE(DWNSLP_ioUnit,'(A,2I4,2I8)')
                0301      &     ' DWNSLP_INIT: bi,bj, DWNSLP_NbSite, xSize =',
                0302      &        bi,bj, DWNSLP_NbSite(bi,bj), xSize
                0303          WRITE(DWNSLP_ioUnit,'(A)')
                0304      &   '  bi  bj     n :     ijd  is  js ,   ijr  ks dkMx  Gamma :'
                0305          DO n=1,DWNSLP_NbSite(bi,bj)
                0306           ijd = DWNSLP_ijDeep(n,bi,bj)
                0307           ideep = 1-OLx + MOD(ijd-1,xSize)
                0308           jdeep = 1-Oly + (ijd-1)/xSize
                0309           ijr = DWNSLP_shVsD(n,bi,bj)
                0310           ishelf = ideep + MOD(ijr,xSize)
                0311           jshelf = jdeep + ijr/xSize
                0312           IF ( usingPCoords ) THEN
                0313             kshelf = kSurfC(ishelf,jshelf,bi,bj)
                0314             dkMx = kshelf - kSurfC(ideep,jdeep,bi,bj)
                0315           ELSE
                0316             kshelf = kLowC (ishelf,jshelf,bi,bj)
                0317             dkMx = kLowC (ideep,jdeep,bi,bj) - kshelf
                0318           ENDIF
                0319           WRITE(DWNSLP_ioUnit,'(2I4,I6,A,I8,2I4,A,I6,2I4,1PE14.6)')
                0320      &      bi,bj,n, ' :', ijd, ideep, jdeep,
                0321      &      ' ,', ijr, kshelf, dkMx, DWNSLP_Gamma(n,bi,bj)
                0322          ENDDO
                0323          WRITE(DWNSLP_ioUnit,*)
                0324         ENDIF
                0325 C---
                0326        ENDDO
                0327       ENDDO
bb79aa40f5 Jean*0328       IF ( DWNSLP_ioUnit.GT.0 .AND. debugLevel.LT.debLevD ) THEN
                0329         CLOSE(DWNSLP_ioUnit)
                0330         DWNSLP_ioUnit = 0
                0331       ENDIF
b6bbe8cccf Jean*0332 
                0333       _END_MASTER(myThid)
                0334 
                0335 #ifdef ALLOW_DIAGNOSTICS
                0336       IF ( useDiagnostics ) THEN
                0337         CALL DWNSLP_DIAGNOSTICS_INIT( myThid )
                0338       ENDIF
                0339 #endif
                0340 
                0341 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0342 
                0343 #endif /* ALLOW_DOWN_SLOPE */
                0344       RETURN
                0345       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!