*IF DEF,FLUXPROC FPGTLOOK.2
C ******************************COPYRIGHT****************************** FPGTLOOK.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPGTLOOK.4
C FPGTLOOK.5
C Use, duplication or disclosure of this code is subject to the FPGTLOOK.6
C restrictions as set forth in the contract. FPGTLOOK.7
C FPGTLOOK.8
C Meteorological Office FPGTLOOK.9
C London Road FPGTLOOK.10
C BRACKNELL FPGTLOOK.11
C Berkshire UK FPGTLOOK.12
C RG12 2SZ FPGTLOOK.13
C FPGTLOOK.14
C If no contract has been raised with this copy of the code, the use, FPGTLOOK.15
C duplication or disclosure of it is strictly prohibited. Permission FPGTLOOK.16
C to do so must first be obtained in writing from the Head of Numerical FPGTLOOK.17
C Modelling at the above address. FPGTLOOK.18
C ******************************COPYRIGHT****************************** FPGTLOOK.19
C FPGTLOOK.20
C Programming standard: Unified Model Documentation Paper No 3 FPGTLOOK.21
C Version No 1 15/1/90 FPGTLOOK.22
C History: FPGTLOOK.23
C version date change FPGTLOOK.24
C 4.5 03/09/98 New code FPGTLOOK.25
C FPGTLOOK.26
! Author: M. J. Bell FPGTLOOK.27
!---------------------------------------------------------------------- FPGTLOOK.28
! contains routines: get_lookup FPGTLOOK.29
! FPGTLOOK.30
! Purpose: Flux processing routine. FPGTLOOK.31
! Return lookup table for one file FPGTLOOK.32
!---------------------------------------------------------------------- FPGTLOOK.33
subroutine get_lookup (UnitIn, icode, 1,1FPGTLOOK.34
*CALL DUMP_AR2 
FPGTLOOK.35
*CALL ARGPPX FPGTLOOK.36
# Len_data, LOOKUP) FPGTLOOK.37
FPGTLOOK.38
implicit none FPGTLOOK.39
FPGTLOOK.40
! declaration of argument list FPGTLOOK.41
integer UnitIn ! IN unit number of file to read FPGTLOOK.42
integer icode ! IN/OUT error code ; > 0 => fatal error detected FPGTLOOK.43
! all arguments in DUMP_LEN are IN FPGTLOOK.44
*CALL DUMP_LEN FPGTLOOK.45
FPGTLOOK.46
integer Len_data ! IN length of data in file FPGTLOOK.47
FPGTLOOK.48
! LOOKUP intent is OUT and is declared by DUMP_DIM FPGTLOOK.49
FPGTLOOK.50
! declaration of globals used FPGTLOOK.51
*CALL CSUBMODL FPGTLOOK.52
*CALL CPPXREF FPGTLOOK.53
*CALL PPXLOOK FPGTLOOK.54
*CALL CMESS FPGTLOOK.55
FPGTLOOK.56
! declaration of local arrays FPGTLOOK.57
! DUMP_DIM declares local arrays for ancillary file header FPGTLOOK.58
*CALL DUMP_DIM FPGTLOOK.59
FPGTLOOK.60
! declaration of local scalars FPGTLOOK.61
integer START_BLOCK ! start of data block FPGTLOOK.62
character*256 CMESSAGE ! error message FPGTLOOK.63
FPGTLOOK.64
external READHEAD FPGTLOOK.65
FPGTLOOK.66
!---------------------------------------------------------------------- FPGTLOOK.67
! 0. Preliminaries FPGTLOOK.68
CSub = 'get_lookup' ! subroutine name for error messages FPGTLOOK.69
FPGTLOOK.70
! 1. Read dump / ancillary file header FPGTLOOK.71
FPGTLOOK.72
call READHEAD(UnitIn, FPGTLOOK.73
*CALL DUMP_AR1 FPGTLOOK.74
# Len_data, FPGTLOOK.75
*CALL ARGPPX FPGTLOOK.76
# START_BLOCK,ICODE,CMESSAGE) FPGTLOOK.77
FPGTLOOK.78
if ( icode .gt. 0 ) then FPGTLOOK.79
write(UnErr,*)CErr,CSub, FPGTLOOK.80
# ' step 1. failed to read ancillary file header; cmessage is ', FPGTLOOK.81
# cmessage FPGTLOOK.82
icode = 32 FPGTLOOK.83
go to 9999 FPGTLOOK.84
end if FPGTLOOK.85
FPGTLOOK.86
9999 continue FPGTLOOK.87
return FPGTLOOK.88
end FPGTLOOK.89
!---------------------------------------------------------------------- FPGTLOOK.90
*ENDIF FPGTLOOK.91