1 : C PAVE SOURCE CHAT 07/10/29 21:25:27 5940 2 : C PROCEDURE UTILISEE PAR PRPAVE POUR LE MAILLAGE DE CUBES. 3 : C 4 : SUBROUTINE PAVE(NX,NY,NZ,IPT1,IPT2,IPT3,IPT4,IPT5,IPT6) 5 : IMPLICIT INTEGER(I-N) 6 : -INC SMELEME 7 : -INC CCOPTIO 8 : -INC SMCOORD 9 : -INC CCGEOME 9 : IF (ILCOUR.NE.14.AND.ILCOUR.NE.15) CALL ERREUR(16) 10 : IF (IERR.NE.0) RETURN 11 : NBSOUS=0 12 : NBREF=6 13 : NBNN=8 14 : NBC=NX*NY 15 : NBELEM=NBC*NZ 16 : SEGINI IPT7 17 : IPT7.ITYPEL=14 18 : C 19 : NN1=IPT1.NUM(/1)/4 20 : NN2=IPT2.NUM(/1)/4 21 : NN3=IPT3.NUM(/1)/4 22 : NN4=IPT4.NUM(/1)/4 23 : NN5=IPT5.NUM(/1)/4 24 : NN6=IPT6.NUM(/1)/4 25 : I1=IPT1.NUM(1,1) 26 : I2=IPT4.NUM(1,1) 27 : I3=IPT6.NUM(NN6+1,NX) 28 : I4=IPT6.NUM(1,1) 29 : I5=IPT2.NUM(1,1) 30 : I6=IPT2.NUM(NN2+1,NX) 31 : I7=IPT2.NUM(2*NN2+1,NBC) 32 : I8=IPT3.NUM(2*NN3+1,NY*NZ) 33 : C 34 : C NUMEROTATION FACE 1 35 : C 36 : IPT7.NUM(1,1)=I1 37 : IF(NX.EQ.1) GOTO 15 38 : C 39 : DO 10 I=2,NX 40 : IPT7.NUM(1,I)=IPT1.NUM(1,I) 41 : IPT7.NUM(2,I-1)=IPT1.NUM(NN1+1,I-1) 42 : 10 CONTINUE 43 : 15 IPT7.NUM(2,NX)=I2 44 : IF(NY.EQ.1) GOTO 35 45 : C 46 : DO 30 N=2,NY 47 : IPT7.NUM(4,(N-2)*NX+1)=IPT1.NUM(3*NN1+1,(N-2)*NX+1) 48 : IPT7.NUM(1,(N-1)*NX+1)=IPT1.NUM(1,(N-1)*NX+1) 49 : IF(NX.EQ.1) GOTO 25 50 : C 51 : DO 20 I=2,NX 52 : IPOINT=IPT1.NUM(3*NN1+1,(N-2)*NX+I) 53 : IPT7.NUM(4,(N-2)*NX+I)=IPOINT 54 : IPT7.NUM(3,(N-2)*NX+I-1)=IPOINT 55 : IPT7.NUM(1,(N-1)*NX+I)=IPOINT 56 : IPT7.NUM(2,(N-1)*NX+I-1)=IPOINT 57 : 20 CONTINUE 58 : 25 IPT7.NUM(3,(N-1)*NX)=IPT1.NUM(2*NN1+1,(N-1)*NX) 59 : IPT7.NUM(2,N*NX)=IPT1.NUM(NN1+1,N*NX) 60 : 30 CONTINUE 61 : 35 IPT7.NUM(4,(NY-1)*NX+1)=I4 62 : IF(NX.EQ.1) GOTO 45 63 : C 64 : DO 40 N=2,NX 65 : IPT7.NUM(4,(NY-1)*NX+N)=IPT1.NUM(3*NN1+1,(NY-1)*NX+N) 66 : IPT7.NUM(3,(NY-1)*NX+N-1)=IPT1.NUM(2*NN1+1,(NY-1)*NX+N-1) 67 : 40 CONTINUE 68 : 45 IPT7.NUM(3,NBC)=I3 69 : C 70 : C `COUCHES` INTERMEDIAIRES 71 : C 72 : IF(NZ.EQ.1) GOTO 105 73 : C 74 : NBPTA=XCOOR(/1)/4 75 : NBPTS=NBPTA+(NY-1)*(NX-1)*(NZ-1) 76 : SEGADJ MCOORD 77 : DO 100 J=2,NZ 78 : C 79 : C 1ERE RANGEE 80 : IPT7.NUM(1,(J-1)*NBC+1)=IPT5.NUM(1,(J-1)*NX+1) 81 : IPT7.NUM(5,(J-2)*NBC+1)=IPT5.NUM(1,(J-1)*NX+1) 82 : IF(NX.EQ.1) GOTO 55 83 : C 84 : DO 50 I=2,NX 85 : IPOINT=IPT5.NUM(1,(J-1)*NX+I) 86 : IPT7.NUM(1,(J-1)*NBC+I)=IPOINT 87 : IPT7.NUM(5,(J-2)*NBC+I)=IPOINT 88 : IPT7.NUM(2,(J-1)*NBC+I-1)=IPOINT 89 : IPT7.NUM(6,(J-2)*NBC+I-1)=IPOINT 90 : 50 CONTINUE 91 : 55 IPT7.NUM(2,(J-1)*NBC+NX)=IPT5.NUM(NN5+1,J*NX) 92 : IPT7.NUM(6,(J-2)*NBC+NX)=IPT5.NUM(NN5+1,J*NX) 93 : C 94 : C RANGEES SUIVANTES 95 : IF(NY.EQ.1) GOTO 85 96 : C 97 : DO 80 N=2,NY 98 : IPOINT=IPT3.NUM(1,(J-1)*NY+N) 99 : IPT7.NUM(1,(J-1)*NBC+(N-1)*NX+1)=IPOINT 100 : IPT7.NUM(5,(J-2)*NBC+(N-1)*NX+1)=IPOINT 101 : IPT7.NUM(4,(J-1)*NBC+(N-2)*NX+1)=IPOINT 102 : IPT7.NUM(8,(J-2)*NBC+(N-2)*NX+1)=IPOINT 103 : IF (NX.EQ.1) GOTO 75 104 : C 105 : DO 70 I=2,NX 106 : C 107 : C CREATION DU POINT COURANT 108 : IPL=I-1 109 : JPL=J-1 110 : NPL=N-1 111 : C 112 : DO 60 K=1,4 113 : XINT=(XCOOR(4*(I1-1)+K)*(NX-IPL)*(NZ-JPL)*(NY-NPL) 114 : 1 +XCOOR(4*(I5-1)+K)*(NX-IPL)*JPL*(NY-NPL) 115 : 2 +XCOOR(4*(I2-1)+K)*IPL*(NZ-JPL)*(NY-NPL) 116 : 3 +XCOOR(4*(I6-1)+K)*IPL*JPL*(NY-NPL) 117 : 4 +XCOOR(4*(I3-1)+K)*IPL*(NZ-JPL)*NPL 118 : 5 +XCOOR(4*(I7-1)+K)*IPL*JPL*NPL 119 : 6 +XCOOR(4*(I4-1)+K)*(NX-IPL)*(NZ-JPL)*NPL 120 : 7 +XCOOR(4*(I8-1)+K)*(NX-IPL)*JPL*NPL)/NBELEM 121 : C 122 : IND1=IPT1.NUM(NN1+1,NPL*NX+IPL) 123 : IND2=IPT2.NUM(NN2+1,NPL*NX+IPL) 124 : IND3=IPT3.NUM(NN3+1,JPL*NY+NPL) 125 : IND4=IPT4.NUM(NN4+1,JPL*NY+NPL) 126 : IND5=IPT5.NUM(NN5+1,JPL*NX+IPL) 127 : IND6=IPT6.NUM(NN6+1,JPL*NX+IPL) 128 : COFAC=(XCOOR(4*(IND1-1)+K)*(NZ-JPL)+XCOOR(4* 129 : 1 (IND2-1)+K)*JPL)/NZ+(XCOOR(4*(IND3-1)+K)*(NX-IPL)+ 130 : 2 XCOOR(4*(IND4-1)+K)*IPL)/NX+(XCOOR(4*(IND5-1)+K)* 131 : 3 (NY-NPL)+XCOOR(4*(IND6-1)+K)*NPL)/NY 132 : C 133 : I13=IPT3.NUM(NN3+1,NPL) 134 : I14=IPT4.NUM(NN4+1,NPL) 135 : I15=IPT5.NUM(NN5+1,IPL) 136 : I16=IPT6.NUM(NN6+1,IPL) 137 : I23=IPT2.NUM(1,NPL*NX+1) 138 : I24=IPT2.NUM(NN2+1,(NPL+1)*NX) 139 : I25=IPT2.NUM(NN2+1,IPL) 140 : I26=IPT2.NUM(2*NN2+1,(NY-1)*NX+IPL) 141 : I35=IPT3.NUM(1,JPL*NY+1) 142 : I36=IPT3.NUM(NN3+1,(JPL+1)*NY) 143 : I45=IPT4.NUM(1,JPL*NY+1) 144 : I46=IPT4.NUM(NN4+1,(JPL+1)*NY) 145 : COAR=((XCOOR(4*(I35-1)+K)*(NX-IPL)+XCOOR(4*(I45-1)+K) 146 : 1 *IPL)*(NY-NPL)+(XCOOR(4*(I36-1)+K)*(NX-IPL)+ 147 : 2 XCOOR(4*(I46-1)+K)*IPL)*NPL)/NBC 148 : COAR=COAR+((XCOOR(4*(I13-1)+K)*(NX-IPL)+XCOOR(4*(I14 149 : 1 -1)+K)*IPL)*(NZ-JPL)+(XCOOR(4*(I23-1)+K)*(NX-IPL) 150 : 2 +XCOOR(4*(I24-1)+K)*IPL)*JPL)/(NX*NZ) 151 : COAR=COAR+((XCOOR(4*(I15-1)+K)*(NY-NPL)+XCOOR(4*(I16 152 : 1 -1)+K)*NPL)*(NZ-JPL)+(XCOOR(4*(I25-1)+K)*(NY-NPL) 153 : 2 +XCOOR(4*(I26-1)+K)*NPL)*JPL)/(NY*NZ) 154 : C 155 : XCOOR(NBPTA*4+K)=XINT+COFAC-COAR 156 : 60 CONTINUE 157 : NBPTA=NBPTA+1 158 : C 159 : IPOINT=NBPTA 160 : IPT7.NUM(1,(N-1)*NX+(J-1)*NBC+I)=IPOINT 161 : IPT7.NUM(5,(N-1)*NX+(J-2)*NBC+I)=IPOINT 162 : IPT7.NUM(2,(N-1)*NX+(J-1)*NBC+I-1)=IPOINT 163 : IPT7.NUM(6,(N-1)*NX+(J-2)*NBC+I-1)=IPOINT 164 : IPT7.NUM(3,(N-2)*NX+(J-1)*NBC+I-1)=IPOINT 165 : IPT7.NUM(7,(N-2)*NX+(J-2)*NBC+I-1)=IPOINT 166 : IPT7.NUM(4,(N-2)*NX+(J-1)*NBC+I)=IPOINT 167 : IPT7.NUM(8,(N-2)*NX+(J-2)*NBC+I)=IPOINT 168 : 70 CONTINUE 169 : 75 IPOINT=IPT4.NUM(1,(J-1)*NY+N) 170 : IPT7.NUM(3,(N-1)*NX+(J-1)*NBC)=IPOINT 171 : IPT7.NUM(2,N*NX+(J-1)*NBC)=IPOINT 172 : IPT7.NUM(7,(N-1)*NX+(J-2)*NBC)=IPOINT 173 : IPT7.NUM(6,N*NX+(J-2)*NBC)=IPOINT 174 : 80 CONTINUE 175 : C 176 : C DERNIERE RANGEE 177 : 85 IPT7.NUM(4,(NY-1)*NX+(J-1)*NBC+1)=IPT6.NUM(1,(J-1)*NX+1) 178 : IPT7.NUM(8,(NY-1)*NX+(J-2)*NBC+1)=IPT6.NUM(1,(J-1)*NX+1) 179 : IF(NX.EQ.1) GOTO 95 180 : C 181 : DO 90 I=2,NX 182 : IPOINT=IPT6.NUM(1,(J-1)*NX+I) 183 : IPT7.NUM(4,(NY-1)*NX+(J-1)*NBC+I)=IPOINT 184 : IPT7.NUM(8,(NY-1)*NX+(J-2)*NBC+I)=IPOINT 185 : IPT7.NUM(3,(NY-1)*NX+(J-1)*NBC+I-1)=IPOINT 186 : IPT7.NUM(7,(NY-1)*NX+(J-2)*NBC+I-1)=IPOINT 187 : 90 CONTINUE 188 : 95 IPT7.NUM(3,J*NBC)=IPT6.NUM(NN6+1,J*NX) 189 : IPT7.NUM(7,(J-1)*NBC)=IPT6.NUM(NN6+1,J*NX) 190 : 100 CONTINUE 191 : C 192 : C DERNIERE COUCHE = FACE 2 193 : C 194 : 105 IND=NBC*(NZ-1) 195 : IPT7.NUM(5,IND+1)=I5 196 : IF(NX.EQ.1) GOTO 115 197 : C 198 : DO 110 I=2,NX 199 : IPT7.NUM(5,IND+I)=IPT2.NUM(1,I) 200 : IPT7.NUM(6,IND+I-1)=IPT2.NUM(NN2+1,I-1) 201 : 110 CONTINUE 202 : 115 IPT7.NUM(6,NX+IND)=I6 203 : IF(NY.EQ.1) GOTO 135 204 : C 205 : DO 130 N=2,NY 206 : IPT7.NUM(8,IND+(N-2)*NX+1)=IPT2.NUM(3*NN2+1,(N-2)*NX+1) 207 : IPT7.NUM(5,IND+(N-1)*NX+1)=IPT2.NUM(1,(N-1)*NX+1) 208 : IF(NX.EQ.1) GOTO 125 209 : C 210 : DO 120 I=2,NX 211 : IPOINT=IPT2.NUM(3*NN2+1,(N-2)*NX+I) 212 : IPT7.NUM(8,IND+(N-2)*NX+I)=IPOINT 213 : IPT7.NUM(7,IND+(N-2)*NX+I-1)=IPOINT 214 : IPT7.NUM(5,IND+(N-1)*NX+I)=IPOINT 215 : IPT7.NUM(6,IND+(N-1)*NX+I-1)=IPOINT 216 : 120 CONTINUE 217 : 125 IPT7.NUM(7,IND+(N-1)*NX)=IPT2.NUM(2*NN2+1,(N-1)*NX) 218 : IPT7.NUM(6,IND+N*NX)=IPT2.NUM(NN2+1,N*NX) 219 : 130 CONTINUE 220 : 135 IPT7.NUM(8,IND+(NY-1)*NX+1)=I8 221 : IF(NX.EQ.1) GOTO 145 222 : C 223 : DO 140 N=2,NX 224 : IPT7.NUM(8,IND+(NY-1)*NX+N)=IPT2.NUM(3*NN2+1,(NY-1)*NX+N) 225 : IPT7.NUM(7,IND+(NY-1)*NX+N-1)=IPT2.NUM(2*NN2+1,(NY-1)*NX+N-1) 226 : 140 CONTINUE 227 : 145 IPT7.NUM(7,IND+NBC)=I7 228 : C 229 : IPT7.LISREF(1)=IPT1 230 : IPT7.LISREF(2)=IPT2 231 : IPT7.LISREF(3)=IPT3 232 : IPT7.LISREF(4)=IPT4 233 : IPT7.LISREF(5)=IPT5 234 : IPT7.LISREF(6)=IPT6 235 : ITY=ILCOUR 235 : CALL CHANGE(IPT7,ITY) 235 : CALL ECROBJ('MAILLAGE',IPT7) 236 : SEGDES IPT7 237 : RETURN 238 : END 239 : 240 : 241 : 242 : 243 : 244 : 245 :
© Cast3M 2003 - All rights reserved.
Disclaimer