Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:38:52 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
0b42559cbf Jean*0001 #include "DEBUG_OPTIONS.h"
ad30945049 Jean*0002 
1b71c3d58f Jean*0003       SUBROUTINE DEBUG_CS_CORNER_UV(
c424ee7cc7 Jean*0004      I                 word2print,
                0005      I                 uFld, vFld,
                0006      I                 k, ioUnit, bi,bj, myThid )
ad30945049 Jean*0007 C     *==========================================================*
                0008 C     | S/R DEBUG_CS_CORNER_UV                                   |
                0009 C     | o check UV fields at Egdes of CS grid, near corners.     |
                0010 C     *==========================================================*
                0011 C     | Values of U,V fields at the Edges of the CS grid         |
                0012 C     |  are common to 2 faces, and are stored + used in 2       |
                0013 C     |  places (2 tiles): one in the interior of the 1rst tile, |
1b71c3d58f Jean*0014 C     |  the other in the halo of the 2nd one.                   |
                0015 C     | This S/R print the 2 values and  check that they are     |
ad30945049 Jean*0016 C     |  identical (print the difference).                       |
                0017 C     | This is specially usefull for checking that gU,gV are    |
                0018 C     |  correct before entering solve_for_pressure.             |
                0019 C     *==========================================================*
0b42559cbf Jean*0020 C     | Note: only works on a 1.cpu set up with square tiles     |
ad30945049 Jean*0021 C     *==========================================================*
                0022       IMPLICIT NONE
                0023 
                0024 C     == Global variables ==
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
0b42559cbf Jean*0027 #ifdef ALLOW_EXCH2
f9f661930b Jean*0028 #include "W2_EXCH2_SIZE.h"
0b42559cbf Jean*0029 #include "W2_EXCH2_TOPOLOGY.h"
                0030 #endif
ad30945049 Jean*0031 c #include "PARAMS.h"
                0032 c #include "GRID.h"
                0033 
                0034 C     == Routine arguments ==
c424ee7cc7 Jean*0035 C     word2print :: a string to print
                0036 C     uFld   :: u component of 2D vector
                0037 C     vFld   :: v component of 2D vector
                0038 C     k      :: current level
                0039 C     ioUnit :: I/O unit number
                0040 C     bi,bj  :: tile indices
                0041 C     myThid :: Instance number for this invocation of
bcbb4a5699 Jean*0042       CHARACTER*(*) word2print
ad30945049 Jean*0043       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0044       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0b42559cbf Jean*0045       INTEGER k, ioUnit
                0046       INTEGER bi, bj
ad30945049 Jean*0047       INTEGER myThid
                0048 
0b42559cbf Jean*0049 #ifdef ALLOW_DEBUG
ad30945049 Jean*0050 
                0051 C     == Local variables in common block :
                0052       COMMON / DEBUG_CS_CORNER_UV_LOCAL / tmpU, tmpV
5a7b2a763a Jean*0053       _RL tmpU(4,Nr,nSx*nSy)
                0054       _RL tmpV(4,Nr,nSx*nSy)
ad30945049 Jean*0055 
                0056 C     == Local variables ==
0b42559cbf Jean*0057 C     edgeIndex :: index (in X or Y) from the W. or S. edge of the tile
1b71c3d58f Jean*0058 C               :: of the U,V field to write
5a7b2a763a Jean*0059 C     n1        :: combined bi,bj index for current tile
                0060 C     n2, n3    :: combined bi,bj index for W. and S. neigbour tile
                0061 C     t1        :: current tile id
                0062 C     t2, t3    :: tile id of W. and S. neigbour tile
                0063 #ifdef ALLOW_EXCH2
                0064       INTEGER t1, t2, t3
                0065 #endif
                0066       INTEGER n1, n2, n3
0b42559cbf Jean*0067       INTEGER edgeIndex
c424ee7cc7 Jean*0068       INTEGER ic, i, j
ad30945049 Jean*0069 
bcbb4a5699 Jean*0070       EXTERNAL ILNBLNK
                0071       INTEGER  ILNBLNK
                0072 
ad30945049 Jean*0073 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0074 
0b42559cbf Jean*0075        edgeIndex = 1
                0076 
                0077        j = MIN(MAX(1-Olx,edgeIndex),Olx)
5a7b2a763a Jean*0078        n1 = bi + (bj-1)*nSx
ad30945049 Jean*0079  1010 FORMAT(2A,I2,1PE12.4,I3,1P2E12.4)
                0080 c     IF (k.EQ.4 .AND. myIter.EQ.nIter0 ) THEN
5a7b2a763a Jean*0081        tmpU(1,k,n1)= uFld(1,j)
                0082        tmpU(2,k,n1)= uFld(1,sNy+1-j)
                0083        tmpU(3,k,n1)= uFld(sNx+1,j)
                0084        tmpU(4,k,n1)= uFld(sNx+1,sNy+1-j)
                0085        tmpV(1,k,n1)= vFld(j,1)
                0086        tmpV(2,k,n1)= vFld(sNx+1-j,1)
                0087        tmpV(3,k,n1)= vFld(j,sNy+1)
                0088        tmpV(4,k,n1)= vFld(sNx+1-j,sNy+1)
ad30945049 Jean*0089        _BARRIER
0b42559cbf Jean*0090 #ifdef ALLOW_EXCH2
c424ee7cc7 Jean*0091        IF (bi.EQ.nSx .AND. bj.EQ.nSy .AND. sNx.EQ.sNy) THEN
0b42559cbf Jean*0092 #else /* ALLOW_EXCH2 */
c424ee7cc7 Jean*0093        IF (bi.EQ.nSx .AND. nSy.EQ.1  .AND. nSx.EQ.6) THEN
0b42559cbf Jean*0094 #endif /* ALLOW_EXCH2 */
ad30945049 Jean*0095         WRITE(ioUnit,'(2A)') 'DEBUG_CS_CORNER_UV: ',
                0096      &   '------------------------------------------------------------'
bcbb4a5699 Jean*0097         ic = MAX(1,ILNBLNK(word2print))
0b42559cbf Jean*0098         WRITE(ioUnit,'(3A,I3)') 'DEBUG_CS_CORNER_UV: ',
                0099      &        word2print(1:ic), ' , index=', j
ad30945049 Jean*0100         WRITE(ioUnit,'(2A,I4)') 'DEBUG_CS_CORNER_UV: ',
1b71c3d58f Jean*0101      &       ' Edges values near a corner, lev=',k
ad30945049 Jean*0102         WRITE(ioUnit,'(2A)') 'DEBUG_CS_CORNER_UV: ',
0b42559cbf Jean*0103      &     '      tile_1, value_1, tile_2, value_2, difference v1-v2:'
c424ee7cc7 Jean*0104         DO j=1,nSy
                0105          DO i=1,nSx
0b42559cbf Jean*0106 #ifdef ALLOW_EXCH2
5a7b2a763a Jean*0107           n1 = i + (j-1)*nSx
                0108           n2 = 0
                0109           n3 = 0
                0110           t1 = W2_myTileList(i,j)
                0111           t2 = exch2_neighbourId(4,t1)
                0112           t3 = exch2_neighbourId(2,t1)
                0113           IF ( W2_tileProc(t2).EQ.myProcId+1 ) n2 = W2_tileIndex(t2)
                0114           IF ( W2_tileProc(t3).EQ.myProcId+1 ) n3 = W2_tileIndex(t3)
                0115 
                0116           IF ( n2.GE.1 .AND. exch2_pij(3,4,t1).EQ.-1 ) THEN
c424ee7cc7 Jean*0117            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
5a7b2a763a Jean*0118      &       t1,tmpU(1,k,n1), t2,tmpV(4,k,n2),
                0119      &          tmpU(1,k,n1)  -  tmpV(4,k,n2)
c424ee7cc7 Jean*0120            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
5a7b2a763a Jean*0121      &       t1,tmpU(2,k,n1), t2,tmpV(3,k,n2),
                0122      &          tmpU(2,k,n1)  -  tmpV(3,k,n2)
c424ee7cc7 Jean*0123           ENDIF
5a7b2a763a Jean*0124           IF ( n2.GE.1 .AND. exch2_pij(4,4,t1).EQ.1 ) THEN
c424ee7cc7 Jean*0125            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
5a7b2a763a Jean*0126      &       t1,tmpU(1,k,n1), t2,tmpU(3,k,n2),
                0127      &          tmpU(1,k,n1)  -  tmpU(3,k,n2)
c424ee7cc7 Jean*0128            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
5a7b2a763a Jean*0129      &       t1,tmpU(2,k,n1), t2,tmpU(4,k,n2),
                0130      &          tmpU(2,k,n1)  -  tmpU(4,k,n2)
c424ee7cc7 Jean*0131           ENDIF
5a7b2a763a Jean*0132           IF ( n3.GE.1 .AND. exch2_pij(1,2,t1).EQ.1 ) THEN
c424ee7cc7 Jean*0133            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
5a7b2a763a Jean*0134      &       t1,tmpV(1,k,n1), t3,tmpV(3,k,n3),
                0135      &          tmpV(1,k,n1)  -  tmpV(3,k,n3)
c424ee7cc7 Jean*0136            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
5a7b2a763a Jean*0137      &       t1,tmpV(2,k,n1), t3,tmpV(4,k,n3),
                0138      &          tmpV(2,k,n1)  -  tmpV(4,k,n3)
c424ee7cc7 Jean*0139           ENDIF
5a7b2a763a Jean*0140           IF (  n3.GE.1 .AND. exch2_pij(2,2,t1).EQ.-1 ) THEN
c424ee7cc7 Jean*0141            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
5a7b2a763a Jean*0142      &       t1,tmpV(1,k,n1), t3,tmpU(4,k,n3),
                0143      &          tmpV(1,k,n1)  -  tmpU(4,k,n3)
c424ee7cc7 Jean*0144            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
5a7b2a763a Jean*0145      &       t1,tmpV(2,k,n1), t3,tmpU(3,k,n3),
                0146      &          tmpV(2,k,n1)  -  tmpU(3,k,n3)
c424ee7cc7 Jean*0147           ENDIF
0b42559cbf Jean*0148 #else /* ALLOW_EXCH2 */
c424ee7cc7 Jean*0149           n1 = i
                0150           IF (MOD(n1,2).EQ.1 ) THEN
                0151 c          n1=1 n2=5,+v,-
                0152 c          n1=1 n3=6,+v,+
                0153 c          n1=3 n2=1,+v,-
                0154 c          n1=3 n3=2,+v,+
                0155 c          n1=5 n2=3,+v,-
                0156 c          n1=5 n3=4,+v,+
5a7b2a763a Jean*0157            n2 = 1+MOD(n1-2+5,6)
                0158            n3 = 1+MOD(n1-1+5,6)
c424ee7cc7 Jean*0159            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
5a7b2a763a Jean*0160      &       n1,tmpU(1,k,n1), n2,tmpV(4,k,n2),
                0161      &          tmpU(1,k,n1)  -  tmpV(4,k,n2)
c424ee7cc7 Jean*0162            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
5a7b2a763a Jean*0163      &       n1,tmpU(2,k,n1), n2,tmpV(3,k,n2),
                0164      &          tmpU(2,k,n1)  -  tmpV(3,k,n2)
c424ee7cc7 Jean*0165            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
5a7b2a763a Jean*0166      &       n1,tmpV(1,k,n1), n3,tmpV(3,k,n3),
                0167      &          tmpV(1,k,n1)  -  tmpV(3,k,n3)
c424ee7cc7 Jean*0168            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
5a7b2a763a Jean*0169      &       n1,tmpV(2,k,n1), n3,tmpV(4,k,n3),
                0170      &          tmpV(2,k,n1)  -  tmpV(4,k,n3)
c424ee7cc7 Jean*0171           ELSE
                0172 c          n1=2 n2=1,+u,+
                0173 c          n1=2 n3=6,+u,-
                0174 c          n1=4 n2=3,+u,+
                0175 c          n1=4 n3=2,+u,-
                0176 c          n1=6 n2=5,+u,+
                0177 c          n1=6 n3=4,+u,-
5a7b2a763a Jean*0178            n2 = 1+MOD(n1-1+5,6)
                0179            n3 = 1+MOD(n1-2+5,6)
c424ee7cc7 Jean*0180            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
5a7b2a763a Jean*0181      &       n1,tmpU(1,k,n1), n2,tmpU(3,k,n2),
                0182      &          tmpU(1,k,n1)  -  tmpU(3,k,n2)
c424ee7cc7 Jean*0183            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
5a7b2a763a Jean*0184      &       n1,tmpU(2,k,n1), n2,tmpU(4,k,n2),
                0185      &          tmpU(2,k,n1)  -  tmpU(4,k,n2)
c424ee7cc7 Jean*0186            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
5a7b2a763a Jean*0187      &       n1,tmpV(1,k,n1), n3,tmpU(4,k,n3),
                0188      &          tmpV(1,k,n1)  -  tmpU(4,k,n3)
c424ee7cc7 Jean*0189            WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
5a7b2a763a Jean*0190      &       n1,tmpV(2,k,n1), n3,tmpU(3,k,n3),
                0191      &          tmpV(2,k,n1)  -  tmpU(3,k,n3)
c424ee7cc7 Jean*0192           ENDIF
0b42559cbf Jean*0193 #endif /* ALLOW_EXCH2 */
c424ee7cc7 Jean*0194          ENDDO
ad30945049 Jean*0195         ENDDO
                0196         WRITE(ioUnit,'(2A)') 'DEBUG_CS_CORNER_UV: ',
                0197      &   '------------------------------------------------------------'
                0198        ENDIF
                0199 c     ENDIF
                0200 
0b42559cbf Jean*0201 #endif /* ALLOW_DEBUG */
ad30945049 Jean*0202 
                0203       RETURN
                0204       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!