Ignore:
Timestamp:
Dec 23, 2021, 6:54:17 PM (3 years ago)
Author:
dcugnet
Message:

Second commit for new tracers.

  • include most of the keys in the tracers descriptor vector "tracers(:)".
  • fix in phylmdiso/cv3_routines: fq_* variables were used where their fxt_* counterparts were expected.
  • multiple IF(nqdesc(iq)>0) and IF(nqfils(iq)>0) tests suppressed, because they are not needed: "do ... enddo" loops with 0 upper bound are not executed.
  • remove French accents from comments (encoding problem) in phylmdiso/cv3_routines and phylmdiso/cv30_routines.
  • modifications in "isotopes_verif_mod", where the call to function "iso_verif_tag17_q_deltad_chn" in "iso_verif_tag17_q_deltad_chn" was not detected at linking stage, although defined in the same module (?).
Location:
LMDZ6/trunk/libf/dyn3d_common
Files:
2 edited

Legend:

Unmodified
Added
Removed

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

    r4046 r4050  
    3232  TYPE(isot_type), TARGET,  SAVE, ALLOCATABLE :: isotopes(:)    !=== ISOTOPES PARAMETERS VECTOR
    3333
    34 ! iadv  : index of trasport schema for each tracer
    35   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iadv
    36 
    3734! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
    3835!         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
    3936  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    4037
    41 ! CRisi: tableaux de fils
    42   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    43   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les generations
    44   INTEGER, SAVE :: nqdesc_tot
    45   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    46   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
    4738  REAL :: qperemin,masseqmin,ratiomin ! MVals et CRisi
    4839  PARAMETER (qperemin=1e-30,masseqmin=1e-18,ratiomin=1e-16) ! MVals
    … …  
    6354  LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
    6455  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    65   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numero iso entre 1 et niso_possibles en fn de nqtot
    6656  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numero iso entre 1 et niso effectif en fn de nqtot
    67   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numero de la zone de tracage en fn de nqtot
    68   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numero de la zone de tracage en fn de nqtot
    6957  INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numero d isotope entre 1 et niso_possibles
    7058  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numero ixt en fn izone, indnum entre 1 et niso
    … …  
    128116 
    129117    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    130     INTEGER :: iq, new_iq, iiq, jq, ierr,itr
    131     INTEGER :: ifils,ipere,generation ! CRisi
     118    INTEGER :: iq, new_iq, iiq, jq, ierr,itr, iadv
     119    INTEGER :: ifils,ipere ! CRisi
    132120    LOGICAL :: continu,nouveau_traceurdef
    133121    INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
    134122    CHARACTER(len=maxlen) :: tchaine   
     123    INTEGER, ALLOCATABLE  :: iqfils(:,:)
    135124
    136125    character(len=*),parameter :: modname="infotrac_init"
    … …  
    565554!
    566555    ALLOCATE(tracers(nqtot))
    567     ALLOCATE(iadv(nqtot), niadv(nqtot))
     556    ALLOCATE(niadv(nqtot))
    568557
    569558!-----------------------------------------------------------------------
    … …  
    578567       ! Verify choice of advection schema
    579568       IF (hadv(iq)==vadv(iq)) THEN
    580           iadv(new_iq)=hadv(iq)
     569          tracers(new_iq)%iadv=hadv(iq)
    581570       ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
    582           iadv(new_iq)=11
     571          tracers(new_iq)%iadv=11
    583572       ELSE
    584573          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    … …  
    588577     
    589578       str1=tnom_0(iq)
    590        tracers(new_iq)%name=TRIM(tnom_0(iq))
    591        IF (iadv(new_iq)==0) THEN
     579       tracers(new_iq)%name = TRIM(tnom_0(iq))
     580       tracers(new_iq)%parent = TRIM(tnom_transp(iq))
     581       IF (tracers(new_iq)%iadv==0) THEN
    592582          tracers(new_iq)%longName=trim(str1)
    593583       ELSE
    594           tracers(new_iq)%longName=trim(tnom_0(iq))//descrq(iadv(new_iq))
     584          tracers(new_iq)%longName=trim(tnom_0(iq))//descrq(tracers(new_iq)%iadv)
    595585       ENDIF
    596586
    597587       ! schemas tenant compte des moments d'ordre superieur
    598588       str2=TRIM(tracers(new_iq)%longName)
    599        IF (iadv(new_iq)==20) THEN
     589       IF (tracers(new_iq)%iadv==20) THEN
    600590          DO jq=1,3
    601591             new_iq=new_iq+1
    602              iadv(new_iq)=-20
     592             tracers(new_iq)%iadv=-20
    603593             tracers(new_iq)%longName=trim(str2)//txts(jq)
    604594             tracers(new_iq)%name=trim(str1)//txts(jq)
    605595          END DO
    606        ELSE IF (iadv(new_iq)==30) THEN
     596       ELSE IF (tracers(new_iq)%iadv==30) THEN
    607597          DO jq=1,9
    608598             new_iq=new_iq+1
    609              iadv(new_iq)=-30
     599             tracers(new_iq)%iadv=-30
    610600             tracers(new_iq)%longName=trim(str2)//txtp(jq)
    611601             tracers(new_iq)%name=trim(str1)//txtp(jq)
    … …  
    620610    iiq=0
    621611    DO iq=1,nqtot
    622        IF(iadv(iq).GE.0) THEN
     612       IF(tracers(iq)%iadv.GE.0) THEN
    623613          ! True tracer
    624614          iiq=iiq+1
    … …  
    632622
    633623    DO iq=1,nqtot
    634        WRITE(lunout,*) iadv(iq),niadv(iq), ' ',trim(tracers(iq)%name),' ',trim(tracers(iq)%longName)
     624       WRITE(lunout,*) tracers(iq)%iadv,niadv(iq), ' ',trim(tracers(iq)%name),' ',trim(tracers(iq)%longName)
    635625    END DO
    636626
    … …  
    640630!
    641631    DO iq=1,nqtot
    642        IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
    643           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     632       iadv=tracers(iq)%iadv
     633       IF (ALL([10, 14, 0]/=iadv)) THEN
     634          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not tested in this version of LMDZ'
    644635          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
    645        ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
    646           WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     636       ELSE IF (iadv==14 .AND. iq/=1) THEN
     637          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv,' is not tested in this version of LMDZ'
    647638          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
    648639       ENDIF
    … …  
    653644! initialiser tous les tableaux d'indices lies aux traceurs familiaux
    654645! + verifier que tous les peres sont ecrits en premieres positions
    655     ALLOCATE(nqfils(nqtot),nqdesc(nqtot))   
    656646    ALLOCATE(iqfils(nqtot,nqtot))   
    657     ALLOCATE(iqpere(nqtot))
    658647    nqperes=0
    659     nqfils(:)=0
    660     nqdesc(:)=0
    661648    iqfils(:,:)=0
    662     iqpere(:)=0
    663     nqdesc_tot=0   
     649    tracers(:)%iqParent=0
    664650    DO iq=1,nqtot
    665651      if (tnom_transp(iq) == 'air') then
    … …  
    667653        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
    668654        nqperes=nqperes+1
    669         iqpere(iq)=0
     655        tracers(iq)%iqParent=0
    670656      else !if (tnom_transp(iq) == 'air') then
    671657        ! ceci est un fils. Qui est son pere?
    … …  
    681667                CALL abort_gcm('infotrac_init','Un fils est son propre pere',1)
    682668            endif
    683             nqfils(ipere)=nqfils(ipere)+1 
    684             iqfils(nqfils(ipere),ipere)=iq
    685             iqpere(iq)=ipere         
     669            tracers(ipere)%nqChilds = tracers(ipere)%nqChilds+1 
     670            iqfils(tracers(ipere)%nqChilds,ipere)=iq
     671            tracers(iq)%iqParent=ipere         
    686672            continu=.false.
    687673          else !if (tnom_transp(iq) == tnom_0(ipere)) then
    … …  
    697683    enddo !DO iq=1,nqtot
    698684    WRITE(lunout,*) 'infotrac: nqperes=',nqperes   
    699     WRITE(lunout,*) 'nqfils=',nqfils
    700     WRITE(lunout,*) 'iqpere=',iqpere
     685    WRITE(lunout,*) 'nqChilds=',tracers(:)%nqChilds
     686    WRITE(lunout,*) 'iqParent=',tracers(:)%iqParent
    701687    WRITE(lunout,*) 'iqfils=',iqfils
    702688
    703689! Calculer le nombre de descendants a partir de iqfils et de nbfils
    704690    DO iq=1,nqtot   
    705       generation=0
     691      tracers(iq)%iGeneration=0
    706692      continu=.true.
    707693      ifils=iq
    708694      do while (continu)
    709         ipere=iqpere(ifils)
     695        ipere=tracers(ifils)%iqParent
    710696        if (ipere.gt.0) then
    711          nqdesc(ipere)=nqdesc(ipere)+1   
    712          nqdesc_tot=nqdesc_tot+1     
    713          iqfils(nqdesc(ipere),ipere)=iq
     697         tracers(ipere)%nqDescen = tracers(ipere)%nqDescen+1   
     698         iqfils(tracers(ipere)%nqDescen,ipere)=iq
    714699         ifils=ipere
    715          generation=generation+1
     700         tracers(iq)%iGeneration=tracers(iq)%iGeneration+1
    716701        else !if (ipere.gt.0) then
    717702         continu=.false.
    718703        endif !if (ipere.gt.0) then
    719704      enddo !do while (continu)   
    720       WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation
     705      WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)), &
     706        ' est un traceur de generation: ',tracers(iq)%iGeneration
    721707    enddo !DO iq=1,nqtot
    722     WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc
     708    DO iq=1,nqtot
     709      ALLOCATE(tracers(iq)%iqDescen(tracers(iq)%nqDescen))
     710      tracers(iq)%iqDescen(:) = iqfils(1:tracers(iq)%nqDescen,iq)
     711    END DO
     712
     713    WRITE(lunout,*) 'infotrac: nqDescen=',tracers(iq)%nqDescen
    723714    WRITE(lunout,*) 'iqfils=',iqfils
    724     WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
     715    WRITE(lunout,*) 'nqDescen_tot=',SUM(tracers(:)%nqDescen)
    725716
    726717! Interdire autres schemas que 10 pour les traceurs fils, et autres schemas
    727718! que 10 et 14 si des peres ont des fils
    728719    do iq=1,nqtot
    729       if (iqpere(iq).gt.0) then
     720      if (tracers(iq)%iqParent > 0) then
    730721        ! ce traceur a un pere qui n'est pas l'air
    731722        ! Seul le schema 10 est autorise
    732         if (iadv(iq)/=10) then
    733            WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
     723        iadv=tracers(iq)%iadv
     724        if (iadv/=10) then
     725           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not implemented for sons'
    734726          CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
    735727        endif
    736728        ! Le traceur pere ne peut etre advecte que par schema 10 ou 14:
    737         IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    738           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
     729        IF (ALL([10,14]/=tracers(tracers(iq)%iqParent)%iadv)) THEN
     730          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not implemented for fathers'
    739731          CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1)
    740         endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    741      endif !if (iqpere(iq).gt.0) the
     732        endif
     733     endif
    742734    enddo !do iq=1,nqtot
    743 
     735    tracers(:)%gen0Name = ancestor(tracers)      !--- Name of the first generation ancestor
    744736
    745737
    … …  
    763755        itr=0
    764756        do iq=nqo+1, nqtot
    765           if (iso_num(iq).eq.0) then
     757          if (tracers(iq)%iso_iName.eq.0) then
    766758            itr=itr+1
    767759            write(*,*) 'itr=',itr
    768760            itr_indice(itr)=iq
    769           endif !if (iso_num(iq).eq.0) then
     761          endif !if (tracers(iq)%iso_iName.eq.0) then
    770762        enddo
    771763        if (itr.ne.nqtottr) then
    … …  
    811803    ALLOCATE(nb_isoind(nqo))
    812804    ALLOCATE(nb_traciso(niso_possibles,nqo))
    813     ALLOCATE(iso_num(nqtot))
    814805    ALLOCATE(iso_indnum(nqtot))
    815     ALLOCATE(zone_num(nqtot))
    816     ALLOCATE(phase_num(nqtot))
    817806     
    818     iso_num(:)=0
    819807    iso_indnum(:)=0
    820     zone_num(:)=0
    821     phase_num(:)=0
    822808    indnum_fn_num(:)=0
    823809    use_iso(:)=.false. 
    … …  
    841827          nb_iso(ixt,phase)=nb_iso(ixt,phase)+1   
    842828          nb_isoind(phase)=nb_isoind(phase)+1   
    843           iso_num(iq)=ixt
     829          tracers(iq)%iso_iName=ixt
    844830          iso_indnum(iq)=nb_isoind(phase)
    845831          indnum_fn_num(ixt)=iso_indnum(iq)
    846           phase_num(iq)=phase
    847 !          write(lunout,*) 'iso_num(iq)=',iso_num(iq)
    848 !          write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
    849 !          write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
    850 !          write(lunout,*) 'phase_num(iq)=',phase_num(iq)
     832          tracers(iq)%iso_iPhase=phase
    851833          goto 20
    852          else if (iqpere(iq).gt.0) then         
    853           if (tnom_0(iqpere(iq)) == tnom_trac) then
     834         else if ( tracers(iq)%iqParent> 0) then         
     835          if (tnom_0(tracers(iq)%iqParent) == tnom_trac) then
    854836!           write(lunout,*) 'Ce traceur est le fils d''un isotope'
    855837           ! c'est un traceur d'isotope
    856838           nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1
    857            iso_num(iq)=ixt
     839           tracers(iq)%iso_iName=ixt
    858840           iso_indnum(iq)=indnum_fn_num(ixt)
    859            zone_num(iq)=nb_traciso(ixt,phase)
    860            phase_num(iq)=phase
    861 !           write(lunout,*) 'iso_num(iq)=',iso_num(iq)
    862 !           write(lunout,*) 'phase_num(iq)=',phase_num(iq)
    863 !           write(lunout,*) 'zone_num(iq)=',zone_num(iq)
     841           tracers(iq)%iso_iZone=nb_traciso(ixt,phase)
     842           tracers(iq)%iso_iPhase=phase
    864843           goto 20
    865           endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
     844          endif !if (tnom_0(tracers(iq)%iqParent) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
    866845         endif !IF (tnom_0(iq) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
    867846        enddo !do ixt= niso_possibles
    … …  
    869848  20   continue
    870849      enddo !do iq=1,nqtot
    871 
    872 !      write(lunout,*) 'iso_num=',iso_num
    873 !      write(lunout,*) 'iso_indnum=',iso_indnum
    874 !      write(lunout,*) 'zone_num=',zone_num 
    875 !      write(lunout,*) 'phase_num=',phase_num
    876 !      write(lunout,*) 'indnum_fn_num=',indnum_fn_num
    877850
    878851      do ixt= 1,niso_possibles 
    … …  
    926899 
    927900    ! flags isotopiques:
    928     if (niso.gt.0) then
    929         ok_isotopes=.true.
    930     else
    931         ok_isotopes=.false.
    932     endif
     901    ok_isotopes = niso > 0
    933902!    WRITE(lunout,*) 'ok_isotopes=',ok_isotopes
    934903 
    … …  
    955924    iqiso(:,:)=0     
    956925    do iq=1,nqtot
    957         if (iso_num(iq).gt.0) then
    958           ixt=iso_indnum(iq)+zone_num(iq)*niso
    959           iqiso(ixt,phase_num(iq))=iq
     926        if (tracers(iq)%iso_iName > 0) then
     927          ixt=iso_indnum(iq)+tracers(iq)%iso_iZone*niso
     928          iqiso(ixt,tracers(iq)%iso_iPhase)=iq
    960929        endif
    961930    enddo

  • LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F

    r2270 r4050  
    6464        function iso_verif_aberrant_nostop
    6565     :           (x,iso,q,err_msg)
    66         USE infotrac
     66        USE infotrac, ONLY: tnat
    6767        implicit none
    6868       
Note: See TracChangeset for help on using the changeset viewer.