1 : C FPLISP SOURCE PV 09/03/12 21:23:12 6325 2 : SUBROUTINE FPLISP(IPTVPR,IPTGEO,IPTINT,IVACAR,IVAFOR) 3 : C_____________________________________________________________________ 4 : C 5 : C CALCULE LES FORCES DE PRESSION DANS LE LINESPRING 6 : C 7 : C ENTREES : 8 : C --------- 9 : C 10 : C IPTVPR POINTEUR SUR LE MELVAL CONTENANT LES PRESSIONS 11 : C IPTGEO POINTEUR SUR LE MAILLAGE 12 : C IPTINT POINTEUR SUR MINTE 13 : C IVACAR POINTEUR SUR MPTVAL DE CARACTERISTIQUE 14 : C IVAFOR POINTEUR SUR MPTVAL DE FORCE 15 : C 16 : C EBERSOLT MAI 85 J UTILISE DFLOAT ET SQRT 17 : C PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 21 09 90 18 : C 19 : C_____________________________________________________________________ 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : -INC SMINTE 24 : -INC SMCHAML 25 : -INC SMELEME 26 : -INC SMCOORD 27 : -INC CCOPTIO 28 : C 29 : SEGMENT MPTVAL 30 : INTEGER IPOS(NS) ,NSOF(NS) 31 : INTEGER IVAL(NCOSOU) 32 : CHARACTER*16 TYVAL(NCOSOU) 33 : ENDSEGMENT 34 : C 35 : DIMENSION BPSS(3,3),XE(3,4),XEL(3,3),V1(3),V2(3),H1(3),H2(3) 36 : C 37 : DATA X774/.774596669241483D0/ 38 : DATA UN,UNDEMI,ZERO/1.D0,.5D0,0.D0/ 39 : C 40 : C ON INITIALISE LES FONCTIONS DE FORME 41 : C 42 : H1(1) =(UN-X774)*UNDEMI 43 : H1(2) = UNDEMI 44 : H1(3) =(UN+X774)*UNDEMI 45 : H2(1) = H1(3) 46 : H2(2) = UNDEMI 47 : H2(3) = H1(1) 48 : C 49 : MELVA1=IPTVPR 50 : C 51 : MELEME=IPTGEO 52 : NBNN =NUM(/1) 53 : NBELEM=NUM(/2) 54 : C 55 : MINTE =IPTINT 56 : SEGACT MINTE 57 : NBNO =SHPTOT(/2) 58 : NBPGAU=SHPTOT(/3) 59 : C 60 : C BOUCLE SUR LES ELEMENTS 61 : C 62 : DO 100 IA=1,NBELEM 63 : C 64 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 65 : C 65 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IA,XE) 66 : C 67 : C ON RECUPERE LES VECTEURS ORIENTANT LE LINESPRING 68 : C AINSI QUE LA LONGUEUR DU LINESPRING 69 : C 70 : XLONG= ZERO 71 : MPTVAL=IVACAR 72 : DO 110 IB=1,3 73 : MELVAL=IVAL(2+IB) 74 : IBMN=MIN(IA,VELCHE(/2)) 75 : V1(IB)=VELCHE(1,IBMN) 76 : V2(IB)=VELCHE(1,IBMN) 77 : XLONG =XLONG +(XE(IB,1)-XE(IB,2))*(XE(IB,1)-XE(IB,2)) 78 : 110 CONTINUE 79 : XLONG = SQRT(XLONG) 80 : C 81 : C AINSI QUE L EPAISSEUR 82 : C 83 : EPAISS=ZERO 84 : DO 120 IB=1,NBPGAU 85 : MELVAL=IVAL(1) 86 : IGMN=MIN(IB,VELCHE(/1)) 87 : IBMN=MIN(IA,VELCHE(/2)) 88 : EPAISS=VELCHE(IGMN,IBMN)+EPAISS 89 : 120 CONTINUE 90 : EPAISS=EPAISS/DBLE(NBPGAU) 91 : C 92 : C EXTRACTION DE LA MATRICE DE PASSAGE 93 : C 94 : DO 130 IB=1,3 95 : XEL(IB,1)=XE(IB,1) 96 : XEL(IB,2)=XE(IB,2) 97 : XEL(IB,3)=XE(IB,1)+(V1(IB)+V2(IB))*UNDEMI 98 : 130 CONTINUE 99 : DO 97 II=1,3 100 : DO 97 JJ=1,3 101 : 97 CONTINUE 101 : CALL VPAST(XEL,BPSS) 102 : C 103 : C ON INTEGRE LES FORCES DU A LA PRESSION DANS LA FISSURE 104 : C 105 : FZ1= ZERO 106 : CX1= ZERO 107 : FZ2= ZERO 108 : CX2= ZERO 109 : C 110 : C BOUCLE SUR LES POINTS DE GAUSS 111 : C 112 : MPTVAL=IVACAR 113 : DO 200 IB=1,NBPGAU 114 : MELVAL=IVAL(2) 115 : IGMN=MIN(IB,VELCHE(/1)) 116 : IBMN=MIN(IA,VELCHE(/2)) 117 : FISS=VELCHE(IGMN,IBMN) 118 : IGMN=MIN(IB,MELVA1.VELCHE(/1)) 119 : IBMN=MIN(IA,MELVA1.VELCHE(/2)) 120 : PRES=MELVA1.VELCHE(IGMN,IBMN) 121 : XX=FISS*PRES*POIGAU(IB)*XLONG*UNDEMI 122 : FZ1= FZ1+ XX*H1(IB) 123 : CX1= CX1+ XX*(EPAISS-FISS)*H1(IB)*UNDEMI 124 : FZ2= FZ2+ XX*H2(IB) 125 : CX2= CX2+ XX*(EPAISS-FISS)*H2(IB)*UNDEMI 126 : 200 CONTINUE 127 : C 128 : C CHANGEMENT DE REPERE 129 : C 130 : MPTVAL=IVAFOR 131 : MELVAL=IVAL(1) 132 : VELCHE(1,IA)=FZ1*BPSS(3,1) 133 : VELCHE(2,IA)=FZ2*BPSS(3,1) 134 : C 135 : MELVAL=IVAL(2) 136 : VELCHE(1,IA)=FZ1*BPSS(3,2) 137 : VELCHE(2,IA)=FZ2*BPSS(3,2) 138 : C 139 : MELVAL=IVAL(3) 140 : VELCHE(1,IA)=FZ1*BPSS(3,3) 141 : VELCHE(2,IA)=FZ2*BPSS(3,3) 142 : C 143 : MELVAL=IVAL(4) 144 : VELCHE(1,IA)=CX1*BPSS(1,1) 145 : VELCHE(2,IA)=CX2*BPSS(1,1) 146 : C 147 : MELVAL=IVAL(5) 148 : VELCHE(1,IA)=CX1*BPSS(1,2) 149 : VELCHE(2,IA)=CX2*BPSS(1,2) 150 : C 151 : MELVAL=IVAL(6) 152 : VELCHE(1,IA)=CX1*BPSS(1,3) 153 : VELCHE(2,IA)=CX2*BPSS(1,3) 154 : C 155 : MPTVAL=IVAFOR 156 : DO 300 IB=1,6 157 : MELVAL=IVAL(IB) 158 : VELCHE(3,IA)=-VELCHE(2,IA) 159 : VELCHE(4,IA)=-VELCHE(1,IA) 160 : 300 CONTINUE 161 : C 162 : 100 CONTINUE 163 : C 164 : 666 CONTINUE 165 : SEGDES MINTE 166 : RETURN 167 : END 168 : 169 : 170 :
© Cast3M 2003 - All rights reserved.
Disclaimer