Télécharger preco.eso

Retour à la liste

Numérotation des lignes :

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

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