FORTRAN Reference Manual

Interprocess Communication
FORTRAN Reference Manual—528615-001
14-17
Message Queuing
Example 14-2. Example Queued Server (Part 1 of 3)
1 ?PAGE "QUEUED SERVER -- DISTRIBUTOR"
2 ?UNIT (7, QSD)
3 ?RECEIVE (OPEN 4,QDEPTH 4,SYNCDEPTH 2,MAXREPLY 200,SYSMSG)
4 PROGRAM qserver
5 IMPLICIT INTEGER*2 (a-z)
6 LOGICAL matchnew
7 PARAMETER (norqr=4, destrqr=4)
8 DIMENSION messno(norqr), request(norqr), record(66)
9 DIMENSION dest(norqr,destrqr), dest this rqr(norqr)
10 COMMON /block/messno, request, record, dest, dest this rqr
11 DIMENSION source(16)
12 LOGICAL system
13 C -- Compile-time TOGGLE 1 is FALSE if ENV OLD, TRUE if ENV COMMON
14 ?IFNOT 1
15 INTEGER rqr, msgnum, fileno, procname(4), readcount
16 EQUIVALENCE (source(1), system),
17 1 (source(2), rqr),
18 2 (source(3), msgnum),
19 3 (source(4), fileno),
20 4 (source(5), procname),
21 5 (source(9), readcount)
22 ?ENDIF 1
23 ?IF 1
24 INTEGER rqr, msgnum, fileno, procname(10), readcount
25 EQUIVALENCE (source(1), system),
26 1 (source(2), rqr),
27 2 (source(3), msgnum),
28 3 (source(4), fileno),
29 4 (source(5), procname),
30 5 (source(15), readcount)
31 ?ENDIF 1
32 CALL set array (messno, norqr, -1)
33 CALL set array (dest this rqr, norqr, 0)
34 CALL set array (dest, norqr*destrqr, -1)
35 OPEN (UNIT=5)
36 OPEN (UNIT=6)
37 OPEN (UNIT=7)