1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
#if defined(MPI)
*DECK DRVMPI
SUBROUTINE DRVMPI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
* MPI INITIALIZATION.
*
* INPUT/OUTPUT PARAMETERS:
* NENTRY : NUMBER OF LCM OBJECTS AND FILES USED BY THE MODULE.
* HENTRY : CHARACTER*12 NAME OF EACH LCM OBJECT OR FILE.
* IENTRY : =1 LCM OBJECT; =2 XSM FILE;
* =3 SEQUENTIAL BINARY FILE; =4 SEQUENTIAL ASCII FILE;
* =5 DIRECT ACCESS FILE.
* JENTRY : =0 THE LCM OBJECT OR FILE IS CREATED.
* =1 THE LCM OBJECT OR FILE IS OPEN FOR MODIFICATIONS;
* =2 THE LCM OBJECT OR FILE IS OPEN IN READ-ONLY MODE.
* KENTRY : =FILE UNIT NUMBER; =LCM OBJECT ADDRESS OTHERWISE.
* DIMENSION HENTRY(NENTRY),IENTRY(NENTRY),JENTRY(NENTRY),
* KENTRY(NENTRY)
*
*--------------------------------------- AUTHOR: R.CHAMBON ; 04/2003 ---
*
USE GANLIB
include 'mpif.h'
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
CHARACTER HENTRY(NENTRY)*12
TYPE(C_PTR) KENTRY(NENTRY)
*----
* LOCAL VARIABLES
*----
CHARACTER TEXT12*12
LOGICAL LLCMCR
INTEGER BGLOOP,EDLOOP,NTLOOP,ITYP,INIPOS
INTEGER IPRINT
REAL FLOTT,FLOTT2
INTEGER NITMA,NITMA2
DOUBLE PRECISION DFLOTT,DFLOTT2,DTIME
INTEGER*4 RANK32,SIZE32,IPROC,IERR
INTEGER RANK,SIZE
*----
* ALLOCATABLE STATEMENTS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: IPOSBG,INBPOS
#if defined(__x86_64__)
# define M64 2
#else
# define M64 1
#endif
*----
* PARAMETER VALIDATION.
*----
IF(NENTRY.GE.2) THEN
CALL XABORT('DRVMPI: ONE ENTRY MAX EXPECTED')
ENDIF
IF(NENTRY.EQ.1) THEN
IF(JENTRY(1).NE.0) THEN
CALL XABORT('DRVMPI: IF ONE ENTRY, HAS TO BE'
1 //' IN CREATE MODE'//HENTRY(1))
ELSEIF((IENTRY(1).LE.0).OR.(IENTRY(1).GE.3)) THEN
CALL XABORT('DRVMPI: ONE ENTRY, HAS TO BE'
1 //' LINKED_LIST OR XSM_FILE'//HENTRY(1))
ELSE
LLCMCR=.TRUE.
WRITE(6,*) 'LLCMCR : ',LLCMCR
ENDIF
CALL LCMVAL(KENTRY(1),' ')
ENDIF
*
IPRINT= 0
CALL MPI_COMM_RANK(MPI_COMM_WORLD,RANK32,IERR)
RANK=RANK32
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,SIZE32,IERR)
SIZE=SIZE32
ALLOCATE(IPOSBG(SIZE),INBPOS(SIZE))
*----
* READ INPUT
*----
20 CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.3 ) CALL XABORT('DRVMPI: CHARACTER DATA EXPECTED.')
* EDITION LEVEL
IF( TEXT12.EQ.'EDIT' )THEN
CALL REDGET(ITYP,IPRINT,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.1 ) CALL XABORT('DRVMPI: NO INTEGER AFTER *EDIT*.')
* TOTAL NUMBER OF CPU
ELSEIF( TEXT12.EQ.'WORLD-SIZE' )THEN
CALL REDGET(ITYP,NTLOOP,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.-1 ) CALL XABORT('DRVMPI: NO INTEGER VARIABLE '//
1 'AFTER *SETLOOP*.')
ITYP = 1
CALL REDPUT(ITYP,SIZE,FLOTT,TEXT12,DFLOTT)
IF(IPRINT.GE.1) WRITE(6,1000) SIZE
* CPU NUMBER
ELSEIF( TEXT12.EQ.'MY-ID' )THEN
CALL REDGET(ITYP,NTLOOP,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.-1 ) CALL XABORT('DRVMPI: NO INTEGER VARIABLE '//
1 'AFTER *SETLOOP*.')
ITYP = 1
CALL REDPUT(ITYP,RANK,FLOTT,TEXT12,DFLOTT)
IF(IPRINT.GE.1) WRITE(6,1010) RANK
* CPU REPARTITION FOR A LOOP
ELSEIF( TEXT12.EQ.'SETLOOP' )THEN
CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
IF(ITYP.NE.3.AND.TEXT12.NE.'B0'.AND.TEXT12.NE.'B1' ) THEN
CALL XABORT('DRVMPI: BO OR B1 KEYWORD EXPECTED '//
1 'AFTER *SETLOOP*.')
ENDIF
INIPOS=-99999
IF(TEXT12.EQ.'B0') INIPOS=0
IF(TEXT12.EQ.'B1') INIPOS=1
CALL REDGET(ITYP,NTLOOP,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.1 ) CALL XABORT('DRVMPI: NO INTEGER '//
1 'AFTER *SETLOOP*.')
CALL REDGET(ITYP,BGLOOP,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.-1 ) CALL XABORT('DRVMPI: NO INTEGER VARIABLE '//
1 'AFTER *SETLOOP*.')
CALL REDGET(ITYP,EDLOOP,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.-1 ) CALL XABORT('DRVMPI: NO INTEGER VARIABLE '//
1 'AFTER *SETLOOP*.')
IF(SIZE.GT.NTLOOP) THEN
DO 3 IPROC=0,SIZE-1
IPOSBG(IPROC+1)=MIN0(IPROC,NTLOOP-1)+INIPOS
INBPOS(IPROC+1)=1
3 CONTINUE
ELSE
DO 4 IPROC=0,SIZE-1
IPOSBG(IPROC+1) = INIPOS +
1 IPROC * (NTLOOP / SIZE) + MIN0(IPROC, MOD(NTLOOP, SIZE))
INBPOS(IPROC+1) =
1 (NTLOOP / SIZE) + MIN0(1, MOD(NTLOOP, SIZE)/(IPROC + 1))
4 CONTINUE
ENDIF
BGLOOP=IPOSBG(RANK+1)
EDLOOP=IPOSBG(RANK+1)+INBPOS(RANK+1)-1
ITYP = 1
CALL REDPUT(ITYP,EDLOOP,FLOTT,TEXT12,DFLOTT)
CALL REDPUT(ITYP,BGLOOP,FLOTT,TEXT12,DFLOTT)
IF(IPRINT.GE.1) THEN
WRITE(6,1020) BGLOOP,EDLOOP
IF(IPRINT.GE.2) THEN
WRITE (6,1030)
DO 5 IPROC=0,SIZE-1
WRITE (6,1031) IPROC,IPOSBG(IPROC+1),
1 IPOSBG(IPROC+1)+INBPOS(IPROC+1)-1
5 CONTINUE
ENDIF
ENDIF
* REDUCTION OPERATION
ELSEIF( TEXT12.EQ.'ALLREDUCE' )THEN
CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
IF(ITYP.NE.3.AND.TEXT12.NE.'SUM'.AND.TEXT12.NE.'PROD'
1 .AND.TEXT12.NE.'MAX'.AND.TEXT12.NE.'MIN') THEN
CALL XABORT('DRVMPI: REDUCE OPERATOR KEYWORD EXPECTED '//
1 'AFTER *ALLREDUCE*.')
ENDIF
IF(TEXT12.EQ.'SUM') IOPERT=MPI_SUM
IF(TEXT12.EQ.'PROD') IOPERT=MPI_PROD
IF(TEXT12.EQ.'MAX') IOPERT=MPI_MAX
IF(TEXT12.EQ.'MIN') IOPERT=MPI_MIN
CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
IF( ITYP.NE.1.AND.ITYP.NE.2.AND.ITYP.NE.4 )
1 CALL XABORT('DRVMPI: SCALAR VARIABLE TO REDUCE '//
2 'EXPECTED FOR *ALLREDUCE*.')
ITYPE=ITYP
CALL REDGET(ITYP,NITMA2,FLOTT2,TEXT12,DFLOTT2)
IF(-ITYP.NE.ITYPE ) CALL XABORT('DRVMPI: DESTINATION '//
1 'AND SOURCE NOT SAME TYPE FOR *ALLREDUCE*.')
IF( ITYPE.EQ.1 ) THEN
CALL MPI_ALLREDUCE(NITMA,NITMA2,1*M64,MPI_INTEGER,
1 IOPERT,MPI_COMM_WORLD,IERR)
CALL REDPUT(ITYPE,NITMA2,FLOTT2,TEXT12,DFLOTT2)
IF(IPRINT.GE.1)
1 WRITE(6,*) 'RESULT OF THE ALLREDUCE',NITMA2
ELSEIF( ITYPE.EQ.2 ) THEN
CALL MPI_ALLREDUCE(FLOTT,FLOTT2,1*M64,MPI_REAL,
1 IOPERT,MPI_COMM_WORLD,IERR)
CALL REDPUT(ITYPE,NITMA2,FLOTT2,TEXT12,DFLOTT2)
IF(IPRINT.GE.1)
1 WRITE(6,*) 'RESULT OF THE ALLREDUCE',FLOTT2
ELSEIF( ITYPE.EQ.4 ) THEN
CALL MPI_ALLREDUCE(DFLOTT,DFLOTT2,1*M64,MPI_DOUBLE_PRECISION,
1 IOPERT,MPI_COMM_WORLD,IERR)
CALL REDPUT(ITYPE,NITMA2,FLOTT2,TEXT12,DFLOTT2)
IF(IPRINT.GE.1)
1 WRITE(6,*) 'RESULT OF THE ALLREDUCE',DFLOTT2
ELSE
CALL XABORT('DRVMPI: NO LOGICAL OR STRING VARIABLE '//
1 'ACCEPTED FOR *ALLREDUCE*.')
ENDIF
* TIME
ELSEIF( TEXT12.EQ.'TIME' )THEN
CALL REDGET(ITYP,NTLOOP,FLOTT,TEXT12,DTIME)
IF( ITYP.NE.-4 ) CALL XABORT('DRVMPI: NO DOUBLE VARIABLE ' //
1 'AFTER *TIME*.')
ITYP = 4
DTIME = MPI_WTIME()
CALL REDPUT(ITYP,SIZE,FLOTT,TEXT12,DTIME)
IF(IPRINT.GE.1) WRITE(6,1040) DTIME
* BARRIER
ELSEIF( TEXT12.EQ.'BARRIER' )THEN
CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
IF(IPRINT.GE.1) WRITE(6,1050)
* END OF THIS SUBROUTINE
ELSEIF( TEXT12.EQ.';' )THEN
GO TO 40
ELSE
CALL XABORT('DRVMPI: '//TEXT12//' IS AN INVALID KEYWORD.')
ENDIF
GO TO 20
*----
* END OF INPUT OPTIONS
*----
40 DEALLOCATE(INBPOS,IPOSBG)
RETURN
*----
* FORMATS
*----
1000 FORMAT(35H TOTAL NUMBER OF CPU (WORLD-SIZE): ,I4)
1010 FORMAT(35H NUMBER OF THIS CPU (MY-ID) : ,I4)
1020 FORMAT(35H FOR THIS CPU: BEGIN LOOP (BGLOOP) ,I8,
1 20H END LOOP (EDLOOP) ,I8)
1030 FORMAT(37H FOR CPU #: BEGIN LOOP - END LOOP)
1031 FORMAT(4H # ,I4,2X,1H:,1X,I8,5X,1H-,1X,I8)
1040 FORMAT(35H TIME (DTIME): ,D20.14)
1050 FORMAT(35H ALL CPU HAVE BEEN SYNCHRONISED. )
END
#endif /* defined(MPI) */
|
