C FORCE2    SOURCE    KICH      08/07/30    21:15:10     6140           
      SUBROUTINE FORCE2(IPT)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC CCOPTIO
-INC SMTABLE
      CHARACTER*4 MOTYPO(10),charm,charre
      character*8 typret
      CHARACTER*4 MODEDU(6),MORODU(5)
      REAL*8 XXA,vval,X0,X1
      DATA MODEDU / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ' /
      DATA MORODU / 'MX  ','MY  ','MZ  ','MT  ','MS  ' /

      mtable = ipt
      segact mtable
      ima = mlotab - 1 
      if (ima.eq.1) RETURN 
      do 1200 im = 1,ima
           typret = ' '
           CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0,
     &                   'TABLE',I1,X1,CHARRE,.true.,ITMOD)
           if (ierr.ne.0) return
           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DDL_LIAISON',.true.,IP0,
     &                      typret,I1,X1,charre,.true.,IR1)
           if (typret.ne.'MOT') goto 1200
           do kmo = 1,6
            if (charre.eq.modedu(kmo)) goto 220
           enddo
           do kmo = 1,5
            if (charre.eq.morodu(kmo)) goto 220
           enddo
cc           write(6,*)  charre,' ne correspond pas à un effort'
           goto 1200
 220       continue
           CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0,
     &                      'POINT',I1,X1,charre,.true.,IPTS)
           if (ierr.ne.0) return


           if (ierr.ne.0) return
*
         call ecrobj('POINT',IPTS)
         call ecrree(1.d0)
         call ecrcha(charre)
         call force(1)
         call lirobj('CHPOINT',ichpoi,1, iretou)
         if (ierr.ne.0) return

           CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'FORCE',.TRUE.,IPO,
     &        'CHPOINT',0,0.0D0,' ',.TRUE.,ichpoi)

 1200 continue
      segdes mtable
      return
      END