1 | include(dom.inc)
2 |
3 | PROGRAM tabfsck
4 |
5 | ! ================================================================!
6 | ! !
7 | ! tabfsck : Produce database for FSCK !
8 | ! Author : Damien Poitou (July 2008) !
9 | ! !
10 | ! ================================================================!
11 |
12 | IMPLICIT NONE
13 |
14 | include 'dom_constants.h'
15 |
16 | CHARACTER*80 :: pathspec,snbfile
17 | CHARACTER*80 :: homosyst,outfile
18 | CHARACTER*80 :: namefile
19 | DOM_INT :: nT,iT,nquad,i,j,k,iq
20 | DOM_INT :: nYh,nYc,nYco
21 | DOM_INT :: i_comp,i_compt
22 | DOM_INT :: nbands,ngbands,i_bande
23 | DOM_REAL :: planck,mh2o,mco2,mco
24 | DOM_REAL :: DT,DYH,DYC,DYCO,P
25 | DOM_REAL, DIMENSION(14,n_SNBmax) :: KCO,DCO,KC,DC,KH,DH
26 | DOM_REAL, DIMENSION(n_SNBmax) :: nu, delta_nu
27 | DOM_REAL,ALLOCATABLE,DIMENSION(:,:) :: celldata,kabsmel
28 | DOM_REAL,ALLOCATABLE,DIMENSION(:,:,:,:,:) :: kabs_all
29 | DOM_REAL,ALLOCATABLE,DIMENSION(:) :: wquad,Lb
30 | DOM_REAL :: t_start,t_stop,time
31 |
32 | call CPU_TIME(t_start)
33 |
34 | ! ----------------!
35 | ! READ PARAMETERS !
36 | ! ----------------!
37 |
38 | OPEN(1,FILE='tabfsck.choices')
39 | READ(1,*) pathspec
40 | READ(1,*) namefile
41 | READ(1,*) P
42 | READ(1,*) nquad
43 | READ(1,*) DT
44 | READ(1,*) DYH
45 | READ(1,*) DYC
46 | READ(1,*) DYCO
47 | READ(1,*) mh2o
48 | READ(1,*) mco2
49 | READ(1,*) mco
50 |
51 | homosyst ='NO'
52 | nbands = 1
53 | ngbands = 371
54 |
55 | outfile = pathspec(1:len_trim(pathspec))//'/'//namefile
56 |
57 | ! -----------------!
58 | ! ALLOCATE VECTORS !
59 | ! -----------------!
60 |
61 | nT=INT((2900-300)/DT)+1
62 | nYh=INT((mh2o-0.0)/DYH)+1
63 | nYc=INT((mco2-0.0)/DYC)+1
64 | nYco=INT((mco-0.0)/DYCO)+1
65 |
66 | i_compt = nYh*nYc*nYco*nT
67 |
68 | ALLOCATE(celldata(1,8))
69 | ALLOCATE(kabsmel(1,nquad))
70 | ALLOCATE(kabs_all(nYh,nYc,nYco,nT,nquad))
71 | ALLOCATE(wquad(nquad))
72 | ALLOCATE(Lb(1))
73 |
74 | ! ------------------!
75 | ! READ GLOBAL DATAS !
76 | ! ------------------!
77 |
78 | snbfile = pathspec (1:len_trim(pathspec))//'/SNBWN'
79 | OPEN(2,FILE=snbfile,FORM='FORMATTED')
80 | DO i_bande=1,n_SNBmax
81 | READ(2,*) nu(i_bande),delta_nu(i_bande)
82 | ENDDO
83 |
84 | CALL PARAM(KCO,KC,KH,DCO,DC,DH,pathspec,n_SNBmax)
85 |
86 | PRINT*, "param ok"
87 | celldata = 0.0
88 | celldata(:,2) = P
89 |
90 | OPEN(12,FILE=outfile,FORM='FORMATTED')
91 | WRITE(12,*) nquad
92 | WRITE(12,*) DT
93 | WRITE(12,*) DYH, mh2o
94 | WRITE(12,*) DYC, mco2
95 | WRITE(12,*) DYCO, mco
96 |
97 |
98 | i_comp = 0
99 | DO i=1,nYh !YH2O
100 | DO j=1,nYc!YCO2
101 | DO k=1,nYco!YCO
102 |
103 | DO iT=1,nT
104 | celldata(1,1) = 300 + (iT-1)*DT
105 | celldata(1,3) = 0 + (i-1)*DYH
106 | celldata(1,4) = 0 + (j-1)*DYC
107 | celldata(1,5) = 0 + (k-1)*DYCO
108 |
109 | Lb(1)= planck(celldata(1,1))
110 |
111 | IF((celldata(1,3) + celldata(1,4) + celldata(1,5)).le.1) &
112 | & THEN
113 | call FSCK_CASE(kabsmel, wquad, Lb, celldata,1,nu, &
114 | & delta_nu,KCO,DCO,KC,DC,KH,DH,homosyst, &
115 | & ngbands, n_SNBmax, nquad)
116 | kabs_all(i,j,k,iT,:) = kabsmel(1,:)
117 | ELSE
118 | kabs_all(i,j,k,iT,:) = 0.d0
119 | ENDIF
120 |
121 | WRITE(12,*) (kabs_all(i,j,k,iT,iq),iq=1,nquad)
122 | i_comp = i_comp + 1
123 | PRINT*, i_comp,'/',i_compt
124 | ENDDO
125 |
126 | ENDDO
127 | ENDDO
128 | ENDDO
129 |
130 | CLOSE(12)
131 |
132 | call CPU_TIME(t_stop)
133 | time = t_stop - t_start
134 |
135 | PRINT*, 'Tabulation created in file :', outfile
136 | PRINT*, 'Time caclucation :', time
137 |
138 | END PROGRAM tabfsck
139 |