SUBROUTINE PIPE_Init_Model(cdmodnam,jm) 1,4PINIM.3
C**** PINIM.4
C ***************************** PINIM.5
C * adapted from oasis PIPE_Init PINIM.6
C * ------------- ------- * PINIM.7
C ***************************** PINIM.8
C PINIM.9
C**** *PIPE_Init_Model* - Initialize coupled mode communication for PINIM.10
C one model. PINIM.11
C PINIM.12
C Purpose: PINIM.13
C ------- PINIM.14
C Initialize coupler - model communication using named PINIM.15
c pipes(fifo). PINIM.16
C PINIM.17
C** Interface: PINIM.18
C --------- PINIM.19
C *CALL* *PIPE_Init_Model(cdmodnam,jm) PINIM.20
C PINIM.21
C Input: PINIM.22
C ----- PINIM.23
C cdmodnam : remote models names (char string) PINIM.24
c after this routine PIPE_Init_Model has run, PINIM.25
c each of the models will be able to : PINIM.26
c o write to the pipe Preadm?? when writing to PINIM.27
c 'WT'//cdmodnam PINIM.28
c o read from the pipe Pwritm?? when reading PINIM.29
c from 'RD'//cdmodnam PINIM.30
c using unix named pipes. PINIM.31
c NB : take care of NOT using the PINIM.32
c same cdmodnam into the coupler and the models PINIM.33
c as they are simple unix files whose name must PINIM.34
c be unique... PINIM.35
C jm : number of the model according to the namelist PINIM.36
c of the Oasis coupler (intger). PINIM.37
C PINIM.38
C Output: PINIM.39
C ------ PINIM.40
C kinfo : error status PINIM.41
C PINIM.42
C Workspace: PINIM.43
C --------- PINIM.44
C None PINIM.45
C PINIM.46
C Externals: PINIM.47
C --------- PINIM.48
C assign, mknod, fsigctl, ,empty, ferror, getfpe PINIM.49
C PINIM.50
C Reference: PINIM.51
C --------- PINIM.52
C See OASIS manual (1995) PINIM.53
C PINIM.54
C History: PINIM.55
C ------- PINIM.56
C Version Programmer Date Description PINIM.57
C ------- ---------- ---- ----------- PINIM.58
C 2.0 JC. Thil 96/05/03 created PINIM.59
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PINIM.60
C PINIM.61
C* ---------------------------- Argument declarations --------------- PINIM.62
PINIM.63
C PINIM.64
CHARACTER*6 cdmodnam PINIM.65
INTEGER jm PINIM.66
C PINIM.67
C* ---------------------------- Local declarations ------------------ PINIM.68
C PINIM.69
CHARACTER*90 clcmd PINIM.70
INTEGER mknod PINIM.71
CHARACTER*8 cprnam, cpwnam PINIM.72
integer nulou PINIM.73
C PINIM.74
C* ---------------------------- Poema verses ------------------------ PINIM.75
C PINIM.76
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PINIM.77
C PINIM.78
C* 1. Initializations PINIM.79
C --------------- PINIM.80
C PINIM.81
data nulou/6/ PINIM.82
C PINIM.83
C* Zeroes error codes PINIM.84
C PINIM.85
ierror = 0 PINIM.86
icumul = 0 PINIM.87
PINIM.88
C* 3. Create pipes to communicate between the ocean model and the PINIM.89
C ------------------------------------------------------------- PINIM.90
c coupler. PINIM.91
C -------- PINIM.92
C PINIM.93
C PINIM.94
C* Assign business for reading PINIM.95
C PINIM.96
C ---> Options u and unblocked valid for sequential unformatted files PINIM.97
C Option u results in an immediate system call (see man assign) PINIM.98
C PINIM.99
c excerpt of the Cray documentation : PINIM.100
c PINIM.101
c The undefined file structure PINIM.102
c (specified by assign -s u) should be specified PINIM.103
c for a pipe by the sending process. The unblocked PINIM.104
c structure (specified by assign -s unblocked) PINIM.105
c should be specified for a pipe by the receiving PINIM.106
c process.cc PINIM.107
c PINIM.108
c The file structure for the pipe of the sending PINIM.109
c (write) process should be set to undefined PINIM.110
c (assign -s u), which issues a system call for PINIM.111
c each write. You can also select a file PINIM.112
c specification of system (assign -F system) for PINIM.113
c the sending process. PINIM.114
PINIM.115
c from that end Pwritm?? is the pipe we read from PINIM.116
c hence the -s unblocked option. PINIM.117
cprnam = 'WT'//cdmodnam PINIM.118
WRITE (UNIT = clcmd,FMT =' PINIM.119
$ (''assign -s unblocked -a Pwritm'',i2.2, PINIM.120
$ '' f:'', A8 )') jm, cprnam PINIM.121
print *, clcmd PINIM.122
CALL assign(
clcmd, ierror) PINIM.123
CALL empty(clcmd,90) PINIM.124
C PINIM.125
C* Find error if any PINIM.126
C PINIM.127
IF (ierror .EQ. 0) THEN PINIM.128
write(nulou,*) PINIM.129
$ 'Assign command done for pipe ', 'Pwritm', jm, PINIM.130
$ ' file ', cprnam PINIM.131
ELSE PINIM.132
write(nulou,*) PINIM.133
$ 'Problem with assign command for pipe file', PINIM.134
$ cprnam PINIM.135
ENDIF PINIM.136
C PINIM.137
C* Assign business for writing PINIM.138
C PINIM.139
c from that end Preadm?? is the pipe we write to, PINIM.140
c hence the -s u option. PINIM.141
cpwnam = 'RD'//cdmodnam PINIM.142
WRITE (UNIT = clcmd,FMT =' PINIM.143
$ (''assign -s u -a Preadm'',i2.2, PINIM.144
$ '' f:'',A8 )') jm, cpwnam PINIM.145
print *, clcmd PINIM.146
CALL assign(clcmd, ierror) PINIM.147
CALL empty(clcmd,90) PINIM.148
C PINIM.149
C* Find error if any PINIM.150
C PINIM.151
IF (ierror .EQ. 0) THEN PINIM.152
write(nulou,*) PINIM.153
$ 'Assign command done for pipe', 'Preadm', jm, PINIM.154
$ ' file ', cpwnam PINIM.155
ELSE PINIM.156
write(nulou,*) PINIM.157
$ 'Problem with assign command for pipe file', PINIM.158
$ cpwnam PINIM.159
ENDIF PINIM.160
PINIM.161
PINIM.162
C PINIM.163
C* Mknod business PINIM.164
C PINIM.165
C ---> mode 4480: named pipe with rw permission for user PINIM.166
C decimal value of octal 0010600 (see man mknod) PINIM.167
C PINIM.168
C PINIM.169
C* Reading pipes PINIM.170
C PINIM.171
WRITE (UNIT = clcmd,FMT ='(''Preadm'',i2.2)')jm PINIM.172
ierror = mknod (clcmd, 4480, 0) PINIM.173
CALL empty(clcmd,90) PINIM.174
C PINIM.175
C* Find error if any PINIM.176
C PINIM.177
IF (ierror .EQ. 0) THEN PINIM.178
write(nulou,*) PINIM.179
$ 'Mknod command done for pipe Preadm', jm PINIM.180
ELSE PINIM.181
write(nulou,*) PINIM.182
$ 'Mknod command useless for pipe Preadm', jm PINIM.183
write(nulou,*) PINIM.184
$ 'File exists. The return code number is', ierror PINIM.185
ENDIF PINIM.186
C PINIM.187
C* Writing pipes PINIM.188
C PINIM.189
WRITE (UNIT = clcmd,FMT ='(''Pwritm'',i2.2)')jm PINIM.190
ierror = mknod (clcmd, 4480, 0) PINIM.191
CALL empty(clcmd,90) PINIM.192
C PINIM.193
C* Find error if any PINIM.194
C PINIM.195
IF (ierror .EQ. 0) THEN PINIM.196
write(nulou,*) PINIM.197
$ 'Mknod command done for pipe Pwritm', jm PINIM.198
ELSE PINIM.199
write(nulou,*) PINIM.200
$ 'Mknod command useless for pipe Pwritm', jm PINIM.201
write(nulou,*) PINIM.202
$ 'File exists. The return code number is', ierror PINIM.203
ENDIF PINIM.204
C PINIM.205
C PINIM.206
RETURN PINIM.207
END PINIM.208
PINIM.209
*ENDIF PINIM.210