*IF DEF,FLUXPROC FPOPENC1.2
C ******************************COPYRIGHT****************************** FPOPENC1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPOPENC1.4
C FPOPENC1.5
C Use, duplication or disclosure of this code is subject to the FPOPENC1.6
C restrictions as set forth in the contract. FPOPENC1.7
C FPOPENC1.8
C Meteorological Office FPOPENC1.9
C London Road FPOPENC1.10
C BRACKNELL FPOPENC1.11
C Berkshire UK FPOPENC1.12
C RG12 2SZ FPOPENC1.13
C FPOPENC1.14
C If no contract has been raised with this copy of the code, the use, FPOPENC1.15
C duplication or disclosure of it is strictly prohibited. Permission FPOPENC1.16
C to do so must first be obtained in writing from the Head of Numerical FPOPENC1.17
C Modelling at the above address. FPOPENC1.18
C ******************************COPYRIGHT****************************** FPOPENC1.19
C FPOPENC1.20
C Programming standard: Unified Model Documentation Paper No 3 FPOPENC1.21
C Version No 1 15/1/90 FPOPENC1.22
C History: FPOPENC1.23
C version date change FPOPENC1.24
C 4.5 03/09/98 New code FPOPENC1.25
C FPOPENC1.26
! Author: M. J. Bell FPOPENC1.27
!---------------------------------------------------------------------- FPOPENC1.28
! contains routines: open_control_files FPOPENC1.29
! FPOPENC1.30
! Purpose: Flux processing routine. FPOPENC1.31
! Opens all control and log files used by FOAM_Flux_Process FPOPENC1.32
!---------------------------------------------------------------------- FPOPENC1.33
subroutine open_control_files ( icode ) 1,7FPOPENC1.34
FPOPENC1.35
implicit none FPOPENC1.36
FPOPENC1.37
! declaration of argument list FPOPENC1.38
integer icode ! IN/OUT error code ; > 0 => fatal error detected FPOPENC1.39
FPOPENC1.40
! declaration of globals used FPOPENC1.41
*CALL CUNITNOS 
FPOPENC1.42
*CALL CMESS FPOPENC1.43
*CALL CENVIRON FPOPENC1.44
FPOPENC1.45
! No local arrays FPOPENC1.46
FPOPENC1.47
! declaration of local scalars FPOPENC1.48
integer i ! do loop index FPOPENC1.49
!---------------------------------------------------------------------- FPOPENC1.50
! 0. Preliminaries FPOPENC1.51
CSub = 'open_cnt_files' ! subroutine name for error messages FPOPENC1.52
FPOPENC1.53
! 0.1 Before opening any files set values in CENVIRON FPOPENC1.54
do i = 1, NUNITS FPOPENC1.55
CEnv(i) = ' ' FPOPENC1.56
LEnv(i) = 1 FPOPENC1.57
end do FPOPENC1.58
CEnv(UnitNWPlsmt) = 'FFLSMNWPT' FPOPENC1.59
LEnv(UnitNWPlsmt) = 9 FPOPENC1.60
CEnv(UnitFOAMlsmt) = 'FFLSMFOAMT' FPOPENC1.61
LEnv(UnitFOAMlsmt) = 15 FPOPENC1.62
CEnv(UnitFOAMlsmu) = 'FFLSMFOAMU' FPOPENC1.63
LEnv(UnitFOAMlsmu) = 16 FPOPENC1.64
FPOPENC1.65
FPOPENC1.66
CEnv(UnitPreferred) = 'FFPREFERRED' FPOPENC1.67
LEnv(UnitPreferred) = 11 FPOPENC1.68
CEnv(UnitPrevious) = 'FFPREVIOUS' FPOPENC1.69
LEnv(UnitPrevious) = 10 FPOPENC1.70
CEnv(UnitClimate) = 'FFCLIMATE' FPOPENC1.71
LEnv(UnitClimate) = 9 FPOPENC1.72
FPOPENC1.73
FPOPENC1.74
! 1. open log files FPOPENC1.75
FPOPENC1.76
! 1.1 open error, warning and standard log files FPOPENC1.77
call open_file(UnErr, 'Formatted ', 'Unknown', icode) FPOPENC1.78
if ( icode .gt. 0 ) then FPOPENC1.79
write(6,*)' ERROR opening error log file in FOAM flux ' FPOPENC1.80
write(6,*)' processing. This job will have failed. ' FPOPENC1.81
write(6,*)CErr,CSub,' step 1.1 unable to open error log ' FPOPENC1.82
icode = 1 FPOPENC1.83
go to 9999 FPOPENC1.84
end if FPOPENC1.85
FPOPENC1.86
! 1.2 open warning log file FPOPENC1.87
call open_file(UnWarn, 'Formatted ', 'Unknown', icode) FPOPENC1.88
if ( icode .gt. 0 ) then FPOPENC1.89
write(UnErr,*)CErr,CSub, FPOPENC1.90
# ' step 1.2 unable to open warning log ' FPOPENC1.91
icode = 2 FPOPENC1.92
go to 9999 FPOPENC1.93
end if FPOPENC1.94
FPOPENC1.95
! 1.3 open standard log file FPOPENC1.96
call open_file(UnStd, 'Formatted ', 'Unknown', icode) FPOPENC1.97
if ( icode .gt. 0 ) then FPOPENC1.98
write(UnErr,*)CErr,CSub, FPOPENC1.99
# ' step 1.3 unable to open standard log ' FPOPENC1.100
icode = 3 FPOPENC1.101
go to 9999 FPOPENC1.102
end if FPOPENC1.103
FPOPENC1.104
! 2. open control files FPOPENC1.105
FPOPENC1.106
! 2.1 open housekeeping file FPOPENC1.107
call open_file(UnitHK, 'Formatted ', 'Unknown', icode) FPOPENC1.108
if ( icode .ne. 0 ) then FPOPENC1.109
write(UnErr,*)CErr,CSub, FPOPENC1.110
# ' step 2.1 unable to open housekeeping file' FPOPENC1.111
icode = 4 FPOPENC1.112
go to 9999 FPOPENC1.113
end if FPOPENC1.114
FPOPENC1.115
! 2.2 open Validity time selection file FPOPENC1.116
call open_file(UnitVT, 'Formatted ', 'Unknown', icode) FPOPENC1.117
if ( icode .ne. 0 ) then FPOPENC1.118
write(UnErr,*)CErr,CSub, FPOPENC1.119
# ' step 2.2 unable to open Validity time selection file' FPOPENC1.120
icode = 5 FPOPENC1.121
go to 9999 FPOPENC1.122
end if FPOPENC1.123
FPOPENC1.124
! 2.3 open debug control file FPOPENC1.125
call open_file(UnitDbg, 'Formatted ', 'Unknown', icode) FPOPENC1.126
if ( icode .ne. 0 ) then FPOPENC1.127
write(UnErr,*)CErr,CSub, FPOPENC1.128
# ' step 2.3 unable to open debug control file' FPOPENC1.129
icode = 6 FPOPENC1.130
go to 9999 FPOPENC1.131
end if FPOPENC1.132
FPOPENC1.133
! 2.4 open flux selection control file FPOPENC1.134
call open_file(UnitSlt, 'Formatted ', 'Unknown', icode) FPOPENC1.135
if ( icode .ne. 0 ) then FPOPENC1.136
write(UnErr,*)CErr,CSub, FPOPENC1.137
# ' step 2.4 unable to open select control file' FPOPENC1.138
icode = 7 FPOPENC1.139
go to 9999 FPOPENC1.140
end if FPOPENC1.141
FPOPENC1.142
FPOPENC1.143
9999 continue FPOPENC1.144
return FPOPENC1.145
end FPOPENC1.146
!---------------------------------------------------------------------- FPOPENC1.147
*ENDIF FPOPENC1.148