Numérotation des lignes :

pave
C PAVE      SOURCE    PV        20/03/24    21:20:01     10554          C    PROCEDURE UTILISEE PAR PRPAVE POUR LE MAILLAGE DE CUBES.C       SUBROUTINE PAVE(NX,NY,NZ,IPT1,IPT2,IPT3,IPT4,IPT5,IPT6)      IMPLICIT INTEGER(I-N)-INC SMELEME -INC PPARAM-INC CCOPTIO-INC SMCOORD-INC CCGEOME      IF (ILCOUR.NE.14.AND.ILCOUR.NE.15) CALL ERREUR(16)      IF (IERR.NE.0) RETURN       NBSOUS=0       NBREF=6       NBNN=8       NBC=NX*NY       NBELEM=NBC*NZ       SEGINI IPT7       IPT7.ITYPEL=14C       NN1=IPT1.NUM(/1)/4       NN2=IPT2.NUM(/1)/4       NN3=IPT3.NUM(/1)/4       NN4=IPT4.NUM(/1)/4       NN5=IPT5.NUM(/1)/4       NN6=IPT6.NUM(/1)/4       I1=IPT1.NUM(1,1)       I2=IPT4.NUM(1,1)       I3=IPT6.NUM(NN6+1,NX)       I4=IPT6.NUM(1,1)       I5=IPT2.NUM(1,1)       I6=IPT2.NUM(NN2+1,NX)       I7=IPT2.NUM(2*NN2+1,NBC)       I8=IPT3.NUM(2*NN3+1,NY*NZ)CC        NUMEROTATION FACE 1C       IPT7.NUM(1,1)=I1       IF(NX.EQ.1) GOTO 15C       DO 10 I=2,NX       IPT7.NUM(1,I)=IPT1.NUM(1,I)       IPT7.NUM(2,I-1)=IPT1.NUM(NN1+1,I-1)10     CONTINUE15     IPT7.NUM(2,NX)=I2       IF(NY.EQ.1) GOTO 35C       DO 30 N=2,NY       IPT7.NUM(4,(N-2)*NX+1)=IPT1.NUM(3*NN1+1,(N-2)*NX+1)       IPT7.NUM(1,(N-1)*NX+1)=IPT1.NUM(1,(N-1)*NX+1)       IF(NX.EQ.1) GOTO 25C       DO 20 I=2,NX       IPOINT=IPT1.NUM(3*NN1+1,(N-2)*NX+I)       IPT7.NUM(4,(N-2)*NX+I)=IPOINT       IPT7.NUM(3,(N-2)*NX+I-1)=IPOINT       IPT7.NUM(1,(N-1)*NX+I)=IPOINT       IPT7.NUM(2,(N-1)*NX+I-1)=IPOINT20     CONTINUE25     IPT7.NUM(3,(N-1)*NX)=IPT1.NUM(2*NN1+1,(N-1)*NX)       IPT7.NUM(2,N*NX)=IPT1.NUM(NN1+1,N*NX)30     CONTINUE35     IPT7.NUM(4,(NY-1)*NX+1)=I4       IF(NX.EQ.1) GOTO 45C       DO 40 N=2,NX       IPT7.NUM(4,(NY-1)*NX+N)=IPT1.NUM(3*NN1+1,(NY-1)*NX+N)       IPT7.NUM(3,(NY-1)*NX+N-1)=IPT1.NUM(2*NN1+1,(NY-1)*NX+N-1)40     CONTINUE45     IPT7.NUM(3,NBC)=I3CC        COUCHES INTERMEDIAIRESC       IF(NZ.EQ.1) GOTO 105C       segact mcoord*mod       NBPTA=nbpts       NBPTS=NBPTA+(NY-1)*(NX-1)*(NZ-1)       SEGADJ MCOORD       DO 100 J=2,NZCC         1ERE RANGEE       IPT7.NUM(1,(J-1)*NBC+1)=IPT5.NUM(1,(J-1)*NX+1)       IPT7.NUM(5,(J-2)*NBC+1)=IPT5.NUM(1,(J-1)*NX+1)       IF(NX.EQ.1) GOTO 55C       DO 50 I=2,NX       IPOINT=IPT5.NUM(1,(J-1)*NX+I)       IPT7.NUM(1,(J-1)*NBC+I)=IPOINT       IPT7.NUM(5,(J-2)*NBC+I)=IPOINT       IPT7.NUM(2,(J-1)*NBC+I-1)=IPOINT       IPT7.NUM(6,(J-2)*NBC+I-1)=IPOINT50     CONTINUE55     IPT7.NUM(2,(J-1)*NBC+NX)=IPT5.NUM(NN5+1,J*NX)       IPT7.NUM(6,(J-2)*NBC+NX)=IPT5.NUM(NN5+1,J*NX)CC        RANGEES SUIVANTES       IF(NY.EQ.1) GOTO 85C       DO 80 N=2,NY       IPOINT=IPT3.NUM(1,(J-1)*NY+N)       IPT7.NUM(1,(J-1)*NBC+(N-1)*NX+1)=IPOINT       IPT7.NUM(5,(J-2)*NBC+(N-1)*NX+1)=IPOINT       IPT7.NUM(4,(J-1)*NBC+(N-2)*NX+1)=IPOINT       IPT7.NUM(8,(J-2)*NBC+(N-2)*NX+1)=IPOINT       IF (NX.EQ.1) GOTO 75C       DO 70 I=2,NXCC      CREATION DU POINT COURANT       IPL=I-1       JPL=J-1       NPL=N-1C       DO 60 K=1,4       XINT=(XCOOR(4*(I1-1)+K)*(NX-IPL)*(NZ-JPL)*(NY-NPL)     1 +XCOOR(4*(I5-1)+K)*(NX-IPL)*JPL*(NY-NPL)     2 +XCOOR(4*(I2-1)+K)*IPL*(NZ-JPL)*(NY-NPL)     3 +XCOOR(4*(I6-1)+K)*IPL*JPL*(NY-NPL)     4 +XCOOR(4*(I3-1)+K)*IPL*(NZ-JPL)*NPL     5 +XCOOR(4*(I7-1)+K)*IPL*JPL*NPL     6 +XCOOR(4*(I4-1)+K)*(NX-IPL)*(NZ-JPL)*NPL     7 +XCOOR(4*(I8-1)+K)*(NX-IPL)*JPL*NPL)/NBELEMC       IND1=IPT1.NUM(NN1+1,NPL*NX+IPL)       IND2=IPT2.NUM(NN2+1,NPL*NX+IPL)       IND3=IPT3.NUM(NN3+1,JPL*NY+NPL)       IND4=IPT4.NUM(NN4+1,JPL*NY+NPL)       IND5=IPT5.NUM(NN5+1,JPL*NX+IPL)       IND6=IPT6.NUM(NN6+1,JPL*NX+IPL)       COFAC=(XCOOR(4*(IND1-1)+K)*(NZ-JPL)+XCOOR(4*     1 (IND2-1)+K)*JPL)/NZ+(XCOOR(4*(IND3-1)+K)*(NX-IPL)+     2 XCOOR(4*(IND4-1)+K)*IPL)/NX+(XCOOR(4*(IND5-1)+K)*     3 (NY-NPL)+XCOOR(4*(IND6-1)+K)*NPL)/NYC       I13=IPT3.NUM(NN3+1,NPL)       I14=IPT4.NUM(NN4+1,NPL)       I15=IPT5.NUM(NN5+1,IPL)       I16=IPT6.NUM(NN6+1,IPL)       I23=IPT2.NUM(1,NPL*NX+1)       I24=IPT2.NUM(NN2+1,(NPL+1)*NX)       I25=IPT2.NUM(NN2+1,IPL)       I26=IPT2.NUM(2*NN2+1,(NY-1)*NX+IPL)       I35=IPT3.NUM(1,JPL*NY+1)       I36=IPT3.NUM(NN3+1,(JPL+1)*NY)       I45=IPT4.NUM(1,JPL*NY+1)       I46=IPT4.NUM(NN4+1,(JPL+1)*NY)       COAR=((XCOOR(4*(I35-1)+K)*(NX-IPL)+XCOOR(4*(I45-1)+K)     1 *IPL)*(NY-NPL)+(XCOOR(4*(I36-1)+K)*(NX-IPL)+     2 XCOOR(4*(I46-1)+K)*IPL)*NPL)/NBC       COAR=COAR+((XCOOR(4*(I13-1)+K)*(NX-IPL)+XCOOR(4*(I14     1 -1)+K)*IPL)*(NZ-JPL)+(XCOOR(4*(I23-1)+K)*(NX-IPL)     2 +XCOOR(4*(I24-1)+K)*IPL)*JPL)/(NX*NZ)       COAR=COAR+((XCOOR(4*(I15-1)+K)*(NY-NPL)+XCOOR(4*(I16     1 -1)+K)*NPL)*(NZ-JPL)+(XCOOR(4*(I25-1)+K)*(NY-NPL)     2 +XCOOR(4*(I26-1)+K)*NPL)*JPL)/(NY*NZ)C       XCOOR(NBPTA*4+K)=XINT+COFAC-COAR60     CONTINUE       NBPTA=NBPTA+1C       IPOINT=NBPTA       IPT7.NUM(1,(N-1)*NX+(J-1)*NBC+I)=IPOINT       IPT7.NUM(5,(N-1)*NX+(J-2)*NBC+I)=IPOINT       IPT7.NUM(2,(N-1)*NX+(J-1)*NBC+I-1)=IPOINT       IPT7.NUM(6,(N-1)*NX+(J-2)*NBC+I-1)=IPOINT       IPT7.NUM(3,(N-2)*NX+(J-1)*NBC+I-1)=IPOINT       IPT7.NUM(7,(N-2)*NX+(J-2)*NBC+I-1)=IPOINT       IPT7.NUM(4,(N-2)*NX+(J-1)*NBC+I)=IPOINT       IPT7.NUM(8,(N-2)*NX+(J-2)*NBC+I)=IPOINT70     CONTINUE75     IPOINT=IPT4.NUM(1,(J-1)*NY+N)       IPT7.NUM(3,(N-1)*NX+(J-1)*NBC)=IPOINT       IPT7.NUM(2,N*NX+(J-1)*NBC)=IPOINT       IPT7.NUM(7,(N-1)*NX+(J-2)*NBC)=IPOINT       IPT7.NUM(6,N*NX+(J-2)*NBC)=IPOINT80     CONTINUECC        DERNIERE RANGEE85     IPT7.NUM(4,(NY-1)*NX+(J-1)*NBC+1)=IPT6.NUM(1,(J-1)*NX+1)       IPT7.NUM(8,(NY-1)*NX+(J-2)*NBC+1)=IPT6.NUM(1,(J-1)*NX+1)       IF(NX.EQ.1) GOTO 95C       DO 90 I=2,NX       IPOINT=IPT6.NUM(1,(J-1)*NX+I)       IPT7.NUM(4,(NY-1)*NX+(J-1)*NBC+I)=IPOINT       IPT7.NUM(8,(NY-1)*NX+(J-2)*NBC+I)=IPOINT       IPT7.NUM(3,(NY-1)*NX+(J-1)*NBC+I-1)=IPOINT       IPT7.NUM(7,(NY-1)*NX+(J-2)*NBC+I-1)=IPOINT90     CONTINUE95     IPT7.NUM(3,J*NBC)=IPT6.NUM(NN6+1,J*NX)       IPT7.NUM(7,(J-1)*NBC)=IPT6.NUM(NN6+1,J*NX)100    CONTINUECC        DERNIERE COUCHE = FACE 2C105    IND=NBC*(NZ-1)       IPT7.NUM(5,IND+1)=I5       IF(NX.EQ.1) GOTO 115C       DO 110 I=2,NX       IPT7.NUM(5,IND+I)=IPT2.NUM(1,I)       IPT7.NUM(6,IND+I-1)=IPT2.NUM(NN2+1,I-1)110    CONTINUE115    IPT7.NUM(6,NX+IND)=I6       IF(NY.EQ.1) GOTO 135C       DO 130 N=2,NY       IPT7.NUM(8,IND+(N-2)*NX+1)=IPT2.NUM(3*NN2+1,(N-2)*NX+1)       IPT7.NUM(5,IND+(N-1)*NX+1)=IPT2.NUM(1,(N-1)*NX+1)       IF(NX.EQ.1) GOTO 125C       DO 120 I=2,NX       IPOINT=IPT2.NUM(3*NN2+1,(N-2)*NX+I)       IPT7.NUM(8,IND+(N-2)*NX+I)=IPOINT       IPT7.NUM(7,IND+(N-2)*NX+I-1)=IPOINT       IPT7.NUM(5,IND+(N-1)*NX+I)=IPOINT       IPT7.NUM(6,IND+(N-1)*NX+I-1)=IPOINT120    CONTINUE125    IPT7.NUM(7,IND+(N-1)*NX)=IPT2.NUM(2*NN2+1,(N-1)*NX)       IPT7.NUM(6,IND+N*NX)=IPT2.NUM(NN2+1,N*NX)130    CONTINUE135    IPT7.NUM(8,IND+(NY-1)*NX+1)=I8       IF(NX.EQ.1) GOTO 145C       DO 140 N=2,NX       IPT7.NUM(8,IND+(NY-1)*NX+N)=IPT2.NUM(3*NN2+1,(NY-1)*NX+N)       IPT7.NUM(7,IND+(NY-1)*NX+N-1)=IPT2.NUM(2*NN2+1,(NY-1)*NX+N-1)140    CONTINUE145    IPT7.NUM(7,IND+NBC)=I7C       IPT7.LISREF(1)=IPT1       IPT7.LISREF(2)=IPT2       IPT7.LISREF(3)=IPT3       IPT7.LISREF(4)=IPT4       IPT7.LISREF(5)=IPT5       IPT7.LISREF(6)=IPT6      ITY=ILCOUR      CALL CHANGE(IPT7,ITY)      CALL ECROBJ('MAILLAGE',IPT7)       SEGDES IPT7       RETURN       END           

© Cast3M 2003 - Tous droits réservés.
Mentions légales