SUBROUTINE SOLAR_COEFFICIENT_BASIC(IERR 2SOLCF3A.19
& , N_PROFILE, I_LAYER_FIRST, I_LAYER_LAST SOLCF3A.20
& , OMEGA, ASYMMETRY, SEC_0 SOLCF3A.21
& , I_2STREAM SOLCF3A.22
& , SUM, DIFF, LAMBDA SOLCF3A.23
& , GAMMA_UP, GAMMA_DOWN SOLCF3A.24
& , NPD_PROFILE, NPD_LAYER SOLCF3A.25
& ) SOLCF3A.26
! SOLCF3A.27
! SOLCF3A.28
! SOLCF3A.29
IMPLICIT NONE SOLCF3A.30
! SOLCF3A.31
! SOLCF3A.32
! SIZES OF DUMMY ARRAYS. SOLCF3A.33
INTEGER SOLCF3A.34
& NPD_PROFILE SOLCF3A.35
! MAXIMUM NUMBER OF PROFILES SOLCF3A.36
& , NPD_LAYER SOLCF3A.37
! MAXIMUM NUMBER OF LAYERS SOLCF3A.38
! SOLCF3A.39
! INCLUDE COMDECKS. SOLCF3A.40
*CALL PRMCH3A 
SOLCF3A.41
*CALL PRECSN3A SOLCF3A.42
*CALL TWOSTR3A SOLCF3A.43
*CALL STDIO3A SOLCF3A.44
*CALL ERROR3A SOLCF3A.45
! SOLCF3A.46
! SOLCF3A.47
! DUMMY VARIABLES. SOLCF3A.48
INTEGER !, INTENT(OUT) SOLCF3A.49
& IERR SOLCF3A.50
! ERROR FLAG SOLCF3A.51
INTEGER !, INTENT(IN) SOLCF3A.52
& N_PROFILE SOLCF3A.53
! NUMBER OF PROFILES SOLCF3A.54
& , I_LAYER_FIRST SOLCF3A.55
! FIRST LAYER TO CONSIDER SOLCF3A.56
& , I_LAYER_LAST SOLCF3A.57
! FIRST LAYER TO CONSIDER SOLCF3A.58
& , I_2STREAM SOLCF3A.59
! TWO-STREAM SCHEME SOLCF3A.60
! SOLCF3A.61
REAL !, INTENT(IN) SOLCF3A.62
& OMEGA(NPD_PROFILE, NPD_LAYER) SOLCF3A.63
! ALBEDO OF SINGLE SCATTERING SOLCF3A.64
& , ASYMMETRY(NPD_PROFILE, NPD_LAYER) SOLCF3A.65
! ASYMMETRY SOLCF3A.66
& , SEC_0(NPD_PROFILE) SOLCF3A.67
! SECANT OF SOLAR ZENITH ANGLE SOLCF3A.68
& , SUM(NPD_PROFILE, NPD_LAYER) SOLCF3A.69
! SUM OF TWO-STREAM COEFFICIENTS SOLCF3A.70
& , DIFF(NPD_PROFILE, NPD_LAYER) SOLCF3A.71
! DIFFERENCE OF TWO-STREAM COEFFICIENTS SOLCF3A.72
& , LAMBDA(NPD_PROFILE, NPD_LAYER) SOLCF3A.73
! LAMBDA SOLCF3A.74
! SOLCF3A.75
! BASIC TWO-STREAM COEFFICIENTS: SOLCF3A.76
REAL !, INTENT(OUT) SOLCF3A.77
& GAMMA_UP(NPD_PROFILE, NPD_LAYER) SOLCF3A.78
! COEFFICIENT FOR UPWARD RADIATION SOLCF3A.79
& , GAMMA_DOWN(NPD_PROFILE, NPD_LAYER) SOLCF3A.80
! COEFFICIENT FOR DOWNWAD RADIATION SOLCF3A.81
! SOLCF3A.82
! SOLCF3A.83
! LOCAL VARIABLES. SOLCF3A.84
INTEGER SOLCF3A.85
& I SOLCF3A.86
! LOOP VARIABLE SOLCF3A.87
& , L SOLCF3A.88
! LOOP VARIABLE SOLCF3A.89
& , K SOLCF3A.90
! LOOP VARIABLE SOLCF3A.91
& , KK SOLCF3A.92
! TEMPORARY VARIABLE SOLCF3A.93
& , N_INDEX SOLCF3A.94
! NUMBER OF INDICES SATISFYING TEST SOLCF3A.95
& , INDEX(NPD_PROFILE) SOLCF3A.96
! INDICES OF TESTED POINTS SOLCF3A.97
REAL SOLCF3A.98
& KSI_0(NPD_PROFILE, NPD_LAYER) SOLCF3A.99
! DIFFERENCE IN SOLAR SCATTERING FRACTIONS SOLCF3A.100
& , TEST_ARRAY(NPD_PROFILE) SOLCF3A.101
! ARRAY TO TEST SOLCF3A.102
& , FACTOR SOLCF3A.103
! TEMPORARY VARIABLE SOLCF3A.104
REAL SOLCF3A.105
& ROOT_3 SOLCF3A.106
! SQUARE ROOT OF 3 SOLCF3A.107
PARAMETER( SOLCF3A.108
& ROOT_3=1.7320508075688772E+00 SOLCF3A.109
& ) SOLCF3A.110
! SOLCF3A.111
! SUBROUTINES CALLED: SOLCF3A.112
! SOLCF3A.115
! CRAY DIRECTIVES FOR THE WHOLE ROUTINE: ADB1F402.687
! POINTS ARE NOT REPEATED IN THE INDEXING ARRAY, SO IT IS SAFE ADB1F402.688
! TO VECTORIZE OVER INDIRECTLY ADDRESSED ARRAYS. ADB1F402.689
Cfpp$ NODEPCHK R ADB1F402.690
! SOLCF3A.116
! SOLCF3A.117
! SOLCF3A.118
! IF LAMBDA IS TOO CLOSE TO SEC_0 IT MUST BE PERTURBED SOLCF3A.119
DO I=I_LAYER_FIRST, I_LAYER_LAST SOLCF3A.120
DO L=1, N_PROFILE SOLCF3A.121
TEST_ARRAY(L)=ABS(LAMBDA(L, I)-SEC_0(L)) SOLCF3A.122
ENDDO SOLCF3A.123
! GSS2F402.82
N_INDEX=0 GSS2F402.83
DO L =1,N_PROFILE GSS2F402.84
IF (TEST_ARRAY(L).LT.TOL_DIV) THEN GSS2F402.85
N_INDEX =N_INDEX+1 GSS2F402.86
INDEX(N_INDEX)=L GSS2F402.87
END IF GSS2F402.88
END DO GSS2F402.89
! GSS2F402.90
CDIR$ IVDEP SOLCF3A.126
DO K=1, N_INDEX SOLCF3A.127
KK=INDEX(K) SOLCF3A.128
SUM(KK, I)=(1.0E+00+TOL_DIV)*SUM(KK, I) SOLCF3A.129
DIFF(KK, I)=(1.0E+00+TOL_DIV)*DIFF(KK, I) SOLCF3A.130
LAMBDA(KK, I)=(1.0E+00+TOL_DIV)*LAMBDA(KK, I) SOLCF3A.131
ENDDO SOLCF3A.132
ENDDO SOLCF3A.133
! SOLCF3A.134
IF ( (I_2STREAM.EQ.IP_EDDINGTON).OR. SOLCF3A.135
& (I_2STREAM.EQ.IP_ELSASSER).OR. SOLCF3A.136
& (I_2STREAM.EQ.IP_PIFM85).OR. ADB1F401.936
& (I_2STREAM.EQ.IP_2S_TEST).OR. SOLCF3A.138
& (I_2STREAM.EQ.IP_HEMI_MEAN).OR. ADB1F402.691
& (I_2STREAM.EQ.IP_PIFM80) ) THEN ADB1F402.692
! SOLCF3A.140
DO I=I_LAYER_FIRST, I_LAYER_LAST SOLCF3A.141
DO L=1, N_PROFILE SOLCF3A.142
KSI_0(L, I)=1.5E+00*ASYMMETRY(L, I)/SEC_0(L) SOLCF3A.143
ENDDO SOLCF3A.144
ENDDO SOLCF3A.145
! SOLCF3A.146
ELSE IF (I_2STREAM.EQ.IP_DISCRETE_ORD) THEN SOLCF3A.147
! SOLCF3A.148
DO I=I_LAYER_FIRST, I_LAYER_LAST SOLCF3A.149
DO L=1, N_PROFILE SOLCF3A.150
KSI_0(L, I)=ROOT_3*ASYMMETRY(L, I)/SEC_0(L) SOLCF3A.151
ENDDO SOLCF3A.152
ENDDO SOLCF3A.153
! SOLCF3A.154
ELSE SOLCF3A.155
! SOLCF3A.156
WRITE(IU_ERR, '(/A)') SOLCF3A.157
& '*** ERROR: AN ILLEGAL SOLAR TWO-STREAM SCHEME HAS ' SOLCF3A.158
& //'BEEN SELECTED.' SOLCF3A.159
IERR=I_ERR_FATAL SOLCF3A.160
RETURN SOLCF3A.161
! SOLCF3A.162
ENDIF SOLCF3A.163
! SOLCF3A.164
! SOLCF3A.165
! DETERMINE THE BASIC SOLAR COEFFICIENTS FOR THE SOLCF3A.166
! TWO-STREAM EQUATIONS. SOLCF3A.167
! SOLCF3A.168
DO I=I_LAYER_FIRST, I_LAYER_LAST SOLCF3A.169
DO L=1, N_PROFILE SOLCF3A.170
FACTOR=0.5E+00*OMEGA(L, I)*SEC_0(L) SOLCF3A.171
& /((LAMBDA(L, I)-SEC_0(L))*(LAMBDA(L, I)+SEC_0(L))) SOLCF3A.172
GAMMA_UP(L, I)=FACTOR*(SUM(L, I)-SEC_0(L) SOLCF3A.173
& -KSI_0(L, I)*(DIFF(L, I)-SEC_0(L))) SOLCF3A.174
GAMMA_DOWN(L, I)=FACTOR*(SUM(L, I)+SEC_0(L) SOLCF3A.175
& +KSI_0(L, I)*(DIFF(L, I)+SEC_0(L))) SOLCF3A.176
ENDDO SOLCF3A.177
ENDDO SOLCF3A.178
! SOLCF3A.179
! SOLCF3A.180
! SOLCF3A.181
RETURN SOLCF3A.182
END SOLCF3A.183
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SOLCF3A.184
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.102