Ignore:
Timestamp:
May 22, 2018, 4:30:21 PM (6 years ago)
Author:
acozic
Message:

Add modification for isotopes

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/IPSLCM5A2.1_ISO/libf/dyn3d_common/infotrac.F90

    r2567 r3331  
    1111!        number of tracers used in the physics
    1212  INTEGER, SAVE :: nbtr
     13
     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
    1318
    1419! CRisi: nb traceurs pères= directement advectés par l'air
    … …  
    98103 
    99104    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    100     INTEGER :: iq, new_iq, iiq, jq, ierr
     105    INTEGER :: iq, new_iq, iiq, jq, ierr,itr
    101106    INTEGER :: ifils,ipere,generation ! CRisi
    102107    LOGICAL :: continu,nouveau_traceurdef
    103108    INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
    104     CHARACTER(len=15) :: tchaine   
     109    CHARACTER(len=30) :: tchaine   
    105110
    106111    character(len=*),parameter :: modname="infotrac_init"
    … …  
    203208          CALL abort_gcm('infotrac_init','Bad number of water phases',1)
    204209       END IF
    205        ! nbtr has been read from INCA by init_const_lmdz() in gcm.F
    206 #ifdef INCA
    207        CALL Init_chem_inca_trac(nbtr)
    208 #endif       
    209        nqtrue=nbtr+nqo
    210 
    211        ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr))
     210! On déplace ce qui suit plus bas, une fois qu'on connait nbtr retranché des
     211! isotopes
     212!       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F
     213!#ifdef INCA
     214!       CALL Init_chem_inca_trac(nbtr)
     215!#endif       
     216!       nqtrue=nbtr+nqo
     217!
     218!       ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr))
    212219
    213220    END IF   ! type_trac
    … …  
    300307                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    301308                tnom_0(iq)=tchaine(1:iiq-1)
    302                 tnom_transp(iq)=tchaine(iiq+1:15)
     309                tnom_transp(iq)=tchaine(iiq+1:LEN_TRIM(tchaine))
    303310             else
    304311                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    364371!jyg<
    365372!
    366 ! Transfert number of tracers to Reprobus
    367     IF (type_trac == 'repr') THEN
    368 #ifdef REPROBUS
    369        CALL Init_chem_rep_trac(nbtr)
    370 #endif
    371     END IF
     373! On déplace ce qui suit plus bas une fois qu'on a retranché les isotopes de
     374! nbtr
     375!! Transfert number of tracers to Reprobus
     376!    IF (type_trac == 'repr') THEN
     377!#ifdef REPROBUS
     378!       CALL Init_chem_rep_trac(nbtr)
     379!#endif
     380!    END IF
    372381!
    373382! Allocate variables depending on nbtr
    374383!
    375     ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
    376     conv_flg(:) = 1 ! convection activated for all tracers
    377     pbl_flg(:)  = 1 ! boundary layer activated for all tracers
     384!    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
     385!    conv_flg(:) = 1 ! convection activated for all tracers
     386!    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
    378387!
    379388!!    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
    … …  
    416425                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    417426                tnom_0(iq)=tchaine(1:iiq-1)
    418                 tnom_transp(iq)=tchaine(iiq+1:15)
     427                tnom_transp(iq)=tchaine(iiq+1:LEN_TRIM(tchaine))
    419428             else
    420429                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    423432                tnom_transp(iq) = 'air'
    424433             endif
    425              write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>'
     434             write(lunout,*) 'infotrac 426: tnom_0(iq)=<',trim(tnom_0(iq)),'>'
    426435             write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
    427436
    … …  
    607616        continu=.true.
    608617        ipere=1
    609         do while (continu)           
     618        do while (continu)   
     619          write(lunout,*) 'infotrac 610: ipere,tnom_0(ipere)=',ipere,tnom_0(ipere)
     620          write(lunout,*) 'tnom_transp(iq)=',tnom_transp(iq)       
    610621          if (tnom_transp(iq) == tnom_0(ipere)) then
    611622            ! Son père est ipere
    612623            WRITE(lunout,*) 'Le traceur',iq,'appele ', &
    613624      &          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
    614628            nqfils(ipere)=nqfils(ipere)+1 
    615629            iqfils(nqfils(ipere),ipere)=iq
    … …  
    621635                WRITE(lunout,*) 'Le traceur',iq,'appele ', &
    622636      &          trim(tnom_0(iq)),', est orpelin.'
     637                write(lunout,*) 'ipere,nqtot=',ipere,nqtot
    623638                CALL abort_gcm('infotrac_init','Un traceur est orphelin',1)
    624639            endif !if (ipere.gt.nqtot) then
    … …  
    676691! detecter quels sont les traceurs isotopiques parmi des traceurs
    677692    call infotrac_isoinit(tnom_0,nqtrue)
     693
     694    if (ntraciso.gt.0) then
     695! retrancher les traceurs isotopiques de la liste des traceurs qui passent dans
     696! phytrac
     697        nbtr=nbtr-nqo*ntraciso
     698
     699! faire un tableau d'indice des traceurs qui passeront dans phytrac
     700        nqtottr=nqtot-nqo*(1+ntraciso)
     701        write(*,*) 'infotrac 704: nqtottr,nqtot,nqo=',nqtottr,nqtot,nqo
     702        ! Rq: nqtottr n'est pas forcément égal à nbtr dans le cas où new_iq /= nqtrue
     703        ALLOCATE (itr_indice(nqtot)) 
     704        itr_indice(:)=0 
     705        itr=0
     706        do iq=nqo+1, nqtot
     707          if (iso_num(iq).eq.0) then
     708            itr=itr+1
     709            write(*,*) 'itr=',itr
     710            itr_indice(itr)=iq
     711          endif !if (iso_num(iq).eq.0) then
     712        enddo
     713        if (itr.ne.nqtottr) then
     714            CALL abort_gcm('infotrac_init','pb dans le calcul de nqtottr',1)
     715        endif
     716    endif !if (ntraciso.gt.0) then
     717
     718! on déplace les initialisations de REPROBUS ou INCA ici, avec la nouvelle
     719! valeur de nbtr
     720
     721     if (type_trac == 'inca') then
     722       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F
     723#ifdef INCA
     724       CALL Init_chem_inca_trac(nbtr)
     725#endif       
     726       nqtrue=nbtr+nqo
     727
     728       ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr))
     729    endif
     730
     731! Transfert number of tracers to Reprobus
     732    IF (type_trac == 'repr') THEN
     733#ifdef REPROBUS
     734       CALL Init_chem_rep_trac(nbtr)
     735#endif
     736    END IF
     737!
     738! Allocate variables depending on nbtr
     739!
     740    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
     741    conv_flg(:) = 1 ! convection activated for all tracers
     742    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
     743
    678744       
    679745!-----------------------------------------------------------------------
    … …  
    732798
    733799    do iq=nqo+1,nqtot
    734 !       write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq)
     800       write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq)
    735801       do phase=1,nqo   
    736802        do ixt= 1,niso_possibles   
    737803         tnom_trac=trim(tnom_0(phase))//'_'
    738804         tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt))
    739 !         write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac     
     805         write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac     
    740806         IF (tnom_0(iq) == tnom_trac) then
    741 !          write(lunout,*) 'Ce traceur est un isotope'
     807          write(lunout,*) 'Ce traceur est un isotope'
    742808          nb_iso(ixt,phase)=nb_iso(ixt,phase)+1   
    743809          nb_isoind(phase)=nb_isoind(phase)+1   
    … …  
    746812          indnum_fn_num(ixt)=iso_indnum(iq)
    747813          phase_num(iq)=phase
    748 !          write(lunout,*) 'iso_num(iq)=',iso_num(iq)
    749 !          write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
    750 !          write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
    751 !          write(lunout,*) 'phase_num(iq)=',phase_num(iq)
     814          write(lunout,*) 'iso_num(iq)=',iso_num(iq)
     815          write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
     816          write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
     817          write(lunout,*) 'phase_num(iq)=',phase_num(iq)
    752818          goto 20
    753819         else if (iqpere(iq).gt.0) then         
    754820          if (tnom_0(iqpere(iq)) == tnom_trac) then
    755 !           write(lunout,*) 'Ce traceur est le fils d''un isotope'
     821           write(lunout,*) 'Ce traceur est le fils d''un isotope'
    756822           ! c'est un traceur d'isotope
    757823           nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1
    … …  
    760826           zone_num(iq)=nb_traciso(ixt,phase)
    761827           phase_num(iq)=phase
    762 !           write(lunout,*) 'iso_num(iq)=',iso_num(iq)
    763 !           write(lunout,*) 'phase_num(iq)=',phase_num(iq)
    764 !           write(lunout,*) 'zone_num(iq)=',zone_num(iq)
     828           write(lunout,*) 'iso_num(iq)=',iso_num(iq)
     829           write(lunout,*) 'phase_num(iq)=',phase_num(iq)
     830           write(lunout,*) 'zone_num(iq)=',zone_num(iq)
    765831           goto 20
    766832          endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
    … …  
    771837      enddo !do iq=1,nqtot
    772838
    773 !      write(lunout,*) 'iso_num=',iso_num
    774 !      write(lunout,*) 'iso_indnum=',iso_indnum
    775 !      write(lunout,*) 'zone_num=',zone_num 
    776 !      write(lunout,*) 'phase_num=',phase_num
    777 !      write(lunout,*) 'indnum_fn_num=',indnum_fn_num
     839      write(lunout,*) 'iso_num=',iso_num
     840      write(lunout,*) 'iso_indnum=',iso_indnum
     841      write(lunout,*) 'zone_num=',zone_num 
     842      write(lunout,*) 'phase_num=',phase_num
     843      write(lunout,*) 'indnum_fn_num=',indnum_fn_num
     844      write(lunout,*) 'nb_iso=',nb_iso
    778845
    779846      do ixt= 1,niso_possibles 
    … …  
    823890    ! dimensions isotopique:
    824891    ntraciso=niso*(ntraceurs_zone+1)
    825 !    WRITE(lunout,*) 'niso=',niso
    826 !    WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso   
     892    WRITE(lunout,*) 'niso=',niso
     893    WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso 
     894    WRITE(lunout,*) 'use_iso=',use_iso 
    827895 
    828896    ! flags isotopiques:
    … …  
    832900        ok_isotopes=.false.
    833901    endif
    834 !    WRITE(lunout,*) 'ok_isotopes=',ok_isotopes
     902    WRITE(lunout,*) 'infotrac 837: ok_isotopes=',ok_isotopes
    835903 
    836904    if (ok_isotopes) then
Note: See TracChangeset for help on using the changeset viewer.