C PRECO     SOURCE    CB215821  19/07/31    21:16:26     10277          
      SUBROUTINE PRECO
C======================================================================C
C                                                                      C
C     OPERATEUR DE PRECONTRAINTES D'UN CABLE ET DE FORCE DU            C
C               CABLE SUR LE BETON                                     C
C                                                                      C
C       PREC=PREC MODL MCH1 PS1 TAB1  (PRE1) ( GEO1)  ;                                C
C  ENTREES :                                                                     C
C       MODL :   MODELE DE CABLE                                       C
C       IPCHA1 : CARACTERISTIQUES DU CABLE                             C
C       PS1  :  tension appliquee a  l' extremite du cable             C
C       GEO1 :  maillage des point d application de la tension         C
C
C                                                                      C
C       IPTAB: table dans laquelle sont ranges les parametres de pertes
C  SORTIE  :
C       IPSTRS  MCHAML de contraintes resultant ( EFFX ces tun effort) C
C======================================================================C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
        ipmail=0
C lecture eventuelle  des extremites ou on applique la tension
      CALL LIROBJ('MAILLAGE',IPMAIL,0,IRET)
C  rattrapage eventuel si il n y a q un cable et qu'on a donné un POINT
      if(ipmail.eq.0) then
      INOD1 = 0
      CALL LIROBJ('POINT   ',INOD1,0,IRETP)
      if(inod1.ne.0) then
      NBNN =1
      NBELEM=1
      nbsous=0
      nbref=0
      segini MELEME
      itypel=1
      num(1,1)=inod1
      ipmail = meleme
      segdes meleme
      endif
      endif
C
C --- LECTURE DU MODELE
C
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRTM)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
      
      IPCHA1 = 0
      CALL LIROBJ('MCHAML  ',IPIN,1,IRET1)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF (IERR.NE.0) RETURN
      CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
      
      IPTAB=0
      CALL LIROBJ('TABLE',IPTAB,0,IRETOU)
      IF (IERR.NE.0) RETURN
      
      CALL LIRREE(PS1,1,IRETOU)
      IF (IERR.NE.0) RETURN
      
      CALL LIROBJ('MCHAML ',IPIN,0,IRETC)
      IF (IERR.NE.0) RETURN
      IPCHC1=0
      
      if(IRETC .EQ. 1) then
        CALL ACTOBJ('MCHAML ',IPIN,1)
        CALL REDUAF(IPIN,IPMODL,IPCHC1,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
        call rngcha(ipcha1,ipchc1,'CARACTERISTIQUES','CONTRAINTES',
     &              ipcar,ipcont)
      else
        ipcont = 0
        ipcar= ipcha1
      endif
C
       CALL PRECOP (IPMODL,ipcar,IPTAB,IPSTRS,IPMAIL,
     &              PS1,ipcont,IRET)
C
      IF(IRET.EQ.0) RETURN
      
      CALL ACTOBJ('MCHAML  ',IPSTRS,1)
      CALL ECROBJ('MCHAML  ',IPSTRS)

      END