SUBROUTINE SET_SURFACE_PROPERTIES(N_POINT_TYPE, INDEX_SURFACE 1SURFP3A.20
& , I_SPEC_SURFACE SURFP3A.21
& , ISOLIR, IB SURFP3A.22
& , SURFACE_ALBEDO, ALBEDO_FIELD_DIFF, ALBEDO_FIELD_DIR SURFP3A.23
& , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, SEC_0 SURFP3A.24
& , EMISSIVITY_GROUND, EMISSIVITY_FIELD SURFP3A.25
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR SURFP3A.26
& , THERMAL_GROUND_BAND SURFP3A.27
& , NPD_PROFILE, NPD_BAND, NPD_SURFACE, NPD_ALBEDO_PARM SURFP3A.28
& ) SURFP3A.29
! SURFP3A.30
! SURFP3A.31
IMPLICIT NONE SURFP3A.32
! SURFP3A.33
! SURFP3A.34
! SIZES OF DUMMY ARRAYS. SURFP3A.35
INTEGER !, INTENT(IN) SURFP3A.36
& NPD_PROFILE SURFP3A.37
! MAXIMUM NUMBER OF PROFILES SURFP3A.38
& , NPD_SURFACE SURFP3A.39
! MAXIMUM NUMBER OF SURFACES SURFP3A.40
& , NPD_BAND SURFP3A.41
! MAXIMUM NUMBER OF BANDS SURFP3A.42
& , NPD_ALBEDO_PARM SURFP3A.43
! MAXIMUM NUMBER OF ALBEDO PARAMETERS SURFP3A.44
! SURFP3A.45
! COMDECK CALLS SURFP3A.46
*CALL SRFSP3A 
SURFP3A.47
*CALL SPCRG3A SURFP3A.48
! SURFP3A.49
! DUMMY ARGUMENTS. SURFP3A.50
INTEGER !, INTENT(IN) SURFP3A.51
& N_POINT_TYPE(NPD_SURFACE) SURFP3A.52
! NUMBER OF POINTS OF EEACH TYPE SURFP3A.53
& , INDEX_SURFACE(NPD_PROFILE, NPD_SURFACE) SURFP3A.54
! LIST OF POINTS OF EACH TYPE SURFP3A.55
& , I_SPEC_SURFACE(NPD_SURFACE) SURFP3A.56
! METHOD OF SPECIFYING SURFACES SURFP3A.57
& , ISOLIR SURFP3A.58
! SPECTRAL REGION SURFP3A.59
& , IB SURFP3A.60
! NUMBER OF BAND SURFP3A.61
& , N_DIR_ALBEDO_FIT(NPD_SURFACE) SURFP3A.62
! NUMBER OF PARAMETERS IN FIT TO DIRECT ALBEDO SURFP3A.63
REAL !, INTENT(IN) SURFP3A.64
& SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE) SURFP3A.65
! BAND-DEPENDENT SURFACE ALBEDOS SURFP3A.66
& , ALBEDO_FIELD_DIFF(NPD_PROFILE) SURFP3A.67
! SPECIFIED DIFFUSE ALBEDO FIELD SURFP3A.68
& , ALBEDO_FIELD_DIR(NPD_PROFILE) SURFP3A.69
! SPECIFIED DIRECT ALBEDO FIELD SURFP3A.70
& , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND, NPD_SURFACE) SURFP3A.71
! COEFFICIENTS FOR DIRECT ALBEDOS SURFP3A.72
& , SEC_0(NPD_PROFILE) SURFP3A.73
! SECANTS OF ZENITH ANGLES SURFP3A.74
& , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE) SURFP3A.75
! BAND-DEPENDENT EMISSIVITIES SURFP3A.76
& , EMISSIVITY_FIELD(NPD_PROFILE) SURFP3A.77
! SPECIFIED EMISSIVITIES SURFP3A.78
REAL !, INTENT(INOUT) SURFP3A.79
& THERMAL_GROUND_BAND(NPD_PROFILE) SURFP3A.80
! THERMAL SOURCE FROM GROUND SURFP3A.81
REAL !, INTENT(OUT) SURFP3A.82
& ALBEDO_SURFACE_DIFF(NPD_PROFILE) SURFP3A.83
! DIFFUSE SURFACE ALBEDOS SURFP3A.84
& , ALBEDO_SURFACE_DIR(NPD_PROFILE) SURFP3A.85
! DIRECT SURFACE ALBEDOS SURFP3A.86
SURFP3A.87
! SURFP3A.88
! LOCAL VARIABLES. SURFP3A.89
INTEGER SURFP3A.90
& J SURFP3A.91
! LOOP VARIABLE SURFP3A.92
& , K SURFP3A.93
! LOOP VARIABLE SURFP3A.94
& , L SURFP3A.95
! LOOP VARIABLE SURFP3A.96
& , IC SURFP3A.97
! LOOP VARIABLE SURFP3A.98
! SURFP3A.99
! SURFP3A.100
! SET THE SURFACE ALBEDOS. SURFP3A.101
DO K=1, NPD_SURFACE SURFP3A.102
! SURFP3A.103
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_SPECIFIED) THEN SURFP3A.104
DO J=1, N_POINT_TYPE(K) SURFP3A.105
L=INDEX_SURFACE(J, K) SURFP3A.106
ALBEDO_SURFACE_DIFF(L) SURFP3A.107
& =SURFACE_ALBEDO(IB, K) SURFP3A.108
ALBEDO_SURFACE_DIR(L) SURFP3A.109
& =SURFACE_ALBEDO(IB, K) SURFP3A.110
ENDDO SURFP3A.111
ENDIF SURFP3A.112
! SURFP3A.113
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_INTERNAL) THEN SURFP3A.114
DO J=1, N_POINT_TYPE(K) SURFP3A.115
L=INDEX_SURFACE(J, K) SURFP3A.116
ALBEDO_SURFACE_DIFF(L)=ALBEDO_FIELD_DIFF(L) SURFP3A.117
ALBEDO_SURFACE_DIR(L)=ALBEDO_FIELD_DIR(L) SURFP3A.118
ENDDO SURFP3A.119
ENDIF SURFP3A.120
! SURFP3A.121
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_POLYNOMIAL) THEN SURFP3A.122
DO J=1, N_POINT_TYPE(K) SURFP3A.123
L=INDEX_SURFACE(J, K) SURFP3A.124
ALBEDO_SURFACE_DIFF(L) SURFP3A.125
& =SURFACE_ALBEDO(IB, K) SURFP3A.126
ALBEDO_SURFACE_DIR(L) SURFP3A.127
& =DIRECT_ALBEDO_PARM(N_DIR_ALBEDO_FIT(K), IB, K) SURFP3A.128
ENDDO SURFP3A.129
DO IC=N_DIR_ALBEDO_FIT(K), 1, -1 SURFP3A.130
DO J=1, N_POINT_TYPE(K) SURFP3A.131
L=INDEX_SURFACE(J, K) SURFP3A.132
ALBEDO_SURFACE_DIR(L) SURFP3A.133
& =ALBEDO_SURFACE_DIR(L)/SEC_0(L) SURFP3A.134
& +DIRECT_ALBEDO_PARM(IC-1, IB, K) SURFP3A.135
ENDDO SURFP3A.136
ENDDO SURFP3A.137
ENDIF SURFP3A.138
! SURFP3A.139
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_PAYNE) THEN SURFP3A.140
DO J=1, N_POINT_TYPE(K) SURFP3A.141
L=INDEX_SURFACE(J, K) SURFP3A.142
ALBEDO_SURFACE_DIFF(L)=0.06E+00 SURFP3A.143
ALBEDO_SURFACE_DIR(L)=DIRECT_ALBEDO_PARM(1, IB, K) SURFP3A.144
& /(DIRECT_ALBEDO_PARM(2, IB, K) SURFP3A.145
& +DIRECT_ALBEDO_PARM(3, IB, K) SURFP3A.146
& *EXP(-DIRECT_ALBEDO_PARM(4, IB, K)*LOG(SEC_0(L)))) SURFP3A.147
ENDDO SURFP3A.148
ENDIF SURFP3A.149
ENDDO SURFP3A.150
! SURFP3A.151
! SET THE EMISSIVITY AND MULTIPLY THE SOURCE FUNCTION SURFP3A.152
! IN THE INFRA-RED. SURFP3A.153
IF (ISOLIR.EQ.IP_INFRA_RED) THEN SURFP3A.154
DO K=1, NPD_SURFACE SURFP3A.155
! SURFP3A.156
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_SPECIFIED) THEN SURFP3A.157
DO J=1, N_POINT_TYPE(K) SURFP3A.158
L=INDEX_SURFACE(J, K) SURFP3A.159
THERMAL_GROUND_BAND(L)=EMISSIVITY_GROUND(IB, K) SURFP3A.160
& *THERMAL_GROUND_BAND(L) SURFP3A.161
ENDDO SURFP3A.162
ENDIF SURFP3A.163
! SURFP3A.164
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_INTERNAL) THEN SURFP3A.165
DO J=1, N_POINT_TYPE(K) SURFP3A.166
L=INDEX_SURFACE(J, K) SURFP3A.167
THERMAL_GROUND_BAND(L)=EMISSIVITY_FIELD(L) SURFP3A.168
& *THERMAL_GROUND_BAND(L) SURFP3A.169
ENDDO SURFP3A.170
ENDIF SURFP3A.171
! SURFP3A.172
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_POLYNOMIAL) THEN SURFP3A.173
DO J=1, N_POINT_TYPE(K) SURFP3A.174
L=INDEX_SURFACE(J, K) SURFP3A.175
THERMAL_GROUND_BAND(L)=EMISSIVITY_GROUND(IB, K) SURFP3A.176
& *THERMAL_GROUND_BAND(L) SURFP3A.177
ENDDO SURFP3A.178
ENDIF SURFP3A.179
! SURFP3A.180
IF (I_SPEC_SURFACE(K).EQ.IP_SURFACE_PAYNE) THEN SURFP3A.181
DO J=1, N_POINT_TYPE(K) SURFP3A.182
L=INDEX_SURFACE(J, K) SURFP3A.183
! SINCE THE EMISSIVITY IS 1.0 CONTINUE. SURFP3A.184
CONTINUE SURFP3A.185
ENDDO SURFP3A.186
ENDIF SURFP3A.187
! SURFP3A.188
ENDDO SURFP3A.189
ENDIF SURFP3A.190
! SURFP3A.191
! SURFP3A.192
RETURN SURFP3A.193
END SURFP3A.194
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SURFP3A.195
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.118