| 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 |