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

    ! 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)
    ! Pour Van-Leer plus vapeur d'eau saturée : iadv(1)=4
    ! Pour Van-Leer : iadv=10

    use nr_util, only: assert

    ! 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
       call assert(nq_local == nqmx, "iniadvtrac nq_local")

       do iq=1, nqmx
          read(90, 999) hadv(iq), vadv(iq), tnom(iq)
       end do
       close(90)  
       PRINT *, 'lecture de traceur.def :'   
       do iq=1, nqmx
          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.'
       call assert(nqmx == 4, "iniadvtrac nqmx")
       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, nqmx
       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, nqmx
       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

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