Télécharger dirich.eso

Retour à la liste

Numérotation des lignes :

  1. C DIRICH SOURCE AM 16/09/05 21:15:01 9062
  2. SUBROUTINE DIRICH
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC CCOPTIO
  7. -INC CCNOYAU
  8. -INC SMTABLE
  9. -INC SMLREEL
  10.  
  11. LOGICAL LOGRE,LOGIN
  12. REAL*8 TEMPS(0:1000),YOUNG(0:1000)
  13. REAL*8 TREL(0:10),EVO(0:1000,0:10)
  14. CHARACTER*8 CHARIN,CHARRE
  15. CHARACTER*(8) CHARA,TYPIND,TYPOBJ
  16. C
  17. CHARACTER*4 MOUNIT,MOCODE(3)
  18.  
  19. C
  20. DATA MOCODE/'EURO','BPEL','LCPC'/
  21.  
  22. XVALIN=0.D0
  23. CHARIN=' '
  24. LOGIN =.FALSE.
  25. IOBIN=0
  26. IVALRE=0
  27. XVALRE=0.D0
  28. IOBRE=0
  29.  
  30. C
  31. C ON LIT LE MOT UNITE
  32. C
  33. CALL LIRCHA(MOUNIT,1,IRETOU)
  34. IF(IERR.NE.0) RETURN
  35. CALL LIRREE(TMAXA,1,IRETOU)
  36. IF(IERR.NE.0) RETURN
  37. CALL LIRENT(NB,1,IRETOU)
  38. IF(IERR.NE.0) RETURN
  39. CALL LIRMOT(MOCODE,3,IMLU,0)
  40. *
  41. * MOT CLE EURO PAR DEFAUT
  42. *
  43. IF(IMLU.EQ.0) IMLU=1
  44. *
  45. * CAS EUROCODE
  46. *
  47.  
  48. IF(IMLU.EQ.1) THEN
  49. CALL LIRREE(HO,1,IRETOU)
  50. IF(IERR.NE.0) RETURN
  51. CALL LIRREE(ROH,1,IRETOU)
  52. IF(IERR.NE.0) RETURN
  53. CALL LIRREE(S,1,IRETOU)
  54. IF(IERR.NE.0) RETURN
  55. CALL LIRREE(FCM,1,IRETOU)
  56. IF(IERR.NE.0) RETURN
  57. *
  58. * CAS BPEL
  59. *
  60. ELSE IF(IMLU.EQ.2) THEN
  61. CALL LIRREE(RM,1,IRETOU)
  62. IF(IERR.NE.0) RETURN
  63. CALL LIRREE(RH,1,IRETOU)
  64. IF(IERR.NE.0) RETURN
  65. CALL LIRREE(FC28,1,IRETOU)
  66. IF(IERR.NE.0) RETURN
  67. *
  68. * CAS LCPC
  69. *
  70. ELSE
  71. CALL LIRREE(H0,1,IRETOU)
  72. IF(IERR.NE.0) RETURN
  73. CALL LIRREE(RHOS,1,IRETOU)
  74. IF(IERR.NE.0) RETURN
  75. CALL LIRREE(E1AN,1,IRETOU)
  76. IF(IERR.NE.0) RETURN
  77. ENDIF
  78. *
  79. * TESTS SUR LES DONNEES
  80. *
  81. TMAX=TMAXA
  82. IF (MOUNIT.EQ.'SECO') THEN
  83. TMAX=TMAXA/3600./24.
  84. ELSE IF (MOUNIT.EQ.'ANNE') THEN
  85. TMAX=TMAXA*365.
  86. ELSE IF (MOUNIT.NE.'JOUR') THEN
  87. MOTERR(1:4)= MOUNIT
  88. CALL ERREUR(7)
  89. RETURN
  90. ENDIF
  91.  
  92. IF (NB.GT.8) THEN
  93. NB=8
  94. ENDIF
  95.  
  96. *
  97. * ICI APPEL AUX ROUTINES DE CALCUL
  98. *
  99. IF(IMLU.EQ.1) THEN
  100. *
  101. * ENTREES : HO en mm
  102. * EUROCODE ROH en valeur reelle ( entre 0 et 1 )
  103. * FCM en MPa
  104. * Temps en jours
  105. *
  106. HO=HO*1000.D0
  107. ROH=ROH/100.D0
  108. CALL EURODI(HO,ROH,FCM,S,TMAX,NB,TEMPS,
  109. & TREL,EVO,YOUNG,LIDIM)
  110. *
  111. ELSE IF (IMLU.EQ.2) THEN
  112. *
  113. * ENTREES : RM en cm
  114. * BPEL RH en % ( entre 0 et 100 )
  115. * FC28 en MPa
  116. * Temps en jours
  117. *
  118. RM=RM*100.D0
  119. CALL BPELDI(RM,RH,FC28,TMAX,NB,TEMPS,
  120. & TREL,EVO,YOUNG,LIDIM)
  121.  
  122. ELSE
  123. *
  124. * ENTREES : H0 en mm
  125. * LCPC RHOS taux d'armatures passives
  126. * dans une section de beton arme.
  127. * (0. < RHOS < 1.)
  128. *
  129. H0 = H0*1000.D0
  130. CALL LCPCDI(H0,RHOS,E1AN,TMAX,NB,TEMPS,
  131. & TREL,EVO,YOUNG,LIDIM)
  132. *
  133. ENDIF
  134. *
  135. * CREATION DES TABLES
  136. *
  137. CALL CRTABL(IPT1)
  138. CALL CRTABL(IPT2)
  139.  
  140.  
  141. *
  142. * CREATION DE DEUX PROGS
  143. *
  144. JG=LIDIM+1
  145. *
  146. * AM 5/9/16 ON REMET LA SORTIE DANS LES UNITES ANNONCEES
  147. *
  148. IF (MOUNIT.EQ.'SECO') THEN
  149. FAFAC= 3600.*24.
  150. ELSE IF (MOUNIT.EQ.'ANNE') THEN
  151. FAFAC= 1./365.
  152. ELSE
  153. FAFAC= 1.
  154. ENDIF
  155.  
  156. * ON CREE LES ABSCISSES
  157. SEGINI MLREEL
  158. IPRABS=MLREEL
  159. DO I=0,LIDIM
  160. PROG(I+1)=TEMPS(I)*FAFAC
  161. ENDDO
  162. *
  163. * AM 5/9/16 ON ETEND LES TEMPS A TMAX SI BESOIN
  164. *
  165. IF(PROG(JG).LT.TMAXA) PROG(JG)=TMAXA
  166.  
  167. SEGDES MLREEL
  168.  
  169.  
  170. * ON CREE LE PROG DES MODULES D'YOUNG
  171. SEGINI MLREEL
  172. IPRMOD=MLREEL
  173. DO I=0,LIDIM
  174. PROG(I+1)=YOUNG(I)
  175. ENDDO
  176. SEGDES MLREEL
  177.  
  178. *
  179. * CREATION DE L'OBJET MODULE D'YOUNG
  180. *
  181.  
  182. CALL DIRIC1('TEMP',IPRABS,'YOUN',IPRMOD,IPEVYO)
  183.  
  184.  
  185. DO 10 IC=0,NB
  186. *
  187. * ON CREE LES ORDONNEES
  188. *
  189. SEGINI MLREEL
  190. IPRORD=MLREEL
  191. DO I=0,LIDIM
  192. PROG(I+1)=EVO(I,IC)
  193. ENDDO
  194. *
  195. * AM 5/9/16 ON REMET LES INVERSES DES TEMPS DE RELAXATION
  196. * DANS LES BONNES UNITES
  197. *
  198. TREL(IC)=TREL(IC)/FAFAC
  199. *
  200. *
  201. * CREATION D'UN OBJET EVOLUTION
  202. *
  203.  
  204. CALL DIRIC1('TEMP',IPRABS,'MODU',IPRORD,IPEV)
  205. IF(IERR.NE.0) RETURN
  206. *
  207. * DANS LA TABLE DES MODULES
  208. * A L'INDICE II ON MET L'EVOLUTION DE POINTEUR IPEV
  209. *
  210. CALL ECCTAB(IPT2,'ENTIER ',IC,XVALIN,CHARIN,LOGIN,IOBIN,
  211. & 'EVOLUTIO',IVALRE,XVALRE,CHARRE,LOGRE,IPEV)
  212.  
  213.  
  214. *
  215. * DANS LA TABLE DES TEMPS
  216. * A L'INDICE II ON MET LE TEMPS TREL(IC)
  217. *
  218. CALL ECCTAB(IPT1,'ENTIER ',IC,XVALIN,CHARIN,LOGIN,IOBIN,
  219. & 'FLOTTANT',IVALRE,TREL(IC),CHARRE,LOGRE,IOBRE)
  220.  
  221.  
  222. 10 CONTINUE
  223.  
  224.  
  225.  
  226. *
  227. * ECRITURE DES RESULTATS
  228. *
  229. CALL ECROBJ('TABLE',IPT2)
  230. CALL ECROBJ('TABLE',IPT1)
  231. CALL ECROBJ('EVOLUTIO',IPEVYO)
  232. RETURN
  233. END
  234.  
  235.  
  236.  
  237.  

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