trunk/dyn3d/iniadvtrac.f

module iniadvtrac_m

  ! From advtrac.h, v 1.1.1.1 2004/05/19 12:53:06

  use dimens_m, only: nqmx

  implicit none

  private nqmx

  INTEGER iadv(nqmx) ! indice schema de transport 
  INTEGER hadv(nqmx) ! indice schema transport horizontal 
  INTEGER vadv(nqmx) ! indice schema transport vertical 
  INTEGER niadv(nqmx) ! equivalent dyn / physique
  character(len=8) tnom(nqmx) ! nom court du traceur
  character(len=10) tname(nqmx) ! nom du traceur pour restart
  character(len=13) ttext(nqmx) ! nom long du traceur pour sorties

contains

  subroutine iniadvtrac(nq)

    ! From dyn3d/iniadvtrac.F, version 1.3 2005/04/13 08:58:34

    ! Authors :  P. Le Van, L. Fairhead, F. Hourdin
    ! Modification spéciale traceur F. Forget 05/94
    ! Modification M.-A. Filiberti 02/02 lecture de "traceur.def"
    ! Modification de l'intégration de "q" (26/04/94)

    integer, intent(out), optional:: nq

    ! Variables local to the procedure:

    character(len=3) descrq(30)
    character:: txts(3) = (/'x', 'y', 'z'/)
    character(len=2) txtp(9)
    character(len=13) str1, str2

    integer iq, iiq, iiiq, ierr, ii, nq_local

    data txtp/'x', 'y', 'z', 'xx', 'xy', 'xz', 'yy', 'yz', 'zz'/

    !-----------------------------------------------------------------------

    print *, "Call sequence information: iniadvtrac"

    ! Initializations:
    descrq(14)='VLH'
    descrq(10)='VL1'
    descrq(11)='VLP'
    descrq(12)='FH1'
    descrq(13)='FH2'
    descrq(16)='PPM'
    descrq(17)='PPS'
    descrq(18)='PPP'
    descrq(20)='SLP'
    descrq(30)='PRA'

    !        Choix  des schemas d'advection pour l'eau et les traceurs

    ! iadv = 1    schema  transport type "humidite specifique LMD"
    ! iadv = 2    schema   amont
    ! iadv = 14    schema  Van-leer + humidite specifique 
    !                        Modif F.Codron
    ! iadv = 10   schema  Van-leer (retenu pour l'eau vapeur et liquide)
    ! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone)
    !           pour vadv
    ! iadv = 12   schema  Frederic Hourdin I
    ! iadv = 13   schema  Frederic Hourdin II
    ! iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
    ! iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
    ! iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
    ! iadv = 20   schema  Slopes
    ! iadv = 30   schema  Prather

    !    Dans le tableau q(ij, l, iq) : iq = 1  pour l'eau vapeur
    !                                 iq = 2  pour l'eau liquide
    !    Et éventuellement            iq = 3, nqmx pour les autres traceurs

    !    iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.

    ! Choix du schema d'advection
    ! choix par defaut = van leer pour tous les traceurs
    do iq=1, nqmx
       iadv(iq)=10
       str1(1:1)='q'
       if (nqmx.le.99) then
          WRITE(str1(2:3), '(i2.2)') iq
       else
          WRITE(str1(2:4), '(i3.3)') iq
       endif
       tnom(iq)=str1
       tname(iq)=tnom(iq) 
       str2=tnom(iq) 
       ttext(iq) = trim(str2) // descrq(iadv(iq))
    end do

    ! Choix du schema pour l'advection dans fichier "traceur.def"

    open(unit=90, file='traceur.def', form='formatted', status='old', &
         iostat=ierr)
    if (ierr == 0) then
       print *, 'Ouverture de "traceur.def" ok'
       read(unit=90, fmt=*) nq_local
       print *, 'nombre de traceurs ', nq_local
       if (nq_local > nqmx) then
          print *, 'nombre de traceurs trop important'
          print *, 'verifier traceur.def'
          stop 1
       endif

       do iq=1, nq_local
          read(90, 999) hadv(iq), vadv(iq), tnom(iq)
       end do
       close(90)  
       PRINT *, 'lecture de traceur.def :'   
       do iq=1, nq_local
          write(*, *) hadv(iq), vadv(iq), tnom(iq)
       end do
    else
       print *, 'Problème à l''ouverture de "traceur.def"'
       print *, 'Attention : on prend des valeurs par défaut.'
       nq_local = 4
       hadv(1) = 14
       vadv(1) = 14
       tnom(1) = 'H2Ov'
       hadv(2) = 10
       vadv(2) = 10
       tnom(2) = 'H2Ol'
       hadv(3) = 10
       vadv(3) = 10
       tnom(3) = 'RN'
       hadv(4) = 10
       vadv(4) = 10
       tnom(4) = 'PB'
    ENDIF
    PRINT *, 'Valeur de traceur.def :'
    do iq=1, nq_local
       write(*, *) hadv(iq), vadv(iq), tnom(iq)
    end do

    ! À partir du nom court du traceur et du schéma d'advection, on
    ! détemine le nom long :
    iiq=0
    ii=0
    do iq=1, nq_local
       iiq=iiq+1
       if (hadv(iq) /= vadv(iq)) then
          if (hadv(iq) == 10.and.vadv(iq) == 16) then
             iadv(iiq)=11
          else
             print *, 'le choix des schemas d''advection H et V'
             print *, 'est non disponible actuellement'
             stop 
          endif
       else
          iadv(iiq)=hadv(iq)
       endif
       ! verification nombre de traceurs
       if (iadv(iiq).lt.20) then
          ii=ii+1
       elseif (iadv(iiq) == 20) then
          ii=ii+4
       elseif (iadv(iiq) == 30) then
          ii=ii+10
       endif

       str1=tnom(iq)
       tname(iiq)=tnom(iq)
       IF (iadv(iiq) == 0) THEN
          ttext(iiq)=trim(str1)
       ELSE
          ttext(iiq)=trim(str1)//descrq(iadv(iiq))
       endif
       str2=ttext(iiq)
       !   schemas tenant compte des moments d'ordre superieur.
       if (iadv(iiq) == 20) then
          do iiiq=1, 3
             iiq=iiq+1
             iadv(iiq)=-20
             ttext(iiq)=trim(str2)//txts(iiiq)
             tname(iiq)=trim(str1)//txts(iiiq)
          enddo
       elseif (iadv(iiq) == 30) then
          do iiiq=1, 9
             iiq=iiq+1
             iadv(iiq)=-30
             ttext(iiq)=trim(str2)//txtp(iiiq)
             tname(iiq)=trim(str1)//txtp(iiiq)
          enddo
       endif
    end do
    if (ii /= nqmx) then
       print *, 'WARNING'
       print *, 'le nombre de traceurs et de moments eventuels'
       print *, 'est inferieur a nqmx '
    endif
    if (iiq > nqmx) then
       print *, 'le choix des schemas est incompatible avec '
       print *, 'la dimension nqmx (nombre de traceurs)'
       print *, 'verifier traceur.def ou la namelist INCA'
       print *, 'ou recompiler avec plus de traceurs'
       stop
    endif
    iiq=0
    do iq=1, nqmx
       if (iadv(iq).ge.0) then
          iiq=iiq+1
          niadv(iiq)=iq
       endif
    end do
    if (present(nq)) nq = nq_local

999 format (i2, 1x, i2, 1x, a8)

  END subroutine iniadvtrac

end module iniadvtrac_m
1	guez	18	module iniadvtrac_m
2	guez	3
3			! From advtrac.h, v 1.1.1.1 2004/05/19 12:53:06
4
5			use dimens_m, only: nqmx
6
7			implicit none
8
9			private nqmx
10
11			INTEGER iadv(nqmx) ! indice schema de transport
12			INTEGER hadv(nqmx) ! indice schema transport horizontal
13			INTEGER vadv(nqmx) ! indice schema transport vertical
14			INTEGER niadv(nqmx) ! equivalent dyn / physique
15			character(len=8) tnom(nqmx) ! nom court du traceur
16			character(len=10) tname(nqmx) ! nom du traceur pour restart
17			character(len=13) ttext(nqmx) ! nom long du traceur pour sorties
18
19			contains
20
21			subroutine iniadvtrac(nq)
22
23			! From dyn3d/iniadvtrac.F, version 1.3 2005/04/13 08:58:34
24
25			! Authors : P. Le Van, L. Fairhead, F. Hourdin
26			! Modification spéciale traceur F. Forget 05/94
27			! Modification M.-A. Filiberti 02/02 lecture de "traceur.def"
28			! Modification de l'intégration de "q" (26/04/94)
29
30	guez	5	integer, intent(out), optional:: nq
31	guez	3
32			! Variables local to the procedure:
33
34			character(len=3) descrq(30)
35			character:: txts(3) = (/'x', 'y', 'z'/)
36			character(len=2) txtp(9)
37			character(len=13) str1, str2
38
39	guez	5	integer iq, iiq, iiiq, ierr, ii, nq_local
40	guez	3
41			data txtp/'x', 'y', 'z', 'xx', 'xy', 'xz', 'yy', 'yz', 'zz'/
42
43			!-----------------------------------------------------------------------
44
45			print *, "Call sequence information: iniadvtrac"
46
47			! Initializations:
48			descrq(14)='VLH'
49			descrq(10)='VL1'
50			descrq(11)='VLP'
51			descrq(12)='FH1'
52			descrq(13)='FH2'
53			descrq(16)='PPM'
54			descrq(17)='PPS'
55			descrq(18)='PPP'
56			descrq(20)='SLP'
57			descrq(30)='PRA'
58
59			! Choix des schemas d'advection pour l'eau et les traceurs
60
61			! iadv = 1 schema transport type "humidite specifique LMD"
62			! iadv = 2 schema amont
63			! iadv = 14 schema Van-leer + humidite specifique
64			! Modif F.Codron
65			! iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide)
66			! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone)
67			! pour vadv
68			! iadv = 12 schema Frederic Hourdin I
69			! iadv = 13 schema Frederic Hourdin II
70			! iadv = 16 schema PPM Monotone(Collela & Woodward 1984)
71			! iadv = 17 schema PPM Semi Monotone (overshoots autorisés)
72			! iadv = 18 schema PPM Positif Defini (overshoots undershoots autorisés)
73			! iadv = 20 schema Slopes
74			! iadv = 30 schema Prather
75
76			! Dans le tableau q(ij, l, iq) : iq = 1 pour l'eau vapeur
77			! iq = 2 pour l'eau liquide
78			! Et éventuellement iq = 3, nqmx pour les autres traceurs
79
80			! iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq.
81
82			! Choix du schema d'advection
83			! choix par defaut = van leer pour tous les traceurs
84			do iq=1, nqmx
85			iadv(iq)=10
86			str1(1:1)='q'
87			if (nqmx.le.99) then
88			WRITE(str1(2:3), '(i2.2)') iq
89			else
90			WRITE(str1(2:4), '(i3.3)') iq
91			endif
92			tnom(iq)=str1
93			tname(iq)=tnom(iq)
94			str2=tnom(iq)
95			ttext(iq) = trim(str2) // descrq(iadv(iq))
96			end do
97
98			! Choix du schema pour l'advection dans fichier "traceur.def"
99
100			open(unit=90, file='traceur.def', form='formatted', status='old', &
101			iostat=ierr)
102			if (ierr == 0) then
103			print *, 'Ouverture de "traceur.def" ok'
104	guez	5	read(unit=90, fmt=*) nq_local
105			print *, 'nombre de traceurs ', nq_local
106			if (nq_local > nqmx) then
107	guez	3	print *, 'nombre de traceurs trop important'
108			print *, 'verifier traceur.def'
109	guez	18	stop 1
110	guez	3	endif
111
112	guez	5	do iq=1, nq_local
113	guez	3	read(90, 999) hadv(iq), vadv(iq), tnom(iq)
114			end do
115			close(90)
116			PRINT *, 'lecture de traceur.def :'
117	guez	5	do iq=1, nq_local
118	guez	3	write(, ) hadv(iq), vadv(iq), tnom(iq)
119			end do
120			else
121	guez	5	print *, 'Problème à l''ouverture de "traceur.def"'
122			print *, 'Attention : on prend des valeurs par défaut.'
123			nq_local = 4
124	guez	3	hadv(1) = 14
125			vadv(1) = 14
126			tnom(1) = 'H2Ov'
127			hadv(2) = 10
128			vadv(2) = 10
129			tnom(2) = 'H2Ol'
130			hadv(3) = 10
131			vadv(3) = 10
132			tnom(3) = 'RN'
133			hadv(4) = 10
134			vadv(4) = 10
135			tnom(4) = 'PB'
136			ENDIF
137			PRINT *, 'Valeur de traceur.def :'
138	guez	5	do iq=1, nq_local
139	guez	3	write(, ) hadv(iq), vadv(iq), tnom(iq)
140			end do
141
142			! À partir du nom court du traceur et du schéma d'advection, on
143			! détemine le nom long :
144			iiq=0
145			ii=0
146	guez	5	do iq=1, nq_local
147	guez	3	iiq=iiq+1
148			if (hadv(iq) /= vadv(iq)) then
149			if (hadv(iq) == 10.and.vadv(iq) == 16) then
150			iadv(iiq)=11
151			else
152			print *, 'le choix des schemas d''advection H et V'
153			print *, 'est non disponible actuellement'
154			stop
155			endif
156			else
157			iadv(iiq)=hadv(iq)
158			endif
159			! verification nombre de traceurs
160			if (iadv(iiq).lt.20) then
161			ii=ii+1
162			elseif (iadv(iiq) == 20) then
163			ii=ii+4
164			elseif (iadv(iiq) == 30) then
165			ii=ii+10
166			endif
167
168			str1=tnom(iq)
169			tname(iiq)=tnom(iq)
170			IF (iadv(iiq) == 0) THEN
171			ttext(iiq)=trim(str1)
172			ELSE
173			ttext(iiq)=trim(str1)//descrq(iadv(iiq))
174			endif
175			str2=ttext(iiq)
176			! schemas tenant compte des moments d'ordre superieur.
177			if (iadv(iiq) == 20) then
178			do iiiq=1, 3
179			iiq=iiq+1
180			iadv(iiq)=-20
181			ttext(iiq)=trim(str2)//txts(iiiq)
182			tname(iiq)=trim(str1)//txts(iiiq)
183			enddo
184			elseif (iadv(iiq) == 30) then
185			do iiiq=1, 9
186			iiq=iiq+1
187			iadv(iiq)=-30
188			ttext(iiq)=trim(str2)//txtp(iiiq)
189			tname(iiq)=trim(str1)//txtp(iiiq)
190			enddo
191			endif
192			end do
193			if (ii /= nqmx) then
194			print *, 'WARNING'
195			print *, 'le nombre de traceurs et de moments eventuels'
196			print *, 'est inferieur a nqmx '
197			endif
198			if (iiq > nqmx) then
199			print *, 'le choix des schemas est incompatible avec '
200			print *, 'la dimension nqmx (nombre de traceurs)'
201			print *, 'verifier traceur.def ou la namelist INCA'
202			print *, 'ou recompiler avec plus de traceurs'
203			stop
204			endif
205			iiq=0
206			do iq=1, nqmx
207			if (iadv(iq).ge.0) then
208			iiq=iiq+1
209			niadv(iiq)=iq
210			endif
211			end do
212	guez	5	if (present(nq)) nq = nq_local
213	guez	3
214			999 format (i2, 1x, i2, 1x, a8)
215
216			END subroutine iniadvtrac
217
218	guez	18	end module iniadvtrac_m