C KNOL SOURCE GOUNAND 25/11/12 21:15:29 12399 SUBROUTINE KNOL IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C************************************************************************* C Operateur KNOL C C Objet Transforme un CHAMPOINT SOMMET en un CHAMPOINT CENTRE C C SYNTAXE : CHPC = KNOL TABDOM CHPS ; C C TABDOM : Table DOMAINE contenant les supports geometriques de CHPS C CHPS : CHAMPOINT SOMMET C CHPC : CHAMPOINT CENTRE C C C************************************************************************* -INC PPARAM -INC CCOPTIO -INC CCREEL -INC CCGEOME -INC SMCOORD -INC SMELEME POINTEUR MELEMS.MELEME,MELEMD.MELEME,SPGD.MELEME -INC SMMODEL -INC SMCHPOI POINTEUR IZB.MCHPOI,IZBB.MPOVAL -INC SMLENTI -INC SIZFFB POINTEUR IZF1.IZFFM,IZH2.IZHR,IZW.IZFFM,IZWH.IZHR SEGMENT SAJT REAL*8 AJT(IDIM,IDIM,NPG),RF1(NP,MP,IDIM),SM1(NP,IDIM) c REAL*8 TN1(NP,IDIM),TN2(NP,IDIM) ENDSEGMENT PARAMETER (NTO=4,NBMO=4) DIMENSION ITABO(NTO) CHARACTER*4 NOMD4 CHARACTER*8 TYPE,TYPC,LISMO(NBMO),TYPSPG,MTERR,NOM0 DATA LISMO/'CENTRE ',' ', 'CENTREP1','MSOMMET'/ C*** TYPSPG='CENTRE ' CALL INITI(ITABO,NTO,0) 4 CONTINUE CALL QUETYP(TYPE,0,IRET) c write(6,*)' Iret de Quetyp= ',iret,' TYPSPG=',typspg IF(IRET.EQ.0)THEN IF(TYPSPG.EQ.'MSOMMET '.OR.TYPSPG.EQ.'CENTRE '.OR. & TYPSPG.EQ.'CENTREP1'.OR.TYPSPG.EQ.' ')THEN IF(ITABO(1).EQ.1.AND.ITABO(2).EQ.1)GO TO 52 IF(ITABO(1).NE.1)THEN C% Il faut spécifier un objet de type %m1:8 et de sous type %m9:16 MOTERR(1: 8) = 'CHPOINT ' MOTERR(9:16) = 'DIFFUS ' CALL ERREUR(79) ENDIF IF(ITABO(2).NE.1)THEN C% Il faut spécifier un objet de type %m1:8 et de sous type %m9:16 MOTERR(1: 8) = 'MMODEL ' MOTERR(9:16) = ' ' CALL ERREUR(79) ENDIF ENDIF RETURN ENDIF * * Lecture du CHPOIN * IF(TYPE.EQ.'CHPOINT')THEN IF(ITABO(1).NE.0)THEN C% On a déja lu un objet de type %m1:8 MOTERR(1: 8) = 'CHPOINT ' CALL ERREUR(966) RETURN ENDIF ITABO(1)=1 CALL LIROBJ('CHPOINT ',IZB,1,IRETOU) CALL ACTOBJ('CHPOINT ',IZB,1) SEGACT IZB IF(IZB.IPCHP(/1).NE.1)THEN C% Erreur dans le partitionnement CALL ERREUR(920) RETURN ENDIF GO TO 4 ENDIF * * Lecture de l'objet modele 'Navier-Stokes' * C*** IF(TYPE.EQ.'MMODEL ')THEN IF(ITABO(2).NE.0)THEN C% On a déja lu un objet de type %m1:8 MOTERR(1: 8) = 'MMODEL ' MOTERR(9:16) = ' ' CALL ERREUR(966) RETURN ENDIF ITABO(2)=1 CALL LIROBJ('MMODEL ',MMODEL,1,IRET) CALL ACTOBJ('MMODEL ',MMODEL,1) SEGACT MMODEL N1=KMODEL(/1) DO 41 L=1,N1 IMODEL=KMODEL(L) SEGACT IMODEL 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 /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE C INEFMD=4 LINB C KPOIN = 0->SOMMET 1-> FACE 2-> CENTRE 3-> CENTREP0 4-> CENTREP1 5-> MSOMMET GO TO 4 ENDIF * * Lecture de l'objet table DOMAINE * C*** IF(TYPE.EQ.'TABLE ')THEN IF(ITABO(4).NE.0)THEN C% On a déja lu un objet de type %m1:8 MOTERR(1: 8) = 'TABLE ' MOTERR(9:16) = ' ' CALL ERREUR(966) RETURN ENDIF ITABO(2)=1 CALL LIROBJ('TABLE ',MTABD,1,IRET) GO TO 4 ENDIF * * Lecture d'un mot * IF(TYPE.EQ.'MOT ')THEN CALL LIRMOT(LISMO,NBMO,IP,1) TYPSPG=LISMO(IP) GO TO 4 ENDIF 52 CONTINUE C C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% C------------------ Traitement du cas MSOMMET --------------------------- IF(TYPSPG.EQ.'MSOMMET')THEN CALL LICHTL(IZB,IZBB,TYPC,IGEOMB) NC=IZBB.VPOCHA(/2) TYPE=' ' CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS) IF(TYPE.NE.'MAILLAGE')GO TO 90 C C On verifie Le support du CHP1 (SOMMET) C CALL KRIPAD(IGEOMB,MLENTI) CALL VERPAD(MLENTI,MELEMS,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) = 'SOMMET' MOTERR(9:16) = 'CHPOINT ' SEGSUP MLENTI RETURN ENDIF SEGSUP MLENTI TYPE=' ' CALL ACMO(MTABD,'MSOMMET',TYPE,MELEME) IF(TYPE.NE.'MAILLAGE')GO TO 90 CALL ECROBJ('MAILLAGE',MELEME) CALL ECROBJ('CHPOINT ',IZB) CALL REDU RETURN ENDIF C-------------- FIN Traitement du cas MSOMMET --------------------------- C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% C C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% C------------------ Traitement du cas CENTRE ---------------------------- IF(TYPSPG.EQ.'CENTRE')THEN CALL LICHTL(IZB,IZBB,TYPC,IGEOMB) NC=IZBB.VPOCHA(/2) TYPE=' ' CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS) IF(TYPE.NE.'MAILLAGE')GO TO 90 CALL KRIPAD(IGEOMB,MLENTI) CALL VERPAD(MLENTI,MELEMS,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) = 'SOMMET' MOTERR(9:16) = 'CHPOINT ' SEGSUP MLENTI RETURN ENDIF TYPE=' ' CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC) IF(TYPE.NE.'MAILLAGE')GO TO 90 TYPE=' ' CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME) IF(TYPE.NE.'MAILLAGE')GO TO 90 TYPE='CENTRE' c write(6,*)' Apparemment on traite le cas centre !!!' CALL CRCHPT(TYPE,MELEMC,NC,1,MCHPOI) CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM) SEGACT MELEME NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 KK=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) DO 10 K=1,NEL KK=KK+1 DO 13 N=1,NC UU=0.D0 DO 12 I=1,NP IU=LECT(IPT1.NUM(I,K)) UU=UU+IZBB.VPOCHA(IU,N) 12 CONTINUE VPOCHA(KK,N)=UU/FLOAT(NP) 13 CONTINUE 10 CONTINUE 1 CONTINUE C SEGSUP MLENTI CALL ECROBJ('CHPOINT ',MCHPOI) RETURN ENDIF C-------------- FIN Traitement du cas CENTRE ---------------------------- C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% C------------------ Traitement du cas CENTREP1 -------------------------- IF(TYPSPG.EQ.'CENTREP1')THEN MTERR='EF CTRP1' IF(INEFMD.EQ.2)NOMD4='MCP1' IF(INEFMD.EQ.3)NOMD4='PRP1' IF(INEFMD.NE.2.AND.INEFMD.NE.3)THEN C Option %m1:8 incompatible avec les données MOTERR( 1: 8) = MTERR CALL ERREUR(803) RETURN ENDIF CALL LEKTAB(MTABD,'CENTREP1',SPGD) CALL LEKTAB(MTABD,'ELTP1NC ',MELEMD) CALL LICHTL(IZB,IZBB,TYPC,IGEOMB) NC=IZBB.VPOCHA(/2) TYPE=' ' CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS) IF(TYPE.NE.'MAILLAGE')GO TO 90 CALL KRIPAD(IGEOMB,MLENT1) CALL VERPAD(MLENT1,MELEMS,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) = 'SOMMET' MOTERR(9:16) = 'CHPOINT ' SEGSUP MLENTI RETURN ENDIF TYPE=' ' CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME) IF(TYPE.NE.'MAILLAGE')GO TO 90 IF(INEFMD.EQ.2)CALL LEKTAB(MTABD,'MACRO1',MELEME) IF (IERR.NE.0) RETURN TYPE='CENTREP1' c write(6,*)' Apparemment on traite le cas centrep1 !!!' CALL CRCHPT(TYPE,SPGD,NC,1,MCHPOI) CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM) c.......................................................................... c IK3=0 IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 DEUPI=1.D0 IF(IAXI.NE.0)DEUPI=2.D0*XPI NC=MPOVAL.VPOCHA(/2) CALL KRIPAD(SPGD,MLENTI) SEGACT MELEME NKD=0 DO 101 L=1,MAX(1,LISOUS(/1)) SEGACT MELEMD IPT1=MELEME IPT2=MELEMD IF(LISOUS(/1).NE.0)IPT1=LISOUS(L) SEGACT IPT1 IF(MELEMD.LISOUS(/1).NE.0)THEN IPT2=MELEMD.LISOUS(L) NKD=0 ENDIF SEGACT IPT2 MP=IPT2.NUM(/1) NOM0 = NOMS(IPT1.ITYPEL)//NOMD4 c write(6,*)' KNOL 1er KALPBG NOM0=',NOM0,IPT1 CALL KALPBG(NOM0,'FONFORM ',IZFFM) IF(IZFFM.EQ.0)RETURN SEGACT IZFFM*MOD IZHR=KZHR(1) SEGACT IZHR*MOD IZF1 = KTP(1) IZH2 = KZHR(2) IZW = IZF1 SEGACT IZW*MOD IF(MP.NE.IZW.FN(/1))THEN write(6,*)' Gross problem ds KNOL ' write(6,*)' NOM0=',NOM0 ,' NOMD4=',NOMD4 write(6,*)' MP=',MP,' IZW.FN(/1)=' & ,IZW.FN(/1) return ENDIF NES=GR(/1) NPG=GR(/3) NP = IPT1.NUM(/1) NBEL=IPT1.NUM(/2) SEGINI SAJT c write(6,*)' AVANT 108 NC=',NC,' NBEL=',NBEL,MP,NP,NC c write(6,*)' AVANT 108 IK4=',IK4 DO 108 KE=1,NBEL NKD=NKD+1 DO 109 I=1,NP J=IPT1.NUM(I,KE) DO 1091 N=1,IDIM XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N) 1091 CONTINUE 109 CONTINUE CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES, * IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) CALL INITD(SM1,(MP*IDIM),0.D0) C======================================================================= C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: C...... Source DO 710 I=1,MP U2=0.D0 U4=0.D0 DO 717 N=1,NC DO 715 LG=1,NPG WT=IZW.FN(I,LG) U4=U4+WT*PGSQ(LG)*DEUPI*RPG(LG) UJ=0.D0 DO 714 J=1,NP JU=MLENT1.LECT(IPT1.NUM(J,KE)) UJ=UJ+FN(J,LG)*IZBB.VPOCHA(JU,N) 714 CONTINUE U2=U2+UJ*WT*PGSQ(LG)*DEUPI*RPG(LG) 715 CONTINUE SM1(I,N)=SM1(I,N)+(U2/U4) 717 CONTINUE 710 CONTINUE c write(6,*)' SM1 *****' c do 711 n=1,nc c write(6,1002)(sm1(i,n),i=1,mp) c711 continue C...... Source Fin C======================================================================= C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> C ...... Chargement Second membre DO 910 I=1,MP I1=LECT(IPT2.NUM(I,NKD)) DO 9101 N=1,NC VPOCHA(I1,N)=VPOCHA(I1,N)+SM1(I,N) 9101 CONTINUE 910 CONTINUE C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 108 CONTINUE SEGSUP IZFFM,IZHR,IZF1,IZH2 SEGSUP SAJT 101 CONTINUE SEGSUP MLENTI c.......................................................................... SEGSUP MLENTI,MLENT1 CALL ECROBJ('CHPOINT ',MCHPOI) RETURN ENDIF C-------------- FIN Traitement du cas CENTREP1 -------------------------- C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90 CONTINUE WRITE(6,*)'Interruption anormale de KLNO ' RETURN 1001 FORMAT(20(1X,I5)) 1002 FORMAT(10(1X,1PE11.4)) 1008 FORMAT(10(1X,A8)) END