1 : C KDOM11 SOURCE CHAT 05/01/13 00:53:39 5004 2 : SUBROUTINE KDOM11(MELF,MELFL,MELFP,MCHPSU,MCHPNO,MCHPMR) 3 : C 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : KDOM11 9 : C 9 : C DESCRIPTION : Subroutine called by KDOM10 in the case of EULER 10 : C model. 11 : C We create the CHPOINTS 12 : C MCHPSU = surfaces (faces dimension) 13 : C MCHPNO = normals (oriented from the first 14 : C to the second point of FACEL) 15 : C MCHPMR = rotation matrix 16 : C 17 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 18 : C 19 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF 20 : C 21 : C************************************************************************ 22 : C 23 : C INPUTS : 24 : C 25 : C MELF : meleme 'FACE' 26 : C MELFL : meleme 'FACEL' 27 : C MELFP : meleme 'FACEP' 28 : C 29 : C OUTPUTS : 30 : C 31 : C MCHPSU : mchpoi 'XXSURFAC' 32 : C MCHPNO : mchpoi 'XXNORMAF' 33 : C MCHPMR : mchpoi 'MATROT' 34 : C 35 : C 36 : IMPLICIT INTEGER(I-N) 37 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 38 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 39 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 40 : & ,IECHO, IIMPI, IOSPI 41 : & ,IDIM 42 : C & ,MCOORD 43 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 44 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 45 : & ,NORINC,NORVAL,NORIND,NORVAD 46 : & ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR 47 : C 48 : INTEGER IGEOM, MCHPSU, MCHPNO, MCHPMR 49 : & ,JGN, JGM, NBSOUS, ISOUS, NP, NEL, IEL, IPO, NLCF 50 : & , NF, IFAC 51 : REAL*8 XF,YF,X1,Y1, DSURFX, DSURFY, XSURF, YSURF, SURF, A 52 : & ,ORIENT 53 : & ,ZF, DXP, DYP, DZP, DXPM1, DYPM1, DZPM1, DSURFZ, ZSURF 54 : & ,RMX, RMY, RMZ, RRX, RRY, RRZ 55 : CHARACTER*8 TYPE 56 : 57 : -INC CCOPTIO 58 : -INC SMELEME 59 : POINTEUR MELFL.MELEME,MELFP.MELEME,MELF.MELEME 60 : -INC SMCHPOI 61 : POINTEUR MPOVSU.MPOVAL, MPOVNO.MPOVAL, MPOVMR.MPOVAL 62 : -INC SMLENTI 63 : -INC SMLMOTS 64 : -INC SMCOORD 65 : C 66 : C**** Corresp. FACE 67 : C 67 : CALL KRIPAD(MELF,MLENTI) 68 : C SEGINI MLENTI 69 : C 70 : C**** Champoint surfaces 71 : C 72 : JGN=4 73 : JGM=1 74 : SEGINI MLMOTS 75 : MLMOTS.MOTS(1)='SCAL' 76 : TYPE='FACE ' 76 : CALL KRCHP1(TYPE,MELF,MCHPSU,MLMOTS) 77 : IF(IERR.NE.0)GOTO 9999 77 : CALL LICHT(MCHPSU,MPOVSU,TYPE,IGEOM) 78 : IF(IERR.NE.0)GOTO 9999 79 : C SEGACT MPOVSU 80 : SEGSUP MLMOTS 81 : C 82 : C**** Champoint normales 83 : C 84 : JGN=4 85 : JGM=IDIM 86 : SEGINI MLMOTS 87 : MLMOTS.MOTS(1)='UX' 88 : MLMOTS.MOTS(2)='UY' 89 : IF(IDIM .EQ. 3) MLMOTS.MOTS(3)='UZ' 90 : TYPE='FACE ' 90 : CALL KRCHP1(TYPE,MELF,MCHPNO,MLMOTS) 91 : IF(IERR.NE.0)GOTO 9999 91 : CALL LICHT(MCHPNO,MPOVNO,TYPE,IGEOM) 92 : IF(IERR.NE.0)GOTO 9999 93 : C SEGACT MPOVNO 94 : SEGSUP MLMOTS 95 : C 96 : C**** Champoint matrice de rotation 97 : C 98 : JGN=4 99 : JGM=IDIM*IDIM 100 : SEGINI MLMOTS 101 : IF(IDIM.EQ.2)THEN 102 : MLMOTS.MOTS(1)='RX' 103 : MLMOTS.MOTS(2)='RY' 104 : MLMOTS.MOTS(3)='MX' 105 : MLMOTS.MOTS(4)='MY' 106 : * Normale en M 107 : * vect(M,U) = z 108 : ELSE 109 : MLMOTS.MOTS(1)='UX' 110 : MLMOTS.MOTS(2)='UY' 111 : MLMOTS.MOTS(3)='UZ' 112 : MLMOTS.MOTS(4)='RX' 113 : MLMOTS.MOTS(5)='RY' 114 : MLMOTS.MOTS(6)='RZ' 115 : MLMOTS.MOTS(7)='MX' 116 : MLMOTS.MOTS(8)='MY' 117 : MLMOTS.MOTS(9)='MZ' 118 : * Normale en M 119 : * vect(M,R) = U 120 : ENDIF 120 : CALL KRCHP1(TYPE,MELF,MCHPMR,MLMOTS) 121 : IF(IERR.NE.0)GOTO 9999 121 : CALL LICHT(MCHPMR,MPOVMR,TYPE,IGEOM) 122 : IF(IERR.NE.0)GOTO 9999 123 : C SEGACT MPOVMR 124 : C 125 : SEGACT MELFP 126 : NBSOUS=MELFP.LISOUS(/1) 127 : IF(NBSOUS.EQ.0)NBSOUS=1 128 : SEGACT MELFL 129 : C********************** 130 : C CAS DE LA DIMENSION 2 131 : C********************** 132 : IF (IDIM.EQ.2) THEN 133 : C 134 : DO ISOUS=1,NBSOUS,1 135 : IPT1 = MELFP 136 : IF(NBSOUS .NE. 1)THEN 137 : IPT1 = MELFP.LISOUS(ISOUS) 138 : SEGACT IPT1 139 : ENDIF 140 : C 141 : NP=IPT1.NUM(/1)-1 142 : NEL=IPT1.NUM(/2) 143 : IF(NP .NE. 2)THEN 144 : WRITE(IOIMP,*) 'Subroutine knrf.eso' 144 : CALL ERREUR(5) 145 : ENDIF 146 : C 147 : DO IEL=1,NEL,1 148 : NF=IPT1.NUM(NP+1,IEL) 149 : XF = XCOOR((NF-1)*(IDIM+1)+1) 150 : YF = XCOOR((NF-1)*(IDIM+1)+2) 151 : * 152 : IPO=IPT1.NUM(1,IEL) 153 : X1=XCOOR((IPO-1)*(IDIM+1)+1) 154 : Y1=XCOOR((IPO-1)*(IDIM+1)+2) 155 : DSURFX=Y1-YF 156 : DSURFY=XF-X1 157 : XSURF=DSURFX 158 : YSURF=DSURFY 159 : SURF=((DSURFX*DSURFX)+(DSURFY*DSURFY))**0.5D0 160 : * 161 : IPO=IPT1.NUM(2,IEL) 162 : X1=XCOOR((IPO-1)*(IDIM+1)+1) 163 : Y1=XCOOR((IPO-1)*(IDIM+1)+2) 164 : DSURFX=YF-Y1 165 : DSURFY=X1-XF 166 : XSURF=XSURF+DSURFX 167 : YSURF=YSURF+DSURFY 168 : SURF=SURF+(((DSURFX*DSURFX)+(DSURFY*DSURFY))**0.5D0) 169 : C 170 : NLCF=MLENTI.LECT(NF) 171 : MPOVSU.VPOCHA(NLCF,1)=SURF 172 : C 173 : C************* Orientation selon FACEL 174 : C 175 : IPO=MELFL.NUM(1,NLCF) 176 : X1=XCOOR((IPO-1)*(IDIM+1)+1) 177 : Y1=XCOOR((IPO-1)*(IDIM+1)+2) 178 : DSURFX=XF-X1 179 : DSURFY=YF-Y1 180 : ORIENT=SIGN(1.0D0,((DSURFX*XSURF)+(DSURFY*YSURF))) 181 : C 182 : MPOVNO.VPOCHA(NLCF,1)=XSURF/SURF*ORIENT 183 : MPOVNO.VPOCHA(NLCF,2)=YSURF/SURF*ORIENT 184 : C 185 : MPOVMR.VPOCHA(NLCF,3)=XSURF/SURF*ORIENT 186 : MPOVMR.VPOCHA(NLCF,4)=YSURF/SURF*ORIENT 187 : MPOVMR.VPOCHA(NLCF,1)=-1*YSURF/SURF*ORIENT 188 : MPOVMR.VPOCHA(NLCF,2)=XSURF/SURF*ORIENT 189 : C 190 : ENDDO 191 : IF(NBSOUS .NE. 1) SEGDES IPT1 192 : ENDDO 193 : C********************** 194 : C CAS DE LA DIMENSION 3 195 : C********************** 196 : ELSE 197 : C 198 : DO ISOUS=1,NBSOUS,1 199 : IPT1 = MELFP 200 : IF(NBSOUS .NE. 1)THEN 201 : IPT1 = MELFP.LISOUS(ISOUS) 202 : SEGACT IPT1 203 : ENDIF 204 : C 205 : NP=IPT1.NUM(/1)-1 206 : NEL=IPT1.NUM(/2) 207 : C 208 : DO IEL=1,NEL,1 209 : NF=IPT1.NUM(NP+1,IEL) 210 : XF = XCOOR((NF-1)*(IDIM+1)+1) 211 : YF = XCOOR((NF-1)*(IDIM+1)+2) 212 : ZF = XCOOR((NF-1)*(IDIM+1)+3) 213 : * 214 : IPO=IPT1.NUM(NP,IEL) 215 : DXP = XCOOR((IPO-1)*(IDIM+1)+1) - XF 216 : DYP = XCOOR((IPO-1)*(IDIM+1)+2) - YF 217 : DZP = XCOOR((IPO-1)*(IDIM+1)+3) - ZF 218 : SURF=0.0D0 219 : XSURF=0.0D0 220 : YSURF=0.0D0 221 : ZSURF=0.0D0 222 : DO IFAC=1,NP,1 223 : DXPM1 = DXP 224 : DYPM1 = DYP 225 : DZPM1 = DZP 226 : IPO=IPT1.NUM(IFAC,IEL) 227 : DXP = XCOOR((IPO-1)*(IDIM+1)+1) - XF 228 : DYP = XCOOR((IPO-1)*(IDIM+1)+2) - YF 229 : DZP = XCOOR((IPO-1)*(IDIM+1)+3) - ZF 230 : DSURFX = 0.5D0 * ((DYPM1 * DZP) - (DZPM1 * DYP)) 231 : DSURFY = 0.5D0 * ((DZPM1 * DXP) - (DXPM1 * DZP)) 232 : DSURFZ = 0.5D0 * ((DXPM1 * DYP) - (DYPM1 * DXP)) 233 : XSURF=XSURF+DSURFX 234 : YSURF=YSURF+DSURFY 235 : ZSURF=ZSURF+DSURFZ 236 : ENDDO 237 : * 238 : SURF=(XSURF*XSURF)+(YSURF*YSURF)+(ZSURF*ZSURF) 239 : SURF=SURF**0.5D0 240 : NLCF=MLENTI.LECT(NF) 241 : MPOVSU.VPOCHA(NLCF,1)=SURF 242 : C 243 : C************* Orientation selon FACEL 244 : C 245 : IPO=MELFL.NUM(1,NLCF) 246 : DSURFX=XF-XCOOR((IPO-1)*(IDIM+1)+1) 247 : DSURFY=YF-XCOOR((IPO-1)*(IDIM+1)+2) 248 : DSURFZ=ZF-XCOOR((IPO-1)*(IDIM+1)+3) 249 : ORIENT=SIGN(1.0D0,((DSURFX*XSURF)+(DSURFY*YSURF)+(DSURFZ 250 : & *ZSURF))) 251 : C 252 : MPOVNO.VPOCHA(NLCF,1)=XSURF/SURF*ORIENT 253 : MPOVNO.VPOCHA(NLCF,2)=YSURF/SURF*ORIENT 254 : MPOVNO.VPOCHA(NLCF,3)=ZSURF/SURF*ORIENT 255 : C 256 : C************* MATROT 257 : C 258 : C Normal 259 : C 260 : MPOVMR.VPOCHA(NLCF,7)=XSURF/SURF*ORIENT 261 : MPOVMR.VPOCHA(NLCF,8)=YSURF/SURF*ORIENT 262 : MPOVMR.VPOCHA(NLCF,9)=ZSURF/SURF*ORIENT 263 : 264 : C First direction (RX,RY,RZ) is normal to the 265 : C normal and FP (P = first point of FACEP) 266 : C 267 : IPO=IPT1.NUM(1,IEL) 268 : DXP = XCOOR((IPO-1)*(IDIM+1)+1) - XF 269 : DYP = XCOOR((IPO-1)*(IDIM+1)+2) - YF 270 : DZP = XCOOR((IPO-1)*(IDIM+1)+3) - ZF 271 : DSURFX = (ZSURF * DYP) - (YSURF * DZP) 272 : DSURFY = (XSURF * DZP) - (ZSURF * DXP) 273 : DSURFZ = (YSURF * DXP) - (XSURF * DYP) 274 : C 275 : C DZP=modulus of the RX,RY,RZ 276 : C 277 : DZP=(((DSURFX*DSURFX)+(DSURFY*DSURFY)+ 278 : & (DSURFZ*DSURFZ))**0.5D0) 279 : C 280 : MPOVMR.VPOCHA(NLCF,4)=DSURFX/DZP 281 : MPOVMR.VPOCHA(NLCF,5)=DSURFY/DZP 282 : MPOVMR.VPOCHA(NLCF,6)=DSURFZ/DZP 283 : C 284 : C (UX,UY,UZ,RX,RY,RZ,MX,MY,MZ)=(1,2,3,4,5,6,7,8,9) 285 : C M,R,U is a right-hand normal frame 286 : C 287 : RMX=MPOVMR.VPOCHA(NLCF,7) 288 : RMY=MPOVMR.VPOCHA(NLCF,8) 289 : RMZ=MPOVMR.VPOCHA(NLCF,9) 290 : RRX=MPOVMR.VPOCHA(NLCF,4) 291 : RRY=MPOVMR.VPOCHA(NLCF,5) 292 : RRZ=MPOVMR.VPOCHA(NLCF,6) 293 : C 294 : MPOVMR.VPOCHA(NLCF,1)=(RMY*RRZ) - (RMZ*RRY) 295 : MPOVMR.VPOCHA(NLCF,2)=(RMZ*RRX) - (RMX*RRZ) 296 : MPOVMR.VPOCHA(NLCF,3)=(RMX*RRY) - (RMY*RRX) 297 : ENDDO 298 : IF(NBSOUS .NE. 1) SEGDES IPT1 299 : ENDDO 300 : ENDIF 301 : C 302 : SEGDES MPOVSU 303 : SEGDES MPOVNO 304 : SEGDES MPOVMR 305 : SEGDES MELFP 306 : C 307 : SEGDES MELFL 308 : SEGSUP MLENTI 309 : C 310 : 9999 RETURN 311 : END 312 : 313 : 314 : 315 : 316 : 317 : 318 : 319 : 320 : 321 : 322 : 323 : 324 : 325 :
© Cast3M 2003 - All rights reserved.
Disclaimer