subroutine oasis_diagnostics_import( 2,17OASISDIAGI.69
*IF DEF,ATMOS OASISDIAGI.70
& g_p_field, OASISDIAGI.71
*ENDIF OASISDIAGI.72
*IF DEF,OCEAN OASISDIAGI.73
& g_imtjmt, OASISDIAGI.74
*ENDIF OASISDIAGI.75
*CALL ARGSIZE 
OASISDIAGI.76
*CALL ARGD1 OASISDIAGI.77
*CALL ARGSTS OASISDIAGI.78
*CALL ARGDUMO OASISDIAGI.79
*CALL ARGDUMA OASISDIAGI.80
*CALL ARGPTRO OASISDIAGI.81
*CALL ARGPTRA OASISDIAGI.82
& Zwork, OASISDIAGI.83
*IF DEF,ATMOS OASISDIAGI.84
& Zwork_aice_previous, OASISDIAGI.85
*ENDIF OASISDIAGI.86
& CouplingField, OASISDIAGI.87
& internal_model, OASISDIAGI.88
& icode,cmessage) OASISDIAGI.89
OASISDIAGI.90
implicit none OASISDIAGI.91
OASISDIAGI.92
C arguments type : OASISDIAGI.93
*IF DEF,OCEAN OASISDIAGI.94
integer g_imtjmt OASISDIAGI.95
*ENDIF OASISDIAGI.96
*IF DEF,ATMOS OASISDIAGI.97
integer g_p_field OASISDIAGI.98
*ENDIF OASISDIAGI.99
*CALL CMAXSIZE OASISDIAGI.100
*CALL CSUBMODL OASISDIAGI.101
*CALL TYPSIZE OASISDIAGI.102
*CALL TYPD1 OASISDIAGI.103
*CALL TYPSTS OASISDIAGI.104
*CALL TYPDUMO OASISDIAGI.105
*CALL TYPDUMA OASISDIAGI.106
*CALL TYPPTRO OASISDIAGI.107
*CALL TYPPTRA OASISDIAGI.108
OASISDIAGI.109
*IF DEF,OCEAN OASISDIAGI.110
! Coupling fields : OASISDIAGI.111
real Zwork(g_imtjmt) OASISDIAGI.112
! Temp local array for the field scattering. OASISDIAGI.113
real Zworklocal(imt*jmt) OASISDIAGI.114
*ENDIF OASISDIAGI.115
*IF DEF,ATMOS OASISDIAGI.116
! Coupling fields : OASISDIAGI.117
real Zwork(g_p_field) OASISDIAGI.118
real Zwork_aice_previous(g_p_field) ! IO : aice from the OASISDIAGI.119
! previous ts. OASISDIAGI.120
! Temp local array for the field scattering. OASISDIAGI.121
real Zworklocal(p_field) OASISDIAGI.122
real Zworklocal2(p_field) OASISDIAGI.123
*ENDIF OASISDIAGI.124
OASISDIAGI.125
integer CouplingField ! No of the current coupling field. OASISDIAGI.126
integer internal_model ! No of the current internal model. OASISDIAGI.127
integer icode ! OUT - Error return code OASISDIAGI.128
character*(*) cmessage ! OUT - Error return message OASISDIAGI.129
OASISDIAGI.130
*CALL CHSUNITS OASISDIAGI.131
*CALL CCONTROL OASISDIAGI.132
*CALL CLOOKADD OASISDIAGI.133
*CALL C_LHEAT OASISDIAGI.134
*CALL C_0_DG_C OASISDIAGI.135
*CALL C_MDI OASISDIAGI.136
*CALL CTRACERA OASISDIAGI.137
*CALL TYPOCDPT OASISDIAGI.138
OASISDIAGI.139
C commons : OASISDIAGI.140
! Time status of the Unified Model. OASISDIAGI.141
*CALL CTIME OASISDIAGI.142
! common variables of the UM_OASIS section. OASISDIAGI.143
*CALL COASIS OASISDIAGI.144
OASISDIAGI.145
*CALL PARVARS OASISDIAGI.146
*CALL DECOMPTP OASISDIAGI.147
*CALL DECOMPDB OASISDIAGI.148
OASISDIAGI.151
real OASISDIAGI.152
& aicemin ! minimum ice concentration if ice OASISDIAGI.153
! present OASISDIAGI.154
parameter (aicemin = 0.001 ) OASISDIAGI.155
OASISDIAGI.156
integer k OASISDIAGI.157
C Local parameters: OASISDIAGI.158
INTEGER OASISDIAGI.159
& swap_levels ! no. levels for SWAPBOUNDS OASISDIAGI.160
PARAMETER( OASISDIAGI.161
& swap_levels=1) ! by definition OASISDIAGI.162
integer info OASISDIAGI.163
OASISDIAGI.164
! Declaration of the pointers on the atmosphere D1. OASISDIAGI.165
integer OASISDIAGI.166
& D1_Zptr_aice ! Pointer towards the coupling field in D1. OASISDIAGI.167
! These need to be stored in a static area of memory (therefore are OASISDIAGI.168
! initialized to dummy in data): OASISDIAGI.169
data OASISDIAGI.170
& D1_Zptr_aice /1/ OASISDIAGI.171
OASISDIAGI.172
OASISDIAGI.173
icode = 0 ! error code set to nil at begining OASISDIAGI.174
! of the procedure. OASISDIAGI.175
OASISDIAGI.176
C--------------------------------------------------------------------- OASISDIAGI.177
write(nulou,*) 'entering OASIS_DIAGNOSTICS_IMPORT ...' OASISDIAGI.178
C--------------------------------------------------------------------- OASISDIAGI.179
OASISDIAGI.180
C I/ if the internal model is the UM_atmosphere: OASISDIAGI.181
if (internal_model .eq. atmos_im) then OASISDIAGI.182
*IF DEF,ATMOS OASISDIAGI.183
C OASISDIAGI.184
C*-- Sea Ice fraction OASISDIAGI.185
C*-- !!! Only the pointers are setup for the SIF ; the field in OASISDIAGI.186
C*-- !!! itself is handled at the same time as the SST. OASISDIAGI.187
C OASISDIAGI.188
if ((FieldLocator(direction,CouplingField) .eq. 'I') OASISDIAGI.189
& .and. (FieldLocator(istash,CouplingField) .eq. '00031')) OASISDIAGI.190
& then OASISDIAGI.191
C Pointer towards the coupling field in D1 OASISDIAGI.192
D1_Zptr_aice = D1_Zptr(CouplingField) OASISDIAGI.193
C Store the current ice fraction into an array for future use: OASISDIAGI.194
do k = 1, lasize(1)*lasize(2) OASISDIAGI.195
Zwork_aice_previous(k) = D1(D1_Zptr_aice + k - 1) OASISDIAGI.196
enddo OASISDIAGI.197
endif OASISDIAGI.198
C OASISDIAGI.199
C*-- Sea Surface Temperature : OASISDIAGI.200
C OASISDIAGI.201
if ((FieldLocator(direction,CouplingField) .eq. 'I') OASISDIAGI.202
& .and. (FieldLocator(istash,CouplingField) .eq. '00024')) OASISDIAGI.203
& then OASISDIAGI.204
C Unfortunately, the SST deserves a special treatment we only OASISDIAGI.205
C can deliver while importing the field within the atmosphere OASISDIAGI.206
C model. This is because the input values are meant to take OASISDIAGI.207
C into account the values of the previous timestep ; see OASISDIAGI.208
C below the comment on the computation method as it is in the OASISDIAGI.209
C current coupling system (without oasis) : OASISDIAGI.210
C OASISDIAGI.211
C `` at sea-ice points, the grid box mean surface temperature OASISDIAGI.212
c is altered in such a way that the surface temperature of OASISDIAGI.213
c the icy portion of the box is the same as it was at the end OASISDIAGI.214
c of the last atmospheric phase. however, if ice appeared OASISDIAGI.215
c during the most recent ocean phase, its temperature is OASISDIAGI.216
c initialised at the freezing point of seawater. OASISDIAGI.217
c this code uses the old values of ice concentration, which OASISDIAGI.218
c were stored during section 2 in aiceref. '' OASISDIAGI.219
!*IF DEF,SEAICE ! the update switch is undefined when in ocean mode!! OASISDIAGI.220
C Scatter the sst across all PEs (into Zworklocal): OASISDIAGI.221
call scatter_field(Zworklocal, OASISDIAGI.222
& Zwork, OASISDIAGI.223
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAGI.224
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAGI.225
if(info.ne.0) then ! Check return code OASISDIAGI.226
cmessage='OASIS DIAG IMPORT : ERROR in scatter' OASISDIAGI.227
icode=101 OASISDIAGI.228
go to 999 OASISDIAGI.229
endif OASISDIAGI.230
call swapbounds(Zworklocal,lasize(1),lasize(2), OASISDIAGI.231
& offx,offy,swap_levels) OASISDIAGI.232
call set_sides(Zworklocal,lasize(1)*lasize(2),lasize(1), OASISDIAGI.233
& swap_levels,fld_type_p) OASISDIAGI.234
C Compute the new SST field. OASISDIAGI.235
do k = 1, lasize(1)*lasize(2) OASISDIAGI.236
if (Zworklocal(k) .ne. rmdi) then OASISDIAGI.237
if (D1(D1_Zptr_aice+k-1) .eq. 0.0) then OASISDIAGI.238
D1(D1_Zptr(CouplingField)+k-1) = OASISDIAGI.239
& Zworklocal(k) + zerodegc OASISDIAGI.240
elseif (Zwork_aice_previous(k) .ge. aicemin) then OASISDIAGI.241
D1(D1_Zptr(CouplingField)+k-1) = tfs + OASISDIAGI.242
& (D1(D1_Zptr_aice+k-1)/Zwork_aice_previous(k)) OASISDIAGI.243
& * (D1(D1_Zptr(CouplingField)+k-1) - tfs) OASISDIAGI.244
else OASISDIAGI.245
D1(D1_Zptr(CouplingField)+k-1) = tfs OASISDIAGI.246
endif OASISDIAGI.247
endif OASISDIAGI.248
enddo OASISDIAGI.249
OASISDIAGI.250
!*ELSE ! no seaice in the ocean model for the following bit of code. OASISDIAGI.251
C Copy the field over to D1 and convert from degrees C to K. OASISDIAGI.252
C Since we assume we are using the ocean model WITH the ice OASISDIAGI.253
C model, the next portion of code should be commented out: OASISDIAGI.254
c do k = 1, FieldSize(CouplingField) OASISDIAGI.255
c if (Zwork(Zwork_Zptr(CouplingField)+k-1) .ne. rmdi) then OASISDIAGI.256
c D1(D1_Zptr(CouplingField)+k-1) = OASISDIAGI.257
c & Zwork(Zwork_Zptr(CouplingField)+k-1) + zerodegc OASISDIAGI.258
c endif OASISDIAGI.259
c enddo OASISDIAGI.260
!*ENDIF OASISDIAGI.261
else ! fields which do not need a special treatment. OASISDIAGI.262
OASISDIAGI.263
C 1/ Scatter the array from 1 PE to the rest of them OASISDIAGI.264
C 2/ Copy those small arrays onto D1 while ignoring the OASISDIAGI.265
C undefined values(rmdi) of the current field. OASISDIAGI.266
C Copy the field over to the D1 array OASISDIAGI.267
C 1. Scatter the array from 1 PE to the rest of them OASISDIAGI.268
if (FieldLocator(grd,CouplingField) .eq. 'T') then OASISDIAGI.269
call scatter_field(Zworklocal, OASISDIAGI.270
& Zwork, OASISDIAGI.271
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAGI.272
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAGI.273
if(info.ne.0) then ! Check return code OASISDIAGI.274
cmessage='OASIS DIAG IMPORT : ERROR in scatter' OASISDIAGI.275
icode=101 OASISDIAGI.276
go to 999 OASISDIAGI.277
endif OASISDIAGI.278
call swapbounds(Zworklocal,lasize(1),lasize(2), OASISDIAGI.279
& offx,offy,swap_levels) OASISDIAGI.280
call set_sides(Zworklocal,lasize(1)*lasize(2),lasize(1), OASISDIAGI.281
& swap_levels,fld_type_p) OASISDIAGI.282
elseif (FieldLocator(grd,CouplingField) .eq. 'U') then OASISDIAGI.283
call scatter_field(Zworklocal, OASISDIAGI.284
& Zwork, OASISDIAGI.285
& lasize(1),lasize(2),glsize(1),glsize(2)-1, OASISDIAGI.286
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAGI.287
if(info.ne.0) then ! Check return code OASISDIAGI.288
cmessage='OASIS DIAG IMPORT : ERROR in scatter' OASISDIAGI.289
icode=102 OASISDIAGI.290
go to 999 OASISDIAGI.291
endif OASISDIAGI.292
call swapbounds(Zworklocal,lasize(1),lasize(2),offx,offy, OASISDIAGI.293
& swap_levels) OASISDIAGI.294
call set_sides(Zworklocal,lasize(1)*lasize(2),lasize(1), OASISDIAGI.295
& swap_levels,fld_type_u) OASISDIAGI.296
else ! error OASISDIAGI.297
cmessage='OASIS DIAG IMPORT : ERROR in input list' OASISDIAGI.298
icode=102 OASISDIAGI.299
go to 999 OASISDIAGI.300
endif OASISDIAGI.301
OASISDIAGI.302
OASISDIAGI.303
C 2.Copy the local arrays into D1. OASISDIAGI.304
do k = 1, lasize(1)*lasize(2) OASISDIAGI.305
if (Zworklocal(k) .ne. rmdi) then OASISDIAGI.306
D1(D1_Zptr(CouplingField)+k-1) = Zworklocal(k) OASISDIAGI.307
endif OASISDIAGI.308
enddo OASISDIAGI.309
OASISDIAGI.310
OASISDIAGI.311
endif OASISDIAGI.312
OASISDIAGI.313
*ENDIF OASISDIAGI.314
C--------------------------------------------------------------------- OASISDIAGI.315
C II/ if the internal model is the UM_ocean : OASISDIAGI.316
else if (internal_model .eq. ocean_im) then OASISDIAGI.317
OASISDIAGI.318
*IF DEF,OCEAN OASISDIAGI.319
C 1/ Add the wrap around 2 columns at the end of the global OASISDIAGI.320
C array OASISDIAGI.321
C 2/ Scatter the array from 1 PE to the rest of them OASISDIAGI.322
C 3/ Copy those small arrays onto D1 while ignoring the OASISDIAGI.323
C undefined values(rmdi) of the current field. OASISDIAGI.324
C Copy the field over to the D1 array OASISDIAGI.325
OASISDIAGI.326
C 1.Add two columns at the end identical to the colums one and OASISDIAGI.327
C two. OASISDIAGI.328
if (mype .eq. gather_pe) then OASISDIAGI.329
if ((cyclic_ocean) .and. OASISDIAGI.330
& (FieldLocator(grd,CouplingField) .eq. 'T')) then OASISDIAGI.331
call oasis_cyclicbc(Zwork, OASISDIAGI.332
& Zwork,g_imt,g_jmt) OASISDIAGI.333
elseif ((cyclic_ocean) .and. OASISDIAGI.334
& (FieldLocator(grd,CouplingField) .eq. 'U')) then OASISDIAGI.335
call oasis_cyclicbc(Zwork, OASISDIAGI.336
& Zwork,g_imt,g_jmt) OASISDIAGI.337
endif OASISDIAGI.338
endif ! 1 pe. OASISDIAGI.339
OASISDIAGI.340
C 2. Scatter the array from 1 PE to the rest of them OASISDIAGI.341
if (FieldLocator(grd,CouplingField) .eq. 'T') then OASISDIAGI.342
call scatter_field(Zworklocal, OASISDIAGI.343
& Zwork, OASISDIAGI.344
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAGI.345
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAGI.346
if(info.ne.0) then ! Check return code OASISDIAGI.347
cmessage='OASIS DIAG IMPORT : ERROR in scatter' OASISDIAGI.348
icode=101 OASISDIAGI.349
go to 999 OASISDIAGI.350
endif OASISDIAGI.351
call swapbounds(Zworklocal,lasize(1),lasize(2), OASISDIAGI.352
& offx,offy,swap_levels) OASISDIAGI.353
elseif (FieldLocator(grd,CouplingField) .eq. 'U') then OASISDIAGI.354
call scatter_field(Zworklocal, OASISDIAGI.355
& Zwork, OASISDIAGI.356
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAGI.357
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAGI.358
if(info.ne.0) then ! Check return code OASISDIAGI.359
cmessage='OASIS DIAG IMPORT : ERROR in scatter' OASISDIAGI.360
icode=102 OASISDIAGI.361
go to 999 OASISDIAGI.362
endif OASISDIAGI.363
call swapbounds(Zworklocal,lasize(1),lasize(2),offx,offy, OASISDIAGI.364
& swap_levels) OASISDIAGI.365
else ! error: OASISDIAGI.366
cmessage='OASIS DIAGNOSTICS IMPORT : ERROR in input list' OASISDIAGI.367
icode=102 OASISDIAGI.368
go to 999 OASISDIAGI.369
endif OASISDIAGI.370
OASISDIAGI.371
C 3.Copy the local arrays into D1. OASISDIAGI.372
do k = 1, lasize(1)*lasize(2) OASISDIAGI.373
if (Zworklocal(k) .ne. rmdi) then OASISDIAGI.374
D1(D1_Zptr(CouplingField)+k-1) = Zworklocal(k) OASISDIAGI.375
endif OASISDIAGI.376
enddo OASISDIAGI.377
OASISDIAGI.378
*ENDIF OASISDIAGI.379
OASISDIAGI.380
C--------------------------------------------------------------------- OASISDIAGI.381
C III/ if the internal model is any of the above, generate an OASISDIAGI.382
C error message OASISDIAGI.383
else !! internal_model OASISDIAGI.384
icode = 1 OASISDIAGI.385
cmessage = ' OASIS : Unauthorised internal model. ' OASISDIAGI.386
endif !! internal_model OASISDIAGI.387
OASISDIAGI.388
C------------------------------------------------ OASISDIAGI.389
C Error trap. OASISDIAGI.390
999 continue OASISDIAGI.391
if(icode.ne.0) then OASISDIAGI.392
write(nulou,*) cmessage,icode OASISDIAGI.393
endif OASISDIAGI.394
write(nulou,*) "exiting OASIS_DIAGNOSTICS_IMPORT" OASISDIAGI.395
OASISDIAGI.396
return OASISDIAGI.397
end OASISDIAGI.398
OASISDIAGI.399
CLL subroutine oasis_cyclicbc ------------------------------------- OASISDIAGI.400
cll ------------------- OASISDIAGI.401
cll OASISDIAGI.402
cll this routine copies the first two columns of a two-dimensional OASISDIAGI.403
cll array to the last two columns, overwriting any data that happen OASISDIAGI.404
cll to be in those columns. the motivation for this is that the OASISDIAGI.405
cll ocean model has two such duplicate columns when it is working OASISDIAGI.406
cll with a domain with cyclically continuous east-west boundaries OASISDIAGI.407
cll (such as a global model or a fram-type configuration). OASISDIAGI.408
cll this routine is called from transa2o. OASISDIAGI.409
cll OASISDIAGI.410
cll routine written by d.l.roberts OASISDIAGI.411
cll OASISDIAGI.412
cll model modification history from model version 3.0: OASISDIAGI.413
cll version date OASISDIAGI.414
cll OASISDIAGI.415
cll programming standard : OASISDIAGI.416
cll this routine can be compiled by cft77 but does not conform to OASISDIAGI.417
cll fortran77 standards, because of the inline comments. it follows OASISDIAGI.418
cll version 1 of documentation paper no. 3. OASISDIAGI.419
cll OASISDIAGI.420
cll logical components covered : S194 OASISDIAGI.421
CLL OASISDIAGI.422
CLL Project task : D2 OASISDIAGI.423
CLL OASISDIAGI.424
CLL External documentation: Unified Model documentation paper No: OASISDIAGI.425
CLL Version: OASISDIAGI.426
CLL OASISDIAGI.427
CLLEND -------------------------------------------------------------- OASISDIAGI.428
subroutine oasis_cyclicbc(source,target,icols,jrows) 4OASISDIAGI.429
c -------------------------------------- OASISDIAGI.430
c OASISDIAGI.431
implicit none OASISDIAGI.432
c*l OASISDIAGI.433
integer icols ! in total number of columns in field OASISDIAGI.434
integer jrows ! in number of rows in field. OASISDIAGI.435
real source(icols-2,jrows) ! in out array to be operated on. OASISDIAGI.436
real target(icols,jrows) ! in out array to be operated on. OASISDIAGI.437
real temp_grid(icols,jrows) ! temporary array to re-arrange the OASISDIAGI.438
! field. OASISDIAGI.439
c* OASISDIAGI.440
integer OASISDIAGI.441
& icolsm1, ! the penultimate column. OASISDIAGI.442
& i,j ! loop counter. OASISDIAGI.443
c OASISDIAGI.444
icolsm1 = icols - 1 OASISDIAGI.445
c OASISDIAGI.446
c Re-arrange the layout of the grid OASISDIAGI.447
c to fit their new sizes. OASISDIAGI.448
do j = 1, jrows OASISDIAGI.449
do i = 1, icols-2 OASISDIAGI.450
temp_grid(i,j) = source(i,j) OASISDIAGI.451
enddo OASISDIAGI.452
enddo OASISDIAGI.453
do j = 1, jrows OASISDIAGI.454
do i = 1, icols-2 OASISDIAGI.455
target(i,j) = temp_grid(i,j) OASISDIAGI.456
enddo OASISDIAGI.457
enddo OASISDIAGI.458
OASISDIAGI.459
C copy the first and second columns to OASISDIAGI.460
C the two last columns into the target grid. OASISDIAGI.461
do j = 1, jrows OASISDIAGI.462
target(icolsm1,j) = target(1,j) OASISDIAGI.463
target(icols,j) = target(2,j) OASISDIAGI.464
enddo OASISDIAGI.465
c OASISDIAGI.466
return OASISDIAGI.467
end OASISDIAGI.468
OASISDIAGI.469
OASISDIAGI.470
*ENDIF OASISDIAGI.471
*IF DEF,C99_1A,AND,-DEF,MPP OASISDIAGI.475
subroutine oasis_diagnostics_import( 2,17OASISDIAGI.476
*CALL ARGSIZE OASISDIAGI.477
*CALL ARGD1 OASISDIAGI.478
*CALL ARGSTS OASISDIAGI.479
*CALL ARGDUMO OASISDIAGI.480
*CALL ARGDUMA OASISDIAGI.481
*CALL ARGPTRO OASISDIAGI.482
*CALL ARGPTRA OASISDIAGI.483
& Zwork, OASISDIAGI.484
*IF DEF,ATMOS OASISDIAGI.485
& Zwork_aice_previous, OASISDIAGI.486
*ENDIF OASISDIAGI.487
& CouplingField, OASISDIAGI.488
& internal_model, OASISDIAGI.489
& icode,cmessage) OASISDIAGI.490
OASISDIAGI.491
implicit none OASISDIAGI.492
OASISDIAGI.493
C arguments type : OASISDIAGI.494
*CALL CMAXSIZE OASISDIAGI.495
*CALL CSUBMODL OASISDIAGI.496
*CALL TYPSIZE OASISDIAGI.497
*CALL TYPD1 OASISDIAGI.498
*CALL TYPSTS OASISDIAGI.499
*CALL TYPDUMO OASISDIAGI.500
*CALL TYPDUMA OASISDIAGI.501
*CALL TYPPTRO OASISDIAGI.502
*CALL TYPPTRA OASISDIAGI.503
! Coupling fields : OASISDIAGI.504
*IF DEF,OCEAN OASISDIAGI.505
real Zwork(imt*jmt) OASISDIAGI.506
*ENDIF OASISDIAGI.507
*IF DEF,ATMOS OASISDIAGI.508
real Zwork(P_FIELD) OASISDIAGI.509
real Zwork_aice_previous(p_field) OASISDIAGI.510
*ENDIF OASISDIAGI.511
integer CouplingField ! No of the current coupling field. OASISDIAGI.512
integer internal_model ! No of the current internal model. OASISDIAGI.513
integer icode ! OUT - Error return code OASISDIAGI.514
character*(*) cmessage ! OUT - Error return message OASISDIAGI.515
OASISDIAGI.516
*CALL CHSUNITS OASISDIAGI.517
*CALL CCONTROL OASISDIAGI.518
*CALL CLOOKADD OASISDIAGI.519
*CALL C_LHEAT OASISDIAGI.520
*CALL C_0_DG_C OASISDIAGI.521
*CALL C_MDI OASISDIAGI.522
*CALL CTRACERA OASISDIAGI.523
*CALL TYPOCDPT OASISDIAGI.524
OASISDIAGI.525
OASISDIAGI.526
C commons : OASISDIAGI.527
! Time status of the Unified Model. OASISDIAGI.528
*CALL CTIME OASISDIAGI.529
! common variables of the UM_OASIS section. OASISDIAGI.530
*CALL COASIS OASISDIAGI.531
OASISDIAGI.532
real OASISDIAGI.533
& aicemin ! minimum ice concentration if ice OASISDIAGI.534
! present OASISDIAGI.535
parameter (aicemin = 0.001 ) OASISDIAGI.536
OASISDIAGI.537
integer k OASISDIAGI.538
OASISDIAGI.539
! Declaration of the pointers on the atmosphere D1. OASISDIAGI.540
integer OASISDIAGI.541
& D1_Zptr_aice ! Pointer towards the coupling field in D1. OASISDIAGI.542
! These need to be stored in a static area of memory (therefore are OASISDIAGI.543
! initialized to dummy in data): OASISDIAGI.544
data OASISDIAGI.545
& D1_Zptr_aice /1/ OASISDIAGI.546
OASISDIAGI.547
icode = 0 ! error code set to nil at begining OASISDIAGI.548
! of the procedure. OASISDIAGI.549
OASISDIAGI.550
C--------------------------------------------------------------------- OASISDIAGI.551
write(nulou,*) 'entering OASIS_DIAGNOSTICS_IMPORT ...' OASISDIAGI.552
C--------------------------------------------------------------------- OASISDIAGI.553
OASISDIAGI.554
C I/ if the internal model is the UM_atmosphere: OASISDIAGI.555
if (internal_model .eq. atmos_im) then OASISDIAGI.556
*IF DEF,ATMOS OASISDIAGI.557
C OASISDIAGI.558
C*-- Sea Ice fraction : OASISDIAGI.559
C OASISDIAGI.560
if ((FieldLocator(direction,CouplingField) .eq. 'I') OASISDIAGI.561
& .and. (FieldLocator(istash,CouplingField) .eq. '00031')) OASISDIAGI.562
& then OASISDIAGI.563
C Pointer towards the coupling field in D1 OASISDIAGI.564
D1_Zptr_aice = D1_Zptr(CouplingField) OASISDIAGI.565
C Copy the field over to the D1 array while ignoring the OASISDIAGI.566
C undefined values(rmdi) of the current field: OASISDIAGI.567
do k = 1, FieldSize(CouplingField) OASISDIAGI.568
Zwork_aice_previous(k) = Zwork(k) OASISDIAGI.569
enddo OASISDIAGI.570
endif OASISDIAGI.571
C OASISDIAGI.572
C*-- Sea Surface Temperature : OASISDIAGI.573
C OASISDIAGI.574
if ((FieldLocator(direction,CouplingField) .eq. 'I') OASISDIAGI.575
& .and. (FieldLocator(istash,CouplingField) .eq. '00024')) OASISDIAGI.576
& then OASISDIAGI.577
C Unfortunately, the SST deserves a special treatment we only OASISDIAGI.578
C can deliver while importing the field within the atmosphere OASISDIAGI.579
C model. This is because the input values are meant to take OASISDIAGI.580
C into account the values of the previous timestep ; see OASISDIAGI.581
C below the comment on the computation method as it is in the OASISDIAGI.582
C current coupling system (without oasis) : OASISDIAGI.583
C OASISDIAGI.584
C `` at sea-ice points, the grid box mean surface temperature OASISDIAGI.585
c is altered in such a way that the surface temperature of OASISDIAGI.586
c the icy portion of the box is the same as it was at the end OASISDIAGI.587
c of the last atmospheric phase. however, if ice appeared OASISDIAGI.588
c during the most recent ocean phase, its temperature is OASISDIAGI.589
c initialised at the freezing point of seawater. OASISDIAGI.590
c this code uses the old values of ice concentration, which OASISDIAGI.591
c were stored during section 2 in aiceref. '' OASISDIAGI.592
!*IF DEF,SEAICE ! the update switch is undefined when in ocean mode !! OASISDIAGI.593
do k = 1, FieldSize(CouplingField) OASISDIAGI.594
if (Zwork(k) .ne. rmdi) then OASISDIAGI.595
if (D1(D1_Zptr_aice+k-1) .eq. 0.0) then OASISDIAGI.596
D1(D1_Zptr(CouplingField)+k-1) = OASISDIAGI.597
& Zwork(k) + zerodegc OASISDIAGI.598
elseif (Zwork_aice_previous(k) .ge. aicemin) then OASISDIAGI.599
D1(D1_Zptr(CouplingField)+k-1) = tfs + OASISDIAGI.600
& (D1(D1_Zptr_aice+k-1)/Zwork_aice_previous(k)) OASISDIAGI.601
& * (D1(D1_Zptr(CouplingField)+k-1) - tfs) OASISDIAGI.602
else OASISDIAGI.603
D1(D1_Zptr(CouplingField)+k-1) = tfs OASISDIAGI.604
endif OASISDIAGI.605
endif OASISDIAGI.606
enddo OASISDIAGI.607
OASISDIAGI.608
!*ELSE ! no seaice in the ocean model for the following bit of code. OASISDIAGI.609
C Copy the field over to D1 and convert from degrees C to K. OASISDIAGI.610
C Since we assume we are using the ocean model WITH the ice OASISDIAGI.611
C model, the next portion of code should be commented out: OASISDIAGI.612
c do k = 1, FieldSize(CouplingField) OASISDIAGI.613
c if (Zwork(Zwork_Zptr(CouplingField)+k-1) .ne. rmdi) then OASISDIAGI.614
c D1(D1_Zptr(CouplingField)+k-1) = OASISDIAGI.615
c & Zwork(Zwork_Zptr(CouplingField)+k-1) + zerodegc OASISDIAGI.616
c endif OASISDIAGI.617
c enddo OASISDIAGI.618
!*ENDIF OASISDIAGI.619
else OASISDIAGI.620
C Copy the field over to the D1 array while ignoring the OASISDIAGI.621
C undefined values(rmdi) of the current field : OASISDIAGI.622
do k = 1, FieldSize(CouplingField) OASISDIAGI.623
if (Zwork(k) .ne. rmdi) then OASISDIAGI.624
D1(D1_Zptr(CouplingField)+k-1) = Zwork(k) OASISDIAGI.625
endif OASISDIAGI.626
enddo OASISDIAGI.627
endif OASISDIAGI.628
OASISDIAGI.629
*ENDIF OASISDIAGI.630
C--------------------------------------------------------------------- OASISDIAGI.631
C II/ if the internal model is the UM_ocean : OASISDIAGI.632
else if (internal_model .eq. ocean_im) then OASISDIAGI.633
*IF DEF,OCEAN OASISDIAGI.634
OASISDIAGI.635
C Copy the field over to the D1 array while ignoring the OASISDIAGI.636
C undefined values(rmdi) of the current field: OASISDIAGI.637
do k = 1, FieldSize(CouplingField) OASISDIAGI.638
if (Zwork(k) .ne. rmdi) then OASISDIAGI.639
D1(D1_Zptr(CouplingField)+k-1) = Zwork(k) OASISDIAGI.640
endif OASISDIAGI.641
enddo OASISDIAGI.642
OASISDIAGI.643
C Add two columns at the end identical to the colums one and OASISDIAGI.644
C two. OASISDIAGI.645
if ((cyclic_ocean) .and. OASISDIAGI.646
& (FieldLocator(grd,CouplingField) .eq. 'T')) then OASISDIAGI.647
call oasis_cyclicbc(D1(D1_Zptr(CouplingField)), OASISDIAGI.648
& D1(D1_Zptr(CouplingField)),imt,jmt) OASISDIAGI.649
elseif ((cyclic_ocean) .and. OASISDIAGI.650
& (FieldLocator(grd,CouplingField) .eq. 'U')) then OASISDIAGI.651
call oasis_cyclicbc(D1(D1_Zptr(CouplingField)), OASISDIAGI.652
& D1(D1_Zptr(CouplingField)),imt,jmtm1) OASISDIAGI.653
endif OASISDIAGI.654
*ENDIF OASISDIAGI.655
OASISDIAGI.656
C--------------------------------------------------------------------- OASISDIAGI.657
C III/ if the internal model is any of the above, generate an OASISDIAGI.658
C error message. OASISDIAGI.659
else !! internal_model OASISDIAGI.660
icode = 1 OASISDIAGI.661
cmessage = ' OASIS : Unauthorised internal model. ' OASISDIAGI.662
endif !! internal_model OASISDIAGI.663
OASISDIAGI.664
C------------------------------------------------ OASISDIAGI.665
C Error trap. OASISDIAGI.666
999 continue OASISDIAGI.667
if(icode.ne.0) then OASISDIAGI.668
write(nulou,*) cmessage,icode OASISDIAGI.669
endif OASISDIAGI.670
write(nulou,*) "exiting OASIS_DIAGNOSTICS_IMPORT" OASISDIAGI.671
OASISDIAGI.672
return OASISDIAGI.673
end OASISDIAGI.674
OASISDIAGI.675
CLL subroutine oasis_cyclicbc -------------------------------------- OASISDIAGI.676
cll OASISDIAGI.677
cll this routine copies the first two columns of a two-dimensional OASISDIAGI.678
cll array to the last two columns, overwriting any data that happen OASISDIAGI.679
cll to be in those columns. the motivation for this is that the OASISDIAGI.680
cll ocean model has two such duplicate columns when it is working OASISDIAGI.681
cll with a domain with cyclically continuous east-west boundaries OASISDIAGI.682
cll (such as a global model or a fram-type configuration). OASISDIAGI.683
cll this routine is called from transa2o. OASISDIAGI.684
cll OASISDIAGI.685
cll routine written by d.l.roberts OASISDIAGI.686
cll OASISDIAGI.687
cll model modification history from model version 3.0: OASISDIAGI.688
cll version date OASISDIAGI.689
cll OASISDIAGI.690
cll programming standard : OASISDIAGI.691
cll this routine can be compiled by cft77 but does not conform to OASISDIAGI.692
cll fortran77 standards, because of the inline comments. it follows OASISDIAGI.693
cll version 1 of documentation paper no. 3. OASISDIAGI.694
cll OASISDIAGI.695
cll logical components covered : S194 OASISDIAGI.696
CLL OASISDIAGI.697
CLL Project task : D2 OASISDIAGI.698
CLL OASISDIAGI.699
CLL External documentation: Unified Model documentation paper No: OASISDIAGI.700
CLL Version: OASISDIAGI.701
CLL OASISDIAGI.702
CLLEND -------------------------------------------------------------- OASISDIAGI.703
subroutine oasis_cyclicbc(source,target,icols,jrows) 4OASISDIAGI.704
c -------------------------------------- OASISDIAGI.705
c OASISDIAGI.706
implicit none OASISDIAGI.707
c*l OASISDIAGI.708
integer icols ! in total number of columns in field OASISDIAGI.709
integer jrows ! in number of rows in field. OASISDIAGI.710
real source(icols-2,jrows) ! in out array to be operated on. OASISDIAGI.711
real target(icols,jrows) ! in out array to be operated on. OASISDIAGI.712
real temp_grid(icols,jrows) ! temporary array to re-arrange the OASISDIAGI.713
! field. OASISDIAGI.714
c* OASISDIAGI.715
integer OASISDIAGI.716
& icolsm1, ! the penultimate column. OASISDIAGI.717
& i,j ! loop counter. OASISDIAGI.718
c OASISDIAGI.719
icolsm1 = icols - 1 OASISDIAGI.720
c OASISDIAGI.721
c Re-arrange the layout of the grid OASISDIAGI.722
c to fit their new sizes. OASISDIAGI.723
do j = 1, jrows OASISDIAGI.724
do i = 1, icols-2 OASISDIAGI.725
temp_grid(i,j) = source(i,j) OASISDIAGI.726
enddo OASISDIAGI.727
enddo OASISDIAGI.728
do j = 1, jrows OASISDIAGI.729
do i = 1, icols-2 OASISDIAGI.730
target(i,j) = temp_grid(i,j) OASISDIAGI.731
enddo OASISDIAGI.732
enddo OASISDIAGI.733
OASISDIAGI.734
C copy the first and second columns to OASISDIAGI.735
C the two last columns into the target grid. OASISDIAGI.736
do j = 1, jrows OASISDIAGI.737
target(icolsm1,j) = target(1,j) OASISDIAGI.738
target(icols,j) = target(2,j) OASISDIAGI.739
enddo OASISDIAGI.740
c OASISDIAGI.741
return OASISDIAGI.742
end OASISDIAGI.743
OASISDIAGI.744
OASISDIAGI.745
*ENDIF OASISDIAGI.746