*IF DEF,COMB COMBINE1.2
C ******************************COPYRIGHT****************************** GTS2F400.1063
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1064
C GTS2F400.1065
C Use, duplication or disclosure of this code is subject to the GTS2F400.1066
C restrictions as set forth in the contract. GTS2F400.1067
C GTS2F400.1068
C Meteorological Office GTS2F400.1069
C London Road GTS2F400.1070
C BRACKNELL GTS2F400.1071
C Berkshire UK GTS2F400.1072
C RG12 2SZ GTS2F400.1073
C GTS2F400.1074
C If no contract has been raised with this copy of the code, the use, GTS2F400.1075
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1076
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1077
C Modelling at the above address. GTS2F400.1078
C ******************************COPYRIGHT****************************** GTS2F400.1079
C GTS2F400.1080
CLL Routine: COMBINE-------------------------------------------------- COMBINE1.3
CLL COMBINE1.4
CLL Purpose: To create an Interim History File by combining information COMBINE1.5
CLL in the interim control file with that in the existing COMBINE1.6
CLL permanent history file .If the run is operational, data COMBINE1.7
CLL is also incorporated from the Operational Houskeeping File COMBINE1.8
CLL COMBINE1.9
CLL Tested under compiler: cft77 COMBINE1.10
CLL Tested under OS version: UNICOS 5.0 COMBINE1.11
CLL COMBINE1.12
CLL Author: A.Sangster COMBINE1.13
CLL COMBINE1.14
CLL Model Modification history from model version 3.0: COMBINE1.15
CLL version Date COMBINE1.16
CLL 3.1 29/01/93 : added CHSUNITS to comdecks - defines nunits for i/o RS030293.60
CLL 3.4 17/06/94 *CALL CCONTROL added - declares logical switches GSS1F304.265
CLL which replace *DEFs S.J.Swarbrick URB1F305.1
CLL Argument LCAL360 passed to READHK GSS1F304.267
CLL 3.5 03/05/95 Sub-models stage 1: History/control files. RTHBarnes URB1F305.2
CLL 4.5 10/11/98 Remove superfluous *CCONTROL and associated GRR2F405.66
CLL variables: this information is only available GRR2F405.67
CLL within the model and hence all such variables are GRR2F405.68
CLL uninitialised. R Rawlins GRR2F405.69
CLL COMBINE1.17
CLL Programming standard: UM Doc Paper 3, draft version 3 (15/1/90) COMBINE1.18
CLL COMBINE1.19
CLL Logical components covered: H82 COMBINE1.20
CLL COMBINE1.21
CLL Project task: H COMBINE1.22
CLL COMBINE1.23
CLL Documentation: Unified Model Documentation Paper COMBINE1.24
CLL H- History Bricks Version 5 18/6/90 COMBINE1.25
CLLEND -------------------------------------------------------------- COMBINE1.26
C COMBINE1.27
C*L Interface and arguments COMBINE1.28
C COMBINE1.29
PROGRAM COMBINE ,5COMBINE1.30
C COMBINE1.31
IMPLICIT NONE COMBINE1.32
C* COMBINE1.33
C COMBINE1.34
CL Common blocks COMBINE1.35
C COMBINE1.36
*CALL CSUBMODL 
URB1F305.3
*CALL CHSUNITS RS030293.61
*CALL CHISTORY URB1F305.4
C COMBINE1.41
C*L EXTERNAL subroutines called COMBINE1.42
EXTERNAL INITCHST,READHIST,TEMPHIST,WRITFTXX, URB1F305.5
* EREPORT,ABORT COMBINE1.44
C* COMBINE1.45
C COMBINE1.46
C Local variables COMBINE1.47
C COMBINE1.48
INTEGER ICODE,IABORT ! Work- Return codes from called routines COMBINE1.49
CHARACTER*256 CMESSAGE ! Work- Return message if failure occured COMBINE1.50
INTEGER HIST_UNIT ! Work- Input unit for history file COMBINE1.51
PARAMETER(HIST_UNIT=10) COMBINE1.52
CL COMBINE1.53
CL 1. Set common block area to zero or blank COMBINE1.54
CL COMBINE1.55
CALL INITCHST COMBINE1.56
CL COMBINE1.57
CL 2. Read History file into common history block COMBINE1.58
CL COMBINE1.59
CALL READHIST(HIST_UNIT,ICODE,CMESSAGE) COMBINE1.60
IF(ICODE .GT. 0) GOTO 999 COMBINE1.61
CL COMBINE1.62
CL 3. Read Interim Control file namelist information COMBINE1.63
CL COMBINE1.64
!! CALL READINTC(ICTL_UNIT,ICODE,CMESSAGE) URB1F305.6
!! IF(ICODE .GT. 0) GOTO 999 URB1F305.7
CL COMBINE1.67
CL 4. Switch file assignments so old restart dump is new start dump COMBINE1.68
CL ( Continuation runs only ) COMBINE1.69
CL COMBINE1.70
IF(H_STEPim(a_im) .GT. 0) ASTART(11:80) = ARESTART(11:80) URB1F305.8
IF(H_STEPim(o_im) .GT. 0) OSTART(11:80) = ORESTART(11:80) URB1F305.9
C COMBINE1.73
CL COMBINE1.75
CL 5. Read Operational housekeeping file COMBINE1.76
CL COMBINE1.77
C [Reading housekeeping moved from small execs into model at vn3.5.] GRR2F405.70
C COMBINE1.81
CL COMBINE1.82
CL COMBINE1.83
CL 6. Write history common block data to Interim History File COMBINE1.84
CL COMBINE1.85
RUN_HIST_TYPE='Interim' COMBINE1.86
CALL TEMPHIST(IHIST_UNIT,ICODE,CMESSAGE) COMBINE1.87
IF(ICODE .GT. 0) GOTO 999 COMBINE1.88
CL COMBINE1.89
CL 7. Re-write file of user assigned unit details COMBINE1.90
CL COMBINE1.91
CALL WRITFTXX(FTXX_UNIT,ICODE,CMESSAGE) COMBINE1.92
IF(ICODE .GT. 0) GOTO 999 COMBINE1.93
999 CONTINUE COMBINE1.94
CL COMBINE1.95
CL 8. Output error message if problem COMBINE1.96
CL COMBINE1.97
IABORT=ICODE COMBINE1.98
IF(ICODE .NE. 0) CALL EREPORT(ICODE,CMESSAGE) COMBINE1.99
CL COMBINE1.100
CL 9. Stop and abort if error has occurred COMBINE1.101
CL COMBINE1.102
IF(IABORT .GT. 0)CALL ABORT COMBINE1.103
STOP COMBINE1.104
END COMBINE1.105
*ENDIF COMBINE1.106