source: LMDZ5/branches/testing/libf/phymar/swtt.F90 @ 5192

Last change on this file since 5192 was 2160, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand

File size: 2.6 KB
Line 
1SUBROUTINE 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
16!        EXPLICIT ARGUMENTS :
17!        --------------------
18! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
19! KA     :                     ; INDEX OF THE ABSORBER
20! PU     : (KLON)             ; ABSORBER AMOUNT
21!     ==== OUTPUTS ===
22! PTR    : (KLON)             ; 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 : 88-12-15
51   
52!-----------------------------------------------------------------------
53
54#include "tsmbkind.h"
55
56USE YOESW    , ONLY : APAD     ,BPAD     ,D
57
58
59IMPLICIT NONE
60
61
62!     DUMMY INTEGER SCALARS
63INTEGER_M :: KA
64INTEGER_M :: KFDIA
65INTEGER_M :: KIDIA
66INTEGER_M :: KLON
67INTEGER_M :: KNU
68
69
70
71!-----------------------------------------------------------------------
72
73!*       0.1   ARGUMENTS
74!              ---------
75
76REAL_B :: PU(KLON), PTR(KLON)
77
78!-----------------------------------------------------------------------
79
80!*       0.2   LOCAL ARRAYS
81!              ------------
82
83REAL_B :: ZR1(KLON), ZR2(KLON)
84
85!     LOCAL INTEGER SCALARS
86INTEGER_M :: JL
87
88
89!-----------------------------------------------------------------------
90
91!*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
92
93
94DO JL = KIDIA,KFDIA
95  ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL)&
96   &* ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL)&
97   &* ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL)&
98   &* ( APAD(KNU,KA,7) ))))))
99
100  ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL)&
101   &* ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL)&
102   &* ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL)&
103   &* ( BPAD(KNU,KA,7) ))))))
104
105
106!*         2.      ADD THE BACKGROUND TRANSMISSION
107
108
109
110  PTR(JL) = (ZR1(JL) / ZR2(JL)) * (_ONE_ - D(KNU,KA)) + D(KNU,KA)
111ENDDO
112
113RETURN
114END SUBROUTINE SWTT
Note: See TracBrowser for help on using the repository browser.