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

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