Back to home page

MITgcm
 
 

    

File indexing completed on 2021-11-06 05:18:33 UTC

view on githubraw file Latest commit 016b84c4 on 2021-11-02 20:24:44 UTC
50f1081522 Jean*0001 #include "OPPS_OPTIONS.h"
893df04db0 Mart*0002 
                0003 CBOP
                0004 C     !ROUTINE: OPPS_INTERFACE
                0005 C     !INTERFACE:
                0006       SUBROUTINE OPPS_INTERFACE(
                0007      I       bi, bj, iMin, iMax, jMin, jMax,
                0008      I       myTime, myIter, myThid )
                0009 C     !DESCRIPTION: \bv
                0010 C     *================================================================*
                0011 C     | SUBROUTINE OPPS_INTERFACE                                      |
                0012 C     | o Driver for OPPS mixing scheme that can be called             |
                0013 C     |   instead of convective_adjustment.                            |
                0014 C     |   Reference: Paluszkiewicz+Romea, Dynamics of Atmospheres and  |
                0015 C     |   Oceans (1997) 26, pp. 95-130                                 |
                0016 C     | o Support for passive tracers by joint treatment of            |
                0017 C     |   active (theta, salt) and passive tracers. The array          |
                0018 C     |   tracerLoc(Nr,2+PTRACERS_num) contains                        |
                0019 C     |   theta    = tracerLoc(:,1),                                   |
                0020 C     |   salt     = tracerLoc(:,2), and                               |
                0021 C     |   ptracers = tracerLoc(:,3:PTRACERS_num+2). For this to        |
                0022 C     |   work, the routine opps_calc had to be modified               |
                0023 C     |   considerably. opps_calc is based on nlopps.F but there is    |
                0024 C     |   is little left of the original (see opps_calc.F)             |
                0025 C     *================================================================*
                0026 C     \ev
                0027 
                0028 C     !USES:
                0029       IMPLICIT NONE
                0030 C     == Global data ==
                0031 #include "SIZE.h"
                0032 #include "EEPARAMS.h"
                0033 #include "PARAMS.h"
                0034 #include "DYNVARS.h"
                0035 #include "GRID.h"
                0036 #include "OPPS.h"
                0037 #ifdef ALLOW_PTRACERS
                0038 #include "PTRACERS_SIZE.h"
5c06315546 Jean*0039 #include "PTRACERS_PARAMS.h"
                0040 #include "PTRACERS_FIELDS.h"
893df04db0 Mart*0041 #endif
                0042 
                0043 C     !INPUT/OUTPUT PARAMETERS:
                0044 C     == Routine arguments ==
016b84c482 Mart*0045 C     bi, bj :: tile indices
                0046 C     iMin, iMax, jMin, jMax :: Loop range
                0047 C     myTime :: Current time in simulation
                0048 C     myIter :: Current iteration in simulation
                0049 C     myThid :: Thread number of this instance of S/R CONVECT
                0050       INTEGER bi, bj, iMin, iMax, jMin, jMax
893df04db0 Mart*0051       _RL myTime
                0052       INTEGER myIter
                0053       INTEGER myThid
                0054 
016b84c482 Mart*0055 #ifdef ALLOW_OPPS_SNAPSHOT
                0056 C     !FUNCTIONS:
                0057       LOGICAL  DIFFERENT_MULTIPLE
                0058       EXTERNAL DIFFERENT_MULTIPLE
                0059 #endif
893df04db0 Mart*0060 
                0061 C     !LOCAL VARIABLES:
                0062 C     == Local variables ==
016b84c482 Mart*0063 C     OPPSconvectCount :: counter for freqency of convection events
                0064 C     msgBuf           :: Informational/error message buffer
893df04db0 Mart*0065       INTEGER nTracer
                0066 #ifdef ALLOW_PTRACERS
                0067       PARAMETER( nTracer = 2+PTRACERS_num )
98ea03b340 Jean*0068       INTEGER itr
893df04db0 Mart*0069 #else /* not ALLOW_PTRACERS */
                0070       PARAMETER( nTracer = 2 )
                0071 #endif /* ALLOW_PTRACERS */
98ea03b340 Jean*0072       INTEGER I, J, K, kMax
                0073       INTEGER nTracerInUse
893df04db0 Mart*0074       _RL tMin, tMax, sMin, sMax
                0075       _RL tMinNew, tMaxNew, sMinNew, sMaxNew
98ea03b340 Jean*0076       _RL wVelLoc(Nr)
893df04db0 Mart*0077       _RL tracerLoc(Nr,nTracer)
016b84c482 Mart*0078       _RL OPPSconvectCount(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
893df04db0 Mart*0079       CHARACTER*(MAX_LEN_MBUF) msgBuf
016b84c482 Mart*0080 #ifdef ALLOW_OPPS_SNAPSHOT
                0081       CHARACTER*(10) suff
                0082 #endif
893df04db0 Mart*0083 CEOP
                0084 
                0085 C     initialization
                0086 #ifdef ALLOW_PTRACERS
                0087       nTracerInUse = 2+PTRACERS_numInUse
                0088 #else
                0089       nTracerInUse = 2
                0090 #endif /* ALLOW_PTRACERS */
                0091       tMax    = -1. _d 23
                0092       tMin    =  1. _d 23
                0093       sMax    = -1. _d 23
                0094       sMin    =  1. _d 23
                0095       tMaxNew = -1. _d 23
                0096       tMinNew =  1. _d 23
                0097       sMaxNew = -1. _d 23
                0098       sMinNew =  1. _d 23
                0099       tMinNew =  1. _d 23
016b84c482 Mart*0100 C     Initialize convection counter
98ea03b340 Jean*0101       DO K=1,Nr
016b84c482 Mart*0102        DO J=1-OLy,sNy+OLy
                0103         DO I=1-OLx,sNx+OLx
                0104          OPPSconvectCount(I,J,K) = 0. _d 0
893df04db0 Mart*0105         ENDDO
                0106        ENDDO
                0107       ENDDO
5c06315546 Jean*0108 
893df04db0 Mart*0109       DO J=jMin,jMax
                0110        DO I=iMin,iMax
98ea03b340 Jean*0111         IF ( kSurfC(I,J,bi,bj) .LE. Nr ) THEN
893df04db0 Mart*0112          IF ( useGCMwVel ) THEN
                0113           DO K=1,Nr
                0114            tracerLoc(K,1) = theta(I,J,K,bi,bj)
                0115            tracerLoc(K,2)  = salt(I,J,K,bi,bj)
                0116            wVelLoc(K)  = wVel(I,J,K,bi,bj)
5c06315546 Jean*0117           ENDDO
893df04db0 Mart*0118          ELSE
                0119           DO K=1,Nr
                0120            tracerLoc(K,1) = theta(I,J,K,bi,bj)
                0121            tracerLoc(K,2)  = salt(I,J,K,bi,bj)
                0122            wVelLoc(K)  = - VERTICAL_VELOCITY
5c06315546 Jean*0123           ENDDO
893df04db0 Mart*0124          ENDIF
                0125 #ifdef ALLOW_PTRACERS
98ea03b340 Jean*0126          DO itr = 3, nTracerInUse
893df04db0 Mart*0127           DO K=1,Nr
98ea03b340 Jean*0128            tracerLoc(K,itr) = ptracer(I,J,K,bi,bj,itr-2)
893df04db0 Mart*0129           ENDDO
5c06315546 Jean*0130          ENDDO
893df04db0 Mart*0131 #endif /* ALLOW_PTRACERS */
                0132 #ifdef ALLOW_OPPS_DEBUG
                0133          IF ( OPPSdebugLevel .GE. debLevA ) THEN
                0134 C     determine range of temperature and salinity
                0135           tMax = -1. d 23
                0136           tMin =  1. d 23
                0137           sMax = -1. d 23
                0138           sMin =  1. d 23
                0139           DO K=1,Nr
                0140            tMax = MAX(tracerLoc(K,1),tMax)
                0141            tMin = MAX(tracerLoc(K,1),tMin)
                0142            sMax = MAX(tracerLoc(K,2),sMax)
                0143            sMin = MAX(tracerLoc(K,2),sMin)
                0144           ENDDO
                0145          ENDIF
                0146 #endif /* ALLOW_OPPS_DEBUG */
                0147          kMax = kLowC(I,J,bi,bj)
                0148          CALL OPPS_CALC(
                0149      U        tracerLoc,
016b84c482 Mart*0150      O        OPPSconvectCount,
                0151      I        wVelLoc, kMax, nTracer, nTracerInUse,
                0152      I        I, J, bi, bj, myTime, myIter, myThid )
5c06315546 Jean*0153 #ifdef ALLOW_OPPS_DEBUG
893df04db0 Mart*0154          IF ( OPPSdebugLevel .GE. debLevA ) THEN
                0155 C     determine range of temperature and salinity
                0156           tMaxNew = -1. d 23
                0157           tMinNew =  1. d 23
                0158           sMaxNew = -1. d 23
                0159           sMinNew =  1. d 23
                0160           DO K=1,Nr
                0161            tMaxNew = MAX(tracerLoc(K,1),tMaxNew)
                0162            tMinNew = MAX(tracerLoc(K,1),tMinNew)
                0163            sMaxNew = MAX(tracerLoc(K,2),sMaxNew)
                0164            sMinNew = MAX(tracerLoc(K,2),sMinNew)
                0165           ENDDO
                0166           IF ( tMaxNew.GT.tMax .OR. tMinNew.LT.tMin .OR.
                0167      &         sMaxNew.GT.sMax .OR. sMinNew.LT.sMIN ) THEN
                0168            WRITE(msgBuf,'(A,A)') 'OPPS_INTERFACE: theta or S-range is',
                0169      &          ' larger than before mixing'
                0170            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
98ea03b340 Jean*0171      &          SQUEEZE_RIGHT , myThid )
893df04db0 Mart*0172            WRITE(msgBuf,'(A,2I5)') '                for (i,j) = ', I,J
                0173            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
98ea03b340 Jean*0174      &          SQUEEZE_RIGHT , myThid )
893df04db0 Mart*0175           ENDIF
                0176          ENDIF
                0177 #endif /* ALLOW_OPPS_DEBUG */
                0178          DO K=1,Nr
                0179           theta(I,J,K,bi,bj) = tracerLoc(K,1)
                0180           salt(I,J,K,bi,bj)  = tracerLoc(K,2)
5c06315546 Jean*0181          ENDDO
893df04db0 Mart*0182 #ifdef ALLOW_PTRACERS
98ea03b340 Jean*0183          DO itr = 3, nTracerInUse
893df04db0 Mart*0184           DO K=1,Nr
98ea03b340 Jean*0185            ptracer(I,J,K,bi,bj,itr-2) = tracerLoc(K,itr)
893df04db0 Mart*0186           ENDDO
5c06315546 Jean*0187          ENDDO
893df04db0 Mart*0188 #endif /* ALLOW_PTRACERS */
5c06315546 Jean*0189         ENDIF
893df04db0 Mart*0190        ENDDO
                0191       ENDDO
016b84c482 Mart*0192 
                0193 #ifdef ALLOW_DIAGNOSTICS
                0194       IF ( useDiagnostics ) THEN
                0195        CALL DIAGNOSTICS_FILL( OPPSconvectCount, 'OPPScadj',
                0196      &                        0 , Nr, 2, bi, bj, myThid )
                0197       ENDIF
                0198 #endif /* ALLOW_DIAGNOSTICS */
                0199 
                0200 #ifdef ALLOW_OPPS_SNAPSHOT
                0201       IF ( DIFFERENT_MULTIPLE( dumpFreq, myTime, deltaTClock ) ) THEN
                0202 c      IF (OPPSwriteState) THEN
                0203 C       Write each snap-shot as a new file
                0204 C- Caution: This might not work in multi-threaded with multiple fields to write
                0205         WRITE(suff,'(I10.10)') myIter
                0206         CALL WRITE_LOCAL_RL( 'OPPSconv.', suff, Nr, OPPSconvectCount,
                0207      &                       bi, bj, 1, myIter, myThid )
                0208 c      ENDIF
                0209       ENDIF
                0210 #endif /* ALLOW_OPPS_SNAPSHOT */
893df04db0 Mart*0211 
                0212       RETURN
                0213       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!