| 1 |
guez |
24 |
SUBROUTINE SWTT (KNU,KA,PU,PTR) |
| 2 |
|
|
use dimens_m |
| 3 |
|
|
use dimphy |
| 4 |
|
|
use raddim |
| 5 |
|
|
IMPLICIT none |
| 6 |
|
|
C |
| 7 |
|
|
C----------------------------------------------------------------------- |
| 8 |
|
|
C PURPOSE. |
| 9 |
|
|
C -------- |
| 10 |
|
|
C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
| 11 |
|
|
C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL |
| 12 |
|
|
C INTERVALS. |
| 13 |
|
|
C |
| 14 |
|
|
C METHOD. |
| 15 |
|
|
C ------- |
| 16 |
|
|
C |
| 17 |
|
|
C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS |
| 18 |
|
|
C AND HORNER'S ALGORITHM. |
| 19 |
|
|
C |
| 20 |
|
|
C REFERENCE. |
| 21 |
|
|
C ---------- |
| 22 |
|
|
C |
| 23 |
|
|
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
| 24 |
|
|
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
| 25 |
|
|
C |
| 26 |
|
|
C AUTHOR. |
| 27 |
|
|
C ------- |
| 28 |
|
|
C JEAN-JACQUES MORCRETTE *ECMWF* |
| 29 |
|
|
C |
| 30 |
|
|
C MODIFICATIONS. |
| 31 |
|
|
C -------------- |
| 32 |
|
|
C ORIGINAL : 88-12-15 |
| 33 |
|
|
C----------------------------------------------------------------------- |
| 34 |
|
|
C |
| 35 |
|
|
C* ARGUMENTS |
| 36 |
|
|
C |
| 37 |
|
|
INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL |
| 38 |
|
|
INTEGER KA ! INDEX OF THE ABSORBER |
| 39 |
guez |
71 |
DOUBLE PRECISION PU(KDLON) ! ABSORBER AMOUNT |
| 40 |
guez |
24 |
C |
| 41 |
guez |
71 |
DOUBLE PRECISION PTR(KDLON) ! TRANSMISSION FUNCTION |
| 42 |
guez |
24 |
C |
| 43 |
|
|
C* LOCAL VARIABLES: |
| 44 |
|
|
C |
| 45 |
guez |
71 |
DOUBLE PRECISION ZR1(KDLON), ZR2(KDLON) |
| 46 |
guez |
24 |
INTEGER jl, i,j |
| 47 |
|
|
C |
| 48 |
|
|
C* Prescribed Data: |
| 49 |
|
|
C |
| 50 |
guez |
71 |
DOUBLE PRECISION APAD(2,3,7), BPAD(2,3,7), D(2,3) |
| 51 |
guez |
24 |
SAVE APAD, BPAD, D |
| 52 |
|
|
DATA ((APAD(1,I,J),I=1,3),J=1,7) / |
| 53 |
|
|
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
| 54 |
|
|
S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01, |
| 55 |
|
|
S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00, |
| 56 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02, |
| 57 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02, |
| 58 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02, |
| 59 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 / |
| 60 |
|
|
DATA ((APAD(2,I,J),I=1,3),J=1,7) / |
| 61 |
|
|
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
| 62 |
|
|
S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02, |
| 63 |
|
|
S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00, |
| 64 |
|
|
S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00, |
| 65 |
|
|
S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00, |
| 66 |
|
|
S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00, |
| 67 |
|
|
S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 / |
| 68 |
|
|
C |
| 69 |
|
|
DATA ((BPAD(1,I,J),I=1,3),J=1,7) / |
| 70 |
|
|
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
| 71 |
|
|
S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01, |
| 72 |
|
|
S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00, |
| 73 |
|
|
S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02, |
| 74 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02, |
| 75 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02, |
| 76 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 / |
| 77 |
|
|
DATA ((BPAD(2,I,J),I=1,3),J=1,7) / |
| 78 |
|
|
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
| 79 |
|
|
S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02, |
| 80 |
|
|
S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01, |
| 81 |
|
|
S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00, |
| 82 |
|
|
S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00, |
| 83 |
|
|
S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00, |
| 84 |
|
|
S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 / |
| 85 |
|
|
c |
| 86 |
|
|
DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 / |
| 87 |
|
|
DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 / |
| 88 |
|
|
C |
| 89 |
|
|
C----------------------------------------------------------------------- |
| 90 |
|
|
C |
| 91 |
|
|
C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
| 92 |
|
|
C |
| 93 |
|
|
100 CONTINUE |
| 94 |
|
|
C |
| 95 |
|
|
DO 201 JL = 1, KDLON |
| 96 |
|
|
ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL) |
| 97 |
|
|
S * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL) |
| 98 |
|
|
S * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL) |
| 99 |
|
|
S * ( APAD(KNU,KA,7) )))))) |
| 100 |
|
|
C |
| 101 |
|
|
ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL) |
| 102 |
|
|
S * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL) |
| 103 |
|
|
S * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL) |
| 104 |
|
|
S * ( BPAD(KNU,KA,7) )))))) |
| 105 |
|
|
C |
| 106 |
|
|
C |
| 107 |
|
|
C* 2. ADD THE BACKGROUND TRANSMISSION |
| 108 |
|
|
C |
| 109 |
|
|
200 CONTINUE |
| 110 |
|
|
C |
| 111 |
|
|
C |
| 112 |
|
|
PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1. - D(KNU,KA)) + D(KNU,KA) |
| 113 |
|
|
201 CONTINUE |
| 114 |
|
|
C |
| 115 |
|
|
RETURN |
| 116 |
|
|
END |
Parent Directory
| 
Revision Log