Télécharger la plaquette Cast3M


fr en

Télécharger sigmap.eso

Retour à la liste

Numérotation des lignes : 

sigmap

  1. C SIGMAP    SOURCE    OF166741  25/02/21    21:18:37     12166          
  2.  
  3.       SUBROUTINE SIGMAP(IDERI,IPMODL,IPCHP1,IPCHE1,IPCHE2,IMAT,
  4.      1                  IPSTRS,IRET,inoer)
  5. C_______________________________________________________________________
  6. C
  7. C            OPERATEUR CONTRAINTES APPELE PAR SIGMA
  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           IPMODL Pointeur sur un MMODEL
  18. C           IPCHP1 Pointeur sur un CHAMPOINT deplacements
  19. C           IPCHE1 Pointeur sur un MCHAML de caracteristiques
  20. C           IPCHE2 Pointeur sur un MCHAML de HOOKE
  21. C           IMAT   Flag de HOOKE      (2 si oui, 1 sinon)
  22. C
  23. C    Sorties:
  24. C    ________
  25. C
  26. C           IPSTRS Pointeur sur un MCHAML de CONTRAINTES
  27. C           IRET   1 ou 0 suivant succes ou pas
  28. C
  29. C_______________________________________________________________________
  30. C
  31.       IMPLICIT INTEGER(I-N)
  32.       IMPLICIT REAL*8(A-H,O-Z)
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCHAMP
  37. -INC CCREEL
  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.       POINTEUR MOTYR8.NOTYPE
  56.  
  57.       CHARACTER*8 CMATE
  58.       CHARACTER*(NCONCH) CONM
  59.       PARAMETER ( NINF=3 )
  60.       INTEGER INFOS(NINF)
  61.       LOGICAL LDPGE,lsupdp,lsupco,lsupma
  62. C
  63. *  quelques initialisations pour enlever des warnings
  64.       ldpge=.false.
  65.       lsupdp=.false.
  66.       ldpge=.false.
  67.       lsupco=.false.
  68.       lsupma=.false.
  69.       IRET = 0
  70.       IPSTRS = 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. C
  78.       NHRM=NIFOUR
  79.       ISUP=0
  80.       ISUP1=0
  81.       MCHAML=0
  82. C
  83. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE
  84. C
  85.       IF (IMAT.EQ.2) THEN
  86.          CALL  QUESUP(IPMODL,IPCHE2,5,1,ISUP,IRETHO)
  87.          IF (ISUP.NE.0) RETURN
  88.       ENDIF
  89. C
  90. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  91. C
  92.       IF (IPCHE1.NE.0) THEN
  93.          CALL  QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRETCA)
  94.          IF (ISUP1.GT.1) RETURN
  95.       ENDIF
  96.  
  97. C____________________________________________________________________
  98. C
  99. C     ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT
  100. C____________________________________________________________________
  101. C
  102.       CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHA1,1)
  103.       IF (IERR.NE.0) RETURN
  104. C
  105. C     ACTIVATION DU MODELE
  106. C
  107.       MMODEL=IPMODL
  108.       NSOUS=KMODEL(/1)
  109. C
  110. C     CREATION DU MCHELM
  111. C
  112. C=============================================
  113.       N1=NSOUS
  114.       DO IJKL=1,NSOUS
  115.         IMODEL=KMODEL(IJKL)
  116.         IF (NEFMOD.EQ.22.OR.NEFMOD.EQ.259) then
  117.           N1=N1-1
  118.         ELSEIF (FORMOD(1).EQ.'CHARGEMENT')  then
  119.           N1=N1-1
  120. * l operateur sait ce qu il peut traiter
  121.         elseif(formod(1)(1:9).ne.'MECANIQUE'.and.
  122.      &formod(1)(1:6).ne.'POREUX'.and.formod(1)(1:7).ne.'LIQUIDE')
  123.      & then
  124.           N1=N1-1
  125.        endif
  126.       END DO
  127. C      WRITE(*,*) 'NSOUS=',NSOUS
  128. C      WRITE(*,*) 'N1=',N1
  129. C=============================================
  130.       L1=11
  131.       N3=6
  132.       SEGINI MCHELM
  133.       TITCHE='CONTRAINTES'
  134.       IFOCHE=IFOUR
  135.  
  136. C Un petit segment toujours utile :
  137.       nbtype = 1
  138.       SEGINI,MOTYR8
  139.       MOTYR8.type(1) = 'REAL*8  '
  140. C
  141. C____________________________________________________________________
  142. C
  143. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  144. C____________________________________________________________________
  145. C
  146.       ISOUS=0
  147.       DO 500 KISOUS=1,NSOUS
  148. *
  149. *   INITIALISATION
  150. *
  151.       IVAMAT=0
  152.       IVACAR=0
  153.       IVASTR=0
  154.       IVADEP=0
  155.       IPMING=0
  156.       MOSTRS=0
  157.       MODEPL=0
  158.       MOMATR=0
  159.       MOCARA=0
  160. C
  161. C     ON RECUPERE L INFORMATION GENERALE
  162. C
  163.       IMODEL=KMODEL(KISOUS)
  164. C*    SEGACT IMODEL
  165. C=============================================
  166.       MELE=NEFMOD
  167.          if((MELE.eq.22).OR.(MELE.eq.259)) go to 500
  168.          IF (FORMOD(1).EQ.'CHARGEMENT') GOTO 500
  169.          ISOUS=ISOUS+1
  170. C==============================================
  171. C
  172. C     TRAITEMENT DU MODELE
  173. C
  174.       IIPDPG=imodel.IPDPGE
  175.       IIPDPG=IPTPOI(IIPDPG)
  176.       IPMAIL=IMAMOD
  177.       CONM  =CONMOD
  178. c       ideri=ideriv
  179. c       ireps2=0
  180. c       if(ideri.eq.2.and.ibid2.eq.0) ireps2=1
  181. cbp,2020-12-10 : ideriv n'est plus utilise -> IDERI en argument
  182.       IMACHE(ISOUS)=IPMAIL
  183.       CONCHE(ISOUS)=CONMOD
  184.  
  185. C   COQUE INTEGREE OU PAS ?
  186.       NPINT = imodel.INFMOD(1)
  187. C
  188. C     NATURE DU MATERIAU
  189. C
  190.       CMATE = imodel.CMATEE
  191.       MATE  = imodel.IMATEE
  192.       INAT  = imodel.INATUU
  193. C____________________________________________________________________
  194. C
  195. C     INFORMATION SUR L'ELEMENT FINI
  196. C____________________________________________________________________
  197.       MFR  =INFELE(13)
  198.       IELE =INFELE(14)
  199.       IPORE=INFELE(8)
  200.       NBG  =INFELE(6)
  201.       NBGS =INFELE(4)
  202.       NSTRS=INFELE(16)
  203.       LRE  =INFELE(9)
  204.       LW   =INFELE(7)
  205.       LHOOK=INFELE(10)
  206.       NDDL =INFELE(15)
  207. *      MINTE=INFELE(11)
  208.       MINTE=INFMOD(7)
  209.       MINTE1=INFELE(12)
  210. c*      MINTE1=INFMOD(8)
  211.       IPMINT=MINTE
  212.       IPMIN1=MINTE1
  213. C
  214.       CALL INFDPG(MFR,IFOUR, LDPGE,ndpge)
  215. C
  216. C     CREATION DU TABLEAU INFOS
  217. C
  218.       CALL IDENT(IPMAIL,CONM,IPCHA1,IPCHE1,INFOS,IRTD)
  219.       IF (IRTD.EQ.0) GOTO 9990
  220. C
  221.       INFCHE(ISOUS,1)=0
  222.       INFCHE(ISOUS,2)=0
  223.       INFCHE(ISOUS,3)=NHRM
  224.       INFCHE(ISOUS,4)=MINTE
  225.       INFCHE(ISOUS,5)=0
  226.       INFCHE(ISOUS,6)=5
  227. C
  228. C     INITIALISATION DE MINTE
  229. C
  230.       if(mele.ne.260) then
  231.       NBPGAU=POIGAU(/1)
  232.       endif
  233. C
  234. C     ACTIVATION DU MELEME
  235. C
  236.       MELEME=IPMAIL
  237. c*       SEGACT MELEME
  238.       NBNN  =NUM(/1)
  239.       NBELEM=NUM(/2)
  240.       IPPORE=0
  241.       IF(MFR.EQ.33) THEN
  242.          IPPORE=NBNN
  243.       ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
  244.          IPPORE=NBNN
  245.          LHOOK=4
  246.          IF(IFOUR.EQ.1.OR.IFOUR.EQ.-3) LHOOK=6
  247.       ENDIF
  248.       LHOO2=LHOOK*LHOOK
  249. C
  250. C     EXTRACTION DES DEPLACEMENTS DU NOEUD SUPPORT DE LA
  251. C     DEFORMATION PLANE GENERALISEE
  252. C
  253.         IF (LDPGE) THEN
  254.           IF (IIPDPG.LE.0) THEN
  255.             CALL ERREUR(925)
  256.           ELSE
  257.             CALL DEPDPG(IPCHP1,UZDPG,RXDPG,RYDPG,IIPDPG)
  258.           ENDIF
  259.           IF (IERR.NE.0) GOTO 9990
  260.         ELSE
  261.           UZDPG=XZero
  262.           RXDPG=XZero
  263.           RYDPG=XZero
  264.         ENDIF
  265. C____________________________________________________________________
  266. C
  267. C     RECHERCHE DES NOMS DE COMPOSANTES
  268. C____________________________________________________________________
  269. C
  270.        if(lnomid(4).ne.0) then
  271.          lsupco=.false.
  272.          nomid=lnomid(4)
  273.          mostrs=nomid
  274.          nstr=lesobl(/2)
  275.          nfac=lesfac(/2)
  276.        else
  277.          lsupco=.true.
  278.          CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  279.        endif
  280. C
  281.       if(lnomid(1).ne.0) then
  282.          lsupdp=.false.
  283.          nomid=lnomid(1)
  284. c*         segact nomid
  285.          modepl=nomid
  286.          ndep=lesobl(/2)
  287.          nfac=lesfac(/2)
  288.       else
  289.          lsupdp=.true.
  290.          CALL IDPRIM(IMODEL,MFR,MODEPL,NDEP,NFAC)
  291.       endif
  292.  
  293. C==DEB= FORMULATION HHO == Le MCHAML est vide, on utilise le CHPOINT ===
  294.       IF (MELE .EQ. HHO_NUM_ELEMENT) THEN
  295.         GOTO 890
  296.       END IF
  297. C==FIN= FORMULATION HHO ================================================
  298. C____________________________________________________________________
  299. C
  300. C     VERIFICATION DE LEUR PRESENCE
  301. C____________________________________________________________________
  302. C
  303.       MOTYPE = MOTYR8
  304.       CALL KOMCHA(IPCHA1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP)
  305.       IF (IERR.NE.0) GOTO 9990
  306. C
  307. C     RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  308. C
  309. C==DEB= FORMULATION HHO == Etiquette specifique ========================
  310.  890  CONTINUE
  311. C==FIN= FORMULATION HHO ================================================
  312.       N1PTEL=NBGS
  313.       N1EL=NBELEM
  314.       NBPTEL=N1PTEL
  315.       NEL=N1EL
  316. C
  317. C     CREATION DU MCHAML DE LA SOUS ZONE
  318. C
  319.       N2=NSTRS
  320.       SEGINI MCHAML
  321.       ICHAML(ISOUS)=MCHAML
  322.       NSR=1
  323.       NCOSOR=NSTRS
  324.       SEGINI MPTVAL
  325.       IVASTR=MPTVAL
  326.       NOMID=MOSTRS
  327. c*      SEGACT NOMID
  328.       DO 100 ICOMP=1,NSTRS
  329.         NOMCHE(ICOMP)=LESOBL(ICOMP)
  330.         TYPCHE(ICOMP)='REAL*8'
  331.         N2PTEL=0
  332.         N2EL=0
  333.         SEGINI MELVAL
  334.         IELVAL(ICOMP)=MELVAL
  335.         IVAL(ICOMP)=MELVAL
  336.  100  CONTINUE
  337. C____________________________________________________________________
  338. C
  339. *  RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL *
  340. C____________________________________________________________________
  341. *
  342.       lsupma=.true.
  343.       IF (IMAT.EQ.2) THEN
  344.         IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
  345.             NBROBL=3
  346.             NBRFAC=0
  347.             SEGINI NOMID
  348.             LESOBL(1)='MAHO'
  349.             LESOBL(2)='V1X '
  350.             LESOBL(3)='V1Y '
  351.             NBTYPE=3
  352.             SEGINI NOTYPE
  353.             TYPE(1)='POINTEURLISTREEL'
  354.             TYPE(2)='REAL*8'
  355.             TYPE(3)='REAL*8'
  356.         ELSE
  357.             NBROBL=1
  358.             NBRFAC=0
  359.             SEGINI NOMID
  360.             LESOBL(1)='MAHO'
  361.             NBTYPE=1
  362.             SEGINI NOTYPE
  363.             TYPE(1)='POINTEURLISTREEL'
  364.         ENDIF
  365.         MOMATR=NOMID
  366.         NMATR=NBROBL
  367.         NMATF=NBRFAC
  368.         CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,NOTYPE,1,INFOS,3,IVAMAT)
  369.         SEGSUP NOTYPE
  370.         IF (IERR.NE.0) GOTO 9990
  371.         MPTVAL=IVAMAT
  372.         MELVAL=IVAL(1)
  373.         NBGMAT=IELCHE(/1)
  374.         NELMAT=IELCHE(/2)
  375.         NMATT=NMATR+NMATF
  376.       ELSE
  377. C____________________________________________________________________
  378. *
  379. * SINON TRAITEMENT DES CHAMPS DE MATERIAU
  380. C____________________________________________________________________
  381. *
  382.           IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  383.              NBROBL=2
  384.              NBRFAC=0
  385.              SEGINI NOMID
  386.              MOMATR=NOMID
  387.              IF (MFR.EQ.35) THEN
  388.               LESOBL(1)='KS  '
  389.               LESOBL(2)='KN  '
  390.              ELSE IF(MFR.EQ.53) THEN
  391.               NBROBL=1
  392.               SEGADJ,NOMID
  393.               LESOBL(1)='KS  '
  394.              ELSE
  395.               LESOBL(1)='YOUN'
  396.               LESOBL(2)='NU  '
  397. C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ========
  398.               CALL HHOIDC(imodel,MOMATR)
  399.               NBROBL=nomid.lesobl(/2)
  400. **              NBRFAC=nomid.lesfac(/2)
  401. C=FIN==== FORMULATION HHO ==============================================
  402.              ENDIF
  403.              NMATR=NBROBL
  404.              NMATF=NBRFAC
  405.           ELSE
  406.      $    IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  407.            IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  408.              NBROBL=7
  409.              NBRFAC=0
  410.              SEGINI NOMID
  411.              MOMATR=NOMID
  412.              LESOBL(1)='YOUN'
  413.              LESOBL(2)='V1X '
  414.              LESOBL(3)='V1Y '
  415.              LESOBL(4)='V1Z '
  416.              LESOBL(5)='V2X '
  417.              LESOBL(6)='V2Y '
  418.              LESOBL(7)='V2Z '
  419.             ELSE
  420.              NBROBL=3
  421.              NBRFAC=0
  422.              SEGINI NOMID
  423.              MOMATR=NOMID
  424.              LESOBL(1)='YOUN'
  425.              LESOBL(2)='V1X '
  426.              LESOBL(3)='V1Y '
  427.             ENDIF
  428.              NMATR=NBROBL
  429.              NMATF=NBRFAC
  430.           ELSE
  431.      $      IF (FORMOD(1).EQ.'POREUX   '.AND.CMATE.EQ.'ISOTROPE') THEN
  432.                IF (MELE.GE.79.AND.MELE.LE.83) THEN
  433.                  NBROBL=4
  434.                  NBRFAC=0
  435.                  SEGINI NOMID
  436.                  MOMATR=NOMID
  437.                  LESOBL(1)='YOUN'
  438.                  LESOBL(2)='NU  '
  439.                  LESOBL(3)='COB '
  440.                  LESOBL(4)='MOB '
  441.                ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  442.                  NBROBL=4
  443.                  NBRFAC=0
  444.                  SEGINI NOMID
  445.                  MOMATR=NOMID
  446.                  LESOBL(1)='KS  '
  447.                  LESOBL(2)='KN  '
  448.                  LESOBL(3)='COB '
  449.                  LESOBL(4)='MOB '
  450.                ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  451.                  NBROBL=10
  452.                  NBRFAC=0
  453.                  SEGINI NOMID
  454.                  MOMATR=NOMID
  455.                  LESOBL(1)='YOUN'
  456.                  LESOBL(2)='NU  '
  457.                  LESOBL(3)='COP1'
  458.                  LESOBL(4)='COP2'
  459.                  LESOBL(5)='CPP1'
  460.                  LESOBL(6)='CPP2'
  461.                  LESOBL(7)='KK11'
  462.                  LESOBL(8)='KK12'
  463.                  LESOBL(9)='KK21'
  464.                  LESOBL(10)='KK22'
  465.                ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  466.                  NBROBL=17
  467.                  NBRFAC=0
  468.                  SEGINI NOMID
  469.                  MOMATR=NOMID
  470.                  LESOBL(1)='YOUN'
  471.                  LESOBL(2)='NU  '
  472.                  LESOBL(3)='COP1'
  473.                  LESOBL(4)='COP2'
  474.                  LESOBL(5)='COP3'
  475.                  LESOBL(6)='CPP1'
  476.                  LESOBL(7)='CPP2'
  477.                  LESOBL(8)='CPP3'
  478.                  LESOBL(9)='KK11'
  479.                  LESOBL(10)='KK12'
  480.                  LESOBL(11)='KK13'
  481.                  LESOBL(12)='KK21'
  482.                  LESOBL(13)='KK22'
  483.                  LESOBL(14)='KK23'
  484.                  LESOBL(15)='KK31'
  485.                  LESOBL(16)='KK32'
  486.                  LESOBL(17)='KK33'
  487.                ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  488.                  NBROBL=10
  489.                  NBRFAC=0
  490.                  SEGINI NOMID
  491.                  MOMATR=NOMID
  492.                  LESOBL(1)='KS  '
  493.                  LESOBL(2)='KN  '
  494.                  LESOBL(3)='COP1'
  495.                  LESOBL(4)='COP2'
  496.                  LESOBL(5)='CPP1'
  497.                  LESOBL(6)='CPP2'
  498.                  LESOBL(7)='KK11'
  499.                  LESOBL(8)='KK12'
  500.                  LESOBL(9)='KK21'
  501.                  LESOBL(10)='KK22'
  502.                ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  503.                  NBROBL=17
  504.                  NBRFAC=0
  505.                  SEGINI NOMID
  506.                  MOMATR=NOMID
  507.                  LESOBL(1)='KS  '
  508.                  LESOBL(2)='KN  '
  509.                  LESOBL(3)='COP1'
  510.                  LESOBL(4)='COP2'
  511.                  LESOBL(5)='COP3'
  512.                  LESOBL(6)='CPP1'
  513.                  LESOBL(7)='CPP2'
  514.                  LESOBL(8)='CPP3'
  515.                  LESOBL(9)='KK11'
  516.                  LESOBL(10)='KK12'
  517.                  LESOBL(11)='KK13'
  518.                  LESOBL(12)='KK21'
  519.                  LESOBL(13)='KK22'
  520.                  LESOBL(14)='KK23'
  521.                  LESOBL(15)='KK31'
  522.                  LESOBL(16)='KK32'
  523.                  LESOBL(17)='KK33'
  524.                ENDIF
  525.                NMATR=NBROBL
  526.                NMATF=NBRFAC
  527. *
  528.           ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  529.                NBROBL=6
  530.                NBRFAC=0
  531.                SEGINI NOMID
  532.                MOMATR=NOMID
  533.                LESOBL(1)='YG1 '
  534.                LESOBL(2)='YG2 '
  535.                LESOBL(3)='NU12'
  536.                LESOBL(4)='G12 '
  537.                LESOBL(5)='V1X '
  538.                LESOBL(6)='V1Y '
  539.                NMATR=NBROBL
  540.                NMATF=NBRFAC
  541. *
  542. *         ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  543. *           Pour l'instant, lnomid(6) ou appel a IDMATR suffisent.
  544. *
  545. *         ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  546. *           Pour l'instant, lnomid(6) ou appel a IDMATR suffisent.
  547. *
  548. * Autres cas :
  549.           ELSE
  550.               if(lnomid(6).ne.0) then
  551.                 nomid=lnomid(6)
  552.                 segact nomid
  553.                 momatr=nomid
  554.                 nmatr=lesobl(/2)
  555.                 nmatf=lesfac(/2)
  556.                 lsupma=.false.
  557.               else
  558.                 lsupma=.true.
  559.                 CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  560.               endif
  561.           ENDIF
  562. *
  563.           IF (CMATE.EQ.'SECTION') THEN
  564.             NBTYPE=3
  565.             SEGINI,notype
  566.             TYPE(1)='POINTEURMMODEL'
  567.             TYPE(2)='POINTEURMCHAML'
  568.             TYPE(3)='POINTEURLISTREEL'
  569.           ELSE
  570.             NBTYPE = 1
  571.             notype = MOTYR8
  572.           ENDIF
  573.           NMATT=NMATR+NMATF
  574. C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ========
  575.           IF (MFR.EQ.HHO_MFR_ELEMENT) THEN
  576.             IF (NBTYPE.EQ.1) THEN
  577.               NBTYPE = NMATT
  578.               SEGINI,notype
  579.               DO ITYP = 1, NBTYPE
  580.                 notype.TYPE(ITYP) = 'REAL*8          '
  581.               END DO
  582.             END IF
  583.             notype.TYPE(NMATR-1) = 'POINTEURLISTREEL'
  584.             notype.TYPE(NMATR  ) = 'POINTEURLISTREEL'
  585.           END IF
  586. C=FIN==== FORMULATION HHO ==============================================
  587.           MOTYPE = notype
  588. *
  589.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  590.         IF (MOTYPE .NE. MOTYR8) SEGSUP,notype
  591.         IF (IERR.NE.0) GOTO 9990
  592. *
  593.         IF(ISUP1.EQ.1)THEN
  594.           CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  595.           IF(IERR.NE.0)THEN
  596.              ISUP1=0
  597.              GOTO 9990
  598.           ENDIF
  599.         ENDIF
  600.         MPTVAL=IVAMAT
  601.         NBGMAT = 0
  602.         NELMAT = 0
  603.         DO 1108 IM=1,NMATT
  604.          IF(IVAL(IM).NE.0)THEN
  605.             MELVAL=IVAL(IM)
  606.             IF (CMATE.EQ.'SECTION') THEN
  607.               NBGMAT=MAX(NBGMAT,IELCHE(/1))
  608.               NELMAT=MAX(NELMAT,IELCHE(/2))
  609.             ELSE
  610.               NBGMAT=MAX(NBGMAT,VELCHE(/1))
  611.               NELMAT=MAX(NELMAT,VELCHE(/2))
  612.             ENDIF
  613.          ENDIF
  614.  1108   CONTINUE
  615.       ENDIF
  616. C____________________________________________________________________
  617. C
  618. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  619. C____________________________________________________________________
  620. C
  621.            NBROBL=0
  622.            NBRFAC=0
  623.            MOCARA=0
  624.            IVECT=0
  625. *
  626.            NOTYPE = MOTYR8
  627. *
  628. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  629. *
  630.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  631.            NBROBL=1
  632.            NBRFAC=1
  633.            SEGINI NOMID
  634.            MOCARA=NOMID
  635.            LESOBL(1)='EPAI'
  636.            LESFAC(1)='EXCE'
  637. *
  638. * SECTION POUR LES BARRES
  639. *
  640.          ELSE IF (MFR.EQ.27) THEN
  641.            NBROBL=1
  642.            SEGINI NOMID
  643.            MOCARA=NOMID
  644.            LESOBL(1)='SECT'
  645. *
  646. * section, excentrements et orientation pour les barres excentrees
  647. *
  648.            ELSE IF (MFR.EQ.49) THEN
  649.              NBROBL=6
  650.              SEGINI NOMID
  651.              MOCARA=NOMID
  652.              LESOBL(1)='SECT'
  653.              LESOBL(2)='EXCZ'
  654.              LESOBL(3)='EXCY'
  655.              LESOBL(4)='VX  '
  656.              LESOBL(5)='VY  '
  657.              LESOBL(6)='VZ  '
  658. *
  659. * raideurs locales et orientation pour l'element LIA2
  660. *              de liaison a 2 noeuds
  661. *
  662.           ELSE IF (MFR.EQ.51) THEN
  663.              NBROBL=9
  664.              SEGINI NOMID
  665.              MOCARA=NOMID
  666.              LESOBL(1)='RLUX'
  667.              LESOBL(2)='RLUY'
  668.              LESOBL(3)='RLUZ'
  669.              LESOBL(4)='RLRX'
  670.              LESOBL(5)='RLRY'
  671.              LESOBL(6)='RLRZ'
  672.              LESOBL(7)='VX  '
  673.              LESOBL(8)='VY  '
  674.              LESOBL(9)='VZ  '
  675. *
  676. * CARACTERISTIQUES POUR LES POUTRES
  677. *
  678.          ELSE IF (MFR.EQ.7 ) THEN
  679.            IF ((CMATE.EQ.'SECTION')) THEN
  680.              NBROBL=0
  681.              NBRFAC=3
  682.              SEGINI NOMID
  683.              MOCARA=NOMID
  684.              LESFAC(1)='VX'
  685.              LESFAC(2)='VY'
  686.              LESFAC(3)='VZ'
  687.              IVECT=1
  688. *
  689. * CAS 2D
  690. *
  691.            ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  692.              NBRFAC=1
  693.              NBROBL=2
  694.              SEGINI NOMID
  695.              MOCARA=NOMID
  696.              LESOBL(1)= 'SECT'
  697.              LESOBL(2)= 'INRZ'
  698.              LESFAC(1)= 'SECY'
  699. *
  700.            ELSE
  701.              NBROBL=4
  702.              NBRFAC=5
  703.              SEGINI NOMID
  704.              MOCARA=NOMID
  705.              LESOBL(1)='TORS'
  706.              LESOBL(2)='INRY'
  707.              LESOBL(3)='INRZ'
  708.              LESOBL(4)='SECT'
  709.              LESFAC(1)='SECY'
  710.              LESFAC(2)='SECZ'
  711.              LESFAC(3)='VX'
  712.              LESFAC(4)='VY'
  713.              LESFAC(5)='VZ'
  714.              IVECT=1
  715.            ENDIF
  716. *
  717. * CARACTERISTIQUES POUR LES TUYAUX
  718. *
  719.          ELSE IF (MFR.EQ.13) THEN
  720.            NBROBL=2
  721.            NBRFAC=6
  722.            SEGINI NOMID
  723.            MOCARA=NOMID
  724.            LESOBL(1)='EPAI'
  725.            LESOBL(2)='RAYO'
  726.            LESFAC(1)='RACO'
  727.            LESFAC(2)='PRES'
  728.            LESFAC(3)='CISA'
  729.            LESFAC(4)='VX'
  730.            LESFAC(5)='VY'
  731.            LESFAC(6)='VZ'
  732.            IVECT=1
  733. *
  734. * CARACTERISTIQUES POUR LES LINESPRING
  735. *
  736.          ELSE IF (MFR.EQ.15) THEN
  737.            NBROBL=5
  738.            SEGINI NOMID
  739.            MOCARA=NOMID
  740.            LESOBL(1)='EPAI'
  741.            LESOBL(2)='FISS'
  742.            LESOBL(3)='VX  '
  743.            LESOBL(4)='VY  '
  744.            LESOBL(5)='VZ  '
  745. *
  746. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  747. *
  748.          ELSE IF (MFR.EQ.17) THEN
  749.            NBROBL=9
  750.            SEGINI NOMID
  751.            MOCARA=NOMID
  752.            LESOBL(1)='RAYO'
  753.            LESOBL(2)='EPAI'
  754.            LESOBL(3)='VX  '
  755.            LESOBL(4)='VY  '
  756.            LESOBL(5)='VZ  '
  757.            LESOBL(6)='VXF '
  758.            LESOBL(7)='VYF '
  759.            LESOBL(8)='VZF '
  760.            LESOBL(9)='ANGL'
  761. *
  762. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  763. *
  764.          ELSE IF (MFR.EQ.37) THEN
  765.            IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  766.              NBROBL=4
  767.              SEGINI NOMID
  768.              MOCARA=NOMID
  769.              LESOBL(1)='SCEL'
  770.              LESOBL(2)='SFLU'
  771.              LESOBL(3)='EPS '
  772.              LESOBL(4)='XINE'
  773.            ELSE
  774.              NBROBL=3
  775.              SEGINI NOMID
  776.              MOCARA=NOMID
  777.              LESOBL(1)='SCEL'
  778.              LESOBL(2)='SFLU'
  779.              LESOBL(3)='EPS '
  780.            ENDIF
  781. *
  782. * EPAISSEUR POUR LES JOINTS GENERALISES
  783. *
  784.          ELSE IF (MFR.EQ.55) THEN
  785. CcPPj      NBROBL=1
  786. CcPPj      NBRFAC=0
  787. CcPPj      SEGINI NOMID
  788. CcPPj      MOCARA=NOMID
  789. CcPPj      LESOBL(1)='EPAI'
  790.            NBROBL=0
  791.            NBRFAC=1
  792.            SEGINI NOMID
  793.            MOCARA=NOMID
  794.            LESFAC(1)='EPAI'
  795. *
  796. * CARACTERISTIQUE MACRO_EL (element CIFL)
  797. *
  798.          ELSE IF (MFR.EQ.61)THEN
  799.            NBRFAC=0
  800.            NBROBL=2
  801.            SEGINI NOMID
  802.            MOCARA=NOMID
  803.            LESOBL(1)= 'SECT'
  804.            LESOBL(2)= 'INRZ'
  805. *
  806.          ENDIF
  807.  
  808.          NCARA=NBROBL
  809.          NCARF=NBRFAC
  810.          NCARR=NCARA+NCARF
  811.  
  812.          MOTYPE = NOTYPE
  813. *
  814.          IF (IPCHE1.NE.0.AND.MOCARA.NE.0)  THEN
  815. *
  816.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  817.      $                IVACAR)
  818.           IF (IERR.NE.0) GOTO 9990
  819. *
  820.           IF (ISUP1.EQ.1) THEN
  821.              CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  822.              IF(IERR.NE.0)THEN
  823.                ISUP1=0
  824.                GOTO 9990
  825.              ENDIF
  826.           ENDIF
  827.         ENDIF
  828.         IF (MOTYPE .NE. MOTYR8) SEGSUP,NOTYPE
  829. *
  830. C_______________________________________________________________________
  831. C
  832. C     NUMERO DES ETIQUETTES      :
  833. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  834. C     Les elements sont groupes comme suit :
  835. C      - massif, poreux, joints poreux ------------------> sigma1
  836. C      - coq3,dkt,coq4,coq8,coq2,joints -----------------> sigma2
  837. C      - poutre,tuyau,linespring,tuyau fissure,barre ----> sigma3
  838. C        et poutre de Timoschenko
  839. C_______________________________________________________________________
  840. C
  841.       SEGACT,MCOORD
  842.       IF (MELE.LE.100)
  843.      &GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  844.      1      99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99,
  845.      2      27,29,29,27,29,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
  846.      3      99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  847.      4       4, 4, 4,29,27,27,27,27,99,99,99,99,27,99,29,29,99,99,99,99
  848.      5      ),MELE
  849.       IF (MELE.LE.200)
  850.      &GOTO (99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  851.      1       4, 4,29,29,29,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  852.      2      34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  853. c                                <168-    -172> <173-
  854.      3      34,34,34,34,34,34,34,27,27,27,27,27, 4, 4, 4, 4, 4, 4, 4, 4,
  855. c        Elements mecaniques 1D (M1Dx) : MELE = 193, 194
  856. c                                   -190>      <M1Dx>
  857.      4       4, 4, 4, 4, 4, 4, 4, 4, 4, 4,34,34, 4, 4,34,34,34,34,34,34
  858.      5      ),MELE-100
  859.       IF (MELE.LE.300)
  860.      &GOTO (34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  861.      1      34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  862. c     mele = 258, 260 --> goto 29
  863.      2      34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,29,34,29,
  864.      3      34,34,34,34,29,34,34,34,34,34,34,34, 4, 4,34,34,34,34,34,34,
  865. C         <HHO>
  866.      4      89,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34 
  867.      5      ),MELE-200
  868. C     CASE OF THE NEW JOINT ELEMENTS (JCT3 AND JCI4)
  869. C                                    (JGI2 2D GENERALIZED)
  870. C                                    (JGT3 AND JGI4 GENERALIZED)
  871.  34   CONTINUE
  872.  
  873. C POUR les XFEM on fait un cas particuliers
  874.         IF(MFR.EQ.63) THEN
  875.           CALL SIGMAX (MATE,IMAT,NBGMAT,NELMAT,NMATT,CMATE,
  876.      &         IVAMAT,IMODEL,IREPS2,IVADEP,
  877.      &         IVASTR,UZDPG,RYDPG,RXDPG,IIPDPG,IRETER)
  878. *          write(*,*) 'retour de SIGMAX'
  879.           IF(IRETER.NE.0) RETURN
  880.           GO TO 9990
  881.         ENDIF
  882. C fin des  XFEM
  883. C
  884.  99   CONTINUE
  885.       MOTERR(1:4)=NOMTP(MELE)
  886.       MOTERR(9:12)='SIGM'
  887.       CALL ERREUR(86)
  888.       GOTO 9990
  889. C_______________________________________________________________________
  890. C
  891. C     massifs, poreux, joints poreux
  892. C_______________________________________________________________________
  893. C
  894.    4  CONTINUE
  895.       IF (MFR.EQ.71) THEN
  896.         CALL SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK,
  897.      &               LRE,MATE,IVAMAT,NMATT, IVASTR)
  898.       ELSE IF (MFR.EQ.73) THEN
  899.         CALL SIGDIF (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK,
  900.      &               LRE,MATE,IVAMAT,NMATT, IVASTR)
  901.       ELSE
  902.       CALL SIGMA1(MATE,IMAT,IPMAIL,IPMINT,MELE,IELE,IVADEP,
  903.      &   NBPTEL,LRE,NSTRS,IVAMAT,NBGMAT,NELMAT,LHOOK,NMATT,CMATE,
  904.      &   MFR,NDEP,IPORE,IREPS2,NBPGAU,IVASTR,UZDPG,RYDPG,RXDPG
  905.      & , IIPDPG,inoer)
  906.       ENDIF
  907.       GOTO 9990
  908. C_______________________________________________________________________
  909. C
  910. C     coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D
  911. C_______________________________________________________________________
  912. C
  913.   27  CONTINUE
  914.       CALL SIGMA2(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVAMAT,
  915.      &          LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,IPMIN1,
  916.      &           NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,NPINT,IVASTR
  917.      &          ,UZDPG,RYDPG,RXDPG,IIPDPG,inoer)
  918.       GOTO 9990
  919. C_______________________________________________________________________
  920. C
  921. C     poutres,tuyau,linespring,tuyau fissure,barre
  922. C_______________________________________________________________________
  923. C
  924.   29  CONTINUE
  925.       CALL SIGMA3(IPMAIL,IVADEP,NDEP,IVACAR,NCARR,IPMINT,IVECT,IVAMAT,
  926.      &       MELE,IMAT,NELMAT,NBGMAT,LHOOK,CMATE,IREPS2,NBPTEL,NSTRS,
  927.      &       MFR,NMATT,NBPGAU,ISOUS,LRE,LW,IVASTR,UZDPG,RYDPG,RXDPG
  928.      & , IIPDPG,inoer)
  929.       GOTO 9990
  930.  
  931. C=DEB==== FORMULATION HHO ==== Cas particulier de la formulation =======
  932.   89    CONTINUE
  933.         IF (MELE.NE.HHO_NUM_ELEMENT) THEN
  934.           write(ioimp,*) 'Branchement MELE / HHO incorrect'
  935.           CALL ERREUR(5)
  936.           RETURN
  937.         END IF
  938.         CALL HHOSIG (IMODEL, IPCHP1,MODEPL, IIPDPG,UZDPG,RYDPG,RXDPG,
  939.      &                       MATE,IVAMAT,NMATR, IPMINT,NBPTEL,
  940.      &                       IVASTR,NSTRS, ireth)
  941.         IF (ireth.NE.0) THEN
  942.           CALL ERREUR(ireth)
  943.           RETURN
  944.         END IF
  945.         GOTO 9990
  946. C=FIN==== FORMULATION HHO ==============================================
  947.  
  948. C____________________________________________________________________
  949. C
  950. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  951. C____________________________________________________________________
  952. C
  953.  9990 CONTINUE
  954. *
  955.       IF(ISUP1.EQ.1.AND.IMAT.NE.2)THEN
  956.            CALL DTMVAL(IVAMAT,3)
  957.       ELSE
  958.            CALL DTMVAL(IVAMAT,1)
  959.       ENDIF
  960. *
  961.       IF(ISUP1.EQ.1)THEN
  962.            CALL DTMVAL(IVACAR,3)
  963.       ELSE
  964.           CALL DTMVAL(IVACAR,1)
  965.       ENDIF
  966. *
  967.       IF(IERR.NE.0)THEN
  968.          CALL DTMVAL(IVASTR,3)
  969.       ELSE
  970.          CALL DTMVAL(IVASTR,1)
  971.       ENDIF
  972. *
  973.       CALL DTMVAL(IVADEP,1)
  974. *
  975.       IF(MOMATR.NE.0)THEN
  976.          NOMID=MOMATR
  977.          if(lsupma)SEGSUP NOMID
  978.       ENDIF
  979. *
  980.       IF(MOCARA.NE.0)THEN
  981.          NOMID=MOCARA
  982.          SEGSUP NOMID
  983.       ENDIF
  984. *
  985.       IF(MOSTRS.NE.0)THEN
  986.          NOMID=MOSTRS
  987.          if(lsupco)SEGSUP NOMID
  988.       ENDIF
  989. *
  990.       IF(MODEPL.NE.0)THEN
  991.          NOMID=MODEPL
  992.          if(lsupdp)SEGSUP NOMID
  993.       ENDIF
  994. C
  995. C     DANS LE CAS D'ERREUR
  996. C
  997.       IF(IERR.NE.0)THEN
  998.         IF (MCHAML.NE.0) SEGSUP MCHAML
  999.         GOTO 888
  1000.       ENDIF
  1001. C
  1002.   500 CONTINUE
  1003.  
  1004.   888 CONTINUE
  1005.       IF (IERR.NE.0) THEN
  1006.         IRET = 0
  1007.         SEGSUP MCHELM
  1008.         IPSTRS = 0
  1009.       ELSE
  1010.         IRET = 1
  1011.         IPSTRS = MCHELM
  1012.       ENDIF
  1013.  
  1014.       SEGSUP,MOTYR8
  1015.  
  1016.       END
  1017.  
  1018.  
  1019.  

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