1 |
|
16848 |
SUBROUTINE SWTT ( KIDIA, KFDIA, KLON, KNU, KA , PU, PTR) |
2 |
|
|
|
3 |
|
|
!**** *SWTT* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS |
4 |
|
|
|
5 |
|
|
! PURPOSE. |
6 |
|
|
! -------- |
7 |
|
|
! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
8 |
|
|
! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL |
9 |
|
|
! INTERVALS. |
10 |
|
|
|
11 |
|
|
!** INTERFACE. |
12 |
|
|
! ---------- |
13 |
|
|
! *SWTT* IS CALLED FROM *SW1S*, *SWNI*. |
14 |
|
|
|
15 |
|
|
! EXPLICIT ARGUMENTS : |
16 |
|
|
! -------------------- |
17 |
|
|
! KNU : ; INDEX OF THE SPECTRAL INTERVAL |
18 |
|
|
! KA : ; INDEX OF THE ABSORBER |
19 |
|
|
! PU : (KLON) ; ABSORBER AMOUNT |
20 |
|
|
! ==== OUTPUTS === |
21 |
|
|
! PTR : (KLON) ; TRANSMISSION FUNCTION |
22 |
|
|
|
23 |
|
|
! IMPLICIT ARGUMENTS : NONE |
24 |
|
|
! -------------------- |
25 |
|
|
|
26 |
|
|
! METHOD. |
27 |
|
|
! ------- |
28 |
|
|
|
29 |
|
|
! TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS |
30 |
|
|
! AND HORNER'S ALGORITHM. |
31 |
|
|
|
32 |
|
|
! EXTERNALS. |
33 |
|
|
! ---------- |
34 |
|
|
|
35 |
|
|
! NONE |
36 |
|
|
|
37 |
|
|
! REFERENCE. |
38 |
|
|
! ---------- |
39 |
|
|
|
40 |
|
|
! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
41 |
|
|
! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
42 |
|
|
|
43 |
|
|
! AUTHOR. |
44 |
|
|
! ------- |
45 |
|
|
! JEAN-JACQUES MORCRETTE *ECMWF* |
46 |
|
|
|
47 |
|
|
! MODIFICATIONS. |
48 |
|
|
! -------------- |
49 |
|
|
! ORIGINAL : 88-12-15 |
50 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
51 |
|
|
|
52 |
|
|
!----------------------------------------------------------------------- |
53 |
|
|
|
54 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
55 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
56 |
|
|
|
57 |
|
|
USE YOESW , ONLY : APAD ,BPAD ,D |
58 |
|
|
|
59 |
|
|
IMPLICIT NONE |
60 |
|
|
|
61 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
62 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
63 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
64 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KNU |
65 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KA |
66 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON) |
67 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON) |
68 |
|
|
!----------------------------------------------------------------------- |
69 |
|
|
|
70 |
|
|
!* 0.1 ARGUMENTS |
71 |
|
|
! --------- |
72 |
|
|
|
73 |
|
|
!----------------------------------------------------------------------- |
74 |
|
|
|
75 |
|
|
! ------------ |
76 |
|
|
|
77 |
|
33696 |
REAL(KIND=JPRB) :: ZR1(KLON), ZR2(KLON) |
78 |
|
|
|
79 |
|
|
INTEGER(KIND=JPIM) :: JL |
80 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
81 |
|
|
|
82 |
|
|
!----------------------------------------------------------------------- |
83 |
|
|
|
84 |
|
|
!* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
85 |
|
|
|
86 |
✓✗ |
16848 |
IF (LHOOK) CALL DR_HOOK('SWTT',0,ZHOOK_HANDLE) |
87 |
✓✓ |
16763760 |
DO JL = KIDIA,KFDIA |
88 |
|
|
ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL)& |
89 |
|
|
& * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL)& |
90 |
|
|
& * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL)& |
91 |
|
16746912 |
& * ( APAD(KNU,KA,7) )))))) |
92 |
|
|
|
93 |
|
|
ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL)& |
94 |
|
|
& * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL)& |
95 |
|
|
& * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL)& |
96 |
|
16746912 |
& * ( BPAD(KNU,KA,7) )))))) |
97 |
|
|
|
98 |
|
|
!* 2. ADD THE BACKGROUND TRANSMISSION |
99 |
|
|
|
100 |
|
16763760 |
PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1.0_JPRB - D(KNU,KA)) + D(KNU,KA) |
101 |
|
|
ENDDO |
102 |
|
|
|
103 |
✓✗ |
16848 |
IF (LHOOK) CALL DR_HOOK('SWTT',1,ZHOOK_HANDLE) |
104 |
|
16848 |
END SUBROUTINE SWTT |