C PRECO     SOURCE    CHAT      06/08/24    21:59:25     5529           
      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 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    
      IPCHC1 = 0 
      CALL LIROBJ('MMODEL',IPMODL,1,IRTM)
      IF (IERR.NE.0) RETURN
      IPCHA1 = 0
      CALL LIROBJ('MCHAML',IPCHA1,1,IRET1)
      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
      IPCHC1=0                           
      CALL LIROBJ('MCHAML',IPCHC1,0,IRETC)
      if(ipchc1.ne.0) then
      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 ECROBJ('MCHAML',IPSTRS)
      RETURN
      END