source: LMDZ4/branches/LMDZ4_V2_patch/libf/dyn3d/iniadvtrac.F @ 665

Last change on this file since 665 was 665, checked in by (none), 19 years ago

This commit was manufactured by cvs2svn to create branch
'LMDZ4_V2_patch'.

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