*IF DEF,FLUXPROC FPINTLV1.2
C ******************************COPYRIGHT****************************** FPINTLV1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPINTLV1.4
C FPINTLV1.5
C Use, duplication or disclosure of this code is subject to the FPINTLV1.6
C restrictions as set forth in the contract. FPINTLV1.7
C FPINTLV1.8
C Meteorological Office FPINTLV1.9
C London Road FPINTLV1.10
C BRACKNELL FPINTLV1.11
C Berkshire UK FPINTLV1.12
C RG12 2SZ FPINTLV1.13
C FPINTLV1.14
C If no contract has been raised with this copy of the code, the use, FPINTLV1.15
C duplication or disclosure of it is strictly prohibited. Permission FPINTLV1.16
C to do so must first be obtained in writing from the Head of Numerical FPINTLV1.17
C Modelling at the above address. FPINTLV1.18
C ******************************COPYRIGHT****************************** FPINTLV1.19
C FPINTLV1.20
C Programming standard: Unified Model Documentation Paper No 3 FPINTLV1.21
C Version No 1 15/1/90 FPINTLV1.22
C History: FPINTLV1.23
C version date change FPINTLV1.24
C 4.5 03/09/98 New code FPINTLV1.25
C FPINTLV1.26
! Author: M. J. Bell FPINTLV1.27
!---------------------------------------------------------------------- FPINTLV1.28
! contains routines: interleave FPINTLV1.29
! FPINTLV1.30
! Purpose: Flux processing routine. FPINTLV1.31
! To perform a check on each element of an input field. FPINTLV1.32
! If the test fails, that element shall be replaced by FPINTLV1.33
! the climatological value. FPINTLV1.34
!---------------------------------------------------------------------- FPINTLV1.35
SUBROUTINE interleave 1FPINTLV1.36
# (ncols, nrows, FPINTLV1.37
# fieldNWP, fieldClim, FPINTLV1.38
# icefrac, rmdi, FPINTLV1.39
# l_leads,out_field) FPINTLV1.40
FPINTLV1.41
FPINTLV1.42
FPINTLV1.43
FPINTLV1.44
IMPLICIT NONE FPINTLV1.45
FPINTLV1.46
FPINTLV1.47
C Input: FPINTLV1.48
C ------ FPINTLV1.49
FPINTLV1.50
integer ncols ! IN number of columns of array FPINTLV1.51
integer nrows ! IN number of rows in array FPINTLV1.52
FPINTLV1.53
real minicefrac ! minimum ice fraction FPINTLV1.54
real minleadsfrac ! minimum leads fraction FPINTLV1.55
FPINTLV1.56
parameter ( minicefrac = 0.005 ) FPINTLV1.57
parameter ( minleadsfrac = 0.005 ) FPINTLV1.58
FPINTLV1.59
real fieldNWP(ncols,nrows) ! IN array of input values (NWPfield) FPINTLV1.60
real fieldClim(ncols,nrows) ! IN array of input values FPINTLV1.61
! (Climatology) FPINTLV1.62
real icefrac(ncols,nrows) ! IN array of input values (Icefrac) FPINTLV1.63
real rmdi ! IN missing data indicator FPINTLV1.64
FPINTLV1.65
logical l_leads ! IN T => using minleadsfrac FPINTLV1.66
! F => using minicefrac FPINTLV1.67
FPINTLV1.68
C Output: FPINTLV1.69
C ------- FPINTLV1.70
FPINTLV1.71
FPINTLV1.72
real out_field(ncols,nrows) ! OUT composite array of NWP and FPINTLV1.73
! Climatology values FPINTLV1.74
FPINTLV1.75
FPINTLV1.76
C Local variables FPINTLV1.77
C --------------- FPINTLV1.78
FPINTLV1.79
FPINTLV1.80
integer i ! Loop counter over columns FPINTLV1.81
integer j ! Loop counter over rows FPINTLV1.82
FPINTLV1.83
FPINTLV1.84
C ------------------------------------------------------------------ FPINTLV1.85
FPINTLV1.86
! 1. Use l_leads to test whether using leads or ice frac FPINTLV1.87
if ( l_leads ) then FPINTLV1.88
! 1.1 Loop over each element in field FPINTLV1.89
! and check if icefrac element is missing data FPINTLV1.90
do j = 1,nrows ! Loop over rows FPINTLV1.91
do i = 1,ncols ! Loop over columns FPINTLV1.92
if ( icefrac (i,j) .eq. rmdi ) then FPINTLV1.93
out_field (i,j) = fieldClim(i,j) FPINTLV1.94
else FPINTLV1.95
if ( (1 - icefrac(i,j)) .lt. minleadsfrac ) then FPINTLV1.96
! 1.3 If test is true, use climatology for that element FPINTLV1.97
! else manipulate NWP field FPINTLV1.98
out_field(i,j) = fieldClim(i,j) FPINTLV1.99
else FPINTLV1.100
out_field(i,j) = FPINTLV1.101
# fieldNWP(i,j) / ( 1 - icefrac(i,j)) FPINTLV1.102
endif FPINTLV1.103
endif FPINTLV1.104
enddo ! i FPINTLV1.105
enddo ! j FPINTLV1.106
else FPINTLV1.107
! 2.1 Loop over each element in field FPINTLV1.108
! and check if icefrac element is missing data FPINTLV1.109
do j = 1,nrows ! Loop over rows FPINTLV1.110
do i = 1,ncols ! Loop over columns FPINTLV1.111
if ( icefrac (i,j) .eq. rmdi ) then FPINTLV1.112
out_field (i,j) = fieldClim(i,j) FPINTLV1.113
else FPINTLV1.114
if ( icefrac(i,j) .lt. minicefrac) then FPINTLV1.115
! 2.3 If test is true, use climatology for that element FPINTLV1.116
! else manipulate NWP field FPINTLV1.117
out_field(i,j) = fieldClim(i,j) FPINTLV1.118
else FPINTLV1.119
out_field(i,j) = fieldNWP(i,j) / icefrac(i,j) FPINTLV1.120
endif FPINTLV1.121
endif FPINTLV1.122
enddo ! i FPINTLV1.123
enddo FPINTLV1.124
endif FPINTLV1.125
return FPINTLV1.126
end FPINTLV1.127
!---------------------------------------------------------------------- FPINTLV1.128
*ENDIF FPINTLV1.129