*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.69
*IF DEF,A01_3A,OR,DEF,A02_3A RSCAS3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13688
C GTS2F400.13689
C Use, duplication or disclosure of this code is subject to the GTS2F400.13690
C restrictions as set forth in the contract. GTS2F400.13691
C GTS2F400.13692
C Meteorological Office GTS2F400.13693
C London Road GTS2F400.13694
C BRACKNELL GTS2F400.13695
C Berkshire UK GTS2F400.13696
C RG12 2SZ GTS2F400.13697
C GTS2F400.13698
C If no contract has been raised with this copy of the code, the use, GTS2F400.13699
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13700
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13701
C Modelling at the above address. GTS2F400.13702
C ******************************COPYRIGHT****************************** GTS2F400.13703
C GTS2F400.13704
!+ Subroutine to rescale the asymmetry. RSCAS3A.3
! RSCAS3A.4
! Method: RSCAS3A.5
! The standard rescaling of the asymmetry is used. RSCAS3A.6
! RSCAS3A.7
! Current Owner of Code: J. M. Edwards RSCAS3A.8
! RSCAS3A.9
! History: RSCAS3A.10
! Version Date Comment RSCAS3A.11
! 4.0 27-07-95 Original Code RSCAS3A.12
! (J. M. Edwards) RSCAS3A.13
! RSCAS3A.14
! Description of Code: RSCAS3A.15
! FORTRAN 77 with extensions listed in documentation. RSCAS3A.16
! RSCAS3A.17
!- --------------------------------------------------------------------- RSCAS3A.18
SUBROUTINE RESCALE_ASYMMETRY(N_PROFILE 2RSCAS3A.19
& , I_LAYER_FIRST, I_LAYER_LAST RSCAS3A.20
& , ASYMMETRY, FORWARD_SCATTER RSCAS3A.21
& , NPD_PROFILE, NPD_LAYER RSCAS3A.22
& ) RSCAS3A.23
! RSCAS3A.24
! RSCAS3A.25
IMPLICIT NONE RSCAS3A.26
! RSCAS3A.27
! RSCAS3A.28
! SIZES OF DUMMY ARRAYS. RSCAS3A.29
INTEGER !, INTENT(IN) RSCAS3A.30
& NPD_PROFILE RSCAS3A.31
! MAXIMUM NUMBER OF PROFILES RSCAS3A.32
& , NPD_LAYER RSCAS3A.33
! MAXIMUM NUMBER OF LAYERS RSCAS3A.34
! RSCAS3A.35
! DUMMY ARGUMENTS. RSCAS3A.36
INTEGER !, INTENT(IN) RSCAS3A.37
& N_PROFILE RSCAS3A.38
! NUMBER OF PROFILES RSCAS3A.39
& , I_LAYER_FIRST RSCAS3A.40
! FIRST LAYER TO RESCALE RSCAS3A.41
& , I_LAYER_LAST RSCAS3A.42
! LAST LAYER TO RESCALE RSCAS3A.43
REAL !, INTENT(IN) RSCAS3A.44
& FORWARD_SCATTER(NPD_PROFILE, NPD_LAYER) RSCAS3A.45
! FORWARD SCATTERING RSCAS3A.46
REAL !, INTENT(INOUT) RSCAS3A.47
& ASYMMETRY(NPD_PROFILE, NPD_LAYER) RSCAS3A.48
! ASYMMETRY RSCAS3A.49
! RSCAS3A.50
! LOCAL VARIABLES. RSCAS3A.51
INTEGER RSCAS3A.52
& I RSCAS3A.53
! LOOP VARIABLE RSCAS3A.54
& , L RSCAS3A.55
! LOOP VARIABLE RSCAS3A.56
! RSCAS3A.57
! RSCAS3A.58
! RSCAS3A.59
DO I=I_LAYER_FIRST, I_LAYER_LAST RSCAS3A.60
DO L=1, N_PROFILE RSCAS3A.61
ASYMMETRY(L, I)=(ASYMMETRY(L, I)-FORWARD_SCATTER(L, I)) RSCAS3A.62
& /(1.0E+00-FORWARD_SCATTER(L, I)) RSCAS3A.63
ENDDO RSCAS3A.64
ENDDO RSCAS3A.65
! RSCAS3A.66
! RSCAS3A.67
RETURN RSCAS3A.68
END RSCAS3A.69
*ENDIF DEF,A01_3A,OR,DEF,A02_3A RSCAS3A.70
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.70