1 |
|
68472 |
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 |
|
136944 |
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 |
✓✗ |
68472 |
IF (LHOOK) CALL DR_HOOK('SWTT1',0,ZHOOK_HANDLE) |
91 |
✓✓ |
281232 |
DO JA = 1,KABS |
92 |
|
212760 |
IA=KIND(JA) |
93 |
|
|
! print *,'SWTT1: KNU', KNU |
94 |
✓✓ |
211764672 |
DO JL = KIDIA,KFDIA |
95 |
|
211483440 |
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 |
|
211483440 |
& * ( 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 |
|
211483440 |
& * ( BPAD(KNU,IA,7) )))))) |
107 |
|
211483440 |
ZRR=1.0_JPRB/ZR2(JL) |
108 |
|
|
|
109 |
|
|
!* 2. ADD THE BACKGROUND TRANSMISSION |
110 |
|
|
|
111 |
|
211696200 |
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 |
✓✗ |
68472 |
IF (LHOOK) CALL DR_HOOK('SWTT1',1,ZHOOK_HANDLE) |
117 |
|
68472 |
END SUBROUTINE SWTT1 |