source: trunk/LMDZ.MARS/libf/phymars/nlte_setup.F @ 2740

Last change on this file since 2740 was 2606, checked in by romain.vande, 3 years ago

LMDZ_MARS RV : Open_MP; Reading files in parallel for nlte parametrisation
(callnlte = .true.)
File size: 7.2 KB
Line 
1c***********************************************************************
2
3      subroutine nlte_setup
4
5c     malv    Oct 09          Adapt mz1d_onlyTCR_MUCHASveces.f to "V09"
6c     malv    Sep 07          Add LU deccomp & repetition option to test CPU
7c     malv    Jan 07          Add new vertical fine-grid for NLTE
8c     apr 06  malv            Read date,effuv from Driver. T fixed at zbott.
9c     2003    fgg             Double precission in UV, Photoq, Conduct & Diff
10c     oct 02  malv            V02: New scheme to allow for continuity eq.
11c     dec 01  malv            See changes/progress of the code in mz1d.actual
12c     nov 01  malv            adapt for parameterizations of tcr y shr
13c     nov 98  malv            add chemical & photochem. processes
14c     jul 98  malv            transic hiperb con zs fuera de la region
15c     equil hidrostatico. smoothing en cr y sh
16c     jan 98    malv            first version
17c***********************************************************************
18
19      use datafile_mod, only: datadir
20      USE mod_phys_lmdz_para, ONLY: is_master
21      USE mod_phys_lmdz_transfert_para, ONLY: bcast
22     
23      implicit none
24
25      include   'nlte_paramdef.h'
26      include   'nlte_commons.h'
27
28
29c***************
30
31c     local variables
32
33      integer   i, k, lun1, lun2
34      real*8          xx
35      character isotcode*2
36
37
38c     formats
39 132  format (i2)
40
41c**********************************************************************
42
43c     *** Groups old 1-d model subroutines SETTINGS and LeeESCTVCISO_dlvr11
44c     *** Both were called in old NLTEdlvr11_SETUP ***
45
46c     *** Old SETTINGS ***
47
48      lun1 = 1
49      lun2 = 2
50
51      if(is_master) then
52
53      do k=1,nisot
54         write (isotcode,132) indexisot(k)
55         open (lun1,
56     $        file=trim(datadir)//'/NLTEDAT/enelow'
57     $        //isotcode//'.dat',status='old')
58         open (lun2,
59     $        file=trim(datadir)//'/NLTEDAT/deltanu'
60     $        //isotcode//'.dat',status='old')
61         read (lun1,*)
62         read (lun2,*)
63         read (lun1,*) (elow(k,i), i=1,nb)
64         read (lun2,*) (deltanu(k,i), i=1,nb)
65         close (lun1)
66         close (lun2)
67      end do
68
69      endif !      if(is_master)
70
71      call bcast(elow)
72      call bcast(deltanu)
73
74      a1_010_000 = 1.3546d00
75      a2_010_000 = 1.3452d00
76      a3_010_000 = 1.1878d00
77      a4_010_000 = 1.2455d00
78      a1_020_010 = 4.35d0
79     
80
81c     *** Old LeeESCTVCISO_dlvr11 ***
82
83      if(is_master) then
84
85      open( 11, file=trim(datadir)//
86     $     '/NLTEDAT/parametp_Tstar_IAA1204.dat' )
87      read (11, *)
88      do i=1,nztabul
89         read (11,*) lnpnbtab(i), tstar11tab(i),
90     $        tstar21tab(i), tstar31tab(i), tstar41tab(i)
91      enddo
92      close (11)
93
94      open( 12, file=trim(datadir)//
95     $     '/NLTEDAT/parametp_VC_IAA1204.dat' )
96      read (12, *)
97      do i=1,nztabul
98         read (12,*) xx, vc210tab(i), vc310tab(i), vc410tab(i)
99      enddo
100      close (12)
101
102
103      endif !is_master
104
105      call bcast(lnpnbtab)
106      call bcast(tstar11tab)
107      call bcast(tstar21tab)
108      call bcast(tstar31tab)
109      call bcast(tstar41tab)
110      call bcast(xx)
111      call bcast(vc210tab)
112      call bcast(vc310tab)
113      call bcast(vc410tab)
114
115      xx=xx
116
117
118
119      call LeeHISTOGRMS
120
121c     end subroutine
122
123      return
124      end
125
126
127
128c***********************************************************************
129      subroutine LeeHISTOGRMS
130c***********************************************************************
131
132      use datafile_mod, only: datadir
133
134      implicit none
135
136      include   'nlte_paramdef.h'
137      include   'nlte_commons.h'
138
139
140c     local variables and constants
141      integer   ihist
142
143
144c***********************************************************************
145
146                                ! Banda fundamental
147                                !
148      hisfile = trim(datadir)//
149     $     '/NLTEDAT/hid26-1.dat'
150      ihist = 1
151      call rhist_03 (ihist)
152
153
154                                ! First Hot bands       
155                                !     
156      hisfile = trim(datadir)//
157     $     '/NLTEDAT/hid26-2.dat'
158      ihist = 2
159      call rhist_03 (ihist)
160
161      hisfile = trim(datadir)//
162     $     '/NLTEDAT/hid26-3.dat'
163      ihist = 3
164      call rhist_03 (ihist)
165
166      hisfile = trim(datadir)//
167     $     '/NLTEDAT/hid26-4.dat'
168      ihist = 4
169      call rhist_03 (ihist)
170
171
172
173
174      return
175      end
176
177
178c     *** Old GETK_dlvr11.f ***
179
180c***********************************************************************
181
182      subroutine GETK_dlvr11 (tt)
183
184c***********************************************************************
185
186      implicit none
187
188      include 'nlte_paramdef.h'
189      include 'nlte_commons.h'
190
191c     arguments
192      real              tt      ! i. temperature
193
194!     ! local variables:
195      real*8 k20x, k20xb, k20xc
196      real*8 k19xca,k19xcb,k19xcc
197      real*8 k19xba,k19xbb,k19xbc
198      real*8 k21x,k21xa,k21xb,k21xc
199      real*8 anu, factor , tdt
200      integer   i
201
202c***********************************************************************
203
204      tdt = dble(tt)
205
206                                !! k19 & k20
207
208      k20x = 3.d-12
209      k20xc = k20x * rf20
210      k20xb = 2.d0 * k20xc
211
212      k19xca = 4.2d-12 * exp( -2988.d0/tdt + 303930.d0/tdt**2.d0 )
213      if (tt.le.175.) k19xca = 3.3d-15
214      k19xcb = 2.1d-12 * exp( -2659.d0/tdt + 223052.d0/tdt**2.d0 )
215      if (tt.le.175.) k19xcb = 7.6d-16
216      k19xca = k19xca * rf19
217      k19xcb = k19xcb * rf19
218      k19xcc = k19xcb
219
220      factor = 2.5d0
221      k19xba = factor * k19xca
222      k19xbb = factor * k19xcb
223      k19xbc = factor * k19xcc
224
225      do i = 1, nisot
226
227         k19ba(i) = k19xba
228         k19ca(i) = k19xca
229         k19bb(i) = k19xbb
230         k19cb(i) = k19xcb
231         k19bc(i) = k19xbc
232         k19cc(i) = k19xcc
233
234         k20b(i) = k20xb
235         k20c(i) = k20xc
236
237         anu = dble( nu(i,2)-nu(i,1) )
238
239         k19bap(i) = k19ba(i) * 2.d0 * exp( -ee*anu/tdt )
240         k19bbp(i) = k19bb(i) * 2.d0 * exp( -ee*anu/tdt )
241         k19bcp(i) = k19bc(i) * 2.d0 * exp( -ee*anu/tdt )
242
243         k20bp(i) = k20b(i)*4.d0/2.d0 * exp( -ee/tdt * anu )
244
245         anu = dble( nu(i,1) )
246
247         k19cap(i) = k19ca(i) * 2.d0 * exp( -ee*anu/tdt )
248         k19cbp(i) = k19cb(i) * 2.d0 * exp( -ee*anu/tdt )
249         k19ccp(i) = k19cc(i) * 2.d0 * exp( -ee*anu/tdt )
250
251         k20cp(i) = k20c(i)*2.d0/1.d0 * exp( -ee/tdt * anu )
252
253      end do
254
255
256                                !! k21 &  k23k21c &  k24k21c & k34k21c
257
258      k21x = 2.49d-11
259      k21xb = k21x
260      k21xa = 3.d0/2.d0 * k21xb
261      k21xc = k21xb / 2.d0
262
263      k21xa = k21xa * rf21a
264      k21xb = k21xb * rf21b
265      k21xc = k21xc * rf21c
266
267      do i = 1, nisot
268         k21b(i) = k21xb
269         k21c(i) = k21xc
270         k21bp(i) = k21b(i) *
271     @        exp( -ee/tdt* dble(nu(i,2)-nu(i,1)-nu(1,1)) )
272         k21cp(i) = k21c(i) *
273     @        exp( -ee/tdt * dble(nu(i,1)-nu(1,1)) )
274      end do
275
276      k23k21c = k21xc
277      k24k21c = k21xc
278      k34k21c = k21xc
279      k23k21cp = k23k21c*2.d0/2.d0 *
280     @     exp( -ee/tdt* dble(nu(2,1)-nu(3,1)) )
281      k24k21cp = k24k21c*2.d0/2.d0 *
282     @     exp( -ee/tdt* dble(nu(2,1)-nu(4,1)) )
283      k34k21cp = k34k21c*2.d0/2.d0 *
284     @     exp( -ee/tdt* dble(nu(3,1)-nu(4,1)) )
285
286
287                                !! k33
288
289      k33c = k21x * rf33bc
290      do i=2,nisot
291         k33cp(i) = k33c *
292     @        exp( -ee/tdt * dble(nu(1,2)-nu(1,1)-nu(i,1)) )
293      end do
294
295
296      return
297      end
298
299
300
301
302
303
304
Note: See TracBrowser for help on using the repository browser.