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

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