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

Last change on this file since 3026 was 3018, checked in by emillour, 17 months ago

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