subroutine oasis_diagnostics( 2,57OASISDIAG.58
*IF DEF,ATMOS OASISDIAG.59
& g_p_field, OASISDIAG.60
*ENDIF OASISDIAG.61
*IF DEF,OCEAN OASISDIAG.62
& g_imtjmt, OASISDIAG.63
*ENDIF OASISDIAG.64
*CALL ARGSIZE 
OASISDIAG.65
*CALL ARGD1 OASISDIAG.66
*CALL ARGSTS OASISDIAG.67
*CALL ARGDUMO OASISDIAG.68
*CALL ARGDUMA OASISDIAG.69
*CALL ARGPTRO OASISDIAG.70
*CALL ARGPTRA OASISDIAG.71
*CALL ARGCONO OASISDIAG.72
*CALL ARGCONA OASISDIAG.73
& Zwork, OASISDIAG.74
& CouplingField, OASISDIAG.75
& internal_model, OASISDIAG.76
& icode, OASISDIAG.77
& cmessage) OASISDIAG.78
OASISDIAG.79
implicit none OASISDIAG.80
OASISDIAG.81
C arguments type : OASISDIAG.82
*IF DEF,OCEAN OASISDIAG.83
integer g_imtjmt OASISDIAG.84
*ENDIF OASISDIAG.85
*IF DEF,ATMOS OASISDIAG.86
integer g_p_field OASISDIAG.87
*ENDIF OASISDIAG.88
*CALL CMAXSIZE OASISDIAG.89
*CALL CSUBMODL OASISDIAG.90
*CALL TYPSIZE OASISDIAG.91
*CALL TYPD1 OASISDIAG.92
*CALL TYPSTS OASISDIAG.93
*CALL TYPDUMO OASISDIAG.94
*CALL TYPDUMA OASISDIAG.95
*CALL TYPPTRO OASISDIAG.96
*CALL TYPPTRA OASISDIAG.97
*CALL TYPCONO OASISDIAG.98
*CALL TYPCONA OASISDIAG.99
! Coupling fields. OASISDIAG.100
*IF DEF,OCEAN OASISDIAG.101
real Zwork(g_imtjmt) OASISDIAG.102
*ENDIF OASISDIAG.103
*IF DEF,ATMOS OASISDIAG.104
real Zwork(g_p_field) OASISDIAG.105
*ENDIF OASISDIAG.106
integer CouplingField ! No of the current coupling field. OASISDIAG.107
integer internal_model ! No of the corrent internal model. OASISDIAG.108
integer icode ! OUT - Error return code OASISDIAG.109
character*(*) cmessage ! OUT - Error return message OASISDIAG.110
OASISDIAG.111
*CALL CHSUNITS OASISDIAG.112
*CALL CCONTROL OASISDIAG.113
*CALL CLOOKADD OASISDIAG.114
*CALL C_LHEAT OASISDIAG.115
*CALL C_0_DG_C OASISDIAG.116
*CALL C_MDI OASISDIAG.117
*CALL CTRACERA OASISDIAG.118
*CALL TYPOCDPT OASISDIAG.119
*CALL PARVARS OASISDIAG.120
*CALL DECOMPTP OASISDIAG.121
*CALL DECOMPDB OASISDIAG.122
*CALL AMAXSIZE OASISDIAG.123
*CALL ATM_LSM GPB2F405.147
OASISDIAG.125
C commons : OASISDIAG.126
! Time status of the Unified Model. OASISDIAG.127
*CALL CTIME OASISDIAG.128
! common variables of the UM_OASIS section. OASISDIAG.129
*CALL COASIS OASISDIAG.130
OASISDIAG.131
OASISDIAG.132
integer OASISDIAG.133
& im_ident ! Internal Model Identifier OASISDIAG.134
& ,im_index ! Internal Model Index in Stash arrays OASISDIAG.135
OASISDIAG.136
! Declaration of the pointers on the ocean D1. OASISDIAG.137
integer OASISDIAG.138
& D1_Zptr_snow_depth ! Pointer towards the coupling field OASISDIAG.139
& ,D1_Zptr_aice ! in D1. OASISDIAG.140
& ,D1_Zptr_hice OASISDIAG.141
& ,D1_Zptr_tstar OASISDIAG.142
! These need to be stored in a static area of memory (even if they OASISDIAG.143
! are initialized as dummy) : OASISDIAG.144
data OASISDIAG.145
& D1_Zptr_snow_depth /1/ ! Pointer towards the coupling OASISDIAG.146
& ,D1_Zptr_aice /1/ ! field in D1. OASISDIAG.147
& ,D1_Zptr_hice /1/ OASISDIAG.148
& ,D1_Zptr_tstar /1/ OASISDIAG.149
OASISDIAG.150
real OASISDIAG.151
& rcmpm ! reciprocal of cm per m OASISDIAG.152
& ,conratio ! ratio of conductivities (ice/snow) OASISDIAG.153
& ,rhosnow ! density of snow in kg/m**3 OASISDIAG.154
& ,aicemin ! minimum ice concentration if ice OASISDIAG.155
! present OASISDIAG.156
parameter (conratio = 6.5656) OASISDIAG.157
parameter (rhosnow = 300.0 ) OASISDIAG.158
parameter (rcmpm = 0.01 ) OASISDIAG.159
parameter (aicemin = 0.001 ) OASISDIAG.160
OASISDIAG.161
integer ptr_field OASISDIAG.162
OASISDIAG.163
integer number_of_landpts_out OASISDIAG.164
integer info OASISDIAG.165
OASISDIAG.166
C Atmos only variables : OASISDIAG.167
*IF DEF,ATMOS OASISDIAG.168
real OASISDIAG.169
& Zworktemp1(g_p_field) ! Temp work array for field gathering. OASISDIAG.170
& ,Zworktemp2(g_p_field) ! Temp work array for field gathering. OASISDIAG.171
& ,Zworktemp3(g_p_field) ! Temp work array for field gathering. OASISDIAG.172
& ,Zworktemp4(g_p_field) ! Temp work array for field gathering. OASISDIAG.173
& ,Zworktemp5(g_p_field) ! Temp work array for field gathering. OASISDIAG.174
& ,Zworktemp6(g_p_field) ! Temp work array for field gathering. OASISDIAG.175
INTEGER OASISDIAG.176
& ocentpts(g_p_field) ! Ocean entry points index OASISDIAG.177
! Intermediate field for work space OASISDIAG.178
& ,ocentpts_local(p_field) ! local land-compressed OASISDIAG.179
& ,ocentpts_global(g_p_field) ! OASISDIAG.180
c Intermediate pre-calculated trig field for coupling: OASISDIAG.181
& ,a_cos_p_latitude(g_p_field) ! Cos(lat) on atmos p grid OASISDIAG.182
OASISDIAG.183
*ENDIF OASISDIAG.184
OASISDIAG.185
C Ocean only variables : OASISDIAG.186
*IF DEF,OCEAN OASISDIAG.187
real OASISDIAG.188
& Zwork_Diagnos(imt*jmt) ! Work array of local area of the OASISDIAG.189
! decomposition. OASISDIAG.190
real OASISDIAG.191
& Zworktemp1(g_imtjmt) ! Temp work array for field gathering. OASISDIAG.192
& ,Zworktemp2(g_imtjmt) ! Temp work array for field gathering. OASISDIAG.193
& ,Zworktemp3(g_imtjmt) ! Temp work array for field gathering. OASISDIAG.194
& ,Zworktemp4(g_imtjmt) ! Temp work array for field gathering. OASISDIAG.195
*ENDIF OASISDIAG.196
OASISDIAG.197
icode = 0 ! error code set to nil at begining OASISDIAG.198
! of the procedure. OASISDIAG.199
OASISDIAG.200
C--------------------------------------------------------------------- OASISDIAG.201
write(nulou,*) 'entering OASIS_DIAGNOSTICS ...' OASISDIAG.202
write(nulou,*) "CouplingField number", CouplingField OASISDIAG.203
C--------------------------------------------------------------------- OASISDIAG.204
OASISDIAG.205
OASISDIAG.206
C I/ if the internal model is the UM_atmosphere, generate the OASISDIAG.207
C required diagnostics. OASISDIAG.208
if (internal_model .eq. atmos_im) then OASISDIAG.209
OASISDIAG.210
*IF DEF,ATMOS OASISDIAG.211
OASISDIAG.212
im_ident = internal_model OASISDIAG.213
im_index = internal_model_index(im_ident) OASISDIAG.214
OASISDIAG.215
C OASISDIAG.216
C*-- Following the field number, gather it : OASISDIAG.217
C OASISDIAG.218
if ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.219
& .and. (FieldLocator(istash,CouplingField) .eq. '03228')) OASISDIAG.220
& then OASISDIAG.221
C OASISDIAG.222
C*-- HEAT FLUXes OASISDIAG.223
C OASISDIAG.224
C Compute the heat-flux field. OASISDIAG.225
C Gather the field from all the PE onto the gather_pe OASISDIAG.226
C processor: OASISDIAG.227
call gather_field(D1(ptr_solar), Zworktemp1, OASISDIAG.228
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.229
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.230
if(info.ne.0) then ! Check return code OASISDIAG.231
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.232
icode=1 OASISDIAG.233
go to 999 OASISDIAG.234
endif OASISDIAG.235
C Gather the field from all the PE onto the gather_pe OASISDIAG.236
C processor: OASISDIAG.237
call gather_field(D1(ptr_blue), Zworktemp2, OASISDIAG.238
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.239
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.240
if(info.ne.0) then ! Check return code OASISDIAG.241
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.242
icode=1 OASISDIAG.243
go to 999 OASISDIAG.244
endif OASISDIAG.245
C Gather the field from all the PE onto the gather_pe OASISDIAG.246
C processor: OASISDIAG.247
call gather_field(D1(ptr_longwave), Zworktemp3, OASISDIAG.248
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.249
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.250
if(info.ne.0) then ! Check return code OASISDIAG.251
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.252
icode=1 OASISDIAG.253
go to 999 OASISDIAG.254
endif OASISDIAG.255
C Gather the field from all the PE onto the gather_pe OASISDIAG.256
C processor: OASISDIAG.257
call gather_field(D1(ptr_sensible), Zworktemp4, OASISDIAG.258
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.259
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.260
if(info.ne.0) then ! Check return code OASISDIAG.261
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.262
icode=1 OASISDIAG.263
go to 999 OASISDIAG.264
endif OASISDIAG.265
C Gather the field from all the PE onto the gather_pe OASISDIAG.266
C processor: OASISDIAG.267
call gather_field(D1(ptr_evap), Zworktemp5, OASISDIAG.268
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.269
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.270
if(info.ne.0) then ! Check return code OASISDIAG.271
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.272
icode=1 OASISDIAG.273
go to 999 OASISDIAG.274
endif OASISDIAG.275
C compute the field : OASISDIAG.276
C (solar - blue + longwave - (sensible + LC * evap)) OASISDIAG.277
C 1 2 3 4 5 OASISDIAG.278
if (mype .eq. gather_pe) then OASISDIAG.279
do i = 1, FieldSize(CouplingField) OASISDIAG.280
if ( (Zworktemp1(i) .eq. rmdi) OASISDIAG.281
& .or. (Zworktemp2(i) .eq. rmdi) OASISDIAG.282
& .or. (Zworktemp3(i) .eq. rmdi) OASISDIAG.283
& .or. (Zworktemp4(i) .eq. rmdi) OASISDIAG.284
& .or. (Zworktemp5(i) .eq. rmdi) ) then OASISDIAG.285
Zwork(i) = rmdi OASISDIAG.286
else OASISDIAG.287
Zwork(i) = OASISDIAG.288
& Zworktemp1(i) OASISDIAG.289
& - Zworktemp2(i) + Zworktemp3(i) OASISDIAG.290
& - (Zworktemp4(i) + LC * Zworktemp5(i) ) OASISDIAG.291
endif OASISDIAG.292
enddo OASISDIAG.293
endif OASISDIAG.294
OASISDIAG.295
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.296
& .and. (FieldLocator(istash,CouplingField) .eq. '04203')) OASISDIAG.297
& then OASISDIAG.298
C OASISDIAG.299
C*-- PRECIPITATION MINUS EVAPORATION. OASISDIAG.300
C OASISDIAG.301
C Gather the field from all the PE onto the gather_pe OASISDIAG.302
C processor: OASISDIAG.303
call gather_field(D1(ptr_snowls), Zworktemp1, OASISDIAG.304
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.305
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.306
if(info.ne.0) then ! Check return code OASISDIAG.307
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.308
icode=1 OASISDIAG.309
go to 999 OASISDIAG.310
endif OASISDIAG.311
C Gather the field from all the PE onto the gather_pe OASISDIAG.312
C processor: OASISDIAG.313
call gather_field(D1(ptr_snowconv), Zworktemp2, OASISDIAG.314
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.315
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.316
if(info.ne.0) then ! Check return code OASISDIAG.317
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.318
icode=1 OASISDIAG.319
go to 999 OASISDIAG.320
endif OASISDIAG.321
C Gather the field from all the PE onto the gather_pe OASISDIAG.322
C processor: OASISDIAG.323
call gather_field(D1(ptr_ice), Zworktemp3, OASISDIAG.324
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.325
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.326
if(info.ne.0) then ! Check return code OASISDIAG.327
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.328
icode=1 OASISDIAG.329
go to 999 OASISDIAG.330
endif OASISDIAG.331
C Gather the field from all the PE onto the gather_pe OASISDIAG.332
C processor: OASISDIAG.333
call gather_field(D1(ptr_rainls), Zworktemp4, OASISDIAG.334
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.335
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.336
if(info.ne.0) then ! Check return code OASISDIAG.337
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.338
icode=1 OASISDIAG.339
go to 999 OASISDIAG.340
endif OASISDIAG.341
C Gather the field from all the PE onto the gather_pe OASISDIAG.342
C processor: OASISDIAG.343
call gather_field(D1(ptr_rainconv), Zworktemp5, OASISDIAG.344
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.345
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.346
if(info.ne.0) then ! Check return code OASISDIAG.347
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.348
icode=1 OASISDIAG.349
go to 999 OASISDIAG.350
endif OASISDIAG.351
C Gather the field from all the PE onto the gather_pe OASISDIAG.352
C processor: OASISDIAG.353
call gather_field(D1(ptr_evap), Zworktemp6, OASISDIAG.354
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.355
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.356
if(info.ne.0) then ! Check return code OASISDIAG.357
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.358
icode=1 OASISDIAG.359
go to 999 OASISDIAG.360
endif OASISDIAG.361
OASISDIAG.362
C Compute the precipitation-minus-evaporation field: OASISDIAG.363
C [(snowls+snowconv)*(1-aice)+rainls+rainconv-evap] OASISDIAG.364
C 1 2 3 4 5 6 OASISDIAG.365
if (mype .eq. gather_pe) then OASISDIAG.366
do i = 1, FieldSize(CouplingField) OASISDIAG.367
if ( (Zworktemp1(i) .eq. rmdi) OASISDIAG.368
& .or. (Zworktemp2(i) .eq. rmdi) OASISDIAG.369
& .or. (Zworktemp3(i) .eq. rmdi) OASISDIAG.370
& .or. (Zworktemp4(i) .eq. rmdi) OASISDIAG.371
& .or. (Zworktemp5(i) .eq. rmdi) OASISDIAG.372
& .or. (Zworktemp6(i) .eq. rmdi) ) then OASISDIAG.373
Zwork(i) = rmdi OASISDIAG.374
else OASISDIAG.375
Zwork(i) = OASISDIAG.376
& (Zworktemp1(i)+Zworktemp2(i)) OASISDIAG.377
!*IF DEF,SEAICE OASISDIAG.378
& * (1.0 - Zworktemp3(i)) OASISDIAG.379
!*ENDIF OASISDIAG.380
& + Zworktemp4(i) + Zworktemp5(i) OASISDIAG.381
& - Zworktemp6(i) OASISDIAG.382
endif OASISDIAG.383
enddo OASISDIAG.384
endif OASISDIAG.385
OASISDIAG.386
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.387
& .and. (FieldLocator(istash,CouplingField) .eq. '08205')) OASISDIAG.388
& then OASISDIAG.389
OASISDIAG.390
C OASISDIAG.391
C*-- RIVER OUTFLOW OASISDIAG.392
C OASISDIAG.393
C Gather the field from all the PE onto the gather_pe OASISDIAG.394
C processor: OASISDIAG.395
call gather_field(D1(ptr_slowrunoff), Zworktemp1, OASISDIAG.396
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.397
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.398
if(info.ne.0) then ! Check return code OASISDIAG.399
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.400
icode=1 OASISDIAG.401
go to 999 OASISDIAG.402
endif OASISDIAG.403
C Gather the field from all the PE onto the gather_pe OASISDIAG.404
C processor: OASISDIAG.405
call gather_field(D1(ptr_fastrunoff), Zworktemp2, OASISDIAG.406
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.407
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.408
if(info.ne.0) then ! Check return code OASISDIAG.409
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.410
icode=1 OASISDIAG.411
go to 999 OASISDIAG.412
endif OASISDIAG.413
OASISDIAG.414
c Compute the runoff field: OASISDIAG.415
c (slow_runoff + fastrunoff) OASISDIAG.416
c 1 2 OASISDIAG.417
if (mype .eq. gather_pe) then OASISDIAG.418
do i = 1, FieldSize(CouplingField) OASISDIAG.419
if ( (Zworktemp1(i) .eq. rmdi) OASISDIAG.420
& .or. (Zworktemp2(i) .eq. rmdi) ) then OASISDIAG.421
Zwork(i) = rmdi OASISDIAG.422
else OASISDIAG.423
Zwork(i) = OASISDIAG.424
& (Zworktemp1(i)+Zworktemp2(i)) OASISDIAG.425
& / 86400 ! daily accumulated OASISDIAG.426
! --> instantaneous (s-1) OASISDIAG.427
endif OASISDIAG.428
enddo OASISDIAG.429
endif OASISDIAG.430
OASISDIAG.431
! Expand river index compressed on land points for each PE domain OASISDIAG.432
call from_land_points(ocentpts_local,id1(ptr_ocentpts), OASISDIAG.433
& atmos_landmask_local,lasize(1)*lasize(2), OASISDIAG.434
& number_of_landpts_out) OASISDIAG.435
OASISDIAG.436
call gather_field(ocentpts_local,ocentpts_global, OASISDIAG.437
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.438
& gather_pe,gc_all_proc_group,info) OASISDIAG.439
if(info.ne.0) then ! check return code OASISDIAG.440
cmessage='oasis diag : error in gather of ocentpts' OASISDIAG.441
icode=20 OASISDIAG.442
go to 999 OASISDIAG.443
endif OASISDIAG.444
OASISDIAG.445
! Pre-calculated trig field cos(lat) on atmos p grid OASISDIAG.446
call gather_field(cos_p_latitude,a_cos_p_latitude, OASISDIAG.447
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.448
& gather_pe,gc_all_proc_group,info) OASISDIAG.449
if(info.ne.0) then ! check return code OASISDIAG.450
cmessage='oasis diag : error in gather of a_cos_p_latitude' OASISDIAG.451
icode=21 OASISDIAG.452
go to 999 OASISDIAG.453
endif OASISDIAG.454
OASISDIAG.455
c Compress river index on global domain onto land points OASISDIAG.456
if(mype.eq.gather_pe) then ! global data on single pe only OASISDIAG.457
call to_land_points(ocentpts_global,ocentpts, OASISDIAG.458
& atmos_landmask,glsize(1)*glsize(2), OASISDIAG.459
& number_of_landpts_out) OASISDIAG.460
OASISDIAG.461
C call a dedicated routine to compute the river outflow: OASISDIAG.462
call ComputeRiverOutflow( OASISDIAG.463
& Zwork, g_row_length, g_p_rows, OASISDIAG.464
& A_COS_P_LATITUDE, OASISDIAG.465
& atmos_landmask, OASISDIAG.466
& ocentpts) OASISDIAG.467
endif ! 1 pe. OASISDIAG.468
OASISDIAG.469
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.470
& .and. (FieldLocator(istash,CouplingField) .eq. '04204')) OASISDIAG.471
& then OASISDIAG.472
C OASISDIAG.473
C*-- SNOWFALL OASISDIAG.474
C OASISDIAG.475
C Gather the field from all the PE onto the gather_pe OASISDIAG.476
C processor: OASISDIAG.477
call gather_field(D1(ptr_snowls), Zworktemp1, OASISDIAG.478
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.479
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.480
if(info.ne.0) then ! Check return code OASISDIAG.481
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.482
icode=1 OASISDIAG.483
go to 999 OASISDIAG.484
endif OASISDIAG.485
C Gather the field from all the PE onto the gather_pe OASISDIAG.486
C processor: OASISDIAG.487
call gather_field(D1(ptr_snowconv), Zworktemp2, OASISDIAG.488
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.489
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.490
if(info.ne.0) then ! Check return code OASISDIAG.491
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.492
icode=1 OASISDIAG.493
go to 999 OASISDIAG.494
endif OASISDIAG.495
C Compute the snowfall field: OASISDIAG.496
C snowls + snowconv OASISDIAG.497
C 1 2 OASISDIAG.498
if (mype .eq. gather_pe) then OASISDIAG.499
do i = 1, FieldSize(CouplingField) OASISDIAG.500
if ( (Zworktemp1(i) .eq. rmdi) OASISDIAG.501
& .or. (Zworktemp2(i) .eq. rmdi) ) then OASISDIAG.502
Zwork(i) = rmdi OASISDIAG.503
else OASISDIAG.504
Zwork(i) = OASISDIAG.505
& (Zworktemp1(i)+Zworktemp2(i)) OASISDIAG.506
endif OASISDIAG.507
enddo OASISDIAG.508
endif OASISDIAG.509
OASISDIAG.510
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.511
& .and. (FieldLocator(istash,CouplingField) .eq. '03231')) OASISDIAG.512
& then OASISDIAG.513
C OASISDIAG.514
C*-- SUBLIMATION OASISDIAG.515
C OASISDIAG.516
C Gather the field from all the PE onto the gather_pe OASISDIAG.517
C processor: OASISDIAG.518
call gather_field(D1(ptr_sublimation_accumul), Zwork, OASISDIAG.519
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.520
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.521
if(info.ne.0) then ! Check return code OASISDIAG.522
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.523
icode=1 OASISDIAG.524
go to 999 OASISDIAG.525
endif OASISDIAG.526
C Compute the sublimation field: OASISDIAG.527
C (day accumulation to instantaneous) OASISDIAG.528
if (mype .eq. gather_pe) then OASISDIAG.529
do i = 1, FieldSize(CouplingField) OASISDIAG.530
if (Zwork(i) .ne. rmdi) then OASISDIAG.531
Zwork(i) = OASISDIAG.532
& (Zwork(i) / 86400 ) OASISDIAG.533
endif OASISDIAG.534
enddo OASISDIAG.535
endif OASISDIAG.536
C OASISDIAG.537
C*-- Fields which do not need any particular handling : OASISDIAG.538
C OASISDIAG.539
elseif ( (FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.540
& .and. (FieldLocator(grd,CouplingField) .eq. 'T') ) then OASISDIAG.541
C Pointer towards the coupling field in D1 OASISDIAG.542
ptr_field = D1_Zptr(CouplingField) OASISDIAG.543
C Gather the field from all the PE onto the gather_pe OASISDIAG.544
C processor: OASISDIAG.545
call gather_field(D1(ptr_field), Zwork, OASISDIAG.546
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.547
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.548
if(info.ne.0) then ! Check return code OASISDIAG.549
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.550
icode=1 OASISDIAG.551
go to 999 OASISDIAG.552
endif OASISDIAG.553
elseif ( (FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.554
& .and. (FieldLocator(grd,CouplingField) .eq. 'U') ) then OASISDIAG.555
C Pointer towards the coupling field in D1 OASISDIAG.556
ptr_field = D1_Zptr(CouplingField) OASISDIAG.557
C Gather the field from all the PE onto the gather_pe OASISDIAG.558
C processor: OASISDIAG.559
call gather_field(D1(ptr_field),Zwork, OASISDIAG.560
& lasize(1),lasize(2),glsize(1),glsize(2)-1, OASISDIAG.561
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.562
if(info.ne.0) then ! Check return code OASISDIAG.563
cmessage='oasis diagnostic : ERROR in field gathering ' OASISDIAG.564
icode=1 OASISDIAG.565
go to 999 OASISDIAG.566
endif OASISDIAG.567
endif OASISDIAG.568
OASISDIAG.569
OASISDIAG.570
*ENDIF OASISDIAG.571
OASISDIAG.572
C--------------------------------------------------------------------- OASISDIAG.573
C CouplingField/ if the internal model is the UM_ocean, OASISDIAG.574
C generate the required diagnostics. OASISDIAG.575
else if (internal_model .eq. ocean_im) then OASISDIAG.576
*IF DEF,OCEAN OASISDIAG.577
OASISDIAG.578
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! OASISDIAG.579
C Some fields need to be unpacked before they are used. OASISDIAG.580
if ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.581
& .and. (FieldLocator(istash,CouplingField) .eq. '00147')) OASISDIAG.582
& then OASISDIAG.583
C OASISDIAG.584
C*-- Ice Depth : OASISDIAG.585
c OASISDIAG.586
c Begin by converting from the grid box mean actual ice depth OASISDIAG.587
c to the equivalent ice depth averaged over thick ice. OASISDIAG.588
c this process uses the ice concentration and snow depth OASISDIAG.589
c fields. OASISDIAG.590
c Neglect sea-ice in boxes with less than the minimum OASISDIAG.591
c ice-fraction OASISDIAG.592
OASISDIAG.593
C Pointer towards the coupling field in D1 OASISDIAG.594
D1_Zptr_hice = D1_Zptr(CouplingField) OASISDIAG.595
C Gather to 1 PE. OASISDIAG.596
CALL GATHER_FIELD(D1(D1_Zptr_tstar),Zworktemp1, OASISDIAG.597
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.598
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.599
IF(info.NE.0) THEN ! Check return code OASISDIAG.600
CMESSAGE='oasis : error in gather_field' OASISDIAG.601
ICODE=41 OASISDIAG.602
GO TO 999 OASISDIAG.603
ENDIF OASISDIAG.604
C Gather to 1 PE. OASISDIAG.605
call gather_field(D1(D1_Zptr_aice),Zworktemp2, OASISDIAG.606
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.607
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.608
IF(info.NE.0) THEN ! Check return code OASISDIAG.609
CMESSAGE='oasis : error in gather_field' OASISDIAG.610
ICODE=41 OASISDIAG.611
GO TO 999 OASISDIAG.612
ENDIF OASISDIAG.613
C Gather to 1 PE. OASISDIAG.614
call gather_field(D1(D1_Zptr_hice),Zworktemp3, OASISDIAG.615
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.616
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.617
IF(info.NE.0) THEN ! Check return code OASISDIAG.618
CMESSAGE='oasis : error in gather_field' OASISDIAG.619
ICODE=41 OASISDIAG.620
GO TO 999 OASISDIAG.621
ENDIF OASISDIAG.622
C Gather to 1 PE. OASISDIAG.623
call gather_field(D1(D1_Zptr_snow_depth),Zworktemp4, OASISDIAG.624
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.625
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.626
IF(info.NE.0) THEN ! Check return code OASISDIAG.627
CMESSAGE='oasis : error in gather_field' OASISDIAG.628
ICODE=41 OASISDIAG.629
GO TO 999 OASISDIAG.630
ENDIF OASISDIAG.631
OASISDIAG.632
C Compute the field on 1 pe: OASISDIAG.633
C (hice / aice + conratio * snow_depth OASISDIAG.634
C 3 2 4 OASISDIAG.635
if (mype .eq. gather_pe) then OASISDIAG.636
do i = 1, g_imt*g_jmt OASISDIAG.637
if (Zworktemp1(i).ne.rmdi) then OASISDIAG.638
if (Zworktemp2(i).lt.aicemin) then OASISDIAG.639
Zwork(i)=0. OASISDIAG.640
else OASISDIAG.641
Zwork(i) = OASISDIAG.642
& Zworktemp3(i) OASISDIAG.643
& / Zworktemp2(i) OASISDIAG.644
& + conratio * Zworktemp4(i) OASISDIAG.645
endif OASISDIAG.646
else OASISDIAG.647
Zwork(i) = rmdi OASISDIAG.648
endif OASISDIAG.649
enddo OASISDIAG.650
C Re-arrange the field on the unwrapped grid: OASISDIAG.651
call oasis_oce_export(Zwork, OASISDIAG.652
& g_imt,g_jmt, Zwork,g_imt-2,g_jmt) OASISDIAG.653
endif ! 1 pe. OASISDIAG.654
OASISDIAG.655
C OASISDIAG.656
C*-- Snow depth (has to be multiplied by the snow density OASISDIAG.657
C*-- rhosnow): OASISDIAG.658
C OASISDIAG.659
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.660
& .and. (FieldLocator(istash,CouplingField) .eq. '00141')) OASISDIAG.661
& then OASISDIAG.662
C Pointer towards the coupling field in D1 OASISDIAG.663
D1_Zptr_snow_depth = D1_Zptr(CouplingField) OASISDIAG.664
C In Zwork : OASISDIAG.665
C Gather to 1 PE. OASISDIAG.666
write(nulou,*) "calling gather_field" OASISDIAG.667
CALL GATHER_FIELD(D1(D1_Zptr_snow_depth),Zworktemp1, OASISDIAG.668
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.669
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.670
IF(info.NE.0) THEN ! Check return code OASISDIAG.671
CMESSAGE='oasis : error in gather_field' OASISDIAG.672
ICODE=41 OASISDIAG.673
GO TO 999 OASISDIAG.674
ENDIF OASISDIAG.675
OASISDIAG.676
C Compute the field : OASISDIAG.677
C snow_detph * rhosnow OASISDIAG.678
if (mype .eq. gather_pe) then OASISDIAG.679
write(nulou,*) "rescale zworktemp1" OASISDIAG.680
write(nulou,*) "rhosnow", rhosnow OASISDIAG.681
write(nulou,*) "rmdi", rmdi OASISDIAG.682
write(nulou,*) "g_imt, g_jmt", g_imt, g_jmt OASISDIAG.683
do i = 1, g_imt*g_jmt OASISDIAG.684
ccccccc write(nulou,*)"i,Zworktemp1(i)", i,Zworktemp1(i) OASISDIAG.685
if (Zworktemp1(i) .eq. rmdi) then OASISDIAG.686
Zwork(i) = rmdi OASISDIAG.687
else OASISDIAG.688
Zwork(i) = OASISDIAG.689
& Zworktemp1(i) * rhosnow OASISDIAG.690
endif OASISDIAG.691
enddo OASISDIAG.692
C Re-arrange the field on the unwrapped grid: OASISDIAG.693
write(nulou,*) "calling oasis_oce_export" OASISDIAG.694
call oasis_oce_export(Zwork OASISDIAG.695
& ,g_imt,g_jmt, OASISDIAG.696
& Zwork,g_imt-2,g_jmt) OASISDIAG.697
endif OASISDIAG.698
write(nulou,*) "called (oasis_oce_export)" OASISDIAG.699
OASISDIAG.700
C OASISDIAG.701
C*-- Sea Ice fraction : OASISDIAG.702
C OASISDIAG.703
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.704
& .and. (FieldLocator(istash,CouplingField) .eq. '00146')) OASISDIAG.705
& then OASISDIAG.706
C Pointer towards the coupling field in D1 OASISDIAG.707
D1_Zptr_aice = D1_Zptr(CouplingField) OASISDIAG.708
C In Zwork : OASISDIAG.709
C Gather to 1 PE. OASISDIAG.710
call gather_field(D1(D1_Zptr_aice),Zworktemp1, OASISDIAG.711
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.712
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.713
if(info.ne.0) then ! Check return code OASISDIAG.714
cmessage='oasis : error in gather_field' OASISDIAG.715
icode=41 OASISDIAG.716
go to 999 OASISDIAG.717
endif OASISDIAG.718
OASISDIAG.719
C Compute the field : OASISDIAG.720
if (mype .eq. gather_pe) then OASISDIAG.721
do i = 1, g_imt*g_jmt OASISDIAG.722
Zwork(i) = Zworktemp1(i) OASISDIAG.723
enddo OASISDIAG.724
C Re-arrange the field on the unwrapped grid: OASISDIAG.725
call oasis_oce_export(Zwork OASISDIAG.726
& ,g_imt,g_jmt, OASISDIAG.727
& Zwork,g_imt-2,g_jmt) OASISDIAG.728
endif OASISDIAG.729
OASISDIAG.730
C OASISDIAG.731
C*-- Sea Surface Temperature : OASISDIAG.732
C OASISDIAG.733
C IMPORTANT : the sst is simply exported as is in the ocean OASISDIAG.734
C model (degrees C) and the real computations performed OASISDIAG.735
C at the import step in the atmosphere model. This is the OASISDIAG.736
C easyest way to cope with the blending between different OASISDIAG.737
C atmos timesteps I have found. OASISDIAG.738
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.739
& .and. (FieldLocator(istash,CouplingField) .eq. '00101')) OASISDIAG.740
& then OASISDIAG.741
C unpack the array and let it into Zwork_Diagnos : OASISDIAG.742
C Pointer towards the coupling field in D1 OASISDIAG.743
D1_Zptr_tstar = D1_Zptr(CouplingField) OASISDIAG.744
! The use of Zwork_diagnos as below implies that the OASISDIAG.745
! field will be cut in its 2 last columns : they overlap OASISDIAG.746
! the columns 1&2 and are not needed by the external model. OASISDIAG.747
if (l_ocomp) then OASISDIAG.748
CALL UNPACK(1,JMT, 1,1,JMT,KM, IMT,JMT,1, OASISDIAG.749
& O_CFI1,O_CFI2,joc_no_segs,O_CFI3,joc_no_seapts, OASISDIAG.750
& D1(joc_tracer(1,2)),Zwork_Diagnos, OASISDIAG.751
& RMDI,CYCLIC_OCEAN) OASISDIAG.752
else OASISDIAG.753
do i = 1, imt*jmt OASISDIAG.754
Zwork_Diagnos(i) = D1(joc_tracer(1,2)-i+1) OASISDIAG.755
enddo OASISDIAG.756
endif OASISDIAG.757
*IF DEF,SEAICE OASISDIAG.758
*ELSE OASISDIAG.759
*ENDIF OASISDIAG.760
C Gather to 1 PE. OASISDIAG.761
call gather_field(Zwork_Diagnos,Zworktemp1, OASISDIAG.762
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.763
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.764
if(info.ne.0) then ! Check return code OASISDIAG.765
cmessage='oasis : error in gather_field' OASISDIAG.766
icode=41 OASISDIAG.767
go to 999 OASISDIAG.768
endif OASISDIAG.769
OASISDIAG.770
C Re-arrange the field on the unwrapped grid: OASISDIAG.771
if (mype .eq. gather_pe) then OASISDIAG.772
call oasis_oce_export(Zworktemp1 OASISDIAG.773
& ,g_imt,g_jmt, OASISDIAG.774
& Zwork,g_imt-2,g_jmt) OASISDIAG.775
endif OASISDIAG.776
C OASISDIAG.777
C*-- U surface current : OASISDIAG.778
C OASISDIAG.779
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.780
& .and. (FieldLocator(istash,CouplingField).eq.'00121')) OASISDIAG.781
& then OASISDIAG.782
OASISDIAG.783
! The use of Zwork_diagnos as below implies that the OASISDIAG.784
! field will be cut in its 2 last columns : they overlap OASISDIAG.785
! the columns 1&2 and are not needed by the external model. OASISDIAG.786
if (l_ocomp) then OASISDIAG.787
CALL UNPACK(1,JMT, 1,1,JMT,KM, IMT,JMT,1, OASISDIAG.788
& O_CFI1,O_CFI2,joc_no_segs,O_CFI3,joc_no_seapts, OASISDIAG.789
& D1(joc_u(2)),Zwork_Diagnos, OASISDIAG.790
& RMDI,CYCLIC_OCEAN) OASISDIAG.791
else OASISDIAG.792
do i = 1, imt*jmt OASISDIAG.793
Zwork_Diagnos(i) = D1(joc_u(2)-i+1) OASISDIAG.794
enddo OASISDIAG.795
endif OASISDIAG.796
C Gather to 1 PE. OASISDIAG.797
call gather_field(Zwork_Diagnos,Zworktemp1, OASISDIAG.798
& lasize(1),lasize(2),glsize(1),glsize(2)-1, OASISDIAG.799
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.800
if(info.ne.0) then ! Check return code OASISDIAG.801
cmessage='oasis : error in gather_field' OASISDIAG.802
icode=41 OASISDIAG.803
go to 999 OASISDIAG.804
endif OASISDIAG.805
OASISDIAG.806
C Rescale surface currents from ocean (cm/s) to atmosphere OASISDIAG.807
C (m/s) units OASISDIAG.808
if (mype .eq. gather_pe) then OASISDIAG.809
do i = 1, g_imt*(g_jmt-1) OASISDIAG.810
if (Zworktemp1(i).NE.RMDI) then OASISDIAG.811
Zwork(i) = OASISDIAG.812
& Zworktemp1(i) * RCMPM OASISDIAG.813
else OASISDIAG.814
Zwork(i) = rmdi OASISDIAG.815
endif OASISDIAG.816
enddo OASISDIAG.817
C Re-arrange the field on the unwrapped grid: OASISDIAG.818
call oasis_oce_export(Zwork OASISDIAG.819
& ,g_imt,g_jmt-1, OASISDIAG.820
& Zwork,g_imt-2,g_jmt-1) OASISDIAG.821
endif ! 1 PE. OASISDIAG.822
C OASISDIAG.823
C*-- V Surface Current : OASISDIAG.824
C OASISDIAG.825
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.826
& .and. (FieldLocator(istash,CouplingField).eq.'00122')) OASISDIAG.827
& then OASISDIAG.828
! The use of Zwork_diagnos asa below implies that the OASISDIAG.829
! field will be cut in its 2 last columns : they overlap OASISDIAG.830
! the columns 1&2 and are not needed by the external model. OASISDIAG.831
if (l_ocomp) then OASISDIAG.832
CALL UNPACK(1,JMT, 1,1,JMT,KM, IMT,JMT,1, OASISDIAG.833
& O_CF I1, O_CFI2,joc_no_segs,O_CFI3,joc_no_seapts, OASISDIAG.834
& D1(joc_v(2)),Zwork_Diagnos, OASISDIAG.835
& RMDI,CYCLIC_OCEAN) OASISDIAG.836
else OASISDIAG.837
do i = 1, imt*jmt OASISDIAG.838
Zwork_Diagnos(i) = D1(joc_v(2)-i+1) OASISDIAG.839
enddo OASISDIAG.840
endif OASISDIAG.841
OASISDIAG.842
C Gather to 1 PE. OASISDIAG.843
call gather_field(Zwork_Diagnos,Zworktemp1, OASISDIAG.844
& lasize(1),lasize(2),glsize(1),glsize(2)-1, OASISDIAG.845
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.846
if(info.ne.0) then ! Check return code OASISDIAG.847
cmessage='oasis : error in gather_field' OASISDIAG.848
icode=41 OASISDIAG.849
go to 999 OASISDIAG.850
endif OASISDIAG.851
OASISDIAG.852
C Rescale surface currents from ocean (cm/s) to atmosphere OASISDIAG.853
C (m/s) units OASISDIAG.854
if (mype .eq. gather_pe) then OASISDIAG.855
do i = 1, g_imt*(g_jmt-1) OASISDIAG.856
if (Zworktemp1(i).NE.RMDI) then OASISDIAG.857
Zwork(i) = OASISDIAG.858
& Zworktemp1(i) * RCMPM OASISDIAG.859
else OASISDIAG.860
Zwork(i) = rmdi OASISDIAG.861
endif OASISDIAG.862
enddo OASISDIAG.863
OASISDIAG.864
C Re-arrange the field on the unwrapped grid: OASISDIAG.865
call oasis_oce_export(Zwork OASISDIAG.866
& ,g_imt,g_jmt-1, OASISDIAG.867
& Zwork,g_imt-2,g_jmt-1) OASISDIAG.868
endif ! 1 PE. OASISDIAG.869
C OASISDIAG.870
C*-- Fields which to not need any particular handling (U grid): OASISDIAG.871
C OASISDIAG.872
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.873
& .and. (FieldLocator(grd,CouplingField) .eq. 'U')) OASISDIAG.874
& then OASISDIAG.875
C Pointer towards the coupling field in D1 OASISDIAG.876
ptr_field = D1_Zptr(CouplingField) OASISDIAG.877
OASISDIAG.878
C Gather to 1 PE. OASISDIAG.879
call gather_field(D1(ptr_field),Zwork, OASISDIAG.880
& lasize(1),lasize(2),glsize(1),glsize(2)-1, OASISDIAG.881
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.882
if(info.ne.0) then ! Check return code OASISDIAG.883
cmessage='oasis : error in gather_field' OASISDIAG.884
icode=41 OASISDIAG.885
go to 999 OASISDIAG.886
endif OASISDIAG.887
OASISDIAG.888
if (mype .eq. gather_pe) then OASISDIAG.889
C Re-arrange the field on the unwrapped grid: OASISDIAG.890
call oasis_oce_export(Zwork OASISDIAG.891
& ,g_imt,g_jmt-1, OASISDIAG.892
& Zwork,g_imt-2,g_jmt-1) OASISDIAG.893
endif ! 1 pe. OASISDIAG.894
C OASISDIAG.895
C*-- Fields which to not need any particular handling (T grid): OASISDIAG.896
C OASISDIAG.897
OASISDIAG.898
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.899
& .and. (FieldLocator(grd,CouplingField) .eq. 'T')) OASISDIAG.900
& then OASISDIAG.901
C Pointer towards the coupling field in D1 OASISDIAG.902
ptr_field = D1_Zptr(CouplingField) OASISDIAG.903
C Gather to 1 PE. OASISDIAG.904
call gather_field(D1(ptr_field), Zwork, OASISDIAG.905
& lasize(1),lasize(2),glsize(1),glsize(2), OASISDIAG.906
& gather_pe,GC_ALL_PROC_GROUP,info) OASISDIAG.907
if(info.ne.0) then ! Check return code OASISDIAG.908
cmessage='oasis : error in gather_field' OASISDIAG.909
icode=41 OASISDIAG.910
go to 999 OASISDIAG.911
endif OASISDIAG.912
OASISDIAG.913
C Re-arrange the field on the unwrapped grid: OASISDIAG.914
if (mype .eq. gather_pe) then OASISDIAG.915
call oasis_oce_export(Zwork OASISDIAG.916
& ,g_imt,g_jmt, OASISDIAG.917
& Zwork,g_imt-2,g_jmt) OASISDIAG.918
endif OASISDIAG.919
endif OASISDIAG.920
OASISDIAG.921
OASISDIAG.922
OASISDIAG.923
*ENDIF OASISDIAG.924
C--------------------------------------------------------------------- OASISDIAG.925
C IIII/ if the internal model is any of the above, generate an OASISDIAG.926
C error message OASISDIAG.927
else !! internal_model OASISDIAG.928
icode = 1 OASISDIAG.929
cmessage = ' OASIS : Unauthorised internal model. ' OASISDIAG.930
endif !! internal_model OASISDIAG.931
OASISDIAG.932
C------------------------------------------------ OASISDIAG.933
C Error trap. OASISDIAG.934
999 continue OASISDIAG.935
if (icode.ne.0) then OASISDIAG.936
write(nulou,*) cmessage,icode OASISDIAG.937
endif OASISDIAG.938
write(nulou,*) "exiting OASIS_DIAGNOSTICS" OASISDIAG.939
OASISDIAG.940
return OASISDIAG.941
end OASISDIAG.942
OASISDIAG.943
C This routine is to deal with the wrapped around grid of the OASISDIAG.944
C ocean; the source grid is copied into the target grid which OASISDIAG.945
C happen to be smaller ; in the process, the last 2 columns of OASISDIAG.946
C the source grid are left over. OASISDIAG.947
subroutine oasis_oce_export(source,is,js,target,it,jt) 16OASISDIAG.948
integer is,js OASISDIAG.949
real source(is,js) OASISDIAG.950
integer it,jt OASISDIAG.951
real target (it,jt) OASISDIAG.952
integer i,j OASISDIAG.953
OASISDIAG.954
do j = 1, jt OASISDIAG.955
do i = 1, it OASISDIAG.956
target(i,j) = source(i,j) OASISDIAG.957
enddo OASISDIAG.958
enddo OASISDIAG.959
OASISDIAG.960
return OASISDIAG.961
end OASISDIAG.962
OASISDIAG.963
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OASISDIAG.964
C RIVER OUTFLOW OASISDIAG.965
c sum the runoff for each ocean entry point (k,l) :- OASISDIAG.966
c for every land point (i,j) get the coordinates of the ocean OASISDIAG.967
c entry point (k,l) from array ocentpts and add the runoff for OASISDIAG.968
c point (i,j) to point (k,l) - multiply by the ratio of areas of OASISDIAG.969
c source to target gridbox in forming sum; this gives a mass flux OASISDIAG.970
c per unit area. OASISDIAG.971
subroutine ComputeRiverOutflow( 2OASISDIAG.972
& runoffinout, icols, jrows, OASISDIAG.973
& a_COS_P_LATITUDE, OASISDIAG.974
& amasktp, OASISDIAG.975
& ocentpts) OASISDIAG.976
real runoffinout(icols,jrows) OASISDIAG.977
integer icols, jrows OASISDIAG.978
logical amasktp(icols, jrows) OASISDIAG.979
integer ocentpts(icols*jrows) OASISDIAG.980
real A_COS_P_LATITUDE(ICOLS,JROWS) ! IN COSINE OF LATITUDE AT P OASISDIAG.981
! POINTS OASISDIAG.982
OASISDIAG.983
C local variables : OASISDIAG.984
real worka(icols, jrows) OASISDIAG.985
integer landpt OASISDIAG.986
integer i,j,k,l OASISDIAG.987
OASISDIAG.988
do j=1,jrows OASISDIAG.989
do i=1,icols OASISDIAG.990
worka(i,j)=0.0 OASISDIAG.991
enddo OASISDIAG.992
enddo OASISDIAG.993
landpt=0 OASISDIAG.994
do j=1,jrows OASISDIAG.995
do i=1,icols OASISDIAG.996
if (amasktp(i,j)) then OASISDIAG.997
landpt=landpt+1 OASISDIAG.998
k=ocentpts(landpt)/100000 OASISDIAG.999
l=mod(ocentpts(landpt),100000) OASISDIAG.1000
worka(k,l)=worka(k,l)+runoffinout(i,j)* OASISDIAG.1001
& a_cos_p_latitude(i,j)/a_cos_p_latitude(k,l) OASISDIAG.1002
endif OASISDIAG.1003
enddo OASISDIAG.1004
enddo OASISDIAG.1005
C copy back the quantities obtained in worka to runoffinout. OASISDIAG.1006
do j=1,jrows OASISDIAG.1007
do i=1,icols OASISDIAG.1008
runoffinout(i,j) = worka(i,j) OASISDIAG.1009
enddo OASISDIAG.1010
enddo OASISDIAG.1011
return OASISDIAG.1012
end OASISDIAG.1013
OASISDIAG.1014
*ENDIF OASISDIAG.1015
*IF DEF,C99_1A,AND,-DEF,MPP OASISDIAG.1019
subroutine oasis_diagnostics( 2,57OASISDIAG.1020
*CALL ARGSIZE OASISDIAG.1021
*CALL ARGD1 OASISDIAG.1022
*CALL ARGSTS OASISDIAG.1023
*CALL ARGDUMO OASISDIAG.1024
*CALL ARGDUMA OASISDIAG.1025
*CALL ARGPTRO OASISDIAG.1026
*CALL ARGPTRA OASISDIAG.1027
*CALL ARGCONO OASISDIAG.1028
*CALL ARGCONA OASISDIAG.1029
& Zwork, OASISDIAG.1030
& CouplingField, OASISDIAG.1031
& internal_model, OASISDIAG.1032
& icode,cmessage) OASISDIAG.1033
OASISDIAG.1034
implicit none OASISDIAG.1035
OASISDIAG.1036
C arguments type : OASISDIAG.1037
*CALL CMAXSIZE OASISDIAG.1038
*CALL CSUBMODL OASISDIAG.1039
*CALL TYPSIZE OASISDIAG.1040
*CALL TYPD1 OASISDIAG.1041
*CALL TYPSTS OASISDIAG.1042
*CALL TYPDUMO OASISDIAG.1043
*CALL TYPDUMA OASISDIAG.1044
*CALL TYPPTRO OASISDIAG.1045
*CALL TYPPTRA OASISDIAG.1046
*CALL TYPCONO OASISDIAG.1047
*CALL TYPCONA OASISDIAG.1048
! Coupling fields. OASISDIAG.1049
*IF DEF,OCEAN OASISDIAG.1050
real Zwork(imt*jmt) OASISDIAG.1051
*ENDIF OASISDIAG.1052
*IF DEF,ATMOS OASISDIAG.1053
real Zwork(P_FIELD) OASISDIAG.1054
*ENDIF OASISDIAG.1055
integer CouplingField ! No of the current coupling field. OASISDIAG.1056
integer internal_model ! No of the corrent internal model. OASISDIAG.1057
integer icode ! OUT - Error return code OASISDIAG.1058
character*(*) cmessage ! OUT - Error return message OASISDIAG.1059
OASISDIAG.1060
*CALL CHSUNITS OASISDIAG.1061
*CALL CCONTROL OASISDIAG.1062
*CALL CLOOKADD OASISDIAG.1063
*CALL C_LHEAT OASISDIAG.1064
*CALL C_0_DG_C OASISDIAG.1065
*CALL C_MDI OASISDIAG.1066
*CALL CTRACERA OASISDIAG.1067
*CALL TYPOCDPT OASISDIAG.1068
OASISDIAG.1069
OASISDIAG.1070
C commons : OASISDIAG.1071
! Time status of the Unified Model. OASISDIAG.1072
*CALL CTIME OASISDIAG.1073
! common variables of the UM_OASIS section. OASISDIAG.1074
*CALL COASIS OASISDIAG.1075
OASISDIAG.1076
OASISDIAG.1077
integer OASISDIAG.1078
& im_ident ! Internal Model Identifier OASISDIAG.1079
& ,im_index ! Internal Model Index in Stash arrays OASISDIAG.1080
OASISDIAG.1081
OASISDIAG.1082
! Declaration of the pointers on the ocean D1. OASISDIAG.1083
integer OASISDIAG.1084
& D1_Zptr_snow_depth ! Pointer towards the coupling field OASISDIAG.1085
& ,D1_Zptr_aice ! in D1. OASISDIAG.1086
& ,D1_Zptr_hice OASISDIAG.1087
& ,D1_Zptr_tstar OASISDIAG.1088
! These need to be stored in a static area of memory (even if they OASISDIAG.1089
! are initialized as dummy) : OASISDIAG.1090
data OASISDIAG.1091
& D1_Zptr_snow_depth /1/ ! Pointer towards the coupling OASISDIAG.1092
& ,D1_Zptr_aice /1/ ! field in D1. OASISDIAG.1093
& ,D1_Zptr_hice /1/ OASISDIAG.1094
& ,D1_Zptr_tstar /1/ OASISDIAG.1095
OASISDIAG.1096
real OASISDIAG.1097
& rcmpm ! reciprocal of cm per m OASISDIAG.1098
& ,conratio ! ratio of conductivities (ice/snow) OASISDIAG.1099
& ,rhosnow ! density of snow in kg/m**3 OASISDIAG.1100
& ,aicemin ! minimum ice concentration if ice OASISDIAG.1101
! present OASISDIAG.1102
parameter (conratio = 6.5656) OASISDIAG.1103
parameter (rhosnow = 300.0 ) OASISDIAG.1104
parameter (rcmpm = 0.01 ) OASISDIAG.1105
parameter (aicemin = 0.001 ) OASISDIAG.1106
OASISDIAG.1107
integer ptr_field OASISDIAG.1108
OASISDIAG.1109
C Ocean only variables : OASISDIAG.1110
*IF DEF,OCEAN OASISDIAG.1111
real OASISDIAG.1112
& Zwork_Diagnos(imt*jmt) ! Work array OASISDIAG.1113
*ENDIF OASISDIAG.1114
OASISDIAG.1115
icode = 0 ! error code set to nil at begining OASISDIAG.1116
! of the procedure. OASISDIAG.1117
OASISDIAG.1118
C--------------------------------------------------------------------- OASISDIAG.1119
write(nulou,*) 'entering OASIS_DIAGNOSTICS ...' OASISDIAG.1120
C--------------------------------------------------------------------- OASISDIAG.1121
OASISDIAG.1122
OASISDIAG.1123
C I/ if the internal model is the UM_atmosphere, generate the OASISDIAG.1124
C required diagnostics. OASISDIAG.1125
if (internal_model .eq. atmos_im) then OASISDIAG.1126
OASISDIAG.1127
*IF DEF,ATMOS OASISDIAG.1128
OASISDIAG.1129
im_ident = internal_model OASISDIAG.1130
im_index = internal_model_index(im_ident) OASISDIAG.1131
OASISDIAG.1132
C OASISDIAG.1133
C*-- Following the field number, gather it : OASISDIAG.1134
C OASISDIAG.1135
if ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1136
& .and. (FieldLocator(istash,CouplingField) .eq. '03228')) OASISDIAG.1137
& then OASISDIAG.1138
C OASISDIAG.1139
C*-- HEAT FLUXes OASISDIAG.1140
C OASISDIAG.1141
C Compute the heat-flux field. OASISDIAG.1142
do i = 1, FieldSize(CouplingField) OASISDIAG.1143
if ( (D1(ptr_solar-1+i) .eq. rmdi) OASISDIAG.1144
& .or. (D1(ptr_blue-1+i) .eq. rmdi) OASISDIAG.1145
& .or. (D1(ptr_longwave-1+i) .eq. rmdi) OASISDIAG.1146
& .or. (D1(ptr_sensible-1+i) .eq. rmdi) OASISDIAG.1147
& .or. (D1(ptr_evap-1+i) .eq. rmdi) ) then OASISDIAG.1148
Zwork(i) = rmdi OASISDIAG.1149
else OASISDIAG.1150
Zwork(i) = OASISDIAG.1151
& D1(ptr_solar-1+i) OASISDIAG.1152
& - D1(ptr_blue-1+i) + D1(ptr_longwave-1+i) OASISDIAG.1153
& - (D1(ptr_sensible-1+i) + LC * D1(ptr_evap-1+i) ) OASISDIAG.1154
endif OASISDIAG.1155
enddo OASISDIAG.1156
OASISDIAG.1157
OASISDIAG.1158
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1159
& .and. (FieldLocator(istash,CouplingField) .eq. '04203')) OASISDIAG.1160
& then OASISDIAG.1161
OASISDIAG.1162
C OASISDIAG.1163
C*-- PRECIPITATION MINUS EVAPORATION. OASISDIAG.1164
C OASISDIAG.1165
C Compute the precipitation-minus-evaporation field: OASISDIAG.1166
do i = 1, FieldSize(CouplingField) OASISDIAG.1167
OASISDIAG.1168
if ( (D1(ptr_snowls-1+i) .eq. rmdi) OASISDIAG.1169
& .or. (D1(ptr_snowconv-1+i) .eq. rmdi) OASISDIAG.1170
& .or. (D1(ptr_ice-1+i) .eq. rmdi) OASISDIAG.1171
& .or. (D1(ptr_rainls-1+i) .eq. rmdi) OASISDIAG.1172
& .or. (D1(ptr_rainconv-1+i) .eq. rmdi) OASISDIAG.1173
& .or. (D1(ptr_evap-1+i) .eq. rmdi)) then OASISDIAG.1174
Zwork(i) = rmdi OASISDIAG.1175
else OASISDIAG.1176
Zwork(i) = OASISDIAG.1177
& (D1(ptr_snowls-1+i)+D1(ptr_snowconv-1+i)) OASISDIAG.1178
!*IF DEF,SEAICE OASISDIAG.1179
& * (1.0 - D1(ptr_ice-1+i)) OASISDIAG.1180
!*ENDIF OASISDIAG.1181
& + D1(ptr_rainls-1+i) + D1(ptr_rainconv-1+i) OASISDIAG.1182
& - D1(ptr_evap-1+i) OASISDIAG.1183
endif OASISDIAG.1184
enddo OASISDIAG.1185
OASISDIAG.1186
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1187
& .and. (FieldLocator(istash,CouplingField) .eq. '08205')) OASISDIAG.1188
& then OASISDIAG.1189
OASISDIAG.1190
C OASISDIAG.1191
C*-- RIVER OUTFLOW OASISDIAG.1192
C OASISDIAG.1193
C Compute the runoff field: OASISDIAG.1194
do i = 1, FieldSize(CouplingField) OASISDIAG.1195
if ( (D1(ptr_slowrunoff-1+i) .eq. rmdi) OASISDIAG.1196
& .or. (D1(ptr_fastrunoff-1+i) .eq. rmdi)) then OASISDIAG.1197
Zwork(i) = rmdi OASISDIAG.1198
else OASISDIAG.1199
Zwork(i) = OASISDIAG.1200
& (D1(ptr_slowrunoff-1+i)+D1(ptr_fastrunoff-1+i)) OASISDIAG.1201
& / 86400 ! daily accumulated OASISDIAG.1202
! --> instantaneous (s-1) OASISDIAG.1203
endif OASISDIAG.1204
enddo OASISDIAG.1205
OASISDIAG.1206
C call a dedicated routine to compute the river outflow: OASISDIAG.1207
call ComputeRiverOutflow( OASISDIAG.1208
& Zwork, row_length, p_rows, OASISDIAG.1209
& COS_P_LATITUDE, OASISDIAG.1210
& LD1(JLAND), OASISDIAG.1211
& ID1(ptr_ocentpts)) OASISDIAG.1212
OASISDIAG.1213
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1214
& .and. (FieldLocator(istash,CouplingField) .eq. '04204')) OASISDIAG.1215
& then OASISDIAG.1216
C OASISDIAG.1217
C*-- SNOWFALL OASISDIAG.1218
C OASISDIAG.1219
C Compute the snowfall field: OASISDIAG.1220
do i = 1, FieldSize(CouplingField) OASISDIAG.1221
if ( (D1(ptr_snowls-1+i) .eq. rmdi) OASISDIAG.1222
& .or. (D1(ptr_snowconv-1+i) .eq. rmdi)) then OASISDIAG.1223
Zwork(i) = rmdi OASISDIAG.1224
else OASISDIAG.1225
Zwork(i) = OASISDIAG.1226
& (D1(ptr_snowls-1+i)+D1(ptr_snowconv-1+i)) OASISDIAG.1227
endif OASISDIAG.1228
enddo OASISDIAG.1229
OASISDIAG.1230
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1231
& .and. (FieldLocator(istash,CouplingField) .eq. '03231')) OASISDIAG.1232
& then OASISDIAG.1233
C OASISDIAG.1234
C*-- SUBLIMATION OASISDIAG.1235
C OASISDIAG.1236
!C target pointer in atm D1 (as today set as stash 00158): OASISDIAG.1237
! ptr_sublimation_inst = si(159, 0, im_index) OASISDIAG.1238
C Compute the snowfall field: OASISDIAG.1239
do i = 1, FieldSize(CouplingField) OASISDIAG.1240
if (D1(ptr_sublimation_accumul-1+i) .eq. rmdi) then OASISDIAG.1241
Zwork(i) = rmdi OASISDIAG.1242
else OASISDIAG.1243
Zwork(i) = OASISDIAG.1244
& (D1(ptr_sublimation_accumul-1+i) / 86400 ) OASISDIAG.1245
endif OASISDIAG.1246
enddo OASISDIAG.1247
OASISDIAG.1248
C OASISDIAG.1249
C*-- Fields which to not need any particular handling : OASISDIAG.1250
C OASISDIAG.1251
elseif (FieldLocator(direction,CouplingField) .eq. 'E') then OASISDIAG.1252
C Pointer towards the coupling field in D1 OASISDIAG.1253
ptr_field = D1_Zptr(CouplingField) OASISDIAG.1254
C Compute the field: OASISDIAG.1255
do i = 1, FieldSize(CouplingField) OASISDIAG.1256
if ( D1(ptr_field-1+i) .eq. rmdi) then OASISDIAG.1257
Zwork(i) = rmdi OASISDIAG.1258
else OASISDIAG.1259
Zwork(i) = OASISDIAG.1260
& D1(ptr_field-1+i) OASISDIAG.1261
endif OASISDIAG.1262
enddo OASISDIAG.1263
endif OASISDIAG.1264
OASISDIAG.1265
*ENDIF OASISDIAG.1266
OASISDIAG.1267
C--------------------------------------------------------------------- OASISDIAG.1268
C CouplingField/ if the internal model is the UM_ocean, OASISDIAG.1269
C generate the required diagnostics. OASISDIAG.1270
else if (internal_model .eq. ocean_im) then OASISDIAG.1271
*IF DEF,OCEAN OASISDIAG.1272
OASISDIAG.1273
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! OASISDIAG.1274
C Some fields need to be unpacked before they are used. OASISDIAG.1275
OASISDIAG.1276
if ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1277
& .and. (FieldLocator(istash,CouplingField) .eq. '00147')) OASISDIAG.1278
& then OASISDIAG.1279
OASISDIAG.1280
C OASISDIAG.1281
C*-- Ice Depth : OASISDIAG.1282
c OASISDIAG.1283
c Begin by converting from the grid box mean actual ice depth OASISDIAG.1284
c to the equivalent ice depth averaged over thick ice. OASISDIAG.1285
c this process uses the ice concentration and snow depth OASISDIAG.1286
c fields. OASISDIAG.1287
c Neglect sea-ice in boxes with less than the minimum ice OASISDIAG.1288
c fraction OASISDIAG.1289
OASISDIAG.1290
C Pointer towards the coupling field in D1 OASISDIAG.1291
D1_Zptr_hice = D1_Zptr(CouplingField) OASISDIAG.1292
OASISDIAG.1293
do i = 1,imt*jmt OASISDIAG.1294
if (D1(D1_Zptr_tstar-1+i).ne.rmdi) then OASISDIAG.1295
if (D1(D1_Zptr_aice-1+i).lt.aicemin) then OASISDIAG.1296
Zwork(i)=0. OASISDIAG.1297
else OASISDIAG.1298
Zwork(i) = OASISDIAG.1299
& D1(D1_Zptr_hice-1+i) OASISDIAG.1300
& / D1(D1_Zptr_aice-1+i) OASISDIAG.1301
& + conratio * D1(D1_Zptr_snow_depth-1+i) OASISDIAG.1302
endif OASISDIAG.1303
else OASISDIAG.1304
Zwork(i) = rmdi OASISDIAG.1305
endif OASISDIAG.1306
enddo OASISDIAG.1307
C Re-arrange the field on the unwrapped grid: OASISDIAG.1308
call oasis_oce_export(Zwork, OASISDIAG.1309
& imt,jmt, Zwork,imt-2,jmt) OASISDIAG.1310
OASISDIAG.1311
OASISDIAG.1312
C OASISDIAG.1313
C*-- Snow depth (has to be multiplied by the snow density OASISDIAG.1314
C*-- rhosnow): OASISDIAG.1315
C OASISDIAG.1316
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1317
& .and. (FieldLocator(istash,CouplingField) .eq. '00141')) OASISDIAG.1318
& then OASISDIAG.1319
C Pointer towards the coupling field in D1 OASISDIAG.1320
D1_Zptr_snow_depth = D1_Zptr(CouplingField) OASISDIAG.1321
do i = 1, imt*jmt OASISDIAG.1322
if (D1(D1_Zptr_snow_depth-1+i) .eq. rmdi) then OASISDIAG.1323
Zwork(i) = rmdi OASISDIAG.1324
else OASISDIAG.1325
Zwork(i) = OASISDIAG.1326
& D1(D1_Zptr_snow_depth-1+i) * rhosnow OASISDIAG.1327
endif OASISDIAG.1328
enddo OASISDIAG.1329
C Re-arrange the field on the unwrapped grid: OASISDIAG.1330
call oasis_oce_export(Zwork OASISDIAG.1331
& ,imt,jmt, OASISDIAG.1332
& Zwork,imt-2,jmt) OASISDIAG.1333
OASISDIAG.1334
C OASISDIAG.1335
C*-- Sea Ice fraction : OASISDIAG.1336
C OASISDIAG.1337
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1338
& .and. (FieldLocator(istash,CouplingField) .eq. '00146')) OASISDIAG.1339
& then OASISDIAG.1340
C Pointer towards the coupling field in D1 OASISDIAG.1341
D1_Zptr_aice = D1_Zptr(CouplingField) OASISDIAG.1342
C Compute the field : OASISDIAG.1343
do i = 1, imt*jmt OASISDIAG.1344
Zwork(i) = OASISDIAG.1345
& D1(D1_Zptr_aice-1+i) OASISDIAG.1346
enddo OASISDIAG.1347
C Re-arrange the field on the unwrapped grid: OASISDIAG.1348
call oasis_oce_export(Zwork OASISDIAG.1349
& ,imt,jmt, OASISDIAG.1350
& Zwork,imt-2,jmt) OASISDIAG.1351
OASISDIAG.1352
C OASISDIAG.1353
C*-- Sea Surface Temperature : OASISDIAG.1354
C OASISDIAG.1355
C IMPORTANT : the sst is simply exported as is in the ocean OASISDIAG.1356
C model (degrees C) and the real computations performed OASISDIAG.1357
C at the import step in the atmosphere model. This is the OASISDIAG.1358
C simplest way to cope with the blending between different OASISDIAG.1359
C atmos timesteps I have found. OASISDIAG.1360
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1361
& .and. (FieldLocator(istash,CouplingField) .eq. '00101')) OASISDIAG.1362
& then OASISDIAG.1363
C unpack the array and let it into Zwork_Diagnos : OASISDIAG.1364
C Pointer towards the coupling field in D1 OASISDIAG.1365
D1_Zptr_tstar = D1_Zptr(CouplingField) OASISDIAG.1366
! The use of Zwork_diagnos as below implies that the OASISDIAG.1367
! field will be cut in its 2 last columns : they overlap OASISDIAG.1368
! the columns 1&2 and are not needed by the external model. OASISDIAG.1369
CALL UNPACK(1,JMT, 1,1,JMT,KM, IMT,JMT,1, OASISDIAG.1370
& O_CFI1,O_CFI2,joc_no_segs,O_CFI3,joc_no_seapts, OASISDIAG.1371
& D1(joc_tracer(1,2)),Zwork_Diagnos, OASISDIAG.1372
& RMDI,CYCLIC_OCEAN) OASISDIAG.1373
*IF DEF,SEAICE OASISDIAG.1374
OASISDIAG.1375
*ELSE OASISDIAG.1376
OASISDIAG.1377
*ENDIF OASISDIAG.1378
OASISDIAG.1379
C Re-arrange the field on the unwrapped grid: OASISDIAG.1380
call oasis_oce_export(Zwork_Diagnos OASISDIAG.1381
& ,imt,jmt, OASISDIAG.1382
& Zwork,imt-2,jmt) OASISDIAG.1383
OASISDIAG.1384
C OASISDIAG.1385
C*-- U surface current : OASISDIAG.1386
C OASISDIAG.1387
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1388
& .and. (FieldLocator(istash,CouplingField).eq.'00121')) OASISDIAG.1389
& then OASISDIAG.1390
OASISDIAG.1391
! The use of Zwork_diagnos as below implies that the OASISDIAG.1392
! field will be cut in its 2 last columns : they overlap OASISDIAG.1393
! the columns 1&2 and are not needed by the external model. OASISDIAG.1394
CALL UNPACK(1,JMT, 1,1,JMT,KM, IMT,JMT,1, OASISDIAG.1395
& O_CFI1,O_CFI2,joc_no_segs,O_CFI3,joc_no_seapts, OASISDIAG.1396
& D1(joc_u(2)),Zwork_Diagnos, OASISDIAG.1397
& RMDI,CYCLIC_OCEAN) OASISDIAG.1398
C Rescale surface currents from ocean (cm/s) to atmosphere OASISDIAG.1399
C (m/s) units OASISDIAG.1400
do i = 1, imt*(jmt-1) OASISDIAG.1401
if (Zwork_Diagnos(i).NE.RMDI) then OASISDIAG.1402
Zwork(i) = OASISDIAG.1403
& Zwork_Diagnos(i) * RCMPM OASISDIAG.1404
else OASISDIAG.1405
Zwork(i) = OASISDIAG.1406
& rmdi OASISDIAG.1407
endif OASISDIAG.1408
enddo OASISDIAG.1409
C Re-arrange the field on the unwrapped grid: OASISDIAG.1410
call oasis_oce_export(Zwork OASISDIAG.1411
& ,imt,jmt-1, OASISDIAG.1412
& Zwork,imt-2,jmt-1) OASISDIAG.1413
C OASISDIAG.1414
C*-- V Surface Current : OASISDIAG.1415
C OASISDIAG.1416
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1417
& .and. (FieldLocator(istash,CouplingField).eq.'00122')) OASISDIAG.1418
& then OASISDIAG.1419
! The use of Zwork_diagnos asa below implies that the OASISDIAG.1420
! field will be cut in its 2 last columns : they overlap OASISDIAG.1421
! the columns 1&2 and are not needed by the external model. OASISDIAG.1422
CALL UNPACK(1,JMT, 1,1,JMT,KM, IMT,JMT,1, OASISDIAG.1423
& O_CFI1,O_CFI2,joc_no_segs,O_CFI3,joc_no_seapts, OASISDIAG.1424
& D1(joc_v(2)),Zwork_Diagnos, OASISDIAG.1425
& RMDI,CYCLIC_OCEAN) OASISDIAG.1426
C Rescale surface currents from ocean (cm/s) to atmosphere OASISDIAG.1427
C (m/s) units OASISDIAG.1428
do i = 1, imt*(jmt-1) OASISDIAG.1429
if (Zwork_Diagnos(i).NE.RMDI) then OASISDIAG.1430
Zwork(i) = OASISDIAG.1431
& Zwork_Diagnos(i) * RCMPM OASISDIAG.1432
else OASISDIAG.1433
Zwork(i) = OASISDIAG.1434
& rmdi OASISDIAG.1435
endif OASISDIAG.1436
enddo OASISDIAG.1437
C Re-arrange the field on the unwrapped grid: OASISDIAG.1438
call oasis_oce_export(Zwork OASISDIAG.1439
& ,imt,jmt-1, OASISDIAG.1440
& Zwork,imt-2,jmt-1) OASISDIAG.1441
C OASISDIAG.1442
C*-- Fields which to not need any particular handling (U grid): OASISDIAG.1443
C OASISDIAG.1444
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1445
& .and. (FieldLocator(grd,CouplingField) .eq. 'U')) OASISDIAG.1446
& then OASISDIAG.1447
C Pointer towards the coupling field in D1 OASISDIAG.1448
ptr_field = D1_Zptr(CouplingField) OASISDIAG.1449
C Compute the field: OASISDIAG.1450
do i = 1, imt*(jmt-1) OASISDIAG.1451
Zwork(i) = D1(ptr_field-1+i) OASISDIAG.1452
enddo OASISDIAG.1453
C Re-arrange the field on the unwrapped grid: OASISDIAG.1454
call oasis_oce_export(Zwork OASISDIAG.1455
& ,imt,jmt-1, OASISDIAG.1456
& Zwork,imt-2,jmt-1) OASISDIAG.1457
C OASISDIAG.1458
C*-- Fields which to not need any particular handling (T grid): OASISDIAG.1459
C OASISDIAG.1460
OASISDIAG.1461
elseif ((FieldLocator(direction,CouplingField) .eq. 'E') OASISDIAG.1462
& .and. (FieldLocator(grd,CouplingField) .eq. 'T')) OASISDIAG.1463
& then OASISDIAG.1464
C Pointer towards the coupling field in D1 OASISDIAG.1465
ptr_field = D1_Zptr(CouplingField) OASISDIAG.1466
C Compute the field: OASISDIAG.1467
do i = 1, imt*jmt OASISDIAG.1468
Zwork(i) = OASISDIAG.1469
& D1(ptr_field-1+i) OASISDIAG.1470
enddo OASISDIAG.1471
C Re-arrange the field on the unwrapped grid: OASISDIAG.1472
call oasis_oce_export(Zwork OASISDIAG.1473
& ,imt,jmt, OASISDIAG.1474
& Zwork,imt-2,jmt) OASISDIAG.1475
endif OASISDIAG.1476
OASISDIAG.1477
OASISDIAG.1478
OASISDIAG.1479
*ENDIF OASISDIAG.1480
C--------------------------------------------------------------------- OASISDIAG.1481
C IIII/ if the internal model is any of the above, generate an OASISDIAG.1482
C error message OASISDIAG.1483
else !! internal_model OASISDIAG.1484
icode = 1 OASISDIAG.1485
cmessage = ' OASIS : Unauthorised internal model. ' OASISDIAG.1486
endif !! internal_model OASISDIAG.1487
OASISDIAG.1488
C------------------------------------------------ OASISDIAG.1489
C Error trap. OASISDIAG.1490
999 continue OASISDIAG.1491
if (icode.ne.0) then OASISDIAG.1492
write(nulou,*) cmessage,icode OASISDIAG.1493
endif OASISDIAG.1494
write(nulou,*) "exiting OASIS_DIAGNOSTICS" OASISDIAG.1495
OASISDIAG.1496
return OASISDIAG.1497
end OASISDIAG.1498
OASISDIAG.1499
C This routine is to deal with the wrapped around grid of the OASISDIAG.1500
C ocean ; the source grid is copied into the target grid which OASISDIAG.1501
C happen to be smaller ; in the process, the last 2 columns of OASISDIAG.1502
C the source grid are left over. OASISDIAG.1503
subroutine oasis_oce_export(source,is,js,target,it,jt) 16OASISDIAG.1504
integer is,js OASISDIAG.1505
real source(is,js) OASISDIAG.1506
integer it,jt OASISDIAG.1507
real target (it,jt) OASISDIAG.1508
integer i,j OASISDIAG.1509
OASISDIAG.1510
do j = 1, jt OASISDIAG.1511
do i = 1, it OASISDIAG.1512
target(i,j) = source(i,j) OASISDIAG.1513
enddo OASISDIAG.1514
enddo OASISDIAG.1515
OASISDIAG.1516
return OASISDIAG.1517
end OASISDIAG.1518
OASISDIAG.1519
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OASISDIAG.1520
C RIVER OUTFLOW OASISDIAG.1521
c sum the runoff for each ocean entry point (k,l) :- OASISDIAG.1522
c for every land point (i,j) get the coordinates of the ocean OASISDIAG.1523
c entry point (k,l) from array ocentpts and add the runoff for OASISDIAG.1524
c point (i,j) to point (k,l) - multiply by the ratio of areas of OASISDIAG.1525
c source to target gridbox in forming sum; this gives a mass flux OASISDIAG.1526
c per unit area. OASISDIAG.1527
subroutine ComputeRiverOutflow( 2OASISDIAG.1528
& runoffinout, icols, jrows, OASISDIAG.1529
& COS_P_LATITUDE, OASISDIAG.1530
& amasktp, OASISDIAG.1531
& ocentpts) OASISDIAG.1532
real runoffinout(icols,jrows) OASISDIAG.1533
integer icols, jrows OASISDIAG.1534
logical amasktp(icols, jrows) OASISDIAG.1535
integer ocentpts(icols*jrows) OASISDIAG.1536
real COS_P_LATITUDE(ICOLS,JROWS) ! IN COSINE OF LATITUDE AT P OASISDIAG.1537
! POINTS OASISDIAG.1538
OASISDIAG.1539
C local variables : OASISDIAG.1540
real worka(icols, jrows) OASISDIAG.1541
integer landpt OASISDIAG.1542
integer i,j,k,l OASISDIAG.1543
OASISDIAG.1544
do j=1,jrows OASISDIAG.1545
do i=1,icols OASISDIAG.1546
worka(i,j)=0.0 OASISDIAG.1547
enddo OASISDIAG.1548
enddo OASISDIAG.1549
landpt=0 OASISDIAG.1550
do j=1,jrows OASISDIAG.1551
do i=1,icols OASISDIAG.1552
if (amasktp(i,j)) then OASISDIAG.1553
landpt=landpt+1 OASISDIAG.1554
k=ocentpts(landpt)/100000 OASISDIAG.1555
l=mod(ocentpts(landpt),100000) OASISDIAG.1556
worka(k,l)=worka(k,l)+runoffinout(i,j)* OASISDIAG.1557
& cos_p_latitude(i,j)/cos_p_latitude(k,l) OASISDIAG.1558
endif OASISDIAG.1559
enddo OASISDIAG.1560
enddo OASISDIAG.1561
C copy back the quantities obtained in worka to runoffinout. OASISDIAG.1562
do j=1,jrows OASISDIAG.1563
do i=1,icols OASISDIAG.1564
runoffinout(i,j) = worka(i,j) OASISDIAG.1565
enddo OASISDIAG.1566
enddo OASISDIAG.1567
return OASISDIAG.1568
end OASISDIAG.1569
OASISDIAG.1570
*ENDIF OASISDIAG.1571