*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.28SUBROUTINE 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