Esope source files

   1 : C PRECO     SOURCE    CHAT      06/08/24    21:59:25     5529           
   2 :       SUBROUTINE PRECO
   3 : C======================================================================C
   4 : C                                                                      C
   5 : C     OPERATEUR DE PRECONTRAINTES D'UN CABLE ET DE FORCE DU            C
   6 : C               CABLE SUR LE BETON                                     C
   7 : C                                                                      C
   8 : C       PREC=PREC MODL MCH1 PS1 TAB1  (PRE1) ( GEO1)  ;                                C
   9 : C  ENTREES :                                                                     C
  10 : C       MODL :   MODELE DE CABLE                                       C
  11 : C       IPCHA1 : CARACTERISTIQUES DU CABLE                             C
  12 : C       PS1  :  tension appliquee a  l' extremite du cable             C
  13 : C       GEO1 :  maillage des point d application de la tension         C
  14 : C              
  15 : C                                                                      C
  16 : C       IPTAB: table dans laquelle sont ranges les parametres de pertes
  17 : C  SORTIE  :
  18 : C       IPSTRS  MCHAML de contraintes resultant ( EFFX ces tun effort) C
  19 : C======================================================================C
  20 :       IMPLICIT INTEGER(I-N)
  21 :       IMPLICIT REAL*8(A-H,O-Z)
  22 : -INC CCOPTIO
  23 : -INC SMELEME
  24 :         ipmail=0
  25 : C lecture eventuelle  des extremites ou on applique la tension   
  25 :       CALL LIROBJ('MAILLAGE',IPMAIL,0,IRET)
  26 : C  rattrapage eventuel si il n y a q un cable et qu'on a donné un POINT
  27 :       if(ipmail.eq.0) then       
  28 :       INOD1 = 0 
  28 :       CALL LIROBJ('POINT   ',INOD1,0,IRETP)
  29 :       if(inod1.ne.0) then
  30 :       NBNN =1
  31 :       NBELEM=1
  32 :       nbsous=0
  33 :       nbref=0
  34 :       segini MELEME
  35 :       itypel=1
  36 :       num(1,1)=inod1
  37 :       ipmail = meleme 
  38 :       segdes meleme
  39 :       endif
  40 :       endif  
  41 : C      
  42 : C --- LECTURE DU MODELE 
  43 : C    
  44 :       IPCHC1 = 0 
  44 :       CALL LIROBJ('MMODEL',IPMODL,1,IRTM)
  45 :       IF (IERR.NE.0) RETURN
  46 :       IPCHA1 = 0
  46 :       CALL LIROBJ('MCHAML',IPCHA1,1,IRET1)
  47 :       IF (IERR.NE.0) RETURN 
  48 :       IPTAB=0     
  48 :       CALL LIROBJ('TABLE',IPTAB,0,IRETOU)
  49 :       IF (IERR.NE.0) RETURN     
  49 :       CALL LIRREE(PS1,1,IRETOU)
  50 :       IF (IERR.NE.0) RETURN
  51 :       IPCHC1=0                           
  51 :       CALL LIROBJ('MCHAML',IPCHC1,0,IRETC)
  52 :       if(ipchc1.ne.0) then
  52 :       call rngcha(ipcha1,ipchc1,'CARACTERISTIQUES','CONTRAINTES',
  53 :      &            ipcar,ipcont)
  54 :       else
  55 :       ipcont = 0
  56 :       ipcar= ipcha1 
  57 :       endif 
  58 : C
  58 :        CALL PRECOP (IPMODL,ipcar,IPTAB,IPSTRS,IPMAIL,
  59 :      &              PS1,ipcont,IRET)
  60 : C
  61 :       IF(IRET.EQ.0) RETURN
  61 :       CALL ECROBJ('MCHAML',IPSTRS)
  62 :       RETURN
  63 :       END
  64 : 
  65 : 
  66 : 
  67 :  
  68 :  
  69 :  
  70 :  
  71 :  
  72 :