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

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