Télécharger la plaquette Cast3M


fr en

Télécharger jacopo.eso

Retour à la liste

Numérotation des lignes : 

jacopo

  1. C JACOPO    SOURCE    CB215821  24/04/12    21:16:26     11897          
  2.       SUBROUTINE JACOPO(IPMODL,IPCHE,IRET)
  3. C=======================================================================
  4. C    ENTREES :
  5. C    ---------
  6. C      IPMODL= pointeur sur un MMODEL
  7. C
  8. C    SORTIES :
  9. C    --------
  10. C
  11. C      IPCHE = CHAMELEM contenant les JACOBIENS
  12. C      IRET  = 1 si succes 0 sinon
  13. C
  14. C    Passage au nouveau Chamelem PAR S.RAMAHANDRY le 11/09/90
  15. C    CB215821 20/03/2017 : Ajout de la formulation DIFFUSION (MFR=73)
  16. C=====================================================================
  17.       IMPLICIT INTEGER(I-N)
  18.       IMPLICIT REAL*8(A-H,O-Z)
  19.       PARAMETER(UN=1.D0,XZER=0.D0)
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC CCHAMP
  24. -INC SMCHAML
  25. -INC SMMODEL
  26. -INC SMELEME
  27. -INC SMCOORD
  28. -INC SMINTE
  29. C
  30.       SEGMENT TRA
  31.        REAL*8 XEL(3,NBNN) ,SHP(6,NBNN) ,XE(3,NBNN) ,BPSS(3,3)
  32.        ENDSEGMENT
  33. C
  34.       SEGMENT TR1
  35.        REAL*8 TH(NBN1) ,TXR(3,3,NBN1) ,XJ(3,3)
  36.        ENDSEGMENT
  37. C
  38.       SEGMENT INFO
  39.        INTEGER INFELL(JG)
  40.        ENDSEGMENT
  41. C
  42.       SEGMENT MPTVAL
  43.        INTEGER IPOS(NS) , NSOF(NS)
  44.        INTEGER IVAL(NCOSOU)
  45.        CHARACTER*16 TYVAL(NCOSOU)
  46.        ENDSEGMENT
  47. C
  48.       DIMENSION BPSS(3,3)
  49.       CHARACTER*8 CMATE
  50. C
  51.       NHRM  = NIFOUR
  52.       IRET  = 1
  53. C
  54. C     ACTIVATION DU MODELE
  55. C
  56.       MMODEL= IPMODL
  57.       NSOUS = KMODEL(/1)
  58. C
  59. C     CREATION DU MCHELM
  60. C
  61.       N1= NSOUS
  62.       L1= 8
  63.       N3= 6
  64.       SEGINI,MCHELM
  65.       IPCHE =MCHELM
  66.       TITCHE='SCALAIRE'
  67.       IFOCHE=IFOUR
  68. C____________________________________________________________________
  69. C
  70. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  71. C____________________________________________________________________
  72. C
  73.       DO 500 ISOUS=1,NSOUS
  74. C
  75. C     ON RECUPERE L INFORMATION GENERALE
  76. C
  77.       IMODEL=KMODEL(ISOUS)
  78.       IPMAIL=IMAMOD
  79.       IMACHE(ISOUS)=IPMAIL
  80.       CONCHE(ISOUS)=CONMOD
  81. C
  82. C     TRAITEMENT DU MODELE
  83. C
  84.       MELE  = NEFMOD
  85.       MELEME= IMAMOD
  86. C      NFOR  = FORMOD(/2)
  87. C      NMAT  = MATMOD(/2)
  88. C____________________________________________________________________
  89. C
  90. C     INFORMATION SUR L'ELEMENT FINI
  91. C____________________________________________________________________
  92. C
  93.       if(infmod(/1).lt.7) then
  94.         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  95.         IF (IERR.NE.0) THEN
  96.           SEGSUP,MCHELM
  97.           IRET=0
  98.           RETURN
  99.         ENDIF
  100.  
  101.         INFO=IPINF
  102.         MELE  = INFELL(1)
  103.         MFR   = INFELL(13)
  104.         MINTE = INFELL(11)
  105.         MINTE1= INFELL(12)
  106.         segsup,info
  107.       else
  108.         MELE =INFELE(1)
  109.         MFR  =INFELE(13)
  110.         MINTE=INFMOD(7)
  111.         MINTE1=INFMOD(8)
  112.       endif
  113. C
  114.       INFCHE(ISOUS,1)= 0
  115.       INFCHE(ISOUS,2)= 0
  116.       INFCHE(ISOUS,3)= NHRM
  117.       INFCHE(ISOUS,4)= MINTE
  118.       INFCHE(ISOUS,5)= 0
  119.       INFCHE(ISOUS,6)= 5
  120. C
  121. C     INITIALISATION DE MINTE
  122. C
  123.         NBPGAU=POIGAU(/1)
  124. C
  125. C     ACTIVATION DU MELEME
  126. C
  127.         NBNN  =NUM(/1)
  128.         NBELEM=NUM(/2)
  129. C
  130. C     RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  131. C
  132.       N1PTEL=NBPGAU
  133.       N1EL=NBELEM
  134. C
  135. C     CREATION DU MCHAML DE LA SOUS ZONE
  136. C
  137.       NJAC=1
  138.       N2  =1
  139.       SEGINI,MCHAML
  140.       ICHAML(ISOUS)=MCHAML
  141.       NS=1
  142.       NCOSOU=NJAC
  143.       SEGINI MPTVAL
  144.       IVAJAC=MPTVAL
  145. C
  146. C     1 COMPOSANTE
  147. C
  148.       ICOMP        = 1
  149.       NOMCHE(ICOMP)='SCAL '
  150.       TYPCHE(ICOMP)='REAL*8'
  151.       N2PTEL       = 0
  152.       N2EL         = 0
  153.       SEGINI,MELVAL
  154.       IELVAL(ICOMP)= MELVAL
  155.       IVAL(ICOMP)  = MELVAL
  156. C
  157. C     ERREUR FORMULATION INDISPONIBLE
  158. C
  159.       IF(MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9.OR.MFR.EQ.7
  160.      1 .OR.MFR.EQ.13.OR.MFR.EQ.33.OR.MFR.EQ.35.OR.MFR.EQ.73)
  161.      1   GOTO 44
  162.       MOTERR(1:8)=NOMFR(MFR)
  163.       CALL ERREUR(193)
  164.       IRET=0
  165.       GOTO 9990
  166. C
  167.   44  CONTINUE
  168. C
  169.  
  170.       SEGACT,MCOORD
  171.       SEGINI,TRA
  172. C
  173. C ================== FORMULATION JOINT =======================
  174. C
  175. C ----------------- Element JOT3
  176. C
  177.       IF(MFR.EQ.35) THEN
  178.         IF(MELE.EQ.87) THEN
  179.          DO 9000 IB=1,NBELEM
  180.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  181.             DO 9002 IC=1,NBPGAU
  182.               DO 9003 ID=1,6
  183.               DO 9003 IE=1,NBNN
  184.                  SHP(ID,IE)=SHPTOT(ID,IE,IC)
  185.  9003         CONTINUE
  186.  
  187.               CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  188.               IF (NOQUAL.EQ.1) THEN
  189.                 INTERR(1)=IB
  190.                 MOTERR(1:4)='JOT3'
  191.                 CALL ERREUR(765)
  192.                 RETURN
  193.               ELSE IF(NOQUAL.EQ.2) THEN
  194.                 INTERR(1)=IB
  195.                 MOTERR(1:4)='JOT3'
  196.                 CALL ERREUR(766)
  197.                 RETURN
  198.               ENDIF
  199.  
  200.               NBNONN=NBNN/2
  201.            CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOUR,NIFOUR,2,1.D0,RR,DJAC)
  202.               IRRT = 0
  203.               IF (DJAC.LT.XZER) THEN
  204.                 IRRT = 1
  205.               ELSE IF(DJAC.EQ.XZER) THEN
  206.                 IRRT = 2
  207.               ENDIF
  208.               IF(IRRT.NE.0) THEN
  209.                  CALL ERREUR(764)
  210.                  RETURN
  211.               ENDIF
  212.  
  213.               MPTVAL=IVAJAC
  214.               MELVAL = IVAL(1)
  215.               IBMN=MIN(IB, VELCHE(/2))
  216.               IGMN=MIN(IC, VELCHE(/1))
  217.               VELCHE(IGMN,IBMN)=ABS(DJAC)
  218.  9002       CONTINUE
  219.  9000     CONTINUE
  220. C
  221. C ----------------- Element JOI4
  222. C
  223.        ELSE IF (MELE.EQ.88) THEN
  224.          DO 8000 IB=1,NBELEM
  225.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  226.             DO 8002 IC=1,NBPGAU
  227.               DO 8003 ID=1,6
  228.               DO 8003 IE=1,NBNN
  229.                  SHP(ID,IE)=SHPTOT(ID,IE,IC)
  230.  8003         CONTINUE
  231.  
  232.               CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  233.               IF (NOQUAL.EQ.1) THEN
  234.                 INTERR(1)=IB
  235.                 MOTERR(1:4)='JOI4'
  236.                 CALL ERREUR(765)
  237.                 RETURN
  238.               ELSE IF(NOQUAL.EQ.2) THEN
  239.                 INTERR(1)=IB
  240.                 MOTERR(1:4)='JOI4'
  241.                 CALL ERREUR(766)
  242.                 RETURN
  243.               ENDIF
  244.  
  245.               NBNONN=NBNN/2
  246.            CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOUR,NIFOUR,2,1.D0,RR,DJAC)
  247.               IRRT = 0
  248.               IF (DJAC.LT.XZER) THEN
  249.                 IRRT = 1
  250.               ELSE IF(DJAC.EQ.XZER) THEN
  251.                 IRRT = 2
  252.               ENDIF
  253.               IF(IRRT.NE.0) THEN
  254.                  CALL ERREUR(764)
  255.                  RETURN
  256.               ENDIF
  257.  
  258.               MPTVAL=IVAJAC
  259.               MELVAL = IVAL(1)
  260.               IBMN=MIN(IB, VELCHE(/2))
  261.               IGMN=MIN(IC, VELCHE(/1))
  262.               VELCHE(IGMN,IBMN)=ABS(DJAC)
  263.  8002       CONTINUE
  264.  8000     CONTINUE
  265.  
  266.        ELSE
  267.          CALL ERREUR(767)
  268.          RETURN
  269.        ENDIF
  270.  
  271.  
  272.  
  273. C
  274. C ================ FORMULATION MASSIVE =======================
  275. C
  276. C
  277.       ELSE IF(MFR.EQ.1.OR.MFR.EQ.33.OR.MFR.EQ.73) THEN
  278.             DO 1000 IB=1,NBELEM
  279.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  280.             DO 1002 IC=1,NBPGAU
  281.             DO 1003 ID=1,6
  282.             DO 1003 IE=1,NBNN
  283.             SHP(ID,IE)=SHPTOT(ID,IE,IC)
  284.  1003 CONTINUE
  285.            CALL JACOBI(XE,SHP,IDIM,NBNN,DJAC)
  286.             MPTVAL=IVAJAC
  287.            MELVAL = IVAL(1)
  288.             IBMN=MIN(IB, VELCHE(/2))
  289.             IGMN=MIN(IC, VELCHE(/1))
  290.            VELCHE(IGMN,IBMN)=ABS(DJAC)
  291.  1002 CONTINUE
  292.  1000 CONTINUE
  293.       GOTO 520
  294. C
  295. C ================ FORMULATION COQUE  MINCE =====================
  296. C
  297. C
  298.       ELSE IF(MFR.EQ.3.OR.MFR.EQ.9) THEN
  299.         IDI2=IDIM-1
  300.         DO 3000 IB=1,NBELEM
  301.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  302. C
  303.          IF(IDIM.EQ.2)THEN
  304.            CALL VPAST2(XE,BPSS)
  305.          ELSE IF(IDIM.EQ.3) THEN
  306.            CALL VPAST(XE,BPSS)
  307.          ENDIF
  308.            CALL VCORL1(XE,XEL,BPSS,NBNN)
  309.          DO 3002 IC=1,NBPGAU
  310.          DO 3003 ID=1,6
  311.          DO 3003 IE=1,NBNN
  312.          SHP(ID,IE)=SHPTOT(ID,IE,IC)
  313.  3003 CONTINUE
  314.          CALL JACOBI(XEL,SHP,IDI2,NBNN,DJAC)
  315.          MPTVAL=IVAJAC
  316.           MELVAL = IVAL(1)
  317.           IBMN=MIN(IB, VELCHE(/2))
  318.           IGMN=MIN(IC,VELCHE(/1))
  319.          VELCHE(IGMN,IBMN)=ABS(DJAC)
  320.  3002 CONTINUE
  321.  3000 CONTINUE
  322.       GOTO 520
  323. C
  324. C ================ FORMULATION POUTRE ET TUYAU ====================
  325. C
  326. C
  327.       ELSE IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  328.          IDI2=IDIM-1
  329.          DO 7000 IB=1,NBELEM
  330.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  331. C
  332.          DO 7002 IC=1,NBPGAU
  333.          CALL POUJAC(XE,DJAC)
  334.          MPTVAL=IVAJAC
  335.           MELVAL = IVAL(1)
  336.           IBMN=MIN(IB, VELCHE(/2))
  337.           IGMN=MIN(IC, VELCHE(/1))
  338.          VELCHE(IGMN,IBMN)=DJAC
  339.  7002 CONTINUE
  340.  7000 CONTINUE
  341.       GOTO 520
  342. C
  343. C ================ FORMULATION COQUE  EPAISSE ====================
  344. C
  345. C
  346.       ELSE IF(MFR.EQ.5) THEN
  347. C         NBPGA1=MINTE1.POIGAU(/1)
  348.          NBN1  =MINTE1.SHPTOT(/2)
  349.          SEGINI,TR1
  350. C
  351. C     UNE PETITE HORREUR ON CONSIDERE LES EPAISSEURS CONSTANTES
  352. C
  353.          DO 5010 IC=1,NBNN
  354.          TH(IC)=UN
  355.  5010 CONTINUE
  356.          DO 5000 IB=1,NBELEM
  357.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  358. C
  359.          CALL CQ8LOC(XE,NBN1,MINTE1.SHPTOT,TXR,IRR)
  360. C
  361.          DO 5002 IC=1,NBPGAU
  362.          E=DZEGAU(IC)
  363.          CALL COQ8JC(IC,NBN1,E,XE,TH,TXR,SHPTOT,XJ,DJAC,IRR)
  364.          MPTVAL=IVAJAC
  365.           MELVAL = IVAL(1)
  366.           IBMN=MIN(IB, VELCHE(/2))
  367.           IGMN=MIN(IC, VELCHE(/1))
  368.          VELCHE(IGMN,IBMN)=ABS(DJAC)
  369.  5002 CONTINUE
  370.  5000 CONTINUE
  371.       GOTO 520
  372.       ENDIF
  373. C---------------------------------------------------------------------
  374. C  DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  375. C---------------------------------------------------------------------
  376. C
  377.  520  CONTINUE
  378.       MPTVAL=IVAJAC
  379.       SEGSUP,MPTVAL,TRA
  380.  
  381.       SEGDES,MCOORD
  382. C
  383.   500 CONTINUE
  384.       RETURN
  385. C
  386.  9990 CONTINUE
  387. *
  388. C-------------------------------------------------------------------
  389. C         ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR
  390. C-------------------------------------------------------------------
  391. *
  392. *
  393. *
  394.       MPTVAL=IVAJAC
  395.       SEGSUP,MPTVAL
  396. *      SEGSUP INFO
  397.       END
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  

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