Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:43:05 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
c3afacc940 Jean*0001 #include "RBCS_OPTIONS.h"
5a13c92ce6 Step*0002 
                0003 C !INTERFACE: ==========================================================
c3afacc940 Jean*0004       SUBROUTINE RBCS_INIT_FIXED( myThid )
5a13c92ce6 Step*0005 
                0006 C !DESCRIPTION:
a16c4403c6 Jean*0007 C calls subroutines that initializes fixed variables for relaxed
5a13c92ce6 Step*0008 c boundary conditions
                0009 
                0010 C !USES: ===============================================================
                0011       IMPLICIT NONE
                0012 #include "SIZE.h"
                0013 #include "EEPARAMS.h"
                0014 #include "PARAMS.h"
a16c4403c6 Jean*0015 #include "GRID.h"
5a13c92ce6 Step*0016 #ifdef ALLOW_PTRACERS
d89d005be6 Jean*0017 # include "PTRACERS_SIZE.h"
                0018 # include "PTRACERS_PARAMS.h"
5a13c92ce6 Step*0019 #endif
a16c4403c6 Jean*0020 #include "RBCS_SIZE.h"
                0021 #include "RBCS_PARAMS.h"
                0022 #include "RBCS_FIELDS.h"
5a13c92ce6 Step*0023 
                0024 C !INPUT PARAMETERS: ===================================================
c3afacc940 Jean*0025 C  myThid               :: my Thread Id number
5a13c92ce6 Step*0026       INTEGER myThid
                0027 CEOP
                0028 
                0029 #ifdef ALLOW_RBCS
d89d005be6 Jean*0030 C     !FUNCTIONS:
                0031       INTEGER  ILNBLNK
                0032       EXTERNAL ILNBLNK
                0033 
5a13c92ce6 Step*0034 C     !LOCAL VARIABLES:
a16c4403c6 Jean*0035 C     i,j,k,bi,bj,irbc  :: loop indices
                0036 C     msgBuf      :: Informational/error message buffer
5a13c92ce6 Step*0037       INTEGER i,j,k,bi,bj
d89d005be6 Jean*0038       INTEGER irbc, iLen
a16c4403c6 Jean*0039       CHARACTER*(MAX_LEN_MBUF) msgBuf
915632ad4e Jean*0040       CHARACTER*(12) filName
d89d005be6 Jean*0041 #ifdef ALLOW_PTRACERS
                0042       INTEGER iTr
                0043 #endif
                0044 
                0045 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0046 C     Report RBCS mask setting
                0047 
                0048       _BEGIN_MASTER(myThid)
                0049 
                0050       WRITE(msgBuf,'(2A)') ' '
                0051       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0052      &                    SQUEEZE_RIGHT, myThid )
                0053       WRITE(msgBuf,'(2A)') ' ---  RBCS_INIT_FIXED:',
                0054      &                     ' setting RBCS mask  ---'
                0055       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0056      &                    SQUEEZE_RIGHT, myThid )
                0057 
                0058       IF ( useRBCtemp ) THEN
                0059         irbc = MIN(maskLEN,1)
63f94a92e5 Jean*0060         IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
d89d005be6 Jean*0061          WRITE(msgBuf,'(2A,I3,2A)') '** WARNING ** RBCS_INIT_FIXED:',
                0062      &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
                0063      &     ' for Temp'
                0064          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0065      &                       SQUEEZE_RIGHT, myThid )
                0066          WRITE(msgBuf,'(2A,I3,2A)') 'Warning:',
                0067      &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
                0068      &     ' for Temp'
                0069          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0070      &                       SQUEEZE_RIGHT, myThid )
                0071         ELSE
63f94a92e5 Jean*0072          iLen = ILNBLNK(relaxMaskTrFile(irbc))
d89d005be6 Jean*0073          WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
63f94a92e5 Jean*0074      &     ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
d89d005be6 Jean*0075          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0076      &                       SQUEEZE_RIGHT, myThid )
                0077          WRITE(msgBuf,'(A,1PE21.13)')
                0078      &     ' for Temp  relaxation with tauRelaxT =', tauRelaxT
                0079          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0080      &                       SQUEEZE_RIGHT, myThid )
                0081         ENDIF
                0082       ENDIF
                0083       IF ( useRBCsalt ) THEN
                0084         irbc = MIN(maskLEN,2)
63f94a92e5 Jean*0085         IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
d89d005be6 Jean*0086          WRITE(msgBuf,'(2A,I3,2A)') '** WARNING ** RBCS_INIT_FIXED:',
                0087      &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
                0088      &     ' for Salt'
                0089          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0090      &                       SQUEEZE_RIGHT, myThid )
                0091          WRITE(msgBuf,'(2A,I3,2A)') 'Warning:',
                0092      &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
                0093      &     ' for Salt'
                0094          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0095      &                       SQUEEZE_RIGHT, myThid )
                0096         ELSE
63f94a92e5 Jean*0097          iLen = ILNBLNK(relaxMaskTrFile(irbc))
d89d005be6 Jean*0098          WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
63f94a92e5 Jean*0099      &     ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
d89d005be6 Jean*0100          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0101      &                       SQUEEZE_RIGHT, myThid )
                0102          WRITE(msgBuf,'(A,1PE21.13)')
                0103      &     ' for Salt  relaxation with tauRelaxS =', tauRelaxS
                0104          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0105      &                       SQUEEZE_RIGHT, myThid )
                0106         ENDIF
                0107       ENDIF
                0108       IF ( useRBCuVel ) THEN
                0109         IF ( relaxMaskUFile.EQ. ' ' ) THEN
85a5afa1fe Jean*0110          WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
d89d005be6 Jean*0111      &     ' relaxMaskUFile unset ==> use Temp mask instead'
                0112          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0113      &                       SQUEEZE_RIGHT, myThid )
85a5afa1fe Jean*0114          WRITE(msgBuf,'(2A)') 'Warning:',
d89d005be6 Jean*0115      &     ' relaxMaskUFile unset ==> use Temp mask instead'
                0116          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0117      &                       SQUEEZE_RIGHT, myThid )
                0118         ELSE
                0119          iLen = ILNBLNK(relaxMaskUFile)
85a5afa1fe Jean*0120          WRITE(msgBuf,'(A,3A)') 'Use relaxMaskUFile',
d89d005be6 Jean*0121      &     ' = "', relaxMaskUFile(1:iLen), '"'
                0122          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0123      &                       SQUEEZE_RIGHT, myThid )
                0124         ENDIF
                0125          WRITE(msgBuf,'(A,1PE21.13)')
                0126      &     ' for U-Vel relaxation with tauRelaxU =', tauRelaxU
                0127          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0128      &                       SQUEEZE_RIGHT, myThid )
                0129       ENDIF
                0130       IF ( useRBCvVel ) THEN
                0131         IF ( relaxMaskVFile.EQ. ' ' ) THEN
85a5afa1fe Jean*0132          WRITE(msgBuf,'(2A)') '** WARNING ** RBCS_INIT_FIXED:',
d89d005be6 Jean*0133      &     ' relaxMaskVFile unset ==> use Temp mask instead'
                0134          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0135      &                       SQUEEZE_RIGHT, myThid )
85a5afa1fe Jean*0136          WRITE(msgBuf,'(2A)') 'Warning:',
d89d005be6 Jean*0137      &     ' relaxMaskVFile unset ==> use Temp mask instead'
                0138          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0139      &                       SQUEEZE_RIGHT, myThid )
                0140         ELSE
                0141          iLen = ILNBLNK(relaxMaskVFile)
85a5afa1fe Jean*0142          WRITE(msgBuf,'(A,3A)') 'Use relaxMaskVFile',
d89d005be6 Jean*0143      &     ' = "', relaxMaskVFile(1:iLen), '"'
                0144          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0145      &                       SQUEEZE_RIGHT, myThid )
                0146         ENDIF
                0147          WRITE(msgBuf,'(A,1PE21.13)')
                0148      &     ' for V-Vel relaxation with tauRelaxV =', tauRelaxV
                0149          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0150      &                       SQUEEZE_RIGHT, myThid )
                0151       ENDIF
                0152 #ifdef ALLOW_PTRACERS
                0153       IF ( usePTRACERS .AND. PTRACERS_numInUse.GE.1 ) THEN
                0154        DO iTr=1,PTRACERS_numInUse
                0155         IF ( useRBCpTrNum(iTr) ) THEN
                0156          irbc = MIN(maskLEN,2+iTr)
63f94a92e5 Jean*0157          IF ( relaxMaskTrFile(irbc).EQ.' ' ) THEN
d89d005be6 Jean*0158           WRITE(msgBuf,'(2A,I3,2A,I3)')
                0159      &     '** WARNING ** RBCS_INIT_FIXED:',
                0160      &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
                0161      &     ' for pTr=', iTr
                0162           CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0163      &                        SQUEEZE_RIGHT, myThid )
                0164           WRITE(msgBuf,'(2A,I3,2A,I3)') 'Warning:',
                0165      &     ' relaxMaskFile(irbc=', irbc, ') unset ==> No relaxation',
                0166      &     ' for pTr=', iTr
                0167           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0168      &                        SQUEEZE_RIGHT, myThid )
                0169          ELSE
63f94a92e5 Jean*0170           iLen = ILNBLNK(relaxMaskTrFile(irbc))
d89d005be6 Jean*0171           WRITE(msgBuf,'(A,I3,3A)') 'Use relaxMaskFile(irbc=', irbc,
63f94a92e5 Jean*0172      &     ') = "', relaxMaskTrFile(irbc)(1:iLen), '"'
d89d005be6 Jean*0173           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0174      &                        SQUEEZE_RIGHT, myThid )
                0175           WRITE(msgBuf,'(A,I3,A,1PE21.13)')
                0176      &     ' for pTr=', iTr, ' relaxation, tauRelaxPTR =',
                0177      &                          tauRelaxPTR(iTr)
                0178           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0179      &                        SQUEEZE_RIGHT, myThid )
                0180          ENDIF
                0181         ENDIF
                0182        ENDDO
                0183       ENDIF
                0184 #endif /* ALLOW_PTRACERS */
                0185 
                0186       _END_MASTER(myThid)
a16c4403c6 Jean*0187 
                0188 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0189 
                0190 #ifndef DISABLE_RBCS_MOM
                0191 C     Loop over tiles
                0192       DO bj = myByLo(myThid), myByHi(myThid)
                0193        DO bi = myBxLo(myThid), myBxHi(myThid)
                0194          DO k=1,Nr
63f94a92e5 Jean*0195           DO j=1-OLy,sNy+OLy
                0196            DO i=1-OLx,sNx+OLx
a16c4403c6 Jean*0197              RBC_maskU(i,j,k,bi,bj) = 0. _d 0
                0198              RBC_maskV(i,j,k,bi,bj) = 0. _d 0
                0199            ENDDO
                0200           ENDDO
                0201          ENDDO
                0202        ENDDO
                0203       ENDDO
                0204 #endif /* DISABLE_RBCS_MOM */
5a13c92ce6 Step*0205 
c3afacc940 Jean*0206 C     Loop over mask index
                0207       DO irbc=1,maskLEN
5a13c92ce6 Step*0208 
c3afacc940 Jean*0209 C     Loop over tiles
5a13c92ce6 Step*0210         DO bj = myByLo(myThid), myByHi(myThid)
c3afacc940 Jean*0211          DO bi = myBxLo(myThid), myBxHi(myThid)
5a13c92ce6 Step*0212 
c3afacc940 Jean*0213 C        Initialize arrays in common blocks :
                0214            DO k=1,Nr
63f94a92e5 Jean*0215             DO j=1-OLy,sNy+OLy
                0216              DO i=1-OLx,sNx+OLx
c3afacc940 Jean*0217                RBC_mask(i,j,k,bi,bj,irbc) = 0. _d 0
                0218              ENDDO
5a13c92ce6 Step*0219             ENDDO
c3afacc940 Jean*0220            ENDDO
5a13c92ce6 Step*0221 
c3afacc940 Jean*0222 C        end bi,bj loops
                0223          ENDDO
                0224         ENDDO
                0225 C     end of mask index loop
5a13c92ce6 Step*0226       ENDDO
                0227 
                0228 C read in mask for relaxing
c3afacc940 Jean*0229       DO irbc=1,maskLEN
63f94a92e5 Jean*0230        IF ( relaxMaskTrFile(irbc).NE. ' ' ) THEN
                0231          CALL READ_FLD_XYZ_RS( relaxMaskTrFile(irbc), ' ',
                0232      &                RBC_mask(1-OLx,1-OLy,1,1,1,irbc), 0, myThid )
                0233          CALL EXCH_XYZ_RS( RBC_mask(1-OLx,1-OLy,1,1,1,irbc), myThid )
a16c4403c6 Jean*0234 C--   Apply mask:
                0235          DO bj = myByLo(myThid), myByHi(myThid)
                0236           DO bi = myBxLo(myThid), myBxHi(myThid)
                0237            DO k=1,Nr
63f94a92e5 Jean*0238             DO j=1-OLy,sNy+OLy
                0239              DO i=1-OLx,sNx+OLx
a16c4403c6 Jean*0240                RBC_mask(i,j,k,bi,bj,irbc) = RBC_mask(i,j,k,bi,bj,irbc)
                0241      &                                    * maskC(i,j,k,bi,bj)
                0242              ENDDO
                0243             ENDDO
                0244            ENDDO
                0245           ENDDO
                0246          ENDDO
8830b8f970 Jean*0247          IF ( debugLevel.GE.debLevC ) THEN
915632ad4e Jean*0248            WRITE(filName,'(A,I3.3)') 'RBC_mask_',irbc
                0249            CALL WRITE_FLD_XYZ_RS( filName,' ',
63f94a92e5 Jean*0250      &                RBC_mask(1-OLx,1-OLy,1,1,1,irbc), 0, myThid )
915632ad4e Jean*0251          ENDIF
1830fa7b80 Step*0252        ENDIF
c3afacc940 Jean*0253       ENDDO
                0254 
a16c4403c6 Jean*0255 #ifndef DISABLE_RBCS_MOM
                0256       IF ( useRBCuVel .AND. relaxMaskUFile.NE. ' ' ) THEN
                0257         CALL READ_FLD_XYZ_RS(relaxMaskUFile,' ',RBC_maskU, 0, myThid)
                0258       ELSEIF( useRBCuVel ) THEN
                0259         DO bj = myByLo(myThid), myByHi(myThid)
                0260          DO bi = myBxLo(myThid), myBxHi(myThid)
                0261            DO k=1,Nr
63f94a92e5 Jean*0262             DO j=1-OLy,sNy+OLy
                0263              DO i=2-OLx,sNx+OLx
a16c4403c6 Jean*0264                RBC_maskU(i,j,k,bi,bj) =
                0265      &                  ( RBC_mask(i-1,j,k,bi,bj,1)
                0266      &                  + RBC_mask( i ,j,k,bi,bj,1) )*0.5 _d 0
                0267              ENDDO
                0268             ENDDO
                0269            ENDDO
                0270          ENDDO
                0271         ENDDO
                0272       ENDIF
                0273       IF ( useRBCvVel .AND. relaxMaskVFile.NE. ' ' ) THEN
                0274         CALL READ_FLD_XYZ_RS(relaxMaskVFile,' ',RBC_maskV, 0, myThid)
                0275       ELSEIF( useRBCvVel ) THEN
                0276         DO bj = myByLo(myThid), myByHi(myThid)
                0277          DO bi = myBxLo(myThid), myBxHi(myThid)
                0278            DO k=1,Nr
63f94a92e5 Jean*0279             DO j=2-OLy,sNy+OLy
                0280              DO i=1-OLx,sNx+OLx
a16c4403c6 Jean*0281                RBC_maskV(i,j,k,bi,bj) =
                0282      &                  ( RBC_mask(i,j-1,k,bi,bj,1)
                0283      &                  + RBC_mask(i, j ,k,bi,bj,1) )*0.5 _d 0
                0284              ENDDO
                0285             ENDDO
                0286            ENDDO
                0287          ENDDO
                0288         ENDDO
                0289       ENDIF
                0290       IF( useRBCuVel .OR. useRBCvVel ) THEN
                0291          CALL EXCH_UV_XYZ_RS( RBC_maskU, RBC_maskV, .FALSE., myThid )
                0292 C--   Apply mask:
                0293          DO bj = myByLo(myThid), myByHi(myThid)
                0294           DO bi = myBxLo(myThid), myBxHi(myThid)
                0295            DO k=1,Nr
63f94a92e5 Jean*0296             DO j=1-OLy,sNy+OLy
                0297              DO i=1-OLx,sNx+OLx
a16c4403c6 Jean*0298                RBC_maskU(i,j,k,bi,bj) = RBC_maskU(i,j,k,bi,bj)
                0299      &                                * maskW(i,j,k,bi,bj)
                0300                RBC_maskV(i,j,k,bi,bj) = RBC_maskV(i,j,k,bi,bj)
                0301      &                                * maskS(i,j,k,bi,bj)
                0302              ENDDO
                0303             ENDDO
                0304            ENDDO
                0305           ENDDO
                0306          ENDDO
8830b8f970 Jean*0307          IF ( debugLevel.GE.debLevC ) THEN
915632ad4e Jean*0308            CALL WRITE_FLD_XYZ_RS('RBC_maskU',' ',RBC_maskU,0,myThid )
                0309            CALL WRITE_FLD_XYZ_RS('RBC_maskV',' ',RBC_maskV,0,myThid )
                0310          ENDIF
a16c4403c6 Jean*0311       ENDIF
                0312 #endif /* DISABLE_RBCS_MOM */
                0313 
d89d005be6 Jean*0314       _BEGIN_MASTER(myThid)
                0315       WRITE(msgBuf,'(2A)') ' ---  RBCS_INIT_FIXED:',
                0316      &                     ' setting RBCS mask done'
                0317       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0318      &                    SQUEEZE_RIGHT, myThid )
                0319       _END_MASTER(myThid)
                0320 
5a13c92ce6 Step*0321 #endif /* ALLOW_RBCS */
                0322 
                0323       RETURN
                0324       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!