1 : C KDOM9 SOURCE CHAT 05/01/13 00:54:38 5004 2 : SUBROUTINE KDOM9(NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10, 3 : & NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20, 4 : & NN21,NN22,NN23,NN24,NN25,NN26,NN27) 5 : C 6 : C************************************************************************ 7 : C 8 : C PROJET : CASTEM 2000 9 : C 10 : C NOM : KDOM9 11 : C 12 : C DESCRIPTION : This subroutine check whether NN27 is inside of 13 : C the CU27 14 : C 15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 16 : C 17 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF 18 : C 19 : C************************************************************************ 20 : C 21 : C 22 : C**** Variables de COOPTIO 23 : C 24 : IMPLICIT INTEGER(I-N) 25 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 26 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 27 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 28 : & ,IECHO, IIMPI, IOSPI 29 : & ,IDIM, IFICLE, IPREFI 30 : C & ,MCOORD 31 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 32 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 33 : & ,NORINC,NORVAL,NORIND,NORVAD 34 : & ,NUCROU, IPSAUV, IREFOR, ISAFOR 35 : C 36 : INTEGER NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10, 37 : & NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20, 38 : & NN21,NN22,NN23,NN24,NN25,NN26,NN27, I1, IPCEN, IPL, IPR 39 : REAL*8 DX0,DY0,DZ0,DX1,DY1,DZ1,NORX1,NORY1,NORZ1,PSCA0,PSCA1 40 : C 41 : -INC CCOPTIO 42 : -INC SMCOORD 43 : C 44 : C**** First triangle 45 : C 46 : IPCEN=NN1 47 : IPR=NN25 48 : IPL=NN7 49 : DX0=XCOOR((IPR-1)*(IDIM+1)+1)- 50 : & XCOOR((IPCEN-1)*(IDIM+1)+1) 51 : DY0=XCOOR((IPR-1)*(IDIM+1)+2)- 52 : & XCOOR((IPCEN-1)*(IDIM+1)+2) 53 : DZ0=XCOOR((IPR-1)*(IDIM+1)+3)- 54 : & XCOOR((IPCEN-1)*(IDIM+1)+3) 55 : DX1=XCOOR((IPL-1)*(IDIM+1)+1)- 56 : & XCOOR((IPCEN-1)*(IDIM+1)+1) 57 : DY1=XCOOR((IPL-1)*(IDIM+1)+2)- 58 : & XCOOR((IPCEN-1)*(IDIM+1)+2) 59 : DZ1=XCOOR((IPL-1)*(IDIM+1)+3)- 60 : & XCOOR((IPCEN-1)*(IDIM+1)+3) 61 : NORX1=(DY0*DZ1-DY1*DZ0) 62 : NORY1=(DZ0*DX1-DZ1*DX0) 63 : NORZ1=(DX0*DY1-DX1*DY0) 64 : C 65 : C The scalar product between this normal and 66 : C CENTRE-IPCEN 67 : C 68 : DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)- 69 : & XCOOR((NN27-1)*(IDIM+1)+1) 70 : DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)- 71 : & XCOOR((NN27-1)*(IDIM+1)+2) 72 : DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)- 73 : & XCOOR((NN27-1)*(IDIM+1)+3) 74 : PSCA0=DX1*NORX1+DY1*NORY1+DZ1*NORZ1 75 : C 76 : C The other triangles 77 : C 78 : DO I1=1,23 79 : IF(I1.EQ.1)THEN 80 : IPCEN=NN3 81 : IPR=NN25 82 : IPL=NN1 83 : ELSEIF(I1.EQ.2)THEN 84 : IPCEN=NN5 85 : IPR=NN25 86 : IPL=NN3 87 : ELSEIF(I1.EQ.3)THEN 88 : IPCEN=NN7 89 : IPR=NN25 90 : IPL=NN5 91 : ELSEIF(I1.EQ.4)THEN 92 : IPCEN=NN13 93 : IPR=NN26 94 : IPL=NN15 95 : ELSEIF(I1.EQ.5)THEN 96 : IPCEN=NN19 97 : IPR=NN26 98 : IPL=NN13 99 : ELSEIF(I1.EQ.6)THEN 100 : IPCEN=NN17 101 : IPR=NN26 102 : IPL=NN19 103 : ELSEIF(I1.EQ.7)THEN 104 : IPCEN=NN15 105 : IPR=NN26 106 : IPL=NN17 107 : ELSEIF(I1.EQ.8)THEN 108 : IPCEN=NN1 109 : IPR=NN21 110 : IPL=NN3 111 : ELSEIF(I1.EQ.9)THEN 112 : IPCEN=NN13 113 : IPR=NN21 114 : IPL=NN1 115 : ELSEIF(I1.EQ.10)THEN 116 : IPCEN=NN15 117 : IPR=NN21 118 : IPL=NN13 119 : ELSEIF(I1.EQ.11)THEN 120 : IPCEN=NN3 121 : IPR=NN21 122 : IPL=NN15 123 : ELSEIF(I1.EQ.12)THEN 124 : IPCEN=NN3 125 : IPR=NN22 126 : IPL=NN5 127 : ELSEIF(I1.EQ.13)THEN 128 : IPCEN=NN15 129 : IPR=NN22 130 : IPL=NN3 131 : ELSEIF(I1.EQ.14)THEN 132 : IPCEN=NN17 133 : IPR=NN22 134 : IPL=NN15 135 : ELSEIF(I1.EQ.15)THEN 136 : IPCEN=NN5 137 : IPR=NN22 138 : IPL=NN17 139 : ELSEIF(I1.EQ.16)THEN 140 : IPCEN=NN7 141 : IPR=NN23 142 : IPL=NN19 143 : ELSEIF(I1.EQ.17)THEN 144 : IPCEN=NN5 145 : IPR=NN23 146 : IPL=NN7 147 : ELSEIF(I1.EQ.18)THEN 148 : IPCEN=NN17 149 : IPR=NN23 150 : IPL=NN5 151 : ELSEIF(I1.EQ.19)THEN 152 : IPCEN=NN19 153 : IPR=NN23 154 : IPL=NN17 155 : ELSEIF(I1.EQ.20)THEN 156 : IPCEN=NN1 157 : IPR=NN24 158 : IPL=NN13 159 : ELSEIF(I1.EQ.21)THEN 160 : IPCEN=NN7 161 : IPR=NN24 162 : IPL=NN1 163 : ELSEIF(I1.EQ.22)THEN 164 : IPCEN=NN19 165 : IPR=NN24 166 : IPL=NN7 167 : ELSEIF(I1.EQ.23)THEN 168 : IPCEN=NN13 169 : IPR=NN24 170 : IPL=NN19 171 : ENDIF 172 : DX0=XCOOR((IPR-1)*(IDIM+1)+1)- 173 : & XCOOR((IPCEN-1)*(IDIM+1)+1) 174 : DY0=XCOOR((IPR-1)*(IDIM+1)+2)- 175 : & XCOOR((IPCEN-1)*(IDIM+1)+2) 176 : DZ0=XCOOR((IPR-1)*(IDIM+1)+3)- 177 : & XCOOR((IPCEN-1)*(IDIM+1)+3) 178 : DX1=XCOOR((IPL-1)*(IDIM+1)+1)- 179 : & XCOOR((IPCEN-1)*(IDIM+1)+1) 180 : DY1=XCOOR((IPL-1)*(IDIM+1)+2)- 181 : & XCOOR((IPCEN-1)*(IDIM+1)+2) 182 : DZ1=XCOOR((IPL-1)*(IDIM+1)+3)- 183 : & XCOOR((IPCEN-1)*(IDIM+1)+3) 184 : NORX1=(DY0*DZ1-DY1*DZ0) 185 : NORY1=(DZ0*DX1-DZ1*DX0) 186 : NORZ1=(DX0*DY1-DX1*DY0) 187 : C 188 : C The scalar product between this normal and 189 : C CENTRE-IPCEN 190 : C 191 : DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)- 192 : & XCOOR((NN27-1)*(IDIM+1)+1) 193 : DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)- 194 : & XCOOR((NN27-1)*(IDIM+1)+2) 195 : DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)- 196 : & XCOOR((NN27-1)*(IDIM+1)+3) 197 : PSCA1=DX1*NORX1+DY1*NORY1+DZ1*NORZ1 198 : IF((PSCA1*PSCA0) .LT.0)THEN 199 : C 200 : WRITE(IOIMP,*) 'CU27' 201 : C 202 : C Erreur -107 0 203 : C Liste des noeuds de l'élément : 204 : C 205 : WRITE(IOIMP,*) 'Subroutine kdom9.eso' 205 : CALL ERREUR(-107) 206 : WRITE(IOIMP,*) NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10 207 : WRITE(IOIMP,*) NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19 208 : $ ,NN20 209 : WRITE(IOIMP,*) NN21,NN22,NN23,NN24,NN25,NN26,NN27 210 : C 211 : C Erreur 845 2 212 : C Maillage donné incorrect ?!!! 213 : C 213 : CALL ERREUR(845) 214 : C 215 : GOTO 9999 216 : ENDIF 217 : ENDDO 218 : C 219 : 9999 RETURN 220 : END 221 : 222 :
© Cast3M 2003 - All rights reserved.
Disclaimer