Warning, /eesupp/src/exch1_rx_cube.template is written in an unsupported language. File is not indexed.
view on githubraw file Latest commit aa6b2555 on 2021-06-06 02:50:10 UTC
efef5241b2 Jean*0001 #include "CPP_EEOPTIONS.h"
0002
0003 CBOP
0004 C !ROUTINE: EXCH1_RX_CUBE
0005
0006 C !INTERFACE:
0007 SUBROUTINE EXCH1_RX_CUBE(
0008 U array,
0009 I withSigns,
0010 I myOLw, myOLe, myOLs, myOLn, myNz,
0011 I exchWidthX, exchWidthY,
0012 I cornerMode, myThid )
0013
0014 C !DESCRIPTION:
aa6b2555c8 Jean*0015 C *==============================================================*
efef5241b2 Jean*0016 C | SUBROUTINE EXCH1_RX_CUBE
0017 C | o Forward-mode edge exchanges for RX array on CS config.
aa6b2555c8 Jean*0018 C *==============================================================*
efef5241b2 Jean*0019 C | Controlling routine for exchange of XY edges of an array
aa6b2555c8 Jean*0020 C | distributed in X and Y.
0021 C | This is a preliminary (exch1), simpler version with few
0022 C | limitations (no MPI, 1 tile per face, regular 6 squared faces,
0023 C | multi-threads only on shared arrays, i.e., in commom block)
0024 C | that are fixed in generalised pkg/exch2 implementation.
0025 C *==============================================================*
efef5241b2 Jean*0026
0027 C !USES:
0028 IMPLICIT NONE
0029
0030 C == Global data ==
0031 #include "SIZE.h"
0032 #include "EEPARAMS.h"
0033
0034 C !INPUT/OUTPUT PARAMETERS:
0035 C == Routine arguments ==
0036 C array :: Array with edges to exchange.
0037 C withSigns :: Flag controlling whether field sign depends on orientation
0038 C :: (signOption not yet implemented but needed for SM exch)
0039 C myOLw,myOLe :: West and East overlap region sizes.
0040 C myOLs,myOLn :: South and North overlap region sizes.
0041 C exchWidthX :: Width of data region exchanged in X.
0042 C exchWidthY :: Width of data region exchanged in Y.
0043 C Note --
0044 C 1. In theory one could have a send width and
0045 C a receive width for each face of each tile. The only
0046 C restriction would be that the send width of one
0047 C face should equal the receive width of the sent to
0048 C tile face. Dont know if this would be useful. I
0049 C have left it out for now as it requires additional
0050 C bookeeping.
0051 C cornerMode :: Flag indicating whether corner updates are needed.
0052 C myThid :: my Thread Id number
0053
0054 INTEGER myOLw, myOLe, myOLs, myOLn, myNz
0055 _RX array( 1-myOLw:sNx+myOLe,
0056 & 1-myOLs:sNy+myOLn,
0057 & myNz, nSx, nSy )
0058 LOGICAL withSigns
0059 INTEGER exchWidthX
0060 INTEGER exchWidthY
0061 INTEGER cornerMode
0062 INTEGER myThid
0063
0064 C !LOCAL VARIABLES:
0065 C == Local variables ==
0066 C theSimulationMode :: Holds working copy of simulation mode
0067 C theCornerMode :: Holds working copy of corner mode
0068 C I,J,K :: Loop and index counters
0069 C bl,bt,bn,bs,be,bw :: tile indices
0070 c INTEGER theSimulationMode
0071 c INTEGER theCornerMode
0072 INTEGER I,J,K
0073 INTEGER bl,bt,bn,bs,be,bw
0074 CHARACTER*(MAX_LEN_MBUF) msgBuf
0075
0076 C == Statement function ==
0077 C tilemod :: Permutes indices to return neighboring tile index
0078 C on six face cube.
0079 INTEGER tilemod
0080 tilemod(I)=1+mod(I-1+6,6)
0081 CEOP
0082
0083 c theSimulationMode = FORWARD_SIMULATION
0084 c theCornerMode = cornerMode
0085
0086 c IF ( simulationMode.EQ.REVERSE_SIMULATION ) THEN
0087 c WRITE(msgBuf,'(A)') 'EXCH1_RX_CUBE: AD mode not implemented'
0088 c CALL PRINT_ERROR( msgBuf, myThid )
0089 c STOP 'ABNORMAL END: EXCH1_RX_CUBE: no AD code'
0090 c ENDIF
0091 IF ( sNx.NE.sNy .OR.
0092 & nSx.NE.6 .OR. nSy.NE.1 .OR.
0093 & nPx.NE.1 .OR. nPy.NE.1 ) THEN
0094 WRITE(msgBuf,'(2A)') 'EXCH1_RX_CUBE: Wrong Tiling'
0095 CALL PRINT_ERROR( msgBuf, myThid )
0096 WRITE(msgBuf,'(2A)') 'EXCH1_RX_CUBE: ',
0097 & 'works only with sNx=sNy & nSx=6 & nSy=nPx=nPy=1'
0098 CALL PRINT_ERROR( msgBuf, myThid )
0099 STOP 'ABNORMAL END: EXCH1_RX_CUBE: Wrong Tiling'
0100 ENDIF
0101
0102 C For now tile<->tile exchanges are sequentialised through
0103 C thread 1. This is a temporary feature for preliminary testing until
0104 C general tile decomposistion is in place (CNH April 11, 2001)
0105 CALL BAR2( myThid )
0106 IF ( myThid .EQ. 1 ) THEN
0107
0108 DO bl = 1, 5, 2
0109
0110 bt = bl
0111 bn=tilemod(bt+2)
0112 bs=tilemod(bt-1)
0113 be=tilemod(bt+1)
0114 bw=tilemod(bt-2)
0115
0116 DO K = 1, myNz
0117 DO J = 1, sNy
0118 DO I = 1, exchWidthX
0119
0120 C Tile Odd:Odd+2 [get] [North<-West]
0121 array(J,sNy+I,K,bt,1) = array(I,sNy+1-J,K,bn,1)
0122 C Tile Odd:Odd-1 [get] [South<-North]
0123 array(J,1-I,K,bt,1) = array(J,sNy+1-I,K,bs,1)
0124 C Tile Odd:Odd+1 [get] [East<-West]
0125 array(sNx+I,J,K,bt,1) = array(I,J,K,be,1)
0126 C Tile Odd:Odd-2 [get] [West<-North]
0127 array(1-I,J,K,bt,1) = array(sNx+1-J,sNy+1-I,K,bw,1)
0128
0129 ENDDO
0130 ENDDO
0131 ENDDO
0132
0133 bt = bl+1
0134 bn=tilemod(bt+1)
0135 bs=tilemod(bt-2)
0136 be=tilemod(bt+2)
0137 bw=tilemod(bt-1)
0138
0139 DO K = 1, myNz
0140 DO J = 1, sNy
0141 DO I = 1, exchWidthX
0142
0143 C Tile Even:Even+1 [get] [North<-South]
0144 array(J,sNy+I,K,bt,1) = array(J,I,K,bn,1)
0145 C Tile Even:Even-2 [get] [South<-East]
0146 array(J,1-I,K,bt,1) = array(sNx+1-I,sNy+1-J,K,bs,1)
0147 C Tile Even:Even+2 [get] [East<-South]
0148 array(sNx+I,J,K,bt,1) = array(sNx+1-J,I,K,be,1)
0149 C Tile Even:Even-1 [get] [West<-East]
0150 array(1-I,J,K,bt,1) = array(sNx+1-I,J,K,bw,1)
0151
0152 ENDDO
0153 ENDDO
0154 ENDDO
0155
0156 ENDDO
0157
0158 ENDIF
0159 CALL BAR2(myThid)
0160
0161 RETURN
0162 END
