Télécharger cv2mc9.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2MC9 SOURCE CHAT 09/10/09 21:16:52 6519
  2. SUBROUTINE CV2MC9(TABVDC,TABMAT,
  3. $ MYFALS,
  4. $ MATLS9,CHPLS9,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : CV2MC9
  10. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  11. C représentant un ensemble de matrices élémentaires en
  12. C RIGIDITE...
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES : KEEF (recherche de l'élément fini)
  19. C APPELES (E/S) : ECROBJ, PRLIST (écriture entier, objet,
  20. C impression)
  21. C APPELE PAR : PRLS92
  22. C***********************************************************************
  23. C ENTREES :
  24. C ENTREES/SORTIES : -
  25. C SORTIES :
  26. C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire.
  27. C * JMTLS9 (type MCHEVA) : valeurs du champ IMTLS9
  28. C sur le maillage élémentaire.
  29. C Structure (cf.include SMCHAEL) :
  30. C (nb. ddl dual, nb. ddl primal,
  31. C nb. comp. duales, nb. comp. primales,
  32. C 1, nb. éléments)
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION : v1, 26/09/03, version initiale
  36. C HISTORIQUE : v1, 26/09/03, création
  37. C HISTORIQUE :
  38. C***********************************************************************
  39. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40. C en cas de modification de ce sous-programme afin de faciliter
  41. C la maintenance !
  42. C***********************************************************************
  43. -INC CCOPTIO
  44. -INC SMLMOTS
  45. POINTEUR MYLMOT.MLMOTS
  46. POINTEUR NCVARP.MLMOTS
  47. POINTEUR NCVARD.MLMOTS
  48. -INC SMRIGID
  49. POINTEUR MATLS9.MRIGID
  50. POINTEUR MATTMP.MRIGID
  51. POINTEUR MATTM2.MRIGID
  52. -INC SMCHPOI
  53. POINTEUR CHPLS9.MCHPOI
  54. POINTEUR CHPTMP.MCHPOI
  55. POINTEUR CHPTM2.MCHPOI
  56. *
  57. * Includes persos
  58. *
  59. CBEGININCLUDE SMCHAEL
  60. SEGMENT MCHAEL
  61. POINTEUR IMACHE(N1).MELEME
  62. POINTEUR ICHEVA(N1).MCHEVA
  63. ENDSEGMENT
  64. SEGMENT MCHEVA
  65. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  66. ENDSEGMENT
  67. SEGMENT LCHEVA
  68. POINTEUR LISCHE(NBCHE).MCHEVA
  69. ENDSEGMENT
  70. CENDINCLUDE SMCHAEL
  71. POINTEUR MYMCHA.MCHAEL
  72. CBEGININCLUDE SFALRF
  73. SEGMENT FALRF
  74. CHARACTER*(LNNFA) NOMFA
  75. INTEGER NUQUAF(NBLRF)
  76. POINTEUR ELEMF(NBLRF).ELREF
  77. ENDSEGMENT
  78. SEGMENT FALRFS
  79. POINTEUR LISFA(0).FALRF
  80. ENDSEGMENT
  81. CENDINCLUDE SFALRF
  82. POINTEUR MYFALS.FALRFS
  83. CBEGININCLUDE SMPOUET
  84. SEGMENT TABGEO
  85. CHARACTER*4 DISGEO
  86. POINTEUR IGEO.MCHAEL
  87. ENDSEGMENT
  88. SEGMENT TABVDC
  89. INTEGER VVARPR(NUMVPR)
  90. INTEGER VVARDU(NUMVDU)
  91. INTEGER VDATPR(NUMDPR)
  92. INTEGER VDATDU(NUMDDU)
  93. INTEGER VCOFPR(NUMCPR)
  94. INTEGER VCOFDU(NUMCDU)
  95. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  96. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  97. POINTEUR VLCOF(JLCOF).MLENTI
  98. POINTEUR VCOMP(JGCOF).COMP
  99. POINTEUR VLDAT(JGCOF).MLENTI
  100. INTEGER DJSVD(JGVD)
  101. POINTEUR NOMVD(JGVD).MLMOTS
  102. POINTEUR MVD(JGVD).MCHPOI
  103. REAL*8 XVD(JGVD)
  104. CHARACTER*4 DISVD(KGVD)
  105. ENDSEGMENT
  106. SEGMENT TATRAV
  107. POINTEUR VVCOF(JLCOF).MCHEVA
  108. POINTEUR VCOF(JGCOF).MCHEVA
  109. POINTEUR IVD(JGVD).MCHAEL
  110. POINTEUR VD(JGVD).MCHEVA
  111. POINTEUR DVD(JGVD).MCHEVA
  112. POINTEUR FFVD(KGVD).MCHEVA
  113. POINTEUR DFFVD(KGVD).MCHEVA
  114. LOGICAL LVCOF(JGCOF)
  115. LOGICAL LVD(JGVD)
  116. LOGICAL LDVD(JGVD)
  117. LOGICAL LFFVD(KGVD)
  118. LOGICAL LDFFVD(KGVD)
  119. ENDSEGMENT
  120. SEGMENT TABMAT
  121. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  122. ENDSEGMENT
  123. CENDINCLUDE SMPOUET
  124. INTEGER NUMVPR,NUMVDU
  125. *
  126. CHARACTER*4 MDISCP,MDISCD,MYDISC
  127. INTEGER IMPR,IRET
  128. *
  129. LOGICAL MVVPR,MVVDU
  130. *
  131. * Executable statements
  132. *
  133. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mc9'
  134. * WRITE(IOIMP,*) '<'
  135. MATLS9=0
  136. CHPLS9=0
  137. MATTMP=0
  138. CHPTMP=0
  139. SEGACT TABVDC
  140. SEGACT TABMAT
  141. * SEGPRT,TABMAT
  142. NUMVPR=TABMAT.VMAT(/2)
  143. NUMVDU=TABMAT.VMAT(/1)
  144. DO IVARPR=1,NUMVPR
  145. DO IVARDU=1,NUMVDU
  146. IJVARP=TABVDC.VVARPR(IVARPR)
  147. IJVARD=TABVDC.VVARDU(IVARDU)
  148. MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  149. MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  150. IKVARP=TABVDC.DJSVD(IJVARP)
  151. MDISCP=TABVDC.DISVD(IKVARP)
  152. NCVARP=TABVDC.NOMVD(IJVARP)
  153. IKVARD=TABVDC.DJSVD(IJVARD)
  154. MDISCD=TABVDC.DISVD(IKVARD)
  155. NCVARD=TABVDC.NOMVD(IJVARD)
  156. MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  157. IF (MYMCHA.NE.0) THEN
  158. IF ((.NOT.MVVPR).AND.(.NOT.MVVDU)) THEN
  159. * In cv2ma9 : SEGINI MATTMP
  160. CALL CV2MA9(MDISCP,NCVARP,MDISCD,NCVARD,
  161. $ MYMCHA,
  162. $ MYFALS,
  163. $ MATTMP,
  164. $ IMPR,IRET)
  165. IF (IRET.NE.0) GOTO 9999
  166. ELSEIF ((.NOT.MVVPR).AND.MVVDU) THEN
  167. MYDISC=MDISCP
  168. MYLMOT=NCVARP
  169. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  170. $ MYFALS,
  171. $ CHPTMP,
  172. $ IMPR,IRET)
  173. IF (IRET.NE.0) GOTO 9999
  174. ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
  175. MYDISC=MDISCD
  176. MYLMOT=NCVARD
  177. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  178. $ MYFALS,
  179. $ CHPTMP,
  180. $ IMPR,IRET)
  181. IF (IRET.NE.0) GOTO 9999
  182. ELSEIF (MVVPR.AND.MVVDU) THEN
  183. MYDISC='CSTE'
  184. JGN=4
  185. JGM=1
  186. SEGINI,MYLMOT
  187. * MYLMOT.MOTS(1)='RES2'
  188. MYLMOT.MOTS(1)='SCAL'
  189. * In CV2CP9 : SEGINI CHPTMP
  190. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  191. $ MYFALS,
  192. $ CHPTMP,
  193. $ IMPR,IRET)
  194. IF (IRET.NE.0) GOTO 9999
  195. SEGSUP,MYLMOT
  196. ENDIF
  197. IF (CHPTMP.NE.0) THEN
  198. IF (CHPLS9.EQ.0) THEN
  199. CHPLS9=CHPTMP
  200. CHPTMP=0
  201. ELSE
  202. * In ADCHPO : SEGINI CHPTM2
  203. CALL ADCHPO(CHPLS9,CHPTMP,CHPTM2,1.D0,1.D0)
  204. IF (CHPTM2.EQ.0) THEN
  205. WRITE(IOIMP,*)
  206. $ 'Pas pu faire le ET des chpoints...'
  207. GOTO 9999
  208. ENDIF
  209. * In DTCHPO : SEGSUP CHPLS9
  210. CALL DTCHPO(CHPLS9)
  211. * In DTCHPO : SEGSUP CHPTMP
  212. CALL DTCHPO(CHPTMP)
  213. CHPLS9=CHPTM2
  214. CHPTMP=0
  215. ENDIF
  216. ENDIF
  217. IF (MATTMP.NE.0) THEN
  218. IF (MATLS9.EQ.0) THEN
  219. MATLS9=MATTMP
  220. MATTMP=0
  221. ELSE
  222. * In FUSRIG : SEGINI MATTM2
  223. CALL FUSRIG(MATLS9,MATTMP,MATTM2)
  224. IF (MATTM2.EQ.0) THEN
  225. WRITE(IOIMP,*)
  226. $ 'Pas pu faire le ET des chpoints...'
  227. GOTO 9999
  228. ENDIF
  229. SEGSUP MATLS9
  230. SEGSUP MATTMP
  231. MATLS9=MATTM2
  232. MATTMP=0
  233. ENDIF
  234. ENDIF
  235. ENDIF
  236. ENDDO
  237. ENDDO
  238. SEGDES TABMAT
  239. SEGDES TABVDC
  240. * WRITE(IOIMP,*) '>'
  241. IF (IMPR.GT.3) THEN
  242. WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9
  243. IF (MATLS9.NE.0) THEN
  244. CALL ECROBJ('RIGIDITE',MATLS9)
  245. CALL PRLIST
  246. ENDIF
  247. WRITE(IOIMP,*) 'On a créé CHPLS9=',CHPLS9
  248. IF (CHPLS9.NE.0) THEN
  249. CALL ECROBJ('CHPOINT ',CHPLS9)
  250. CALL PRLIST
  251. ENDIF
  252. ENDIF
  253. *
  254. * Normal termination
  255. *
  256. IRET=0
  257. RETURN
  258. *
  259. * Format handling
  260. *
  261. *
  262. * Error handling
  263. *
  264. 9999 CONTINUE
  265. IRET=1
  266. WRITE(IOIMP,*) 'An error was detected in subroutine cv2mc9'
  267. RETURN
  268. *
  269. * End of subroutine CV2MC9
  270. *
  271. END
  272.  
  273.  
  274.  
  275.  
  276.  

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