subroutine OASIS_STEP( 1,10OASISTEP.65
*IF DEF,ATMOS OASISTEP.66
& G_P_FIELD, OASISTEP.67
*ENDIF OASISTEP.68
*IF DEF,OCEAN OASISTEP.69
& G_IMTJMT, OASISTEP.70
*ENDIF OASISTEP.71
*CALL ARGSIZE 
OASISTEP.72
*CALL ARGD1 OASISTEP.73
*CALL ARGSTS OASISTEP.74
*CALL ARGDUMA OASISTEP.75
*CALL ARGDUMO OASISTEP.76
*CALL ARGPTRA OASISTEP.77
*CALL ARGPTRO OASISTEP.78
*CALL ARGCONA OASISTEP.79
*CALL ARGCONO OASISTEP.80
& internal_model, OASISTEP.81
& ICODE,CMESSAGE) OASISTEP.82
OASISTEP.83
implicit none OASISTEP.84
OASISTEP.85
C arguments type : OASISTEP.86
*IF DEF,ATMOS OASISTEP.87
integer g_p_field OASISTEP.88
*ENDIF OASISTEP.89
*IF DEF,OCEAN OASISTEP.90
integer g_imtjmt OASISTEP.91
*ENDIF OASISTEP.92
*CALL C_MDI OASISTEP.93
*CALL CMAXSIZE OASISTEP.94
*CALL CSUBMODL OASISTEP.95
*CALL TYPSIZE OASISTEP.96
*CALL TYPD1 OASISTEP.97
*CALL TYPSTS OASISTEP.98
*CALL TYPDUMO OASISTEP.99
*CALL TYPDUMA OASISTEP.100
*CALL TYPPTRO OASISTEP.101
*CALL TYPPTRA OASISTEP.102
*CALL TYPCONA OASISTEP.103
*CALL TYPCONO OASISTEP.104
OASISTEP.105
integer internal_model OASISTEP.106
OASISTEP.107
INTEGER ICODE ! OUT - Error return code OASISTEP.108
CHARACTER*(*) CMESSAGE ! OUT - Error return message OASISTEP.109
OASISTEP.110
C commons : OASISTEP.111
! Time status of the Unified Model. OASISTEP.112
*CALL CTIME OASISTEP.113
! common variables of the UM_OASIS section. OASISTEP.114
*CALL COASIS OASISTEP.115
OASISTEP.116
*CALL PARVARS OASISTEP.117
*CALL DECOMPTP OASISTEP.118
*CALL DECOMPDB OASISTEP.119
OASISTEP.122
! memory allocation for the coupling fields. OASISTEP.123
*IF DEF,OCEAN OASISTEP.124
real Zwork(g_imtjmt) OASISTEP.125
*ENDIF OASISTEP.126
*IF DEF,ATMOS OASISTEP.127
real Zwork(g_p_field) OASISTEP.128
real Zwork_aice_previous(p_field) ! Temp array to store the OASISTEP.129
! ice fraction. OASISTEP.130
*ENDIF OASISTEP.131
OASISTEP.132
integer timestep ! timesteps of the atmosphere model OASISTEP.133
integer cpl_timestep ! timestep of the coupler (we get it AJC1F405.579
! from a pipe from the coupler OASISTEP.135
OASISTEP.136
integer kinfo OASISTEP.137
integer exchange_frequency ! interval in timesteps between each OASISTEP.138
! coupling of the current field. OASISTEP.139
integer exchange_basis ! basis timestep of the OASISTEP.140
! coupling of the current field. OASISTEP.141
integer Zoffset ! = min of offsets over all coupled OASISTEP.142
! fields OASISTEP.143
! (ie : offset of the model). OASISTEP.144
integer iost ! io status at open file time. OASISTEP.145
integer kerror ! error number of locread/write. OASISTEP.146
OASISTEP.147
integer res ! modulo of timestep by OASISTEP.148
! exchange_frequency. OASISTEP.149
OASISTEP.150
character*80 tempstring ! temporary string. OASISTEP.151
integer nulinp, nuloup ! unit no of the io files shared with OASISTEP.152
! OASIS. OASISTEP.153
character*255 cficinp, cficoup ! names of the io files shared OASISTEP.154
! with OASIS. OASISTEP.155
OASISTEP.156
integer first_call ! eq 1 if first call of OASIS_STEP, OASISTEP.157
! 0 otherwise OASISTEP.158
data first_call /1/ OASISTEP.159
C--------------------------------------------------------------------- OASISTEP.160
OASISTEP.161
write(nulou,*) 'entering OASIS_STEP ...' OASISTEP.162
OASISTEP.163
C OASISTEP.164
C*-- Get 'global' atmos and ocean horizontal domain sizes from OASISTEP.165
C*-- database in DECOMPDB to set dynamic allocation in TRANSO2A OASISTEP.166
C OASISTEP.167
OASISTEP.168
*IF DEF,ATMOS OASISTEP.169
g_row_length = decomp_db_glsize(1,decomp_standard_atmos) OASISTEP.170
g_p_rows = decomp_db_glsize(2,decomp_standard_atmos) OASISTEP.171
g_u_rows = g_p_rows - 1 OASISTEP.172
write(nulou,*) OASISTEP.173
& 'g_row_length, g_p_rows, g_u_rows, g_p_field ', OASISTEP.174
& g_row_length, g_p_rows, g_u_rows, g_p_field OASISTEP.175
*ENDIF OASISTEP.176
*IF DEF,OCEAN OASISTEP.177
g_imt = decomp_db_glsize(1,decomp_standard_ocean) OASISTEP.178
g_jmt = decomp_db_glsize(2,decomp_standard_ocean) OASISTEP.179
CCC g_jmt = decomp_db_glsize(2,decomp_standard_ocean) + 1 OASISTEP.180
g_jmtm1 = g_jmt - 1 OASISTEP.181
write(nulou,*) OASISTEP.182
& 'g_imt, g_jmt, g_jmt-1, g_imtjmt ', OASISTEP.183
& g_imt, g_jmt, g_jmtm1, g_imtjmt OASISTEP.184
*ENDIF OASISTEP.185
OASISTEP.186
OASISTEP.187
C OASISTEP.188
C*-- Setup the initialisation of the coupler at the first call of OASISTEP.189
C*-- oasis_step. OASISTEP.190
C OASISTEP.191
if (first_call .eq. 1) then OASISTEP.192
call init_oasis( OASISTEP.193
*CALL ARGSIZE OASISTEP.194
*CALL ARGD1 OASISTEP.195
*CALL ARGSTS OASISTEP.196
*CALL ARGDUMA OASISTEP.197
*CALL ARGDUMO OASISTEP.198
*CALL ARGPTRA OASISTEP.199
*CALL ARGPTRO OASISTEP.200
*CALL ARGCONA OASISTEP.201
*CALL ARGCONO OASISTEP.202
& internal_model, OASISTEP.203
& icode,cmessage) OASISTEP.204
first_call = 0 ! won't be called afterwards then. OASISTEP.205
endif ! first_call OASISTEP.206
OASISTEP.207
C OASISTEP.208
C*-- Extract the current timestep of the UM : OASISTEP.209
C OASISTEP.210
timestep = STEPim(internal_model) OASISTEP.211
OASISTEP.212
! Compute the offset of the model = the OASISTEP.213
! Min of the offsets over all coupling fields. OASISTEP.214
Zoffset = 10000000 ! should be large enough. OASISTEP.215
do i = 1, NoCouplingField OASISTEP.216
read(FieldLocator(exc_basis,i),'(i8)') exchange_basis OASISTEP.217
if (exchange_basis.le.Zoffset) then OASISTEP.218
Zoffset = exchange_basis OASISTEP.219
endif OASISTEP.220
enddo OASISTEP.221
OASISTEP.222
C Loop over the list of coupling fields : OASISTEP.223
do ii = 1, NoCouplingField OASISTEP.224
C OASISTEP.225
C*- Check if the field ii is due to be coupled at this timestep OASISTEP.226
C*- of the UM. In a nutshell, coupling of a field occurs at OASISTEP.227
C*- a frequency choosen by the user (item 'exc_frequency' of OASISTEP.228
C*- the array FieldLocator) and start on a timestep of the UM OASISTEP.229
C*- also chosen by the user (item 'exc_basis' of the array OASISTEP.230
C*- FieldLocator). As the UM timesteps begin at 1, a choice of OASISTEP.231
C*- exchange basis of 1 will induce coupling straight from the OASISTEP.232
C*- first timestep, even before any computation has been made. OASISTEP.233
C OASISTEP.234
read(FieldLocator(exc_frequency,ii),'(i8)') exchange_frequency OASISTEP.235
read(FieldLocator(exc_basis,ii), '(i8)') exchange_basis OASISTEP.236
res = mod((timestep - exchange_basis), exchange_frequency) OASISTEP.237
if ((res .eq. 0).and.(timestep.ge.exchange_basis)) then OASISTEP.238
C OASISTEP.239
C*- The current field is due to be coupled : Two possibilities : OASISTEP.240
C*- a/ The field is to be imported. OASISTEP.241
C*- b/ The field is to be exported. OASISTEP.242
C OASISTEP.243
C*- We explore the above item a/. OASISTEP.244
C*- The UM waits until the coupler sends a message OASISTEP.245
C*- telling him that the field has been produced : OASISTEP.246
C OASISTEP.247
if (FieldLocator(direction,ii) .eq. 'I') then OASISTEP.248
C OASISTEP.249
C* I/O to OASIS are done on one PE only. OASISTEP.250
C OASISTEP.251
if (mype .eq. gather_pe) then OASISTEP.252
write(nulou,*) '######### UM reads timestep from cpl...' OASISTEP.253
tempstring = cdpipe(ii) OASISTEP.254
read(tempstring,*) cpl_timestep PXOASIS.1
write(nulou,*) OASISTEP.256
& '######### ....UM has read timestep info from cpl: ', OASISTEP.257
& cpl_timestep OASISTEP.258
OASISTEP.259
C OASISTEP.260
C*- Read the field using the oasis routine locread. OASISTEP.261
C OASISTEP.262
write(nulou,*) '######### UM reads field from file...' OASISTEP.263
nulinp = 3 OASISTEP.264
C*- define the filename the field will be located in : OASISTEP.265
cficinp = "UM" // cdpipe(ii) OASISTEP.266
open (unit = nulinp,file = cficinp,status='UNKNOWN', OASISTEP.267
& form ='UNFORMATTED',iostat = iost) OASISTEP.268
if (iost .ne. 0) then OASISTEP.269
icode = 1 OASISTEP.270
cmessage = 'io error in OASIS_STEP from atmosphere' OASISTEP.271
& // 'model.' OASISTEP.272
endif ! iost OASISTEP.273
! The straightforward call to locwrite with D1 as an argument is OASISTEP.274
! replaced with Zwork as argument ; Zwork contains the fields OASISTEP.275
! which are due to be exported by the UM; they are computed during OASISTEP.276
! the call to oasis_diagnostics. OASISTEP.277
*IF DEF,ATMOS OASISTEP.278
do i = 1, g_p_field OASISTEP.279
*ENDIF OASISTEP.280
*IF DEF,OCEAN OASISTEP.281
do i = 1, g_imtjmt OASISTEP.282
*ENDIF OASISTEP.283
Zwork(i) = RMDI ! set the extended array to rmdi. OASISTEP.284
enddo OASISTEP.285
call locread(cdpipe(ii),Zwork, OASISTEP.286
& FieldSize(ii), nulinp,kerror) OASISTEP.287
write(nulou,*) OASISTEP.288
& '######### ....UM has read field from file' OASISTEP.289
close(nulinp) OASISTEP.290
OASISTEP.291
endif ! mype.eq.gather_pe OASISTEP.292
C OASISTEP.293
C*-- Some fields need to be reworked after they have been OASISTEP.294
C*-- imported; OASISTEP.295
C*-- This is the case of ALL the ocean fields whose 1st and OASISTEP.296
C*-- 2nd columns need be copied in the columns no imt-1, imt. OASISTEP.297
C OASISTEP.298
call oasis_diagnostics_import( OASISTEP.299
*IF DEF,ATMOS OASISTEP.300
& g_p_field, OASISTEP.301
*ENDIF OASISTEP.302
*IF DEF,OCEAN OASISTEP.303
& g_imtjmt, OASISTEP.304
*ENDIF OASISTEP.305
*CALL ARGSIZE OASISTEP.306
*CALL ARGD1 OASISTEP.307
*CALL ARGSTS OASISTEP.308
*CALL ARGDUMO OASISTEP.309
*CALL ARGDUMA OASISTEP.310
*CALL ARGPTRO OASISTEP.311
*CALL ARGPTRA OASISTEP.312
& Zwork, OASISTEP.313
*IF DEF,ATMOS OASISTEP.314
& Zwork_aice_previous, OASISTEP.315
*ENDIF OASISTEP.316
& ii, OASISTEP.317
& internal_model, OASISTEP.318
& ICODE,CMESSAGE ) OASISTEP.319
OASISTEP.320
C OASISTEP.321
C*- We explore the above item b/. OASISTEP.322
C*- The UM tells the coupler that the field has been produced OASISTEP.323
C*- by sending a message to the coupler : OASISTEP.324
C OASISTEP.325
elseif (FieldLocator(direction,ii) .eq. 'E') then OASISTEP.326
C OASISTEP.327
C*-- Gather some of the coupling fields ; those fields are OASISTEP.328
C*-- required by the external model, but not generated by the UM. OASISTEP.329
C*-- After this routine has run, the fields exist in the working OASISTEP.330
C*-- memory of OASIS (Zwork). OASISTEP.331
C OASISTEP.332
call oasis_diagnostics( OASISTEP.333
*IF DEF,ATMOS OASISTEP.334
& g_p_field, OASISTEP.335
*ENDIF OASISTEP.336
*IF DEF,OCEAN OASISTEP.337
& g_imtjmt, OASISTEP.338
*ENDIF OASISTEP.339
*CALL ARGSIZE OASISTEP.340
*CALL ARGD1 OASISTEP.341
*CALL ARGSTS OASISTEP.342
*CALL ARGDUMO OASISTEP.343
*CALL ARGDUMA OASISTEP.344
*CALL ARGPTRO OASISTEP.345
*CALL ARGPTRA OASISTEP.346
*CALL ARGCONO OASISTEP.347
*CALL ARGCONA OASISTEP.348
& Zwork, OASISTEP.349
& ii, OASISTEP.350
& internal_model, OASISTEP.351
& ICODE, OASISTEP.352
& CMESSAGE ) OASISTEP.353
OASISTEP.354
C OASISTEP.355
C* I/O to OASIS are done on one PE only. OASISTEP.356
C OASISTEP.357
if (mype .eq. gather_pe) then OASISTEP.358
C OASISTEP.359
C*- Write the field at the location agreed so that it can be OASISTEP.360
C*- read by the coupler at a further phase. OASISTEP.361
C OASISTEP.362
write(nulou,*) '######### UM writes field on file...' OASISTEP.363
nuloup = 3 OASISTEP.364
C*- Define the filename the field will be located in : OASISTEP.365
cficoup = "UM" // cdpipe(ii) OASISTEP.366
open (unit = nuloup,file = cficoup,status='UNKNOWN', OASISTEP.367
& form ='UNFORMATTED',iostat = iost) OASISTEP.368
if (iost .ne. 0) then OASISTEP.369
icode = 1 OASISTEP.370
cmessage = 'io error in OASIS_STEP from atmosphere ' OASISTEP.371
& // 'model.' OASISTEP.372
endif OASISTEP.373
OASISTEP.374
! Zwork contains the fields which are due to be exported by the UM OASISTEP.375
! computed during the call to oasis_diagnostics. OASISTEP.376
call locwrite(cdpipe(ii),Zwork, OASISTEP.377
& FieldSize(ii), nuloup, kerror) OASISTEP.378
write(nulou,*) OASISTEP.379
& '######### .... UM has written field on file.' OASISTEP.380
C OASISTEP.381
C*- Close the file to flush its contents on disk. OASISTEP.382
C OASISTEP.383
close(nuloup) OASISTEP.384
C OASISTEP.385
C*- notify OASIS that the field has been written OASISTEP.386
C*- by writing the timestep on the pipe dedicated to it : OASISTEP.387
C OASISTEP.388
write(nulou,*) OASISTEP.389
& '######## UM writes timestep info to OASIS...' OASISTEP.390
tempstring = cdfile(ii) OASISTEP.391
write(tempstring,*) (timestep - Zoffset + 1) PXOASIS.2
write(nulou,*) OASISTEP.393
& '######## .....UM has written timestep info to OASIS' OASISTEP.394
OASISTEP.395
OASISTEP.396
endif ! mype.eq.gather_pe OASISTEP.397
OASISTEP.398
else OASISTEP.399
write(nulou,*) OASISTEP.400
& 'ERROR in oasis_step : erroneous direction of field ' OASISTEP.401
& // 'selected.' OASISTEP.402
endif ! FieldLocator OASISTEP.403
OASISTEP.404
endif ! res, timestep OASISTEP.405
OASISTEP.406
enddo ! ii OASISTEP.407
OASISTEP.408
!------------------------------------------------ OASISTEP.409
! error trap. OASISTEP.410
999 continue OASISTEP.411
if(icode.ne.0) then OASISTEP.412
write(nulou,*) cmessage,icode OASISTEP.413
endif OASISTEP.414
write(nulou,*) "exiting OASIS_STEP" OASISTEP.415
OASISTEP.416
return OASISTEP.417
end OASISTEP.418
OASISTEP.419
*ENDIF OASISTEP.420
*IF DEF,C99_1A,AND,-DEF,MPP OASISTEP.425
subroutine OASIS_STEP( 1,10OASISTEP.426
*CALL ARGSIZE OASISTEP.427
*CALL ARGD1 OASISTEP.428
*CALL ARGSTS OASISTEP.429
*CALL ARGDUMA OASISTEP.430
*CALL ARGDUMO OASISTEP.431
*CALL ARGPTRA OASISTEP.432
*CALL ARGPTRO OASISTEP.433
*CALL ARGCONA OASISTEP.434
*CALL ARGCONO OASISTEP.435
& internal_model, OASISTEP.436
& ICODE,CMESSAGE) OASISTEP.437
OASISTEP.438
implicit none OASISTEP.439
OASISTEP.440
C arguments type : OASISTEP.441
*CALL CMAXSIZE OASISTEP.442
*CALL CSUBMODL OASISTEP.443
*CALL TYPSIZE OASISTEP.444
*CALL TYPD1 OASISTEP.445
*CALL TYPSTS OASISTEP.446
*CALL TYPDUMO OASISTEP.447
*CALL TYPDUMA OASISTEP.448
*CALL TYPPTRO OASISTEP.449
*CALL TYPPTRA OASISTEP.450
*CALL TYPCONA OASISTEP.451
*CALL TYPCONO OASISTEP.452
OASISTEP.453
integer internal_model OASISTEP.454
OASISTEP.455
INTEGER ICODE ! OUT - Error return code OASISTEP.456
CHARACTER*(*) CMESSAGE ! OUT - Error return message OASISTEP.457
OASISTEP.458
C commons : OASISTEP.459
! Time status of the Unified Model. OASISTEP.460
*CALL CTIME OASISTEP.461
! common variables of the UM_OASIS section. OASISTEP.462
*CALL COASIS OASISTEP.463
OASISTEP.464
! memory allocation for the coupling fields. OASISTEP.465
*IF DEF,OCEAN OASISTEP.466
real Zwork(imt*jmt) OASISTEP.467
*ENDIF OASISTEP.468
*IF DEF,ATMOS OASISTEP.469
real Zwork(P_FIELD) OASISTEP.470
real Zwork_aice_previous(p_field) OASISTEP.471
*ENDIF OASISTEP.472
OASISTEP.473
integer timestep ! timesteps of the atmosphere model OASISTEP.474
integer cpl_timestep ! timestep of the coupler (we get it AJC1F405.580
! from a pipe from the coupler OASISTEP.476
OASISTEP.477
integer kinfo OASISTEP.478
integer exchange_frequency ! interval in timesteps between each OASISTEP.479
! coupling of the current field. OASISTEP.480
integer exchange_basis ! basis timestep of the OASISTEP.481
! coupling of the current field. OASISTEP.482
integer Zoffset ! = min of offsets over all coupled OASISTEP.483
! fields OASISTEP.484
! (ie : offset of the model). OASISTEP.485
integer iost ! io status at open file time. OASISTEP.486
integer kerror ! error number of locread/write. OASISTEP.487
OASISTEP.488
integer res ! modulo of timestep by OASISTEP.489
! exchange_frequency. OASISTEP.490
OASISTEP.491
character*80 tempstring ! temporary string. OASISTEP.492
integer nulinp, nuloup ! unit no of the io files shared with OASISTEP.493
! OASIS. OASISTEP.494
character*255 cficinp, cficoup ! names of the io files shared OASISTEP.495
! with OASIS. OASISTEP.496
OASISTEP.497
integer first_call ! eq 1 if first call of OASIS_STEP, OASISTEP.498
! 0 otherwise OASISTEP.499
data first_call /1/ OASISTEP.500
C--------------------------------------------------------------------- OASISTEP.501
OASISTEP.502
write(nulou,*) 'entering OASIS_STEP ...' OASISTEP.503
OASISTEP.504
OASISTEP.505
C OASISTEP.506
C*-- Setup the initialisation of the coupler at the first call of OASISTEP.507
C*-- oasis_step. OASISTEP.508
C OASISTEP.509
if ( first_call .eq. 1 ) then OASISTEP.510
call init_oasis( OASISTEP.511
*CALL ARGSIZE OASISTEP.512
*CALL ARGD1 OASISTEP.513
*CALL ARGSTS OASISTEP.514
*CALL ARGDUMA OASISTEP.515
*CALL ARGDUMO OASISTEP.516
*CALL ARGPTRA OASISTEP.517
*CALL ARGPTRO OASISTEP.518
*CALL ARGCONA OASISTEP.519
*CALL ARGCONO OASISTEP.520
& internal_model, OASISTEP.521
& icode,cmessage) OASISTEP.522
first_call = 0 ! won't be called afterwards then. OASISTEP.523
endif ! first_call OASISTEP.524
OASISTEP.525
C OASISTEP.526
C*-- Extract the current timestep of the UM : OASISTEP.527
C OASISTEP.528
timestep = STEPim(internal_model) OASISTEP.529
OASISTEP.530
! Compute the offset of the model = the OASISTEP.531
! Min of the offsets over all coupling fields. OASISTEP.532
Zoffset = 10000000 ! should be large enough. OASISTEP.533
do i = 1, NoCouplingField OASISTEP.534
read(FieldLocator(exc_basis,i),'(i8)') exchange_basis OASISTEP.535
if (exchange_basis.le.Zoffset) then OASISTEP.536
Zoffset = exchange_basis OASISTEP.537
endif OASISTEP.538
enddo OASISTEP.539
OASISTEP.540
C Loop over the list of coupling fields : OASISTEP.541
do ii = 1, NoCouplingField OASISTEP.542
C OASISTEP.543
C*- Check if the field ii is due to be coupled at this timestep OASISTEP.544
C*- of the UM. In a nutshell, coupling of a field occurs at OASISTEP.545
C*- a frequency choosen by the user (item 'exc_frequency' of OASISTEP.546
C*- the array FieldLocator) and start on a timestep of the UM OASISTEP.547
C*- also chosen by the user (item 'exc_basis' of the array OASISTEP.548
C*- FieldLocator). As the UM timesteps begin at 1, a choice of OASISTEP.549
C*- exchange basis of 1 will induce coupling straight from the OASISTEP.550
C*- first timestep, even before any computation has been made. OASISTEP.551
C OASISTEP.552
read(FieldLocator(exc_frequency,ii),'(i8)')exchange_frequency OASISTEP.553
read(FieldLocator(exc_basis,ii), '(i8)') exchange_basis OASISTEP.554
res = mod((timestep - exchange_basis), exchange_frequency) OASISTEP.555
if ((res .eq. 0).and.(timestep.ge.exchange_basis)) then OASISTEP.556
C OASISTEP.557
C*- The current field is due to be coupled : Two possibilities : OASISTEP.558
C*- a/ The field is to be imported. OASISTEP.559
C*- b/ The field is to be exported. OASISTEP.560
C OASISTEP.561
C*- We explore the above item a/. OASISTEP.562
C*- The UM waits until the coupler sends a message OASISTEP.563
C*- telling him that the field has been produced : OASISTEP.564
C OASISTEP.565
if (FieldLocator(direction,ii) .eq. 'I') then OASISTEP.566
write(nulou,*) '######### UM reads timestep from cpl...' OASISTEP.567
tempstring = cdpipe(ii) OASISTEP.568
read(tempstring,*) cpl_timestep PXOASIS.3
write(nulou,*) OASISTEP.570
& '######### ....UM has read timestep info from cpl: ', OASISTEP.571
& cpl_timestep OASISTEP.572
OASISTEP.573
C OASISTEP.574
C*- read the field using the oasis routine locread. OASISTEP.575
C OASISTEP.576
write(nulou,*) '######### UM reads field from file...' OASISTEP.577
nulinp = 3 OASISTEP.578
C*- define the filename the field will be located in : OASISTEP.579
cficinp = "UM" // cdpipe(ii) OASISTEP.580
open (unit = nulinp,file = cficinp,status='UNKNOWN', OASISTEP.581
& form ='UNFORMATTED',iostat = iost) OASISTEP.582
if (iost .ne. 0) then OASISTEP.583
icode = 1 OASISTEP.584
cmessage = 'io error in OASIS_STEP from atmos model.' OASISTEP.585
endif OASISTEP.586
! The straightforward call to locwrite with D1 as an argument is OASISTEP.587
! replaced with Zwork as argument ; Zwork contains the fields OASISTEP.588
! which are due to be exported by the UM; they are computed during OASISTEP.589
! the call to oasis_diagnostics. OASISTEP.590
call locread(cdpipe(ii),Zwork, OASISTEP.591
& FieldSize(ii), nulinp,kerror) OASISTEP.592
write(nulou,*) OASISTEP.593
& '######### ....UM has read field from file' OASISTEP.594
close(nulinp) OASISTEP.595
C OASISTEP.596
C*-- Some fields need to be reworked after they have been OASISTEP.597
C*-- imported; this is the case of ALL the ocean fields whose OASISTEP.598
C*-- 1st and 2nd columns need be copied in the columns no imt-1, OASISTEP.599
C*-- imt. OASISTEP.600
C OASISTEP.601
call oasis_diagnostics_import( OASISTEP.602
*CALL ARGSIZE OASISTEP.603
*CALL ARGD1 OASISTEP.604
*CALL ARGSTS OASISTEP.605
*CALL ARGDUMO OASISTEP.606
*CALL ARGDUMA OASISTEP.607
*CALL ARGPTRO OASISTEP.608
*CALL ARGPTRA OASISTEP.609
& Zwork, OASISTEP.610
*IF DEF,ATMOS OASISTEP.611
& Zwork_aice_previous, OASISTEP.612
*ENDIF OASISTEP.613
& ii, OASISTEP.614
& internal_model, OASISTEP.615
& ICODE,CMESSAGE ) OASISTEP.616
OASISTEP.617
OASISTEP.618
C OASISTEP.619
C*- We explore the above item b/. OASISTEP.620
C*- The UM tells the coupler that the field has been produced OASISTEP.621
C*- by sending a message to the coupler : OASISTEP.622
C OASISTEP.623
elseif (FieldLocator(direction,ii) .eq. 'E') then OASISTEP.624
C OASISTEP.625
C*-- Gather some of the coupling fields ; those fields are OASISTEP.626
C*-- required by the external model, but not generated by the UM. OASISTEP.627
C*-- After this routine has run, the fields exist in the working OASISTEP.628
C*-- memory of OASIS (Zwork). OASISTEP.629
C OASISTEP.630
OASISTEP.631
call oasis_diagnostics( OASISTEP.632
*CALL ARGSIZE OASISTEP.633
*CALL ARGD1 OASISTEP.634
*CALL ARGSTS OASISTEP.635
*CALL ARGDUMO OASISTEP.636
*CALL ARGDUMA OASISTEP.637
*CALL ARGPTRO OASISTEP.638
*CALL ARGPTRA OASISTEP.639
*CALL ARGCONO OASISTEP.640
*CALL ARGCONA OASISTEP.641
& Zwork, OASISTEP.642
& ii, OASISTEP.643
& internal_model, OASISTEP.644
& ICODE, OASISTEP.645
& CMESSAGE ) OASISTEP.646
OASISTEP.647
C OASISTEP.648
C*- Write the field at the location agreed so that it can be OASISTEP.649
C*- read by the coupler at a further phase. OASISTEP.650
C OASISTEP.651
OASISTEP.652
write(nulou,*) '######### UM writes field on file...' OASISTEP.653
nuloup = 3 OASISTEP.654
C*- define the filename the field will be located in : OASISTEP.655
cficoup = "UM" // cdpipe(ii) OASISTEP.656
open (unit = nuloup,file = cficoup,status='UNKNOWN', OASISTEP.657
& form ='UNFORMATTED',iostat = iost) OASISTEP.658
if (iost .ne. 0) then OASISTEP.659
icode = 1 OASISTEP.660
cmessage = 'io error in OASIS_STEP from atmos model.' OASISTEP.661
endif OASISTEP.662
! The straightforward call to locwrite with D1 as an argument is OASISTEP.663
! replaced with Zwork as argument ; Zwork contains the field OASISTEP.664
! which is due to be exported by the UM computed during the call OASISTEP.665
! to oasis_diagnostics. OASISTEP.666
! call locwrite(cdfile(ii),D1(D1_Zptr(ii)),FieldSize(ii), OASISTEP.667
! & nuloup,kerror) OASISTEP.668
call locwrite(cdpipe(ii),Zwork, OASISTEP.669
& FieldSize(ii), nuloup, kerror) OASISTEP.670
write(nulou,*) OASISTEP.671
& '######### .... UM has written field on file.' OASISTEP.672
C OASISTEP.673
C*- Close the file to flush its contents on disk. OASISTEP.674
C OASISTEP.675
close(nuloup) OASISTEP.676
C OASISTEP.677
C*- notify OASIS that the field has been written OASISTEP.678
C*- by writing the timestep on the pipe dedicated to it : OASISTEP.679
C OASISTEP.680
write(nulou,*) AJC1F405.581
& '######## UM writes timestep info to OASIS...' OASISTEP.682
tempstring = cdfile(ii) OASISTEP.683
write(tempstring,*) (timestep - Zoffset + 1) PXOASIS.4
write(nulou,*) AJC1F405.582
& '######## .....UM has written timestep info to OASIS' OASISTEP.686
OASISTEP.687
endif AJC1F405.583
OASISTEP.689
endif OASISTEP.690
OASISTEP.691
enddo OASISTEP.692
OASISTEP.693
!------------------------------------------------ OASISTEP.694
! error trap. OASISTEP.695
999 continue OASISTEP.696
if(icode.ne.0) then OASISTEP.697
write(nulou,*) cmessage,icode OASISTEP.698
endif OASISTEP.699
write(nulou,*) "exiting OASIS_STEP" OASISTEP.700
OASISTEP.701
return OASISTEP.702
end OASISTEP.703
OASISTEP.704
*ENDIF OASISTEP.705