*IF DEF,RECON FIND1.2 C ******************************COPYRIGHT****************************** GTS2F400.2881 C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.2882 C GTS2F400.2883 C Use, duplication or disclosure of this code is subject to the GTS2F400.2884 C restrictions as set forth in the contract. GTS2F400.2885 C GTS2F400.2886 C Meteorological Office GTS2F400.2887 C London Road GTS2F400.2888 C BRACKNELL GTS2F400.2889 C Berkshire UK GTS2F400.2890 C RG12 2SZ GTS2F400.2891 C GTS2F400.2892 C If no contract has been raised with this copy of the code, the use, GTS2F400.2893 C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.2894 C to do so must first be obtained in writing from the Head of Numerical GTS2F400.2895 C Modelling at the above address. GTS2F400.2896 C ******************************COPYRIGHT****************************** GTS2F400.2897 C GTS2F400.2898 CLL SUBROUTINE FIND-------------------------------------------------- FIND1.3 CLL FIND1.4 CLL Purpose: FIND1.5 CLL Locates requested item code in array of item codes FIND1.6 CLL with matching field length. FIND1.7 CLL FIND1.8 CLL Written by A. Dickinson 08/02/92 FIND1.9 CLL FIND1.10 CLL Model Modification history from model version 3.0: FIND1.11 CLL version Date FIND1.12 CLL FIND1.13 CLL Documentation: FIND1.14 CLL None FIND1.15 CLL FIND1.16 CLL ----------------------------------------------------------------- FIND1.17 C*L Arguments:------------------------------------------------------- FIND1.18SUBROUTINE FIND(TYPE,PP_STASH,LENGTH,PP_LEN,N_FIELDS,OCEAN,POS) 9FIND1.19 IMPLICIT NONE FIND1.20 INTEGER FIND1.21 * TYPE !IN Required item code FIND1.22 *,LENGTH !IN Required field length FIND1.23 *,N_FIELDS !IN No of field types FIND1.24 *,PP_STASH(N_FIELDS) !IN Array of item codes FIND1.25 *,PP_LEN (N_FIELDS) !IN Array of field lengths FIND1.26 *,POS !OUT Position of TYPE in PP_STASH FIND1.27 *,K FIND1.28 LOGICAL FIND1.29 * OCEAN !IN defines the field to be an ocean field FIND1.30 FIND1.31 DO K=1,N_FIELDS FIND1.32 IF(PP_STASH(K).EQ.TYPE) THEN FIND1.33 IF(.NOT.OCEAN) THEN FIND1.34 POS=K FIND1.35 RETURN FIND1.36 ELSE IF (PP_LEN(K).EQ.LENGTH) THEN FIND1.37 POS=K FIND1.38 RETURN FIND1.39 ENDIF FIND1.40 ENDIF FIND1.41 ENDDO FIND1.42 FIND1.43 POS=0 FIND1.44 FIND1.45 RETURN FIND1.46 END FIND1.47 *ENDIF FIND1.48