Directory: | ./ |
---|---|
File: | rad/swtt.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 9 | 9 | 100.0% |
Branches: | 4 | 6 | 66.7% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | 28080 | 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 | 56160 | 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 |
1/2✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
|
28080 | IF (LHOOK) CALL DR_HOOK('SWTT',0,ZHOOK_HANDLE) |
87 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27939600 | 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 | 27911520 | & * ( 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 | 27911520 | & * ( BPAD(KNU,KA,7) )))))) | |
97 | |||
98 | !* 2. ADD THE BACKGROUND TRANSMISSION | ||
99 | |||
100 | 27939600 | PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1.0_JPRB - D(KNU,KA)) + D(KNU,KA) | |
101 | ENDDO | ||
102 | |||
103 |
1/2✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
|
28080 | IF (LHOOK) CALL DR_HOOK('SWTT',1,ZHOOK_HANDLE) |
104 | 28080 | END SUBROUTINE SWTT | |
105 |