Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit 672b8226 on 2024-05-18 15:32:33 UTC
42c525bfb4 Alis*0001 #include "OBCS_OPTIONS.h"
                0002 
89af82137f Jean*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: OBCS_INIT_FIXED
                0006 
                0007 C     !INTERFACE:
42c525bfb4 Alis*0008       SUBROUTINE OBCS_INIT_FIXED( myThid )
89af82137f Jean*0009 
                0010 C     !DESCRIPTION:
cf2908d436 Jean*0011 C     *==========================================================*
                0012 C     | SUBROUTINE OBCS_INIT_FIXED
                0013 C     | o Initialise OBCs fixed arrays
                0014 C     *==========================================================*
89af82137f Jean*0015 
                0016 C     !USES:
42c525bfb4 Alis*0017       IMPLICIT NONE
                0018 
                0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
7af3d6f22c Jean*0023 #include "GRID.h"
9b4f2a04e2 Jean*0024 #include "OBCS_PARAMS.h"
                0025 #include "OBCS_GRID.h"
672b822630 Jean*0026 #ifdef ALLOW_OBCS_TIDES
                0027 # include "OBCS_FIELDS.h"
                0028 #endif
42c525bfb4 Alis*0029 
89af82137f Jean*0030 C     !INPUT/OUTPUT PARAMETERS:
87ec912e7f Jean*0031 C     myThid   :: my Thread Id. number
42c525bfb4 Alis*0032       INTEGER myThid
89af82137f Jean*0033 CEOP
42c525bfb4 Alis*0034 
                0035 #ifdef ALLOW_OBCS
89af82137f Jean*0036 C     !LOCAL VARIABLES:
6646af77e1 Jean*0037 C     msgBuf   :: Informational/error message buffer
87ec912e7f Jean*0038 C     OB_ApplX :: number of grid points (in X dir) overwritten by obcs_apply
                0039 C     OB_ApplY :: number of grid points (in Y dir) overwritten by obcs_apply
                0040 C     bi,bj    :: tile indices
                0041 C     i, j     :: Loop counters
6646af77e1 Jean*0042       CHARACTER*(MAX_LEN_MBUF) msgBuf, errMsg
87ec912e7f Jean*0043       INTEGER OB_ApplX
                0044       INTEGER OB_ApplY
42c525bfb4 Alis*0045       INTEGER bi, bj
87ec912e7f Jean*0046       INTEGER  i, j
6910a0b3a6 Jean*0047       INTEGER im, jm
87ec912e7f Jean*0048       INTEGER iB, jB
                0049       LOGICAL flag
6646af77e1 Jean*0050       INTEGER ioUnit
672b822630 Jean*0051 #ifdef ALLOW_OBCS_TIDES
                0052       LOGICAL inCurrentDir
                0053       INTEGER  k, fp
                0054       _RS dummyRS(1)
                0055       _RL recipPeriod, locPh
                0056 #endif
87ec912e7f Jean*0057 
6646af77e1 Jean*0058 #ifdef ALLOW_DEBUG
                0059       IF (debugMode) CALL DEBUG_ENTER('OBCS_INIT_FIXED',myThid)
                0060 #endif
87ec912e7f Jean*0061 
                0062 C==   Set Interior mask at Cell Center:
6646af77e1 Jean*0063 
aa04b5d0aa Jean*0064       DO bj = myByLo(myThid), myByHi(myThid)
                0065        DO bi = myBxLo(myThid), myBxHi(myThid)
                0066         DO j=1-OLy,sNy+OLy
                0067          DO i=1-OLx,sNx+OLx
                0068            OBCS_insideMask(i,j,bi,bj) = 1.
                0069          ENDDO
                0070         ENDDO
                0071        ENDDO
                0072       ENDDO
87ec912e7f Jean*0073 
                0074       IF ( insideOBmaskFile.EQ.' ' ) THEN
                0075 C--   If no maskFile is provided, set Interior mask from OB list of indices
                0076 
                0077        DO bj = myByLo(myThid), myByHi(myThid)
                0078         DO bi = myBxLo(myThid), myBxHi(myThid)
                0079          DO j=1,sNy
                0080 C-    Eastern boundary
74019f026d Jean*0081           IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
87ec912e7f Jean*0082            flag = .TRUE.
                0083            DO i=OB_Ie(j,bi,bj),sNx
                0084              flag = flag .AND.
aa04b5d0aa Jean*0085      &              kSurfC(i,j,bi,bj).LE.Nr .AND. i.NE.OB_Iw(j,bi,bj)
                0086              IF ( flag ) OBCS_insideMask(i,j,bi,bj) = 0.
87ec912e7f Jean*0087            ENDDO
                0088           ENDIF
                0089 C-    Western boundary
74019f026d Jean*0090           IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
87ec912e7f Jean*0091            flag = .TRUE.
                0092            DO i=OB_Iw(j,bi,bj),1,-1
                0093              flag = flag .AND.
aa04b5d0aa Jean*0094      &              kSurfC(i,j,bi,bj).LE.Nr .AND. i.NE.OB_Ie(j,bi,bj)
                0095              IF ( flag ) OBCS_insideMask(i,j,bi,bj) = 0.
87ec912e7f Jean*0096            ENDDO
                0097           ENDIF
                0098          ENDDO
                0099          DO i=1,sNx
                0100 C-    Northern boundary
74019f026d Jean*0101           IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
87ec912e7f Jean*0102            flag = .TRUE.
                0103            DO j=OB_Jn(i,bi,bj),sNy
                0104              flag = flag .AND.
aa04b5d0aa Jean*0105      &              kSurfC(i,j,bi,bj).LE.Nr .AND. j.NE.OB_Js(i,bi,bj)
                0106              IF ( flag ) OBCS_insideMask(i,j,bi,bj) = 0.
87ec912e7f Jean*0107            ENDDO
                0108           ENDIF
                0109 C-    Southern boundary
74019f026d Jean*0110           IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
87ec912e7f Jean*0111            flag = .TRUE.
                0112            DO j=OB_Js(i,bi,bj),1,-1
                0113              flag = flag .AND.
aa04b5d0aa Jean*0114      &              kSurfC(i,j,bi,bj).LE.Nr .AND. j.NE.OB_Jn(i,bi,bj)
                0115              IF ( flag ) OBCS_insideMask(i,j,bi,bj) = 0.
87ec912e7f Jean*0116            ENDDO
                0117           ENDIF
                0118          ENDDO
                0119 
                0120 C--   end bi,bj loops
                0121         ENDDO
                0122        ENDDO
                0123 
                0124       ELSE
                0125 C--   Read in Interior mask from file :
                0126 
aa04b5d0aa Jean*0127        CALL READ_FLD_XY_RS( insideOBmaskFile, ' ', OBCS_insideMask,
                0128      &                      0, myThid )
87ec912e7f Jean*0129 
                0130        DO bj = myByLo(myThid), myByHi(myThid)
                0131         DO bi = myBxLo(myThid), myBxHi(myThid)
                0132          DO j=1,sNy
                0133           DO i=1,sNx
aa04b5d0aa Jean*0134            IF ( OBCS_insideMask(i,j,bi,bj).NE.0. )
                0135      &          OBCS_insideMask(i,j,bi,bj) = 1.
87ec912e7f Jean*0136           ENDDO
                0137          ENDDO
                0138         ENDDO
                0139        ENDDO
                0140 
                0141 C--   end computing/reading Interior mask
                0142       ENDIF
                0143 
                0144 C--   Fill in the overlap:
aa04b5d0aa Jean*0145       _EXCH_XY_RS( OBCS_insideMask, myThid )
87ec912e7f Jean*0146 
                0147 C==   Set interior mask at U & V location (grid-cell Wester & Southern edges)
d4086c624f Jean*0148 C     leave OB edges inside (maskIn=1) (e.g., Eastern OB: maskInW(OB_Ie)=1 )
6910a0b3a6 Jean*0149 C     so that velocity normal-component at OB is still in Interior region.
87ec912e7f Jean*0150       DO bj = myByLo(myThid), myByHi(myThid)
                0151        DO bi = myBxLo(myThid), myBxHi(myThid)
6646af77e1 Jean*0152          DO j=2-OLy,sNy+OLy
                0153           DO i=2-OLx,sNx+OLx
87ec912e7f Jean*0154             maskInW(i,j,bi,bj) = maskInW(i,j,bi,bj)
aa04b5d0aa Jean*0155      &                     *MAX( OBCS_insideMask(i-1,j,bi,bj),
                0156      &                           OBCS_insideMask(i,j,bi,bj) )
87ec912e7f Jean*0157             maskInS(i,j,bi,bj) = maskInS(i,j,bi,bj)
aa04b5d0aa Jean*0158      &                     *MAX( OBCS_insideMask(i,j-1,bi,bj),
                0159      &                           OBCS_insideMask(i,j,bi,bj) )
87ec912e7f Jean*0160           ENDDO
                0161          ENDDO
                0162        ENDDO
                0163       ENDDO
                0164 
                0165 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0166 
6646af77e1 Jean*0167 C--   After exchange, set tiled index arrays OB_Jn/Js/Ie/Iw in overlap region
                0168 C     issue a warning if not consistent (similar to OBCS_CHECK but for overlap)
                0169 
33d0ba7c8f Jean*0170 c     IF ( .TRUE. ) THEN
                0171       IF ( OBCS_indexStatus .LT. 2 ) THEN
6646af77e1 Jean*0172        ioUnit = standardMessageUnit
                0173        WRITE(msgBuf,'(2A)')
                0174      &      'OBCS_INIT_FIXED: Setting OB indices in Overlap'
                0175        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0176        WRITE(errMsg,'(2A)') 'S/R OBCS_INIT_FIXED: ',
                0177      &              'Inside Mask and OB locations disagree :'
                0178        flag = .TRUE.
                0179        DO bj = myByLo(myThid), myByHi(myThid)
                0180         DO bi = myBxLo(myThid), myBxHi(myThid)
                0181 
                0182 C-    Eastern boundary
                0183          DO j=1-OLy,sNy+OLy
                0184           DO i=1,sNx+1
                0185            IF ( OBCS_insideMask(i,j,bi,bj).LT.
                0186      &          OBCS_insideMask(i-1,j,bi,bj)
                0187      &          .AND. ( j.LT.1 .OR. j.GT.sNy )
9ea74cf9a7 Jean*0188      &          .AND. kSurfW(i,j,bi,bj).LE.Nr ) THEN
74019f026d Jean*0189             IF ( OB_Ie(j,bi,bj).EQ.OB_indexNone ) THEN
6646af77e1 Jean*0190               OB_Ie(j,bi,bj) = i
                0191               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0192      &        ' Sets OBE(j,bi,bj=',j,',',bi,',',bj,')=', OB_Ie(j,bi,bj)
                0193               CALL PRINT_MESSAGE( msgBuf,ioUnit,SQUEEZE_RIGHT,myThid )
                0194             ELSEIF ( OB_Ie(j,bi,bj).NE.i ) THEN
                0195               IF ( flag ) CALL PRINT_ERROR( errMsg, myThid )
                0196               flag = .FALSE.
                0197               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0198      &        ' OBE(j,bi,bj=',j,',',bi,',',bj,')=', OB_Ie(j,bi,bj),
                0199      &        ' but from insideMask expects I=', i
                0200               CALL PRINT_ERROR( msgBuf, myThid )
                0201             ENDIF
                0202            ENDIF
                0203           ENDDO
                0204          ENDDO
                0205 C-    Western boundary
                0206          DO j=1-OLy,sNy+OLy
74019f026d Jean*0207           DO i=0,sNx
6646af77e1 Jean*0208            IF ( OBCS_insideMask(i,j,bi,bj).LT.
                0209      &          OBCS_insideMask(i+1,j,bi,bj)
                0210      &          .AND. ( j.LT.1 .OR. j.GT.sNy )
9ea74cf9a7 Jean*0211      &          .AND. kSurfW(i+1,j,bi,bj).LE.Nr ) THEN
74019f026d Jean*0212             IF ( OB_Iw(j,bi,bj).EQ.OB_indexNone ) THEN
6646af77e1 Jean*0213               OB_Iw(j,bi,bj) = i
                0214               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0215      &        ' Sets OBW(j,bi,bj=',j,',',bi,',',bj,')=', OB_Iw(j,bi,bj)
                0216               CALL PRINT_MESSAGE( msgBuf,ioUnit,SQUEEZE_RIGHT,myThid )
                0217             ELSEIF ( OB_Iw(j,bi,bj).NE.i ) THEN
                0218               IF ( flag ) CALL PRINT_ERROR( errMsg, myThid )
                0219               flag = .FALSE.
                0220               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0221      &        ' OBW(j,bi,bj=',j,',',bi,',',bj,')=', OB_Iw(j,bi,bj),
                0222      &        ' but from insideMask expects I=', i
                0223               CALL PRINT_ERROR( msgBuf, myThid )
                0224             ENDIF
                0225            ENDIF
                0226           ENDDO
                0227          ENDDO
                0228 C-    Northern boundary
                0229          DO j=1,sNy+1
                0230           DO i=1-OLx,sNx+OLx
                0231            IF ( OBCS_insideMask(i,j,bi,bj).LT.
                0232      &          OBCS_insideMask(i,j-1,bi,bj)
                0233      &          .AND. ( i.LT.1 .OR. i.GT.sNx )
9ea74cf9a7 Jean*0234      &          .AND. kSurfS(i,j,bi,bj).LE.Nr ) THEN
74019f026d Jean*0235             IF ( OB_Jn(i,bi,bj).EQ.OB_indexNone ) THEN
6646af77e1 Jean*0236               OB_Jn(i,bi,bj) = j
                0237               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0238      &        ' Sets OBN(i,bi,bj=',i,',',bi,',',bj,')=', OB_Jn(i,bi,bj)
                0239               CALL PRINT_MESSAGE( msgBuf,ioUnit,SQUEEZE_RIGHT,myThid )
                0240             ELSEIF ( OB_Jn(i,bi,bj).NE.j ) THEN
                0241               IF ( flag ) CALL PRINT_ERROR( errMsg, myThid )
                0242               flag = .FALSE.
                0243               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0244      &        ' OBN(i,bi,bj=',i,',',bi,',',bj,')=', OB_Jn(i,bi,bj),
                0245      &        ' but from insideMask expects J=', j
                0246               CALL PRINT_ERROR( msgBuf, myThid )
                0247             ENDIF
                0248            ENDIF
                0249           ENDDO
                0250          ENDDO
                0251 C-    Southern boundary
74019f026d Jean*0252          DO j=0,sNy
6646af77e1 Jean*0253           DO i=1-OLx,sNx+OLx
                0254            IF ( OBCS_insideMask(i,j,bi,bj).LT.
                0255      &          OBCS_insideMask(i,j+1,bi,bj)
                0256      &          .AND. ( i.LT.1 .OR. i.GT.sNx )
9ea74cf9a7 Jean*0257      &          .AND. kSurfS(i,j+1,bi,bj).LE.Nr ) THEN
74019f026d Jean*0258             IF ( OB_Js(i,bi,bj).EQ.OB_indexNone ) THEN
6646af77e1 Jean*0259               OB_Js(i,bi,bj) = j
                0260               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0261      &        ' Sets OBS(i,bi,bj=',i,',',bi,',',bj,')=', OB_Js(i,bi,bj)
                0262               CALL PRINT_MESSAGE( msgBuf,ioUnit,SQUEEZE_RIGHT,myThid )
                0263             ELSEIF ( OB_Js(i,bi,bj).NE.j ) THEN
                0264               IF ( flag ) CALL PRINT_ERROR( errMsg, myThid )
                0265               flag = .FALSE.
                0266               WRITE(msgBuf,'(A,I5,2(A,I3),2(A,I5))')
                0267      &        ' OBS(i,bi,bj=',i,',',bi,',',bj,')=', OB_Js(i,bi,bj),
                0268      &        ' but from insideMask expects J=', j
                0269               CALL PRINT_ERROR( msgBuf, myThid )
                0270             ENDIF
                0271            ENDIF
                0272           ENDDO
                0273          ENDDO
                0274 
                0275         ENDDO
                0276        ENDDO
                0277        WRITE(msgBuf,'(2A)')
                0278      &      'OBCS_INIT_FIXED: Setting OB indices in Overlap <= done'
                0279        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0280       ENDIF
                0281 
                0282 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0283 
87ec912e7f Jean*0284 C==   After EXCH: reset Interior mask to zero beyond OB: this is necessary
                0285 C     when EXCH are not disabled (e.g. with EXCH1) between tile Edges
                0286 C     that are closed by OB.
6646af77e1 Jean*0287 C     Do it over OLx,OLy grid points beyond OB, in agreement with OBCS code
87ec912e7f Jean*0288 C     (apply_tracer) which overwrites tracer over the same width.
                0289       OB_ApplX = OLx
                0290       OB_ApplY = OLy
42c525bfb4 Alis*0291 
                0292       DO bj = myByLo(myThid), myByHi(myThid)
                0293        DO bi = myBxLo(myThid), myBxHi(myThid)
                0294 
cf2908d436 Jean*0295 C--   Set Interior mask to zero beyond OB
                0296 C-    Eastern boundary
6910a0b3a6 Jean*0297         DO j=1-OLy,sNy+OLy
6646af77e1 Jean*0298          jm = MAX( j-1, 1-OLy )
87ec912e7f Jean*0299          iB = OB_Ie(j,bi,bj)
74019f026d Jean*0300          IF ( iB.NE.OB_indexNone ) THEN
6910a0b3a6 Jean*0301            DO i=iB,iB+OB_ApplX-1
aa04b5d0aa Jean*0302              OBCS_insideMask(i,j,bi,bj) = 0.
6910a0b3a6 Jean*0303            ENDDO
                0304            DO i=iB+1,iB+OB_ApplX-1
                0305              maskInW(i,j,bi,bj) = 0.
                0306            ENDDO
74019f026d Jean*0307            IF ( OB_Ie(jm,bi,bj).NE.OB_indexNone ) THEN
                0308             iB = MAX( iB, OB_Ie(jm,bi,bj) )
                0309             DO i=iB,iB+OB_ApplX-1
6910a0b3a6 Jean*0310              maskInS(i,j,bi,bj) = 0.
74019f026d Jean*0311             ENDDO
                0312            ENDIF
6910a0b3a6 Jean*0313          ENDIF
                0314         ENDDO
cf2908d436 Jean*0315 C-    Western boundary
6910a0b3a6 Jean*0316         DO j=1-OLy,sNy+OLy
6646af77e1 Jean*0317          jm = MAX( j-1, 1-OLy )
87ec912e7f Jean*0318          iB = OB_Iw(j,bi,bj)
74019f026d Jean*0319          IF ( iB.NE.OB_indexNone ) THEN
6910a0b3a6 Jean*0320            DO i=1-OB_ApplX+iB,iB
aa04b5d0aa Jean*0321              OBCS_insideMask(i,j,bi,bj) = 0.
6910a0b3a6 Jean*0322            ENDDO
                0323            DO i=2-OB_ApplX+iB,iB
                0324              maskInW(i,j,bi,bj) = 0.
                0325            ENDDO
74019f026d Jean*0326            IF ( OB_Iw(jm,bi,bj).NE.OB_indexNone ) THEN
                0327             iB = MIN( iB, OB_Iw(jm,bi,bj) )
                0328             DO i=1-OB_ApplX+iB,iB
6910a0b3a6 Jean*0329              maskInS(i,j,bi,bj) = 0.
74019f026d Jean*0330             ENDDO
                0331            ENDIF
cf2908d436 Jean*0332          ENDIF
                0333         ENDDO
                0334 C-    Northern boundary
6910a0b3a6 Jean*0335         DO i=1-OLx,sNx+OLx
6646af77e1 Jean*0336          im = MAX( i-1, 1-OLx )
87ec912e7f Jean*0337          jB = OB_Jn(i,bi,bj)
74019f026d Jean*0338          IF ( jB.NE.OB_indexNone ) THEN
6910a0b3a6 Jean*0339            DO j=jB,jB+OB_ApplY-1
aa04b5d0aa Jean*0340              OBCS_insideMask(i,j,bi,bj) = 0.
6910a0b3a6 Jean*0341            ENDDO
                0342            DO j=jB+1,jB+OB_ApplY-1
                0343              maskInS(i,j,bi,bj) = 0.
                0344            ENDDO
74019f026d Jean*0345            IF ( OB_Jn(im,bi,bj).NE.OB_indexNone ) THEN
                0346             jB = MAX( jB, OB_Jn(im,bi,bj) )
                0347             DO j=jB,jB+OB_ApplY-1
6910a0b3a6 Jean*0348              maskInW(i,j,bi,bj) = 0.
74019f026d Jean*0349             ENDDO
                0350            ENDIF
6910a0b3a6 Jean*0351          ENDIF
                0352         ENDDO
cf2908d436 Jean*0353 C-    Southern boundary
6910a0b3a6 Jean*0354         DO i=1-OLx,sNx+OLx
6646af77e1 Jean*0355          im = MAX( i-1, 1-OLx )
87ec912e7f Jean*0356          jB = OB_Js(i,bi,bj)
74019f026d Jean*0357          IF ( jB.NE.OB_indexNone ) THEN
6910a0b3a6 Jean*0358            DO j=1-OB_ApplY+jB,jB
aa04b5d0aa Jean*0359              OBCS_insideMask(i,j,bi,bj) = 0.
6910a0b3a6 Jean*0360            ENDDO
                0361            DO j=2-OB_ApplY+jB,jB
                0362              maskInS(i,j,bi,bj) = 0.
                0363            ENDDO
74019f026d Jean*0364            IF ( OB_Js(im,bi,bj).NE.OB_indexNone ) THEN
                0365             jB = MIN( jB, OB_Js(im,bi,bj) )
                0366             DO j=1-OB_ApplY+jB,jB
6910a0b3a6 Jean*0367              maskInW(i,j,bi,bj) = 0.
74019f026d Jean*0368             ENDDO
                0369            ENDIF
cf2908d436 Jean*0370          ENDIF
                0371         ENDDO
                0372 
aa04b5d0aa Jean*0373 C--   Apply mask to maskInC :
6646af77e1 Jean*0374         DO j=1-OLy,sNy+OLy
                0375           DO i=1-OLx,sNx+OLx
aa04b5d0aa Jean*0376             maskInC(i,j,bi,bj) = maskInC(i,j,bi,bj)
                0377      &                          *OBCS_insideMask(i,j,bi,bj)
                0378           ENDDO
                0379         ENDDO
                0380 
cf2908d436 Jean*0381 C--   end bi,bj loops
42c525bfb4 Alis*0382        ENDDO
                0383       ENDDO
                0384 
6646af77e1 Jean*0385 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0386 
                0387 C--   Set OB active tiles:
                0388       DO bj = myByLo(myThid), myByHi(myThid)
                0389        DO bi = myBxLo(myThid), myBxHi(myThid)
                0390          tileHasOBE(bi,bj) = .FALSE.
                0391          tileHasOBW(bi,bj) = .FALSE.
74019f026d Jean*0392          tileHasOBN(bi,bj) = .FALSE.
                0393          tileHasOBS(bi,bj) = .FALSE.
6646af77e1 Jean*0394          DO j=1-OLy,sNy+OLy
74019f026d Jean*0395           tileHasOBE(bi,bj) = tileHasOBE(bi,bj) .OR.
                0396      &                      ( OB_Ie(j,bi,bj).NE.OB_indexNone )
                0397           tileHasOBW(bi,bj) = tileHasOBW(bi,bj) .OR.
                0398      &                      ( OB_Iw(j,bi,bj).NE.OB_indexNone )
6646af77e1 Jean*0399          ENDDO
                0400          DO i=1-OLx,sNx+OLx
74019f026d Jean*0401           tileHasOBN(bi,bj) = tileHasOBN(bi,bj) .OR.
                0402      &                      ( OB_Jn(i,bi,bj).NE.OB_indexNone )
                0403           tileHasOBS(bi,bj) = tileHasOBS(bi,bj) .OR.
                0404      &                      ( OB_Js(i,bi,bj).NE.OB_indexNone )
6646af77e1 Jean*0405          ENDDO
                0406        ENDDO
                0407       ENDDO
                0408 
9ea74cf9a7 Jean*0409 C--   Set domain connected-piece Id for OB grid points:
                0410       CALL OBCS_SET_CONNECT( myThid )
                0411 
672b822630 Jean*0412 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0413 #ifdef ALLOW_OBCS_TIDES
                0414 C==   Set-up OB Tidal forcing
                0415 C     (kept fixed during simulation --> moved here from obcs_init_variables.F)
                0416 
                0417 C--   Initialise Tidal Component coeff:
                0418       DO bj = myByLo(myThid), myByHi(myThid)
                0419        DO bi = myBxLo(myThid), myBxHi(myThid)
                0420         DO k=1,OBCS_tideCompSize
                0421          DO i=1-OLx,sNx+OLx
                0422 # ifdef ALLOW_OBCS_NORTH
                0423           OBN_uTideCs(i,k,bi,bj) = 0. _d 0
                0424           OBN_uTideSn(i,k,bi,bj) = 0. _d 0
                0425           OBN_vTideCs(i,k,bi,bj) = 0. _d 0
                0426           OBN_vTideSn(i,k,bi,bj) = 0. _d 0
                0427 # endif
                0428 # ifdef ALLOW_OBCS_SOUTH
                0429           OBS_uTideCs(i,k,bi,bj) = 0. _d 0
                0430           OBS_uTideSn(i,k,bi,bj) = 0. _d 0
                0431           OBS_vTideCs(i,k,bi,bj) = 0. _d 0
                0432           OBS_vTideSn(i,k,bi,bj) = 0. _d 0
                0433 # endif
                0434          ENDDO
                0435          DO j=1-OLy,sNy+OLy
                0436 # ifdef ALLOW_OBCS_EAST
                0437           OBE_uTideCs(j,k,bi,bj) = 0. _d 0
                0438           OBE_uTideSn(j,k,bi,bj) = 0. _d 0
                0439           OBE_vTideCs(j,k,bi,bj) = 0. _d 0
                0440           OBE_vTideSn(j,k,bi,bj) = 0. _d 0
                0441 # endif
                0442 # ifdef ALLOW_OBCS_WEST
                0443           OBW_uTideCs(j,k,bi,bj) = 0. _d 0
                0444           OBW_uTideSn(j,k,bi,bj) = 0. _d 0
                0445           OBW_vTideCs(j,k,bi,bj) = 0. _d 0
                0446           OBW_vTideSn(j,k,bi,bj) = 0. _d 0
                0447 # endif
                0448          ENDDO
                0449         ENDDO
                0450        ENDDO
                0451       ENDDO
                0452       _BARRIER
                0453 
                0454       IF ( useOBCStides ) THEN
                0455 C--   Read from files Barotropic Tidal Amplitude and Phase:
                0456        fp = readBinaryPrec
                0457        inCurrentDir = .FALSE.
                0458 # ifdef ALLOW_MDSIO
                0459 #  ifdef ALLOW_OBCS_NORTH
                0460        IF ( OBN_uTidAmFile .NE. ' '  )
                0461      &   CALL MDS_READ_SEC_XZ( OBN_uTidAmFile, fp, inCurrentDir, 'RL',
                0462      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0463      &                         OBN_uTideCs, dummyRS, 1, myThid )
                0464        IF ( OBN_uTidPhFile .NE. ' '  )
                0465      &   CALL MDS_READ_SEC_XZ( OBN_uTidPhFile, fp, inCurrentDir, 'RL',
                0466      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0467      &                         OBN_uTideSn, dummyRS, 1, myThid )
                0468        IF ( OBN_vTidAmFile .NE. ' '  )
                0469      &   CALL MDS_READ_SEC_XZ( OBN_vTidAmFile, fp, inCurrentDir, 'RL',
                0470      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0471      &                         OBN_vTideCs, dummyRS, 1, myThid )
                0472        IF ( OBN_vTidPhFile .NE. ' '  )
                0473      &   CALL MDS_READ_SEC_XZ( OBN_vTidPhFile, fp, inCurrentDir, 'RL',
                0474      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0475      &                         OBN_vTideSn, dummyRS, 1, myThid )
                0476 #  endif
                0477 #  ifdef ALLOW_OBCS_SOUTH
                0478        IF ( OBS_uTidAmFile .NE. ' '  )
                0479      &   CALL MDS_READ_SEC_XZ( OBS_uTidAmFile, fp, inCurrentDir, 'RL',
                0480      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0481      &                         OBS_uTideCs, dummyRS, 1, myThid )
                0482        IF ( OBS_uTidPhFile .NE. ' '  )
                0483      &   CALL MDS_READ_SEC_XZ( OBS_uTidPhFile, fp, inCurrentDir, 'RL',
                0484      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0485      &                         OBS_uTideSn, dummyRS, 1, myThid )
                0486        IF ( OBS_vTidAmFile .NE. ' '  )
                0487      &   CALL MDS_READ_SEC_XZ( OBS_vTidAmFile, fp, inCurrentDir, 'RL',
                0488      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0489      &                         OBS_vTideCs, dummyRS, 1, myThid )
                0490        IF ( OBS_vTidPhFile .NE. ' '  )
                0491      &   CALL MDS_READ_SEC_XZ( OBS_vTidPhFile, fp, inCurrentDir, 'RL',
                0492      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0493      &                         OBS_vTideSn, dummyRS, 1, myThid )
                0494 #  endif
                0495 #  ifdef ALLOW_OBCS_EAST
                0496        IF ( OBE_uTidAmFile .NE. ' '  )
                0497      &   CALL MDS_READ_SEC_YZ( OBE_uTidAmFile, fp, inCurrentDir, 'RL',
                0498      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0499      &                         OBE_uTideCs, dummyRS, 1, myThid )
                0500        IF ( OBE_uTidPhFile .NE. ' '  )
                0501      &   CALL MDS_READ_SEC_YZ( OBE_uTidPhFile, fp, inCurrentDir, 'RL',
                0502      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0503      &                         OBE_uTideSn, dummyRS, 1, myThid )
                0504        IF ( OBE_vTidAmFile .NE. ' '  )
                0505      &   CALL MDS_READ_SEC_YZ( OBE_vTidAmFile, fp, inCurrentDir, 'RL',
                0506      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0507      &                         OBE_vTideCs, dummyRS, 1, myThid )
                0508        IF ( OBE_vTidPhFile .NE. ' '  )
                0509      &   CALL MDS_READ_SEC_YZ( OBE_vTidPhFile, fp, inCurrentDir, 'RL',
                0510      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0511      &                         OBE_vTideSn, dummyRS, 1, myThid )
                0512 #  endif
                0513 #  ifdef ALLOW_OBCS_WEST
                0514        IF ( OBW_uTidAmFile .NE. ' '  )
                0515      &   CALL MDS_READ_SEC_YZ( OBW_uTidAmFile, fp, inCurrentDir, 'RL',
                0516      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0517      &                         OBW_uTideCs, dummyRS, 1, myThid )
                0518        IF ( OBW_uTidPhFile .NE. ' '  )
                0519      &   CALL MDS_READ_SEC_YZ( OBW_uTidPhFile, fp, inCurrentDir, 'RL',
                0520      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0521      &                         OBW_uTideSn, dummyRS, 1, myThid )
                0522        IF ( OBW_vTidAmFile .NE. ' '  )
                0523      &   CALL MDS_READ_SEC_YZ( OBW_vTidAmFile, fp, inCurrentDir, 'RL',
                0524      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0525      &                         OBW_vTideCs, dummyRS, 1, myThid )
                0526        IF ( OBW_vTidPhFile .NE. ' '  )
                0527      &   CALL MDS_READ_SEC_YZ( OBW_vTidPhFile, fp, inCurrentDir, 'RL',
                0528      &                         OBCS_tideCompSize, 1, OBCS_nTidalComp,
                0529      &                         OBW_vTideSn, dummyRS, 1, myThid )
                0530 #  endif
                0531 # else /* ALLOW_MDSIO */
                0532        STOP 'ABNORMAL END: S/R OBCS_INIT_FIXED needs pkg/mdsio'
                0533 # endif /* ALLOW_MDSIO */
                0534        _BARRIER
                0535 
                0536 C--   Set Tidal coeff (= Amplit x COS & SIN of Phase ) from Amplitude and Phase:
                0537        DO bj = myByLo(myThid), myByHi(myThid)
                0538         DO bi = myBxLo(myThid), myBxHi(myThid)
                0539          DO k=1,OBCS_nTidalComp
                0540           IF ( OBCS_tidalPeriod(k).NE.zeroRL ) THEN
                0541            recipPeriod = twoRL * PI / OBCS_tidalPeriod(k)
                0542            DO i=1-OLx,sNx+OLx
                0543 # ifdef ALLOW_OBCS_NORTH
                0544             locPh = OBN_uTideSn(i,k,bi,bj)*recipPeriod
                0545             OBN_uTideSn(i,k,bi,bj) = OBN_uTideCs(i,k,bi,bj)*SIN(locPh)
                0546             OBN_uTideCs(i,k,bi,bj) = OBN_uTideCs(i,k,bi,bj)*COS(locPh)
                0547             locPh = OBN_vTideSn(i,k,bi,bj)*recipPeriod
                0548             OBN_vTideSn(i,k,bi,bj) = OBN_vTideCs(i,k,bi,bj)*SIN(locPh)
                0549             OBN_vTideCs(i,k,bi,bj) = OBN_vTideCs(i,k,bi,bj)*COS(locPh)
                0550 # endif
                0551 # ifdef ALLOW_OBCS_SOUTH
                0552             locPh = OBS_uTideSn(i,k,bi,bj)*recipPeriod
                0553             OBS_uTideSn(i,k,bi,bj) = OBS_uTideCs(i,k,bi,bj)*SIN(locPh)
                0554             OBS_uTideCs(i,k,bi,bj) = OBS_uTideCs(i,k,bi,bj)*COS(locPh)
                0555             locPh = OBS_vTideSn(i,k,bi,bj)*recipPeriod
                0556             OBS_vTideSn(i,k,bi,bj) = OBS_vTideCs(i,k,bi,bj)*SIN(locPh)
                0557             OBS_vTideCs(i,k,bi,bj) = OBS_vTideCs(i,k,bi,bj)*COS(locPh)
                0558 # endif
                0559            ENDDO
                0560            DO j=1-OLy,sNy+OLy
                0561 # ifdef ALLOW_OBCS_EAST
                0562             locPh = OBE_uTideSn(j,k,bi,bj)*recipPeriod
                0563             OBE_uTideSn(j,k,bi,bj) = OBE_uTideCs(j,k,bi,bj)*SIN(locPh)
                0564             OBE_uTideCs(j,k,bi,bj) = OBE_uTideCs(j,k,bi,bj)*COS(locPh)
                0565             locPh = OBE_vTideSn(j,k,bi,bj)*recipPeriod
                0566             OBE_vTideSn(j,k,bi,bj) = OBE_vTideCs(j,k,bi,bj)*SIN(locPh)
                0567             OBE_vTideCs(j,k,bi,bj) = OBE_vTideCs(j,k,bi,bj)*COS(locPh)
                0568 # endif
                0569 # ifdef ALLOW_OBCS_WEST
                0570             locPh = OBW_uTideSn(j,k,bi,bj)*recipPeriod
                0571             OBW_uTideSn(j,k,bi,bj) = OBW_uTideCs(j,k,bi,bj)*SIN(locPh)
                0572             OBW_uTideCs(j,k,bi,bj) = OBW_uTideCs(j,k,bi,bj)*COS(locPh)
                0573             locPh = OBW_vTideSn(j,k,bi,bj)*recipPeriod
                0574             OBW_vTideSn(j,k,bi,bj) = OBW_vTideCs(j,k,bi,bj)*SIN(locPh)
                0575             OBW_vTideCs(j,k,bi,bj) = OBW_vTideCs(j,k,bi,bj)*COS(locPh)
                0576 # endif
                0577            ENDDO
                0578           ENDIF
                0579          ENDDO
                0580 C-    end bi.bj loops:
                0581         ENDDO
                0582        ENDDO
                0583 C-    end if useOBCStides
                0584       ENDIF
                0585 
                0586 #endif /* ALLOW_OBCS_TIDES */
                0587 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0588 
6646af77e1 Jean*0589 #ifdef ALLOW_DEBUG
                0590       IF (debugMode) CALL DEBUG_LEAVE('OBCS_INIT_FIXED',myThid)
                0591 #endif
                0592 
42c525bfb4 Alis*0593 #endif /* ALLOW_OBCS */
                0594       RETURN
                0595       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!