SUBROUTINE FieldAdd 7FPFIELD1.36
& (nx, ny, rmdi, FPFIELD1.37
& in_field1, in_field2, FPFIELD1.38
& out_field, FPFIELD1.39
& icode, cmessage) FPFIELD1.40
FPFIELD1.41
FPFIELD1.42
C FieldAdd: subroutine to add two arrays. FPFIELD1.43
C --------- Takes account of missing data. FPFIELD1.44
FPFIELD1.45
C Programmer: S J Foreman FPFIELD1.46
C ----------- FPFIELD1.47
FPFIELD1.48
C Method: FPFIELD1.49
C ------- loop over all elements, adding unless either is FPFIELD1.50
C missing, in which case result is missing. FPFIELD1.51
FPFIELD1.52
IMPLICIT NONE FPFIELD1.53
FPFIELD1.54
FPFIELD1.55
C Input: FPFIELD1.56
C ------ FPFIELD1.57
FPFIELD1.58
INTEGER FPFIELD1.59
& nx ! IN number of columns of array FPFIELD1.60
& ,ny ! IN number of rows in array FPFIELD1.61
FPFIELD1.62
REAL FPFIELD1.63
& rmdi ! IN value of REAL missing data indicator FPFIELD1.64
FPFIELD1.65
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.66
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.67
FPFIELD1.68
C Output FPFIELD1.69
C ------ FPFIELD1.70
FPFIELD1.71
REAL FPFIELD1.72
& out_field(nx,ny) ! OUT results of addition FPFIELD1.73
FPFIELD1.74
INTEGER FPFIELD1.75
& icode ! OUT Completion code FPFIELD1.76
FPFIELD1.77
CHARACTER *(*) FPFIELD1.78
& cmessage ! OUT Error message FPFIELD1.79
FPFIELD1.80
FPFIELD1.81
C Local variables FPFIELD1.82
C --------------- FPFIELD1.83
FPFIELD1.84
INTEGER FPFIELD1.85
& ix ! Loop counter over columns FPFIELD1.86
& ,iy ! Loop counter over rows FPFIELD1.87
FPFIELD1.88
FPFIELD1.89
C ------------------------------------------------------------------ FPFIELD1.90
FPFIELD1.91
icode =0 FPFIELD1.92
cmessage="FieldAdd: addition successful." FPFIELD1.93
FPFIELD1.94
DO iy = 1, ny ! iy: loop over rows FPFIELD1.95
DO ix = 1, nx ! ix: loop over columns FPFIELD1.96
FPFIELD1.97
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.98
& .AND. in_field2(ix,iy) .NE. rmdi ) FPFIELD1.99
FPFIELD1.100
& THEN FPFIELD1.101
FPFIELD1.102
out_field(ix,iy) = in_field1(ix,iy) + in_field2(ix,iy) FPFIELD1.103
FPFIELD1.104
ELSE FPFIELD1.105
FPFIELD1.106
out_field(ix,iy) = rmdi FPFIELD1.107
FPFIELD1.108
END IF FPFIELD1.109
FPFIELD1.110
END DO ! ix: loop over columns FPFIELD1.111
END DO ! iy: loop over columns FPFIELD1.112
FPFIELD1.113
RETURN FPFIELD1.114
END ! Subroutine FieldAdd FPFIELD1.115
FPFIELD1.116
FPFIELD1.117
SUBROUTINE FieldSub 5FPFIELD1.118
& (nx, ny, rmdi, FPFIELD1.119
& in_field1, in_field2, FPFIELD1.120
& out_field, FPFIELD1.121
& icode, cmessage) FPFIELD1.122
FPFIELD1.123
FPFIELD1.124
C FieldAdd: subroutine to subtract two arrays. FPFIELD1.125
C --------- Takes account of missing data. FPFIELD1.126
FPFIELD1.127
C Programmer: S J Foreman FPFIELD1.128
C ----------- FPFIELD1.129
FPFIELD1.130
C Method: FPFIELD1.131
C ------- loop over all elements, subtracting unless either FPFIELD1.132
C is missing, in which case result is missing. FPFIELD1.133
C in_field1 - in_field2. FPFIELD1.134
FPFIELD1.135
IMPLICIT NONE FPFIELD1.136
FPFIELD1.137
C Input: FPFIELD1.138
C ------ FPFIELD1.139
FPFIELD1.140
INTEGER FPFIELD1.141
& nx ! IN number of columns of array FPFIELD1.142
& ,ny ! IN number of rows in array FPFIELD1.143
FPFIELD1.144
REAL FPFIELD1.145
& rmdi ! IN value of REAL missing data indicator FPFIELD1.146
FPFIELD1.147
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.148
& ,in_field2(nx,ny) ! IN array of input values (subtrahend) FPFIELD1.149
FPFIELD1.150
C Output FPFIELD1.151
C ------ FPFIELD1.152
FPFIELD1.153
REAL FPFIELD1.154
& out_field(nx,ny) ! OUT results of subtraction FPFIELD1.155
FPFIELD1.156
INTEGER FPFIELD1.157
& icode ! OUT Completion code FPFIELD1.158
FPFIELD1.159
CHARACTER *(*) FPFIELD1.160
& cmessage ! OUT Error message FPFIELD1.161
FPFIELD1.162
FPFIELD1.163
C Local variables FPFIELD1.164
C --------------- FPFIELD1.165
FPFIELD1.166
INTEGER FPFIELD1.167
& ix ! Loop counter over columns FPFIELD1.168
& ,iy ! Loop counter over rows FPFIELD1.169
FPFIELD1.170
FPFIELD1.171
C ------------------------------------------------------------------ FPFIELD1.172
FPFIELD1.173
icode = 0 FPFIELD1.174
cmessage="FieldSub: subtraction successful." FPFIELD1.175
FPFIELD1.176
DO iy = 1, ny ! iy: loop over rows FPFIELD1.177
DO ix = 1, nx ! ix: loop over columns FPFIELD1.178
FPFIELD1.179
IF ( in_field1(ix,iy) .GT. rmdi FPFIELD1.180
& .AND. in_field2(ix,iy) .GT. rmdi ) FPFIELD1.181
FPFIELD1.182
& THEN FPFIELD1.183
FPFIELD1.184
out_field(ix,iy) = in_field1(ix,iy) - in_field2(ix,iy) FPFIELD1.185
FPFIELD1.186
ELSE FPFIELD1.187
FPFIELD1.188
out_field(ix,iy) = rmdi FPFIELD1.189
FPFIELD1.190
END IF FPFIELD1.191
FPFIELD1.192
END DO ! ix: loop over columns FPFIELD1.193
END DO ! iy: loop over columns FPFIELD1.194
FPFIELD1.195
RETURN FPFIELD1.196
END ! Subroutine FieldSub FPFIELD1.197
FPFIELD1.198
FPFIELD1.199
SUBROUTINE FieldMult 1FPFIELD1.200
& (nx, ny, rmdi, FPFIELD1.201
& in_field1, in_field2, FPFIELD1.202
& out_field, FPFIELD1.203
& icode, cmessage) FPFIELD1.204
FPFIELD1.205
FPFIELD1.206
C FieldMult: subroutine to multiply two arrays. FPFIELD1.207
C ---------- Takes account of missing data. FPFIELD1.208
FPFIELD1.209
C Programmer: S J Foreman FPFIELD1.210
C ----------- FPFIELD1.211
FPFIELD1.212
C Method: FPFIELD1.213
C ------- loop over all elements, adding unless either is FPFIELD1.214
C missing, in which case result is missing. FPFIELD1.215
C in_field1*in_field2. FPFIELD1.216
FPFIELD1.217
IMPLICIT NONE FPFIELD1.218
FPFIELD1.219
FPFIELD1.220
C Input: FPFIELD1.221
C ------ FPFIELD1.222
FPFIELD1.223
INTEGER FPFIELD1.224
& nx ! IN number of columns of array FPFIELD1.225
& ,ny ! IN number of rows in array FPFIELD1.226
FPFIELD1.227
REAL FPFIELD1.228
& rmdi ! IN value of REAL missing data indicator FPFIELD1.229
FPFIELD1.230
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.231
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.232
FPFIELD1.233
C Output FPFIELD1.234
C ------ FPFIELD1.235
FPFIELD1.236
REAL FPFIELD1.237
& out_field(nx,ny) ! OUT results of multipication FPFIELD1.238
FPFIELD1.239
INTEGER FPFIELD1.240
& icode ! OUT Completion code FPFIELD1.241
FPFIELD1.242
CHARACTER *(*) FPFIELD1.243
& cmessage ! OUT Error message FPFIELD1.244
FPFIELD1.245
FPFIELD1.246
C Local variables FPFIELD1.247
C --------------- FPFIELD1.248
FPFIELD1.249
INTEGER FPFIELD1.250
& ix ! Loop counter over columns FPFIELD1.251
& ,iy ! Loop counter over rows FPFIELD1.252
FPFIELD1.253
FPFIELD1.254
C ------------------------------------------------------------------ FPFIELD1.255
FPFIELD1.256
icode =0 FPFIELD1.257
cmessage="FieldMult: multiplication successful." FPFIELD1.258
FPFIELD1.259
DO iy = 1, ny ! iy: loop over rows FPFIELD1.260
DO ix = 1, nx ! ix: loop over columns FPFIELD1.261
FPFIELD1.262
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.263
& .AND. in_field2(ix,iy) .NE. rmdi ) FPFIELD1.264
FPFIELD1.265
& THEN FPFIELD1.266
FPFIELD1.267
out_field(ix,iy) = in_field1(ix,iy) * in_field2(ix,iy) FPFIELD1.268
FPFIELD1.269
ELSE FPFIELD1.270
FPFIELD1.271
out_field(ix,iy) = rmdi FPFIELD1.272
FPFIELD1.273
END IF FPFIELD1.274
FPFIELD1.275
END DO ! ix: loop over columns FPFIELD1.276
END DO ! iy: loop over columns FPFIELD1.277
FPFIELD1.278
RETURN FPFIELD1.279
END ! Subroutine FieldMult FPFIELD1.280
FPFIELD1.281
FPFIELD1.282
SUBROUTINE FieldDiv FPFIELD1.283
& (nx, ny, rmdi, FPFIELD1.284
& in_field1, in_field2, FPFIELD1.285
& out_field, FPFIELD1.286
& icode, cmessage) FPFIELD1.287
FPFIELD1.288
FPFIELD1.289
C FieldDiv: subroutine to divide elements of one array by FPFIELD1.290
C --------- corresponding elements of another. FPFIELD1.291
C Takes account of missing data. FPFIELD1.292
FPFIELD1.293
C Programmer: S J Foreman FPFIELD1.294
C ----------- FPFIELD1.295
FPFIELD1.296
C Method: FPFIELD1.297
C ------- loop over all elements, dividing unless either is FPFIELD1.298
C missing or divisor is zero, in which case result FPFIELD1.299
C is missing. FPFIELD1.300
C in_field1 / in_field2. FPFIELD1.301
FPFIELD1.302
IMPLICIT NONE FPFIELD1.303
FPFIELD1.304
FPFIELD1.305
C Input: FPFIELD1.306
C ------ FPFIELD1.307
FPFIELD1.308
INTEGER FPFIELD1.309
& nx ! IN number of columns of array FPFIELD1.310
& ,ny ! IN number of rows in array FPFIELD1.311
FPFIELD1.312
REAL FPFIELD1.313
& rmdi ! IN value of REAL missing data indicator FPFIELD1.314
FPFIELD1.315
& ,in_field1(nx,ny) ! IN array of input values (numerator) FPFIELD1.316
& ,in_field2(nx,ny) ! IN array of input values (denominator) FPFIELD1.317
FPFIELD1.318
C Output FPFIELD1.319
C ------ FPFIELD1.320
FPFIELD1.321
REAL FPFIELD1.322
& out_field(nx,ny) ! OUT results of division FPFIELD1.323
FPFIELD1.324
INTEGER FPFIELD1.325
& icode ! OUT Completion code FPFIELD1.326
FPFIELD1.327
CHARACTER *(*) FPFIELD1.328
& cmessage ! OUT Error message FPFIELD1.329
FPFIELD1.330
FPFIELD1.331
C Local variables FPFIELD1.332
C --------------- FPFIELD1.333
FPFIELD1.334
INTEGER FPFIELD1.335
& ix ! Loop counter over columns FPFIELD1.336
& ,iy ! Loop counter over rows FPFIELD1.337
FPFIELD1.338
FPFIELD1.339
C ------------------------------------------------------------------ FPFIELD1.340
FPFIELD1.341
icode =0 FPFIELD1.342
cmessage='FieldDiv: division successful.' FPFIELD1.343
FPFIELD1.344
DO iy = 1, ny ! iy: loop over rows FPFIELD1.345
DO ix = 1, nx ! ix: loop over columns FPFIELD1.346
FPFIELD1.347
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.348
& .AND. in_field2(ix,iy) .NE. rmdi ) FPFIELD1.349
& THEN FPFIELD1.350
FPFIELD1.351
IF ( in_field2(ix,iy) .NE. 0.0 ) FPFIELD1.352
FPFIELD1.353
& THEN ! divide FPFIELD1.354
out_field(ix,iy) = in_field1(ix,iy)/in_field2(ix,iy) FPFIELD1.355
FPFIELD1.356
ELSE ! avoid division by zero FPFIELD1.357
icode = 4 FPFIELD1.358
out_field(ix,iy) = rmdi FPFIELD1.359
END IF FPFIELD1.360
FPFIELD1.361
ELSE ! set missing data if either input is missing FPFIELD1.362
FPFIELD1.363
out_field(ix,iy) = rmdi FPFIELD1.364
FPFIELD1.365
END IF FPFIELD1.366
FPFIELD1.367
END DO ! ix: loop over columns FPFIELD1.368
END DO ! iy: loop over columns FPFIELD1.369
FPFIELD1.370
C Set appropriate error message if division by zero has occurred FPFIELD1.371
FPFIELD1.372
IF (icode .NE. 0) THEN FPFIELD1.373
cmessage = 'FieldDiv: division by zero' FPFIELD1.374
END IF FPFIELD1.375
FPFIELD1.376
RETURN FPFIELD1.377
END ! Subroutine FieldDiv FPFIELD1.378
FPFIELD1.379
FPFIELD1.380
SUBROUTINE FieldCopy FPFIELD1.381
& (nx, ny, rmdi, FPFIELD1.382
& in_field, FPFIELD1.383
& out_field, FPFIELD1.384
& icode, cmessage) FPFIELD1.385
FPFIELD1.386
FPFIELD1.387
C FieldCopy: subroutine to copy one array to another. FPFIELD1.388
C ---------- FPFIELD1.389
FPFIELD1.390
C Programmer: S J Foreman FPFIELD1.391
C ----------- FPFIELD1.392
FPFIELD1.393
C Method: FPFIELD1.394
C ------- copy one array to another. FPFIELD1.395
FPFIELD1.396
IMPLICIT NONE FPFIELD1.397
FPFIELD1.398
FPFIELD1.399
C Input: FPFIELD1.400
C ------ FPFIELD1.401
FPFIELD1.402
INTEGER FPFIELD1.403
& nx ! IN number of columns of array FPFIELD1.404
& ,ny ! IN number of rows in array FPFIELD1.405
FPFIELD1.406
REAL FPFIELD1.407
& rmdi ! IN value of REAL missing data indicator FPFIELD1.408
FPFIELD1.409
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.410
FPFIELD1.411
C Output FPFIELD1.412
C ------ FPFIELD1.413
FPFIELD1.414
REAL FPFIELD1.415
& out_field(nx,ny) ! OUT copy of values in input FPFIELD1.416
FPFIELD1.417
INTEGER FPFIELD1.418
& icode ! OUT Completion code FPFIELD1.419
FPFIELD1.420
CHARACTER *(*) FPFIELD1.421
& cmessage ! OUT Error message FPFIELD1.422
FPFIELD1.423
FPFIELD1.424
C Local variables FPFIELD1.425
C --------------- FPFIELD1.426
FPFIELD1.427
INTEGER FPFIELD1.428
& ix ! Loop counter over columns FPFIELD1.429
& ,iy ! Loop counter over rows FPFIELD1.430
FPFIELD1.431
FPFIELD1.432
C ------------------------------------------------------------------ FPFIELD1.433
FPFIELD1.434
icode =0 FPFIELD1.435
cmessage='FieldCopy: copy successful.' FPFIELD1.436
FPFIELD1.437
DO iy = 1, ny ! iy: loop over rows FPFIELD1.438
DO ix = 1, nx ! ix: loop over columns FPFIELD1.439
FPFIELD1.440
out_field(ix,iy) = in_field(ix,iy) FPFIELD1.441
FPFIELD1.442
END DO ! ix: loop over columns FPFIELD1.443
END DO ! iy: loop over columns FPFIELD1.444
FPFIELD1.445
RETURN FPFIELD1.446
END ! Subroutine FieldCopy FPFIELD1.447
FPFIELD1.448
FPFIELD1.449
SUBROUTINE FieldEQ FPFIELD1.450
& (nx, ny, rmdi, FPFIELD1.451
& in_field1, in_field2, FPFIELD1.452
& out_field, FPFIELD1.453
& icode, cmessage) FPFIELD1.454
FPFIELD1.455
FPFIELD1.456
C FieldEQ: Set MDI where two fields are equal. FPFIELD1.457
C ---------- Takes account of missing data. FPFIELD1.458
FPFIELD1.459
C Programmer: S J Foreman FPFIELD1.460
C ----------- FPFIELD1.461
FPFIELD1.462
C Method: FPFIELD1.463
C ------- loop over all elements, testing unless either is FPFIELD1.464
C missing, in which case result is missing. FPFIELD1.465
C out_field1 = in_field1. FPFIELD1.466
FPFIELD1.467
IMPLICIT NONE FPFIELD1.468
FPFIELD1.469
FPFIELD1.470
C Input: FPFIELD1.471
C ------ FPFIELD1.472
FPFIELD1.473
INTEGER FPFIELD1.474
& nx ! IN number of columns of array FPFIELD1.475
& ,ny ! IN number of rows in array FPFIELD1.476
FPFIELD1.477
REAL FPFIELD1.478
& rmdi ! IN value of REAL missing data indicator FPFIELD1.479
FPFIELD1.480
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.481
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.482
FPFIELD1.483
C Output FPFIELD1.484
C ------ FPFIELD1.485
FPFIELD1.486
REAL FPFIELD1.487
& out_field(nx,ny) ! OUT results of multipication FPFIELD1.488
FPFIELD1.489
INTEGER FPFIELD1.490
& icode ! OUT Completion code FPFIELD1.491
FPFIELD1.492
CHARACTER *(*) FPFIELD1.493
& cmessage ! OUT Error message FPFIELD1.494
FPFIELD1.495
FPFIELD1.496
C Local variables FPFIELD1.497
C --------------- FPFIELD1.498
FPFIELD1.499
INTEGER FPFIELD1.500
& ix ! Loop counter over columns FPFIELD1.501
& ,iy ! Loop counter over rows FPFIELD1.502
FPFIELD1.503
FPFIELD1.504
C ------------------------------------------------------------------ FPFIELD1.505
FPFIELD1.506
icode =0 FPFIELD1.507
cmessage="FieldEQ: test successful." FPFIELD1.508
FPFIELD1.509
DO iy = 1, ny ! iy: loop over rows FPFIELD1.510
DO ix = 1, nx ! ix: loop over columns FPFIELD1.511
FPFIELD1.512
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.513
& .AND. in_field2(ix,iy) .NE. rmdi FPFIELD1.514
& .AND. in_field1(ix,iy).NE.in_field2(ix,iy) ) FPFIELD1.515
FPFIELD1.516
& THEN FPFIELD1.517
FPFIELD1.518
out_field(ix,iy) = in_field1(ix,iy) FPFIELD1.519
FPFIELD1.520
ELSE FPFIELD1.521
FPFIELD1.522
out_field(ix,iy) = rmdi FPFIELD1.523
FPFIELD1.524
END IF FPFIELD1.525
FPFIELD1.526
END DO ! ix: loop over columns FPFIELD1.527
END DO ! iy: loop over columns FPFIELD1.528
FPFIELD1.529
RETURN FPFIELD1.530
END ! Subroutine FieldEQ FPFIELD1.531
FPFIELD1.532
SUBROUTINE FieldNE FPFIELD1.533
& (nx, ny, rmdi, FPFIELD1.534
& in_field1, in_field2, FPFIELD1.535
& out_field, FPFIELD1.536
& icode, cmessage) FPFIELD1.537
FPFIELD1.538
FPFIELD1.539
C FieldEQ: Set MDI where two fields are not equal. FPFIELD1.540
C ---------- Takes account of missing data. FPFIELD1.541
FPFIELD1.542
C Programmer: S J Foreman FPFIELD1.543
C ----------- FPFIELD1.544
FPFIELD1.545
C Method: FPFIELD1.546
C ------- loop over all elements, testing unless either is FPFIELD1.547
C missing, in which case result is missing. FPFIELD1.548
C out_field1 = in_field1. FPFIELD1.549
FPFIELD1.550
IMPLICIT NONE FPFIELD1.551
FPFIELD1.552
FPFIELD1.553
C Input: FPFIELD1.554
C ------ FPFIELD1.555
FPFIELD1.556
INTEGER FPFIELD1.557
& nx ! IN number of columns of array FPFIELD1.558
& ,ny ! IN number of rows in array FPFIELD1.559
FPFIELD1.560
REAL FPFIELD1.561
& rmdi ! IN value of REAL missing data indicator FPFIELD1.562
FPFIELD1.563
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.564
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.565
FPFIELD1.566
C Output FPFIELD1.567
C ------ FPFIELD1.568
FPFIELD1.569
REAL FPFIELD1.570
& out_field(nx,ny) ! OUT results of multipication FPFIELD1.571
FPFIELD1.572
INTEGER FPFIELD1.573
& icode ! OUT Completion code FPFIELD1.574
FPFIELD1.575
CHARACTER *(*) FPFIELD1.576
& cmessage ! OUT Error message FPFIELD1.577
FPFIELD1.578
FPFIELD1.579
C Local variables FPFIELD1.580
C --------------- FPFIELD1.581
FPFIELD1.582
INTEGER FPFIELD1.583
& ix ! Loop counter over columns FPFIELD1.584
& ,iy ! Loop counter over rows FPFIELD1.585
FPFIELD1.586
FPFIELD1.587
C ------------------------------------------------------------------ FPFIELD1.588
FPFIELD1.589
icode =0 FPFIELD1.590
cmessage="FieldNE: test successful." FPFIELD1.591
FPFIELD1.592
DO iy = 1, ny ! iy: loop over rows FPFIELD1.593
DO ix = 1, nx ! ix: loop over columns FPFIELD1.594
FPFIELD1.595
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.596
& .AND. in_field2(ix,iy) .NE. rmdi FPFIELD1.597
& .AND. in_field1(ix,iy).EQ.in_field2(ix,iy) ) FPFIELD1.598
FPFIELD1.599
& THEN FPFIELD1.600
FPFIELD1.601
out_field(ix,iy) = in_field1(ix,iy) FPFIELD1.602
FPFIELD1.603
ELSE FPFIELD1.604
FPFIELD1.605
out_field(ix,iy) = rmdi FPFIELD1.606
FPFIELD1.607
END IF FPFIELD1.608
FPFIELD1.609
END DO ! ix: loop over columns FPFIELD1.610
END DO ! iy: loop over columns FPFIELD1.611
FPFIELD1.612
RETURN FPFIELD1.613
END ! Subroutine FieldNE FPFIELD1.614
FPFIELD1.615
SUBROUTINE FieldGT FPFIELD1.616
& (nx, ny, rmdi, FPFIELD1.617
& in_field1, in_field2, FPFIELD1.618
& out_field, FPFIELD1.619
& icode, cmessage) FPFIELD1.620
FPFIELD1.621
FPFIELD1.622
C FieldGT: Set MDI where field1 > field2. FPFIELD1.623
C ---------- Takes account of missing data. FPFIELD1.624
FPFIELD1.625
C Programmer: S J Foreman FPFIELD1.626
C ----------- FPFIELD1.627
FPFIELD1.628
C Method: FPFIELD1.629
C ------- loop over all elements, testing unless either is FPFIELD1.630
C missing, in which case result is missing. FPFIELD1.631
C out_field1 = in_field1. FPFIELD1.632
FPFIELD1.633
IMPLICIT NONE FPFIELD1.634
FPFIELD1.635
FPFIELD1.636
C Input: FPFIELD1.637
C ------ FPFIELD1.638
FPFIELD1.639
INTEGER FPFIELD1.640
& nx ! IN number of columns of array FPFIELD1.641
& ,ny ! IN number of rows in array FPFIELD1.642
FPFIELD1.643
REAL FPFIELD1.644
& rmdi ! IN value of REAL missing data indicator FPFIELD1.645
FPFIELD1.646
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.647
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.648
FPFIELD1.649
C Output FPFIELD1.650
C ------ FPFIELD1.651
FPFIELD1.652
REAL FPFIELD1.653
& out_field(nx,ny) ! OUT results of multipication FPFIELD1.654
FPFIELD1.655
INTEGER FPFIELD1.656
& icode ! OUT Completion code FPFIELD1.657
FPFIELD1.658
CHARACTER *(*) FPFIELD1.659
& cmessage ! OUT Error message FPFIELD1.660
FPFIELD1.661
FPFIELD1.662
C Local variables FPFIELD1.663
C --------------- FPFIELD1.664
FPFIELD1.665
INTEGER FPFIELD1.666
& ix ! Loop counter over columns FPFIELD1.667
& ,iy ! Loop counter over rows FPFIELD1.668
FPFIELD1.669
FPFIELD1.670
C ------------------------------------------------------------------ FPFIELD1.671
FPFIELD1.672
icode =0 FPFIELD1.673
cmessage="FieldGT: test successful." FPFIELD1.674
FPFIELD1.675
DO iy = 1, ny ! iy: loop over rows FPFIELD1.676
DO ix = 1, nx ! ix: loop over columns FPFIELD1.677
FPFIELD1.678
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.679
& .AND. in_field2(ix,iy) .NE. rmdi FPFIELD1.680
& .AND. in_field1(ix,iy).LE.in_field2(ix,iy) ) FPFIELD1.681
FPFIELD1.682
& THEN FPFIELD1.683
FPFIELD1.684
out_field(ix,iy) = in_field1(ix,iy) FPFIELD1.685
FPFIELD1.686
ELSE FPFIELD1.687
FPFIELD1.688
out_field(ix,iy) = rmdi FPFIELD1.689
FPFIELD1.690
END IF FPFIELD1.691
FPFIELD1.692
END DO ! ix: loop over columns FPFIELD1.693
END DO ! iy: loop over columns FPFIELD1.694
FPFIELD1.695
RETURN FPFIELD1.696
END ! Subroutine FieldGT FPFIELD1.697
FPFIELD1.698
FPFIELD1.699
SUBROUTINE FieldLT FPFIELD1.700
& (nx, ny, rmdi, FPFIELD1.701
& in_field1, in_field2, FPFIELD1.702
& out_field, FPFIELD1.703
& icode, cmessage) FPFIELD1.704
FPFIELD1.705
FPFIELD1.706
C FieldLT: Set MDI where field1 < field2. FPFIELD1.707
C ---------- Takes account of missing data. FPFIELD1.708
FPFIELD1.709
C Programmer: S J Foreman FPFIELD1.710
C ----------- FPFIELD1.711
FPFIELD1.712
C Method: FPFIELD1.713
C ------- loop over all elements, testing unless either is FPFIELD1.714
C missing, in which case result is missing. FPFIELD1.715
C out_field1 = in_field1. FPFIELD1.716
FPFIELD1.717
IMPLICIT NONE FPFIELD1.718
FPFIELD1.719
FPFIELD1.720
C Input: FPFIELD1.721
C ------ FPFIELD1.722
FPFIELD1.723
INTEGER FPFIELD1.724
& nx ! IN number of columns of array FPFIELD1.725
& ,ny ! IN number of rows in array FPFIELD1.726
FPFIELD1.727
REAL FPFIELD1.728
& rmdi ! IN value of REAL missing data indicator FPFIELD1.729
FPFIELD1.730
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.731
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.732
FPFIELD1.733
C Output FPFIELD1.734
C ------ FPFIELD1.735
FPFIELD1.736
REAL FPFIELD1.737
& out_field(nx,ny) ! OUT results of multipication FPFIELD1.738
FPFIELD1.739
INTEGER FPFIELD1.740
& icode ! OUT Completion code FPFIELD1.741
FPFIELD1.742
CHARACTER *(*) FPFIELD1.743
& cmessage ! OUT Error message FPFIELD1.744
FPFIELD1.745
FPFIELD1.746
C Local variables FPFIELD1.747
C --------------- FPFIELD1.748
FPFIELD1.749
INTEGER FPFIELD1.750
& ix ! Loop counter over columns FPFIELD1.751
& ,iy ! Loop counter over rows FPFIELD1.752
FPFIELD1.753
FPFIELD1.754
C ------------------------------------------------------------------ FPFIELD1.755
FPFIELD1.756
icode =0 FPFIELD1.757
cmessage="FieldLT: test successful." FPFIELD1.758
FPFIELD1.759
DO iy = 1, ny ! iy: loop over rows FPFIELD1.760
DO ix = 1, nx ! ix: loop over columns FPFIELD1.761
FPFIELD1.762
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.763
& .AND. in_field2(ix,iy) .NE. rmdi FPFIELD1.764
& .AND. in_field1(ix,iy).GE.in_field2(ix,iy) ) FPFIELD1.765
FPFIELD1.766
& THEN FPFIELD1.767
FPFIELD1.768
out_field(ix,iy) = in_field1(ix,iy) FPFIELD1.769
FPFIELD1.770
ELSE FPFIELD1.771
FPFIELD1.772
out_field(ix,iy) = rmdi FPFIELD1.773
FPFIELD1.774
END IF FPFIELD1.775
FPFIELD1.776
END DO ! ix: loop over columns FPFIELD1.777
END DO ! iy: loop over columns FPFIELD1.778
FPFIELD1.779
RETURN FPFIELD1.780
END ! Subroutine FieldLT FPFIELD1.781
FPFIELD1.782
SUBROUTINE FieldLE FPFIELD1.783
& (nx, ny, rmdi, FPFIELD1.784
& in_field1, in_field2, FPFIELD1.785
& out_field, FPFIELD1.786
& icode, cmessage) FPFIELD1.787
FPFIELD1.788
FPFIELD1.789
C FieldLE: Set MDI where field1 <= field2. FPFIELD1.790
C ---------- Takes account of missing data. FPFIELD1.791
FPFIELD1.792
C Programmer: S J Foreman FPFIELD1.793
C ----------- FPFIELD1.794
FPFIELD1.795
C Method: FPFIELD1.796
C ------- loop over all elements, testing unless either is FPFIELD1.797
C missing, in which case result is missing. FPFIELD1.798
C out_field1 = in_field1. FPFIELD1.799
FPFIELD1.800
IMPLICIT NONE FPFIELD1.801
FPFIELD1.802
FPFIELD1.803
C Input: FPFIELD1.804
C ------ FPFIELD1.805
FPFIELD1.806
INTEGER FPFIELD1.807
& nx ! IN number of columns of array FPFIELD1.808
& ,ny ! IN number of rows in array FPFIELD1.809
FPFIELD1.810
REAL FPFIELD1.811
& rmdi ! IN value of REAL missing data indicator FPFIELD1.812
FPFIELD1.813
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.814
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.815
FPFIELD1.816
C Output FPFIELD1.817
C ------ FPFIELD1.818
FPFIELD1.819
REAL FPFIELD1.820
& out_field(nx,ny) ! OUT results of multipication FPFIELD1.821
FPFIELD1.822
INTEGER FPFIELD1.823
& icode ! OUT Completion code FPFIELD1.824
FPFIELD1.825
CHARACTER *(*) FPFIELD1.826
& cmessage ! OUT Error message FPFIELD1.827
FPFIELD1.828
FPFIELD1.829
C Local variables FPFIELD1.830
C --------------- FPFIELD1.831
FPFIELD1.832
INTEGER FPFIELD1.833
& ix ! Loop counter over columns FPFIELD1.834
& ,iy ! Loop counter over rows FPFIELD1.835
FPFIELD1.836
FPFIELD1.837
C ------------------------------------------------------------------ FPFIELD1.838
FPFIELD1.839
icode =0 FPFIELD1.840
cmessage="FieldLE: test successful." FPFIELD1.841
FPFIELD1.842
DO iy = 1, ny ! iy: loop over rows FPFIELD1.843
DO ix = 1, nx ! ix: loop over columns FPFIELD1.844
FPFIELD1.845
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.846
& .AND. in_field2(ix,iy) .NE. rmdi FPFIELD1.847
& .AND. in_field1(ix,iy).GT.in_field2(ix,iy) ) FPFIELD1.848
FPFIELD1.849
& THEN FPFIELD1.850
FPFIELD1.851
out_field(ix,iy) = in_field1(ix,iy) FPFIELD1.852
FPFIELD1.853
ELSE FPFIELD1.854
FPFIELD1.855
out_field(ix,iy) = rmdi FPFIELD1.856
FPFIELD1.857
END IF FPFIELD1.858
FPFIELD1.859
END DO ! ix: loop over columns FPFIELD1.860
END DO ! iy: loop over columns FPFIELD1.861
FPFIELD1.862
RETURN FPFIELD1.863
END ! Subroutine FieldLE FPFIELD1.864
FPFIELD1.865
SUBROUTINE FieldGE FPFIELD1.866
& (nx, ny, rmdi, FPFIELD1.867
& in_field1, in_field2, FPFIELD1.868
& out_field, FPFIELD1.869
& icode, cmessage) FPFIELD1.870
FPFIELD1.871
FPFIELD1.872
C FieldGE: Set MDI where field1 >= field2. FPFIELD1.873
C ---------- Takes account of missing data. FPFIELD1.874
FPFIELD1.875
C Programmer: S J Foreman FPFIELD1.876
C ----------- FPFIELD1.877
FPFIELD1.878
C Method: FPFIELD1.879
C ------- loop over all elements, testing unless either is FPFIELD1.880
C missing, in which case result is missing. FPFIELD1.881
C out_field1 = in_field1. FPFIELD1.882
FPFIELD1.883
IMPLICIT NONE FPFIELD1.884
FPFIELD1.885
FPFIELD1.886
C Input: FPFIELD1.887
C ------ FPFIELD1.888
FPFIELD1.889
INTEGER FPFIELD1.890
& nx ! IN number of columns of array FPFIELD1.891
& ,ny ! IN number of rows in array FPFIELD1.892
FPFIELD1.893
REAL FPFIELD1.894
& rmdi ! IN value of REAL missing data indicator FPFIELD1.895
FPFIELD1.896
& ,in_field1(nx,ny) ! IN first array of input values FPFIELD1.897
& ,in_field2(nx,ny) ! IN second array of input values FPFIELD1.898
FPFIELD1.899
C Output FPFIELD1.900
C ------ FPFIELD1.901
FPFIELD1.902
REAL FPFIELD1.903
& out_field(nx,ny) ! OUT results of multipication FPFIELD1.904
FPFIELD1.905
INTEGER FPFIELD1.906
& icode ! OUT Completion code FPFIELD1.907
FPFIELD1.908
CHARACTER *(*) FPFIELD1.909
& cmessage ! OUT Error message FPFIELD1.910
FPFIELD1.911
FPFIELD1.912
C Local variables FPFIELD1.913
C --------------- FPFIELD1.914
FPFIELD1.915
INTEGER FPFIELD1.916
& ix ! Loop counter over columns FPFIELD1.917
& ,iy ! Loop counter over rows FPFIELD1.918
FPFIELD1.919
FPFIELD1.920
C ------------------------------------------------------------------ FPFIELD1.921
FPFIELD1.922
icode =0 FPFIELD1.923
cmessage="FieldGE: test successful." FPFIELD1.924
FPFIELD1.925
DO iy = 1, ny ! iy: loop over rows FPFIELD1.926
DO ix = 1, nx ! ix: loop over columns FPFIELD1.927
FPFIELD1.928
IF ( in_field1(ix,iy) .NE. rmdi FPFIELD1.929
& .AND. in_field2(ix,iy) .NE. rmdi FPFIELD1.930
& .AND. in_field1(ix,iy).LT.in_field2(ix,iy) ) FPFIELD1.931
FPFIELD1.932
& THEN FPFIELD1.933
FPFIELD1.934
out_field(ix,iy) = in_field1(ix,iy) FPFIELD1.935
FPFIELD1.936
ELSE FPFIELD1.937
FPFIELD1.938
out_field(ix,iy) = rmdi FPFIELD1.939
FPFIELD1.940
END IF FPFIELD1.941
FPFIELD1.942
END DO ! ix: loop over columns FPFIELD1.943
END DO ! iy: loop over columns FPFIELD1.944
FPFIELD1.945
RETURN FPFIELD1.946
END ! Subroutine FieldGE FPFIELD1.947
FPFIELD1.948
FPFIELD1.949
FPFIELD1.950
SUBROUTINE ScalarAdd 3FPFIELD1.951
& (nx, ny, rmdi, FPFIELD1.952
& scalar, in_field, FPFIELD1.953
& out_field, FPFIELD1.954
& icode, cmessage) FPFIELD1.955
FPFIELD1.956
FPFIELD1.957
C ScalarAdd: subroutine to add a scalar to FPFIELD1.958
C ---------- an array. FPFIELD1.959
C Takes account of missing data. FPFIELD1.960
FPFIELD1.961
C Programmer: S J Foreman FPFIELD1.962
C ----------- FPFIELD1.963
FPFIELD1.964
C Method: FPFIELD1.965
C ------- loop over all elements, adding unless either is FPFIELD1.966
C missing, in which case result is missing. FPFIELD1.967
FPFIELD1.968
IMPLICIT NONE FPFIELD1.969
FPFIELD1.970
FPFIELD1.971
C Input: FPFIELD1.972
C ------ FPFIELD1.973
FPFIELD1.974
INTEGER FPFIELD1.975
& nx ! IN number of columns of array FPFIELD1.976
& ,ny ! IN number of rows in array FPFIELD1.977
FPFIELD1.978
REAL FPFIELD1.979
& rmdi ! IN value of REAL missing data indicator FPFIELD1.980
FPFIELD1.981
& ,scalar ! IN scalar FPFIELD1.982
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.983
FPFIELD1.984
C Output FPFIELD1.985
C ------ FPFIELD1.986
FPFIELD1.987
REAL FPFIELD1.988
& out_field(nx,ny) ! OUT results of addition FPFIELD1.989
FPFIELD1.990
INTEGER FPFIELD1.991
& icode ! OUT Completion code FPFIELD1.992
FPFIELD1.993
CHARACTER *(*) FPFIELD1.994
& cmessage ! OUT Error message FPFIELD1.995
FPFIELD1.996
FPFIELD1.997
C Local variables FPFIELD1.998
C --------------- FPFIELD1.999
FPFIELD1.1000
INTEGER FPFIELD1.1001
& ix ! Loop counter over columns FPFIELD1.1002
& ,iy ! Loop counter over rows FPFIELD1.1003
FPFIELD1.1004
FPFIELD1.1005
C ------------------------------------------------------------------ FPFIELD1.1006
FPFIELD1.1007
icode =0 FPFIELD1.1008
cmessage='ScalarAdd: addition successful.' FPFIELD1.1009
FPFIELD1.1010
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1011
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1012
FPFIELD1.1013
IF ( scalar .NE. rmdi FPFIELD1.1014
& .AND. in_field(ix,iy) .NE. rmdi ) FPFIELD1.1015
& THEN FPFIELD1.1016
FPFIELD1.1017
out_field(ix,iy) = scalar + in_field(ix,iy) FPFIELD1.1018
ELSE ! set missing data if either input is missing FPFIELD1.1019
FPFIELD1.1020
out_field(ix,iy) = rmdi FPFIELD1.1021
FPFIELD1.1022
END IF FPFIELD1.1023
FPFIELD1.1024
END DO ! ix: loop over columns FPFIELD1.1025
END DO ! iy: loop over columns FPFIELD1.1026
FPFIELD1.1027
RETURN FPFIELD1.1028
END ! Subroutine ScalarAdd FPFIELD1.1029
FPFIELD1.1030
FPFIELD1.1031
FPFIELD1.1032
SUBROUTINE ScalarSub FPFIELD1.1033
& (nx, ny, rmdi, FPFIELD1.1034
& scalar, in_field, FPFIELD1.1035
& out_field, FPFIELD1.1036
& icode, cmessage) FPFIELD1.1037
FPFIELD1.1038
FPFIELD1.1039
C ScalarSub: subroutine to subtract an array FPFIELD1.1040
C ---------- from a scalar. FPFIELD1.1041
C Takes account of missing data. FPFIELD1.1042
FPFIELD1.1043
C Programmer: S J Foreman FPFIELD1.1044
C ----------- FPFIELD1.1045
FPFIELD1.1046
C Method: FPFIELD1.1047
C ------- loop over all elements, subtracting unless either is FPFIELD1.1048
C missing, in which case result is missing. FPFIELD1.1049
C Scalar - array. FPFIELD1.1050
FPFIELD1.1051
IMPLICIT NONE FPFIELD1.1052
FPFIELD1.1053
FPFIELD1.1054
C Input: FPFIELD1.1055
C ------ FPFIELD1.1056
FPFIELD1.1057
INTEGER FPFIELD1.1058
& nx ! IN number of columns of array FPFIELD1.1059
& ,ny ! IN number of rows in array FPFIELD1.1060
FPFIELD1.1061
REAL FPFIELD1.1062
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1063
FPFIELD1.1064
& ,scalar ! IN scalar FPFIELD1.1065
& ,in_field(nx,ny) ! IN array of input values (subtrahend) FPFIELD1.1066
FPFIELD1.1067
C Output FPFIELD1.1068
C ------ FPFIELD1.1069
FPFIELD1.1070
REAL FPFIELD1.1071
& out_field(nx,ny) ! OUT results of subtraction FPFIELD1.1072
FPFIELD1.1073
INTEGER FPFIELD1.1074
& icode ! OUT Completion code FPFIELD1.1075
FPFIELD1.1076
CHARACTER *(*) FPFIELD1.1077
& cmessage ! OUT Error message FPFIELD1.1078
FPFIELD1.1079
FPFIELD1.1080
C Local variables FPFIELD1.1081
C --------------- FPFIELD1.1082
FPFIELD1.1083
INTEGER FPFIELD1.1084
& ix ! Loop counter over columns FPFIELD1.1085
& ,iy ! Loop counter over rows FPFIELD1.1086
FPFIELD1.1087
FPFIELD1.1088
C ------------------------------------------------------------------ FPFIELD1.1089
FPFIELD1.1090
icode = 0 FPFIELD1.1091
cmessage='ScalarSub: subtraction successful.' FPFIELD1.1092
FPFIELD1.1093
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1094
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1095
FPFIELD1.1096
IF ( scalar .NE. rmdi FPFIELD1.1097
& .AND. in_field(ix,iy) .NE. rmdi ) FPFIELD1.1098
& THEN FPFIELD1.1099
FPFIELD1.1100
out_field(ix,iy) = scalar - in_field(ix,iy) FPFIELD1.1101
FPFIELD1.1102
ELSE ! set missing data if either input is missing FPFIELD1.1103
FPFIELD1.1104
out_field(ix,iy) = rmdi FPFIELD1.1105
FPFIELD1.1106
END IF FPFIELD1.1107
FPFIELD1.1108
END DO ! ix: loop over columns FPFIELD1.1109
END DO ! iy: loop over columns FPFIELD1.1110
FPFIELD1.1111
RETURN FPFIELD1.1112
END ! Subroutine ScalarSub FPFIELD1.1113
FPFIELD1.1114
FPFIELD1.1115
FPFIELD1.1116
SUBROUTINE ScalarMult 5FPFIELD1.1117
& (nx, ny, rmdi, FPFIELD1.1118
& scalar, in_field, FPFIELD1.1119
& out_field, FPFIELD1.1120
& icode, cmessage) FPFIELD1.1121
FPFIELD1.1122
FPFIELD1.1123
C ScalarMult: subroutine to multiply an array FPFIELD1.1124
C ----------- by a scalar. FPFIELD1.1125
C Takes account of missing data. FPFIELD1.1126
FPFIELD1.1127
C Programmer: S J Foreman FPFIELD1.1128
C ----------- FPFIELD1.1129
FPFIELD1.1130
C Method: FPFIELD1.1131
C ------- loop over all elements, multiplying unless either FPFIELD1.1132
C is missing, in which case result is missing. FPFIELD1.1133
C Scalar*array. FPFIELD1.1134
FPFIELD1.1135
IMPLICIT NONE FPFIELD1.1136
FPFIELD1.1137
FPFIELD1.1138
C Input: FPFIELD1.1139
C ------ FPFIELD1.1140
FPFIELD1.1141
INTEGER FPFIELD1.1142
& nx ! IN number of columns of array FPFIELD1.1143
& ,ny ! IN number of rows in array FPFIELD1.1144
FPFIELD1.1145
REAL FPFIELD1.1146
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1147
FPFIELD1.1148
& ,scalar ! IN scalar FPFIELD1.1149
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.1150
FPFIELD1.1151
C Output FPFIELD1.1152
C ------ FPFIELD1.1153
FPFIELD1.1154
REAL FPFIELD1.1155
& out_field(nx,ny) ! OUT results of multiplication FPFIELD1.1156
FPFIELD1.1157
INTEGER FPFIELD1.1158
& icode ! OUT Completion code FPFIELD1.1159
FPFIELD1.1160
CHARACTER *(*) FPFIELD1.1161
& cmessage ! OUT Error message FPFIELD1.1162
FPFIELD1.1163
FPFIELD1.1164
C Local variables FPFIELD1.1165
C --------------- FPFIELD1.1166
FPFIELD1.1167
INTEGER FPFIELD1.1168
& ix ! Loop counter over columns FPFIELD1.1169
& ,iy ! Loop counter over rows FPFIELD1.1170
FPFIELD1.1171
FPFIELD1.1172
C ------------------------------------------------------------------ FPFIELD1.1173
FPFIELD1.1174
icode = 0 FPFIELD1.1175
cmessage='ScalarMult: multiplication successful.' FPFIELD1.1176
FPFIELD1.1177
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1178
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1179
IF ( scalar .NE. rmdi FPFIELD1.1180
& .AND. in_field(ix,iy) .NE. rmdi ) FPFIELD1.1181
& THEN FPFIELD1.1182
FPFIELD1.1183
out_field(ix,iy) = scalar * in_field(ix,iy) FPFIELD1.1184
FPFIELD1.1185
ELSE ! set missing data if either input is missing FPFIELD1.1186
FPFIELD1.1187
out_field(ix,iy) = rmdi FPFIELD1.1188
FPFIELD1.1189
END IF FPFIELD1.1190
FPFIELD1.1191
END DO ! ix: loop over columns FPFIELD1.1192
END DO ! iy: loop over columns FPFIELD1.1193
FPFIELD1.1194
RETURN FPFIELD1.1195
END ! Subroutine ScalarMult FPFIELD1.1196
FPFIELD1.1197
FPFIELD1.1198
FPFIELD1.1199
SUBROUTINE ScalarDiv FPFIELD1.1200
& (nx, ny, rmdi, FPFIELD1.1201
& scalar, in_field, FPFIELD1.1202
& out_field, FPFIELD1.1203
& icode, cmessage) FPFIELD1.1204
FPFIELD1.1205
FPFIELD1.1206
C ScalarDiv: subroutine to divide a scalar by FPFIELD1.1207
C ---------- an array. FPFIELD1.1208
C Takes account of missing data. FPFIELD1.1209
FPFIELD1.1210
C Programmer: S J Foreman FPFIELD1.1211
C ----------- FPFIELD1.1212
FPFIELD1.1213
C Method: FPFIELD1.1214
C ------- loop over all elements, dividing unless either is FPFIELD1.1215
C missing or divisor is zero, in which case result FPFIELD1.1216
C is missing. FPFIELD1.1217
FPFIELD1.1218
IMPLICIT NONE FPFIELD1.1219
FPFIELD1.1220
FPFIELD1.1221
C Input: FPFIELD1.1222
C ------ FPFIELD1.1223
FPFIELD1.1224
INTEGER FPFIELD1.1225
& nx ! IN number of columns of array FPFIELD1.1226
& ,ny ! IN number of rows in array FPFIELD1.1227
FPFIELD1.1228
REAL FPFIELD1.1229
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1230
FPFIELD1.1231
& ,scalar ! IN scalar (numerator) FPFIELD1.1232
& ,in_field(nx,ny) ! IN array of input values (denominator) FPFIELD1.1233
FPFIELD1.1234
C Output FPFIELD1.1235
C ------ FPFIELD1.1236
FPFIELD1.1237
REAL FPFIELD1.1238
& out_field(nx,ny) ! OUT results of division FPFIELD1.1239
FPFIELD1.1240
INTEGER FPFIELD1.1241
& icode ! OUT Completion code FPFIELD1.1242
FPFIELD1.1243
CHARACTER *(*) FPFIELD1.1244
& cmessage ! OUT Error message FPFIELD1.1245
FPFIELD1.1246
FPFIELD1.1247
C Local variables FPFIELD1.1248
C --------------- FPFIELD1.1249
FPFIELD1.1250
INTEGER FPFIELD1.1251
& ix ! Loop counter over columns FPFIELD1.1252
& ,iy ! Loop counter over rows FPFIELD1.1253
FPFIELD1.1254
FPFIELD1.1255
C ------------------------------------------------------------------ FPFIELD1.1256
FPFIELD1.1257
icode =0 FPFIELD1.1258
cmessage='ScalarDiv: division successful.' FPFIELD1.1259
FPFIELD1.1260
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1261
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1262
FPFIELD1.1263
IF ( scalar .NE. rmdi FPFIELD1.1264
& .AND. in_field(ix,iy) .NE. rmdi ) FPFIELD1.1265
& THEN FPFIELD1.1266
FPFIELD1.1267
IF ( in_field(ix,iy) .NE. 0.0 ) FPFIELD1.1268
FPFIELD1.1269
& THEN ! divide FPFIELD1.1270
out_field(ix,iy) = scalar/in_field(ix,iy) FPFIELD1.1271
FPFIELD1.1272
ELSE ! avoid division by zero FPFIELD1.1273
icode = 4 FPFIELD1.1274
out_field(ix,iy) = rmdi FPFIELD1.1275
END IF FPFIELD1.1276
FPFIELD1.1277
ELSE ! set missing data if either input is missing FPFIELD1.1278
FPFIELD1.1279
out_field(ix,iy) = rmdi FPFIELD1.1280
FPFIELD1.1281
END IF FPFIELD1.1282
FPFIELD1.1283
END DO ! ix: loop over columns FPFIELD1.1284
END DO ! iy: loop over columns FPFIELD1.1285
FPFIELD1.1286
C Set appropriate error message if division by zero has occurred FPFIELD1.1287
FPFIELD1.1288
IF (icode .NE. 0) THEN FPFIELD1.1289
cmessage = 'ScalarDiv: division by zero' FPFIELD1.1290
END IF FPFIELD1.1291
FPFIELD1.1292
RETURN FPFIELD1.1293
END ! Subroutine ScalarDiv FPFIELD1.1294
FPFIELD1.1295
SUBROUTINE ScalarCopy FPFIELD1.1296
& (nx, ny, rmdi, FPFIELD1.1297
& scalar, FPFIELD1.1298
& out_field, FPFIELD1.1299
& icode, cmessage) FPFIELD1.1300
FPFIELD1.1301
FPFIELD1.1302
C ScalarCopy: subroutine to copy a scalar to FPFIELD1.1303
C ---------- an array. FPFIELD1.1304
FPFIELD1.1305
C Programmer: S J Foreman FPFIELD1.1306
C ----------- FPFIELD1.1307
FPFIELD1.1308
C Method: FPFIELD1.1309
C ------- loop over all elements. FPFIELD1.1310
FPFIELD1.1311
IMPLICIT NONE FPFIELD1.1312
FPFIELD1.1313
FPFIELD1.1314
C Input: FPFIELD1.1315
C ------ FPFIELD1.1316
FPFIELD1.1317
INTEGER FPFIELD1.1318
& nx ! IN number of columns of array FPFIELD1.1319
& ,ny ! IN number of rows in array FPFIELD1.1320
FPFIELD1.1321
REAL FPFIELD1.1322
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1323
FPFIELD1.1324
& ,scalar ! IN scalar FPFIELD1.1325
FPFIELD1.1326
C Output FPFIELD1.1327
C ------ FPFIELD1.1328
FPFIELD1.1329
REAL FPFIELD1.1330
& out_field(nx,ny) ! OUT results of addition FPFIELD1.1331
FPFIELD1.1332
INTEGER FPFIELD1.1333
& icode ! OUT Completion code FPFIELD1.1334
FPFIELD1.1335
CHARACTER *(*) FPFIELD1.1336
& cmessage ! OUT Error message FPFIELD1.1337
FPFIELD1.1338
FPFIELD1.1339
C Local variables FPFIELD1.1340
C --------------- FPFIELD1.1341
FPFIELD1.1342
INTEGER FPFIELD1.1343
& ix ! Loop counter over columns FPFIELD1.1344
& ,iy ! Loop counter over rows FPFIELD1.1345
FPFIELD1.1346
FPFIELD1.1347
C ------------------------------------------------------------------ FPFIELD1.1348
FPFIELD1.1349
icode =0 FPFIELD1.1350
cmessage='ScalarCopy: copy successful.' FPFIELD1.1351
FPFIELD1.1352
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1353
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1354
FPFIELD1.1355
FPFIELD1.1356
out_field(ix,iy) = scalar FPFIELD1.1357
FPFIELD1.1358
END DO ! ix: loop over columns FPFIELD1.1359
END DO ! iy: loop over columns FPFIELD1.1360
FPFIELD1.1361
RETURN FPFIELD1.1362
END ! Subroutine ScalarCopy FPFIELD1.1363
FPFIELD1.1364
FPFIELD1.1365
SUBROUTINE ScalarEQ FPFIELD1.1366
& (nx, ny, rmdi, FPFIELD1.1367
& scalar, in_field, FPFIELD1.1368
& out_field, FPFIELD1.1369
& icode, cmessage) FPFIELD1.1370
FPFIELD1.1371
FPFIELD1.1372
C ScalarEQ: Set MDI if field equals scalar FPFIELD1.1373
C ----------- FPFIELD1.1374
C Takes account of missing data. FPFIELD1.1375
FPFIELD1.1376
C Programmer: S J Foreman FPFIELD1.1377
C ----------- FPFIELD1.1378
FPFIELD1.1379
C Method: FPFIELD1.1380
C ------- loop over all elements FPFIELD1.1381
C FPFIELD1.1382
FPFIELD1.1383
IMPLICIT NONE FPFIELD1.1384
FPFIELD1.1385
FPFIELD1.1386
C Input: FPFIELD1.1387
C ------ FPFIELD1.1388
FPFIELD1.1389
INTEGER FPFIELD1.1390
& nx ! IN number of columns of array FPFIELD1.1391
& ,ny ! IN number of rows in array FPFIELD1.1392
FPFIELD1.1393
REAL FPFIELD1.1394
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1395
FPFIELD1.1396
& ,scalar ! IN scalar FPFIELD1.1397
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.1398
FPFIELD1.1399
C Output FPFIELD1.1400
C ------ FPFIELD1.1401
FPFIELD1.1402
REAL FPFIELD1.1403
& out_field(nx,ny) ! OUT results of test FPFIELD1.1404
FPFIELD1.1405
INTEGER FPFIELD1.1406
& icode ! OUT Completion code FPFIELD1.1407
FPFIELD1.1408
CHARACTER *(*) FPFIELD1.1409
& cmessage ! OUT Error message FPFIELD1.1410
FPFIELD1.1411
FPFIELD1.1412
C Local variables FPFIELD1.1413
C --------------- FPFIELD1.1414
FPFIELD1.1415
INTEGER FPFIELD1.1416
& ix ! Loop counter over columns FPFIELD1.1417
& ,iy ! Loop counter over rows FPFIELD1.1418
FPFIELD1.1419
FPFIELD1.1420
C ------------------------------------------------------------------ FPFIELD1.1421
FPFIELD1.1422
icode =0 FPFIELD1.1423
cmessage='ScalarEQ: equality test successful.' FPFIELD1.1424
FPFIELD1.1425
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1426
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1427
FPFIELD1.1428
IF ( scalar .NE. in_field(ix,iy) ) THEN FPFIELD1.1429
FPFIELD1.1430
out_field(ix,iy) = in_field(ix,iy) FPFIELD1.1431
FPFIELD1.1432
ELSE ! set missing data if either input is missing FPFIELD1.1433
FPFIELD1.1434
out_field(ix,iy) = rmdi FPFIELD1.1435
FPFIELD1.1436
END IF FPFIELD1.1437
FPFIELD1.1438
END DO ! ix: loop over columns FPFIELD1.1439
END DO ! iy: loop over columns FPFIELD1.1440
FPFIELD1.1441
RETURN FPFIELD1.1442
END ! Subroutine ScalarEQ FPFIELD1.1443
FPFIELD1.1444
SUBROUTINE ScalarNE FPFIELD1.1445
& (nx, ny, rmdi, FPFIELD1.1446
& scalar, in_field, FPFIELD1.1447
& out_field, FPFIELD1.1448
& icode, cmessage) FPFIELD1.1449
FPFIELD1.1450
FPFIELD1.1451
C ScalarNE: Set MDI if field not equal to scalar FPFIELD1.1452
C ----------- FPFIELD1.1453
C Takes account of missing data. FPFIELD1.1454
FPFIELD1.1455
C Programmer: S J Foreman FPFIELD1.1456
C ----------- FPFIELD1.1457
FPFIELD1.1458
C Method: FPFIELD1.1459
C ------- loop over all elements FPFIELD1.1460
C FPFIELD1.1461
FPFIELD1.1462
IMPLICIT NONE FPFIELD1.1463
FPFIELD1.1464
FPFIELD1.1465
C Input: FPFIELD1.1466
C ------ FPFIELD1.1467
FPFIELD1.1468
INTEGER FPFIELD1.1469
& nx ! IN number of columns of array FPFIELD1.1470
& ,ny ! IN number of rows in array FPFIELD1.1471
FPFIELD1.1472
REAL FPFIELD1.1473
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1474
FPFIELD1.1475
& ,scalar ! IN scalar FPFIELD1.1476
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.1477
FPFIELD1.1478
C Output FPFIELD1.1479
C ------ FPFIELD1.1480
FPFIELD1.1481
REAL FPFIELD1.1482
& out_field(nx,ny) ! OUT results of test FPFIELD1.1483
FPFIELD1.1484
INTEGER FPFIELD1.1485
& icode ! OUT Completion code FPFIELD1.1486
FPFIELD1.1487
CHARACTER *(*) FPFIELD1.1488
& cmessage ! OUT Error message FPFIELD1.1489
FPFIELD1.1490
FPFIELD1.1491
C Local variables FPFIELD1.1492
C --------------- FPFIELD1.1493
FPFIELD1.1494
INTEGER FPFIELD1.1495
& ix ! Loop counter over columns FPFIELD1.1496
& ,iy ! Loop counter over rows FPFIELD1.1497
FPFIELD1.1498
FPFIELD1.1499
C ------------------------------------------------------------------ FPFIELD1.1500
FPFIELD1.1501
icode =0 FPFIELD1.1502
cmessage='ScalarNE: non-equality test successful.' FPFIELD1.1503
FPFIELD1.1504
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1505
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1506
FPFIELD1.1507
IF ( scalar .EQ. in_field(ix,iy) ) THEN FPFIELD1.1508
FPFIELD1.1509
out_field(ix,iy) = in_field(ix,iy) FPFIELD1.1510
FPFIELD1.1511
ELSE ! set missing data if either input is missing FPFIELD1.1512
FPFIELD1.1513
out_field(ix,iy) = rmdi FPFIELD1.1514
FPFIELD1.1515
END IF FPFIELD1.1516
FPFIELD1.1517
END DO ! ix: loop over columns FPFIELD1.1518
END DO ! iy: loop over columns FPFIELD1.1519
FPFIELD1.1520
RETURN FPFIELD1.1521
END ! Subroutine ScalarNE FPFIELD1.1522
FPFIELD1.1523
SUBROUTINE ScalarLE FPFIELD1.1524
& (nx, ny, rmdi, FPFIELD1.1525
& scalar, in_field, FPFIELD1.1526
& out_field, FPFIELD1.1527
& icode, cmessage) FPFIELD1.1528
FPFIELD1.1529
FPFIELD1.1530
C ScalarLE: Set MDI if scalar <= field FPFIELD1.1531
C ----------- FPFIELD1.1532
C Takes account of missing data. FPFIELD1.1533
FPFIELD1.1534
C Programmer: S J Foreman FPFIELD1.1535
C ----------- FPFIELD1.1536
FPFIELD1.1537
C Method: FPFIELD1.1538
C ------- loop over all elements FPFIELD1.1539
C FPFIELD1.1540
FPFIELD1.1541
IMPLICIT NONE FPFIELD1.1542
FPFIELD1.1543
FPFIELD1.1544
C Input: FPFIELD1.1545
C ------ FPFIELD1.1546
FPFIELD1.1547
INTEGER FPFIELD1.1548
& nx ! IN number of columns of array FPFIELD1.1549
& ,ny ! IN number of rows in array FPFIELD1.1550
FPFIELD1.1551
REAL FPFIELD1.1552
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1553
FPFIELD1.1554
& ,scalar ! IN scalar FPFIELD1.1555
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.1556
FPFIELD1.1557
C Output FPFIELD1.1558
C ------ FPFIELD1.1559
FPFIELD1.1560
REAL FPFIELD1.1561
& out_field(nx,ny) ! OUT results of test FPFIELD1.1562
FPFIELD1.1563
INTEGER FPFIELD1.1564
& icode ! OUT Completion code FPFIELD1.1565
FPFIELD1.1566
CHARACTER *(*) FPFIELD1.1567
& cmessage ! OUT Error message FPFIELD1.1568
FPFIELD1.1569
FPFIELD1.1570
C Local variables FPFIELD1.1571
C --------------- FPFIELD1.1572
FPFIELD1.1573
INTEGER FPFIELD1.1574
& ix ! Loop counter over columns FPFIELD1.1575
& ,iy ! Loop counter over rows FPFIELD1.1576
FPFIELD1.1577
FPFIELD1.1578
C ------------------------------------------------------------------ FPFIELD1.1579
FPFIELD1.1580
icode =0 FPFIELD1.1581
cmessage='ScalarLE: test successful.' FPFIELD1.1582
FPFIELD1.1583
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1584
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1585
FPFIELD1.1586
IF ( scalar .GT. in_field(ix,iy) ) THEN FPFIELD1.1587
FPFIELD1.1588
out_field(ix,iy) = in_field(ix,iy) FPFIELD1.1589
FPFIELD1.1590
ELSE ! set missing data if either input is missing FPFIELD1.1591
FPFIELD1.1592
out_field(ix,iy) = rmdi FPFIELD1.1593
FPFIELD1.1594
END IF FPFIELD1.1595
FPFIELD1.1596
END DO ! ix: loop over columns FPFIELD1.1597
END DO ! iy: loop over columns FPFIELD1.1598
FPFIELD1.1599
RETURN FPFIELD1.1600
END ! Subroutine ScalarLE FPFIELD1.1601
FPFIELD1.1602
SUBROUTINE ScalarGE FPFIELD1.1603
& (nx, ny, rmdi, FPFIELD1.1604
& scalar, in_field, FPFIELD1.1605
& out_field, FPFIELD1.1606
& icode, cmessage) FPFIELD1.1607
FPFIELD1.1608
FPFIELD1.1609
C ScalarGE: Set MDI if scalar >= field FPFIELD1.1610
C ----------- FPFIELD1.1611
C Takes account of missing data. FPFIELD1.1612
FPFIELD1.1613
C Programmer: S J Foreman FPFIELD1.1614
C ----------- FPFIELD1.1615
FPFIELD1.1616
C Method: FPFIELD1.1617
C ------- loop over all elements FPFIELD1.1618
C FPFIELD1.1619
FPFIELD1.1620
IMPLICIT NONE FPFIELD1.1621
FPFIELD1.1622
FPFIELD1.1623
C Input: FPFIELD1.1624
C ------ FPFIELD1.1625
FPFIELD1.1626
INTEGER FPFIELD1.1627
& nx ! IN number of columns of array FPFIELD1.1628
& ,ny ! IN number of rows in array FPFIELD1.1629
FPFIELD1.1630
REAL FPFIELD1.1631
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1632
FPFIELD1.1633
& ,scalar ! IN scalar FPFIELD1.1634
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.1635
FPFIELD1.1636
C Output FPFIELD1.1637
C ------ FPFIELD1.1638
FPFIELD1.1639
REAL FPFIELD1.1640
& out_field(nx,ny) ! OUT results of test FPFIELD1.1641
FPFIELD1.1642
INTEGER FPFIELD1.1643
& icode ! OUT Completion code FPFIELD1.1644
FPFIELD1.1645
CHARACTER *(*) FPFIELD1.1646
& cmessage ! OUT Error message FPFIELD1.1647
FPFIELD1.1648
FPFIELD1.1649
C Local variables FPFIELD1.1650
C --------------- FPFIELD1.1651
FPFIELD1.1652
INTEGER FPFIELD1.1653
& ix ! Loop counter over columns FPFIELD1.1654
& ,iy ! Loop counter over rows FPFIELD1.1655
FPFIELD1.1656
FPFIELD1.1657
C ------------------------------------------------------------------ FPFIELD1.1658
FPFIELD1.1659
icode =0 FPFIELD1.1660
cmessage='ScalarGE: test successful.' FPFIELD1.1661
FPFIELD1.1662
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1663
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1664
FPFIELD1.1665
IF ( scalar .LT. in_field(ix,iy) ) THEN FPFIELD1.1666
FPFIELD1.1667
out_field(ix,iy) = in_field(ix,iy) FPFIELD1.1668
FPFIELD1.1669
ELSE ! set missing data if either input is missing FPFIELD1.1670
FPFIELD1.1671
out_field(ix,iy) = rmdi FPFIELD1.1672
FPFIELD1.1673
END IF FPFIELD1.1674
FPFIELD1.1675
END DO ! ix: loop over columns FPFIELD1.1676
END DO ! iy: loop over columns FPFIELD1.1677
FPFIELD1.1678
RETURN FPFIELD1.1679
END ! Subroutine ScalarGE FPFIELD1.1680
FPFIELD1.1681
SUBROUTINE ScalarGT FPFIELD1.1682
& (nx, ny, rmdi, FPFIELD1.1683
& scalar, in_field, FPFIELD1.1684
& out_field, FPFIELD1.1685
& icode, cmessage) FPFIELD1.1686
FPFIELD1.1687
FPFIELD1.1688
C ScalarGT: Set MDI if scalar > field FPFIELD1.1689
C ----------- FPFIELD1.1690
C Takes account of missing data. FPFIELD1.1691
FPFIELD1.1692
C Programmer: S J Foreman FPFIELD1.1693
C ----------- FPFIELD1.1694
FPFIELD1.1695
C Method: FPFIELD1.1696
C ------- loop over all elements FPFIELD1.1697
C FPFIELD1.1698
FPFIELD1.1699
IMPLICIT NONE FPFIELD1.1700
FPFIELD1.1701
FPFIELD1.1702
C Input: FPFIELD1.1703
C ------ FPFIELD1.1704
FPFIELD1.1705
INTEGER FPFIELD1.1706
& nx ! IN number of columns of array FPFIELD1.1707
& ,ny ! IN number of rows in array FPFIELD1.1708
FPFIELD1.1709
REAL FPFIELD1.1710
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1711
FPFIELD1.1712
& ,scalar ! IN scalar FPFIELD1.1713
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.1714
FPFIELD1.1715
C Output FPFIELD1.1716
C ------ FPFIELD1.1717
FPFIELD1.1718
REAL FPFIELD1.1719
& out_field(nx,ny) ! OUT results of test FPFIELD1.1720
FPFIELD1.1721
INTEGER FPFIELD1.1722
& icode ! OUT Completion code FPFIELD1.1723
FPFIELD1.1724
CHARACTER *(*) FPFIELD1.1725
& cmessage ! OUT Error message FPFIELD1.1726
FPFIELD1.1727
FPFIELD1.1728
C Local variables FPFIELD1.1729
C --------------- FPFIELD1.1730
FPFIELD1.1731
INTEGER FPFIELD1.1732
& ix ! Loop counter over columns FPFIELD1.1733
& ,iy ! Loop counter over rows FPFIELD1.1734
FPFIELD1.1735
FPFIELD1.1736
C ------------------------------------------------------------------ FPFIELD1.1737
FPFIELD1.1738
icode =0 FPFIELD1.1739
cmessage='ScalarGT: test successful.' FPFIELD1.1740
FPFIELD1.1741
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1742
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1743
FPFIELD1.1744
IF ( scalar .LE. in_field(ix,iy) ) THEN FPFIELD1.1745
FPFIELD1.1746
out_field(ix,iy) = in_field(ix,iy) FPFIELD1.1747
FPFIELD1.1748
ELSE ! set missing data if either input is missing FPFIELD1.1749
FPFIELD1.1750
out_field(ix,iy) = rmdi FPFIELD1.1751
FPFIELD1.1752
END IF FPFIELD1.1753
FPFIELD1.1754
END DO ! ix: loop over columns FPFIELD1.1755
END DO ! iy: loop over columns FPFIELD1.1756
FPFIELD1.1757
RETURN FPFIELD1.1758
END ! Subroutine ScalarGT FPFIELD1.1759
FPFIELD1.1760
SUBROUTINE ScalarLT FPFIELD1.1761
& (nx, ny, rmdi, FPFIELD1.1762
& scalar, in_field, FPFIELD1.1763
& out_field, FPFIELD1.1764
& icode, cmessage) FPFIELD1.1765
FPFIELD1.1766
FPFIELD1.1767
C ScalarLT: Set MDI if scalar < field FPFIELD1.1768
C ----------- FPFIELD1.1769
C Takes account of missing data. FPFIELD1.1770
FPFIELD1.1771
C Programmer: S J Foreman FPFIELD1.1772
C ----------- FPFIELD1.1773
FPFIELD1.1774
C Method: FPFIELD1.1775
C ------- loop over all elements FPFIELD1.1776
C FPFIELD1.1777
FPFIELD1.1778
IMPLICIT NONE FPFIELD1.1779
FPFIELD1.1780
FPFIELD1.1781
C Input: FPFIELD1.1782
C ------ FPFIELD1.1783
FPFIELD1.1784
INTEGER FPFIELD1.1785
& nx ! IN number of columns of array FPFIELD1.1786
& ,ny ! IN number of rows in array FPFIELD1.1787
FPFIELD1.1788
REAL FPFIELD1.1789
& rmdi ! IN value of REAL missing data indicator FPFIELD1.1790
FPFIELD1.1791
& ,scalar ! IN scalar FPFIELD1.1792
& ,in_field(nx,ny) ! IN array of input values FPFIELD1.1793
FPFIELD1.1794
C Output FPFIELD1.1795
C ------ FPFIELD1.1796
FPFIELD1.1797
REAL FPFIELD1.1798
& out_field(nx,ny) ! OUT results of test FPFIELD1.1799
FPFIELD1.1800
INTEGER FPFIELD1.1801
& icode ! OUT Completion code FPFIELD1.1802
FPFIELD1.1803
CHARACTER *(*) FPFIELD1.1804
& cmessage ! OUT Error message FPFIELD1.1805
FPFIELD1.1806
FPFIELD1.1807
C Local variables FPFIELD1.1808
C --------------- FPFIELD1.1809
FPFIELD1.1810
INTEGER FPFIELD1.1811
& ix ! Loop counter over columns FPFIELD1.1812
& ,iy ! Loop counter over rows FPFIELD1.1813
FPFIELD1.1814
FPFIELD1.1815
C ------------------------------------------------------------------ FPFIELD1.1816
FPFIELD1.1817
icode =0 FPFIELD1.1818
cmessage='ScalarLT: test successful.' FPFIELD1.1819
FPFIELD1.1820
DO iy = 1, ny ! iy: loop over rows FPFIELD1.1821
DO ix = 1, nx ! ix: loop over columns FPFIELD1.1822
FPFIELD1.1823
IF ( scalar .GE. in_field(ix,iy) ) THEN FPFIELD1.1824
FPFIELD1.1825
out_field(ix,iy) = in_field(ix,iy) FPFIELD1.1826
FPFIELD1.1827
ELSE ! set missing data if either input is missing FPFIELD1.1828
FPFIELD1.1829
out_field(ix,iy) = rmdi FPFIELD1.1830
FPFIELD1.1831
END IF FPFIELD1.1832
FPFIELD1.1833
END DO ! ix: loop over columns FPFIELD1.1834
END DO ! iy: loop over columns FPFIELD1.1835
FPFIELD1.1836
RETURN FPFIELD1.1837
END ! Subroutine ScalarLT FPFIELD1.1838
!---------------------------------------------------------------------- FPFIELD1.1839
*ENDIF FPFIELD1.1840