Télécharger dynplx.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNPLX SOURCE PV 16/11/17 21:59:10 9180
  2. SUBROUTINE DYNPLX
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * SOUS-PROGRAMME DE L'OPERATEUR "DYNE"
  8. * ALGORITHME EXPLICITE DE PLEXUS
  9. * ____________________________________
  10. *
  11. * FONCTION:
  12. * ---------
  13. * LECTURE ET TESTS DE COMPATIBILITE DES OPERANDES
  14. *
  15. * DENIS ROBERT, LE 19 OCTOBRE 1988.
  16. * REVU ET CORRIGE DECEMBRE 89 MP
  17. ************************************************************************
  18. *
  19. * MODULES UTILISES:
  20. *
  21. -INC CCOPTIO
  22. -INC SMRIGID
  23. -INC SMMATRI
  24. -INC SMVECTD
  25. -INC SMELEME
  26. *
  27. PARAMETER ( ZERO=0.D0 )
  28. PARAMETER ( EPSI=1.D-30 )
  29. *
  30. *--- TABLEAUX DE POINTEURS :
  31. *
  32. INTEGER IPRIG(4),IPCGT(2),IPCHM(2),IPPT(6)
  33. *
  34. *--- SEGMENTS DE TRAVAIL :
  35. * -1 T
  36. * MZZZ CONTIENT LE PRODUIT A M A RANGE EN LIGNE
  37. * -1
  38. * MBLO CONTIENT LE PRODUIT A M TABLEAU IDDL * NDDL
  39. * MBLO2 CONTIENT LA MATRICE A TABLEAU IDDL * NDDL
  40. * MUCTRA CONTIENT LES RENSEIGNEMENTS POUR LES PRODUITS K * U
  41. * ICPR CONTIENT DES REFERENCES GEOMETRIQUES
  42. *
  43. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  44. SEGMENT,MZZZ
  45. REAL*8 ZZZZ(LONZ)
  46. ENDSEGMENT
  47. SEGMENT,MBLO
  48. REAL*8 BLO(IDDL,NDDL)
  49. ENDSEGMENT
  50. POINTEUR MBLO2.MBLO
  51. SEGMENT,MUCTRA
  52. REAL*8 CC(NLIGMA)
  53. INTEGER MUCPO,MUCMIK,MUCDUA,MUIPOS(NLIGMA),MUCPR
  54. ENDSEGMENT
  55. *
  56. *--- INITIALISATIONS
  57. *
  58. DT=ZERO
  59. NINS=0
  60. IRE1=0
  61. IRE3=0
  62. DO 1 I0=1,4
  63. IPRIG(I0)=0
  64. 1 CONTINUE
  65. * END DO
  66. IPCGT(1)=0
  67. IPCGT(2)=0
  68. MCHT=0
  69. IPCHM(1)=0
  70. IPCHM(2)=0
  71. DO 2 I1=1,6
  72. IPPT(I1)=0
  73. 2 CONTINUE
  74. * END DO
  75. *
  76. *--------------------------------------------------*
  77. *--- LECTURE DES OPERANDES DE TYPE 'RIGIDITE' ---*
  78. *--------------------------------------------------*
  79. *
  80. CALL MESLIR(-161)
  81. CALL LIROBJ('RIGIDITE',IPRIG(1),1,IRET)
  82. IF (IERR.NE.0) RETURN
  83. *
  84. CALL MESLIR(-160)
  85. CALL LIROBJ('RIGIDITE',IPRIG(2),1,IRET)
  86. IF (IERR.NE.0) RETURN
  87. *
  88. CALL MESLIR(-159)
  89. CALL LIROBJ('RIGIDITE',IPRIG(3),0,IRET)
  90. IF (IERR.NE.0) RETURN
  91. *
  92. *--------------------------------------------------*
  93. *--- LECTURE DES OPERANDES DE TYPE 'CHARGEME' ---*
  94. *--------------------------------------------------*
  95. *
  96. CALL MESLIR(-158)
  97. CALL LIROBJ('CHARGEME',IPCGT(1),0,IRET)
  98. IF (IERR.NE.0) RETURN
  99. *
  100. CALL MESLIR(-157)
  101. CALL LIROBJ('CHARGEME',IPCGT(2),0,IRET)
  102. IF (IERR.NE.0) RETURN
  103. *
  104. IF (IPCGT(1).EQ.0.AND.IPCGT(2).EQ.0) THEN
  105. *
  106. *--- ON NE TROUVE PAS D'OBJET DE TYPE CHARGEMENT ...
  107. *
  108. MOTERR(1:8)='CHARGEME'
  109. CALL ERREUR(37)
  110. RETURN
  111. ENDIF
  112. *
  113. *-----------------------------------------*
  114. *--- LECTURE DES OPERANDES TEMPORELS ---*
  115. *-----------------------------------------*
  116. *
  117. CALL MESLIR(-156)
  118. CALL LIRREE(DT,1,IRET)
  119. IF (IERR.NE.0) RETURN
  120. IF (DT.LE.EPSI) THEN
  121. *
  122. *--- NOMBRE INACCEPTABLE ...
  123. *
  124. CALL ERREUR(36)
  125. RETURN
  126. ENDIF
  127. *
  128. CALL MESLIR(-155)
  129. CALL LIRENT(NPAS,1,IRET)
  130. IF (IERR.NE.0) RETURN
  131. *
  132. CALL MESLIR(-154)
  133. CALL LIRENT(NINS,0,IRE3)
  134. IF (IERR.NE.0) RETURN
  135. IF (IRE3.EQ.1) THEN
  136. IF (NINS.LT.1) THEN
  137. *
  138. *--- NOMBRE INACCEPTABLE ...
  139. *
  140. CALL ERREUR(36)
  141. RETURN
  142. ENDIF
  143. ELSE
  144. NINS=1
  145. ENDIF
  146. *
  147. CALL MESLIR(-153)
  148. CALL LIRREE(TINI,0,IRE1)
  149. IF (IERR.NE.0) RETURN
  150. IF (IRE1.EQ.0) TINI=ZERO
  151. *
  152. *-----------------------------------------------------------*
  153. *--- LECTURE DE LA TABLE CONTENANT LES CHAMPS INITIAUX ---*
  154. *-----------------------------------------------------------*
  155. *
  156. CALL MESLIR(-152)
  157. CALL LIROBJ('TABLE',ITAB1,1,IRET)
  158. IF (IERR.NE.0) RETURN
  159. *
  160. *------------------------------------------------------------------*
  161. *--- VERIFICATION IDENTIFICATION ET PREPARATION DES OPERANDES ---*
  162. *------------------------------------------------------------------*
  163. *
  164. CALL DYNEVE(IPRIG,ICHT1,ICHT2,ICHT3,ICHT4,
  165. & IPCGT,TINI,DT,NPAS,ITAB1,IPCHM,IPPT)
  166. IF (IERR.NE.0) RETURN
  167. *
  168. MBLO=IPPT(2)
  169. IDDL=BLO(/1)
  170. NDDL=BLO(/2)
  171. *
  172. *----------------------------------------*
  173. *--- MISE EN OEUVRE DE L'ALGORITHME ---*
  174. *----------------------------------------*
  175. *
  176. CALL DYNEPL(IPRIG,ICHT1,ICHT2,ICHT3,ICHT4,
  177. & IPCGT,IDDL,NDDL,DT,NPAS,NINS,IPCHM,IPPT,ITAB2)
  178. IF (IERR.NE.0) RETURN
  179. *
  180. *---------------------------------------*
  181. *--- DESACTIVATIONS / DESTRUCTIONS ---*
  182. *---------------------------------------*
  183. *
  184. MRIGID=IPRIG(2)
  185. NRIGEL=IRIGEL(/2)
  186. DO 100 IRI=1,NRIGEL
  187. MELEME=IRIGEL(1,IRI)
  188. SEGDES,MELEME
  189. DESCR=IRIGEL(3,IRI)
  190. SEGDES,DESCR
  191. xMATRI=IRIGEL(4,IRI)
  192. * NELRIG=re(/3)
  193. * DO 200 IEL=1,NELRIG
  194. * XMATRI=IMATTT(IEL)
  195. * SEGDES,XMATRI
  196. * 200 CONTINUE
  197. * END DO
  198. SEGDES,xMATRI
  199. 100 CONTINUE
  200. * END DO
  201. SEGDES,MRIGID
  202. *
  203. MVECTD=IPPT(1)
  204. SEGSUP,MVECTD
  205. MBLO=IPPT(2)
  206. SEGSUP,MBLO
  207. MBLO=IPPT(3)
  208. SEGSUP,MBLO
  209. *
  210. MUCTRA=IPPT(4)
  211. ICPR=MUCPR
  212. SEGSUP,ICPR
  213. SEGSUP,MUCTRA
  214. *
  215. MMATRI=IPPT(5)
  216. MINCPO=IINCPO
  217. MIMIK=IIMIK
  218. MIDUA=IIDUA
  219. MHARK=IHARK
  220. MELEME=IGEOMA
  221. SEGDES,MELEME,MHARK,MIDUA,MIMIK,MINCPO
  222. SEGDES,MMATRI
  223. IF (IPRIG(3).NE.0) THEN
  224. MRIGID=IPRIG(4)
  225. SEGSUP,MRIGID
  226. MZZZ=IPPT(6)
  227. SEGSUP,MZZZ
  228. ENDIF
  229. *
  230. *---------------------------------------*
  231. *--- ECRITURE DE LA TABLE RESULTAT ---*
  232. *---------------------------------------*
  233. *
  234. CALL ECROBJ('TABLE',ITAB2)
  235. *
  236. END
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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