| Directory: | ./ |
|---|---|
| File: | rad/swtt1.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 13 | 13 | 100.0% |
| Branches: | 6 | 8 | 75.0% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | 114120 | SUBROUTINE SWTT1 ( KIDIA,KFDIA,KLON,KNU,KABS,KIND, PU, PTR ) | |
| 2 | |||
| 3 | !**** *SWTT1* - 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 | ! *SWTT1* IS CALLED FROM *SW1S*. | ||
| 14 | |||
| 15 | ! EXPLICIT ARGUMENTS : | ||
| 16 | ! -------------------- | ||
| 17 | ! KNU : ; INDEX OF THE SPECTRAL INTERVAL | ||
| 18 | ! KABS : ; NUMBER OF ABSORBERS | ||
| 19 | ! KIND : (KABS) ; INDICES OF THE ABSORBERS | ||
| 20 | ! PU : (KLON,KABS) ; ABSORBER AMOUNT | ||
| 21 | ! ==== OUTPUTS === | ||
| 22 | ! PTR : (KLON,KABS) ; TRANSMISSION FUNCTION | ||
| 23 | |||
| 24 | ! IMPLICIT ARGUMENTS : NONE | ||
| 25 | ! -------------------- | ||
| 26 | |||
| 27 | ! METHOD. | ||
| 28 | ! ------- | ||
| 29 | |||
| 30 | ! TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS | ||
| 31 | ! AND HORNER'S ALGORITHM. | ||
| 32 | |||
| 33 | ! EXTERNALS. | ||
| 34 | ! ---------- | ||
| 35 | |||
| 36 | ! NONE | ||
| 37 | |||
| 38 | ! REFERENCE. | ||
| 39 | ! ---------- | ||
| 40 | |||
| 41 | ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND | ||
| 42 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS | ||
| 43 | |||
| 44 | ! AUTHOR. | ||
| 45 | ! ------- | ||
| 46 | ! JEAN-JACQUES MORCRETTE *ECMWF* | ||
| 47 | |||
| 48 | ! MODIFICATIONS. | ||
| 49 | ! -------------- | ||
| 50 | ! ORIGINAL : 95-01-20 | ||
| 51 | ! 03-10-10 Deborah Salmond and Marta Janiskova Optimisation | ||
| 52 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
| 53 | |||
| 54 | !----------------------------------------------------------------------- | ||
| 55 | |||
| 56 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
| 57 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
| 58 | |||
| 59 | USE YOESW , ONLY : APAD ,BPAD ,D | ||
| 60 | |||
| 61 | IMPLICIT NONE | ||
| 62 | |||
| 63 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
| 64 | INTEGER(KIND=JPIM),INTENT(IN) :: KABS | ||
| 65 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
| 66 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
| 67 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
| 68 | INTEGER(KIND=JPIM),INTENT(IN) :: KIND(KABS) | ||
| 69 | REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON,KABS) | ||
| 70 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON,KABS) | ||
| 71 | !----------------------------------------------------------------------- | ||
| 72 | |||
| 73 | !* 0.1 ARGUMENTS | ||
| 74 | ! --------- | ||
| 75 | |||
| 76 | !----------------------------------------------------------------------- | ||
| 77 | |||
| 78 | ! ------------ | ||
| 79 | |||
| 80 | 228240 | REAL(KIND=JPRB) :: ZR1(KLON), ZR2(KLON), ZU(KLON) | |
| 81 | REAL(KIND=JPRB) :: ZRR | ||
| 82 | |||
| 83 | INTEGER(KIND=JPIM) :: IA, JA, JL | ||
| 84 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
| 85 | |||
| 86 | !----------------------------------------------------------------------- | ||
| 87 | |||
| 88 | !* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION | ||
| 89 | |||
| 90 |
1/2✓ Branch 0 taken 114120 times.
✗ Branch 1 not taken.
|
114120 | IF (LHOOK) CALL DR_HOOK('SWTT1',0,ZHOOK_HANDLE) |
| 91 |
2/2✓ Branch 0 taken 354600 times.
✓ Branch 1 taken 114120 times.
|
468720 | DO JA = 1,KABS |
| 92 | 354600 | IA=KIND(JA) | |
| 93 | ! print *,'SWTT1: KNU', KNU | ||
| 94 |
2/2✓ Branch 0 taken 352472400 times.
✓ Branch 1 taken 354600 times.
|
352941120 | DO JL = KIDIA,KFDIA |
| 95 | 352472400 | ZU(JL) = PU(JL,JA) | |
| 96 | ZR1(JL) = APAD(KNU,IA,1) + ZU(JL) * (APAD(KNU,IA,2) + ZU(JL)& | ||
| 97 | & * ( APAD(KNU,IA,3) + ZU(JL) * (APAD(KNU,IA,4) + ZU(JL)& | ||
| 98 | & * ( APAD(KNU,IA,5) + ZU(JL) * (APAD(KNU,IA,6) + ZU(JL)& | ||
| 99 | 352472400 | & * ( APAD(KNU,IA,7) )))))) | |
| 100 | ! print *,'SWTT1 ZU APAD',IA,ZU(JL),APAD(KNU,IA,1),APAD(KNU,IA,2),& | ||
| 101 | ! &APAD(KNU,IA,3),APAD(KNU,IA,4),APAD(KNU,IA,5),APAD(KNU,IA,6),APAD(KNU,IA,7) | ||
| 102 | |||
| 103 | ZR2(JL) = BPAD(KNU,IA,1) + ZU(JL) * (BPAD(KNU,IA,2) + ZU(JL)& | ||
| 104 | & * ( BPAD(KNU,IA,3) + ZU(JL) * (BPAD(KNU,IA,4) + ZU(JL)& | ||
| 105 | & * ( BPAD(KNU,IA,5) + ZU(JL) * (BPAD(KNU,IA,6) + ZU(JL)& | ||
| 106 | 352472400 | & * ( BPAD(KNU,IA,7) )))))) | |
| 107 | 352472400 | ZRR=1.0_JPRB/ZR2(JL) | |
| 108 | |||
| 109 | !* 2. ADD THE BACKGROUND TRANSMISSION | ||
| 110 | |||
| 111 | 352827000 | PTR(JL,JA) = (ZR1(JL)*ZRR) * (1.0_JPRB-D(KNU,IA)) + D(KNU,IA) | |
| 112 | ENDDO | ||
| 113 | ENDDO | ||
| 114 | !WRITE(*,'("---> Dans SWTT1, PTR : "10E12.5)') (PTR(1,JA),JA=1,KABS) | ||
| 115 | |||
| 116 |
1/2✓ Branch 0 taken 114120 times.
✗ Branch 1 not taken.
|
114120 | IF (LHOOK) CALL DR_HOOK('SWTT1',1,ZHOOK_HANDLE) |
| 117 | 114120 | END SUBROUTINE SWTT1 | |
| 118 |