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

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