*IF DEF,C72_1A,AND,DEF,ATMOS,AND,DEF,OCEAN GLW1F404.7
C ******************************COPYRIGHT****************************** CHK1BOX1.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. CHK1BOX1.4
C CHK1BOX1.5
C Use, duplication or disclosure of this code is subject to the CHK1BOX1.6
C restrictions as set forth in the contract. CHK1BOX1.7
C CHK1BOX1.8
C Meteorological Office CHK1BOX1.9
C London Road CHK1BOX1.10
C BRACKNELL CHK1BOX1.11
C Berkshire UK CHK1BOX1.12
C RG12 2SZ CHK1BOX1.13
C CHK1BOX1.14
C If no contract has been raised with this copy of the code, the use, CHK1BOX1.15
C duplication or disclosure of it is strictly prohibited. Permission CHK1BOX1.16
C to do so must first be obtained in writing from the Head of Numerical CHK1BOX1.17
C Modelling at the above address. CHK1BOX1.18
C ******************************COPYRIGHT****************************** CHK1BOX1.19
C CHK1BOX1.20
SUBROUTINE CHK1BOX(LENL,INDEX,NX,NY,ICODE,CMESSAGE) 1CHK1BOX1.21
CLL Subroutine CHK1BOX --------------------------------------------- CHK1BOX1.22
CLL CHK1BOX1.23
CLL Purpose: CHK1BOX1.24
CLL CHK1BOX1.25
CLL Check that each gridbox appears no more than once in a CHK1BOX1.26
CLL supplied list of box indices. This routine is used to check CHK1BOX1.27
CLL that it is valid to use the ADJUST mode of DO_AREAVER. CHK1BOX1.28
CLL CHK1BOX1.29
CLL Programming Standard, paper 4 version 4 (14.12.90) CHK1BOX1.30
CLL CHK1BOX1.31
CLL Modification history: CHK1BOX1.32
CLL CHK1BOX1.33
CLL Original version: J.M.Gregory 5.9.96 for HADCM3 CHK1BOX1.34
CLL CHK1BOX1.35
CLL Logical components covered : CHK1BOX1.36
CLL CHK1BOX1.37
CLL Project task : CHK1BOX1.38
CLL CHK1BOX1.39
CLL External documentation: Unified Model documentation paper No: CHK1BOX1.40
CLL Version: CHK1BOX1.41
CLL CHK1BOX1.42
CLLEND ----------------------------------------------------------------- CHK1BOX1.43
C CHK1BOX1.44
IMPLICIT NONE CHK1BOX1.45
C*L CHK1BOX1.46
INTEGER CHK1BOX1.47
& LENL !IN length of index list CHK1BOX1.48
&,NX,NY !IN dimensions of grid CHK1BOX1.49
&,INDEX(LENL) !IN indices of gridboxes CHK1BOX1.50
&,ICODE !OUT return code CHK1BOX1.51
CHARACTER CHK1BOX1.52
& CMESSAGE*(*) !OUT error message CHK1BOX1.53
C* CHK1BOX1.54
INTEGER CHK1BOX1.55
& IP ! pointer into list CHK1BOX1.56
&,IX,IY ! working indices CHK1BOX1.57
&,COUNT(NX,NY) ! counts of occurrences of indexes CHK1BOX1.58
C CHK1BOX1.59
DO IY=1,NY CHK1BOX1.60
DO IX=1,NX CHK1BOX1.61
COUNT(IX,IY)=0 CHK1BOX1.62
ENDDO CHK1BOX1.63
ENDDO CHK1BOX1.64
C CHK1BOX1.65
DO IP=1,LENL CHK1BOX1.66
IX=MOD(INDEX(IP)-1,NX)+1 CHK1BOX1.67
IY=(INDEX(IP)-1)/NX+1 CHK1BOX1.68
COUNT(IX,IY)=COUNT(IX,IY)+1 CHK1BOX1.69
ENDDO CHK1BOX1.70
C CHK1BOX1.71
ICODE=0 CHK1BOX1.72
DO IY=1,NY CHK1BOX1.73
DO IX=1,NX CHK1BOX1.74
IF (COUNT(IX,IY).GT.1) ICODE=1 CHK1BOX1.75
ENDDO CHK1BOX1.76
ENDDO CHK1BOX1.77
C CHK1BOX1.78
IF (ICODE.NE.0) CHK1BOX1.79
&CMESSAGE='ADJUST mode of DO_AREAVER should not be used' CHK1BOX1.80
C CHK1BOX1.81
RETURN CHK1BOX1.82
END CHK1BOX1.83
*ENDIF CHK1BOX1.84