source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/dyn3d/iniadvtrac.F @ 5171

Last change on this file since 5171 was 524, checked in by lmdzadmin, 20 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.5 KB
Line 
1!
2! $Header$
3!
4c
5c
6      subroutine iniadvtrac(nq)
7      USE ioipsl
8#ifdef INCA
9      USE transport_controls, only : hadv_flg, vadv_flg
10      USE chemshut
11#endif
12      IMPLICIT NONE
13c=======================================================================
14c
15c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
16c   -------
17c   Modif special traceur F.Forget 05/94
18c   Modif M-A Filiberti 02/02 lecture de traceur.def
19c
20c   Objet:
21c   ------
22c
23c   GCM LMD nouvelle grille
24c
25c=======================================================================
26c   ... modification de l'integration de q ( 26/04/94 ) ....
27c-----------------------------------------------------------------------
28c   Declarations:
29c   -------------
30C
31#include "dimensions.h"
32#include "advtrac.h"
33
34c   local
35      character*3 descrq(30)
36      character*1 txts(3)
37      character*2 txtp(9)
38      character*13 str1,str2,str3
39
40      integer nq,iq,iiq,iiiq,ierr,ii
41      integer lnblnk
42      external lnblnk
43
44      data txts/'x','y','z'/
45      data txtp/'x','y','z','xx','xy','xz','yy','yz','zz'/
46
47c-----------------------------------------------------------------------
48c   Initialisations:
49c   ----------------
50      descrq(14)='VLH'
51      descrq(10)='VL1'
52      descrq(11)='VLP'
53      descrq(12)='FH1'
54      descrq(13)='FH2'
55      descrq(16)='PPM'
56      descrq(17)='PPS'
57      descrq(18)='PPP'
58      descrq(20)='SLP'
59      descrq(30)='PRA'
60
61c-----------------------------------------------------------------------
62c        Choix  des schemas d'advection pour l'eau et les traceurs
63c
64c     iadv = 1    schema  transport type "humidite specifique LMD"
65c     iadv = 2    schema   amont
66c     iadv = 14    schema  Van-leer + humidite specifique
67c                            Modif F.Codron
68c     iadv = 10   schema  Van-leer (retenu pour l'eau vapeur et liquide)
69c     iadv = 11   schema  Van-Leer pour hadv et version PPM (Monotone) pour vadv
70c     iadv = 12   schema  Frederic Hourdin I
71c     iadv = 13   schema  Frederic Hourdin II
72c     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
73c     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
74c     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
75c     iadv = 20   schema  Slopes
76c     iadv = 30   schema  Prather
77c
78c        Dans le tableau q(ij,l,iq) : iq = 1  pour l'eau vapeur
79c                                     iq = 2  pour l'eau liquide
80c        Et eventuellement            iq = 3,nqmx pour les autres traceurs
81c
82c        iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
83C------------------------------------------------------------------------
84c     Choix du schema d'advection
85c------------------------------------------------------------------
86c choix par defaut = van leer pour tous les traceurs
87      do iq=1,nqmx
88       iadv(iq)=10
89       str1(1:1)='q'
90       if (nqmx.le.99) then
91       WRITE(str1(2:3),'(i2.2)') iq
92       else
93       WRITE(str1(2:4),'(i3.3)') iq
94       endif
95       tnom(iq)=str1
96       tname(iq)=tnom(iq)
97       str2=tnom(iq)
98       ttext(iq)=str2(1:lnblnk(str2))//descrq(iadv(iq))
99      end do
100      nq=nqmx
101c------------------------------------------------------------------
102c     Choix du schema pour l'advection
103c    dans fichier traceur.def
104c------------------------------------------------------------------
105#ifdef INCA
106C le module de chimie fournit les noms des traceurs
107C et les schemas d'advection associes.
108      tnom(1)='H2Ov'
109      tnom(2)='H2Ol'
110      nq=nbtrac+2
111       if (nq.gt.nqmx) then
112       print*,'nombre de traceurs incompatible INCA/LMDZT'
113       stop
114       endif
115      do iq =3,nq
116      tnom(iq)=tracnam(iq-2)
117      end do
118      do iq =1,nq
119      hadv(iq)= hadv_flg(iq)
120      vadv(iq)= vadv_flg(iq)
121      end do
122#else
123      print*,'ouverture de traceur.def'
124      open(90,file='traceur.def',form='formatted',status='old',
125     s     iostat=ierr)
126      if(ierr.eq.0) then
127       print*,'ouverture de traceur.def ok'
128       read(90,*) nq
129       print*,'nombre de traceurs ',nq
130       if (nq.gt.nqmx) then
131       print*,'nombre de traceurs trop important'
132       print*,'verifier traceur.def'
133       stop
134       endif
135C
136       do iq=1,nq
137         read(90,999) hadv(iq),vadv(iq),tnom(iq)
138       end do
139       close(90) 
140       PRINT*,'lecture de traceur.def :'   
141       do iq=1,nq
142         write(*,*) hadv(iq),vadv(iq),tnom(iq)
143       end do       
144      else
145       print*,'pb ouverture traceur.def'
146       print*,'ATTENTION on prend des valeurs par defaut'
147      endif
148#endif
149c a partir du nom court du traceur et du schema d'advection au detemine le nom long.
150        iiq=0
151        ii=0
152        do iq=1,nq
153         iiq=iiq+1
154         if (hadv(iq).ne.vadv(iq)) then
155           if (hadv(iq).eq.10.and.vadv(iq).eq.16) then
156             iadv(iiq)=11
157           else
158             print*,'le choix des schemas d''advection H et V'
159             print*, 'est non disponible actuellement'
160             stop
161           endif
162         else
163          iadv(iiq)=hadv(iq)
164         endif
165c verification nombre de traceurs
166          if (iadv(iiq).lt.20) then
167             ii=ii+1
168          elseif (iadv(iiq).eq.20) then
169             ii=ii+4
170          elseif (iadv(iiq).eq.30) then
171             ii=ii+10
172          endif
173 
174         str1=tnom(iq)
175         tname(iiq)=tnom(iq)
176         ttext(iiq)=str1(1:lnblnk(str1))//descrq(iadv(iiq))
177         str2=ttext(iiq)
178c   schemas tenant compte des moments d'ordre superieur.
179          if (iadv(iiq).eq.20) then
180             do iiiq=1,3
181               iiq=iiq+1
182               iadv(iiq)=-20
183               ttext(iiq)=str2(1:lnblnk(str2))//txts(iiiq)
184               tname(iiq)=str1(1:lnblnk(str1))//txts(iiiq)
185              enddo
186            elseif (iadv(iiq).eq.30) then
187              do iiiq=1,9
188               iiq=iiq+1
189               iadv(iiq)=-30
190               ttext(iiq)=str2(1:lnblnk(str2))//txtp(iiiq)
191               tname(iiq)=str1(1:lnblnk(str1))//txtp(iiiq)
192              enddo
193           endif
194        end do
195       if(ii.ne.nqmx) then
196       print*,'WARNING'
197       print*,'le nombre de traceurs et de moments eventuels'
198       print*,'est inferieur a nqmx '
199       endif
200       if (iiq.gt.nqmx) then
201       print*,'le choix des schemas est incompatible avec '
202       print*,'la dimension nqmx (nombre de traceurs)'
203       print*,'verifier traceur.def ou la namelist INCA'
204       print*,'ou recompiler avec plus de traceurs'
205       stop
206       endif
207      iiq=0
208      do iq=1,nqmx
209         if(iadv(iq).ge.0) then
210             iiq=iiq+1
211             niadv(iiq)=iq
212         endif
213      end do
214      return
215999   format (i2,1x,i2,1x,a8)
216      END
Note: See TracBrowser for help on using the repository browser.