Télécharger kalpbg.eso

Retour à la liste

Numérotation des lignes :

  1. C KALPBG SOURCE MAGN 10/05/31 21:15:10 6679
  2. SUBROUTINE KALPBG(NOME,DISCR,IZFFM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  6. C
  7. C CE SOUS PROGRAMME CREE DES OBJETS DE TYPE FONFORM OU FONFORM0
  8. C SUIVANT QUE ITYPI = 1 OU 0 ET CONTENANT LES FONCTIONS DE FORME
  9. C DU TYPE D'ELEMENT CONSIDERE
  10. C
  11. C ARGUMENTS D'ENTREE NOMI CHARACTER*8 TYPE ELEMENT DS TYPELT
  12. C (COMMON CCHAMTR)
  13. C ITYPI ENTIER 1 INTEGRATION NORMALE
  14. C 0 SOUS INTEGRATION
  15. C NOM2= PRP1 -> vitesses quadratiques pression P1
  16. C NOM2= PRP0 -> vitesses quadratiques pression P0
  17. C NOM2= PFP1 -> vitesses quadratiques pression P1 C
  18. C NOM2= MCP1 -> vitesses Iso-P2 pression P1
  19. C NOM2= MCP0 -> vitesses Iso-P2 pression P0
  20. C NOM2= MCF1 -> vitesses Iso-P2 pression P1/Q1 C
  21. C
  22. C IZFFM POINTEUR DE L'OBJET CR{{
  23. C
  24. C IES=IDIM EST LA DIMENSION DE L ESPACE DE CALCUL
  25. C NES EST LA DIMENSION DE L ESPACE DE L ELEMENT DE REFERENC
  26. C NP NB DE PTS DE L ELEMENT
  27. C MP NB DE PTS PRESSION
  28. C NPG NB DE PTS D'INTEGRATION POUR LA VITESSE
  29. C MPG NB DE PTS D'INTEGRATION POUR LA PRESSION
  30. C
  31. C FN(NP,NPG) ) ELEMENT DE REF
  32. C GR(NES,NP,NPG) )
  33. C FM(MP,NPG) )
  34. C GM(NES,MP,NPG) )
  35. C
  36. C HR(IES,NP,NPG) ) GRADIENT DANS LE REPERE GLOBAL DEFINI ICI
  37. C MAIS CHARGE DANS LES CALJ..
  38. C IES=NES SI L ELEMENT EST DROIT
  39. C IES=IES SI L ELEMENT EST GAUCHE
  40. C PG(NPG)
  41. C
  42. C -----------------------------------------------------------------
  43. C***
  44. C
  45. C Modification du 12/01/99 : les elements dont les fonctions de formes
  46. C n'existent pas sont en commentaires
  47. C Cela correspond aux subroutines suivantes : PB602, PB802, PRPB15,
  48. C PB2003
  49. C***
  50. * 15/06/00 : ajout tétraèdre quadratique par gounand
  51. *
  52. *
  53. REAL*8 X(64),Y(64),Z(64)
  54. PARAMETER (NBELT=21)
  55. CHARACTER*8 NOME,DISCR,TYPELT(NBELT),NOM1
  56. CHARACTER*4 NOM2
  57. -INC CCOPTIO
  58. -INC SIZFFB
  59. POINTEUR IZF1.IZFFM,IZF2.IZFFM
  60. CBEGININCLUDE SELREF
  61. SEGMENT ELREF
  62. CHARACTER*(LNNOM) NOMLRF
  63. CHARACTER*(LNFORM) FORME
  64. CHARACTER*(LNTYPL) TYPEL
  65. CHARACTER*(LNESP) ESPACE
  66. INTEGER DEGRE
  67. REAL*8 XCONOD(NDIMEL,NBNOD)
  68. INTEGER NPQUAF(NBDDL)
  69. INTEGER NUMCMP(NBDDL)
  70. INTEGER QUENOD(NBDDL)
  71. INTEGER ORDDER(NDIMEL,NBDDL)
  72. POINTEUR MBPOLY.POLYNS
  73. ENDSEGMENT
  74. SEGMENT ELREFS
  75. POINTEUR LISEL(0).ELREF
  76. ENDSEGMENT
  77. CENDINCLUDE SELREF
  78. POINTEUR MYLRFS.ELREFS
  79. POINTEUR ELVIT.ELREF
  80. POINTEUR ELPRES.ELREF
  81. CBEGININCLUDE SFALRF
  82. SEGMENT FALRF
  83. CHARACTER*(LNNFA) NOMFA
  84. INTEGER NUQUAF(NBLRF)
  85. POINTEUR ELEMF(NBLRF).ELREF
  86. ENDSEGMENT
  87. SEGMENT FALRFS
  88. POINTEUR LISFA(0).FALRF
  89. ENDSEGMENT
  90. CENDINCLUDE SFALRF
  91. POINTEUR MYFALS.FALRFS
  92. CBEGININCLUDE SPOGAU
  93. SEGMENT POGAU
  94. CHARACTER*(LNNPG) NOMPG
  95. CHARACTER*(LNTPG) TYPMPG
  96. CHARACTER*(LNFPG) FORLPG
  97. INTEGER NORDPG
  98. REAL*8 XCOPG(NDLPG,NBPG)
  99. REAL*8 XPOPG(NBPG)
  100. ENDSEGMENT
  101. SEGMENT POGAUS
  102. POINTEUR LISPG(0).POGAU
  103. ENDSEGMENT
  104. CENDINCLUDE SPOGAU
  105. POINTEUR MYPGS.POGAUS
  106. POINTEUR PGCOUR.POGAU
  107. CBEGININCLUDE SMCHAEL
  108. SEGMENT MCHAEL
  109. POINTEUR IMACHE(N1).MELEME
  110. POINTEUR ICHEVA(N1).MCHEVA
  111. ENDSEGMENT
  112. SEGMENT MCHEVA
  113. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  114. ENDSEGMENT
  115. SEGMENT LCHEVA
  116. POINTEUR LISCHE(NBCHE).MCHEVA
  117. ENDSEGMENT
  118. CENDINCLUDE SMCHAEL
  119. POINTEUR FFPGV.MCHEVA
  120. POINTEUR DFFPGV.MCHEVA
  121. POINTEUR FFPGP.MCHEVA
  122. POINTEUR DFFPGP.MCHEVA
  123. C
  124. DATA TYPELT/'SEG2 ','TRI3 ','QUA4 ',
  125. & 'PRI6 ','CUB8 ','TET4 ','PYR5 ',
  126. C speciaux iso-P2 p1/p0
  127. & 'TRI6 ','PR18 ','TE10 ','PY14xxxx',
  128. C quadratiques
  129. & 'SEG3 ','TRI7 ','QUA9 ',
  130. & 'PR21 ','CU27 ','TE15 ','PY19xxxx',
  131. C lineaires b
  132. & 'TRI4 ','TET5 ',
  133. C cubiques
  134. & 'SEG4 '/
  135. C***
  136. *
  137. * Initialisation du segment contenant les informations sur les
  138. * éléments de référence.
  139. *
  140. * SEGINI MYLRFS.LISEL(*)
  141. IMPR=0
  142. CALL INLRFS(MYLRFS,IMPR,IRET)
  143. IF (IRET.NE.0) GOTO 9999
  144. *
  145. * Initialisation du segment contenant les informations sur les
  146. * méthodes d'intégration (type Gauss).
  147. *
  148. * SEGINI MYPGS.LISPG(*)
  149. CALL INPGS(MYPGS,IMPR,IRET)
  150. IF (IRET.NE.0) GOTO 9999
  151. *
  152. IZFFM=0
  153. IF(DISCR.EQ.'FONFORM0')THEN
  154. ITYPI=0
  155. ELSEIF(DISCR.EQ.'FONFORM ')THEN
  156. ITYPI=1
  157. ELSEIF(DISCR.EQ.'LOBATTO ')THEN
  158. ITYPI=2
  159. ELSE
  160. C Impossible d'utiliser cet opérateur pour la formulation %m1:8
  161. MOTERR(1:8) = DISCR
  162. CALL ERREUR(193)
  163. RETURN
  164. ENDIF
  165. C
  166. IES=IDIM
  167. NOM1=NOME(1:4)//' '
  168. NOM2=NOME(5:8)
  169. C WRITE(6,*)'KALPBG NOM1=',NOM1,' NOM2=',NOM2,':'
  170. CALL OPTLI(IP,TYPELT,NOM1,NBELT)
  171. C
  172. IF(IP.EQ.0)THEN
  173. WRITE(6,1981)NOME
  174. 1981 FORMAT(/10X,' SUB KALPBG : ',1X,A8,' TYPE D''ELEMENT NON ENCORE PR
  175. &EVU')
  176. RETURN
  177. ENDIF
  178. C
  179. GO TO (
  180. & 201 ,302 ,402 ,603 ,803 ,403 ,503 ,
  181. & 612 , 1813, 1013,1413,
  182. & 301 ,702 ,902 ,2103,2703,1503,1903,
  183. & 9402,9503,
  184. & 401),IP
  185. C
  186. C
  187. C100 CONTINUE
  188. C? NP=1
  189. C? NES=0
  190. C? NG=1
  191. C? NPG=1
  192. C? N1=0
  193. C? N2=2
  194. C? CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  195. C? CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  196. C? KZHR(1)=IPKKZZ
  197. C? NOMEL=TYPELT(IP)
  198. C? FN(1,1)=1.D0
  199. C? GO TO 1
  200. C************************** ELEMENTS LINE ******************************
  201.  
  202. C SEG2
  203. 201 CONTINUE
  204. NP=2
  205. MP=1
  206. IF(NOM2.EQ.'P1P1')MP=2
  207. NES=1
  208. NG=2
  209. NPG=2
  210. IF(ITYPI.EQ.0)NG=1
  211. IF(ITYPI.EQ.0)NPG=1
  212. N1=1
  213. N2=2
  214. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  215. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  216. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  217. KZHR(1)=IPKKZZ
  218. KZHR(2)=IPKKZ2
  219. NOMEL=TYPELT(IP)
  220. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  221. KTP(1)=IZF1
  222. CALL PB201
  223. &(XREF,X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
  224. GO TO 1
  225.  
  226. C TRI3
  227. 302 CONTINUE
  228. NP=3
  229. MP=1
  230. IF(NOM2.EQ.'P1P1')MP=3
  231. NES=2
  232. NPG=7
  233. IF(ITYPI.EQ.0)NPG=1
  234. IF(ITYPI.EQ.2)NPG=3
  235. N1=1
  236. N2=2
  237. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  238. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  239. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  240. KZHR(1)=IPKKZZ
  241. KZHR(2)=IPKKZ2
  242. NOMEL=TYPELT(IP)
  243. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  244. KTP(1)=IZF1
  245. CALL PB302
  246. &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2,ITYPI)
  247. GO TO 1
  248.  
  249. C QUA4
  250. 402 CONTINUE
  251. NP=4
  252. MP=1
  253. IF(NOM2.EQ.'P1P1')MP=4
  254. NES=2
  255. NG=2
  256. NPG=4
  257. IF(ITYPI.EQ.0)NG=1
  258. IF(ITYPI.EQ.0)NPG=1
  259. N1=1
  260. N2=2
  261. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  262. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  263. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  264. KZHR(1)=IPKKZZ
  265. KZHR(2)=IPKKZ2
  266. NOMEL=TYPELT(IP)
  267. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  268. KTP(1)=IZF1
  269. CALL PB402
  270. &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
  271. GO TO 1
  272.  
  273. C PRI6
  274. 603 CONTINUE
  275. NP=6
  276. MP=1
  277. IF(NOM2.EQ.'P1P1')MP=6
  278. NES=3
  279. NPG=6
  280. IF(ITYPI.EQ.0)NPG=1
  281. N1=1
  282. N2=2
  283. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  284. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  285. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  286. KZHR(1)=IPKKZZ
  287. KZHR(2)=IPKKZ2
  288. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  289. KTP(1)=IZF1
  290. NOMEL=TYPELT(IP)
  291. CALL PB603
  292. &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
  293. GOTO 1
  294.  
  295. C CUB8
  296. 803 CONTINUE
  297. NP=8
  298. MP=1
  299. IF(NOM2.EQ.'P1P1')MP=8
  300. NES=3
  301. NG=2
  302. NPG=8
  303. IF(ITYPI.EQ.0)NG=1
  304. IF(ITYPI.EQ.0)NPG=1
  305. N1=1
  306. N2=2
  307. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  308. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  309. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  310. KZHR(1)=IPKKZZ
  311. KZHR(2)=IPKKZ2
  312. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  313. KTP(1)=IZF1
  314. NOMEL=TYPELT(IP)
  315. CALL PB803
  316. &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
  317. GO TO 1
  318.  
  319. C TET4
  320. 403 CONTINUE
  321. NP=4
  322. MP=1
  323. IF(NOM2.EQ.'P1P1')MP=4
  324. NES=3
  325. NPG=4
  326. IF(ITYPI.EQ.0)NPG=1
  327. N1=1
  328. N2=2
  329. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  330. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  331. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  332. KZHR(1)=IPKKZZ
  333. KZHR(2)=IPKKZ2
  334. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  335. KTP(1)=IZF1
  336. NOMEL=TYPELT(IP)
  337. CALL PB403
  338. &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
  339. GO TO 1
  340.  
  341. C PYR5
  342. 503 CONTINUE
  343. NP=5
  344. MP=1
  345. IF(NOM2.EQ.'P1P1')MP=5
  346. NES=3
  347. NPG=5
  348. IF(ITYPI.EQ.0)NPG=1
  349. N1=1
  350. N2=2
  351. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  352. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  353. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  354. KZHR(1)=IPKKZZ
  355. KZHR(2)=IPKKZ2
  356. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  357. KTP(1)=IZF1
  358. NOMEL=TYPELT(IP)
  359. CALL PB503
  360. &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
  361. GO TO 1
  362.  
  363. C************************** ELEMENTS LINB ******************************
  364.  
  365. C TRI4
  366. 9402 CONTINUE
  367. IMPR=0
  368. CALL FILRF('H1D1TR4',MYLRFS,ELVIT,IMPR,IRET)
  369. IF (IRET.NE.0) GOTO 9999
  370. CALL FILRF('H1D1TR3',MYLRFS,ELPRES,IMPR,IRET)
  371. IF (ITYPI.EQ.0) THEN
  372. CALL FIPG('GAT2-1-1',MYPGS,PGCOUR,IMPR,IRET)
  373. IF (IRET.NE.0) GOTO 9999
  374. ELSE
  375. CALL FIPG('GAT2-7-12',MYPGS,PGCOUR,IMPR,IRET)
  376. IF (IRET.NE.0) GOTO 9999
  377. ENDIF
  378. *
  379. * Calculons les fns de forme de réf. et leurs dérivées aux
  380. * points de Gauss pour chaque type d'éléments...
  381. *
  382. CALL KFNREF(ELVIT,PGCOUR,
  383. $ FFPGV,DFFPGV,
  384. $ IMPR,IRET)
  385. IF (IRET.NE.0) GOTO 9999
  386. CALL KFNREF(ELPRES,PGCOUR,
  387. $ FFPGP,DFFPGP,
  388. $ IMPR,IRET)
  389. IF (IRET.NE.0) GOTO 9999
  390. SEGACT PGCOUR
  391. SEGACT FFPGV
  392. SEGACT DFFPGV
  393. SEGACT FFPGP
  394. SEGACT DFFPGP
  395. NP =DFFPGV.VELCHE(/2)
  396. NES=DFFPGV.VELCHE(/4)
  397. NPG=DFFPGV.VELCHE(/5)
  398. MP =DFFPGP.VELCHE(/2)
  399. N1=1
  400. N2=2
  401. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  402. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  403. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  404. KZHR(1)=IPKKZZ
  405. KZHR(2)=IPKKZ2
  406. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  407. KTP(1)=IZF1
  408. NOMEL=TYPELT(IP)
  409. CALL BB302(XREF,PGCOUR.XCOPG,PGCOUR.XPOPG,
  410. $ FFPGV.VELCHE,DFFPGV.VELCHE,
  411. $ FFPGP.VELCHE,DFFPGP.VELCHE,
  412. $ X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
  413. SEGSUP FFPGV
  414. SEGSUP DFFPGV
  415. SEGSUP FFPGP
  416. SEGSUP DFFPGP
  417. SEGDES PGCOUR
  418. C NP=4
  419. C MP=3
  420. C NES=2
  421. C NPG=7
  422. C IF(ITYPI.EQ.0)NPG=1
  423. C MPG=NPG
  424. C N1=1
  425. C N2=2
  426. C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  427. C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  428. C CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  429. C KZHR(1)=IPKKZZ
  430. C KZHR(2)=IPKKZ2
  431. C NOMEL=TYPELT(IP)
  432. C CALL ZDFM(MP,MPG,NES,IES,0,1,IZF1,1)
  433. C KTP(1)=IZF1
  434. C CALL BB302(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,MPG)
  435. GO TO 1
  436.  
  437. C TET5
  438. 9503 CONTINUE
  439. NP=5
  440. MP=4
  441. NES=3
  442. NPG=4
  443. IF(ITYPI.EQ.0)NG=1
  444. IF(ITYPI.EQ.0)NPG=1
  445. MPG=NPG
  446. N1=1
  447. N2=2
  448. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  449. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  450. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  451. KZHR(1)=IPKKZZ
  452. KZHR(2)=IPKKZ2
  453. NOMEL=TYPELT(IP)
  454. CALL ZDFM(MP,MPG,NES,IES,0,1,IZF1,1)
  455. KTP(1)=IZF1
  456. CALL BB403(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
  457. GO TO 1
  458.  
  459. C************************** ELEMENTS MACRO *****************************
  460.  
  461. C TRI6 Iso-P2 P1/P0
  462. 612 CONTINUE
  463.  
  464. NP=6
  465. MP=3
  466. IF(NOM2.EQ.'MCP0')MP=1
  467. IF(NOM2.EQ.'MCP1')MP=3
  468. IF(NOM2.EQ.'MCF1')MP=3
  469. IF(ITYPI.EQ.0)MP=1
  470. NES=2
  471. NPG=7
  472. C NPG=3
  473. N1=1
  474. N2=2
  475. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  476. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  477. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  478. KZHR(1)=IPKKZZ
  479. KZHR(2)=IPKKZ2
  480. NOMEL=TYPELT(IP)
  481. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  482. KTP(1)=IZF1
  483. CALL PB342
  484. &(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
  485. GO TO 1
  486.  
  487. C QUA9 Iso-P2 P1/P0
  488. 912 CONTINUE
  489.  
  490. MP=3
  491. IF(NOM2.EQ.'MCP0')MP=1
  492. IF(NOM2.EQ.'MCP1')MP=3
  493. IF(NOM2.EQ.'MCF1')MP=4
  494. IF(ITYPI.EQ.0)MP=1
  495. NP=9
  496. NES=2
  497. NG=2
  498. NPG=16
  499. N1=1
  500. N2=2
  501. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  502. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  503. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  504. KZHR(1)=IPKKZZ
  505. KZHR(2)=IPKKZ2
  506. NOMEL=TYPELT(IP)
  507. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  508. KTP(1)=IZF1
  509. CALL PB442
  510. &(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
  511. GO TO 1
  512.  
  513. C CU27 Iso-P2 P1/P0
  514. 2713 CONTINUE
  515.  
  516. MP=4
  517. IF(NOM2.EQ.'MCP0')MP=1
  518. IF(NOM2.EQ.'MCP1')MP=4
  519. IF(NOM2.EQ.'MCF1')MP=8
  520. IF(ITYPI.EQ.0)MP=1
  521. NP=27
  522. NES=3
  523. NG=2
  524. NPG=64
  525. C NG=1
  526. C NPG=8
  527. N1=1
  528. N2=2
  529. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  530. CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0)
  531. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  532. KZHR(1)=IPKKZZ
  533. KZHR(2)=IPKKZ2
  534. NOMEL=TYPELT(IP)
  535. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  536. KTP(1)=IZF1
  537. CALL PB883
  538. &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
  539. GO TO 1
  540.  
  541. C PR18 Iso-P2 P1/P0
  542. 1813 CONTINUE
  543.  
  544. MP=4
  545. IF(NOM2.EQ.'MCP0')MP=1
  546. IF(NOM2.EQ.'MCP1')MP=4
  547. IF(NOM2.EQ.'MCF1')MP=6
  548. IF(ITYPI.EQ.0)MP=1
  549. NP=18
  550. NES=3
  551. NG=6
  552. NPG=48
  553. C NG=1
  554. C NPG=8
  555. N1=1
  556. N2=2
  557. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  558. CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0)
  559. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  560. KZHR(1)=IPKKZZ
  561. KZHR(2)=IPKKZ2
  562. NOMEL=TYPELT(IP)
  563. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  564. KTP(1)=IZF1
  565. CALL PB663
  566. &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
  567. GO TO 1
  568.  
  569. C TE10 Iso-P2 P1/P0
  570. 1013 CONTINUE
  571.  
  572. MP=4
  573. IF(NOM2.EQ.'MCP0')MP=1
  574. IF(NOM2.EQ.'MCP1')MP=4
  575. IF(NOM2.EQ.'MCF1')MP=4
  576. IF(ITYPI.EQ.0)MP=1
  577. NP=10
  578. NES=3
  579. C NG=4
  580. C NPG=32
  581. NG=1
  582. NPG=8
  583. N1=1
  584. N2=2
  585. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  586. CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0)
  587. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  588. KZHR(1)=IPKKZZ
  589. KZHR(2)=IPKKZ2
  590. NOMEL=TYPELT(IP)
  591. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  592. KTP(1)=IZF1
  593. CALL PB443
  594. &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
  595. GO TO 1
  596.  
  597. C PY14 Iso-P2 P1/P0
  598. 1413 CONTINUE
  599. GO TO 1
  600.  
  601. C************************** ELEMENTS QUAF ******************************
  602.  
  603. C SEG3
  604. 301 CONTINUE
  605.  
  606. MP=2
  607. IF(NOM2.EQ.'PRP0')MP=1
  608. IF(NOM2.EQ.'PRP1')MP=2
  609. IF(NOM2.EQ.'PFP1')MP=2
  610. IF(NOM2.EQ.'P1P1')MP=2
  611. NP=3
  612. NES=1
  613. NG=3
  614. NPG=3
  615. IF(ITYPI.EQ.0)THEN
  616. NG=2
  617. NPG=2
  618. ENDIF
  619. IF(NOM2.EQ.'MCF1')THEN
  620. NG=4
  621. NPG=4
  622. ENDIF
  623. N1=1
  624. N2=2
  625. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  626. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  627. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  628. KZHR(1)=IPKKZZ
  629. KZHR(2)=IPKKZ2
  630. NOMEL=TYPELT(IP)
  631. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  632. KTP(1)=IZF1
  633. CALL PB301
  634. &(XREF,X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
  635. GO TO 1
  636.  
  637. C TRI7
  638. 702 CONTINUE
  639.  
  640. MP=3
  641. IF(NOM2.EQ.'PRP0')MP=1
  642. IF(NOM2.EQ.'PRP1')MP=3
  643. IF(NOM2.EQ.'PFP1')MP=3
  644. NP=7
  645. NES=2
  646. NPG=7
  647. IF(ITYPI.EQ.0)NPG=1
  648. N1=1
  649. N2=2
  650. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  651. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  652. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  653. KZHR(1)=IPKKZZ
  654. KZHR(2)=IPKKZ2
  655. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  656. KTP(1)=IZF1
  657. NOMEL=TYPELT(IP)
  658. CALL PB702
  659. &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2,ITYPI)
  660. GO TO 1
  661.  
  662. C QUA9
  663. 902 CONTINUE
  664.  
  665. IF(NOM2(1:2).EQ.'MC')GO TO 912
  666. MP=3
  667. IF(NOM2.EQ.'PRP0')MP=1
  668. IF(NOM2.EQ.'PRP1')MP=3
  669. IF(NOM2.EQ.'PFP1')MP=4
  670. IF(NOM2.EQ.'PRQ1')MP=4
  671. NP=9
  672. NES=2
  673. NG=4
  674. NPG=16
  675. IF(ITYPI.EQ.0)NG=3
  676. IF(ITYPI.EQ.0)NPG=9
  677. IF(ITYPI.EQ.2)NG=3
  678. IF(ITYPI.EQ.2)NPG=9
  679. N1=1
  680. N2=2
  681. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  682. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  683. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  684. KZHR(1)=IPKKZZ
  685. KZHR(2)=IPKKZ2
  686. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  687. KTP(1)=IZF1
  688. NOMEL=TYPELT(IP)
  689. CALL PB902
  690. &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
  691. GO TO 1
  692.  
  693. C PR21
  694. 2103 CONTINUE
  695.  
  696. MP=4
  697. IF(NOM2.EQ.'PRP0')MP=1
  698. IF(NOM2.EQ.'PRP1')MP=4
  699. IF(NOM2.EQ.'PFP1')MP=6
  700. NP=21
  701. NES=3
  702. NG=3
  703. NGT=7
  704. NPG=NG*NGT
  705. N1=1
  706. N2=2
  707. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  708. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  709. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  710. KZHR(1)=IPKKZZ
  711. KZHR(2)=IPKKZ2
  712. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  713. KTP(1)=IZF1
  714. NOMEL=TYPELT(IP)
  715. CALL PB2103
  716. &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NGT,NPG,NOM2)
  717. GO TO 1
  718.  
  719. C CU27
  720. 2703 CONTINUE
  721.  
  722. IF(NOM2(1:2).EQ.'MC')GO TO 2713
  723. MP=4
  724. IF(NOM2.EQ.'PRP0')MP=1
  725. IF(NOM2.EQ.'PRP1')MP=4
  726. IF(NOM2.EQ.'PFP1')MP=8
  727. NP=27
  728. NES=3
  729. NG=3
  730. NPG=27
  731. IF(ITYPI.EQ.0)NG=2
  732. IF(ITYPI.EQ.0)NPG=8
  733. N1=1
  734. N2=2
  735. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  736. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  737. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  738. KZHR(1)=IPKKZZ
  739. KZHR(2)=IPKKZ2
  740. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  741. KTP(1)=IZF1
  742. NOMEL=TYPELT(IP)
  743. CALL PB2703
  744. &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
  745. GO TO 1
  746.  
  747. C TE15
  748. 1503 CONTINUE
  749. IMPR=0
  750. CALL FILRF('H1D2TE15',MYLRFS,ELVIT,IMPR,IRET)
  751. IF (IRET.NE.0) GOTO 9999
  752. IF (NOM2.EQ.'PRP0') THEN
  753. CALL FILRF('L2D0TE1',MYLRFS,ELPRES,IMPR,IRET)
  754. IF (IRET.NE.0) GOTO 9999
  755. ELSEIF (NOM2.EQ.'PRP1') THEN
  756. CALL FILRF('L2D1TE4',MYLRFS,ELPRES,IMPR,IRET)
  757. IF (IRET.NE.0) GOTO 9999
  758. ELSEIF (NOM2.EQ.'PFP1') THEN
  759. CALL FILRF('H1D1TE4',MYLRFS,ELPRES,IMPR,IRET)
  760. IF (IRET.NE.0) GOTO 9999
  761. ELSE
  762. CALL FILRF('L2D1TE4',MYLRFS,ELPRES,IMPR,IRET)
  763. IF (IRET.NE.0) GOTO 9999
  764. ENDIF
  765. CALL FIPG('GPT3-7-64',MYPGS,PGCOUR,IMPR,IRET)
  766. IF (IRET.NE.0) GOTO 9999
  767. *
  768. * Calculons les fns de forme de réf. et leurs dérivées aux
  769. * points de Gauss pour chaque type d'éléments...
  770. *
  771. CALL KFNREF(ELVIT,PGCOUR,
  772. $ FFPGV,DFFPGV,
  773. $ IMPR,IRET)
  774. IF (IRET.NE.0) GOTO 9999
  775. CALL KFNREF(ELPRES,PGCOUR,
  776. $ FFPGP,DFFPGP,
  777. $ IMPR,IRET)
  778. IF (IRET.NE.0) GOTO 9999
  779. SEGACT PGCOUR
  780. SEGACT FFPGV
  781. SEGACT DFFPGV
  782. SEGACT FFPGP
  783. SEGACT DFFPGP
  784. NP =DFFPGV.VELCHE(/2)
  785. NES=DFFPGV.VELCHE(/4)
  786. NPG=DFFPGV.VELCHE(/5)
  787. MP =DFFPGP.VELCHE(/2)
  788. N1=1
  789. N2=2
  790. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  791. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  792. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  793. KZHR(1)=IPKKZZ
  794. KZHR(2)=IPKKZ2
  795. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  796. KTP(1)=IZF1
  797. NOMEL=TYPELT(IP)
  798. CALL PB1503(XREF,PGCOUR.XCOPG,PGCOUR.XPOPG,
  799. $ FFPGV.VELCHE,DFFPGV.VELCHE,
  800. $ FFPGP.VELCHE,DFFPGP.VELCHE,
  801. $ X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
  802. SEGSUP FFPGV
  803. SEGSUP DFFPGV
  804. SEGSUP FFPGP
  805. SEGSUP DFFPGP
  806. SEGDES PGCOUR
  807. GO TO 1
  808.  
  809. C PY19
  810. 1903 CONTINUE
  811. GO TO 1
  812.  
  813. C************************** ELEMENTS QUAD ******************************
  814.  
  815. C TRI6
  816. 602 CONTINUE
  817.  
  818. C MP=3
  819. C NP=6
  820. C NES=2
  821. C NPG=7
  822. C IF(ITYPI.EQ.0)NPG=1
  823. C N1=1
  824. C N2=2
  825. C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  826. C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  827. C KZHR(1)=IPKKZZ
  828. C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  829. C KTP(1)=IZF1
  830. C NOMEL=TYPELT(IP)
  831. C CALL PB602(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
  832. GO TO 1
  833.  
  834. C QUA8
  835. 802 CONTINUE
  836.  
  837. C MP=4
  838. C NP=8
  839. C NES=2
  840. C NG=3
  841. C NPG=9
  842. C IF(ITYPI.EQ.0)NG=2
  843. C IF(ITYPI.EQ.0)NPG=4
  844. C N1=1
  845. C N2=2
  846. C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  847. C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  848. C KZHR(1)=IPKKZZ
  849. C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  850. C KTP(1)=IZF1
  851. C NOMEL=TYPELT(IP)
  852. C CALL PB802(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG)
  853. GO TO 1
  854.  
  855. C PR15
  856. 11503 CONTINUE
  857.  
  858. C MP=6
  859. C NP=15
  860. C NES=3
  861. C NG=3
  862. C NGT=7
  863. C NPG=NG*NGT
  864. C N1=1
  865. C N2=2
  866. C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  867. C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  868. C KZHR(1)=IPKKZZ
  869. C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  870. C KTP(1)=IZF1
  871. C NOMEL=TYPELT(IP)
  872. C CALL PBPR15(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NGT,NPG)
  873. GO TO 1
  874.  
  875. C CU20
  876. 2003 CONTINUE
  877.  
  878. C MP=8
  879. C NP=20
  880. C NES=3
  881. C NG=3
  882. C NPG=27
  883. C IF(ITYPI.EQ.0)NG=2
  884. C IF(ITYPI.EQ.0)NPG=8
  885. C N1=1
  886. C N2=2
  887. C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  888. C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  889. C KZHR(1)=IPKKZZ
  890. C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  891. C KTP(1)=IZF1
  892. C NOMEL=TYPELT(IP)
  893. C CALL PB2003(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG)
  894. GO TO 1
  895.  
  896. C TE10
  897. 1003 CONTINUE
  898. GO TO 1
  899.  
  900. C************************** ELEMENTS CUBIC *****************************
  901.  
  902. C SEG4
  903. 401 CONTINUE
  904.  
  905. MP=3
  906. IF(NOM2.EQ.'PRP0')MP=1
  907. IF(NOM2.EQ.'PRP2')MP=3
  908. NP=4
  909. NES=1
  910. NG=4
  911. NPG=4
  912. IF(ITYPI.EQ.0)NG=3
  913. IF(ITYPI.EQ.0)NPG=3
  914. MPG=NPG
  915. N1=1
  916. N2=2
  917. CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
  918. CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
  919. CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
  920. KZHR(1)=IPKKZZ
  921. KZHR(2)=IPKKZ2
  922. NOMEL=TYPELT(IP)
  923. CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
  924. KTP(1)=IZF1
  925. CALL PB401(X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,MPG)
  926. GO TO 1
  927.  
  928.  
  929. 1 CONTINUE
  930. SEGACT MYLRFS*MOD
  931. SEGSUP MYLRFS.LISEL(*)
  932. SEGSUP MYLRFS
  933. SEGACT MYPGS*MOD
  934. SEGSUP MYPGS.LISPG(*)
  935. SEGSUP MYPGS
  936. C write(6,*)' Retour KALPBG'
  937. RETURN
  938. *
  939. * Error handling
  940. *
  941. 9999 CONTINUE
  942. WRITE(IOIMP,*) 'An error was detected in kalpbg.eso'
  943. * 153 2
  944. * Opération illicite dans ce contexte
  945. CALL ERREUR(153)
  946. RETURN
  947. END
  948.  
  949.  
  950.  
  951.  
  952.  
  953.  
  954.  

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