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

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