C CALP1 SOURCE KK2000 13/11/08 21:15:08 7860 SUBROUTINE CALP1(IPTR1,IPTR2,IPMODL,LOC,IPTR4) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C C APPELE PAR CALP C C AUTEUR : J.BRUN (AVRIL 90) C C PARTIE CALCUL EN PEAU DES CONTRAINTES C C----------------------------------------------------------- C PARAMETRES : C IPTR1 : POINTEUR SUR UN MCHAML DE TYPE CONTRAINTE C IPTR2 : POINTEUR SUR UN MCHAML DE TYPE CARACTERISTIQUE C IPMODL : POINTEUR SUR UN SEGMENT MMODEL C LOC : MOT CLE SUR 4 CARACTERES C SUPE PEAU SUP C MOYE PLAN MOYEN C INFE PEAU INF C IPTR4 : POINTEUR SUR UN MCHMAL DU MEME TYPE QUE CELUI D'IPTR1 C (SORTIE) C -INC SMMODEL -INC SMCHAML -INC SMELEME -INC CCOPTIO C -INC CCREEL -INC CCHAMP -INC CCGEOME -INC SMCOORD -INC SMINTE C SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT C SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT C PARAMETER ( NINF=3 ) INTEGER INFOS(NINF) CHARACTER*4 LOC CHARACTER*(NCONCH) CONM LOGICAL lsupco IPTR4 = 0 IF (LOC.EQ.'SUPE') THEN I_LOC = 1 ELSE IF (LOC.EQ.'MOYE') THEN I_LOC = 2 ELSE IF (LOC.EQ.'INFE') THEN I_LOC = 3 ELSE CALL ERREUR(5) RETURN ENDIF C C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES C CALL QUESUP(IPMODL,IPTR1,5,0,ISUP1,IRET) IF (ISUP1.GT.1) RETURN C C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES C CALL QUESUP(IPMODL,IPTR2,5,0,ISUP2,IRET1) IF (ISUP2.GT.1) RETURN NHRM=NIFOUR C C ACTIVATION DU MODELE C MMODEL=IPMODL SEGACT MMODEL NSOUS=KMODEL(/1) C C CREATION DU MCHELM C N1=NSOUS L1=11 N3=6 SEGINI MCHELM TITCHE='CONTRAINTES' IFOCHE=IFOUR IPTR4=MCHELM C---------------------------------------------------------- C TRAITEMENT POUR CHAQUE SOUS ZONE DU MODELE ORIGINE C DO 1 NS=1,KMODEL(/1) C INITIALISATION IPMING=0 IVASTR=0 IVACAR=0 NSTR=0 NCARA=0 NCARF=0 MOSTRS=0 MOCARA=0 lsupco=.false. IMODEL=KMODEL(NS) SEGACT IMODEL MELE=NEFMOD C CALL ELQUOI(MELE,0,5,INFO,IMODEL) MFR=INFELE(13) NBPGAU=INFELE(4) C MINTE=INFELE(11) MINTE=infmod(7) NBNN= NBNNE( NUMGEO(MELE)) IPPORE=0 IF(MFR.EQ.33) IPPORE=NBNN C SEGSUP INFO MELEME=IMAMOD SEGACT MELEME NBELEM=NUM(/2) SEGDES MELEME IPMAIL=IMAMOD CONM =CONMOD IMACHE(NS)=IPMAIL CONCHE(NS)=CONMOD C C COQUE INTEGREE OU PAS ? C IF(INFMOD(/1).NE.0)THEN NPINT=INFMOD(1) ELSE NPINT=0 ENDIF IF (NPINT.NE.0)THEN MCHEL1=IPTR1 IF (I_LOC.EQ.2) THEN INF=INFMOD(1) IF (MOD(INF,2).EQ.0) THEN CALL ERREUR(722) RETURN ENDIF IENT1=(INFMOD(1)+1)/2 IERR1=0 CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1) IF (IERR1.NE.0) GO TO 9990 GO TO 1 ELSE IF (I_LOC.EQ.1) THEN IENT1=INFMOD(1) IERR1=0 CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1) IF (IERR1.NE.0) GO TO 9990 GO TO 1 ELSE IF (I_LOC.EQ.3) THEN IERR1=0 CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM, 1,IERR1) IF (IERR1.NE.0) GO TO 9990 GO TO 1 ENDIF ENDIF C C CREATION DU TABLEAU INFOS C CALL IDENT(IPMAIL,CONM,IPTR1,IPTR2,INFOS,IRTD) IF (IRTD.EQ.0) GOTO 9990 C INFCHE(NS,1)=1 INFCHE(NS,2)=0 INFCHE(NS,3)=NHRM INFCHE(NS,4)=MINTE INFCHE(NS,5)=1 INFCHE(NS,6)=5 C____________________________________________________________________ C C RECHERCHE DES NOMS DE COMPOSANTES C____________________________________________________________________ C if(lnomid(4).ne.0) then nomid=lnomid(4) segact nomid mostrs=nomid nstr=lesobl(/2) nfac=lesfac(/2) else lsupco=.true. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) endif C C VERIFICATION DE LEUR PRESENCE C____________________________________________________________________ C NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' CALL KOMCHA(IPTR1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 IPMING=MINTE SEGACT,MINTE IF (ISUP1.EQ.1) THEN CALL VALCHE(IVASTR,NSTR,IPMING,IPPORE) ENDIF C C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER C N1PTEL=0 N1EL=0 MPTVAL=IVASTR DO 110 IO=1,NSTR MELVAL=IVAL(IO) N1PTEL=MAX(N1PTEL,VELCHE(/1)) N1EL =MAX(N1EL ,VELCHE(/2)) 110 CONTINUE C NBGSTR=N1PTEL IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN N1PTEL=1 ELSE N1PTEL=NBPGAU ENDIF NBPTEL=N1PTEL NEL=N1EL C____________________________________________________________________ C C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * C____________________________________________________________________ C NBROBL=0 NBRFAC=0 NOMID =0 NOTYPE=0 C IVECT=0 C C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES C IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN NBROBL=1 NBRFAC=1 SEGINI NOMID LESOBL(1)='EPAI' LESFAC(1)='EXCE' NBTYPE=1 SEGINI NOTYPE TYPE(1)='REAL*8' C C CARACTERISTIQUES POUR LES POUTRES C ELSE IF (MFR.EQ.7 ) THEN NBROBL=5 NBRFAC=1 SEGINI NOMID LESOBL(1)='INRY' LESOBL(2)='INRZ' LESOBL(3)='SECT' LESOBL(4)='DY ' LESOBL(5)='DZ ' LESFAC(1)='TORS' C NBTYPE=1 SEGINI NOTYPE TYPE(1)='REAL*8' C C CARACTERISTIQUES POUR LES TUYAUX C ELSE IF (MFR.EQ.13) THEN NBROBL=2 NBRFAC=2 SEGINI NOMID LESOBL(1)='EPAI' LESOBL(2)='RAYO' LESFAC(1)='RACO' LESFAC(2)='PRES' NBTYPE=1 SEGINI NOTYPE TYPE(1)='REAL*8' ENDIF MOCARA=NOMID MOTYPE=NOTYPE NCARA=NBROBL NCARF=NBRFAC NCARR=NCARA+NCARF CALL KOMCHA(IPTR2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3, $ IVACAR) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 IF (ISUP2.EQ.1) THEN CALL VALCHE(IVACAR,NCARR,IPMING,IPPORE) ENDIF N2=6 SEGINI MCHAML ICHAML(NS)=MCHAML NOMCHE(1)='SMXX' TYPCHE(1)='REAL*8' NOMCHE(2)='SMYY' TYPCHE(2)='REAL*8' NOMCHE(3)='SMZZ' TYPCHE(3)='REAL*8' NOMCHE(4)='SMXY' TYPCHE(4)='REAL*8' NOMCHE(5)='SMYZ' TYPCHE(5)='REAL*8' NOMCHE(6)='SMXZ' TYPCHE(6)='REAL*8' N2PTEL=0 N2EL=0 C----------------------------------------------------------- C CHAQUE MELVAL = COMPOSANTE SELON SIGMA C SEGINI MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6 IELVAL(1)=MELVA1 IELVAL(2)=MELVA2 IELVAL(3)=MELVA3 IELVAL(4)=MELVA4 IELVAL(5)=MELVA5 IELVAL(6)=MELVA6 C----------------------------------------------------------- C BRANCHEMENT SELON ELEMENT FINI C----------------------------------------------------------- C COQ3,COQ2,DKT IF ((MELE.EQ.27).OR.(MELE.EQ.28).OR.(MELE.EQ.44)) GOTO 3000 C POUTRE IF (MELE.EQ.29) GOTO 2000 C TUYAU C IF (MELE.EQ.42) GOTO 4000 C COQ4 ,DST IF (MELE.EQ.49.OR.MELE.EQ.93) GOTO 5000 C----------------------------------------------------------- C AUCUNE CREATION CAR NE SAIT PAS FAIRE POUR L'ELEMENT C----------------------------------------------------------- MOTERR(1:4) =NOMTP(MELE) MOTERR(5:12)='CALP ' CALL ERREUR(86) SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML GOTO 9990 C----------------------------------------------------------- C POUTRES + CONTRAINTES C----------------------------------------------------------- 2000 CONTINUE DO 2010 N2=1,NEL DO 2011 N1=1,NBPTEL MPTVAL=IVASTR MELVAL=IVAL(1) EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(2) EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(3) EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(5) FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(6) FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MPTVAL=IVACAR MELVAL=IVAL(3) SECT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(1) FINRY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(2) FINRZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(4) PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(5) PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) AIRY=SECT AIRZ=SECT C CALCUL DES CONTRAINTES REELLES MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ/FINRY) . -(FLEXZ*PY/FINRZ) MELVA2.VELCHE(N1,N2)=0. MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=(EFFY/AIRY) MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ) 2011 CONTINUE 2010 CONTINUE SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML GOTO 510 C----------------------------------------------------------- C COQ2,COQ3,DKT + CONTRAINTES C----------------------------------------------------------- 3000 CONTINUE IF (IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN DO 3010 N2=1,NEL DO 3011 N1=1,NBPTEL MPTVAL=IVASTR MELVAL=IVAL(1) AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(2) AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(3) AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(4) AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(5) AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(6) AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MPTVAL=IVACAR MELVAL=IVAL(1) EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) IF (I_LOC.EQ.3) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z) MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.1) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z) MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.2) THEN MELVA1.VELCHE(N1,N2)=AN11/EPAI MELVA2.VELCHE(N1,N2)=AN22/EPAI MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=AN12/EPAI MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ENDIF 3011 CONTINUE 3010 CONTINUE ENDIF IF (IFOUR.EQ.0) THEN DO 3012 N2=1,NEL DO 3013 N1=1,NBPTEL MPTVAL=IVASTR MELVAL=IVAL(1) AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(2) AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(3) AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(4) AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MPTVAL=IVACAR MELVAL=IVAL(1) EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) IF (I_LOC.EQ.3) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.1) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.2) THEN MELVA1.VELCHE(N1,N2)=AN11/EPAI MELVA2.VELCHE(N1,N2)=AN22/EPAI MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ENDIF 3013 CONTINUE 3012 CONTINUE ENDIF IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN DO 3014 N2=1,NEL DO 3015 N1=1,NBPTEL MPTVAL=IVASTR MELVAL=IVAL(1) AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(2) ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(3) AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(4) AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MPTVAL=IVACAR MELVAL=IVAL(1) EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) IF (I_LOC.EQ.3) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.1) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.2) THEN MELVA1.VELCHE(N1,N2)=AN11/EPAI MELVA2.VELCHE(N1,N2)=ANZZ/EPAI MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ENDIF 3015 CONTINUE 3014 CONTINUE ENDIF IF (IFOUR.EQ.-3) THEN DO 3016 N2=1,NEL DO 3017 N1=1,NBPTEL MPTVAL=IVASTR MELVAL=IVAL(1) AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(2) ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(3) AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(4) AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MPTVAL=IVACAR MELVAL=IVAL(1) EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) IF (I_LOC.EQ.3) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=0. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z) MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.1) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=0. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z) MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ELSE IF (I_LOC.EQ.2) THEN MELVA1.VELCHE(N1,N2)=AN11/EPAI MELVA2.VELCHE(N1,N2)=0. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI MELVA4.VELCHE(N1,N2)=0. MELVA5.VELCHE(N1,N2)=0. MELVA6.VELCHE(N1,N2)=0. ENDIF 3017 CONTINUE 3016 CONTINUE ENDIF SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML GOTO 510 C----------------------------------------------------------- C TUYAU+CONTRAINTE C----------------------------------------------------------- C 4000 CONTINUE C DO 4010 N2=1,NEL C DO 4011 N1=1,NBPTEL C C MPTVAL=IVASTR C C MELVAL=IVAL(1) C EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C MELVAL=IVAL(2) C EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C MELVAL=IVAL(3) C EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C MELVAL=IVAL(4) C FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C MELVAL=IVAL(5) C FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C MELVAL=IVAL(6) C C FLEXX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C MPTVAL=IVACAR C C MELVAL=IVAL(1) C EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C MELVAL=IVAL(2) C RAYO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C C IF(IVECT.EQ.2)THEN C MELVAL=IVAL(6) C PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C MELVAL=IVAL(7) C PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C ELSE C MELVAL=IVAL(5) C IPO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) C CALL EXCOO1(IPO,PX,PY,PZ,D) C ENDIF C RINT=(RAYO-EPAI) C D1=SQRT((PY**2)+(PZ**2)) C C CALCUL DES CONTRAINTES REELLES C C FINRY=((RAYO**4)-(RINT**4))*XPI/4 C SECT=XPI*((RAYO**2)-(RINT**2)) C IF ((D1.GE.RINT).AND.(D1.LE.RAYO)) THEN C MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ C . /FINRY)-(FLEXZ*PY/FINRY) C MELVA2.VELCHE(N1,N2)=0. C MELVA3.VELCHE(N1,N2)=0. C MELVA4.VELCHE(N1,N2)=(EFFY/AIRY) C MELVA5.VELCHE(N1,N2)=(FLEXX/2*XPI*RAYO**2*EPAI) C MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ) C ELSE C CALL ERREUR(505) C SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML C GOTO 9990 C ENDIF C 4011 CONTINUE C 4010 CONTINUE C C SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML C GOTO 510 C----------------------------------------------------------- C COQ4 +CONTRAINTE C----------------------------------------------------------- 5000 CONTINUE DO 5010 N2=1,NEL DO 5011 N1=1,NBPTEL MPTVAL=IVASTR MELVAL=IVAL(1) AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(2) AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(3) AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(4) AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(5) AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(6) AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(7) V1=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MELVAL=IVAL(8) V2=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) MPTVAL=IVACAR MELVAL=IVAL(1) EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) IF (I_LOC.EQ.3) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z) MELVA5.VELCHE(N1,N2)=V1/EPAI MELVA6.VELCHE(N1,N2)=V2/EPAI ELSE IF (I_LOC.EQ.1) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z) MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z) MELVA5.VELCHE(N1,N2)=V1/EPAI MELVA6.VELCHE(N1,N2)=V2/EPAI ELSE IF (I_LOC.EQ.2) THEN r_z = EPAI*EPAI MELVA1.VELCHE(N1,N2)=AN11/EPAI MELVA2.VELCHE(N1,N2)=AN22/EPAI MELVA3.VELCHE(N1,N2)=0. MELVA4.VELCHE(N1,N2)=AN12/EPAI MELVA5.VELCHE(N1,N2)=V1/EPAI MELVA6.VELCHE(N1,N2)=V2/EPAI ENDIF 5011 CONTINUE 5010 CONTINUE SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML C----------------------------------------------------------- C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE NS C----------------------------------------------------------- 510 CONTINUE SEGDES IMODEL SEGDES,MINTE IF (ISUP1.EQ.1) THEN CALL DTMVAL(IVASTR,3) ELSE CALL DTMVAL(IVASTR,1) ENDIF IF (ISUP2.EQ.1) THEN CALL DTMVAL(IVACAR,3) ELSE CALL DTMVAL(IVACAR,1) ENDIF NOMID=MOSTRS IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID NOMID=MOCARA IF (MOCARA.NE.0) SEGSUP NOMID 1 CONTINUE SEGDES MCHELM,MMODEL RETURN C----------------------------------------------------------- C DESACTIVATION ET RETOUR DANS LE CAS D'ERREUR C----------------------------------------------------------- 9990 CONTINUE SEGDES,MINTE IF (ISUP1.EQ.1) THEN CALL DTMVAL(IVASTR,3) ELSE CALL DTMVAL(IVASTR,1) ENDIF IF (ISUP2.EQ.1) THEN CALL DTMVAL(IVACAR,3) ELSE CALL DTMVAL(IVACAR,1) ENDIF NOMID=MOCARA IF (MOCARA.NE.0) SEGSUP NOMID NOMID=MOSTRS IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID SEGDES MMODEL,IMODEL SEGSUP MCHELM RETURN END