Télécharger d2vrig.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VRIG SOURCE CHAT 05/01/12 22:35:53 5004
  2. C DEVRIG SOURCE KK2000 97/09/08 21:18:59 2809
  3. SUBROUTINE D2VRIG(ITCHAR,KTNUM,KTPHI,KTFEX,KTLIAB,
  4. & REPRIS)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *---------------------------------------------------------------*
  8. * *
  9. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * Remplissage du tableau FTEXB représentant les chargements,*
  13. * sur base B, on ne lit que les efforts car ces forces *
  14. * servent au calcul des moments pour les corps rigides *
  15. * On effectue aussi les interpolations nécessaires. *
  16. * *
  17. * Paramètres: *
  18. * *
  19. * e ITCHAR Table représentant les chargements *
  20. * e ITINIT Table représentant les conditions initiales *
  21. * e KTNUM Segment contenant les paramètres numériques *
  22. * e KPREF Segment des points de référence *
  23. * es KTFEX Segment contenant les chargements libres *
  24. * e REPRISE Vrai si reprise, faux sinon *
  25. * *
  26. * Auteur, date de création: *
  27. * *
  28. * Samuel DURAND, le 07 octobre 1996 . *
  29. * *
  30. * *
  31. *---------------------------------------------------------------*
  32. *
  33. -INC CCOPTIO
  34. -INC SMTABLE
  35. -INC SMCHARG
  36. -INC SMCHPOI
  37. -INC SMELEME
  38. -INC SMLREEL
  39. *
  40. * FTEXB(.,.,1,..) valeur au pas m
  41. * FTEXB(.,.,2,..) valeur au pas m-1
  42. *
  43. SEGMENT,MTNUM
  44. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  45. ENDSEGMENT
  46. SEGMENT,MTPHI
  47. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  48. INTEGER IAROTA(NSB)
  49. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  50. ENDSEGMENT
  51. SEGMENT,MTFEX
  52. REAL*8 FEXA(NPFEXA,NPC1,2)
  53. REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB)
  54. REAL*8 FTEXB(NPLB,NPC1,2,IDIM)
  55. INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  56. ENDSEGMENT
  57. SEGMENT,MTRAV
  58. REAL*8 FTCHG(NPC2)
  59. ENDSEGMENT
  60. SEGMENT,MTLIAB
  61. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  62. REAL*8 XPALB(NLIAB,NXPALB)
  63. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  64. ENDSEGMENT
  65. *
  66. *
  67. LOGICAL L0,L1,REPRIS
  68. CHARACTER*4 CMOT,NOMTRI(3)
  69. CHARACTER*8 TYPRET,CHARRE
  70. CHARACTER*40 MONMOT
  71. *
  72. DATA NOMTRI/'FX ','FY ','FZ '/
  73. *
  74. MTNUM = KTNUM
  75. MTFEX = KTFEX
  76. MTPHI = KTPHI
  77. MTLIAB = KTLIAB
  78. *
  79. NPC1 = XDT(/1)
  80. NPLB = JPLIB(/1)
  81. NSB = IAROTA(/1)
  82. IDIMB = XPHILB(/4)
  83. *
  84. * Lecture des chargements en base B
  85. *
  86. DO 5 IP=1,NPLB
  87. DO 6 IC=1,NPC1
  88. DO 7 I2=1,2
  89. DO 8 I3=1,IDIM
  90. FTEXB(IP,IC,I2,I3)=0.D0
  91. 8 CONTINUE
  92. 7 CONTINUE
  93. 6 CONTINUE
  94. 5 CONTINUE
  95. IF (ITCHAR.NE.0) THEN
  96. TYPRET = ' '
  97. CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0,
  98. & TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  99. IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  100. MCHARG = ICHAR1
  101. SEGACT,MCHARG
  102. NCHAR = KCHARG(/1)
  103. *
  104. * Boucle sur les chargements élémentaires
  105. *
  106. DO 10 ICHAR=1,NCHAR
  107. ICHARG = KCHARG(ICHAR)
  108. SEGACT,ICHARG
  109. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  110. & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  111. SEGDES ICHARG
  112. SEGDES MCHARG
  113. CALL ERREUR(696)
  114. RETURN
  115. ENDIF
  116. MLR1 = ICHPO2
  117. MLR2 = ICHPO3
  118. CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  119. MTRAV = KTRAV
  120. MCHPOI = ICHPO1
  121. SEGACT,MCHPOI
  122. NSOUPO=IPCHP(/1)
  123. DO 20 I=1,NSOUPO
  124. MSOUPO = IPCHP(I)
  125. SEGACT,MSOUPO
  126. MELEME = IGEOC
  127. SEGACT,MELEME
  128. NC = NOCOMP(/2)
  129. MPOVAL = IPOVAL
  130. SEGACT,MPOVAL
  131. N = VPOCHA(/1)
  132. DO 30 J=1,N
  133. KNOE = NUM(1,J)
  134. DO 35 K=1,NC
  135. CMOT = NOCOMP(K)
  136. CALL PLACE5(NOMTRI,3,ID,CMOT)
  137. IF (ID.NE.0) THEN
  138. * On vérifie que le point est un point de liaison
  139. CALL PLACE2(JPLIB,NPLB,IPOS,KNOE)
  140. IF (IPOS.NE.0) THEN
  141. ISB = IBASB(IPOS)
  142. IF (IAROTA(ISB).NE.0) THEN
  143. XFORCB = VPOCHA(J,K)
  144. *
  145. * Boucle sur les pas de temps
  146. *
  147. DO 36 IT=1,(NPC1 - 1)
  148. FTEXB(IPOS,IT,2,ID) =
  149. & FTEXB(IPOS,IT,2,ID) +( XFORCB * FTCHG(IT) )
  150. IT2 = IT + 1
  151. FTEXB(IPOS,IT,1,ID) =
  152. & FTEXB(IPOS,IT,1,ID) +( XFORCB * FTCHG(IT2) )
  153. 36 CONTINUE
  154. ENDIF
  155. * end do
  156. ENDIF
  157. ENDIF
  158. 35 CONTINUE
  159. * end do
  160. 30 CONTINUE
  161. * end do
  162. SEGDES,MPOVAL,MELEME,MSOUPO
  163. 20 CONTINUE
  164. * end do
  165. SEGDES,MCHPOI,ICHARG
  166. SEGSUP,MTRAV
  167. 10 CONTINUE
  168. * end do
  169. SEGDES,MCHARG
  170. ENDIF
  171. ENDIF
  172. *
  173. END
  174.  
  175.  

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