*IF DEF,A70_1A ADB1F402.1
*IF DEF,A01_3A,OR,DEF,A02_3A AGFX3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13059
C GTS2F400.13060
C Use, duplication or disclosure of this code is subject to the GTS2F400.13061
C restrictions as set forth in the contract. GTS2F400.13062
C GTS2F400.13063
C Meteorological Office GTS2F400.13064
C London Road GTS2F400.13065
C BRACKNELL GTS2F400.13066
C Berkshire UK GTS2F400.13067
C RG12 2SZ GTS2F400.13068
C GTS2F400.13069
C If no contract has been raised with this copy of the code, the use, GTS2F400.13070
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13071
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13072
C Modelling at the above address. GTS2F400.13073
C ******************************COPYRIGHT****************************** GTS2F400.13074
C GTS2F400.13075
!+ Subroutine to increment a sum of fluxes. AGFX3A.3
! AGFX3A.4
! Method: AGFX3A.5
! The arrays holding the summed fluxes are incremented AGFX3A.6
! by a weighted sum of the variables suffixed with _INCR. AGFX3A.7
! Arguments specify which arrays are to be incremented. AGFX3A.8
! AGFX3A.9
! Current Owner of Code: J. M. Edwards AGFX3A.10
! AGFX3A.11
! History: AGFX3A.12
! Version Date Comment AGFX3A.13
! 4.0 27-07-95 Original Code AGFX3A.14
! (J. M. Edwards) AGFX3A.15
! AGFX3A.16
! Description of Code: AGFX3A.17
! FORTRAN 77 with extensions listed in documentation. AGFX3A.18
! AGFX3A.19
!- --------------------------------------------------------------------- AGFX3A.20
SUBROUTINE AUGMENT_FLUX(N_PROFILE, N_LAYER, N_AUGMENT 7AGFX3A.21
& , ISOLIR, L_CLEAR AGFX3A.22
& , WEIGHT_INCR AGFX3A.23
& , FLUX_DIRECT, FLUX_TOTAL AGFX3A.24
& , FLUX_DIRECT_INCR, FLUX_TOTAL_INCR AGFX3A.25
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR AGFX3A.26
& , FLUX_DIRECT_INCR_CLEAR, FLUX_TOTAL_INCR_CLEAR AGFX3A.27
& , NPD_PROFILE, NPD_LAYER AGFX3A.28
& ) AGFX3A.29
! AGFX3A.30
! AGFX3A.31
IMPLICIT NONE AGFX3A.32
! AGFX3A.33
! AGFX3A.34
! SIZES OF DUMMY ARRAYS. AGFX3A.35
INTEGER !, INTENT(IN) AGFX3A.36
& NPD_PROFILE AGFX3A.37
! MAXIMUM NUMBER OF PROFILES AGFX3A.38
& , NPD_LAYER AGFX3A.39
! MAXIMUM NUMBER OF LAYERS AGFX3A.40
! AGFX3A.41
! INCLUDE COMDECKS AGFX3A.42
*CALL SPCRG3A 
AGFX3A.43
! AGFX3A.44
! DUMMY ARGUMENTS. AGFX3A.45
INTEGER !, INTENT(IN) AGFX3A.46
& N_PROFILE AGFX3A.47
! NUMBER OF PROFILES AGFX3A.48
& , N_LAYER AGFX3A.49
! NUMBER OF LAYERS AGFX3A.50
& , N_AUGMENT AGFX3A.51
! LENGTH OF VECTOR TO AUGMENT AGFX3A.52
& , ISOLIR AGFX3A.53
! SPECTRAL REGION AGFX3A.54
LOGICAL !, INTENT(IN) AGFX3A.55
& L_CLEAR AGFX3A.56
! CLEAR FLUXES CALCULATED AGFX3A.57
REAL !, INTENT(IN) AGFX3A.58
& WEIGHT_INCR AGFX3A.59
! WEIGHT TO APPLY TO FLUXES AGFX3A.60
& , FLUX_DIRECT_INCR(NPD_PROFILE, 0: NPD_LAYER) AGFX3A.61
! DIRECT FLUX IN BAND AGFX3A.62
& , FLUX_TOTAL_INCR(NPD_PROFILE, 2*NPD_LAYER+2) AGFX3A.63
! TOTAL FLUX IN BAND AGFX3A.64
& , FLUX_DIRECT_INCR_CLEAR(NPD_PROFILE, 0: NPD_LAYER) AGFX3A.65
! CLEAR DIRECT FLUX IN BAND AGFX3A.66
& , FLUX_TOTAL_INCR_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2) AGFX3A.67
! CLEAR TOTAL FLUX IN BAND AGFX3A.68
REAL !, INTENT(INOUT) AGFX3A.69
& FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER) AGFX3A.70
! DIRECT FLUX AGFX3A.71
& , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2) AGFX3A.72
! TOTAL FLUX AGFX3A.73
& , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER) AGFX3A.74
! CLEAR DIRECT FLUX AGFX3A.75
& , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2) AGFX3A.76
! CLEAR TOTAL FLUX AGFX3A.77
! AGFX3A.78
! LOCAL ARGUMENTS. AGFX3A.79
INTEGER AGFX3A.80
& I AGFX3A.81
! LOOP VARIABLE AGFX3A.82
& , L AGFX3A.83
! LOOP VARIABLE AGFX3A.84
! AGFX3A.85
! AGFX3A.86
! INCREMENT THE ACTUAL FLUXES. AGFX3A.87
IF (ISOLIR.EQ.IP_SOLAR) THEN AGFX3A.88
DO I=0, N_LAYER AGFX3A.89
DO L=1, N_PROFILE AGFX3A.90
FLUX_DIRECT(L, I)=FLUX_DIRECT(L, I) AGFX3A.91
& +WEIGHT_INCR*FLUX_DIRECT_INCR(L, I) AGFX3A.92
ENDDO AGFX3A.93
ENDDO AGFX3A.94
ENDIF AGFX3A.95
DO I=1, N_AUGMENT AGFX3A.96
DO L=1, N_PROFILE AGFX3A.97
FLUX_TOTAL(L, I)=FLUX_TOTAL(L, I) AGFX3A.98
& +WEIGHT_INCR*FLUX_TOTAL_INCR(L, I) AGFX3A.99
ENDDO AGFX3A.100
ENDDO AGFX3A.101
! AGFX3A.102
IF (L_CLEAR) THEN AGFX3A.103
IF (ISOLIR.EQ.IP_SOLAR) THEN AGFX3A.104
DO I=0, N_LAYER AGFX3A.105
DO L=1, N_PROFILE AGFX3A.106
FLUX_DIRECT_CLEAR(L, I)=FLUX_DIRECT_CLEAR(L, I) AGFX3A.107
& +WEIGHT_INCR*FLUX_DIRECT_INCR_CLEAR(L, I) AGFX3A.108
ENDDO AGFX3A.109
ENDDO AGFX3A.110
ENDIF AGFX3A.111
DO I=1, N_AUGMENT AGFX3A.112
DO L=1, N_PROFILE AGFX3A.113
FLUX_TOTAL_CLEAR(L, I)=FLUX_TOTAL_CLEAR(L, I) AGFX3A.114
& +WEIGHT_INCR*FLUX_TOTAL_INCR_CLEAR(L, I) AGFX3A.115
ENDDO AGFX3A.116
ENDDO AGFX3A.117
ENDIF AGFX3A.118
! AGFX3A.119
! AGFX3A.120
RETURN AGFX3A.121
END AGFX3A.122
*ENDIF DEF,A01_3A,OR,DEF,A02_3A AGFX3A.123
*ENDIF DEF,A70_1A ADB1F402.2