/[MITgcm]/MITgcm/pkg/exch2/exch2_send_rx2.template
ViewVC logotype

Diff of /MITgcm/pkg/exch2/exch2_send_rx2.template

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

revision 1.1 by afe, Fri Jan 9 20:46:09 2004 UTC revision 1.4 by jmc, Fri Jul 22 18:21:55 2005 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6        SUBROUTINE EXCH2_SEND_RX2 (        SUBROUTINE EXCH2_SEND_RX2 (
# Line 26  C Line 29  C
29  #define  W2_USE_E2_SAFEMODE  #define  W2_USE_E2_SAFEMODE
30    
31  #include "EEPARAMS.h"  #include "EEPARAMS.h"
       CHARACTER*(MAX_LEN_MBUF) messageBuffer  
32  C  C
33  C     === Routine arguments ===  C     === Routine arguments ===
34        INTEGER tILo, tIHi, tiStride        INTEGER tILo, tIHi, tiStride
# Line 53  C                    :: itc etc... targe Line 55  C                    :: itc etc... targe
55  C                    :: isl etc... source local  C                    :: isl etc... source local
56  C                    :: isc etc... source canonical  C                    :: isc etc... source canonical
57        INTEGER itl, jtl, ktl        INTEGER itl, jtl, ktl
58        INTEGER itc, jtc, ktc        INTEGER itc, jtc
59        INTEGER isc, jsc, ksc        INTEGER isc, jsc
60        INTEGER isl, jsl, ksl        INTEGER isl, jsl
61    c     INTEGER ktc, ksc, ksl
62  C     tt         :: Target tile  C     tt         :: Target tile
63  C     itb, jtb   :: Target local to canonical offsets  C     itb, jtb   :: Target local to canonical offsets
64  C  C
# Line 71  C Line 74  C
74  C     MPI setup  C     MPI setup
75  #include "SIZE.h"  #include "SIZE.h"
76  #include "EESUPPORT.h"  #include "EESUPPORT.h"
77    #ifdef ALLOW_USE_MPI
78        INTEGER theTag1, theTag2, theType, theHandle1, theHandle2        INTEGER theTag1, theTag2, theType, theHandle1, theHandle2
79        INTEGER sProc, tProc, mpiRc        INTEGER sProc, tProc, mpiRc
80    #endif
81          CHARACTER*(MAX_LEN_MBUF) messageBuffer
82    
83        IF     ( commSetting .EQ. 'P' ) THEN        IF     ( commSetting .EQ. 'P' ) THEN
84  C      Need to check that buffer synchronisation token is decremented  C      Need to check that buffer synchronisation token is decremented
# Line 144  C       DO itl=1,32,31 Line 150  C       DO itl=1,32,31
150       &       +sa2*array2(isl,jsl,ktl)       &       +sa2*array2(isl,jsl,ktl)
151           e2Bufr1_RX(iBufr1)=val1           e2Bufr1_RX(iBufr1)=val1
152  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
153           WRITE(messageBuffer,'(A,2I4)') 'EXCH2_SEND_RX2 target  u(itl, jtl) = ', itl, jtl           WRITE(messageBuffer,'(A,2I4)')
154         &           'EXCH2_SEND_RX2 target  u(itl, jtl) = ', itl, jtl
155           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
156       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
157       I         myThid)       I         myThid)
158           IF (     pi(1) .EQ. 1 ) THEN           IF (     pi(1) .EQ. 1 ) THEN
159  C         i index aligns  C         i index aligns
160            WRITE(messageBuffer,'(A,2I4)') '               source +u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
161         &           '               source +u(isl, jsl) = ', isl, jsl
162           ELSEIF ( pi(1) .EQ. -1 ) THEN           ELSEIF ( pi(1) .EQ. -1 ) THEN
163  C         reversed i index aligns  C         reversed i index aligns
164            WRITE(messageBuffer,'(A,2I4)') '               source -u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
165         &            '               source -u(isl, jsl) = ', isl, jsl
166           ELSEIF ( pj(1) .EQ.  1 ) THEN           ELSEIF ( pj(1) .EQ.  1 ) THEN
167            WRITE(messageBuffer,'(A,2I4)') '               source +v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
168         &            '               source +v(isl, jsl) = ', isl, jsl
169           ELSEIF ( pj(1) .EQ. -1 ) THEN           ELSEIF ( pj(1) .EQ. -1 ) THEN
170            WRITE(messageBuffer,'(A,2I4)') '               source -v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
171         &            '               source -v(isl, jsl) = ', isl, jsl
172           ENDIF           ENDIF
173           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
174       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
175       I         myThid)       I         myThid)
176           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN
177            WRITE(messageBuffer,'(A,2I4)') '               *** isl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
178         &           '               *** isl is out of bounds '
179            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
180       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
181       I     myThid)       I     myThid)
182           ENDIF           ENDIF
183           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN
184            WRITE(messageBuffer,'(A,2I4)') '               *** jsl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
185         &           '               *** jsl is out of bounds '
186            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
187       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
188       I     myThid)       I     myThid)
# Line 275  C       DO itl=1,32,31 Line 288  C       DO itl=1,32,31
288       &       +sa2*array2(isl,jsl,ktl)       &       +sa2*array2(isl,jsl,ktl)
289           e2Bufr2_RX(iBufr2)=val2           e2Bufr2_RX(iBufr2)=val2
290  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
291           WRITE(messageBuffer,'(A,2I4)') 'EXCH2_SEND_RX2 target  v(itl, jtl) = ', itl, jtl           WRITE(messageBuffer,'(A,2I4)')
292         &            'EXCH2_SEND_RX2 target  v(itl, jtl) = ', itl, jtl
293           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
294       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
295       I         myThid)       I         myThid)
296           IF (     pi(2) .EQ. 1 ) THEN           IF (     pi(2) .EQ. 1 ) THEN
297  C         i index aligns  C         i index aligns
298            WRITE(messageBuffer,'(A,2I4)') '               source +u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
299         &          '               source +u(isl, jsl) = ', isl, jsl
300           ELSEIF ( pi(2) .EQ. -1 ) THEN           ELSEIF ( pi(2) .EQ. -1 ) THEN
301  C         reversed i index aligns  C         reversed i index aligns
302            WRITE(messageBuffer,'(A,2I4)') '               source -u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
303         &          '               source -u(isl, jsl) = ', isl, jsl
304           ELSEIF ( pj(2) .EQ.  1 ) THEN           ELSEIF ( pj(2) .EQ.  1 ) THEN
305            WRITE(messageBuffer,'(A,2I4)') '               source +v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
306         &          '               source +v(isl, jsl) = ', isl, jsl
307           ELSEIF ( pj(2) .EQ. -1 ) THEN           ELSEIF ( pj(2) .EQ. -1 ) THEN
308            WRITE(messageBuffer,'(A,2I4)') '               source -v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
309         &          '               source -v(isl, jsl) = ', isl, jsl
310           ENDIF           ENDIF
311           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
312       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
313       I         myThid)       I         myThid)
314           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN
315            WRITE(messageBuffer,'(A,2I4)') '               *** isl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
316         &          '               *** isl is out of bounds '
317            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
318       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
319       I     myThid)       I     myThid)
320           ENDIF           ENDIF
321           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN
322            WRITE(messageBuffer,'(A,2I4)') '               *** jsl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
323         &          '               *** jsl is out of bounds '
324            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
325       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
326       I     myThid)       I     myThid)
# Line 416  C      Store MPI_Wait token in messageHa Line 436  C      Store MPI_Wait token in messageHa
436    
437        RETURN        RETURN
438        END        END
439    
440    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
441    
442    CEH3 ;;; Local Variables: ***
443    CEH3 ;;; mode:fortran ***
444    CEH3 ;;; End: ***
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22