*IF DEF,C70_1A GLW1F404.17
C ******************************COPYRIGHT****************************** GTS2F400.1855
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1856
C GTS2F400.1857
C Use, duplication or disclosure of this code is subject to the GTS2F400.1858
C restrictions as set forth in the contract. GTS2F400.1859
C GTS2F400.1860
C Meteorological Office GTS2F400.1861
C London Road GTS2F400.1862
C BRACKNELL GTS2F400.1863
C Berkshire UK GTS2F400.1864
C RG12 2SZ GTS2F400.1865
C GTS2F400.1866
C If no contract has been raised with this copy of the code, the use, GTS2F400.1867
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1868
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1869
C Modelling at the above address. GTS2F400.1870
C ******************************COPYRIGHT****************************** GTS2F400.1871
C GTS2F400.1872
CLL Subroutine: DEL_HIST ------------------------------------------- DELHIST1.3
CLL DELHIST1.4
CLL Purpose: delete a history file -called if problems writing DELHIST1.5
CLL out partial sums DELHIST1.6
CLL DELHIST1.7
CLL Tested under compiler: cft77 DELHIST1.8
CLL Tested under OS version: UNICOS 6.1.5A DELHIST1.9
CLL DELHIST1.10
CLL Author: R A Stratton DELHIST1.11
CLL DELHIST1.12
CLL Model Modification history from model version 3.0: DELHIST1.13
CLL version Date DELHIST1.14
CLL AD050293.189
CLL 3.1 05/02/93 Portable Fortran unit no assigns AD050293.190
CLL Author: A. Dickinson Reviewer: R. Stratton AD050293.191
CLL DELHIST1.15
CLL Programming standard: UM Doc Paper 3, version 1 (15/1/90) DELHIST1.16
CLL DELHIST1.17
CLL Logical components covered: H DELHIST1.18
CLL DELHIST1.19
CLL Project task: H DELHIST1.20
CLL DELHIST1.21
CLL External documentation: DELHIST1.22
CLL DELHIST1.23
CLLEND------------------------------------------------------------------ DELHIST1.24
C DELHIST1.25
C*L Interface and arguments: ------------------------------------------ DELHIST1.26
SUBROUTINE DEL_HIST(HUNIT) 1,1DELHIST1.27
C DELHIST1.28
IMPLICIT NONE DELHIST1.29
C DELHIST1.30
INTEGER DELHIST1.31
& HUNIT ! IN - history file unit number DELHIST1.32
C DELHIST1.33
C NOTE no error code and error message are passed back from this routine DELHIST1.34
C as this routine is only called in the event of a non-zero error DELHIST1.35
C code in U_MODEL. DELHIST1.36
C*---------------------------------------------------------------------- DELHIST1.37
C Common blocks DELHIST1.38
C DELHIST1.39
C Subroutines called DELHIST1.40
C DELHIST1.41
EXTERNAL GET_FILE AD050293.193
C DELHIST1.43
C Local variables DELHIST1.44
C DELHIST1.45
INTEGER ICODE ! error from open and close DELHIST1.46
CHARACTER*80 CMESSAGE ! error message this routine only DELHIST1.47
CHARACTER*80 FILENAME AD050293.192
C DELHIST1.48
CL---------------------------------------------------------------------- DELHIST1.49
CL 1. Open history file DELHIST1.50
CL DELHIST1.51
CALL GET_FILE
(HUNIT,FILENAME,80,ICODE) GTD0F400.152
OPEN(HUNIT,FILE=FILENAME,FORM='UNFORMATTED',IOSTAT=ICODE) AD050293.195
IF (ICODE.NE.0) THEN DELHIST1.53
CMESSAGE='DELHIST: failure to open history file prior to its del DELHIST1.54
&etion' DELHIST1.55
WRITE(6,*)CMESSAGE GIE0F403.120
ENDIF DELHIST1.57
CL DELHIST1.58
CL 2. Close history file deleting it in the process. DELHIST1.59
CL DELHIST1.60
CLOSE(HUNIT,IOSTAT=ICODE,STATUS='DELETE') DELHIST1.61
IF (ICODE.NE.0) THEN DELHIST1.62
CMESSAGE='DELHIST: failure to delete history file' DELHIST1.63
WRITE(6,*)CMESSAGE GIE0F403.121
ENDIF DELHIST1.65
DELHIST1.66
RETURN DELHIST1.67
CL---------------------------------------------------------------------- DELHIST1.68
END DELHIST1.69
C DELHIST1.70
*ENDIF DELHIST1.71