Télécharger la plaquette Cast3M


fr en

Télécharger rtens.eso

Retour à la liste

Numérotation des lignes : 

rtens

  1. C RTENS     SOURCE    MB234859  25/09/08    21:16:09     12358          
  2.  
  3. *-----------------------------------------------------------------------*
  4. *     Operateur RTENS                                                   *
  5. *                                                                       *
  6. *     IPCHE  (e)   pointeur sur un MCHAML (CONTRAINTES ou DEFORMATIONS  *
  7. *                    ou DEFORMATIONS INELASTIQUES)                      *
  8. *     IPMODL (e)   pointeur sur un MMODEL                               *
  9. *     IMOT   (e)   0 : repere cartesien ou repere d'orthotropie         *
  10. *                  1 : repere en coordonnees polaires                   *
  11. *                  2 : repere en coordonnees cylindriques               *
  12. *                  3 : repere en coordonnees spheriques                 *
  13. *                  4 : repere en coordonnees toriques circulaires       *
  14. *                  5 : repere en coordonnees toriques cartesiennes      *
  15. *     KMOT   (e)   1 : transformation RT*A*R                            *
  16. *                  2 : transformation R*A*RT                            *
  17. *                  utilisé avec le champ de gradient
  18. *     IPTV1  (e)   1er vecteur  (IMOT = 0) ou 1er point  (IMOT <> 0)    *
  19. *     IPTV2  (e)   2eme vecteur (IMOT = 0) ou 2eme point (IMOT <> 0)    *
  20. *     IPTV3  (e)   3eme point (IMOT <> 0)                               *
  21. *     IPCHE1 (e)   pointeur sur un MCHAML de CARACTERISTIQUES           *
  22. *     ICAS   (e)   distingue les differents cas                         *
  23. *                  1 =
  24. *                  2 =
  25. *                  3 =
  26. *                  4 = option CHAM2 champ de gradient
  27. *     IPCHAM (s)   pointeur sur un MCHAML (CONTRAINTES ou DEFORMATIONS) *
  28. *                                         (ou VARIABLES INTERNES      ) *
  29. *                                                                       *
  30. *  Passage aux nouveaux Chamelem par S.RAMAHANDRY le 28/10/90           *
  31. *  Corrections / redecoupage / ajouts D. R.-M. le 18/3/94               *
  32. *-----------------------------------------------------------------------*
  33.       SUBROUTINE RTENS(IPCHE,IPMODL,IMOT,KMOT,
  34.      &                 IPTV1,IPTV2,IPTV3,IPCHE1,ICAS,IPCHAM)
  35.  
  36.       IMPLICIT INTEGER(I-N)
  37.       IMPLICIT REAL*8(A-H,O-Z)
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC CCHAMP
  42.  
  43. -INC SMCHAML
  44. -INC SMMODEL
  45. -INC SMINTE
  46. -INC SMCOORD
  47. -INC SMELEME
  48.  
  49. -INC TMPTVAL
  50.  
  51.       SEGMENT NOTYPE
  52.          CHARACTER*16 TYPE(NBTYPE)
  53.       ENDSEGMENT
  54.  
  55.       DIMENSION V1(4),V2(4),W2(3),W3(3)
  56.       DIMENSION CENTR1(3),CENTR2(3),AXEI1(3)
  57.  
  58.       PARAMETER ( NINF=3 )
  59.       INTEGER INFOS(NINF)
  60.       CHARACTER*(NCONCH) CONM
  61.       CHARACTER*8  CMATE
  62.       LOGICAL lsupgd
  63.  
  64.       lsupgd=.true.
  65.  
  66.       NHRM=NIFOUR
  67.  
  68. *     Activation du MMODEL
  69.  
  70.       MMODEL=IPMODL
  71.       NSOUS=KMODEL(/1)
  72.  
  73.       ICONT=0
  74.       IDEFO=0
  75.       IDEF = 0
  76.       IVARI=0
  77.       MOCOMP = 0
  78.       MOEP = 0
  79.       MOVEC = 0
  80.  
  81.       MCHELM=IPCHE
  82.       IFOMEM=IFOCHE
  83.       IF (TITCHE .EQ.'CONTRAINTES')  ICONT = 1
  84.       IF (TITCHE .EQ.'DEFORMATIONS') IDEFO = 1
  85.       IF (TITCHE .EQ.'DEFORMATIONS INELASTIQUES') IDEFO = 2
  86.       if (idefo.gt.0) idef= 1
  87.       IF (TITCHE .EQ.'VARIABLES INTERNES') IVARI = 1
  88.  
  89. *        Le sous-type du MCHAML doit etre CONTRAINTES ou DEFORMATIONS
  90. *        sauf dans le cas gradient pour le moment
  91.  
  92.       IF (ICAS.NE.4.AND.ICONT.NE.1.AND.IDEFO.NE.1.AND.IDEFO.NE.2) THEN
  93.          MOTERR(1:24) ='CONTRAINTES'
  94.          MOTERR(25:48)='DEFORMATIONS'
  95.          CALL ERREUR(109)
  96.          RETURN
  97.       ENDIF
  98.  
  99. *     Verification du lieu support du MCHAML de contraintes
  100.  
  101. ***   CALL QUESUP (IPMODL,IPCHE,5,0,ISUP,IRETCO)
  102.       ISUP = 5
  103.       CALL CHASUP (IPMODL,IPCHE,IPPV,IRET,5)
  104.       IF (IRET.NE.0) RETURN
  105.       IPCHE=IPPV
  106.  
  107. *     Verification du lieu support du MCHAML de caracteristiques
  108.  
  109.       IF (IPCHE1.NE.0) THEN
  110. **       CALL QUESUP (IPMODL,IPCHE1,5,1,ISUP1,IRETCA)
  111. **       IF (ISUP1.NE.0) RETURN
  112.       ISUP1 = 5
  113.       CALL CHASUP (IPMODL,IPCHE1,IPPV,IRET,5)
  114.       IF (IRET.NE.0) RETURN
  115.       IPCHE1=IPPV
  116.       ENDIF
  117.  
  118. *     Creation du MCHAML resultat (apres rotation)
  119.  
  120. *     cas des champs de contraintes ou de deformations
  121.  
  122.       N1=NSOUS
  123.       L1=12
  124.       IF (IVARI.EQ.1) L1=18
  125.       if (idefo.eq.2) L1=25
  126.       N3=6
  127.       SEGINI MCHELM
  128.       IF (ICONT.EQ.1) THEN
  129.          TITCHE='CONTRAINTES'
  130.       ELSE IF (IDEFO.EQ.1) THEN
  131.          TITCHE='DEFORMATIONS'
  132.       ELSE IF (IDEFO.EQ.2) THEN
  133.          TITCHE='DEFORMATIONS INELASTIQUES'
  134.       ELSE IF (IVARI.EQ.1) THEN
  135.          TITCHE='VARIABLES INTERNES'
  136.       ENDIF
  137.       IFOCHE=IFOUR
  138.       IPCHAM=MCHELM
  139.  
  140.       NBTYPE=1
  141.       SEGINI NOTYPE
  142.       TYPE(1)='REAL*8'
  143.       MOTYR8 = NOTYPE
  144.  
  145. *     Boucle sur les zones du MMODEL
  146.  
  147.       ISOUSS = 0
  148.       DO 500 ISOUS=1,NSOUS
  149.          ISOUSS = ISOUSS + 1
  150. *        compteurs de sous champs de lobjet rasutlat
  151.  
  152. *        Initialisations
  153.  
  154.          IVACOM=0
  155.          IVARES=0
  156.          IMODEL=0
  157.          NCOMP=0
  158.          MOCOMP=0
  159.          IVAVEC=0
  160.          MOVEC=0
  161.          NVEC=0
  162.  
  163. *        >>> Recuparation des informations generiques <<<
  164.  
  165.          IMODEL=KMODEL(ISOUS)
  166.          IPMAIL=IMAMOD
  167.          CONM  =CONMOD
  168.          IMACHE(ISOUSS)=IPMAIL
  169.          CONCHE(ISOUSS)=CONMOD
  170.  
  171. *        Informations contenues dans le MMODEL
  172.  
  173.          MELE=NEFMOD
  174.          MELEME=IMAMOD
  175.  
  176. *        Nature et formulation du materiau
  177.  
  178.          CMATE = CMATEE
  179.          MATE  = IMATEE
  180.          INAT  = INATUU
  181.  
  182. c GG : si le sous modele est un sure rien a faire ne cree pas de sous champs
  183.          IF (NEFMOD.EQ.259) THEN
  184.            ISOUSS = ISOUSS - 1
  185.            GOTO 500
  186.          ENDIF
  187.  
  188.          IF (IVARI.EQ.1) THEN
  189.  
  190. *           test sur le type de modele de materiau
  191. *           en cas de variables internes en attendant que
  192. *           tous les modeles soient branches
  193. *           on admet actuellement les modeles ou toutes
  194. *           les variables internes sont scalaires
  195.  
  196.             LEPROB=2
  197.  
  198. *           cas des materiaux ou on n'a rien a faire
  199.  
  200.             IF(INAT.EQ. 0.OR.INAT.EQ. 1.OR.INAT.EQ. 3.OR.
  201.      &         INAT.EQ. 5.OR.INAT.EQ.15.OR.INAT.EQ.33.OR.
  202.      &         INAT.EQ.48) THEN
  203.                  LEPROB=0
  204.             ENDIF
  205.  
  206. *           cas des materiaux a traiter ( A FAIRE )
  207.  
  208. *           IF(INAT.EQ. 4) THEN
  209. *              LEPROB=1
  210. *              ..........
  211. *           ENDIF
  212.  
  213. *        cas des materiaux non prevus
  214.  
  215.             IF(LEPROB.EQ.2) THEN
  216.                CALL ERREUR(19)
  217.                SEGSUP MCHELM
  218.                RETURN
  219.             ENDIF
  220.          ENDIF
  221.  
  222. *        Informations concernant l'element-fini
  223.  
  224. *        Coque integree ou non ?
  225.          NPINT  = INFMOD(1)
  226.          MFR    = INFELE(13)
  227.          NBGS   = INFELE(4)
  228.          NSTRS  = INFELE(16)
  229.          MINTE  = INFMOD(7)
  230. c*         MINTE  = INFELE(11)
  231.          IPMINT = MINTE
  232.          MINTE1 = INFMOD(3)
  233.  
  234. *        Test presence MCHAML CARACTERISTIQUES si MFR=5 et IMOT<>0
  235.  
  236.          IF (MFR.EQ.5.AND.ICAS.NE.1.AND.ICAS.NE.4
  237.      &               .AND.IPCHE1.EQ.0) THEN
  238.             MOTERR(1:32) = 'CARACTERISTIQUES'
  239.             CALL ERREUR(565)
  240.             RETURN
  241.          ENDIF
  242.  
  243. *        L'option GRADIENT ne fonctionne qu'en massif actuellement
  244.  
  245.          IF (ICAS.EQ.4.AND.MFR.NE.1.AND.MFR.NE.31.AND.MFR.NE.63) THEN
  246.             CALL ERREUR(19)
  247.             RETURN
  248.          ENDIF
  249.  
  250. *        Creation du tableau INFOS
  251.  
  252.          CALL IDENT(IPMAIL,CONM,IPCHE,IPCHE1,INFOS,IRTD)
  253.          IF (IRTD.EQ.0) GOTO 9990
  254.  
  255.          INFCHE(ISOUSS,1)=0
  256.          INFCHE(ISOUSS,2)=0
  257.          INFCHE(ISOUSS,3)=NHRM
  258.          INFCHE(ISOUSS,4)=MINTE
  259.          INFCHE(ISOUSS,5)=0
  260.          INFCHE(ISOUSS,6)=5
  261.  
  262. *        Activation du segment MINTE
  263.  
  264.          NBPGAU=POIGAU(/1)
  265.  
  266. *        Activation du segment MELEME
  267.  
  268.          NBNN  =NUM(/1)
  269.          NBELEM=NUM(/2)
  270.          IPPORE=0
  271.          IF(MFR.EQ.33) IPPORE=NBNN
  272.  
  273. *        Recherche des noms de composantes
  274.  
  275.          IF (ICONT.EQ.1) THEN
  276.            nomid=lnomid(4)
  277.            if (nomid.eq.0) then
  278.              write(ioimp,*) 'ICONT : nomid = 0'
  279.              call erreur(5)
  280.            endif
  281.          ELSE IF (IDEFO.EQ.1) THEN
  282.            nomid = lnomid(5)
  283.            if (nomid.eq.0) then
  284.              write(ioimp,*) 'IDEFO(1): nomid = 0'
  285.              call erreur(5)
  286.            endif
  287.          ELSE IF (IDEFO.EQ.2) THEN
  288.            nomid=lnomid(13)
  289.            if (nomid.eq.0) then
  290.              write(ioimp,*) 'IDEFO(2): nomid = 0'
  291.              call erreur(5)
  292.            endif
  293.          ELSE IF (IVARI.EQ.1) THEN
  294.            nomid=lnomid(10)
  295.            if (nomid.eq.0) then
  296.              write(ioimp,*) 'IVARI : nomid = 0'
  297.              call erreur(5)
  298.            endif
  299.          ENDIF
  300.          ncomp = nomid.lesobl(/2)
  301.          nfac  = nomid.lesfac(/2)
  302.          mocomp = nomid
  303.  
  304. *        Verification de leur presence
  305.  
  306.          IF(IVARI.EQ.1.AND.LEPROB.EQ.0) THEN
  307.            NBTYPE=0
  308.            SEGINI NOTYPE
  309.          ELSE
  310.            NOTYPE=MOTYR8
  311.          ENDIF
  312.  
  313.          CALL KOMCHA(IPCHE,IPMAIL,CONM,MOCOMP,NOTYPE,1,INFOS,3,IVACOM)
  314.          IF (NOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  315.          IF (IERR.NE.0) GOTO 9990
  316.          IF (ISUP.EQ.1) THEN
  317.             CALL VALCHE(IVACOM,NCOMP,IPMINT,IPPORE,MOCOMP,MELE)
  318.          ENDIF
  319.  
  320. *        Cas des variables internes
  321. *         Si rien a faire, on se contente de recopier la
  322. *         zone elementaire du MCHAML
  323.  
  324.          IF(IVARI.EQ.1.AND.LEPROB.EQ.0) THEN
  325.            MPTVAL=IVACOM
  326.            NCOS=IVAL(/1)
  327.            IE=0
  328.            DO 1021 ICOMP=1,NCOS
  329.              IF(IVAL(ICOMP).NE.0) IE=IE+1
  330. 1021       CONTINUE
  331.  
  332.            N2=IE
  333.            SEGINI MCHAML
  334.            ICHAML(ISOUSS)=MCHAML
  335.            NSR=1
  336.            NCOSOR=N2
  337.            SEGINI MPTVA1
  338.            IVARES=MPTVA1
  339.            NOMID=MOCOMP
  340.            NBROBL=LESOBL(/2)
  341.            NBRFAC=LESFAC(/2)
  342.            IE=0
  343.            DO 1022 ICOMP=1,NCOMP
  344.              IF(IVAL(ICOMP).NE.0) THEN
  345.                IE=IE+1
  346.                IF(ICOMP.LE.NBROBL) THEN
  347.                  NOMCHE(IE)=LESOBL(ICOMP)
  348.                ELSE
  349.                  NOMCHE(IE)=LESFAC(ICOMP-NBROBL)
  350.                ENDIF
  351.                TYPCHE(IE)=TYVAL(ICOMP)
  352.                MELVA1=IVAL(ICOMP)
  353.                SEGINI,MELVAL=MELVA1
  354.                IELVAL(IE)=MELVAL
  355.                MPTVA1.IVAL(IE)=MELVAL
  356.              ENDIF
  357.  1022      CONTINUE
  358.            GO TO 510
  359.          ENDIF
  360.  
  361. *        Taille des MELVAL a allouer (champ non constant a priori)
  362.  
  363.          N1PTEL=NBGS
  364.          N1EL  =NBELEM
  365.          NBPTEL=N1PTEL
  366.          NEL   =N1EL
  367.  
  368. *        Creation du MCHAML pour la zone ISOUS
  369.  
  370.          N2=NCOMP
  371.          SEGINI MCHAML
  372.          ICHAML(ISOUSS)=MCHAML
  373.          NSR=1
  374.          NCOSOR=NCOMP
  375.          SEGINI MPTVAL
  376.          IVARES=MPTVAL
  377.          NOMID=MOCOMP
  378.          DO 102 ICOMP=1,NCOMP
  379.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  380.             TYPCHE(ICOMP)='REAL*8'
  381.             N2PTEL=0
  382.             N2EL=0
  383.             SEGINI MELVAL
  384.             IELVAL(ICOMP)=MELVAL
  385.             IVAL(ICOMP)=MELVAL
  386.  102     CONTINUE
  387.  
  388. *        Coordonnees des points caracterisant les
  389. *        reperes choisis (spherique, cylindrique, ...)
  390.  
  391.          lsupgd=.true.
  392.          IF (IMOT.NE.0) THEN
  393.             IF (IMOT.EQ.1) THEN
  394.  
  395. *              Coordonnees POLAIRES
  396.  
  397.                IF (IDIM.EQ.2) THEN
  398.                   IREF=(IPTV1-1)*(IDIM+1)
  399.                   CENTR1(1)=XCOOR(IREF+1)
  400.                   CENTR1(2)=XCOOR(IREF+2)
  401.                   DO 12 II=1,4
  402.                     V1(II)=0.D0
  403.  12               CONTINUE
  404.                ELSE
  405.                   CALL ERREUR(31)
  406.                   GOTO 9990
  407.                ENDIF
  408.             ELSE IF (IDIM.EQ.3) THEN
  409.  
  410. *              Autres coordonnees
  411.  
  412.                IREF1=(IPTV1-1)*(IDIM+1)
  413.                CENTR1(1)=XCOOR(IREF1+1)
  414.                CENTR1(2)=XCOOR(IREF1+2)
  415.                CENTR1(3)=XCOOR(IREF1+3)
  416.                IREF2=(IPTV2-1)*(IDIM+1)
  417.                AXEI1(1)=XCOOR(IREF2+1)
  418.                AXEI1(2)=XCOOR(IREF2+2)
  419.                AXEI1(3)=XCOOR(IREF2+3)
  420.                DO 103 IC=1,IDIM
  421.                   V1(IC)=AXEI1(IC)-CENTR1(IC)
  422.  103           CONTINUE
  423.                V1(4)=SQRT(V1(1)**2+V1(2)**2+V1(3)**2)
  424.                IF (V1(4).EQ.0.D0) THEN
  425.                   CALL ERREUR(277)
  426.                   GOTO 9990
  427.                ENDIF
  428.                DO 104 IC=1,IDIM
  429.                   V1(IC) = V1(IC) / V1(4)
  430.  104           CONTINUE
  431.                IF (IPTV3.NE.0) THEN
  432.                   IREF3=(IPTV3-1)*(IDIM+1)
  433.                   CENTR2(1)=XCOOR(IREF3+1)
  434.                   CENTR2(2)=XCOOR(IREF3+2)
  435.                   CENTR2(3)=XCOOR(IREF3+3)
  436.                ENDIF
  437.             ENDIF
  438.          ELSE IF (ICAS.EQ.2) THEN
  439.  
  440. *           Repere cartesien (IPCHE1 = 0 et IMOT = 0)
  441.  
  442.             IF (IDIM.EQ.2) THEN
  443.                IREF=(IPTV1-1)*(IDIM+1)
  444.                V1(1)=XCOOR(IREF+1)
  445.                V1(2)=XCOOR(IREF+2)
  446.                V1(4)=SQRT(V1(1)**2+V1(2)**2)
  447.                IF (V1(4).EQ.0.) THEN
  448.                   CALL ERREUR(277)
  449.                   GOTO 9990
  450.                ENDIF
  451.             ELSE IF (IDIM.EQ.3) THEN
  452.                IREF1=(IPTV1-1)*(IDIM+1)
  453.                V1(1)=XCOOR(IREF1+1)
  454.                V1(2)=XCOOR(IREF1+2)
  455.                V1(3)=XCOOR(IREF1+3)
  456.                V1(4)=SQRT(V1(1)**2+V1(2)**2+V1(3)**2)
  457.                IF (V1(4).EQ.0.D0) THEN
  458.                   CALL ERREUR(277)
  459.                   GOTO 9990
  460.                ENDIF
  461.                IF (IPTV2.NE.0) THEN
  462.                   IREF2=(IPTV2-1)*(IDIM+1)
  463.                   V2(1)=XCOOR(IREF2+1)
  464.                   V2(2)=XCOOR(IREF2+2)
  465.                   V2(3)=XCOOR(IREF2+3)
  466.                   V2(4)=SQRT(V2(1)**2+V2(2)**2+V2(3)**2)
  467.                   IF (V2(4).EQ.0.D0) THEN
  468.                      CALL ERREUR(277)
  469.                      GOTO 9990
  470.                   ENDIF
  471.                   W3(1)=(V1(2)*V2(3)-V1(3)*V2(2))/(V1(4)*V2(4))
  472.                   W3(2)=(V1(3)*V2(1)-V1(1)*V2(3))/(V1(4)*V2(4))
  473.                   W3(3)=(V1(1)*V2(2)-V1(2)*V2(1))/(V1(4)*V2(4))
  474.                   W2(1)=(W3(2)*V1(3)-W3(3)*V1(2))/V1(4)
  475.                   W2(2)=(W3(3)*V1(1)-W3(1)*V1(3))/V1(4)
  476.                   W2(3)=(W3(1)*V1(2)-W3(2)*V1(1))/V1(4)
  477.                ENDIF
  478.             ENDIF
  479.          ELSEIF (ICAS.EQ.1) THEN
  480.  
  481. *        On veut le tenseur dans le repere d'orthotropie. Il est
  482. *        stocke pour chaque element dans un MCHAML de CARACTERISTIQUES
  483. *        (IMOT = 0 et IPCHE1 <> 0)
  484.  
  485.             IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
  486.                IF (IDIM.EQ.2) THEN
  487.                   NBROBL=2
  488.                   NBRFAC=0
  489.                   SEGINI NOMID
  490.                   MOVEC=NOMID
  491.                   LESOBL(1)='V1X '
  492.                   LESOBL(2)='V1Y '
  493.                ELSE
  494.                   NBROBL=6
  495.                   NBRFAC=0
  496.                   SEGINI NOMID
  497.                   MOVEC=NOMID
  498.                   LESOBL(1)='V1X '
  499.                   LESOBL(2)='V1Y '
  500.                   LESOBL(3)='V1Z '
  501.                   LESOBL(4)='V2X '
  502.                   LESOBL(5)='V2Y '
  503.                   LESOBL(6)='V2Z '
  504.                ENDIF
  505.             ELSE IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  506.                NBROBL=2
  507.                NBRFAC=0
  508.                SEGINI NOMID
  509.                MOVEC=NOMID
  510.                LESOBL(1)='V1X '
  511.                LESOBL(2)='V1Y '
  512.             ENDIF
  513.             NVEC = NBROBL+NBRFAC
  514.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOVEC,MOTYR8,
  515.      &                  1,INFOS,3,IVAVEC)
  516.             IF (IERR.NE.0) GOTO 9990
  517.  
  518. *        cas du champ de gradient
  519.  
  520.          ELSE IF (ICAS.EQ.4) THEN
  521.  
  522. *        On veut tourner le tenseur la matrice contenue dans
  523. *        un MCHAML de GRADIENT  ( IPCHE1 )
  524.            nomid=lnomid(3)
  525.            if (nomid.eq.0) then
  526.              write(ioimp,*) 'ICAS : nomid = 0'
  527.              call erreur(5)
  528.            endif
  529.            movec=nomid
  530.            nvec=lesobl(/2)
  531.            nfac=lesfac(/2)
  532.            lsupgd=.false.
  533.  
  534. *       VERIFICATION DE LEUR PRESENCE
  535.  
  536.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOVEC,MOTYR8,
  537.      &                  1,INFOS,3,IVAVEC)
  538.             IF (IERR.NE.0) GOTO 9990
  539.  
  540.          ENDIF
  541.  
  542.          IF (ICAS.NE.1.AND.MFR.EQ.5) THEN
  543.  
  544. *           Caracteristiques pour les coques epaisses
  545.  
  546.             NBROBL = 1
  547.             NBRFAC = 0
  548.             SEGINI NOMID
  549.             MOEP = NOMID
  550.             LESOBL(1) = 'EPAI'
  551.             NVEC = NBROBL + NBRFAC
  552.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOEP,MOTYR8,
  553.      &                  1,INFOS,3,IVAEP)
  554.             IF (IERR.NE.0) GOTO 9990
  555.          ENDIF
  556.  
  557. *        MASSI COQUE COQEP POUT  CIST  THER  TUYAU LISP
  558.  
  559.          GOTO (10,66,30,66,50,66,66,66,90,66,66,66,66,66,66),MFR
  560.          IF (MFR.EQ.31.or.MFR.EQ.63) GOTO 10
  561.  
  562.   66     CONTINUE
  563.          MOTERR(1:8)=NOMFR(MFR)
  564.          CALL ERREUR(194)
  565.          GOTO 9990
  566.  10      CONTINUE
  567.  
  568. *        Formulations massive et incompressible
  569.  
  570.          IF (ICAS.EQ.4) THEN
  571.  
  572. *          cas du champ de gradient
  573.  
  574.            CALL RTENS6(IPCHE1,IFOMEM,MELEME,IVAVEC,IVACOM,IVARES,
  575.      &                 IDEF,MINTE,MELE,NPINT,NVEC,KMOT)
  576.            IF(IERR.NE.0) GO TO 9990
  577.          ELSE
  578.  
  579. *          autres cas
  580.  
  581.            CALL RTENS1(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,
  582.      &                 IVAVEC,IVACOM,IVARES,IDEF,MINTE,MELE,NPINT,
  583.      &                 NVEC,V1,V2,W2,W3,CENTR1,CENTR2,AXEI1,IER1)
  584.            IF (IER1.NE.0) GOTO 9990
  585.          ENDIF
  586.          GOTO 510
  587.   30     CONTINUE
  588.  
  589. *        Formulation coque (COQ2, COQ3, DKT ...)
  590.  
  591.          IF (IFOMEM.LT.2) THEN
  592.             CALL ERREUR(339)
  593.             GOTO 9990
  594.          ENDIF
  595.         CALL RTENS2(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,IVAVEC,IVACOM,
  596.      &              IVARES,IDEF,MINTE,MELE,NPINT,NVEC,V1,V2,W2,W3,
  597.      &              CENTR1,CENTR2,AXEI1,IER1)
  598.          IF (IER1.NE.0) GOTO 9990
  599.          GOTO 510
  600.   50     CONTINUE
  601.  
  602. *        Formulation coque epaisse (COQ6, COQ8 ...)
  603.  
  604.          CALL RTENS3(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,IVAVEC,IVACOM,
  605.      &               IVARES,IVAEP,IDEF,MINTE,MINTE1,MELE,NPINT,NVEC,
  606.      &               V1,V2,W2,W3,CENTR1,CENTR2,AXEI1,ICAS,IER1)
  607.          IF (IER1.NE.0) GOTO 9990
  608.          GOTO 510
  609.   90     CONTINUE
  610.  
  611. *        Formulation coque avec cisaillement transverse
  612. *        (COQ4, DST ...)
  613.  
  614.          IF (IFOMEM.LT.2) THEN
  615.             CALL ERREUR(339)
  616.             GOTO 9990
  617.          ENDIF
  618.          CALL RTENS4(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,IVAVEC,IVACOM,
  619.      &               IVARES,IDEF,MINTE,MELE,NPINT,NVEC,V1,V2,W2,W3,
  620.      &               CENTR1,CENTR2,AXEI1,ICAS,IER1)
  621.          IF (IER1.NE.0) GOTO 9990
  622.          GOTO 510
  623.  
  624. *        Desactivation des segments de la zone ISOUS
  625.  
  626.   510    CONTINUE
  627.  
  628.          IF (ISUP.EQ.1) THEN
  629.            CALL DTMVAL(IVACOM,3)
  630.          ELSE
  631.            CALL DTMVAL(IVACOM,1)
  632.          ENDIF
  633.          CALL DTMVAL(IVARES,1)
  634.          CALL DTMVAL(IVAVEC,1)
  635.  
  636.          NOMID=MOVEC
  637.          IF (NOMID.NE.0.and.lsupgd) SEGSUP NOMID
  638.          NOMID = MOEP
  639.          IF (NOMID.NE.0) SEGSUP NOMID
  640.  
  641. *        Fin de la boucle sur les zones du MCHAML
  642.  
  643.   500 CONTINUE
  644.  
  645.       IF (N1.NE.ISOUSS) then
  646.         N1=ISOUSS
  647.         SEGADJ MCHELM
  648.       ENDIF
  649.       RETURN
  650.  
  651.  9990 CONTINUE
  652.  
  653. *     Erreur dans une zone : desactivation puis retour
  654.  
  655.       CALL DTMVAL(IVACOM,1)
  656.       IF (ISUP.EQ.1) THEN
  657.         CALL DTMVAL(IVARES,3)
  658.       ELSE
  659.         CALL DTMVAL(IVARES,1)
  660.       ENDIF
  661.       CALL DTMVAL(IVAVEC,1)
  662.  
  663.       NOMID=MOVEC
  664.       IF (NOMID.NE.0.and.lsupgd) SEGSUP NOMID
  665.       NOMID = MOEP
  666.       IF (NOMID.NE.0) SEGSUP NOMID
  667.  
  668.       IF (ISOUS.GT.1) SEGSUP MCHAML
  669.  
  670.       SEGSUP MCHELM
  671.  
  672.       RETURN
  673.       END
  674.  
  675.  
  676.  
  677.  

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