SUBROUTINE MONOCHROMATIC_GAS_FLUX(N_PROFILE, N_LAYER 3MNGFX3A.22
& , L_NET MNGFX3A.23
& , TAU_GAS MNGFX3A.24
& , ISOLIR, SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN MNGFX3A.25
& , DIFF_PLANCK, SOURCE_GROUND MNGFX3A.26
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR MNGFX3A.27
& , DIFFUSIVITY_FACTOR MNGFX3A.28
& , FLUX_DIRECT, FLUX_DIFFUSE MNGFX3A.29
& , NPD_PROFILE, NPD_LAYER MNGFX3A.30
& ) MNGFX3A.31
! MNGFX3A.32
! MNGFX3A.33
IMPLICIT NONE MNGFX3A.34
! MNGFX3A.35
! MNGFX3A.36
! SIZES OF DUMMY ARRAYS. MNGFX3A.37
INTEGER !, INTENT(IN) MNGFX3A.38
& NPD_PROFILE MNGFX3A.39
! MAXIMUM NUMBER OF PROFILES MNGFX3A.40
& , NPD_LAYER MNGFX3A.41
! MAXIMUM NUMBER OF LAYERS MNGFX3A.42
! MNGFX3A.43
! INCLUDE COMDECKS MNGFX3A.44
*CALL SPCRG3A 
MNGFX3A.45
*CALL PRMCH3A MNGFX3A.46
! MNGFX3A.47
! DUMMY ARGUMENTS. MNGFX3A.48
INTEGER !, INTENT(IN) MNGFX3A.49
& N_PROFILE MNGFX3A.50
! NUMBER OF PROFILES MNGFX3A.51
& , N_LAYER MNGFX3A.52
! NUMBER OF LAYERS MNGFX3A.53
& , ISOLIR MNGFX3A.54
! SPECTRAL REGION MNGFX3A.55
LOGICAL !, INTENT(IN) MNGFX3A.56
& L_NET MNGFX3A.57
! CALCULATE NET FLUXES. MNGFX3A.58
REAL !, INTENT(IN) MNGFX3A.59
& TAU_GAS(NPD_PROFILE, NPD_LAYER) MNGFX3A.60
! GASEOUS OPTICAL DEPTHS MNGFX3A.61
& , SEC_0(NPD_PROFILE) MNGFX3A.62
! SECANT OF ZENITH ANGLE MNGFX3A.63
& , FLUX_INC_DIRECT(NPD_PROFILE) MNGFX3A.64
! INCIDENT DIRECT FLUX MNGFX3A.65
& , FLUX_INC_DOWN(NPD_PROFILE) MNGFX3A.66
! INCIDENT DIFFUSE FLUX MNGFX3A.67
& , SOURCE_GROUND(NPD_PROFILE) MNGFX3A.68
! SOURCE FUNCTION OF GROUND MNGFX3A.69
& , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER) MNGFX3A.70
! DIFFERENCE IN PLANCK FUNCTION MNGFX3A.71
& , ALBEDO_SURFACE_DIFF(NPD_PROFILE) MNGFX3A.72
! DIFFUSE SURFACE ALBEDO MNGFX3A.73
& , ALBEDO_SURFACE_DIR(NPD_PROFILE) MNGFX3A.74
! DIRECT SURFACE ALBEDO MNGFX3A.75
& , DIFFUSIVITY_FACTOR MNGFX3A.76
! DIFFUSIVITY FACTOR MNGFX3A.77
REAL !, INTENT(OUT) MNGFX3A.78
& FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER) MNGFX3A.79
! DIRECT FLUX MNGFX3A.80
& , FLUX_DIFFUSE(NPD_PROFILE, 2*NPD_LAYER+2) MNGFX3A.81
! DIFFUSE FLUX MNGFX3A.82
! MNGFX3A.83
! LOCAL VARIABLES. MNGFX3A.84
INTEGER MNGFX3A.85
& I MNGFX3A.86
! LOOP VARIABLE MNGFX3A.87
& , L MNGFX3A.88
! LOOP VARIABLE MNGFX3A.89
REAL ADB6F403.3
& TRANS(N_PROFILE, N_LAYER) GSS1F403.51
! TRANSMISSIVITIES MNGFX3A.92
REAL GSS3F402.230
& SOURCE_UP(NPD_PROFILE, NPD_LAYER) GSS3F402.231
! UPWARD SOURCE FUNCTION MNGFX3A.94
& , SOURCE_DOWN(NPD_PROFILE, NPD_LAYER) MNGFX3A.95
! DOWNWARD SOURCE FUNCTION MNGFX3A.96
! MNGFX3A.97
! ADB1F401.613
! MNGFX3A.98
! GSS3F402.232
*IF DEF,VECTLIB PXVECTLB.111
DO I=1, N_LAYER MNGFX3A.99
DO L=1, N_PROFILE MNGFX3A.100
TRANS(L, I)= -DIFFUSIVITY_FACTOR*TAU_GAS(L, I) GSS3F402.234
ENDDO MNGFX3A.102
ENDDO MNGFX3A.103
call exp_v(n_layer*n_profile,trans,trans) ADB6F403.4
*ELSE GSS3F402.236
DO I=1, N_LAYER GSS3F402.237
DO L=1, N_PROFILE GSS3F402.238
TRANS(L, I)=EXP(-DIFFUSIVITY_FACTOR*TAU_GAS(L, I)) GSS3F402.239
ENDDO GSS3F402.240
ENDDO GSS3F402.241
*ENDIF GSS3F402.242
! MNGFX3A.104
IF (ISOLIR.EQ.IP_SOLAR) THEN MNGFX3A.105
DO I=1, N_LAYER MNGFX3A.106
DO L=1, N_PROFILE MNGFX3A.107
SOURCE_UP(L, I)=0.0E+00 MNGFX3A.108
SOURCE_DOWN(L, I)=0.0E+00 MNGFX3A.109
ENDDO MNGFX3A.110
ENDDO MNGFX3A.111
ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN MNGFX3A.112
DO I=1, N_LAYER MNGFX3A.113
DO L=1, N_PROFILE MNGFX3A.114
SOURCE_UP(L, I)=(1.0E+00-TRANS(L, I)+SQRT_TOL_MACHINE) MNGFX3A.115
& *DIFF_PLANCK(L, I) MNGFX3A.116
& /(DIFFUSIVITY_FACTOR*TAU_GAS(L, I)+SQRT_TOL_MACHINE) MNGFX3A.117
SOURCE_DOWN(L, I)=-SOURCE_UP(L, I) MNGFX3A.118
ENDDO MNGFX3A.119
ENDDO MNGFX3A.120
ENDIF MNGFX3A.121
! MNGFX3A.122
! THE DIRECT FLUX. MNGFX3A.123
IF (ISOLIR.EQ.IP_SOLAR) THEN MNGFX3A.124
DO L=1, N_PROFILE MNGFX3A.125
FLUX_DIRECT(L, 0)=FLUX_INC_DIRECT(L) MNGFX3A.126
ENDDO MNGFX3A.127
DO I=1, N_LAYER MNGFX3A.128
DO L=1, N_PROFILE MNGFX3A.129
FLUX_DIRECT(L, I) MNGFX3A.130
& =FLUX_DIRECT(L, I-1)*EXP(-TAU_GAS(L, I)*SEC_0(L)) MNGFX3A.131
ENDDO MNGFX3A.132
ENDDO MNGFX3A.133
ENDIF MNGFX3A.134
! MNGFX3A.135
! DOWNWARD FLUXES. MNGFX3A.136
DO L=1, N_PROFILE MNGFX3A.137
FLUX_DIFFUSE(L, 2)=FLUX_INC_DOWN(L) MNGFX3A.138
ENDDO MNGFX3A.139
DO I=1, N_LAYER MNGFX3A.140
DO L=1, N_PROFILE MNGFX3A.141
FLUX_DIFFUSE(L, 2*I+2)=TRANS(L, I)*FLUX_DIFFUSE(L, 2*I) MNGFX3A.142
& +SOURCE_DOWN(L, I) MNGFX3A.143
ENDDO MNGFX3A.144
ENDDO MNGFX3A.145
! MNGFX3A.146
! UPWARD FLUXES. MNGFX3A.147
IF (ISOLIR.EQ.IP_SOLAR) THEN MNGFX3A.148
DO L=1, N_PROFILE MNGFX3A.149
FLUX_DIFFUSE(L, 2*N_LAYER+1)=SOURCE_GROUND(L) MNGFX3A.150
& +ALBEDO_SURFACE_DIFF(L)*FLUX_DIFFUSE(L, 2*N_LAYER+2) MNGFX3A.151
& +ALBEDO_SURFACE_DIR(L)*FLUX_DIRECT(L, N_LAYER) MNGFX3A.152
ENDDO MNGFX3A.153
ELSE MNGFX3A.154
DO L=1, N_PROFILE MNGFX3A.155
FLUX_DIFFUSE(L, 2*N_LAYER+1)=SOURCE_GROUND(L) MNGFX3A.156
& +ALBEDO_SURFACE_DIFF(L)*FLUX_DIFFUSE(L, 2*N_LAYER+2) MNGFX3A.157
ENDDO MNGFX3A.158
ENDIF MNGFX3A.159
DO I=N_LAYER, 1, -1 MNGFX3A.160
DO L=1, N_PROFILE MNGFX3A.161
FLUX_DIFFUSE(L, 2*I-1)=TRANS(L, I)*FLUX_DIFFUSE(L, 2*I+1) MNGFX3A.162
& +SOURCE_UP(L, I) MNGFX3A.163
ENDDO MNGFX3A.164
ENDDO MNGFX3A.165
! MNGFX3A.166
! REDUCE TO THE NET FLUX IF THIS IS REQUIRED. MNGFX3A.167
IF (L_NET) THEN MNGFX3A.168
DO I=0, N_LAYER MNGFX3A.169
DO L=1, N_PROFILE MNGFX3A.170
FLUX_DIFFUSE(L, I+1)=FLUX_DIFFUSE(L, 2*I+2) MNGFX3A.171
& -FLUX_DIFFUSE(L, 2*I+1) MNGFX3A.172
ENDDO MNGFX3A.173
ENDDO MNGFX3A.174
ENDIF MNGFX3A.175
! MNGFX3A.176
! MNGFX3A.177
RETURN MNGFX3A.178
END MNGFX3A.179
*ENDIF DEF,A01_3A,OR,DEF,A02_3A MNGFX3A.180
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.42