Télécharger georeg.eso

Retour à la liste

Numérotation des lignes :

  1. C GEOREG SOURCE BP208322 16/11/18 21:17:23 9177
  2. SUBROUTINE GEOREG(ITQUAF,MYFALS,MYFPGS,
  3. $ JMAREG,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : GEOREG
  9. C DESCRIPTION :
  10. *
  11. * Calcul du jacobien de la transformation :
  12. * élément volumique de référence -> élément réguliers
  13. * de côté 1
  14. * Cela sert pour l'adaptativité.
  15. C
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES :
  21. C APPELES (E/S) :
  22. C APPELES (BLAS) :
  23. C APPELES (CALCUL) :
  24. C APPELE PAR :
  25. C***********************************************************************
  26. C SYNTAXE GIBIANE :
  27. C ENTREES :
  28. C ENTREES/SORTIES :
  29. C SORTIES :
  30. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  31. C***********************************************************************
  32. C VERSION : v1, 04/10/2005, version initiale
  33. C HISTORIQUE : v1, 04/10/2005, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38. C en cas de modification de ce sous-programme afin de faciliter
  39. C la maintenance !
  40. C***********************************************************************
  41. -INC CCOPTIO
  42. -INC CCGEOME
  43. CBEGININCLUDE SELREF
  44. SEGMENT ELREF
  45. CHARACTER*(LNNOM) NOMLRF
  46. CHARACTER*(LNFORM) FORME
  47. CHARACTER*(LNTYPL) TYPEL
  48. CHARACTER*(LNESP) ESPACE
  49. INTEGER DEGRE
  50. REAL*8 XCONOD(NDIMEL,NBNOD)
  51. INTEGER NPQUAF(NBDDL)
  52. INTEGER NUMCMP(NBDDL)
  53. INTEGER QUENOD(NBDDL)
  54. INTEGER ORDDER(NDIMEL,NBDDL)
  55. POINTEUR MBPOLY.POLYNS
  56. ENDSEGMENT
  57. SEGMENT ELREFS
  58. POINTEUR LISEL(0).ELREF
  59. ENDSEGMENT
  60. CENDINCLUDE SELREF
  61. POINTEUR ELCOUR.ELREF
  62. CBEGININCLUDE SFALRF
  63. SEGMENT FALRF
  64. CHARACTER*(LNNFA) NOMFA
  65. INTEGER NUQUAF(NBLRF)
  66. POINTEUR ELEMF(NBLRF).ELREF
  67. ENDSEGMENT
  68. SEGMENT FALRFS
  69. POINTEUR LISFA(0).FALRF
  70. ENDSEGMENT
  71. CENDINCLUDE SFALRF
  72. POINTEUR MYFALS.FALRFS
  73. CBEGININCLUDE SPOGAU
  74. SEGMENT POGAU
  75. CHARACTER*(LNNPG) NOMPG
  76. CHARACTER*(LNTPG) TYPMPG
  77. CHARACTER*(LNFPG) FORLPG
  78. INTEGER NORDPG
  79. REAL*8 XCOPG(NDLPG,NBPG)
  80. REAL*8 XPOPG(NBPG)
  81. ENDSEGMENT
  82. SEGMENT POGAUS
  83. POINTEUR LISPG(0).POGAU
  84. ENDSEGMENT
  85. CENDINCLUDE SPOGAU
  86. POINTEUR MYPGS.POGAUS
  87. POINTEUR PGCOUR.POGAU
  88. CBEGININCLUDE SFAPG
  89. SEGMENT FAPG
  90. CHARACTER*(LNNFAP) NOMFAP
  91. INTEGER NBQUAF(NBMPG)
  92. POINTEUR MPOGAU(NBMPG).POGAU
  93. ENDSEGMENT
  94. SEGMENT FAPGS
  95. POINTEUR LISFPG(0).FAPG
  96. ENDSEGMENT
  97. CENDINCLUDE SFAPG
  98. POINTEUR MYFPGS.FAPGS
  99. CBEGININCLUDE SMCHAEL
  100. SEGMENT MCHAEL
  101. POINTEUR IMACHE(N1).MELEME
  102. POINTEUR ICHEVA(N1).MCHEVA
  103. ENDSEGMENT
  104. SEGMENT MCHEVA
  105. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  106. ENDSEGMENT
  107. SEGMENT LCHEVA
  108. POINTEUR LISCHE(NBCHE).MCHEVA
  109. ENDSEGMENT
  110. CENDINCLUDE SMCHAEL
  111. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  112. POINTEUR JCOOR.MCHEVA
  113. POINTEUR JMAREG.MCHEVA
  114. POINTEUR JMIREG.MCHEVA
  115. POINTEUR JDTREG.MCHEVA
  116. POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA
  117. *
  118. SEGMENT NOEREG
  119. REAL*8 XNOEUD(NDIM,NNLREG)
  120. ENDSEGMENT
  121. *
  122. CHARACTER*4 CQUAF,METGAU,MYDISC
  123. LOGICAL LBID
  124. INTEGER IMPR,IRET
  125.  
  126. *
  127. * Executable statements
  128. *
  129. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans georeg.eso'
  130. CQUAF=NOMS(ITQUAF)
  131. *
  132. * Here : SEGINI NOEREG
  133. *
  134. IF (CQUAF.EQ.'SEG3') THEN
  135. NNLREG=2
  136. NDIM =1
  137. SEGINI NOEREG
  138. XNOEUD(1,1)=0.D0
  139. XNOEUD(1,2)=1.D0
  140. * SEGDES NOEREG
  141. ELSEIF (CQUAF.EQ.'TRI7') THEN
  142. NNLREG=3
  143. NDIM =2
  144. SEGINI NOEREG
  145. XNOEUD(1,1)=0.D0
  146. XNOEUD(2,1)=0.D0
  147. XNOEUD(1,2)=1.D0
  148. XNOEUD(2,2)=0.D0
  149. XNOEUD(1,3)=0.5D0
  150. XNOEUD(2,3)=SQRT(3.D0)/2.D0
  151. * SEGDES NOEREG
  152. ELSEIF (CQUAF.EQ.'QUA9') THEN
  153. NNLREG=4
  154. NDIM =2
  155. SEGINI NOEREG
  156. XNOEUD(1,1)=0.D0
  157. XNOEUD(2,1)=0.D0
  158. XNOEUD(1,2)=1.D0
  159. XNOEUD(2,2)=0.D0
  160. XNOEUD(1,3)=1.D0
  161. XNOEUD(2,3)=1.D0
  162. XNOEUD(1,4)=0.D0
  163. XNOEUD(2,4)=1.D0
  164. * SEGDES NOEREG
  165. ELSEIF (CQUAF.EQ.'TE15') THEN
  166. NNLREG=4
  167. NDIM =3
  168. SEGINI NOEREG
  169. XNOEUD(1,1)=0.D0
  170. XNOEUD(2,1)=0.D0
  171. XNOEUD(3,1)=0.D0
  172. XNOEUD(1,2)=1.D0
  173. XNOEUD(2,2)=0.D0
  174. XNOEUD(3,2)=0.D0
  175. XNOEUD(1,3)=0.5D0
  176. XNOEUD(2,3)=SQRT(3.D0)/2.D0
  177. XNOEUD(3,3)=0.D0
  178. XNOEUD(1,4)=0.5D0
  179. XNOEUD(2,4)=SQRT(3.D0)/6.D0
  180. XNOEUD(3,4)=SQRT(6.D0)/3.D0
  181. * SEGDES NOEREG
  182. ELSEIF (CQUAF.EQ.'PY19') THEN
  183. NNLREG=5
  184. NDIM =3
  185. SEGINI NOEREG
  186. XNOEUD(1,1)=0.D0
  187. XNOEUD(2,1)=0.D0
  188. XNOEUD(3,1)=0.D0
  189. XNOEUD(1,2)=1.D0
  190. XNOEUD(2,2)=0.D0
  191. XNOEUD(3,2)=0.D0
  192. XNOEUD(1,3)=1.D0
  193. XNOEUD(2,3)=1.D0
  194. XNOEUD(3,3)=0.D0
  195. XNOEUD(1,4)=0.D0
  196. XNOEUD(2,4)=1.D0
  197. XNOEUD(3,4)=0.D0
  198. XNOEUD(1,5)=0.5D0
  199. XNOEUD(2,5)=0.5D0
  200. XNOEUD(3,5)=SQRT(2.D0)/2.D0
  201. * XNOEUD(3,5)=1.D0
  202. * SEGDES NOEREG
  203. ELSEIF (CQUAF.EQ.'PR21') THEN
  204. NNLREG=6
  205. NDIM =3
  206. SEGINI NOEREG
  207. XNOEUD(1,1)=0.D0
  208. XNOEUD(2,1)=0.D0
  209. XNOEUD(3,1)=0.D0
  210. XNOEUD(1,2)=1.D0
  211. XNOEUD(2,2)=0.D0
  212. XNOEUD(3,2)=0.D0
  213. XNOEUD(1,3)=0.5D0
  214. XNOEUD(2,3)=SQRT(3.D0)/2.D0
  215. XNOEUD(3,3)=0.D0
  216. *
  217. XNOEUD(1,4)=0.D0
  218. XNOEUD(2,4)=0.D0
  219. XNOEUD(3,4)=1.D0
  220. XNOEUD(1,5)=1.D0
  221. XNOEUD(2,5)=0.D0
  222. XNOEUD(3,5)=1.D0
  223. XNOEUD(1,6)=0.5D0
  224. XNOEUD(2,6)=SQRT(3.D0)/2.D0
  225. XNOEUD(3,6)=1.D0
  226.  
  227. * SEGDES NOEREG
  228. ELSEIF (CQUAF.EQ.'CU27') THEN
  229. NNLREG=8
  230. NDIM =3
  231. SEGINI NOEREG
  232. XNOEUD(1,1)=0.D0
  233. XNOEUD(2,1)=0.D0
  234. XNOEUD(3,1)=0.D0
  235. XNOEUD(1,2)=1.D0
  236. XNOEUD(2,2)=0.D0
  237. XNOEUD(3,2)=0.D0
  238. XNOEUD(1,3)=1.D0
  239. XNOEUD(2,3)=1.D0
  240. XNOEUD(3,3)=0.D0
  241. XNOEUD(1,4)=0.D0
  242. XNOEUD(2,4)=1.D0
  243. XNOEUD(3,4)=0.D0
  244. *
  245. XNOEUD(1,5)=0.D0
  246. XNOEUD(2,5)=0.D0
  247. XNOEUD(3,5)=1.D0
  248. XNOEUD(1,6)=1.D0
  249. XNOEUD(2,6)=0.D0
  250. XNOEUD(3,6)=1.D0
  251. XNOEUD(1,7)=1.D0
  252. XNOEUD(2,7)=1.D0
  253. XNOEUD(3,7)=1.D0
  254. XNOEUD(1,8)=0.D0
  255. XNOEUD(2,8)=1.D0
  256. XNOEUD(3,8)=1.D0
  257. * SEGDES NOEREG
  258. ELSE
  259. WRITE(IOIMP,*) CQUAF,' regulier non implemente'
  260. GOTO 9999
  261. ENDIF
  262. *
  263. NBLIG=1
  264. NBCOL=XNOEUD(/2)
  265. N2LIG=1
  266. N2COL=XNOEUD(/1)
  267. NBPOI=1
  268. NBELM=1
  269. SEGINI JCOOR
  270. DO I=1,N2COL
  271. DO J=1,NBCOL
  272. JCOOR.VELCHE(1,J,1,I,1,1)=XNOEUD(I,J)
  273. ENDDO
  274. ENDDO
  275. *
  276. * On suppose la transformation linéaire entre élément de
  277. * référence et élément régulier => 1 point de Gauss
  278. *
  279. METGAU='GAU1'
  280. CALL KEPG(ITQUAF,METGAU,
  281. $ MYFPGS,
  282. $ PGCOUR,
  283. $ IMPR,IRET)
  284. IF (IRET.NE.0) GOTO 9999
  285. MYDISC='LINE'
  286. CALL KEEF(ITQUAF,MYDISC,
  287. $ MYFALS,
  288. $ ELCOUR,
  289. $ IMPR,IRET)
  290. IF (IRET.NE.0) GOTO 9999
  291. * In KFNREF : SEGINI FFPG
  292. * In KFNREF : SEGINI DFFPG
  293. CALL KFNREF(ELCOUR,PGCOUR,
  294. $ FFPG,DFFPG,
  295. $ IMPR,IRET)
  296. IF (IRET.NE.0) GOTO 9999
  297. * Création des matrices jacobiennes et déterminants
  298. * On ne garde que la matrice jacobienne.
  299. * In GEOLIN : SEGINI JMAREG
  300. * In GEOLIN : SEGINI JMIREG
  301. * In GEOLIN : SEGINI JDTREG
  302. NBELEM=1
  303. LBID=.FALSE.
  304. *
  305. CALL GEOLIN(DFFPG,JCOOR,NBELEM,
  306. $ JMAREG,JMIREG,JDTREG,LBID,
  307. $ IMPR,IRET)
  308. IF (IRET.NE.0) THEN
  309. IF (LBID) GOTO 9666
  310. GOTO 9999
  311. ENDIF
  312. SEGSUP JDTREG
  313. SEGSUP JMIREG
  314. SEGDES JMAREG
  315. SEGSUP DFFPG
  316. SEGSUP FFPG
  317. SEGSUP JCOOR
  318. SEGSUP NOEREG
  319. * SEGPRT,JMAREG
  320. *
  321. * Normal termination
  322. *
  323. IRET=0
  324. RETURN
  325. *
  326. * Format handling
  327. *
  328. *
  329. * Error handling
  330. *
  331. 9666 CONTINUE
  332. IRET=666
  333. RETURN
  334. 9999 CONTINUE
  335. IRET=1
  336. WRITE(IOIMP,*) 'An error was detected in subroutine georeg'
  337. RETURN
  338. *
  339. * End of subroutine GEOREG
  340. *
  341. END
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  

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