subroutine ini_cmc( 4,3INICMC.50
*CALL ARGSIZE 
INICMC.51
*CALL ARGD1 INICMC.52
*CALL ARGSTS INICMC.53
*CALL ARGDUMA INICMC.54
*CALL ARGDUMO INICMC.55
*CALL ARGPTRA INICMC.56
*CALL ARGPTRO INICMC.57
*CALL ARGCONA INICMC.58
*CALL ARGCONO INICMC.59
& internal_model, INICMC.60
& un_lock_mode, INICMC.61
& icode,cmessage ) INICMC.62
C INICMC.63
implicit none INICMC.64
C parameters : INICMC.65
*CALL CMAXSIZE INICMC.66
*CALL CSUBMODL INICMC.67
*CALL TYPSIZE INICMC.68
*CALL TYPD1 INICMC.69
*CALL TYPSTS INICMC.70
*CALL TYPDUMA INICMC.71
*CALL TYPDUMO INICMC.72
*CALL TYPPTRA INICMC.73
*CALL TYPPTRO INICMC.74
*CALL TYPCONA INICMC.75
*CALL TYPCONO INICMC.76
C INICMC.77
INICMC.78
integer internal_model ! IN - no of current internal model. INICMC.79
integer un_lock_mode ! IN - 1 create pipes and receive from INICMC.80
! OASIS INICMC.81
! 2 send OK to OASIS INICMC.82
integer icode ! OUT - Error return code INICMC.83
character*(*) cmessage ! OUT - Error return message INICMC.84
INICMC.85
C INICMC.86
C*-------------------------------------------------------------------- INICMC.87
C INICMC.88
C Common blocks INICMC.89
C INICMC.90
*CALL COASIS INICMC.91
*CALL C_MDI INICMC.92
*CALL STPARAM INICMC.93
! include internal_model timestep information. INICMC.94
*CALL CTIME INICMC.95
INICMC.96
C INICMC.97
C*-------------------------------------------------------------------- INICMC.98
C INICMC.99
C INICMC.100
C Local variables INICMC.101
C INICMC.102
INICMC.103
external getpid INICMC.104
integer getpid INICMC.105
INICMC.106
integer exchange_basis ! first exchange timestep for a given INICMC.107
! field. INICMC.108
integer max_timestep INICMC.109
integer timestep_duration INICMC.110
integer Zoffset ! = min of offsets over all coupled INICMC.111
! fields INICMC.112
! (ie : offset of the model). INICMC.113
character*8 INICMC.114
& cprnam, ! reading pipe of the UM. INICMC.115
& cpwnam ! writing pipe of the UM. INICMC.116
character*6 cdmodnam ! string name of the current internal INICMC.117
! model. INICMC.118
INICMC.119
character*80 tempstring ! a temporary string. INICMC.120
INICMC.121
integer kinfo INICMC.122
INICMC.123
integer ! arrays exported/imported to OASIS. INICMC.124
& isend(4), irecv(4) ! via pipes INICMC.125
integer npioc ! UNIX pid of the UM as given by the INICMC.126
! system INICMC.127
INICMC.128
C INICMC.129
C*-------------------------------------------------------------------- INICMC.130
C INICMC.131
write(nulou,*) "entering INICMC" INICMC.132
INICMC.133
C Define the base name and the number of the model as it will INICMC.134
C be seen by OASIS : INICMC.135
if (internal_model.eq.atmos_im) then ! atmosphere INICMC.136
cdmodnam = 'UMatm' INICMC.137
elseif (internal_model.eq.ocean_im) then ! ocean INICMC.138
cdmodnam = 'UMoce' INICMC.139
else INICMC.140
icode = -1 INICMC.141
write(nulou,*) INICMC.142
& 'Coupling with UM internal model different from' INICMC.143
write(nulou,*) INICMC.144
& 'the atmosphere or the ocean not currently allowed.' INICMC.145
goto 999 INICMC.146
endif INICMC.147
INICMC.148
cprnam = 'WT' // cdmodnam !pipe the UM is reading from. INICMC.149
cpwnam = 'RD' // cdmodnam !pipe the UM is writing to INICMC.150
INICMC.151
C INICMC.152
C*-------------------------------------------------------------------- INICMC.153
C INICMC.154
if (un_lock_mode .eq. 1) then INICMC.155
C create the named pipes with which the communication INICMC.156
C will occur with oasis. This is done via the routine INICMC.157
C PIPE_Init_Model as far as the pipes for the INICMC.158
C models are concerned. INICMC.159
call PIPE_Init_Model(cdmodnam,internal_model) INICMC.160
INICMC.161
C Define the name of the pipes to be exchanged with the oasis INICMC.162
C coupler : INICMC.163
C loop over the values of the array FieldLocator for that : INICMC.164
do i = 1, NoCouplingField INICMC.165
C create the named pipes with which the communication INICMC.166
C relative to each of the INICMC.167
C exchanged files will occur with oasis. This is done via the INICMC.168
C routines INICMC.169
C PIPE_Define_Model_Write/Read for the pipes INICMC.170
C dedicated to each fields. INICMC.171
C It creates the named pipes and assigns a given file to it. INICMC.172
tempstring = FieldLocator(istash,i) ! pipe INICMC.173
cdpipe(i)= tempstring(1:5) INICMC.174
cdfile(i)= 'f' // cdpipe(i) ! associated file INICMC.175
if (FieldLocator(direction,i) .eq. 'E') then INICMC.176
call PIPE_Define_Model_Write(cdfile(i), cdpipe(i),kinfo) INICMC.177
else !imported fields INICMC.178
call PIPE_Define_Model_Read( cdfile(i), cdpipe(i), kinfo) INICMC.179
endif INICMC.180
enddo INICMC.181
INICMC.182
INICMC.183
write(nulou,*) INICMC.184
& '########### ' INICMC.185
& // cdmodnam // INICMC.186
& ' reads pid info from OASIS.....' INICMC.187
read(cprnam,*) irecv PXINICMC.1
write(nulou,*) INICMC.189
& '########### ...... ' INICMC.190
& // cdmodnam // INICMC.191
& ' has read pid info from cpl.' INICMC.192
write(nulou,*) irecv INICMC.193
INICMC.194
C INICMC.195
C*----------------------------------------------------------- INICMC.196
C INICMC.197
elseif (un_lock_mode .eq. 2) then INICMC.198
C*- send the pid of the UM to the coupler via INICMC.199
C*- the dedicated pipe, and wait for the coupler to allow INICMC.200
C*- to proceed. INICMC.201
C INICMC.202
write(nulou,*) INICMC.203
& '########### '// cdmodnam // 'writes pid info to OASIS....' INICMC.204
max_timestep = TARGET_END_STEPim(internal_model) INICMC.205
*IF DEF,MPP INICMC.206
timestep_duration = SECS_PER_STEPim(internal_model) ! + 1 INICMC.207
*ELSE INICMC.208
timestep_duration = SECS_PER_STEPim(internal_model) + 1 INICMC.209
*ENDIF INICMC.210
C Compute the offset of the model = the INICMC.211
C Min of the offsets over all coupling fields. INICMC.212
Zoffset = 10000000 ! should be large enough. INICMC.213
do i = 1, NoCouplingField INICMC.214
read(FieldLocator(exc_basis,i),'(i8)') exchange_basis INICMC.215
if (exchange_basis.le.Zoffset) then INICMC.216
Zoffset = exchange_basis INICMC.217
endif INICMC.218
enddo INICMC.219
INICMC.220
C Get the Process ID of the model: INICMC.221
npioc = getpid() INICMC.222
INICMC.223
isend(1) = max_timestep - Zoffset + 1 INICMC.224
! isend(2) should be exchange_frequency, but is obsolete now as INICMC.225
! the coupling frequency depends on the field. The value for the INICMC.226
! first coupling field is set instead. INICMC.227
read( FieldLocator(exc_frequency,1), '(i8)') isend(2) INICMC.228
isend(3) = timestep_duration INICMC.229
isend(4) = npioc INICMC.230
print *, "write on pipe cpwnam : ", cpwnam INICMC.231
write(cpwnam,*) isend PXINICMC.2
print *, "done !" INICMC.233
write(nulou,*) INICMC.234
& '########### ....' INICMC.235
& // cdmodnam // INICMC.236
& 'UM has written pid info to OASIS' INICMC.237
write(nulou,*) "finishing INICMC" INICMC.238
INICMC.239
endif ! un_lock_mode eq 1 or 2 INICMC.240
INICMC.241
999 continue INICMC.242
return INICMC.243
end INICMC.244
*ENDIF INICMC.245