/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_calc_phivel.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_calc_phivel.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by jmc, Tue Jun 14 00:18:37 2011 UTC revision 1.3 by jmc, Fri Jun 24 22:15:48 2011 UTC
# Line 10  C     !ROUTINE: DIAGNOSTICS_CALC_PHIVEL Line 10  C     !ROUTINE: DIAGNOSTICS_CALC_PHIVEL
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:
# Line 36  C     ndId    :: diagnostics  Id number Line 36  C     ndId    :: diagnostics  Id number
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:
# Line 57  C     !LOCAL VARIABLES: Line 58  C     !LOCAL VARIABLES:
58  C     i,j,k :: loop indices  C     i,j,k :: loop indices
59        INTEGER i, j, k        INTEGER i, j, k
60        INTEGER bi, bj        INTEGER bi, bj
61        CHARACTER*(MAX_LEN_MBUF) msgBuf  c     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
# Line 75  C     i,j,k :: loop indices Line 75  C     i,j,k :: loop indices
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
# Line 150  C-    calculate RHS = Div(uVel,vVel): Line 108  C-    calculate RHS = Div(uVel,vVel):
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
# Line 234  C-    Un-normalise the answer Line 192  C-    Un-normalise the answer
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
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22