Télécharger la plaquette Cast3M


fr en

Télécharger calp2.eso

Retour à la liste

Numérotation des lignes : 

calp2

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

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