OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
dens76.f
Go to the documentation of this file.
1  SUBROUTINE dens76(H,DENS)
2 C VERSION OF 2/9/87
3 C PURPOSE
4 C COMPUTES DENSITY FOR ALTITUDES BETWEEN 86 KM TO 1000 KM USING THE
5 C 1976 U.S. STANDARD ATMOSPHERE
6 C INPUT ARGUMENTS
7 C H = ALTITUDE (KM)
8 C OUTPUT ARGUMENTS
9 C DENS = ATMOSPHERE DENSITY AT H (KG/KM**3)
10 C CALL SUBROUTINES
11 C NONE
12 C REFERENCES
13 C JPL EM 312/87-153, 20 APRIL 1987
14 C 1976 U.S. STANDARD ATMOSPHERE, NOAA, NASA, USAF, U.S. GOVERNMENT
15 C PRINT OFFICE, WASHINGTON, D.C., OCTOBER 1976.
16 C ANALYSIS
17 C JOHNNY H. KWOK - JPL
18 C PROGRAMMER
19 C JOHNNY H. KWOK - JPL
20 C MODIFICATIONS
21 C NONE
22 C COMMENTS
23 C THE DATA T(429) ARE SEGMENTED INTO 18 LINES EACH BECAUSE SOME
24 C COMPILERS HAVE A LIMITATION OF THE NUMBER OF CONTINUATION LINES
25 C
26  IMPLICIT DOUBLE PRECISION (a-h,o-z)
27  dimension n(3),f(5),g(4),t(429)
28  DATA zero/0.d0/
29  DATA f/86.d0,100.d0,300.d0,500.d0,1000.d0/
30  DATA g/0.5d0,1.d0,2.d0,5.d0/
31  DATA n/28,228,328/
32  DATA (t(i),i=1,126)
33  x /6.958d+3,6.366d+3,5.824d+3,5.328d+3,4.875d+3,4.460d+3,4.081d+3
34  x ,3.734d+3,3.416d+3,3.126d+3,2.860d+3,2.616d+3,2.393d+3,2.188d+3
35  x ,2.000d+3,1.828d+3,1.670d+3,1.526d+3,1.393d+3,1.273d+3,1.162d+3
36  x ,1.061d+3,9.685d+2,8.842d+2,8.071d+2,7.367d+2,6.725d+2,6.139d+2
37  x ,5.604d+2,4.695d+2,3.935d+2,3.300d+2,2.769d+2,2.325d+2,1.954d+2
38  x ,1.643d+2,1.381d+2,1.161d+2,9.708d+1,8.111d+1,6.838d+1,5.811d+1
39  x ,4.975d+1,4.289d+1,3.720d+1,3.246d+1,2.847d+1,2.509d+1,2.222d+1
40  x ,1.977d+1,1.767d+1,1.585d+1,1.428d+1,1.291d+1,1.171d+1,1.065d+1
41  x ,9.717d+0,8.889d+0,8.152d+0,7.494d+0,6.904d+0,6.374d+0,5.897d+0
42  x ,5.465d+0,5.074d+0,4.719d+0,4.396d+0,4.101d+0,3.831d+0,3.584d+0
43  x ,3.358d+0,3.150d+0,2.958d+0,2.781d+0,2.618d+0,2.466d+0,2.326d+0
44  x ,2.196d+0,2.076d+0,1.963d+0,1.859d+0,1.761d+0,1.670d+0,1.585d+0
45  x ,1.505d+0,1.431d+0,1.361d+0,1.295d+0,1.233d+0,1.175d+0,1.121d+0
46  x ,1.069d+0,1.021d+0,9.750d-1,9.319d-1,8.911d-1,8.525d-1,8.161d-1
47  x ,7.815d-1,7.488d-1,7.178d-1,6.883d-1,6.604d-1,6.339d-1,6.086d-1
48  x ,5.846d-1,5.618d-1,5.401d-1,5.194d-1,4.997d-1,4.809d-1,4.630d-1
49  x ,4.459d-1,4.295d-1,4.139d-1,3.990d-1,3.847d-1,3.711d-1,3.581d-1
50  x ,3.456d-1,3.336d-1,3.222d-1,3.112d-1,3.006d-1,2.905d-1,2.809d-1/
51  DATA (t(i),i=127,252)
52  x /2.716d-1,2.626d-1,2.541d-1,2.458d-1,2.379d-1,2.303d-1,2.230d-1
53  x ,2.160d-1,2.092d-1,2.027d-1,1.964d-1,1.904d-1,1.846d-1,1.790d-1
54  x ,1.736d-1,1.683d-1,1.633d-1,1.585d-1,1.538d-1,1.493d-1,1.450d-1
55  x ,1.408d-1,1.367d-1,1.328d-1,1.290d-1,1.253d-1,1.218d-1,1.184d-1
56  x ,1.151d-1,1.119d-1,1.088d-1,1.058d-1,1.029d-1,1.001d-1,9.741d-2
57  x ,9.479d-2,9.225d-2,8.979d-2,8.740d-2,8.509d-2,8.285d-2,8.068d-2
58  x ,7.858d-2,7.654d-2,7.456d-2,7.265d-2,7.079d-2,6.898d-2,6.723d-2
59  x ,6.553d-2,6.388d-2,6.228d-2,6.073d-2,5.922d-2,5.775d-2,5.633d-2
60  x ,5.494d-2,5.360d-2,5.229d-2,5.102d-2,4.979d-2,4.859d-2,4.742d-2
61  x ,4.629d-2,4.519d-2,4.412d-2,4.307d-2,4.206d-2,4.107d-2,4.011d-2
62  x ,3.918d-2,3.827d-2,3.738d-2,3.652d-2,3.568d-2,3.486d-2,3.407d-2
63  x ,3.329d-2,3.254d-2,3.180d-2,3.108d-2,3.039d-2,2.971d-2,2.904d-2
64  x ,2.840d-2,2.777d-2,2.715d-2,2.656d-2,2.597d-2,2.540d-2,2.485d-2
65  x ,2.431d-2,2.378d-2,2.326d-2,2.276d-2,2.227d-2,2.179d-2,2.133d-2
66  x ,2.087d-2,2.043d-2,1.999d-2,1.957d-2,1.916d-2,1.836d-2,1.760d-2
67  x ,1.688d-2,1.618d-2,1.552d-2,1.489d-2,1.429d-2,1.372d-2,1.317d-2
68  x ,1.264d-2,1.214d-2,1.166d-2,1.121d-2,1.077d-2,1.035d-2,9.946d-3
69  x ,9.561d-3,9.193d-3,8.841d-3,8.503d-3,8.179d-3,7.869d-3,7.572d-3/
70  DATA (t(i),i=253,378)
71  x /7.287d-3,7.014d-3,6.751d-3,6.500d-3,6.259d-3,6.027d-3,5.805d-3
72  x ,5.592d-3,5.387d-3,5.190d-3,5.001d-3,4.820d-3,4.645d-3,4.478d-3
73  x ,4.316d-3,4.162d-3,4.013d-3,3.870d-3,3.732d-3,3.599d-3,3.472d-3
74  x ,3.350d-3,3.232d-3,3.118d-3,3.009d-3,2.904d-3,2.803d-3,2.705d-3
75  x ,2.611d-3,2.521d-3,2.434d-3,2.350d-3,2.269d-3,2.192d-3,2.117d-3
76  x ,2.044d-3,1.975d-3,1.908d-3,1.843d-3,1.781d-3,1.720d-3,1.662d-3
77  x ,1.606d-3,1.553d-3,1.501d-3,1.450d-3,1.402d-3,1.355d-3,1.310d-3
78  x ,1.267d-3,1.225d-3,1.184d-3,1.145d-3,1.108d-3,1.071d-3,1.036d-3
79  x ,1.002d-3,9.694d-4,9.377d-4,9.072d-4,8.777d-4,8.492d-4,8.217d-4
80  x ,7.952d-4,7.695d-4,7.447d-4,7.208d-4,6.976d-4,6.753d-4,6.537d-4
81  x ,6.328d-4,6.127d-4,5.932d-4,5.743d-4,5.561d-4,5.385d-4,5.215d-4
82  x ,4.814d-4,4.446d-4,4.107d-4,3.796d-4,3.509d-4,3.246d-4,3.003d-4
83  x ,2.780d-4,2.574d-4,2.384d-4,2.210d-4,2.049d-4,1.900d-4,1.763d-4
84  x ,1.637d-4,1.520d-4,1.413d-4,1.313d-4,1.221d-4,1.137d-4,1.058d-4
85  x ,9.859d-5,9.190d-5,8.571d-5,7.998d-5,7.468d-5,6.977d-5,6.523d-5
86  x ,6.102d-5,5.712d-5,5.350d-5,5.015d-5,4.704d-5,4.416d-5,4.148d-5
87  x ,3.900d-5,3.669d-5,3.454d-5,3.255d-5,3.070d-5,2.897d-5,2.736d-5
88  x ,2.587d-5,2.448d-5,2.318d-5,2.197d-5,2.084d-5,1.979d-5,1.880d-5/
89  DATA (t(i),i=379,429)
90  x /1.788d-5,1.702d-5,1.622d-5,1.547d-5,1.476d-5,1.410d-5,1.348d-5
91  x ,1.290d-5,1.235d-5,1.184d-5,1.136d-5,1.091d-5,1.048d-5,1.008d-5
92  x ,9.697d-6,9.339d-6,9.001d-6,8.682d-6,8.380d-6,8.094d-6,7.824d-6
93  x ,7.567d-6,7.324d-6,7.093d-6,6.873d-6,6.664d-6,6.465d-6,6.276d-6
94  x ,6.096d-6,5.924d-6,5.759d-6,5.602d-6,5.452d-6,5.308d-6,5.170d-6
95  x ,5.038d-6,4.912d-6,4.790d-6,4.673d-6,4.561d-6,4.453d-6,4.349d-6
96  x ,4.248d-6,4.152d-6,4.058d-6,3.968d-6,3.881d-6,3.797d-6,3.716d-6
97  x ,3.637d-6,3.561d-6/
98  DATA one/1.d0/
99  IF (h.LT.f(1)) GO TO 901
100  IF (h.GE.f(2)) GO TO 100
101  hh=(h-f(1))/g(1)
102  ih=hh+1
103  fact=dmod(hh,one)
104  GO TO 500
105  100 CONTINUE
106  IF (h.GE.f(3)) GO TO 200
107  hh=(h-f(2))/g(2)
108  ih=hh+n(1)+1
109  fact=dmod(hh,one)
110  GO TO 500
111  200 CONTINUE
112  IF (h.GE.f(4)) GO TO 300
113  hh=(h-f(3))/g(3)
114  ih=hh+n(2)+1
115  fact=dmod(hh,one)
116  GO TO 500
117  300 CONTINUE
118  IF (h.GT.f(5)) GO TO 902
119  hh=(h-f(4))/g(4)
120  ih=hh+n(3)+1
121  fact=dmod(hh,one)
122  GO TO 500
123  500 CONTINUE
124  dens=t(ih)+(t(ih+1)-t(ih))*fact
125  RETURN
126  901 CONTINUE
127 C
128 C *** DENSITY BELOW TABLE, SET EQUAL AT 86 KM
129 C
130  dens=t(1)
131  RETURN
132  902 CONTINUE
133 C
134 C *** DENSITY ABOVE TABLE, SET TO ZERO
135 C
136  dens=zero
137  RETURN
138  END
subroutine fact
Definition: tmd.lp.f:1161
subroutine dens76(H, DENS)
Definition: dens76.f:2
#define f
Definition: l1_czcs_hdf.c:702