1 : C MOCE SOURCE CHAT 07/10/29 21:24:25 5940 2 : C MODI RECENTRAGE DES POINTS MILIEUX (SAUF LE CONTOUR) 3 : C 4 : SUBROUTINE MOCE(MELEME,XPROJ,ICPR,IBOUJ) 5 : IMPLICIT INTEGER(I-N) 6 : -INC CCOPTIO 7 : -INC SMELEME 8 : -INC CCGEOME 9 : -INC SMCOORD 10 : SEGMENT ICPR(0) 11 : SEGMENT IBOUJ(0) 12 : SEGMENT XPROJ(3,0) 13 : SEGMENT IAUX(XCOOR(/1)/(IDIM+1)) 13 : CALL ECROBJ('MAILLAGE',MELEME) 13 : CALL PRCONT 13 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 14 : IF (IERR.NE.0) RETURN 15 : SEGACT IPT1 16 : * REACTIVONS LE MAILLAGE A TOUT HASARD 17 : SEGACT MELEME 18 : DO 100 I=1,LISOUS(/1) 19 : IPT2=LISOUS(I) 20 : SEGACT IPT2 21 : 100 CONTINUE 22 : IF (IPT1.ITYPEL.NE.3) THEN 23 : SEGDES IPT1 24 : RETURN 25 : ENDIF 26 : SEGINI IAUX 27 : DO 110 I=1,IPT1.NUM(/2) 28 : IAUX(IPT1.NUM(2,I))=1 29 : 110 CONTINUE 30 : SEGDES IPT1 31 : IPT1=MELEME 32 : DO 30 IO=1,MAX(1,LISOUS(/1)) 33 : IF (LISOUS(/1).NE.0) IPT1=LISOUS(IO) 34 : K=IPT1.ITYPEL 35 : IF (K.NE.KSURF(K)) GOTO 21 36 : C LE NOMBRE DE FACE EST 1 QUEL EST SON TYPE 37 : KK=LTEL(2,K) 38 : ITYP=LDEL(1,KK) 39 : NBNN=KDEGRE(K) 40 : IF (NBNN.NE.3) GOTO 21 41 : IPAS=NBNN-1 42 : IDEP=LDEL(2,KK) 43 : IFEP=IDEP+KDFAC(1,ITYP)-1 44 : DO 22 I=1,IPT1.NUM(/2) 45 : DO 22 J=IDEP,IFEP,IPAS 46 : N1=IPT1.NUM(LFAC(J),I) 47 : JSUIV=J+IPAS 48 : IF (JSUIV.GT.IFEP) JSUIV=IDEP 49 : N2=IPT1.NUM(LFAC(JSUIV),I) 50 : NMIL=IPT1.NUM(LFAC(J+1),I) 51 : IF (IAUX(NMIL).NE.0) GOTO 22 52 : IP1=ICPR(N1) 53 : IP2=ICPR(N2) 54 : IPMIL=ICPR(NMIL) 55 : XPROJ(1,IPMIL)=(XPROJ(1,IP1)+XPROJ(1,IP2))/2 56 : XPROJ(2,IPMIL)=(XPROJ(2,IP1)+XPROJ(2,IP2))/2 57 : XPROJ(3,IPMIL)=(XPROJ(3,IP1)+XPROJ(3,IP2))/2 57 : CALL PROMOD(ICPR,XPROJ,NMIL,4,IBOUJ) 58 : IAUX(NMIL)=1 59 : 22 CONTINUE 60 : 21 CONTINUE 61 : 30 CONTINUE 62 : SEGSUP IAUX 63 : RETURN 64 : END 65 : 66 : 67 : 68 : 69 : 70 : 71 :
© Cast3M 2003 - All rights reserved.
Disclaimer