*IF DEF,FLUXPROC FPRDCNT1.2
C ******************************COPYRIGHT****************************** FPRDCNT1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPRDCNT1.4
C FPRDCNT1.5
C Use, duplication or disclosure of this code is subject to the FPRDCNT1.6
C restrictions as set forth in the contract. FPRDCNT1.7
C FPRDCNT1.8
C Meteorological Office FPRDCNT1.9
C London Road FPRDCNT1.10
C BRACKNELL FPRDCNT1.11
C Berkshire UK FPRDCNT1.12
C RG12 2SZ FPRDCNT1.13
C FPRDCNT1.14
C If no contract has been raised with this copy of the code, the use, FPRDCNT1.15
C duplication or disclosure of it is strictly prohibited. Permission FPRDCNT1.16
C to do so must first be obtained in writing from the Head of Numerical FPRDCNT1.17
C Modelling at the above address. FPRDCNT1.18
C ******************************COPYRIGHT****************************** FPRDCNT1.19
C FPRDCNT1.20
C Programming standard: Unified Model Documentation Paper No 3 FPRDCNT1.21
C Version No 1 15/1/90 FPRDCNT1.22
C History: FPRDCNT1.23
C version date change FPRDCNT1.24
C 4.5 03/09/98 New code FPRDCNT1.25
C FPRDCNT1.26
! Author: M. J. Bell FPRDCNT1.27
!---------------------------------------------------------------------- FPRDCNT1.28
! contains routines: read_control_files FPRDCNT1.29
! FPRDCNT1.30
! Purpose: Flux processing routine. FPRDCNT1.31
! Reads all control files used by FOAM_Flux_Process FPRDCNT1.32
! Units added for pressure and windspeed (S. Spall) FPRDCNT1.33
!---------------------------------------------------------------------- FPRDCNT1.34
subroutine read_control_files (icode) 1,4FPRDCNT1.35
FPRDCNT1.36
implicit none FPRDCNT1.37
FPRDCNT1.38
! declaration of argument list FPRDCNT1.39
integer icode ! IN/OUT error code ; > 0 => fatal error detected FPRDCNT1.40
FPRDCNT1.41
! declaration of globals used FPRDCNT1.42
*CALL CUNITNOS 
FPRDCNT1.43
*CALL CMESS FPRDCNT1.44
FPRDCNT1.45
*CALL CREFTIM FPRDCNT1.46
*CALL CVALOFF FPRDCNT1.47
FPRDCNT1.48
*CALL C_MDI FPRDCNT1.49
FPRDCNT1.50
! declaration of local arrays FPRDCNT1.51
integer iunit_base(7) ! main unit numbers for output files FPRDCNT1.52
FPRDCNT1.53
! declaration of local scalars FPRDCNT1.54
integer ivt ! loop index over validity times FPRDCNT1.55
integer iunit ! loop index over unit numbers FPRDCNT1.56
integer IAdd ! value to add to basic unit number FPRDCNT1.57
integer IUnitOpen ! unit number to open FPRDCNT1.58
FPRDCNT1.59
! namelist declaration FPRDCNT1.60
NAMELIST / NamFluxSelect / FPRDCNT1.61
# ValidityPeriod, FPRDCNT1.62
# NoValidTimes, IValidOffHr, IOutUnitOff, FPRDCNT1.63
# NoAddTimesPreferred, ISrchOffHrPreferred, INewOffHrPreferred, FPRDCNT1.64
# NoAddTimesPrevious, ISrchOffHrPrevious, INewOffHrPrevious, FPRDCNT1.65
# NoAddTimesClimate, ISrchOffHrClimate, INewOffHrClimate, FPRDCNT1.66
# output_land_value FPRDCNT1.67
FPRDCNT1.68
! declaration of external subroutines and functions FPRDCNT1.69
external readhk, read_debug_cntl, open_file FPRDCNT1.70
FPRDCNT1.71
!---------------------------------------------------------------------- FPRDCNT1.72
! 0. Preliminaries FPRDCNT1.73
CSub = 'read_control_files' ! subroutine name for error messages FPRDCNT1.74
FPRDCNT1.75
! 1. Read house keeping file to set reference date FPRDCNT1.76
RefSec = 0 FPRDCNT1.77
RefMin = 0 FPRDCNT1.78
call readhk(UnitHK, RefHour, RefDay, RefMonth, RefYear,icode) FPRDCNT1.79
FPRDCNT1.80
if ( icode .ne. 0 ) then FPRDCNT1.81
write (UnErr,*)CErr,CSub, FPRDCNT1.82
# '1. Failed to read housekeeping file' FPRDCNT1.83
goto 9999 FPRDCNT1.84
endif FPRDCNT1.85
write(UnStd,*) CStd,CSub,'reference time from housekeeping file:' FPRDCNT1.86
# , ' RefYear, RefMonth, RefDay, RefHour, RefMin, RefSec = ', FPRDCNT1.87
# RefYear, RefMonth, RefDay, RefHour, RefMin, RefSec FPRDCNT1.88
FPRDCNT1.89
! 2. Read debug control file and open debug ouput file FPRDCNT1.90
call read_debug_cntl ( icode ) FPRDCNT1.91
if ( icode .gt. 0 ) then FPRDCNT1.92
write(UnErr,*)CErr,CSub, FPRDCNT1.93
# ' step 2. Failed to read debug control file' FPRDCNT1.94
go to 9999 FPRDCNT1.95
end if FPRDCNT1.96
FPRDCNT1.97
! 2.1 Read select control file FPRDCNT1.98
call read_select_cntl ( icode ) FPRDCNT1.99
if ( icode .gt. 0 ) then FPRDCNT1.100
write(UnErr,*)CErr,CSub, FPRDCNT1.101
# ' step 2.1 Failed to read select control file' FPRDCNT1.102
go to 9999 FPRDCNT1.103
end if FPRDCNT1.104
FPRDCNT1.105
! 3. Read validity times control file FPRDCNT1.106
FPRDCNT1.107
! 3.0 Set defaults FPRDCNT1.108
NoAddTimesPreferred = 0 FPRDCNT1.109
NoAddTimesPrevious = 0 FPRDCNT1.110
NoAddTimesClimate = 0 FPRDCNT1.111
FPRDCNT1.112
do ivt = 1, MaxTimes FPRDCNT1.113
IValidOffHr(ivt) = 0 FPRDCNT1.114
IOutUnitOff(ivt) = 0 FPRDCNT1.115
ISrchOffHrPreferred(ivt) = 0 FPRDCNT1.116
INewOffHrPreferred(ivt) = 0 FPRDCNT1.117
ISrchOffHrPrevious(ivt) = 0 FPRDCNT1.118
INewOffHrPrevious(ivt) = 0 FPRDCNT1.119
ISrchOffHrClimate(ivt) = 0 FPRDCNT1.120
INewOffHrClimate(ivt) = 0 FPRDCNT1.121
end do FPRDCNT1.122
FPRDCNT1.123
output_land_value = rmdi FPRDCNT1.124
FPRDCNT1.125
! 3.1 read namelist FPRDCNT1.126
FPRDCNT1.127
read (UnitVT, NamFluxSelect, iostat = icode) FPRDCNT1.128
if ( icode .gt. 0) then FPRDCNT1.129
write(UnErr,*)CErr,CSub, FPRDCNT1.130
# ' step 3.1 Failed to read validity times control file' FPRDCNT1.131
icode = 10 FPRDCNT1.132
go to 9999 FPRDCNT1.133
end if FPRDCNT1.134
FPRDCNT1.135
write(UnStd, NamFluxSelect) FPRDCNT1.136
FPRDCNT1.137
! 4. set which units to open for output flux files FPRDCNT1.138
FPRDCNT1.139
do iunit = IUnOutLow, IUnOutHi FPRDCNT1.140
LUnOutOpen(iunit) = .False. FPRDCNT1.141
end do FPRDCNT1.142
FPRDCNT1.143
iunit_base(1) = UnitWindsOut FPRDCNT1.144
iunit_base(2) = UnitHeatOut FPRDCNT1.145
iunit_base(3) = UnitMoistureOut FPRDCNT1.146
iunit_base(4) = UnitSeaIceOut FPRDCNT1.147
iunit_base(5) = UnitReferencesOut FPRDCNT1.148
iunit_base(6) = UnitPressureOut FPRDCNT1.149
iunit_base(7) = UnitWindspdOut FPRDCNT1.150
FPRDCNT1.151
do ivt = 1, NoValidTimes FPRDCNT1.152
IAdd = IOutUnitOff(ivt) FPRDCNT1.153
do iunit = 1, 7 FPRDCNT1.154
IUnitOpen = iunit_base(iunit) + IAdd FPRDCNT1.155
if ( IUnitOpen .lt. IUnOutLow .or. FPRDCNT1.156
# IUnitOpen .gt. IUnOutHi ) then FPRDCNT1.157
icode = 11 FPRDCNT1.158
write(UnErr,*)CErr,CSub,' step 4. Unit number chosen' FPRDCNT1.159
# ,' incorrectly; ivt,iunit =',ivt,iunit FPRDCNT1.160
go to 9999 FPRDCNT1.161
else FPRDCNT1.162
LUnOutOpen(IUnitOpen) = .True. FPRDCNT1.163
end if FPRDCNT1.164
end do ! iunit FPRDCNT1.165
end do ! ivt FPRDCNT1.166
FPRDCNT1.167
! 5. open output flux files FPRDCNT1.168
do iunit = IUnOutLow, IUnOutHi FPRDCNT1.169
if ( LUnOutOpen(iunit) ) then FPRDCNT1.170
FPRDCNT1.171
call open_file ( iunit, 'unformatted', 'unknown', icode ) FPRDCNT1.172
write(UnStd,*)CStd,CSub, ' step 5. Opening file ', iunit FPRDCNT1.173
FPRDCNT1.174
if ( icode .gt. 0) then FPRDCNT1.175
write(UnErr,*)CErr,CSub, FPRDCNT1.176
# ' step 5. Failed to open output flux file ', iunit FPRDCNT1.177
icode = 12 FPRDCNT1.178
go to 9999 FPRDCNT1.179
end if ! icode FPRDCNT1.180
FPRDCNT1.181
end if ! LUnOutOpen(iunit) FPRDCNT1.182
end do ! iunit FPRDCNT1.183
FPRDCNT1.184
9999 continue FPRDCNT1.185
return FPRDCNT1.186
end FPRDCNT1.187
!---------------------------------------------------------------------- FPRDCNT1.188
*ENDIF FPRDCNT1.189