*IF DEF,C80_1A,OR,DEF,UTILIO,OR,DEF,RECON UIE3F404.4
C ******************************COPYRIGHT****************************** GTS2F400.883
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.884
C GTS2F400.885
C Use, duplication or disclosure of this code is subject to the GTS2F400.886
C restrictions as set forth in the contract. GTS2F400.887
C GTS2F400.888
C Meteorological Office GTS2F400.889
C London Road GTS2F400.890
C BRACKNELL GTS2F400.891
C Berkshire UK GTS2F400.892
C RG12 2SZ GTS2F400.893
C GTS2F400.894
C If no contract has been raised with this copy of the code, the use, GTS2F400.895
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.896
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.897
C Modelling at the above address. GTS2F400.898
C ******************************COPYRIGHT****************************** GTS2F400.899
C GTS2F400.900
CLL SUBROUTINE CHK_LOOK--------------------------------------- CHKLOO1A.3
CLL CHKLOO1A.4
CLL Written by A. Dickinson CHKLOO1A.5
CLL CHKLOO1A.6
CLL Purpose: Cross checks pointers in PP LOOKUP records with CHKLOO1A.7
CLL model parameters CHKLOO1A.8
CLL CHKLOO1A.9
CLL Model Modification history from model version 3.0: CHKLOO1A.10
CLL version Date CHKLOO1A.11
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.32
CLL portability. Author: Tracey Smith. TS150793.33
CLL 3.3 22/07/93 Applies a different consistency check for GO151293.1
CLL boundary files because the value stored in GO151293.2
CLL FIXHD(161) is half the correct value. This is a GO151293.3
CLL temporary fix. A permanent fix will follow in GO151293.4
CLL version 3.3. GO151293.5
CLL Author: D.M.Goddard GO151293.6
CLL 3.4 24/12/93 Removes fix included at version 3.3 as GENINTF1 GDG2F304.6
CLL now sets FIXHD(161) correctly for boundary files GDG2F304.7
CLL Author D.M.Goddard GDG2F304.8
!LL 4.1 20/05/96 Remove check on length of data for MPP code GPB0F401.150
!LL P.Burton GPB0F401.151
! 4.1 18/06/96 Changes to cope with changes in STASH addressing GDG0F401.126
! Author D.M. Goddard. GDG0F401.127
! 4.2 10/05/96 Bypass checks in cumf, pumf and ieee UDG2F403.1
! Author Bob Carruthers UDG2F403.2
! 4.3 12/03/97 Bypass checks in convpp UDG2F403.3
! Author D.M.Goddard UDG2F403.4
! 4.3 20/03/97 Bypass checks in camdump UDG2F403.5
! Author A Brady UDG2F403.6
! 4.4 15/09/97 Add helpful message. RTHBarnes ARB1F404.138
! 4.4 14/10/97 Skip check for Pre 3.4 Boundary Datasets. D. Robinson UDR1F404.1
CLL CHKLOO1A.12
CLL Programming standard: Unified Model Documentation Paper No 3 CHKLOO1A.13
CLL Version No 1 15/1/90 CHKLOO1A.14
CLL CHKLOO1A.15
CLL System component: C25 CHKLOO1A.16
CLL CHKLOO1A.17
CLL System task: F3 CHKLOO1A.18
CLL CHKLOO1A.19
CLL Documentation: Unified Model Documentation Paper No F3 CHKLOO1A.20
CLL Version No 5 9/2/90 CHKLOO1A.21
CLL CHKLOO1A.22
CLL------------------------------------------------------------ CHKLOO1A.23
C*L Arguments:------------------------------------------------- CHKLOO1A.24
SUBROUTINE CHK_LOOK(FIXHD,LOOKUP,LEN1_LOOKUP, ! Intent (In) 4,1GDG0F401.128
& LEN_DATA, ! GDG0F401.129
*CALL ARGPPX 
GDG0F401.130
& ICODE,CMESSAGE) ! Intent (Out) GDG0F401.131
CHKLOO1A.27
IMPLICIT NONE CHKLOO1A.28
CHKLOO1A.29
INTEGER CHKLOO1A.30
* LEN_DATA !IN Length of model data CHKLOO1A.31
*,LEN1_LOOKUP !IN First dimension for LOOKUP CHKLOO1A.32
*,LOOKUP(LEN1_LOOKUP,*) !IN Integer equivalence of PP LOOKUP CHKLOO1A.33
*,FIXHD(*) !IN Fixed length header CHKLOO1A.34
*,ICODE !OUT Return code; successful=0 CHKLOO1A.35
* ! error > 0 CHKLOO1A.36
CHKLOO1A.37
CHARACTER*80 TS150793.34
* CMESSAGE !OUT Error message if ICODE > 0 CHKLOO1A.39
CHKLOO1A.40
! Comdecks:---------------------------------------------------------- GDG0F401.132
*CALL CSUBMODL GDG0F401.133
*CALL CPPXREF GDG0F401.134
*CALL PPXLOOK GDG0F401.135
*CALL CLOOKADD CHKLOO1A.41
CHKLOO1A.42
C ------------------------------------------------------------- CHKLOO1A.43
C Workspace usage:--------------------------------------------- CHKLOO1A.44
C None CHKLOO1A.45
C ------------------------------------------------------------- CHKLOO1A.46
C*L External subroutines called:------------------------------- CHKLOO1A.47
EXTERNAL PR_LOOK CHKLOO1A.48
C-------------------------------------------------------------- CHKLOO1A.49
C Local variables:--------------------------------------------- CHKLOO1A.50
INTEGER CHKLOO1A.51
* K ! Loop count CHKLOO1A.52
*,LEN_D ! Cumulative length of data CHKLOO1A.53
*,N1 CHKLOO1A.54
C-------------------------------------------------------------- CHKLOO1A.55
CHKLOO1A.56
CL Internal structure: None CHKLOO1A.57
CHKLOO1A.58
ICODE=0 CHKLOO1A.59
CMESSAGE=' ' CHKLOO1A.60
CHKLOO1A.61
! CHK_LOOK falls over with Boundary Datasets if pre-3.4 UDR1F404.2
IF (FIXHD(5).EQ.5 .and. FIXHD(12).LT.304) THEN UDR1F404.3
write (6,*) ' CHK_LOOK skipped for Boundary Dataset (Pre 3.4)' UDR1F404.4
ELSE UDR1F404.5
UDR1F404.6
LEN_D=0 CHKLOO1A.62
CHKLOO1A.63
DO 100 K=1,FIXHD(152) CHKLOO1A.64
CHKLOO1A.65
*IF DEF,CONVIEEE,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CONVPP,OR,DEF,CAMDUMP UDG2F403.7
if(lookup(1,k).eq.-99) goto 9986 UBC1F402.142
*ENDIF UBC1F402.143
C Check that data_type is valid no: 1 to 3 or -1 to -3 CHKLOO1A.66
IF((LOOKUP(DATA_TYPE,K).GE.1.AND.LOOKUP(DATA_TYPE,K).LE.3) .OR. CHKLOO1A.67
+ (LOOKUP(DATA_TYPE,K).LE.-1.AND.LOOKUP(DATA_TYPE,K).GE.-3)) CHKLOO1A.68
+ THEN CHKLOO1A.69
LEN_D=LEN_D+LOOKUP(LBLREC,K) CHKLOO1A.70
ELSE CHKLOO1A.71
WRITE(6,'('' *ERROR* Wrong value of'',I9,'' in LOOKUP(DATA_'', CHKLOO1A.72
*''TYPE'',I4,'')'')')LOOKUP(DATA_TYPE,K),K CHKLOO1A.73
CALL PR_LOOK( GDG0F401.136
*CALL ARGPPX GDG0F401.137
& LOOKUP,LOOKUP,LEN1_LOOKUP,K) GDG0F401.138
ICODE=1 CHKLOO1A.75
CMESSAGE='CHK_LOOK: Consistency check' CHKLOO1A.76
RETURN CHKLOO1A.77
ENDIF CHKLOO1A.78
CHKLOO1A.79
100 CONTINUE CHKLOO1A.80
CHKLOO1A.81
*IF -DEF,MPP GPB0F401.152
IF(LEN_DATA.NE.LEN_D.OR.FIXHD(161).NE.LEN_DATA.OR. GDG2F304.9
&FIXHD(161).NE.LEN_D)THEN GDG2F304.10
GO151293.12
WRITE(6,'('' *ERROR* Length of model data specified wrongly CHKLOO1A.84
* : PARAMETER='',I9,''FILE='',I9,''FIXHD(161)'',I9)') CHKLOO1A.85
* LEN_DATA,LEN_D,FIXHD(161) CHKLOO1A.86
WRITE(6,*)' Your initial dump may need reconfiguring.' ARB1F404.139
ICODE=2 CHKLOO1A.87
CMESSAGE='CHK_LOOK: Consistency check - try reconfiguring your in ARB1F404.140
&itial dump' ARB1F404.141
RETURN CHKLOO1A.89
ENDIF CHKLOO1A.90
*ENDIF GPB0F401.153
CHKLOO1A.91
*IF DEF,CONVIEEE,OR,DEF,CUMF,OR,DEF,PUMF,OR,DEF,CONVPP,OR,DEF,CAMDUMP UDG2F403.8
9986 continue UBC1F402.145
*ENDIF UBC1F402.146
UDR1F404.7
ENDIF ! Check on pre-3.4 Boundary Datasets UDR1F404.8
RETURN CHKLOO1A.92
END CHKLOO1A.93
CHKLOO1A.94
*ENDIF CHKLOO1A.95