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

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