Télécharger ktrsf.eso

Retour à la liste

ktrsf
C KTRSF     SOURCE    CB215821  20/11/25    13:33:19     10792          
      SUBROUTINE KTRSF(MACRO,MELEME,MTBT0,IRET,GA,EPS,EPSD,ALFA)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMCOORD
-INC SMCHPOI
-INC SMELEME
-INC SIZFFB
      POINTEUR MACRO.MELEME,MFACEI.MELEME,MFICEL.MELEME,MELTFI.MELEME
      POINTEUR MCTREI.MELEME,MELELI.MELEME,MELSTB.MELEME
      DIMENSION ITAB(5),GA(3),EPS(3),EPSD(3)
      PARAMETER (NBE=3)
      CHARACTER*8 LISTE(NBE),TYPE,LIST(NBE)
      DATA LISTE /'TRI6    ','QUA8    ','SEG3    '/
      DATA LIST  /'TRI3    ','QUA4    ','SEG2    '/
 
      COEF=ALFA*0.01D0
      IAXI=0
      IF(IFOMOD.EQ.0)IAXI=2
 
      IRET=1
      IM  =0
 
      IPT5=0
      IPT6=0
      IPT7=0
 
      NSOUPO=1
      NAT=1
      N=0
C     NC=3
C aire de la face interne , 2 composantes de la normale
C     SEGINI MCHPOI,MSOUPO,MPOVAL
      KPOC=0
      NC=4
      SEGINI MCHPO1,MSOUP1,MPOVA1
C     JATTRI(1)=2
      MCHPO1.JATTRI(1)=2
C     IFOPOI=IFOMOD
      MCHPO1.IFOPOI=IFOMOD
C     MTYPOI='FACE    '
      MCHPO1.MTYPOI='CENTRE  '
C     MOCHDE='                                                  '
      MCHPO1.MOCHDE='                                                  '
C     IPCHP(1)=MSOUPO
      MCHPO1.IPCHP(1)=MSOUP1
 
C     IPOVAL=MPOVAL
      MSOUP1.IPOVAL=MPOVA1
C     NOCOMP(1)='SCF1'
      MSOUP1.NOCOMP(1)='SCC1'
      MSOUP1.NOCOMP(2)='SCC2'
      MSOUP1.NOCOMP(3)='SCC3'
      MSOUP1.NOCOMP(4)='SCC4'
 
      NBELEM=0
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGINI MCTREI
      MCTREI.ITYPEL=1
      KCTREI=0
C MLELI Connectivités : pour chaque ligne pression donne les
C connectivités pour la matrice de stabilisation
C Pt centre Pts centre connectes Pts face intermediares
C QUA8 -> 5 pts 1pc + 2pc + 2pf
C TRI6 -> 3 pts 1pc + 1pc + 1pf
C      -> 7 pts 1pc + 3pc + 3pf
 
C     NBELEM=0
C     NBNN=0
C     NBSOUS=0
C     NBREF=0
C     SEGINI MELELI
C     MELELI.ITYPEL=0
C     KELELI=0
 
C Connectivités de la matrice de stabilisation
      NBELEM=0
      NBNN=4
      NBSOUS=0
      NBREF=0
      SEGINI MELSTB
      MELSTB.ITYPEL=8
      KSTB=0
 
C     NBELEM=0
C     NBNN=0
C     NBSOUS=0
C     NBREF=0
C     SEGINI MELTFI
C     KELTFI=0
 
C     NBELEM=0
C     NBNN=1
C     NBSOUS=0
C     NBREF=0
C     SEGINI MFACEI
C     MFACEI.ITYPEL=1
C     KFACEI=0
 
C     NBELEM=0
C     NBNN=3
C     NBSOUS=0
C     NBREF=0
C     SEGINI MFICEL
C     MFICEL.ITYPEL=3
C     KFICEL=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),IP
 
C TRI6 -> 4 TRI3
 106  CONTINUE
 
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
C     NBPF=NBEL*3
      NBPF=0
      NBPC=NBEL*4
 
C     N=NBPF+VPOCHA(/1)
C     NC=3
C     SEGADJ MPOVAL
      N=NBPC+MPOVA1.VPOCHA(/1)
      NC=4
      NCTV0=MPOVA1.VPOCHA(/1)
      SEGADJ MPOVA1
      segact mcoord*mod
      NBV0=nbpts
      NBPTS=NBV0+NBPF+NBPC
      SEGADJ MCOORD
 
      NBELEM=NBPC
      NBNN=3
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=4
      IM=IM+1
      ITAB(IM)=IPT2
 
C     IF(IPT5.EQ.0)THEN
C     NBELEM=3*NBEL
C     NBNN=3
C     NBSOUS=0
C     NBREF=0
C     K5=0
C     SEGINI IPT5
C     IPT5.ITYPEL=4
C     ELSE
C     K5=IPT5.NUM(/2)
C     NBELEM=IPT5.NUM(/2)+3*NBEL
C     NBNN=3
C     NBSOUS=0
C     NBREF=0
C     SEGADJ IPT5
C     ENDIF
C
C     IF(IPT6.EQ.0)THEN
C     NBELEM=NBEL
C     NBNN=7
C     NBSOUS=0
C     NBREF=0
C     K6=0
C     SEGINI IPT6
C     IPT6.ITYPEL=7
C     ELSE
C     K6=IPT6.NUM(/2)
C     NBELEM=IPT6.NUM(/2)+NBEL
C     NBNN=7
C     NBSOUS=0
C     NBREF=0
C     SEGADJ IPT6
C     ENDIF
 
C Spg des pts centres des macro elements
      NCTR0=MCTREI.NUM(/2)
      NBELEM=NCTR0+NBPC
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGADJ MCTREI
C     write(6,*)' MCTREI=',mctrei,nbelem
      KCTREI=1
 
C Connectivités de la matrice de stabilisation
      NCSTB=MELSTB.NUM(/2)
      NBELEM=NCSTB+NBPC
      NBNN=4
C     write(6,*)' KTRSF : ',nbnn,nbelem
      NBSOUS=0
      NBREF=0
      SEGADJ MELSTB
      KSTB=1
 
C     NBELEM=0
C     NBNN=0
C     NBS=MELTFI.LISOUS(/1)
C     NBSOUS=NBS+2
C     NBREF=0
C     SEGADJ MELTFI
C     KELTFI=1
C     NBELEM=3*NBEL
C     NBNN=2
C     NBSOUS=0
C     NBREF=0
C     SEGINI IPT3
C     IPT3.ITYPEL=2
C     MELTFI.LISOUS(NBS+1)=IPT3
C     NBELEM=NBEL
C     NBNN=4
C     NBSOUS=0
C     NBREF=0
C     SEGINI IPT4
C     IPT4.ITYPEL=5
C     MELTFI.LISOUS(NBS+2)=IPT4
 
C     KFM=MFACEI.NUM(/2)
C     NBNN=MFACEI.NUM(/1)
C     NBELEM=MFACEI.NUM(/2)+NBPF
C     SEGADJ MFACEI
C     KFACEI=1
 
C     NBNN=MFICEL.NUM(/1)
C     NBELEM=MFICEL.NUM(/2)+NBPF
C     SEGADJ MFICEL
C     KFICEL=1
 
      CALL KALPBG('SEG2    ','FONFORM0',IZFFM)
      IF(IZFFM.EQ.0)CALL ARRET(0)
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      NPG=GR(/3)
      NES=GR(/1)
 
      K1=0
      KF=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)
 
      XN1=XCOOR((N1-1)*(IDIM+1)    +1)
      YN1=XCOOR((N1-1)*(IDIM+1)    +2)
      XN2=XCOOR((N2-1)*(IDIM+1)    +1)
      YN2=XCOOR((N2-1)*(IDIM+1)    +2)
      XN3=XCOOR((N3-1)*(IDIM+1)    +1)
      YN3=XCOOR((N3-1)*(IDIM+1)    +2)
      XN4=XCOOR((N4-1)*(IDIM+1)    +1)
      YN4=XCOOR((N4-1)*(IDIM+1)    +2)
      XN5=XCOOR((N5-1)*(IDIM+1)    +1)
      YN5=XCOOR((N5-1)*(IDIM+1)    +2)
      XN6=XCOOR((N6-1)*(IDIM+1)    +1)
      YN6=XCOOR((N6-1)*(IDIM+1)    +2)
 
      K3=3*(K-1)
CT1
      K1=K1+1
      KF=KF+1
      KFM=KFM+1
      NC1=NBV0+K1
C     NF1=NBV0+NBPC+KF
 
      MCTREI.NUM(1,NCTR0+K1)=NC1
      IPT2.NUM(1,K1)=N1
      IPT2.NUM(2,K1)=N2
      IPT2.NUM(3,K1)=N6
C     IPT3.NUM(1,K3+1)=NC1
C     IPT3.NUM(2,K3+1)=NF1
 
      XCOOR((NC1-1)*(IDIM+1)    +1)= (XN1+XN2+XN6)/3.D0
      XCOOR((NC1-1)*(IDIM+1)    +2)= (YN1+YN2+YN6)/3.D0
 
C     XCOOR((NF1-1)*(IDIM+1)    +1)= (XN2+XN6)/2.D0
C     XCOOR((NF1-1)*(IDIM+1)    +2)= (YN2+YN6)/2.D0
 
C     MFACEI.NUM(1,KFM)=NF1
C     MFICEL.NUM(1,KFM)=NC1
C     MFICEL.NUM(2,KFM)=NF1
C     MFICEL.NUM(3,KFM)=NC4
CT2
      K1=K1+1
      KF=KF+1
      KFM=KFM+1
      NC2=NBV0+K1
C     NF2=NBV0+NBPC+KF
 
      MCTREI.NUM(1,NCTR0+K1)=NC2
      IPT2.NUM(1,K1)=N3
      IPT2.NUM(2,K1)=N4
      IPT2.NUM(3,K1)=N2
C     IPT3.NUM(1,K3+2)=NC2
C     IPT3.NUM(2,K3+2)=NF2
 
      XCOOR((NC2-1)*(IDIM+1)    +1)= (XN3+XN4+XN2)/3.D0
      XCOOR((NC2-1)*(IDIM+1)    +2)= (YN3+YN4+YN2)/3.D0
 
C     XCOOR((NF2-1)*(IDIM+1)    +1)= (XN4+XN2)/2.D0
C     XCOOR((NF2-1)*(IDIM+1)    +2)= (YN4+YN2)/2.D0
 
C     MFACEI.NUM(1,KFM)=NF2
C     MFICEL.NUM(1,KFM)=NC2
C     MFICEL.NUM(2,KFM)=NF2
C     MFICEL.NUM(3,KFM)=NC4
CT3
      K1=K1+1
      KF=KF+1
      KFM=KFM+1
      NC3=NBV0+K1
C     NF3=NBV0+NBPC+KF
 
      MCTREI.NUM(1,NCTR0+K1)=NC3
      IPT2.NUM(1,K1)=N5
      IPT2.NUM(2,K1)=N6
      IPT2.NUM(3,K1)=N4
C     IPT3.NUM(1,K3+3)=NC3
C     IPT3.NUM(2,K3+3)=NF3
 
      XCOOR((NC3-1)*(IDIM+1)    +1)= (XN5+XN6+XN4)/3.D0
      XCOOR((NC3-1)*(IDIM+1)    +2)= (YN5+YN6+YN4)/3.D0
 
C     XCOOR((NF3-1)*(IDIM+1)    +1)= (XN6+XN4)/2.D0
C     XCOOR((NF3-1)*(IDIM+1)    +2)= (YN6+YN4)/2.D0
 
C     MFACEI.NUM(1,KFM)=NF3
C     MFICEL.NUM(1,KFM)=NC3
C     MFICEL.NUM(2,KFM)=NF3
C     MFICEL.NUM(3,KFM)=NC4
CT4
      K1=K1+1
      NC4=NBV0+K1
      MCTREI.NUM(1,NCTR0+K1)=NC4
      IPT2.NUM(1,K1)=N2
      IPT2.NUM(2,K1)=N4
      IPT2.NUM(3,K1)=N6
 
      XCOOR((NC4-1)*(IDIM+1)    +1)= (XN2+XN4+XN6)/3.D0
      XCOOR((NC4-1)*(IDIM+1)    +2)= (YN2+YN4+YN6)/3.D0
 
C     IPT4.NUM(1,K)=NC4
C     IPT4.NUM(2,K)=NF1
C     IPT4.NUM(3,K)=NF2
C     IPT4.NUM(4,K)=NF3
 
C     IPT5.NUM(1,K5+K)=NC1
C     IPT5.NUM(2,K5+K)=NC4
C     IPT5.NUM(3,K5+K)=NF1
 
C     IPT5.NUM(1,K5+K+1)=NC2
C     IPT5.NUM(2,K5+K+1)=NC4
C     IPT5.NUM(3,K5+K+1)=NF2
 
C     IPT5.NUM(1,K5+K+2)=NC3
C     IPT5.NUM(2,K5+K+2)=NC4
C     IPT5.NUM(3,K5+K+2)=NF3
C     K5=K5+2
 
C     IPT6.NUM(1,K6+K)=NC4
C     IPT6.NUM(2,K6+K)=NC1
C     IPT6.NUM(3,K6+K)=NC2
C     IPT6.NUM(4,K6+K)=NC3
C     IPT6.NUM(5,K6+K)=NF1
C     IPT6.NUM(6,K6+K)=NF2
C     IPT6.NUM(7,K6+K)=NF3
 
      NPI=2
 
      XYZ(1,1)=XN2
      XYZ(2,1)=YN2
      XYZ(1,2)=XN6
      XYZ(2,2)=YN6
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)
 
      DF1=(XN2-XN6)**2.D0 + (YN2-YN6)**2.D0
      DF1=SQRT(DF1)
      TX1 = (XN2-XN6)/DF1
      TY1 = (YN2-YN6)/DF1
 
      XYZ(1,1)=XN2
      XYZ(2,1)=YN2
      XYZ(1,2)=XN4
      XYZ(2,2)=YN4
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)
 
      DF2=(XN2-XN4)**2.D0 + (YN2-YN4)**2.D0
      DF2=SQRT(DF2)
      TX2 = (XN4-XN2)/DF2
      TY2 = (YN4-YN2)/DF2
 
      XYZ(1,1)=XN6
      XYZ(2,1)=YN6
      XYZ(1,2)=XN4
      XYZ(2,2)=YN4
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)
 
      DF3=(XN6-XN4)**2.D0 + (YN6-YN4)**2.D0
      DF3=SQRT(DF3)
      TX3 = (XN6-XN4)/DF3
      TY3 = (YN6-YN4)/DF3
 
      DFM=(DF1+DF2+DF3)/3.D0
      AIRM=(AIR1+AIR2+AIR3)/3.D0
C     AIR1=AIRM
C     AIR2=AIRM
C     AIR3=AIRM
C     DF1=DFM
C     DF2=DFM
C     DF3=DFM
 
 
C     VPOCHA(KFM-2,1)=DF1*AIR1
C     VPOCHA(KFM-1,1)=DF2*AIR2
C     VPOCHA(KFM  ,1)=DF3*AIR3
C
C     VPOCHA(KFM-2,2)=-TY1
C     VPOCHA(KFM-1,2)=-TY2
C     VPOCHA(KFM  ,2)=-TY3
C
C     VPOCHA(KFM-2,3)= TX1
C     VPOCHA(KFM-1,3)= TX2
C     VPOCHA(KFM  ,3)= TX3
 
C     MPOVA1.VPOCHA(NCTV0+K,1)=AIR1*DF1
C     MPOVA1.VPOCHA(NCTV0+K,2)=-AIR1*DF1
C     MPOVA1.VPOCHA(NCTV0+K+1,1)=AIR2*DF2
C     MPOVA1.VPOCHA(NCTV0+K+1,2)=-AIR2*DF2
C     MPOVA1.VPOCHA(NCTV0+K+2,1)=AIR3*DF3
C     MPOVA1.VPOCHA(NCTV0+K+2,2)=-AIR3*DF3
C     MPOVA1.VPOCHA(NCTV0+K+3,1)=(AIR1*DF1+AIR2*DF2+AIR3*DF3)
C     MPOVA1.VPOCHA(NCTV0+K+3,2)=-AIR1*DF1
C     MPOVA1.VPOCHA(NCTV0+K+3,3)=-AIR2*DF2
C     MPOVA1.VPOCHA(NCTV0+K+3,4)=-AIR3*DF3
 
      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(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)=NC1
 
      MELSTB.NUM(1,NCSTB+K+2)=NC3
      MELSTB.NUM(2,NCSTB+K+2)=NC4
      MELSTB.NUM(3,NCSTB+K+2)=NC1
      MELSTB.NUM(4,NCSTB+K+2)=NC2
 
      MELSTB.NUM(1,NCSTB+K+3)=NC4
      MELSTB.NUM(2,NCSTB+K+3)=NC1
      MELSTB.NUM(3,NCSTB+K+3)=NC2
      MELSTB.NUM(4,NCSTB+K+3)=NC3
 
 
      H14=AIR1*DF1*GA(1)
      H24=AIR2*DF2*GA(1)
      H34=AIR3*DF3*GA(1)
      H12=(AIR1*DF1+AIR2*DF2)*0.5D0*EPS(1)
      H13=(AIR1*DF1+AIR3*DF3)*0.5D0*EPS(1)
      H23=(AIR2*DF2+AIR3*DF3)*0.5D0*EPS(1)
 
      MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+EPSD(1)
      MPOVA1.VPOCHA(NCTV0+K,2)=-H12
      MPOVA1.VPOCHA(NCTV0+K,3)=-H13
      MPOVA1.VPOCHA(NCTV0+K,4)=-H14
      MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+EPSD(1)
      MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
      MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
      MPOVA1.VPOCHA(NCTV0+K+1,4)=-H12
      MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+EPSD(1)
      MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
      MPOVA1.VPOCHA(NCTV0+K+2,3)=-H13
      MPOVA1.VPOCHA(NCTV0+K+2,4)=-H23
      MPOVA1.VPOCHA(NCTV0+K+3,1)=-(H14+H24+H34)+EPSD(1)
      MPOVA1.VPOCHA(NCTV0+K+3,2)=-H14
      MPOVA1.VPOCHA(NCTV0+K+3,3)=-H24
      MPOVA1.VPOCHA(NCTV0+K+3,4)=-H34
      KPOC=1
      NCTV0=NCTV0+3
      NCSTB=NCSTB+3
 
 206  CONTINUE
C     SEGDES IPT1,IPT2,IPT3,IPT4
      SEGDES      IPT2
      GO TO 1
 
C**************************************************************************
 
C QUA8 -> 4 QUA4
 108  CONTINUE
 
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
      NBP9=NBEL
C     NBPF=NBEL*4
      NBPF=0
      NBPC=NBEL*4
 
C     N=NBPF+VPOCHA(/1)
C     NC=3
C     SEGADJ MPOVAL
      N=NBPC+MPOVA1.VPOCHA(/1)
      NC=4
      NCTV0=MPOVA1.VPOCHA(/1)
      SEGADJ MPOVA1
 
      NBV0=nbpts
      NBPTS=NBV0+NBPF+NBPC+NBP9
      SEGADJ MCOORD
 
      NBELEM=4*NBEL
      NBNN=4
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=8
      IM=IM+1
      ITAB(IM)=IPT2
 
C     IF(IPT7.EQ.0)THEN
C     NBELEM=4*NBEL
C     NBNN=5
C     NBSOUS=0
C     NBREF=0
C     K7=0
C     SEGINI IPT7
C     IPT7.ITYPEL=9
C     ELSE
C     K7=IPT7.NUM(/2)
C     NBELEM=IPT7.NUM(/2)+4*NBEL
C     NBNN=5
C     NBSOUS=0
C     NBREF=0
C     SEGADJ IPT7
C     ENDIF
 
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=4
C     write(6,*)' KTRSF : ',nbnn,nbelem
      NBSOUS=0
      NBREF=0
      SEGADJ MELSTB
      KSTB=1
 
C     NBELEM=0
C     NBNN=0
C     NBS=MELTFI.LISOUS(/1)
C     NBSOUS=NBS+1
C     NBREF=0
C     SEGADJ MELTFI
C     KELTFI=1
C     NBELEM=4*NBEL
C     NBNN=3
C     NBSOUS=0
C     NBREF=0
C     SEGINI IPT3
C     IPT3.ITYPEL=4
C     MELTFI.LISOUS(NBS+1)=IPT3
 
C     KFM=MFACEI.NUM(/2)
C     NBNN=MFACEI.NUM(/1)
C     NBELEM=MFACEI.NUM(/2)+NBPF
C     SEGADJ MFACEI
C     KFACEI=1
 
C     NBNN=MFICEL.NUM(/1)
C     NBELEM=MFICEL.NUM(/2)+NBPF
C     SEGADJ MFICEL
C     KFICEL=1
 
      CALL KALPBG('SEG2    ','FONFORM0',IZFFM)
      IF(IZFFM.EQ.0)CALL ARRET(0)
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      NPG=GR(/3)
      NES=GR(/1)
 
      K1=0
      KF=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+NBPF+NBPC+K
 
      XN1=XCOOR((N1-1)*(IDIM+1)    +1)
      YN1=XCOOR((N1-1)*(IDIM+1)    +2)
      XN2=XCOOR((N2-1)*(IDIM+1)    +1)
      YN2=XCOOR((N2-1)*(IDIM+1)    +2)
      XN3=XCOOR((N3-1)*(IDIM+1)    +1)
      YN3=XCOOR((N3-1)*(IDIM+1)    +2)
      XN4=XCOOR((N4-1)*(IDIM+1)    +1)
      YN4=XCOOR((N4-1)*(IDIM+1)    +2)
      XN5=XCOOR((N5-1)*(IDIM+1)    +1)
      YN5=XCOOR((N5-1)*(IDIM+1)    +2)
      XN6=XCOOR((N6-1)*(IDIM+1)    +1)
      YN6=XCOOR((N6-1)*(IDIM+1)    +2)
      XN7=XCOOR((N7-1)*(IDIM+1)    +1)
      YN7=XCOOR((N7-1)*(IDIM+1)    +2)
      XN8=XCOOR((N8-1)*(IDIM+1)    +1)
      YN8=XCOOR((N8-1)*(IDIM+1)    +2)
      XN9=(XN1+XN2+XN3+XN4+XN5+XN6+XN7+XN8)/8.D0
      YN9=(YN1+YN2+YN3+YN4+YN5+YN6+YN7+YN8)/8.D0
      DX=ABS(XN3-XN7)+ABS(XN1-XN5)
      DY=ABS(YN3-YN7)+ABS(YN1-YN5)
      XCOOR((N9-1)*(IDIM+1)    +1)=XN9+DX*COEF
      XCOOR((N9-1)*(IDIM+1)    +2)=YN9+DY*COEF
 
CQ1
      K1=K1+1
      KF=KF+1
      NC1=NBV0+K1
C     NF1=NBV0+NBPC+KF
 
      MCTREI.NUM(1,NCTR0+K1)=NC1
      IPT2.NUM(1,K1)=N1
      IPT2.NUM(2,K1)=N2
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N8
 
      XCOOR((NC1-1)*(IDIM+1)    +1)= (XN1+XN2+XN9+XN8)/4.D0
      XCOOR((NC1-1)*(IDIM+1)    +2)= (YN1+YN2+YN9+YN8)/4.D0
 
C     XCOOR((NF1-1)*(IDIM+1)    +1)= (XN2+XN9)/2.D0
C     XCOOR((NF1-1)*(IDIM+1)    +2)= (YN2+YN9)/2.D0
 
CQ2
      K1=K1+1
      KF=KF+1
      NC2=NBV0+K1
C     NF2=NBV0+NBPC+KF
 
      MCTREI.NUM(1,NCTR0+K1)=NC2
      IPT2.NUM(1,K1)=N3
      IPT2.NUM(2,K1)=N4
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N2
 
      XCOOR((NC2-1)*(IDIM+1)    +1)= (XN3+XN4+XN9+XN2)/4.D0
      XCOOR((NC2-1)*(IDIM+1)    +2)= (YN3+YN4+YN9+YN2)/4.D0
 
C     XCOOR((NF2-1)*(IDIM+1)    +1)= (XN4+XN9)/2.D0
C     XCOOR((NF2-1)*(IDIM+1)    +2)= (YN4+YN9)/2.D0
 
CQ3
      K1=K1+1
      KF=KF+1
      NC3=NBV0+K1
C     NF3=NBV0+NBPC+KF
 
      MCTREI.NUM(1,NCTR0+K1)=NC3
      IPT2.NUM(1,K1)=N5
      IPT2.NUM(2,K1)=N6
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N4
 
      XCOOR((NC3-1)*(IDIM+1)    +1)= (XN5+XN6+XN9+XN4)/4.D0
      XCOOR((NC3-1)*(IDIM+1)    +2)= (YN5+YN6+YN9+YN4)/4.D0
 
C     XCOOR((NF3-1)*(IDIM+1)    +1)= (XN6+XN9)/2.D0
C     XCOOR((NF3-1)*(IDIM+1)    +2)= (YN6+YN9)/2.D0
 
CQ4
      K1=K1+1
      KF=KF+1
      NC4=NBV0+K1
C     NF4=NBV0+NBPC+KF
 
      MCTREI.NUM(1,NCTR0+K1)=NC4
      IPT2.NUM(1,K1)=N7
      IPT2.NUM(2,K1)=N8
      IPT2.NUM(3,K1)=N9
      IPT2.NUM(4,K1)=N6
 
      XCOOR((NC4-1)*(IDIM+1)    +1)= (XN7+XN8+XN9+XN6)/4.D0
      XCOOR((NC4-1)*(IDIM+1)    +2)= (YN7+YN8+YN9+YN6)/4.D0
 
C     XCOOR((NF4-1)*(IDIM+1)    +1)= (XN8+XN9)/2.D0
C     XCOOR((NF4-1)*(IDIM+1)    +2)= (YN9+YN9)/2.D0
 
C     KFM=KFM+1
C     MFACEI.NUM(1,KFM)=NF1
C     MFICEL.NUM(1,KFM)=NC1
C     MFICEL.NUM(2,KFM)=NF1
C     MFICEL.NUM(3,KFM)=NC2
 
C     KFM=KFM+1
C     MFACEI.NUM(1,KFM)=NF2
C     MFICEL.NUM(1,KFM)=NC2
C     MFICEL.NUM(2,KFM)=NF2
C     MFICEL.NUM(3,KFM)=NC3
 
C     KFM=KFM+1
C     MFACEI.NUM(1,KFM)=NF3
C     MFICEL.NUM(1,KFM)=NC3
C     MFICEL.NUM(2,KFM)=NF3
C     MFICEL.NUM(3,KFM)=NC4
 
C     KFM=KFM+1
C     MFACEI.NUM(1,KFM)=NF4
C     MFICEL.NUM(1,KFM)=NC4
C     MFICEL.NUM(2,KFM)=NF4
C     MFICEL.NUM(3,KFM)=NC1
 
C     K4=4*(K-1)
C     IPT3.NUM(1,K4+1)=NC1
C     IPT3.NUM(2,K4+1)=NF1
C     IPT3.NUM(3,K4+1)=NF4
 
C     IPT3.NUM(1,K4+2)=NC2
C     IPT3.NUM(2,K4+2)=NF2
C     IPT3.NUM(3,K4+2)=NF1
 
C     IPT3.NUM(1,K4+3)=NC3
C     IPT3.NUM(2,K4+3)=NF3
C     IPT3.NUM(3,K4+3)=NF2
 
C     IPT3.NUM(1,K4+4)=NC4
C     IPT3.NUM(2,K4+4)=NF4
C     IPT3.NUM(3,K4+4)=NF3
 
C     IPT7.NUM(1,K7+K)=NC1
C     IPT7.NUM(2,K7+K)=NC2
C     IPT7.NUM(3,K7+K)=NC4
C     IPT7.NUM(4,K7+K)=NF1
C     IPT7.NUM(5,K7+K)=NF4
 
C     IPT7.NUM(1,K7+K+1)=NC2
C     IPT7.NUM(2,K7+K+1)=NC3
C     IPT7.NUM(3,K7+K+1)=NC1
C     IPT7.NUM(4,K7+K+1)=NF2
C     IPT7.NUM(5,K7+K+1)=NF1
 
C     IPT7.NUM(1,K7+K+2)=NC3
C     IPT7.NUM(2,K7+K+2)=NC4
C     IPT7.NUM(3,K7+K+2)=NC2
C     IPT7.NUM(4,K7+K+2)=NF3
C     IPT7.NUM(5,K7+K+2)=NF2
 
C     IPT7.NUM(1,K7+K+3)=NC4
C     IPT7.NUM(2,K7+K+3)=NC1
C     IPT7.NUM(3,K7+K+3)=NC3
C     IPT7.NUM(4,K7+K+3)=NF4
C     IPT7.NUM(5,K7+K+3)=NF3
C     K7=K7+3
 
      NPI=2
 
      XYZ(1,1)=XN2
      XYZ(2,1)=YN2
      XYZ(1,2)=XN9
      XYZ(2,2)=YN9
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1)
 
      DF1=(XN2-XN9)**2.D0 + (YN2-YN9)**2.D0
      DF1=SQRT(DF1)
      TX1 = (XN2-XN9)/DF1
      TY1 = (YN2-YN9)/DF1
 
      XYZ(1,1)=XN4
      XYZ(2,1)=YN4
      XYZ(1,2)=XN9
      XYZ(2,2)=YN9
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2)
 
      DF2=(XN4-XN9)**2.D0 + (YN4-YN9)**2.D0
      DF2=SQRT(DF2)
      TX2 = (XN4-XN9)/DF2
      TY2 = (YN4-YN9)/DF2
 
      XYZ(1,1)=XN6
      XYZ(2,1)=YN6
      XYZ(1,2)=XN9
      XYZ(2,2)=YN9
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3)
 
      DF3=(XN6-XN9)**2.D0 + (YN6-YN9)**2.D0
      DF3=SQRT(DF3)
      TX3 = (XN6-XN9)/DF3
      TY3 = (YN6-YN9)/DF3
 
      XYZ(1,1)=XN8
      XYZ(2,1)=YN8
      XYZ(1,2)=XN9
      XYZ(2,2)=YN9
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR4)
 
      DF4=(XN8-XN9)**2.D0 + (YN8-YN9)**2.D0
      DF4=SQRT(DF4)
      TX4 = (XN8-XN9)/DF4
      TY4 = (YN8-YN9)/DF4
 
      DFM=(DF1+DF2+DF3+DF4)/4.D0
C?    DF1=1.D0
C?    DF2=1.D0
C?    DF3=1.D0
C?    DF4=1.D0
      AIRM=(AIR1+AIR2+AIR3+AIR4)/4.D0
C?    AIR1=AIRM
C?    AIR2=AIRM
C?    AIR3=AIRM
C?    AIR4=AIRM
 
C     VPOCHA(KFM-3,1)=DF1*AIR1
C     VPOCHA(KFM-2,1)=DF2*AIR2
C     VPOCHA(KFM-1,1)=DF3*AIR3
C     VPOCHA(KFM  ,1)=DF4*AIR4
C
C     VPOCHA(KFM-3,2)=-TY1
C     VPOCHA(KFM-2,2)=-TY2
C     VPOCHA(KFM-1,2)=-TY3
C     VPOCHA(KFM  ,2)=-TY4
 
C     VPOCHA(KFM-3,3)= TX1
C     VPOCHA(KFM-2,3)= TX2
C     VPOCHA(KFM-1,3)= TX3
C     VPOCHA(KFM  ,3)= TX4
 
C?    MPOVA1.VPOCHA(NCTV0+K,1)=AIR1+AIR4
C?    MPOVA1.VPOCHA(NCTV0+K,2)=-AIR1
C?    MPOVA1.VPOCHA(NCTV0+K,3)=-AIR4
C?    MPOVA1.VPOCHA(NCTV0+K+1,1)=AIR2+AIR1
C?    MPOVA1.VPOCHA(NCTV0+K+1,2)=-AIR2
C?    MPOVA1.VPOCHA(NCTV0+K+1,3)=-AIR1
C?    MPOVA1.VPOCHA(NCTV0+K+2,1)=AIR3+AIR2
C?    MPOVA1.VPOCHA(NCTV0+K+2,2)=-AIR3
C?    MPOVA1.VPOCHA(NCTV0+K+2,3)=-AIR2
C?    MPOVA1.VPOCHA(NCTV0+K+3,1)=AIR4+AIR3
C?    MPOVA1.VPOCHA(NCTV0+K+3,2)=-AIR4
C?    MPOVA1.VPOCHA(NCTV0+K+3,3)=-AIR3
 
      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(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)=NC1
 
      MELSTB.NUM(1,NCSTB+K+2)=NC3
      MELSTB.NUM(2,NCSTB+K+2)=NC4
      MELSTB.NUM(3,NCSTB+K+2)=NC1
      MELSTB.NUM(4,NCSTB+K+2)=NC2
 
      MELSTB.NUM(1,NCSTB+K+3)=NC4
      MELSTB.NUM(2,NCSTB+K+3)=NC1
      MELSTB.NUM(3,NCSTB+K+3)=NC2
      MELSTB.NUM(4,NCSTB+K+3)=NC3
 
 
      H12=AIR1*DF1*GA(2)
      H13=AIRM*DFM*EPS(2)
      H14=AIR4*DF4*GA(2)
      H23=AIR2*DF2*GA(2)
      H24=AIRM*DFM*EPS(2)
      H34=AIR3*DF3*GA(2)
 
      MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14
      MPOVA1.VPOCHA(NCTV0+K,2)=-H12
      MPOVA1.VPOCHA(NCTV0+K,3)=-H13
      MPOVA1.VPOCHA(NCTV0+K,4)=-H14
      MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24
      MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23
      MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24
      MPOVA1.VPOCHA(NCTV0+K+1,4)=-H12
      MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34
      MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34
      MPOVA1.VPOCHA(NCTV0+K+2,3)=-H13
      MPOVA1.VPOCHA(NCTV0+K+2,4)=-H23
      MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34
      MPOVA1.VPOCHA(NCTV0+K+3,2)=-H14
      MPOVA1.VPOCHA(NCTV0+K+3,3)=-H24
      MPOVA1.VPOCHA(NCTV0+K+3,4)=-H34
      KPOC=1
      NCTV0=NCTV0+3
      NCSTB=NCSTB+3
 
 208  CONTINUE
C     SEGDES IPT1,IPT2,IPT3
      SEGDES IPT2
      GO TO 1
 
C**************************************************************************
 
C SEG3 -> 2 SEG2
 103  CONTINUE
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
 
      NBPC=NBEL*2
 
      NBV0=nbpts
      NBPTS=NBV0+NBPC
      SEGADJ MCOORD
 
      NBELEM=2*NBEL
      NBNN=2
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      IPT2.ITYPEL=2
      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
 
      K1=0
      DO 203 K=1,NBEL
      N1=IPT1.NUM(1,K)
      N2=IPT1.NUM(2,K)
      N3=IPT1.NUM(3,K)
      XN1=XCOOR((N1-1)*(IDIM+1)    +1)
      YN1=XCOOR((N1-1)*(IDIM+1)    +2)
      XN2=XCOOR((N2-1)*(IDIM+1)    +1)
      YN2=XCOOR((N2-1)*(IDIM+1)    +2)
      XN3=XCOOR((N3-1)*(IDIM+1)    +1)
      YN3=XCOOR((N3-1)*(IDIM+1)    +2)
      XNC1=(XN1+XN2)/2.D0
      YNC1=(YN1+YN2)/2.D0
      XNC2=(XN2+XN3)/2.D0
      YNC2=(YN2+YN3)/2.D0
 
 
CS1
      K1=K1+1
      NC1=NBV0+K1
      MCTREI.NUM(1,NCTR0+K1)=NC1
      XCOOR((NC1-1)*(IDIM+1)    +1)=XNC1
      XCOOR((NC1-1)*(IDIM+1)    +2)=YNC1
 
      IPT2.NUM(1,K1)=N1
      IPT2.NUM(2,K1)=N2
 
CS2
      K1=K1+1
      NC2=NBV0+K1
      MCTREI.NUM(1,NCTR0+K1)=NC2
      XCOOR((NC2-1)*(IDIM+1)    +1)=XNC2
      XCOOR((NC2-1)*(IDIM+1)    +2)=YNC2
 
      IPT2.NUM(1,K1)=N2
      IPT2.NUM(2,K1)=N3
 203  CONTINUE
      SEGDES IPT1,IPT2
      GO TO 1
 
 
 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     IF(IPT5.EQ.0.AND.IPT7.NE.0)THEN
C     CALL ECMO(MTBT0,'MELELI','MAILLAGE',IPT7  )
C     ELSEIF(IPT5.NE.0)THEN
C     NBELEM=0
C     NBNN=0
C     NBREF=0
C     NBSOUS=2
C     IF(IPT7.NE.0)NBSOUS=3
C     SEGINI MELELI
C     MELELI.LISOUS(1)=IPT5
C     MELELI.LISOUS(2)=IPT6
C     IF(IPT7.NE.0)MELELI.LISOUS(3)=IPT7
C     CALL ECMO(MTBT0,'MELELI','MAILLAGE',MELELI)
C     ENDIF
 
C Connectivités de la matrice de stabilisation
 
      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
 
C     IF(KFACEI.NE.0)THEN
C     CALL ECMO(MTBT0,'MFACEI','MAILLAGE',MFACEI)
C     SEGDES MFACEI
C     IGEOC=MFACEI
C     CALL ECMO(MTBT0,'MCHPOF','CHPOINT',MCHPOI)
C     ELSE
C     SEGSUP MFACEI
C     MFACEI=0
C     ENDIF
 
C     IF(KFICEL.NE.0)THEN
C     CALL ECMO(MTBT0,'MFICEL','MAILLAGE',MFICEL)
C     SEGDES MFICEL
C     ELSE
C     SEGSUP MFICEL
C     MFICEL=0
C     ENDIF
 
C     IF(KELTFI.NE.0)THEN
C     CALL ECMO(MTBT0,'MELTFI','MAILLAGE',MELTFI)
C     SEGDES MELTFI
C     ELSE
C     SEGSUP MELTFI
C     MELTFI=0
C     ENDIF
 
 
      SEGDES MELEME,MACRO
 
      RETURN
      END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

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