Télécharger la plaquette Cast3M


fr en

Télécharger epsi1.eso

Retour à la liste

Numérotation des lignes : 

epsi1

  1. C EPSI1     SOURCE    OF166741  25/02/21    21:16:11     12166          
  2.  
  3.       SUBROUTINE EPSI1(IDERI,MODORI,IPCHP1,IPCHA1,IPCHA2,
  4.      1                 IMAT,IPEPSI,IRET,ipchp2,noer,kerr)
  5. C_______________________________________________________________________
  6. C
  7. C            OPERATEUR DEFORMATIONS APPELE PAR EPSI
  8. C
  9. C   ENTREES :
  10. C   _________
  11. C
  12. c      IDERI = | 1 si deformations LINEaires
  13. c              | 2 si QUADratiques
  14. c              | 3 si TRUEsdell,
  15. c              | 4 si JAUMann
  16. c              | 5 si UTILisateur
  17. C      MODORI   POINTEUR SUR UN MMODEL
  18. C      IPCHP1   POINTEUR SUR UN CHAMPOINT DEPLACEMENT
  19. C      IPCHA1   POINTEUR SUR UN MCHAML DE CARACTERISTIQUE (FACULTATIF)
  20. C      IPCHA2   POINTEUR SUR UN MCHAML DE HOOKE (FACULTATIF)
  21. C      IMAT     Flag de HOOKE      (2 si oui, 1 sinon)
  22. C
  23. C   SORTIES :
  24. C   _________
  25. C
  26. C      IPEPSI   POINTEUR SUR UN MCHAML DE DEFORMATION
  27. C      IRET     1 OU 0 SUIVANT SUCCES OU PAS
  28. C
  29. C-----------------------------------------------------------------------
  30.  
  31.       IMPLICIT INTEGER(I-N)
  32.       IMPLICIT REAL*8(A-H,O-Z)
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCREEL
  37. -INC CCHAMP
  38. C==DEB= FORMULATION HHO == INCLUDE =====================================
  39. -INC CCHHOPA
  40. C==FIN= FORMULATION HHO ================================================
  41.  
  42. -INC SMCHAML
  43. -INC SMCHPOI
  44. -INC SMELEME
  45. -INC SMCOORD
  46. -INC SMMODEL
  47. -INC SMINTE
  48. -INC SMLREEL
  49.  
  50. -INC TMPTVAL
  51.  
  52.       SEGMENT NOTYPE
  53.         CHARACTER*16 TYPE(NBTYPE)
  54.       ENDSEGMENT
  55.  
  56.       CHARACTER*8  CMATE
  57.       CHARACTER*16 MO16
  58.       CHARACTER*(NCONCH) CONM
  59.       PARAMETER (NINF=3)
  60.       INTEGER INFOS(NINF)
  61.       INTEGER ISUP1
  62.       LOGICAL LDPGE,lsupma,dcmate
  63.  
  64.       ISUP1=0
  65.       IRET = 0
  66.       IPEPSI = 0
  67.       kerr = 0
  68. c     on calcule les termes quadratiques seulement si deformations QUAD
  69.       IF(IDERI.EQ.2) THEN
  70.         IREPS2=1
  71.       ELSE
  72.         IREPS2=0
  73.       ENDIF
  74.       NHRM=NIFOUR
  75. C
  76. C  ON VERIFIE QUE LE MCHAML DE CARACTERISTIQUES EST SUR SON SUPPORT
  77. C
  78.       IF (IPCHA1.NE.0) THEN
  79.          CALL QUESUP (MODORI,IPCHA1,5,0,ISUP1,IRET0)
  80.          IF (ISUP1.GT.1) RETURN
  81.       ELSE
  82. C        SI massif jaumann et truesdel ==> manque un argument
  83. C        IF() THEN
  84. C          CALL ERREUR(404)
  85. C          RETURN
  86. C        ENDIF
  87.       ENDIF
  88. C
  89. C  ON VERIFIE QUE LE MCHAML DE HOOKE EST SUR SON SUPPORT
  90. C
  91.       IF (IPCHA2.NE.0) THEN
  92.          CALL QUESUP (MODORI,IPCHA2,5,1,ISUP2,IRET0)
  93.          IF (ISUP2.NE.0) RETURN
  94.       ENDIF
  95. C
  96. C     ACTIVATION DU MODELE
  97. C
  98. C  MODORI = Modele initial complet
  99. C  IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  100.       CALL PIMODL(MODORI,IPMODL,MAILDG,2)
  101.       IF (IPMODL.EQ.0) RETURN
  102. C  IPMODL est ACTIF en retour
  103.       MMODEL=IPMODL
  104.       NSOUS = KMODEL(/1)
  105. c*dbg      write(ioimp,*) 'EPSI1=',MODORI,IPMODL,MAILDG,NSOUS
  106.  
  107. C==DEB= FORMULATION HHO ================================================
  108.       IF (IDERI.NE.1)  THEN
  109.         DO IJKL=1,NSOUS
  110.           imodel = KMODEL(IJKL)
  111.           IF (imodel.NEFMOD.EQ.HHO_NUM_ELEMENT) THEN
  112.             write(ioimp,*) 'HHO EPSI: IDERI not compatible'
  113.             call erreur(21)
  114.             return
  115.           END IF
  116.         END DO
  117.       END IF
  118. C==FIN= FORMULATION HHO ================================================
  119.  
  120. C_______________________________________________________________________
  121. C
  122. C  ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT idem pour le 2eme
  123. C_______________________________________________________________________
  124.       CALL CHAME1 (0,IPMODL,IPCHP1,' ',IPCH1,1)
  125.       IF (IERR.NE.0) RETURN
  126.       ipch2=0
  127.       IF (ipchp2.ne.0) then
  128.         call CHAME1 (0,IPMODL,IPCHP2,' ',IPCH2,1)
  129.         IF (IERR.NE.0) RETURN
  130.       ENDIF
  131. C
  132. C     CREATION DU MCHELM
  133. C
  134.       N1=NSOUS
  135.       DO IJKL=1,NSOUS
  136.         IMODEL=KMODEL(IJKL)
  137.         IF (NEFMOD.EQ.22.OR.NEFMOD.EQ.259) N1 = N1 - 1
  138.       END DO
  139.       L1=12
  140.       N3=6
  141.       SEGINI MCHELM
  142.       mchelm.TITCHE='DEFORMATIONS'
  143.       mchelm.IFOCHE=IFOUR
  144.  
  145. C Un petit segment utile :
  146.       NBTYPE = 1
  147.       SEGINI NOTYPE
  148.       TYPE(1)='REAL*8'
  149.       MOTYR8 = NOTYPE
  150. C_______________________________________________________________________
  151. C
  152. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  153. C_______________________________________________________________________
  154. C
  155.       ISOUS=0
  156.  
  157.       DO 500 KISOUS=1,NSOUS
  158. C
  159. C   INITIALISATION
  160. C
  161.         IVAMAT=0
  162.         IVACAR=0
  163.         IVADEP=0
  164.         IVADE2=0
  165.         IVAEPS=0
  166.         IPMINT=0
  167.         MOCARA=0
  168.         MOMATR=0
  169.         lsupma=.true.
  170. C
  171. C     ON RECUPERE L INFORMATION GENERALE
  172. C
  173.         IMODEL = KMODEL(KISOUS)
  174.  
  175.         IPMAIL = IMAMOD
  176.         CONM   = CONMOD
  177.         MELE   = NEFMOD
  178.         IF (MELE.EQ.22.OR.MELE.EQ.259) GOTO 502
  179. C
  180. C     CREATION DE TABLEAU INFOS
  181. C
  182.         CALL IDENT(IPMAIL,CONM,IPCH1,IPCHA1,INFOS,IRTD)
  183.         IF (IRTD.EQ.0) GOTO 9993
  184. C
  185. C     TRAITEMENT DU MODELE
  186. C
  187.         if (formod(1).eq.'MELANGE'.and.CMATEE.EQ.'PARALLEL') then
  188.           IF (IVAMOD(/1).GE.1) THEN
  189.             DO j = 1,IVAMOD(/1)
  190.               IF (TYMODE(j).EQ.'IMODEL  ') THEN
  191.                 IMODE1 = IVAMOD(j)
  192.                 IF (IMODE1.FORMOD(1)(1:10).EQ.'MECANIQUE ' .OR.
  193.      &              IMODE1.FORMOD(1)(1:10).EQ.'POREUX    ' .OR.
  194.      &              IMODE1.FORMOD(1)(1:16).EQ.'ELECTROSTATIQUE ' .OR.
  195.      &              IMODE1.FORMOD(1)(1:10).EQ.'LIQUIDE   ' ) THEN
  196.                    imodel = imode1
  197.                    goto 30
  198.                 ENDIF
  199.               ENDIF
  200.             ENDDO
  201.           ENDIF
  202.         endif
  203.  30     continue
  204. C
  205. C     NATURE DU MATERIAU
  206. C
  207.         CMATE = CMATEE
  208.         MATE  = IMATEE
  209.         INAT  = INATUU
  210.  
  211.         dcmate = .false.
  212.         do im = 1, matmod(/2)
  213. C         Pour optimisation et eviter _gfortran_compare_string inefficace
  214.           MO16=matmod(im)
  215.           if (MO16 .eq. 'IMPEDANCE       ') dcmate =.true.
  216.         enddo
  217. C_______________________________________________________________________
  218. C
  219. C     INFORMATION SUR L ELEMENT FINI
  220. C_______________________________________________________________________
  221. C
  222.         NPINT = INFMOD(1)
  223.         MFR   = INFELE(13)
  224.         IELE  = INFELE(14)
  225.         IPORE = INFELE(8)
  226.         NBGS  = INFELE(4)
  227.         NEPSI = INFELE(16)
  228.         LRE   = INFELE(9)
  229.         LW    = INFELE(7)
  230.         LHOOK = INFELE(10)
  231. c?        IPGRAV=INFMOD(2+2)
  232.         IPMINT=INFMOD(2+5)
  233. C        IPMINT =INFELE(11)
  234.         IPMIN1=INFELE(12)
  235. C        IPMIN1=INFMOD(8) <- Pas toujours defini
  236.  
  237.         MELEME = IPMAIL
  238.         NBNN   = NUM(/1)
  239.         NBELEM = NUM(/2)
  240.  
  241. ccc        mele = imodel.nefmod
  242.         if (dcmate) then
  243.           if (itypel.eq.1) mele = 45
  244.           if (itypel.eq.2) mele = 2
  245.         endif
  246.  
  247.       IPPORE=0
  248.       IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) IPPORE=NBNN
  249.       IF((MFR.NE.1.AND.IPPORE.NE.1).AND.(IDERI.EQ.3.OR.IDERI.EQ.4))THEN
  250.         call erreur (1013)
  251.         return
  252.       endif
  253. C
  254. C     EXTRACTION DES DEPLACEMENTS DU NOEUD SUPPORT DE LA
  255. C     DEFORMATION PLANE GENERALISEE (MECANIQUE) SI BESOIN
  256. C
  257.       CALL INFDPG(MFR,IFOUR, LDPGE, ndpge)
  258.       IF (LDPGE) THEN
  259.         IIPDPG = imodel.IPDPGE
  260.         IIPDPG = IPTPOI(IIPDPG)
  261.         CALL DEPDPG(IPCHP1,UZDPG,RXDPG,RYDPG,IIPDPG)
  262.         IF (IERR.NE.0) GOTO 9993
  263.       ELSE
  264.         IIPDPG = 0
  265.         UZDPG=XZero
  266.         RXDPG=XZero
  267.         RYDPG=XZero
  268.       ENDIF
  269. C
  270. C     INITIALISATION DE MINTE
  271. C
  272.         MINTE = IPMINT
  273.         NBPGAU= minte.POIGAU(/1)
  274.         if (NBGS.ne.NBPGAU) then
  275.           write(ioimp,*) 'EPSI1 : Incoherence NBGS & NBPGAU',NBGS,NBPGAU
  276.           call erreur(5)
  277.         endif
  278.  
  279. C_______________________________________________________________________
  280. C
  281. C     RECHERCHE DES NOMS COMPOSANTES
  282. C_______________________________________________________________________
  283. C
  284.         MOEPSI = lnomid(5)
  285.         if (MOEPSI.eq.0) then
  286.           write(ioimp,*) 'EPSI1 : moepsi=0',imodel
  287.           call erreur(5)
  288.         endif
  289.         nomid = MOEPSI
  290.         NDEFO = nomid.lesobl(/2)
  291.         ndefac= nomid.lesfac(/2)
  292. C Cas particulier :
  293.         if (ifomod.eq.6) then
  294.           NEPSI = NDEFO + ndefac
  295.         endif
  296.  
  297.         MODEPL = lnomid(1)
  298.         if (modepl.eq.0) then
  299.           write(ioimp,*) 'EPSI1 : modepl=0',imodel
  300.           call erreur(5)
  301.         endif
  302.         nomid = MODEPL
  303.         ndep = nomid.lesobl(/2)
  304.         nfac = nomid.lesfac(/2)
  305. C_______________________________________________________________________
  306. C
  307. C     VERICIATION DE LA PRESENCE DES COMPOSANTES DE DEPLACEMENT
  308. C_______________________________________________________________________
  309. C
  310. C==DEB= FORMULATION HHO ================================================
  311.         IF (MELE .EQ. HHO_NUM_ELEMENT) GOTO 2750
  312. C==FIN= FORMULATION HHO ================================================
  313.  
  314.         MOTYPE = MOTYR8
  315.         CALL KOMCHA(IPCH1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP)
  316.         IF (IERR.NE.0) GOTO 9993
  317. C traitement du 2e champ par point
  318.         if (ipch2.ne.0) then
  319.           CALL KOMCHA(IPCH2,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADE2)
  320.           IF (IERR.NE.0) GOTO 9993
  321.         ENDIF
  322.  
  323. c-dbg : tests de verification
  324.       if (iimpi.eq.1972) then
  325.         NUPT = 0
  326.         NUEL = 0
  327.         MPTVAL = IVADEP
  328.         DO ICOMP = 1, NDEP
  329.           MELVAL = IVAL(ICOMP)
  330.           NUPT = MAX(NUPT,VELCHE(/1))
  331.           NUEL = MAX(NUEL,VELCHE(/2))
  332.         ENDDO
  333. c-dbg
  334.         IF (NUPT.EQ.1) THEN
  335.           if (NUEL.EQ.1) then
  336.       write(ioimp,*) 'DEPLACEMENT UNIFORME IVADEP',IVADEP,NUPT,NUEL
  337.           else
  338.       write(ioimp,*) 'DEPLACEMENT CST/ELT IVADEP',IVADEP,NUPT,NUEL
  339.           endif
  340.         ENDIF
  341.         if (NUPT.EQ.1 .and. NBGS.ne.1) then
  342.           write(ioimp,*) 'NUPT != NBGS',NUPT,NBGS,NUEL
  343.         endif
  344.       endif
  345.  
  346. C==DEB= FORMULATION HHO == Etiquette speciale ==========================
  347.  2750 CONTINUE
  348. C==FIN= FORMULATION HHO ================================================
  349.  
  350. C_______________________________________________________________________
  351. C
  352. C     TAILLE DES MELVAL DU CHAMP DE DEFORMATIONS A ALLOUER
  353. C     ON CONSIDERE LE CAS GENERAL (CHAMP VARIABLE EN TOUT POINT)
  354. C     COMRED SE CHARGERA DE COMPACTER LES COMPOSANTES SI BESOIN
  355. C_______________________________________________________________________
  356. C
  357.         N1PTEL = NBGS
  358.         N1EL   = NBELEM
  359.         N2PTEL = 0
  360.         N2EL   = 0
  361.  
  362.         NBPTEL = N1PTEL
  363. c        NEL    = N1EL
  364. C
  365. C     CREATION DU MPTVAL CORRESPONDANT AU MCHAML DE LA SOUS ZONE
  366. C
  367.         NSR=1
  368.         NCOSOR=NEPSI
  369.         SEGINI MPTVAL
  370.         DO ICOMP = 1, NEPSI
  371.           SEGINI MELVAL
  372.           IVAL(ICOMP) = MELVAL
  373.         ENDDO
  374.         IVAEPS = MPTVAL
  375.  
  376. C  en cas de derivee de truesdell et de Jaumann il faudra calculer 
  377. C  des contraintes donc on a besoin de la loi de hooke ou des
  378. C  caracteristiques materiau ( young ...)
  379.  
  380. C____________________________________________________________________
  381. C
  382. C  RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL *
  383. C____________________________________________________________________
  384. C
  385.       NGRA = 0
  386.       IF (IDERI.EQ.3.or.IDERI.eq.4)  THEN
  387. C       Cas de la derivee de Truesdell ou Jaumann
  388.         IF (IPCHA1 .EQ. 0) THEN
  389.           CALL ERREUR(404)
  390.           RETURN
  391.         ENDIF
  392.  
  393.           MOGRAD = imodel.LNOMID(3)
  394.         if (MOGRAD.eq.0) then
  395.           write(ioimp,*) 'EPSI - IDERI=3 ou 4 - MOGRAD = lnomid(3) = 0'
  396.           call erreur(5)
  397.         endif
  398.           nomid = MOGRAD
  399.           NGRA = nomid.LESOBL(/2)
  400.           nfac = nomid.lesfac(/2)
  401.  
  402.         nbrobl=0
  403.         nbrfac=0
  404.         nomid = 0
  405. C Sauf cas particuliers, les composantes sont de type REAL*8.
  406.         notype = MOTYR8
  407.         IF (IMAT.EQ.2) THEN
  408.           IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
  409.             NBROBL=3
  410.             SEGINI NOMID
  411.             LESOBL(1)='MAHO'
  412.             LESOBL(2)='V1X '
  413.             LESOBL(3)='V1Y '
  414.             NBTYPE=3
  415.             SEGINI NOTYPE
  416.             TYPE(1)='POINTEURLISTREEL'
  417.             TYPE(2)='REAL*8'
  418.             TYPE(3)='REAL*8'
  419.           ELSE
  420.             NBROBL=1
  421.             SEGINI NOMID
  422.             LESOBL(1)='MAHO'
  423.             NBTYPE=1
  424.             SEGINI NOTYPE
  425.             TYPE(1)='POINTEURLISTREEL'
  426.           ENDIF
  427.           NMATR=NBROBL
  428.           NMATF=NBRFAC
  429.           NMATT=NMATR+NMATF
  430.           MOMATR=NOMID
  431.           MOTYPE=NOTYPE
  432.           CALL KOMCHA(IPCHA2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  433.           SEGSUP NOTYPE
  434.           IF (IERR.NE.0) GOTO 9990
  435.           MPTVAL=IVAMAT
  436.           MELVAL=IVAL(1)
  437.           NBGMAT=IELCHE(/1)
  438.           NELMAT=IELCHE(/2)
  439.         ELSE
  440. C____________________________________________________________________
  441. C
  442. C SINON TRAITEMENT DES CHAMPS DE MATERIAU
  443. C aussi obligatoire en massif pour truesdell et jaumann
  444. C____________________________________________________________________
  445. C
  446. C         Pour optimisation et eviter _gfortran_compare_string inefficace
  447.           MO16=FORMOD(1)
  448.           IF (MO16.EQ.'MECANIQUE       '.AND.CMATE.EQ.'ISOTROPE') THEN
  449.              NBROBL=2
  450.              SEGINI NOMID
  451.              IF (MFR.EQ.35.or.mfr.eq.78) THEN
  452.               LESOBL(1)='KS  '
  453.               LESOBL(2)='KN  '
  454.              ELSE IF(MFR.EQ.53) THEN
  455.               NBROBL=1
  456.               SEGADJ,NOMID
  457.               LESOBL(1)='KS  '
  458.              ELSE
  459.               LESOBL(1)='YOUN'
  460.               LESOBL(2)='NU  '
  461.              ENDIF
  462.  
  463.           ELSEIF(MO16.EQ.'MECANIQUE       '.AND.CMATE.EQ.'UNIDIREC')THEN
  464.            IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  465.              NBROBL=7
  466.              SEGINI NOMID
  467.              LESOBL(1)='YOUN'
  468.              LESOBL(2)='V1X '
  469.              LESOBL(3)='V1Y '
  470.              LESOBL(4)='V1Z '
  471.              LESOBL(5)='V2X '
  472.              LESOBL(6)='V2Y '
  473.              LESOBL(7)='V2Z '
  474.             ELSE
  475.              NBROBL=3
  476.              SEGINI NOMID
  477.              LESOBL(1)='YOUN'
  478.              LESOBL(2)='V1X '
  479.              LESOBL(3)='V1Y '
  480.             ENDIF
  481.  
  482.           ELSEIF(MO16.EQ.'POREUX          '.AND.CMATE.EQ.'ISOTROPE')THEN
  483.              IF (MELE.GE.79.AND.MELE.LE.83) THEN
  484.                  NBROBL=4
  485.                  SEGINI NOMID
  486.                  LESOBL(1)='YOUN'
  487.                  LESOBL(2)='NU  '
  488.                  LESOBL(3)='COB '
  489.                  LESOBL(4)='MOB '
  490.              ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  491.                  NBROBL=4
  492.                  SEGINI NOMID
  493.                  LESOBL(1)='KS  '
  494.                  LESOBL(2)='KN  '
  495.                  LESOBL(3)='COB '
  496.                  LESOBL(4)='MOB '
  497.              ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  498.                  NBROBL=10
  499.                  SEGINI NOMID
  500.                  LESOBL(1)='YOUN'
  501.                  LESOBL(2)='NU  '
  502.                  LESOBL(3)='COP1'
  503.                  LESOBL(4)='COP2'
  504.                  LESOBL(5)='CPP1'
  505.                  LESOBL(6)='CPP2'
  506.                  LESOBL(7)='KK11'
  507.                  LESOBL(8)='KK12'
  508.                  LESOBL(9)='KK21'
  509.                  LESOBL(10)='KK22'
  510.              ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  511.                  NBROBL=17
  512.                  SEGINI NOMID
  513.                  LESOBL(1)='YOUN'
  514.                  LESOBL(2)='NU  '
  515.                  LESOBL(3)='COP1'
  516.                  LESOBL(4)='COP2'
  517.                  LESOBL(5)='COP3'
  518.                  LESOBL(6)='CPP1'
  519.                  LESOBL(7)='CPP2'
  520.                  LESOBL(8)='CPP3'
  521.                  LESOBL(9)='KK11'
  522.                  LESOBL(10)='KK12'
  523.                  LESOBL(11)='KK13'
  524.                  LESOBL(12)='KK21'
  525.                  LESOBL(13)='KK22'
  526.                  LESOBL(14)='KK23'
  527.                  LESOBL(15)='KK31'
  528.                  LESOBL(16)='KK32'
  529.                  LESOBL(17)='KK33'
  530.                ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  531.                  NBROBL=10
  532.                  SEGINI NOMID
  533.                  LESOBL(1)='KS  '
  534.                  LESOBL(2)='KN  '
  535.                  LESOBL(3)='COP1'
  536.                  LESOBL(4)='COP2'
  537.                  LESOBL(5)='CPP1'
  538.                  LESOBL(6)='CPP2'
  539.                  LESOBL(7)='KK11'
  540.                  LESOBL(8)='KK12'
  541.                  LESOBL(9)='KK21'
  542.                  LESOBL(10)='KK22'
  543.                ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  544.                  NBROBL=17
  545.                  SEGINI NOMID
  546.                  LESOBL(1)='KS  '
  547.                  LESOBL(2)='KN  '
  548.                  LESOBL(3)='COP1'
  549.                  LESOBL(4)='COP2'
  550.                  LESOBL(5)='COP3'
  551.                  LESOBL(6)='CPP1'
  552.                  LESOBL(7)='CPP2'
  553.                  LESOBL(8)='CPP3'
  554.                  LESOBL(9)='KK11'
  555.                  LESOBL(10)='KK12'
  556.                  LESOBL(11)='KK13'
  557.                  LESOBL(12)='KK21'
  558.                  LESOBL(13)='KK22'
  559.                  LESOBL(14)='KK23'
  560.                  LESOBL(15)='KK31'
  561.                  LESOBL(16)='KK32'
  562.                  LESOBL(17)='KK33'
  563.              ENDIF
  564. C
  565.           ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  566.              NBROBL=6
  567.              SEGINI NOMID
  568.              LESOBL(1)='YG1 '
  569.              LESOBL(2)='YG2 '
  570.              LESOBL(3)='NU12'
  571.              LESOBL(4)='G12 '
  572.              LESOBL(5)='V1X '
  573.              LESOBL(6)='V1Y '
  574. C Autres cas :
  575.           ELSE
  576.             nomid = lnomid(6)
  577.             if(nomid.ne.0) then
  578.               nbrobl=lesobl(/2)
  579.               nbrfac=lesfac(/2)
  580.               lsupma=.false.
  581.             else
  582.               CALL IDMATR(MFR,IMODEL,nomid,nbrobl,nbrfac)
  583.               lsupma=.true.
  584.             endif
  585.           ENDIF
  586.  
  587.           NMATR=NBROBL
  588.           NMATF=NBRFAC
  589.           NMATT=NMATR+NMATF
  590.           MOMATR=NOMID
  591.           MOTYPE=NOTYPE
  592.  
  593.           CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  594.           IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  595.           IF (IERR.NE.0) GOTO 9990
  596.  
  597.           IF(ISUP1.EQ.1)THEN
  598.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  599.             IF(IERR.NE.0)THEN
  600.                ISUP1=0
  601.                GOTO 9990
  602.             ENDIF
  603.           ENDIF
  604.           MPTVAL=IVAMAT
  605.           NBGMAT = 0
  606.           NELMAT = 0
  607.           DO IM=1,NMATT
  608.             MELVAL=IVAL(IM)
  609.             IF (MELVAL.NE.0)THEN
  610.               IF (CMATE.EQ.'SECTION ') THEN
  611.                 NBGMAT=MAX(NBGMAT,IELCHE(/1))
  612.                 NELMAT=MAX(NELMAT,IELCHE(/2))
  613.               ELSE
  614.                 NBGMAT=MAX(NBGMAT,VELCHE(/1))
  615.                 NELMAT=MAX(NELMAT,VELCHE(/2))
  616.               ENDIF
  617.             ENDIF
  618.           ENDDO
  619.         ENDIF
  620.         nmattd=nmatt
  621.         ivamtd=ivamat
  622.       ENDIF
  623. C_______________________________________________________________________
  624. C
  625. C     TRAITEMENT DES CHAMP CARACTERISTIQUES
  626. C_______________________________________________________________________
  627. C
  628.       NBROBL=0
  629.       NBRFAC=0
  630.       NOMID = 0
  631. C Sauf cas particuliers, toutes les composantes sont de type REAL*8.
  632.       notype = MOTYR8
  633. C
  634. C     EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  635. C
  636.       IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  637.          NBROBL=1
  638.          NBRFAC=1
  639.          SEGINI NOMID
  640.          LESOBL(1)='EPAI'
  641.          LESFAC(1)='EXCE'
  642. C
  643. C     SECTION POUR LES BARRES
  644. C
  645.       ELSE IF (MFR.EQ.27) THEN
  646.         IF(.NOT.dcmate)  THEN
  647.  
  648.          NBROBL=1
  649.          SEGINI NOMID
  650.          LESOBL(1)='SECT'
  651.         ENDIF
  652. C
  653. C section, excentrements et orientation pour les barres excentrees
  654. C
  655.         ELSE IF (MFR.EQ.49) THEN
  656.              NBROBL=6
  657.              SEGINI NOMID
  658.              LESOBL(1)='SECT'
  659.              LESOBL(2)='EXCZ'
  660.              LESOBL(3)='EXCY'
  661.              LESOBL(4)='VX  '
  662.              LESOBL(5)='VY  '
  663.              LESOBL(6)='VZ  '
  664. C
  665. C raideurs locales et orientation pour l'element LIA2
  666. C              de liaison a 2 noeuds
  667. C
  668.        ELSE IF (MFR.EQ.51) THEN
  669.              NBROBL=9
  670.              SEGINI NOMID
  671.              LESOBL(1)='RLUX'
  672.              LESOBL(2)='RLUY'
  673.              LESOBL(3)='RLUZ'
  674.              LESOBL(4)='RLRX'
  675.              LESOBL(5)='RLRY'
  676.              LESOBL(6)='RLRZ'
  677.              LESOBL(7)='VX  '
  678.              LESOBL(8)='VY  '
  679.              LESOBL(9)='VZ  '
  680. C
  681. C     CARACTERISTIQUE POUR LES POUTRES
  682. C
  683.       ELSE IF (MFR.EQ.7) THEN
  684.        IF(.NOT.dcmate)  THEN
  685.         IF (CMATE.EQ.'SECTION ') THEN
  686.          NBRFAC=3
  687.          SEGINI NOMID
  688.          LESFAC(1)='VX'
  689.          LESFAC(2)='VY'
  690.          LESFAC(3)='VZ'
  691.         ELSE
  692.          IF(IFOUR.EQ.2) THEN
  693.            NBROBL=4
  694.            NBRFAC=5
  695.            SEGINI NOMID
  696.            LESOBL(1)='TORS'
  697.            LESOBL(2)='INRY'
  698.            LESOBL(3)='INRZ'
  699.            LESOBL(4)='SECT'
  700.            LESFAC(1)='SECY'
  701.            LESFAC(2)='SECZ'
  702.            LESFAC(3)='VX'
  703.            LESFAC(4)='VY'
  704.            LESFAC(5)='VZ'
  705.  
  706.          ELSEIF(IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.63) THEN
  707.            NBRFAC=1
  708.            NBROBL=2
  709.            SEGINI NOMID
  710.            LESOBL(1)= 'SECT'
  711.            LESOBL(2)= 'INRZ'
  712.            LESFAC(1)= 'SECY'
  713.          ENDIF
  714.         ENDIF
  715.        ENDIF
  716. C
  717. C    TIMO 2D
  718. C
  719. C      ELSE IF ((MFR.EQ.7).AND.
  720. C     & (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3)) THEN
  721. C
  722. C       IF (CMATE.NE.'SECTION') THEN
  723. C        ENDIF
  724. C
  725. C     CARACTERISTIQUE POUR LES TUYAUX
  726. C
  727.       ELSE IF (MFR.EQ.13) THEN
  728.          NBROBL=2
  729.          NBRFAC=5
  730.          SEGINI NOMID
  731.          LESOBL(1)='EPAI'
  732.          LESOBL(2)='RAYO'
  733.          LESFAC(1)='RACO'
  734.          LESFAC(2)='CISA'
  735.          LESFAC(3)='VX'
  736.          LESFAC(4)='VY'
  737.          LESFAC(5)='VZ'
  738. C
  739. C     CARACTERISTIQUE POUR LES LINESPRING
  740. C
  741.       ELSE IF (MFR.EQ.15) THEN
  742.          NBROBL=5
  743.          SEGINI NOMID
  744.          LESOBL(1)='EPAI'
  745.          LESOBL(2)='FISS'
  746.          LESOBL(3)='VX  '
  747.          LESOBL(4)='VY  '
  748.          LESOBL(5)='VZ  '
  749. C
  750. C     CARACTERISTIQUE POUR LES TUYAUX FISSURES
  751. C
  752.       ELSE IF (MFR.EQ.17) THEN
  753.          NBROBL=9
  754.          SEGINI NOMID
  755.          LESOBL(1)='RAYO'
  756.          LESOBL(2)='EPAI'
  757.          LESOBL(3)='VX  '
  758.          LESOBL(4)='VY  '
  759.          LESOBL(5)='VZ  '
  760.          LESOBL(6)='VXF '
  761.          LESOBL(7)='VYF '
  762.          LESOBL(8)='VZF '
  763.          LESOBL(9)='ANGL'
  764. C
  765. C     CARACTERISTIQUE POUR LES ELEMENTS HOMOGENEISES
  766. C
  767.       ELSE IF (MFR.EQ.37) THEN
  768.          IF (IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  769.             NBROBL=4
  770.             SEGINI NOMID
  771.             LESOBL(1)='SCEL'
  772.             LESOBL(2)='SFLU'
  773.             LESOBL(3)='EPS '
  774.             LESOBL(4)='XINE'
  775.          ELSE
  776.             NBROBL=3
  777.             SEGINI NOMID
  778.             LESOBL(1)='SCEL'
  779.             LESOBL(2)='SFLU'
  780.             LESOBL(3)='EPS '
  781.          ENDIF
  782. C
  783. C     CARACTERISTIQUE POUR LES JOINTS GENE
  784. C
  785.       ELSE IF (MFR.EQ.55) THEN
  786.          NBRFAC=1
  787.          SEGINI NOMID
  788.          LESFAC(1)='EPAI'
  789. C
  790. C==DEB= FORMULATION HHO ================================================
  791.       ELSE IF (MFR.EQ.HHO_MFR_ELEMENT) THEN
  792.         IF (MELE.EQ.HHO_NUM_ELEMENT) THEN
  793.           nbrobl = 1
  794.           nbrfac = 0
  795.           SEGINI,nomid
  796.           nomid.LESOBL(1) = 'BHHO'
  797.           nbtype = 1
  798.           SEGINI,NOTYPE
  799.           notype.TYPE(1) = 'POINTEURLISTREEL'
  800.         END IF
  801. C==FIN= FORMULATION HHO ================================================
  802.       ENDIF
  803. C
  804.         NCARA=NBROBL
  805.         NCARF=NBRFAC
  806.         NCARR=NCARA+NCARF
  807.         MOCARA = nomid
  808.  
  809.         MOTYPE = notype
  810.  
  811.         IF (MOCARA.NE.0) THEN
  812.           IF (IPCHA1.EQ.0) THEN
  813.             MOTERR(1:8)='CARACTER'
  814.             MOTERR(9:12)=NOMTP(MELE)
  815.             MOTERR(13:20)='EPSI'
  816.             CALL ERREUR(145)
  817.             GOTO 9990
  818.           ENDIF
  819.           CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS
  820.      &                ,3,IVACAR)
  821.           IF (IERR.NE.0) GOTO 9990
  822.           IF(ISUP1.EQ.1)THEN
  823.             CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  824.             IF(IERR.NE.0)THEN
  825.                ISUP1=0
  826.                GOTO 9990
  827.             ENDIF
  828.           ENDIF
  829.         ENDIF
  830.         IF (MOTYPE.NE.MOTYR8) SEGSUP,notype
  831. C____________________________________________________________________
  832. C
  833. C  RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL *
  834. C  UNIQUEMENT DANS LE CAS DE L'ELEMENT COQUE DST
  835. C____________________________________________________________________
  836. C
  837.       NMATR=0
  838.       NMATF=0
  839.       NMATT=0
  840.       NBGMAT=0
  841.       NELMAT=0
  842.       IF(MELE.EQ.93.and.IMAT.EQ.2) THEN
  843.         IF(CMATE.NE.'ISOTROPE')THEN
  844.             NBROBL=3
  845.             NBRFAC=0
  846.             SEGINI NOMID
  847.             LESOBL(1)='MAHO'
  848.             LESOBL(2)='V1X '
  849.             LESOBL(3)='V1Y '
  850.         ELSE
  851.            NBROBL=1
  852.            NBRFAC=0
  853.            SEGINI NOMID
  854.            LESOBL(1)='MAHO'
  855.         ENDIF
  856.         MOMATR=NOMID
  857.         NMATR=NBROBL
  858.         NMATF=NBRFAC
  859.         NMATT=NMATR+NMATF
  860.         IF(CMATE.NE.'ISOTROPE')THEN
  861.             NBTYPE=3
  862.             SEGINI NOTYPE
  863.             TYPE(1)='POINTEURLISTREEL'
  864.             TYPE(2)='REAL*8'
  865.             TYPE(3)='REAL*8'
  866.         ELSE
  867.            NBTYPE=1
  868.            SEGINI NOTYPE
  869.            TYPE(1)='POINTEURLISTREEL'
  870.         ENDIF
  871.         MOTYPE=NOTYPE
  872.         CALL KOMCHA(IPCHA2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  873.         SEGSUP NOTYPE
  874.         IF (IERR.NE.0) GOTO 9990
  875.         MPTVAL=IVAMAT
  876.         MELVAL=IVAL(1)
  877.         NBGMAT=IELCHE(/1)
  878.         NELMAT=IELCHE(/2)
  879.       ENDIF
  880. C____________________________________________________________________
  881. C
  882. C SINON TRAITEMENT DES CHAMPS DE MATERIAU
  883. C____________________________________________________________________
  884. C
  885.       IF((MELE.EQ.93.and.IMAT.ne.2).or.
  886.      $ (mfr.eq.7.and.CMATE.NE.'SECTION '.and.(.not.dcmate))
  887.      $.or.mfr.eq.13)THEN
  888. C      Pour optimisation et eviter _gfortran_compare_string inefficace
  889.        MO16=FORMOD(1)
  890.        IF ((MO16.EQ.'MECANIQUE       '.AND.CMATE.EQ.'ISOTROPE')
  891.      $     .or.mfr.eq.7) THEN
  892.              NBROBL=2
  893.              NBRFAC=0
  894.              SEGINI NOMID
  895.              MOMATR=NOMID
  896.              LESOBL(1)='YOUN'
  897.              LESOBL(2)='NU  '
  898.              NMATR=NBROBL
  899.              NMATF=NBRFAC
  900.         ELSEIF(MO16.EQ.'MECANIQUE       '.AND.(CMATE.EQ.'ORTHOTRO'))THEN
  901.             IF(INAT.EQ.67) THEN
  902.                NBROBL=6
  903.                NBRFAC=0
  904.                SEGINI NOMID
  905.                MOMATR=NOMID
  906.                LESOBL(1)='YG1 '
  907.                LESOBL(2)='YG2 '
  908.                LESOBL(3)='NU12'
  909.                LESOBL(4)='G12 '
  910.                LESOBL(5)='V1X '
  911.                LESOBL(6)='V1Y '
  912.                NMATR=NBROBL
  913.                NMATF=NBRFAC
  914.             ELSE
  915.               if(lnomid(6).ne.0) then
  916.                lsupma=.false.
  917.                nomid=lnomid(6)
  918.                segact nomid
  919.                momatr=nomid
  920.                nmatr=lesobl(/2)
  921.                nmatf=lesfac(/2)
  922.               else
  923.                CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  924.                nomid=MOMATR
  925.               endif
  926.             ENDIF
  927.         ELSE
  928.             CALL ERREUR(19)
  929.             GOTO 9990
  930.         ENDIF
  931.          NMATT=NMATR+NMATF
  932.  
  933. C Les composantes sont toutes de type 'REAL*8'.
  934.          MOTYPE=MOTYR8
  935. C
  936.          CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  937.          IF (IERR.NE.0) GOTO 9990
  938. C
  939.          IF(ISUP1.EQ.1)THEN
  940.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  941.             IF(IERR.NE.0)THEN
  942.                ISUP1=0
  943.                GOTO 9990
  944.             ENDIF
  945.          ENDIF
  946. C
  947.         MPTVAL=IVAMAT
  948.         NBGMAT = 0
  949.         NELMAT = 0
  950.         DO IM=1,NMATT
  951.          IF(IVAL(IM).NE.0)THEN
  952.             MELVAL=IVAL(IM)
  953.             IF (CMATE.EQ.'SECTION ') THEN
  954.               NBGMAT=MAX(NBGMAT,IELCHE(/1))
  955.               NELMAT=MAX(NELMAT,IELCHE(/2))
  956.             ELSE
  957.               NBGMAT=MAX(NBGMAT,VELCHE(/1))
  958.               NELMAT=MAX(NELMAT,VELCHE(/2))
  959.             ENDIF
  960.          ENDIF
  961.         ENDDO
  962.       ENDIF
  963. C================================================
  964. C
  965. C      CAS D'UN JOINT UNIDIMENSIONNEL JOI1
  966. C   Chargement des vecteurs situes dans les caracteristiques materiau
  967. C
  968. C================================================
  969.        IF(MFR.EQ.75) THEN
  970.          IF(IDIM.EQ.3) THEN
  971.              NBROBL=6
  972.              NBRFAC=0
  973.              SEGINI NOMID
  974.              MOMATR=NOMID
  975.              LESOBL(1)='V1X'
  976.              LESOBL(2)='V1Y'
  977.              LESOBL(3)='V1Z'
  978.              LESOBL(4)='V2X'
  979.              LESOBL(5)='V2Y'
  980.              LESOBL(6)='V2Z'
  981.              NMATR=NBROBL
  982.              NMATF=NBRFAC
  983.          ELSE IF(IDIM.EQ.2) THEN
  984.              NBROBL=2
  985.              NBRFAC=0
  986.              SEGINI NOMID
  987.              MOMATR=NOMID
  988.              LESOBL(1)='V1X'
  989.              LESOBL(2)='V1Y'
  990.              NMATR=NBROBL
  991.              NMATF=NBRFAC
  992.          ENDIF
  993.          NMATT=NMATR+NMATF
  994.          MOTYPE = MOTYR8
  995. C
  996.          CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  997.          IF (IERR.NE.0) GOTO 9990
  998. C                                                                        C
  999.           IF(ISUP1.EQ.1)THEN
  1000.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  1001.             IF(IERR.NE.0)THEN
  1002.                ISUP1=0
  1003.                GOTO 9990
  1004.             ENDIF
  1005.           ENDIF
  1006.           MPTVAL=IVAMAT
  1007.           NBGMAT = 0
  1008.           NELMAT = 0
  1009.           DO IM=1,NMATT
  1010.             IF(IVAL(IM).NE.0)THEN
  1011.               MELVAL=IVAL(IM)
  1012.               IF (CMATE.EQ.'SECTION ') THEN
  1013.                 NBGMAT=MAX(NBGMAT,IELCHE(/1))
  1014.                 NELMAT=MAX(NELMAT,IELCHE(/2))
  1015.               ELSE
  1016.                 NBGMAT=MAX(NBGMAT,VELCHE(/1))
  1017.                 NELMAT=MAX(NELMAT,VELCHE(/2))
  1018.               ENDIF
  1019.             ENDIF
  1020.           ENDDO
  1021.         nmattd=nmatt
  1022.         ivamtd= ivamat
  1023.        ENDIF
  1024. c*dbg      write(ioimp,*) 'EPSI1',imodel,ISOUS,kisous,formod(1),mele,mfr
  1025. C
  1026. C=======================================================================
  1027. C     NUMERO DES ETIQUETTES      :
  1028. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  1029. C     ON DIRIGE DANS 3 SOUS-PROGRAMMES SELON LES ELEMENTS
  1030. C
  1031. C      - massif, poreux, joints poreux ------------------> epsi2
  1032. C      - coq3,dkt,coq4,coq8,coq2,joints -----------------> epsi3
  1033. C      - poutre,tuyau,linespring,tuyau fissure,barre ----> epsi4
  1034. C      - elements XFEM (mfr = 63) -----------------------> epsix
  1035. C
  1036. C=======================================================================
  1037.  
  1038.       IF(MELE.GE.1.AND.MELE.LE.100) THEN
  1039. C            CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8
  1040.       GOTO (   99,  29,  99,   4,  99,   4,  99,   4,  99,   4
  1041. C            QUA9 RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6
  1042.      1      ,  99,  99,  99,   4,   4,   4,   4,  99,  99,  99
  1043. C            LIA8 MULT TET4 TE10 PYR5 PY13 COQ3  DKT POUT LISP
  1044.      2      ,  99,  99,   4,   4,   4,   4,  27,  27,  27,  29
  1045. C            FAC3 FAC4 FAC6 FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5
  1046.      3      ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1047. C            COQ8 TUYA TUFI COQ2 POI1 BARR RACO LSU2 COQ4 LISM
  1048.      4      ,  27,  27,  29,  27,  29,  29,  99,  99,  27,  29
  1049. C            COF3 RES2 LSU3 LSU4 LICO COQ6 CVS2 CVS3 CVT3 CVT6
  1050.      5      ,  99,  99,  99,  99,  99,  27,  99,  99,  99,  99
  1051. C            CVQ4 CVQ8 THP5 TH13 THP6 TH15 THC8 TH20 ICT3 ICQ4
  1052.      6      ,  99,  99,  99,  99,  99,  99,  99,  99,   4,   4
  1053. C            ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 IC15 TRIP QUAP
  1054.      7      ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  1055. C            CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 JOI6 JOI8
  1056.      8      ,   4,   4,   4,  27,  27,  27,  27,  27,  99,  99
  1057. C            LISC TRIH  DST LIC4 CERC TUYO LSE2 LITU HYT3 HYQ4
  1058.      9      ,  99,  99,  27,  99,  29,  29,  99,  99,  99,  99)
  1059. c cccccc
  1060.      .      ,MELE
  1061.       ELSEIF(MELE.GE.101.AND.MELE.LE.200) THEN
  1062. C            HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  1063.       GOTO (   99,  99,  99,  99,  99,  99,  99,   4,   4,   4
  1064. C            POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12
  1065.      1      ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  1066. C            PO13 PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3
  1067.      2      ,   4,   4,  29,  29,  29,  34,  34,  34,  34,  34
  1068. C            QUF4 CUF8 PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18
  1069.      3      ,  34,  34,  34,  34,  34,  34,  34,  34,  34,  34
  1070. C            MT10 MP14 SEF3 TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6
  1071.      4      ,  34,  34,  34,  34,  34,  34,  34,  34,  34,  34
  1072. C            TR21 QU36 C216 P126 TE56 PY91 TRH6 BSE2 BTR4 BQU5
  1073.      5      ,  34,  34,  34,  34,  34,  34,  34,  34,  34,  34
  1074. C            BCU9 BPR7 BTE5 BPY6 FRO4 SEGS POJS JCT3 JCI4 JGI2
  1075.      6      ,  34,  34,  34,  34,  34,  34,  34,  27,  27,  27
  1076. C            JGT3 JGI4 TRIQ QUAQ CUBQ TETQ PRIQ TRIR QUAR CUBR
  1077.      7      ,  27,  27,   4,   4,   4,   4,   4,   4,   4,   4
  1078. C            TETR PRIR Q4RI Q8RI JOQ3 JOQ6 JOQ8 JOR3 JOR6 JOR8
  1079.      8      ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  1080. C            T1D2 T1D3 M1D2 M1D3 LC03 LC07 LC09 LC27 LC21 LC15
  1081.      9      ,  34,  34,   4,   4,  34,  34,  34,  34,  34,  34)
  1082. c cccccc
  1083.      .      ,MELE-100
  1084.       ELSEIF(MELE.GE.201.AND.MELE.LE.300) THEN
  1085. C            LC19 LS03 LS07 LS09 LS27 LS21 LS15 LS19 BS03 BS07
  1086.       GOTO (   34,  34,  34,  34,  34,  34,  34,  34,  34,  34 
  1087. C            BS09 BS27 BS21 BS15 BS19 MC03 MC07 MC09 MC27 MC21
  1088.      1      ,  34,  34,  34,  34,  34,  34,  34,  34,  34,  34
  1089. C            MC15 MC19 M103 M107 M109 M127 M121 M115 M119 MS03
  1090.      2      ,  34,  34,  34,  34,  34,  34,  34,  34,  34,  34
  1091. C            MS07 MS09 MS27 MS21 MS15 MS19 QC03 QC07 QC09 QC27
  1092.      3      ,  34,  34,  34,  34,  34,  34,  34,  34,  34,  34
  1093. C            QC21 QC15 QC19 Q103 Q107 Q109 Q127 Q121 Q115 Q119
  1094.      4      ,  34,  34,  34,  34,  34,  34,  34,  34,  34,  34
  1095. C            QS03 QS07 QS09 QS27 QS21 QS15 QS19 CIFL SURE SHB8
  1096.      5      ,  34,  34,  34,  34,  34,  34,  34,  27,  34,  27
  1097. C            CAF2 CAF3 XQ4R XC8R JOI1 ZCO2 ZCO3 ZCO4 TUY2 TUY3
  1098.      6      ,  34,  34,  63,  63,  29,  29,  29,  29,  99,  99
  1099. C            COS2 COA2 ICY5 IC13 CU27 PR21 TE15 PY19 C20R P15R
  1100.      7      ,  29,  29,   4,   4,   4,   4,   4,   4,   4,   4
  1101. C            HHO  .... .... .... .... .... .... .... .... ....
  1102.      8      , 281,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1103. C            .... .... .... .... .... .... .... .... .... ....
  1104.      9      ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99)
  1105. c cccccc
  1106.      .      ,MELE-200
  1107.       ENDIF
  1108. C
  1109.  34   CONTINUE
  1110.  99   CONTINUE
  1111.       MOTERR(1:4) =NOMTP(MELE)
  1112.       MOTERR(5:12)='EPSI'
  1113.       CALL ERREUR(86)
  1114.       GOTO 9990
  1115. C_______________________________________________________________________
  1116. C
  1117. C     massifs, poreux et joints poreux
  1118. C_______________________________________________________________________
  1119. C
  1120.     4 CONTINUE
  1121.       CALL EPSI2(IPMAIL,IPMINT,MELE,IELE,IVADEP,NBPTEL,LRE,NEPSI,LHOOK,
  1122.      &   MFR,NDEP,IPORE,IREPS2,NBPGAU,IVAEPS,UZDPG,RYDPG,RXDPG,IIPDPG,
  1123.      &   IDERI,IVAMTD,ivade2,mate,nmattD,cmate,NGRA,noer,kerr)
  1124.       GOTO 9990
  1125. C_______________________________________________________________________
  1126. C
  1127. C     poutres,tuyau,coq3,dkt,coq4,coq8,coq2,dst,joint 3D,joints 2D
  1128. C_______________________________________________________________________
  1129. C
  1130.    27 CONTINUE
  1131.       if (dcmate) goto 29
  1132.       CALL EPSI3(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,
  1133.      &     IVAMAT,LHOOK,IMAT,MATE,CMATE,NMATT,NEPSI,MFR,IPMINT,
  1134.      &     NCARR,NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,IVAEPS,
  1135.      &     IPMIN1,UZDPG,RYDPG,RXDPG,NPINT,IIPDPG)
  1136.       GOTO 9990
  1137. C_______________________________________________________________________
  1138. C
  1139. C     linespring,tuyau fissure,barre,joi1,zone cohesive
  1140. C_______________________________________________________________________
  1141. C
  1142.    29 CONTINUE
  1143.       CALL EPSI4(IPMAIL,IVADEP,NDEP,IVAMAT,NMATT,IVACAR,NCARR,IPMINT,
  1144.      &           MELE,LHOOK,IREPS2,NBPTEL,NEPSI,MFR,
  1145.      &    NBPGAU,LRE,LW,IVAEPS,UZDPG,RYDPG,RXDPG,KISOUS,IIPDPG,cmate)
  1146.       GOTO 9990
  1147. C_______________________________________________________________________
  1148. C
  1149. C      Elements XFEM (MFR = 63)
  1150. C_______________________________________________________________________
  1151. C
  1152.  63   CONTINUE
  1153.       CALL EPSIX (IMODEL,IREPS2,IVADEP,IVAEPS,
  1154.      &            UZDPG,RYDPG,RXDPG,IIPDPG,IRETER)
  1155.       IF (IRETER.NE.0) RETURN
  1156.       GO TO 9990
  1157.  
  1158. C==DEB= FORMULATION HHO ================================================
  1159.  281  CONTINUE
  1160.       CALL HHOEPS('EPSI', IMODEL, IPCHP1,MODEPL,
  1161.      &                    IIPDPG,UZDPG,RYDPG,RXDPG,
  1162.      &                    IVACAR, NCARA, IPMINT,NBPTEL,
  1163.      &                    IVAEPS,NEPSI, iret)
  1164.       IF (iret.NE.0) THEN
  1165.         CALL ERREUR(iret)
  1166.         RETURN
  1167.       END IF
  1168.       GO TO 9990
  1169. C==FIN= FORMULATION HHO ================================================
  1170.  
  1171. C_______________________________________________________________________
  1172. C
  1173. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1174. C_______________________________________________________________________
  1175.  9990   CONTINUE
  1176.         IF (IMAT.NE.2.AND.ISUP1.EQ.1) THEN
  1177.           CALL DTMVAL(IVAMAT,3)
  1178.         ELSE
  1179.           CALL DTMVAL(IVAMAT,1)
  1180.         ENDIF
  1181.         IF (ISUP1.EQ.1) THEN
  1182.           CALL DTMVAL(IVACAR,3)
  1183.         ELSE
  1184.           CALL DTMVAL(IVACAR,1)
  1185.         ENDIF
  1186.  9993   CONTINUE
  1187.         IF (IVADEP.NE.0) CALL DTMVAL(IVADEP,1)
  1188.         IF (IVADE2.NE.0) CALL DTMVAL(IVADE2,1)
  1189.         nomid = MOMATR
  1190.         IF (nomid.NE.0 .AND. lsupma) SEGSUP,nomid
  1191.         nomid = MOCARA
  1192.         IF (nomid.NE.0) SEGSUP,nomid
  1193.  
  1194. C   SORTIE PREMATUREE EN CAS D'ERREUR
  1195.         IF (IERR.NE.0) THEN
  1196.           IF (IVAEPS.NE.0) CALL DTMVAL(IVAEPS,3)
  1197.           GOTO 888
  1198.         ENDIF
  1199. C
  1200. C   REMPLISSAGE DU MCHAML DE LA SOUS-ZONE ISOUS
  1201. C
  1202.         MPTVAL = IVAEPS
  1203.         NOMID  = MOEPSI
  1204. c* On doit avoir : ival(/1) = NEPSI = N2
  1205.         N2 = NEPSI
  1206.         SEGINI MCHAML
  1207.         DO ICOMP = 1, NEPSI
  1208.           if (ifomod.eq.6) then
  1209.             if (icomp.le.NDEFO) then
  1210.               NOMCHE(ICOMP)=LESOBL(ICOMP)
  1211.             else
  1212.               NOMCHE(ICOMP)=LESFAC(ICOMP - NDEFO)
  1213.             endif
  1214.           else
  1215.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  1216.           endif
  1217.           TYPCHE(ICOMP)='REAL*8'
  1218.           melval = IVAL(ICOMP)
  1219.           CALL COMRED(melval)
  1220.           IELVAL(ICOMP) = melval
  1221.         ENDDO
  1222.         CALL DTMVAL(IVAEPS,1)
  1223.  
  1224.         ISOUS=ISOUS+1
  1225.  
  1226.         IMACHE(ISOUS) = IPMAIL
  1227.         CONCHE(ISOUS) = CONM
  1228.         ICHAML(ISOUS) = MCHAML
  1229.         INFCHE(ISOUS,1) = 0
  1230.         INFCHE(ISOUS,2) = 0
  1231.         INFCHE(ISOUS,3) = NHRM
  1232.         INFCHE(ISOUS,4) = IPMINT
  1233.         INFCHE(ISOUS,5) = 0
  1234.         INFCHE(ISOUS,6) = 5
  1235.  
  1236.  502    CONTINUE
  1237.  
  1238.  500  CONTINUE
  1239.  
  1240. C- FIN DU TRAITEMENT
  1241.  888  CONTINUE
  1242.       mmodel = IPMODL
  1243.       SEGDES,mmodel
  1244.       meleme = MAILDG
  1245.       IF (meleme.NE.0) SEGDES,meleme
  1246.       notype = MOTYR8
  1247.       SEGSUP,notype
  1248.  
  1249.       IF(IERR.NE.0)THEN
  1250.          IRET = 0
  1251.          SEGSUP MCHELM
  1252.          IPEPSI = 0
  1253.       ELSE
  1254.          IRET = 1
  1255.          IPEPSI = MCHELM
  1256.       ENDIF
  1257.  
  1258. c      return
  1259.       END
  1260.  
  1261.  
  1262.  

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