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

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