Télécharger la plaquette Cast3M


fr en

Télécharger calp1.eso

Retour à la liste

Numérotation des lignes : 

calp1

  1. C CALP1     SOURCE    OF166741  24/10/07    21:15:04     12016          
  2.  
  3. C
  4. C     APPELE PAR CALP
  5. C
  6. C     AUTEUR : J.BRUN (AVRIL 90)
  7. C
  8. C     PARTIE CALCUL EN PEAU DES CONTRAINTES
  9. C
  10. C-----------------------------------------------------------
  11. C     PARAMETRES :
  12. C        IPTR1 : POINTEUR SUR UN MCHAML DE TYPE CONTRAINTE
  13. C        IPTR2 : POINTEUR SUR UN MCHAML DE TYPE CARACTERISTIQUE
  14. C        IPMODL : POINTEUR SUR UN SEGMENT MMODEL
  15. C        LOC   : MOT CLE SUR 4 CARACTERES
  16. C                SUPE  PEAU SUP
  17. C                MOYE  PLAN MOYEN
  18. C                INFE  PEAU INF
  19. C        IPTR4 : POINTEUR SUR UN MCHMAL DU MEME TYPE QUE CELUI D'IPTR1
  20. C                (SORTIE)
  21. C
  22.       SUBROUTINE CALP1(IPTR1,IPTR2,IPMODL,LOC,IPTR4)
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC CCGEOME
  31. C -INC CCREEL
  32.  
  33. -INC SMMODEL
  34. -INC SMCHAML
  35. -INC SMELEME
  36. -INC SMCOORD
  37. -INC SMINTE
  38.  
  39.       SEGMENT MPTVAL
  40.         INTEGER IPOS(NS)    ,NSOF(NS)
  41.         INTEGER      IVAL(NCOSOU)
  42.         CHARACTER*16 TYVAL(NCOSOU)
  43.       ENDSEGMENT
  44.  
  45.       SEGMENT NOTYPE
  46.         CHARACTER*16 TYPE(NBTYPE)
  47.       ENDSEGMENT
  48.  
  49.       PARAMETER ( NINF=3 )
  50.       INTEGER INFOS(NINF)
  51.       CHARACTER*4 LOC
  52.       CHARACTER*(NCONCH) CONM
  53.       LOGICAL lsupco
  54.  
  55.       IPTR4 = 0
  56.       IF (LOC.EQ.'SUPE') THEN
  57.         I_LOC = 1
  58.       ELSE IF (LOC.EQ.'MOYE') THEN
  59.         I_LOC = 2
  60.       ELSE IF (LOC.EQ.'INFE') THEN
  61.         I_LOC = 3
  62.       ELSE
  63.         CALL ERREUR(5)
  64.         RETURN
  65.       ENDIF
  66.  
  67.       nbtype = 1
  68.       SEGINI,notype
  69.       notype.TYPE(1) = 'REAL*8  '
  70.       MOTYR8 = notype
  71. C
  72. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES
  73. C
  74.        CALL  QUESUP(IPMODL,IPTR1,5,0,ISUP1,IRET)
  75.        IF (ISUP1.GT.1) RETURN
  76. C
  77. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  78. C
  79.        CALL  QUESUP(IPMODL,IPTR2,5,0,ISUP2,IRET1)
  80.        IF (ISUP2.GT.1) RETURN
  81.  
  82.       NHRM=NIFOUR
  83. C
  84. C     ACTIVATION DU MODELE
  85. C
  86.       MMODEL=IPMODL
  87.       NSOUS=KMODEL(/1)
  88.       N1=NSOUS
  89. C
  90. C     ON NE TIENT PAS COMPTE D'UN EVENTUEL MODELE CHARGEMENT
  91. C
  92.       DO III = 1,NSOUS
  93.         IMODEL = KMODEL(III)
  94.         IF (FORMOD(1).EQ.'CHARGEMENT') N1=N1-1
  95.       END DO
  96. C
  97. C     CREATION DU MCHELM
  98. C
  99.       L1=11
  100.       N3=6
  101.       SEGINI MCHELM
  102.       TITCHE='CONTRAINTES'
  103.       IFOCHE=IFOUR
  104.       IPTR4=MCHELM
  105. C----------------------------------------------------------
  106. C        TRAITEMENT POUR CHAQUE SOUS ZONE DU MODELE ORIGINE
  107. C
  108.       DO 1 NS=1,KMODEL(/1)
  109. C  INITIALISATION
  110.          IPMING=0
  111.          IVASTR=0
  112.          IVACAR=0
  113.          NSTR=0
  114.          NCARA=0
  115.          NCARF=0
  116.          MOSTRS=0
  117.          MOCARA=0
  118.          lsupco=.false.
  119.  
  120.          IMODEL=KMODEL(NS)
  121.          IF (FORMOD(1).EQ.'CHARGEMENT') GOTO 1
  122.          MELE=NEFMOD
  123.          MFR=INFELE(13)
  124.          NBPGAU=INFELE(4)
  125. C         MINTE=INFELE(11)
  126.          MINTE=infmod(7)
  127.       IPMING=MINTE
  128.          NBNN= NBNNE( NUMGEO(MELE))
  129.          IPPORE=0
  130.          IF(MFR.EQ.33) IPPORE=NBNN
  131.  
  132.          MELEME=IMAMOD
  133.          NBELEM=NUM(/2)
  134.          IPMAIL=IMAMOD
  135.          CONM  =CONMOD
  136.          IMACHE(NS)=IPMAIL
  137.          CONCHE(NS)=CONMOD
  138.  
  139. C   COQUE INTEGREE OU PAS ?
  140.       NPINT=INFMOD(1)
  141.       IF (NPINT.NE.0)THEN
  142.          MCHEL1=IPTR1
  143.          IF (I_LOC.EQ.2) THEN
  144.             INF=INFMOD(1)
  145.             IF (MOD(INF,2).EQ.0) THEN
  146.                CALL ERREUR(722)
  147.                RETURN
  148.             ENDIF
  149.             IENT1=(INFMOD(1)+1)/2
  150.             IERR1=0
  151.             CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1)
  152.             IF (IERR1.NE.0) GO TO 9990
  153.             GO TO 1
  154.          ELSE IF (I_LOC.EQ.1) THEN
  155.             IENT1=INFMOD(1)
  156.             IERR1=0
  157.             CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1)
  158.             IF (IERR1.NE.0) GO TO 9990
  159.             GO TO 1
  160.          ELSE IF (I_LOC.EQ.3) THEN
  161.             IERR1=0
  162.             CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,    1,IERR1)
  163.             IF (IERR1.NE.0) GO TO 9990
  164.             GO TO 1
  165.          ENDIF
  166.       ENDIF
  167. C
  168. C     CREATION DU TABLEAU INFOS
  169. C
  170.         CALL IDENT(IPMAIL,CONM,IPTR1,IPTR2,INFOS,IRTD)
  171.         IF (IRTD.EQ.0) GOTO 9990
  172. C
  173.         INFCHE(NS,1)=1
  174.         INFCHE(NS,2)=0
  175.         INFCHE(NS,3)=NHRM
  176.         INFCHE(NS,4)=MINTE
  177.         INFCHE(NS,5)=1
  178.         INFCHE(NS,6)=5
  179. C____________________________________________________________________
  180. C
  181. C     RECHERCHE DES NOMS DE COMPOSANTES
  182. C____________________________________________________________________
  183. C
  184.       if(lnomid(4).ne.0) then
  185.          nomid=lnomid(4)
  186.          segact nomid
  187.          mostrs=nomid
  188.          nstr=lesobl(/2)
  189.          nfac=lesfac(/2)
  190.       else
  191.          lsupco=.true.
  192.          CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  193.       endif
  194. C
  195. C     VERIFICATION DE LEUR PRESENCE
  196. C____________________________________________________________________
  197. C
  198.       CALL KOMCHA(IPTR1,IPMAIL,CONM,MOSTRS,MOTYR8,1,INFOS,3,IVASTR)
  199.       IF (IERR.NE.0) GOTO 9990
  200.  
  201.       IF (ISUP1.EQ.1) THEN
  202.           CALL VALCHE(IVASTR,NSTR,IPMING,IPPORE,MOSTRS,MELE)
  203.       ENDIF
  204. C
  205. C     RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  206. C
  207.       N1PTEL=0
  208.       N1EL=0
  209.       MPTVAL=IVASTR
  210.       DO 110 IO=1,NSTR
  211.         MELVAL=IVAL(IO)
  212.         N1PTEL=MAX(N1PTEL,VELCHE(/1))
  213.         N1EL  =MAX(N1EL  ,VELCHE(/2))
  214.  110  CONTINUE
  215. C      NBGSTR=N1PTEL
  216.       IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
  217.         N1PTEL=1
  218.       ELSE
  219.         N1PTEL=NBPGAU
  220.       ENDIF
  221.       NBPTEL=N1PTEL
  222.       NEL=N1EL
  223. C____________________________________________________________________
  224. C
  225. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  226. C____________________________________________________________________
  227. C
  228.            NBROBL=0
  229.            NBRFAC=0
  230.            NOMID =0
  231.         NOTYPE = MOTYR8
  232. C           IVECT=0
  233. C
  234. C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  235. C
  236.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  237.            NBROBL=1
  238.            NBRFAC=1
  239.            SEGINI NOMID
  240.            LESOBL(1)='EPAI'
  241.            LESFAC(1)='EXCE'
  242. C
  243. C        CARACTERISTIQUES POUR LES POUTRES
  244. C
  245.          ELSE IF (MFR.EQ.7 ) THEN
  246. C
  247.            IF (IDIM.NE.3) THEN
  248.               INTERR(1)=IDIM
  249.               CALL ERREUR(709)
  250.               RETURN
  251.            ENDIF
  252. C
  253.            NBROBL=6
  254.            NBRFAC=0
  255.            SEGINI NOMID
  256.            LESOBL(1)='TORS'
  257.            LESOBL(2)='INRY'
  258.            LESOBL(3)='INRZ'
  259.            LESOBL(4)='SECT'
  260.            LESOBL(5)='DY  '
  261.            LESOBL(6)='DZ  '
  262. C
  263. C CARACTERISTIQUES POUR LES TUYAUX
  264. C
  265.          ELSE IF (MFR.EQ.13) THEN
  266.            NBROBL=2
  267.            NBRFAC=2
  268.            SEGINI NOMID
  269.            LESOBL(1)='EPAI'
  270.            LESOBL(2)='RAYO'
  271.            LESFAC(1)='RACO'
  272.            LESFAC(2)='PRES'
  273.  
  274.          ENDIF
  275.  
  276.          MOCARA=NOMID
  277.          MOTYPE=NOTYPE
  278.          NCARA=NBROBL
  279.          NCARF=NBRFAC
  280.          NCARR=NCARA+NCARF
  281.  
  282.          CALL KOMCHA(IPTR2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  283.      $                IVACAR)
  284.          IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  285.          IF (IERR.NE.0) GOTO 9990
  286.  
  287.          IF (ISUP2.EQ.1) THEN
  288.             CALL VALCHE(IVACAR,NCARR,IPMING,IPPORE,MOCARA,MELE)
  289.          ENDIF
  290.           N2=6
  291.           SEGINI MCHAML
  292.           ICHAML(NS)=MCHAML
  293.           NOMCHE(1)='SMXX'
  294.           TYPCHE(1)='REAL*8'
  295.           NOMCHE(2)='SMYY'
  296.           TYPCHE(2)='REAL*8'
  297.           NOMCHE(3)='SMZZ'
  298.           TYPCHE(3)='REAL*8'
  299.           NOMCHE(4)='SMXY'
  300.           TYPCHE(4)='REAL*8'
  301.           NOMCHE(5)='SMYZ'
  302.           TYPCHE(5)='REAL*8'
  303.           NOMCHE(6)='SMXZ'
  304.           TYPCHE(6)='REAL*8'
  305.           N2PTEL=0
  306.           N2EL=0
  307.  
  308. C-----------------------------------------------------------
  309. C           CHAQUE MELVAL = COMPOSANTE SELON SIGMA
  310. C
  311.             SEGINI MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6
  312.             IELVAL(1)=MELVA1
  313.             IELVAL(2)=MELVA2
  314.             IELVAL(3)=MELVA3
  315.             IELVAL(4)=MELVA4
  316.             IELVAL(5)=MELVA5
  317.             IELVAL(6)=MELVA6
  318.  
  319. C-----------------------------------------------------------
  320. C        BRANCHEMENT SELON ELEMENT FINI
  321. C-----------------------------------------------------------
  322. C        COQ3,COQ2,DKT
  323.          IF ((MELE.EQ.27).OR.(MELE.EQ.28).OR.(MELE.EQ.44)) GOTO 3000
  324. C        POUTRE, TIMO
  325.          IF ((MELE.EQ.29).OR.(MELE.EQ.84)) GOTO 2000
  326. C        TUYAU
  327. C         IF (MELE.EQ.42) GOTO 4000
  328. C        COQ4 ,DST
  329.          IF (MELE.EQ.49.OR.MELE.EQ.93) GOTO 5000
  330. C-----------------------------------------------------------
  331. C        AUCUNE CREATION CAR NE SAIT PAS FAIRE POUR L'ELEMENT
  332. C-----------------------------------------------------------
  333.          MOTERR(1:4) =NOMTP(MELE)
  334.          MOTERR(5:12)='CALP    '
  335.          CALL ERREUR(86)
  336.          SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  337.          GOTO 9990
  338. C-----------------------------------------------------------
  339. C        POUTRES + CONTRAINTES
  340. C-----------------------------------------------------------
  341.  2000    CONTINUE
  342.             DO 2010 N2=1,NEL
  343.                DO 2011 N1=1,NBPTEL
  344.                   MPTVAL=IVASTR
  345.                   MELVAL=IVAL(1)
  346.                   EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  347.  
  348.                   MELVAL=IVAL(2)
  349.                   EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  350.  
  351.                   MELVAL=IVAL(3)
  352.                   EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  353.  
  354.                   MELVAL=IVAL(4)
  355.                   MTORX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  356.  
  357.                   MELVAL=IVAL(5)
  358.                   FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  359.  
  360.                   MELVAL=IVAL(6)
  361.                   FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  362.  
  363.                   MPTVAL=IVACAR
  364.  
  365.                   MELVAL=IVAL(1)
  366.                   FINRX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  367.                   MELVAL=IVAL(2)
  368.                   FINRY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  369.                   MELVAL=IVAL(3)
  370.                   FINRZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  371.                   MELVAL=IVAL(4)
  372.                   SECT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  373.                   MELVAL=IVAL(5)
  374.                   PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  375.                   MELVAL=IVAL(6)
  376.                   PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  377.                   AIRY=SECT
  378.                   AIRZ=SECT
  379.  
  380. C  CALCUL DES CONTRAINTES REELLES
  381.                   MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ/FINRY)
  382.      .  -(FLEXZ*PY/FINRZ)
  383.                   MELVA2.VELCHE(N1,N2)=0.
  384.                   MELVA3.VELCHE(N1,N2)=0.
  385.                   MELVA4.VELCHE(N1,N2)=(EFFY/AIRY)-(PZ*MTORX/FINRX)
  386.                   MELVA5.VELCHE(N1,N2)=0.
  387.                   MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ)+(PY*MTORX/FINRX)
  388.  2011           CONTINUE
  389.  2010        CONTINUE
  390.  
  391.          SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  392.  
  393.          GOTO 510
  394.  
  395. C-----------------------------------------------------------
  396. C        COQ2,COQ3,DKT + CONTRAINTES
  397. C-----------------------------------------------------------
  398.  3000     CONTINUE
  399.             IF (IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN
  400.                DO 3010 N2=1,NEL
  401.                   DO 3011 N1=1,NBPTEL
  402.  
  403.                      MPTVAL=IVASTR
  404.  
  405.                      MELVAL=IVAL(1)
  406.                      AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  407.  
  408.                      MELVAL=IVAL(2)
  409.                      AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  410.  
  411.                      MELVAL=IVAL(3)
  412.                      AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  413.  
  414.                      MELVAL=IVAL(4)
  415.                      AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  416.  
  417.                      MELVAL=IVAL(5)
  418.                      AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  419.  
  420.                      MELVAL=IVAL(6)
  421.                      AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  422.  
  423.                      MPTVAL=IVACAR
  424.  
  425.                      MELVAL=IVAL(1)
  426.                      EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  427.  
  428.                      IF (I_LOC.EQ.3) THEN
  429.                         r_z = EPAI*EPAI
  430.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  431.                         MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  432.                         MELVA3.VELCHE(N1,N2)=0.
  433.                         MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z)
  434.                         MELVA5.VELCHE(N1,N2)=0.
  435.                         MELVA6.VELCHE(N1,N2)=0.
  436.                      ELSE IF (I_LOC.EQ.1) THEN
  437.                         r_z = EPAI*EPAI
  438.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  439.                         MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  440.                         MELVA3.VELCHE(N1,N2)=0.
  441.                         MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z)
  442.                         MELVA5.VELCHE(N1,N2)=0.
  443.                         MELVA6.VELCHE(N1,N2)=0.
  444.                      ELSE IF (I_LOC.EQ.2) THEN
  445.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI
  446.                         MELVA2.VELCHE(N1,N2)=AN22/EPAI
  447.                         MELVA3.VELCHE(N1,N2)=0.
  448.                         MELVA4.VELCHE(N1,N2)=AN12/EPAI
  449.                         MELVA5.VELCHE(N1,N2)=0.
  450.                         MELVA6.VELCHE(N1,N2)=0.
  451.                      ENDIF
  452.  3011                 CONTINUE
  453.  3010            CONTINUE
  454.              ENDIF
  455.  
  456.             IF (IFOUR.EQ.0) THEN
  457.                DO 3012 N2=1,NEL
  458.                   DO 3013 N1=1,NBPTEL
  459.  
  460.                      MPTVAL=IVASTR
  461.  
  462.                      MELVAL=IVAL(1)
  463.                      AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  464.  
  465.                      MELVAL=IVAL(2)
  466.                      AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  467.  
  468.                      MELVAL=IVAL(3)
  469.                      AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  470.  
  471.                      MELVAL=IVAL(4)
  472.                      AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  473.  
  474.                      MPTVAL=IVACAR
  475.  
  476.                      MELVAL=IVAL(1)
  477.                      EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  478.  
  479.                      IF (I_LOC.EQ.3) THEN
  480.                         r_z = EPAI*EPAI
  481.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  482.                         MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  483.                         MELVA3.VELCHE(N1,N2)=0.
  484.                         MELVA4.VELCHE(N1,N2)=0.
  485.                         MELVA5.VELCHE(N1,N2)=0.
  486.                         MELVA6.VELCHE(N1,N2)=0.
  487.                      ELSE IF (I_LOC.EQ.1) THEN
  488.                         r_z = EPAI*EPAI
  489.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  490.                         MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  491.                         MELVA3.VELCHE(N1,N2)=0.
  492.                         MELVA4.VELCHE(N1,N2)=0.
  493.                         MELVA5.VELCHE(N1,N2)=0.
  494.                         MELVA6.VELCHE(N1,N2)=0.
  495.                      ELSE IF (I_LOC.EQ.2) THEN
  496.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI
  497.                         MELVA2.VELCHE(N1,N2)=AN22/EPAI
  498.                         MELVA3.VELCHE(N1,N2)=0.
  499.                         MELVA4.VELCHE(N1,N2)=0.
  500.                         MELVA5.VELCHE(N1,N2)=0.
  501.                         MELVA6.VELCHE(N1,N2)=0.
  502.                      ENDIF
  503.  3013                 CONTINUE
  504.  3012            CONTINUE
  505.              ENDIF
  506.  
  507.             IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  508.                DO 3014 N2=1,NEL
  509.                   DO 3015 N1=1,NBPTEL
  510.  
  511.                      MPTVAL=IVASTR
  512.  
  513.                      MELVAL=IVAL(1)
  514.                      AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  515.  
  516.                      MELVAL=IVAL(2)
  517.                      ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  518.  
  519.                      MELVAL=IVAL(3)
  520.                      AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  521.  
  522.                      MELVAL=IVAL(4)
  523.                      AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  524.  
  525.                      MPTVAL=IVACAR
  526.  
  527.                      MELVAL=IVAL(1)
  528.                      EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  529.  
  530.                      IF (I_LOC.EQ.3) THEN
  531.                         r_z = EPAI*EPAI
  532.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  533.                         MELVA2.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z)
  534.                         MELVA3.VELCHE(N1,N2)=0.
  535.                         MELVA4.VELCHE(N1,N2)=0.
  536.                         MELVA5.VELCHE(N1,N2)=0.
  537.                         MELVA6.VELCHE(N1,N2)=0.
  538.                       ELSE IF (I_LOC.EQ.1) THEN
  539.                         r_z = EPAI*EPAI
  540.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  541.                         MELVA2.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z)
  542.                         MELVA3.VELCHE(N1,N2)=0.
  543.                         MELVA4.VELCHE(N1,N2)=0.
  544.                         MELVA5.VELCHE(N1,N2)=0.
  545.                         MELVA6.VELCHE(N1,N2)=0.
  546.                      ELSE IF (I_LOC.EQ.2) THEN
  547.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI
  548.                         MELVA2.VELCHE(N1,N2)=ANZZ/EPAI
  549.                         MELVA3.VELCHE(N1,N2)=0.
  550.                         MELVA4.VELCHE(N1,N2)=0.
  551.                         MELVA5.VELCHE(N1,N2)=0.
  552.                         MELVA6.VELCHE(N1,N2)=0.
  553.                      ENDIF
  554.  3015                 CONTINUE
  555.  3014            CONTINUE
  556.              ENDIF
  557.             IF (IFOUR.EQ.-3) THEN
  558.                DO 3016 N2=1,NEL
  559.                   DO 3017 N1=1,NBPTEL
  560.  
  561.                      MPTVAL=IVASTR
  562.  
  563.                      MELVAL=IVAL(1)
  564.                      AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  565.  
  566.                      MELVAL=IVAL(2)
  567.                      ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  568.  
  569.                      MELVAL=IVAL(3)
  570.                      AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  571.  
  572.                      MELVAL=IVAL(4)
  573.                      AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  574.  
  575.                      MPTVAL=IVACAR
  576.  
  577.                      MELVAL=IVAL(1)
  578.                      EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  579.  
  580.                      IF (I_LOC.EQ.3) THEN
  581.                         r_z = EPAI*EPAI
  582.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  583.                         MELVA2.VELCHE(N1,N2)=0.
  584.                         MELVA3.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z)
  585.                         MELVA4.VELCHE(N1,N2)=0.
  586.                         MELVA5.VELCHE(N1,N2)=0.
  587.                         MELVA6.VELCHE(N1,N2)=0.
  588.                      ELSE IF (I_LOC.EQ.1) THEN
  589.                         r_z = EPAI*EPAI
  590.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  591.                         MELVA2.VELCHE(N1,N2)=0.
  592.                         MELVA3.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z)
  593.                         MELVA4.VELCHE(N1,N2)=0.
  594.                         MELVA5.VELCHE(N1,N2)=0.
  595.                         MELVA6.VELCHE(N1,N2)=0.
  596.                      ELSE IF (I_LOC.EQ.2) THEN
  597.                         MELVA1.VELCHE(N1,N2)=AN11/EPAI
  598.                         MELVA2.VELCHE(N1,N2)=0.
  599.                         MELVA3.VELCHE(N1,N2)=ANZZ/EPAI
  600.                         MELVA4.VELCHE(N1,N2)=0.
  601.                         MELVA5.VELCHE(N1,N2)=0.
  602.                         MELVA6.VELCHE(N1,N2)=0.
  603.                      ENDIF
  604.  3017                 CONTINUE
  605.  3016            CONTINUE
  606.              ENDIF
  607.          SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  608.  
  609.          GOTO 510
  610. C-----------------------------------------------------------
  611. C        TUYAU+CONTRAINTE
  612. C-----------------------------------------------------------
  613. C 4000     CONTINUE
  614. C            DO 4010 N2=1,NEL
  615. C               DO 4011 N1=1,NBPTEL
  616. C
  617. C                 MPTVAL=IVASTR
  618. C
  619. C                  MELVAL=IVAL(1)
  620. C                  EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  621. C
  622. C                  MELVAL=IVAL(2)
  623. C                  EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  624. C
  625. C                  MELVAL=IVAL(3)
  626. C                  EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  627. C
  628. C                  MELVAL=IVAL(4)
  629. C                  FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  630. C
  631. C                  MELVAL=IVAL(5)
  632. C                  FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  633. C
  634. C                  MELVAL=IVAL(6)
  635. C
  636. C                  FLEXX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  637. C
  638. C                  MPTVAL=IVACAR
  639. C
  640. C                  MELVAL=IVAL(1)
  641. C                  EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  642. C
  643. C                  MELVAL=IVAL(2)
  644. C                  RAYO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  645. C
  646. C                 IF(IVECT.EQ.2)THEN
  647. C                  MELVAL=IVAL(6)
  648. C                  PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  649. C                  MELVAL=IVAL(7)
  650. C                  PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  651. C                 ELSE
  652. C                  MELVAL=IVAL(5)
  653. C                  IPO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  654. C                  CALL EXCOO1(IPO,PX,PY,PZ,D)
  655. C                 ENDIF
  656. C                  RINT=(RAYO-EPAI)
  657. C                  D1=SQRT((PY**2)+(PZ**2))
  658. C
  659. C  CALCUL DES CONTRAINTES REELLES
  660. C
  661. C                  FINRY=((RAYO**4)-(RINT**4))*XPI/4
  662. C                  SECT=XPI*((RAYO**2)-(RINT**2))
  663. C                  IF ((D1.GE.RINT).AND.(D1.LE.RAYO)) THEN
  664. C                     MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ
  665. C     .  /FINRY)-(FLEXZ*PY/FINRY)
  666. C                     MELVA2.VELCHE(N1,N2)=0.
  667. C                     MELVA3.VELCHE(N1,N2)=0.
  668. C                     MELVA4.VELCHE(N1,N2)=(EFFY/AIRY)
  669. C                   MELVA5.VELCHE(N1,N2)=(FLEXX/2*XPI*RAYO**2*EPAI)
  670. C                     MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ)
  671. C                  ELSE
  672. C                     CALL ERREUR(505)
  673. C         SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  674. C                    GOTO 9990
  675. C                  ENDIF
  676. C 4011           CONTINUE
  677. C 4010        CONTINUE
  678. C
  679. C         SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  680. C         GOTO 510
  681. C-----------------------------------------------------------
  682. C        COQ4  +CONTRAINTE
  683. C-----------------------------------------------------------
  684.  5000     CONTINUE
  685.             DO 5010 N2=1,NEL
  686.                DO 5011 N1=1,NBPTEL
  687.  
  688.                   MPTVAL=IVASTR
  689.  
  690.                   MELVAL=IVAL(1)
  691.                   AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  692.  
  693.                   MELVAL=IVAL(2)
  694.                   AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  695.  
  696.                   MELVAL=IVAL(3)
  697.                   AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  698.  
  699.                   MELVAL=IVAL(4)
  700.                   AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  701.  
  702.                   MELVAL=IVAL(5)
  703.                   AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  704.  
  705.                   MELVAL=IVAL(6)
  706.                   AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  707.  
  708.                   MELVAL=IVAL(7)
  709.                   V1=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  710.  
  711.                   MELVAL=IVAL(8)
  712.                   V2=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  713.  
  714.                   MPTVAL=IVACAR
  715.  
  716.                   MELVAL=IVAL(1)
  717.                   EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  718.  
  719.                   IF (I_LOC.EQ.3) THEN
  720.                      r_z = EPAI*EPAI
  721.                      MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  722.                      MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  723.                      MELVA3.VELCHE(N1,N2)=0.
  724.                      MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z)
  725.                      MELVA5.VELCHE(N1,N2)=V1/EPAI
  726.                      MELVA6.VELCHE(N1,N2)=V2/EPAI
  727.                   ELSE IF (I_LOC.EQ.1) THEN
  728.                      r_z = EPAI*EPAI
  729.                      MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  730.                      MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  731.                      MELVA3.VELCHE(N1,N2)=0.
  732.                      MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z)
  733.                      MELVA5.VELCHE(N1,N2)=V1/EPAI
  734.                      MELVA6.VELCHE(N1,N2)=V2/EPAI
  735.                   ELSE IF (I_LOC.EQ.2) THEN
  736.                      r_z = EPAI*EPAI
  737.                      MELVA1.VELCHE(N1,N2)=AN11/EPAI
  738.                      MELVA2.VELCHE(N1,N2)=AN22/EPAI
  739.                      MELVA3.VELCHE(N1,N2)=0.
  740.                      MELVA4.VELCHE(N1,N2)=AN12/EPAI
  741.                      MELVA5.VELCHE(N1,N2)=V1/EPAI
  742.                      MELVA6.VELCHE(N1,N2)=V2/EPAI
  743.                   ENDIF
  744.  5011           CONTINUE
  745.  5010        CONTINUE
  746.  
  747.          SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  748.  
  749.  
  750. C-----------------------------------------------------------
  751. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE NS
  752. C-----------------------------------------------------------
  753.   510 CONTINUE
  754.  
  755.       IF (ISUP1.EQ.1) THEN
  756.                CALL DTMVAL(IVASTR,3)
  757.       ELSE
  758.                CALL DTMVAL(IVASTR,1)
  759.       ENDIF
  760.  
  761.       IF (ISUP2.EQ.1) THEN
  762.                CALL DTMVAL(IVACAR,3)
  763.       ELSE
  764.                CALL DTMVAL(IVACAR,1)
  765.       ENDIF
  766.  
  767.       NOMID=MOSTRS
  768.       IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID
  769.       NOMID=MOCARA
  770.       IF (MOCARA.NE.0) SEGSUP NOMID
  771.  
  772.   1   CONTINUE
  773.  
  774.       SEGDES MCHELM,MMODEL
  775.  
  776.       GOTO 900
  777.  
  778. C-----------------------------------------------------------
  779. C     DESACTIVATION ET RETOUR   DANS LE CAS D'ERREUR
  780. C-----------------------------------------------------------
  781.  9990 CONTINUE
  782.  
  783.       IF (ISUP1.EQ.1) THEN
  784.                CALL DTMVAL(IVASTR,3)
  785.       ELSE
  786.                CALL DTMVAL(IVASTR,1)
  787.       ENDIF
  788.  
  789.       IF (ISUP2.EQ.1) THEN
  790.                CALL DTMVAL(IVACAR,3)
  791.       ELSE
  792.                CALL DTMVAL(IVACAR,1)
  793.       ENDIF
  794.  
  795.       NOMID=MOCARA
  796.       IF (MOCARA.NE.0) SEGSUP NOMID
  797.       NOMID=MOSTRS
  798.       IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID
  799.       SEGSUP MCHELM
  800.  
  801.  900  continue
  802.       notype = MOTYR8
  803.       SEGSUP,notype
  804.  
  805.       RETURN
  806.       END
  807.  
  808.  
  809.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales