source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/dyn3d/iniadvtrac.F @ 5373

!
! $Header$
!
c
c
      subroutine iniadvtrac(nq)
      USE ioipsl
#ifdef INCA
      USE transport_controls, only : hadv_flg, vadv_flg
      USE chemshut
#endif
      IMPLICIT NONE
c=======================================================================
c
c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
c   -------
c   Modif special traceur F.Forget 05/94
c   Modif M-A Filiberti 02/02 lecture de traceur.def
c
c   Objet:
c   ------
c
c   GCM LMD nouvelle grille
c
c=======================================================================
c   ... modification de l'integration de q ( 26/04/94 ) ....
c-----------------------------------------------------------------------
c   Declarations:
c   -------------
C
#include "dimensions.h"
#include "advtrac.h"

c   local
      character*3 descrq(30)
      character*1 txts(3)
      character*2 txtp(9)
      character*13 str1,str2,str3

      integer nq,iq,iiq,iiiq,ierr,ii
      integer lnblnk
      external lnblnk

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

c-----------------------------------------------------------------------
c   Initialisations:
c   ----------------
      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'

c-----------------------------------------------------------------------
c        Choix  des schemas d'advection pour l'eau et les traceurs
c
c     iadv = 1    schema  transport type "humidite specifique LMD"
c     iadv = 2    schema   amont
c     iadv = 14    schema  Van-leer + humidite specifique 
c                            Modif F.Codron
c     iadv = 10   schema  Van-leer (retenu pour l'eau vapeur et liquide)
c     iadv = 11   schema  Van-Leer pour hadv et version PPM (Monotone) pour vadv
c     iadv = 12   schema  Frederic Hourdin I
c     iadv = 13   schema  Frederic Hourdin II
c     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
c     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
c     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
c     iadv = 20   schema  Slopes
c     iadv = 30   schema  Prather
c
c        Dans le tableau q(ij,l,iq) : iq = 1  pour l'eau vapeur
c                                     iq = 2  pour l'eau liquide
c        Et eventuellement            iq = 3,nqmx pour les autres traceurs
c
c        iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
C------------------------------------------------------------------------
c     Choix du schema d'advection
c------------------------------------------------------------------
c 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)=str2(1:lnblnk(str2))//descrq(iadv(iq))
      end do
      nq=nqmx
c------------------------------------------------------------------
c     Choix du schema pour l'advection
c    dans fichier traceur.def
c------------------------------------------------------------------
#ifdef INCA
C le module de chimie fournit les noms des traceurs
C et les schemas d'advection associes.
      tnom(1)='H2Ov'
      tnom(2)='H2Ol'
      nq=nbtrac+2
       if (nq.gt.nqmx) then
       print*,'nombre de traceurs incompatible INCA/LMDZT'
       stop
       endif
      do iq =3,nq
      tnom(iq)=tracnam(iq-2)
      end do
      do iq =1,nq
      hadv(iq)= hadv_flg(iq) 
      vadv(iq)= vadv_flg(iq) 
      end do
#else
      print*,'ouverture de traceur.def'
      open(90,file='traceur.def',form='formatted',status='old',
     s     iostat=ierr)
      if(ierr.eq.0) then
       print*,'ouverture de traceur.def ok'
       read(90,*) nq
       print*,'nombre de traceurs ',nq
       if (nq.gt.nqmx) then
       print*,'nombre de traceurs trop important'
       print*,'verifier traceur.def'
       stop
       endif
C
       do iq=1,nq
         read(90,999) hadv(iq),vadv(iq),tnom(iq)
       end do
       close(90)  
       PRINT*,'lecture de traceur.def :'   
       do iq=1,nq
         write(*,*) hadv(iq),vadv(iq),tnom(iq)
       end do       
      else
       print*,'pb ouverture traceur.def'
       print*,'ATTENTION on prend des valeurs par defaut'
      endif
#endif
c a partir du nom court du traceur et du schema d'advection au detemine le nom long.
        iiq=0
        ii=0
        do iq=1,nq 
         iiq=iiq+1
         if (hadv(iq).ne.vadv(iq)) then
           if (hadv(iq).eq.10.and.vadv(iq).eq.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
c verification nombre de traceurs
          if (iadv(iiq).lt.20) then
             ii=ii+1
          elseif (iadv(iiq).eq.20) then
             ii=ii+4
          elseif (iadv(iiq).eq.30) then
             ii=ii+10
          endif
 
         str1=tnom(iq)
         tname(iiq)=tnom(iq)
         ttext(iiq)=str1(1:lnblnk(str1))//descrq(iadv(iiq))
         str2=ttext(iiq)
c   schemas tenant compte des moments d'ordre superieur.
          if (iadv(iiq).eq.20) then
             do iiiq=1,3
               iiq=iiq+1
               iadv(iiq)=-20
               ttext(iiq)=str2(1:lnblnk(str2))//txts(iiiq)
               tname(iiq)=str1(1:lnblnk(str1))//txts(iiiq)
              enddo
            elseif (iadv(iiq).eq.30) then
              do iiiq=1,9
               iiq=iiq+1
               iadv(iiq)=-30
               ttext(iiq)=str2(1:lnblnk(str2))//txtp(iiiq)
               tname(iiq)=str1(1:lnblnk(str1))//txtp(iiiq)
              enddo
           endif
        end do
       if(ii.ne.nqmx) then
       print*,'WARNING'
       print*,'le nombre de traceurs et de moments eventuels'
       print*,'est inferieur a nqmx '
       endif
       if (iiq.gt.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
      return
999   format (i2,1x,i2,1x,a8)
      END