*IF DEF,C70_1A                                                             GLW1F404.26     
C ******************************COPYRIGHT******************************    GTS2F400.2647   
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.2648   
C                                                                          GTS2F400.2649   
C Use, duplication or disclosure of this code is subject to the            GTS2F400.2650   
C restrictions as set forth in the contract.                               GTS2F400.2651   
C                                                                          GTS2F400.2652   
C                Meteorological Office                                     GTS2F400.2653   
C                London Road                                               GTS2F400.2654   
C                BRACKNELL                                                 GTS2F400.2655   
C                Berkshire UK                                              GTS2F400.2656   
C                RG12 2SZ                                                  GTS2F400.2657   
C                                                                          GTS2F400.2658   
C If no contract has been raised with this copy of the code, the use,      GTS2F400.2659   
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.2660   
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.2661   
C Modelling at the above address.                                          GTS2F400.2662   
C ******************************COPYRIGHT******************************    GTS2F400.2663   
C                                                                          GTS2F400.2664   
CLL  Routine: EXITPROC -------------------------------------------------   EXITPRO1.3      
CLL                                                                        EXITPRO1.4      
CLL  Purpose: Tidies up at the end of the run, and takes certain           EXITPRO1.5      
CLL           actions in the case of model failure (as indicated by        EXITPRO1.6      
CLL           ICODE input)                                                 EXITPRO1.7      
CLL                                                                        EXITPRO1.8      
CLL  Tested under compiler:   cft77                                        EXITPRO1.9      
CLL  Tested under OS version: UNICOS 5.1                                   EXITPRO1.10     
CLL                                                                        EXITPRO1.11     
CLL  Author:   T.C.Johns                                                   EXITPRO1.12     
CLL                                                                        EXITPRO1.13     
CLL  Model            Modification history from model version 3.0:         EXITPRO1.14     
CLL version  Date                                                          EXITPRO1.15     
CLL 3.4  16/6/94 : Change CHARACTER*(*) to CHARACTER*(80) N.Farnon         ANF0F304.9      
CLL                                                                        EXITPRO1.16     
CLL  Programming standard: UM Doc Paper 3, version 2 (7/9/90)              EXITPRO1.17     
CLL                                                                        EXITPRO1.18     
CLL  Logical components covered: C0                                        EXITPRO1.19     
CLL                                                                        EXITPRO1.20     
CLL  Project task: C0                                                      EXITPRO1.21     
CLL                                                                        EXITPRO1.22     
CLL  External documentation: On-line UM document C0 - The top-level        EXITPRO1.23     
CLL                          control system                                EXITPRO1.24     
CLL                                                                        EXITPRO1.25     
CLL  -------------------------------------------------------------------   EXITPRO1.26     
C*L  Interface and arguments: ------------------------------------------   EXITPRO1.27     
C                                                                          EXITPRO1.28     

      SUBROUTINE EXITPROC(ICODE,CMESSAGE)                                   1EXITPRO1.29     
      IMPLICIT NONE                                                        EXITPRO1.30     
      INTEGER ICODE            ! INOUT - Error code from model             EXITPRO1.31     
      CHARACTER*(80) CMESSAGE   ! IN    - Error message from model         ANF0F304.10     
C                                                                          EXITPRO1.33     
C*----------------------------------------------------------------------   EXITPRO1.34     
C  Common blocks                                                           EXITPRO1.35     
C                                                                          EXITPRO1.36     
*CALL CSUBMODL                                                             GDR3F305.71     
*CALL CHSUNITS                                                             GDR3F305.72     
*CALL CHISTORY                                                             EXITPRO1.37     
C                                                                          EXITPRO1.38     
C  Subroutines called                                                      EXITPRO1.39     
C                                                                          EXITPRO1.40     
CL----------------------------------------------------------------------   EXITPRO1.41     
CL 1. If fatal error occurred in main body of model, suppress resubmit     EXITPRO1.42     
CL    switch to prevent model resubmit (if activated)                      EXITPRO1.43     
CL                                                                         EXITPRO1.44     
      IF (ICODE.GT.0) THEN                                                 EXITPRO1.45     
        RUN_RESUBMIT="N"                                                   EXITPRO1.46     
      ENDIF                                                                EXITPRO1.47     
CL                                                                         EXITPRO1.48     
CL 1.1  Reset error code                                                   EXITPRO1.49     
CL                                                                         EXITPRO1.50     
      ICODE=0                                                              EXITPRO1.51     
 999  CONTINUE                                                             EXITPRO1.52     
CL----------------------------------------------------------------------   EXITPRO1.53     
CL 2. Close named pipe unit used for communication with server             EXITPRO1.54     
CL                                                                         EXITPRO1.55     
      CLOSE(8)                                                             EXITPRO1.56     
C                                                                          EXITPRO1.57     
      RETURN                                                               EXITPRO1.58     
CL----------------------------------------------------------------------   EXITPRO1.59     
      END                                                                  EXITPRO1.60     
*ENDIF                                                                     EXITPRO1.61