1 : C KDOM8 SOURCE CHAT 05/01/13 00:54:34 5004 2 : SUBROUTINE KDOM8(NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10, 3 : & NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20, 4 : & NN21) 5 : C 6 : C************************************************************************ 7 : C 8 : C PROJET : CASTEM 2000 9 : C 10 : C NOM : KDOM8 11 : C 12 : C DESCRIPTION : This subroutine check whether NN21 is inside of 13 : C the PR21 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, 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=NN3 48 : IPL=NN5 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((NN21-1)*(IDIM+1)+1) 70 : DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)- 71 : & XCOOR((NN21-1)*(IDIM+1)+2) 72 : DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)- 73 : & XCOOR((NN21-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,13 79 : IF(I1.EQ.1)THEN 80 : IPCEN=NN10 81 : IPR=NN14 82 : IPL=NN12 83 : ELSEIF(I1.EQ.2)THEN 84 : IPCEN=NN1 85 : IPR=NN18 86 : IPL=NN10 87 : ELSEIF(I1.EQ.3)THEN 88 : IPCEN=NN5 89 : IPR=NN18 90 : IPL=NN1 91 : ELSEIF(I1.EQ.4)THEN 92 : IPCEN=NN14 93 : IPR=NN18 94 : IPL=NN5 95 : ELSEIF(I1.EQ.5)THEN 96 : IPCEN=NN10 97 : IPR=NN18 98 : IPL=NN14 99 : ELSEIF(I1.EQ.6)THEN 100 : IPCEN=NN5 101 : IPR=NN17 102 : IPL=NN14 103 : ELSEIF(I1.EQ.7)THEN 104 : IPCEN=NN3 105 : IPR=NN17 106 : IPL=NN5 107 : ELSEIF(I1.EQ.8)THEN 108 : IPCEN=NN12 109 : IPR=NN17 110 : IPL=NN3 111 : ELSEIF(I1.EQ.9)THEN 112 : IPCEN=NN14 113 : IPR=NN17 114 : IPL=NN12 115 : ELSEIF(I1.EQ.10)THEN 116 : IPCEN=NN3 117 : IPR=NN16 118 : IPL=NN12 119 : ELSEIF(I1.EQ.11)THEN 120 : IPCEN=NN1 121 : IPR=NN16 122 : IPL=NN3 123 : ELSEIF(I1.EQ.12)THEN 124 : IPCEN=NN10 125 : IPR=NN16 126 : IPL=NN1 127 : ELSEIF(I1.EQ.13)THEN 128 : IPCEN=NN12 129 : IPR=NN16 130 : IPL=NN10 131 : ENDIF 132 : DX0=XCOOR((IPR-1)*(IDIM+1)+1)- 133 : & XCOOR((IPCEN-1)*(IDIM+1)+1) 134 : DY0=XCOOR((IPR-1)*(IDIM+1)+2)- 135 : & XCOOR((IPCEN-1)*(IDIM+1)+2) 136 : DZ0=XCOOR((IPR-1)*(IDIM+1)+3)- 137 : & XCOOR((IPCEN-1)*(IDIM+1)+3) 138 : DX1=XCOOR((IPL-1)*(IDIM+1)+1)- 139 : & XCOOR((IPCEN-1)*(IDIM+1)+1) 140 : DY1=XCOOR((IPL-1)*(IDIM+1)+2)- 141 : & XCOOR((IPCEN-1)*(IDIM+1)+2) 142 : DZ1=XCOOR((IPL-1)*(IDIM+1)+3)- 143 : & XCOOR((IPCEN-1)*(IDIM+1)+3) 144 : NORX1=(DY0*DZ1-DY1*DZ0) 145 : NORY1=(DZ0*DX1-DZ1*DX0) 146 : NORZ1=(DX0*DY1-DX1*DY0) 147 : C 148 : C The scalar product between this normal and 149 : C CENTRE-IPCEN 150 : C 151 : DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)- 152 : & XCOOR((NN21-1)*(IDIM+1)+1) 153 : DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)- 154 : & XCOOR((NN21-1)*(IDIM+1)+2) 155 : DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)- 156 : & XCOOR((NN21-1)*(IDIM+1)+3) 157 : PSCA1=DX1*NORX1+DY1*NORY1+DZ1*NORZ1 158 : IF((PSCA1*PSCA0) .LT.0)THEN 159 : C 160 : WRITE(IOIMP,*) 'Subroutine kdom8.eso' 161 : WRITE(IOIMP,*) 'PR21' 162 : C 163 : C Erreur -107 0 164 : C Liste des noeuds de l'élément : 165 : C 165 : CALL ERREUR(-107) 166 : WRITE(IOIMP,*) NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10 167 : WRITE(IOIMP,*) NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19 168 : $ ,NN20 169 : WRITE(IOIMP,*) NN21 170 : C 171 : C Erreur 845 2 172 : C Maillage donné incorrect ?!!! 173 : C 173 : CALL ERREUR(845) 174 : C 175 : GOTO 9999 176 : ENDIF 177 : ENDDO 178 : C 179 : 9999 RETURN 180 : END 181 : 182 :
© Cast3M 2003 - All rights reserved.
Disclaimer