SUBROUTINE INIT_OASIS ( 2,6INIOASIS.63
*CALL ARGSIZE 
INIOASIS.64
*CALL ARGD1 INIOASIS.65
*CALL ARGSTS INIOASIS.66
*CALL ARGDUMA INIOASIS.67
*CALL ARGDUMO INIOASIS.68
*CALL ARGPTRA INIOASIS.69
*CALL ARGPTRO INIOASIS.70
*CALL ARGCONA INIOASIS.71
*CALL ARGCONO INIOASIS.72
& internal_model, INIOASIS.73
& ICODE,CMESSAGE ) INIOASIS.74
C INIOASIS.75
IMPLICIT NONE INIOASIS.76
C INIOASIS.77
*CALL CMAXSIZE INIOASIS.78
*CALL CSUBMODL INIOASIS.79
*CALL TYPSIZE INIOASIS.80
*CALL TYPD1 INIOASIS.81
*CALL TYPSTS INIOASIS.82
*CALL TYPDUMA INIOASIS.83
*CALL TYPDUMO INIOASIS.84
*CALL TYPPTRA INIOASIS.85
*CALL TYPPTRO INIOASIS.86
*CALL TYPCONA INIOASIS.87
*CALL TYPCONO INIOASIS.88
C INIOASIS.89
integer internal_model INIOASIS.90
INIOASIS.91
INTEGER ICODE ! OUT - Error return code INIOASIS.92
CHARACTER*(*) CMESSAGE ! OUT - Error return message INIOASIS.93
INIOASIS.94
INIOASIS.95
integer iost ! return status of the open statement. INIOASIS.96
external ini_z_ptr INIOASIS.97
C INIOASIS.98
C* ---------------------------- Include files ------------------------ INIOASIS.99
C INIOASIS.100
*CALL COASIS INIOASIS.101
C INIOASIS.102
C -------------------------------------------------------------------- INIOASIS.103
C INIOASIS.104
INIOASIS.105
C INIOASIS.106
C Common blocks INIOASIS.107
C INIOASIS.108
*CALL C_MDI INIOASIS.109
*CALL STPARAM INIOASIS.110
*CALL C_PI INIOASIS.111
INIOASIS.112
*CALL PARVARS INIOASIS.113
*CALL DECOMPTP INIOASIS.114
*CALL DECOMPDB INIOASIS.115
*CALL AMAXSIZE INIOASIS.116
*CALL ATM_LSM GPB2F405.73
C INIOASIS.118
C INIOASIS.119
C INIOASIS.120
C Local variables INIOASIS.121
C INIOASIS.122
real Rearth INIOASIS.123
parameter (Rearth = 6 366 198 ) ! Radius of the earth in meters INIOASIS.124
real INIOASIS.125
& Zlatitude1 ! latitudes delimiting the gridboxes. INIOASIS.126
& , Zlatitude2 ! INIOASIS.127
C INIOASIS.128
C declatarions for the atmosphere model : INIOASIS.129
*IF DEF,ATMOS INIOASIS.130
real INIOASIS.131
& xta(0:g_row_length+1) ! atmosphere tp longitude coordinates INIOASIS.132
& , xua(0:g_row_length+1) ! atmosphere uv longitude coordinates INIOASIS.133
& , yta(0:g_p_rows+1) ! atmosphere tp latitude coordinates INIOASIS.134
& , yua(0:g_u_rows+1) ! atmosphere uv latitude coordinates INIOASIS.135
! INIOASIS.136
! The masks are defined twice here, once as real, INIOASIS.137
! once as integer. And that's because they are handled INIOASIS.138
! as real in the UM while OASIS expects integers. INIOASIS.139
! INIOASIS.140
logical INIOASIS.141
& Zmaskua(g_row_length,g_u_rows) ! atmosphere mask on u grid INIOASIS.142
& , Zmaskta(g_row_length,g_p_rows) ! atmosphere mask on t grid INIOASIS.143
integer INIOASIS.144
& imaskua(g_row_length,g_u_rows) ! atmosphere mask on u grid INIOASIS.145
& , imaskta(g_row_length,g_p_rows) ! atmosphere mask on t grid INIOASIS.146
! INIOASIS.147
! surface arrays INIOASIS.148
! INIOASIS.149
real INIOASIS.150
& surfua(g_row_length,g_u_rows) ! atmosphere surface on u grid INIOASIS.151
& , surfta(g_row_length,g_p_rows) ! atmosphere surface on t grid INIOASIS.152
INIOASIS.153
! INIOASIS.154
! Arrays holding the latitudes, longitudes for both sub-models, INIOASIS.155
! and both type of grids. INIOASIS.156
! INIOASIS.157
real INIOASIS.158
& Zxua(g_row_length,g_u_rows) ! atm longitude on u grid INIOASIS.159
& , Zxta(g_row_length,g_p_rows) ! atm longitude on t grid INIOASIS.160
& , Zyua(g_row_length,g_u_rows) ! atm latitude on u grid INIOASIS.161
& , Zyta(g_row_length,g_p_rows) ! atm latitude on t grid INIOASIS.162
*ENDIF INIOASIS.163
C declations for the ocean model : INIOASIS.164
*IF DEF,OCEAN INIOASIS.165
INIOASIS.166
*CALL TYPOCDPT INIOASIS.167
! INIOASIS.168
! Grid points definition. A virtual point is added at the begining INIOASIS.169
! and end of each of the coordinate system to allow a more regular INIOASIS.170
! computation of the surfaces. INIOASIS.171
! INIOASIS.172
real INIOASIS.173
& xuo(0:g_imt+1) ! ocean uv longitude coordinates INIOASIS.174
& ,xto(0:g_imt+1) ! ocean ts longitude coordinates INIOASIS.175
& ,yuo(0:g_jmtm1+1) ! ocean uv latitude coordinates INIOASIS.176
& ,yto(0:g_jmt+1) ! ocean ts latitude coordinates INIOASIS.177
! INIOASIS.178
! The masks are defined twice here, once as real, INIOASIS.179
! once as integer. And that's because they are handled INIOASIS.180
! as real in the UM while OASIS expects integers. INIOASIS.181
! INIOASIS.182
integer INIOASIS.183
& imaskto(g_imt,g_jmt) ! ocean mask on t grid INIOASIS.184
& , imaskuo(g_imt,g_jmt) ! ocean mask on u grid INIOASIS.185
! INIOASIS.186
! surface arrays INIOASIS.187
! INIOASIS.188
real INIOASIS.189
& surfto(g_imt,g_jmt) ! ocean surface on t grid INIOASIS.190
& , surfuo(g_imt,g_jmtm1) ! ocean surface on u grid INIOASIS.191
INIOASIS.192
INIOASIS.193
! INIOASIS.194
! Arrays holding the latitudes, longitudes for both sub-models, INIOASIS.195
! and both type of grids. INIOASIS.196
! INIOASIS.197
real INIOASIS.198
& Zxuo(g_imt,g_jmtm1) ! oce longitude on u grid INIOASIS.199
& , Zxto(g_imt,g_jmt) ! oce longitude on t grid INIOASIS.200
& , Zyuo(g_imt,g_jmtm1) ! oce latitude on u grid INIOASIS.201
& , Zyto(g_imt,g_jmt) ! oce latitude on t grid INIOASIS.202
INIOASIS.203
real INIOASIS.204
& fkmp(g_imt,g_jmt) !in number of levels at ocean T points INIOASIS.205
& ,fkmq(g_imt,g_jmt) !in number of levels at ocean U points INIOASIS.206
INIOASIS.207
*ENDIF INIOASIS.208
INIOASIS.209
integer ll, p ! indexes. INIOASIS.210
INIOASIS.211
c*-------------------------------------------------------------------- INIOASIS.212
c INIOASIS.213
write(nulou,*) "entering INIOASIS" INIOASIS.214
icode = 0 INIOASIS.215
INIOASIS.216
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! INIOASIS.217
CCC Read here the input values : INIOASIS.218
C 1/ number of coupling fields. INIOASIS.219
C 2/ the list of fields itself. INIOASIS.220
INIOASIS.221
C Search for end of 'coasis_in' INIOASIS.222
ll=0 INIOASIS.223
do p=1,200 INIOASIS.224
if(coasis_in(p:p).ne.' ') then INIOASIS.225
ll=ll+1 INIOASIS.226
endif INIOASIS.227
enddo INIOASIS.228
c construct filename with pe no. appended INIOASIS.229
coasis_in(ll+1:ll+1)='.' INIOASIS.230
write(coasis_in(ll+2:ll+5),'(i2.2)') mype INIOASIS.231
INIOASIS.232
open(unit = 3, file = coasis_in) INIOASIS.233
read(3,*) NoCouplingField ! input the number of coupling fields. INIOASIS.234
if (NoCouplingField .gt. MaxCouplingField) then INIOASIS.235
icode=27 INIOASIS.236
cmessage='init_oasis: the number of coupling fields is to ' INIOASIS.237
& // 'large : increase MaxCouplingField and recompile.' INIOASIS.238
goto 999 INIOASIS.239
else INIOASIS.240
C Input the description of the fields. INIOASIS.241
do ii = 1, NoCouplingField INIOASIS.242
read(3,'(a5,1x,a1,1x,a1,1x,a2,1x,a2)') GPB0F405.154
& Zinput(Zistash,ii),Zinput(Zgrd,ii), INIOASIS.244
& Zinput(Zdirection,ii),Zinput(Zexc_frequency,ii), INIOASIS.245
& Zinput(Zexc_basis,ii) INIOASIS.246
enddo INIOASIS.247
endif INIOASIS.248
close(3) ! close oasis namefile. INIOASIS.249
INIOASIS.250
c INIOASIS.251
c*-------------------------------------------------------------------- INIOASIS.252
c INIOASIS.253
C Initialise the FieldLocator array from the Input Array: INIOASIS.254
do ii = 1, NoCouplingField INIOASIS.255
FieldLocator(istash,ii) = ZInput(Zistash,ii) INIOASIS.256
FieldLocator(lon,ii) = ZInput(Zistash,ii)(1:5) // 'lon' INIOASIS.257
FieldLocator(lat,ii) = ZInput(Zistash,ii)(1:5) // 'lat' INIOASIS.258
FieldLocator(msk,ii) = ZInput(Zistash,ii)(1:5) // 'msk' INIOASIS.259
FieldLocator(srf,ii) = ZInput(Zistash,ii)(1:5) // 'srf' INIOASIS.260
FieldLocator(grd,ii) = ZInput(Zgrd,ii) INIOASIS.261
FieldLocator(direction,ii) = ZInput(Zdirection,ii) INIOASIS.262
FieldLocator(exc_frequency,ii) = ZInput(Zexc_frequency,ii) INIOASIS.263
FieldLocator(exc_basis,ii) = ZInput(Zexc_basis,ii) INIOASIS.264
enddo INIOASIS.265
INIOASIS.266
C INIOASIS.267
c INIOASIS.268
c*-------------------------------------------------------------------- INIOASIS.269
c INIOASIS.270
c Initialise the communication channels with the OASIS coupler : INIOASIS.271
c Either create pipes, or pvm channels. ( pipes until now ) INIOASIS.272
c INIOASIS.273
c The pipes are only handled by one PE. INIOASIS.274
c INIOASIS.275
if (mype .eq. gather_pe) then INIOASIS.276
call ini_cmc( INIOASIS.277
*CALL ARGSIZE INIOASIS.278
*CALL ARGD1 INIOASIS.279
*CALL ARGSTS INIOASIS.280
*CALL ARGDUMA INIOASIS.281
*CALL ARGDUMO INIOASIS.282
*CALL ARGPTRA INIOASIS.283
*CALL ARGPTRO INIOASIS.284
*CALL ARGCONA INIOASIS.285
*CALL ARGCONO INIOASIS.286
& internal_model, INIOASIS.287
& 1, INIOASIS.288
& ICODE,CMESSAGE ) INIOASIS.289
if (icode .ne. 0) goto 999 INIOASIS.290
endif ! mype INIOASIS.291
C INIOASIS.292
C*- Most of the computation below need only be done on one PE. INIOASIS.293
C INIOASIS.294
if (mype .eq. gather_pe) then INIOASIS.295
INIOASIS.296
c*-------------------------------------------------------------------- INIOASIS.297
C Split the work according to wether the UM internal model INIOASIS.298
C is the atmosphere or the ocean. Any other submodel is INIOASIS.299
C not (yet) implemented and the code fails on error in such a INIOASIS.300
C case. INIOASIS.301
INIOASIS.302
if(internal_model.eq.atmos_im) then ! atmosphere ( 1.a & 1.b ) INIOASIS.303
INIOASIS.304
*IF DEF,ATMOS INIOASIS.305
cl-------------------------------------------------------------------- INIOASIS.306
C 2. calculate size of each of the coupling fields. INIOASIS.307
do ii = 1, NoCouplingField INIOASIS.308
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.309
FieldSize(ii) = g_row_length * g_u_rows INIOASIS.310
else ! TP grid. INIOASIS.311
FieldSize(ii) = g_row_length * g_p_rows INIOASIS.312
endif INIOASIS.313
enddo INIOASIS.314
INIOASIS.315
INIOASIS.316
cl-------------------------------------------------------------------- INIOASIS.317
cl 3. calculate gridline coordinates on all grids using dump INIOASIS.318
cl information on grid spacing and position INIOASIS.319
c INIOASIS.320
! define the grids of the atmosphere UM submodel. INIOASIS.321
do ii = 0, g_row_length + 1 INIOASIS.322
xta(ii)=a_realhd(4)+(ii-1)*a_realhd(1) INIOASIS.323
xua(ii)=a_realhd(4)+(ii-0.5)*a_realhd(1) INIOASIS.324
enddo INIOASIS.325
do j = 0, g_p_rows + 1 INIOASIS.326
yta(j)=a_realhd(3)-(j-1)*a_realhd(2) INIOASIS.327
enddo INIOASIS.328
do j = 0, g_u_rows + 1 INIOASIS.329
yua(j)=a_realhd(3)-(j-0.5)*a_realhd(2) INIOASIS.330
enddo INIOASIS.331
INIOASIS.332
INIOASIS.333
! Develop those 1D array onto 2D arrays in order to suit the oasis INIOASIS.334
! layout. INIOASIS.335
do ii = 1, g_row_length INIOASIS.336
do j = 1, g_u_rows INIOASIS.337
Zxua(ii,j) = xua(ii) ! longitude on u grid INIOASIS.338
Zyua(ii,j) = yua(j) ! latitude on u grid INIOASIS.339
enddo INIOASIS.340
enddo INIOASIS.341
do ii = 1, g_row_length INIOASIS.342
do j = 1, g_p_rows INIOASIS.343
Zxta(ii,j) = xta(ii) ! longitude on t grid INIOASIS.344
Zyta(ii,j) = yta(j) ! latitude on t grid INIOASIS.345
enddo INIOASIS.346
enddo INIOASIS.347
! define the mask grids of the atmosphere UM submodel. INIOASIS.348
! T grid : INIOASIS.349
do j = 1, g_p_rows INIOASIS.350
do ii = 1, g_row_length INIOASIS.351
if (atmos_landmask(ii+(j-1)*g_row_length)) then INIOASIS.352
Zmaskta(ii,j)= .true. INIOASIS.353
imaskta(ii,j)= 1 INIOASIS.354
else INIOASIS.355
Zmaskta(ii,j)= .false. INIOASIS.356
imaskta(ii,j)= 0 INIOASIS.357
endif INIOASIS.358
enddo INIOASIS.359
enddo INIOASIS.360
C set up logical land/sea mask on atmosphere UV grid INIOASIS.361
do j = 1, g_u_rows INIOASIS.362
do ii = 1, g_row_length-1 INIOASIS.363
Zmaskua(ii,j) = INIOASIS.364
& Zmaskta(ii,j) .or. Zmaskta(ii+1,j) INIOASIS.365
& .or. Zmaskta(ii,j+1) .or. Zmaskta(ii+1,j+1) INIOASIS.366
enddo INIOASIS.367
Zmaskua(g_row_length,j) = INIOASIS.368
& Zmaskta(g_row_length,j) .or. Zmaskta(1,j) INIOASIS.369
& .or. Zmaskta(g_row_length,j+1) .or. Zmaskta(1,j+1) INIOASIS.370
enddo INIOASIS.371
! Generate an integer mask from the logical mask above ; INIOASIS.372
! 1 = land, 0 = ocean. (as requiered by OASIS). INIOASIS.373
do j = 1, g_u_rows INIOASIS.374
do ii = 1, g_row_length INIOASIS.375
if (Zmaskua(ii,j)) then INIOASIS.376
imaskua(ii, j) = 1 INIOASIS.377
else INIOASIS.378
imaskua(ii, j) = 0 INIOASIS.379
endif INIOASIS.380
enddo INIOASIS.381
enddo INIOASIS.382
INIOASIS.383
!--------------------------------------------------------------------- INIOASIS.384
! prepare the surface grids here : INIOASIS.385
INIOASIS.386
! u grid INIOASIS.387
do ii = 1, g_row_length INIOASIS.388
do j = 1, g_u_rows INIOASIS.389
Zlatitude1 = (yua(j-1)+yua(j))/2. INIOASIS.390
Zlatitude2 = (yua(j+1)+yua(j))/2. INIOASIS.391
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.392
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.393
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.394
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.395
surfua(ii,j) = Rearth * Rearth ! on u grid INIOASIS.396
& * abs( INIOASIS.397
& ( sin(pi_over_180*Zlatitude2) INIOASIS.398
& - sin(pi_over_180*Zlatitude1) ) INIOASIS.399
& * pi_over_180 INIOASIS.400
& * ((xua(ii+1)+xua(ii))/2. - (xua(ii-1)+xua(ii))/2.) INIOASIS.401
& ) INIOASIS.402
enddo INIOASIS.403
enddo INIOASIS.404
INIOASIS.405
! p grid INIOASIS.406
do ii = 1, g_row_length INIOASIS.407
do j = 1, g_p_rows INIOASIS.408
Zlatitude1 = (yta(j-1)+yta(j))/2. INIOASIS.409
Zlatitude2 = (yta(j+1)+yta(j))/2. INIOASIS.410
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.411
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.412
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.413
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.414
surfta(ii,j) = Rearth * Rearth ! on u grid INIOASIS.415
& * abs( INIOASIS.416
& ( sin(pi_over_180*Zlatitude2) INIOASIS.417
& - sin(pi_over_180*Zlatitude1) ) INIOASIS.418
& * pi_over_180 INIOASIS.419
& * ((xta(ii+1)+xta(ii))/2. - (xta(ii-1)+xta(ii))/2.) INIOASIS.420
& ) INIOASIS.421
enddo INIOASIS.422
enddo INIOASIS.423
INIOASIS.424
!--------------------------------------------------------------------- INIOASIS.425
! Write to file the grids of the coupling INIOASIS.426
! fields. INIOASIS.427
! Note : the layout of the atmos grid is reverse of the one of oasis; INIOASIS.428
! therefore the descending j indexes for masks, surf, and grids. INIOASIS.429
nulgr = 3 INIOASIS.430
OPEN (UNIT = nulgr, POSITION = 'APPEND', INIOASIS.431
& FILE = cficgr,STATUS = 'UNKNOWN', INIOASIS.432
& FORM = 'UNFORMATTED', IOSTAT = iost) INIOASIS.433
if (iost .ne. 0) then INIOASIS.434
icode = 1 INIOASIS.435
cmessage = 'io error in INIT_OASIS from UM atmos model.' INIOASIS.436
endif INIOASIS.437
do ii = 1, NoCouplingField INIOASIS.438
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.439
! locator for the longitude array: INIOASIS.440
write(nulgr) FieldLocator(lon,ii) INIOASIS.441
! longitude array: INIOASIS.442
write(nulgr) ((Zxua(i,j),i=1,g_row_length), INIOASIS.443
& j=g_u_rows,1,-1) INIOASIS.444
! locator for the latitude array: INIOASIS.445
write(nulgr) FieldLocator(lat,ii) INIOASIS.446
! latitude array: INIOASIS.447
write(nulgr) ((Zyua(i,j),i=1,g_row_length), INIOASIS.448
& j=g_u_rows,1,-1) INIOASIS.449
else ! T.P grids INIOASIS.450
! locator for the longitude array: INIOASIS.451
write(nulgr) FieldLocator(lon,ii) INIOASIS.452
! longitude array: INIOASIS.453
write(nulgr) ((Zxta(i,j),i=1,g_row_length), INIOASIS.454
& j=g_p_rows,1,-1) INIOASIS.455
! locator for the latitude array: INIOASIS.456
write(nulgr) FieldLocator(lat,ii) INIOASIS.457
! latitude array: INIOASIS.458
write(nulgr) ((Zyta(i,j),i=1,g_row_length), INIOASIS.459
& j=g_p_rows,1,-1) INIOASIS.460
! mask locator : INIOASIS.461
endif INIOASIS.462
enddo INIOASIS.463
! Close the grid file. INIOASIS.464
close(nulgr) INIOASIS.465
!--------------------------------------------------------------------- INIOASIS.466
INIOASIS.467
nulma = 3 INIOASIS.468
OPEN (UNIT = nulma, POSITION = 'APPEND', INIOASIS.469
& FILE = cficma,STATUS = 'UNKNOWN', INIOASIS.470
& FORM = 'UNFORMATTED', IOSTAT = iost) INIOASIS.471
if (iost .ne. 0) then INIOASIS.472
icode = 1 INIOASIS.473
cmessage = 'io error in INIT_OASIS from UM atmos model.' INIOASIS.474
endif INIOASIS.475
do ii = 1, NoCouplingField INIOASIS.476
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.477
! mask locator : INIOASIS.478
write(nulma) FieldLocator(msk,ii) INIOASIS.479
write(nulma) INIOASIS.480
& ((imaskua(i,j),i=1,g_row_length),j=g_u_rows,1,-1) INIOASIS.481
! surface locator : INIOASIS.482
else ! T.P grids INIOASIS.483
! mask locator : INIOASIS.484
write(nulma) FieldLocator(msk,ii) INIOASIS.485
write(nulma) ((imaskta(i,j),i=1,g_row_length), INIOASIS.486
& j=g_p_rows,1,-1) INIOASIS.487
endif INIOASIS.488
enddo INIOASIS.489
! Close the mask files. INIOASIS.490
close(nulma) INIOASIS.491
INIOASIS.492
!--------------------------------------------------------------------- INIOASIS.493
INIOASIS.494
nulsu = 3 INIOASIS.495
OPEN (UNIT = nulsu,POSITION = 'APPEND', INIOASIS.496
& FILE = cficsu,STATUS = 'UNKNOWN', INIOASIS.497
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.498
if (iost .ne. 0) then INIOASIS.499
icode = 1 INIOASIS.500
cmessage = 'io error in INIT_OASIS from UM atmos model.' INIOASIS.501
endif INIOASIS.502
do ii = 1, NoCouplingField INIOASIS.503
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.504
write(nulsu) FieldLocator(srf,ii) INIOASIS.505
! surface filed for tx : INIOASIS.506
write(nulsu)((surfua(i,j),i=1,g_row_length), INIOASIS.507
& j=g_u_rows,1,-1) INIOASIS.508
else ! T.P grids INIOASIS.509
! surface locator : INIOASIS.510
write(nulsu) FieldLocator(srf,ii) INIOASIS.511
! surface field : INIOASIS.512
write(nulsu) ((surfta(i,j),i=1,g_row_length), INIOASIS.513
& j=g_p_rows,1,-1) INIOASIS.514
endif INIOASIS.515
enddo INIOASIS.516
! Close the grids, masks and surface files. INIOASIS.517
close(nulsu) INIOASIS.518
!--------------------------------------------------------------------- INIOASIS.519
INIOASIS.520
INIOASIS.521
*ENDIF INIOASIS.522
INIOASIS.523
cl-------------------------------------------------------------------- INIOASIS.524
C PART II : we now deal with the ocean in the following INIOASIS.525
C sections. INIOASIS.526
INIOASIS.527
elseif (internal_model.eq.ocean_im) then ! ocean ( 2.a & 2.b ) INIOASIS.528
INIOASIS.529
*IF DEF,OCEAN INIOASIS.530
C INIOASIS.531
CL SECTION 1: No. of distinct columns in ocean. INIOASIS.532
C INIOASIS.533
if (cyclic_ocean) then INIOASIS.534
g_iru=g_imt-2 INIOASIS.535
g_irt=g_iru INIOASIS.536
else INIOASIS.537
g_iru=g_imt-1 INIOASIS.538
g_irt=g_imt INIOASIS.539
endif INIOASIS.540
C INIOASIS.541
cl-------------------------------------------------------------------- INIOASIS.542
C 2. calculate size of each of the coupling fields using dump INIOASIS.543
C info. INIOASIS.544
do ii = 1, NoCouplingField INIOASIS.545
if (FieldLocator(grd,ii) .eq. 'U') then ! U grid INIOASIS.546
FieldSize(ii) = (g_iru) * (g_jmtm1) INIOASIS.547
else ! TS grid INIOASIS.548
FieldSize(ii) = (g_irt) * (g_jmt) INIOASIS.549
endif INIOASIS.550
enddo INIOASIS.551
INIOASIS.552
cl-------------------------------------------------------------------- INIOASIS.553
cl 3. calculate gridline coordinates on all grids using dump INIOASIS.554
cl information on grid spacing and position INIOASIS.555
if (global_ocean.and..not.cyclic_ocean) then INIOASIS.556
icode=24 INIOASIS.557
cmessage='init_oasis: a coupled global ocean must be cyclic' INIOASIS.558
goto 999 INIOASIS.559
elseif (.not.global_ocean.and.cyclic_ocean) then INIOASIS.560
icode=25 INIOASIS.561
cmessage='init_oasis: ' INIOASIS.562
& //'a coupled limited-area ocean must not be cyclic' INIOASIS.563
goto 999 INIOASIS.564
endif INIOASIS.565
! if (a_realhd(5).ne.o_realhd(5).or.a_realhd(6).ne.o_realhd(6)) INIOASIS.566
! & then INIOASIS.567
! icode=26 INIOASIS.568
! cmessage='init_oasis: ' INIOASIS.569
! & //'coupled atmosphere and ocean must have coincident poles' INIOASIS.570
! goto 999 INIOASIS.571
! endif INIOASIS.572
INIOASIS.573
! define the grids of the ocean UM submodel. INIOASIS.574
! the global alternative can be removed when we are sure that the INIOASIS.575
! ocean dump headers have been correctly created INIOASIS.576
if (global_ocean) then INIOASIS.577
xuo(1)=o_realhd(4)+0.5*o_realhd(1) INIOASIS.578
else INIOASIS.579
xuo(1)=o_realhd(8) INIOASIS.580
endif INIOASIS.581
xuo(0)=xuo(1)-o_coldepc(1) INIOASIS.582
xto(1)=xuo(1)-0.5*o_coldepc(1) INIOASIS.583
xto(0)=xto(1)-o_coldepc(1) INIOASIS.584
do ii=2,g_imt INIOASIS.585
xuo(ii)=xuo(ii-1)+o_coldepc(ii) INIOASIS.586
xto(ii)=xto(ii-1)+0.5*(o_coldepc(ii-1)+o_coldepc(ii)) INIOASIS.587
enddo INIOASIS.588
xuo(g_imt+1)=xuo(g_imt)+o_coldepc(g_imt) INIOASIS.589
xto(g_imt+1)=xto(g_imt)+o_coldepc(g_imt) INIOASIS.590
INIOASIS.591
yuo(1)=o_realhd(7) INIOASIS.592
yuo(0)=yuo(1)-o_rowdepc(1) INIOASIS.593
yto(1)=yuo(1)-0.5*o_rowdepc(1) INIOASIS.594
yto(0)=yto(1)-o_rowdepc(1) INIOASIS.595
do j=2,g_jmt INIOASIS.596
yuo(j)=yuo(j-1)+o_rowdepc(j) INIOASIS.597
yto(j)=yto(j-1)+0.5*(o_rowdepc(j-1)+o_rowdepc(j)) INIOASIS.598
enddo INIOASIS.599
yto(g_jmt+1) = yto(g_jmt)+o_rowdepc(g_jmt) INIOASIS.600
INIOASIS.601
! Develop those 1D array onto 2D arrays in order to suit the oasis INIOASIS.602
! layout. INIOASIS.603
do ii = 1, g_imt INIOASIS.604
do j = 1, g_jmtm1 INIOASIS.605
Zxuo(ii,j) = xuo(ii) ! longitude on u grid INIOASIS.606
Zyuo(ii,j) = yuo(j) ! latitude on u grid INIOASIS.607
enddo INIOASIS.608
enddo INIOASIS.609
INIOASIS.610
do ii = 1, g_imt INIOASIS.611
do j = 1, g_jmt INIOASIS.612
Zxto(ii,j) = xto(ii) ! longitude on t grid INIOASIS.613
Zyto(ii,j) = yto(j) ! latitude on t grid INIOASIS.614
enddo INIOASIS.615
enddo INIOASIS.616
INIOASIS.617
! define the mask grids of the ocean UM submodel. INIOASIS.618
! TS grid : (use the number of levels) INIOASIS.619
INIOASIS.620
do j = 1, g_jmt INIOASIS.621
do ii = 1, g_imt INIOASIS.622
if ( o_flddepc(ii+(j-1)*g_imt) .lt. 0.1 ) then INIOASIS.623
imaskto(ii,j) = 1 INIOASIS.624
else INIOASIS.625
imaskto(ii,j) = 0 INIOASIS.626
endif INIOASIS.627
enddo INIOASIS.628
enddo INIOASIS.629
! UV grid : (use the number of levels) INIOASIS.630
do j = 1, g_jmt INIOASIS.631
do ii = 1, g_imt INIOASIS.632
if ( (o_spcon(jocp_fkmq_global+ii-1+(j-1)*g_imt)) INIOASIS.633
& .LT. (0.1) ) then INIOASIS.634
imaskuo(ii,j) = 1 INIOASIS.635
else INIOASIS.636
imaskuo(ii,j) = 0 INIOASIS.637
endif INIOASIS.638
enddo INIOASIS.639
enddo INIOASIS.640
INIOASIS.641
!--------------------------------------------------------------------- INIOASIS.642
! prepare the surface grids here : INIOASIS.643
! Note that I produce the surfaces at the centre of the gridboxes. INIOASIS.644
INIOASIS.645
! on U grid : INIOASIS.646
do j = 1, g_jmtm1 INIOASIS.647
do ii = 1, g_imt INIOASIS.648
Zlatitude1 = (yuo(j-1)+yuo(j))/2. INIOASIS.649
Zlatitude2 = (yuo(j+1)+yuo(j))/2. INIOASIS.650
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.651
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.652
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.653
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.654
surfuo(ii,j) = Rearth * Rearth ! on u grid INIOASIS.655
& * abs( INIOASIS.656
& ( sin(pi_over_180* Zlatitude2 ) INIOASIS.657
& - sin(pi_over_180* Zlatitude1 ) ) INIOASIS.658
& * pi_over_180 INIOASIS.659
& * ((xuo(ii+1)+xuo(ii))/2. - (xuo(ii-1)+xuo(ii))/2.) INIOASIS.660
& ) INIOASIS.661
enddo INIOASIS.662
enddo INIOASIS.663
INIOASIS.664
! on T grid INIOASIS.665
do j = 1, g_jmt INIOASIS.666
do ii = 1, g_imt INIOASIS.667
Zlatitude1 = (yto(j-1)+yto(j))/2. INIOASIS.668
Zlatitude2 = (yto(j+1)+yto(j))/2. INIOASIS.669
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.670
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.671
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.672
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.673
surfto(ii,j) = Rearth * Rearth ! on t grid INIOASIS.674
& * abs( INIOASIS.675
& ( sin(pi_over_180*Zlatitude1) INIOASIS.676
& - sin(pi_over_180*Zlatitude2) ) INIOASIS.677
& * pi_over_180 INIOASIS.678
& * ((xto(ii+1)+xto(ii))/2. - (xto(ii-1)+xto(ii))/2.) INIOASIS.679
& ) INIOASIS.680
enddo INIOASIS.681
enddo INIOASIS.682
INIOASIS.683
INIOASIS.684
!--------------------------------------------------------------------- INIOASIS.685
! Write to file the grids, masks and surface of each of the coupling INIOASIS.686
! fields. INIOASIS.687
! a/import of fields INIOASIS.688
! b/export of fields INIOASIS.689
nulgr = 3 INIOASIS.690
OPEN (UNIT = nulgr, POSITION = 'APPEND', INIOASIS.691
& FILE = cficgr,STATUS = 'UNKNOWN', INIOASIS.692
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.693
if (iost .ne. 0) then INIOASIS.694
icode = 1 INIOASIS.695
cmessage = 'io error in INIT_OASIS from UM ocean model.' INIOASIS.696
endif INIOASIS.697
do ii = 1, NoCouplingField INIOASIS.698
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.699
! locator for the longitude array: INIOASIS.700
write(nulgr) FieldLocator(lon,ii) INIOASIS.701
! longitude array: INIOASIS.702
write(nulgr) ((Zxuo(i,j),i = 1,g_iru), j=1,g_jmtm1) INIOASIS.703
! locator for the latitude array: INIOASIS.704
write(nulgr) FieldLocator(lat,ii) INIOASIS.705
! latitude array: INIOASIS.706
write(nulgr) ((Zyuo(i,j),i = 1,g_iru), j=1,g_jmtm1) INIOASIS.707
! mask locator : INIOASIS.708
else ! T grids INIOASIS.709
! locator for the longitude array: INIOASIS.710
write(nulgr) FieldLocator(lon,ii) INIOASIS.711
! longitude array: INIOASIS.712
write(nulgr) ((Zxto(i,j),i = 1,g_irt), j=1,g_jmt) INIOASIS.713
! locator for the latitude array: INIOASIS.714
write(nulgr) FieldLocator(lat,ii) INIOASIS.715
! latitude array: INIOASIS.716
write(nulgr) ((Zyto(i,j),i = 1,g_irt), j=1,g_jmt) INIOASIS.717
! mask locator : INIOASIS.718
endif INIOASIS.719
enddo INIOASIS.720
! Close the grids, masks and surface files. INIOASIS.721
close(nulgr) INIOASIS.722
INIOASIS.723
!--------------------------------------------------------------------- INIOASIS.724
! Write to file the masks of the coupling INIOASIS.725
! fields. INIOASIS.726
! a/import of fields INIOASIS.727
! b/export of fields INIOASIS.728
nulsu = 3 INIOASIS.729
OPEN (UNIT = nulsu, POSITION = 'APPEND', INIOASIS.730
& FILE = cficsu,STATUS = 'UNKNOWN', INIOASIS.731
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.732
if (iost .ne. 0) then INIOASIS.733
icode = 1 INIOASIS.734
cmessage = 'io error in INIT_OASIS from UM ocean model.' INIOASIS.735
endif INIOASIS.736
do ii = 1, NoCouplingField INIOASIS.737
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.738
! locator for the longitude array: INIOASIS.739
write(nulsu) FieldLocator(srf,ii) INIOASIS.740
! surface filed for tx : INIOASIS.741
write(nulsu) ((surfuo(i,j),i = 1,g_iru), j=1,g_jmtm1) INIOASIS.742
else ! T grids INIOASIS.743
! surface locator : INIOASIS.744
write(nulsu) FieldLocator(srf,ii) INIOASIS.745
! surface field : INIOASIS.746
write(nulsu) ((surfto(i,j),i = 1,g_irt), j=1,g_jmt) INIOASIS.747
endif INIOASIS.748
enddo INIOASIS.749
! Close the grids, masks and surface files. INIOASIS.750
close(nulsu) INIOASIS.751
INIOASIS.752
!--------------------------------------------------------------------- INIOASIS.753
! Write to file the grids, masks and surface of each of the coupling INIOASIS.754
! fields. INIOASIS.755
! a/import of fields INIOASIS.756
! b/export of fields INIOASIS.757
nulma = 3 INIOASIS.758
OPEN (UNIT = nulma, POSITION = 'APPEND', INIOASIS.759
& FILE = cficma,STATUS = 'UNKNOWN', INIOASIS.760
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.761
if (iost .ne. 0) then INIOASIS.762
icode = 1 INIOASIS.763
cmessage = 'io error in INIT_OASIS from UM ocean model.' INIOASIS.764
endif INIOASIS.765
do ii = 1, NoCouplingField INIOASIS.766
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.767
! mask locator : INIOASIS.768
write(nulma) FieldLocator(msk,ii) INIOASIS.769
write(nulma) ((imaskuo(i,j),i = 1,g_iru),j=1,g_jmtm1) INIOASIS.770
else ! T grids INIOASIS.771
! mask locator : INIOASIS.772
write(nulma) FieldLocator(msk,ii) INIOASIS.773
write(nulma) ((imaskto(i,j),i = 1,g_irt), j=1,g_jmt) INIOASIS.774
endif INIOASIS.775
enddo INIOASIS.776
! Close the grids, masks and surface files. INIOASIS.777
close(nulma) INIOASIS.778
INIOASIS.779
*ENDIF INIOASIS.780
INIOASIS.781
else ! neither ocean or atmosphere UM have been selected. INIOASIS.782
icode = -1 INIOASIS.783
write(nulou,*) INIOASIS.784
& 'Coupling with UM internal model different from' INIOASIS.785
write(nulou,*) INIOASIS.786
& 'the atmosphere or the ocean not currently allowed.' INIOASIS.787
goto 999 INIOASIS.788
endif ! atmos or ocean model. INIOASIS.789
INIOASIS.790
endif ! mype. INIOASIS.791
! INIOASIS.792
! Initialise pointers of the coupling fields to the D1 array : INIOASIS.793
! INIOASIS.794
INIOASIS.795
call ini_z_ptr( INIOASIS.796
*CALL ARGSIZE INIOASIS.797
*CALL ARGD1 INIOASIS.798
*CALL ARGSTS INIOASIS.799
*CALL ARGDUMA INIOASIS.800
*CALL ARGDUMO INIOASIS.801
*CALL ARGPTRA INIOASIS.802
*CALL ARGPTRO INIOASIS.803
& internal_model, INIOASIS.804
& ICODE,CMESSAGE ) INIOASIS.805
if (icode .ne. 0) goto 999 INIOASIS.806
INIOASIS.807
c INIOASIS.808
c Send OK to the coupler indicating the initialization phase has INIOASIS.809
c been completed. INIOASIS.810
c INIOASIS.811
c The pipes are only handled by one PE. INIOASIS.812
c INIOASIS.813
if (mype .eq. gather_pe) then INIOASIS.814
call ini_cmc( INIOASIS.815
*CALL ARGSIZE INIOASIS.816
*CALL ARGD1 INIOASIS.817
*CALL ARGSTS INIOASIS.818
*CALL ARGDUMA INIOASIS.819
*CALL ARGDUMO INIOASIS.820
*CALL ARGPTRA INIOASIS.821
*CALL ARGPTRO INIOASIS.822
*CALL ARGCONA INIOASIS.823
*CALL ARGCONO INIOASIS.824
& internal_model, INIOASIS.825
& 2, INIOASIS.826
& ICODE,CMESSAGE ) INIOASIS.827
if (icode .ne. 0) goto 999 INIOASIS.828
endif ! mype INIOASIS.829
write(nulou,*) "exiting INIOASIS" INIOASIS.830
INIOASIS.831
!------------------------------------------------ INIOASIS.832
! error trap. INIOASIS.833
999 continue INIOASIS.834
if(icode.ne.0) then INIOASIS.835
write(nulou,*) cmessage,icode INIOASIS.836
endif INIOASIS.837
INIOASIS.838
return INIOASIS.839
end INIOASIS.840
INIOASIS.841
*ENDIF INIOASIS.842
*IF DEF,C99_1A,AND,-DEF,MPP INIOASIS.846
SUBROUTINE INIT_OASIS ( 2,6INIOASIS.847
*CALL ARGSIZE INIOASIS.848
*CALL ARGD1 INIOASIS.849
*CALL ARGSTS INIOASIS.850
*CALL ARGDUMA INIOASIS.851
*CALL ARGDUMO INIOASIS.852
*CALL ARGPTRA INIOASIS.853
*CALL ARGPTRO INIOASIS.854
*CALL ARGCONA INIOASIS.855
*CALL ARGCONO INIOASIS.856
& internal_model, INIOASIS.857
& ICODE,CMESSAGE ) INIOASIS.858
C INIOASIS.859
IMPLICIT NONE INIOASIS.860
C INIOASIS.861
*CALL CMAXSIZE INIOASIS.862
*CALL CSUBMODL INIOASIS.863
*CALL TYPSIZE INIOASIS.864
*CALL TYPD1 INIOASIS.865
*CALL TYPSTS INIOASIS.866
*CALL TYPDUMA INIOASIS.867
*CALL TYPDUMO INIOASIS.868
*CALL TYPPTRA INIOASIS.869
*CALL TYPPTRO INIOASIS.870
*CALL TYPCONA INIOASIS.871
*CALL TYPCONO INIOASIS.872
C INIOASIS.873
integer internal_model INIOASIS.874
INIOASIS.875
INTEGER ICODE ! OUT - Error return code INIOASIS.876
CHARACTER*(*) CMESSAGE ! OUT - Error return message INIOASIS.877
INIOASIS.878
real INIOASIS.879
& fkmp(imt,jmt) !in number of levels at ocean T points INIOASIS.880
& ,fkmq(imt,jmt) !in number of levels at ocean U points INIOASIS.881
INIOASIS.882
integer iost ! return status of the open statement. INIOASIS.883
INIOASIS.884
INIOASIS.885
external ini_z_ptr, p_to_uv INIOASIS.886
C INIOASIS.887
C* ---------------------------- Include files ------------------------ INIOASIS.888
C INIOASIS.889
*CALL COASIS INIOASIS.890
C INIOASIS.891
C -------------------------------------------------------------------- INIOASIS.892
C INIOASIS.893
INIOASIS.894
C INIOASIS.895
C*-------------------------------------------------------------------- INIOASIS.896
INIOASIS.897
C INIOASIS.898
C Common blocks INIOASIS.899
C INIOASIS.900
*CALL C_MDI INIOASIS.901
*CALL STPARAM INIOASIS.902
*CALL C_PI INIOASIS.903
C INIOASIS.904
C INIOASIS.905
C INIOASIS.906
C Local variables INIOASIS.907
C INIOASIS.908
real Rearth INIOASIS.909
parameter (Rearth = 6 366 198 ) ! Radius of the earth in meters INIOASIS.910
real INIOASIS.911
& Zlatitude1 ! latitudes delimiting the gridboxes. INIOASIS.912
& , Zlatitude2 ! INIOASIS.913
C INIOASIS.914
C declatarions for the atmosphere model : INIOASIS.915
*IF DEF,ATMOS INIOASIS.916
real INIOASIS.917
& xta(0:row_length+1) ! atmosphere tp longitude coordinates INIOASIS.918
& ,xua(0:row_length+1) ! atmosphere uv longitude coordinates INIOASIS.919
& ,yta(0:p_rows+1) ! atmosphere tp latitude coordinates INIOASIS.920
& ,yua(0:u_rows+1) ! atmosphere uv latitude coordinates INIOASIS.921
! INIOASIS.922
! The masks are defined twice here, once as real, INIOASIS.923
! once as integer. And that's because they are handled INIOASIS.924
! as real in the UM while OASIS expects integers. INIOASIS.925
! INIOASIS.926
logical INIOASIS.927
& Zmaskua(row_length,u_rows) ! atmosphere mask on u grid INIOASIS.928
& , Zmaskta(row_length,p_rows) ! atmosphere mask on t grid INIOASIS.929
integer INIOASIS.930
& imaskua(row_length,u_rows) ! atmosphere mask on u grid INIOASIS.931
& , imaskta(row_length,p_rows) ! atmosphere mask on t grid INIOASIS.932
! INIOASIS.933
! surface arrays INIOASIS.934
! INIOASIS.935
real INIOASIS.936
& surfua(row_length,u_rows) ! atmosphere surface on u grid INIOASIS.937
& , surfta(row_length,p_rows) ! atmosphere surface on t grid INIOASIS.938
INIOASIS.939
! INIOASIS.940
! Arrays holding the latitudes, longitudes for both sub-models, INIOASIS.941
! and both type of grids. INIOASIS.942
! INIOASIS.943
real INIOASIS.944
& Zxua(row_length,u_rows) ! atm longitude on u grid INIOASIS.945
& , Zxta(row_length,p_rows) ! atm longitude on t grid INIOASIS.946
& , Zyua(row_length,u_rows) ! atm latitude on u grid INIOASIS.947
& , Zyta(row_length,p_rows) ! atm latitude on t grid INIOASIS.948
*ENDIF INIOASIS.949
C declations for the ocean model : INIOASIS.950
*IF DEF,OCEAN INIOASIS.951
INIOASIS.952
*CALL TYPOCDPT INIOASIS.953
! INIOASIS.954
! Grid points definition. A virtual point is added at the begining INIOASIS.955
! and end of each of the coordinate system to allow a more regular INIOASIS.956
! computation of the surfaces. INIOASIS.957
! INIOASIS.958
real INIOASIS.959
& xuo(0:imt+1) ! ocean uv longitude coordinates INIOASIS.960
& ,xto(0:imt+1) ! ocean ts longitude coordinates INIOASIS.961
& ,yuo(0:jmtm1+1) ! ocean uv latitude coordinates INIOASIS.962
& ,yto(0:jmt+1) ! ocean ts latitude coordinates INIOASIS.963
! INIOASIS.964
! The masks are defined twice here, once as real, INIOASIS.965
! once as integer. And that's because they are handled INIOASIS.966
! as real in the UM while OASIS expects integers. INIOASIS.967
! INIOASIS.968
integer INIOASIS.969
& imaskto(imt,jmt) ! ocean mask on t grid INIOASIS.970
& , imaskuo(imt,jmt) ! ocean mask on u grid INIOASIS.971
! INIOASIS.972
! surface arrays INIOASIS.973
! INIOASIS.974
real INIOASIS.975
& surfto(imt,jmt) ! ocean surface on t grid INIOASIS.976
& , surfuo(imt,jmtm1) ! ocean surface on u grid INIOASIS.977
INIOASIS.978
INIOASIS.979
! INIOASIS.980
! Arrays holding the latitudes, longitudes for both sub-models, INIOASIS.981
! and both type of grids. INIOASIS.982
! INIOASIS.983
real INIOASIS.984
& Zxuo(imt,jmtm1) ! oce longitude on u grid INIOASIS.985
& , Zxto(imt,jmt) ! oce longitude on t grid INIOASIS.986
& , Zyuo(imt,jmtm1) ! oce latitude on u grid INIOASIS.987
& , Zyto(imt,jmt) ! oce latitude on t grid INIOASIS.988
INIOASIS.989
*ENDIF INIOASIS.990
INIOASIS.991
c*-------------------------------------------------------------------- INIOASIS.992
c INIOASIS.993
write(nulou,*) "entering INIOASIS" INIOASIS.994
icode = 0 INIOASIS.995
INIOASIS.996
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! INIOASIS.997
CCC read here the input values : INIOASIS.998
C 1/number of coupling fields. INIOASIS.999
C 2/the list of fields itself. INIOASIS.1000
open(unit = 3, file = coasis_in) INIOASIS.1001
read(3,*) NoCouplingField ! input the number of fouplin fields. INIOASIS.1002
if (NoCouplingField .gt. MaxCouplingField) then INIOASIS.1003
icode=27 INIOASIS.1004
cmessage='init_oasis: the number of coupling fields is to ' INIOASIS.1005
& // 'large : increase MaxCouplingField and recompile.' INIOASIS.1006
goto 999 INIOASIS.1007
else INIOASIS.1008
C Input the description of the fields. INIOASIS.1009
do ii = 1, NoCouplingField INIOASIS.1010
read(3,'(a5,1x,a1,1x,a1,1x,a2,1x,a2)') GPB0F405.155
& Zinput(Zistash,ii),Zinput(Zgrd,ii), INIOASIS.1012
& Zinput(Zdirection,ii),Zinput(Zexc_frequency,ii), INIOASIS.1013
& Zinput(Zexc_basis,ii) INIOASIS.1014
enddo INIOASIS.1015
endif INIOASIS.1016
close(3) ! close oasis namefile. INIOASIS.1017
c INIOASIS.1018
c*-------------------------------------------------------------------- INIOASIS.1019
c INIOASIS.1020
C Initialise the FieldLocator array from the Input Array: INIOASIS.1021
do ii = 1, NoCouplingField INIOASIS.1022
FieldLocator(istash,ii) = ZInput(Zistash,ii) INIOASIS.1023
FieldLocator(lon,ii) = ZInput(Zistash,ii)(1:5) // 'lon' INIOASIS.1024
FieldLocator(lat,ii) = ZInput(Zistash,ii)(1:5) // 'lat' INIOASIS.1025
FieldLocator(msk,ii) = ZInput(Zistash,ii)(1:5) // 'msk' INIOASIS.1026
FieldLocator(srf,ii) = ZInput(Zistash,ii)(1:5) // 'srf' INIOASIS.1027
FieldLocator(grd,ii) = ZInput(Zgrd,ii) INIOASIS.1028
FieldLocator(direction,ii) = ZInput(Zdirection,ii) INIOASIS.1029
FieldLocator(exc_frequency,ii) = ZInput(Zexc_frequency,ii) INIOASIS.1030
FieldLocator(exc_basis,ii) = ZInput(Zexc_basis,ii) INIOASIS.1031
enddo INIOASIS.1032
INIOASIS.1033
c INIOASIS.1034
c*-------------------------------------------------------------------- INIOASIS.1035
c INIOASIS.1036
c INIOASIS.1037
c Initialise the communication channels with the OASIS coupler : INIOASIS.1038
c Either create pipes, or pvm channels. ( pipes until now ) INIOASIS.1039
c INIOASIS.1040
call ini_cmc( INIOASIS.1041
*CALL ARGSIZE INIOASIS.1042
*CALL ARGD1 INIOASIS.1043
*CALL ARGSTS INIOASIS.1044
*CALL ARGDUMA INIOASIS.1045
*CALL ARGDUMO INIOASIS.1046
*CALL ARGPTRA INIOASIS.1047
*CALL ARGPTRO INIOASIS.1048
*CALL ARGCONA INIOASIS.1049
*CALL ARGCONO INIOASIS.1050
& internal_model, INIOASIS.1051
& 1, INIOASIS.1052
& ICODE,CMESSAGE ) INIOASIS.1053
if (icode .ne. 0) goto 999 INIOASIS.1054
c*-------------------------------------------------------------------- INIOASIS.1055
C Split the work according to wether the UM internal model INIOASIS.1056
C is the atmosphere or the ocean. Any other submodel is INIOASIS.1057
C not (yet) implemented and the code fails on error in such a case. INIOASIS.1058
INIOASIS.1059
if(internal_model.eq.atmos_im) then ! atmosphere ( 1.a & 1.b ) INIOASIS.1060
*IF DEF,ATMOS INIOASIS.1061
cl-------------------------------------------------------------------- INIOASIS.1062
C 2. calculate size of each of the coupling fields using dump INIOASIS.1063
C info. INIOASIS.1064
do ii = 1, NoCouplingField INIOASIS.1065
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.1066
FieldSize(ii) = U_FIELD INIOASIS.1067
else ! TP grid. INIOASIS.1068
FieldSize(ii) = P_FIELD INIOASIS.1069
endif INIOASIS.1070
enddo INIOASIS.1071
INIOASIS.1072
INIOASIS.1073
cl-------------------------------------------------------------------- INIOASIS.1074
cl 3. calculate gridline coordinates on all grids using dump INIOASIS.1075
cl information on grid spacing and position INIOASIS.1076
c INIOASIS.1077
! define the grids of the atmosphere UM submodel. INIOASIS.1078
do ii = 0, row_length + 1 INIOASIS.1079
xta(ii)=a_realhd(4)+(ii-1)*a_realhd(1) INIOASIS.1080
xua(ii)=a_realhd(4)+(ii-0.5)*a_realhd(1) INIOASIS.1081
enddo INIOASIS.1082
do j = 0 ,p_rows + 1 INIOASIS.1083
yta(j)=a_realhd(3)-(j-1)*a_realhd(2) INIOASIS.1084
enddo INIOASIS.1085
do j = 0 ,u_rows + 1 INIOASIS.1086
yua(j)=a_realhd(3)-(j-0.5)*a_realhd(2) INIOASIS.1087
enddo INIOASIS.1088
INIOASIS.1089
! Develop those 1D array onto 2D arrays in order to suit the oasis INIOASIS.1090
! layout. INIOASIS.1091
do ii = 1, row_length INIOASIS.1092
do j = 1, u_rows INIOASIS.1093
Zxua(ii,j) = xua(ii) ! longitude on u grid INIOASIS.1094
Zyua(ii,j) = yua(j) ! latitude on u grid INIOASIS.1095
enddo INIOASIS.1096
enddo INIOASIS.1097
do ii = 1, row_length INIOASIS.1098
do j = 1, p_rows INIOASIS.1099
Zxta(ii,j) = xta(ii) ! longitude on t grid INIOASIS.1100
Zyta(ii,j) = yta(j) ! latitude on t grid INIOASIS.1101
enddo INIOASIS.1102
enddo INIOASIS.1103
! define the mask grids of the atmosphere UM submodel. INIOASIS.1104
! T grid : INIOASIS.1105
do j = 1, p_rows INIOASIS.1106
do ii = 1, row_length INIOASIS.1107
if (LD1(jland-1+ii+(j-1)*row_length)) then INIOASIS.1108
Zmaskta(ii,j)= .true. INIOASIS.1109
imaskta(ii,j)= 1 INIOASIS.1110
else INIOASIS.1111
Zmaskta(ii,j)= .false. INIOASIS.1112
imaskta(ii,j)= 0 INIOASIS.1113
endif INIOASIS.1114
enddo INIOASIS.1115
enddo INIOASIS.1116
C set up logical land/sea mask on atmosphere UV grid INIOASIS.1117
do j = 1, u_rows INIOASIS.1118
do ii = 1, row_length-1 INIOASIS.1119
Zmaskua(ii,j) = INIOASIS.1120
& Zmaskta(ii,j) .or. Zmaskta(ii+1,j) INIOASIS.1121
& .or. Zmaskta(ii,j+1) .or. Zmaskta(ii+1,j+1) INIOASIS.1122
enddo INIOASIS.1123
Zmaskua(row_length,j) = INIOASIS.1124
& Zmaskta(row_length,j) .or. Zmaskta(1,j) INIOASIS.1125
& .or. Zmaskta(row_length,j+1) .or. Zmaskta(1,j+1) INIOASIS.1126
enddo INIOASIS.1127
! Generate an integer mask from the logical mask above ; INIOASIS.1128
! 1 = land, 0 = ocean. (as requiered by OASIS). INIOASIS.1129
INIOASIS.1130
do j = 1, u_rows INIOASIS.1131
do ii = 1, row_length INIOASIS.1132
if (Zmaskua(ii,j)) then INIOASIS.1133
imaskua(ii, j) = 1 INIOASIS.1134
else INIOASIS.1135
imaskua(ii, j) = 0 INIOASIS.1136
endif INIOASIS.1137
enddo INIOASIS.1138
enddo INIOASIS.1139
INIOASIS.1140
!--------------------------------------------------------------------- INIOASIS.1141
! prepare the surface grids here : INIOASIS.1142
INIOASIS.1143
! u grid INIOASIS.1144
do ii = 1, row_length INIOASIS.1145
do j = 1, u_rows INIOASIS.1146
Zlatitude1 = (yua(j-1)+yua(j))/2. INIOASIS.1147
Zlatitude2 = (yua(j+1)+yua(j))/2. INIOASIS.1148
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.1149
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.1150
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.1151
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.1152
surfua(ii,j) = Rearth * Rearth ! on u grid INIOASIS.1153
& * abs( INIOASIS.1154
& ( sin(pi_over_180*Zlatitude2) INIOASIS.1155
& - sin(pi_over_180*Zlatitude1) ) INIOASIS.1156
& * pi_over_180 INIOASIS.1157
& * ((xua(ii+1)+xua(ii))/2. - (xua(ii-1)+xua(ii))/2.) INIOASIS.1158
& ) INIOASIS.1159
enddo INIOASIS.1160
enddo INIOASIS.1161
INIOASIS.1162
! p grid INIOASIS.1163
do ii = 1, row_length INIOASIS.1164
do j = 1, p_rows INIOASIS.1165
Zlatitude1 = (yta(j-1)+yta(j))/2. INIOASIS.1166
Zlatitude2 = (yta(j+1)+yta(j))/2. INIOASIS.1167
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.1168
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.1169
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.1170
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.1171
surfta(ii,j) = Rearth * Rearth ! on u grid INIOASIS.1172
& * abs( INIOASIS.1173
& ( sin(pi_over_180*Zlatitude2) INIOASIS.1174
& - sin(pi_over_180*Zlatitude1) ) INIOASIS.1175
& * pi_over_180 INIOASIS.1176
& * ((xta(ii+1)+xta(ii))/2. - (xta(ii-1)+xta(ii))/2.) INIOASIS.1177
& ) INIOASIS.1178
enddo INIOASIS.1179
enddo INIOASIS.1180
INIOASIS.1181
!--------------------------------------------------------------------- INIOASIS.1182
! Write to file the grids of the coupling INIOASIS.1183
! fields. INIOASIS.1184
!! Note : the layout of the atmos grid is reverse of the one of oasis; INIOASIS.1185
!! therefore the descending j indexes for masks, surf, and grids. INIOASIS.1186
nulgr = 3 INIOASIS.1187
OPEN (UNIT = nulgr, POSITION = 'APPEND', INIOASIS.1188
& FILE = cficgr,STATUS = 'UNKNOWN', INIOASIS.1189
& FORM = 'UNFORMATTED', IOSTAT = iost) INIOASIS.1190
if (iost .ne. 0) then INIOASIS.1191
icode = 1 INIOASIS.1192
cmessage = 'io error in INIT_OASIS from UM atmos model.' INIOASIS.1193
endif INIOASIS.1194
do ii = 1, NoCouplingField INIOASIS.1195
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.1196
! locator for the longitude array: INIOASIS.1197
write(nulgr) FieldLocator(lon,ii) INIOASIS.1198
! longitude array: INIOASIS.1199
write(nulgr) ((Zxua(i,j),i=1,row_length),j=u_rows,1,-1) INIOASIS.1200
! locator for the latitude array: INIOASIS.1201
write(nulgr) FieldLocator(lat,ii) INIOASIS.1202
! latitude array: INIOASIS.1203
write(nulgr) ((Zyua(i,j),i=1,row_length),j=u_rows,1,-1) INIOASIS.1204
else ! T.P grids INIOASIS.1205
! locator for the longitude array: INIOASIS.1206
write(nulgr) FieldLocator(lon,ii) INIOASIS.1207
! longitude array: INIOASIS.1208
write(nulgr) ((Zxta(i,j),i=1,row_length),j=p_rows,1,-1) INIOASIS.1209
! locator for the latitude array: INIOASIS.1210
write(nulgr) FieldLocator(lat,ii) INIOASIS.1211
! latitude array: INIOASIS.1212
write(nulgr) ((Zyta(i,j),i=1,row_length),j=p_rows,1,-1) INIOASIS.1213
! mask locator : INIOASIS.1214
endif INIOASIS.1215
enddo INIOASIS.1216
! Close the grid file. INIOASIS.1217
close(nulgr) INIOASIS.1218
!--------------------------------------------------------------------- INIOASIS.1219
INIOASIS.1220
nulma = 3 INIOASIS.1221
OPEN (UNIT = nulma, POSITION = 'APPEND', INIOASIS.1222
& FILE = cficma,STATUS = 'UNKNOWN', INIOASIS.1223
& FORM = 'UNFORMATTED', IOSTAT = iost) INIOASIS.1224
if (iost .ne. 0) then INIOASIS.1225
icode = 1 INIOASIS.1226
cmessage = 'io error in INIT_OASIS from UM atmos model.' INIOASIS.1227
endif INIOASIS.1228
do ii = 1, NoCouplingField INIOASIS.1229
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.1230
! mask locator : INIOASIS.1231
write(nulma) FieldLocator(msk,ii) INIOASIS.1232
write(nulma) INIOASIS.1233
& ((imaskua(i,j),i=1,row_length),j=u_rows,1,-1) INIOASIS.1234
! surface locator : INIOASIS.1235
else ! T.P grids INIOASIS.1236
! mask locator : INIOASIS.1237
write(nulma) FieldLocator(msk,ii) INIOASIS.1238
write(nulma) ((imaskta(i,j),i=1,row_length),j=p_rows,1,-1) INIOASIS.1239
endif INIOASIS.1240
enddo INIOASIS.1241
! Close the mask files. INIOASIS.1242
close(nulma) INIOASIS.1243
INIOASIS.1244
!--------------------------------------------------------------------- INIOASIS.1245
INIOASIS.1246
nulsu = 3 INIOASIS.1247
OPEN (UNIT = nulsu,POSITION = 'APPEND', INIOASIS.1248
& FILE = cficsu,STATUS = 'UNKNOWN', INIOASIS.1249
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.1250
if (iost .ne. 0) then INIOASIS.1251
icode = 1 INIOASIS.1252
cmessage = 'io error in INIT_OASIS from UM atmos model.' INIOASIS.1253
endif INIOASIS.1254
do ii = 1, NoCouplingField INIOASIS.1255
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.1256
write(nulsu) FieldLocator(srf,ii) INIOASIS.1257
! surface filed for tx : INIOASIS.1258
write(nulsu)((surfua(i,j),i=1,row_length),j=u_rows,1,-1) INIOASIS.1259
else ! T.P grids INIOASIS.1260
! surface locator : INIOASIS.1261
write(nulsu) FieldLocator(srf,ii) INIOASIS.1262
! surface field : INIOASIS.1263
write(nulsu) ((surfta(i,j),i=1,row_length),j=p_rows,1,-1) INIOASIS.1264
endif INIOASIS.1265
enddo INIOASIS.1266
! Close the grids, masks and surface files. INIOASIS.1267
close(nulsu) INIOASIS.1268
!--------------------------------------------------------------------- INIOASIS.1269
INIOASIS.1270
INIOASIS.1271
INIOASIS.1272
*ENDIF INIOASIS.1273
INIOASIS.1274
cl-------------------------------------------------------------------- INIOASIS.1275
C PART II : we now deal with the ocean in the following INIOASIS.1276
C sections. INIOASIS.1277
INIOASIS.1278
elseif (internal_model.eq.ocean_im) then ! ocean ( 2.a & 2.b ) INIOASIS.1279
INIOASIS.1280
*IF DEF,OCEAN INIOASIS.1281
C INIOASIS.1282
CL SECTION 1: No. of distinct columns in ocean. INIOASIS.1283
C INIOASIS.1284
if (cyclic_ocean) then INIOASIS.1285
iru=imt-2 INIOASIS.1286
irt=iru INIOASIS.1287
else INIOASIS.1288
iru=imt-1 INIOASIS.1289
irt=imt INIOASIS.1290
endif INIOASIS.1291
C INIOASIS.1292
cl-------------------------------------------------------------------- INIOASIS.1293
C 2. calculate size of each of the coupling fields using dump INIOASIS.1294
C info. INIOASIS.1295
do ii = 1, NoCouplingField INIOASIS.1296
if (FieldLocator(grd,ii) .eq. 'U') then ! U grid INIOASIS.1297
FieldSize(ii) = (iru) * (jmtm1) INIOASIS.1298
else ! TS grid INIOASIS.1299
FieldSize(ii) = (irt) * (jmt) INIOASIS.1300
endif INIOASIS.1301
enddo INIOASIS.1302
INIOASIS.1303
cl-------------------------------------------------------------------- INIOASIS.1304
cl 3. calculate gridline coordinates on all grids using dump INIOASIS.1305
cl information on grid spacing and position INIOASIS.1306
if (global_ocean.and..not.cyclic_ocean) then INIOASIS.1307
icode=24 INIOASIS.1308
cmessage='init_oasis: a coupled global ocean must be cyclic' INIOASIS.1309
goto 999 INIOASIS.1310
elseif (.not.global_ocean.and.cyclic_ocean) then INIOASIS.1311
icode=25 INIOASIS.1312
cmessage='init_oasis: ' INIOASIS.1313
& //'a coupled limited-area ocean must not be cyclic' INIOASIS.1314
goto 999 INIOASIS.1315
endif INIOASIS.1316
! if (a_realhd(5).ne.o_realhd(5).or.a_realhd(6).ne.o_realhd(6)) INIOASIS.1317
! & then INIOASIS.1318
! icode=26 INIOASIS.1319
! cmessage='init_oasis: ' INIOASIS.1320
! & //'coupled atmosphere and ocean must have coincident poles' INIOASIS.1321
! goto 999 INIOASIS.1322
! endif INIOASIS.1323
INIOASIS.1324
! define the grids of the ocean UM submodel. INIOASIS.1325
! the global alternative can be removed when we are sure that the INIOASIS.1326
! ocean dump headers have been correctly created INIOASIS.1327
if (global_ocean) then INIOASIS.1328
xuo(1)=o_realhd(4)+0.5*o_realhd(1) INIOASIS.1329
else INIOASIS.1330
xuo(1)=o_realhd(8) INIOASIS.1331
endif INIOASIS.1332
xuo(0)=xuo(1)-o_coldepc(1) INIOASIS.1333
xto(1)=xuo(1)-0.5*o_coldepc(1) INIOASIS.1334
xto(0)=xto(1)-o_coldepc(1) INIOASIS.1335
do ii=2,imt INIOASIS.1336
xuo(ii)=xuo(ii-1)+o_coldepc(ii) INIOASIS.1337
xto(ii)=xto(ii-1)+0.5*(o_coldepc(ii-1)+o_coldepc(ii)) INIOASIS.1338
enddo INIOASIS.1339
xuo(imt+1)=xuo(imt)+o_coldepc(imt) INIOASIS.1340
xto(imt+1)=xto(imt)+o_coldepc(imt) INIOASIS.1341
INIOASIS.1342
yuo(1)=o_realhd(7) INIOASIS.1343
yuo(0)=yuo(1)-o_rowdepc(1) INIOASIS.1344
yto(1)=yuo(1)-0.5*o_rowdepc(1) INIOASIS.1345
yto(0)=yto(1)-o_rowdepc(1) INIOASIS.1346
do j=2,jmt INIOASIS.1347
yuo(j)=yuo(j-1)+o_rowdepc(j) INIOASIS.1348
yto(j)=yto(j-1)+0.5*(o_rowdepc(j-1)+o_rowdepc(j)) INIOASIS.1349
enddo INIOASIS.1350
yto(jmt+1) = yto(jmt)+o_rowdepc(jmt) INIOASIS.1351
INIOASIS.1352
! Develop those 1D array onto 2D arrays in order to suit the oasis INIOASIS.1353
! layout. INIOASIS.1354
do ii = 1, imt INIOASIS.1355
do j = 1, jmtm1 INIOASIS.1356
Zxuo(ii,j) = xuo(ii) ! longitude on u grid INIOASIS.1357
Zyuo(ii,j) = yuo(j) ! latitude on u grid INIOASIS.1358
enddo INIOASIS.1359
enddo INIOASIS.1360
do ii = 1, imt INIOASIS.1361
do j = 1, jmt INIOASIS.1362
Zxto(ii,j) = xto(ii) ! longitude on t grid INIOASIS.1363
Zyto(ii,j) = yto(j) ! latitude on t grid INIOASIS.1364
enddo INIOASIS.1365
enddo INIOASIS.1366
INIOASIS.1367
! define the mask grids of the ocean UM submodel. INIOASIS.1368
! TS grid : (use the number of levels) INIOASIS.1369
do j = 1, jmt INIOASIS.1370
do ii = 1, imt INIOASIS.1371
if ( o_flddepc(ii+(j-1)*imt) .lt. 0.1 ) then INIOASIS.1372
imaskto(ii,j) = 1 INIOASIS.1373
else INIOASIS.1374
imaskto(ii,j) = 0 INIOASIS.1375
endif INIOASIS.1376
enddo INIOASIS.1377
enddo INIOASIS.1378
! UV grid : (use the number of levels) INIOASIS.1379
do j = 1, jmt INIOASIS.1380
do ii = 1, imt INIOASIS.1381
if ( (o_spcon(jocp_fkmq+ii-1+(j-1)*imt)) .LT. (0.1) ) then INIOASIS.1382
imaskuo(ii,j) = 1 INIOASIS.1383
else INIOASIS.1384
imaskuo(ii,j) = 0 INIOASIS.1385
endif INIOASIS.1386
enddo INIOASIS.1387
enddo INIOASIS.1388
INIOASIS.1389
!--------------------------------------------------------------------- INIOASIS.1390
! prepare the surface grids here : INIOASIS.1391
! Note that I produce the surfaces at the centre of the gridboxes. INIOASIS.1392
INIOASIS.1393
! on U grid : INIOASIS.1394
do j = 1, jmtm1 INIOASIS.1395
do ii = 1, imt INIOASIS.1396
Zlatitude1 = (yuo(j-1)+yuo(j))/2. INIOASIS.1397
Zlatitude2 = (yuo(j+1)+yuo(j))/2. INIOASIS.1398
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.1399
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.1400
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.1401
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.1402
surfuo(ii,j) = Rearth * Rearth ! on u grid INIOASIS.1403
& * abs( INIOASIS.1404
& ( sin(pi_over_180* Zlatitude2 ) INIOASIS.1405
& - sin(pi_over_180* Zlatitude1 ) ) INIOASIS.1406
& * pi_over_180 INIOASIS.1407
& * ((xuo(ii+1)+xuo(ii))/2. - (xuo(ii-1)+xuo(ii))/2.) INIOASIS.1408
& ) INIOASIS.1409
enddo INIOASIS.1410
enddo INIOASIS.1411
INIOASIS.1412
! on T grid INIOASIS.1413
do j = 1, jmt INIOASIS.1414
do ii = 1, imt INIOASIS.1415
Zlatitude1 = (yto(j-1)+yto(j))/2. INIOASIS.1416
Zlatitude2 = (yto(j+1)+yto(j))/2. INIOASIS.1417
if (Zlatitude1 .gt. 90.0) Zlatitude1 = 90.0 INIOASIS.1418
if (Zlatitude2 .gt. 90.0) Zlatitude2 = 90.0 INIOASIS.1419
if (Zlatitude1 .lt. -90.0) Zlatitude1 = -90.0 INIOASIS.1420
if (Zlatitude2 .lt. -90.0) Zlatitude2 = -90.0 INIOASIS.1421
surfto(ii,j) = Rearth * Rearth ! on t grid INIOASIS.1422
& * abs( INIOASIS.1423
& ( sin(pi_over_180*Zlatitude1) INIOASIS.1424
& - sin(pi_over_180*Zlatitude2) ) INIOASIS.1425
& * pi_over_180 INIOASIS.1426
& * ((xto(ii+1)+xto(ii))/2. - (xto(ii-1)+xto(ii))/2.) INIOASIS.1427
& ) INIOASIS.1428
enddo INIOASIS.1429
enddo INIOASIS.1430
INIOASIS.1431
INIOASIS.1432
!--------------------------------------------------------------------- INIOASIS.1433
! Write to file the grids, masks and surface of each of the coupling INIOASIS.1434
! fields. INIOASIS.1435
! a/import of fields INIOASIS.1436
! b/export of fields INIOASIS.1437
nulgr = 3 INIOASIS.1438
OPEN (UNIT = nulgr, POSITION = 'APPEND', INIOASIS.1439
& FILE = cficgr,STATUS = 'UNKNOWN', INIOASIS.1440
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.1441
if (iost .ne. 0) then INIOASIS.1442
icode = 1 INIOASIS.1443
cmessage = 'io error in INIT_OASIS from UM ocean model.' INIOASIS.1444
endif INIOASIS.1445
do ii = 1, NoCouplingField INIOASIS.1446
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.1447
! locator for the longitude array: INIOASIS.1448
write(nulgr) FieldLocator(lon,ii) INIOASIS.1449
! longitude array: INIOASIS.1450
write(nulgr) ((Zxuo(i,j),i = 1,iru), j=1,jmtm1) INIOASIS.1451
! locator for the latitude array: INIOASIS.1452
write(nulgr) FieldLocator(lat,ii) INIOASIS.1453
! latitude array: INIOASIS.1454
write(nulgr) ((Zyuo(i,j),i = 1,iru), j=1,jmtm1) INIOASIS.1455
! mask locator : INIOASIS.1456
else ! T grids INIOASIS.1457
! locator for the longitude array: INIOASIS.1458
write(nulgr) FieldLocator(lon,ii) INIOASIS.1459
! longitude array: INIOASIS.1460
write(nulgr) ((Zxto(i,j),i = 1,irt), j=1,jmt) INIOASIS.1461
! locator for the latitude array: INIOASIS.1462
write(nulgr) FieldLocator(lat,ii) INIOASIS.1463
! latitude array: INIOASIS.1464
write(nulgr) ((Zyto(i,j),i = 1,irt), j=1,jmt) INIOASIS.1465
! mask locator : INIOASIS.1466
endif INIOASIS.1467
enddo INIOASIS.1468
! Close the grids, masks and surface files. INIOASIS.1469
close(nulgr) INIOASIS.1470
INIOASIS.1471
!--------------------------------------------------------------------- INIOASIS.1472
! Write to file the masks of the coupling INIOASIS.1473
! fields. INIOASIS.1474
! a/import of fields INIOASIS.1475
! b/export of fields INIOASIS.1476
nulsu = 3 INIOASIS.1477
OPEN (UNIT = nulsu, POSITION = 'APPEND', INIOASIS.1478
& FILE = cficsu,STATUS = 'UNKNOWN', INIOASIS.1479
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.1480
if (iost .ne. 0) then INIOASIS.1481
icode = 1 INIOASIS.1482
cmessage = 'io error in INIT_OASIS from UM ocean model.' INIOASIS.1483
endif INIOASIS.1484
do ii = 1, NoCouplingField INIOASIS.1485
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.1486
! locator for the longitude array: INIOASIS.1487
write(nulsu) FieldLocator(srf,ii) INIOASIS.1488
! surface filed for tx : INIOASIS.1489
write(nulsu) ((surfuo(i,j),i = 1,iru), j=1,jmtm1) INIOASIS.1490
else ! T grids INIOASIS.1491
! surface locator : INIOASIS.1492
write(nulsu) FieldLocator(srf,ii) INIOASIS.1493
! surface field : INIOASIS.1494
write(nulsu) ((surfto(i,j),i = 1,irt), j=1,jmt) INIOASIS.1495
endif INIOASIS.1496
enddo INIOASIS.1497
! Close the grids, masks and surface files. INIOASIS.1498
close(nulsu) INIOASIS.1499
INIOASIS.1500
!--------------------------------------------------------------------- INIOASIS.1501
! Write to file the grids, masks and surface of each of the coupling INIOASIS.1502
! fields. INIOASIS.1503
! a/import of fields INIOASIS.1504
! b/export of fields INIOASIS.1505
nulma = 3 INIOASIS.1506
OPEN (UNIT = nulma, POSITION = 'APPEND', INIOASIS.1507
& FILE = cficma,STATUS = 'UNKNOWN', INIOASIS.1508
& FORM = 'UNFORMATTED',IOSTAT = iost) INIOASIS.1509
if (iost .ne. 0) then INIOASIS.1510
icode = 1 INIOASIS.1511
cmessage = 'io error in INIT_OASIS from UM ocean model.' INIOASIS.1512
endif INIOASIS.1513
do ii = 1, NoCouplingField INIOASIS.1514
if (FieldLocator(grd,ii) .eq. 'U') then ! U grids INIOASIS.1515
! mask locator : INIOASIS.1516
write(nulma) FieldLocator(msk,ii) INIOASIS.1517
write(nulma) ((imaskuo(i,j),i = 1,iru),j=1,jmtm1) INIOASIS.1518
else ! T grids INIOASIS.1519
! mask locator : INIOASIS.1520
write(nulma) FieldLocator(msk,ii) INIOASIS.1521
write(nulma) ((imaskto(i,j),i = 1,irt), j=1,jmt) INIOASIS.1522
endif INIOASIS.1523
enddo INIOASIS.1524
! Close the grids, masks and surface files. INIOASIS.1525
close(nulma) INIOASIS.1526
INIOASIS.1527
*ENDIF INIOASIS.1528
INIOASIS.1529
else ! neither ocean or atmosphere UM have been selected. INIOASIS.1530
icode = -1 INIOASIS.1531
write(nulou,*) INIOASIS.1532
& 'Coupling with UM internal model different from' INIOASIS.1533
write(nulou,*) INIOASIS.1534
& 'the atmosphere or the ocean not currently allowed.' INIOASIS.1535
goto 999 INIOASIS.1536
endif INIOASIS.1537
INIOASIS.1538
! INIOASIS.1539
! Initialise pointers of the coupling fields to the D1 array : INIOASIS.1540
! INIOASIS.1541
call ini_z_ptr( INIOASIS.1542
*CALL ARGSIZE INIOASIS.1543
*CALL ARGD1 INIOASIS.1544
*CALL ARGSTS INIOASIS.1545
*CALL ARGDUMA INIOASIS.1546
*CALL ARGDUMO INIOASIS.1547
*CALL ARGPTRA INIOASIS.1548
*CALL ARGPTRO INIOASIS.1549
& internal_model, INIOASIS.1550
& ICODE,CMESSAGE ) INIOASIS.1551
if (icode .ne. 0) goto 999 INIOASIS.1552
INIOASIS.1553
c INIOASIS.1554
c Send OK to the coupler indicating the initialization phase has INIOASIS.1555
c been completed. INIOASIS.1556
c INIOASIS.1557
call ini_cmc( INIOASIS.1558
*CALL ARGSIZE INIOASIS.1559
*CALL ARGD1 INIOASIS.1560
*CALL ARGSTS INIOASIS.1561
*CALL ARGDUMA INIOASIS.1562
*CALL ARGDUMO INIOASIS.1563
*CALL ARGPTRA INIOASIS.1564
*CALL ARGPTRO INIOASIS.1565
*CALL ARGCONA INIOASIS.1566
*CALL ARGCONO INIOASIS.1567
& internal_model, INIOASIS.1568
& 2, INIOASIS.1569
& ICODE,CMESSAGE ) INIOASIS.1570
if (icode .ne. 0) goto 999 INIOASIS.1571
INIOASIS.1572
write(nulou,*) "exiting INIOASIS" INIOASIS.1573
INIOASIS.1574
!------------------------------------------------ INIOASIS.1575
! error trap. INIOASIS.1576
999 continue INIOASIS.1577
if(icode.ne.0) then INIOASIS.1578
write(nulou,*) cmessage,icode INIOASIS.1579
endif INIOASIS.1580
INIOASIS.1581
return INIOASIS.1582
end INIOASIS.1583
INIOASIS.1584
*ENDIF INIOASIS.1585