C DYNE36 SOURCE CHAT 05/01/12 23:17:40 5004 SUBROUTINE DYNE36(NUMEL1,NUMEL2,XBARY,YBARY,XP,YP,XPP,YPP,XPALB, & IPALB,NLIAB,I,ID1,SOMAIR) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Op{rateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Calcul de l'aire de la section qui n'a pas travers{ le * * maillage fixe. * * * * Param}tres: * * * * e XBARY coordonn{e du barycentre * * e YBARY coordonn{e du barycentre * * e NUMEL1 {l{ment du profil fixe * * e NUMEL2 {l{ment du profil fixe * * e XP,YP coordonn{es du point P d'intersection * * e XPP,YPP coordonn{es du point PP d'intersection * * e NLIAB nombre total de liaisons * * e I num{ro de la liaison trait{e * * s SOMAIR aire de la section * * * * Auteur, date de cr{ation: * * * * Lionel VIVAN, le 1 f{vrier 1991. * * * *--------------------------------------------------------------------* * INTEGER IPALB(NLIAB,*) REAL*8 XPALB(NLIAB,*) PARAMETER ( ZERO = 0.D0 ) * ITYP = IPALB(I,1) IDIM = IPALB(I,3) NOMBN1 = IPALB(I,4) ID2 = ID1 + IDIM ID3 = ID1 + 2*IDIM ID4 = ID1 + 3*IDIM ID6 = ID1 + 5*IDIM * SOMAIR = ZERO IF (NUMEL1.EQ.NUMEL2) THEN XPPG = XBARY - XPP YPPG = YBARY - YPP DA = SQRT( (XPPG ** 2) + (YPPG ** 2) ) XGP = XP - XBARY YGP = YP - YBARY DB = SQRT( (XGP ** 2) + (YGP ** 2) ) XPPP = XPP - XP YPPP = YPP - YP DC = SQRT( (XPPP ** 2) + (YPPP ** 2) ) PERI = 0.5 * ( DA + DB + DC ) SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC) SOMAIR = SOMAIR + SQRT(SURF) * ELSE NBELEM = 0 IF (ITYP.EQ.31) THEN I2 = NUMEL1 2 CONTINUE I2 = I2 + 1 IF (I2.EQ.(NOMBN1+1)) I2 = 1 IF (I2.EQ.NUMEL2) GOTO 4 NBELEM = NBELEM + 1 GOTO 2 4 CONTINUE ELSE I6 = NUMEL1 6 CONTINUE I6 = I6 - 1 IF (I6.EQ.0) I6 = NOMBN1 IF (I6.EQ.NUMEL2) GOTO 8 NBELEM = NBELEM + 1 GOTO 6 8 CONTINUE ENDIF IF (ITYP.EQ.31) THEN IEE1 = NUMEL1 + 1 IF (IEE1.EQ.(NOMBN1+1)) IEE1 = 1 IE1 = ID6 + IDIM*(IEE1-1) ELSE IE1 = ID6 + IDIM*(NUMEL1-1) ENDIF XE1 = ZERO YE1 = ZERO DO 10 ID = 1,IDIM XX1 = XPALB(I,IE1+ID) - XPALB(I,ID2+ID) XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) ) YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) ) 10 CONTINUE * end do XPE1 = XE1 - XP YPE1 = YE1 - YP DA = SQRT( (XPE1 ** 2) + (YPE1 ** 2) ) XE1G = XBARY - XE1 YE1G = YBARY - YE1 DB = SQRT( (XE1G ** 2) + (YE1G ** 2) ) XGP = XP - XBARY YGP = YP - YBARY DC = SQRT( (XGP ** 2) + (YGP ** 2) ) PERI = 0.5 * ( DA + DB + DC ) SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC) SOMAIR = SOMAIR + SQRT(SURF) IF (NBELEM.NE.0) THEN IE1 = NUMEL1 DO 12 IE = 1,NBELEM IF (ITYP.EQ.31) THEN IE1 = IE1 + 1 IF (IE1.EQ.(NOMBN1+1)) IE1 = 1 IE2 = IE1 + 1 IF (IE2.EQ.(NOMBN1+1)) IE2 = 1 IPT1 = ID6 + IDIM*(IE1-1) IPT2 = ID6 + IDIM*(IE2-1) ELSE IE2 =IE1 - 1 IF (IE2.EQ.0) IE2 = NOMBN1 IPT1 = ID6 + IDIM*(IE1-1) IPT2 = ID6 + IDIM*(IE2-1) IE1 = IE1 - 1 IF (IE1.EQ.0) IE1 = NOMBN1 ENDIF XE1 = ZERO YE1 = ZERO XE2 = ZERO YE2 = ZERO DO 14 ID = 1,IDIM XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID) XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID) XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) ) YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) ) XE2 = XE2 + ( XX2 * XPALB(I,ID3+ID) ) YE2 = YE2 + ( XX2 * XPALB(I,ID4+ID) ) 14 CONTINUE * end do XE1E2 = XE2 - XE1 YE1E2 = YE2 - YE1 DA = SQRT( (XE1E2 ** 2) + (YE1E2 ** 2) ) XE2G = XBARY - XE2 YE2G = YBARY - YE2 DB = SQRT( (XE2G ** 2) + (YE2G ** 2) ) XGE1 = XE1 - XBARY YGE1 = YE1 - YBARY DC = SQRT( (XGE1 ** 2) + (YGE1 ** 2) ) PERI = 0.5 * ( DA + DB + DC ) SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC) SOMAIR = SOMAIR + SQRT(SURF) 12 CONTINUE * end do XE2PP = XPP - XE2 YE2PP = YPP - YE2 DA = SQRT( (XE2PP ** 2) + (YE2PP ** 2) ) XPPG = XBARY - XPP YPPG = YBARY - YPP DB = SQRT( (XPPG ** 2) + (YPPG ** 2) ) XGE2 = XE2 - XBARY YGE2 = YE2 - YBARY DC = SQRT( (XGE2 ** 2) + (YGE2 ** 2 ) ) PERI = 0.5 * ( DA + DB + DC ) SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC) SOMAIR = SOMAIR + SQRT(SURF) ELSE XE1PP = XPP - XE1 YE1PP = YPP - YE1 DA = SQRT( (XE1PP ** 2) + (YE1PP ** 2) ) XPPG = XBARY - XPP YPPG = YBARY - YPP DB = SQRT( (XPPG ** 2) + (YPPG ** 2 ) ) XGE1 = XE1 - XBARY YGE1 = YE1 - YBARY DC = SQRT( (XGE1 ** 2 ) + (YGE1 ** 2) ) PERI = 0.5 * ( DA + DB + DC ) SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC) SOMAIR = SOMAIR + SQRT(SURF) ENDIF ENDIF * END