C MEDCHP    SOURCE    CHAT      11/10/26    22:15:23     7176           
      subroutine medchp(ifid,nocham,itypch,ncomp,nbnoin,nommaa,
     $ iprofi,nprof,ichamp,nbpta,ich,icret)
      implicit real*8(a-h,o-z)
      implicit integer (i-n)
*
* subroutine pour  lire le champ par point de nom  nomcha s'il existe
* issu d'un fichier MED 
*
* il  a ncomp composante, leavaleur sont de type itypch(64bits, entier ..)
* Le retour est ich objet de type itycha
* iprofi stocke les profils deja lus et ichamp contient les noms 
* de compiosantes 
* ich contient 0 ou le pointeur du chpoint

-INC CCOPTIO
-INC SMELEME
-INC SMCHPOI
-INC SMCHAML
-INC SMTABLE
      segment iprofi
         character*32 nompro(m)
         integer melem(m)
      endsegment
      Character*16 cha16a
      character*32 cha32a, nommaa,nocham,cha32b,cha32c
      character*72 cha72
      segment ichamp
         character*16  nomcom(nc+1),iunit(nc+1)
      endsegment        
      character*8 itycha,nucham
      logical bnoel,nboel
      CHARACTER*26 MINU,MAJU                                                    
      DATA MINU/'abcdefghijklmnopqrstuvwxyz'/                                   
      DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/         
      icret=0
      ich=0
*      write(6,*) ' *** medchp nb de composantes du champ ',ncomp
*      write(6,*) ' les noms des composantes sont : ',
*     $ (nomcom(iou),iou=1,ncomp)
      nc = ncomp 
*      i11=1
*
* quelques initialisations 
*
*
      nat=1
      nsoupo=1
      nbnn=1
      nbsous=0
      nbref=0
      n=1  
      nsoupo=1
*            
*      write(6,*) ' entree dans medchp '   
** le 3 represente MED_NOEUD
*      if(i11.ne.1) write(6,*) ' tou va mal 1'
      call efnpdt4(ifid,nocham,3,0,npasdt,icret)
*      if(i11.ne.1) write(6,*) ' tou va mal 2'
*      write(6,*)'sortie appel efnpdt nb de pas de temps ',npasdt
      if(icret.ne.0)  then
*        write(6,*) ' plouf 13'
        call efexit4(-1)
        return
      endif
      if(npasdt.eq.0) then
*        write(6,*) ' ce n est pas un chpoint'
        return 
      endif  
      if( npasdt.gt.1) then
*  on stocke les champs dans deux tables resultats ( temps , champoint).            
        m=npasdt
        segini mtable,mtab1
        mlotab=m   
        m=2 
        segini mtab2
        call ecctab(mtab2,'MOT',ii,xv,'CHAMPS',nboel,iob,'TABLE   ',
     $             ii,xv,itycha,nboel,mtable)
        call ecctab(mtab2,'MOT',ii,xv,'INSTANTS',nboel,iob,'TABLE   ',
     $             ii,xv,itycha,nboel,mtab1)
      endif
*      if(i11.ne.1) write(6,*) ' tou va mal 3'
      nprof=0
      ngauss=0       
      do ib=1,npasdt
        segini mchpoi
        if( npasdt.gt.1) then
          mtabti(ib)='ENTIER'
          mtabii(ib)=ib
          mtabtv(ib)='CHPOINT'
*          mtab1.mtabti(ib)='ENTIER'
*          mtab1.mtabii(ib)=ib
*          mtab1.mtabtv(ib)='FLOTTANT'
        endif
** 3 pour MED_NOEUD    
*        write(6,*) ' avant appel à efpdti ' 
*        if(i11.ne.1) write(6,*) ' tou va mal 4'
        i33=3
        i00=0
        bnoel=.false.
*        if(.not.bnoel) write(6,*) 'avant appel efpdti4 bnoel ', bnoel
        call efpdti4( ifid,nocham,i33,i00,ib,ngauss,numdt,
     &  numo,iunit,dt,cha32a,bnoel,nbmaa,icret)
*        call efpdti4(ifid, nocham,i33,I00, 
*     &              ib, ngauss, numdt, numo, iunit,
*     &              dt, cha32a, bnoel, nbmaa, icret)
*        write (6,*)' nbmaa   bnoel (local)' , nbmaa,bnoel
        if( nbmaa.ne.1) then  
          call erreur (1013)
          icret=1
          return
        endif
        if (.not.bnoel)then
*          write(6,*) ' bnoel ' , bnoel
          call erreur (1012)
          icret=1
          return
        endif
        if(icret.ne.0)  then    
*          write(6,*) ' plouf 141'
          call efexit4(-1)
          return
        endif    
*        write(6,*)'numdt,numo,ngauss,dt',numdt,numo,ngauss,dt
** 2 pour MED_COMPACT
** 3 pour MED_NOEUD
*        write(6,*) ' avant appel à efnval '    
        call efnval4(ifid,nocham,3,0,numdt,numo
     $              ,cha32a,2,nval,icret)
*        write(6,*) ' apres appel à efnval  ',numdt,numo,cha32a      
        if(icret.ne.0)  then
*          write(6,*) ' plouf 142'
          call efexit4(-1)
          return
        endif     
*        write(6,*)' le champ ' , nocham , 'contient', nval,' valeurs' 
        if(npasdt.gt.1)then
          call ecctab(mtab1,'ENTIER',ib,xva,cha16a,nboel,iob,
     $                'FLOTTANT',iob,dt,cha16a,nboel,iob)
        endif
        n=nval
        segini mpoval
        ifopoi=ifour
*        write(6,*) ' avant appel efchal'            
        call efchal4(ifid,cha32a,nocham,vpocha,0,0,cha32c,cha32b,2,3,
     $              0,numdt,numo,icret)    
*        write(6,*)'sortie appel efchal cha32a cha32b ',cha32a,cha32b     
        if(icret.ne.0)  then
*          write(6,*) ' plouf 15'
          call efexit4(-1)
          return
        endif
        segdes mpoval 
        segini msoupo
        ipoval=mpoval           
        ipchp(1)=msoupo
        jattri(1)=1
        segdes mchpoi           
        do ic=1,nc
          nocomp(ic)=nomcom(ic)
        enddo
        nbelem=n  
*        write(6,*) ' cha32b ', cha32b
*        write(6,*) ' nompro ' , nprof,( nompro(iou),iou=1,nprof)    
        do ic = 1, nprof
          if( cha32b.eq.nompro(ic)) then
            igeoc= melem(ic)
            go to 555
          endif  
        enddo
        nbelem=nval
        nbnn=1
        nbref=0
        nbsous=0
        segini meleme
        itypel=1
        if (cha32b.ne.' ') then 
          nprof=nprof+1
          if(nprof.gt.melem(/1)) then
             m=nprof+50
             segadj iprofi
          endif
*          write(6,*) ' avant appel efpfll nb points dans profil',nval
          nompro(nprof)=cha32b
          call efpfll4(ifid,num,cha32b,icret,num,nbelem)
          if(nbnoin.ne.0) then
            do iuy=1,nbelem
              num(1,iuy)=num(1,iuy)+nbnoin
            enddo
          endif
*          write(6,*) ' sortie appel efpfll profil de nom  ' ,cha32b
          if(icret.ne.0)  then
*            write(6,*) ' plouf 16'
            call efexit4(-1)
            return
          endif
        else
*          write(6,*) 'on prend tous les ' , nbpta , ' points'
          do iou=1,nbpta
            num(1,iou)=iou+nbnoin
          enddo
        endif                      
        segdes meleme
        if(nprof.ne.0) melem(nprof)=meleme
        igeoc=meleme
  555   continue
        segdes msoupo
        segdes mchpoi        
        if(npasdt.gt.1) then
          mtabiv(ib)=mchpoi
        endif
      enddo
      segsup ichamp
      if(npasdt.gt.1) then
        segdes mtab1,mtab2, mtable
        itycha='TABLE'
        ich=mtab2
      else
        itycha='CHPOINT'
        ich=mchpoi
      endif
      nucham=nocham
      do iaux=1,8
        IRAL=INDEX(MINU,nocham(IAUX:IAUX))                                          
        IF (IRAL.NE.0) nucham(IAUX:IAUX)=MAJU(IRAL:IRAL)
      enddo   
*      write(6,*) nocham , nucham                
*     write(6,*) ' on nomme : ' , nucham ,'l objet de type ', itycha
      call nomobj(itycha,nucham,ich)
      return
      end