C KTRS3     SOURCE    MAGN      10/05/18    21:16:10     6675           
      SUBROUTINE KTRS3(MACRO,MELEME,MTBT0,IRET,GA,EPS,EPSD,ALFA)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z) 
-INC CCOPTIO
-INC CCGEOME
-INC SMCOORD
-INC SMCHPOI
-INC SIZFFB
      POINTEUR IZFF1.IZFFM,IZHR1.IZHR
-INC SMELEME
      POINTEUR MACRO.MELEME,MFACEI.MELEME,MFICEL.MELEME,MELTFI.MELEME
      POINTEUR MCTREI.MELEME,MELSTB.MELEME
      DIMENSION XA(3,27)
      DIMENSION ITAB(5),GA(8),EPS(8),EPSD(8)
      PARAMETER (NBE=7)
      CHARACTER*8 LISTE(NBE),TYPE,LIST(NBE)
      DATA LISTE /'TRI6    ','QUA8    ','SEG3    ',
     &            'CU20    ','PR15    ','PY13    ','TE10    '/
      DATA LIST  /'TRI3    ','QUA4    ','SEG2    ',
     &            'CUB8    ','PRI6    ','PYR5    ','TET4    '/
C****

      COEF=ALFA*0.01D0
      IAXI=0
      IF(IFOMOD.EQ.0)IAXI=2

      IRET=1
      IM  =0

      NSOUPO=1
      NAT=1
      N=0
      NC=8
      KPOC=0
      SEGINI MCHPO1,MSOUP1,MPOVA1
      MCHPO1.JATTRI(1)=2
      MCHPO1.IFOPOI=IFOMOD
      MCHPO1.MTYPOI='CENTRE  '
      MCHPO1.MOCHDE='                                                  '
      MCHPO1.IPCHP(1)=MSOUP1
      MSOUP1.IPOVAL=MPOVA1
      MSOUP1.NOCOMP(1)='SCC1'
      MSOUP1.NOCOMP(2)='SCC2'
      MSOUP1.NOCOMP(3)='SCC3'
      MSOUP1.NOCOMP(4)='SCC4'
      MSOUP1.NOCOMP(5)='SCC5'
      MSOUP1.NOCOMP(6)='SCC6'
      MSOUP1.NOCOMP(7)='SCC7'
      MSOUP1.NOCOMP(8)='SCC8'

      NBELEM=0
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGINI MCTREI
      MCTREI.ITYPEL=1
      KCTREI=0

C Connectivités de la matrice de stabilisation
      NBELEM=0
      NBNN=4
      NBSOUS=0
      NBREF=0
      SEGINI MELSTB
      MELSTB.ITYPEL=14
      KSTB=0

      SEGACT MACRO
      NBSOUS=MACRO.LISOUS(/1)
      IF(NBSOUS.EQ.0)NBSOUS=1
      DO 1 L=1,NBSOUS
      IPT1=MACRO
      IF(NBSOUS.NE.1)IPT1=MACRO.LISOUS(L)
      SEGACT IPT1
      TYPE=NOMS(IPT1.ITYPEL)//'    '
      CALL OPTLI(IP,LISTE,TYPE,NBE)
      IF(IP.EQ.0)THEN
      WRITE(6,*)' Type d''élément : ',TYPE,' non prévu '
      IRET=0
      RETURN
      ENDIF
      GO TO (106,108,103,120,115,113,110),IP

C TRI6 -> 4 TRI3
 106  CONTINUE
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
      NBPC=NBEL*4
      KCTREI=1
C     write(6,*)' TRI6 -> 4 TRI3 nbel= ',nbel

      NBV0=XCOOR(/1)/(IDIM+1)
      NBPTS=NBV0+NBPC
      SEGADJ MCOORD

C maillage de lineaires
      NBELEM=4*NBEL
      NBNN=3
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=4
      IM=IM+1
      ITAB(IM)=IPT2

      K1=0
      DO 206 K=1,NBEL
      N1=IPT1.NUM(1,K)
      N2=IPT1.NUM(2,K)
      N3=IPT1.NUM(3,K)
      N4=IPT1.NUM(4,K)
      N5=IPT1.NUM(5,K)
      N6=IPT1.NUM(6,K)

      DO 1061 M=1,3
      XA(M,1)=XCOOR((N1-1)*(IDIM+1)    +M)
      XA(M,2)=XCOOR((N2-1)*(IDIM+1)    +M)
      XA(M,3)=XCOOR((N3-1)*(IDIM+1)    +M)
      XA(M,4)=XCOOR((N4-1)*(IDIM+1)    +M)
      XA(M,5)=XCOOR((N5-1)*(IDIM+1)    +M)
      XA(M,6)=XCOOR((N6-1)*(IDIM+1)    +M)
 1061 CONTINUE

CT1
      K1=K1+1
      NC1=NBV0+K1

      IPT2.NUM(1,K1)=N1
      IPT2.NUM(2,K1)=N2
      IPT2.NUM(3,K1)=N6

CT2
      K1=K1+1
      NC2=NBV0+K1

      IPT2.NUM(1,K1)=N3
      IPT2.NUM(2,K1)=N4
      IPT2.NUM(3,K1)=N2

CT3
      K1=K1+1
      NC3=NBV0+K1

      IPT2.NUM(1,K1)=N5
      IPT2.NUM(2,K1)=N6
      IPT2.NUM(3,K1)=N4

CT4
      K1=K1+1
      NC4=NBV0+K1

      IPT2.NUM(1,K1)=N2
      IPT2.NUM(2,K1)=N4
      IPT2.NUM(3,K1)=N6

      DO 1062 M=1,3
      XCOOR((NC4-1)*(IDIM+1)    +M)= (XA(M,2)+XA(M,4)+XA(M,6))/3.D0
      XCOOR((NC1-1)*(IDIM+1)    +M)= (XA(M,1)+XA(M,2)+XA(M,6))/3.D0
      XCOOR((NC2-1)*(IDIM+1)    +M)= (XA(M,3)+XA(M,4)+XA(M,2))/3.D0
      XCOOR((NC3-1)*(IDIM+1)    +M)= (XA(M,5)+XA(M,6)+XA(M,4))/3.D0
 1062 CONTINUE

 206  CONTINUE
      SEGDES IPT1,IPT2
      GO TO 1

C**************************************************************************

C QUA8 -> 4 QUA4
 108  CONTINUE

      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
      NBP9=NBEL
      NBPC=NBEL*4
      KCTREI=1
C     write(6,*)' QUA8 -> 4 QUA4 nbel=',nbel

      NBV0=XCOOR(/1)/(IDIM+1)
      NBPTS=NBV0+NBPC+NBP9
      SEGADJ MCOORD

C maillage de lineaires
      NBELEM=4*NBEL
      NBNN=4
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=8
      IM=IM+1
      ITAB(IM)=IPT2

      K1=0
      DO 208 K=1,NBEL
      N1=IPT1.NUM(1,K)
      N2=IPT1.NUM(2,K)
      N3=IPT1.NUM(3,K)
      N4=IPT1.NUM(4,K)
      N5=IPT1.NUM(5,K)
      N6=IPT1.NUM(6,K)
      N7=IPT1.NUM(7,K)
      N8=IPT1.NUM(8,K)
      N9=NBV0+NBPC+K
C     write(6,*)' N1,N2,N3,N4,N5,N6,N7,N8,N9=',
C    &N1,N2,N3,N4,N5,N6,N7,N8,N9

      DO 1081 M=1,3
      XA(M,1)=XCOOR((N1-1)*(IDIM+1)    +M)
      XA(M,2)=XCOOR((N2-1)*(IDIM+1)    +M)
      XA(M,3)=XCOOR((N3-1)*(IDIM+1)    +M)
      XA(M,4)=XCOOR((N4-1)*(IDIM+1)    +M)
      XA(M,5)=XCOOR((N5-1)*(IDIM+1)    +M)
      XA(M,6)=XCOOR((N6-1)*(IDIM+1)    +M)
      XA(M,7)=XCOOR((N7-1)*(IDIM+1)    +M)
      XA(M,8)=XCOOR((N8-1)*(IDIM+1)    +M)
 1081 CONTINUE

      CALL FFQUA8(XA)


CQ1
      K1=K1+1
      NC1=NBV0+K1

      IPT2.NUM(1,K1)=N1
      IPT2.NUM(2,K1)=N2
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N8
CQ2
      K1=K1+1
      NC2=NBV0+K1

      IPT2.NUM(1,K1)=N3
      IPT2.NUM(2,K1)=N4
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N2
CQ3
      K1=K1+1
      NC3=NBV0+K1

      IPT2.NUM(1,K1)=N5
      IPT2.NUM(2,K1)=N6
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N4
CQ4
      K1=K1+1
      NC4=NBV0+K1

      IPT2.NUM(1,K1)=N7
      IPT2.NUM(2,K1)=N8
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N6

      DO 1082 M=1,3
      XCOOR((N9-1)*(IDIM+1)    +M)=XA(M,9)
      XCOOR((NC1-1)*(IDIM+1)    +M)= (XA(M,1)+XA(M,2)+XA(M,9)+XA(M,8))/4.D0
      XCOOR((NC2-1)*(IDIM+1)    +M)= (XA(M,3)+XA(M,4)+XA(M,9)+XA(M,2))/4.D0
      XCOOR((NC3-1)*(IDIM+1)    +M)= (XA(M,5)+XA(M,6)+XA(M,9)+XA(M,4))/4.D0
      XCOOR((NC4-1)*(IDIM+1)    +M)= (XA(M,7)+XA(M,8)+XA(M,9)+XA(M,6))/4.D0

 1082 CONTINUE

 208  CONTINUE
      SEGDES IPT1,IPT2
      GO TO 1

C**************************************************************************

C SEG3 -> 2 SEG2
 103  CONTINUE
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)

      NBELEM=2*NBEL
      write(6,*)' SEG3 -> 2 SEG2 nbel=',nbel
      NBNN=2
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=2
      IM=IM+1
      ITAB(IM)=IPT2

      K1=0
      DO 203 K=1,NBEL
      N1=IPT1.NUM(1,K)
      N2=IPT1.NUM(2,K)
      N3=IPT1.NUM(3,K)

CS1
      K1=K1+1

      IPT2.NUM(1,K1)=N1
      IPT2.NUM(2,K1)=N2

CS2
      K1=K1+1

      IPT2.NUM(1,K1)=N2
      IPT2.NUM(2,K1)=N3
 203  CONTINUE
      SEGDES IPT1,IPT2
      GO TO 1
C**************************************************************************
C CU20 -> 8 CUB8
 120  CONTINUE
C     write(6,*)' CU20 -> 8 CUB8 '
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
      NBPC=NBEL*8
      NBP9=NBEL*7

      N=NBPC+MPOVA1.VPOCHA(/1)
      NC=8
      NCTV0=MPOVA1.VPOCHA(/1)
      SEGADJ MPOVA1

      NBV0=XCOOR(/1)/(IDIM+1)
      NBPTS=NBV0+NBPC+NBP9
      SEGADJ MCOORD

C maillage de lineaires
      NBELEM=8*NBEL
      NBNN=8
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=14
      IM=IM+1
      ITAB(IM)=IPT2

C Spg des pts centres des macro elements
      NCTR0=MCTREI.NUM(/2)
      NBELEM=NCTR0+NBPC
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGADJ MCTREI
      KCTREI=1

C Connectivités de la matrice de stabilisation
      NCSTB=MELSTB.NUM(/2)
      NBELEM=NCSTB+NBPC
      NBNN=8
C     write(6,*)' KTRS3 : ',nbnn,nbelem
      NBSOUS=0
      NBREF=0
      SEGADJ MELSTB
      KSTB=1

      CALL KALPBG('QUA4    ','FONFORM0',IZFFM)
      IF(IZFFM.EQ.0)CALL ARRET(0)
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      NPG=GR(/3)
      NES=GR(/1)
      NPI=4

      K1=0
      DO 220 K=1,NBEL
      N1=IPT1.NUM(1,K)
      N2=IPT1.NUM(2,K)
      N3=IPT1.NUM(3,K)
      N4=IPT1.NUM(4,K)
      N5=IPT1.NUM(5,K)
      N6=IPT1.NUM(6,K)
      N7=IPT1.NUM(7,K)
      N8=IPT1.NUM(8,K)
      N9=IPT1.NUM(9,K)
      N10=IPT1.NUM(10,K)
      N11=IPT1.NUM(11,K)
      N12=IPT1.NUM(12,K)
      N13=IPT1.NUM(13,K)
      N14=IPT1.NUM(14,K)
      N15=IPT1.NUM(15,K)
      N16=IPT1.NUM(16,K)
      N17=IPT1.NUM(17,K)
      N18=IPT1.NUM(18,K)
      N19=IPT1.NUM(19,K)
      N20=IPT1.NUM(20,K)
      N21=NBV0+NBPC+(K-1)*7+1
      N22=NBV0+NBPC+(K-1)*7+2
      N23=NBV0+NBPC+(K-1)*7+3
      N24=NBV0+NBPC+(K-1)*7+4
      N25=NBV0+NBPC+(K-1)*7+5
      N26=NBV0+NBPC+(K-1)*7+6
      N27=NBV0+NBPC+(K-1)*7+7
      NC1=NBV0+(K-1)*8+1
      NC2=NBV0+(K-1)*8+2
      NC3=NBV0+(K-1)*8+3
      NC4=NBV0+(K-1)*8+4
      NC5=NBV0+(K-1)*8+5
      NC6=NBV0+(K-1)*8+6
      NC7=NBV0+(K-1)*8+7
      NC8=NBV0+(K-1)*8+8

      DO 2201 M=1,3
      XA(M,1)=XCOOR((N1-1)*(IDIM+1)    +M)
      XA(M,2)=XCOOR((N2-1)*(IDIM+1)    +M)
      XA(M,3)=XCOOR((N3-1)*(IDIM+1)    +M)
      XA(M,4)=XCOOR((N4-1)*(IDIM+1)    +M)
      XA(M,5)=XCOOR((N5-1)*(IDIM+1)    +M)
      XA(M,6)=XCOOR((N6-1)*(IDIM+1)    +M)
      XA(M,7)=XCOOR((N7-1)*(IDIM+1)    +M)
      XA(M,8)=XCOOR((N8-1)*(IDIM+1)    +M)
      XA(M,9)=XCOOR((N9-1)*(IDIM+1)    +M)
      XA(M,10)=XCOOR((N10-1)*(IDIM+1)    +M)
      XA(M,11)=XCOOR((N11-1)*(IDIM+1)    +M)
      XA(M,12)=XCOOR((N12-1)*(IDIM+1)    +M)
      XA(M,13)=XCOOR((N13-1)*(IDIM+1)    +M)
      XA(M,14)=XCOOR((N14-1)*(IDIM+1)    +M)
      XA(M,15)=XCOOR((N15-1)*(IDIM+1)    +M)
      XA(M,16)=XCOOR((N16-1)*(IDIM+1)    +M)
      XA(M,17)=XCOOR((N17-1)*(IDIM+1)    +M)
      XA(M,18)=XCOOR((N18-1)*(IDIM+1)    +M)
      XA(M,19)=XCOOR((N19-1)*(IDIM+1)    +M)
      XA(M,20)=XCOOR((N20-1)*(IDIM+1)    +M)
 2201 CONTINUE

      CALL FFCU20(XA)


      DO 2202 M=1,3

      XCOOR((N21-1)*(IDIM+1)    +M)=XA(M,21)
      XCOOR((N22-1)*(IDIM+1)    +M)=XA(M,22)
      XCOOR((N23-1)*(IDIM+1)    +M)=XA(M,23)
      XCOOR((N24-1)*(IDIM+1)    +M)=XA(M,24)
      XCOOR((N25-1)*(IDIM+1)    +M)=XA(M,25)
      XCOOR((N26-1)*(IDIM+1)    +M)=XA(M,26)
      XCOOR((N27-1)*(IDIM+1)    +M)=XA(M,27)

      XNC1 =(XA(M,1)+XA(M,2)+XA(M,21)+XA(M,8)+XA(M,9)+XA(M,23)
     &       +XA(M,27)+XA(M,26))/8.D0
      XCOOR((NC1 -1)*(IDIM+1)    +M)=XNC1

      XNC2 =(XA(M,3)+XA(M,2)+XA(M,21)+XA(M,4)+XA(M,10)+XA(M,23)
     &      +XA(M,27)+XA(M,24))/8.D0
      XCOOR((NC2 -1)*(IDIM+1)    +M)=XNC2

      XNC3 =(XA(M,5)+XA(M,6)+XA(M,21)+XA(M,4)+XA(M,25)
     &      +XA(M,11)+XA(M,27)+XA(M,24))/8.D0
      XCOOR((NC3 -1)*(IDIM+1)    +M)=XNC3

      XNC4 =(XA(M,8)+XA(M,6)+XA(M,21)+XA(M,7)+XA(M,25)
     &      +XA(M,12)+XA(M,27)+XA(M,26))/8.D0
      XCOOR((NC4 -1)*(IDIM+1)    +M)=XNC4

      XNC5 =(XA(M,26)+XA(M,9)+XA(M,23)+XA(M,27)+XA(M,20)
     &      +XA(M,13)+XA(M,14)+XA(M,22))/8.D0
      XCOOR((NC5 -1)*(IDIM+1)    +M)=XNC5

      XNC6 =(XA(M,10)+XA(M,24)+XA(M,23)+XA(M,27)+XA(M,22)
     &      +XA(M,15)+XA(M,14)+XA(M,16))/8.D0
      XCOOR((NC6 -1)*(IDIM+1)    +M)=XNC6

      XNC7 =(XA(M,11)+XA(M,24)+XA(M,25)+XA(M,27)+XA(M,22)
     &      +XA(M,17)+XA(M,18)+XA(M,16))/8.D0
      XCOOR((NC7 -1)*(IDIM+1)    +M)=XNC7

      XNC8 =(XA(M,12)+XA(M,26)+XA(M,25)+XA(M,27)+XA(M,22)
     &      +XA(M,20)+XA(M,18)+XA(M,19))/8.D0
      XCOOR((NC8 -1)*(IDIM+1)    +M)=XNC8

 2202 CONTINUE

      MCTREI.NUM(1,NCTR0+K1+1)=NC1
      MCTREI.NUM(1,NCTR0+K1+2)=NC2
      MCTREI.NUM(1,NCTR0+K1+3)=NC3
      MCTREI.NUM(1,NCTR0+K1+4)=NC4
      MCTREI.NUM(1,NCTR0+K1+5)=NC5
      MCTREI.NUM(1,NCTR0+K1+6)=NC6
      MCTREI.NUM(1,NCTR0+K1+7)=NC7
      MCTREI.NUM(1,NCTR0+K1+8)=NC8

      IPT2.NUM(1,K1+1)=N1
      IPT2.NUM(2,K1+1)=N2
      IPT2.NUM(3,K1+1)=N21
      IPT2.NUM(4,K1+1)=N8
      IPT2.NUM(5,K1+1)=N9
      IPT2.NUM(6,K1+1)=N23
      IPT2.NUM(7,K1+1)=N27
      IPT2.NUM(8,K1+1)=N26

      IPT2.NUM(1,K1+2)=N2
      IPT2.NUM(2,K1+2)=N3
      IPT2.NUM(3,K1+2)=N4
      IPT2.NUM(4,K1+2)=N21
      IPT2.NUM(5,K1+2)=N23
      IPT2.NUM(6,K1+2)=N10
      IPT2.NUM(7,K1+2)=N24
      IPT2.NUM(8,K1+2)=N27

      IPT2.NUM(1,K1+3)=N4
      IPT2.NUM(2,K1+3)=N5
      IPT2.NUM(3,K1+3)=N6
      IPT2.NUM(4,K1+3)=N21
      IPT2.NUM(5,K1+3)=N24
      IPT2.NUM(6,K1+3)=N11
      IPT2.NUM(7,K1+3)=N25
      IPT2.NUM(8,K1+3)=N27

      IPT2.NUM(1,K1+4)=N8
      IPT2.NUM(2,K1+4)=N21
      IPT2.NUM(3,K1+4)=N6
      IPT2.NUM(4,K1+4)=N7
      IPT2.NUM(5,K1+4)=N26
      IPT2.NUM(6,K1+4)=N27
      IPT2.NUM(7,K1+4)=N25
      IPT2.NUM(8,K1+4)=N12

      IPT2.NUM(1,K1+5)=N9
      IPT2.NUM(2,K1+5)=N23
      IPT2.NUM(3,K1+5)=N27
      IPT2.NUM(4,K1+5)=N26
      IPT2.NUM(5,K1+5)=N13
      IPT2.NUM(6,K1+5)=N14
      IPT2.NUM(7,K1+5)=N22
      IPT2.NUM(8,K1+5)=N20

      IPT2.NUM(1,K1+6)=N23
      IPT2.NUM(2,K1+6)=N10
      IPT2.NUM(3,K1+6)=N24
      IPT2.NUM(4,K1+6)=N27
      IPT2.NUM(5,K1+6)=N14
      IPT2.NUM(6,K1+6)=N15
      IPT2.NUM(7,K1+6)=N16
      IPT2.NUM(8,K1+6)=N22

      IPT2.NUM(1,K1+7)=N25
      IPT2.NUM(2,K1+7)=N27
      IPT2.NUM(3,K1+7)=N24
      IPT2.NUM(4,K1+7)=N11
      IPT2.NUM(5,K1+7)=N18
      IPT2.NUM(6,K1+7)=N22
      IPT2.NUM(7,K1+7)=N16
      IPT2.NUM(8,K1+7)=N17

      IPT2.NUM(1,K1+8)=N26
      IPT2.NUM(2,K1+8)=N27
      IPT2.NUM(3,K1+8)=N25
      IPT2.NUM(4,K1+8)=N12
      IPT2.NUM(5,K1+8)=N20
      IPT2.NUM(6,K1+8)=N22
      IPT2.NUM(7,K1+8)=N18
      IPT2.NUM(8,K1+8)=N19

      K1=K1+8

C DF1
      DO 22001 M=1,3
      XYZ(M,1)=XA(M,2)
      XYZ(M,2)=XA(M,21)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,23)
22001 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)

      AIR1=ABS(AIR1)
      DF1=SQRT(AIR1)

CDF2
      DO 22002 M=1,3
      XYZ(M,1)=XA(M,21)
      XYZ(M,2)=XA(M,4)
      XYZ(M,3)=XA(M,24)
      XYZ(M,4)=XA(M,27)
22002 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)

      AIR2=ABS(AIR2)
      DF2=SQRT(AIR2)

CDF3
      DO 22003 M=1,3
      XYZ(M,1)=XA(M,21)
      XYZ(M,2)=XA(M,6)
      XYZ(M,3)=XA(M,25)
      XYZ(M,4)=XA(M,27)
22003 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)

      AIR3=ABS(AIR3)
      DF3=SQRT(AIR3)

CDF4
      DO 22004 M=1,3
      XYZ(M,1)=XA(M,21)
      XYZ(M,2)=XA(M,8)
      XYZ(M,3)=XA(M,26)
      XYZ(M,4)=XA(M,27)
22004 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR4)

      AIR4=ABS(AIR4)
      DF4=SQRT(AIR4)

CDF5
      DO 22005 M=1,3
      XYZ(M,1)=XA(M,9 )
      XYZ(M,2)=XA(M,23)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,26)
22005 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR5)

      AIR5=ABS(AIR5)
      DF5=SQRT(AIR5)

CDF6
      DO 22006 M=1,3
      XYZ(M,1)=XA(M,10)
      XYZ(M,2)=XA(M,24)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,23)
22006 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR6)

      AIR6=ABS(AIR6)
      DF6=SQRT(AIR6)

CDF7
      DO 22007 M=1,3
      XYZ(M,1)=XA(M,11)
      XYZ(M,2)=XA(M,25)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,24)
22007 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR7)

      AIR7=ABS(AIR7)
      DF7=SQRT(AIR7)

CDF8
      DO 22008 M=1,3
      XYZ(M,1)=XA(M,12)
      XYZ(M,2)=XA(M,26)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,25)
22008 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8)

      AIR8=ABS(AIR8)
      DF8=SQRT(AIR8)

CDF9
      DO 22009 M=1,3
      XYZ(M,1)=XA(M,23)
      XYZ(M,2)=XA(M,27)
      XYZ(M,3)=XA(M,22)
      XYZ(M,4)=XA(M,14)
22009 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR9)

      AIR9=ABS(AIR9)
      DF9=SQRT(AIR9)

CDF10
      DO 22010 M=1,3
      XYZ(M,1)=XA(M,16)
      XYZ(M,2)=XA(M,24)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,22)
22010 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR10)

      AIR10=ABS(AIR10)
      DF10=SQRT(AIR10)

CDF11
      DO 22011 M=1,3
      XYZ(M,1)=XA(M,18)
      XYZ(M,2)=XA(M,25)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,22)
22011 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR11)

      AIR11=ABS(AIR11)
      DF11=SQRT(AIR11)

CDF12
      DO 22012 M=1,3
      XYZ(M,1)=XA(M,20)
      XYZ(M,2)=XA(M,26)
      XYZ(M,3)=XA(M,27)
      XYZ(M,4)=XA(M,22)
22012 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR12)

      AIR12=ABS(AIR12)
      DF12=SQRT(AIR12)

      DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8+DF9+DF10+DF11+DF12)/12.D0
      AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6
     &     +AIR7+AIR8+AIR9+AIR10+AIR11+AIR12)/12.D0

      MELSTB.NUM(1,NCSTB+K)=NC1
      MELSTB.NUM(2,NCSTB+K)=NC2
      MELSTB.NUM(3,NCSTB+K)=NC3
      MELSTB.NUM(4,NCSTB+K)=NC4
      MELSTB.NUM(5,NCSTB+K)=NC5
      MELSTB.NUM(6,NCSTB+K)=NC6
      MELSTB.NUM(7,NCSTB+K)=NC7
      MELSTB.NUM(8,NCSTB+K)=NC8

      MELSTB.NUM(1,NCSTB+K+1)=NC2
      MELSTB.NUM(2,NCSTB+K+1)=NC3
      MELSTB.NUM(3,NCSTB+K+1)=NC4
      MELSTB.NUM(4,NCSTB+K+1)=NC5
      MELSTB.NUM(5,NCSTB+K+1)=NC6
      MELSTB.NUM(6,NCSTB+K+1)=NC7
      MELSTB.NUM(7,NCSTB+K+1)=NC8
      MELSTB.NUM(8,NCSTB+K+1)=NC1

      MELSTB.NUM(1,NCSTB+K+2)=NC3
      MELSTB.NUM(2,NCSTB+K+2)=NC4
      MELSTB.NUM(3,NCSTB+K+2)=NC5
      MELSTB.NUM(4,NCSTB+K+2)=NC6
      MELSTB.NUM(5,NCSTB+K+2)=NC7
      MELSTB.NUM(6,NCSTB+K+2)=NC8
      MELSTB.NUM(7,NCSTB+K+2)=NC1
      MELSTB.NUM(8,NCSTB+K+2)=NC2

      MELSTB.NUM(1,NCSTB+K+3)=NC4
      MELSTB.NUM(2,NCSTB+K+3)=NC5
      MELSTB.NUM(3,NCSTB+K+3)=NC6
      MELSTB.NUM(4,NCSTB+K+3)=NC7
      MELSTB.NUM(5,NCSTB+K+3)=NC8
      MELSTB.NUM(6,NCSTB+K+3)=NC1
      MELSTB.NUM(7,NCSTB+K+3)=NC2
      MELSTB.NUM(8,NCSTB+K+3)=NC3

      MELSTB.NUM(1,NCSTB+K+4)=NC5
      MELSTB.NUM(2,NCSTB+K+4)=NC6
      MELSTB.NUM(3,NCSTB+K+4)=NC7
      MELSTB.NUM(4,NCSTB+K+4)=NC8
      MELSTB.NUM(5,NCSTB+K+4)=NC1
      MELSTB.NUM(6,NCSTB+K+4)=NC2
      MELSTB.NUM(7,NCSTB+K+4)=NC3
      MELSTB.NUM(8,NCSTB+K+4)=NC4

      MELSTB.NUM(1,NCSTB+K+5)=NC6
      MELSTB.NUM(2,NCSTB+K+5)=NC7
      MELSTB.NUM(3,NCSTB+K+5)=NC8
      MELSTB.NUM(4,NCSTB+K+5)=NC1
      MELSTB.NUM(5,NCSTB+K+5)=NC2
      MELSTB.NUM(6,NCSTB+K+5)=NC3
      MELSTB.NUM(7,NCSTB+K+5)=NC4
      MELSTB.NUM(8,NCSTB+K+5)=NC5

      MELSTB.NUM(1,NCSTB+K+6)=NC7
      MELSTB.NUM(2,NCSTB+K+6)=NC8
      MELSTB.NUM(3,NCSTB+K+6)=NC1
      MELSTB.NUM(4,NCSTB+K+6)=NC2
      MELSTB.NUM(5,NCSTB+K+6)=NC3
      MELSTB.NUM(6,NCSTB+K+6)=NC4
      MELSTB.NUM(7,NCSTB+K+6)=NC5
      MELSTB.NUM(8,NCSTB+K+6)=NC6

      MELSTB.NUM(1,NCSTB+K+7)=NC8
      MELSTB.NUM(2,NCSTB+K+7)=NC1
      MELSTB.NUM(3,NCSTB+K+7)=NC2
      MELSTB.NUM(4,NCSTB+K+7)=NC3
      MELSTB.NUM(5,NCSTB+K+7)=NC4
      MELSTB.NUM(6,NCSTB+K+7)=NC5
      MELSTB.NUM(7,NCSTB+K+7)=NC6
      MELSTB.NUM(8,NCSTB+K+7)=NC7



      H12=AIR1*DF1*GA(4)
      H13=AIRM*DFM*EPS(4)
      H14=AIR4*DF4*GA(4)
      H15=AIR5*DF5*GA(4)
      H16=AIRM*DFM*EPS(4)
      H17=AIRM*DFM*EPS(4)
      H18=AIRM*DFM*EPS(4)

      H23=AIR2*DF2*GA(4)
      H24=AIRM*DFM*EPS(4)
      H25=AIRM*DFM*EPS(4)
      H26=AIR6*DF6*GA(4)
      H27=AIRM*DFM*EPS(4)
      H28=AIRM*DFM*EPS(4)

      H34=AIR3*DF3*GA(4)
      H35=AIRM*DFM*EPS(4)
      H36=AIRM*DFM*EPS(4)
      H37=AIR7*DF7*GA(4)
      H38=AIRM*DFM*EPS(4)

      H45=AIRM*DFM*EPS(4)
      H46=AIRM*DFM*EPS(4)
      H47=AIRM*DFM*EPS(4)
      H48=AIR8*DF8*GA(4)

      H56=AIR9*DF9*GA(4)
      H57=AIRM*DFM*EPS(4)
      H58=AIR12*DF12*GA(4)

      H67=AIR10*DF10*GA(4)
      H68=AIRM*DFM*EPS(4)

      H78=AIR11*DF11*GA(4)

      MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18
      MPOVA1.VPOCHA(NCTV0+K,2)=-H12
      MPOVA1.VPOCHA(NCTV0+K,3)=-H13
      MPOVA1.VPOCHA(NCTV0+K,4)=-H14
      MPOVA1.VPOCHA(NCTV0+K,5)=-H15
      MPOVA1.VPOCHA(NCTV0+K,6)=-H16
      MPOVA1.VPOCHA(NCTV0+K,7)=-H17
      MPOVA1.VPOCHA(NCTV0+K,8)=-H18
      MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28
      MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
      MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
      MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25
      MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26
      MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27
      MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28
      MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12
      MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38
      MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
      MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35
      MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36
      MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37
      MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38
      MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13
      MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23
      MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48
      MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45
      MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46
      MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47
      MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48
      MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14
      MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24
      MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34
      MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58
      MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56
      MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57
      MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58
      MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15
      MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25
      MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35
      MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45
      MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68
      MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67
      MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68
      MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16
      MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26
      MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36
      MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46
      MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56
      MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78
      MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78
      MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17
      MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27
      MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37
      MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47
      MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57
      MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67
      MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78
      MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18
      MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28
      MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38
      MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48
      MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58
      MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68
      MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78
      KPOC=1
      NCTV0=NCTV0+7
      NCSTB=NCSTB+7



 220  CONTINUE
C     SEGDES IPT1,IPT2,IPT3
      SEGDES IPT1,IPT2
      GO TO 1

C**************************************************************************
C PR15 -> 8 PRI6

 115  CONTINUE
C     write(6,*)' PR15 -> 8 PRI6 '
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
      NBPC=NBEL*8
      NBP9=NBEL*3

      N=NBPC+MPOVA1.VPOCHA(/1)
      NC=8
      NCTV0=MPOVA1.VPOCHA(/1)
      SEGADJ MPOVA1

      NBV0=XCOOR(/1)/(IDIM+1)
      NBPTS=NBV0+NBPC+NBP9
      SEGADJ MCOORD

C maillage de lineaires
      NBELEM=8*NBEL
      NBNN=6
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=16
      IM=IM+1
      ITAB(IM)=IPT2

C Spg des pts centres des macro elements
      NCTR0=MCTREI.NUM(/2)
      NBELEM=NCTR0+NBPC
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGADJ MCTREI
      KCTREI=1

C Connectivités de la matrice de stabilisation
      NCSTB=MELSTB.NUM(/2)
      NBELEM=NCSTB+NBPC
      NBNN=8
C     write(6,*)' KTRS3 : ',nbnn,nbelem
      NBSOUS=0
      NBREF=0
      SEGADJ MELSTB
      KSTB=1

      CALL KALPBG('QUA4    ','FONFORM0',IZFFM)
      IF(IZFFM.EQ.0)CALL ARRET(0)
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      NPG=GR(/3)
      NES=GR(/1)

      CALL KALPBG('TRI3    ','FONFORM0',IZFF1)
      IF(IZFF1.EQ.0)CALL ARRET(0)
      SEGACT IZFF1*MOD
      IZHR1=IZFF1.KZHR(1)
      SEGACT IZHR1*MOD
      NPG1=IZFF1.GR(/3)
      NES1=IZFF1.GR(/1)

      NPI=4
      NPI1=3
C     write(6,*)' npg1,nes1,npi1=',npg1,nes1,npi1

      K1=0
      DO 215 K=1,NBEL
      N1=IPT1.NUM(1,K)
      N2=IPT1.NUM(2,K)
      N3=IPT1.NUM(3,K)
      N4=IPT1.NUM(4,K)
      N5=IPT1.NUM(5,K)
      N6=IPT1.NUM(6,K)
      N7=IPT1.NUM(7,K)
      N8=IPT1.NUM(8,K)
      N9=IPT1.NUM(9,K)
      N10=IPT1.NUM(10,K)
      N11=IPT1.NUM(11,K)
      N12=IPT1.NUM(12,K)
      N13=IPT1.NUM(13,K)
      N14=IPT1.NUM(14,K)
      N15=IPT1.NUM(15,K)
      N16=NBV0+NBPC+(K-1)*3+1
      N17=NBV0+NBPC+(K-1)*3+2
      N18=NBV0+NBPC+(K-1)*3+3
      NC1=NBV0+(K-1)*8+1
      NC2=NBV0+(K-1)*8+2
      NC3=NBV0+(K-1)*8+3
      NC4=NBV0+(K-1)*8+4
      NC5=NBV0+(K-1)*8+5
      NC6=NBV0+(K-1)*8+6
      NC7=NBV0+(K-1)*8+7
      NC8=NBV0+(K-1)*8+8

      DO 2101 M=1,3
      XA(M,1)=XCOOR((N1-1)*(IDIM+1)    +M)
      XA(M,2)=XCOOR((N2-1)*(IDIM+1)    +M)
      XA(M,3)=XCOOR((N3-1)*(IDIM+1)    +M)
      XA(M,4)=XCOOR((N4-1)*(IDIM+1)    +M)
      XA(M,5)=XCOOR((N5-1)*(IDIM+1)    +M)
      XA(M,6)=XCOOR((N6-1)*(IDIM+1)    +M)
      XA(M,7)=XCOOR((N7-1)*(IDIM+1)    +M)
      XA(M,8)=XCOOR((N8-1)*(IDIM+1)    +M)
      XA(M,9)=XCOOR((N9-1)*(IDIM+1)    +M)
      XA(M,10)=XCOOR((N10-1)*(IDIM+1)    +M)
      XA(M,11)=XCOOR((N11-1)*(IDIM+1)    +M)
      XA(M,12)=XCOOR((N12-1)*(IDIM+1)    +M)
      XA(M,13)=XCOOR((N13-1)*(IDIM+1)    +M)
      XA(M,14)=XCOOR((N14-1)*(IDIM+1)    +M)
      XA(M,15)=XCOOR((N15-1)*(IDIM+1)    +M)
 2101 CONTINUE

      CALL FFPR15(XA)
C     write(6,*)' X'
C     write(6,1002)(XA(1,j),j=16,18)
C     write(6,*)' Y'
C     write(6,1002)(XA(2,j),j=16,18)
C     write(6,*)' Z'
C     write(6,1002)(XA(3,j),j=16,18)

      DO 2102 M=1,3

      XCOOR((N16-1)*(IDIM+1)    +M)=XA(M,16)
      XCOOR((N17-1)*(IDIM+1)    +M)=XA(M,17)
      XCOOR((N18-1)*(IDIM+1)    +M)=XA(M,18)

      XNC1 =(XA(M,1)+XA(M,2)+XA(M,6)+XA(M,7)+XA(M,16)+XA(M,18))/6.D0
      XCOOR((NC1 -1)*(IDIM+1)    +M)=XNC1

      XNC2 =(XA(M,2)+XA(M,3)+XA(M,4)+XA(M,16)+XA(M,8)+XA(M,17))/6.D0
      XCOOR((NC2 -1)*(IDIM+1)    +M)=XNC2

      XNC3 =(XA(M,4)+XA(M,5)+XA(M,6)+XA(M,17)+XA(M,9)+XA(M,18))/6.D0
      XCOOR((NC3 -1)*(IDIM+1)    +M)=XNC3

      XNC4 =(XA(M,2)+XA(M,4)+XA(M,6)+XA(M,16)+XA(M,17)+XA(M,18))/6.D0
      XCOOR((NC4 -1)*(IDIM+1)    +M)=XNC4

      XNC5 =(XA(M,7)+XA(M,16)+XA(M,18)+XA(M,10)+XA(M,11)+XA(M,15))/6.D0
      XCOOR((NC5 -1)*(IDIM+1)    +M)=XNC5

      XNC6 =(XA(M,16)+XA(M,8)+XA(M,17)+XA(M,11)+XA(M,12)+XA(M,13))/6.D0
      XCOOR((NC6 -1)*(IDIM+1)    +M)=XNC6

      XNC7 =(XA(M,18)+XA(M,17)+XA(M,9)+XA(M,15)+XA(M,13)+XA(M,14))/6.D0
      XCOOR((NC7 -1)*(IDIM+1)    +M)=XNC7

      XNC8 =(XA(M,16)+XA(M,17)+XA(M,18)+XA(M,11)+XA(M,13)+XA(M,15))/6.D0
      XCOOR((NC8 -1)*(IDIM+1)    +M)=XNC8


 2102 CONTINUE

      MCTREI.NUM(1,NCTR0+K1+1)=NC1
      MCTREI.NUM(1,NCTR0+K1+2)=NC2
      MCTREI.NUM(1,NCTR0+K1+3)=NC3
      MCTREI.NUM(1,NCTR0+K1+4)=NC4
      MCTREI.NUM(1,NCTR0+K1+5)=NC5
      MCTREI.NUM(1,NCTR0+K1+6)=NC6
      MCTREI.NUM(1,NCTR0+K1+7)=NC7
      MCTREI.NUM(1,NCTR0+K1+8)=NC8

      IPT2.NUM(1,K1+1)=N1
      IPT2.NUM(2,K1+1)=N2
      IPT2.NUM(3,K1+1)=N6
      IPT2.NUM(4,K1+1)=N7
      IPT2.NUM(5,K1+1)=N16
      IPT2.NUM(6,K1+1)=N18

      IPT2.NUM(1,K1+2)=N2
      IPT2.NUM(2,K1+2)=N3
      IPT2.NUM(3,K1+2)=N4
      IPT2.NUM(4,K1+2)=N16
      IPT2.NUM(5,K1+2)=N8
      IPT2.NUM(6,K1+2)=N17

      IPT2.NUM(1,K1+3)=N4
      IPT2.NUM(2,K1+3)=N5
      IPT2.NUM(3,K1+3)=N6
      IPT2.NUM(4,K1+3)=N17
      IPT2.NUM(5,K1+3)=N9
      IPT2.NUM(6,K1+3)=N18

      IPT2.NUM(1,K1+4)=N2
      IPT2.NUM(2,K1+4)=N4
      IPT2.NUM(3,K1+4)=N6
      IPT2.NUM(4,K1+4)=N16
      IPT2.NUM(5,K1+4)=N17
      IPT2.NUM(6,K1+4)=N18

      IPT2.NUM(1,K1+5)=N7
      IPT2.NUM(2,K1+5)=N16
      IPT2.NUM(3,K1+5)=N18
      IPT2.NUM(4,K1+5)=N10
      IPT2.NUM(5,K1+5)=N11
      IPT2.NUM(6,K1+5)=N15

      IPT2.NUM(1,K1+6)=N16
      IPT2.NUM(2,K1+6)=N8
      IPT2.NUM(3,K1+6)=N17
      IPT2.NUM(4,K1+6)=N11
      IPT2.NUM(5,K1+6)=N12
      IPT2.NUM(6,K1+6)=N13

      IPT2.NUM(1,K1+7)=N18
      IPT2.NUM(2,K1+7)=N17
      IPT2.NUM(3,K1+7)=N9
      IPT2.NUM(4,K1+7)=N15
      IPT2.NUM(5,K1+7)=N13
      IPT2.NUM(6,K1+7)=N14

      IPT2.NUM(1,K1+8)=N16
      IPT2.NUM(2,K1+8)=N17
      IPT2.NUM(3,K1+8)=N18
      IPT2.NUM(4,K1+8)=N11
      IPT2.NUM(5,K1+8)=N13
      IPT2.NUM(6,K1+8)=N15


      K1=K1+8

C DF1
      DO 21001 M=1,3
      XYZ(M,1)=XA(M,6)
      XYZ(M,2)=XA(M,2 )
      XYZ(M,3)=XA(M,16)
      XYZ(M,4)=XA(M,18)
21001 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)

      AIR1=ABS(AIR1)
      DF1=SQRT(AIR1)

C DF2
      DO 21002 M=1,3
      XYZ(M,1)=XA(M,2)
      XYZ(M,2)=XA(M,4 )
      XYZ(M,3)=XA(M,17)
      XYZ(M,4)=XA(M,16)
21002 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)

      AIR2=ABS(AIR2)
      DF2=SQRT(AIR2)

C DF3
      DO 21003 M=1,3
      XYZ(M,1)=XA(M,4)
      XYZ(M,2)=XA(M,6 )
      XYZ(M,3)=XA(M,18)
      XYZ(M,4)=XA(M,17)
21003 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)

      AIR3=ABS(AIR3)
      DF3=SQRT(AIR3)

C DF4
      DO 21004 M=1,3
      IZHR1.XYZ(M,1)=XA(M,7)
      IZHR1.XYZ(M,2)=XA(M,16)
      IZHR1.XYZ(M,3)=XA(M,18)
21004 CONTINUE

      CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
     & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR4)

      AIR4=ABS(AIR4)
      DF4=SQRT(AIR4)

C DF5
      DO 21005 M=1,3
      IZHR1.XYZ(M,1)=XA(M,16)
      IZHR1.XYZ(M,2)=XA(M,8 )
      IZHR1.XYZ(M,3)=XA(M,17)
21005 CONTINUE

      CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
     & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR5)

      AIR5=ABS(AIR5)
      DF5=SQRT(AIR5)

C DF6
      DO 21006 M=1,3
      IZHR1.XYZ(M,1)=XA(M,18)
      IZHR1.XYZ(M,2)=XA(M,17)
      IZHR1.XYZ(M,3)=XA(M,9 )
21006 CONTINUE

      CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
     & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR6)

      AIR6=ABS(AIR6)
      DF6=SQRT(AIR6)

C DF7
      DO 21007 M=1,3
      IZHR1.XYZ(M,1)=XA(M,16)
      IZHR1.XYZ(M,2)=XA(M,17)
      IZHR1.XYZ(M,3)=XA(M,18)
21007 CONTINUE

      CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ,
     & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR7)

      AIR7=ABS(AIR7)
      DF7=SQRT(AIR7)

C DF8
      DO 21008 M=1,3
      XYZ(M,1)=XA(M,18)
      XYZ(M,2)=XA(M,16)
      XYZ(M,3)=XA(M,11)
      XYZ(M,4)=XA(M,15)
21008 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8)

      AIR8=ABS(AIR8)
      DF8=SQRT(AIR8)

C DF9
      DO 21009 M=1,3
      XYZ(M,1)=XA(M,16)
      XYZ(M,2)=XA(M,17)
      XYZ(M,3)=XA(M,13)
      XYZ(M,4)=XA(M,11)
21009 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR9)

      AIR9=ABS(AIR9)
      DF9=SQRT(AIR9)

C DF10
      DO 21010 M=1,3
      XYZ(M,1)=XA(M,18)
      XYZ(M,2)=XA(M,17)
      XYZ(M,3)=XA(M,13)
      XYZ(M,4)=XA(M,15)
21010 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR10)

      AIR10=ABS(AIR10)
      DF10=SQRT(AIR10)


      DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8+DF9+DF10)/10.D0
      AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6
     &     +AIR7+AIR8+AIR9+AIR10)/10.D0

      MELSTB.NUM(1,NCSTB+K)=NC1
      MELSTB.NUM(2,NCSTB+K)=NC2
      MELSTB.NUM(3,NCSTB+K)=NC3
      MELSTB.NUM(4,NCSTB+K)=NC4
      MELSTB.NUM(5,NCSTB+K)=NC5
      MELSTB.NUM(6,NCSTB+K)=NC6
      MELSTB.NUM(7,NCSTB+K)=NC7
      MELSTB.NUM(8,NCSTB+K)=NC8

      MELSTB.NUM(1,NCSTB+K+1)=NC2
      MELSTB.NUM(2,NCSTB+K+1)=NC3
      MELSTB.NUM(3,NCSTB+K+1)=NC4
      MELSTB.NUM(4,NCSTB+K+1)=NC5
      MELSTB.NUM(5,NCSTB+K+1)=NC6
      MELSTB.NUM(6,NCSTB+K+1)=NC7
      MELSTB.NUM(7,NCSTB+K+1)=NC8
      MELSTB.NUM(8,NCSTB+K+1)=NC1

      MELSTB.NUM(1,NCSTB+K+2)=NC3
      MELSTB.NUM(2,NCSTB+K+2)=NC4
      MELSTB.NUM(3,NCSTB+K+2)=NC5
      MELSTB.NUM(4,NCSTB+K+2)=NC6
      MELSTB.NUM(5,NCSTB+K+2)=NC7
      MELSTB.NUM(6,NCSTB+K+2)=NC8
      MELSTB.NUM(7,NCSTB+K+2)=NC1
      MELSTB.NUM(8,NCSTB+K+2)=NC2

      MELSTB.NUM(1,NCSTB+K+3)=NC4
      MELSTB.NUM(2,NCSTB+K+3)=NC5
      MELSTB.NUM(3,NCSTB+K+3)=NC6
      MELSTB.NUM(4,NCSTB+K+3)=NC7
      MELSTB.NUM(5,NCSTB+K+3)=NC8
      MELSTB.NUM(6,NCSTB+K+3)=NC1
      MELSTB.NUM(7,NCSTB+K+3)=NC2
      MELSTB.NUM(8,NCSTB+K+3)=NC3

      MELSTB.NUM(1,NCSTB+K+4)=NC5
      MELSTB.NUM(2,NCSTB+K+4)=NC6
      MELSTB.NUM(3,NCSTB+K+4)=NC7
      MELSTB.NUM(4,NCSTB+K+4)=NC8
      MELSTB.NUM(5,NCSTB+K+4)=NC1
      MELSTB.NUM(6,NCSTB+K+4)=NC2
      MELSTB.NUM(7,NCSTB+K+4)=NC3
      MELSTB.NUM(8,NCSTB+K+4)=NC4

      MELSTB.NUM(1,NCSTB+K+5)=NC6
      MELSTB.NUM(2,NCSTB+K+5)=NC7
      MELSTB.NUM(3,NCSTB+K+5)=NC8
      MELSTB.NUM(4,NCSTB+K+5)=NC1
      MELSTB.NUM(5,NCSTB+K+5)=NC2
      MELSTB.NUM(6,NCSTB+K+5)=NC3
      MELSTB.NUM(7,NCSTB+K+5)=NC4
      MELSTB.NUM(8,NCSTB+K+5)=NC5

      MELSTB.NUM(1,NCSTB+K+6)=NC7
      MELSTB.NUM(2,NCSTB+K+6)=NC8
      MELSTB.NUM(3,NCSTB+K+6)=NC1
      MELSTB.NUM(4,NCSTB+K+6)=NC2
      MELSTB.NUM(5,NCSTB+K+6)=NC3
      MELSTB.NUM(6,NCSTB+K+6)=NC4
      MELSTB.NUM(7,NCSTB+K+6)=NC5
      MELSTB.NUM(8,NCSTB+K+6)=NC6

      MELSTB.NUM(1,NCSTB+K+7)=NC8
      MELSTB.NUM(2,NCSTB+K+7)=NC1
      MELSTB.NUM(3,NCSTB+K+7)=NC2
      MELSTB.NUM(4,NCSTB+K+7)=NC3
      MELSTB.NUM(5,NCSTB+K+7)=NC4
      MELSTB.NUM(6,NCSTB+K+7)=NC5
      MELSTB.NUM(7,NCSTB+K+7)=NC6
      MELSTB.NUM(8,NCSTB+K+7)=NC7

C     write(6,1002)air1,air2,air3,air4,air5,air6,air7,air8,air9,
C    &air10
C     write(6,1002)df3,df4,df5,df6,df7,df8,df9,df10
      H12=AIRM*DFM*EPS(5)
      H13=AIRM*DFM*EPS(5)
      H14=AIR1*DF1*GA(5)
      H15=AIR4*DF4*GA(5)
      H16=AIRM*DFM*EPS(5)
      H17=AIRM*DFM*EPS(5)
      H18=AIRM*DFM*EPS(5)

      H23=AIRM*DFM*EPS(5)
      H24=AIR2*DF2*GA(5)
      H25=AIRM*DFM*EPS(5)
      H26=AIR5*DF5*GA(5)
      H27=AIRM*DFM*EPS(5)
      H28=AIRM*DFM*EPS(5)

      H34=AIR3*DF3*GA(5)
      H35=AIRM*DFM*EPS(5)
      H36=AIRM*DFM*EPS(5)
      H37=AIR6*DF6*GA(5)
      H38=AIRM*DFM*EPS(5)

      H45=AIRM*DFM*EPS(5)
      H46=AIRM*DFM*EPS(5)
      H47=AIRM*DFM*EPS(5)
      H48=AIR7*DF7*GA(5)

      H56=AIRM*DFM*EPS(5)
      H57=AIRM*DFM*EPS(5)
      H58=AIR8*DF8*GA(5)

      H67=AIRM*DFM*EPS(5)
      H68=AIR9*DF9*GA(5)

      H78=AIR10*DF10*GA(5)

      MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18
      MPOVA1.VPOCHA(NCTV0+K,2)=-H12
      MPOVA1.VPOCHA(NCTV0+K,3)=-H13
      MPOVA1.VPOCHA(NCTV0+K,4)=-H14
      MPOVA1.VPOCHA(NCTV0+K,5)=-H15
      MPOVA1.VPOCHA(NCTV0+K,6)=-H16
      MPOVA1.VPOCHA(NCTV0+K,7)=-H17
      MPOVA1.VPOCHA(NCTV0+K,8)=-H18
      MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28
      MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
      MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
      MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25
      MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26
      MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27
      MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28
      MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12
      MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38
      MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
      MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35
      MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36
      MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37
      MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38
      MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13
      MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23
      MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48
      MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45
      MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46
      MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47
      MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48
      MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14
      MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24
      MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34
      MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58
      MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56
      MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57
      MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58
      MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15
      MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25
      MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35
      MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45
      MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68
      MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67
      MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68
      MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16
      MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26
      MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36
      MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46
      MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56
      MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78
      MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78
      MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17
      MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27
      MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37
      MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47
      MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57
      MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67
      MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78
      MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18
      MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28
      MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38
      MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48
      MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58
      MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68
      MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78
      KPOC=1
      NCTV0=NCTV0+7
      NCSTB=NCSTB+7


 215  CONTINUE
      SEGDES IPT1,IPT2
      GO TO 1

C**************************************************************************

 113  CONTINUE
      WRITE(6,*)'Opérateur DOMA : Les éléments PY13 ne sont pas traités'
      IRET=0
      RETURN

C**************************************************************************
C TE10 -> 8 TET4

 110  CONTINUE
C     write(6,*)' TE10 -> 8 TET4 '
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
      NBPC=NBEL*8

      N=NBPC+MPOVA1.VPOCHA(/1)
      NC=8
      NCTV0=MPOVA1.VPOCHA(/1)
      SEGADJ MPOVA1

      NBV0=XCOOR(/1)/(IDIM+1)
      NBPTS=NBV0+NBPC
      SEGADJ MCOORD

C maillage de lineaires
      NBELEM=8*NBEL
      NBNN=4
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=23
      IM=IM+1
      ITAB(IM)=IPT2

C Spg des pts centres des macro elements
      NCTR0=MCTREI.NUM(/2)
      NBELEM=NCTR0+NBPC
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGADJ MCTREI
      KCTREI=1

C Connectivités de la matrice de stabilisation
      NCSTB=MELSTB.NUM(/2)
      NBELEM=NCSTB+NBPC
      NBNN=8
C     write(6,*)' KTRS3 : ',nbnn,nbelem
      NBSOUS=0
      NBREF=0
      SEGADJ MELSTB
      KSTB=1

      CALL KALPBG('TRI3    ','FONFORM0',IZFFM)
      IF(IZFFM.EQ.0)CALL ARRET(0)
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      NPG=GR(/3)
      NES=GR(/1)
      NPI=3

C     write(6,*)' NBEL=',nbel

      K1=0
      DO 210 K=1,NBEL
      N1=IPT1.NUM(1,K)
      N2=IPT1.NUM(2,K)
      N3=IPT1.NUM(3,K)
      N4=IPT1.NUM(4,K)
      N5=IPT1.NUM(5,K)
      N6=IPT1.NUM(6,K)
      N7=IPT1.NUM(7,K)
      N8=IPT1.NUM(8,K)
      N9=IPT1.NUM(9,K)
      N10=IPT1.NUM(10,K)
      NC1=NBV0+(K-1)*8+1
      NC2=NBV0+(K-1)*8+2
      NC3=NBV0+(K-1)*8+3
      NC4=NBV0+(K-1)*8+4
      NC5=NBV0+(K-1)*8+5
      NC6=NBV0+(K-1)*8+6
      NC7=NBV0+(K-1)*8+7
      NC8=NBV0+(K-1)*8+8

      DO 2111 M=1,3
      XA(M,1)=XCOOR((N1-1)*(IDIM+1)    +M)
      XA(M,2)=XCOOR((N2-1)*(IDIM+1)    +M)
      XA(M,3)=XCOOR((N3-1)*(IDIM+1)    +M)
      XA(M,4)=XCOOR((N4-1)*(IDIM+1)    +M)
      XA(M,5)=XCOOR((N5-1)*(IDIM+1)    +M)
      XA(M,6)=XCOOR((N6-1)*(IDIM+1)    +M)
      XA(M,7)=XCOOR((N7-1)*(IDIM+1)    +M)
      XA(M,8)=XCOOR((N8-1)*(IDIM+1)    +M)
      XA(M,9)=XCOOR((N9-1)*(IDIM+1)    +M)
      XA(M,10)=XCOOR((N10-1)*(IDIM+1)    +M)
 2111 CONTINUE

      DO 2112 M=1,3

      XNC1 =(XA(M,1)+XA(M,2)+XA(M,6)+XA(M,7))/4.D0
      XCOOR((NC1 -1)*(IDIM+1)    +M)=XNC1

      XNC2 =(XA(M,2)+XA(M,3)+XA(M,4)+XA(M,8))/4.D0
      XCOOR((NC2 -1)*(IDIM+1)    +M)=XNC2

      XNC3 =(XA(M,4)+XA(M,5)+XA(M,6)+XA(M,9))/4.D0
      XCOOR((NC3 -1)*(IDIM+1)    +M)=XNC3

      XNC4 =(XA(M,7)+XA(M,8)+XA(M,9)+XA(M,10))/4.D0
      XCOOR((NC4 -1)*(IDIM+1)    +M)=XNC4

      XNC5 =(XA(M,2)+XA(M,6)+XA(M,7)+XA(M,8))/4.D0
      XCOOR((NC5 -1)*(IDIM+1)    +M)=XNC5

      XNC6 =(XA(M,6)+XA(M,8)+XA(M,9)+XA(M,7))/4.D0
      XCOOR((NC6 -1)*(IDIM+1)    +M)=XNC6

      XNC7 =(XA(M,6)+XA(M,8)+XA(M,2)+XA(M,4))/4.D0
      XCOOR((NC7 -1)*(IDIM+1)    +M)=XNC7

      XNC8 =(XA(M,6)+XA(M,8)+XA(M,9)+XA(M,4))/4.D0
      XCOOR((NC8 -1)*(IDIM+1)    +M)=XNC8


 2112 CONTINUE

      MCTREI.NUM(1,NCTR0+K1+1)=NC1
      MCTREI.NUM(1,NCTR0+K1+2)=NC2
      MCTREI.NUM(1,NCTR0+K1+3)=NC3
      MCTREI.NUM(1,NCTR0+K1+4)=NC4
      MCTREI.NUM(1,NCTR0+K1+5)=NC5
      MCTREI.NUM(1,NCTR0+K1+6)=NC6
      MCTREI.NUM(1,NCTR0+K1+7)=NC7
      MCTREI.NUM(1,NCTR0+K1+8)=NC8

      IPT2.NUM(1,K1+1)=N1
      IPT2.NUM(2,K1+1)=N2
      IPT2.NUM(3,K1+1)=N6
      IPT2.NUM(4,K1+1)=N7

      IPT2.NUM(1,K1+2)=N3
      IPT2.NUM(2,K1+2)=N4
      IPT2.NUM(3,K1+2)=N8
      IPT2.NUM(4,K1+2)=N2

      IPT2.NUM(1,K1+3)=N5
      IPT2.NUM(2,K1+3)=N6
      IPT2.NUM(3,K1+3)=N4
      IPT2.NUM(4,K1+3)=N9

      IPT2.NUM(1,K1+4)=N7
      IPT2.NUM(2,K1+4)=N8
      IPT2.NUM(3,K1+4)=N9
      IPT2.NUM(4,K1+4)=N10

      IPT2.NUM(1,K1+5)=N2
      IPT2.NUM(2,K1+5)=N6
      IPT2.NUM(3,K1+5)=N7
      IPT2.NUM(4,K1+5)=N8

      IPT2.NUM(1,K1+6)=N6
      IPT2.NUM(2,K1+6)=N8
      IPT2.NUM(3,K1+6)=N9
      IPT2.NUM(4,K1+6)=N7

      IPT2.NUM(1,K1+7)=N6
      IPT2.NUM(2,K1+7)=N8
      IPT2.NUM(3,K1+7)=N2
      IPT2.NUM(4,K1+7)=N4

      IPT2.NUM(1,K1+8)=N6
      IPT2.NUM(2,K1+8)=N8
      IPT2.NUM(3,K1+8)=N9
      IPT2.NUM(4,K1+8)=N4


      K1=K1+8

C DF1
      DO 21101 M=1,3
      XYZ(M,1)=XA(M,2)
      XYZ(M,2)=XA(M,6)
      XYZ(M,3)=XA(M,7)
21101 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)

      AIR1=ABS(AIR1)
      DF1=SQRT(AIR1)

C DF2
      DO 21102 M=1,3
      XYZ(M,1)=XA(M,2)
      XYZ(M,2)=XA(M,4)
      XYZ(M,3)=XA(M,6)
21102 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)

      AIR2=ABS(AIR2)
      DF2=SQRT(AIR2)

C DF3
      DO 21103 M=1,3
      XYZ(M,1)=XA(M,7)
      XYZ(M,2)=XA(M,6)
      XYZ(M,3)=XA(M,8)
21103 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)

      AIR3=ABS(AIR3)
      DF3=SQRT(AIR3)

C DF4
      DO 21104 M=1,3
      XYZ(M,1)=XA(M,2)
      XYZ(M,2)=XA(M,8)
      XYZ(M,3)=XA(M,6)
21104 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR4)

      AIR4=ABS(AIR4)
      DF4=SQRT(AIR4)

C DF5
      DO 21105 M=1,3
      XYZ(M,1)=XA(M,6)
      XYZ(M,2)=XA(M,9)
      XYZ(M,3)=XA(M,8)
21105 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR5)

      AIR5=ABS(AIR5)
      DF5=SQRT(AIR5)

C DF6
      DO 21106 M=1,3
      XYZ(M,1)=XA(M,6)
      XYZ(M,2)=XA(M,8)
      XYZ(M,3)=XA(M,4)
21106 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR6)

      AIR6=ABS(AIR6)
      DF6=SQRT(AIR6)

C DF7
      DO 21107 M=1,3
      XYZ(M,1)=XA(M,7)
      XYZ(M,2)=XA(M,8)
      XYZ(M,3)=XA(M,9)
21107 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR7)

      AIR7=ABS(AIR7)
      DF7=SQRT(AIR7)

C DF8
      DO 21108 M=1,3
      XYZ(M,1)=XA(M,9)
      XYZ(M,2)=XA(M,6)
      XYZ(M,3)=XA(M,4)
21108 CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8)

      AIR8=ABS(AIR8)
      DF8=SQRT(AIR8)


      DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8)/8.D0
      AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6+AIR7+AIR8)/8.D0

      MELSTB.NUM(1,NCSTB+K)=NC1
      MELSTB.NUM(2,NCSTB+K)=NC2
      MELSTB.NUM(3,NCSTB+K)=NC3
      MELSTB.NUM(4,NCSTB+K)=NC4
      MELSTB.NUM(5,NCSTB+K)=NC5
      MELSTB.NUM(6,NCSTB+K)=NC6
      MELSTB.NUM(7,NCSTB+K)=NC7
      MELSTB.NUM(8,NCSTB+K)=NC8

      MELSTB.NUM(1,NCSTB+K+1)=NC2
      MELSTB.NUM(2,NCSTB+K+1)=NC3
      MELSTB.NUM(3,NCSTB+K+1)=NC4
      MELSTB.NUM(4,NCSTB+K+1)=NC5
      MELSTB.NUM(5,NCSTB+K+1)=NC6
      MELSTB.NUM(6,NCSTB+K+1)=NC7
      MELSTB.NUM(7,NCSTB+K+1)=NC8
      MELSTB.NUM(8,NCSTB+K+1)=NC1

      MELSTB.NUM(1,NCSTB+K+2)=NC3
      MELSTB.NUM(2,NCSTB+K+2)=NC4
      MELSTB.NUM(3,NCSTB+K+2)=NC5
      MELSTB.NUM(4,NCSTB+K+2)=NC6
      MELSTB.NUM(5,NCSTB+K+2)=NC7
      MELSTB.NUM(6,NCSTB+K+2)=NC8
      MELSTB.NUM(7,NCSTB+K+2)=NC1
      MELSTB.NUM(8,NCSTB+K+2)=NC2

      MELSTB.NUM(1,NCSTB+K+3)=NC4
      MELSTB.NUM(2,NCSTB+K+3)=NC5
      MELSTB.NUM(3,NCSTB+K+3)=NC6
      MELSTB.NUM(4,NCSTB+K+3)=NC7
      MELSTB.NUM(5,NCSTB+K+3)=NC8
      MELSTB.NUM(6,NCSTB+K+3)=NC1
      MELSTB.NUM(7,NCSTB+K+3)=NC2
      MELSTB.NUM(8,NCSTB+K+3)=NC3

      MELSTB.NUM(1,NCSTB+K+4)=NC5
      MELSTB.NUM(2,NCSTB+K+4)=NC6
      MELSTB.NUM(3,NCSTB+K+4)=NC7
      MELSTB.NUM(4,NCSTB+K+4)=NC8
      MELSTB.NUM(5,NCSTB+K+4)=NC1
      MELSTB.NUM(6,NCSTB+K+4)=NC2
      MELSTB.NUM(7,NCSTB+K+4)=NC3
      MELSTB.NUM(8,NCSTB+K+4)=NC4

      MELSTB.NUM(1,NCSTB+K+5)=NC6
      MELSTB.NUM(2,NCSTB+K+5)=NC7
      MELSTB.NUM(3,NCSTB+K+5)=NC8
      MELSTB.NUM(4,NCSTB+K+5)=NC1
      MELSTB.NUM(5,NCSTB+K+5)=NC2
      MELSTB.NUM(6,NCSTB+K+5)=NC3
      MELSTB.NUM(7,NCSTB+K+5)=NC4
      MELSTB.NUM(8,NCSTB+K+5)=NC5

      MELSTB.NUM(1,NCSTB+K+6)=NC7
      MELSTB.NUM(2,NCSTB+K+6)=NC8
      MELSTB.NUM(3,NCSTB+K+6)=NC1
      MELSTB.NUM(4,NCSTB+K+6)=NC2
      MELSTB.NUM(5,NCSTB+K+6)=NC3
      MELSTB.NUM(6,NCSTB+K+6)=NC4
      MELSTB.NUM(7,NCSTB+K+6)=NC5
      MELSTB.NUM(8,NCSTB+K+6)=NC6

      MELSTB.NUM(1,NCSTB+K+7)=NC8
      MELSTB.NUM(2,NCSTB+K+7)=NC1
      MELSTB.NUM(3,NCSTB+K+7)=NC2
      MELSTB.NUM(4,NCSTB+K+7)=NC3
      MELSTB.NUM(5,NCSTB+K+7)=NC4
      MELSTB.NUM(6,NCSTB+K+7)=NC5
      MELSTB.NUM(7,NCSTB+K+7)=NC6
      MELSTB.NUM(8,NCSTB+K+7)=NC7

C     write(6,1002)air1,air2,air3,air4,air5,air6,air7,air8,air9,
C    &air10
C     write(6,1002)df3,df4,df5,df6,df7,df8,df9,df10
      H12=AIRM*DFM*EPS(7)
      H13=AIRM*DFM*EPS(7)
      H14=AIRM*DFM*EPS(7)
      H15=AIR1*DF1*GA(7)
      H16=AIRM*DFM*EPS(7)
      H17=AIRM*DFM*EPS(7)
      H18=AIRM*DFM*EPS(7)

      H23=AIRM*DFM*EPS(7)
      H24=AIRM*DFM*EPS(7)
      H25=AIRM*DFM*EPS(7)
      H26=AIRM*DFM*EPS(7)
      H27=AIR2*DF2*GA(7)
      H28=AIRM*DFM*EPS(7)

      H34=AIRM*DFM*EPS(7)
      H35=AIRM*DFM*EPS(7)
      H36=AIRM*DFM*EPS(7)
      H37=AIRM*DFM*EPS(7)
      H38=AIR8*DF8*GA(7)

      H45=AIRM*DFM*EPS(7)
      H46=AIR7*DF7*GA(7)
      H47=AIRM*DFM*EPS(7)
      H48=AIRM*DFM*EPS(7)

      H56=AIR3*DF3*GA(7)
      H57=AIR4*DF4*GA(7)
      H58=AIRM*DFM*EPS(7)

      H67=AIRM*DFM*EPS(7)
      H68=AIR5*DF5*GA(7)

      H78=AIR6*DF6*GA(7)

      MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18
      MPOVA1.VPOCHA(NCTV0+K,2)=-H12
      MPOVA1.VPOCHA(NCTV0+K,3)=-H13
      MPOVA1.VPOCHA(NCTV0+K,4)=-H14
      MPOVA1.VPOCHA(NCTV0+K,5)=-H15
      MPOVA1.VPOCHA(NCTV0+K,6)=-H16
      MPOVA1.VPOCHA(NCTV0+K,7)=-H17
      MPOVA1.VPOCHA(NCTV0+K,8)=-H18
      MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28
      MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
      MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
      MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25
      MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26
      MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27
      MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28
      MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12
      MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38
      MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
      MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35
      MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36
      MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37
      MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38
      MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13
      MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23
      MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48
      MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45
      MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46
      MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47
      MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48
      MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14
      MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24
      MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34
      MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58
      MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56
      MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57
      MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58
      MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15
      MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25
      MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35
      MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45
      MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68
      MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67
      MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68
      MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16
      MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26
      MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36
      MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46
      MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56
      MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78
      MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78
      MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17
      MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27
      MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37
      MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47
      MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57
      MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67
      MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78
      MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18
      MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28
      MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38
      MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48
      MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58
      MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68
      MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78
      KPOC=1
      NCTV0=NCTV0+7
      NCSTB=NCSTB+7


 210  CONTINUE
      SEGDES IPT1,IPT2
C     write(6,*)' Sortie boucle',K
      GO TO 1
C**************************************************************************


 1    CONTINUE
C     IF(MELTFI.LISOUS(/1).EQ.1)THEN
C     MEL=MELTFI.LISOUS(1)
C     SEGSUP MELTFI
C     MELTFI=MEL
C     ENDIF

      IF(IM.EQ.1)THEN
      MELEME=ITAB(1)
      ELSE
      IF(IM.GT.5)THEN
      WRITE(6,*)' Problemes dans DOMA option MACRO '
      RETURN
      ENDIF
      NBELEM=0
      NBNN=0
      NBSOUS=IM
      NBREF=0
      SEGINI MELEME
      DO 2 L=1,NBSOUS
      LISOUS(L)=ITAB(L)
 2    CONTINUE
      ENDIF
      CALL ECMO(MTBT0,'MELEME','MAILLAGE',MELEME)

C Connectivités de la matrice de stabilisation
      segact melstb

      IF(KSTB.NE.0)THEN
      CALL ECMO(MTBT0,'MELSTB','MAILLAGE',MELSTB)
      ELSE
      SEGSUP MELSTB
      MELSTB=0
      ENDIF

      IF(KCTREI.NE.0)THEN
      CALL ECMO(MTBT0,'MCTREI','MAILLAGE',MCTREI)
      IF(KPOC.NE.0)THEN
      MSOUP1.IGEOC=MCTREI
      CALL ECMO(MTBT0,'MCHPOC','CHPOINT',MCHPO1)
      ELSE
      SEGSUP MCHPO1,MSOUP1,MPOVA1
      ENDIF
      ELSE
      SEGSUP MCTREI
      MCTREI=0
      ENDIF


      SEGDES MELEME,MACRO
 1002 FORMAT(10(1X,1PE11.4))
      RETURN
      END