1 : C CREDEF SOURCE CHAT 05/01/12 22:29:05 5004 2 : C CE SOUS-PROGRAMME CREE LES CHAMPS DE COORDONNEES ASSOCIES AUX 3 : C DEFORMES. IL ACTUALISE LES ELEMENTS SUR CES CHAMPS 4 : C 5 : SUBROUTINE CREDEF(KABEL,KABCOR,KABCPR,MDEFOR,LABCO2,AMPIMP) 6 : IMPLICIT INTEGER(I-N) 7 : -INC CCOPTIO 8 : -INC CCREEL 9 : -INC SMELEME 10 : -INC SMCOORD 11 : -INC SMCHPOI 12 : -INC SMDEFOR 13 : -INC SMVECTE 14 : SEGMENT KABEL(NDEF) 15 : SEGMENT KABCOR(NDEF) 16 : SEGMENT KABCPR(NDEF) 17 : SEGMENT LABCO2(3,NDEF) 18 : SEGMENT XCO(IDIM,NCO) 19 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 20 : CHARACTER*4 NODEF(3),NODEG(3) 21 : DATA NODEF /'UX ','UY ','UZ '/ 22 : DATA NODEG /'UR ','UZ ','UT '/ 23 : LABCO2=0 24 : SEGACT MCOORD 25 : SEGACT MDEFOR 26 : NDEF=AMPL(/1) 27 : SEGINI KABEL,KABCOR,KABCPR,LABCO2 28 : DO 200 IDEF=1,NDEF 29 : LABCO2(3,IDEF)=MTVECT(IDEF) 30 : SEGINI ICPR 31 : KABCPR(IDEF)=ICPR 32 : DO 10 I=1,XCOOR(/1)/(IDIM+1) 33 : ICPR(I)=0 34 : 10 CONTINUE 35 : NCO=0 36 : MELEME=IELDEF(IDEF) 37 : KABEL(IDEF)=MELEME 38 : SEGACT MELEME 39 : NBSOUS=LISOUS(/1) 40 : IPT1=MELEME 41 : DO 20 ISOUS=1,MAX(1,NBSOUS) 42 : IF (NBSOUS.NE.0) THEN 43 : IPT1=LISOUS(ISOUS) 44 : SEGACT IPT1 45 : ENDIF 46 : DO 22 I=1,IPT1.NUM(/1) 47 : DO 22 J=1,IPT1.NUM(/2) 48 : IP=IPT1.NUM(I,J) 49 : IF (ICPR(IP).NE.0) GOTO 22 50 : NCO=NCO+1 51 : ICPR(IP)=NCO 52 : 22 CONTINUE 53 : 20 CONTINUE 54 : C MAINTENANT CREER LES COORDONNEES DEFORMES 55 : SEGINI XCO 56 : DO 40 J=1,XCOOR(/1)/(IDIM+1) 57 : IPC=ICPR(J) 58 : IF (IPC.EQ.0) GOTO 40 59 : IREF=(IDIM+1)*(J-1) 60 : DO 41 I=1,IDIM 61 : XCO(I,IPC)=XCOOR(IREF+I) 62 : 41 CONTINUE 63 : 40 CONTINUE 64 : KABCOR(IDEF)=XCO 65 : MCHPOI=ICHDEF(IDEF) 66 : C# if (ampimp.lt.xgrand/2) then 67 : if (ampimp.lt.xsgran/2) then 68 : amp=ampimp 69 : else 70 : AMP=AMPL(IDEF) 71 : endif 72 : SEGACT MCHPOI 73 : NSOUPO=IPCHP(/1) 74 : DO 60 ISOUP=1,NSOUPO 75 : MSOUPO=IPCHP(ISOUP) 76 : SEGACT MSOUPO 77 : MPOVAL=IPOVAL 78 : SEGACT MPOVAL 79 : IPT2=IGEOC 80 : SEGACT IPT2 81 : NC=NOCOMP(/2) 82 : DO 70 IC=1,NC 83 : DO 80 INUM=1,IDIM 84 : IF (IFOUR.NE.0.AND.IFOUR.NE.1) THEN 85 : IF (NOCOMP(IC).EQ.NODEF(INUM)) GOTO 81 86 : ELSE 87 : IF (NOCOMP(IC).EQ.NODEG(INUM)) GOTO 81 88 : ENDIF 89 : 80 CONTINUE 90 : GOTO 70 91 : 81 CONTINUE 92 : DO 90 IEL=1,IPT2.NUM(/2) 93 : IP=ICPR(IPT2.NUM(1,IEL)) 94 : IF (IP.EQ.0) GOTO 90 95 : XCO(INUM,IP)=XCO(INUM,IP)+AMP*VPOCHA(IEL,IC) 96 : 90 CONTINUE 97 : 70 CONTINUE 98 : SEGDES IPT2,MPOVAL,MSOUPO 99 : 60 CONTINUE 100 : SEGDES MCHPOI 101 : IF (LABCO2(3,IDEF).EQ.0) GOTO 200 102 : C IL FAUT ICI REGARDER LES VECTEURS QUI SONT DANS LA DEFORME 103 : MVECTE=LABCO2(3,IDEF) 103 : CALL CREVEC(MELEME,ICPR,KABCOR,LABCO2,MVECTE,IDEF) 104 : 200 CONTINUE 105 : SEGDES MDEFOR 106 : RETURN 107 : END 108 : 109 : 110 : 111 :
© Cast3M 2003 - All rights reserved.
Disclaimer