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

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