Télécharger la plaquette Cast3M


fr en

Télécharger epthp.eso

Retour à la liste

Numérotation des lignes : 

epthp

  1. C EPTHP     SOURCE    OF166741  24/05/06    21:15:05     11082          
  2.  
  3. C=======================================================================
  4. C=                             E P T H P                               =
  5. C=                             ---------                               =
  6. C=                                                                     =
  7. C=  Fonction :                                                         =
  8. C=  ----------                                                         =
  9. C=   Calcul des deformations d'origine thermique.                      =
  10. C=   Sous-programme appele par EPTH (epth.eso).                        =
  11. C=                                                                     =
  12. C=  Parametres :  (E)=Entree   (S)=Sortie                              =
  13. C=  ------------                                                       =
  14. C=   IPMODL   (E)   Pointeur sur le segment MMODEL                     =
  15. C=   IPCHE1   (E)   Pointeur sur le segment MCHELM de CARACTERISTIQUES =
  16. C=   IPCHE2   (E)   Pointeur sur le segment MCHELM de TEMPERATURES     =
  17. C=   IPEPTH   (S)   Pointeur sur le segment MCHPOI de forces nodales   =
  18. C=   IRET     (S)   Entier valant 1 en cas de succes, 0 sinon (et un   =
  19. C=                  message d'erreur est imprime dans ce cas)          =
  20. C=                                                                     =
  21. C=  Remarque : Variation parabolique de la temperature dans les COQUES =
  22. C   ---------- Cas ORTHOTROPE et ANISOTROPE traites pour les MASSIFS   =
  23. C=======================================================================
  24.  
  25.       SUBROUTINE EPTHP (IPMODL,IPCHE1,IPCHE2,IPEPTH,IRET)
  26.  
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8 (A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCGEOME
  33. -INC CCREEL
  34. -INC CCHAMP
  35. C==DEB= FORMULATION HHO == INCLUDE =====================================
  36. -INC CCHHOPA
  37. C==FIN= FORMULATION HHO ================================================
  38.  
  39. -INC SMCHAML
  40. -INC SMELEME
  41. -INC SMINTE
  42. -INC SMMODEL
  43. -INC SMCOORD
  44.  
  45.       SEGMENT NOTYPE
  46.         CHARACTER*16 TYPE(NBTYPE)
  47.       ENDSEGMENT
  48.  
  49.       SEGMENT MPTVAL
  50.         INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  51.         CHARACTER*16 TYVAL(NCOSOU)
  52.       ENDSEGMENT
  53.  
  54.       SEGMENT MVELCH
  55.         REAL*8 VALMAT(NV1)
  56.       ENDSEGMENT
  57.  
  58.       SEGMENT MWRK2
  59.         REAL*8 XE(3,NBNN)
  60.         REAL*8 TXR(IDIM,IDIM),XLOC(3,3),XGLOB(3,3)
  61.         REAL*8 ROTS(NEPTH,NEPTH)
  62.       ENDSEGMENT
  63.  
  64.       SEGMENT MWRK3
  65.         REAL*8 RES(NEPTH)
  66.       ENDSEGMENT
  67.  
  68.       SEGMENT ISEG(0)
  69.  
  70.       PARAMETER (NINF=3)
  71.       INTEGER INFOS(NINF)
  72.       DIMENSION CRIGI(12)
  73.       CHARACTER*8 CMATE,PHAM
  74.       CHARACTER*(NCONCH) CONM
  75.       LOGICAL LOGMA,LOGMF,lsupde,lsupma,lsupte
  76.  
  77.       IRET=0
  78.  
  79. c preliminaire : modèle effectif
  80.  
  81. C  1 - VERIFICATIONS DES DONNEES DE L'OPERATEUR
  82. C ==============================================
  83. C  1.1 - Verification du lieu support du MCHAML de caracteristiques
  84. C =====
  85.       ISupC=0
  86.       CALL QUESUP(IPMODL,IPCHE1,5,0,ISupC,iOK)
  87.       IF (ISupC.GT.1) RETURN
  88. C =====
  89. C  1.2 - Verification du lieu support du MCHAML de temperatures
  90. C =====
  91.       ISupT=0
  92.       CALL QUESUP(IPMODL,IPCHE2,5,0,ISupT,iOK)
  93.       IF (ISupT.GT.1) RETURN
  94.  
  95. C  2 - QUELQUES INITIALISATIONS
  96. C ==============================
  97. C  2.1 - Activation du MMODEL
  98. C =====
  99.       MMODEL=IPMODL
  100.       NSOUS =KMODEL(/1)
  101. C =====
  102. C  2.2 - Activation du MCHELM associe au champ de deformations
  103. C =====
  104.       L1=12
  105.       N1=NSOUS
  106.       N3=6
  107.       SEGINI,MCHELM
  108.       TITCHE='DEFORMATIONS'
  109.       IFOCHE=IFOUR
  110.       IPEPTH=MCHELM
  111. C =====
  112. C  2.3 - Initialisation du segment du type des composantes du champ de
  113. C        temperatures et defini une seule fois (identique sur IPMODL)
  114. C =====
  115.       NBTYPE=1
  116.       SEGINI,NOTYPE
  117.       TYPE(1)='REAL*8'
  118.       MOTYTE=NOTYPE
  119.  
  120. C  3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou)
  121. C ========================================================
  122.       KSOU = 0
  123.       DO iSou=1,NSOUS
  124. C =====
  125. C  3.1 - Quelques initialisations
  126. C =====
  127.         lsupma =.true.
  128.         lsupte =.true.
  129.         MOTEMP = 0
  130.         IVATEM = 0
  131.         MOMATR = 0
  132.         IVAMAT = 0
  133.         MOCARA = 0
  134.         IVACAR = 0
  135.         MOEPTH = 0
  136.         IVAETH = 0
  137.         MCHAML = 0
  138.         TEMP   = XZero
  139.         THM    = XZero
  140.         THIF   = XZero
  141.         THSU   = XZero
  142.         IPMINT = 0
  143. C =====
  144. C  3.2 - Activation du sous-modele (iSou)
  145. C =====
  146.         IMODEL = KMODEL(iSou)
  147.         MELE   = NEFMOD
  148.         IPMAIL = IMAMOD
  149.         CONM   = CONMOD
  150.  
  151.         PHAM  =conm(17:24)
  152.         NPINT =0
  153. * l operateur sait ce qu il peut traiter
  154.         if(formod(1)(1:9).ne.'MECANIQUE'.and.
  155.      &formod(1)(1:6).ne.'POREUX'.and.formod(1)(1:7).ne.'LIQUIDE')
  156.      & goto 98
  157.         KSOU = KSOU + 1
  158.         IF (INFMOD(/1).NE.0) NPINT=INFMOD(1)
  159. C =====
  160. C  3.3 - Determination ...
  161. C =====
  162.         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,iOK)
  163.         IF (iOK.EQ.0) GOTO 210
  164.         iOK=0
  165. C =====
  166. C  3.4 - Determination de la nature du materiau et verification
  167. C =====
  168. C*      NFOR=FORMOD(/2)
  169. C*      NMAT=MATMOD(/2)
  170. C*      CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  171.         CMATE = CMATEE
  172.         MATE  = IMATEE
  173.         INAT  = INATUU
  174. C*      IF (CMATE.EQ.' ') THEN
  175. C*        CALL ERREUR(251)
  176. C*        GOTO 210
  177. C*      ENDIF
  178.         LOGMA = CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  179.      &          CMATE.EQ.'UNIDIREC'
  180. C =====
  181. C  3.5 - Recuperation d'informations sur l'element fini du sous-modele
  182. C        Activation du segment d'integration
  183. C =====
  184. *        CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  185. *        IF (IERR.NE.0) GOTO 210
  186. *        INFO=IPINF
  187.         NBGS=INFELE(4)
  188.         IPORE=INFELE(8)
  189. *        IPMINT=INFELE(11)
  190.         IPMINT=infmod(7)
  191.         MINTE=IPMINT
  192.         if (mele.eq.260) then
  193.           nbpgau=5
  194.         else
  195.           NBPGAU=POIGAU(/1)
  196.         endif
  197.         MFR =INFELE(13)
  198. C=DEB==== FORMULATION HHO ==== Traitement MFR = 1 (MASSIF) =============
  199.         IF (MFR .EQ. HHO_MFR_ELEMENT) MFR = 1
  200. C=FIN==== FORMULATION HHO ==============================================
  201.         NEPTH=INFELE(16)
  202.         LOGMF = MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33.OR.MFR.EQ.63
  203. C =====
  204. C  3.6 - Recuperation d'informations liees au maillage IPMAIL
  205. C =====
  206.         MELEME=IPMAIL
  207.         NBNN=NUM(/1)
  208.         NBELEM=NUM(/2)
  209.         NBNO=NBNN
  210.         IPPORE=0
  211.         IF (MFR.EQ.33) THEN
  212.           NBNO=IPORE
  213.           IPPORE=NBNN
  214.         ENDIF
  215.         IF (MFR.EQ.63) THEN
  216. C         NBNO=IPORE
  217.           IPPORE=NBNN
  218.         ENDIF
  219. C =====
  220. C  3.7 - Recuperation des temperatures associees au sous-modele
  221. C        Verification de leur presence dans le MCHAML (IPCHE2)
  222. C =====
  223.         NFAC=0
  224.         if(lnomid(8).ne.0) then
  225.           lsupte=.false.
  226.           nomid =lnomid(8)
  227.           motemp=nomid
  228.           ntem  =lesobl(/2)
  229.           nfac  =lesfac(/2)
  230.         else
  231.           CALL IDTEMP(MFR,IFOUR,NPINT,MOTEMP,NTEM,NFAC)
  232.         endif
  233.         CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,MOTYTE,1,INFOS,3,IVATEM)
  234.         IF (IERR.NE.0) GOTO 230
  235.         IF (ISupT.EQ.1)THEN
  236.           CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE,MOTEMP,MELE)
  237.           IF (IERR.NE.0) THEN
  238.             ISupT=0
  239.             GOTO 230
  240.           ENDIF
  241.         ENDIF
  242. C =====
  243. C  3.8 - Recuperation des noms des caracteristiques MATERIAU
  244. C        Traitement suivant la formulation MFR et l'element fini MELE
  245. C        Verification de leur presence dans le MCHAML (IPCHE1)
  246. C =====
  247.         NBROBL=0
  248.         NBRFAC=0
  249.         NOMID =0
  250. C= 3.8.1 - Elements POUTRE,BARRE,POI1,TUYAUX...
  251.         IF (MELE.EQ.29.OR.MELE.EQ. 42.OR.MELE.EQ. 45.OR.MELE.EQ. 46.OR.
  252.      .      MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124) THEN
  253.           NBROBL=2
  254.           SEGINI,NOMID
  255.           LESOBL(1)='ALPH'
  256.           LESOBL(2)='TALP'
  257.  
  258. C= 3.8.2 - Materiau isotrope
  259.         ELSEIF (CMATE.EQ.'ISOTROPE') THEN
  260.           NBROBL=2
  261.           SEGINI,NOMID
  262.           IF (MFR.EQ.35) THEN
  263.             LESOBL(1)='ALPN'
  264.           ELSE
  265.             LESOBL(1)='ALPH'
  266.           ENDIF
  267.           LESOBL(2)='TALP'
  268.  
  269. C= 3.8.3 - Materiau orthotrope
  270.         ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  271.           IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  272.             NBROBL=5
  273.             SEGINI,NOMID
  274.             LESOBL(1)='ALP1'
  275.             LESOBL(2)='ALP2'
  276.             LESOBL(3)='V1X'
  277.             LESOBL(4)='V1Y'
  278.             LESOBL(5)='TALP'
  279.           ELSEIF (MFR.EQ.75) THEN
  280.             IF (IDIM.EQ.3) THEN
  281.             NBROBL=7
  282.             SEGINI,NOMID
  283.               LESOBL(1)='ALPN'
  284.               LESOBL(2)='ALP1'
  285.               LESOBL(3)='ALP2'
  286.               LESOBL(4)='ALQN'
  287.               LESOBL(5)='ALQ1'
  288.               LESOBL(6)='ALQ2'
  289.               LESOBL(7)='TALP'
  290.             ELSEIF (IDIM.EQ.2) THEN
  291.             NBROBL=4
  292.             SEGINI,NOMID
  293.               LESOBL(1)='ALPN'
  294.               LESOBL(2)='ALPS'
  295.               LESOBL(3)='ALQS'
  296.               LESOBL(4)='TALP'
  297.             ENDIF
  298.           ELSEIF (MFR.EQ.35) THEN
  299.             NBROBL=4
  300.             SEGINI,NOMID
  301.             LESOBL(1)='ALPN'
  302.             LESOBL(2)='V1X'
  303.             LESOBL(3)='V1Y'
  304.             LESOBL(4)='TALP'
  305.           ELSEIF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  306.             IF (IFOUR.EQ.-2) THEN
  307.               NBROBL=5
  308.               SEGINI,NOMID
  309.               LESOBL(1)='ALP1'
  310.               LESOBL(2)='ALP2'
  311.               LESOBL(3)='V1X'
  312.               LESOBL(4)='V1Y'
  313.               LESOBL(5)='TALP'
  314.             ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
  315.      .               IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  316.               NBROBL=6
  317.               SEGINI,NOMID
  318.               LESOBL(1)='ALP1'
  319.               LESOBL(2)='ALP2'
  320.               LESOBL(3)='ALP3'
  321.               LESOBL(4)='V1X'
  322.               LESOBL(5)='V1Y'
  323.               LESOBL(6)='TALP'
  324.             ELSEIF (IFOUR.EQ.2) THEN
  325.               NBROBL=10
  326.               SEGINI,NOMID
  327.               LESOBL(1 )='ALP1'
  328.               LESOBL(2 )='ALP2'
  329.               LESOBL(3 )='ALP3'
  330.               LESOBL(4 )='V1X '
  331.               LESOBL(5 )='V1Y '
  332.               LESOBL(6 )='V1Z '
  333.               LESOBL(7 )='V2X '
  334.               LESOBL(8 )='V2Y '
  335.               LESOBL(9 )='V2Z '
  336.               LESOBL(10)='TALP'
  337.             ELSEIF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  338.               IF (IFOUR.EQ.6) THEN
  339.                 NBROBL=2
  340.                 SEGINI,NOMID
  341.                 LESOBL(1)='ALP1'
  342.                 LESOBL(2)='TALP'
  343.               ELSEIF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN
  344.                 NBROBL=3
  345.                 SEGINI,NOMID
  346.                 LESOBL(1)='ALP1'
  347.                 LESOBL(2)='ALP3'
  348.                 LESOBL(3)='TALP'
  349.               ELSEIF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN
  350.                 NBROBL=3
  351.                 SEGINI,NOMID
  352.                 LESOBL(1)='ALP1'
  353.                 LESOBL(2)='ALP2'
  354.                 LESOBL(3)='TALP'
  355.               ELSE
  356.                 NBROBL=4
  357.                 SEGINI,NOMID
  358.                 LESOBL(1)='ALP1'
  359.                 LESOBL(2)='ALP2'
  360.                 LESOBL(3)='ALP3'
  361.                 LESOBL(4)='TALP'
  362.               ENDIF
  363.             ENDIF
  364.           ENDIF
  365.  
  366. C= 3.8.4 - Materiau anisotrope
  367.         ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  368.           IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  369.             IF (IFOUR.EQ.-2) THEN
  370.               NBROBL=6
  371.               SEGINI,NOMID
  372.               LESOBL(1)='ALP1'
  373.               LESOBL(2)='ALP2'
  374.               LESOBL(3)='AL12'
  375.               LESOBL(4)='V1X '
  376.               LESOBL(5)='V1Y '
  377.               LESOBL(6)='TALP'
  378.             ELSEIF (IFOUR.EQ.-3 .OR.IFOUR.EQ.-1.OR.
  379.      .              IFOUR.EQ. 0 .OR.IFOUR.EQ. 1) THEN
  380.               NBROBL=7
  381.               SEGINI,NOMID
  382.               LESOBL(1)='ALP1'
  383.               LESOBL(2)='ALP2'
  384.               LESOBL(3)='AL12'
  385.               LESOBL(4)='ALP3'
  386.               LESOBL(5)='V1X '
  387.               LESOBL(6)='V1Y '
  388.               LESOBL(7)='TALP'
  389.             ELSEIF (IFOUR.EQ.2) THEN
  390.               NBROBL=13
  391.               SEGINI,NOMID
  392.               LESOBL(1 )='ALP1'
  393.               LESOBL(2 )='ALP2'
  394.               LESOBL(3 )='ALP3'
  395.               LESOBL(4 )='AL12'
  396.               LESOBL(5 )='AL13'
  397.               LESOBL(6 )='AL23'
  398.               LESOBL(7 )='V1X '
  399.               LESOBL(8 )='V1Y '
  400.               LESOBL(9 )='V1Z '
  401.               LESOBL(10)='V2X '
  402.               LESOBL(11)='V2Y '
  403.               LESOBL(12)='V2Z '
  404.               LESOBL(13)='TALP'
  405.             ENDIF
  406.           ELSEIF (MFR.EQ.75) THEN
  407.             IF (IDIM.EQ.3) THEN
  408.             NBROBL=7
  409.             SEGINI,NOMID
  410.               LESOBL(1)='ALP1'
  411.               LESOBL(2)='ALP2'
  412.               LESOBL(3)='ALP3'
  413.               LESOBL(4)='ALQ1'
  414.               LESOBL(5)='ALQ2'
  415.               LESOBL(6)='ALQ3'
  416.               LESOBL(7)='TALP'
  417.             ELSEIF (IDIM.EQ.2) THEN
  418.             NBROBL=4
  419.             SEGINI,NOMID
  420.               LESOBL(1)='ALP1'
  421.               LESOBL(2)='ALP2'
  422.               LESOBL(3)='ALQ3'
  423.               LESOBL(4)='TALP'
  424.             ENDIF
  425.           ENDIF
  426.  
  427. C= 3.8.5 - Materiau unidirectionnel
  428.         ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  429.           IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  430.             NBROBL=8
  431.             SEGINI,NOMID
  432.             LESOBL(1)='ALPH'
  433.             LESOBL(2)='V1X '
  434.             LESOBL(3)='V1Y '
  435.             LESOBL(4)='V1Z '
  436.             LESOBL(5)='V2X '
  437.             LESOBL(6)='V2Y '
  438.             LESOBL(7)='V2Z '
  439.             LESOBL(8)='TALP'
  440.           ELSE
  441.             NBROBL=4
  442.             SEGINI,NOMID
  443.             LESOBL(1)='ALPH'
  444.             LESOBL(2)='V1X '
  445.             LESOBL(3)='V1Y '
  446.             LESOBL(4)='TALP'
  447.           ENDIF
  448.  
  449.         ELSE
  450.           if(lnomid(6).ne.0) then
  451.             lsupma=.false.
  452.             nomid=lnomid(6)
  453.             momatr=nomid
  454.             nmatr=lesobl(/2)
  455.             nmatf=lesfac(/2)
  456.           else
  457.             CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  458.           endif
  459.           NOMID =MOMATR
  460.           NBROBL=NMATR
  461.           NBRFAC=NMATF
  462.         ENDIF
  463.  
  464.         MOMATR = NOMID
  465.         NMATR  = NBROBL
  466.         NMATF  = NBRFAC
  467.         NMATT  = NMATR + NMATF
  468.         NBGMAT = 0
  469.         NELMAT = 0
  470. C= 3.8.6 - Verification de la presence des caracteristiques dans IPCHE1
  471.         IF (MOMATR.NE.0) THEN
  472.           IF (CMATE.EQ.'SECTION') THEN
  473.             NBTYPE=3
  474.             SEGINI,NOTYPE
  475.             TYPE(1)='POINTEURMMODEL'
  476.             TYPE(2)='POINTEURMCHAML'
  477.             TYPE(3)='POINTEURLISTREEL'
  478.           ELSE
  479.             NBTYPE=1
  480.             SEGINI,NOTYPE
  481.             TYPE(1)='REAL*8'
  482.           ENDIF
  483.           MOTYPE=NOTYPE
  484.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,
  485.      .                INFOS,3,IVAMAT)
  486.           SEGSUP,NOTYPE
  487.           IF (IERR.NE.0) GOTO 240
  488.           IF (ISupC.EQ.1) THEN
  489.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  490.             IF (IERR.NE.0)THEN
  491.                ISupC=0
  492.                GOTO 240
  493.             ENDIF
  494.           ENDIF
  495.           MPTVAL=IVAMAT
  496.           MELVAL=IVAL(1)
  497.           DO i=1,NMATT
  498.             IF (IVAL(i).NE.0) THEN
  499.               MELVAL=IVAL(i)
  500.               IF (CMATE.EQ.'SECTION') THEN
  501.                 NBGMAT=MAX(NBGMAT,IELCHE(/1))
  502.                 NELMAT=MAX(NELMAT,IELCHE(/2))
  503.               ELSE
  504.                 NBGMAT=MAX(NBGMAT,VELCHE(/1))
  505.                 NELMAT=MAX(NELMAT,VELCHE(/2))
  506.               ENDIF
  507.             ENDIF
  508.           ENDDO
  509.         ENDIF
  510. C =====
  511. C  3.9 - Recuperation des noms des caracteristiques
  512. C =====
  513.         NBROBL=0
  514.         NBRFAC=0
  515.         IVECT =0
  516.         NOMID =0
  517.         NOTYPE=MOTYTE
  518. C= 3.9.1 - Elements COQUES : epaisseur
  519.         IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  520.           NBROBL=1
  521.           SEGINI,NOMID
  522.           LESOBL(1)='EPAI'
  523. C= 3.9.2 - Elements BARREs et CERCEs : section
  524.         ELSEIF (MFR.EQ.27) THEN
  525.           NBROBL=1
  526.           SEGINI,NOMID
  527.           LESOBL(1)='SECT'
  528. C= 3.9.3 - Elements BAEX : section, excentrements et orientation
  529.         ELSEIF (MFR.EQ.49) THEN
  530.           NBROBL=6
  531.           SEGINI,NOMID
  532.           LESOBL(1)='SECT'
  533.           LESOBL(2)='EXCZ'
  534.           LESOBL(3)='EXCY'
  535.           LESOBL(4)='VX  '
  536.           LESOBL(5)='VY  '
  537.           LESOBL(6)='VZ  '
  538. C= 3.9.4 - Elements POUTREs
  539.         ELSEIF (MFR.EQ.7) THEN
  540.           IF (CMATE.NE.'SECTION') THEN
  541.             NBROBL=1
  542.             SEGINI,NOMID
  543.             LESOBL(1)='SECT'
  544.           ENDIF
  545. C= 3.9.5 - Elements TUYAUx
  546.         ELSEIF (MFR.EQ.13) THEN
  547.           NBROBL=2
  548.           NBRFAC=4
  549.           SEGINI,NOMID
  550.           LESOBL(1)='EPAI'
  551.           LESOBL(2)='RAYO'
  552.           LESFAC(1)='RACO'
  553.           LESFAC(2)='VX  '
  554.           LESFAC(3)='VY  '
  555.           LESFAC(4)='VZ  '
  556.           IVECT=1
  557.         ENDIF
  558.         MOCARA= NOMID
  559.         NCARA = NBROBL
  560.         NCARF = NBRFAC
  561.         NCARR = NCARA + NCARF
  562.  
  563. C= 3.9.6 - Verification de leur presence dans IPCHE1
  564.         IF (MOCARA.NE.0) THEN
  565.           MOTYPE=NOTYPE
  566.           IF (IPCHE1.NE.0) THEN
  567.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,
  568.      .                  INFOS,3,IVACAR)
  569.             IF (IERR.NE.0) GOTO 250
  570.  
  571.           ELSE
  572.             MOTERR(1:4)='CARA'
  573.             MOTERR(5:8)='CARA'
  574.             MOTERR(9:12)=NOMTP(MELE)
  575.             MOTERR(13:20)='EPTH'
  576.             CALL ERREUR(145)
  577.             GOTO 250
  578.           ENDIF
  579.  
  580.           IF (ISupC.EQ.1) THEN
  581.             CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  582.             IF (IERR.NE.0) THEN
  583.               ISupC=0
  584.               GOTO 250
  585.             ENDIF
  586.           ENDIF
  587.         ENDIF
  588. C ======
  589. C  3.10 - Recuperation des noms des composantes de deformations
  590. C ======
  591.         if(lnomid(5).ne.0) then
  592.           nomid=lnomid(5)
  593.           moepth=nomid
  594.           lsupde=.false.
  595.           nstr=lesobl(/2)
  596.         else
  597.          CALL IDDEFO(IMODEL,IFOUR,MOEPTH,NSTR,NFAC)
  598.          lsupde=.true.
  599.         endif
  600.  
  601. C       Meme verification que dans modeli.eso (On a eu un BUG une fois)
  602.         IF(NSTR .NE. NEPTH)THEN
  603.           IPT1     =IMAMOD
  604.           MOTERR   =NOMS(IPT1.ITYPEL)
  605.           INTERR(1)=NSTR
  606.           INTERR(2)=NEPTH
  607.           CALL ERREUR(1098)
  608.           RETURN
  609.         ENDIF
  610. C ======
  611. C  3.11 - Initialisation du MCHAML des contraintes de Von Mises (MCHAML)
  612. C         associe au modele elementaire iSou (de maillage IPMAIL)
  613. C         Remplissage des donnees associees a MCHAML dans MCHELM(global)
  614. C ======
  615. C= 3.11.1 - Initialisation de MCHAML
  616.         N2=NEPTH
  617.         SEGINI,MCHAML
  618. C= 3.11.2 - Remplissage de MCHEML  (KSou)
  619.         CONCHE(KSou)=CONM
  620.         IMACHE(KSou)=IPMAIL
  621.         ICHAML(KSou)=MCHAML
  622.         INFCHE(KSou,1)=0
  623.         INFCHE(KSou,2)=0
  624.         INFCHE(KSou,3)=NIFOUR
  625.         INFCHE(KSou,4)=IPMINT
  626.         INFCHE(KSou,5)=0
  627.         INFCHE(KSou,6)=5
  628. C= 3.11.3 - Initialisation des N2 MELVAL associes a MCHAML
  629. C=          Fin du remplissage de MCHAML
  630.         N1PTEL=NBGS
  631.         N1EL=NBELEM
  632.         IF (MELE.EQ.30.OR.MELE.EQ.43) THEN
  633.           N1PTEL=1
  634.           N1EL  =1
  635.         ENDIF
  636.         N2PTEL=0
  637.         N2EL  =0
  638.         NS    =1
  639.         NCOSOU=N2
  640.         SEGINI,MPTVAL
  641.         IVAETH=MPTVAL
  642.         NOMID=MOEPTH
  643.         DO i=1,N2
  644.           NOMCHE(i)=LESOBL(i)
  645.           TYPCHE(i)='REAL*8'
  646.           SEGINI,MELVAL
  647.           IELVAL(i)=MELVAL
  648.           IVAL(i)  =MELVAL
  649.         ENDDO
  650. C ======
  651. C  3.12 - Initialisation de quelques segments de travail
  652. C         Recuperation des fonctions de forme et de leurs derivees au
  653. C         centre de l'element pour le calcul des axes locaux
  654. C ======
  655.         IF (LOGMA) THEN
  656.           IF (LOGMF) THEN
  657.             IELE=NUMGEO(MELE)
  658.             CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  659.             IF (IERR.NE.0) GOTO 260
  660.             MINTE2=IPT1
  661.           ENDIF
  662.           SEGINI,MWRK2
  663.         ENDIF
  664.         NV1=NMATT
  665.         SEGINI,MVELCH,MWRK3
  666. C ======
  667. C  3.13 - Boucle sur les elements du sous-modele elementaire
  668. C ======
  669.         DO iElt=1,NBELEM
  670. C= 3.13.1 - Cas des elements MASSIFs - materiau a "TROPIE"
  671. C=          Recuperation des coordonnees des noeuds de l element iElt
  672. C=          Determination des axes locaux aux noeuds
  673.           IF (LOGMA.AND.LOGMF) THEN
  674.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  675.             NBSH=MINTE2.SHPTOT(/2)
  676.             CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  677.             IF (nbsh.EQ.-1) THEN
  678.               CALL ERREUR(525)
  679.               GOTO 260
  680.             ENDIF
  681.           ENDIF
  682. C= 3.13.2 - Cas de la poutre TIMO et modele SECTION
  683.           IF (CMATE.EQ.'SECTION') THEN
  684.             MPTVAL=IVAMAT
  685.             MELVAL=IVAL(1)
  686.             IBMN=MIN(iElt,IELCHE(/2))
  687.             IPMODL=IELCHE(1,IBMN)
  688.             MELVAL=IVAL(2)
  689.             IBMN=MIN(iElt,IELCHE(/2))
  690.             IPMAT=IELCHE(1,IBMN)
  691.             CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,0)
  692.           ENDIF
  693. C= 3.13.3 - Boucle sur les points de Gauss
  694.           DO iGau=1,NBPGAU
  695. C= 3.13.3.1 - Remplissage du tableau des caracteristiques du materiau
  696.             IF (CMATE.NE.'SECTION') THEN
  697.               MPTVAL=IVAMAT
  698.               DO i=1,NMATT
  699.                 MELVAL=IVAL(i)
  700.                 IBMN=MIN(iElt,VELCHE(/2))
  701.                 IGMN=MIN(iGau,VELCHE(/1))
  702.                 VALMAT(i)=VELCHE(IGMN,IBMN)
  703.               ENDDO
  704.             ENDIF
  705. C= 3.13.3.2 - Prise en compte des epaisseur et excentrement dans le cas
  706. C=            des coques minces avec ou sans cisaillement transverse
  707.             IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
  708.      $   OR.CMATE.EQ.'UNIDIREC') .AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  709.               MPTVAL=IVACAR
  710.               MELVAL=IVAL(1)
  711.               IF (MELVAL.NE.0) THEN
  712.                 IBMN=MIN(iElt,VELCHE(/2))
  713.                 IGMN=MIN(iGau,VELCHE(/1))
  714.                 EPAIST=VELCHE(IGMN,IBMN)
  715.               ELSE
  716.                 CALL ERREUR(527)
  717.                 GOTO 260
  718.               ENDIF
  719.             ENDIF
  720. C= 3.13.3.3 - Recuperation des temperatures du point de Gauss iGau (T et TALP)
  721. C             TEMP = T_courant - T_ALPHA_REFERENCE
  722.             MPTVAL=IVAMAT
  723.             MELVAL=IVAL(IVAL(/1))
  724.             TALP  =VELCHE(IGMN,IBMN)
  725.  
  726.             MPTVAL=IVATEM
  727.             MELVAL=IVAL(1)
  728.             IGMN=MIN(iGau,VELCHE(/1))
  729.             IBMN=MIN(iElt,VELCHE(/2))
  730.             TEMP=VELCHE(IGMN,IBMN) - TALP
  731.  
  732. C           write(6,*) 'EPTHP',ielt,igau,igmn,ibmn,temp
  733.             IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'.
  734.      $       OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')).
  735.      $         OR.(MFR.EQ.5.AND.
  736.      $          (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'))) THEN
  737.               IF (NPINT.EQ.0) THEN
  738.                 THIF=TEMP
  739.                 TEMP=XZero
  740.                 MELVAL=IVAL(2)
  741.                 IGMN=MIN(iGau,VELCHE(/1))
  742.                 IBMN=MIN(iElt,VELCHE(/2))
  743.                 THM=VELCHE(IGMN,IBMN)
  744.                 MELVAL=IVAL(3)
  745.                 IGMN=MIN(iGau,VELCHE(/1))
  746.                 IBMN=MIN(iElt,VELCHE(/2))
  747.                 THSU=VELCHE(IGMN,IBMN)
  748.               ENDIF
  749.               E3=DZEGAU(iGau)
  750.             ELSE
  751.               IF (CMATE.EQ.'SECTION') TEMP=TEMP*CRIGI(1)
  752.             ENDIF
  753.  
  754. C= 3.13.3.4 - Cas ISOTROPE : calcul des deformations thermiques
  755.             IF (CMATE.EQ.'ISOTROPE') THEN
  756.               CALL EPTHIS(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  757.      .                    E3,EPAIST,RES,NPINT,KERRE)
  758. C= 3.13.3.5 - Cas ORTHOTROPE : calcul des deformations thermiques
  759.             ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  760.               IF (NPINT.EQ.0) THEN
  761.                 CALL EPTHOR(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  762.      .                      E3,EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  763.               ELSE
  764.                 KERRE=19
  765.               ENDIF
  766. C= 3.13.3.6 - Cas ANISOTROPE : calcul des deformations thermiques
  767.             ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  768.               IF (NPINT.EQ.0) THEN
  769.                 CALL EPTHAN(MFR,MELE,VALMAT,NEPTH,TEMP,TXR,XLOC,XGLOB,
  770.      .                      ROTS,RES,KERRE)
  771.               ELSE
  772.                 KERRE=19
  773.               ENDIF
  774. C= 3.13.3.7 - Cas UNIDIRECTIONNEL : calcul des deformations thermiques
  775.             ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  776.               IF (NPINT.EQ.0) THEN
  777.                 CALL EPTHUN(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  778.      .                      EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  779.               ELSE
  780.                 KERRE=19
  781.               ENDIF
  782. C= 3.13.3.8 - Cas HOMOGENEISE et SECTION : calcul des deformations ther.
  783.             ELSEIF (CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN
  784.               IF (NPINT.EQ.0) THEN
  785.                 CALL EPTHHS(MELE,VALMAT,NEPTH,TEMP,RES,KERRE)
  786.               ELSE
  787.                 KERRE=19
  788.               ENDIF
  789. C= 3.13.3.9 - Cas non prevus et traitement des ERREURS
  790.             ELSE
  791.               KERRE=19
  792.             ENDIF
  793.             IF (KERRE.EQ.19) THEN
  794.               CALL ERREUR(19)
  795.               GOTO 260
  796.             ELSEIF (KERRE.EQ.86) THEN
  797.               MOTERR(1:4)=NOMTP(MELE)
  798.               MOTERR(5:12)='EPTH'
  799.               CALL ERREUR(86)
  800.               GOTO 260
  801.             ENDIF
  802. C= 3.13.3.10 - Stockage des deformations dans les MELVAL
  803.             MPTVAL=IVAETH
  804.             DO i=1,NEPTH
  805.               MELVAL=IVAL(i)
  806.               VELCHE(iGau,iElt)=RES(i)
  807.             ENDDO
  808.           ENDDO
  809. C       Fin boucle sur les points de Gauss
  810.  
  811.         ENDDO
  812. C       Fin boucle sur les elements
  813.  
  814. C       Traitement elements ICompressibles (methode BBAR)
  815.         IF (MFR.EQ.31) THEN
  816.           IELE=NUMGEO(MELE)
  817.           CALL RESHPT(NBPGAU,NBNO,IELE,MELE,NPINT,IPMINT,IRT1)
  818.           IF (IERR.NE.0) RETURN
  819.           IPCHA1 = MCHAML
  820.           CALL EPTBBA(MELE,IPCHA1,IPMINT,IPMAIL,IPCHA2)
  821.           IF (IERR.NE.0) RETURN
  822.           IF (IPCHA2.NE.MCHAML) SEGSUP,MCHAML
  823.           MCHAML = IPCHA2
  824.           ICHAML(KSou)=MCHAML
  825.         ENDIF
  826.  
  827. C ======
  828. C  3.14 - Desactivation/suppression de segments associes a iSou
  829. C         Sortie prematuree en cas d'ERREUR (iOK=0)
  830. C ======
  831.         IF (IERR.EQ.0) iOK=1
  832.  260    SEGSUP,MVELCH,MWRK3
  833.         IF (MOEPTH.NE.0) THEN
  834.           NOMID=MOEPTH
  835.           if(lsupde)SEGSUP,NOMID
  836.         ENDIF
  837.         IF (LOGMA) THEN
  838.           SEGSUP,MWRK2
  839.         ENDIF
  840.  250    IF (MOCARA.NE.0) THEN
  841.           NOMID=MOCARA
  842.           SEGSUP,NOMID
  843.           IF (ISupC.EQ.1) THEN
  844.             CALL DTMVAL(IVACAR,3)
  845.           ELSE
  846.             CALL DTMVAL(IVACAR,1)
  847.           ENDIF
  848.         ENDIF
  849.  240    IF (MOMATR.NE.0) THEN
  850.           NOMID=MOMATR
  851.           if(lsupma)SEGSUP,NOMID
  852.           IF (ISupC.EQ.1) THEN
  853.             CALL DTMVAL(IVAMAT,3)
  854.           ELSE
  855.             CALL DTMVAL(IVAMAT,1)
  856.           ENDIF
  857.         ENDIF
  858.  230    IF (MOTEMP.NE.0) THEN
  859.           NOMID=MOTEMP
  860.           if(lsupte)SEGSUP,NOMID
  861.         ENDIF
  862.         IF (ISupT.EQ.1) THEN
  863.           CALL DTMVAL(IVATEM,3)
  864.         ELSE
  865.          CALL DTMVAL(IVATEM,1)
  866.         ENDIF
  867.  220    CONTINUE
  868.  210    CONTINUE
  869.         IF (iOK.EQ.0) THEN
  870.           CALL DTMVAL(IVAETH,3)
  871.           IF (MCHAML.NE.0) SEGSUP,MCHAML
  872.           SEGSUP,MCHELM
  873.           GOTO 300
  874.         ENDIF
  875.         CALL DTMVAL(IVAETH,1)
  876.  98    CONTINUE
  877.       ENDDO
  878.  
  879. C  4 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  880. C ====================================================
  881.       IRET=1
  882.       N1 = KSOU
  883.       SEGADJ MCHELM
  884.  300  CONTINUE
  885.       NOTYPE=MOTYTE
  886.       SEGSUP,NOTYPE
  887.  
  888.       END
  889.  
  890.  
  891.  

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