source: trunk/MESOSCALE/LMDZ.MARS/libf_gcm/aeronomars/inichim.F

Last change on this file was 57, checked in by aslmd, 14 years ago

mineur LMD_MM_MARS: ajout du GCM ancienne physique, systeme maintenant complet sur SVN (ne manque que la base de donnees d'etats initiaux)

File size: 8.7 KB
Line 
1      subroutine inichim(pq,sig)
2
3      implicit none
4
5c=======================================================================
6c
7c   subject:
8c   --------
9c
10c  Initialization of the composition for use in testphys1d.F
11c
12c   Author:   Sebastien Lebonnois (08/11/2002)
13c   -------
14c            update 12/06/2003
15c            update july 2003: Monica Angelats-i-Coll
16c
17c   Arguments:
18c   ----------
19c
20c    pq(ngridmx,nlayermx,nqmx)  Advected fields, ie chemical species here
21c    sig = sigma                vertical coordinate (interface of layers)
22c
23c=======================================================================
24
25c    Declarations :
26c    --------------
27
28#include "dimensions.h"
29#include "dimphys.h"
30#include "chimiedata.h"
31#include "tracer.h"
32#include "comcstfi.h"
33#include "callkeys.h"
34#include "datafile.h"
35
36c Arguments :
37c -----------
38
39      real    pq(ngridmx,nlayermx,nqmx)  ! chemical species mass mixing ratio
40      real    sig(llm+1)                 ! vertical coordinate (interface of layers)
41
42c Local variables :
43c -----------------
44
45      integer  ig,l,iq, n,i,j,iqmax
46      real     zy(ngridmx,nlayermx,nqmx) ! Composition in MOLE fractions
47      REAL qtot(ngridmx,nlayermx)
48      INTEGER aa(nqmx)  ! relation GCM<->files
49      real densconc,zgcm,zfile(252),vmrint,nt, mmean
50      real nxf(252),zfilemin(252),sigfile(252)
51      real vmrf(252,14),nf(252,14)
52      real tfile(252),zzfile(252)
53      real ni(14)       ! densities from files (interpolated for GCM)
54
55      real mmolf(14)    ! molecular mass in amu (species in files)
56      data mmolf/44.,40.,28.,32.,28.,16.,2.,   ! majors
57     .           1.,17.,33.,18.,34.,16.,48./   ! minors
58
59      character*3 tmp  ! temporary variable
60      integer ierr,lnblnk
61      external lnblnk
62
63
64c Dimension test:
65c ---------------
66
67       if (iceparty) then
68         if ((nqchem_min+ncomp+1).ne.nqmx) then
69            print*,'********* Dimension problem! ********'
70            print*,"nqchem_min+ncomp+1).ne.nqmx"
71            print*,"ncomp: ",ncomp
72            print*,"nqchem_min: ",nqchem_min
73            print*,"nqmx: ",nqmx
74            print*,'Change ncomp in chimiedata.h'
75            STOP
76         endif
77       else
78         if ((nqchem_min+ncomp).ne.nqmx) then
79            print*,'********* Dimension problem! ********'
80            print*,"nqchem_min+ncomp).ne.nqmx"
81            print*,"ncomp: ",ncomp
82            print*,"nqchem_min: ",nqchem_min
83            print*,"nqmx: ",nqmx
84            print*,'Change ncomp in chimiedata.h'
85            STOP
86         endif
87       endif
88
89c noms and mmol vectors:
90c ----------------------
91
92       if (iceparty) then
93          do iq=nqchem_min,nqmx-2
94            noms(iq) = nomchem(iq-nqchem_min+1)
95            mmol(iq) = mmolchem(iq-nqchem_min+1)
96          enddo
97          noms(nqmx-1) = 'ice'
98          mmol(nqmx-1) = 18.
99          noms(nqmx)   = 'h2o'
100          mmol(nqmx)   = 18.
101       else
102          do iq=nqchem_min,nqmx-1
103            noms(iq) = nomchem(iq-nqchem_min+1)
104            mmol(iq) = mmolchem(iq-nqchem_min+1)
105          enddo
106          noms(nqmx)   = 'h2o'
107          mmol(nqmx)   = 18.
108       endif
109       if (nqchem_min.gt.1) then
110          do iq=1,nqchem_min-1
111            noms(iq) = 'dust'
112            mmol(iq) = 100.
113          enddo
114       endif
115
116cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
117c     tracers numbering in the gcm
118cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
119c
120c     co2      =  nqchem_min
121c     co       =  nqchem_min + 1
122c     o        =  nqchem_min + 2
123c     o(1d)    =  nqchem_min + 3
124c     o2       =  nqchem_min + 4
125c     o3       =  nqchem_min + 5
126c     h        =  nqchem_min + 6
127c     h2       =  nqchem_min + 7
128c     oh       =  nqchem_min + 8
129c     ho2      =  nqchem_min + 9
130c     h2o2     =  nqchem_min + 10
131c     n2       =  nqchem_min + 11
132c     ar       =  nqchem_min + 12
133c     h2o      =  nqmx
134c
135c----------------------------------------------------------------------
136c Major species in files:
137c
138c       1=CO2
139c       2=AR
140c       3=N2
141c       4=O2
142c       5=CO
143c       6=O
144c       7=H2
145c
146c Minor species in files:
147c
148c       1=H
149c       2=OH
150c       3=HO2
151c       4=H2O
152c       5=H2O2
153c       6=O1D
154c       7=O3
155c
156c----------------------------------------------------------------------
157c Major species:
158        aa(nqchem_min)      = 1
159        aa(nqchem_min + 12) = 2
160        aa(nqchem_min + 11) = 3
161        aa(nqchem_min + 4)  = 4
162        aa(nqchem_min + 1)  = 5
163        aa(nqchem_min + 2)  = 6
164        aa(nqchem_min + 7)  = 7
165c Minor species:
166        aa(nqchem_min + 6)  = 8
167        aa(nqchem_min + 8)  = 9
168        aa(nqchem_min + 9)  = 10
169        aa(nqmx)            = 11
170        aa(nqchem_min + 10) = 12
171        aa(nqchem_min + 3)  = 13
172        aa(nqchem_min + 5)  = 14
173c----------------------------------------------------------------------
174
175      open(210, iostat=ierr,file=
176     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_may.dat')
177      if (ierr.ne.0) then
178        write(*,*)'Error : cannot open file atmosfera_LMD_may.dat '
179        write(*,*)'(in aeronomars/inichim.F)'
180        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
181        write(*,*)'1) You can change this directory address in '
182        write(*,*)'   file phymars/datafile.h'
183        write(*,*)'2) If necessary atmosfera_LMD_may.dat (and others)'
184        write(*,*)'   can be obtained online on:'
185        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
186         STOP
187      endif
188      open(220, iostat=ierr,file=
189     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_min.dat')
190      if (ierr.ne.0) then
191        write(*,*)'Error : cannot open file atmosfera_LMD_min.dat '
192        write(*,*)'(in aeronomars/inichim.F)'
193        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
194        write(*,*)'1) You can change this directory address in '
195        write(*,*)'   file phymars/datafile.h'
196        write(*,*)'2) If necessary atmosfera_LMD_min.dat (and others)'
197        write(*,*)'   can be obtained online on:'
198        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
199         STOP
200      endif
201      read(210,*) tmp
202      read(220,*) tmp
203        do l=1,252
204          read(210,112) tfile(l),zfile(l),nxf(l),(vmrf(l,n),n=1,7)
205          zfile(l)=zfile(l)*100.                    !pressure (Pa)
206          sigfile(l)=zfile(l)/zfile(1)
207        enddo
208        do l=1,252
209          read(220,113)zfilemin(l),(vmrf(l,n),n=8,14)
210          zfilemin(l)=zfilemin(l)*1000.             !height (m)
211          do n=1,14
212            nf(l,n)=vmrf(l,n)*nxf(l)
213          enddo
214        enddo
215        close(210)
216        close(220)
217
218      do i=1,ngridmx
219         do l=1,nlayermx
220
221          zgcm=sig(l)
222
223          do n=1,14
224            call intrplf(zgcm,vmrint,sigfile,nf(1,n),252)
225            ni(n)=vmrint
226          enddo
227
228          densconc=0.
229          nt=0.
230
231          do n=1,14
232            densconc=densconc+ni(n)*mmolf(n)
233            nt=nt+ni(n)
234          enddo
235
236          mmean=densconc/nt                            ! in amu
237
238c TEST
239c           print*,l," mmean=",mmean
240c           print*,l," nt=",nt
241c FIN TEST
242
243          do n=nqchem_min,nqmx-2
244            pq(i,l,n)=ni(aa(n))/nt*mmol(n)/mmean
245          enddo
246          if (iceparty) then
247            pq(i,l,nqmx-1) = 0.
248            pq(i,l,nqmx)   = ni(aa(nqmx))/nt*mmol(nqmx)/mmean
249          else
250           do n=nqmx-1,nqmx
251            pq(i,l,n)=ni(aa(n))/nt*mmol(n)/mmean
252           enddo
253          endif
254
255c TEST
256c        if (noms(n).eq."h2o") then
257c           print*,l," ",noms(n)," ni=",ni(aa(n))," q=",pq(i,l,n)
258c        endif
259c FIN TEST
260
261c          pq(i,l,nqchem_min)=0.995
262c          do n=nqchem_min+1, nqmx
263c            pq(i,l,n)=0.005/12
264c          enddo
265
266          enddo     
267        enddo   
268
269cccccccccccccccccccccccccccccc     
270c  make sure that sum of q = 1     
271c dominent species is = 1 - sum(all other species)     
272cccccccccccccccccccccccccccccc     
273      iqmax=nqchem_min
274     
275      if ((nqmx-nqchem_min).gt.10) then
276       do l=1,nlayermx
277        do j=1,ngridmx
278           do iq=nqchem_min,nqmx
279            if ( (pq(j,l,iq).gt.pq(j,l,iqmax)).and.
280     .           (noms(iq).ne."ice") )  then
281              iqmax=iq
282            endif
283           enddo
284           pq(j,l,iqmax)=1.
285           qtot(j,l)=0
286           do iq=nqchem_min,nqmx
287            if ( (iq.ne.iqmax).and.
288     .           (noms(iq).ne."ice") ) then       
289              pq(j,l,iqmax)=pq(j,l,iqmax)-pq(j,l,iq)       
290            endif
291           enddo !iq
292           do iq=nqchem_min,nqmx
293            if (noms(iq).ne."ice") then
294             qtot(j,l)=qtot(j,l)+pq(j,l,iq)
295            endif
296c            if (j.eq.1.and.l.eq.1) write(*,*)' qtot(j,l)',
297c     $    qtot(j,l)
298           enddo !iq
299         enddo !j   
300       enddo !l 
301      endif
302ccccccccccccccccccccccccccccccc
303
30466      format(i2,6(1x,e11.5))
305112     format(7x,f7.3,3x,e12.6,3x,e12.6,6(3x,e12.6))
306113     format(1x,f6.2,7(3x,e12.6))
307
308      end
309
Note: See TracBrowser for help on using the repository browser.