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