dens76.f

Go to the documentation of this file.

      SUBROUTINE dens76(H,DENS)
C  VERSION OF 2/9/87
C  PURPOSE
C    COMPUTES DENSITY FOR ALTITUDES BETWEEN 86 KM TO 1000 KM USING THE
C    1976 U.S. STANDARD ATMOSPHERE 
C  INPUT ARGUMENTS
C    H      = ALTITUDE (KM)
C  OUTPUT ARGUMENTS
C    DENS   = ATMOSPHERE DENSITY AT H (KG/KM**3)
C  CALL SUBROUTINES
C    NONE
C  REFERENCES
C    JPL EM 312/87-153, 20 APRIL 1987
C    1976 U.S. STANDARD ATMOSPHERE, NOAA, NASA, USAF, U.S. GOVERNMENT
C      PRINT OFFICE, WASHINGTON, D.C., OCTOBER 1976.
C  ANALYSIS
C    JOHNNY H. KWOK - JPL
C  PROGRAMMER
C    JOHNNY H. KWOK - JPL
C  MODIFICATIONS
C    NONE
C  COMMENTS
C    THE DATA T(429) ARE SEGMENTED INTO 18 LINES EACH BECAUSE SOME
C    COMPILERS HAVE A LIMITATION OF THE NUMBER OF CONTINUATION LINES
C    
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
      dimension n(3),f(5),g(4),t(429)
      DATA zero/0.d0/
      DATA f/86.d0,100.d0,300.d0,500.d0,1000.d0/
      DATA g/0.5d0,1.d0,2.d0,5.d0/
      DATA n/28,228,328/
      DATA (t(i),i=1,126)
     x /6.958d+3,6.366d+3,5.824d+3,5.328d+3,4.875d+3,4.460d+3,4.081d+3
     x ,3.734d+3,3.416d+3,3.126d+3,2.860d+3,2.616d+3,2.393d+3,2.188d+3
     x ,2.000d+3,1.828d+3,1.670d+3,1.526d+3,1.393d+3,1.273d+3,1.162d+3
     x ,1.061d+3,9.685d+2,8.842d+2,8.071d+2,7.367d+2,6.725d+2,6.139d+2
     x ,5.604d+2,4.695d+2,3.935d+2,3.300d+2,2.769d+2,2.325d+2,1.954d+2
     x ,1.643d+2,1.381d+2,1.161d+2,9.708d+1,8.111d+1,6.838d+1,5.811d+1
     x ,4.975d+1,4.289d+1,3.720d+1,3.246d+1,2.847d+1,2.509d+1,2.222d+1
     x ,1.977d+1,1.767d+1,1.585d+1,1.428d+1,1.291d+1,1.171d+1,1.065d+1
     x ,9.717d+0,8.889d+0,8.152d+0,7.494d+0,6.904d+0,6.374d+0,5.897d+0
     x ,5.465d+0,5.074d+0,4.719d+0,4.396d+0,4.101d+0,3.831d+0,3.584d+0
     x ,3.358d+0,3.150d+0,2.958d+0,2.781d+0,2.618d+0,2.466d+0,2.326d+0
     x ,2.196d+0,2.076d+0,1.963d+0,1.859d+0,1.761d+0,1.670d+0,1.585d+0
     x ,1.505d+0,1.431d+0,1.361d+0,1.295d+0,1.233d+0,1.175d+0,1.121d+0
     x ,1.069d+0,1.021d+0,9.750d-1,9.319d-1,8.911d-1,8.525d-1,8.161d-1
     x ,7.815d-1,7.488d-1,7.178d-1,6.883d-1,6.604d-1,6.339d-1,6.086d-1
     x ,5.846d-1,5.618d-1,5.401d-1,5.194d-1,4.997d-1,4.809d-1,4.630d-1
     x ,4.459d-1,4.295d-1,4.139d-1,3.990d-1,3.847d-1,3.711d-1,3.581d-1
     x ,3.456d-1,3.336d-1,3.222d-1,3.112d-1,3.006d-1,2.905d-1,2.809d-1/
      DATA (t(i),i=127,252)
     x /2.716d-1,2.626d-1,2.541d-1,2.458d-1,2.379d-1,2.303d-1,2.230d-1
     x ,2.160d-1,2.092d-1,2.027d-1,1.964d-1,1.904d-1,1.846d-1,1.790d-1
     x ,1.736d-1,1.683d-1,1.633d-1,1.585d-1,1.538d-1,1.493d-1,1.450d-1
     x ,1.408d-1,1.367d-1,1.328d-1,1.290d-1,1.253d-1,1.218d-1,1.184d-1
     x ,1.151d-1,1.119d-1,1.088d-1,1.058d-1,1.029d-1,1.001d-1,9.741d-2
     x ,9.479d-2,9.225d-2,8.979d-2,8.740d-2,8.509d-2,8.285d-2,8.068d-2
     x ,7.858d-2,7.654d-2,7.456d-2,7.265d-2,7.079d-2,6.898d-2,6.723d-2
     x ,6.553d-2,6.388d-2,6.228d-2,6.073d-2,5.922d-2,5.775d-2,5.633d-2
     x ,5.494d-2,5.360d-2,5.229d-2,5.102d-2,4.979d-2,4.859d-2,4.742d-2
     x ,4.629d-2,4.519d-2,4.412d-2,4.307d-2,4.206d-2,4.107d-2,4.011d-2
     x ,3.918d-2,3.827d-2,3.738d-2,3.652d-2,3.568d-2,3.486d-2,3.407d-2
     x ,3.329d-2,3.254d-2,3.180d-2,3.108d-2,3.039d-2,2.971d-2,2.904d-2
     x ,2.840d-2,2.777d-2,2.715d-2,2.656d-2,2.597d-2,2.540d-2,2.485d-2
     x ,2.431d-2,2.378d-2,2.326d-2,2.276d-2,2.227d-2,2.179d-2,2.133d-2
     x ,2.087d-2,2.043d-2,1.999d-2,1.957d-2,1.916d-2,1.836d-2,1.760d-2
     x ,1.688d-2,1.618d-2,1.552d-2,1.489d-2,1.429d-2,1.372d-2,1.317d-2
     x ,1.264d-2,1.214d-2,1.166d-2,1.121d-2,1.077d-2,1.035d-2,9.946d-3
     x ,9.561d-3,9.193d-3,8.841d-3,8.503d-3,8.179d-3,7.869d-3,7.572d-3/
      DATA (t(i),i=253,378)
     x /7.287d-3,7.014d-3,6.751d-3,6.500d-3,6.259d-3,6.027d-3,5.805d-3
     x ,5.592d-3,5.387d-3,5.190d-3,5.001d-3,4.820d-3,4.645d-3,4.478d-3
     x ,4.316d-3,4.162d-3,4.013d-3,3.870d-3,3.732d-3,3.599d-3,3.472d-3
     x ,3.350d-3,3.232d-3,3.118d-3,3.009d-3,2.904d-3,2.803d-3,2.705d-3
     x ,2.611d-3,2.521d-3,2.434d-3,2.350d-3,2.269d-3,2.192d-3,2.117d-3
     x ,2.044d-3,1.975d-3,1.908d-3,1.843d-3,1.781d-3,1.720d-3,1.662d-3
     x ,1.606d-3,1.553d-3,1.501d-3,1.450d-3,1.402d-3,1.355d-3,1.310d-3
     x ,1.267d-3,1.225d-3,1.184d-3,1.145d-3,1.108d-3,1.071d-3,1.036d-3
     x ,1.002d-3,9.694d-4,9.377d-4,9.072d-4,8.777d-4,8.492d-4,8.217d-4
     x ,7.952d-4,7.695d-4,7.447d-4,7.208d-4,6.976d-4,6.753d-4,6.537d-4
     x ,6.328d-4,6.127d-4,5.932d-4,5.743d-4,5.561d-4,5.385d-4,5.215d-4
     x ,4.814d-4,4.446d-4,4.107d-4,3.796d-4,3.509d-4,3.246d-4,3.003d-4
     x ,2.780d-4,2.574d-4,2.384d-4,2.210d-4,2.049d-4,1.900d-4,1.763d-4
     x ,1.637d-4,1.520d-4,1.413d-4,1.313d-4,1.221d-4,1.137d-4,1.058d-4
     x ,9.859d-5,9.190d-5,8.571d-5,7.998d-5,7.468d-5,6.977d-5,6.523d-5
     x ,6.102d-5,5.712d-5,5.350d-5,5.015d-5,4.704d-5,4.416d-5,4.148d-5
     x ,3.900d-5,3.669d-5,3.454d-5,3.255d-5,3.070d-5,2.897d-5,2.736d-5
     x ,2.587d-5,2.448d-5,2.318d-5,2.197d-5,2.084d-5,1.979d-5,1.880d-5/
      DATA (t(i),i=379,429)
     x /1.788d-5,1.702d-5,1.622d-5,1.547d-5,1.476d-5,1.410d-5,1.348d-5
     x ,1.290d-5,1.235d-5,1.184d-5,1.136d-5,1.091d-5,1.048d-5,1.008d-5
     x ,9.697d-6,9.339d-6,9.001d-6,8.682d-6,8.380d-6,8.094d-6,7.824d-6
     x ,7.567d-6,7.324d-6,7.093d-6,6.873d-6,6.664d-6,6.465d-6,6.276d-6
     x ,6.096d-6,5.924d-6,5.759d-6,5.602d-6,5.452d-6,5.308d-6,5.170d-6
     x ,5.038d-6,4.912d-6,4.790d-6,4.673d-6,4.561d-6,4.453d-6,4.349d-6
     x ,4.248d-6,4.152d-6,4.058d-6,3.968d-6,3.881d-6,3.797d-6,3.716d-6
     x ,3.637d-6,3.561d-6/
      DATA one/1.d0/
      IF (h.LT.f(1)) GO TO 901
      IF (h.GE.f(2)) GO TO 100
      hh=(h-f(1))/g(1)
      ih=hh+1
      fact=dmod(hh,one)
      GO TO 500
  100 CONTINUE
      IF (h.GE.f(3)) GO TO 200
      hh=(h-f(2))/g(2)
      ih=hh+n(1)+1
      fact=dmod(hh,one)
      GO TO 500
  200 CONTINUE
      IF (h.GE.f(4)) GO TO 300
      hh=(h-f(3))/g(3)
      ih=hh+n(2)+1
      fact=dmod(hh,one)
      GO TO 500
  300 CONTINUE
      IF (h.GT.f(5)) GO TO 902
      hh=(h-f(4))/g(4)
      ih=hh+n(3)+1
      fact=dmod(hh,one)
      GO TO 500
  500 CONTINUE
      dens=t(ih)+(t(ih+1)-t(ih))*fact
      RETURN
  901 CONTINUE
C
C *** DENSITY BELOW TABLE, SET EQUAL AT 86 KM
C
      dens=t(1)
      RETURN
  902 CONTINUE
C
C *** DENSITY ABOVE TABLE, SET TO ZERO
C
      dens=zero
      RETURN
      END