Télécharger d2vfx0.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VFX0 SOURCE CHAT 05/01/12 22:35:18 5004
  2. C DEVFX0 SOURCE KK2000 97/09/08 21:16:59 2809
  3. SUBROUTINE D2VFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Remplissage des tableaux représentant les chargements, en *
  12. * faisant les interpolations nécessaires. *
  13. * *
  14. * Paramètres: *
  15. * *
  16. * e ITCHAR Table représentant les chargements *
  17. * e ITINIT Table représentant les conditions initiales *
  18. * e KTNUM Segment contenant les paramètres numériques *
  19. * e KPREF Segment des points de référence *
  20. * es KTFEX Segment contenant les chargements libres *
  21. * *
  22. * Auteur, date de création: *
  23. * *
  24. * Denis ROBERT-MOUGIN, le 25 mai 1989. *
  25. * *
  26. *--------------------------------------------------------------------*
  27. *
  28. -INC CCOPTIO
  29. -INC SMCHARG
  30. -INC SMCHPOI
  31. -INC SMELEME
  32. -INC SMLREEL
  33. *
  34. * FEXA(.,.,1) valeur au pas m
  35. * FEXA(.,.,2) valeur au pas m - 1
  36. *
  37. SEGMENT,MTNUM
  38. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  39. ENDSEGMENT
  40. SEGMENT,MTFEX
  41. REAL*8 FEXA(NPFEXA,NPC1,2)
  42. REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB)
  43. REAL*8 FTEXB(NPLB,NPC1,2,IDIM)
  44. INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  45. ENDSEGMENT
  46. SEGMENT,MTRAV
  47. REAL*8 FTCHG(NPC1)
  48. ENDSEGMENT
  49. SEGMENT,MPREF
  50. INTEGER IPOREF(NPREF)
  51. ENDSEGMENT
  52. LOGICAL L0,L1,REPRIS,RIGIDE
  53. CHARACTER*8 TYPRET,CHARRE
  54. *
  55. MTNUM = KTNUM
  56. MTFEX = KTFEX
  57. MPREF = KPREF
  58. NPREF = IPOREF(/1)
  59. NPC1 = XDT(/1)
  60. *
  61. * On extrait les chargements de la table
  62. *
  63. TYPRET = ' '
  64. CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,
  65. & TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  66. IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  67. MCHARG = ICHAR1
  68. SEGACT,MCHARG
  69. NCHAR = KCHARG(/1)
  70. IXA = 0
  71. *
  72. * Boucle sur les chargements élémentaires
  73. *
  74. DO 10 ICHAR=1,NCHAR
  75. ICHARG = KCHARG(ICHAR)
  76. SEGACT,ICHARG
  77. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  78. & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  79. SEGDES ICHARG
  80. SEGDES MCHARG
  81. CALL ERREUR(696)
  82. RETURN
  83. ENDIF
  84. MLR1 = ICHPO2
  85. MLR2 = ICHPO3
  86. CALL D2VINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  87. MTRAV = KTRAV
  88. MCHPOI = ICHPO1
  89. SEGACT,MCHPOI
  90. NSOUPO=IPCHP(/1)
  91. DO 20 I=1,NSOUPO
  92. MSOUPO = IPCHP(I)
  93. SEGACT,MSOUPO
  94. MELEME = IGEOC
  95. SEGACT,MELEME
  96. NC = NOCOMP(/2)
  97. MPOVAL = IPOVAL
  98. SEGACT,MPOVAL
  99. N = VPOCHA(/1)
  100. DO 30 J=1,N
  101. DO 35 K=1,NC
  102. KNOE = NUM(1,J)
  103. CALL PLACE2(IPOREF,NPREF,IPOS,KNOE)
  104. IF (IPOS.NE.0) THEN
  105. IXA = IXA + 1
  106. XFORCA = VPOCHA(J,K)
  107. IFEXA(IPOS) = IXA
  108. *
  109. * Boucle sur les pas de temps
  110. *
  111. DO 36 IT=1, (NPC1 - 1)
  112. FEXA(IPOS,IT,2) = FEXA(IPOS,IT,2) +
  113. & ( XFORCA * FTCHG(IT) )
  114. IT2 = IT + 1
  115. FEXA(IPOS,IT,1) = FEXA(IPOS,IT,1) +
  116. & ( XFORCA * FTCHG(IT2) )
  117. 36 CONTINUE
  118. * end do
  119. ENDIF
  120. 35 CONTINUE
  121. * end do
  122. 30 CONTINUE
  123. * end do
  124. SEGDES,MPOVAL,MELEME,MSOUPO
  125. 20 CONTINUE
  126. * end do
  127. SEGDES,MCHPOI,ICHARG
  128. SEGSUP,MTRAV
  129. 10 CONTINUE
  130. * end do
  131. SEGDES,MCHARG
  132. ELSE
  133. TYPRET = ' '
  134. CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0,
  135. & TYPRET,I1,X1,CHARRE,L1,ICHAR2)
  136. IF ((ICHAR2.EQ.0).OR.(.NOT.RIGIDE)) THEN
  137. CALL ERREUR(486)
  138. RETURN
  139. ENDIF
  140. ENDIF
  141. *
  142. END
  143.  
  144.  
  145.  
  146.  

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