*IF DEF,RECON                                                              LOCATE1.2      
C ******************************COPYRIGHT******************************    GTS2F400.5311   
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.5312   
C                                                                          GTS2F400.5313   
C Use, duplication or disclosure of this code is subject to the            GTS2F400.5314   
C restrictions as set forth in the contract.                               GTS2F400.5315   
C                                                                          GTS2F400.5316   
C                Meteorological Office                                     GTS2F400.5317   
C                London Road                                               GTS2F400.5318   
C                BRACKNELL                                                 GTS2F400.5319   
C                Berkshire UK                                              GTS2F400.5320   
C                RG12 2SZ                                                  GTS2F400.5321   
C                                                                          GTS2F400.5322   
C If no contract has been raised with this copy of the code, the use,      GTS2F400.5323   
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.5324   
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.5325   
C Modelling at the above address.                                          GTS2F400.5326   
C ******************************COPYRIGHT******************************    GTS2F400.5327   
C                                                                          GTS2F400.5328   
CLL  SUBROUTINE LOCATE------------------------------------------------     LOCATE1.3      
CLL                                                                        LOCATE1.4      
CLL  Purpose: Locates requested item code in array of item codes           LOCATE1.5      
CLL                                                                        LOCATE1.6      
CLL  Written by A. Dickinson 16/02/90                                      LOCATE1.7      
CLL                                                                        LOCATE1.8      
CLL  Model            Modification history from model version 3.0:         LOCATE1.9      
CLL version  date                                                          LOCATE1.10     
CLL                                                                        LOCATE1.11     
CLL Programming standard :                                                 LOCATE1.12     
CLL                                                                        LOCATE1.13     
CLL Logical components covered : S1                                        LOCATE1.14     
CLL                                                                        LOCATE1.15     
CLL Project task :                                                         LOCATE1.16     
CLL                                                                        LOCATE1.17     
CLL  Documentation: None                                                   LOCATE1.18     
CLL                                                                        LOCATE1.19     
CLL  -----------------------------------------------------------------     LOCATE1.20     
C*L  Arguments:-------------------------------------------------------     LOCATE1.21     

      SUBROUTINE LOCATE(TYPE,PP_STASH,N_FIELDS,POS)                         150LOCATE1.22     
      IMPLICIT NONE                                                        LOCATE1.23     
      INTEGER                                                              LOCATE1.24     
     * TYPE                   !IN Required item code                       LOCATE1.25     
     *,N_FIELDS               !IN No of field types                        LOCATE1.26     
     *,PP_STASH(N_FIELDS)     !IN Array of item codes                      LOCATE1.27     
     *,POS                    !OUT Position of TYPE in PP_STASH            LOCATE1.28     
     *,K                                                                   LOCATE1.29     
                                                                           LOCATE1.30     
      DO K=1,N_FIELDS                                                      LOCATE1.31     
        IF(PP_STASH(K).EQ.TYPE)THEN                                        LOCATE1.32     
          POS=K                                                            LOCATE1.33     
          RETURN                                                           LOCATE1.34     
        ENDIF                                                              LOCATE1.35     
      ENDDO                                                                LOCATE1.36     
      POS=0                                                                LOCATE1.37     
                                                                           LOCATE1.38     
      RETURN                                                               LOCATE1.39     
      END                                                                  LOCATE1.40     
*ENDIF                                                                     LOCATE1.41