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

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