1 : C ISOINT SOURCE PV 09/03/12 21:25:32 6325 2 : C VISUALISATION INTERACTIVE D'ISOVALEUR 3 : C 4 : SUBROUTINE ISOINT(VCPCHA,MELEME,ICPR,XPROJ,IVU,PAS,XMI,YMI,X1,Y1, 5 : > mcham) 6 : IMPLICIT INTEGER(I-N) 7 : -INC SMELEME 8 : -INC CCOPTIO 9 : -INC CCGEOME 10 : -INC SMCHAML 11 : SEGMENT XPROJ(3,0) 12 : SEGMENT VCPCHA(0) 13 : SEGMENT IVU(0) 14 : SEGMENT ICPR(0) 15 : CHARACTER*19 TEXT2 16 : SEGACT VCPCHA,IVU,ICPR,XPROJ 17 : 400 CONTINUE 17 : CALL TRMESS('POINTEZ LE LIEU OU OBTENIR LA VALEUR DU CHAMP') 17 : CALL TRDIG(XP,YP,INCLE) 18 : XP=(XP-X1)/PAS+XMI 19 : YP=(YP-Y1)/PAS+YMI 20 : IPT1=MELEME 21 : SEGACT IPT1 22 : DO 220 IO=1,MAX(1,LISOUS(/1)) 23 : IF (LISOUS(/1).NE.0) THEN 24 : 25 : IPT1=LISOUS(IO) 26 : if (mcham.ne.0) then 27 : melval=lisref(io) 28 : segact melval 29 : lval=velche(/1) 30 : endif 31 : SEGACT IPT1 32 : ENDIF 33 : NBNN=IPT1.NUM(/1) 34 : IF (KSURF(IPT1.ITYPEL).NE.0) GOTO 30 35 : * C'EST UNE LIGNE 36 : DO 20 IEL=1,IPT1.NUM(/2) 37 : do 21 iafa=1,nbnn-1 38 : ibfa=iafa+1 39 : IPA=IPT1.NUM(iafa,iel) 40 : IA=ICPR(IPA) 41 : IPB=IPT1.NUM(ibfa,iel) 42 : IB=ICPR(IPB) 43 : IF (IVU(IA).LE.0) GOTO 20 44 : IF (IVU(IB).LE.0) GOTO 20 45 : XA=XPROJ(1,IA) 46 : YA=XPROJ(2,IA) 47 : XB=XPROJ(1,IB) 48 : YB=XPROJ(2,IB) 49 : SCA=(XP-XA)*(XP-XB)+(YP-YA)*(YP-YB) 50 : xlong=(xb-xa)**2+(yb-ya)**2 51 : IF (SCA.LE.-0.9*xlong) GOTO 95 52 : 21 CONTINUE 53 : 20 CONTINUE 54 : GOTO 70 55 : 30 CONTINUE 56 : * C'EST UNE SURFACE OU UN VOLUME 57 : NBELEM=IPT1.NUM(/2) 58 : NBNN=IPT1.NUM(/1) 59 : NBFAC=LTEL(1,IPT1.ITYPEL) 60 : IAD=LTEL(2,IPT1.ITYPEL)-1 61 : IF (NBFAC.EQ.0) GOTO 70 62 : DO 65 IFAC=1,NBFAC 63 : ITYP=LDEL(1,IAD+IFAC) 64 : NPFAC=KDFAC(1,ITYP) 65 : IF (NPFAC.NE.0) THEN 66 : JAD=LDEL(2,IAD+IFAC)-1 67 : IDEP=KDFAC(2,ITYP) 68 : IFEP=IDEP+3*(KDFAC(3,ITYP)-1) 69 : DO 60 ITRIAN=IDEP,IFEP,3 70 : IAFA=LFAC(JAD+KFAC(ITRIAN)) 71 : IBFA=LFAC(JAD+KFAC(ITRIAN+1)) 72 : ICFA=LFAC(JAD+KFAC(ITRIAN+2)) 73 : DO 40 IEL=1,NBELEM 74 : IPA=IPT1.NUM(IAFA,IEL) 75 : IPB=IPT1.NUM(IBFA,IEL) 76 : IPC=IPT1.NUM(ICFA,IEL) 77 : IA=ICPR(IPA) 78 : IB=ICPR(IPB) 79 : IC=ICPR(IPC) 80 : IF (IVU(IA).LT.1.OR.IVU(IB).LT.1.OR.IVU(IC).LT.1) 81 : # GOTO 40 82 : XA=XPROJ(1,IA) 83 : XB=XPROJ(1,IB) 84 : XC=XPROJ(1,IC) 85 : YA=XPROJ(2,IA) 86 : YB=XPROJ(2,IB) 87 : YC=XPROJ(2,IC) 88 : VAX=XP-XA 89 : VBX=XP-XB 90 : VCX=XP-XC 91 : VAY=YP-YA 92 : VBY=YP-YB 93 : VCY=YP-YC 94 : DC=VAX*VBY-VAY*VBX 95 : DA=VBX*VCY-VBY*VCX 96 : IF (DA*DC.LT.0.) GOTO 40 97 : DB=VCX*VAY-VCY*VAX 98 : IF (DA*DB.LT.0.) GOTO 40 99 : IF (DB*DC.LT.0.) GOTO 40 100 : if (mcham.eq.0) then 101 : VC = VCPCHA(IPC) 102 : else 103 : VC = velche(min(lval,ICFA),IEL) 104 : endif 105 : GOTO 90 106 : 40 CONTINUE 107 : 60 CONTINUE 108 : ELSE 109 : * 110 : * POLYGONE 111 : * 112 : DO 45, IEL = 1, NBELEM 113 : * 114 : * Recherche des coordonnees du centre du polygone 115 : * 116 : XXM = 0. 117 : YYM = 0. 118 : VVM = 0. 119 : IVUE = 1 120 : DO 67 ICT = 1, NBNN 121 : * 122 : NUPT = IPT1.NUM(ICT, IEL) 123 : IDPT = ICPR(NUPT) 124 : XXM = XPROJ(1,IDPT) + XXM 125 : YYM = XPROJ(2,IDPT) + YYM 126 : 127 : if (mcham.eq.0) then 128 : VVM = VCPCHA(NUPT) 129 : else 130 : VVM = velche(min(lval,IAFA),IEL) 131 : endif 132 : IF (IVU(IDPT).NE.1) IVUE = 0 133 : * 134 : 67 CONTINUE 135 : * 136 : IF (IVUE.EQ.1) THEN 137 : * 138 : XC=XXM/NBNN 139 : YC=YYM/NBNN 140 : VC=VVM/NBNN 141 : * 142 : IAFA = NBNN 143 : IPA = IPT1.NUM(IAFA, IEL) 144 : ID2 = ICPR(IPA) 145 : XA=XPROJ(1,ID2) 146 : YA=XPROJ(2,ID2) 147 : * 148 : * Boucle sur tous les triangles 149 : * 150 : DO 670, ICT = 1, NBNN 151 : * 152 : IBFA = ICT 153 : IPB = IPT1.NUM(IBFA, IEL) 154 : ID1 = ICPR(IPB) 155 : * 156 : XB=XPROJ(1,ID1) 157 : YB=XPROJ(2,ID1) 158 : 159 : VAX=XP-XA 160 : VBX=XP-XB 161 : VCX=XP-XC 162 : VAY=YP-YA 163 : VBY=YP-YB 164 : VCY=YP-YC 165 : DC=VAX*VBY-VAY*VBX 166 : DA=VBX*VCY-VBY*VCX 167 : IF (DA*DC.LT.0.) GOTO 675 168 : DB=VCX*VAY-VCY*VAX 169 : IF (DA*DB.LT.0.) GOTO 675 170 : IF (DB*DC.LT.0.) GOTO 675 171 : GOTO 90 172 : 173 : 675 XA = XB 174 : YA = YB 175 : IPA = IPB 176 : IAFA = IBFA 177 : * 178 : 670 CONTINUE 179 : * 180 : ENDIF 181 : * 182 : 45 CONTINUE 183 : * 184 : ENDIF 185 : 65 CONTINUE 186 : 70 CONTINUE 187 : IF (LISOUS(/1).NE.0) SEGDES IPT1 188 : 220 CONTINUE 189 : SEGDES MELEME 190 : 80 CONTINUE 191 : * ON N'A PAS TROUVE ON TERMINE 192 : GOTO 1000 193 : * ON A TROUVE ON ECRIT CE QUE C'EST 194 : 95 CONTINUE 195 : DA=((XP-XA)**2+(YP-YA)**2)**0.5 196 : DB=((XP-XB)**2+(YP-YB)**2)**0.5 197 : DS=DA+DB 198 : IF (DS.EQ.0.) GOTO 400 199 : if (mcham.eq.0) then 200 : BONVAL=(VCPCHA(IPA)*DA+VCPCHA(IPB)*DB)/DS 201 : else 202 : BONVAL=(velche(min(lval,IAFA),IEL)*da+ 203 : > velche(min(lval,IBFA),IEL)*db)/DS 204 : endif 205 : GOTO 97 206 : 90 CONTINUE 207 : DS=DA+DB+DC 208 : IF (DS.EQ.0.) GOTO 400 209 : if (mcham.eq.0) then 210 : BONVAL=(VCPCHA(IPA)*DA+VCPCHA(IPB)*DB+VC*DC)/DS 211 : else 212 : BONVAL=(velche(min(lval,IAFA),IEL)*da+ 213 : > velche(min(lval,IBFA),IEL)*db+VC*dc)/DS 214 : endif 215 : 97 CONTINUE 216 : TEXT2='VALEUR : ' 217 : WRITE (TEXT2(10:19),FMT='(1PG10.3)') BONVAL 217 : CALL TRMESS(TEXT2) 218 : SEGDES IPT1,MELEME 219 : 1000 CONTINUE 219 : * CALL TRTINI 220 : RETURN 221 : END 222 : 223 : 224 : 225 : 226 : 227 : 228 : 229 : 230 : 231 :
© Cast3M 2003 - All rights reserved.
Disclaimer