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

Last change on this file since 3493 was 3018, checked in by emillour, 18 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
RevLine 
[3018]1!      MODULE nlte_setup_mod
2     
3!      USE nlte_aux_mod
4     
5!      IMPLICIT NONE
6     
7!      CONTAINS
[757]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
[1918]26      use datafile_mod, only: datadir
[2606]27      USE mod_phys_lmdz_para, ONLY: is_master
28      USE mod_phys_lmdz_transfert_para, ONLY: bcast
[3018]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
[757]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
[2606]59      if(is_master) then
60
[757]61      do k=1,nisot
62         write (isotcode,132) indexisot(k)
63         open (lun1,
[1918]64     $        file=trim(datadir)//'/NLTEDAT/enelow'
[757]65     $        //isotcode//'.dat',status='old')
66         open (lun2,
[1918]67     $        file=trim(datadir)//'/NLTEDAT/deltanu'
[757]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
[2606]77      endif !      if(is_master)
78
79      call bcast(elow)
80      call bcast(deltanu)
81
[757]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
[2606]91      if(is_master) then
92
[1918]93      open( 11, file=trim(datadir)//
[757]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
[1918]102      open( 12, file=trim(datadir)//
[757]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)
[2606]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
[757]123      xx=xx
124
125
126
127      call LeeHISTOGRMS
128
[3018]129      end subroutine nlte_setup
[757]130
131
132
133c***********************************************************************
134      subroutine LeeHISTOGRMS
135c***********************************************************************
136
[1918]137      use datafile_mod, only: datadir
[3018]138      use nlte_commons_h, only: hisfile
[757]139      implicit none
140
141c     local variables and constants
142      integer   ihist
143
144
145c***********************************************************************
146
147                                ! Banda fundamental
148                                !
[1918]149      hisfile = trim(datadir)//
[757]150     $     '/NLTEDAT/hid26-1.dat'
151      ihist = 1
152      call rhist_03 (ihist)
153
154
155                                ! First Hot bands       
156                                !     
[1918]157      hisfile = trim(datadir)//
[757]158     $     '/NLTEDAT/hid26-2.dat'
159      ihist = 2
160      call rhist_03 (ihist)
161
[1918]162      hisfile = trim(datadir)//
[757]163     $     '/NLTEDAT/hid26-3.dat'
164      ihist = 3
165      call rhist_03 (ihist)
166
[1918]167      hisfile = trim(datadir)//
[757]168     $     '/NLTEDAT/hid26-4.dat'
169      ihist = 4
170      call rhist_03 (ihist)
171
172
173
[3018]174      end subroutine LeeHISTOGRMS
[757]175
176
177c     *** Old GETK_dlvr11.f ***
178
179c***********************************************************************
180
181      subroutine GETK_dlvr11 (tt)
182
183c***********************************************************************
[3018]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
[757]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
[3018]299      end subroutine GETK_dlvr11
[757]300
301
[3018]302!      END MODULE nlte_setup_mod
[757]303
304
305
306
307
Note: See TracBrowser for help on using the repository browser.