C ATISO SOURCE CB215821 20/11/25 13:18:30 10792 C SUBROUTINE ATISO(MELEME,ICPR,XPROJ,VCPCHA,VCHC,IVU,PTI,NISO,MCOUP, > mcham,BLOK) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C APPEL DU TRACE DES ISOVALEURS D UN OBJET DE TYPE CHAMPOINT C C ==>EN DIMENSION 2 ET 3 C C ==>AVEC VERIFICATIOM SI ICACHE=1 SI LES FACES SONT VISIBLES OU C C NON C C C C AOUT 85 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IMPLICIT INTEGER(I-N) SEGMENT ICPR(0) SEGMENT VCPCHA(nbpts) SEGMENT XPROJ(3,ICPR(/1)) SEGMENT IVU(ICPR(/1)) REAL BLOK REAL VCHC DIMENSION VCHC(*) DIMENSION XX(4),YY(4),ZZ(4),VV(4) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMELEME -INC SMCHPOI -INC SMCOORD -INC SMLREEL -INC SMCHAML C C ON FAIT LE TRACER DES ISOVALEURS D UN CHAMPOINT ou d'un chamelem C SI ON EST EN OPTION ISOV SURF ON VA APPELE FACED2 C C SG Pourquoi separe-t-on le cas ISOTYP=0 et les autres ? C Cela semble etre essentiellement du au fait que tciso ne gere pas C bien ISOTYP=0. Egalement, il y a le trace des labels au bord C gestion des enveloppes egalement ? *dbg Write(ioimp,*) 'coucou atiso' IF (ISOTYP.GT.0) THEN CALL FACED2(MELEME,XPROJ,ICPR,VCHC,VCPCHA,PTI,NISO,IVU,MCOUP $ ,mcham,BLOK) RETURN ENDIF SEGACT ICPR NELEM=0 IPT1=MELEME SEGACT MELEME DO 3101 IOB=1,MAX(1,LISOUS(/1)) IF (LISOUS(/1).NE.0) THEN IPT1=LISOUS(IOB) SEGACT IPT1 ENDIF NELEM=NELEM+IPT1.NUM(/2) 3101 CONTINUE C C ON TRAVAILLE PAR OBJET ELEMENTAIRE C IPT1=MELEME DO 20100 IOB=1,MAX(1,LISOUS(/1)) IF (LISOUS(/1).NE.0) IPT1=LISOUS(IOB) if (mcham.ne.0) melval=lisref(iob) IF (KSURF(IPT1.ITYPEL).EQ.0) GOTO 20150 NBELEM=IPT1.NUM(/2) NBFAC=LTEL(1,IPT1.ITYPEL) IAD=LTEL(2,IPT1.ITYPEL)-1 IF (NBFAC.EQ.0) GOTO 20150 DO 20200 IFAC=1,NBFAC ITYP=LDEL(1,IAD+IFAC) JAD=LDEL(2,IAD+IFAC)-1 IDEP=KDFAC(2,ITYP) IFEP=IDEP+3*(KDFAC(3,ITYP)-1) IF (ITYP.EQ.1.OR.ITYP.EQ.3.OR.ITYP.EQ.7.OR.ITYP.EQ.8) THEN DO 20225 ITRIAN=IDEP,IFEP,3 IAFA=LFAC(JAD+KFAC(ITRIAN)) IBFA=LFAC(JAD+KFAC(ITRIAN+1)) ICFA=LFAC(JAD+KFAC(ITRIAN+2)) if(mcham.ne.0) then iafam=min(iafa,velche(/1)) ibfam=min(ibfa,velche(/1)) icfam=min(icfa,velche(/1)) endif DO 20226 IEL=1,NBELEM ielm=iel if(mcham.ne.0) then ielm=min(iel,velche(/2)) endif IA=ICPR(IPT1.NUM(IAFA,IEL)) IB=ICPR(IPT1.NUM(IBFA,IEL)) IC=ICPR(IPT1.NUM(ICFA,IEL)) IF (IVU(IA).EQ.1.AND.IVU(IB).EQ.1.AND.IVU(IC).EQ.1) $ THEN XX(1)=XPROJ(1,IA) XX(2)=XPROJ(1,IB) XX(3)=XPROJ(1,IC) YY(1)=XPROJ(2,IA) YY(2)=XPROJ(2,IB) YY(3)=XPROJ(2,IC) ZZ(1)=XPROJ(3,IA) ZZ(2)=XPROJ(3,IB) ZZ(3)=XPROJ(3,IC) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(IAFA,IEL)) VV(2)=VCPCHA(IPT1.NUM(IBFA,IEL)) VV(3)=VCPCHA(IPT1.NUM(ICFA,IEL)) else VV(1)=velche(IAFAm,IELm) VV(2)=velche(IBFAm,IELm) VV(3)=velche(ICFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) ENDIF 20226 continue 20225 CONTINUE ELSEIF (ITYP.EQ.2) THEN * cas des quadrangles on rajoute un point au milieu DO 20235 IEL=1,NBELEM IAFA=LFAC(JAD+1) IBFA=LFAC(JAD+2) ICFA=LFAC(JAD+3) IDFA=LFAC(JAD+4) if(mcham.ne.0) then ielm=min(iel,velche(/2)) iafam=min(iafa,velche(/1)) ibfam=min(ibfa,velche(/1)) icfam=min(icfa,velche(/1)) idfam=min(idfa,velche(/1)) endif ia=icpr(ipt1.num(iafa,iel)) ib=icpr(ipt1.num(ibfa,iel)) ic=icpr(ipt1.num(icfa,iel)) id=icpr(ipt1.num(idfa,iel)) IF (IVU(IA).EQ.1.AND.IVU(IB).EQ.1.AND.IVU(IC).EQ.1 $ .and.IVU(Id).EQ.1) THEN xxm=(XPROJ(1,IA)+XPROJ(1,IB) $ +XPROJ(1,IC)+XPROJ(1,ID))/4 yym=(XPROJ(2,IA)+XPROJ(2,IB) $ +XPROJ(2,IC)+XPROJ(2,ID))/4 zzm=(XPROJ(3,IA)+XPROJ(3,IB) $ +XPROJ(3,IC)+XPROJ(3,ID))/4 if (mcham.eq.0) then vvm=(VCPCHA(ipt1.num(iafa,iel)) $ +VCPCHA(ipt1.num(ibfa,iel)) $ +VCPCHA(ipt1.num(icfa,iel)) $ +VCPCHA(ipt1.num(idfa,iel)))/4 else vvm=(velche(iafam,ielm)+velche(ibfam,ielm) * +velche(icfam,ielm)+velche(idfam,ielm))/4 endif XX(1)=XPROJ(1,IA) XX(2)=XPROJ(1,IB) YY(1)=XPROJ(2,IA) YY(2)=XPROJ(2,IB) ZZ(1)=XPROJ(3,IA) ZZ(2)=XPROJ(3,IB) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(IAFA,IEL)) VV(2)=VCPCHA(IPT1.NUM(IBFA,IEL)) else VV(1)=velche(IAFAm,IELm) VV(2)=velche(IBFAm,IELm) endif XX(3)=XXM YY(3)=YYM ZZ(3)=ZZM VV(3)=VVM CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) XX(2)=XPROJ(1,ID) YY(2)=XPROJ(2,ID) ZZ(2)=XPROJ(3,ID) if (mcham.eq.0) then VV(2)=VCPCHA(IPT1.NUM(IDFA,IEL)) else VV(2)=velche(IDFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) XX(1)=XPROJ(1,IC) YY(1)=XPROJ(2,IC) ZZ(1)=XPROJ(3,IC) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(ICFA,IEL)) else VV(1)=velche(ICFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) XX(2)=XPROJ(1,IB) YY(2)=XPROJ(2,IB) ZZ(2)=XPROJ(3,IB) if (mcham.eq.0) then VV(2)=VCPCHA(IPT1.NUM(IBFA,IEL)) else VV(2)=velche(IBFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) ENDIF 20235 CONTINUE ELSEIF (ITYP.EQ.4) THEN * cas des quadrangles a 8 noeuds on decoupe en 4 triangles et un * quadrangle. DO 20237 IEL=1,NBELEM IAFA=LFAC(JAD+1) IBFA=LFAC(JAD+2) ICFA=LFAC(JAD+3) IDFA=LFAC(JAD+4) IEFA=LFAC(JAD+5) IFFA=LFAC(JAD+6) IGFA=LFAC(JAD+7) IHFA=LFAC(JAD+8) if(mcham.ne.0) then ielm=min(iel,velche(/2)) iafam=min(iafa,velche(/1)) ibfam=min(ibfa,velche(/1)) icfam=min(icfa,velche(/1)) idfam=min(idfa,velche(/1)) iefam=min(iefa,velche(/1)) iffam=min(iffa,velche(/1)) igfam=min(igfa,velche(/1)) ihfam=min(ihfa,velche(/1)) endif ia=icpr(ipt1.num(iafa,iel)) ib=icpr(ipt1.num(ibfa,iel)) ic=icpr(ipt1.num(icfa,iel)) id=icpr(ipt1.num(idfa,iel)) ie=icpr(ipt1.num(iefa,iel)) if=icpr(ipt1.num(iffa,iel)) ig=icpr(ipt1.num(igfa,iel)) ih=icpr(ipt1.num(ihfa,iel)) IF (IVU(IA).EQ.1.AND.IVU(IB).EQ.1.AND.IVU(IH).EQ.1) $ then XX(1)=XPROJ(1,IA) XX(2)=XPROJ(1,IB) XX(3)=XPROJ(1,IH) YY(1)=XPROJ(2,IA) YY(2)=XPROJ(2,IB) YY(3)=XPROJ(2,IH) ZZ(1)=XPROJ(3,IA) ZZ(2)=XPROJ(3,IB) ZZ(3)=XPROJ(3,IH) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(IAFA,IEL)) VV(2)=VCPCHA(IPT1.NUM(IBFA,IEL)) VV(3)=VCPCHA(IPT1.NUM(IHFA,IEL)) else VV(1)=velche(IAFAm,IELm) VV(2)=velche(IBFAm,IELm) VV(3)=velche(IHFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) ENDIF IF (IVU(IB).EQ.1.AND.IVU(IC).EQ.1.AND.IVU(ID).EQ.1) $ then XX(1)=XPROJ(1,IB) XX(2)=XPROJ(1,IC) XX(3)=XPROJ(1,ID) YY(1)=XPROJ(2,IB) YY(2)=XPROJ(2,IC) YY(3)=XPROJ(2,ID) ZZ(1)=XPROJ(3,IB) ZZ(2)=XPROJ(3,IC) ZZ(3)=XPROJ(3,ID) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(IBFA,IEL)) VV(2)=VCPCHA(IPT1.NUM(ICFA,IEL)) VV(3)=VCPCHA(IPT1.NUM(IDFA,IEL)) else VV(1)=velche(IBFAm,IELm) VV(2)=velche(ICFAm,IELm) VV(3)=velche(IDFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) ENDIF IF (IVU(ID).EQ.1.AND.IVU(IE).EQ.1.AND.IVU(IF).EQ.1) $ then XX(1)=XPROJ(1,ID) XX(2)=XPROJ(1,IE) XX(3)=XPROJ(1,IF) YY(1)=XPROJ(2,ID) YY(2)=XPROJ(2,IE) YY(3)=XPROJ(2,IF) ZZ(1)=XPROJ(3,ID) ZZ(2)=XPROJ(3,IE) ZZ(3)=XPROJ(3,IF) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(IDFA,IEL)) VV(2)=VCPCHA(IPT1.NUM(IEFA,IEL)) VV(3)=VCPCHA(IPT1.NUM(IFFA,IEL)) else VV(1)=velche(IDFAm,IELm) VV(2)=velche(IEFAm,IELm) VV(3)=velche(IFFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) ENDIF IF (IVU(IF).EQ.1.AND.IVU(IG).EQ.1.AND.IVU(IH).EQ.1) $ then XX(1)=XPROJ(1,IF) XX(2)=XPROJ(1,IG) XX(3)=XPROJ(1,IH) YY(1)=XPROJ(2,IF) YY(2)=XPROJ(2,IG) YY(3)=XPROJ(2,IH) ZZ(1)=XPROJ(3,IF) ZZ(2)=XPROJ(3,IG) ZZ(3)=XPROJ(3,IH) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(IFFA,IEL)) VV(2)=VCPCHA(IPT1.NUM(IGFA,IEL)) VV(3)=VCPCHA(IPT1.NUM(IHFA,IEL)) else VV(1)=velche(IFFAm,IELm) VV(2)=velche(IGFAm,IELm) VV(3)=velche(IHFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) ENDIF * cas du quadrangle on rajoute un point central xxm=-0.25*XPROJ(1,IA)+0.5*XPROJ(1,IB) * -0.25*XPROJ(1,IC)+0.5*XPROJ(1,ID) * -0.25*XPROJ(1,IE)+0.5*XPROJ(1,IF) * -0.25*XPROJ(1,IG)+0.5*XPROJ(1,IH) yym=-0.25*XPROJ(2,IA)+0.5*XPROJ(2,IB) * -0.25*XPROJ(2,IC)+0.5*XPROJ(2,ID) * -0.25*XPROJ(2,IE)+0.5*XPROJ(2,IF) * -0.25*XPROJ(2,IG)+0.5*XPROJ(2,IH) zzm=-0.25*XPROJ(3,IA)+0.5*XPROJ(3,IB) * -0.25*XPROJ(3,IC)+0.5*XPROJ(3,ID) * -0.25*XPROJ(3,IE)+0.5*XPROJ(3,IF) * -0.25*XPROJ(3,IG)+0.5*XPROJ(3,IH) if (mcham.eq.0) then vvm=-0.25*VCPCHA(ipt1.num(iafa,iel)) $ +0.5*VCPCHA(ipt1.num(ibfa,iel)) $ -0.25*VCPCHA(ipt1.num(icfa,iel)) $ +0.5*VCPCHA(ipt1.num(idfa,iel)) $ -0.25*VCPCHA(ipt1.num(iefa,iel)) $ +0.5*VCPCHA(ipt1.num(iffa,iel)) $ -0.25*VCPCHA(ipt1.num(igfa,iel)) $ +0.5*VCPCHA(ipt1.num(ihfa,iel)) else vvm=-0.25*velche(iafam,ielm) $ +0.5*velche(ibfam,ielm) * -0.25*velche(icfam,ielm) $ +0.5*velche(idfam,ielm) $ -0.25*velche(iefam,ielm) $ +0.5*velche(iffam,ielm) $ -0.25*velche(igfam,ielm) $ +0.5*velche(ihfam,ielm) endif IAFA=LFAC(JAD+2) IBFA=LFAC(JAD+4) ICFA=LFAC(JAD+6) IDFA=LFAC(JAD+8) if(mcham.ne.0) then iafam=min(iafa,velche(/1)) ibfam=min(ibfa,velche(/1)) icfam=min(icfa,velche(/1)) idfam=min(idfa,velche(/1)) endif ia=icpr(ipt1.num(iafa,iel)) ib=icpr(ipt1.num(ibfa,iel)) ic=icpr(ipt1.num(icfa,iel)) id=icpr(ipt1.num(idfa,iel)) IF (IVU(IA).EQ.1.AND.IVU(IB).EQ.1.AND.IVU(IC).EQ.1 $ .and.IVU(Id).EQ.1) THEN XX(1)=XPROJ(1,IA) XX(2)=XPROJ(1,IB) YY(1)=XPROJ(2,IA) YY(2)=XPROJ(2,IB) ZZ(1)=XPROJ(3,IA) ZZ(2)=XPROJ(3,IB) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(IAFA,IEL)) VV(2)=VCPCHA(IPT1.NUM(IBFA,IEL)) else VV(1)=velche(IAFAm,IELm) VV(2)=velche(IBFAm,IELm) endif XX(3)=XXM YY(3)=YYM ZZ(3)=ZZM VV(3)=VVM CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) XX(2)=XPROJ(1,ID) YY(2)=XPROJ(2,ID) ZZ(2)=XPROJ(3,ID) if (mcham.eq.0) then VV(2)=VCPCHA(IPT1.NUM(IDFA,IEL)) else VV(2)=velche(IDFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) XX(1)=XPROJ(1,IC) YY(1)=XPROJ(2,IC) ZZ(1)=XPROJ(3,IC) if (mcham.eq.0) then VV(1)=VCPCHA(IPT1.NUM(ICFA,IEL)) else VV(1)=velche(ICFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) XX(2)=XPROJ(1,IB) YY(2)=XPROJ(2,IB) ZZ(2)=XPROJ(3,IB) if (mcham.eq.0) then VV(2)=VCPCHA(IPT1.NUM(IBFA,IEL)) else VV(2)=velche(IBFAm,IELm) endif CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) ENDIF 20237 CONTINUE ELSEIF (ITYP .EQ. 6) THEN * * Element polygone * NBCOT = IPT1.NUM(/1) DO 20300 IEL=1,NBELEM * * Recherche des coordonnees et valeurs au centre du polygone * XXM = 0. YYM = 0. ZZM = 0. VVM = 0. IVUE = 1 DO 20330 ICT = 1, NBCOT * NUPT = IPT1.NUM(ICT, IEL) IDPT = ICPR(NUPT) XXM = XPROJ(1,IDPT) + XXM YYM = XPROJ(2,IDPT) + YYM ZZM = XPROJ(3,IDPT) + ZZM IF (MCHAM.EQ.0) THEN VVM = VCPCHA(NUPT) + VVM ELSE VVM = VELCHE(ICT, IEL) + VVM ENDIF IF (IVU(IDPT).NE.1) IVUE = 0 * 20330 CONTINUE * IF (IVUE.EQ.1) THEN * XX(3)=XXM/NBCOT YY(3)=YYM/NBCOT ZZ(3)=ZZM/NBCOT VV(3)=VVM/NBCOT * NUPT2 = IPT1.NUM(NBCOT, IEL) ID2 = ICPR(NUPT2) XX(2)=XPROJ(1,ID2) YY(2)=XPROJ(2,ID2) ZZ(2)=XPROJ(3,ID2) IF (MCHAM.EQ.0) THEN VV(2) = VCPCHA(NUPT2) ELSE C## MC VV(2) = VELCHE(ICT2, IEL) VV(2) = VELCHE(NBCOT, IEL) ENDIF * * Boucle sur tous les triangles * DO 20360 , ICT = 1, NBCOT * NUPT1 = IPT1.NUM(ICT, IEL) ID1 = ICPR(NUPT1) * XX(1)=XPROJ(1,ID1) YY(1)=XPROJ(2,ID1) ZZ(1)=XPROJ(3,ID1) IF (MCHAM.EQ.0) THEN VV(1)= VCPCHA(NUPT1) ELSE VV(1) = VELCHE(ICT, IEL) ENDIF CALL TRISO(VCHC,XX,YY,ZZ,VV,3,NISO) XX(2)= XX(1) YY(2)= YY(1) ZZ(2)= ZZ(1) VV(2)= VV(1) * 20360 CONTINUE * ENDIF * 20300 CONTINUE ENDIF 20200 CONTINUE 20150 CONTINUE IF (LISOUS(/1).NE.0) SEGDES IPT1 20100 CONTINUE * METTRE LES LABELS SUR LES ISO QUI COUPENT LE CONTOUR CALL TRCISO(MELEME,VCPCHA,ICPR,XPROJ,NISO,VCHC,IVU) SEGDES MELEME SEGDES ICPR RETURN END