source: trunk/LMDZ.TITAN.old/libf/phytitan/setspv.F @ 3094

Last change on this file since 3094 was 3, checked in by slebonnois, 14 years ago

Creation de repertoires:

  • chantiers : pour communiquer sur nos projets de modifs
  • documentation : pour stocker les docs

Ajout de:

  • libf/phytitan : physique de Titan
  • libf/chimtitan: chimie de Titan
  • libf/phyvenus : physique de Venus
File size: 5.3 KB
Line 
1      SUBROUTINE SETSPV(IPRINT)
2      INTEGER    NSPECV,NSPC1V
3      PARAMETER (NSPECV=24,NSPC1V=25)
4      REAL    BWNV(NSPC1V),WNOV(NSPECV),DWNV(NSPECV)
5      REAL    WLNV(NSPECV)
6      INTEGER NTERM(NSPECV)
7      REAL    SOLARF(NSPECV),PEXPON(NSPECV)
8      REAL    ATERM(4,NSPECV),BTERM(4,NSPECV)
9
10      COMMON /SPECTV/ BWNV,WNOV,DWNV,WLNV
11      COMMON /VISGAS/SOLARF,NTERM,PEXPON,ATERM,BTERM
12
13      DATA WLNV/
14     &       0.325,    0.375,    0.425,    0.475,    0.525,    0.575,
15     &       0.640,    0.715,    0.789,    0.850,    0.891,    0.935,
16     &       0.998,    1.073,    1.144,    1.213,    1.292,    1.381,
17     &       1.484,    1.603,    1.742,    1.909,    2.111,    2.361/
18      data solarf/
19     &     525.430,  680.440, 1051.900, 1173.300, 1082.000, 1056.500,
20     &    1495.100, 1123.100, 1053.200,  541.820,  397.630,  484.210,
21     &     624.540,  528.390,  383.250,  372.260,  360.090,  339.230,
22     &     315.600,  292.580,  267.600,  239.700,  208.040,  180.550/
23      data NTERM/1,1,4,4,4,3,4,4,3,4,3,3,3,4,4,3,3,4,3,4,4,3,4,4/
24      data pexpon/
25     &       0.000,    0.000,    0.000,    0.000,    0.000,    0.000,
26     &       0.000,    0.000,    0.000,    0.149,    0.156,    0.186,
27     &       0.302,    0.097,    1.150,    1.040,    1.030,    1.040,
28     &       1.080,    1.070,    1.090,    1.050,    1.050,    0.959/
29      data ATERM/
30     &    1.000000, 0.000000, 0.000000, 0.000000, 1.000000, 0.000000,
31     &    0.000000, 0.000000, 0.700000, 0.093900, 0.015000, 0.191100,
32     &    0.300030, 0.135014, 0.460546, 0.104410, 0.164416, 0.375038,
33     &    0.295630, 0.164917, 0.444755, 0.355864, 0.199380, 0.000000,
34     &    0.198120, 0.331633, 0.335834, 0.134413, 0.327300, 0.335500,
35     &    0.146800, 0.190400, 0.277055, 0.333367, 0.389578, 0.000000,
36     &    0.126666, 0.416016, 0.364590, 0.092728, 0.286216, 0.492476,
37     &    0.221308, 0.000000, 0.445402, 0.453717, 0.100882, 0.000000,
38     &    0.351017, 0.371854, 0.277129, 0.000000, 0.434400, 0.477200,
39     &    0.077600, 0.010800, 0.292343, 0.374023, 0.242032, 0.091602,
40     &    0.501604, 0.385625, 0.112771, 0.000000, 0.597075, 0.308155,
41     &    0.094771, 0.000000, 0.116916, 0.447207, 0.338013, 0.097864,
42     &    0.541475, 0.367862, 0.090663, 0.000000, 0.468164, 0.212875,
43     &    0.213276, 0.105685, 0.245440, 0.416617, 0.242734, 0.095209,
44     &    0.330423, 0.503512, 0.166065, 0.000000, 0.307538, 0.361097,
45     &    0.232456, 0.098909, 0.115609, 0.353355, 0.413319, 0.117718/
46      data BTERM/
47     &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,
48     &0.0000E+00,0.0000E+00,0.0000E+00,7.8260E-04,2.3210E-03,5.5120E-03,
49     &0.0000E+00,9.4390E-04,4.5750E-03,4.2690E-02,1.9500E-04,2.5340E-03,
50     &1.5020E-02,8.9550E-02,2.5430E-03,1.5420E-02,3.1900E-02,0.0000E+00,
51     &7.1740E-03,2.6010E-02,9.7160E-02,4.4030E-01,4.4550E-02,1.8750E-01,
52     &7.9000E-01,2.8660E+00,5.6920E-02,1.9440E-01,7.9630E-01,0.0000E+00,
53     &3.1190E-02,4.9600E-01,2.2970E+00,2.8660E+01,1.2740E+00,1.4250E+01,
54     &1.4070E+02,0.0000E+00,9.4170E-02,6.1850E-01,6.9190E+00,0.0000E+00,
55     &1.8690E+00,1.2560E+01,1.4730E+02,0.0000E+00,1.3600E-01,9.3830E-01,
56     &4.2070E+00,1.4080E+02,6.1300E-02,1.3220E+00,2.2710E+01,8.5640E+02,
57     &0.0000E+00,6.0630E-01,3.9880E+01,0.0000E+00,0.0000E+00,6.0850E-01,
58     &4.5140E+01,0.0000E+00,2.7190E-01,1.9420E+00,3.1990E+01,1.5370E+03,
59     &0.0000E+00,5.8440E-01,5.0650E+01,0.0000E+00,6.2920E-03,7.8350E-01,
60     &3.5630E+01,1.2870E+03,1.7680E+00,3.0850E+01,4.6500E+02,1.3940E+04,
61     &0.0000E+00,6.6970E-01,4.6030E+01,0.0000E+00,0.0000E+00,7.3460E-01,
62     &3.9680E+01,3.1920E+03,9.5930E+00,3.7750E+02,5.1130E+03,2.7940E+05/
63C ******
64C SET UP SPECRAL INTERVALS THESE ARE BASED ON KATHY RAGES PROGRAM
65C CONVERT PER KM-AMAGATS TO PER GM CM-3 (SEE NOTES FOR CONSTANT)
66C&&
67       FUV=2.5
68c       fuv=1.
69C&&
70       SOLARF(1) = FUV*SOLARF(1)
71C&&
72       SOLARF(2) = FUV*SOLARF(2)
73C
74      DO 101 K=1,NSPECV
75      DO 102 NT=1,4
76      BTERM(NT,K)=BTERM(NT,K)/(1.E5 * 16./22.4E3)
77102   CONTINUE
78101   CONTINUE
79C
80C SET UP MEAN WAVENUMBERS AND DELTAS
81C UNITS ON WAVENUMBER ARE CM-1
82C UNITS ON WAVELN ARE MICRONS
83      BWNV(1)=1.E4/.3
84      DO 100 K=2,NSPC1V
85      BWLN=1.E4/BWNV(K-1)
86      EWLN=2.*WLNV(K-1)-BWLN
87      BWNV(K)=1.E4/EWLN
88 100  CONTINUE
89      DO 160 K=1,NSPECV
90      WNOV(K)=1.E4/WLNV(K)
91      DWNV(K)=BWNV(K)-BWNV(K+1)
92  160 CONTINUE
93C IF THERE IS ONLY ONE SPECTRAL INTERVAL THEN TOTAL E IS USED AND
94      IF (NSPECV .EQ. 1) DWNV(1) =1.0
95C PRINT OUT SPECTRAL INTERVALS
96      IF (IPRINT .GT. 1) THEN
97          WRITE (6,190)
98          DO 200 K=1,NSPECV
99          WRITE (6,210)K,WLNV(K),WNOV(K),BWNV(K)
100     &    ,BWNV(K)+DWNV(K),DWNV(K)
101  200     CONTINUE
102      WRITE(6,320)
103 320  FORMAT (///' J   WAVELN   SOLAR FLUX  N   NP      [',
104     & 16X,'A TERMS',14X,'] [',16X,'B   TERMS',14X,']'/)
105      DO 300 J=1,24
106      K=1
107      SUM=ATERM(K,J)+ATERM(K+1,J)+ATERM(K+2,J)+ATERM(K+3,J)
108      WRITE(6,20)J,WLNV(J),SOLARF(J),NTERM(J),PEXPON(J)
109     &,(ATERM(K,J),K=1,4),(BTERM(K,J),K=1,4)
110 300  CONTINUE
111c20   FORMAT(1X,I2,F7.4,1PE14.5,0PI2,F6.3,3X,1P8E10.3)
112 20   FORMAT(1X,I2,F7.4,1PE14.5,I2,F6.3,3X,1P8E10.3)
113      END IF
114  210 FORMAT(1X,I3,F10.3,F10.2,F10.2,'-',F8.2,F10.3)
115  190 FORMAT(///'  SPECTRAL INTERVALS'//
116     &       ' SNUM  MICRONS   WAVENU      INTERVAL',11X,'DELTA-WN')
117C ****** END SPECTRAL INTERVAL SET UP *************
118      RETURN
119      END
Note: See TracBrowser for help on using the repository browser.