File indexing completed on 2021-11-06 05:18:35 UTC
view on githubraw file Latest commit 016b84c4 on 2021-11-02 20:24:44 UTC
08be60903a Mart*0001 #include "PP81_OPTIONS.h"
0002
0003
0004
0005
0006
0007 subroutine PP81_CALC(
dc6107c029 Jean*0008 I bi, bj, sigmaR, myTime, myIter, myThid )
08be60903a Mart*0009
0010
5e48dccc42 Jean*0011
08be60903a Mart*0012
0013
5e48dccc42 Jean*0014
08be60903a Mart*0015
5e48dccc42 Jean*0016
08be60903a Mart*0017
0018
5e48dccc42 Jean*0019
0020
08be60903a Mart*0021
0022
0023
0024
5e48dccc42 Jean*0025 IMPLICIT NONE
08be60903a Mart*0026 #include "SIZE.h"
0027 #include "EEPARAMS.h"
0028 #include "PARAMS.h"
0029 #include "GRID.h"
40cf87ade1 Jean*0030 #ifdef ALLOW_3D_DIFFKR
0031 # include "DYNVARS.h"
0032 #endif
0033 #include "PP81.h"
0034
0035
0036
08be60903a Mart*0037
0038
dc6107c029 Jean*0039
0040
0041
0042
0043
0044
08be60903a Mart*0045 INTEGER bi, bj
dc6107c029 Jean*0046 _RL sigmaR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
08be60903a Mart*0047 _RL myTime
dc6107c029 Jean*0048 INTEGER myIter
5e48dccc42 Jean*0049 INTEGER myThid
08be60903a Mart*0050
0051 #ifdef ALLOW_PP81
0052
0053
0054
0055
0056 INTEGER I, J, K
0057 INTEGER iMin ,iMax ,jMin ,jMax
0058 _RL denom, PPviscTmp
0059 _RL RiNumber(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0060
0061 iMin = 2-OLx
0062 iMax = sNx+OLx-1
0063 jMin = 2-OLy
0064 jMax = sNy+OLy-1
0065
0066 DO K = 2, Nr
0067 CALL PP81_RI_NUMBER(
5e48dccc42 Jean*0068 I bi, bj, K, iMin, iMax, jMin, jMax,
0069 O RiNumber,
08be60903a Mart*0070 I myTime, myThid )
0071 DO J=jMin,jMax
0072 DO I=iMin,iMax
0073 IF ( RiNumber(I,J) .LT. RiLimit ) THEN
0074 denom = 1.0 + PPalpha*RiLimit
0075 PPviscTmp = PPviscMax
0076 ELSE
0077 denom = 1.0 + PPalpha*RiNumber(I,J)
0078 PPviscTmp = PPnu0/(denom**PPnRi)
0079 ENDIF
0080
5e48dccc42 Jean*0081 PPviscAr(I,J,K,bi,bj) = MAX(PPviscTmp,viscArNr(k))
08be60903a Mart*0082 PPdiffKr(I,J,K,bi,bj) = MAX(PPviscAr(I,J,K,bi,bj)/denom,
40cf87ade1 Jean*0083 #ifdef ALLOW_3D_DIFFKR
0084 & diffKr(i,j,k,bi,bj) )
0085 #else
78524d1402 Jean*0086 & diffKrNrS(k) )
40cf87ade1 Jean*0087 #endif
08be60903a Mart*0088
0089
0090
0091
0092 ENDDO
0093 ENDDO
0094 #ifdef ALLOW_PP81_LOWERBOUND
5e48dccc42 Jean*0095
0096
6709240de5 Jean*0097 IF ( (usingZCoords .AND. K .EQ. 2) .OR.
0098 & (usingPCoords .AND. K .EQ. Nr) ) THEN
08be60903a Mart*0099 DO J=jMin,jMax
0100 DO I=iMin,iMax
0101 PPviscAr(I,J,K,bi,bj) = MAX(PPviscMin,PPviscAr(I,J,K,bi,bj))
0102 PPdiffKr(I,J,K,bi,bj) = MAX(PPdiffMin,PPdiffKr(I,J,K,bi,bj))
5e48dccc42 Jean*0103 ENDDO
08be60903a Mart*0104 ENDDO
0105 ENDIF
0106 #endif /* ALLOW_PP81_LOWERBOUND */
0107
0108 DO J=jMin,jMax
0109 DO I=iMin,iMax
0110 PPviscAr(I,J,K,bi,bj) = PPviscAr(I,J,K,bi,bj)
0111 & * maskC(I,J,K,bi,bj)
0112 PPdiffKr(I,J,K,bi,bj) = PPdiffKr(I,J,K,bi,bj)
0113 & * maskC(I,J,K,bi,bj)
5e48dccc42 Jean*0114 ENDDO
08be60903a Mart*0115 ENDDO
0116
0117 ENDDO
0118
016b84c482 Mart*0119 #ifdef ALLOW_DIAGNOSTICS
0120 IF ( useDiagnostics ) THEN
0121 CALL DIAGNOSTICS_FILL(PPviscAr,'PPviscAr',0,Nr,1,bi,bj,myThid)
0122 CALL DIAGNOSTICS_FILL(PPdiffKr,'PPdiffKr',0,Nr,1,bi,bj,myThid)
0123 ENDIF
0124 #endif /* ALLOW_DIAGNOSTICS */
0125
08be60903a Mart*0126 #endif /* ALLOW_PP81 */
0127
0128 RETURN
0129 END