*IF DEF,FLUXPROC FLXPROC1.2
C ******************************COPYRIGHT****************************** FLXPROC1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FLXPROC1.4
C FLXPROC1.5
C Use, duplication or disclosure of this code is subject to the FLXPROC1.6
C restrictions as set forth in the contract. FLXPROC1.7
C FLXPROC1.8
C Meteorological Office FLXPROC1.9
C London Road FLXPROC1.10
C BRACKNELL FLXPROC1.11
C Berkshire UK FLXPROC1.12
C RG12 2SZ FLXPROC1.13
C FLXPROC1.14
C If no contract has been raised with this copy of the code, the use, FLXPROC1.15
C duplication or disclosure of it is strictly prohibited. Permission FLXPROC1.16
C to do so must first be obtained in writing from the Head of Numerical FLXPROC1.17
C Modelling at the above address. FLXPROC1.18
C ******************************COPYRIGHT****************************** FLXPROC1.19
C FLXPROC1.20
C Programming standard: Unified Model Documentation Paper No 3 FLXPROC1.21
C Version No 1 15/1/90 FLXPROC1.22
C History: FLXPROC1.23
C version date change FLXPROC1.24
C 4.5 03/09/98 New code FLXPROC1.25
C FLXPROC1.26
! Author: M. J. Bell FLXPROC1.27
!---------------------------------------------------------------------- FLXPROC1.28
! contains progam: FOAM_Flux_Process FLXPROC1.29
! FLXPROC1.30
! Purpose: Flux processing routine. FLXPROC1.31
! Takes fields files of fluxes FLXPROC1.32
! (a) output from NWP and FLXPROC1.33
! (b) NWP or coupled model or observed "climatologies" FLXPROC1.34
! combines them into fluxes as required by FOAM ocean model FLXPROC1.35
! interpolates them to the FOAM grid and FLXPROC1.36
! fills in missing data values FLXPROC1.37
!---------------------------------------------------------------------- FLXPROC1.38
Program FOAM_Flux_Process ,10FLXPROC1.39
FLXPROC1.40
implicit none FLXPROC1.41
FLXPROC1.42
*CALL CSUBMODL 
FLXPROC1.43
FLXPROC1.44
! declaration of parameters FLXPROC1.45
FLXPROC1.46
! declaration of globals used FLXPROC1.47
*CALL CMESS FLXPROC1.48
FLXPROC1.49
! declaration of local scalars FLXPROC1.50
FLXPROC1.51
*CALL CFLDDIMS FLXPROC1.52
integer icode ! error code ; > 0 => fatal error detected FLXPROC1.53
integer ppxRecs FLXPROC1.54
character*80 cmessage FLXPROC1.55
FLXPROC1.56
! declaration of routines used FLXPROC1.57
external open_control_files, read_control_files, FLXPROC1.58
# read_field_headers, read_lsm_headers, Process_main, FLXPROC1.59
# close_files FLXPROC1.60
!---------------------------------------------------------------------- FLXPROC1.61
! 0. Preliminaries FLXPROC1.62
CSub = 'FOAM_Flux_Process' ! subroutine name for error messages FLXPROC1.63
FLXPROC1.64
icode = 0 ! initialise icode FLXPROC1.65
FLXPROC1.66
! 0.1 Initialise N_INTERNAL_MODEL/INTERNAL_MODEL_INDEX FLXPROC1.67
N_INTERNAL_MODEL=4 FLXPROC1.68
INTERNAL_MODEL_INDEX(1)=1 ! Atmos FLXPROC1.69
INTERNAL_MODEL_INDEX(2)=2 ! Ocean FLXPROC1.70
INTERNAL_MODEL_INDEX(3)=3 ! Slab FLXPROC1.71
INTERNAL_MODEL_INDEX(4)=4 ! Wave FLXPROC1.72
FLXPROC1.73
! 0.2 Read STASHmaster files FLXPROC1.74
ppxRecs=1 FLXPROC1.75
CALL HDPPXRF(22,'STASHmaster_A',ppxRecs,ICODE,CMESSAGE) FLXPROC1.76
CALL HDPPXRF(22,'STASHmaster_O',ppxRecs,ICODE,CMESSAGE) FLXPROC1.77
CALL HDPPXRF(22,'STASHmaster_S',ppxRecs,ICODE,CMESSAGE) FLXPROC1.78
CALL HDPPXRF(22,'STASHmaster_W',ppxRecs,ICODE,CMESSAGE) FLXPROC1.79
FLXPROC1.80
! 1. Open all control and log files FLXPROC1.81
call open_control_files( icode ) FLXPROC1.82
FLXPROC1.83
if ( icode .gt. 0 ) then FLXPROC1.84
write(UnErr,*)CErr,CSub, FLXPROC1.85
# ' step 1. Failed to open control and log files' FLXPROC1.86
go to 9999 FLXPROC1.87
end if FLXPROC1.88
FLXPROC1.89
! 2. Read all control files and open output flux files FLXPROC1.90
call read_control_files( icode ) FLXPROC1.91
FLXPROC1.92
if ( icode .gt. 0 ) then FLXPROC1.93
write(UnErr,*)CErr,CSub, FLXPROC1.94
#' step 2. Failed to read control files or open output flux files' FLXPROC1.95
go to 9999 FLXPROC1.96
end if FLXPROC1.97
FLXPROC1.98
! 3. Open and read headers (fixed header & lookups) of flux fields FLXPROC1.99
call read_field_headers( ppxRecs,icode ) FLXPROC1.100
FLXPROC1.101
if ( icode .gt. 0 ) then FLXPROC1.102
write(UnErr,*)CErr,CSub, FLXPROC1.103
# ' step 3. Failed to read headers of flux fields' FLXPROC1.104
go to 9999 FLXPROC1.105
end if FLXPROC1.106
FLXPROC1.107
! 4. Open and read lookup tables of land-sea masks and find FLXPROC1.108
! field dimensions FLXPROC1.109
call read_lsm_headers( FLXPROC1.110
*CALL AFLDDIMS FLXPROC1.111
# ppxRecs,icode) FLXPROC1.112
FLXPROC1.113
if ( icode .gt. 0 ) then FLXPROC1.114
write(UnErr,*)CErr,CSub, FLXPROC1.115
# ' step 4. Failed to read lookups of lsms' FLXPROC1.116
go to 9999 FLXPROC1.117
end if FLXPROC1.118
FLXPROC1.119
! 5. Do main processing at a lower level FLXPROC1.120
call Process_main( FLXPROC1.121
*CALL AFLDDIMS FLXPROC1.122
# ppxRecs,icode) FLXPROC1.123
FLXPROC1.124
if ( icode .gt. 0 ) then FLXPROC1.125
write(UnErr,*)CErr,CSub, FLXPROC1.126
# ' step 5. Failed doing main processing' FLXPROC1.127
go to 9999 FLXPROC1.128
end if FLXPROC1.129
FLXPROC1.130
! 6. close files opened in steps 1. - 4. FLXPROC1.131
FLXPROC1.132
call close_files FLXPROC1.133
FLXPROC1.134
9999 continue FLXPROC1.135
if ( icode .le. 0 ) then FLXPROC1.136
stop FLXPROC1.137
else FLXPROC1.138
write(UnErr,*)CErr,Csub, FLXPROC1.139
# 'Flux Processing failed with error code = ',icode FLXPROC1.140
close ( UnErr ) FLXPROC1.141
stop FLXPROC1.142
endif FLXPROC1.143
end FLXPROC1.144
!---------------------------------------------------------------------- FLXPROC1.145
*ENDIF FLXPROC1.146