1 : C ELPD99 SOURCE CHAT 05/01/12 23:36:10 5004 2 : SUBROUTINE ELPD99(XBORD,IBORD,NS 3 : & ,XCOIN,ICOIN,NC,NC1 4 : & ,CRE,CPOST,CRP ,NS4 5 : & ,XD,XNU,NTRAP,PF0,XF0,PP0,NP0,CB,ISTAT ) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-B,D-H,O-Z) 8 : IMPLICIT COMPLEX*16(C) 9 : ************************************************************************ 10 : * 11 : * PLAQUES PAR EQUATION INTEGRALE: 12 : * 13 : * CALCUL DU DEPLACEMENT EN UN POINT 14 : * OU UN MAILLAGE PAR POST-TRAITEMENT 15 : * 16 : * 17 : ************************************************************************ 18 : -INC CCOPTIO 19 : * 20 : DIMENSION XBORD(15,*) 21 : DIMENSION IBORD (2 ,*) 22 : DIMENSION XCOIN(14,*) 23 : DIMENSION ICOIN(4 ,*) 24 : DIMENSION CRE (*) 25 : DIMENSION CRP (*) 26 : DIMENSION CPOST (*) 27 : * 28 : DIMENSION PP0(2,*) 29 : DIMENSION PF0(2) 30 : DIMENSION P0(2) 31 : DIMENSION PP1(2) 32 : DIMENSION A (2) 33 : DIMENSION B (2) 34 : DIMENSION OAB (2) 35 : DIMENSION Q (2) 36 : * 37 : DIMENSION XN (2) 38 : DIMENSION XN0(2) 39 : DIMENSION XN1(2) 40 : DIMENSION XN2(2) 41 : * 42 : DIMENSION XT (2) 43 : DIMENSION XT0(2) 44 : DIMENSION XT1(2) 45 : DIMENSION XT2(2) 46 : * 47 : * 48 : DIMENSION COP0(8) 49 : DIMENSION CS1 (8) 50 : DIMENSION CS2 (12) 51 : DIMENSION XLCOIN (4) 52 : * 53 : *-- BOUCLE SUR LES POINTS 54 : * 55 : DO 10 IP = 1,NP0 56 : PP1(1) = PP0(1,IP) 57 : PP1(2) = PP0(2,IP) 58 : *--0. MISE A 0 59 : CI = (0d0,1d0) 60 : DO 100 J=1,NS4 61 : CPOST(J) = 0D0*ci 62 : 100 CONTINUE 63 : * 64 : *--- INITIALISATION BIDON 65 : * 66 : XN0(1) = 1D0 67 : XN0(2) = 0d0 68 : XT0(1) = 0d0 69 : XT0(2) = 1D0 70 : * 71 : *- 1.1 BOUCLE SUR LES BORDS 72 : * 73 : DO 200 JQ=1,NS 74 : XN (1) = XBORD(1,JQ) 75 : XN (2) = XBORD(2,JQ) 76 : XT (1) = XBORD(3,JQ) 77 : XT (2) = XBORD(4,JQ) 78 : A (1) = XBORD(5,JQ) 79 : A (2) = XBORD(6,JQ) 80 : B (1) = XBORD(7,JQ) 81 : B (2) = XBORD(8,JQ) 82 : Q (1) = XBORD(9,JQ) 83 : Q (2) = XBORD(10,JQ) 84 : XLQ = XBORD(11,JQ) 85 : OAB(1) = XBORD(12,JQ) 86 : OAB(2) = XBORD(13,JQ) 87 : TETA = XBORD(14,JQ) 88 : R = XBORD(15,JQ) 88 : CALL ELPDI1(PP1,XN0,XT0 89 : & ,Q,XN,XT,A,B,OAB,TETA,R,XLQ 90 : & ,XD,XNU 91 : & ,NTRAP,CS1,CB,ISTAT) 92 : JCOL= 4* (JQ - 1) 93 : 94 : CPOST(JCOL+1) = CS1(4) / XD 95 : CPOST(JCOL+2) =-CS1(3) / XD 96 : CPOST(JCOL+3) = CS1(2) / XD 97 : CPOST(JCOL+4) =-CS1(1) / XD 98 : 200 CONTINUE 99 : * 100 : *- 1.2 TERMES BORDS-COINS 101 : * 102 : IF ( NC1.NE.0) THEN 103 : DO 220 JC=1,NC 104 : A (1) = XCOIN(1,JC) 105 : A (2) = XCOIN(2,JC) 106 : XN1(1) = XCOIN(3,JC) 107 : XN1(2) = XCOIN(4,JC) 108 : XT1(1) = XCOIN(5,JC) 109 : XT1(2) = XCOIN(6,JC) 110 : XN2(1) = XCOIN(7,JC) 111 : XN2(2) = XCOIN(8,JC) 112 : XT2(1) = XCOIN(9,JC) 113 : XT2(2) = XCOIN(10,JC) 114 : XLCOIN(1) = XCOIN(11,JC) 115 : XLCOIN(2) = XCOIN(12,JC) 116 : XLCOIN(3) = XCOIN(13,JC) 117 : XLCOIN(4) = XCOIN(14,JC) 117 : CALL ELPDI3(PP1,XN0 118 : & ,A,XN1,XN2,XT1,XT2,XLCOIN 119 : & ,XD,XNU 120 : & ,CS2,CB,ISTAT) 121 : 122 : I1 = ICOIN(1,JC) 123 : I2 = ICOIN(2,JC) 124 : I3 = ICOIN(3,JC) 125 : I4 = ICOIN(4,JC) 126 : J1 = 4*(I1 - 1) 127 : J2 = 4*(I2 - 1) 128 : J3 = 4*(I3 - 1) 129 : J4 = 4*(I4 - 1) 130 : 131 : * 132 : * TERMES MULTIPLIANT DES W,N SUR LES 2 LIGNES 133 : * 134 : CPOST(J1+2) = CPOST(J1+2) - CS2(4)/XD 135 : CPOST(J2+2) = CPOST(J2+2) - CS2(3)/XD 136 : CPOST(J3+2) = CPOST(J3+2) - CS2(2)/XD 137 : CPOST(J4+2) = CPOST(J4+2) - CS2(1)/XD 138 : * 139 : * TERMES MULTIPLIANT DES W SUR LES 2 LIGNES 140 : * 141 : CPOST(J2+1) = CPOST(J2+1) - CS2(6)/XD 142 : CPOST(J3+1) = CPOST(J3+1) - CS2(5)/XD 143 : 144 : 220 CONTINUE 145 : * 146 : * 147 : * 148 : ENDIF 149 : 150 : * 151 : *-1.4 SECOND MEMBRE(SI PP0 NEG PF0) 152 : * 153 : RR= ( PP1(2)-PF0(2)) ** 2 154 : & + ( PP1(1)-PF0(1)) ** 2 155 : IF ( ISTAT.NE.1) THEN 156 : IF ( RR .GT. 1E-4 ) THEN 156 : CALL ELPDOP (PP1,XN0,PF0,XN0,XT0,XD,XNU,COP0,CB,ISTAT) 157 : ELSE 158 : COP0(1) = CI/( 8d0 *CB * CB ) 159 : ENDIF 160 : ELSE 161 : COP0(1) = 0D0 162 : ENDIF 163 : CSM0 = COP0(1) *XF0 / XD 164 : * 165 : *-1.5 CALCUL DU DEPLACEMENT 166 : * 167 : CRP(IP) =(0D0,0d0) 168 : DO 300 J=1,NS4 169 : CRP(IP) = CRP(IP) - CPOST(J)*CRE(J) 170 : 300 CONTINUE 171 : CRP(IP) = CRP(IP) + CSM0 172 : * 173 : 10 CONTINUE 174 : * 175 : RETURN 176 : END 177 :
© Cast3M 2003 - All rights reserved.
Disclaimer