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

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