Télécharger d2vrig.eso

Retour à la liste

Numérotation des lignes :

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

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