subroutine intf_out ( 1,20INTFOUT1.32
*CALL ADUMLEN 
INTFOUT1.33
*CALL AINFLEN INTFOUT1.34
*CALL ARGDUM INTFOUT1.35
*CALL ARGINF INTFOUT1.36
*CALL ARGPPX INTFOUT1.37
& NFTOUT, JINTF, im, mype, INTFOUT1.38
& INTF_PACK, INTFWIDTH, LEN_INTF_P, LEN_INTF_U, INTFOUT1.39
& len_intf_data, item_intf, len_bdy_flds, INTFOUT1.40
& dump_lookup_intf, intf_data, icode, cmessage ) INTFOUT1.41
!--------------------------------------- INTFOUT1.42
INTFOUT1.43
implicit none INTFOUT1.44
INTFOUT1.45
*CALL CDUMLEN INTFOUT1.46
*CALL CINFLEN INTFOUT1.47
*CALL TYPDUM INTFOUT1.48
*CALL TYPINF INTFOUT1.49
INTFOUT1.50
*CALL CSUBMODL INTFOUT1.51
*CALL CPPXREF INTFOUT1.52
*CALL PPXLOOK INTFOUT1.53
INTFOUT1.54
integer INTFOUT1.55
& NFTOUT, ! unit to write to INTFOUT1.56
& JINTF, ! number of this boundary file INTFOUT1.57
& im, ! internal model identifier INTFOUT1.58
& mype, ! number of "my" processor INTFOUT1.59
& INTF_PACK(N_INTF), ! Packing Indicator for data INTFOUT1.60
* INTFWIDTH(N_INTF), ! Width of interface zone INTFOUT1.61
& LEN_INTF_P(N_INTF), ! Length of interface p field INTFOUT1.62
& LEN_INTF_U(N_INTF), ! Length of interface u field INTFOUT1.63
& len_intf_data, ! length of field of data to output INTFOUT1.64
& item_intf(INTF_LOOKUPS), ! stash item numbers of fields INTFOUT1.65
& len_bdy_flds(INTF_LOOKUPS), ! length of interface fields INTFOUT1.66
& dump_lookup_intf(INTF_LOOKUPS) ! numbers of corresponding INTFOUT1.67
! dump lookup tables INTFOUT1.68
INTFOUT1.69
real intf_data( len_intf_data ) ! boundary data for output INTFOUT1.70
integer icode INTFOUT1.71
character*256 cmessage INTFOUT1.72
INTFOUT1.73
!----------------------------------------------------------- INTFOUT1.74
*CALL CMAXSIZE INTFOUT1.75
*CALL CMAXSIZO INTFOUT1.76
*CALL CHSUNITS INTFOUT1.77
*CALL IHISTO ! for FT_LASTFIELD INTFOUT1.78
*CALL CLFHIST ! for MODEL_FT_UNIT INTFOUT1.79
*CALL CLOOKADD INTFOUT1.80
*CALL CNTLALL ! for ft_steps and lcal360 INTFOUT1.81
*CALL CNTLGEN ! for STEPS_PER_SEC etc. INTFOUT1.82
*CALL CTIME ! for basis_time_days, STEP_im etc. INTFOUT1.83
*CALL CNTL_IO ! stores um_sector_size INTFOUT1.84
INTFOUT1.85
CL Local variables INTFOUT1.86
INTFOUT1.87
integer INTFOUT1.88
& LEN_PPNAME, ! length of pp file name INTFOUT1.89
& NTIME, ! number of field in output file INTFOUT1.90
& lookup_start,! start location to write lookup table INTFOUT1.91
& LEN_IO, INTFOUT1.92
& disk_address, INTFOUT1.93
* start_addr, INTFOUT1.94
& len_data, ! INTFOUT1.95
& var, ! loop index for variable INTFOUT1.96
& i, ! loop index INTFOUT1.97
& N1, ! local packing index INTFOUT1.98
& disk_length, INTFOUT1.99
& iaddr, INTFOUT1.100
& j, ! loop index INTFOUT1.101
& data_start, ! start location for writing interface data INTFOUT1.102
INTFOUT1.103
& EXPPXI, ! function INTFOUT1.104
& P21BITS ! function INTFOUT1.105
EXTERNAL EXPPXI, P21BITS INTFOUT1.106
INTFOUT1.107
integer SEC,YY,MM,DD,HR,MN,SS,DAY_NO INTFOUT1.108
INTFOUT1.109
real a_io INTFOUT1.110
INTFOUT1.111
LOGICAL LPACK_32B, ! pack as 32 bit numbers INTFOUT1.112
& LPACK_PPXREF ! INTFOUT1.113
INTFOUT1.114
CHARACTER*80 STRING ! work array INTFOUT1.115
CHARACTER*14 PPNAME ! boundary output filename INTFOUT1.116
!------------------------------------------------------------- INTFOUT1.117
INTFOUT1.118
CL 0. Miscellaneous Preliminaries INTFOUT1.119
INTFOUT1.120
LPACK_32B = INTF_PACK(JINTF).EQ.1 INTFOUT1.121
LPACK_PPXREF = INTF_PACK(JINTF).EQ.2 INTFOUT1.122
INTFOUT1.123
CL 1.0 Open file; determine where to write new data INTFOUT1.124
INTFOUT1.125
CL Open boundary output file if reinitialised during run INTFOUT1.126
INTFOUT1.127
IF (FT_STEPS(NFTOUT).GT.0) THEN INTFOUT1.128
STRING = MODEL_FT_UNIT(NFTOUT) INTFOUT1.129
PPNAME = STRING(18:31) INTFOUT1.130
LEN_PPNAME = LEN(PPNAME) INTFOUT1.131
CALL FILE_OPEN(NFTOUT,PPNAME,LEN_PPNAME,1,1,ICODE) INTFOUT1.132
IF (ICODE.NE.0) THEN INTFOUT1.133
CMESSAGE="INTF_OUT: Error opening preassigned boundary file" INTFOUT1.134
GO TO 999 ! Return INTFOUT1.135
ENDIF INTFOUT1.136
ENDIF INTFOUT1.137
INTFOUT1.138
C Determine position where to Buffer out data to INTFOUT1.139
NTIME=FT_LASTFIELD(NFTOUT)+1 INTFOUT1.140
INTFOUT1.141
CL 2. Set up headers INTFOUT1.142
INTFOUT1.143
CL 2.1 Fixed length header INTFOUT1.144
FIXHD_INTF(152,JINTF) = INTF_LOOKUPS*NTIME INTFOUT1.145
FIXHD_INTF(161,JINTF) = LEN_INTF_DATA*NTIME INTFOUT1.146
INTFOUT1.147
CL 2.2 Integer Constants INTFOUT1.148
INTHD_INTF(3,JINTF) = NTIME INTFOUT1.149
INTFOUT1.150
CL 2.3 LOOKUP Table INTFOUT1.151
INTFOUT1.152
C 2.3.1 Determine position in LOOKUP table INTFOUT1.153
LOOKUP_START=FIXHD_INTF(150,JINTF) + INTFOUT1.154
& FIXHD_INTF(151,JINTF)*INTF_LOOKUPS*(NTIME-1) - 1 INTFOUT1.155
INTFOUT1.156
C 2.3.2 For well-formed I/O re-read the last lookup INTFOUT1.157
C table on disk to find disk_address INTFOUT1.158
C also set initial start address INTFOUT1.159
INTFOUT1.160
if(ntime.ne.1) then INTFOUT1.161
call setpos(nftout, lookup_start-len1_lookup, icode) INTFOUT1.162
call buffin(nftout, lookup_intf(1, 1, jintf), len1_lookup, INTFOUT1.163
& len_io, a_io) INTFOUT1.164
INTFOUT1.165
c--check for errors INTFOUT1.166
if(a_io.ne.-1.0 .or. len_io.ne.len1_lookup) then INTFOUT1.167
call ioerror('intf_out: Buffer in of Last Lookup Header', INTFOUT1.168
& a_io, len_io, len1_lookup) INTFOUT1.169
cmessage=' intf_out: I/O Error on reading last lookup' INTFOUT1.170
icode=5 INTFOUT1.171
goto 999 INTFOUT1.172
endif INTFOUT1.173
INTFOUT1.174
c--compute the new disk address from the last address and length INTFOUT1.175
disk_address=lookup_intf(lbegin, 1, jintf)+ INTFOUT1.176
& lookup_intf(lbnrec, 1, jintf) INTFOUT1.177
INTFOUT1.178
else ! ntime INTFOUT1.179
INTFOUT1.180
disk_address=fixhd_intf(160, jintf)-1 INTFOUT1.181
endif ! ntime INTFOUT1.182
INTFOUT1.183
c--round this disk address to ensure we start on a sector boundary INTFOUT1.184
disk_address=((disk_address+um_sector_size-1)/ INTFOUT1.185
& um_sector_size)*um_sector_size INTFOUT1.186
INTFOUT1.187
C - start address (not used by well formed I/O ?) INTFOUT1.188
START_ADDR = FIXHD_INTF(161,JINTF)-LEN_INTF_DATA+1 INTFOUT1.189
INTFOUT1.190
C 2.3.3 Check that there is enough space for this entry in LOOKUP table INTFOUT1.191
INTFOUT1.192
IF (FIXHD_INTF(150,JINTF)+ INTFOUT1.193
& FIXHD_INTF(151,JINTF)*FIXHD_INTF(152,JINTF).GT. INTFOUT1.194
& FIXHD_INTF(160,JINTF)) THEN INTFOUT1.195
CMESSAGE=' INTF_OUT: Insufficient space for headers in boundary INTFOUT1.196
& dataset.' INTFOUT1.197
ICODE=1 INTFOUT1.198
GO TO 999 ! Return INTFOUT1.199
ENDIF INTFOUT1.200
INTFOUT1.201
C 2.3.5 Set validity times INTFOUT1.202
INTFOUT1.203
SEC = STEPim(im) * SECS_PER_PERIODim(im) / INTFOUT1.204
& STEPS_PER_PERIODim(im) INTFOUT1.205
INTFOUT1.206
CALL SEC2TIME(0,SEC,BASIS_TIME_DAYS,BASIS_TIME_SECS, INTFOUT1.207
& YY,MM,DD,HR,MN,SS,DAY_NO,LCAL360) INTFOUT1.208
INTFOUT1.209
DO VAR = 1, INTF_LOOKUPS INTFOUT1.210
INTFOUT1.211
C 2.3.6 Initialise lookup tables (with values from dump lookup tables) INTFOUT1.212
INTFOUT1.213
DO I=1,LEN1_LOOKUP INTFOUT1.214
LOOKUP_INTF(I,VAR,JINTF)=LOOKUP(I,dump_lookup_intf(var)) INTFOUT1.215
ENDDO INTFOUT1.216
INTFOUT1.217
C 2.3.7 Set times in lookup tables INTFOUT1.218
INTFOUT1.219
LOOKUP_INTF(LBYR ,VAR,JINTF) = YY INTFOUT1.220
LOOKUP_INTF(LBMON,VAR,JINTF) = MM INTFOUT1.221
LOOKUP_INTF(LBDAT,VAR,JINTF) = DD INTFOUT1.222
LOOKUP_INTF(LBHR ,VAR,JINTF) = HR INTFOUT1.223
LOOKUP_INTF(LBMIN,VAR,JINTF) = MN INTFOUT1.224
LOOKUP_INTF(LBDAY,VAR,JINTF) = DAY_NO INTFOUT1.225
INTFOUT1.226
LOOKUP_INTF(LBYRD ,VAR,JINTF) = FIXHD(21) INTFOUT1.227
LOOKUP_INTF(LBMOND,VAR,JINTF) = FIXHD(22) INTFOUT1.228
LOOKUP_INTF(LBDATD,VAR,JINTF) = FIXHD(23) INTFOUT1.229
LOOKUP_INTF(LBHRD ,VAR,JINTF) = FIXHD(24) INTFOUT1.230
LOOKUP_INTF(LBMIND,VAR,JINTF) = FIXHD(25) INTFOUT1.231
LOOKUP_INTF(LBDAYD,VAR,JINTF) = FIXHD(27) INTFOUT1.232
INTFOUT1.233
C 2.3.8 Set the length of the field in LOOKUP table INTFOUT1.234
C (simpler than in original atmosphere code) !! CHECK THIS !! INTFOUT1.235
INTFOUT1.236
LOOKUP_INTF(LBLREC,VAR,JINTF) = len_bdy_flds(var) INTFOUT1.237
INTFOUT1.238
C 2.3.9 Set packing info INTFOUT1.239
N1 = 0 ! Data not packed INTFOUT1.240
IF (LPACK_32B) N1 = 2 ! Data packed as 32 bits INTFOUT1.241
IF (LPACK_PPXREF) THEN INTFOUT1.242
N1 = EXPPXI(im,0,item_intf,ppx_dump_packing, INTFOUT1.243
*CALL ARGPPX INTFOUT1.244
& icode,cmessage) INTFOUT1.245
if (icode .gt. 0) then INTFOUT1.246
write(6,*) 'exppxi failed in intf_out' INTFOUT1.247
go to 999 INTFOUT1.248
end if INTFOUT1.249
END IF INTFOUT1.250
LOOKUP_INTF(LBPACK,VAR,JINTF)= N1 INTFOUT1.251
INTFOUT1.252
C 2.3.10 Store the disk address; and calculate for next field INTFOUT1.253
lookup_intf(lbegin, var, jintf)=disk_address INTFOUT1.254
INTFOUT1.255
c--fetch the data field length, allowing for packing INTFOUT1.256
if(mod(lookup_intf(lbpack, var, jintf), 10).eq.2) then INTFOUT1.257
disk_length=(lookup_intf(lblrec, var, jintf)+1)/2 INTFOUT1.258
else INTFOUT1.259
disk_length=lookup_intf(lblrec, var, jintf) INTFOUT1.260
endif INTFOUT1.261
INTFOUT1.262
c--store the rounded-up length INTFOUT1.263
C NB !! This length is not checked to fit sectors !! INTFOUT1.264
lookup_intf(lbnrec, var, jintf)=disk_length INTFOUT1.265
INTFOUT1.266
c--update the disk address INTFOUT1.267
disk_address=disk_address+disk_length INTFOUT1.268
INTFOUT1.269
C 2.3.11 Set other elements in the lookup table INTFOUT1.270
INTFOUT1.271
C grid code ; should be 1 for all variables (correction at 4.4) INTFOUT1.272
C !!! ideally should be 101 for rotated grid INTFOUT1.273
LOOKUP_INTF(LBCODE,VAR,JINTF)=1 INTFOUT1.274
INTFOUT1.275
LOOKUP_INTF(LBHEM,VAR,JINTF)=99 INTFOUT1.276
LOOKUP_INTF(LBROW,VAR,JINTF)=INTFWIDTH(JINTF) INTFOUT1.277
INTFOUT1.278
C numbers of rows & columns; var=2 or 3 is not suitable for ocean INTFOUT1.279
LOOKUP_INTF(LBNPT,VAR,JINTF) = INTFOUT1.280
& LEN_INTF_P(JINTF)/INTFWIDTH(JINTF) INTFOUT1.281
IF ( ( IM .EQ. 1. .AND. (VAR.EQ.2.OR.VAR.EQ.3) ) INTFOUT1.282
& .OR. ( IM .EQ. 2. .AND. (VAR.EQ.3.OR.VAR.EQ.4) ) ) THEN INTFOUT1.283
LOOKUP_INTF(LBNPT,VAR,JINTF) = INTFOUT1.284
& LEN_INTF_U(JINTF)/INTFWIDTH(JINTF) INTFOUT1.285
END IF INTFOUT1.286
INTFOUT1.287
LOOKUP_INTF(LBLEV,VAR,JINTF)=-1 INTFOUT1.288
LOOKUP_INTF(NADDR,VAR,JINTF) = START_ADDR INTFOUT1.289
START_ADDR = START_ADDR + LOOKUP_INTF(LBLREC,VAR,JINTF) INTFOUT1.290
INTFOUT1.291
END DO ! VAR INTFOUT1.292
INTFOUT1.293
CL 3. Pack data as required INTFOUT1.294
INTFOUT1.295
IADDR = 1 INTFOUT1.296
LEN_DATA = 0 INTFOUT1.297
INTFOUT1.298
DO VAR = 1,INTF_LOOKUPS INTFOUT1.299
IF (MOD(LOOKUP_INTF(LBPACK,VAR,JINTF),10).EQ.2) THEN INTFOUT1.300
CL 3.1 Pack this data field INTFOUT1.301
INTFOUT1.302
*IF DEF,MPP INTFOUT1.303
IF (mype .EQ. 0) THEN INTFOUT1.304
*ENDIF INTFOUT1.305
CALL PACK21(LOOKUP_INTF(LBLREC,VAR,JINTF), INTFOUT1.306
& INTF_DATA(IADDR),INTF_DATA(LEN_DATA+1), INTFOUT1.307
& P21BITS(FIXHD_INTF(12,JINTF))) INTFOUT1.308
*IF DEF,MPP INTFOUT1.309
ENDIF INTFOUT1.310
*ENDIF INTFOUT1.311
INTFOUT1.312
c--the (+1) in the expression below is unnecessary, since INTFOUT1.313
c LBC data is composed of two rows NS and two rows EW, and INTFOUT1.314
c thus always has an even number of data points. If this INTFOUT1.315
c is not true, then READFLDS will either get the data one INTFOUT1.316
c out downwards if the (+1) is omitted, or one word upwards INTFOUT1.317
c if the (+1) is added. In other words, the packing will INTFOUT1.318
c cause either one word to be omitted or one word added in INTFOUT1.319
c the data after the read. This is because READFLDS reads INTFOUT1.320
c and converts the whole LBC record at one go, rather than INTFOUT1.321
c as a series of separate records. INTFOUT1.322
LEN_DATA = LEN_DATA+(LOOKUP_INTF(LBLREC,VAR,JINTF)+1)/2 INTFOUT1.323
INTFOUT1.324
c--check that we are not packing an odd nuber of words INTFOUT1.325
if((lookup_intf(lblrec,var,jintf)/2)*2 .ne. INTFOUT1.326
& lookup_intf(lblrec,var,jintf)) then INTFOUT1.327
write(6,7734) lookup_intf(lblrec,var,jintf) INTFOUT1.328
7734 format(/'LBC Data contains ',i10,' Words, which is', INTFOUT1.329
& ' an Odd Number which is not allowed for 32-bit', INTFOUT1.330
& ' Packing') INTFOUT1.331
*IF DEF,T3E,AND,DEF,MPP INTFOUT1.332
if(mype.eq.0) then INTFOUT1.333
write(6,7734) lookup_intf(lblrec,var,jintf) INTFOUT1.334
endif INTFOUT1.335
*ENDIF INTFOUT1.336
endif INTFOUT1.337
INTFOUT1.338
ELSE ! LOOKUP_INTF(LBPACK.. INTFOUT1.339
INTFOUT1.340
CL 3.2 Copy unpacked data to new location if necessary INTFOUT1.341
IF (LEN_DATA+1.LT.IADDR) THEN INTFOUT1.342
*IF DEF,MPP INTFOUT1.343
IF (mype .EQ. 0) THEN INTFOUT1.344
*ENDIF INTFOUT1.345
DO J = 1,LOOKUP_INTF(LBLREC,VAR,JINTF) INTFOUT1.346
INTF_DATA(LEN_DATA+J) = INTF_DATA(IADDR+J-1) INTFOUT1.347
ENDDO INTFOUT1.348
*IF DEF,MPP INTFOUT1.349
ENDIF INTFOUT1.350
*ENDIF INTFOUT1.351
ENDIF INTFOUT1.352
LEN_DATA = LEN_DATA+LOOKUP_INTF(LBLREC,VAR,JINTF) INTFOUT1.353
INTFOUT1.354
ENDIF INTFOUT1.355
INTFOUT1.356
IADDR = IADDR+LOOKUP_INTF(LBLREC,VAR,JINTF) INTFOUT1.357
ENDDO ! VAR INTFOUT1.358
INTFOUT1.359
CL 4.0 Write out headers/data INTFOUT1.360
INTFOUT1.361
CL 4.1 Fixed length header INTFOUT1.362
INTFOUT1.363
IADDR = 0 INTFOUT1.364
CALL SETPOS (NFTOUT,IADDR,ICODE) INTFOUT1.365
CALL BUFFOUT(NFTOUT,FIXHD_INTF(1,JINTF),LEN_FIXHD,LEN_IO,A_IO) INTFOUT1.366
INTFOUT1.367
C Check for I/O Errors INTFOUT1.368
INTFOUT1.369
IF(A_IO.NE.-1.0.OR.LEN_IO.NE.LEN_FIXHD) THEN INTFOUT1.370
CALL IOERROR('buffer out of fixed length header',A_IO,LEN_IO, INTFOUT1.371
& LEN_FIXHD) INTFOUT1.372
CMESSAGE=' intf_out: I/O ERROR ' INTFOUT1.373
ICODE=2 INTFOUT1.374
GO TO 999 ! Return INTFOUT1.375
END IF INTFOUT1.376
INTFOUT1.377
CL 4.2 Integer constants INTFOUT1.378
INTFOUT1.379
CALL BUFFOUT (NFTOUT,INTHD_INTF(1,JINTF), INTFOUT1.380
& PP_LEN_INTHD,LEN_IO,A_IO) INTFOUT1.381
INTFOUT1.382
C Check for I/O Errors INTFOUT1.383
INTFOUT1.384
IF(A_IO.NE.-1.0.OR.LEN_IO.NE.PP_LEN_INTHD) THEN INTFOUT1.385
CALL IOERROR('buffer out of integer header',A_IO,LEN_IO, INTFOUT1.386
& PP_LEN_INTHD) INTFOUT1.387
CMESSAGE=' intf_out: I/O ERROR ' INTFOUT1.388
ICODE=3 INTFOUT1.389
GO TO 999 ! Return INTFOUT1.390
END IF INTFOUT1.391
INTFOUT1.392
CL 4.3 PP headers in LOOKUP table INTFOUT1.393
CALL SETPOS(NFTOUT,LOOKUP_START,ICODE) INTFOUT1.394
CALL BUFFOUT(NFTOUT,LOOKUP_INTF(1,1,JINTF), INTFOUT1.395
& LEN1_LOOKUP*INTF_LOOKUPS,LEN_IO,A_IO) INTFOUT1.396
INTFOUT1.397
C Check for I/O Errors INTFOUT1.398
INTFOUT1.399
IF(A_IO.NE.-1.0.OR.LEN_IO.NE.LEN1_LOOKUP*INTF_LOOKUPS) THEN INTFOUT1.400
CALL IOERROR('buffer out of PP header',A_IO,LEN_IO, INTFOUT1.401
& LEN1_LOOKUP*INTF_LOOKUPS) INTFOUT1.402
CMESSAGE=' intf_out: I/O ERROR ' INTFOUT1.403
ICODE=4 INTFOUT1.404
GO TO 999 ! Return INTFOUT1.405
END IF INTFOUT1.406
INTFOUT1.407
CL 4.4 Interface data INTFOUT1.408
C Determine position in data section INTFOUT1.409
INTFOUT1.410
DATA_START = INTFOUT1.411
& lookup_intf(lbegin, 1, jintf) INTFOUT1.412
c--round this disk length to a multiple of the sector size INTFOUT1.413
len_data=((len_data+um_sector_size-1)/ INTFOUT1.414
& um_sector_size)*um_sector_size INTFOUT1.415
CALL SETPOS(NFTOUT,DATA_START,ICODE) INTFOUT1.416
CALL BUFFOUT(NFTOUT,INTF_DATA(1),LEN_DATA,LEN_IO,A_IO) INTFOUT1.417
INTFOUT1.418
C Check for I/O Errors INTFOUT1.419
INTFOUT1.420
IF(A_IO.NE.-1.0.OR.LEN_IO.NE.LEN_DATA) THEN INTFOUT1.421
CALL IOERROR('buffer out of boundary data',A_IO,LEN_IO, INTFOUT1.422
& LEN_DATA) INTFOUT1.423
CMESSAGE=' intf_out: I/O ERROR ' INTFOUT1.424
ICODE=51 INTFOUT1.425
GO TO 999 ! Return INTFOUT1.426
END IF INTFOUT1.427
INTFOUT1.428
INTFOUT1.429
CL 5. Close boundary output file if reinitialised during run INTFOUT1.430
IF (FT_STEPS(NFTOUT).GT.0) THEN INTFOUT1.431
LEN_PPNAME=LEN(PPNAME) INTFOUT1.432
CALL FILE_CLOSE(NFTOUT,PPNAME,LEN_PPNAME,1,0,ICODE) INTFOUT1.433
END IF INTFOUT1.434
INTFOUT1.435
CL 6. Update FT_LASTFIELD INTFOUT1.436
FT_LASTFIELD(NFTOUT) = FT_LASTFIELD(NFTOUT) + 1 INTFOUT1.437
INTFOUT1.438
999 RETURN INTFOUT1.439
END INTFOUT1.440
*ENDIF INTFOUT1.441