10 |
C !INTERFACE: |
C !INTERFACE: |
11 |
SUBROUTINE DIAGNOSTICS_CALC_PHIVEL( |
SUBROUTINE DIAGNOSTICS_CALC_PHIVEL( |
12 |
I listId, md, ndId, ip, im, lm, |
I listId, md, ndId, ip, im, lm, |
13 |
O nFilled, qtmp1, qtmp2, |
U qtmp1, qtmp2, |
14 |
I myTime, myIter, myThid ) |
I myTime, myIter, myThid ) |
15 |
|
|
16 |
C !DESCRIPTION: |
C !DESCRIPTION: |
36 |
C ip :: diagnostics pointer to storage array |
C ip :: diagnostics pointer to storage array |
37 |
C im :: counter-mate pointer to storage array |
C im :: counter-mate pointer to storage array |
38 |
C lm :: index in the averageCycle |
C lm :: index in the averageCycle |
39 |
C nFilled :: effective counter number (from primary diag which this one is |
C qtmp1 :: horizontal velocity input diag., u-component |
40 |
C derived from); return 0 is missing filling. |
C qtmp2 :: horizontal velocity input diag., v-component |
|
C qtmp1 :: diagnostics field output array |
|
|
C qtmp2 :: temp working array (same size as output array) |
|
41 |
C myTime :: current time of simulation (s) |
C myTime :: current time of simulation (s) |
42 |
C myIter :: current iteration number |
C myIter :: current iteration number |
43 |
C myThid :: my Thread Id number |
C myThid :: my Thread Id number |
44 |
INTEGER listId, md, ndId, ip, im, lm |
INTEGER listId, md, ndId, ip, im, lm |
|
INTEGER nFilled |
|
45 |
_RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy) |
_RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy) |
46 |
_RL qtmp2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy) |
_RL qtmp2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy) |
47 |
_RL myTime |
_RL myTime |
48 |
INTEGER myIter, myThid |
INTEGER myIter, myThid |
49 |
|
|
50 |
|
C !OUTPUT PARAMETERS: |
51 |
|
C qtmp1 :: horizontal-velocity potential |
52 |
|
C qtmp2 :: horizontal-velocity stream-function |
53 |
CEOP |
CEOP |
54 |
|
|
55 |
C !FUNCTIONS: |
C !FUNCTIONS: |
60 |
INTEGER bi, bj |
INTEGER bi, bj |
61 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
62 |
|
|
63 |
_RL undefRL |
INTEGER ks |
|
INTEGER ip1, ip2, jp1, jp2 |
|
64 |
INTEGER numIters |
INTEGER numIters |
65 |
LOGICAL normaliseMatrice, diagNormaliseRHS |
LOGICAL normaliseMatrice, diagNormaliseRHS |
66 |
_RL residCriter, firstResidual, lastResidual |
_RL residCriter, firstResidual, lastResidual |
75 |
|
|
76 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
77 |
|
|
78 |
undefRL = UNSET_RL |
DO ks = 1,kdiag(ndId) |
79 |
CALL DIAGNOSTICS_GET_POINTERS( 'UVELMASS', listId, |
k = NINT(levs(ks,listId)) |
|
& jp1, ip1, myThid ) |
|
|
CALL DIAGNOSTICS_GET_POINTERS( 'VVELMASS', listId, |
|
|
& jp2, ip2, myThid ) |
|
|
IF ( ip1.EQ.0 .OR. ip2.EQ.0 ) THEN |
|
|
WRITE(msgBuf,'(4A)') 'WARNING DIAGNOSTICS_CALC_PHIVEL:', |
|
|
& ' trying to process "', flds(md,listId), '" :' |
|
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
|
|
& SQUEEZE_RIGHT, myThid) |
|
|
IF ( ip1.EQ.0 ) THEN |
|
|
WRITE(msgBuf,'(4A)') 'WARNING DIAGNOSTICS_CALC_PHIVEL:', |
|
|
& ' missing filled diag="UVELMASS"' |
|
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
|
|
& SQUEEZE_RIGHT, myThid) |
|
|
ENDIF |
|
|
IF ( ip2.EQ.0 ) THEN |
|
|
WRITE(msgBuf,'(4A)') 'WARNING DIAGNOSTICS_CALC_PHIVEL:', |
|
|
& ' missing filled diag="VVELMASS"' |
|
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
|
|
& SQUEEZE_RIGHT, myThid) |
|
|
ENDIF |
|
|
nFilled = 0 |
|
|
ELSE |
|
|
nFilled = MIN( ndiag(ip1,1,1), ndiag(ip2,1,1) ) |
|
|
ENDIF |
|
|
IF ( nFilled.EQ.0 ) RETURN |
|
|
|
|
|
C- averageCycle: move pointer |
|
|
ip1 = ip1 + kdiag(jp1)*(lm-1) |
|
|
ip2 = ip2 + kdiag(jp2)*(lm-1) |
|
|
|
|
|
DO bj = myByLo(myThid), myByHi(myThid) |
|
|
DO bi = myBxLo(myThid), myBxHi(myThid) |
|
|
CALL DIAGNOSTICS_GET_DIAG( 0, undefRL, |
|
|
O qtmp1(1-OLx,1-OLy,1,bi,bj), |
|
|
I jp1, 0, ip1, 0, bi, bj, myThid ) |
|
|
CALL DIAGNOSTICS_GET_DIAG( 0, undefRL, |
|
|
O qtmp2(1-OLx,1-OLy,1,bi,bj), |
|
|
I jp2, 0, ip2, 0, bi, bj, myThid ) |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
DO k = 1,kdiag(ndId) |
|
80 |
C-- Solve for velocity potential for each level: |
C-- Solve for velocity potential for each level: |
81 |
|
|
82 |
a2dMax = 0. _d 0 |
a2dMax = 0. _d 0 |
108 |
DO j = 1,sNy+1 |
DO j = 1,sNy+1 |
109 |
DO i = 1,sNx+1 |
DO i = 1,sNx+1 |
110 |
uTrans(i,j) = dyG(i,j,bi,bj)*drF(k) |
uTrans(i,j) = dyG(i,j,bi,bj)*drF(k) |
111 |
& *qtmp1(i,j,k,bi,bj)*maskInW(i,j,bi,bj) |
& *qtmp1(i,j,ks,bi,bj)*maskInW(i,j,bi,bj) |
112 |
vTrans(i,j) = dxG(i,j,bi,bj)*drF(k) |
vTrans(i,j) = dxG(i,j,bi,bj)*drF(k) |
113 |
& *qtmp2(i,j,k,bi,bj)*maskInS(i,j,bi,bj) |
& *qtmp2(i,j,ks,bi,bj)*maskInS(i,j,bi,bj) |
114 |
ENDDO |
ENDDO |
115 |
ENDDO |
ENDDO |
116 |
DO j = 1,sNy |
DO j = 1,sNy |
192 |
DO j = 1,sNy |
DO j = 1,sNy |
193 |
DO i = 1,sNx |
DO i = 1,sNx |
194 |
c x2d(i,j,bi,bj) = x2d(i,j,bi,bj) /rhsNorm |
c x2d(i,j,bi,bj) = x2d(i,j,bi,bj) /rhsNorm |
195 |
qtmp1(i,j,k,bi,bj) = x2d(i,j,bi,bj)/rhsNorm |
qtmp1(i,j,ks,bi,bj) = x2d(i,j,bi,bj)/rhsNorm |
196 |
ENDDO |
ENDDO |
197 |
ENDDO |
ENDDO |
198 |
ENDDO |
ENDDO |