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

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