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

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