*IF DEF,CONVIEEE,OR,DEF,CONVPP,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CAMDUMP UJG4F401.1
C ******************************COPYRIGHT****************************** GTS2F400.5833
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5834
C GTS2F400.5835
C Use, duplication or disclosure of this code is subject to the GTS2F400.5836
C restrictions as set forth in the contract. GTS2F400.5837
C GTS2F400.5838
C Meteorological Office GTS2F400.5839
C London Road GTS2F400.5840
C BRACKNELL GTS2F400.5841
C Berkshire UK GTS2F400.5842
C RG12 2SZ GTS2F400.5843
C GTS2F400.5844
C If no contract has been raised with this copy of the code, the use, GTS2F400.5845
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5846
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5847
C Modelling at the above address. GTS2F400.5848
C ******************************COPYRIGHT****************************** GTS2F400.5849
C GTS2F400.5850
CLL Subroutine FIND_MAX_FIELD_SIZE --------------------------------- MAXFLD1.3
CLL MAXFLD1.4
CLL Purpose: Reads in and searches LOOKUP header for maximum field MAXFLD1.5
CLL size MAXFLD1.6
CLL MAXFLD1.7
CLL Written by A. Dickinson MAXFLD1.8
CLL MAXFLD1.9
CLL Model Modification history: MAXFLD1.10
CLL version Date MAXFLD1.11
CLL 4.3 17/04/97 Tidy DEFS and code so that blank source is not GEX1F403.1
CLL produced (A. Brady) GEX1F403.2
! 4.4 25/04/97 Changes to make the addresses well-formed for GBC5F404.180
! Cray I/O. GBC5F404.181
! Author: Bob Carruthers, Cray Research GBC5F404.182
CLL MAXFLD1.12
CLL Logical component number: E5 MAXFLD1.13
CLL MAXFLD1.14
CLL External Documentation: None MAXFLD1.15
CLL MAXFLD1.16
CLLEND MAXFLD1.17
C*L Arguments:-------------------------------------------------------- MAXFLD1.18
MAXFLD1.19
SUBROUTINE FIND_MAX_FIELD_SIZE 5,4MAXFLD1.20
*IF DEF,CONVIEEE,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CAMDUMP GEX1F403.3
& (NFTIN,LEN1_LOOKUP,LEN2_LOOKUP,FIXHD,MAX_FIELD_SIZE, UBC1F402.110
& wgdos_expand) UBC1F402.111
*ELSE UBC1F402.112
& (NFTIN,LEN1_LOOKUP,LEN2_LOOKUP,FIXHD,MAX_FIELD_SIZE) UBC1F402.113
*ENDIF UBC1F402.114
MAXFLD1.22
IMPLICIT NONE MAXFLD1.23
MAXFLD1.24
INTEGER MAXFLD1.25
& NFTIN !IN Unit number of file MAXFLD1.26
&,LEN1_LOOKUP !IN 1st dim of LOOKUP array MAXFLD1.27
&,LEN2_LOOKUP !IN 2nd dim of LOOKUP array MAXFLD1.28
&,FIXHD(*) !IN Fixed length header MAXFLD1.29
&,MAX_FIELD_SIZE !OUT Maximum size of field held on file MAXFLD1.30
*IF DEF,CONVIEEE,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CAMDUMP GEX1F403.4
integer wgdos_expand UBC1F402.116
*ENDIF UBC1F402.117
C ------------------------------------------------------------- MAXFLD1.31
C Workspace usage:--------------------------------------------- MAXFLD1.32
MAXFLD1.33
INTEGER MAXFLD1.34
& LOOKUP(LEN1_LOOKUP,LEN2_LOOKUP) ! Lookup header MAXFLD1.35
MAXFLD1.36
C ------------------------------------------------------------- MAXFLD1.37
C Local variables:--------------------------------------------- MAXFLD1.38
MAXFLD1.39
INTEGER MAXFLD1.40
& LEN_IO ! No of words transferred by BUFFIN MAXFLD1.41
&,K ! Loop index MAXFLD1.42
MAXFLD1.43
&,ICODE !Return code from setpos GTD0F400.93
REAL MAXFLD1.44
& A ! BUFFIN error code MAXFLD1.45
*IF DEF,CONVIEEE,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CAMDUMP GEX1F403.5
integer pack_type UBC1F402.119
c UBC1F402.120
*CALL CLOOKADD 
UBC1F402.121
*ENDIF UBC1F402.122
*CALL CNTL_IO GBC5F404.183
MAXFLD1.46
C ------------------------------------------------------------- MAXFLD1.47
C*L External subroutines called:------------------------------- MAXFLD1.48
EXTERNAL SETPOS,BUFFIN,IOERROR,ABORT MAXFLD1.49
C*------------------------------------------------------------- MAXFLD1.50
MAXFLD1.51
CL Internal structure: none MAXFLD1.52
MAXFLD1.53
C Move to start of Look Up Table MAXFLD1.54
CALL SETPOS(NFTIN,FIXHD(150)-1,ICODE) GTD0F400.94
MAXFLD1.56
C Read in fields from LOOKUP table MAXFLD1.57
CALL BUFFIN(NFTIN,LOOKUP(1,1),FIXHD(151)*FIXHD(152),LEN_IO,A) MAXFLD1.58
MAXFLD1.59
C Check for I/O errors MAXFLD1.60
IF(A.NE.-1.0.OR.LEN_IO.NE.FIXHD(151)*FIXHD(152))THEN MAXFLD1.61
CALL IOERROR('buffer in of lookup table',A,LEN_IO, MAXFLD1.62
* FIXHD(151)*FIXHD(152)) MAXFLD1.63
CALL ABORT MAXFLD1.64
ENDIF MAXFLD1.65
MAXFLD1.66
C Find maximum field size MAXFLD1.67
MAX_FIELD_SIZE=0 MAXFLD1.68
DO K=1,LEN2_LOOKUP MAXFLD1.69
*IF DEF,CONVIEEE,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CAMDUMP GEX1F403.6
pack_type=mod(lookup(lbpack, k),10) UBC1F402.124
if(pack_type.eq.1 .or. pack_type.eq.3) then UBC1F402.125
max_field_size=max(max_field_size, UBC1F402.126
2 lookup(lbrow, k)*lookup(lbnpt, k), lookup(lblrec,k)) UBC1F402.127
else if(pack_type.eq.2) then UBC1F402.128
max_field_size=max(max_field_size, UBC1F402.129
2 ((lookup(lblrec,k)+1)/2)*2) UBC1F402.130
else UBC1F402.131
max_field_size=max(max_field_size,lookup(lblrec,k)) UBC1F402.132
endif UBC1F402.133
*ELSE UBC1F402.134
MAX_FIELD_SIZE=MAX0(MAX_FIELD_SIZE,LOOKUP(15,K)) UBC1F402.135
*ENDIF UBC1F402.136
ENDDO MAXFLD1.71
*IF DEF,CONVIEEE,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CAMDUMP GEX1F403.7
c UBC1F402.138
max_field_size=((max_field_size+um_sector_size-1)/ GBC5F404.184
2 um_sector_size)*um_sector_size GBC5F404.185
write(6,'(//''Maximum Field Size = '',i7/)') max_field_size UBC1F402.139
*ENDIF UBC1F402.140
MAXFLD1.72
RETURN MAXFLD1.73
END MAXFLD1.74
*ENDIF MAXFLD1.75