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

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