PROGRAM MAIN_MERGE ,26MERGE1A.32
MERGE1A.33
IMPLICIT NONE MERGE1A.34
MERGE1A.35
INTEGER MERGE1A.36
& FIXHD1(256) !Space for fixed length header file 1 MERGE1A.37
&,INTHD1(100) !Space for integer header file 1 MERGE1A.38
&,LOOKUP1(128) !Space for lookup record file 1 MERGE1A.39
MERGE1A.40
INTEGER MERGE1A.41
& FIXHD2(256) !Space for fixed length header file 2 MERGE1A.42
&,INTHD2(100) !Space for integer header file 2 MERGE1A.43
&,LOOKUP2(128) !Space for lookup record file 2 MERGE1A.44
MERGE1A.45
INTEGER MERGE1A.46
& LEN_FIXHD1 !Length of fixed length header on file 1 MERGE1A.47
&,LEN_INTHD1 !Length of integer header on file 1 MERGE1A.48
&,LEN_REALHD1 !Length of real header on file 1 MERGE1A.49
&,LEN1_LEVDEPC1 !1st dim of lev dependent consts on file 1 MERGE1A.50
&,LEN2_LEVDEPC1 !2nd dim of lev dependent consts on file 1 MERGE1A.51
&,LEN1_ROWDEPC1 !1st dim of row dependent consts on file 1 MERGE1A.52
&,LEN2_ROWDEPC1 !2nd dim of row dependent consts on file 1 MERGE1A.53
&,LEN1_COLDEPC1 !1st dim of col dependent consts on file 1 MERGE1A.54
&,LEN2_COLDEPC1 !2nd dim of col dependent consts on file 1 MERGE1A.55
&,LEN1_FLDDEPC1 !1st dim of field dependent consts on file 1 MERGE1A.56
&,LEN2_FLDDEPC1 !2nd dim of field dependent consts on file 1 MERGE1A.57
&,LEN_EXTCNST1 !Length of extra consts on file 1 MERGE1A.58
&,LEN_DUMPHIST1 !Length of history header on file 1 MERGE1A.59
&,LEN_CFI11 !Length of index1 on file 1 MERGE1A.60
&,LEN_CFI21 !Length of index2 on file 1 MERGE1A.61
&,LEN_CFI31 !Length of index3 on file 1 MERGE1A.62
&,LEN1_LOOKUP1 !1st dim of LOOKUP on file 1 MERGE1A.63
&,LEN2_LOOKUP1 !2nd dim of LOOKUP on file 1 MERGE1A.64
&,LEN_DATA1 !Length of data on file 1 MERGE1A.65
&,ROW_LENGTH1 !No of points E-W on file 1 MERGE1A.66
&,P_ROWS1 !No of p-rows on file 1 MERGE1A.67
&,P_FIELD1 !No of p-points per level on file 1 MERGE1A.68
MERGE1A.69
INTEGER MERGE1A.70
& LEN_FIXHD2 !Length of fixed length header on file 2 MERGE1A.71
&,LEN_INTHD2 !Length of integer header on file 2 MERGE1A.72
&,LEN_REALHD2 !Length of real header on file 2 MERGE1A.73
&,LEN1_LEVDEPC2 !1st dim of lev dependent consts on file 2 MERGE1A.74
&,LEN2_LEVDEPC2 !2nd dim of lev dependent consts on file 2 MERGE1A.75
&,LEN1_ROWDEPC2 !1st dim of row dependent consts on file 2 MERGE1A.76
&,LEN2_ROWDEPC2 !2nd dim of row dependent consts on file 2 MERGE1A.77
&,LEN1_COLDEPC2 !1st dim of col dependent consts on file 2 MERGE1A.78
&,LEN2_COLDEPC2 !2nd dim of col dependent consts on file 2 MERGE1A.79
&,LEN1_FLDDEPC2 !1st dim of field dependent consts on file 2 MERGE1A.80
&,LEN2_FLDDEPC2 !2nd dim of field dependent consts on file 2 MERGE1A.81
&,LEN_EXTCNST2 !Length of extra consts on file 2 MERGE1A.82
&,LEN_DUMPHIST2 !Length of history header on file 2 MERGE1A.83
&,LEN_CFI12 !Length of index1 on file 2 MERGE1A.84
&,LEN_CFI22 !Length of index2 on file 2 MERGE1A.85
&,LEN_CFI32 !Length of index3 on file 2 MERGE1A.86
&,LEN1_LOOKUP2 !1st dim of LOOKUP on file 2 MERGE1A.87
&,LEN2_LOOKUP2 !2nd dim of LOOKUP on file 2 MERGE1A.88
&,LEN_DATA2 !Length of data on file 2 MERGE1A.89
&,ROW_LENGTH2 !No of points E-W on file 2 MERGE1A.90
&,P_ROWS2 !No of p-rows on file 2 MERGE1A.91
&,P_FIELD2 !No of p-points per level on file 2 MERGE1A.92
MERGE1A.93
INTEGER MERGE1A.94
& LEN_FIXHD3 !Length of fixed length header on file 3 MERGE1A.95
&,LEN_INTHD3 !Length of integer header on file 3 MERGE1A.96
&,LEN_REALHD3 !Length of real header on file 3 MERGE1A.97
&,LEN1_LEVDEPC3 !1st dim of lev dependent consts on file 3 MERGE1A.98
&,LEN2_LEVDEPC3 !2nd dim of lev dependent consts on file 3 MERGE1A.99
&,LEN1_ROWDEPC3 !1st dim of row dependent consts on file 3 MERGE1A.100
&,LEN2_ROWDEPC3 !2nd dim of row dependent consts on file 3 MERGE1A.101
&,LEN1_COLDEPC3 !1st dim of col dependent consts on file 3 MERGE1A.102
&,LEN2_COLDEPC3 !2nd dim of col dependent consts on file 3 MERGE1A.103
&,LEN1_FLDDEPC3 !1st dim of field dependent consts on file 3 MERGE1A.104
&,LEN2_FLDDEPC3 !2nd dim of field dependent consts on file 3 MERGE1A.105
&,LEN_EXTCNST3 !Length of extra consts on file 3 MERGE1A.106
&,LEN_DUMPHIST3 !Length of history header on file 3 MERGE1A.107
&,LEN_CFI13 !Length of index1 on file 3 MERGE1A.108
&,LEN_CFI23 !Length of index2 on file 3 MERGE1A.109
&,LEN_CFI33 !Length of index3 on file 3 MERGE1A.110
&,LEN1_LOOKUP3 !1st dim of LOOKUP on file 3 MERGE1A.111
&,LEN2_LOOKUP3 !2nd dim of LOOKUP on file 3 MERGE1A.112
&,LEN_DATA3 !Length of data on file 3 MERGE1A.113
&,ROW_LENGTH3 !No of points E-W on file 3 MERGE1A.114
&,P_ROWS3 !No of p-rows on file 3 MERGE1A.115
&,P_FIELD3 !No of p-points per level on file 3 MERGE1A.116
MERGE1A.117
MERGE1A.118
INTEGER ERR !Return code from open UDG7F400.280
INTEGER I !Loop index UDG7F400.281
INTEGER LEN_IO !Length of I/O returned by BUFFER IN UDG7F400.282
INTEGER MAX_LEN1 !Length of longest data record in file 1 UDG7F400.283
INTEGER MAX_LEN2 !Length of longest data record in file 2 UDG7F400.284
INTEGER NFTIN1 !Unit number of input UM file 1 UDG7F400.285
INTEGER NFTIN2 !Unit number of input UM file 2 UDG7F400.286
UDG7F400.287
INTEGER ErrorStatus !Error code returned from FILE_OPEN UDG7F400.288
INTEGER OpenStatus !Error code returned from GET_FILE UDG7F400.289
INTEGER ICODE !Error code returned from SETPOS UDG7F400.290
UDG7F400.291
REAL A !BUFFER IN UNIT function UDG7F400.292
UDG7F400.293
CHARACTER*80 FILENAME !Name of user preSTASHmaster file UDG7F400.294
UDG7F400.295
MERGE1A.129
*CALL CNTL_IO 
UDG1F405.796
MERGE1A.130
C External subroutines called:------------------------------------------ MERGE1A.131
EXTERNAL IOERROR,ABORT_IO,BUFFIN,FILE_OPEN,SETPOS,ABORT,MERGE GPB1F305.87
C*---------------------------------------------------------------------- MERGE1A.133
MERGE1A.134
CL 1. Assign unit numbers MERGE1A.135
MERGE1A.136
NFTIN1=20 MERGE1A.137
NFTIN2=21 MERGE1A.138
MERGE1A.139
WRITE(6,*) " " UDG7F400.310
WRITE(6,*)' MERGE UTILITY' MERGE1A.140
WRITE(6,*)' -------------' MERGE1A.141
WRITE(6,*)' ' MERGE1A.142
MERGE1A.143
WRITE(6,'(20x,''FILE STATUS'')') MERGE1A.144
WRITE(6,'(20x,''==========='')') MERGE1A.145
CALL FILE_OPEN(NFTIN1,'FILE1',5,0,0,ERR) GPB1F305.89
CALL FILE_OPEN(NFTIN2,'FILE2',5,0,0,ERR) GPB1F305.90
MERGE1A.149
CL 2. Buffer in fixed length header record from file 1 MERGE1A.150
MERGE1A.151
CALL BUFFIN(NFTIN1,FIXHD1,256,LEN_IO,A) MERGE1A.152
MERGE1A.153
C Check for I/O errors MERGE1A.154
IF(A.NE.-1.0.OR.LEN_IO.NE.256)THEN MERGE1A.155
CALL IOERROR('buffer in of fixed length header of input file', MERGE1A.156
* A,LEN_IO,256) MERGE1A.157
CALL ABORT MERGE1A.158
ENDIF MERGE1A.159
MERGE1A.160
C Set missing data indicator to zero MERGE1A.161
DO I=1,256 MERGE1A.162
IF(FIXHD1(I).LT.0)FIXHD1(I)=0 MERGE1A.163
ENDDO MERGE1A.164
MERGE1A.165
C Input file dimensions MERGE1A.166
LEN_FIXHD1=256 MERGE1A.167
LEN_INTHD1=FIXHD1(101) MERGE1A.168
LEN_REALHD1=FIXHD1(106) MERGE1A.169
LEN1_LEVDEPC1=FIXHD1(111) MERGE1A.170
LEN2_LEVDEPC1=FIXHD1(112) MERGE1A.171
LEN1_ROWDEPC1=FIXHD1(116) MERGE1A.172
LEN2_ROWDEPC1=FIXHD1(117) MERGE1A.173
LEN1_COLDEPC1=FIXHD1(121) MERGE1A.174
LEN2_COLDEPC1=FIXHD1(122) MERGE1A.175
LEN1_FLDDEPC1=FIXHD1(126) MERGE1A.176
LEN2_FLDDEPC1=FIXHD1(127) MERGE1A.177
LEN_EXTCNST1=FIXHD1(131) MERGE1A.178
LEN_DUMPHIST1=FIXHD1(136) MERGE1A.179
LEN_CFI11=FIXHD1(141) MERGE1A.180
LEN_CFI21=FIXHD1(143) MERGE1A.181
LEN_CFI31=FIXHD1(145) MERGE1A.182
LEN1_LOOKUP1=FIXHD1(151) MERGE1A.183
LEN2_LOOKUP1=FIXHD1(152) MERGE1A.184
LEN_DATA1=FIXHD1(161) MERGE1A.185
MERGE1A.186
CL 3. Buffer in fixed length header record from file 2 MERGE1A.187
MERGE1A.188
CALL BUFFIN(NFTIN2,FIXHD2,256,LEN_IO,A) MERGE1A.189
MERGE1A.190
C Check for I/O errors MERGE1A.191
IF(A.NE.-1.0.OR.LEN_IO.NE.256)THEN MERGE1A.192
CALL IOERROR('buffer in of fixed length header of input file', MERGE1A.193
* A,LEN_IO,256) MERGE1A.194
CALL ABORT MERGE1A.195
ENDIF MERGE1A.196
MERGE1A.197
C Set missing data indicator to zero MERGE1A.198
DO I=1,256 MERGE1A.199
IF(FIXHD2(I).LT.0)FIXHD2(I)=0 MERGE1A.200
ENDDO MERGE1A.201
MERGE1A.202
C Input file dimensions MERGE1A.203
LEN_FIXHD2=256 MERGE1A.204
LEN_INTHD2=FIXHD2(101) MERGE1A.205
LEN_REALHD2=FIXHD2(106) MERGE1A.206
LEN1_LEVDEPC2=FIXHD2(111) MERGE1A.207
LEN2_LEVDEPC2=FIXHD2(112) MERGE1A.208
LEN1_ROWDEPC2=FIXHD2(116) MERGE1A.209
LEN2_ROWDEPC2=FIXHD2(117) MERGE1A.210
LEN1_COLDEPC2=FIXHD2(121) MERGE1A.211
LEN2_COLDEPC2=FIXHD2(122) MERGE1A.212
LEN1_FLDDEPC2=FIXHD2(126) MERGE1A.213
LEN2_FLDDEPC2=FIXHD2(127) MERGE1A.214
LEN_EXTCNST2=FIXHD2(131) MERGE1A.215
LEN_DUMPHIST2=FIXHD2(136) MERGE1A.216
LEN_CFI12=FIXHD2(141) MERGE1A.217
LEN_CFI22=FIXHD2(143) MERGE1A.218
LEN_CFI32=FIXHD2(145) MERGE1A.219
LEN1_LOOKUP2=FIXHD2(151) MERGE1A.220
LEN2_LOOKUP2=FIXHD2(152) MERGE1A.221
LEN_DATA2=FIXHD2(161) MERGE1A.222
MERGE1A.223
MERGE1A.224
CL 4. Buffer in integer constants from file 1 MERGE1A.225
MERGE1A.226
CALL BUFFIN(NFTIN1,INTHD1,FIXHD1(101),LEN_IO,A) MERGE1A.227
MERGE1A.228
C Check for I/O errors MERGE1A.229
IF(A.NE.-1.0.OR.LEN_IO.NE.FIXHD1(101))THEN MERGE1A.230
CALL IOERROR('buffer in of integer constants in input file 1', MERGE1A.231
* A,LEN_IO,FIXHD1(101)) MERGE1A.232
CALL ABORT MERGE1A.233
ENDIF MERGE1A.234
MERGE1A.235
C Set missing data indicator to zero MERGE1A.236
DO I=1,FIXHD1(101) MERGE1A.237
IF(INTHD1(I).LT.0)INTHD1(I)=0 MERGE1A.238
ENDDO MERGE1A.239
MERGE1A.240
ROW_LENGTH1=INTHD1(6) MERGE1A.241
P_ROWS1=INTHD1(7) MERGE1A.242
P_FIELD1=ROW_LENGTH1*P_ROWS1 MERGE1A.243
MERGE1A.244
CL 5. Buffer in integer constants from file 2 MERGE1A.245
MERGE1A.246
CALL BUFFIN(NFTIN2,INTHD2,FIXHD2(101),LEN_IO,A) MERGE1A.247
MERGE1A.248
C Check for I/O errors MERGE1A.249
IF(A.NE.-1.0.OR.LEN_IO.NE.FIXHD2(101))THEN MERGE1A.250
CALL IOERROR('buffer in of integer constants in input file 2', MERGE1A.251
* A,LEN_IO,FIXHD2(101)) MERGE1A.252
CALL ABORT MERGE1A.253
ENDIF MERGE1A.254
MERGE1A.255
C Set missing data indicator to zero MERGE1A.256
DO I=1,FIXHD2(101) MERGE1A.257
IF(INTHD2(I).LT.0)INTHD2(I)=0 MERGE1A.258
ENDDO MERGE1A.259
MERGE1A.260
CL 6. Cause abort if files obviously different MERGE1A.261
MERGE1A.262
ROW_LENGTH2=INTHD2(6) MERGE1A.263
P_ROWS2=INTHD2(7) MERGE1A.264
P_FIELD2=ROW_LENGTH2*P_ROWS2 MERGE1A.265
MERGE1A.266
IF(P_FIELD1.NE.P_FIELD2)THEN MERGE1A.267
WRITE(6,*)'COMPARE: ERROR Dumps are at different resolutions' MERGE1A.268
CALL ABORT MERGE1A.269
ENDIF MERGE1A.270
MERGE1A.271
CL 7. Buffer in lookup table from file 1 and find largest record MERGE1A.272
MERGE1A.273
MAX_LEN1=0 MERGE1A.274
DO I=1,FIXHD1(152) MERGE1A.275
CALL SETPOS(NFTIN1,FIXHD1(150)-1+64*(I-1),ICODE) GTD0F400.105
CALL BUFFIN(NFTIN1,LOOKUP1,FIXHD1(151) MERGE1A.277
&,LEN_IO,A) MERGE1A.278
MERGE1A.279
C Check for I/O errors MERGE1A.280
IF(A.NE.-1.0.OR.LEN_IO.NE.FIXHD1(151))THEN MERGE1A.281
CALL IOERROR('buffer in of lookup table in input file 1', MERGE1A.282
* A,LEN_IO,FIXHD1(151)) MERGE1A.283
CALL ABORT MERGE1A.284
ENDIF MERGE1A.285
MERGE1A.286
MAX_LEN1=MAX0(LOOKUP1(15),MAX_LEN1) MERGE1A.287
MERGE1A.288
ENDDO MERGE1A.289
MERGE1A.290
CL 8. Buffer in lookup table from file 2 and find largest record MERGE1A.291
MERGE1A.292
MAX_LEN2=0 MERGE1A.293
DO I=1,FIXHD2(152) MERGE1A.294
CALL SETPOS(NFTIN2,FIXHD2(150)-1+64*(I-1),ICODE) GTD0F400.106
CALL BUFFIN(NFTIN2,LOOKUP2,FIXHD2(151) MERGE1A.296
&,LEN_IO,A) MERGE1A.297
MERGE1A.298
C Check for I/O errors MERGE1A.299
IF(A.NE.-1.0.OR.LEN_IO.NE.FIXHD2(151))THEN MERGE1A.300
CALL IOERROR('buffer in of lookup table in input file 2', MERGE1A.301
* A,LEN_IO,FIXHD2(151)) MERGE1A.302
CALL ABORT MERGE1A.303
ENDIF MERGE1A.304
MERGE1A.305
MAX_LEN2=MAX0(LOOKUP2(15),MAX_LEN2) MERGE1A.306
MERGE1A.307
ENDDO MERGE1A.308
MERGE1A.309
C Enlargen size of I/O buffer if smaller than field. MERGE1A.310
IF(P_FIELD1.LT.MAX_LEN1) MERGE1A.311
& P_FIELD1=MAX_LEN1 MERGE1A.312
IF(P_FIELD2.LT.MAX_LEN2) MERGE1A.313
& P_FIELD2=MAX_LEN2 MERGE1A.314
MERGE1A.315
C Rewind files MERGE1A.316
CALL SETPOS(NFTIN1,0,ICODE) GTD0F400.107
CALL SETPOS(NFTIN2,0,ICODE) GTD0F400.108
MERGE1A.319
CL 9. Output file dimensions. MERGE1A.320
MERGE1A.321
C Set equal to the dimensions of file 1 initially. MERGE1A.322
C Most will not need to be changed for merged file. MERGE1A.323
LEN_FIXHD3=256 MERGE1A.324
LEN_INTHD3=FIXHD1(101) MERGE1A.325
LEN_REALHD3=FIXHD1(106) MERGE1A.326
LEN1_LEVDEPC3=FIXHD1(111) MERGE1A.327
LEN2_LEVDEPC3=FIXHD1(112) MERGE1A.328
LEN1_ROWDEPC3=FIXHD1(116) MERGE1A.329
LEN2_ROWDEPC3=FIXHD1(117) MERGE1A.330
LEN1_COLDEPC3=FIXHD1(121) MERGE1A.331
LEN2_COLDEPC3=FIXHD1(122) MERGE1A.332
LEN1_FLDDEPC3=FIXHD1(126) MERGE1A.333
LEN2_FLDDEPC3=FIXHD1(127) MERGE1A.334
LEN_EXTCNST3=FIXHD1(131) MERGE1A.335
LEN_DUMPHIST3=FIXHD1(136) MERGE1A.336
LEN_CFI13=FIXHD1(141) MERGE1A.337
LEN_CFI23=FIXHD1(143) MERGE1A.338
LEN_CFI33=FIXHD1(145) MERGE1A.339
LEN1_LOOKUP3=FIXHD1(151) MERGE1A.340
LEN2_LOOKUP3=FIXHD1(152)+FIXHD2(152) MERGE1A.341
LEN_DATA3=FIXHD1(161)+FIXHD2(161) UDG1F405.797
P_FIELD3=P_FIELD1 MERGE1A.343
MERGE1A.344
CL 10. Call MERGE MERGE1A.345
MERGE1A.346
CALL MERGE(LEN_FIXHD1,LEN_INTHD1,LEN_REALHD1, MERGE1A.347
& LEN1_LEVDEPC1,LEN2_LEVDEPC1,LEN1_ROWDEPC1, MERGE1A.348
& LEN2_ROWDEPC1,LEN1_COLDEPC1,LEN2_COLDEPC1, MERGE1A.349
& LEN1_FLDDEPC1,LEN2_FLDDEPC1,LEN_EXTCNST1, MERGE1A.350
& LEN_DUMPHIST1,LEN_CFI11,LEN_CFI21,LEN_CFI31, MERGE1A.351
& LEN1_LOOKUP1,LEN2_LOOKUP1,LEN_DATA1,P_FIELD1, MERGE1A.352
& LEN_FIXHD2,LEN_INTHD2,LEN_REALHD2, MERGE1A.353
& LEN1_LEVDEPC2,LEN2_LEVDEPC2,LEN1_ROWDEPC2, MERGE1A.354
& LEN2_ROWDEPC2,LEN1_COLDEPC2,LEN2_COLDEPC2, MERGE1A.355
& LEN1_FLDDEPC2,LEN2_FLDDEPC2,LEN_EXTCNST2, MERGE1A.356
& LEN_DUMPHIST2,LEN_CFI12,LEN_CFI22,LEN_CFI32, MERGE1A.357
& LEN1_LOOKUP2,LEN2_LOOKUP2,LEN_DATA2,P_FIELD2, MERGE1A.358
& LEN_FIXHD3,LEN_INTHD3,LEN_REALHD3, MERGE1A.359
& LEN1_LEVDEPC3,LEN2_LEVDEPC3,LEN1_ROWDEPC3, MERGE1A.360
& LEN2_ROWDEPC3,LEN1_COLDEPC3,LEN2_COLDEPC3, MERGE1A.361
& LEN1_FLDDEPC3,LEN2_FLDDEPC3,LEN_EXTCNST3, MERGE1A.362
& LEN_DUMPHIST3,LEN_CFI13,LEN_CFI23,LEN_CFI33, MERGE1A.363
& LEN1_LOOKUP3,LEN2_LOOKUP3,LEN_DATA3,P_FIELD3 MERGE1A.364
& ,NFTIN1,NFTIN2) MERGE1A.365
MERGE1A.366
STOP MERGE1A.367
END MERGE1A.368
CLL SUBROUTINE MERGE----------------------------------------------- MERGE1A.369
CLL MERGE1A.370
CLL Written by D. Goddard 14/07/93 MERGE1A.371
CLL MERGE1A.372
CLL Reviewed by MERGE1A.373
CLL MERGE1A.374
CLL Modification History: MERGE1A.375
CLL MERGE1A.376
CLL Purpose: MERGE1A.377
CLL w This program was primarily written to merge two boundary MERGE1A.378
CLL datasets for use with the mesoscale model model in . MERGE1A.379
CLL test mode. It has been extended to cope with the merging MERGE1A.380
CLL of any two SEQUENTIAL datasets in unified model format, MERGE1A.381
CLL provided they are of the same type and resolution. MERGE1A.382
CLL A namelist allows the user to specify the point of merging MERGE1A.383
CLL and in the case of time series to merge the datasets at the MERGE1A.384
CLL point the times overlap. MERGE1A.385
CLL MERGE1A.386
CLL MERGE reads in headers from files on NFTIN1 and NFTIN2, MERGE1A.387
CLL comparing values. If differences occur where they are not MERGE1A.388
CLL expected then the program aborts. Then the user decides if MERGE1A.389
CLL the files are to be merged at a stated point or for time MERGE1A.390
CLL series where they overlap temporally. This is done through MERGE1A.391
CLL namelist CONTROL. If files are to be merged temporally, the MERGE1A.392
CLL lookup table from file 1 is scanned for the first record in MERGE1A.393
CLL the lookup table of file 2, when a common record is found MERGE1A.394
CLL its number is used to set IDIFF. Otherwise IDIFF is taken MERGE1A.395
CLL from the namelist. The new merged file is then produced MERGE1A.396
CLL by taking the first IDIFF records from file 1 then the MERGE1A.397
CLL whole of file 2. MERGE1A.398
CLL MERGE1A.399
CLL MERGE1A.400
CLL Documentation: MERGE1A.401
CLL UM Doc Paper F? MERGE1A.402
CLL MERGE1A.403
CLL ----------------------------------------------------------------- MERGE1A.404
C*L Arguments:------------------------------------------------------- MERGE1A.405
SUBROUTINE MERGE(LEN_FIXHD1,LEN_INTHD1,LEN_REALHD1, 1,84MERGE1A.406
& LEN1_LEVDEPC1,LEN2_LEVDEPC1,LEN1_ROWDEPC1, MERGE1A.407
& LEN2_ROWDEPC1,LEN1_COLDEPC1,LEN2_COLDEPC1, MERGE1A.408
& LEN1_FLDDEPC1,LEN2_FLDDEPC1,LEN_EXTCNST1, MERGE1A.409
& LEN_DUMPHIST1,LEN_CFI11,LEN_CFI21,LEN_CFI31, MERGE1A.410
& LEN1_LOOKUP1,LEN2_LOOKUP1,LEN_DATA1,P_FIELD1, MERGE1A.411
& LEN_FIXHD2,LEN_INTHD2,LEN_REALHD2, MERGE1A.412
& LEN1_LEVDEPC2,LEN2_LEVDEPC2,LEN1_ROWDEPC2, MERGE1A.413
& LEN2_ROWDEPC2,LEN1_COLDEPC2,LEN2_COLDEPC2, MERGE1A.414
& LEN1_FLDDEPC2,LEN2_FLDDEPC2,LEN_EXTCNST2, MERGE1A.415
& LEN_DUMPHIST2,LEN_CFI12,LEN_CFI22,LEN_CFI32, MERGE1A.416
& LEN1_LOOKUP2,LEN2_LOOKUP2,LEN_DATA2,P_FIELD2, MERGE1A.417
& LEN_FIXHD3,LEN_INTHD3,LEN_REALHD3, MERGE1A.418
& LEN1_LEVDEPC3,LEN2_LEVDEPC3,LEN1_ROWDEPC3, MERGE1A.419
& LEN2_ROWDEPC3,LEN1_COLDEPC3,LEN2_COLDEPC3, MERGE1A.420
& LEN1_FLDDEPC3,LEN2_FLDDEPC3,LEN_EXTCNST3, MERGE1A.421
& LEN_DUMPHIST3,LEN_CFI13,LEN_CFI23,LEN_CFI33, MERGE1A.422
& LEN1_LOOKUP3,LEN2_LOOKUP3,LEN_DATA3,P_FIELD3 MERGE1A.423
& ,NFTIN1,NFTIN2) MERGE1A.424
MERGE1A.425
IMPLICIT NONE MERGE1A.426
MERGE1A.427
INTEGER MERGE1A.428
& LEN_FIXHD1 !IN Length of fixed length header on file 1 MERGE1A.429
&,LEN_INTHD1 !IN Length of integer header on file 1 MERGE1A.430
&,LEN_REALHD1 !IN Length of real header on file 1 MERGE1A.431
&,LEN1_LEVDEPC1!IN 1st dim of lev dependent consts on file 1 MERGE1A.432
&,LEN2_LEVDEPC1!IN 2nd dim of lev dependent consts on file 1 MERGE1A.433
&,LEN1_ROWDEPC1!IN 1st dim of row dependent consts on file 1 MERGE1A.434
&,LEN2_ROWDEPC1!IN 2nd dim of row dependent consts on file 1 MERGE1A.435
&,LEN1_COLDEPC1!IN 1st dim of col dependent consts on file 1 MERGE1A.436
&,LEN2_COLDEPC1!IN 2nd dim of col dependent consts on file 1 MERGE1A.437
&,LEN1_FLDDEPC1!IN 1st dim of field dependent consts on file 1 MERGE1A.438
&,LEN2_FLDDEPC1!IN 2nd dim of field dependent consts on file 1 MERGE1A.439
&,LEN_EXTCNST1 !IN Length of extra consts on file 1 MERGE1A.440
&,LEN_DUMPHIST1!IN Length of history header on file 1 MERGE1A.441
&,LEN_CFI11 !IN Length of index1 on file 1 MERGE1A.442
&,LEN_CFI21 !IN Length of index2 on file 1 MERGE1A.443
&,LEN_CFI31 !IN Length of index3 on file 1 MERGE1A.444
&,LEN1_LOOKUP1 !IN 1st dim of LOOKUP on file 1 MERGE1A.445
&,LEN2_LOOKUP1 !IN 2nd dim of LOOKUP on file 1 MERGE1A.446
&,LEN_DATA1 !IN Length of data on file 1 MERGE1A.447
&,P_FIELD1 !IN No of p-points per level on file 1 MERGE1A.448
MERGE1A.449
INTEGER MERGE1A.450
& LEN_FIXHD2 !IN Length of fixed length header on file 2 MERGE1A.451
&,LEN_INTHD2 !IN Length of integer header on file 2 MERGE1A.452
&,LEN_REALHD2 !IN Length of real header on file 2 MERGE1A.453
&,LEN1_LEVDEPC2!IN 1st dim of lev dependent consts on file 2 MERGE1A.454
&,LEN2_LEVDEPC2!IN 2nd dim of lev dependent consts on file 2 MERGE1A.455
&,LEN1_ROWDEPC2!IN 1st dim of row dependent consts on file 2 MERGE1A.456
&,LEN2_ROWDEPC2!IN 2nd dim of row dependent consts on file 2 MERGE1A.457
&,LEN1_COLDEPC2!IN 1st dim of col dependent consts on file 2 MERGE1A.458
&,LEN2_COLDEPC2!IN 2nd dim of col dependent consts on file 2 MERGE1A.459
&,LEN1_FLDDEPC2!IN 1st dim of field dependent consts on file 2 MERGE1A.460
&,LEN2_FLDDEPC2!IN 2nd dim of field dependent consts on file 2 MERGE1A.461
&,LEN_EXTCNST2 !IN Length of extra consts on file 2 MERGE1A.462
&,LEN_DUMPHIST2!IN Length of history header on file 2 MERGE1A.463
&,LEN_CFI12 !IN Length of index1 on file 2 MERGE1A.464
&,LEN_CFI22 !IN Length of index2 on file 2 MERGE1A.465
&,LEN_CFI32 !IN Length of index3 on file 2 MERGE1A.466
&,LEN1_LOOKUP2 !IN 1st dim of LOOKUP on file 2 MERGE1A.467
&,LEN2_LOOKUP2 !IN 2nd dim of LOOKUP on file 2 MERGE1A.468
&,LEN_DATA2 !IN Length of data on file 2 MERGE1A.469
&,P_FIELD2 !IN No of p-points per level on file 2 MERGE1A.470
MERGE1A.471
INTEGER MERGE1A.472
& LEN_FIXHD3 ! OUT Length of fixed length header on file 3 MERGE1A.473
&,LEN_INTHD3 ! OUT Length of teger header on file 3 MERGE1A.474
&,LEN_REALHD3 ! OUT Length of real header on file 3 MERGE1A.475
&,LEN1_LEVDEPC3! OUT 1st dim of lev dependent consts on file 3 MERGE1A.476
&,LEN2_LEVDEPC3! OUT 2nd dim of lev dependent consts on file 3 MERGE1A.477
&,LEN1_ROWDEPC3! OUT 1st dim of row dependent consts on file 3 MERGE1A.478
&,LEN2_ROWDEPC3! OUT 2nd dim of row dependent consts on file 3 MERGE1A.479
&,LEN1_COLDEPC3! OUT 1st dim of col dependent consts on file 3 MERGE1A.480
&,LEN2_COLDEPC3! OUT 2nd dim of col dependent consts on file 3 MERGE1A.481
&,LEN1_FLDDEPC3! OUT 1st dim of field dependent consts on file 3 MERGE1A.482
&,LEN2_FLDDEPC3! OUT 2nd dim of field dependent consts on file 3 MERGE1A.483
&,LEN_EXTCNST3 ! OUT Length of extra consts on file 3 MERGE1A.484
&,LEN_DUMPHIST3! OUT Length of history header on file 3 MERGE1A.485
&,LEN_CFI13 ! OUT Length of index1 on file 3 MERGE1A.486
&,LEN_CFI23 ! OUT Length of index2 on file 3 MERGE1A.487
&,LEN_CFI33 ! OUT Length of index3 on file 3 MERGE1A.488
&,LEN1_LOOKUP3 ! OUT 1st dim of LOOKUP on file 3 MERGE1A.489
&,LEN2_LOOKUP3 ! OUT 2nd dim of LOOKUP on file 3 MERGE1A.490
&,LEN_DATA3 ! OUT Length of data on file 3 MERGE1A.491
&,P_FIELD3 ! OUT No of p-points per level on file 3 MERGE1A.492
MERGE1A.493
INTEGER MERGE1A.494
& NFTIN1 !IN Unit number for file 1 MERGE1A.495
&,NFTIN2 !IN Unit number for file 2 MERGE1A.496
MERGE1A.497
MERGE1A.498
C Comdecks: ------------------------------------------------------------ MERGE1A.499
*CALL CSUBMODL GDG0F401.885
*CALL CPPXREF GDG0F401.886
*CALL PPXLOOK GDG0F401.887
*CALL CLOOKADD UDG1F405.798
*CALL CNTL_IO UDG1F405.799
*CALL CSTASH GDG0F401.888
MERGE1A.501
C Local arrays:--------------------------------------------------------- MERGE1A.502
INTEGER MERGE1A.503
& FIXHD1(LEN_FIXHD1), ! MERGE1A.504
& INTHD1(LEN_INTHD1), !\ MERGE1A.505
& CFI11(LEN_CFI11+1),CFI21(LEN_CFI21+1), ! > file 1 headers MERGE1A.506
& CFI31(LEN_CFI31+1), !/ MERGE1A.507
& LOOKUP1(LEN1_LOOKUP1,LEN2_LOOKUP1) ! MERGE1A.508
MERGE1A.509
INTEGER MERGE1A.510
& FIXHD2(LEN_FIXHD2), ! MERGE1A.511
& INTHD2(LEN_INTHD2), !\ MERGE1A.512
& CFI12(LEN_CFI12+1),CFI22(LEN_CFI22+1), ! > file 2 headers MERGE1A.513
& CFI32(LEN_CFI32+1), !/ MERGE1A.514
& LOOKUP2(LEN1_LOOKUP2,LEN2_LOOKUP2) ! MERGE1A.515
MERGE1A.516
INTEGER MERGE1A.517
& FIXHD3(256), ! MERGE1A.518
& INTHD3(100), !\ MERGE1A.519
& CFI13(LEN_CFI13+1),CFI23(LEN_CFI23+1), ! > file 3 headers MERGE1A.520
& CFI33(LEN_CFI33+1), !/ MERGE1A.521
& LOOKUP3(LEN1_LOOKUP3,LEN2_LOOKUP3) ! MERGE1A.522
MERGE1A.523
REAL MERGE1A.524
& REALHD1(LEN_REALHD1), ! MERGE1A.525
& LEVDEPC1(1+LEN1_LEVDEPC1*LEN2_LEVDEPC1), ! MERGE1A.526
& ROWDEPC1(1+LEN1_ROWDEPC1*LEN2_ROWDEPC1), !\ MERGE1A.527
& COLDEPC1(1+LEN1_COLDEPC1*LEN2_COLDEPC1), ! > file 1 headers MERGE1A.528
& FLDDEPC1(1+LEN1_FLDDEPC1*LEN2_FLDDEPC1), !/ MERGE1A.529
& EXTCNST1(LEN_EXTCNST1+1), ! MERGE1A.530
& DUMPHIST1(LEN_DUMPHIST1+1), ! MERGE1A.531
& D1(P_FIELD1) ! Data array used to read in each field on file 1 MERGE1A.532
MERGE1A.533
REAL MERGE1A.534
& REALHD2(LEN_REALHD2), ! MERGE1A.535
& LEVDEPC2(1+LEN1_LEVDEPC2*LEN2_LEVDEPC2), ! MERGE1A.536
& ROWDEPC2(1+LEN1_ROWDEPC2*LEN2_ROWDEPC2), !\ MERGE1A.537
& COLDEPC2(1+LEN1_COLDEPC2*LEN2_COLDEPC2), ! > file 2 headers MERGE1A.538
& FLDDEPC2(1+LEN1_FLDDEPC2*LEN2_FLDDEPC2), !/ MERGE1A.539
& EXTCNST2(LEN_EXTCNST2+1), ! MERGE1A.540
& DUMPHIST2(LEN_DUMPHIST2+1), ! MERGE1A.541
& D2(P_FIELD2) ! Data array used to read in each field on file 2 MERGE1A.542
MERGE1A.543
REAL MERGE1A.544
& REALHD3(LEN_REALHD3), ! MERGE1A.545
& LEVDEPC3(1+LEN1_LEVDEPC3*LEN2_LEVDEPC3), ! MERGE1A.546
& ROWDEPC3(1+LEN1_ROWDEPC3*LEN2_ROWDEPC3), !\ MERGE1A.547
& COLDEPC3(1+LEN1_COLDEPC3*LEN2_COLDEPC3), ! > file 3 headers MERGE1A.548
& FLDDEPC3(1+LEN1_FLDDEPC3*LEN2_FLDDEPC3), !/ MERGE1A.549
& EXTCNST3(LEN_EXTCNST3+1), ! MERGE1A.550
& DUMPHIST3(LEN_DUMPHIST3+1), ! MERGE1A.551
& D3(P_FIELD3) ! Data array used to read in each field on file 3 MERGE1A.552
MERGE1A.553
INTEGER MERGE1A.554
* PP_XREF(PPXREF_CODELEN) !PPXREF codes for a given section/item MERGE1A.555
MERGE1A.556
C External subroutines called:------------------------------------------ MERGE1A.557
EXTERNAL ABORT,ABORT_IO,READHEAD,READFLDS,WRITHEAD,WRITFLDS GDG0F401.889
EXTERNAL HDPPXRF,GETPPX GDG0F401.890
C*---------------------------------------------------------------------- MERGE1A.559
C*L Local variables:--------------------------------------------------- MERGE1A.560
REAL MERGE1A.561
* MAX_DIFF ! Maximum difference between two fields MERGE1A.562
MERGE1A.563
INTEGER MERGE1A.564
& ICODE ! Error return code from subroutines MERGE1A.565
&,START_BLOCK ! READHEAD argument (not used) MERGE1A.566
&,I,J,K,L ! Loop indices MERGE1A.567
&,JMIN ! Minimum length of two headers MERGE1A.568
&,SECTION ! STASH section number MERGE1A.569
&,MAX_J ! Point number showing max difference in field MERGE1A.570
&,IDIFF ! Number of records passed through before match MERGE1A.571
&,NDIFF ! Number of differences between two header records MERGE1A.572
&,NRECF1 ! Number of records to be copied from file 1 MERGE1A.573
&,LEN_TIMESTEP !Combined length of data for a specified time MERGE1A.574
&,LEN_BUF UDG1F405.800
&,MAX_LEN_BUF UDG1F405.801
&,POS UDG1F405.802
UDG1F405.803
INTEGER IROWDEPC1 UDG1F405.804
INTEGER IROWDEPC2 UDG1F405.805
UDG1F405.806
INTEGER disk_address ! Current rounded disk address UDG1F405.807
INTEGER number_of_data_words_on_disk UDG1F405.808
! Number of data words on disk UDG1F405.809
INTEGER number_of_data_words_in_memory UDG1F405.810
UDG1F405.811
&,NFTOUT ! Unit number for file 3 MERGE1A.575
&,ERROR ! Return code from subroutine OPEN MERGE1A.576
MERGE1A.577
CHARACTER MERGE1A.578
& CMESSAGE*100 ! Character string returned if ICODE .ne. 0 MERGE1A.579
*,PHRASE*(PPXREF_CHARLEN) ! Name of field MERGE1A.580
INTEGER RowNumber GDG0F401.891
GDG0F401.892
INTEGER NFT1,NFT2 GDG0F401.893
PARAMETER (NFT1=22, NFT2=2) GDG0F401.894
C*---------------------------------------------------------------------- MERGE1A.581
MERGE1A.582
NAMELIST/CONTROL/NRECF1 MERGE1A.583
MERGE1A.584
CL 0. Read in PPXREF GDG0F401.895
GDG0F401.896
ppxRecs=1 GDG0F401.897
RowNumber=0 GDG0F401.898
cmessage = ' ' GDW1F404.172
ICODE = 0 UDG1F405.812
CALL HDPPXRF(NFT1,'STASHmaster_A',ppxRecs,ICODE,CMESSAGE) UDG1F405.813
IF(ICODE.GT.0)THEN UDG1F405.814
WRITE(6,*) 'Error reading STASHmaster_A' UDG1F405.815
WRITE(6,*) CMESSAGE UDG1F405.816
CALL ABORT UDG1F405.817
END IF UDG1F405.818
CALL HDPPXRF(NFT1,'STASHmaster_O',ppxRecs,ICODE,CMESSAGE) UDG1F405.819
IF(ICODE.GT.0)THEN UDG1F405.820
WRITE(6,*) 'Error reading STASHmaster_O' UDG1F405.821
WRITE(6,*) CMESSAGE UDG1F405.822
CALL ABORT UDG1F405.823
END IF UDG1F405.824
CALL HDPPXRF(NFT1,'STASHmaster_S',ppxRecs,ICODE,CMESSAGE) UDG1F405.825
IF(ICODE.GT.0)THEN UDG1F405.826
WRITE(6,*) 'Error reading STASHmaster_S' UDG1F405.827
WRITE(6,*) CMESSAGE UDG1F405.828
CALL ABORT UDG1F405.829
END IF UDG1F405.830
CALL HDPPXRF(NFT1,'STASHmaster_W',ppxRecs,ICODE,CMESSAGE) UDG1F405.831
IF(ICODE.GT.0)THEN UDG1F405.832
WRITE(6,*) 'Error reading STASHmaster_W' UDG1F405.833
WRITE(6,*) CMESSAGE UDG1F405.834
CALL ABORT UDG1F405.835
ENDIF UDG1F405.836
IF(ICODE.GT.0)THEN GDW1F404.173
WRITE(6,*) CMESSAGE GDG0F401.904
CALL ABORT GDG0F401.905
ENDIF GDG0F401.906
GDG0F401.907
CALL GETPPX(NFT1,NFT2,'STASHmaster_A',RowNumber, GDG0F401.908
*CALL ARGPPX GDG0F401.909
& ICODE,CMESSAGE) GDG0F401.910
CALL GETPPX(NFT1,NFT2,'STASHmaster_O',RowNumber, GDG0F401.911
*CALL ARGPPX GDG0F401.912
& ICODE,CMESSAGE) GDG0F401.913
CALL GETPPX(NFT1,NFT2,'STASHmaster_S',RowNumber, GDG0F401.914
*CALL ARGPPX GDG0F401.915
& ICODE,CMESSAGE) GDG0F401.916
CALL GETPPX(NFT1,NFT2,'STASHmaster_W',RowNumber, GDG0F401.917
*CALL ARGPPX GDG0F401.918
& ICODE,CMESSAGE) GDG0F401.919
IF(ICODE.NE.0)THEN GDG0F401.920
WRITE(6,*) CMESSAGE GDG0F401.921
CALL ABORT GDG0F401.922
ENDIF GDG0F401.923
GDG0F401.924
!User STASHmaster GDG0F401.925
CALL HDPPXRF(0,' ',ppxRecs,ICODE,CMESSAGE) GDG0F401.926
IF(ICODE.NE.0)THEN GDG0F401.927
WRITE(6,*) CMESSAGE GDG0F401.928
CALL ABORT GDG0F401.929
ENDIF GDG0F401.930
GDG0F401.931
CALL GETPPX(0,NFT2,' ',RowNumber, GDG0F401.932
*CALL ARGPPX GDG0F401.933
& ICODE,CMESSAGE) GDG0F401.934
IF(ICODE.NE.0)THEN GDG0F401.935
WRITE(6,*) CMESSAGE GDG0F401.936
CALL ABORT GDG0F401.937
ENDIF GDG0F401.938
CL 1. Read in file 1 header MERGE1A.585
MERGE1A.586
WRITE(6,*)' ' MERGE1A.587
WRITE(6,*)' FILE 1' MERGE1A.588
WRITE(6,*)' ------' MERGE1A.589
CALL READHEAD(NFTIN1,FIXHD1,LEN_FIXHD1, MERGE1A.590
& INTHD1,LEN_INTHD1, MERGE1A.591
& REALHD1,LEN_REALHD1, MERGE1A.592
& LEVDEPC1,LEN1_LEVDEPC1,LEN2_LEVDEPC1, MERGE1A.593
& ROWDEPC1,LEN1_ROWDEPC1,LEN2_ROWDEPC1, MERGE1A.594
& COLDEPC1,LEN1_COLDEPC1,LEN2_COLDEPC1, MERGE1A.595
& FLDDEPC1,LEN1_FLDDEPC1,LEN2_FLDDEPC1, MERGE1A.596
& EXTCNST1,LEN_EXTCNST1, MERGE1A.597
& DUMPHIST1,LEN_DUMPHIST1, MERGE1A.598
& CFI11,LEN_CFI11, MERGE1A.599
& CFI21,LEN_CFI21, MERGE1A.600
& CFI31,LEN_CFI31, MERGE1A.601
& LOOKUP1,LEN1_LOOKUP1,LEN2_LOOKUP1, MERGE1A.602
& LEN_DATA1, MERGE1A.603
*CALL ARGPPX GDG0F401.939
& START_BLOCK,ICODE,CMESSAGE) MERGE1A.604
MERGE1A.605
IF(ICODE.NE.0)THEN MERGE1A.606
WRITE(6,*)CMESSAGE,ICODE MERGE1A.607
CALL ABORT MERGE1A.608
ENDIF MERGE1A.609
MERGE1A.610
CL 2. Read in file 2 header MERGE1A.611
MERGE1A.612
WRITE(6,*)' ' MERGE1A.613
WRITE(6,*)' FILE 2' MERGE1A.614
WRITE(6,*)' ------' MERGE1A.615
CALL READHEAD(NFTIN2,FIXHD2,LEN_FIXHD2, MERGE1A.616
& INTHD2,LEN_INTHD2, MERGE1A.617
& REALHD2,LEN_REALHD2, MERGE1A.618
& LEVDEPC2,LEN1_LEVDEPC2,LEN2_LEVDEPC2, MERGE1A.619
& ROWDEPC2,LEN1_ROWDEPC2,LEN2_ROWDEPC2, MERGE1A.620
& COLDEPC2,LEN1_COLDEPC2,LEN2_COLDEPC2, MERGE1A.621
& FLDDEPC2,LEN1_FLDDEPC2,LEN2_FLDDEPC2, MERGE1A.622
& EXTCNST2,LEN_EXTCNST2, MERGE1A.623
& DUMPHIST2,LEN_DUMPHIST2, MERGE1A.624
& CFI12,LEN_CFI12, MERGE1A.625
& CFI22,LEN_CFI22, MERGE1A.626
& CFI32,LEN_CFI32, MERGE1A.627
& LOOKUP2,LEN1_LOOKUP2,LEN2_LOOKUP2, MERGE1A.628
& LEN_DATA2, MERGE1A.629
*CALL ARGPPX GDG0F401.940
& START_BLOCK,ICODE,CMESSAGE) MERGE1A.630
MERGE1A.631
MERGE1A.632
IF(ICODE.NE.0)THEN MERGE1A.633
WRITE(6,*)CMESSAGE,ICODE MERGE1A.634
CALL ABORT MERGE1A.635
ENDIF MERGE1A.636
MERGE1A.637
CL 3. Compare fixed length headers and substitute the value of MERGE1A.638
CL file1 in file3. UDG1F405.837
MERGE1A.640
WRITE(6,*)' ' MERGE1A.641
WRITE(6,*)'FIXED LENGTH HEADER:' MERGE1A.642
IF(LEN_FIXHD1.NE.LEN_FIXHD2)THEN MERGE1A.643
WRITE(6,*)'ERROR: LEN1=',LEN_FIXHD1,' LEN2=',LEN_FIXHD2 UDG1F405.838
WRITE(6,*)'Files are incompatable and cannot be merged.' UDG1F405.839
CALL ABORT UDG1F405.840
ELSE MERGE1A.645
LEN_FIXHD3=LEN_FIXHD1 MERGE1A.646
ENDIF MERGE1A.647
IF(FIXHD1(5).EQ.3.OR.FIXHD1(5).GT.5)THEN MERGE1A.649
C Data type not supported. Abort. MERGE1A.650
WRITE(6,*) 'ERROR Data type not supported' MERGE1A.651
CALL ABORT MERGE1A.652
ENDIF MERGE1A.653
DO I=1,LEN_FIXHD1 UDG1F405.841
IF(FIXHD1(I).NE.FIXHD2(I))THEN UDG1F405.842
IF(I.GE.2.AND.I.LT.6)THEN UDG1F405.843
WRITE(6,*)'ERROR: FIXHD1(I)=', FIXHD1(I), UDG1F405.844
& 'FIXHD2(I)=', FIXHD2(I) UDG1F405.845
WRITE(6,*) 'Files are incompatable and cannot be merged.' UDG1F405.846
CALL ABORT UDG1F405.847
ELSE IF(I.EQ.101)THEN UDG1F405.848
WRITE(6,*) 'ERROR: integer constant arrays have different ', UDG1F405.849
& 'lengths' UDG1F405.850
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.851
CALL ABORT UDG1F405.852
ELSE IF(I.EQ.106)THEN UDG1F405.853
WRITE(6,*) 'ERROR: real constant arrays have different ', UDG1F405.854
& 'lengths' UDG1F405.855
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.856
CALL ABORT UDG1F405.857
ELSE IF(I.EQ.111)THEN UDG1F405.858
WRITE(6,*) 'ERROR: level dependant constant arrays have ', UDG1F405.859
& ' different lengths' UDG1F405.860
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.861
CALL ABORT UDG1F405.862
ELSE IF(I.EQ.116)THEN UDG1F405.863
WRITE(6,*) 'ERROR: row dependant constant arrays have ', UDG1F405.864
& ' different lengths' UDG1F405.865
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.866
CALL ABORT UDG1F405.867
ELSE IF(I.EQ.121)THEN UDG1F405.868
WRITE(6,*) 'ERROR: column dependant constant arrays have ', UDG1F405.869
& ' different lengths' UDG1F405.870
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.871
CALL ABORT UDG1F405.872
ELSE IF(I.EQ.126)THEN UDG1F405.873
WRITE(6,*) 'ERROR: field of constant arrays have ', UDG1F405.874
& ' different lengths' UDG1F405.875
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.876
CALL ABORT UDG1F405.877
ELSE IF(I.EQ.127)THEN UDG1F405.878
WRITE(6,*) 'ERROR: field of constant arrays have ', UDG1F405.879
& ' different lengths' UDG1F405.880
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.881
CALL ABORT UDG1F405.882
ELSE IF(I.EQ.131)THEN UDG1F405.883
WRITE(6,*) 'ERROR: extra consatant arrays have ', UDG1F405.884
& ' different lengths' UDG1F405.885
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.886
CALL ABORT UDG1F405.887
ELSE IF(I.EQ.136)THEN UDG1F405.888
WRITE(6,*) 'ERROR: temp historyfile arrays have ', UDG1F405.889
& ' different lengths' UDG1F405.890
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.891
CALL ABORT UDG1F405.892
ELSE IF(I.EQ.141)THEN UDG1F405.893
WRITE(6,*) 'ERROR: compressed field index 1 arrays have ', UDG1F405.894
& ' different lengths' UDG1F405.895
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.896
CALL ABORT UDG1F405.897
ELSE IF(I.EQ.143)THEN UDG1F405.898
WRITE(6,*) 'ERROR: compressed field index 1 arrays have ', UDG1F405.899
& ' different lengths' UDG1F405.900
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.901
CALL ABORT UDG1F405.902
ELSE IF(I.EQ.145)THEN UDG1F405.903
WRITE(6,*) 'ERROR: compressed field index 1 arrays have ', UDG1F405.904
& ' different lengths' UDG1F405.905
WRITE(6,*) 'File 1 = ',FIXHD1(I),' File 2 = ',FIXHD2(I) UDG1F405.906
CALL ABORT UDG1F405.907
END IF UDG1F405.908
END IF UDG1F405.909
FIXHD3(I)=FIXHD1(I) UDG1F405.910
END DO UDG1F405.911
MERGE1A.661
CL 4. Compare integer headers and substitute the value of MERGE1A.662
CL file1 in file3. UDG1F405.912
MERGE1A.664
IF(LEN_INTHD1.GT.0.OR.LEN_INTHD2.GT.0)THEN MERGE1A.665
WRITE(6,*)' ' MERGE1A.666
WRITE(6,*)'INTEGER HEADER:' MERGE1A.667
DO I=1,LEN_INTHD1 UDG1F405.913
IF(FIXHD1(5).EQ.5.AND.FIXHD1(12).LE.303)THEN UDG1F405.914
INTHD1(15)=INTHD1(13) UDG1F405.915
END IF UDG1F405.916
IF(FIXHD2(5).EQ.5.AND.FIXHD2(12).LE.303)THEN UDG1F405.917
INTHD2(15)=INTHD2(13) UDG1F405.918
END IF UDG1F405.919
IF(INTHD1(I).NE.INTHD2(I))THEN UDG1F405.920
IF(I.EQ.6)THEN UDG1F405.921
WRITE(6,*) 'ERROR: Different number of points in row' UDG1F405.922
WRITE(6,*) 'File 1 = ',INTHD1(I),' File 2 = ',INTHD2(I) UDG1F405.923
CALL ABORT UDG1F405.924
ELSE IF(I.EQ.7)THEN UDG1F405.925
WRITE(6,*) 'ERROR: Different number of points in column' UDG1F405.926
WRITE(6,*) 'File 1 = ',INTHD1(I),' File 2 = ',INTHD2(I) UDG1F405.927
CALL ABORT UDG1F405.928
ELSE IF(I.EQ.8)THEN UDG1F405.929
WRITE(6,*) 'ERROR: Different number of levels' UDG1F405.930
WRITE(6,*) 'File 1 = ',INTHD1(I),' File 2 = ',INTHD2(I) UDG1F405.931
CALL ABORT UDG1F405.932
ELSE IF(I.EQ.9)THEN UDG1F405.933
IF(FIXHD1(2).EQ.1)THEN UDG1F405.934
IF(FIXHD1(5).EQ.1.OR.FIXHD1(5).EQ.2.OR.FIXHD1(5).EQ.5) UDG1F405.935
& THEN UDG1F405.936
WRITE(6,*) 'ERROR: Different number of wet levels' UDG1F405.937
WRITE(6,*) 'File 1 = ',INTHD1(I), UDG1F405.938
& ' File 2 = ',INTHD2(I) UDG1F405.939
CALL ABORT UDG1F405.940
END IF UDG1F405.941
END IF UDG1F405.942
ELSE IF(I.EQ.10)THEN UDG1F405.943
IF(FIXHD1(2).EQ.1)THEN UDG1F405.944
IF(FIXHD1(5).EQ.1.OR.FIXHD1(5).EQ.2)THEN UDG1F405.945
WRITE(6,*) 'ERROR: Different number of soil levels' UDG1F405.946
WRITE(6,*) 'File 1 = ',INTHD1(I), UDG1F405.947
& ' File 2 = ',INTHD2(I) UDG1F405.948
CALL ABORT UDG1F405.949
END IF UDG1F405.950
END IF UDG1F405.951
ELSE IF(I.EQ.12)THEN UDG1F405.952
IF(FIXHD1(2).EQ.1)THEN UDG1F405.953
IF(FIXHD1(5).EQ.1.OR.FIXHD1(5).EQ.2)THEN UDG1F405.954
WRITE(6,*) 'ERROR: Different number of tracers' UDG1F405.955
WRITE(6,*) 'File 1 = ',INTHD1(I), UDG1F405.956
& ' File 2 = ',INTHD2(I) UDG1F405.957
CALL ABORT UDG1F405.958
END IF UDG1F405.959
END IF UDG1F405.960
ELSE IF(I.EQ.13)THEN UDG1F405.961
IF(FIXHD1(2).EQ.1)THEN UDG1F405.962
IF(FIXHD1(5).EQ.1.OR.FIXHD1(5).EQ.2)THEN UDG1F405.963
WRITE(6,*) 'ERROR: Different number of boundary ', UDG1F405.964
& 'layer levels' UDG1F405.965
WRITE(6,*) 'File 1 = ',INTHD1(I), UDG1F405.966
& ' File 2 = ',INTHD2(I) UDG1F405.967
CALL ABORT UDG1F405.968
END IF UDG1F405.969
END IF UDG1F405.970
ELSE IF(I.EQ.15)THEN UDG1F405.971
IF(FIXHD1(2).EQ.1)THEN UDG1F405.972
IF(FIXHD1(5).EQ.5)THEN UDG1F405.973
WRITE(6,*) 'ERROR: Different number of field types' UDG1F405.974
WRITE(6,*) 'File 1 = ',INTHD1(I), UDG1F405.975
& ' File 2 = ',INTHD2(I) UDG1F405.976
CALL ABORT UDG1F405.977
END IF UDG1F405.978
END IF UDG1F405.979
ELSE IF(I.EQ.25)THEN UDG1F405.980
IF(FIXHD1(2).EQ.1)THEN UDG1F405.981
IF(FIXHD1(5).EQ.1.OR.FIXHD1(5).EQ.2)THEN UDG1F405.982
WRITE(6,*) 'ERROR: Different number of land points' UDG1F405.983
WRITE(6,*) 'File 1 = ',INTHD1(I), UDG1F405.984
& ' File 2 = ',INTHD2(I) UDG1F405.985
CALL ABORT UDG1F405.986
END IF UDG1F405.987
END IF UDG1F405.988
ELSE IF(I.EQ.26)THEN UDG1F405.989
IF(FIXHD1(2).EQ.1)THEN UDG1F405.990
IF(FIXHD1(5).EQ.1.OR.FIXHD1(5).EQ.2)THEN UDG1F405.991
WRITE(6,*) 'ERROR: Different number of ozone levels' UDG1F405.992
WRITE(6,*) 'File 1 = ',INTHD1(I), UDG1F405.993
& ' File 2 = ',INTHD2(I) UDG1F405.994
CALL ABORT UDG1F405.995
END IF UDG1F405.996
END IF UDG1F405.997
END IF UDG1F405.998
END IF UDG1F405.999
INTHD3(I)=INTHD1(I) UDG1F405.1000
END DO UDG1F405.1001
END IF UDG1F405.1002
MERGE1A.686
CL 5. Compare real headers and substitute the value of MERGE1A.687
CL file1 in file3 if elements the same: MERGE1A.688
MERGE1A.689
IF(LEN_REALHD1.GT.0.OR.LEN_REALHD2.GT.0)THEN MERGE1A.690
WRITE(6,*)' ' MERGE1A.691
WRITE(6,*)'REAL HEADER:' MERGE1A.692
IF(LEN_REALHD1.NE.LEN_REALHD2)THEN MERGE1A.693
WRITE(6,*)'WARNING LEN1=',LEN_REALHD1,' LEN2=',LEN_REALHD2 MERGE1A.694
ELSE MERGE1A.695
LEN_REALHD3=LEN_REALHD1 MERGE1A.696
ENDIF MERGE1A.697
DO I=1,LEN_REALHD1 UDG1F405.1003
*IF DEF,T3E UDG1F405.1004
IF(XOR(REALHD1(I),REALHD2(I)).NE.0) THEN UDG1F405.1005
*ELSE UDG1F405.1006
IF(REALHD1(I).NE.REALHD2(I))THEN UDG1F405.1007
*ENDIF UDG1F405.1008
IF(I.EQ.1)THEN UDG1F405.1009
WRITE(6,*) 'ERROR: Different row spacing' UDG1F405.1010
WRITE(6,*) 'File 1 = ',REALHD1(I), UDG1F405.1011
& ' File 2 = ',REALHD2(I) UDG1F405.1012
CALL ABORT UDG1F405.1013
ELSE IF(I.EQ.2)THEN UDG1F405.1014
WRITE(6,*) 'ERROR: Different column spacing' UDG1F405.1015
WRITE(6,*) 'File 1 = ',REALHD1(I), UDG1F405.1016
& ' File 2 = ',REALHD2(I) UDG1F405.1017
CALL ABORT UDG1F405.1018
ELSE IF(I.EQ.3)THEN UDG1F405.1019
WRITE(6,*) 'ERROR: Different latitude of 1st row' UDG1F405.1020
WRITE(6,*) 'File 1 = ',REALHD1(I), UDG1F405.1021
& ' File 2 = ',REALHD2(I) UDG1F405.1022
CALL ABORT UDG1F405.1023
ELSE IF(I.EQ.4)THEN UDG1F405.1024
WRITE(6,*) 'ERROR: Different longitude of 1st row' UDG1F405.1025
WRITE(6,*) 'File 1 = ',REALHD1(I), UDG1F405.1026
& ' File 2 = ',REALHD2(I) UDG1F405.1027
CALL ABORT UDG1F405.1028
ELSE IF(I.EQ.5)THEN UDG1F405.1029
WRITE(6,*) 'ERROR: Different latitude of pseudo north ', UDG1F405.1030
& 'pole' UDG1F405.1031
WRITE(6,*) 'File 1 = ',REALHD1(I), UDG1F405.1032
& ' File 2 = ',REALHD2(I) UDG1F405.1033
CALL ABORT UDG1F405.1034
ELSE IF(I.EQ.6)THEN UDG1F405.1035
WRITE(6,*) 'ERROR: Different longitude of pseudo north ', UDG1F405.1036
& 'pole' UDG1F405.1037
WRITE(6,*) 'File 1 = ',REALHD1(I), UDG1F405.1038
& ' File 2 = ',REALHD2(I) UDG1F405.1039
CALL ABORT UDG1F405.1040
END IF UDG1F405.1041
END IF UDG1F405.1042
REALHD3(I)=REALHD1(I) UDG1F405.1043
END DO UDG1F405.1044
END IF UDG1F405.1045
MERGE1A.711
CL 6. Compare level dependent constants MERGE1A.712
MERGE1A.713
IF(LEN1_LEVDEPC1.NE.LEN1_LEVDEPC2)THEN MERGE1A.714
WRITE(6,*)'ERROR different number of levels' MERGE1A.715
WRITE(6,*)'LEV1=',LEN1_LEVDEPC1,' LEV2=',LEN1_LEVDEPC2 MERGE1A.716
CALL ABORT MERGE1A.717
ELSE MERGE1A.718
LEN1_LEVDEPC3=LEN1_LEVDEPC1 MERGE1A.719
ENDIF MERGE1A.720
IF(LEN2_LEVDEPC1.GT.0.OR.LEN2_LEVDEPC2.GT.0)THEN MERGE1A.721
WRITE(6,*)' ' MERGE1A.722
WRITE(6,*)'LEVEL DEPENDENT CONSTS:' MERGE1A.723
IF(LEN2_LEVDEPC1.NE.LEN2_LEVDEPC2)THEN MERGE1A.724
WRITE(6,*)'WARNING LEN1=',LEN2_LEVDEPC1,' LEN2=',LEN2_LEVDEPC2 MERGE1A.725
ELSE MERGE1A.726
LEN2_LEVDEPC3=LEN2_LEVDEPC1 MERGE1A.727
ENDIF MERGE1A.728
DO I=1,LEN2_LEVDEPC1 UDG1F405.1046
DO J=1,LEN1_LEVDEPC1 UDG1F405.1047
*IF DEF,T3E UDG1F405.1048
IF(XOR(LEVDEPC1((I-1)*LEN1_LEVDEPC1+J), UDG1F405.1049
& LEVDEPC2((I-1)*LEN1_LEVDEPC1+J)).NE.0)THEN UDG1F405.1050
*ELSE UDG1F405.1051
IF(LEVDEPC1((I-1)*LEN1_LEVDEPC1+J).NE. UDG1F405.1052
& LEVDEPC2((I-1)*LEN1_LEVDEPC1+J))THEN UDG1F405.1053
*ENDIF UDG1F405.1054
WRITE(6,*) 'ERROR: Level dependant constants are ', UDG1F405.1055
& 'different' UDG1F405.1056
WRITE(6,*) 'Level = ',J,' Item = ',I, UDG1F405.1057
& ' File 1 = ',LEVDEPC1((I-1)*LEN1_LEVDEPC1+J), UDG1F405.1058
& ' File 2 = ',LEVDEPC2((I-1)*LEN1_LEVDEPC2+J) UDG1F405.1059
CALL ABORT UDG1F405.1060
END IF UDG1F405.1061
LEVDEPC3((I-1)*LEN1_LEVDEPC1+J)= UDG1F405.1062
& LEVDEPC1((I-1)*LEN1_LEVDEPC1+J) UDG1F405.1063
END DO UDG1F405.1064
END DO UDG1F405.1065
ENDIF MERGE1A.751
MERGE1A.752
CL 7. Compare row dependent constants MERGE1A.753
MERGE1A.754
IF(LEN1_ROWDEPC1.NE.LEN1_ROWDEPC2)THEN MERGE1A.755
WRITE(6,*)'ERROR different number of rows' MERGE1A.756
WRITE(6,*)'ROW1=',LEN1_ROWDEPC1,' ROW2=',LEN1_ROWDEPC2 MERGE1A.757
CALL ABORT MERGE1A.758
ELSE MERGE1A.759
LEN1_ROWDEPC3=LEN1_ROWDEPC1 MERGE1A.760
ENDIF MERGE1A.761
IF(LEN2_ROWDEPC1.GT.0.OR.LEN2_ROWDEPC2.GT.0)THEN MERGE1A.762
WRITE(6,*)' ' MERGE1A.763
WRITE(6,*)'ROW DEPENDENT CONSTS:' MERGE1A.764
IF(LEN2_ROWDEPC1.NE.LEN2_ROWDEPC2)THEN MERGE1A.765
WRITE(6,*)'WARNING LEN1=',LEN2_ROWDEPC1,' LEN2=',LEN2_ROWDEPC2 MERGE1A.766
ELSE MERGE1A.767
LEN2_ROWDEPC3=LEN2_ROWDEPC1 MERGE1A.768
ENDIF MERGE1A.769
! Row dependent constants may be of different data types, UDG1F405.1066
! so comparsion is skipped. UDG1F405.1067
DO I=1,LEN2_ROWDEPC1 UDG1F405.1068
DO J=1,LEN1_ROWDEPC1 UDG1F405.1069
ROWDEPC3((I-1)*LEN1_ROWDEPC1+J)= UDG1F405.1070
& ROWDEPC1((I-1)*LEN1_ROWDEPC1+J) UDG1F405.1071
END DO UDG1F405.1072
END DO UDG1F405.1073
ENDIF MERGE1A.785
C MERGE1A.786
CL 8. Compare column dependent constants MERGE1A.787
MERGE1A.788
IF(LEN1_COLDEPC1.NE.LEN1_COLDEPC2)THEN MERGE1A.789
WRITE(6,*)'ERROR different number of columns' MERGE1A.790
WRITE(6,*)'COL1=',LEN1_COLDEPC1,' ROW2=',LEN1_ROWDEPC2 MERGE1A.791
CALL ABORT MERGE1A.792
ELSE MERGE1A.793
LEN1_COLDEPC3=LEN1_COLDEPC1 MERGE1A.794
ENDIF MERGE1A.795
IF(LEN2_COLDEPC1.GT.0.OR.LEN2_COLDEPC2.GT.0)THEN MERGE1A.796
WRITE(6,*)' ' MERGE1A.797
WRITE(6,*)'COLUMN DEPENDENT CONSTS:' MERGE1A.798
IF(LEN2_COLDEPC1.NE.LEN2_COLDEPC2)THEN MERGE1A.799
WRITE(6,*)'WARNING LEN1=',LEN2_COLDEPC1,' LEN2=',LEN2_COLDEPC2 MERGE1A.800
ELSE MERGE1A.801
LEN2_COLDEPC3=LEN2_COLDEPC1 MERGE1A.802
ENDIF MERGE1A.803
DO I=1,LEN2_COLDEPC1 UDG1F405.1074
DO J=1,LEN1_COLDEPC1 UDG1F405.1075
*IF DEF,T3E UDG1F405.1076
IF(XOR(COLDEPC1((I-1)*LEN1_COLDEPC1+J), UDG1F405.1077
& COLDEPC2((I-1)*LEN1_COLDEPC1+J)).NE.0) THEN UDG1F405.1078
*ELSE UDG1F405.1079
IF(COLDEPC1((I-1)*LEN1_COLDEPC1+J).NE. UDG1F405.1080
& COLDEPC2((I-1)*LEN1_COLDEPC1+J))THEN UDG1F405.1081
*ENDIF UDG1F405.1082
WRITE(6,*) 'ERROR: column dependant constants are ', UDG1F405.1083
& 'different' UDG1F405.1084
WRITE(6,*) 'Column = ',J,' Item = ',I, UDG1F405.1085
& ' File 1 = ',COLDEPC1((I-1)*LEN1_COLDEPC1+J), UDG1F405.1086
& ' File 2 = ',COLDEPC2((I-1)*LEN1_COLDEPC2+J) UDG1F405.1087
CALL ABORT UDG1F405.1088
END IF UDG1F405.1089
COLDEPC3((I-1)*LEN1_COLDEPC1+J)= UDG1F405.1090
& COLDEPC1((I-1)*LEN1_COLDEPC1+J) UDG1F405.1091
END DO UDG1F405.1092
END DO UDG1F405.1093
ENDIF MERGE1A.819
MERGE1A.820
CL 9. Compare field dependent constants MERGE1A.821
MERGE1A.822
IF(LEN1_FLDDEPC1.NE.LEN1_FLDDEPC2)THEN MERGE1A.823
WRITE(6,*)'ERROR different number of fields' MERGE1A.824
WRITE(6,*)'FLD1=',LEN1_FLDDEPC1,' FLD2=',LEN1_FLDDEPC2 MERGE1A.825
CALL ABORT MERGE1A.826
ELSE MERGE1A.827
LEN1_FLDDEPC3=LEN1_FLDDEPC1 MERGE1A.828
ENDIF MERGE1A.829
IF(LEN2_FLDDEPC1.GT.0.OR.LEN2_FLDDEPC2.GT.0)THEN MERGE1A.830
WRITE(6,*)' ' MERGE1A.831
WRITE(6,*)'FIELD DEPENDENT CONSTS:' MERGE1A.832
IF(LEN2_FLDDEPC1.NE.LEN2_FLDDEPC2)THEN MERGE1A.833
WRITE(6,*)'WARNING LEN1=',LEN2_FLDDEPC1,' LEN2=',LEN2_FLDDEPC2 MERGE1A.834
ELSE MERGE1A.835
LEN2_FLDDEPC3=LEN2_FLDDEPC1 MERGE1A.836
ENDIF MERGE1A.837
DO I=1,LEN2_FLDDEPC1 UDG1F405.1094
DO J=1,LEN1_FLDDEPC1 UDG1F405.1095
*IF DEF,T3E UDG1F405.1096
IF(XOR(FLDDEPC1((I-1)*LEN1_FLDDEPC1+J), UDG1F405.1097
& FLDDEPC2((I-1)*LEN1_FLDDEPC1+J)).NE.0) THEN UDG1F405.1098
*ELSE UDG1F405.1099
IF(FLDDEPC1((I-1)*LEN1_FLDDEPC1+J).NE. UDG1F405.1100
& FLDDEPC2((I-1)*LEN1_FLDDEPC1+J))THEN UDG1F405.1101
*ENDIF UDG1F405.1102
WRITE(6,*) 'ERROR: field dependant constants are ', UDG1F405.1103
& 'different' UDG1F405.1104
WRITE(6,*) 'Field = ',J,' Item = ',I, UDG1F405.1105
& ' File 1 = ',FLDDEPC1((I-1)*LEN1_FLDDEPC1+J), UDG1F405.1106
& ' File 2 = ',FLDDEPC2((I-1)*LEN1_FLDDEPC2+J) UDG1F405.1107
CALL ABORT UDG1F405.1108
END IF UDG1F405.1109
FLDDEPC3((I-1)*LEN1_FLDDEPC1+J)= UDG1F405.1110
& FLDDEPC1((I-1)*LEN1_FLDDEPC1+J) UDG1F405.1111
END DO UDG1F405.1112
END DO UDG1F405.1113
ENDIF MERGE1A.853
MERGE1A.854
CL 10. Compare extra constants MERGE1A.855
MERGE1A.856
IF(LEN_EXTCNST1.GT.0.OR.LEN_EXTCNST2.GT.0)THEN MERGE1A.857
WRITE(6,*)' ' MERGE1A.858
WRITE(6,*)'EXTRA CONSTANTS:' MERGE1A.859
IF(LEN_EXTCNST1.NE.LEN_EXTCNST2)THEN MERGE1A.860
WRITE(6,*)'WARNING LEN1=',LEN_EXTCNST1,' LEN2=',LEN_EXTCNST2 MERGE1A.861
ELSE MERGE1A.862
LEN_EXTCNST3=LEN_EXTCNST1 MERGE1A.863
ENDIF MERGE1A.864
DO I=1,LEN_EXTCNST1 UDG1F405.1114
*IF DEF,T3E UDG1F405.1115
IF(XOR(EXTCNST1(I),EXTCNST2(I)).NE.0) THEN UDG1F405.1116
*ELSE UDG1F405.1117
IF(EXTCNST1(I).NE.EXTCNST2(I))THEN UDG1F405.1118
*ENDIF UDG1F405.1119
WRITE(6,*) 'ERROR: extra constants are different' UDG1F405.1120
WRITE(6,*) 'Item = ',I, UDG1F405.1121
& ' File 1 = ',EXTCNST1(I), UDG1F405.1122
& ' File 2 = ',EXTCNST2(I) UDG1F405.1123
CALL ABORT UDG1F405.1124
END IF UDG1F405.1125
EXTCNST3(I)=EXTCNST1(I) UDG1F405.1126
END DO UDG1F405.1127
ENDIF MERGE1A.877
MERGE1A.878
CL 11. Compare dump history MERGE1A.879
MERGE1A.880
IF(LEN_DUMPHIST1.GT.0.OR.LEN_DUMPHIST2.GT.0)THEN MERGE1A.881
WRITE(6,*)' ' MERGE1A.882
WRITE(6,*)'HISTORY BLOCK:' MERGE1A.883
IF(LEN_DUMPHIST1.NE.LEN_DUMPHIST2)THEN MERGE1A.884
WRITE(6,*)'WARNING LEN1=',LEN_DUMPHIST1,' LEN2=',LEN_DUMPHIST2 MERGE1A.885
ELSE MERGE1A.886
LEN_DUMPHIST3=LEN_DUMPHIST1 MERGE1A.887
ENDIF MERGE1A.888
DO I=1,LEN_DUMPHIST1 UDG1F405.1128
*IF DEF,T3E UDG1F405.1129
IF(XOR(DUMPHIST1(I),DUMPHIST2(I)).NE.0) THEN UDG1F405.1130
*ELSE UDG1F405.1131
IF(DUMPHIST1(I).NE.DUMPHIST2(I))THEN UDG1F405.1132
*ENDIF UDG1F405.1133
WRITE(6,*) 'ERROR: dump histories are different' UDG1F405.1134
WRITE(6,*) 'Item = ',I, UDG1F405.1135
& ' File 1 = ',DUMPHIST1(I), UDG1F405.1136
& ' File 2 = ',DUMPHIST2(I) UDG1F405.1137
CALL ABORT UDG1F405.1138
END IF UDG1F405.1139
DUMPHIST3(I)=DUMPHIST1(I) UDG1F405.1140
END DO UDG1F405.1141
ENDIF MERGE1A.901
MERGE1A.902
CL 12. Compare compressed index 1 MERGE1A.903
MERGE1A.904
IF(LEN_CFI11.GT.0.OR.LEN_CFI12.GT.0)THEN MERGE1A.905
WRITE(6,*)' ' MERGE1A.906
WRITE(6,*)'COMPRESSED INDEX 1:' MERGE1A.907
IF(LEN_CFI11.NE.LEN_CFI12)THEN MERGE1A.908
WRITE(6,*)'WARNING LEN1=',LEN_CFI11,' LEN2=',LEN_CFI12 MERGE1A.909
ELSE MERGE1A.910
LEN_CFI13=LEN_CFI11 MERGE1A.911
ENDIF MERGE1A.912
DO I=1,LEN_CFI11 UDG1F405.1142
*IF DEF,T3E UDG1F405.1143
IF(XOR(CFI11(I),CFI12(I)).NE.0) THEN UDG1F405.1144
*ELSE UDG1F405.1145
IF(CFI11(I).NE.CFI12(I))THEN UDG1F405.1146
*ENDIF UDG1F405.1147
WRITE(6,*) 'ERROR: compressed index 1 is different' UDG1F405.1148
WRITE(6,*) 'Item = ',I, UDG1F405.1149
& ' File 1 = ',CFI11(I), UDG1F405.1150
& ' File 2 = ',CFI12(I) UDG1F405.1151
CALL ABORT UDG1F405.1152
END IF UDG1F405.1153
CFI13(I)=CFI11(I) UDG1F405.1154
END DO UDG1F405.1155
ENDIF MERGE1A.925
MERGE1A.926
CL 13. Compare compressed index 2 MERGE1A.927
MERGE1A.928
IF(LEN_CFI21.GT.0.OR.LEN_CFI22.GT.0)THEN MERGE1A.929
WRITE(6,*)' ' MERGE1A.930
WRITE(6,*)'COMPRESSED INDEX 2:' MERGE1A.931
IF(LEN_CFI21.NE.LEN_CFI22)THEN MERGE1A.932
WRITE(6,*)'WARNING LEN1=',LEN_CFI21,' LEN2=',LEN_CFI22 MERGE1A.933
ELSE MERGE1A.934
LEN_CFI23=LEN_CFI21 MERGE1A.935
ENDIF MERGE1A.936
DO I=1,LEN_CFI21 UDG1F405.1156
*IF DEF,T3E UDG1F405.1157
IF(XOR(CFI21(I),CFI22(I)).NE.0) THEN UDG1F405.1158
*ELSE UDG1F405.1159
IF(CFI21(I).NE.CFI22(I))THEN UDG1F405.1160
*ENDIF UDG1F405.1161
WRITE(6,*) 'ERROR: compressed index 2 is different' UDG1F405.1162
WRITE(6,*) 'Item = ',I, UDG1F405.1163
& ' File 1 = ',CFI21(I), UDG1F405.1164
& ' File 2 = ',CFI22(I) UDG1F405.1165
CALL ABORT UDG1F405.1166
END IF UDG1F405.1167
CFI23(I)=CFI21(I) UDG1F405.1168
END DO UDG1F405.1169
ENDIF MERGE1A.949
MERGE1A.950
CL 14. Compare compressed index 3 MERGE1A.951
MERGE1A.952
IF(LEN_CFI31.GT.0.OR.LEN_CFI32.GT.0)THEN MERGE1A.953
WRITE(6,*)' ' MERGE1A.954
WRITE(6,*)'COMPRESSED INDEX 3:' MERGE1A.955
IF(LEN_CFI31.NE.LEN_CFI32)THEN MERGE1A.956
WRITE(6,*)'WARNING LEN1=',LEN_CFI31,' LEN2=',LEN_CFI32 MERGE1A.957
ELSE MERGE1A.958
LEN_CFI33=LEN_CFI31 MERGE1A.959
ENDIF MERGE1A.960
DO I=1,LEN_CFI31 UDG1F405.1170
*IF DEF,T3E UDG1F405.1171
IF(XOR(CFI31(I),CFI32(I)).NE.0) THEN UDG1F405.1172
*ELSE UDG1F405.1173
IF(CFI31(I).NE.CFI32(I))THEN UDG1F405.1174
*ENDIF UDG1F405.1175
WRITE(6,*) 'ERROR: compressed index 3 is different' UDG1F405.1176
WRITE(6,*) 'Item = ',I, UDG1F405.1177
& ' File 1 = ',CFI31(I), UDG1F405.1178
& ' File 2 = ',CFI32(I) UDG1F405.1179
CALL ABORT UDG1F405.1180
END IF UDG1F405.1181
CFI33(I)=CFI31(I) UDG1F405.1182
END DO UDG1F405.1183
ENDIF MERGE1A.973
MERGE1A.974
CL 15. Compare lookup tables MERGE1A.975
MERGE1A.976
IF(LEN1_LOOKUP1.NE.LEN1_LOOKUP2)THEN MERGE1A.977
WRITE(6,*)'ERROR lookup tables of different length' MERGE1A.978
WRITE(6,*)'LEN1=',LEN1_LOOKUP1,' LEN2=',LEN1_LOOKUP2 MERGE1A.979
CALL ABORT MERGE1A.980
ENDIF MERGE1A.981
IF(LEN2_LOOKUP1.GT.0.OR.LEN2_LOOKUP2.GT.0)THEN MERGE1A.982
WRITE(6,*)' ' MERGE1A.983
WRITE(6,*)'LOOKUP:' MERGE1A.984
JMIN=MIN0(LEN2_LOOKUP1,LEN2_LOOKUP2) MERGE1A.985
IDIFF=0 MERGE1A.986
NDIFF=0 MERGE1A.987
MERGE1A.988
C Read in namelist. . MERGE1A.989
C NRECF1>=0 If file 2 is to be appended to file 1 after NRECF1 MERGE1A.990
C records. MERGE1A.991
C NRECF1<0 If the files are time series and the output file is a MERGE1A.992
C time series. The point of overlap is calculated MERGE1A.993
C automatically. This is the setting for merging . MERGE1A.994
C boundary datasets MERGE1A.995
READ(5,CONTROL) MERGE1A.1001
IF(NRECF1.GT.LEN2_LOOKUP1)THEN MERGE1A.1002
WRITE(6,*)'ERROR: NRECF1 is larger than LEN2_LOOKUP1' MERGE1A.1003
WRITE(6,*)' NRECF1 = ',NRECF1,' LEN2_LOOKUP1 = ',LEN2_LOOKUP1 MERGE1A.1004
CALL ABORT MERGE1A.1005
ELSE IF(NRECF1.GE.0)THEN UDG1F405.1184
IF(FIXHD1(5).NE.5)THEN UDG1F405.1185
IDIFF = NRECF1 UDG1F405.1186
ELSE IF(MOD(NRECF1,INTHD1(15)).EQ.0)THEN UDG1F405.1187
IDIFF = NRECF1 UDG1F405.1188
ELSE UDG1F405.1189
WRITE(6,*) 'ERROR: Files are time series.' UDG1F405.1190
WRITE(6,*) 'NRECF1 must be a multiple of ',INTHD1(15) UDG1F405.1191
WRITE(6,*) 'NRECF1 = ',NRECF1 UDG1F405.1192
CALL ABORT UDG1F405.1193
END IF UDG1F405.1194
ELSE UDG1F405.1195
IF(FIXHD1(10).NE.1)THEN UDG1F405.1196
WRITE(6,*)'ERROR: File 1 not a time series' UDG1F405.1197
CALL ABORT UDG1F405.1198
END IF UDG1F405.1199
IF(FIXHD2(10).NE.1)THEN UDG1F405.1200
WRITE(6,*)'ERROR: File 2 not a time series' UDG1F405.1201
CALL ABORT UDG1F405.1202
END IF UDG1F405.1203
MERGE1A.1022
C Compare each lookup record in file 1 with the first looup record MERGE1A.1023
C in file 2. When match is found set IDIFF. MERGE1A.1024
DO I=1,LEN2_LOOKUP1 MERGE1A.1025
DO J=1,LEN1_LOOKUP1 MERGE1A.1026
IF(LOOKUP1(J,I).NE.LOOKUP2(J,1) MERGE1A.1027
&.AND.(J.LE.6.OR.J.EQ.23.OR.J.EQ.26))THEN MERGE1A.1028
NDIFF=NDIFF+1 MERGE1A.1029
ENDIF MERGE1A.1030
ENDDO MERGE1A.1031
IF((NDIFF.EQ.0).AND.(IDIFF.EQ.0))THEN MERGE1A.1032
WRITE(6,*) MERGE1A.1033
&' File 1 lookup record ',I,' matched with File 2 record 1' MERGE1A.1034
IDIFF=I-1 MERGE1A.1035
ELSE MERGE1A.1036
NDIFF=0 MERGE1A.1037
ENDIF MERGE1A.1038
ENDDO MERGE1A.1039
MERGE1A.1040
C If first lookup record in file 2 not found in file 1. Abort with MERGE1A.1041
C error message MERGE1A.1042
IF(IDIFF.EQ.0)THEN MERGE1A.1043
WRITE(6,*) MERGE1A.1044
&'ERROR First lookup record in file 2 not found in file 1' MERGE1A.1045
WRITE(6,*) 'Cannot merge files' MERGE1A.1046
CALL ABORT MERGE1A.1047
ENDIF MERGE1A.1048
ENDIF MERGE1A.1049
ENDIF MERGE1A.1050
MERGE1A.1051
C Copy the first IDIFF records from file 1 and the remainder from MERGE1A.1052
C file 2. MERGE1A.1053
LEN2_LOOKUP3=LEN2_LOOKUP2+IDIFF MERGE1A.1054
DO I=1,LEN2_LOOKUP3 MERGE1A.1055
DO J=1,LEN1_LOOKUP1 MERGE1A.1056
IF(I.LE.IDIFF)THEN MERGE1A.1057
LOOKUP3(J,I)=LOOKUP1(J,I) MERGE1A.1058
ELSE MERGE1A.1059
LOOKUP3(J,I)=LOOKUP2(J,I-IDIFF) MERGE1A.1060
ENDIF MERGE1A.1061
ENDDO MERGE1A.1062
ENDDO MERGE1A.1063
MERGE1A.1064
CL 16 Ammend header information UDG1F405.1204
UDG1F405.1205
C Check and correct fixed header. UDG1F405.1206
DO J=1,7 UDG1F405.1207
IF(FIXHD3(5).EQ.5)THEN UDG1F405.1208
FIXHD3(20+J)=FIXHD1(20+J) ! First validity time from file 1 UDG1F405.1209
FIXHD3(27+J)=FIXHD2(27+J) ! Last validity time from file 2 UDG1F405.1210
IF(FIXHD1(20+J).GT.FIXHD2(20+J))THEN UDG1F405.1211
IF(FIXHD1(20+J-1).GE.(FIXHD2(20+J-1)))THEN UDG1F405.1212
WRITE(6,*) 'ERROR: File 2 is earlier than file 1 ', UDG1F405.1213
& FIXHD1(20+J),FIXHD2(20+J) UDG1F405.1214
CALL ABORT UDG1F405.1215
ENDIF UDG1F405.1216
ENDIF UDG1F405.1217
ELSE UDG1F405.1218
FIXHD3(20+J)=FIXHD1(20+J) UDG1F405.1219
FIXHD3(27+J)=FIXHD1(27+J) UDG1F405.1220
IF(FIXHD1(20+J).NE.FIXHD2(20+J))THEN UDG1F405.1221
WRITE(6,*) 'WARNING: Initial data time differs', UDG1F405.1222
& FIXHD1(20+J),FIXHD2(20+J) UDG1F405.1223
ENDIF UDG1F405.1224
IF(FIXHD1(27+J).NE.FIXHD2(27+J))THEN UDG1F405.1225
WRITE(6,*) 'WARNING: Validity time differs', UDG1F405.1226
& FIXHD1(27+J),FIXHD2(27+J) UDG1F405.1227
ENDIF UDG1F405.1228
ENDIF UDG1F405.1229
ENDDO UDG1F405.1230
FIXHD3(152)=FIXHD2(152)+IDIFF UDG1F405.1231
FIXHD3(160)=FIXHD3(150)+FIXHD3(151)*FIXHD3(152) UDG1F405.1232
UDG1F405.1233
CL 17 Calculate addressing and length of DATA in file 3 UDG1F405.1234
UDG1F405.1235
! Atmospheric dump dataset or Ancillary dataset UDG1F405.1236
IF((FIXHD3(2).EQ.1.OR.FIXHD3(2).EQ.2).AND. UDG1F405.1237
& (FIXHD3(5).LE.2.OR.FIXHD3(5).EQ.4))THEN UDG1F405.1238
LEN_DATA3=0 UDG1F405.1239
DO I=1,LEN2_LOOKUP3 UDG1F405.1240
LOOKUP3(NADDR,I)=LEN_DATA3+1 UDG1F405.1241
LEN_DATA3=LEN_DATA3+LOOKUP3(LBLREC,I) UDG1F405.1242
ENDDO UDG1F405.1243
UDG1F405.1244
! Call SET_DUMPFILE_ADDRESS to calculate start address UDG1F405.1245
CALL SET_DUMPFILE_ADDRESS(FIXHD3,LEN_FIXHD3, UDG1F405.1246
& LOOKUP3,LEN1_LOOKUP3,LEN2_LOOKUP3, UDG1F405.1247
& NUMBER_OF_DATA_WORDS_IN_MEMORY, UDG1F405.1248
& NUMBER_OF_DATA_WORDS_ON_DISK, UDG1F405.1249
& DISK_ADDRESS) UDG1F405.1250
UDG1F405.1251
C Boundary dataset UDG1F405.1252
ELSEIF(FIXHD3(2).EQ.1.AND.FIXHD3(5).EQ.5)THEN UDG1F405.1253
! Calcuate start address from header and round it up UDG1F405.1254
! to ensure we start on a sector boundary UDG1F405.1255
DISK_ADDRESS=FIXHD3(160)-1 UDG1F405.1256
DISK_ADDRESS=((DISK_ADDRESS+UM_SECTOR_SIZE-1)/ UDG1F405.1257
& UM_SECTOR_SIZE)*UM_SECTOR_SIZE UDG1F405.1258
FIXHD3(160)=DISK_ADDRESS+1 UDG1F405.1259
UDG1F405.1260
! Loop over number of times for which data is present in dataset UDG1F405.1261
INTHD3(3)=LEN2_LOOKUP3/INTHD3(15) UDG1F405.1262
LEN_DATA3=0 UDG1F405.1263
DO J=1,INTHD3(3) UDG1F405.1264
LEN_BUF=0 UDG1F405.1265
MAX_LEN_BUF=0 UDG1F405.1266
DO I=1,INTHD3(15) UDG1F405.1267
POS=(J-1)*INTHD3(15)+I UDG1F405.1268
LOOKUP3(LBEGIN,POS)=DISK_ADDRESS+LEN_BUF UDG1F405.1269
LOOKUP3(LBNREC,POS)=LOOKUP3(LBLREC,POS) UDG1F405.1270
LOOKUP3(NADDR,POS)=LEN_DATA3+1 UDG1F405.1271
LEN_BUF=LEN_BUF+LOOKUP3(LBLREC,POS) UDG1F405.1272
END DO UDG1F405.1273
MAX_LEN_BUF=MAX0(LEN_BUF,MAX_LEN_BUF) UDG1F405.1274
! Update disk address and ensure that next time starts UDG1F405.1275
! on a sector boundary UDG1F405.1276
DISK_ADDRESS=DISK_ADDRESS+LEN_BUF UDG1F405.1277
DISK_ADDRESS=((DISK_ADDRESS+UM_SECTOR_SIZE-1)/ UDG1F405.1278
& UM_SECTOR_SIZE)*UM_SECTOR_SIZE UDG1F405.1279
IF(FIXHD3(12).LE.303)THEN UDG1F405.1280
LEN_DATA3=LEN_DATA3+LEN_BUF/2 UDG1F405.1281
ELSE UDG1F405.1282
LEN_DATA3=LEN_DATA3+LEN_BUF UDG1F405.1283
END IF UDG1F405.1284
ENDDO UDG1F405.1285
END IF UDG1F405.1286
FIXHD3(161)=LEN_DATA3 UDG1F405.1287
CL 18. Print out header for file 3 and check for consistency MERGE1A.1119
MERGE1A.1120
CALL PR_FIXHD(FIXHD3,LEN_FIXHD3,LEN_INTHD3,LEN_REALHD3 MERGE1A.1121
&,LEN1_LEVDEPC3,LEN2_LEVDEPC3,LEN1_ROWDEPC3,LEN2_ROWDEPC3 MERGE1A.1122
&,LEN1_COLDEPC3,LEN2_COLDEPC3,LEN1_FLDDEPC3,LEN2_FLDDEPC3 MERGE1A.1123
&,LEN_EXTCNST3,LEN_DUMPHIST3,LEN_CFI13,LEN_CFI23,LEN_CFI33 MERGE1A.1124
&,LEN1_LOOKUP3,LEN2_LOOKUP3,LEN_DATA3 MERGE1A.1125
&,ICODE,CMESSAGE) MERGE1A.1126
IF(ICODE.NE.0)THEN MERGE1A.1127
WRITE(6,*)CMESSAGE,ICODE MERGE1A.1128
CALL ABORT MERGE1A.1129
ENDIF MERGE1A.1130
CALL CHK_LOOK(FIXHD3,LOOKUP3,LEN1_LOOKUP3,LEN_DATA3, GDG0F401.941
*CALL ARGPPX GDG0F401.942
& ICODE,CMESSAGE) GDG0F401.943
IF(ICODE.NE.0)THEN MERGE1A.1133
WRITE(6,*)CMESSAGE,ICODE MERGE1A.1134
CALL ABORT MERGE1A.1135
ENDIF MERGE1A.1136
MERGE1A.1137
CL 19. OPEN output file and write out header MERGE1A.1138
MERGE1A.1139
NFTOUT=22 MERGE1A.1140
CALL FILE_OPEN(NFTOUT,'FILE3',5,1,0,ERROR) GPB1F305.91
IF(ERROR.NE.0)THEN MERGE1A.1142
WRITE(6,*) 'Error opening output file' MERGE1A.1143
CALL ABORT MERGE1A.1144
ENDIF MERGE1A.1145
CALL WRITHEAD(NFTOUT,FIXHD3,LEN_FIXHD3, MERGE1A.1146
& INTHD3,LEN_INTHD3, MERGE1A.1147
& REALHD3,LEN_REALHD3, MERGE1A.1148
& LEVDEPC3,LEN1_LEVDEPC3,LEN2_LEVDEPC3, MERGE1A.1149
& ROWDEPC3,LEN1_ROWDEPC3,LEN2_ROWDEPC3, MERGE1A.1150
& COLDEPC3,LEN1_COLDEPC3,LEN2_COLDEPC3, MERGE1A.1151
& FLDDEPC3,LEN1_FLDDEPC3,LEN2_FLDDEPC3, MERGE1A.1152
& EXTCNST3,LEN_EXTCNST3, MERGE1A.1153
& DUMPHIST3,LEN_DUMPHIST3, MERGE1A.1154
& CFI13,LEN_CFI13, MERGE1A.1155
& CFI23,LEN_CFI23, MERGE1A.1156
& CFI33,LEN_CFI33, MERGE1A.1157
& LOOKUP3,LEN1_LOOKUP3,LEN2_LOOKUP3, MERGE1A.1158
& LEN_DATA3, MERGE1A.1159
*CALL ARGPPX GDG0F401.944
& START_BLOCK,ICODE,CMESSAGE) MERGE1A.1160
MERGE1A.1161
CL 19. Write data fields MERGE1A.1162
MERGE1A.1163
WRITE(6,*)' ' MERGE1A.1164
WRITE(6,*)'DATA FIELDS:' MERGE1A.1165
JMIN=MIN0(LEN2_LOOKUP1,LEN2_LOOKUP2) MERGE1A.1166
MERGE1A.1167
DO I=1,IDIFF MERGE1A.1168
MERGE1A.1169
C Read first fields from file 1 and write them to field 3 MERGE1A.1170
CALL READFLDS(NFTIN1,1,I,LOOKUP1,LEN1_LOOKUP1, MERGE1A.1171
& D1,P_FIELD1,FIXHD1, GDG0F401.945
*CALL ARGPPX GDG0F401.946
& ICODE,CMESSAGE) GDG0F401.947
IF(ICODE.NE.0)CALL ABORT_IO('MERGE',CMESSAGE,ICODE,NFTIN1) GDG0F401.948
CALL WRITFLDS(NFTOUT,1,I,LOOKUP3,LEN1_LOOKUP3, MERGE1A.1174
& D1,P_FIELD3,FIXHD3, GDG0F401.949
*CALL ARGPPX GDG0F401.950
& ICODE,CMESSAGE) GDG0F401.951
IF(ICODE.NE.0)CALL ABORT_IO('MERGE',CMESSAGE,ICODE,NFTIN1) GDG0F401.952
ENDDO MERGE1A.1177
MERGE1A.1178
C Read remaining fields from file 2 and write them to file 3 MERGE1A.1179
DO I=1,LEN2_LOOKUP2 MERGE1A.1180
CALL READFLDS(NFTIN2,1,I,LOOKUP2,LEN1_LOOKUP2, MERGE1A.1181
& D2,P_FIELD2,FIXHD2, GDG0F401.953
*CALL ARGPPX GDG0F401.954
& ICODE,CMESSAGE) GDG0F401.955
IF(ICODE.NE.0)CALL ABORT_IO('MERGE',CMESSAGE,ICODE,NFTIN2) GDG0F401.956
CALL WRITFLDS(NFTOUT,1,I+IDIFF,LOOKUP3,LEN1_LOOKUP3, MERGE1A.1183
& D2,P_FIELD3,FIXHD3, GDG0F401.957
*CALL ARGPPX GDG0F401.958
& ICODE,CMESSAGE) GDG0F401.959
IF(ICODE.NE.0)CALL ABORT_IO('MERGE',CMESSAGE,ICODE,NFTIN2) GDG0F401.960
MERGE1A.1186
ENDDO MERGE1A.1187
MERGE1A.1188
RETURN MERGE1A.1189
END MERGE1A.1190
*ENDIF MERGE1A.1191