Numérotation des lignes :

kalpbg
C KALPBG    SOURCE    CB215821  20/11/25    13:30:46     10792                SUBROUTINE KALPBG(NOME,DISCR,IZFFM)       IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z) C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>CC      CE SOUS PROGRAMME CREE DES OBJETS DE TYPE FONFORM OU FONFORM0C      SUIVANT QUE ITYPI = 1 OU 0  ET CONTENANT LES FONCTIONS DE FORMEC      DU TYPE D'ELEMENT CONSIDERECC     ARGUMENTS D'ENTREE  NOMI   CHARACTER*8 TYPE ELEMENT DS TYPELTC                                            (COMMON CCHAMTR)C                         ITYPI  ENTIER    1 INTEGRATION NORMALEC                                          0 SOUS INTEGRATIONC                         NOM2=  PRP1  -> vitesses quadratiques pression P1C                         NOM2=  PRP0  -> vitesses quadratiques pression P0C                         NOM2=  PFP1  -> vitesses quadratiques pression P1 CC                         NOM2=  MCP1  -> vitesses Iso-P2 pression P1C                         NOM2=  MCP0  -> vitesses Iso-P2 pression P0C                         NOM2=  MCF1  -> vitesses Iso-P2 pression P1/Q1 CCC                         IZFFM              POINTEUR DE L'OBJET CR{{CC     IES=IDIM EST LA DIMENSION DE L ESPACE DE CALCULC     NES      EST LA DIMENSION DE L ESPACE DE L ELEMENT DE REFERENCC     NP  NB DE PTS DE L ELEMENTC     MP  NB DE PTS PRESSIONC     NPG NB DE PTS D'INTEGRATION POUR LA VITESSEC     MPG NB DE PTS D'INTEGRATION POUR LA PRESSIONCC     FN(NP,NPG)         )    ELEMENT DE REFC     GR(NES,NP,NPG)     )C     FM(MP,NPG)         )C     GM(NES,MP,NPG)     )CC     HR(IES,NP,NPG)     )    GRADIENT DANS LE REPERE GLOBAL DEFINI ICIC                             MAIS CHARGE DANS LES CALJ..C                             IES=NES SI L ELEMENT EST DROITC                             IES=IES SI L ELEMENT EST GAUCHEC     PG(NPG)CC     -----------------------------------------------------------------C***CC Modification du 12/01/99 : les elements dont les fonctions de formesC                            n'existent pas sont en commentairesC Cela correspond aux subroutines suivantes : PB602, PB802, PRPB15,C      PB2003C**** 15/06/00 : ajout tétraèdre quadratique par gounand**      REAL*8 X(64),Y(64),Z(64)      PARAMETER (NBELT=21)      CHARACTER*(*) NOME,DISCR      CHARACTER*8 TYPELT(NBELT),NOM1      CHARACTER*4 NOM2 -INC PPARAM-INC CCOPTIO-INC SIZFFB       POINTEUR IZF1.IZFFM,IZF2.IZFFMCBEGININCLUDE SELREF      SEGMENT ELREF      CHARACTER*(LNNOM)  NOMLRF      CHARACTER*(LNFORM) FORME      CHARACTER*(LNTYPL) TYPEL      CHARACTER*(LNESP)  ESPACE      INTEGER DEGRE      REAL*8 XCONOD(NDIMEL,NBNOD)      INTEGER NPQUAF(NBDDL)      INTEGER NUMCMP(NBDDL)      INTEGER QUENOD(NBDDL)      INTEGER ORDDER(NDIMEL,NBDDL)      POINTEUR MBPOLY.POLYNS      ENDSEGMENT      SEGMENT ELREFS      POINTEUR LISEL(0).ELREF      ENDSEGMENTCENDINCLUDE SELREF      POINTEUR MYLRFS.ELREFS      POINTEUR ELVIT.ELREF      POINTEUR ELPRES.ELREFCBEGININCLUDE SFALRF      SEGMENT FALRF      CHARACTER*(LNNFA) NOMFA      INTEGER NUQUAF(NBLRF)      POINTEUR ELEMF(NBLRF).ELREF      ENDSEGMENT      SEGMENT FALRFS      POINTEUR LISFA(0).FALRF      ENDSEGMENTCENDINCLUDE SFALRF      POINTEUR MYFALS.FALRFSCBEGININCLUDE SPOGAU      SEGMENT POGAU      CHARACTER*(LNNPG)  NOMPG      CHARACTER*(LNTPG)  TYPMPG      CHARACTER*(LNFPG)  FORLPG      INTEGER NORDPG      REAL*8 XCOPG(NDLPG,NBPG)      REAL*8 XPOPG(NBPG)      ENDSEGMENT      SEGMENT POGAUS      POINTEUR LISPG(0).POGAU      ENDSEGMENTCENDINCLUDE SPOGAU      POINTEUR MYPGS.POGAUS      POINTEUR PGCOUR.POGAUCBEGININCLUDE SMCHAEL      SEGMENT MCHAEL      POINTEUR IMACHE(N1).MELEME      POINTEUR ICHEVA(N1).MCHEVA      ENDSEGMENT      SEGMENT MCHEVA      REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)      ENDSEGMENT      SEGMENT LCHEVA      POINTEUR LISCHE(NBCHE).MCHEVA      ENDSEGMENTCENDINCLUDE SMCHAEL      POINTEUR FFPGV.MCHEVA      POINTEUR DFFPGV.MCHEVA      POINTEUR FFPGP.MCHEVA      POINTEUR DFFPGP.MCHEVAC      DATA TYPELT/'SEG2    ','TRI3    ','QUA4    ',     & 'PRI6    ','CUB8    ','TET4    ','PYR5    ',C speciaux iso-P2 p1/p0     & 'TRI6    ','PR18    ','TE10    ','PY14xxxx',C quadratiques     & 'SEG3    ','TRI7    ','QUA9    ',     & 'PR21    ','CU27    ','TE15    ','PY19xxxx',C lineaires b     & 'TRI4    ','TET5    ',C cubiques     & 'SEG4    '/C***** Initialisation du segment contenant les informations sur les* éléments de référence.**      SEGINI MYLRFS.LISEL(*)      IMPR=0      CALL INLRFS(MYLRFS,IMPR,IRET)      IF (IRET.NE.0) GOTO 9999** Initialisation du segment contenant les informations sur les* méthodes d'intégration (type Gauss).**      SEGINI MYPGS.LISPG(*)      CALL INPGS(MYPGS,IMPR,IRET)      IF (IRET.NE.0) GOTO 9999*      IZFFM=0      IF(DISCR.EQ.'FONFORM0')THEN      ITYPI=0      ELSEIF(DISCR.EQ.'FONFORM ')THEN      ITYPI=1      ELSEIF(DISCR.EQ.'LOBATTO ')THEN      ITYPI=2      ELSEC Impossible d'utiliser cet opérateur pour la formulation %m1:8      MOTERR(1:8) = DISCR      CALL ERREUR(193)      RETURN      ENDIFC      IES=IDIM      NOM1=NOME(1:4)      NOM2=NOME(5:8)C     WRITE(6,*)'KALPBG NOM1=',NOM1,' NOM2=',NOM2,':'      CALL OPTLI(IP,TYPELT,NOM1,NBELT)C      IF(IP.EQ.0)THEN      WRITE(6,1981)NOME 1981 FORMAT(/10X,' SUB KALPBG : ',1X,A8,' TYPE D''ELEMENT NON ENCORE PR     &EVU')      RETURN      ENDIFC      GO TO (     &   201 ,302 ,402 ,603 ,803 ,403 ,503 ,     &        612 ,     1813,     1013,1413,     &   301 ,702 ,902 ,2103,2703,1503,1903,     &   9402,9503,     &   401),IPCCC100  CONTINUEC?    NP=1C?    NES=0C?    NG=1C?    NPG=1C?    N1=0C?    N2=2C?    CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)C?    CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)C?    KZHR(1)=IPKKZZC?    NOMEL=TYPELT(IP)C?    FN(1,1)=1.D0C?    GO TO 1C************************** ELEMENTS LINE ****************************** C SEG2 201  CONTINUE      NP=2      MP=1      IF(NOM2.EQ.'P1P1')MP=2      NES=1      NG=2      NPG=2      IF(ITYPI.EQ.0)NG=1      IF(ITYPI.EQ.0)NPG=1      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      NOMEL=TYPELT(IP)      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      CALL PB201     &(XREF,X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)      GO TO 1 C TRI3 302  CONTINUE      NP=3      MP=1      IF(NOM2.EQ.'P1P1')MP=3      NES=2      NPG=7      IF(ITYPI.EQ.0)NPG=1      IF(ITYPI.EQ.2)NPG=3      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      NOMEL=TYPELT(IP)      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      CALL PB302     &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2,ITYPI)      GO TO 1 C QUA4 402  CONTINUE      NP=4      MP=1      IF(NOM2.EQ.'P1P1')MP=4      NES=2      NG=2      NPG=4      IF(ITYPI.EQ.0)NG=1      IF(ITYPI.EQ.0)NPG=1      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      NOMEL=TYPELT(IP)      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      CALL PB402     &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)      GO TO 1 C PRI6 603  CONTINUE      NP=6      MP=1      IF(NOM2.EQ.'P1P1')MP=6      NES=3      NPG=6      IF(ITYPI.EQ.0)NPG=1      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      NOMEL=TYPELT(IP)      CALL PB603     &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)      GOTO 1 C CUB8 803  CONTINUE      NP=8      MP=1      IF(NOM2.EQ.'P1P1')MP=8      NES=3      NG=2      NPG=8      IF(ITYPI.EQ.0)NG=1      IF(ITYPI.EQ.0)NPG=1      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      NOMEL=TYPELT(IP)      CALL PB803     &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)      GO TO 1 C TET4 403  CONTINUE      NP=4      MP=1      IF(NOM2.EQ.'P1P1')MP=4      NES=3      NPG=4      IF(ITYPI.EQ.0)NPG=1      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      NOMEL=TYPELT(IP)      CALL PB403     &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)      GO TO 1 C PYR5 503  CONTINUE      NP=5      MP=1      IF(NOM2.EQ.'P1P1')MP=5      NES=3      NPG=5      IF(ITYPI.EQ.0)NPG=1      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      NOMEL=TYPELT(IP)      CALL PB503     &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)      GO TO 1 C************************** ELEMENTS LINB ****************************** C TRI4 9402 CONTINUE      IMPR=0      CALL FILRF('H1D1TR4',MYLRFS,ELVIT,IMPR,IRET)      IF (IRET.NE.0) GOTO 9999      CALL FILRF('H1D1TR3',MYLRFS,ELPRES,IMPR,IRET)      IF (ITYPI.EQ.0) THEN         CALL FIPG('GAT2-1-1',MYPGS,PGCOUR,IMPR,IRET)         IF (IRET.NE.0) GOTO 9999      ELSE         CALL FIPG('GAT2-7-12',MYPGS,PGCOUR,IMPR,IRET)         IF (IRET.NE.0) GOTO 9999      ENDIF** Calculons les fns de forme de réf. et leurs dérivées aux* points de Gauss pour chaque type d'éléments...*      CALL KFNREF(ELVIT,PGCOUR,     $FFPGV,DFFPGV,$     IMPR,IRET)      IF (IRET.NE.0) GOTO 9999      CALL KFNREF(ELPRES,PGCOUR,     $FFPGP,DFFPGP,$     IMPR,IRET)      IF (IRET.NE.0) GOTO 9999      SEGACT PGCOUR      SEGACT FFPGV      SEGACT DFFPGV      SEGACT FFPGP      SEGACT DFFPGP      NP =DFFPGV.VELCHE(/2)      NES=DFFPGV.VELCHE(/4)      NPG=DFFPGV.VELCHE(/5)      MP =DFFPGP.VELCHE(/2)      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      NOMEL=TYPELT(IP)      CALL BB302(XREF,PGCOUR.XCOPG,PGCOUR.XPOPG,     $FFPGV.VELCHE,DFFPGV.VELCHE,$     FFPGP.VELCHE,DFFPGP.VELCHE,     $X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG) SEGSUP FFPGV SEGSUP DFFPGV SEGSUP FFPGP SEGSUP DFFPGP SEGDES PGCOURC NP=4C MP=3C NES=2C NPG=7C IF(ITYPI.EQ.0)NPG=1C MPG=NPGC N1=1C N2=2C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)C CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)C KZHR(1)=IPKKZZC KZHR(2)=IPKKZ2C NOMEL=TYPELT(IP)C CALL ZDFM(MP,MPG,NES,IES,0,1,IZF1,1)C KTP(1)=IZF1C CALL BB302(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,MPG) GO TO 1 C TET5 9503 CONTINUE NP=5 MP=4 NES=3 NPG=4 IF(ITYPI.EQ.0)NG=1 IF(ITYPI.EQ.0)NPG=1 MPG=NPG N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 NOMEL=TYPELT(IP) CALL ZDFM(MP,MPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 CALL BB403(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG) GO TO 1 C************************** ELEMENTS MACRO ***************************** C TRI6 Iso-P2 P1/P0 612 CONTINUE NP=6 MP=3 IF(NOM2.EQ.'MCP0')MP=1 IF(NOM2.EQ.'MCP1')MP=3 IF(NOM2.EQ.'MCF1')MP=3 IF(ITYPI.EQ.0)MP=1 NES=2 NPG=7C NPG=3 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 NOMEL=TYPELT(IP) CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 CALL PB342 &(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2) GO TO 1 C QUA9 Iso-P2 P1/P0 912 CONTINUE MP=3 IF(NOM2.EQ.'MCP0')MP=1 IF(NOM2.EQ.'MCP1')MP=3 IF(NOM2.EQ.'MCF1')MP=4 IF(ITYPI.EQ.0)MP=1 NP=9 NES=2 NG=2 NPG=16 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 NOMEL=TYPELT(IP) CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 CALL PB442 &(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2) GO TO 1 C CU27 Iso-P2 P1/P0 2713 CONTINUE MP=4 IF(NOM2.EQ.'MCP0')MP=1 IF(NOM2.EQ.'MCP1')MP=4 IF(NOM2.EQ.'MCF1')MP=8 IF(ITYPI.EQ.0)MP=1 NP=27 NES=3 NG=2 NPG=64C NG=1C NPG=8 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 NOMEL=TYPELT(IP) CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 CALL PB883 &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2) GO TO 1 C PR18 Iso-P2 P1/P0 1813 CONTINUE MP=4 IF(NOM2.EQ.'MCP0')MP=1 IF(NOM2.EQ.'MCP1')MP=4 IF(NOM2.EQ.'MCF1')MP=6 IF(ITYPI.EQ.0)MP=1 NP=18 NES=3 NG=6 NPG=48C NG=1C NPG=8 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 NOMEL=TYPELT(IP) CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 CALL PB663 &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2) GO TO 1 C TE10 Iso-P2 P1/P0 1013 CONTINUE MP=4 IF(NOM2.EQ.'MCP0')MP=1 IF(NOM2.EQ.'MCP1')MP=4 IF(NOM2.EQ.'MCF1')MP=4 IF(ITYPI.EQ.0)MP=1 NP=10 NES=3C NG=4C NPG=32 NG=1 NPG=8 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 NOMEL=TYPELT(IP) CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 CALL PB443 &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2) GO TO 1 C PY14 Iso-P2 P1/P0 1413 CONTINUE GO TO 1 C************************** ELEMENTS QUAF ****************************** C SEG3 301 CONTINUE MP=2 IF(NOM2.EQ.'PRP0')MP=1 IF(NOM2.EQ.'PRP1')MP=2 IF(NOM2.EQ.'PFP1')MP=2 IF(NOM2.EQ.'P1P1')MP=2 NP=3 NES=1 NG=3 NPG=3 IF(ITYPI.EQ.0)THEN NG=2 NPG=2 ENDIF IF(NOM2.EQ.'MCF1')THEN NG=4 NPG=4 ENDIF N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 NOMEL=TYPELT(IP) CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 CALL PB301 &(XREF,X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI) GO TO 1 C TRI7 702 CONTINUE MP=3 IF(NOM2.EQ.'PRP0')MP=1 IF(NOM2.EQ.'PRP1')MP=3 IF(NOM2.EQ.'PFP1')MP=3 NP=7 NES=2 NPG=7 IF(ITYPI.EQ.0)NPG=1 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 NOMEL=TYPELT(IP) CALL PB702 &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2,ITYPI) GO TO 1 C QUA9 902 CONTINUE IF(NOM2(1:2).EQ.'MC')GO TO 912 MP=3 IF(NOM2.EQ.'PRP0')MP=1 IF(NOM2.EQ.'PRP1')MP=3 IF(NOM2.EQ.'PFP1')MP=4 IF(NOM2.EQ.'PRQ1')MP=4 NP=9 NES=2 NG=4 NPG=16 IF(ITYPI.EQ.0)NG=3 IF(ITYPI.EQ.0)NPG=9 IF(ITYPI.EQ.2)NG=3 IF(ITYPI.EQ.2)NPG=9 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 NOMEL=TYPELT(IP) CALL PB902 &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI) GO TO 1 C PR21 2103 CONTINUE MP=4 IF(NOM2.EQ.'PRP0')MP=1 IF(NOM2.EQ.'PRP1')MP=4 IF(NOM2.EQ.'PFP1')MP=6 NP=21 NES=3 NG=3 NGT=7 NPG=NG*NGT N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 NOMEL=TYPELT(IP) CALL PB2103 &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NGT,NPG,NOM2) GO TO 1 C CU27 2703 CONTINUE IF(NOM2(1:2).EQ.'MC')GO TO 2713 MP=4 IF(NOM2.EQ.'PRP0')MP=1 IF(NOM2.EQ.'PRP1')MP=4 IF(NOM2.EQ.'PFP1')MP=8 NP=27 NES=3 NG=3 NPG=27 IF(ITYPI.EQ.0)NG=2 IF(ITYPI.EQ.0)NPG=8 N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 NOMEL=TYPELT(IP) CALL PB2703 &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2) GO TO 1 C TE15 1503 CONTINUE IMPR=0 CALL FILRF('H1D2TE15',MYLRFS,ELVIT,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 IF (NOM2.EQ.'PRP0') THEN CALL FILRF('L2D0TE1',MYLRFS,ELPRES,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOM2.EQ.'PRP1') THEN CALL FILRF('L2D1TE4',MYLRFS,ELPRES,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (NOM2.EQ.'PFP1') THEN CALL FILRF('H1D1TE4',MYLRFS,ELPRES,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSE CALL FILRF('L2D1TE4',MYLRFS,ELPRES,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF CALL FIPG('GPT3-7-64',MYPGS,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999** Calculons les fns de forme de réf. et leurs dérivées aux* points de Gauss pour chaque type d'éléments...* CALL KFNREF(ELVIT,PGCOUR,$     FFPGV,DFFPGV,     $IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL KFNREF(ELPRES,PGCOUR,$     FFPGP,DFFPGP,     $IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGACT PGCOUR SEGACT FFPGV SEGACT DFFPGV SEGACT FFPGP SEGACT DFFPGP NP =DFFPGV.VELCHE(/2) NES=DFFPGV.VELCHE(/4) NPG=DFFPGV.VELCHE(/5) MP =DFFPGP.VELCHE(/2) N1=1 N2=2 CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1) CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0) CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0) KZHR(1)=IPKKZZ KZHR(2)=IPKKZ2 CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1) KTP(1)=IZF1 NOMEL=TYPELT(IP) CALL PB1503(XREF,PGCOUR.XCOPG,PGCOUR.XPOPG,$     FFPGV.VELCHE,DFFPGV.VELCHE,     $FFPGP.VELCHE,DFFPGP.VELCHE,$     X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)      SEGSUP FFPGV      SEGSUP DFFPGV      SEGSUP FFPGP      SEGSUP DFFPGP      SEGDES PGCOUR      GO TO 1 C PY19 1903 CONTINUE      GO TO 1 C************************** ELEMENTS QUAD ****************************** C TRI6 602  CONTINUE C      MP=3C      NP=6C      NES=2C      NPG=7C      IF(ITYPI.EQ.0)NPG=1C      N1=1C      N2=2C      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)C      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)C      KZHR(1)=IPKKZZC      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)C      KTP(1)=IZF1C      NOMEL=TYPELT(IP)C      CALL PB602(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)      GO TO 1 C QUA8 802  CONTINUE C      MP=4C      NP=8C      NES=2C      NG=3C      NPG=9C      IF(ITYPI.EQ.0)NG=2C      IF(ITYPI.EQ.0)NPG=4C      N1=1C      N2=2C      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)C      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)C      KZHR(1)=IPKKZZC      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)C      KTP(1)=IZF1C      NOMEL=TYPELT(IP)C      CALL PB802(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG)      GO TO 1 C PR1511503 CONTINUE C      MP=6C      NP=15C      NES=3C      NG=3C      NGT=7C      NPG=NG*NGTC      N1=1C      N2=2C      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)C      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)C      KZHR(1)=IPKKZZC      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)C      KTP(1)=IZF1C      NOMEL=TYPELT(IP)C      CALL PBPR15(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NGT,NPG)      GO TO 1 C CU20 2003 CONTINUE C      MP=8C      NP=20C      NES=3C      NG=3C      NPG=27C      IF(ITYPI.EQ.0)NG=2C      IF(ITYPI.EQ.0)NPG=8C      N1=1C      N2=2C      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)C      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)C      KZHR(1)=IPKKZZC      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)C      KTP(1)=IZF1C      NOMEL=TYPELT(IP)C      CALL PB2003(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG)      GO TO 1 C TE10 1003 CONTINUE      GO TO 1 C************************** ELEMENTS CUBIC ***************************** C SEG4 401  CONTINUE       MP=3      IF(NOM2.EQ.'PRP0')MP=1      IF(NOM2.EQ.'PRP2')MP=3      NP=4      NES=1      NG=4      NPG=4      IF(ITYPI.EQ.0)NG=3      IF(ITYPI.EQ.0)NPG=3      MPG=NPG      N1=1      N2=2      CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)      CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)      CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)      KZHR(1)=IPKKZZ      KZHR(2)=IPKKZ2      NOMEL=TYPELT(IP)      CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)      KTP(1)=IZF1      CALL PB401(X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,MPG)      GO TO 1   1    CONTINUE      SEGACT MYLRFS*MOD      SEGSUP MYLRFS.LISEL(*)      SEGSUP MYLRFS      SEGACT MYPGS*MOD      SEGSUP MYPGS.LISPG(*)      SEGSUP MYPGSC     write(6,*)' Retour KALPBG'      RETURN** Error handling* 9999 CONTINUE      WRITE(IOIMP,*) 'An error was detected in kalpbg.eso'*  153 2* Opération illicite dans ce contexte      CALL ERREUR(153)      RETURN      END        

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