Télécharger devfx0.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVFX0 SOURCE BP208322 18/12/20 21:15:30 10048
  2. SUBROUTINE DEVFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE,
  3. &LMODYN,ITBAS)
  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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMCHARG
  32. -INC SMCHPOI
  33. -INC SMELEME
  34. -INC SMLREEL
  35. *
  36. * FEXA(.,.,1) valeur au pas m
  37. * FEXA(.,.,2) valeur au pas m - 1/2
  38. *
  39. SEGMENT,MTNUM
  40. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  41. ENDSEGMENT
  42. SEGMENT,MTFEX
  43. REAL*8 FEXA(NPFEXA,NPC1,2)
  44. REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB)
  45. REAL*8 FTEXB(NPLB,NPC1,2,IDIM)
  46. * INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  47. ENDSEGMENT
  48. SEGMENT,MTRAV
  49. REAL*8 FTCHG(NPC2)
  50. ENDSEGMENT
  51. SEGMENT,MPREF
  52. INTEGER IPOREF(NPREF)
  53. ENDSEGMENT
  54. LOGICAL L0,L1,REPRIS,RIGIDE,LMODYN
  55. CHARACTER*8 TYPRET,CHARRE
  56. *
  57. MTNUM = KTNUM
  58. MTFEX = KTFEX
  59. MPREF = KPREF
  60. NPREF = IPOREF(/1)
  61. NPC1 = XDT(/1)
  62. *
  63. * On extrait les chargements de la table
  64. *
  65. TYPRET = ' '
  66.  
  67. if (lmodyn) then
  68. TYPRET= 'CHARGEME'
  69. ICHAR1 = ITCHAR
  70. else
  71. CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,
  72. & TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  73. endif
  74.  
  75. IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  76. MCHARG = ICHAR1
  77. SEGACT,MCHARG
  78. NCHAR = KCHARG(/1)
  79. IXA = 0
  80. *
  81. * Boucle sur les chargements �l�mentaires
  82. *
  83. DO 10 ICHAR=1,NCHAR
  84. ICHARG = KCHARG(ICHAR)
  85. SEGACT,ICHARG
  86. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  87. & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  88.  
  89. SEGDES ICHARG
  90. SEGDES MCHARG
  91. CALL ERREUR(696)
  92. RETURN
  93. ENDIF
  94. MLR1 = ICHPO2
  95. MLR2 = ICHPO3
  96. CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  97. MTRAV = KTRAV
  98. MCHPOI = ICHPO1
  99. SEGACT,MCHPOI
  100. NSOUPO=IPCHP(/1)
  101. DO 20 I=1,NSOUPO
  102. MSOUPO = IPCHP(I)
  103. SEGACT,MSOUPO
  104. MELEME = IGEOC
  105. SEGACT,MELEME
  106. NC = NOCOMP(/2)
  107. MPOVAL = IPOVAL
  108. SEGACT,MPOVAL
  109. N = VPOCHA(/1)
  110. DO 30 J=1,N
  111. DO 35 K=1,NC
  112. KNOE = NUM(1,J)
  113. CALL PLACE2(IPOREF,NPREF,IPOS,KNOE)
  114. IF (IPOS.NE.0) THEN
  115. IXA = IXA + 1
  116. XFORCA = VPOCHA(J,K)
  117. * bp, 2018-12-14 IFEXA(IPOS) = IXA
  118. *
  119. * Boucle sur les pas de temps
  120. *
  121. DO 36 IT=1,NPC1
  122. NP = 2 * IT
  123. FEXA(IPOS,IT,1) = FEXA(IPOS,IT,1) +
  124. & ( XFORCA * FTCHG(NP) )
  125. NI = NP - 1
  126. FEXA(IPOS,IT,2) = FEXA(IPOS,IT,2) +
  127. & ( XFORCA * FTCHG(NI) )
  128. 36 CONTINUE
  129. * end do
  130. ENDIF
  131. 35 CONTINUE
  132. * end do
  133. 30 CONTINUE
  134. * end do
  135. SEGDES,MPOVAL,MELEME,MSOUPO
  136. 20 CONTINUE
  137. * end do
  138. SEGDES,MCHPOI,ICHARG
  139. SEGSUP,MTRAV
  140. 10 CONTINUE
  141. * end do
  142. SEGDES,MCHARG
  143. ELSE
  144. TYPRET = ' '
  145. CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0,
  146. & TYPRET,I1,X1,CHARRE,L1,ICHAR2)
  147. IF ((ICHAR2.EQ.0).OR.(.NOT.RIGIDE)) THEN
  148. CALL ERREUR(486)
  149. RETURN
  150. ENDIF
  151. ENDIF
  152. *
  153. END
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  

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