C KLNO SOURCE GOUNAND 25/11/12 21:15:23 12399 SUBROUTINE KLNO IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C************************************************************************* C Operateur KLNO C C Objet : transforme un CHAMPOINT CENTRE en un CHAMPOINT SOMMET C C SYNTAXE : CHPS = KLNO OBJM CHPC (MOTCLE (GRAD LIMI)); C C OBJM : Objet modèle 'Navier_Stokes' C : a la rigueur table DOMAINE C CHPC : CHAMPOINT CENTRE C CHPS : CHAMPOINT SOMMET C C************************************************************************* -INC SMELEME POINTEUR MELEMS.MELEME,MELEMC.MELEME,MELEP1.MELEME POINTEUR IGEOMB.MELEME -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMCOORD -INC CCGEOME -INC SMMODEL -INC SMCHPOI POINTEUR IZB.MCHPOI,IZBB.MPOVAL POINTEUR IZD.MCHPOI,IZDD.MPOVAL -INC SMLENTI POINTEUR IZIPAP.MLENTI,IZIPAD.MLENTI -INC SIZFFB POINTEUR IZF1.IZFFM DIMENSION ITABO(4) integer IP CHARACTER*8 TYPE,TYPC,NOM0,TYPSPG, CHAI CHARACTER*8 LISMO(5) DATA LISMO/'CENTRE ','CENTREP0','CENTREP1','MSOMMET','VOLUMF '/ IP=0 SEGACT MCOORD C*********************************************************************** C**** Case VF ********************************************************** C*********************************************************************** CALL QUETYP(TYPE,1,IRET) IF(IERR.NE.0)GOTO 9999 IF(TYPE .EQ. 'MOT ')THEN CALL LIRCHA(CHAI,1,IRET) IF(IERR.NE.0)GOTO 9999 IF(CHAI.EQ. 'VF ')THEN C C CHPOINT to project C CALL LIROBJ('CHPOINT ',IZB,1,IRET) CALL ACTOBJ('CHPOINT ',IZB,1) IF(IERR.NE.0)GOTO 9999 SEGACT IZB IF(IZB.IPCHP(/1).NE.1) THEN CALL ERREUR(920) C Erreur dans le partitionnement GOTO 9999 ENDIF C C Domain table C CALL LIROBJ('TABLE ',MTABD,1,IRET) IF(IERR.NE.0)GOTO 9999 C C Gradient C CALL LIROBJ('CHPOINT ',MCHPO1,1,IRET) CALL ACTOBJ('CHPOINT ',MCHPO1,1) IF(IERR.NE.0)GOTO 9999 C C Limiter C CALL LIROBJ('CHPOINT ',MCHPO2,1,IRET) CALL ACTOBJ('CHPOINT ',MCHPO2,1) IF(IERR.NE.0)GOTO 9999 C C Computation C CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD) IF(IERR.NE.0)GOTO 9999 C C We write the result C CALL ACTOBJ('CHPOINT ',MCHPOI,1) CALL ECROBJ('CHPOINT ',MCHPOI) GOTO 9999 ELSE C C******* I apologize myself and I give back the mot C CALL REFUS ENDIF ENDIF C*********************************************************************** C**** End of the case VF *********************************************** C*********************************************************************** C IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 CALL LIRCHA(CHAI,0,IRET) IF(IRET.EQ.0)THEN TYPSPG='CENTRE' ELSE CALL REFUS CALL LIRMOT(LISMO,5,IP,1) IF(IP.EQ.0)RETURN TYPSPG=LISMO(IP) ENDIF IF(TYPSPG.EQ.'VOLUMF')GO TO 51 CALL LIROBJ('CHPOINT ',IZB,1,IRETOU) CALL ACTOBJ('CHPOINT ',IZB,1) IF(IRETOU.EQ.0)RETURN * * Verification du CHPOINT * SEGACT IZB IF(IZB.IPCHP(/1).NE.1)THEN C% Erreur dans le partitionnement CALL ERREUR(920) RETURN ENDIF CALL LIROBJ('MMODEL ',MMODEL,0,IRET) IF(IRET.EQ.1)THEN CALL ACTOBJ('MMODEL ',MMODEL,1) * * Verification de l'objet modele 'Navier-Stokes' * C*** N1=KMODEL(/1) DO 41 L=1,N1 IMODEL=KMODEL(L) IF(FORMOD(1).NE.'NAVIER_STOKES')THEN IF(FORMOD(1).NE.'DARCY')THEN C% On veut un modèle de type %m1:16 . MOTERR( 1:16) = 'NAVIER_STOKES ' CALL ERREUR(719) RETURN ENDIF ENDIF 41 CONTINUE CALL LEKMOD(MMODEL,MTABD,INEFMD) C INEFMD=1 LINE =2 MACRO =3 QUADRATIQUE =4 LINB ELSE CALL LIROBJ('TABLE ',MTABD,1,IRET) IF(IRET.EQ.0)RETURN ENDIF C------------------ Traitement du cas VOLUMF ---------------------------- 51 CONTINUE IF (IP .EQ. 5) THEN CALL LIROBJ('CHPOINT ',MCHPO1,1,IRETOU) CALL ACTOBJ('CHPOINT ',MCHPO1,1) IF(IRETOU.EQ.0) THEN C% Information manquante (objet CHPOINT) : pas de définition de la densité CALL ERREUR(839) RETURN ENDIF CALL LIROBJ('CHPOINT ',MCHPO2,1,IRETOU) CALL ACTOBJ('CHPOINT ',MCHPO2,1) IF(IRETOU.EQ.0) THEN C% Information manquante (objet CHPOINT) : pas de définition de la densité CALL ERREUR(839) RETURN ENDIF CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD) GOTO 360 ENDIF C------------------ Traitement des cas CENTRE CENTREP0 CENTREP1 --------- 52 CONTINUE C DEUPI=1.D0 IF(IAXI.NE.0)DEUPI=2.D0*XPI CALL LICHTL(IZB,IZBB,TYPC,IGEOMB) NC=IZBB.VPOCHA(/2) N=IZBB.VPOCHA(/1) SEGINI MPOVA3 SEGACT IGEOMB CALL LEKTAB(MTABD,TYPSPG,MELEMC) IF (IERR.NE.0) RETURN CALL KRIPAD(IGEOMB,IZIPAP) CALL VERPAD(IZIPAP,MELEMC,IRET) IF(IRET.NE.0)THEN C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = TYPSPG MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF CALL LEKTAB(MTABD,'SOMMET',MELEMS) CALL KRIPAD(MELEMS,IZIPAD) TYPE='SOMMET' CALL CRCHPT(TYPE,MELEMS,NC,1,MCHPOI) CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM) CALL LEKTAB(MTABD,'MAILLAGE',MELEME) C------------ Cas MSOMMET ------------------------------------------------ C------------ Cas MSOMMET ------------------------------------------------ IF(TYPSPG.EQ.'MSOMMET')THEN IF(INEFMD.EQ.2)THEN CALL LEKTAB(MTABD,'MACRO1',MELEME) ENDIF CALL VERPAD(IZIPAD,MELEMC,IRET) IF(IRET.NE.0)THEN C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique MOTERR(1: 8) = TYPSPG MOTERR(9:16) = 'CHPOINT ' CALL ERREUR(788) RETURN ENDIF C On place les valeurs aux sommets de l'élément DO 741 I=1,N DO 7411 M=1,NC iu = IZIPAD.LECT(MELEMC.NUM(1,I)) VPOCHA(iu,M)=IZBB.VPOCHA(I,M) 7411 CONTINUE 741 CONTINUE IF(INEFMD.EQ.1)GO TO 790 SEGACT MELEME NBSOUS=LISOUS(/1) DO 742 L=1,(MAX(1,NBSOUS)) IPT1=MELEME IF(NBSOUS.NE.0)IPT1=LISOUS(L) SEGACT IPT1 NBELEM =IPT1.NUM(/2) NBNN =IPT1.NUM(/1) IF(IPT1.ITYPEL.EQ.6)THEN C write(6,*)' TRI6' DO 643 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) DO 645 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 645 CONTINUE 643 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.7)THEN C write(6,*)' TRI7' DO 743 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) DO 745 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu7,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0 745 CONTINUE 743 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.11)THEN C write(6,*)' QUA9' DO 943 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) DO 945 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5 VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu9,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ & VPOCHA(iu7,M))/4.D0 945 CONTINUE 943 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.33)THEN C write(6,*)' CU27' DO 2743 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) iu10= IZIPAD.LECT(IPT1.NUM(10,K)) iu11= IZIPAD.LECT(IPT1.NUM(11,K)) iu12= IZIPAD.LECT(IPT1.NUM(12,K)) iu13= IZIPAD.LECT(IPT1.NUM(13,K)) iu14= IZIPAD.LECT(IPT1.NUM(14,K)) iu15= IZIPAD.LECT(IPT1.NUM(15,K)) iu16= IZIPAD.LECT(IPT1.NUM(16,K)) iu17= IZIPAD.LECT(IPT1.NUM(17,K)) iu18= IZIPAD.LECT(IPT1.NUM(18,K)) iu19= IZIPAD.LECT(IPT1.NUM(19,K)) iu20= IZIPAD.LECT(IPT1.NUM(20,K)) iu21= IZIPAD.LECT(IPT1.NUM(21,K)) iu22= IZIPAD.LECT(IPT1.NUM(22,K)) iu23= IZIPAD.LECT(IPT1.NUM(23,K)) iu24= IZIPAD.LECT(IPT1.NUM(24,K)) iu25= IZIPAD.LECT(IPT1.NUM(25,K)) iu26= IZIPAD.LECT(IPT1.NUM(26,K)) iu27= IZIPAD.LECT(IPT1.NUM(27,K)) DO 2745 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5 VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu25,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ & VPOCHA(iu7,M))/4.D0 VPOCHA(iu14,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M))*0.5 VPOCHA(iu16,M)=(VPOCHA(iu15,M)+VPOCHA(iu17,M))*0.5 VPOCHA(iu18,M)=(VPOCHA(iu17,M)+VPOCHA(iu19,M))*0.5 VPOCHA(iu20,M)=(VPOCHA(iu19,M)+VPOCHA(iu13,M))*0.5 VPOCHA(iu26,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+ & VPOCHA(iu19,M))/4.D0 VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5 VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu15,M))*0.5 VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu17,M))*0.5 VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu19,M))*0.5 VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu15,M)+ & VPOCHA(iu13,M))/4.D0 VPOCHA(iu22,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu17,M)+ & VPOCHA(iu15,M))/4.D0 VPOCHA(iu23,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M)+VPOCHA(iu17,M)+ & VPOCHA(iu19,M))/4.D0 VPOCHA(iu24,M)=(VPOCHA(iu1 ,M)+VPOCHA(iu7,M)+VPOCHA(iu19,M)+ & VPOCHA(iu13,M))/4.D0 VPOCHA(iu27,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ &VPOCHA(iu7,M)+VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+ & VPOCHA(iu19,M))/8.D0 2745 CONTINUE 2743 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.34)THEN C write(6,*)' PR21' DO 2143 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) iu10= IZIPAD.LECT(IPT1.NUM(10,K)) iu11= IZIPAD.LECT(IPT1.NUM(11,K)) iu12= IZIPAD.LECT(IPT1.NUM(12,K)) iu13= IZIPAD.LECT(IPT1.NUM(13,K)) iu14= IZIPAD.LECT(IPT1.NUM(14,K)) iu15= IZIPAD.LECT(IPT1.NUM(15,K)) iu16= IZIPAD.LECT(IPT1.NUM(16,K)) iu17= IZIPAD.LECT(IPT1.NUM(17,K)) iu18= IZIPAD.LECT(IPT1.NUM(18,K)) iu19= IZIPAD.LECT(IPT1.NUM(19,K)) iu20= IZIPAD.LECT(IPT1.NUM(20,K)) iu21= IZIPAD.LECT(IPT1.NUM(21,K)) DO 2145 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0 VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5 VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5 VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu20,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/3.D0 VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5 VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5 VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+ & VPOCHA(iu10,M))/4.D0 VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+ & VPOCHA(iu14,M))/4.D0 VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+ & VPOCHA(iu10,M))/4.D0 VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ & VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/6.D0 2145 CONTINUE 2143 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.40)THEN C write(6,*)' PR18' DO 1843 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) iu10= IZIPAD.LECT(IPT1.NUM(10,K)) iu11= IZIPAD.LECT(IPT1.NUM(11,K)) iu12= IZIPAD.LECT(IPT1.NUM(12,K)) iu13= IZIPAD.LECT(IPT1.NUM(13,K)) iu14= IZIPAD.LECT(IPT1.NUM(14,K)) iu15= IZIPAD.LECT(IPT1.NUM(15,K)) iu16= IZIPAD.LECT(IPT1.NUM(16,K)) iu17= IZIPAD.LECT(IPT1.NUM(17,K)) iu18= IZIPAD.LECT(IPT1.NUM(18,K)) DO 1845 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5 VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5 VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5 VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5 VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+ & VPOCHA(iu10,M))/4.D0 VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+ & VPOCHA(iu14,M))/4.D0 VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+ & VPOCHA(iu10,M))/4.D0 1845 CONTINUE 1843 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.35)THEN C write(6,*)' TE15' DO 1543 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) iu10= IZIPAD.LECT(IPT1.NUM(10,K)) iu11= IZIPAD.LECT(IPT1.NUM(11,K)) iu12= IZIPAD.LECT(IPT1.NUM(12,K)) iu13= IZIPAD.LECT(IPT1.NUM(13,K)) iu14= IZIPAD.LECT(IPT1.NUM(14,K)) iu15= IZIPAD.LECT(IPT1.NUM(15,K)) DO 1545 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu11,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0 VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu12,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu10,M))/3.D0 VPOCHA(iu13,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu10,M))/3.D0 VPOCHA(iu14,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu10,M))/3.D0 VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ & VPOCHA(iu10,M))/4.D0 1545 CONTINUE 1543 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.24)THEN C write(6,*)' TE10' DO 1043 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) iu10= IZIPAD.LECT(IPT1.NUM(10,K)) DO 1045 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5 VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5 1045 CONTINUE 1043 CONTINUE ELSEIF(IPT1.ITYPEL.EQ.36)THEN C write(6,*)' PY19' DO 1943 K=1,NBELEM iu1 = IZIPAD.LECT(IPT1.NUM(1,K)) iu2 = IZIPAD.LECT(IPT1.NUM(2,K)) iu3 = IZIPAD.LECT(IPT1.NUM(3,K)) iu4 = IZIPAD.LECT(IPT1.NUM(4,K)) iu5 = IZIPAD.LECT(IPT1.NUM(5,K)) iu6 = IZIPAD.LECT(IPT1.NUM(6,K)) iu7 = IZIPAD.LECT(IPT1.NUM(7,K)) iu8 = IZIPAD.LECT(IPT1.NUM(8,K)) iu9 = IZIPAD.LECT(IPT1.NUM(9,K)) iu10= IZIPAD.LECT(IPT1.NUM(10,K)) iu11= IZIPAD.LECT(IPT1.NUM(11,K)) iu12= IZIPAD.LECT(IPT1.NUM(12,K)) iu13= IZIPAD.LECT(IPT1.NUM(13,K)) iu14= IZIPAD.LECT(IPT1.NUM(14,K)) iu15= IZIPAD.LECT(IPT1.NUM(15,K)) iu16= IZIPAD.LECT(IPT1.NUM(16,K)) iu17= IZIPAD.LECT(IPT1.NUM(17,K)) iu18= IZIPAD.LECT(IPT1.NUM(18,K)) iu19= IZIPAD.LECT(IPT1.NUM(19,K)) DO 1945 M=1,NC VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5 VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5 VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5 VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5 VPOCHA(iu14,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ & VPOCHA(iu7,M))/4.D0 VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5 VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu13,M))*0.5 VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu13,M))*0.5 VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu13,M))*0.5 VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu13,M))/3.D0 VPOCHA(iu16,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0 VPOCHA(iu17,M)=(VPOCHA(iu7,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0 VPOCHA(iu18,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M)+VPOCHA(iu13,M))/3.D0 VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+ & VPOCHA(iu7,M)+VPOCHA(iu13,M))/5.D0 1945 CONTINUE 1943 CONTINUE ELSE write(6,*)' KLNO : Element ',IPT1.ITYPEL,' non implemente' C% Type d'élément incorrect CALL ERREUR(16) RETURN ENDIF 742 CONTINUE 790 CONTINUE SEGSUP IZIPAD,IZIPAP CALL ACTOBJ('CHPOINT ',MCHPOI,1) CALL ECROBJ('CHPOINT ',MCHPOI) RETURN ENDIF C------------ Cas MSOMMET Fin -------------------------------------------- C------------ Cas MSOMMET Fin -------------------------------------------- CALL LEKTAB(MTABD,'MACRO1',MACRO1) CALL LEKTAB(MTABD,'QUADRATI',MQUAD) IF(IERR.NE.0)RETURN KPRE=2 MELEP1=MELEMC IF(TYPSPG.EQ.'CENTREP0')THEN IF(MACRO1.NE.0)MELEME=MACRO1 KPRE=3 ELSEIF(TYPSPG.EQ.'CENTREP1')THEN KPRE=4 IF(MACRO1.NE.0)MELEME=MACRO1 CALL LEKTAB(MTABD,'ELTP1NC ',MELEP1) ENDIF CALL CRCHPT(TYPE,MELEMS,NC,1,IZD) CALL LICHTM(IZD,IZDD,TYPC,IGEOM) SEGACT MELEME,MELEP1,MELEMS IF(IAXI.NE.0)THEN NPTD=MELEMS.NUM(/2) RMINS=XGRAND DO 232 I=1,NPTD J=MELEMS.NUM(1,I) R=XCOOR((J-1)*(IDIM+1) +1) R=ABS(R) IF(R.LT.RMINS)RMINS=R 232 CONTINUE RMIN=XGRAND DO 314 I=1,N J=IGEOMB.NUM(1,I) R=XCOOR((J-1)*(IDIM+1) +1) R=ABS(R) IF(R.LT.RMIN)RMIN=R 314 CONTINUE DR=1.2D0*(RMIN-RMINS) DR=ABS(DR) dr=max(xpetit,dr) DO 315 I=1,N J=IGEOMB.NUM(1,I) R=XCOOR((J-1)*(IDIM+1) +1) R=ABS(R) DO 3151 L=1,NC MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)*(R + DR*EXP(-(R/DR))) 3151 CONTINUE 315 CONTINUE DR=RMIN-RMINS if (abs(dr).lt.xpetit) dr=xpetit ELSE DO 316 I=1,N DO 3161 L=1,NC MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L) 3161 CONTINUE 316 CONTINUE ENDIF NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 DO 350 N=1,NC NK=0 DO 1 L=1,NBSOUS IPT1=MELEME IF(NBSOUS.NE.1)IPT1=LISOUS(L) SEGACT IPT1 NP=IPT1.NUM(/1) NEL=IPT1.NUM(/2) NOM0=NOMS(IPT1.ITYPEL)//' ' IF(MQUAD.NE.0)THEN IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0' IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1' ELSEIF(MACRO1.NE.0)THEN IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0' IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1' ELSE IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' ' ENDIF CALL KALPBG(NOM0,'FONFORM ',IZFFM) C write(6,*)' NOM0=',nom0,kpre,IZFFM IF(IZFFM.EQ.0)THEN C% Type d'élément incorrect CALL ERREUR(16) RETURN ENDIF SEGACT IZFFM*MOD IZHR=KZHR(1) SEGACT IZHR*MOD NPG=FN(/2) NES=GR(/1) IZF1=KTP(1) SEGACT IZF1*MOD MP1=IZF1.FN(/1) NPGP=IZF1.FN(/2) DO 10 K=1,NEL NK=NK+1 DO 12 I=1,NP J=IPT1.NUM(I,K) DO 121 M=1,IDIM XYZ(M,I)=XCOOR((J-1)*(IDIM+1) +M) 121 CONTINUE 12 CONTINUE CALL CALJBR &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) DO 35 I=1,NP IU=IZIPAD.LECT(IPT1.NUM(I,K)) UU=0.D0 DD=0.D0 DO 340 LL=1,NPG VL=0.D0 DO 34 J=1,MP1 KK=IZIPAP.LECT(MELEP1.NUM(J,NK)) VL=VL+IZF1.FN(J,LL)*MPOVA3.VPOCHA(KK,N) 34 CONTINUE DD=DD+FN(I,LL)*PGSQ(LL)*DEUPI UU=UU+VL*FN(I,LL)*PGSQ(LL)*DEUPI 340 CONTINUE VPOCHA(IU,N)=VPOCHA(IU,N)+UU IZDD.VPOCHA(IU,N)=IZDD.VPOCHA(IU,N)+DD 35 CONTINUE 10 CONTINUE 1 CONTINUE NPTD=VPOCHA(/1) DO 13 I=1,NPTD VPOCHA(I,N)=VPOCHA(I,N)/IZDD.VPOCHA(I,1) 13 CONTINUE IF(IAXI.NE.0)THEN DO 132 I=1,NPTD J=MELEMS.NUM(1,I) R=XCOOR((J-1)*(IDIM+1) +1) VPOCHA(I,N)=VPOCHA(I,N)/(R + DR*EXP(-(R/DR))) 132 CONTINUE ENDIF 350 CONTINUE SEGSUP MPOVA3 C SEGSUP IZIPAD,IZIPAP,IZFFM,IZHR,IZF1,IZD,IZDD 360 CONTINUE CALL ACTOBJ('CHPOINT ',MCHPOI,1) CALL ECROBJ('CHPOINT ',MCHPOI) RETURN 1001 FORMAT(20(1X,I5)) 1002 FORMAT(10(1X,1PE11.4)) 1008 FORMAT(10(1X,A8)) 9999 CONTINUE END