C RECOF1    SOURCE    KICH      06/03/17    21:17:14     5342           
      SUBROUTINE RECOF1(itbst,itbm,ichp1,ipout)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

      CHARACTER*4  mocom1,motddl
-INC CCOPTIO                                                                    
-INC SMCHPOI
-INC SMELEME
-INC SMTABLE
-INC SMCOORD

      segment icta
        integer icpt(ima)
        character*4 iccomp(ima)
      endsegment
      segment icpr(nbpts)
      

      nbpts=xcoor(/1)/(idim+1)
      segini icpr
          mtable = itbst
          segact mtable
          ima = mlotab - 1
      segini icta
      ipout = 0 
      if (itbm.gt.0) then 
          CALL ACCTAB(itbm,'MOT',0,0.0D0,'MODES',.TRUE.,0,
     &        'TABLE',0,0.0D0,' ',.TRUE.,ITBM2)   
         if (ierr.ne.0) return
      endif       
      mchpoi = ichp1 
      segact mchpoi
      nsoupo = ipchp(/1)
      DO is = 1 ,nsoupo
       msoupo = ipchp(is)
       segact msoupo
       NC = NOCOMP(/2)
       meleme = igeoc
       mpoval = ipoval
       segact meleme,mpoval
       N = vpocha(/1)
       DO ic = 1,NC
        mocom1 = nocomp(ic)
        if (mocom1.eq.'BETA') then
          mtable = itbst
          segact mtable
          ima = mlotab - 1
        else if (mocom1.eq.'ALFA'.and.itbm2.gt.0) then
          mtable = itbm2
          segact mtable
          ima = mlotab - 2
        else
          goto 95
        endif
        DO 90 ipn = 1 , N
          ipts = num(1,ipn)
          sca1 = vpocha(ipn,ic)
           do 85 im =1,ima
          CALL ACCTAB(mtable,'ENTIER',IM,0.0D0,' ',.TRUE.,0,
     &        'TABLE',0,0.0D0,' ',.TRUE.,ITMOD)
             if (ierr.ne.0) return
          CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'POINT_REPERE',.TRUE.,0,
     &        'POINT',0,0.0D0,' ',.TRUE.,IPOI)
             if (ierr.ne.0) return
             if (ipoi.ne.ipts) goto 85
             if (mocom1.eq.'BETA') then
          CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'DEFORMEE',.TRUE.,0,
     &        'CHPOINT',0,0.0D0,' ',.TRUE.,ICHIN)                            
          CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'POINT_LIAISON',.TRUE.,0,
     &        'POINT',0,0.0D0,' ',.TRUE.,IPL1)
          CALL ACCTAB(ITMOD,'MOT',I0,X0,'DDL_LIAISON',.TRUE.,I6,
     &        'MOT',I7,X1,motddl,.TRUE.,I7)
               icpt(im) = ipl1
               iccomp(im) = motddl
               icpr(ipl1) = icpr(ipl1) + 1
             else if (mocom1.eq.'ALFA') then
          CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'DEFORMEE_MODALE',.TRUE.,0,
     &        'CHPOINT',0,0.0D0,' ',.TRUE.,ICHIN)
             else
             endif
             if (ipout.gt.0) then
              ich1 = ipout
              call adchpo(ich1,ichin,ipout,1.d0,sca1)
             else     
              call muchpo(ichin,sca1,ipout,1)
             endif     
             goto 90
 85        continue
 90     CONTINUE
 95     continue
       ENDDO

       segdes msoupo,meleme,mpoval
      ENDDO
      segdes mchpoi
* correction du chpoint aux points de liaison

      ima = icpt(/1)
      mchpoi = ipout 
      segact mchpoi
      nsoupo = ipchp(/1)
      DO is = 1 ,nsoupo
       msoupo = ipchp(is)
       segact msoupo
       NC = NOCOMP(/2)
       meleme = igeoc
       mpoval = ipoval
       segact meleme,mpoval*mod
       N = vpocha(/1)
       DO ic = 1,NC
        mocom1 = nocomp(ic)

        DO 180 ipn = 1 , N
          ipts = num(1,ipn)
          kpt = 0
            if (icpr(ipts).eq.0) goto 180
            do 170 im = 1,ima
              if (icpt(im).ne.ipts) goto 170
              if (iccomp(im).ne.mocom1) goto 170
              kpt = kpt + 1
 170        continue

          if (kpt.ne.0) vpocha(ipn,ic) = vpocha(ipn,ic)/kpt

 180   CONTINUE

       ENDDO
      ENDDO

      segdes mchpoi
      segsup icta,icpr

      RETURN
      END