Télécharger cv2mcb.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2MCB SOURCE PV 16/11/17 21:58:57 9180
  2. SUBROUTINE CV2MCB(TABVDC,TABMAT,
  3. $ MYFALS,
  4. $ MATLSB,CHPLSB,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : CV2MCB
  10. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  11. C représentant un ensemble de matrices élémentaires en
  12. C MATRIK...
  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 : PRLSB2
  22. C***********************************************************************
  23. C ENTREES :
  24. C ENTREES/SORTIES : -
  25. C SORTIES :
  26. C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire.
  27. C * JMTLSB (type MCHEVA) : valeurs du champ IMTLSB
  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, 22/07/09, version initiale
  36. C HISTORIQUE : v1, 22/07/09, 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. POINTEUR MATLSB.MATRIK
  49. POINTEUR MATTMP.MATRIK
  50. POINTEUR MATTM2.MATRIK
  51. -INC SMCHPOI
  52. POINTEUR CHPLSB.MCHPOI
  53. POINTEUR CHPTMP.MCHPOI
  54. POINTEUR CHPTM2.MCHPOI
  55. *
  56. * Includes persos
  57. *
  58. CBEGININCLUDE SMCHAEL
  59. SEGMENT MCHAEL
  60. POINTEUR IMACHE(N1).MELEME
  61. POINTEUR ICHEVA(N1).MCHEVA
  62. ENDSEGMENT
  63. SEGMENT MCHEVA
  64. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  65. ENDSEGMENT
  66. SEGMENT LCHEVA
  67. POINTEUR LISCHE(NBCHE).MCHEVA
  68. ENDSEGMENT
  69. CENDINCLUDE SMCHAEL
  70. POINTEUR MYMCHA.MCHAEL
  71. CBEGININCLUDE SFALRF
  72. SEGMENT FALRF
  73. CHARACTER*(LNNFA) NOMFA
  74. INTEGER NUQUAF(NBLRF)
  75. POINTEUR ELEMF(NBLRF).ELREF
  76. ENDSEGMENT
  77. SEGMENT FALRFS
  78. POINTEUR LISFA(0).FALRF
  79. ENDSEGMENT
  80. CENDINCLUDE SFALRF
  81. POINTEUR MYFALS.FALRFS
  82. CBEGININCLUDE SMPOUET
  83. SEGMENT TABGEO
  84. CHARACTER*4 DISGEO
  85. POINTEUR IGEO.MCHAEL
  86. ENDSEGMENT
  87. SEGMENT TABVDC
  88. INTEGER VVARPR(NUMVPR)
  89. INTEGER VVARDU(NUMVDU)
  90. INTEGER VDATPR(NUMDPR)
  91. INTEGER VDATDU(NUMDDU)
  92. INTEGER VCOFPR(NUMCPR)
  93. INTEGER VCOFDU(NUMCDU)
  94. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  95. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  96. POINTEUR VLCOF(JLCOF).MLENTI
  97. POINTEUR VCOMP(JGCOF).COMP
  98. POINTEUR VLDAT(JGCOF).MLENTI
  99. INTEGER DJSVD(JGVD)
  100. POINTEUR NOMVD(JGVD).MLMOTS
  101. POINTEUR MVD(JGVD).MCHPOI
  102. REAL*8 XVD(JGVD)
  103. CHARACTER*4 DISVD(KGVD)
  104. ENDSEGMENT
  105. SEGMENT TATRAV
  106. POINTEUR VVCOF(JLCOF).MCHEVA
  107. POINTEUR VCOF(JGCOF).MCHEVA
  108. POINTEUR IVD(JGVD).MCHAEL
  109. POINTEUR VD(JGVD).MCHEVA
  110. POINTEUR DVD(JGVD).MCHEVA
  111. POINTEUR FFVD(KGVD).MCHEVA
  112. POINTEUR DFFVD(KGVD).MCHEVA
  113. LOGICAL LVCOF(JGCOF)
  114. LOGICAL LVD(JGVD)
  115. LOGICAL LDVD(JGVD)
  116. LOGICAL LFFVD(KGVD)
  117. LOGICAL LDFFVD(KGVD)
  118. ENDSEGMENT
  119. SEGMENT TABMAT
  120. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  121. ENDSEGMENT
  122. CENDINCLUDE SMPOUET
  123. INTEGER NUMVPR,NUMVDU
  124. *
  125. CHARACTER*4 MDISCP,MDISCD,MYDISC
  126. INTEGER IMPR,IRET
  127. *
  128. LOGICAL MVVPR,MVVDU
  129. *
  130. * Executable statements
  131. *
  132. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mcb'
  133. * WRITE(IOIMP,*) '<'
  134. MATLSB=0
  135. CHPLSB=0
  136. MATTMP=0
  137. CHPTMP=0
  138. SEGACT TABVDC
  139. SEGACT TABMAT
  140. * SEGPRT,TABMAT
  141. NUMVPR=TABMAT.VMAT(/2)
  142. NUMVDU=TABMAT.VMAT(/1)
  143. DO IVARPR=1,NUMVPR
  144. DO IVARDU=1,NUMVDU
  145. IJVARP=TABVDC.VVARPR(IVARPR)
  146. IJVARD=TABVDC.VVARDU(IVARDU)
  147. MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  148. MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  149. IKVARP=TABVDC.DJSVD(IJVARP)
  150. MDISCP=TABVDC.DISVD(IKVARP)
  151. NCVARP=TABVDC.NOMVD(IJVARP)
  152. IKVARD=TABVDC.DJSVD(IJVARD)
  153. MDISCD=TABVDC.DISVD(IKVARD)
  154. NCVARD=TABVDC.NOMVD(IJVARD)
  155. MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  156. IF (MYMCHA.NE.0) THEN
  157. IF ((.NOT.MVVPR).AND.(.NOT.MVVDU)) THEN
  158. * In cv2ma9 : SEGINI MATTMP
  159. CALL CV2MAB(MDISCP,NCVARP,MDISCD,NCVARD,
  160. $ MYMCHA,
  161. $ MYFALS,
  162. $ MATTMP,
  163. $ IMPR,IRET)
  164. IF (IRET.NE.0) GOTO 9999
  165. ELSEIF ((.NOT.MVVPR).AND.MVVDU) THEN
  166. MYDISC=MDISCP
  167. MYLMOT=NCVARP
  168. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  169. $ MYFALS,
  170. $ CHPTMP,
  171. $ IMPR,IRET)
  172. IF (IRET.NE.0) GOTO 9999
  173. ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
  174. MYDISC=MDISCD
  175. MYLMOT=NCVARD
  176. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  177. $ MYFALS,
  178. $ CHPTMP,
  179. $ IMPR,IRET)
  180. IF (IRET.NE.0) GOTO 9999
  181. ELSEIF (MVVPR.AND.MVVDU) THEN
  182. MYDISC='CSTE'
  183. JGN=4
  184. JGM=1
  185. SEGINI,MYLMOT
  186. * MYLMOT.MOTS(1)='RES2'
  187. MYLMOT.MOTS(1)='SCAL'
  188. * In CV2CP9 : SEGINI CHPTMP
  189. CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  190. $ MYFALS,
  191. $ CHPTMP,
  192. $ IMPR,IRET)
  193. IF (IRET.NE.0) GOTO 9999
  194. SEGSUP,MYLMOT
  195. ENDIF
  196. IF (CHPTMP.NE.0) THEN
  197. IF (CHPLSB.EQ.0) THEN
  198. CHPLSB=CHPTMP
  199. CHPTMP=0
  200. ELSE
  201. * In ADCHPO : SEGINI CHPTM2
  202. CALL ADCHPO(CHPLSB,CHPTMP,CHPTM2,1.D0,1.D0)
  203. IF (CHPTM2.EQ.0) THEN
  204. WRITE(IOIMP,*)
  205. $ 'Pas pu faire le ET des chpoints...'
  206. GOTO 9999
  207. ENDIF
  208. * In DTCHPO : SEGSUP CHPLSB
  209. CALL DTCHPO(CHPLSB)
  210. * In DTCHPO : SEGSUP CHPTMP
  211. CALL DTCHPO(CHPTMP)
  212. CHPLSB=CHPTM2
  213. CHPTMP=0
  214. ENDIF
  215. ENDIF
  216. IF (MATTMP.NE.0) THEN
  217. IF (MATLSB.EQ.0) THEN
  218. MATLSB=MATTMP
  219. MATTMP=0
  220. ELSE
  221. * In FUSMTK : SEGINI MATTM2
  222. CALL FUSMTK(MATLSB,MATTMP,MATTM2)
  223. IF (MATTM2.EQ.0) THEN
  224. WRITE(IOIMP,*)
  225. $ 'Pas pu faire le ET des matriks...'
  226. GOTO 9999
  227. ENDIF
  228. SEGSUP MATLSB
  229. SEGSUP MATTMP
  230. MATLSB=MATTM2
  231. MATTMP=0
  232. ENDIF
  233. ENDIF
  234. ENDIF
  235. ENDDO
  236. ENDDO
  237. SEGDES TABMAT
  238. SEGDES TABVDC
  239. * WRITE(IOIMP,*) '>'
  240. IF (IMPR.GT.3) THEN
  241. WRITE(IOIMP,*) 'On a créé MATLSB=',MATLSB
  242. IF (MATLSB.NE.0) THEN
  243. CALL ECROBJ('MATRIK',MATLSB)
  244. CALL PRLIST
  245. ENDIF
  246. WRITE(IOIMP,*) 'On a créé CHPLSB=',CHPLSB
  247. IF (CHPLSB.NE.0) THEN
  248. CALL ECROBJ('CHPOINT ',CHPLSB)
  249. CALL PRLIST
  250. ENDIF
  251. ENDIF
  252. *
  253. * Normal termination
  254. *
  255. IRET=0
  256. RETURN
  257. *
  258. * Format handling
  259. *
  260. *
  261. * Error handling
  262. *
  263. 9999 CONTINUE
  264. IRET=1
  265. WRITE(IOIMP,*) 'An error was detected in subroutine cv2mcb'
  266. RETURN
  267. *
  268. * End of subroutine CV2MCB
  269. *
  270. END
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  

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