*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.95
*IF DEF,A01_3A,OR,DEF,A02_3A SMTPN3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13909
C GTS2F400.13910
C Use, duplication or disclosure of this code is subject to the GTS2F400.13911
C restrictions as set forth in the contract. GTS2F400.13912
C GTS2F400.13913
C Meteorological Office GTS2F400.13914
C London Road GTS2F400.13915
C BRACKNELL GTS2F400.13916
C Berkshire UK GTS2F400.13917
C RG12 2SZ GTS2F400.13918
C GTS2F400.13919
C If no contract has been raised with this copy of the code, the use, GTS2F400.13920
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13921
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13922
C Modelling at the above address. GTS2F400.13923
C ******************************COPYRIGHT****************************** GTS2F400.13924
C GTS2F400.13925
!+ Subroutine to set the pentadiagonal matrix for the fluxes. SMTPN3A.3
! SMTPN3A.4
! Method: SMTPN3A.5
! Straightforward. SMTPN3A.6
! SMTPN3A.7
! Current Owner of Code: J. M. Edwards SMTPN3A.8
! SMTPN3A.9
! History: SMTPN3A.10
! Version Date Comment SMTPN3A.11
! 4.0 27-07-95 Original Code SMTPN3A.12
! (J. M. Edwards) SMTPN3A.13
! SMTPN3A.14
! Description of Code: SMTPN3A.15
! FORTRAN 77 with extensions listed in documentation. SMTPN3A.16
! SMTPN3A.17
!- --------------------------------------------------------------------- SMTPN3A.18
SUBROUTINE SET_MATRIX_PENTADIAGONAL(N_PROFILE, N_LAYER 3SMTPN3A.19
& , TRANS, REFLECT SMTPN3A.20
& , S_DOWN, S_UP SMTPN3A.21
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR SMTPN3A.22
& , FLUX_DIRECT_GROUND, FLUX_INC_DOWN SMTPN3A.23
& , SOURCE_GROUND SMTPN3A.24
& , A5, B SMTPN3A.25
& , NPD_PROFILE, NPD_LAYER SMTPN3A.26
& ) SMTPN3A.27
! SMTPN3A.28
! SMTPN3A.29
IMPLICIT NONE SMTPN3A.30
! SMTPN3A.31
! SMTPN3A.32
! SIZES OF DUMMY ARRAYS. SMTPN3A.33
INTEGER !, INTENT(IN) SMTPN3A.34
& NPD_PROFILE SMTPN3A.35
! MAXIMUM NUMBER OF PROFILES SMTPN3A.36
& , NPD_LAYER SMTPN3A.37
! MAXIMUM NUMBER OF LAYERS SMTPN3A.38
! SMTPN3A.39
! SMTPN3A.40
! DUMMY ARGUMENTS. SMTPN3A.41
INTEGER !, INTENT(IN) SMTPN3A.42
& N_PROFILE SMTPN3A.43
! NUMBER OF PROFILES SMTPN3A.44
& , N_LAYER SMTPN3A.45
! NUMBER OF LAYERS SMTPN3A.46
REAL !, INTENT(IN) SMTPN3A.47
& TRANS(NPD_PROFILE, NPD_LAYER) SMTPN3A.48
! TRANSMISSION COEFFICIENT SMTPN3A.49
& , REFLECT(NPD_PROFILE, NPD_LAYER) SMTPN3A.50
! REFLECTION COEFFICIENT SMTPN3A.51
& , S_DOWN(NPD_PROFILE, NPD_LAYER) SMTPN3A.52
! DOWNWARD DIFFUSE SOURCE SMTPN3A.53
& , S_UP(NPD_PROFILE, NPD_LAYER) SMTPN3A.54
! UPWARD DIFFUSE SOURCE SMTPN3A.55
& , ALBEDO_SURFACE_DIFF(NPD_PROFILE) SMTPN3A.56
! DIFFUSE SURFACE ALBEDO SMTPN3A.57
& , ALBEDO_SURFACE_DIR(NPD_PROFILE) SMTPN3A.58
! DIRECT SURFACE ALBEDO SMTPN3A.59
& , SOURCE_GROUND(NPD_PROFILE) SMTPN3A.60
! SOURCE FUNCTION OF GROUND SMTPN3A.61
& , FLUX_INC_DOWN(NPD_PROFILE) SMTPN3A.62
! INCIDENT TOTAL FLUX SMTPN3A.63
& , FLUX_DIRECT_GROUND(NPD_PROFILE) SMTPN3A.64
! DIRECT FLUX AT SMTPN3A.65
! GROUND LEVEL SMTPN3A.66
REAL !, INTENT(OUT) SMTPN3A.67
& A5(NPD_PROFILE, 5, 2*NPD_LAYER+2) SMTPN3A.68
! PENTADIAGONAL MATRIX SMTPN3A.69
& , B(NPD_PROFILE, 2*NPD_LAYER+2) SMTPN3A.70
! SOURCE TERMS FOR EQUATIONS SMTPN3A.71
! SMTPN3A.72
! DECLARATION OF LOCAL VARIABLES. SMTPN3A.73
INTEGER SMTPN3A.74
& I SMTPN3A.75
! LOOP VARIABLE SMTPN3A.76
& , L SMTPN3A.77
! LOOP VARIABLE SMTPN3A.78
! SMTPN3A.79
! SMTPN3A.80
! SMTPN3A.81
! THE TOP BOUNDARY CONDITION: SMTPN3A.82
DO L=1, N_PROFILE SMTPN3A.83
A5(L, 4, 2)=0.0E+00 SMTPN3A.84
A5(L, 3, 2)=1.0E+00 SMTPN3A.85
A5(L, 2, 2)=0.0E+00 SMTPN3A.86
A5(L, 1, 2)=0.0E+00 SMTPN3A.87
B(L, 2)=FLUX_INC_DOWN(L) SMTPN3A.88
ENDDO SMTPN3A.89
! SMTPN3A.90
! INTERIOR ROWS: ODD AND EVEN ROWS CORRESPOND TO DIFFERENT BOUNDARY SMTPN3A.91
! CONDITIONS. SMTPN3A.92
DO I=1, N_LAYER SMTPN3A.93
DO L=1, N_PROFILE SMTPN3A.94
A5(L, 5, 2*I-1)=0.0E+00 SMTPN3A.95
A5(L, 4, 2*I-1)=0.0E+00 SMTPN3A.96
A5(L, 3, 2*I-1)=-1.0E+00 SMTPN3A.97
A5(L, 2, 2*I-1)=REFLECT(L, I) SMTPN3A.98
A5(L, 1, 2*I-1)=TRANS(L, I) SMTPN3A.99
B(L, 2*I-1)=-S_UP(L, I) SMTPN3A.100
A5(L, 5, 2*I+2)=TRANS(L, I) SMTPN3A.101
A5(L, 4, 2*I+2)=REFLECT(L, I) SMTPN3A.102
A5(L, 3, 2*I+2)=-1.0E+00 SMTPN3A.103
A5(L, 2, 2*I+2)=0.0E+00 SMTPN3A.104
A5(L, 1, 2*I+2)=0.0E+00 SMTPN3A.105
B(L, 2*I+2)=-S_DOWN(L, I) SMTPN3A.106
ENDDO SMTPN3A.107
ENDDO SMTPN3A.108
! SMTPN3A.109
! THE SURFACE BOUNDARY CONDITION: SMTPN3A.110
DO L=1, N_PROFILE SMTPN3A.111
A5(L, 5, 2*N_LAYER+1)=0.0E+00 SMTPN3A.112
A5(L, 4, 2*N_LAYER+1)=0.0E+00 SMTPN3A.113
A5(L, 3, 2*N_LAYER+1)=1.0E+00 SMTPN3A.114
A5(L, 2, 2*N_LAYER+1)=-ALBEDO_SURFACE_DIFF(L) SMTPN3A.115
B(L, 2*N_LAYER+1)=SOURCE_GROUND(L) SMTPN3A.116
& +(ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L)) SMTPN3A.117
& *FLUX_DIRECT_GROUND(L) SMTPN3A.118
ENDDO SMTPN3A.119
! SMTPN3A.120
! SMTPN3A.121
RETURN SMTPN3A.122
END SMTPN3A.123
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SMTPN3A.124
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.96