SUBROUTINE HorizontalInterpMonotone 1HORMON1A.3
& (LowerBound, HORMON1A.4
& Len1In, Len2In, HORMON1A.5
& Len1Out, Len2Out, HORMON1A.6
& DataExt, HORMON1A.7
& DataHigh, HORMON1A.8
& DataMono, HORMON1A.9
& IOut, HORMON1A.10
& JOut, HORMON1A.11
& DataOut) HORMON1A.12
HORMON1A.13
! Description: Ensures monotonicity if high order non-monotone HORMON1A.14
! interpolation has been used. HORMON1A.15
! HORMON1A.16
! Method: This is a modified version of the routine mono_conserv HORMON1A.17
! written by Mark Mawson and described in: HORMON1A.18
! HORMON1A.19
! The proposed semi-Lagrangian advection scheme for the HORMON1A.20
! semi-Implicit Unified Model integration scheme. HORMON1A.21
! F.R. Division working paper No 162. HORMON1A.22
! Mark H. Mawson HORMON1A.23
! HORMON1A.24
! and is based on Priestley, 1993 (the full reference HORMON1A.25
! for which can be found in the above documentation). HORMON1A.26
! HORMON1A.27
! HORMON1A.28
! Owner: Stuart Bell HORMON1A.29
! HORMON1A.30
! History: HORMON1A.31
! Version Date Comment HORMON1A.32
! ------- ---- ------- HORMON1A.33
! 4.0 6/6/95 Equiv. to VAR code as at time of build:Stuart Bell HORMON1A.34
! HORMON1A.35
! Code Description: HORMON1A.36
! Language: Fortran 77 plus HORMON1A.37
! Software Standards: "UM and Met O standards". HORMON1A.38
! HORMON1A.39
! HORMON1A.40
! Declarations: HORMON1A.41
HORMON1A.42
IMPLICIT NONE HORMON1A.43
HORMON1A.44
!* Subroutine arguments HORMON1A.45
! Scalar arguments with INTENT(in): HORMON1A.46
INTEGER LowerBound ! lower bounds of DataExt HORMON1A.47
INTEGER Len1In ! Dimension of DataIn in i direction. HORMON1A.48
INTEGER Len2In ! Dimension of DataIn in j direction. HORMON1A.49
INTEGER Len1Out ! Dimension of DataOut in i direction. HORMON1A.50
INTEGER Len2Out ! Dimension of DataOut in j direction. HORMON1A.51
HORMON1A.52
! Array arguments with INTENT(in): HORMON1A.53
INTEGER IOut (Len1Out,Len2Out) ! Point such that HORMON1A.54
INTEGER JOut (Len1Out,Len2Out) ! the desired output point HORMON1A.55
! ! lies between it and it+1. HORMON1A.56
REAL DataExt(LowerBound:Len1In+1-LowerBound, HORMON1A.57
& LowerBound:Len2In+1-LowerBound) ! Data interpolated HORMON1A.58
REAL DataHigh (Len1Out,Len2Out) ! Data interpolated HORMON1A.59
! ! by high order scheme HORMON1A.60
REAL DataMono (Len1Out,Len2Out) ! Data interpolated HORMON1A.61
! ! by monotone scheme. HORMON1A.62
HORMON1A.63
! Array arguments with INTENT(out): HORMON1A.64
REAL DataOut (Len1Out,Len2Out) ! Data interpolated to HORMON1A.65
! ! desired locations. HORMON1A.66
HORMON1A.67
!* End of Subroutine arguments HORMON1A.68
HORMON1A.69
! Local scalars: HORMON1A.70
INTEGER i ! } Loop HORMON1A.71
INTEGER j ! } indices. HORMON1A.72
HORMON1A.73
REAL MaxMono HORMON1A.74
REAL HighlessMono HORMON1A.75
HORMON1A.76
! Local arrays: HORMON1A.77
REAL MaxAlpha (Len1Out,Len2Out) HORMON1A.78
REAL MinMono (Len1Out,Len2Out) HORMON1A.79
HORMON1A.80
!- End of header ------------------------------------------------------- HORMON1A.81
HORMON1A.82
HORMON1A.83
!----------------------------------------------------------------------- HORMON1A.84
! 1.0 Find Max and min values of alpha allowed for montonicity. HORMON1A.85
! (Equation 1.8 in Priestley 1993) HORMON1A.86
!----------------------------------------------------------------------- HORMON1A.87
HORMON1A.88
DO j = 1, Len2Out HORMON1A.89
DO i = 1, Len1Out HORMON1A.90
HORMON1A.91
! Find max and min monotone values for the point concerned. HORMON1A.92
HORMON1A.93
MaxMono = MAX ( DataExt(IOut(i,j), JOut(i,j)), HORMON1A.94
& DataExt(IOut(i,j)+1, JOut(i,j)), HORMON1A.95
& DataExt(IOut(i,j), JOut(i,j)+1), HORMON1A.96
& DataExt(IOut(i,j)+1, JOut(i,j)+1) ) HORMON1A.97
HORMON1A.98
MinMono(i,j) = MIN ( DataExt(IOut(i,j), JOut(i,j)), HORMON1A.99
& DataExt(IOut(i,j)+1, JOut(i,j)), HORMON1A.100
& DataExt(IOut(i,j), JOut(i,j)+1), HORMON1A.101
& DataExt(IOut(i,j)+1, JOut(i,j)+1) ) HORMON1A.102
HORMON1A.103
HighlessMono = DataHigh (i,j) - DataMono (i,j) HORMON1A.104
HORMON1A.105
MaxAlpha(i,j) = 0.0 HORMON1A.106
HORMON1A.107
IF (HighlessMono .gt. 0.0) THEN HORMON1A.108
MaxAlpha(i,j) = MAX ( 0.0, HORMON1A.109
& (MaxMono - DataMono(i,j)) / HighlessMono ) HORMON1A.110
HORMON1A.111
ELSE IF (HighlessMono .lt. 0.0) THEN HORMON1A.112
MaxAlpha(i,j) = MAX ( 0.0, HORMON1A.113
& (MinMono(i,j) - DataMono(i,j)) / HighlessMono ) HORMON1A.114
END IF HORMON1A.115
HORMON1A.116
MaxAlpha(i,j) = MIN (1.0, MaxAlpha(i,j)) HORMON1A.117
HORMON1A.118
END DO HORMON1A.119
END DO HORMON1A.120
HORMON1A.121
HORMON1A.122
!----------------------------------------------------------------------- HORMON1A.123
! 2.0 Form output data given the alpha values. HORMON1A.124
!----------------------------------------------------------------------- HORMON1A.125
HORMON1A.126
DO j = 1, Len2Out HORMON1A.127
DO i = 1, Len1Out HORMON1A.128
HORMON1A.129
DataOut(i,j) = (1.0 - MaxAlpha(i,j)) * DataMono(i,j) HORMON1A.130
& + MaxAlpha(i,j) * DataHigh(i,j) HORMON1A.131
HORMON1A.132
! ...still need to check value not less then minimum because of HORMON1A.133
! rounding error problems on the Cray... HORMON1A.134
HORMON1A.135
IF (DataOut(i,j) .lt. MinMono(i,j)) DataOut(i,j) = MinMono(i,j) HORMON1A.136
HORMON1A.137
END DO HORMON1A.138
END DO HORMON1A.139
HORMON1A.140
! End of routine. HORMON1A.141
RETURN HORMON1A.142
END HORMON1A.143
*ENDIF HORMON1A.144