C KDOM3A SOURCE CB215821 20/11/25 13:31:05 10792 SUBROUTINE KDOM3A(MTAB,IPT1) C C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : KDOM3A C C DESCRIPTION : Subroutine called by KDOM2A C Axial-symmetric case, SEG3 C We compute C MTAB . 'XXVOLUM' C MTAB . 'CENTRE' C and we change the position for the central points C of MELEMQ C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) C C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF C C************************************************************************ C C INPUT/OUTPUT : MTAB : domaine table C IPT1 : elementary QUAF mesh of SEG3 C C************************************************************************ C C Created the 24/02/04 C C**** Variables de COOPTIO C C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM, IFICLE, IPREFI CC & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV, IREFOR, ISAFOR C C IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMELEME -INC SMLMOTS -INC SMCHPOI INTEGER MTAB, NBEL,NBELEM, NBSOUS, NBREF, NBNN, IELEM, JGN, JGM & , NN1, NN2, NN3, IEL, IGEOM POINTEUR MELMAI.MELEME, MELCEN.MELEME REAL*8 X1, Y1, X3, Y3, VOLU, X2, Y2 CHARACTER*8 TYPI C NBEL=IPT1.NUM(/2) C C**** 'MAILLAGE' C 'CENTRE' (with bad positions) C C Initialisation C NBELEM=NBEL NBSOUS=0 NBREF=0 NBNN=2 SEGINI MELMAI MELMAI.ITYPEL=2 C NBELEM=NBEL NBNN=1 NBSOUS=0 NBREF=0 SEGINI MELCEN MELCEN.ITYPEL=1 C C**** Filling C DO IELEM=1,NBELEM,1 MELMAI.NUM(1,IELEM)=IPT1.NUM(1,IELEM) MELMAI.NUM(2,IELEM)=IPT1.NUM(3,IELEM) MELMAI.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM) MELCEN.NUM(1,IELEM)=IPT1.NUM(2,IELEM) MELCEN.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM) ENDDO CALL ECMO(MTAB,'MAILLAGE','MAILLAGE',MELMAI) CALL ECMO(MTAB,'CENTRE','MAILLAGE',MELCEN) SEGDES MELCEN SEGDES MELMAI C C**** Volume C TYPI='CENTRE ' JGN=4 JGM=1 SEGINI MLMOTS MLMOTS.MOTS(1)='SCAL' CALL KRCHP1(TYPI,MELCEN,MCHPOI,MLMOTS) IF(IERR.NE.0) GOTO 9999 SEGSUP MLMOTS CALL ECMO(MTAB,'XXVOLUM','CHPOINT',MCHPOI) IF(IERR.NE.0) GOTO 9999 CALL LICHT(MCHPOI,MPOVAL,TYPI,IGEOM) IF(IERR.NE.0) GOTO 9999 C SEGACT MPOVAL C C DO IEL=1,NBEL,1 C NN1=IPT1.NUM(1,IEL) NN2=IPT1.NUM(2,IEL) NN3=IPT1.NUM(3,IEL) X1=XCOOR((NN1-1)*(IDIM+1)+1) Y1=XCOOR((NN1-1)*(IDIM+1)+2) X3=XCOOR((NN3-1)*(IDIM+1)+1) Y3=XCOOR((NN3-1)*(IDIM+1)+2) C CALL KDOM3B(X1,Y1,X3,Y3,VOLU,X2,Y2) C MPOVAL.VPOCHA(IEL,1)=VOLU C C XCOOR((NN2-1)*(IDIM+1)+1)=X2 XCOOR((NN2-1)*(IDIM+1)+2)=Y2 C ENDDO C SEGDES MPOVAL C 9999 RETURN C END