Télécharger geolf2.eso

Retour à la liste

Numérotation des lignes :

  1. C GEOLF2 SOURCE GOUNAND 06/08/04 21:15:55 5520
  2. SUBROUTINE GEOLF2(LRFVOL,IQUVOL,SFAVOL,
  3. $ MYDISC,METING,MYFALS,MYFPGS,
  4. $ JCOOR,SSFACT,NBELEF,
  5. $ JMAJA2,JMIJA2,JDTJA2,LERJ2,
  6. $ IMPR,IRET)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM : GEOLF2
  11. C PROJET : Noyau linéaire NLIN
  12. C DESCRIPTION :
  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 :
  19. C APPELE PAR :
  20. C***********************************************************************
  21. C ENTREES :
  22. C ENTREES/SORTIES : -
  23. C SORTIES :
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 30/07/03, version initiale
  27. C HISTORIQUE : v1, 30/07/03, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. -INC CCOPTIO
  36. -INC SMELEME
  37. POINTEUR SFAVOL.MELEME
  38. -INC SMLENTI
  39. POINTEUR KPQVOL.MLENTI
  40. *
  41. CBEGININCLUDE SFACTIV
  42. SEGMENT FACTIV
  43. POINTEUR IFACTI(NBSOUV).SFACTI
  44. ENDSEGMENT
  45. SEGMENT SFACTI
  46. POINTEUR ISFACT(NBSOFV).SSFACT
  47. ENDSEGMENT
  48. SEGMENT SSFACT
  49. LOGICAL LFACTI(NBELFV,NBELEV)
  50. ENDSEGMENT
  51. CENDINCLUDE SFACTIV
  52. CBEGININCLUDE SMCHAEL
  53. SEGMENT MCHAEL
  54. POINTEUR IMACHE(N1).MELEME
  55. POINTEUR ICHEVA(N1).MCHEVA
  56. ENDSEGMENT
  57. SEGMENT MCHEVA
  58. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  59. ENDSEGMENT
  60. SEGMENT LCHEVA
  61. POINTEUR LISCHE(NBCHE).MCHEVA
  62. ENDSEGMENT
  63. CENDINCLUDE SMCHAEL
  64. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  65. POINTEUR JCOOR.MCHEVA
  66. POINTEUR KCOOR.MCHEVA
  67. POINTEUR FFFAC.MCHEVA
  68. POINTEUR DFFFAC.MCHEVA
  69. POINTEUR JMAJA2.MCHEVA
  70. POINTEUR JMIJA2.MCHEVA
  71. POINTEUR JDTJA2.MCHEVA
  72. CBEGININCLUDE SELREF
  73. SEGMENT ELREF
  74. CHARACTER*(LNNOM) NOMLRF
  75. CHARACTER*(LNFORM) FORME
  76. CHARACTER*(LNTYPL) TYPEL
  77. CHARACTER*(LNESP) ESPACE
  78. INTEGER DEGRE
  79. REAL*8 XCONOD(NDIMEL,NBNOD)
  80. INTEGER NPQUAF(NBDDL)
  81. INTEGER NUMCMP(NBDDL)
  82. INTEGER QUENOD(NBDDL)
  83. INTEGER ORDDER(NDIMEL,NBDDL)
  84. POINTEUR MBPOLY.POLYNS
  85. ENDSEGMENT
  86. SEGMENT ELREFS
  87. POINTEUR LISEL(0).ELREF
  88. ENDSEGMENT
  89. CENDINCLUDE SELREF
  90. POINTEUR LRFVOL.ELREF
  91. POINTEUR LRFFAC.ELREF
  92. CBEGININCLUDE SFALRF
  93. SEGMENT FALRF
  94. CHARACTER*(LNNFA) NOMFA
  95. INTEGER NUQUAF(NBLRF)
  96. POINTEUR ELEMF(NBLRF).ELREF
  97. ENDSEGMENT
  98. SEGMENT FALRFS
  99. POINTEUR LISFA(0).FALRF
  100. ENDSEGMENT
  101. CENDINCLUDE SFALRF
  102. POINTEUR MYFALS.FALRFS
  103. CBEGININCLUDE SPOGAU
  104. SEGMENT POGAU
  105. CHARACTER*(LNNPG) NOMPG
  106. CHARACTER*(LNTPG) TYPMPG
  107. CHARACTER*(LNFPG) FORLPG
  108. INTEGER NORDPG
  109. REAL*8 XCOPG(NDLPG,NBPG)
  110. REAL*8 XPOPG(NBPG)
  111. ENDSEGMENT
  112. SEGMENT POGAUS
  113. POINTEUR LISPG(0).POGAU
  114. ENDSEGMENT
  115. CENDINCLUDE SPOGAU
  116. POINTEUR PGFAC.POGAU
  117. CBEGININCLUDE SFAPG
  118. SEGMENT FAPG
  119. CHARACTER*(LNNFAP) NOMFAP
  120. INTEGER NBQUAF(NBMPG)
  121. POINTEUR MPOGAU(NBMPG).POGAU
  122. ENDSEGMENT
  123. SEGMENT FAPGS
  124. POINTEUR LISFPG(0).FAPG
  125. ENDSEGMENT
  126. CENDINCLUDE SFAPG
  127. POINTEUR MYFPGS.FAPGS
  128. CBEGININCLUDE SIQUAF
  129. SEGMENT IQUAF
  130. INTEGER NUMQUF
  131. REAL*8 XCONQR(NDIMQR,NBNOQR)
  132. INTEGER NUCENT
  133. POINTEUR LFACE.MELEME
  134. ENDSEGMENT
  135. SEGMENT IQUAFS
  136. POINTEUR LISQRF(NBQRF).IQUAF
  137. ENDSEGMENT
  138. CENDINCLUDE SIQUAF
  139. POINTEUR IQUVOL.IQUAF
  140. *
  141. LOGICAL LERJ2
  142. CHARACTER*4 MYDISC,METING
  143. INTEGER NBELEV,NBELEF,NBELFV
  144. INTEGER IMPR,IRET
  145. *
  146. * Executable statements
  147. *
  148. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geolf2'
  149. *
  150. * 1ere etape : on crée les ddl de la transfo geometrique
  151. *
  152. SEGACT IQUVOL
  153. NDIMQR=IQUVOL.XCONQR(/1)
  154. NBNOQR=IQUVOL.XCONQR(/2)
  155. SEGDES IQUVOL
  156. SEGACT LRFVOL
  157. NDDLVO=LRFVOL.NPQUAF(/1)
  158. JG=NBNOQR
  159. SEGINI KPQVOL
  160. DO IDDLVO=1,NDDLVO
  161. KPQVOL.LECT(LRFVOL.NPQUAF(IDDLVO))=IDDLVO
  162. ENDDO
  163. SEGDES LRFVOL
  164. SEGACT SFAVOL
  165. ITYFAC=SFAVOL.ITYPEL
  166. CALL KEEF(ITYFAC,MYDISC,
  167. $ MYFALS,
  168. $ LRFFAC,
  169. $ IMPR,IRET)
  170. IF (IRET.NE.0) GOTO 9999
  171. SEGACT LRFFAC
  172. NDDLFA=LRFFAC.NPQUAF(/1)
  173. SEGACT SSFACT
  174. NBELFV=SSFACT.LFACTI(/1)
  175. NBELEV=SSFACT.LFACTI(/2)
  176. NBLIG=1
  177. NBCOL=NDDLFA
  178. N2LIG=1
  179. N2COL=NDIMQR
  180. NBPOI=1
  181. NBELM=NBELEF
  182. SEGINI KCOOR
  183. SEGACT JCOOR
  184. IBELEF=0
  185. DO IBELEV=1,NBELEV
  186. DO IBELFV=1,NBELFV
  187. IF (SSFACT.LFACTI(IBELFV,IBELEV)) THEN
  188. IBELEF=IBELEF+1
  189. DO IDDLFA=1,NDDLFA
  190. IBNOQR=SFAVOL.NUM(LRFFAC.NPQUAF(IDDLFA),IBELFV)
  191. IBNOVO=KPQVOL.LECT(IBNOQR)
  192. DO IDIMQR=1,NDIMQR
  193. KCOOR.VELCHE(1,IDDLFA,1,IDIMQR,1,IBELEF)=
  194. $ JCOOR.VELCHE(1,IBNOVO,1,IDIMQR,1,IBELEV)
  195. ENDDO
  196. ENDDO
  197. ENDIF
  198. ENDDO
  199. ENDDO
  200. SEGDES JCOOR
  201. SEGDES SSFACT
  202. SEGDES LRFFAC
  203. SEGDES SFAVOL
  204. SEGSUP KPQVOL
  205. *
  206. * 2ème étape : - on crée les fonctions de forme et leurs dérivées
  207. * pour la transformation géométrie face -> volume
  208. * - on récupère coordonnées et poids des points de
  209. * Gauss pour la méthode METING sur la face de
  210. * référence
  211. * - pour chaque face de l'élément de référence volumique
  212. * on construit les coordonnées des points de Gauss
  213. * attenant à l'aide de la transformation géométrique
  214. *
  215. CALL KEPG(ITYFAC,METING,
  216. $ MYFPGS,
  217. $ PGFAC,
  218. $ IMPR,IRET)
  219. IF (IRET.NE.0) GOTO 9999
  220. *
  221. * In KFNREF : SEGINI FFFAC
  222. * In KFNREF : SEGINI DFFFAC
  223. *
  224. CALL KFNREF(LRFFAC,PGFAC,
  225. $ FFFAC,DFFFAC,
  226. $ IMPR,IRET)
  227. IF (IRET.NE.0) GOTO 9999
  228. SEGSUP FFFAC
  229. *
  230. * 3ème étape : On crée le déterminant de la matrice jacobienne
  231. * aux points de Gauss et on multiplie
  232. * les poids des points de Gauss par ce déterminant
  233. *
  234. * In GEOLIN : SEGINI JMAJA2
  235. * In GEOLIN : SEGINI JMIJA2
  236. * In GEOLIN : SEGINI JDTJA2
  237. * SEGPRT,DFFFAC
  238. * SEGPRT,KCOOR
  239. CALL GEOLIN(DFFFAC,KCOOR,NBELEF,
  240. $ JMAJA2,JMIJA2,JDTJA2,LERJ2,
  241. $ IMPR,IRET)
  242. IF (IRET.NE.0) GOTO 9999
  243. * SEGPRT,JDTJA2
  244. * In GEOLIN : SEGDES JMAJA2
  245. * In GEOLIN : SEGDES JMIJA2
  246. * In GEOLIN : SEGDES JDTJA2
  247. SEGSUP DFFFAC
  248. SEGSUP KCOOR
  249. * SEGPRT,IQUVOL
  250. * SEGPRT,SFAVOL
  251. * SEGPRT,LRFVOL
  252. * SEGPRT,LRFFAC
  253. * SEGPRT,SSFACT
  254. * SEGPRT, JCOOR
  255. * SEGPRT, KCOOR
  256. * SEGPRT,PGFAC
  257. * SEGPRT,DFFFAC
  258. * SEGPRT,JMAJA2
  259. * SEGPRT,JDTJA2
  260. * STOP 16
  261.  
  262. *
  263. * Normal termination
  264. *
  265. IRET=0
  266. RETURN
  267. *
  268. * Format handling
  269. *
  270. *
  271. * Error handling
  272. *
  273. 9999 CONTINUE
  274. IRET=1
  275. WRITE(IOIMP,*) 'An error was detected in subroutine geolf2'
  276. RETURN
  277. *
  278. * End of subroutine GEOLF2
  279. *
  280. END
  281.  
  282.  
  283.  

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