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    OF166741  25/02/21    21:18:29     12166          
  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 = INFELE(12)
  233. c*         MINTE1 = INFMOD(8) <- pas toujours defini
  234.  
  235. *        Test presence MCHAML CARACTERISTIQUES si MFR=5 et IMOT<>0
  236.  
  237.          IF (MFR.EQ.5.AND.ICAS.NE.1.AND.ICAS.NE.4
  238.      &               .AND.IPCHE1.EQ.0) THEN
  239.             MOTERR(1:32) = 'CARACTERISTIQUES'
  240.             CALL ERREUR(565)
  241.             RETURN
  242.          ENDIF
  243.  
  244. *        L'option GRADIENT ne fonctionne qu'en massif actuellement
  245.  
  246.          IF (ICAS.EQ.4.AND.MFR.NE.1.AND.MFR.NE.31.AND.MFR.NE.63) THEN
  247.             CALL ERREUR(19)
  248.             RETURN
  249.          ENDIF
  250.  
  251. *        Creation du tableau INFOS
  252.  
  253.          CALL IDENT(IPMAIL,CONM,IPCHE,IPCHE1,INFOS,IRTD)
  254.          IF (IRTD.EQ.0) GOTO 9990
  255.  
  256.          INFCHE(ISOUSS,1)=0
  257.          INFCHE(ISOUSS,2)=0
  258.          INFCHE(ISOUSS,3)=NHRM
  259.          INFCHE(ISOUSS,4)=MINTE
  260.          INFCHE(ISOUSS,5)=0
  261.          INFCHE(ISOUSS,6)=5
  262.  
  263. *        Activation du segment MINTE
  264.  
  265.          NBPGAU=POIGAU(/1)
  266.  
  267. *        Activation du segment MELEME
  268.  
  269.          NBNN  =NUM(/1)
  270.          NBELEM=NUM(/2)
  271.          IPPORE=0
  272.          IF(MFR.EQ.33) IPPORE=NBNN
  273.  
  274. *        Recherche des noms de composantes
  275.  
  276.          IF (ICONT.EQ.1) THEN
  277.            nomid=lnomid(4)
  278.            if (nomid.eq.0) then
  279.              write(ioimp,*) 'ICONT : nomid = 0'
  280.              call erreur(5)
  281.            endif
  282.          ELSE IF (IDEFO.EQ.1) THEN
  283.            nomid = lnomid(5)
  284.            if (nomid.eq.0) then
  285.              write(ioimp,*) 'IDEFO(1): nomid = 0'
  286.              call erreur(5)
  287.            endif
  288.          ELSE IF (IDEFO.EQ.2) THEN
  289.            nomid=lnomid(13)
  290.            if (nomid.eq.0) then
  291.              write(ioimp,*) 'IDEFO(2): nomid = 0'
  292.              call erreur(5)
  293.            endif
  294.          ELSE IF (IVARI.EQ.1) THEN
  295.            nomid=lnomid(10)
  296.            if (nomid.eq.0) then
  297.              write(ioimp,*) 'IVARI : nomid = 0'
  298.              call erreur(5)
  299.            endif
  300.          ENDIF
  301.          ncomp = nomid.lesobl(/2)
  302.          nfac  = nomid.lesfac(/2)
  303.          mocomp = nomid
  304.  
  305. *        Verification de leur presence
  306.  
  307.          IF(IVARI.EQ.1.AND.LEPROB.EQ.0) THEN
  308.            NBTYPE=0
  309.            SEGINI NOTYPE
  310.          ELSE
  311.            NOTYPE=MOTYR8
  312.          ENDIF
  313.  
  314.          CALL KOMCHA(IPCHE,IPMAIL,CONM,MOCOMP,NOTYPE,1,INFOS,3,IVACOM)
  315.          IF (NOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  316.          IF (IERR.NE.0) GOTO 9990
  317.          IF (ISUP.EQ.1) THEN
  318.             CALL VALCHE(IVACOM,NCOMP,IPMINT,IPPORE,MOCOMP,MELE)
  319.          ENDIF
  320.  
  321. *        Cas des variables internes
  322. *         Si rien a faire, on se contente de recopier la
  323. *         zone elementaire du MCHAML
  324.  
  325.          IF(IVARI.EQ.1.AND.LEPROB.EQ.0) THEN
  326.            MPTVAL=IVACOM
  327.            NCOS=IVAL(/1)
  328.            IE=0
  329.            DO 1021 ICOMP=1,NCOS
  330.              IF(IVAL(ICOMP).NE.0) IE=IE+1
  331. 1021       CONTINUE
  332.  
  333.            N2=IE
  334.            SEGINI MCHAML
  335.            ICHAML(ISOUSS)=MCHAML
  336.            NSR=1
  337.            NCOSOR=N2
  338.            SEGINI MPTVA1
  339.            IVARES=MPTVA1
  340.            NOMID=MOCOMP
  341.            NBROBL=LESOBL(/2)
  342.            NBRFAC=LESFAC(/2)
  343.            IE=0
  344.            DO 1022 ICOMP=1,NCOMP
  345.              IF(IVAL(ICOMP).NE.0) THEN
  346.                IE=IE+1
  347.                IF(ICOMP.LE.NBROBL) THEN
  348.                  NOMCHE(IE)=LESOBL(ICOMP)
  349.                ELSE
  350.                  NOMCHE(IE)=LESFAC(ICOMP-NBROBL)
  351.                ENDIF
  352.                TYPCHE(IE)=TYVAL(ICOMP)
  353.                MELVA1=IVAL(ICOMP)
  354.                SEGINI,MELVAL=MELVA1
  355.                IELVAL(IE)=MELVAL
  356.                MPTVA1.IVAL(IE)=MELVAL
  357.              ENDIF
  358.  1022      CONTINUE
  359.            GO TO 510
  360.          ENDIF
  361.  
  362. *        Taille des MELVAL a allouer (champ non constant a priori)
  363.  
  364.          N1PTEL=NBGS
  365.          N1EL  =NBELEM
  366.          NBPTEL=N1PTEL
  367.          NEL   =N1EL
  368.  
  369. *        Creation du MCHAML pour la zone ISOUS
  370.  
  371.          N2=NCOMP
  372.          SEGINI MCHAML
  373.          ICHAML(ISOUSS)=MCHAML
  374.          NSR=1
  375.          NCOSOR=NCOMP
  376.          SEGINI MPTVAL
  377.          IVARES=MPTVAL
  378.          NOMID=MOCOMP
  379.          DO 102 ICOMP=1,NCOMP
  380.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  381.             TYPCHE(ICOMP)='REAL*8'
  382.             N2PTEL=0
  383.             N2EL=0
  384.             SEGINI MELVAL
  385.             IELVAL(ICOMP)=MELVAL
  386.             IVAL(ICOMP)=MELVAL
  387.  102     CONTINUE
  388.  
  389. *        Coordonnees des points caracterisant les
  390. *        reperes choisis (spherique, cylindrique, ...)
  391.  
  392.          lsupgd=.true.
  393.          IF (IMOT.NE.0) THEN
  394.             IF (IMOT.EQ.1) THEN
  395.  
  396. *              Coordonnees POLAIRES
  397.  
  398.                IF (IDIM.EQ.2) THEN
  399.                   IREF=(IPTV1-1)*(IDIM+1)
  400.                   CENTR1(1)=XCOOR(IREF+1)
  401.                   CENTR1(2)=XCOOR(IREF+2)
  402.                   DO 12 II=1,4
  403.                     V1(II)=0.D0
  404.  12               CONTINUE
  405.                ELSE
  406.                   CALL ERREUR(31)
  407.                   GOTO 9990
  408.                ENDIF
  409.             ELSE IF (IDIM.EQ.3) THEN
  410.  
  411. *              Autres coordonnees
  412.  
  413.                IREF1=(IPTV1-1)*(IDIM+1)
  414.                CENTR1(1)=XCOOR(IREF1+1)
  415.                CENTR1(2)=XCOOR(IREF1+2)
  416.                CENTR1(3)=XCOOR(IREF1+3)
  417.                IREF2=(IPTV2-1)*(IDIM+1)
  418.                AXEI1(1)=XCOOR(IREF2+1)
  419.                AXEI1(2)=XCOOR(IREF2+2)
  420.                AXEI1(3)=XCOOR(IREF2+3)
  421.                DO 103 IC=1,IDIM
  422.                   V1(IC)=AXEI1(IC)-CENTR1(IC)
  423.  103           CONTINUE
  424.                V1(4)=SQRT(V1(1)**2+V1(2)**2+V1(3)**2)
  425.                IF (V1(4).EQ.0.D0) THEN
  426.                   CALL ERREUR(277)
  427.                   GOTO 9990
  428.                ENDIF
  429.                DO 104 IC=1,IDIM
  430.                   V1(IC) = V1(IC) / V1(4)
  431.  104           CONTINUE
  432.                IF (IPTV3.NE.0) THEN
  433.                   IREF3=(IPTV3-1)*(IDIM+1)
  434.                   CENTR2(1)=XCOOR(IREF3+1)
  435.                   CENTR2(2)=XCOOR(IREF3+2)
  436.                   CENTR2(3)=XCOOR(IREF3+3)
  437.                ENDIF
  438.             ENDIF
  439.          ELSE IF (ICAS.EQ.2) THEN
  440.  
  441. *           Repere cartesien (IPCHE1 = 0 et IMOT = 0)
  442.  
  443.             IF (IDIM.EQ.2) THEN
  444.                IREF=(IPTV1-1)*(IDIM+1)
  445.                V1(1)=XCOOR(IREF+1)
  446.                V1(2)=XCOOR(IREF+2)
  447.                V1(4)=SQRT(V1(1)**2+V1(2)**2)
  448.                IF (V1(4).EQ.0.) THEN
  449.                   CALL ERREUR(277)
  450.                   GOTO 9990
  451.                ENDIF
  452.             ELSE IF (IDIM.EQ.3) THEN
  453.                IREF1=(IPTV1-1)*(IDIM+1)
  454.                V1(1)=XCOOR(IREF1+1)
  455.                V1(2)=XCOOR(IREF1+2)
  456.                V1(3)=XCOOR(IREF1+3)
  457.                V1(4)=SQRT(V1(1)**2+V1(2)**2+V1(3)**2)
  458.                IF (V1(4).EQ.0.D0) THEN
  459.                   CALL ERREUR(277)
  460.                   GOTO 9990
  461.                ENDIF
  462.                IF (IPTV2.NE.0) THEN
  463.                   IREF2=(IPTV2-1)*(IDIM+1)
  464.                   V2(1)=XCOOR(IREF2+1)
  465.                   V2(2)=XCOOR(IREF2+2)
  466.                   V2(3)=XCOOR(IREF2+3)
  467.                   V2(4)=SQRT(V2(1)**2+V2(2)**2+V2(3)**2)
  468.                   IF (V2(4).EQ.0.D0) THEN
  469.                      CALL ERREUR(277)
  470.                      GOTO 9990
  471.                   ENDIF
  472.                   W3(1)=(V1(2)*V2(3)-V1(3)*V2(2))/(V1(4)*V2(4))
  473.                   W3(2)=(V1(3)*V2(1)-V1(1)*V2(3))/(V1(4)*V2(4))
  474.                   W3(3)=(V1(1)*V2(2)-V1(2)*V2(1))/(V1(4)*V2(4))
  475.                   W2(1)=(W3(2)*V1(3)-W3(3)*V1(2))/V1(4)
  476.                   W2(2)=(W3(3)*V1(1)-W3(1)*V1(3))/V1(4)
  477.                   W2(3)=(W3(1)*V1(2)-W3(2)*V1(1))/V1(4)
  478.                ENDIF
  479.             ENDIF
  480.          ELSEIF (ICAS.EQ.1) THEN
  481.  
  482. *        On veut le tenseur dans le repere d'orthotropie. Il est
  483. *        stocke pour chaque element dans un MCHAML de CARACTERISTIQUES
  484. *        (IMOT = 0 et IPCHE1 <> 0)
  485.  
  486.             IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
  487.                IF (IDIM.EQ.2) THEN
  488.                   NBROBL=2
  489.                   NBRFAC=0
  490.                   SEGINI NOMID
  491.                   MOVEC=NOMID
  492.                   LESOBL(1)='V1X '
  493.                   LESOBL(2)='V1Y '
  494.                ELSE
  495.                   NBROBL=6
  496.                   NBRFAC=0
  497.                   SEGINI NOMID
  498.                   MOVEC=NOMID
  499.                   LESOBL(1)='V1X '
  500.                   LESOBL(2)='V1Y '
  501.                   LESOBL(3)='V1Z '
  502.                   LESOBL(4)='V2X '
  503.                   LESOBL(5)='V2Y '
  504.                   LESOBL(6)='V2Z '
  505.                ENDIF
  506.             ELSE IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  507.                NBROBL=2
  508.                NBRFAC=0
  509.                SEGINI NOMID
  510.                MOVEC=NOMID
  511.                LESOBL(1)='V1X '
  512.                LESOBL(2)='V1Y '
  513.             ENDIF
  514.             NVEC = NBROBL+NBRFAC
  515.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOVEC,MOTYR8,
  516.      &                  1,INFOS,3,IVAVEC)
  517.             IF (IERR.NE.0) GOTO 9990
  518.  
  519. *        cas du champ de gradient
  520.  
  521.          ELSE IF (ICAS.EQ.4) THEN
  522.  
  523. *        On veut tourner le tenseur la matrice contenue dans
  524. *        un MCHAML de GRADIENT  ( IPCHE1 )
  525.            nomid=lnomid(3)
  526.            if (nomid.eq.0) then
  527.              write(ioimp,*) 'ICAS : nomid = 0'
  528.              call erreur(5)
  529.            endif
  530.            movec=nomid
  531.            nvec=lesobl(/2)
  532.            nfac=lesfac(/2)
  533.            lsupgd=.false.
  534.  
  535. *       VERIFICATION DE LEUR PRESENCE
  536.  
  537.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOVEC,MOTYR8,
  538.      &                  1,INFOS,3,IVAVEC)
  539.             IF (IERR.NE.0) GOTO 9990
  540.  
  541.          ENDIF
  542.  
  543.          IF (ICAS.NE.1.AND.MFR.EQ.5) THEN
  544.  
  545. *           Caracteristiques pour les coques epaisses
  546.  
  547.             NBROBL = 1
  548.             NBRFAC = 0
  549.             SEGINI NOMID
  550.             MOEP = NOMID
  551.             LESOBL(1) = 'EPAI'
  552.             NVEC = NBROBL + NBRFAC
  553.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOEP,MOTYR8,
  554.      &                  1,INFOS,3,IVAEP)
  555.             IF (IERR.NE.0) GOTO 9990
  556.          ENDIF
  557.  
  558. *        MASSI COQUE COQEP POUT  CIST  THER  TUYAU LISP
  559.  
  560.          GOTO (10,66,30,66,50,66,66,66,90,66,66,66,66,66,66),MFR
  561.          IF (MFR.EQ.31.or.MFR.EQ.63) GOTO 10
  562.  
  563.   66     CONTINUE
  564.          MOTERR(1:8)=NOMFR(MFR)
  565.          CALL ERREUR(194)
  566.          GOTO 9990
  567.  10      CONTINUE
  568.  
  569. *        Formulations massive et incompressible
  570.  
  571.          IF (ICAS.EQ.4) THEN
  572.  
  573. *          cas du champ de gradient
  574.  
  575.            CALL RTENS6(IPCHE1,IFOMEM,MELEME,IVAVEC,IVACOM,IVARES,
  576.      &                 IDEF,MINTE,MELE,NPINT,NVEC,KMOT)
  577.            IF(IERR.NE.0) GO TO 9990
  578.          ELSE
  579.  
  580. *          autres cas
  581.  
  582.            CALL RTENS1(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,
  583.      &                 IVAVEC,IVACOM,IVARES,IDEF,MINTE,MELE,NPINT,
  584.      &                 NVEC,V1,V2,W2,W3,CENTR1,CENTR2,AXEI1,IER1)
  585.            IF (IER1.NE.0) GOTO 9990
  586.          ENDIF
  587.          GOTO 510
  588.   30     CONTINUE
  589.  
  590. *        Formulation coque (COQ2, COQ3, DKT ...)
  591.  
  592.          IF (IFOMEM.LT.2) THEN
  593.             CALL ERREUR(339)
  594.             GOTO 9990
  595.          ENDIF
  596.         CALL RTENS2(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,IVAVEC,IVACOM,
  597.      &              IVARES,IDEF,MINTE,MELE,NPINT,NVEC,V1,V2,W2,W3,
  598.      &              CENTR1,CENTR2,AXEI1,IER1)
  599.          IF (IER1.NE.0) GOTO 9990
  600.          GOTO 510
  601.   50     CONTINUE
  602.  
  603. *        Formulation coque epaisse (COQ6, COQ8 ...)
  604.  
  605.          CALL RTENS3(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,IVAVEC,IVACOM,
  606.      &               IVARES,IVAEP,IDEF,MINTE,MINTE1,MELE,NPINT,NVEC,
  607.      &               V1,V2,W2,W3,CENTR1,CENTR2,AXEI1,ICAS,IER1)
  608.          IF (IER1.NE.0) GOTO 9990
  609.          GOTO 510
  610.   90     CONTINUE
  611.  
  612. *        Formulation coque avec cisaillement transverse
  613. *        (COQ4, DST ...)
  614.  
  615.          IF (IFOMEM.LT.2) THEN
  616.             CALL ERREUR(339)
  617.             GOTO 9990
  618.          ENDIF
  619.          CALL RTENS4(IPCHE1,IFOMEM,IMOT,IPTV2,MELEME,IVAVEC,IVACOM,
  620.      &               IVARES,IDEF,MINTE,MELE,NPINT,NVEC,V1,V2,W2,W3,
  621.      &               CENTR1,CENTR2,AXEI1,ICAS,IER1)
  622.          IF (IER1.NE.0) GOTO 9990
  623.          GOTO 510
  624.  
  625. *        Desactivation des segments de la zone ISOUS
  626.  
  627.   510    CONTINUE
  628.  
  629.          IF (ISUP.EQ.1) THEN
  630.            CALL DTMVAL(IVACOM,3)
  631.          ELSE
  632.            CALL DTMVAL(IVACOM,1)
  633.          ENDIF
  634.          CALL DTMVAL(IVARES,1)
  635.          CALL DTMVAL(IVAVEC,1)
  636.  
  637.          NOMID=MOVEC
  638.          IF (NOMID.NE.0.and.lsupgd) SEGSUP NOMID
  639.          NOMID = MOEP
  640.          IF (NOMID.NE.0) SEGSUP NOMID
  641.  
  642. *        Fin de la boucle sur les zones du MCHAML
  643.  
  644.   500 CONTINUE
  645.  
  646.       IF (N1.NE.ISOUSS) then
  647.         N1=ISOUSS
  648.         SEGADJ MCHELM
  649.       ENDIF
  650.       RETURN
  651.  
  652.  9990 CONTINUE
  653.  
  654. *     Erreur dans une zone : desactivation puis retour
  655.  
  656.       CALL DTMVAL(IVACOM,1)
  657.       IF (ISUP.EQ.1) THEN
  658.         CALL DTMVAL(IVARES,3)
  659.       ELSE
  660.         CALL DTMVAL(IVARES,1)
  661.       ENDIF
  662.       CALL DTMVAL(IVAVEC,1)
  663.  
  664.       NOMID=MOVEC
  665.       IF (NOMID.NE.0.and.lsupgd) SEGSUP NOMID
  666.       NOMID = MOEP
  667.       IF (NOMID.NE.0) SEGSUP NOMID
  668.  
  669.       IF (ISOUS.GT.1) SEGSUP MCHAML
  670.  
  671.       SEGSUP MCHELM
  672.  
  673.       RETURN
  674.       END
  675.  
  676.  
  677.  

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