Ignore:
Timestamp:
Jun 8, 2021, 11:31:06 AM (4 years ago)
Author:
fhourdin
Message:

Version modifiee par Camille pour compatibilité avec la physique isotopique.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    r3919 r3923  
    1212  INTEGER, SAVE :: nbtr
    1313
    14 ! CRisi: nb traceurs pères= directement advectés par l'air
     14! CRisi: on retranche les isotopes des traceurs habituels
     15! On fait un tableaux d'indices des traceurs qui passeront dans phytrac
     16  INTEGER, SAVE :: nqtottr
     17  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: itr_indice
     18
     19! CRisi: nb traceurs p?res= directement advect?s par l'air
    1520  INTEGER, SAVE :: nqperes
    1621
    … …  
    3439! CRisi: tableaux de fils
    3540  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    36   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
     41  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les g?n?rations
    3742  INTEGER, SAVE :: nqdesc_tot
    3843  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    … …  
    5661  LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
    5762  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    58   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
    59   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
    60   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
    61   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
    62   INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
    63   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
     63  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne num?ro iso entre 1 et niso_possibles en fn de nqtot
     64  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne num?ro iso entre 1 et niso effectif en fn de nqtot
     65  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne num?ro de la zone de tracage en fn de nqtot
     66  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne num?ro de la zone de tracage en fn de nqtot
     67  INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du num?ro d isotope entre 1 et niso_possibles
     68  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! num?ro ixt en fn izone, indnum entre 1 et niso
    6469  INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
    6570
    … …  
    113118    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: solsym_inca
    114119
    115     CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
    116     CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
     120    CHARACTER(len=30), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
     121    CHARACTER(len=30), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
    117122    CHARACTER(len=3), DIMENSION(30) :: descrq
    118123    CHARACTER(len=1), DIMENSION(3)  :: txts
    … …  
    121126 
    122127    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    123     INTEGER :: iq, new_iq, iiq, jq, ierr
     128    INTEGER :: iq, new_iq, iiq, jq, ierr,itr
    124129    INTEGER :: ifils,ipere,generation ! CRisi
    125130    LOGICAL :: continu,nouveau_traceurdef
    126131    INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
    127     CHARACTER(len=15) :: tchaine   
     132    CHARACTER(len=30) :: tchaine   
    128133
    129134    character(len=*),parameter :: modname="infotrac_init"
    … …  
    252257          IF (nqo == 4 .AND. type_trac=='inco') THEN ! ThL
    253258             WRITE(lunout,*) trim(modname),': you are coupling with INCA, and also using CO2i.'
    254              nqo = 3    ! A améliorier... je force 3 traceurs eau...  ThL
     259             nqo = 3    ! A am?liorier... je force 3 traceurs eau...  ThL
    255260             WRITE(lunout,*) trim(modname),': nqo = ',nqo
    256261          ELSE
    … …  
    314319!     iadv = 13   schema  Frederic Hourdin II
    315320!     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
    316 !     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
    317 !     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
     321!     iadv = 17   schema  PPM Semi Monotone (overshoots autoris?s)
     322!     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autoris?s)
    318323!     iadv = 20   schema  Slopes
    319324!     iadv = 30   schema  Prather
    … …  
    362367                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    363368                tnom_0(iq)=tchaine(1:iiq-1)
    364                 tnom_transp(iq)=tchaine(iiq+1:15)
     369                tnom_transp(iq)=tchaine(iiq+1:30)
    365370             else
    366371                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    464469!jyg<
    465470!
     471
     472!-----------------------------------------------------------------------
     473!
     474! 3) Verify if advection schema 20 or 30 choosen
     475!    Calculate total number of tracers needed: nqtot
     476!    Allocate variables depending on total number of tracers
     477!-----------------------------------------------------------------------
     478    new_iq=0
     479    DO iq=1,nqtrue
     480       ! Add tracers for certain advection schema
     481       IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
     482          new_iq=new_iq+1  ! no tracers added
     483       ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
     484          new_iq=new_iq+4  ! 3 tracers added
     485       ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
     486          new_iq=new_iq+10 ! 9 tracers added
     487       ELSE
     488          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
     489          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
     490       ENDIF
     491    END DO
     492   
     493    IF (new_iq /= nqtrue) THEN
     494       ! The choice of advection schema imposes more tracers
     495       ! Assigne total number of tracers
     496       nqtot = new_iq
     497
     498       WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
     499       WRITE(lunout,*) 'makes it necessary to add tracers'
     500       WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
     501       WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
     502
     503    ELSE
     504       ! The true number of tracers is also the total number
     505       nqtot = nqtrue
     506    ENDIF
     507
     508!
     509! Allocate variables with total number of tracers, nqtot
     510!
     511    ALLOCATE(tname(nqtot), ttext(nqtot))
     512    ALLOCATE(iadv(nqtot), niadv(nqtot))
     513
     514!-----------------------------------------------------------------------
     515!
     516! 4) Determine iadv, long and short name
     517!
     518!-----------------------------------------------------------------------
     519    new_iq=0
     520    DO iq=1,nqtrue
     521       new_iq=new_iq+1
     522
     523       ! Verify choice of advection schema
     524       IF (hadv(iq)==vadv(iq)) THEN
     525          iadv(new_iq)=hadv(iq)
     526       ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
     527          iadv(new_iq)=11
     528       ELSE
     529          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
     530
     531          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
     532       ENDIF
     533     
     534       str1=tnom_0(iq)
     535       tname(new_iq)= tnom_0(iq)
     536       IF (iadv(new_iq)==0) THEN
     537          ttext(new_iq)=trim(str1)
     538       ELSE
     539          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
     540       ENDIF
     541
     542       ! schemas tenant compte des moments d'ordre superieur
     543       str2=ttext(new_iq)
     544       IF (iadv(new_iq)==20) THEN
     545          DO jq=1,3
     546             new_iq=new_iq+1
     547             iadv(new_iq)=-20
     548             ttext(new_iq)=trim(str2)//txts(jq)
     549             tname(new_iq)=trim(str1)//txts(jq)
     550          END DO
     551       ELSE IF (iadv(new_iq)==30) THEN
     552          DO jq=1,9
     553             new_iq=new_iq+1
     554             iadv(new_iq)=-30
     555             ttext(new_iq)=trim(str2)//txtp(jq)
     556             tname(new_iq)=trim(str1)//txtp(jq)
     557          END DO
     558       ENDIF
     559    END DO
     560
     561!
     562! Find vector keeping the correspodence between true and total tracers
     563!
     564    niadv(:)=0
     565    iiq=0
     566    DO iq=1,nqtot
     567       IF(iadv(iq).GE.0) THEN
     568          ! True tracer
     569          iiq=iiq+1
     570          niadv(iiq)=iq
     571       ENDIF
     572    END DO
     573
     574
     575    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
     576    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
     577    DO iq=1,nqtot
     578       WRITE(lunout,*) iadv(iq),niadv(iq),&
     579       ' ',trim(tname(iq)),' ',trim(ttext(iq))
     580    END DO
     581
     582!
     583! Test for advection schema.
     584! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
     585!
     586    DO iq=1,nqtot
     587       IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
     588          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     589          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
     590       ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
     591          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     592          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
     593       ENDIF
     594    END DO
     595
     596
     597! CRisi: quels sont les traceurs fils et les traceurs p?res.
     598! initialiser tous les tableaux d'indices li?s aux traceurs familiaux
     599! + v?rifier que tous les p?res sont ?crits en premi?res positions
     600    ALLOCATE(nqfils(nqtot),nqdesc(nqtot))   
     601    ALLOCATE(iqfils(nqtot,nqtot))   
     602    ALLOCATE(iqpere(nqtot))
     603    nqperes=0
     604    nqfils(:)=0
     605    nqdesc(:)=0
     606    iqfils(:,:)=0
     607    iqpere(:)=0
     608    nqdesc_tot=0   
     609    DO iq=1,nqtot
     610      if (tnom_transp(iq) == 'air') then
     611        ! ceci est un traceur p?re
     612        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
     613        nqperes=nqperes+1
     614        iqpere(iq)=0
     615      else !if (tnom_transp(iq) == 'air') then
     616        ! ceci est un fils. Qui est son p?re?
     617        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils'
     618        continu=.true.
     619        ipere=1
     620        do while (continu)           
     621          if (tnom_transp(iq) == tnom_0(ipere)) then
     622            ! Son p?re est ipere
     623            WRITE(lunout,*) 'Le traceur',iq,'appele ', &
     624      &          trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere))
     625            if (iq.eq.ipere) then
     626                CALL abort_gcm('infotrac_init','Un fils est son propre pere',1)
     627            endif
     628            nqfils(ipere)=nqfils(ipere)+1 
     629            iqfils(nqfils(ipere),ipere)=iq
     630            iqpere(iq)=ipere         
     631            continu=.false.
     632          else !if (tnom_transp(iq) == tnom_0(ipere)) then
     633            ipere=ipere+1
     634            if (ipere.gt.nqtot) then
     635                WRITE(lunout,*) 'Le traceur',iq,'appele ', &
     636      &          trim(tnom_0(iq)),', est orphelin.'
     637                CALL abort_gcm('infotrac_init','Un traceur est orphelin',1)
     638            endif !if (ipere.gt.nqtot) then
     639          endif !if (tnom_transp(iq) == tnom_0(ipere)) then
     640        enddo !do while (continu)
     641      endif !if (tnom_transp(iq) == 'air') then
     642    enddo !DO iq=1,nqtot
     643    WRITE(lunout,*) 'infotrac: nqperes=',nqperes   
     644    WRITE(lunout,*) 'nqfils=',nqfils
     645    WRITE(lunout,*) 'iqpere=',iqpere
     646    WRITE(lunout,*) 'iqfils=',iqfils
     647
     648! Calculer le nombre de descendants ? partir de iqfils et de nbfils
     649    DO iq=1,nqtot   
     650      generation=0
     651      continu=.true.
     652      ifils=iq
     653      do while (continu)
     654        ipere=iqpere(ifils)
     655        if (ipere.gt.0) then
     656         nqdesc(ipere)=nqdesc(ipere)+1   
     657         nqdesc_tot=nqdesc_tot+1     
     658         iqfils(nqdesc(ipere),ipere)=iq
     659         ifils=ipere
     660         generation=generation+1
     661        else !if (ipere.gt.0) then
     662         continu=.false.
     663        endif !if (ipere.gt.0) then
     664      enddo !do while (continu)   
     665      WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation
     666    enddo !DO iq=1,nqtot
     667    WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc
     668    WRITE(lunout,*) 'iqfils=',iqfils
     669    WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
     670
     671! Interdire autres sch?mas que 10 pour les traceurs fils, et autres sch?mas
     672! que 10 et 14 si des p?res ont des fils
     673    do iq=1,nqtot
     674      if (iqpere(iq).gt.0) then
     675        ! ce traceur a un p?re qui n'est pas l'air
     676        ! Seul le sch?ma 10 est autoris?
     677        if (iadv(iq)/=10) then
     678           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
     679          CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
     680        endif
     681        ! Le traceur p?re ne peut ?tre advect? que par sch?ma 10 ou 14:
     682        IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
     683          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
     684          CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1)
     685        endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
     686     endif !if (iqpere(iq).gt.0) the
     687    enddo !do iq=1,nqtot
     688
     689
     690
     691! detecter quels sont les traceurs isotopiques parmi des traceurs
     692    call infotrac_isoinit(tnom_0,nqtrue)
     693
     694!    if (ntraciso.gt.0) then
     695! le 18 sep 2020: on enl?ve la condition ntraciso.gt.0 car nqtottr doit ?tre
     696! connu m?me si il n'y a pas d'isotopes!
     697        write(lunout,*) 'infotrac 702: nbtr,ntraciso=',nbtr,ntraciso
     698! retrancher les traceurs isotopiques de la liste des traceurs qui passent dans
     699! phytrac
     700        nbtr=nbtr-nqo*ntraciso
     701
     702! faire un tableau d'indice des traceurs qui passeront dans phytrac
     703        nqtottr=nqtot-nqo*(1+ntraciso)
     704        write(lunout,*) 'infotrac 704: nqtottr,nqtot,nqo=',nqtottr,nqtot,nqo
     705        ! Rq: nqtottr n'est pas forc?ment ?gal ? nbtr dans le cas o? new_iq /= nqtrue
     706        ALLOCATE (itr_indice(nqtottr)) 
     707        itr_indice(:)=0 
     708        itr=0
     709        do iq=nqo+1, nqtot
     710          if (iso_num(iq).eq.0) then
     711            itr=itr+1
     712            write(*,*) 'itr=',itr
     713            itr_indice(itr)=iq
     714          endif !if (iso_num(iq).eq.0) then
     715        enddo
     716        if (itr.ne.nqtottr) then
     717            CALL abort_gcm('infotrac_init','pb dans le calcul de nqtottr',1)
     718        endif
     719        write(lunout,*) 'itr_indice=',itr_indice
     720!    endif !if (ntraciso.gt.0) then
     721
     722
    466723! Transfert number of tracers to Reprobus
    467724    IF (type_trac == 'repr') THEN
    … …  
    516773                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    517774                tnom_0(iq)=tchaine(1:iiq-1)
    518                 tnom_transp(iq)=tchaine(iiq+1:15)
     775                tnom_transp(iq)=tchaine(iiq+1:30)
    519776             else
    520777                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    569826
    570827!-----------------------------------------------------------------------
    571 !
    572 ! 3) Verify if advection schema 20 or 30 choosen
    573 !    Calculate total number of tracers needed: nqtot
    574 !    Allocate variables depending on total number of tracers
    575 !-----------------------------------------------------------------------
    576     new_iq=0
    577     DO iq=1,nqtrue
    578        ! Add tracers for certain advection schema
    579        IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
    580           new_iq=new_iq+1  ! no tracers added
    581        ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
    582           new_iq=new_iq+4  ! 3 tracers added
    583        ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
    584           new_iq=new_iq+10 ! 9 tracers added
    585        ELSE
    586           WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    587           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
    588        ENDIF
    589     END DO
    590    
    591     IF (new_iq /= nqtrue) THEN
    592        ! The choice of advection schema imposes more tracers
    593        ! Assigne total number of tracers
    594        nqtot = new_iq
    595 
    596        WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
    597        WRITE(lunout,*) 'makes it necessary to add tracers'
    598        WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
    599        WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
    600 
    601     ELSE
    602        ! The true number of tracers is also the total number
    603        nqtot = nqtrue
    604     ENDIF
    605 
    606 !
    607 ! Allocate variables with total number of tracers, nqtot
    608 !
    609     ALLOCATE(tname(nqtot), ttext(nqtot))
    610     ALLOCATE(iadv(nqtot), niadv(nqtot))
    611 
    612 !-----------------------------------------------------------------------
    613 !
    614 ! 4) Determine iadv, long and short name
    615 !
    616 !-----------------------------------------------------------------------
    617     new_iq=0
    618     DO iq=1,nqtrue
    619        new_iq=new_iq+1
    620 
    621        ! Verify choice of advection schema
    622        IF (hadv(iq)==vadv(iq)) THEN
    623           iadv(new_iq)=hadv(iq)
    624        ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
    625           iadv(new_iq)=11
    626        ELSE
    627           WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    628 
    629           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
    630        ENDIF
    631      
    632        str1=tnom_0(iq)
    633        tname(new_iq)= tnom_0(iq)
    634        IF (iadv(new_iq)==0) THEN
    635           ttext(new_iq)=trim(str1)
    636        ELSE
    637           ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
    638        ENDIF
    639 
    640        ! schemas tenant compte des moments d'ordre superieur
    641        str2=ttext(new_iq)
    642        IF (iadv(new_iq)==20) THEN
    643           DO jq=1,3
    644              new_iq=new_iq+1
    645              iadv(new_iq)=-20
    646              ttext(new_iq)=trim(str2)//txts(jq)
    647              tname(new_iq)=trim(str1)//txts(jq)
    648           END DO
    649        ELSE IF (iadv(new_iq)==30) THEN
    650           DO jq=1,9
    651              new_iq=new_iq+1
    652              iadv(new_iq)=-30
    653              ttext(new_iq)=trim(str2)//txtp(jq)
    654              tname(new_iq)=trim(str1)//txtp(jq)
    655           END DO
    656        ENDIF
    657     END DO
    658 
    659 !
    660 ! Find vector keeping the correspodence between true and total tracers
    661 !
    662     niadv(:)=0
    663     iiq=0
    664     DO iq=1,nqtot
    665        IF(iadv(iq).GE.0) THEN
    666           ! True tracer
    667           iiq=iiq+1
    668           niadv(iiq)=iq
    669        ENDIF
    670     END DO
    671 
    672 
    673     WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
    674     WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
    675     DO iq=1,nqtot
    676        WRITE(lunout,*) iadv(iq),niadv(iq),&
    677        ' ',trim(tname(iq)),' ',trim(ttext(iq))
    678     END DO
    679 
    680 !
    681 ! Test for advection schema.
    682 ! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
    683 !
    684     DO iq=1,nqtot
    685        IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
    686           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    687           CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
    688        ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
    689           WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    690           CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
    691        ENDIF
    692     END DO
    693 
    694 
    695 ! CRisi: quels sont les traceurs fils et les traceurs pères.
    696 ! initialiser tous les tableaux d'indices liés aux traceurs familiaux
    697 ! + vérifier que tous les pères sont écrits en premières positions
    698     ALLOCATE(nqfils(nqtot),nqdesc(nqtot))   
    699     ALLOCATE(iqfils(nqtot,nqtot))   
    700     ALLOCATE(iqpere(nqtot))
    701     nqperes=0
    702     nqfils(:)=0
    703     nqdesc(:)=0
    704     iqfils(:,:)=0
    705     iqpere(:)=0
    706     nqdesc_tot=0   
    707     DO iq=1,nqtot
    708       if (tnom_transp(iq) == 'air') then
    709         ! ceci est un traceur père
    710         WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
    711         nqperes=nqperes+1
    712         iqpere(iq)=0
    713       else !if (tnom_transp(iq) == 'air') then
    714         ! ceci est un fils. Qui est son père?
    715         WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils'
    716         continu=.true.
    717         ipere=1
    718         do while (continu)           
    719           if (tnom_transp(iq) == tnom_0(ipere)) then
    720             ! Son père est ipere
    721             WRITE(lunout,*) 'Le traceur',iq,'appele ', &
    722       &          trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere))
    723             nqfils(ipere)=nqfils(ipere)+1 
    724             iqfils(nqfils(ipere),ipere)=iq
    725             iqpere(iq)=ipere         
    726             continu=.false.
    727           else !if (tnom_transp(iq) == tnom_0(ipere)) then
    728             ipere=ipere+1
    729             if (ipere.gt.nqtot) then
    730                 WRITE(lunout,*) 'Le traceur',iq,'appele ', &
    731       &          trim(tnom_0(iq)),', est orphelin.'
    732                 CALL abort_gcm('infotrac_init','Un traceur est orphelin',1)
    733             endif !if (ipere.gt.nqtot) then
    734           endif !if (tnom_transp(iq) == tnom_0(ipere)) then
    735         enddo !do while (continu)
    736       endif !if (tnom_transp(iq) == 'air') then
    737     enddo !DO iq=1,nqtot
    738     WRITE(lunout,*) 'infotrac: nqperes=',nqperes   
    739     WRITE(lunout,*) 'nqfils=',nqfils
    740     WRITE(lunout,*) 'iqpere=',iqpere
    741     WRITE(lunout,*) 'iqfils=',iqfils
    742 
    743 ! Calculer le nombre de descendants à partir de iqfils et de nbfils
    744     DO iq=1,nqtot   
    745       generation=0
    746       continu=.true.
    747       ifils=iq
    748       do while (continu)
    749         ipere=iqpere(ifils)
    750         if (ipere.gt.0) then
    751          nqdesc(ipere)=nqdesc(ipere)+1   
    752          nqdesc_tot=nqdesc_tot+1     
    753          iqfils(nqdesc(ipere),ipere)=iq
    754          ifils=ipere
    755          generation=generation+1
    756         else !if (ipere.gt.0) then
    757          continu=.false.
    758         endif !if (ipere.gt.0) then
    759       enddo !do while (continu)   
    760       WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation
    761     enddo !DO iq=1,nqtot
    762     WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc
    763     WRITE(lunout,*) 'iqfils=',iqfils
    764     WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
    765 
    766 ! Interdire autres schémas que 10 pour les traceurs fils, et autres schémas
    767 ! que 10 et 14 si des pères ont des fils
    768     do iq=1,nqtot
    769       if (iqpere(iq).gt.0) then
    770         ! ce traceur a un père qui n'est pas l'air
    771         ! Seul le schéma 10 est autorisé
    772         if (iadv(iq)/=10) then
    773            WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
    774           CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
    775         endif
    776         ! Le traceur père ne peut être advecté que par schéma 10 ou 14:
    777         IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    778           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
    779           CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1)
    780         endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    781      endif !if (iqpere(iq).gt.0) the
    782     enddo !do iq=1,nqtot
     828! Finalize :
     829!
     830    DEALLOCATE(tnom_0, hadv, vadv,tnom_transp)
    783831
    784832    WRITE(lunout,*) 'infotrac init fin'
    785 
    786 ! detecter quels sont les traceurs isotopiques parmi des traceurs
    787     call infotrac_isoinit(tnom_0,nqtrue)
    788        
    789 !-----------------------------------------------------------------------
    790 ! Finalize :
    791 !
    792     DEALLOCATE(tnom_0, hadv, vadv,tnom_transp)
    793 
    794833
    795834  END SUBROUTINE infotrac_init
    … …  
    807846    ! inputs
    808847    INTEGER nqtrue
    809     CHARACTER(len=15) tnom_0(nqtrue)
     848    CHARACTER(len=30) tnom_0(nqtrue)
    810849   
    811850    ! locals   
    … …  
    890929
    891930        if (nb_iso(ixt,1).eq.1) then
    892           ! on vérifie que toutes les phases ont le même nombre de
     931          ! on v?rifie que toutes les phases ont le m?me nombre de
    893932          ! traceurs
    894933          do phase=2,nqo
    … …  
    903942          ntraceurs_zone=nb_traciso(ixt,1)
    904943
    905           ! on vérifie que toutes les phases ont le même nombre de
     944          ! on v?rifie que toutes les phases ont le m?me nombre de
    906945          ! traceurs
    907946          do phase=2,nqo
    … …  
    912951            endif 
    913952          enddo  !do phase=2,nqo
    914           ! on vérifie que tous les isotopes ont le même nombre de
     953          ! on v?rifie que tous les isotopes ont le m?me nombre de
    915954          ! traceurs
    916955          if (ntraceurs_zone_prec.gt.0) then               
Note: See TracChangeset for help on using the changeset viewer.