SUBROUTINE PIPE_Define_Model_Read (cdfread,cdpread, kinfo) 1,1PDEFMR.3
C**** PDEFMR.4
C ***************************** PDEFMR.5
C * OASIS ROUTINE - LEVEL C * PDEFMR.6
C * ------------- ------- * PDEFMR.7
C ***************************** PDEFMR.8
C PDEFMR.9
C**** *PIPE_Define* - Initialize coupled mode communication for PDEFMR.10
C coupler PDEFMR.11
C PDEFMR.12
C Purpose: PDEFMR.13
C ------- PDEFMR.14
C Initialize coupler - models communication using named PDEFMR.15
c pipes(fifo). PDEFMR.16
C PDEFMR.17
C** Interface: PDEFMR.18
C --------- PDEFMR.19
C *CALL* *PIPE_Define (cdfread, cdpread, kinfo)* PDEFMR.20
C PDEFMR.21
C Input: PDEFMR.22
C ----- PDEFMR.23
C cdfread : alias filename for read pipe (char string) PDEFMR.24
C cdpread : symbolic reading pipe name (char string) PDEFMR.25
C PDEFMR.26
C Output: PDEFMR.27
C ------ PDEFMR.28
C kinfo : error status (integer) PDEFMR.29
C PDEFMR.30
C Workspace: PDEFMR.31
C --------- PDEFMR.32
C None PDEFMR.33
C PDEFMR.34
C Externals: PDEFMR.35
C --------- PDEFMR.36
C assign, empty, mknod PDEFMR.37
C PDEFMR.38
C Reference: PDEFMR.39
C --------- PDEFMR.40
C See OASIS manual (1995) PDEFMR.41
C PDEFMR.42
C History: PDEFMR.43
C ------- PDEFMR.44
C Version Programmer Date Description PDEFMR.45
C ------- ---------- ---- ----------- PDEFMR.46
C 2.0 L. Terray 95/09/01 created PDEFMR.47
C PDEFMR.48
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PDEFMR.49
C PDEFMR.50
C* ---------------------------- Argument declarations --------------- PDEFMR.51
C PDEFMR.52
CHARACTER*8 cdfread PDEFMR.53
CHARACTER*8 cdpread PDEFMR.54
C PDEFMR.55
C* ---------------------------- Local declarations ------------------ PDEFMR.56
C PDEFMR.57
CHARACTER*80 clcmd PDEFMR.58
INTEGER mknod PDEFMR.59
integer nulou PDEFMR.60
data nulou /6/ PDEFMR.61
C PDEFMR.62
C* ---------------------------- Poema verses ------------------------ PDEFMR.63
C PDEFMR.64
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PDEFMR.65
C PDEFMR.66
C* 1. Initializations PDEFMR.67
C --------------- PDEFMR.68
C PDEFMR.69
PDEFMR.70
C PDEFMR.71
C* Zeroes error codes PDEFMR.72
C PDEFMR.73
ierror = 0 PDEFMR.74
icumul = 0 PDEFMR.75
C PDEFMR.76
C PDEFMR.77
C* 2. Create pipes to exchange fields coupler and remote models PDEFMR.78
C --------------------------------------------------------- PDEFMR.79
C PDEFMR.80
C* Assign business for reading PDEFMR.81
C PDEFMR.82
C ---> Options u and unblocked valid for sequential unformatted files PDEFMR.83
C Option u results in an immediate system call (see man assign) PDEFMR.84
C PDEFMR.85
WRITE (UNIT = clcmd,FMT =' PDEFMR.86
$ (''assign -s unblocked -a '',A8, PDEFMR.87
$ '' f:'',A8 )') cdpread, cdfread PDEFMR.88
CALL assign(
clcmd, ierror) PDEFMR.89
CALL empty(clcmd,80) PDEFMR.90
C PDEFMR.91
C* Find error if any PDEFMR.92
C PDEFMR.93
IF (ierror .EQ. 0) THEN PDEFMR.94
write(nulou,*) 'Assign command done for pipe file', cdpread PDEFMR.95
ELSE PDEFMR.96
write(nulou,*) 'Problem with assign command for pipe file', PDEFMR.97
$ cdpread PDEFMR.98
write(nulou,*) 'The error code number is', ierror PDEFMR.99
icumul = icumul + ierror PDEFMR.100
ENDIF PDEFMR.101
C PDEFMR.102
C* Get error code PDEFMR.103
C PDEFMR.104
IF (icumul .NE. 0) kinfo = icumul PDEFMR.105
C PDEFMR.106
C* Mknod business PDEFMR.107
C PDEFMR.108
C ---> mode 4480: named pipe with rw permission for user PDEFMR.109
C decimal value of octal 0010600 (see man mknod) PDEFMR.110
C PDEFMR.111
C* Reading pipes PDEFMR.112
C PDEFMR.113
ierror = mknod (cdpread, 4480, 0) PDEFMR.114
C PDEFMR.115
C* Find error if any PDEFMR.116
C PDEFMR.117
IF (ierror .EQ. 0) THEN PDEFMR.118
write(nulou,*) 'Mknod command done for pipe', cdpread PDEFMR.119
ELSE PDEFMR.120
write(nulou,*) 'Mknod command useless for pipe', cdpread PDEFMR.121
write(nulou,*) 'The error code number is', ierror PDEFMR.122
ENDIF PDEFMR.123
C PDEFMR.124
C PDEFMR.125
C* 3. End of routine PDEFMR.126
C -------------- PDEFMR.127
C PDEFMR.128
RETURN PDEFMR.129
END PDEFMR.130
PDEFMR.131
PDEFMR.132
*ENDIF PDEFMR.133
PDEFMR.134
PDEFMR.135
PDEFMR.136
PDEFMR.137
PDEFMR.138
PDEFMR.139
PDEFMR.140
PDEFMR.141