libf/dyn3d/iniadvtrac.f90

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)

    use numer_rec, 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
30	guez	23	use numer_rec, only: assert
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	guez	23	call assert(nq_local == nqmx, "iniadvtrac nq_local")
107	guez	3
108	guez	23	do iq=1, nqmx
109	guez	3	read(90, 999) hadv(iq), vadv(iq), tnom(iq)
110			end do
111			close(90)
112			PRINT *, 'lecture de traceur.def :'
113	guez	23	do iq=1, nqmx
114	guez	3	write(, ) hadv(iq), vadv(iq), tnom(iq)
115			end do
116			else
117	guez	5	print *, 'Problème à l''ouverture de "traceur.def"'
118			print *, 'Attention : on prend des valeurs par défaut.'
119	guez	23	call assert(nqmx == 4, "iniadvtrac nqmx")
120	guez	3	hadv(1) = 14
121			vadv(1) = 14
122			tnom(1) = 'H2Ov'
123			hadv(2) = 10
124			vadv(2) = 10
125			tnom(2) = 'H2Ol'
126			hadv(3) = 10
127			vadv(3) = 10
128			tnom(3) = 'RN'
129			hadv(4) = 10
130			vadv(4) = 10
131			tnom(4) = 'PB'
132			ENDIF
133			PRINT *, 'Valeur de traceur.def :'
134	guez	23	do iq=1, nqmx
135	guez	3	write(, ) hadv(iq), vadv(iq), tnom(iq)
136			end do
137
138			! À partir du nom court du traceur et du schéma d'advection, on
139			! détemine le nom long :
140			iiq=0
141			ii=0
142	guez	23	do iq=1, nqmx
143	guez	3	iiq=iiq+1
144			if (hadv(iq) /= vadv(iq)) then
145			if (hadv(iq) == 10.and.vadv(iq) == 16) then
146			iadv(iiq)=11
147			else
148			print *, 'le choix des schemas d''advection H et V'
149			print *, 'est non disponible actuellement'
150			stop
151			endif
152			else
153			iadv(iiq)=hadv(iq)
154			endif
155			! verification nombre de traceurs
156			if (iadv(iiq).lt.20) then
157			ii=ii+1
158			elseif (iadv(iiq) == 20) then
159			ii=ii+4
160			elseif (iadv(iiq) == 30) then
161			ii=ii+10
162			endif
163
164			str1=tnom(iq)
165			tname(iiq)=tnom(iq)
166			IF (iadv(iiq) == 0) THEN
167			ttext(iiq)=trim(str1)
168			ELSE
169			ttext(iiq)=trim(str1)//descrq(iadv(iiq))
170			endif
171			str2=ttext(iiq)
172			! schemas tenant compte des moments d'ordre superieur.
173			if (iadv(iiq) == 20) then
174			do iiiq=1, 3
175			iiq=iiq+1
176			iadv(iiq)=-20
177			ttext(iiq)=trim(str2)//txts(iiiq)
178			tname(iiq)=trim(str1)//txts(iiiq)
179			enddo
180			elseif (iadv(iiq) == 30) then
181			do iiiq=1, 9
182			iiq=iiq+1
183			iadv(iiq)=-30
184			ttext(iiq)=trim(str2)//txtp(iiiq)
185			tname(iiq)=trim(str1)//txtp(iiiq)
186			enddo
187			endif
188			end do
189			if (ii /= nqmx) then
190			print *, 'WARNING'
191			print *, 'le nombre de traceurs et de moments eventuels'
192			print *, 'est inferieur a nqmx '
193			endif
194			if (iiq > nqmx) then
195			print *, 'le choix des schemas est incompatible avec '
196			print *, 'la dimension nqmx (nombre de traceurs)'
197			print *, 'verifier traceur.def ou la namelist INCA'
198			print *, 'ou recompiler avec plus de traceurs'
199			stop
200			endif
201			iiq=0
202			do iq=1, nqmx
203			if (iadv(iq).ge.0) then
204			iiq=iiq+1
205			niadv(iiq)=iq
206			endif
207			end do
208
209			999 format (i2, 1x, i2, 1x, a8)
210
211			END subroutine iniadvtrac
212
213	guez	18	end module iniadvtrac_m