1 | include(dom.inc)
2 |
3 | PROGRAM tabfsk
4 |
5 | ! ================================================================!
6 | ! !
7 | ! tabfsk : Produce database for FSK !
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, model, nb_base
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 :: Tp
26 | DOM_REAL, DIMENSION(14,n_SNBmax) :: KCO,DCO,KC,DC,KH,DH
27 | DOM_REAL, DIMENSION(n_SNBmax) :: nu, delta_nu
28 | DOM_REAL,ALLOCATABLE,DIMENSION(:,:) :: celldata,kabsmel,WSGG_W
29 | DOM_REAL,ALLOCATABLE,DIMENSION(:,:,:,:,:) :: kabs_all, WSGG_W_all
30 | DOM_REAL,ALLOCATABLE,DIMENSION(:) :: wquad,Lb
31 | DOM_REAL :: t_start,t_stop,time
32 |
33 | DOM_REAL, DIMENSION(8) :: dataref
34 |
35 | call CPU_TIME(t_start)
36 |
37 | ! ----------------!
38 | ! READ PARAMETERS !
39 | ! ----------------!
40 |
41 | dataref = 0.d0
42 |
43 | OPEN(1,FILE='tabfsk.choices')
44 | READ(1,*) model
45 | READ(1,*) nb_base
46 | READ(1,*) pathspec
47 | READ(1,*) namefile
48 | READ(1,*) nquad
49 | READ(1,*)
50 | READ(1,*) Tp
51 | READ(1,*) P
52 | READ(1,*) dataref(1)
53 | READ(1,*) dataref(3)
54 | READ(1,*) dataref(4)
55 | READ(1,*) dataref(5)
56 | READ(1,*) dataref(6)
57 | READ(1,*) dataref(7)
58 | READ(1,*)
59 | READ(1,*) DT
60 | READ(1,*) DYH
61 | READ(1,*) DYC
62 | READ(1,*) DYCO
63 | READ(1,*) mh2o
64 | READ(1,*) mco2
65 | READ(1,*) mco
66 |
67 | homosyst ='NO'
68 | nbands = 1
69 | ngbands = 371
70 |
71 | outfile = pathspec(1:len_trim(pathspec))//'/'//namefile
72 |
73 | ! -----------------!
74 | ! ALLOCATE VECTORS !
75 | ! -----------------!
76 |
77 | nT=INT((2900-300)/DT)+1
78 | nYh=INT((mh2o-0.0)/DYH)+1
79 | nYc=INT((mco2-0.0)/DYC)+1
80 | nYco=INT((mco-0.0)/DYCO)+1
81 |
82 | i_compt = nYh*nYc*nYco*nT
83 |
84 | ALLOCATE(celldata(1,8))
85 | ALLOCATE(kabsmel(1,nquad))
86 | ALLOCATE(kabs_all(nYh,nYc,nYco,nT,nquad))
87 | ALLOCATE(wquad(nquad))
88 | ALLOCATE(Lb(1))
89 |
90 | ! ------------------!
91 | ! READ GLOBAL DATAS !
92 | ! ------------------!
93 |
94 | snbfile = pathspec (1:len_trim(pathspec))//'/SNBWN'
95 | OPEN(2,FILE=snbfile,FORM='FORMATTED')
96 | DO i_bande=1,n_SNBmax
97 | READ(2,*) nu(i_bande),delta_nu(i_bande)
98 | ENDDO
99 |
100 | nb_base='SNB'
101 |
102 | CALL PARAM(KCO,KC,KH,DCO,DC,DH,pathspec,n_SNBmax,nb_base)
103 |
104 | celldata = 0.0
105 | celldata(:,2) = P
106 | dataref(2) = P
107 |
108 | PRINT*, " ->> Tabulation for ", trim(model), " model"
109 |
110 | IF (model.eq.'FSCK') THEN
111 | ALLOCATE(WSGG_W(1,nquad))
112 | ALLOCATE(WSGG_W_all(nYh,nYc,nYco,nT,nquad))
113 |
114 | PRINT*, " DATA_REF : T = ",dataref(1)
115 | PRINT*, " P = ",dataref(2)
116 | PRINT*, " XH2O = ",dataref(3)
117 | PRINT*, " XCO2 = ", dataref(4)
118 | PRINT*, " XCO = ", dataref(5)
119 | PRINT*
120 |
121 | ENDIF
122 |
123 | OPEN(12,FILE=outfile,FORM='FORMATTED')
124 | WRITE(12,*) nquad
125 | WRITE(12,*) DT
126 | WRITE(12,*) DYH, mh2o
127 | WRITE(12,*) DYC, mco2
128 | WRITE(12,*) DYCO, mco
129 |
130 |
131 | i_comp = 0
132 | DO i=1,nYh !YH2O
133 | DO j=1,nYc!YCO2
134 | DO k=1,nYco!YCO
135 |
136 | DO iT=1,nT
137 | celldata(1,1) = 300 + (iT-1)*DT
138 | celldata(1,3) = 0 + (i-1)*DYH
139 | celldata(1,4) = 0 + (j-1)*DYC
140 | celldata(1,5) = 0 + (k-1)*DYCO
141 |
142 | Lb(1)= planck(celldata(1,1))
143 |
144 | IF((celldata(1,3) + celldata(1,4) + celldata(1,5)).le.1) &
145 | & THEN
146 | IF(model.eq.'FSK') THEN
147 | call FSK_CASE(kabsmel, wquad, Lb, celldata,1,nu, &
148 | & delta_nu,KCO,DCO,KC,DC,KH,DH,homosyst, &
149 | & ngbands, n_SNBmax, nquad)
150 | ELSEIF(model.eq.'FSCK') THEN
151 | call FSCK_CASE(kabsmel, wquad, celldata, 1, nu, &
152 | & delta_nu, KCO, DCO, KC, DC, KH, DH, &
153 | & ngbands, n_SNBmax, nquad, dataref, &
154 | & WSGG_W, homosyst, Tp)
155 | WSGG_W_all(i,j,k,iT,:) = WSGG_W(1,:)
156 | kabs_all(i,j,k,iT,:) = kabsmel(1,:)
157 | ELSE
158 | PRINT*,"Unknown spectral model"
159 | EXIT
160 | ENDIF
161 | kabs_all(i,j,k,iT,:) = kabsmel(1,:)
162 |
163 | ELSE
164 | kabs_all(i,j,k,iT,:) = 0.d0
165 | IF(model.eq.'FSCK') WSGG_W_all(i,j,k,iT,:) = 0.d0
166 | ENDIF
167 |
168 | WRITE(12,*) (kabs_all(i,j,k,iT,iq),iq=1,nquad)
169 | i_comp = i_comp + 1
170 | IF (MOD(i_comp,100).eq.0) PRINT*, i_comp,'/',i_compt
171 | ENDDO
172 |
173 | ENDDO
174 | ENDDO
175 | ENDDO
176 |
177 | IF(model.eq.'FSCK') WRITE(12,*) (dataref(iq),iq=1,8)
178 |
179 | CLOSE(12)
180 |
181 | call CPU_TIME(t_stop)
182 | time = t_stop - t_start
183 |
184 | PRINT*, 'Tabulation created in file :', outfile
185 | PRINT*, 'Time caclucation :', time
186 |
187 | END PROGRAM tabfsk
188 |
tabfsk.F could be called by: