Télécharger la plaquette Cast3M


fr en

Télécharger preco.eso

Retour à la liste

Numérotation des lignes : 

preco

  1. C PRECO     SOURCE    CB215821  19/07/31    21:16:26     10277          
  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.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMELEME
  26.         ipmail=0
  27. C lecture eventuelle  des extremites ou on applique la tension
  28.       CALL LIROBJ('MAILLAGE',IPMAIL,0,IRET)
  29. C  rattrapage eventuel si il n y a q un cable et qu'on a donné un POINT
  30.       if(ipmail.eq.0) then
  31.       INOD1 = 0
  32.       CALL LIROBJ('POINT   ',INOD1,0,IRETP)
  33.       if(inod1.ne.0) then
  34.       NBNN =1
  35.       NBELEM=1
  36.       nbsous=0
  37.       nbref=0
  38.       segini MELEME
  39.       itypel=1
  40.       num(1,1)=inod1
  41.       ipmail = meleme
  42.       segdes meleme
  43.       endif
  44.       endif
  45. C
  46. C --- LECTURE DU MODELE
  47. C
  48.       CALL LIROBJ('MMODEL  ',IPMODL,1,IRTM)
  49.       CALL ACTOBJ('MMODEL  ',IPMODL,1)
  50.       IF (IERR.NE.0) RETURN
  51.  
  52.       IPCHA1 = 0
  53.       CALL LIROBJ('MCHAML  ',IPIN,1,IRET1)
  54.       CALL ACTOBJ('MCHAML  ',IPIN,1)
  55.       IF (IERR.NE.0) RETURN
  56.       CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  57.       IF(IR   .NE. 1) CALL ERREUR(KER)
  58.       IF(IERR .NE. 0) RETURN
  59.  
  60.       IPTAB=0
  61.       CALL LIROBJ('TABLE',IPTAB,0,IRETOU)
  62.       IF (IERR.NE.0) RETURN
  63.  
  64.       CALL LIRREE(PS1,1,IRETOU)
  65.       IF (IERR.NE.0) RETURN
  66.  
  67.       CALL LIROBJ('MCHAML ',IPIN,0,IRETC)
  68.       IF (IERR.NE.0) RETURN
  69.       IPCHC1=0
  70.  
  71.       if(IRETC .EQ. 1) then
  72.         CALL ACTOBJ('MCHAML ',IPIN,1)
  73.         CALL REDUAF(IPIN,IPMODL,IPCHC1,0,IR,KER)
  74.         IF(IR   .NE. 1) CALL ERREUR(KER)
  75.         IF(IERR .NE. 0) RETURN
  76.         call rngcha(ipcha1,ipchc1,'CARACTERISTIQUES','CONTRAINTES',
  77.      &              ipcar,ipcont)
  78.       else
  79.         ipcont = 0
  80.         ipcar= ipcha1
  81.       endif
  82. C
  83.        CALL PRECOP (IPMODL,ipcar,IPTAB,IPSTRS,IPMAIL,
  84.      &              PS1,ipcont,IRET)
  85. C
  86.       IF(IRET.EQ.0) RETURN
  87.  
  88.       CALL ACTOBJ('MCHAML  ',IPSTRS,1)
  89.       CALL ECROBJ('MCHAML  ',IPSTRS)
  90.  
  91.       END
  92.  
  93.  
  94.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales