C EVTEMP    SOURCE    CHAT      11/05/27    21:15:16     6984           
      subroutine EVTEMP(icoul)
      implicit integer(i-n)
      implicit real*8(a-h,o-z)
-INC CCOPTIO
-INC SMCHAML
-INC SMCHPOI
-INC SMTABLE
-INC SMLREEL
-INC SMEVOLL
-INC SMELEME
      logical login
      character*8 typobj
      character*18 charin,chalu
      character*1 charre
      character*4 compo,noco
      character*8 nompoi
      call lirobj ('TABLE   ',mtable,1,iretou)
      if(ierr.ne.0) return
      ilo=0
      call lircha(chalu,1,ilo)
      TYPOBJ='TABLE'
      charin='TEMPS'
      segact mtable
      call acctab(mtable,'MOT',ivalin,xvalin,charin(1:5),login,iobi,
     $   TYPOBJ,ivalin,xvalin,charre,login,mtab1)
      if( ierr.ne.0) return
      segact mtable
      call acctab(mtable,'MOT',ivalin,xvalin,chalu(1:ilo),login,iobi,
     $   TYPOBJ,ivalin,xvalin,charre,login,mtab2)
      if( ierr.ne.0) return  
      compo=' '     
      call lircha (compo,0,ilp)    
      segact mtab1,mtab2
      typobj=mtab2.mtabtv(1)
      if(typobj.eq.'CHPOINT ') then
        call lirobj('POINT' , IP1,1,iretou)
        call quenom(nompoi)
        if(ierr.ne.0) then
          moterr(1:8)='TABLE'
          segdes mtab1,mtab2
          return
        endif
        jg = mtab1.mlotab
        if(mtab2.mlotab.ne.jg) then
          segdes mtab1,mtab2
          call erreur ( 1015 )
          return
        endif
        segini mlree1,mlree2 
        do 10 ia=1,mtab1.mlotab

          mlree1.prog(ia)= mtab1.rmtabv(ia)
          mchpoi=mtab2.mtabiv(ia)
          segact mchpoi
          if( ipchp(/1).eq.0.and.ia.eq.1) then
            mlree2.prog(ia)=0.  
            segdes mchpoi  
            go to 10
          endif
          do 11 isou=1,ipchp(/1)
            msoupo= ipchp(isou)
            segact msoupo
            meleme=igeoc
            segact meleme
            noco=nocomp(1)
            icomp=1
            do  12 iel=1,num(/2)
              if(num(1,iel).eq.ip1) then                
                if(ilp.eq.0.and.nocomp(/2).ne.1) then
                  MOTERR(1:8)='chpoint' 
                  INTERR(1)=NOCOMP(/2)
                  call erreur(761)
                  segdes meleme,msoupo,mchpoi
                  go to 100
                endif
                do 13 icomp=1,nocomp(/2)
                  noco=nocomp(icomp)
                  if(nocomp(icomp).eq.compo) goto 14
   13           continue
                
                MOTERR(1:4)=COMPO
                moterr(5:12)='CHPOINT'
                interr(1)=ip1           
                call erreur(65)
                segdes meleme,msoupo,mchpoi
                go to 100
   14           continue
                mpoval=ipoval
                segact mpoval
                noco=nocomp(icomp)
                mlree2.prog(ia)=vpocha(iel,icomp)
                segdes mpoval
                segdes meleme
                segdes mchpoi
                segdes msoupo
                go to 10
              endif
   12       continue
            segdes meleme
            segdes msoupo                 
   11     continue
          interr(1)=ip1
          moterr(1:)='CHPOINT'
          call erreur(64)
          segdes mchpoi
          go to 100         
   10   continue
   
        segdes mlree1,mlree2
        N=1
        
        segini mevoll
        ityevo='REEL'
        IEVTEX=chalu(1:ilo)//' '//noco//' fonction du temps du point '
     $   //nompoi
        segini kevoll
        ievoll(1)=kevoll
        iprogx=mlree1
        iprogy=mlree2
        numevx=icoul
        NUMEVY='REEL'
        NOMEVY=chalu(1:6) // '  '//noco 
        NOMEVX='TEMPS'                                                             
        TYPX='LISTREEL'                                                           
        TYPY='LISTREEL' 
        KEVTEX=chalu(1:ilo)//' fonction du temps du point '//nompoi  
  101   format (I6) 
        segdes mevoll,kevoll 
        call ecrobj('EVOLUTIO',mevoll)
        return                             
      elseif(typobj.eq.'MCHAML' )then
        call lirent ( izo,1,iretou)
        if(ierr.ne.0) return  
        call lirent(iel,1,iretou)
        if(ierr.ne.0) return 
        call lirent(iga,1,iretou)
        if(ierr.ne.0) return
        jg = mtab1.mlotab
        if(mtab2.mlotab.ne.jg) then
          segdes mtab1,mtab2
          call erreur ( 1015 )
          go to 100
        endif
        segini mlree1,mlree2    
        do 20 ia = 1, mtab2.mlotab
          mlree1.prog(ia)= mtab1.rmtabv(ia)
          mchelm=mtab2.mtabiv(ia)
          segact mchelm 
          if( ichaml(/1).lt.izo) then
            call erreur(279)
            segdes mchelm
            go to 100
          endif       
          mchaml=ichaml(izo)
          meleme=imache(izo)
          segact mchaml,meleme
          icomp=1
          if(ilp.eq.0.and.nocomp(/2).ne.1) then
             MOTERR(1:8)='MCHAML' 
             INTERR(1)=NOMCHE(/2)
             call erreur(761)
             segdes mchaml,mchelm,meleme
             go to 100
          endif
          if(num(/2).lt.iel) then
            call erreur(262)
            segdes mchelm,mchaml,meleme
            go to 100
          endif
          noco=nomche(1)
          icomp=1
          do 23 icomp=1,nomche(/2)
            noco=nomche(icomp)
            if(noco.eq.compo) goto 24
   23     continue
          MOTERR(1:4)=COMPO
          moterr(5:12)='MCHAML'
          interr(1)=ip1           
          call erreur(65)
          segdes mchelm,mchaml,meleme
          go to 100
   24     continue
          melval=ielval(icomp)
          segact melval
         mlree2.prog(ia)=velche(min(velche(/1),iga),min(velche(/2),iel))
          segdes melval
          segdes mchaml,meleme
          segdes mchelm
   20   continue                
      endif
      N=1        
      segini mevoll
      segini kevoll
      ityevo='REEL'
      if(typobj.eq.'CHPOINT ') then     
      IEVTEX=chalu(1:ilo)//' '//noco//' fonction du temps du point '
     $   //nompoi
      elseif(typobj.eq.'MCHAML') then
      IEVTEX=chalu(1:ilo)//' '//noco//' zone '
      write(ievtex(ilo+12:ilo+36),102)izo,' elem ',iel,' gauss ',iga
      endif
  102 format (I4,A6,i6,a7,i2) 
      KEVTEX=IEVTEX        
      ievoll(1)=kevoll
      iprogx=mlree1
      iprogy=mlree2
      numevx=icoul
      NUMEVY='REEL'
      NOMEVY=chalu(1:6) // '  '//noco 
      NOMEVX='TEMPS'                                                             
      TYPX='LISTREEL'                                                           
      TYPY='LISTREEL'   
      segdes mevoll,kevoll 
      call ecrobj('EVOLUTIO',mevoll)
      return                                         
100   continue 
      segsup mlree1,mlree2    
      return
      end