source: trunk/LMDZ.MARS/libf/phymars/tcrco2_subrut.F @ 455

Last change on this file since 455 was 414, checked in by aslmd, 14 years ago

LMDZ.MARS : NEW NLTE MODEL FROM GRANADA AMIGOS

23/11/11 == FGG + MALV

New parameterization of the NLTE 15 micron cooling. The old parameterization is kept as an option, including or not variable atomic oxygen concentration. A new flag is introduced in callphys.def, nltemodel, to select which parameterization wants to be used (new one, old one with variable [O], or old one with fixed [O], see below). Includes many new subroutines and commons in phymars. Some existing routines are also modified:

-physiq.F. Call to the new subroutine NLTE_leedat in first call. Call to nltecool modified to allow for variable atomic oxygen. Depending on the value of nltemodel, the new subroutine NLTEdlvr09_TCOOL is called instead of nltecool.

-inifis.F. Reading of nltemodel is added.

-callkeys.h Declaration of nltemodel is added.

The following lines should be added to callphys.def (ideally after setting callnlte):

# NLTE 15um scheme to use.
# 0-> Old scheme, static oxygen
# 1-> Old scheme, dynamic oxygen
# 2-> New scheme
nltemodel = 2

A new directory, NLTEDAT, has to be included in datagcm.

Improvements into NLTE NIR heating parameterization to take into account variability with O/CO2 ratio and SZA. A new subroutine, NIR_leedat.F, and a new common, NIRdata.h, are included. A new flag, nircorr, is added in callphys.def, to include or not these corrections. The following files are modified:

-nirco2abs.F: nq and pq are added in the arguments. The corrections factors are interpolated to the GCM grid and included in the clculation. A new subroutine, interpnir, is added at the end of the file.

-physiq.F: Call to NIR_leedat added at first call. Modified call to nirco2abs

-inifis: Reading new flag nircorr.

-callkeys.h: Declaration of nircorr.

The following lines have to be added to callphys.def (ideally after callnirco2):

# NIR NLTE correction for variable SZA and O/CO2?
# matters only if callnirco2=T
# 0-> no correction
# 1-> include correction
nircorr=1

A new data file, NIRcorrection_feb2011.dat, has to be included in datagcm.

Small changes to the molecular diffusion scheme to fix the number of species considered, to avoid problems when compiling with more than 15 tracers (for example, when CH4 is included). Modified subroutines: aeronomars/moldiff.F and aeronomars/moldiffcoeff.F
File size: 7.7 KB
RevLine 
[414]1c***********************************************************************
2c       tcrco2_subrut.f                             
3c                                               
4c       jan 98  malv    version for mz1d. copied from solar10/mz4sub.f         
5c       jul 2011 malv+fgg   adapted to LMD-MGCM
6c***********************************************************************
7                                               
8************************************************************************
9                                               
10        subroutine dinterconnection ( v, vt )         
11                                               
12*  input: vib. temp. from che*.for programs, vt(nl)         
13*  output: test vibrational temp. for other che*.for, v(nl)
14! iconex_smooth=1  ==>  with smoothing         
15! iconex_smooth=0  ==>  without smoothing       
16! iconex_tk=40  ==>  with forced lte up to 40 km           
17! iconex_tk=20  ==>  with forced lte up to 20 km           
18************************************************************************
19                                               
20        implicit none                           
21        include 'nltedefs.h'         
22                                               
23c argumentos                                   
24        real*8 vt(nl), v(nl)                           
25                                               
26c local variables                               
27        integer         i                                     
28                                               
29c   *************                               
30                                               
31        do i=1,nl                                     
32          v(i) = vt(i)                                 
33        end do                                         
34                                               
35! lo siguiente se utilizaba en solar10, pero es mejor introducirlo en   
36! la driver. por ahora no lo uso todavia.       
37!       call fluctua(v,iconex_fluctua)               
38!       call smooth_nl(v,iconex_smooth,nl)               
39!       call forzar_tk(v,iconex_tk)                   
40                                               
41        return                                         
42        end                 
43                                               
44c***********************************************************************
45        subroutine smooth_nl(y,nlx,nl)
46                                               
47c       returns smoothed y                           
48c***********************************************************************
49                                               
50        implicit none                           
51                                               
52c arguments                         
53        integer         nl      ! Dimension of vectors
54        integer         nlx     ! i. =0 ==> no smoothing         
55                                !    =m ==> smoothing from point m up to nl
56        real*8          y(nl)   ! o. is returned after smoothed 
57                                               
58c local variables and constants                 
59        integer         i  , nlmax   
60        parameter ( nlmax=250 )         ! Llevarse esto al mz1d.par !
61        real*8          x(nlmax)                                 
62                                               
63c   ***************                             
64                                               
65        if (nlx.eq.0) return                         
66                                               
67        do i=nlx,nl                                   
68          x(i)=y(i)                                   
69          y(i)=0.                                     
70        end do                                         
71                                               
72        do i=nlx,nl                                   
73          if(i.eq.nlx)then                             
74                 y(i)=x(i)                                   
75          elseif(i.eq.nl)then                         
76                 y(i)=2.*y(i-1)-y(i-2)                       
77          else                                         
78                 y(i)=(x(i+1)/2.+x(i)+x(i-1)/2.)/2.           
79          end if                                       
80        end do                                         
81                                               
82        return                                         
83        end                                           
84                                               
85c***********************************************************************
86        function planckdp(tp,xnu)                     
87c       returns the black body function at wavenumber xnu and temperature t. 
88c***********************************************************************
89                                               
90        implicit none                                 
91
92        include 'nltedefs.h'
93        include 'nlte_data.h'     
94!        common/datis/ pi, vlight, ee, hplanck, gamma, ab,
95!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg
96!        real*8  pi, vlight, ee, hplanck, gamma, ab,
97!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg
98
99        real*8 planckdp                               
100        real*8 xnu                                     
101        real tp                                       
102                                               
103        planckdp = gamma*xnu**3.0 / exp( ee*xnu/dble(tp) )             
104        !erg cm-2.sr-1/cm-1.                           
105                                               
106        return                                         
107        end                                           
108c***********************************************************************
109        function planckdpdp(tp,xnu)                     
110c       returns the black body function at wavenumber xnu and temperature t. 
111c***********************************************************************
112                                               
113        implicit none                                 
114
115        include 'nltedefs.h'
116        include 'nlte_data.h'     
117!        common/datis/ pi, vlight, ee, hplanck, gamma, ab,
118!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg
119!        real*8  pi, vlight, ee, hplanck, gamma, ab,
120!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg
121
122        real*8 planckdpdp                               
123        real*8 xnu                                     
124        real*8 tp                                       
125                                               
126        planckdpdp = gamma*xnu**3.0 / exp( ee*xnu/dble(tp) )             
127        !erg cm-2.sr-1/cm-1.                           
128                                               
129        return                                         
130        end                                           
131c       ****************************************************************
132        function bandid (ib)                           
133c       returns the 2 character code of the band           
134c       ****************************************************************
135        implicit none                           
136                                               
137        integer ib                             
138        character*2 bandid                     
139                                               
140132     format(i2)                             
141!        encode (2,132,bandid) ib               
142        write ( bandid, 132) ib               
143                                               
144        if ( ib .eq. 1 ) bandid = '01'         
145        if ( ib .eq. 2 ) bandid = '02'         
146        if ( ib .eq. 3 ) bandid = '03'         
147        if ( ib .eq. 4 ) bandid = '04'         
148        if ( ib .eq. 5 ) bandid = '05'         
149        if ( ib .eq. 6 ) bandid = '06'         
150        if ( ib .eq. 7 ) bandid = '07'         
151        if ( ib .eq. 8 ) bandid = '08'         
152        if ( ib .eq. 9 ) bandid = '09'         
153        if ( ib .eq. 0 ) bandid = '00'         
154                                               
155c end                                           
156        return                                 
157        end                                     
Note: See TracBrowser for help on using the repository browser.