SUBROUTINE MONOCHROMATIC_IR_RADIANCE(N_PROFILE, N_LAYER 1MNIRR3A.22
& , L_NET MNIRR3A.23
& , TAU MNIRR3A.24
& , RAD_INC_DOWN MNIRR3A.25
& , DIFF_PLANCK, SOURCE_GROUND, ALBEDO_SURFACE_DIFF MNIRR3A.26
& , SECANT_RAY MNIRR3A.27
& , RADIANCE MNIRR3A.28
& , NPD_PROFILE, NPD_LAYER MNIRR3A.29
& ) MNIRR3A.30
! MNIRR3A.31
! MNIRR3A.32
IMPLICIT NONE MNIRR3A.33
! MNIRR3A.34
! MNIRR3A.35
! SIZES OF DUMMY ARRAYS. MNIRR3A.36
INTEGER !, INTENT(IN) MNIRR3A.37
& NPD_PROFILE MNIRR3A.38
! MAXIMUM NUMBER OF PROFILES MNIRR3A.39
& , NPD_LAYER MNIRR3A.40
! MAXIMUM NUMBER OF LAYERS MNIRR3A.41
! MNIRR3A.42
! INCLUDE COMDECKS MNIRR3A.43
*CALL PRMCH3A 
MNIRR3A.44
! MNIRR3A.45
! DUMMY ARGUMENTS. MNIRR3A.46
INTEGER !, INTENT(IN) MNIRR3A.47
& N_PROFILE MNIRR3A.48
! NUMBER OF PROFILES MNIRR3A.49
& , N_LAYER MNIRR3A.50
! NUMBER OF LAYERS MNIRR3A.51
LOGICAL !, INTENT(IN) MNIRR3A.52
& L_NET MNIRR3A.53
! CALCULATE NET FLUXES. MNIRR3A.54
REAL !, INTENT(IN) MNIRR3A.55
& TAU(NPD_PROFILE, NPD_LAYER) MNIRR3A.56
! OPTICAL DEPTHS OF LAYERS MNIRR3A.57
& , RAD_INC_DOWN(NPD_PROFILE) MNIRR3A.58
! INCIDENT DOWNWARD RADIANCE MNIRR3A.59
& , SOURCE_GROUND(NPD_PROFILE) MNIRR3A.60
! SOURCE FUNCTION OF GROUND MNIRR3A.61
& , ALBEDO_SURFACE_DIFF(NPD_PROFILE) MNIRR3A.62
! DIFFUSE ALBEDO MNIRR3A.63
& , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER) MNIRR3A.64
! DIFFERENCE IN PLANCK FUNCTION MNIRR3A.65
& , SECANT_RAY MNIRR3A.66
! SECANT OF ANGLE WITH VERTICAL MNIRR3A.67
REAL !, INTENT(OUT) MNIRR3A.68
& RADIANCE(NPD_PROFILE, 2*NPD_LAYER+2) MNIRR3A.69
! DIFFUSE RADIANCE MNIRR3A.70
! MNIRR3A.71
! LOCAL VARIABLES. MNIRR3A.72
INTEGER MNIRR3A.73
& I MNIRR3A.74
! LOOP VARIABLE MNIRR3A.75
& , L MNIRR3A.76
! LOOP VARIABLE MNIRR3A.77
REAL MNIRR3A.78
& TRANS(NPD_PROFILE, NPD_LAYER) MNIRR3A.79
! TRANSMISSIVITIES MNIRR3A.80
& , SOURCE_UP(NPD_PROFILE, NPD_LAYER) MNIRR3A.81
! UPWARD SOURCE FUNCTION MNIRR3A.82
& , SOURCE_DOWN(NPD_PROFILE, NPD_LAYER) MNIRR3A.83
! DOWNWARD SOURCE FUNCTION MNIRR3A.84
! MNIRR3A.85
! MNIRR3A.86
DO I=1, N_LAYER MNIRR3A.87
DO L=1, N_PROFILE MNIRR3A.88
TRANS(L, I)=EXP(-SECANT_RAY*TAU(L, I)) MNIRR3A.89
ENDDO MNIRR3A.90
ENDDO MNIRR3A.91
! MNIRR3A.92
DO I=1, N_LAYER MNIRR3A.93
DO L=1, N_PROFILE MNIRR3A.94
SOURCE_UP(L, I)=(1.0E+00-TRANS(L, I)+SQRT_TOL_MACHINE) MNIRR3A.95
& *DIFF_PLANCK(L, I) MNIRR3A.96
& /(SECANT_RAY*TAU(L, I)+SQRT_TOL_MACHINE) MNIRR3A.97
SOURCE_DOWN(L, I)=-SOURCE_UP(L, I) MNIRR3A.98
ENDDO MNIRR3A.99
ENDDO MNIRR3A.100
! MNIRR3A.101
! DOWNWARD RADIANCE. MNIRR3A.102
DO L=1, N_PROFILE MNIRR3A.103
RADIANCE(L, 2)=RAD_INC_DOWN(L) MNIRR3A.104
ENDDO MNIRR3A.105
DO I=1, N_LAYER MNIRR3A.106
DO L=1, N_PROFILE MNIRR3A.107
RADIANCE(L, 2*I+2)=TRANS(L, I)*RADIANCE(L, 2*I) MNIRR3A.108
& +SOURCE_DOWN(L, I) MNIRR3A.109
ENDDO MNIRR3A.110
ENDDO MNIRR3A.111
! MNIRR3A.112
! UPWARD RADIANCE. MNIRR3A.113
DO L=1, N_PROFILE MNIRR3A.114
RADIANCE(L, 2*N_LAYER+1)=SOURCE_GROUND(L) MNIRR3A.115
& +ALBEDO_SURFACE_DIFF(L)*RADIANCE(L, 2*N_LAYER+2) MNIRR3A.116
ENDDO MNIRR3A.117
DO I=N_LAYER, 1, -1 MNIRR3A.118
DO L=1, N_PROFILE MNIRR3A.119
RADIANCE(L, 2*I-1)=TRANS(L, I)*RADIANCE(L, 2*I+1) MNIRR3A.120
& +SOURCE_UP(L, I) MNIRR3A.121
ENDDO MNIRR3A.122
ENDDO MNIRR3A.123
! MNIRR3A.124
! REDUCE TO A NET RADIANCE IF THIS IS REQUIRED. MNIRR3A.125
IF (L_NET) THEN MNIRR3A.126
DO I=0, N_LAYER MNIRR3A.127
DO L=1, N_PROFILE MNIRR3A.128
RADIANCE(L, I+1)=RADIANCE(L, 2*I+2) MNIRR3A.129
& -RADIANCE(L, 2*I+1) MNIRR3A.130
ENDDO MNIRR3A.131
ENDDO MNIRR3A.132
ENDIF MNIRR3A.133
! MNIRR3A.134
! MNIRR3A.135
RETURN MNIRR3A.136
END MNIRR3A.137
*ENDIF DEF,A01_3A,OR,DEF,A02_3A MNIRR3A.138
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.44