Télécharger cv2mca.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2MCA SOURCE CB215821 19/08/01 21:15:38 10279
  2. SUBROUTINE CV2MCA(CGEOME,TABVDC,TABMAT,
  3. $ MYFALS,
  4. $ MATLSA,CHPLSA,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : CV2MCA
  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 ou chpoint...
  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 : prlin2
  22. C***********************************************************************
  23. C ENTREES :
  24. C ENTREES/SORTIES : -
  25. C SORTIES :
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 06/03/09, version initiale
  29. C HISTORIQUE : v1, 06/03/06, création
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCOPTIO
  37. -INC SMLMOTS
  38. POINTEUR MYLMOT.MLMOTS
  39. POINTEUR NCVARP.MLMOTS
  40. POINTEUR NCVARD.MLMOTS
  41. -INC SMRIGID
  42. POINTEUR MATLSA.MRIGID
  43. POINTEUR MATTMP.MRIGID
  44. POINTEUR MATTM2.MRIGID
  45. -INC SMCHPOI
  46. POINTEUR CHPLSA.MCHPOI
  47. POINTEUR CHPTMP.MCHPOI
  48. POINTEUR CHPTM2.MCHPOI
  49. -INC SMELEME
  50. POINTEUR CGEOME.MELEME
  51. *
  52. * Includes persos
  53. *
  54. CBEGININCLUDE SMCHAEL
  55. SEGMENT MCHAEL
  56. POINTEUR IMACHE(N1).MELEME
  57. POINTEUR ICHEVA(N1).MCHEVA
  58. ENDSEGMENT
  59. SEGMENT MCHEVA
  60. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  61. ENDSEGMENT
  62. SEGMENT LCHEVA
  63. POINTEUR LISCHE(NBCHE).MCHEVA
  64. ENDSEGMENT
  65. CENDINCLUDE SMCHAEL
  66. POINTEUR MYMCHA.MCHAEL
  67. CBEGININCLUDE SFALRF
  68. SEGMENT FALRF
  69. CHARACTER*(LNNFA) NOMFA
  70. INTEGER NUQUAF(NBLRF)
  71. POINTEUR ELEMF(NBLRF).ELREF
  72. ENDSEGMENT
  73. SEGMENT FALRFS
  74. POINTEUR LISFA(0).FALRF
  75. ENDSEGMENT
  76. CENDINCLUDE SFALRF
  77. POINTEUR MYFALS.FALRFS
  78. CBEGININCLUDE SMPOUET
  79. SEGMENT TABGEO
  80. CHARACTER*4 DISGEO
  81. POINTEUR IGEO.MCHAEL
  82. ENDSEGMENT
  83. SEGMENT TABVDC
  84. INTEGER VVARPR(NUMVPR)
  85. INTEGER VVARDU(NUMVDU)
  86. INTEGER VDATPR(NUMDPR)
  87. INTEGER VDATDU(NUMDDU)
  88. INTEGER VCOFPR(NUMCPR)
  89. INTEGER VCOFDU(NUMCDU)
  90. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  91. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  92. POINTEUR VLCOF(JLCOF).MLENTI
  93. POINTEUR VCOMP(JGCOF).COMP
  94. POINTEUR VLDAT(JGCOF).MLENTI
  95. INTEGER DJSVD(JGVD)
  96. POINTEUR NOMVD(JGVD).MLMOTS
  97. POINTEUR MVD(JGVD).MCHPOI
  98. REAL*8 XVD(JGVD)
  99. CHARACTER*4 DISVD(KGVD)
  100. ENDSEGMENT
  101. SEGMENT TATRAV
  102. POINTEUR VVCOF(JLCOF).MCHEVA
  103. POINTEUR VCOF(JGCOF).MCHEVA
  104. POINTEUR IVD(JGVD).MCHAEL
  105. POINTEUR VD(JGVD).MCHEVA
  106. POINTEUR DVD(JGVD).MCHEVA
  107. POINTEUR FFVD(KGVD).MCHEVA
  108. POINTEUR DFFVD(KGVD).MCHEVA
  109. LOGICAL LVCOF(JGCOF)
  110. LOGICAL LVD(JGVD)
  111. LOGICAL LDVD(JGVD)
  112. LOGICAL LFFVD(KGVD)
  113. LOGICAL LDFFVD(KGVD)
  114. ENDSEGMENT
  115. SEGMENT TABMAT
  116. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  117. ENDSEGMENT
  118. CENDINCLUDE SMPOUET
  119. INTEGER NUMVPR,NUMVDU
  120. *
  121. CHARACTER*4 MDISCP,MDISCD,MYDISC
  122. INTEGER IMPR,IRET
  123. *
  124. LOGICAL MVVPR,MVVDU
  125. *
  126. * Executable statements
  127. *
  128. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mca'
  129. *
  130. CALL CV2MAA(CGEOME,TABVDC,TABMAT,
  131. $ MYFALS,
  132. $ MATLSA,
  133. $ IMPR,IRET)
  134. IF (IRET.NE.0) GOTO 9999
  135. CHPLSA=0
  136. CHPTMP=0
  137. SEGACT TABVDC
  138. SEGACT TABMAT
  139. NUMVPR=TABMAT.VMAT(/2)
  140. NUMVDU=TABMAT.VMAT(/1)
  141. DO IVARPR=1,NUMVPR
  142. DO IVARDU=1,NUMVDU
  143. IJVARP=TABVDC.VVARPR(IVARPR)
  144. IJVARD=TABVDC.VVARDU(IVARDU)
  145. MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  146. MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  147. IKVARP=TABVDC.DJSVD(IJVARP)
  148. MDISCP=TABVDC.DISVD(IKVARP)
  149. NCVARP=TABVDC.NOMVD(IJVARP)
  150. IKVARD=TABVDC.DJSVD(IJVARD)
  151. MDISCD=TABVDC.DISVD(IKVARD)
  152. NCVARD=TABVDC.NOMVD(IJVARD)
  153. MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  154. IF (MYMCHA.NE.0) THEN
  155. IF (MVVPR.OR.MVVDU) THEN
  156. IF ((.NOT.MVVPR).AND.MVVDU) THEN
  157. MYDISC=MDISCP
  158. MYLMOT=NCVARP
  159. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  160. $ MYFALS,
  161. $ CHPTMP,
  162. $ IMPR,IRET)
  163. IF (IRET.NE.0) GOTO 9999
  164. ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
  165. MYDISC=MDISCD
  166. MYLMOT=NCVARD
  167. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  168. $ MYFALS,
  169. $ CHPTMP,
  170. $ IMPR,IRET)
  171. IF (IRET.NE.0) GOTO 9999
  172. ELSEIF (MVVPR.AND.MVVDU) THEN
  173. MYDISC='CSTE'
  174. JGN=4
  175. JGM=1
  176. SEGINI,MYLMOT
  177. * MYLMOT.MOTS(1)='RES2'
  178. MYLMOT.MOTS(1)='SCAL'
  179. * In CV2CP9 : SEGINI CHPTMP
  180. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  181. $ MYFALS,
  182. $ CHPTMP,
  183. $ IMPR,IRET)
  184. IF (IRET.NE.0) GOTO 9999
  185. SEGSUP,MYLMOT
  186. ENDIF
  187. ENDIF
  188. IF (CHPTMP.NE.0) THEN
  189. IF (CHPLSA.EQ.0) THEN
  190. CHPLSA=CHPTMP
  191. CHPTMP=0
  192. ELSE
  193. * In ADCHPO : SEGINI CHPTM2
  194. CALL ADCHPO(CHPLSA,CHPTMP,CHPTM2,1.D0,1.D0)
  195. IF (CHPTM2.EQ.0) THEN
  196. WRITE(IOIMP,*)
  197. $ 'Pas pu faire le ET des chpoints...'
  198. GOTO 9999
  199. ENDIF
  200. * In DTCHPO : SEGSUP CHPLSA
  201. CALL DTCHPO(CHPLSA)
  202. * In DTCHPO : SEGSUP CHPTMP
  203. CALL DTCHPO(CHPTMP)
  204. CHPLSA=CHPTM2
  205. CHPTMP=0
  206. ENDIF
  207. ENDIF
  208. ENDIF
  209. ENDDO
  210. ENDDO
  211. SEGDES TABMAT
  212. SEGDES TABVDC
  213. * WRITE(IOIMP,*) '>'
  214. IF (IMPR.GT.3) THEN
  215. IF (MATLSA.NE.0) THEN
  216. CALL ECROBJ('RIGIDITE',MATLSA)
  217. CALL PRLIST
  218. ENDIF
  219. IF (CHPLSA.NE.0) THEN
  220. CALL ECROBJ('CHPOINT ',CHPLSA)
  221. CALL PRLIST
  222. ENDIF
  223. ENDIF
  224. *
  225. * Normal termination
  226. *
  227. IRET=0
  228. RETURN
  229. *
  230. * Format handling
  231. *
  232. *
  233. * Error handling
  234. *
  235. 9999 CONTINUE
  236. IRET=1
  237. WRITE(IOIMP,*) 'An error was detected in subroutine cv2mca'
  238. RETURN
  239. *
  240. * End of subroutine CV2MCA
  241. *
  242. END
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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