source: LMDZ4/branches/V3_test/libf/dyn3d/iniadvtrac.F @ 2520

Last change on this file since 2520 was 726, checked in by Laurent Fairhead, 18 years ago

Modifications pour rendre INCA plus independant de LMDZ ACo
LF

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