Télécharger la plaquette Cast3M


fr en

Télécharger kalpbg.eso

Retour à la liste

Numérotation des lignes : 

kalpbg

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

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