Télécharger la plaquette Cast3M


fr en

Télécharger calcga.eso

Retour à la liste

Numérotation des lignes : 

calcga

  1. C CALCGA    SOURCE    GOUNAND   21/06/02    21:15:01     11022          
  2.       SUBROUTINE CALCGA(IVCOM,IICOM,JMAJAC,JMIJAC,JDTJAC,JMAREG,JDIAMA,
  3.      $     JPC,
  4.      $     METRIQ,
  5.      $     TATRAV,
  6.      $     FC,
  7.      $     IMPR,IRET)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.       IMPLICIT INTEGER (I-N)
  10. C***********************************************************************
  11. C NOM         : CALCGA
  12. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss
  13. C
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          :
  20. C APPELE PAR       :
  21. C***********************************************************************
  22. C ENTREES            :
  23. C ENTREES/SORTIES    :
  24. C SORTIES            : -
  25. C TRAVAIL            :
  26. C***********************************************************************
  27. C VERSION    : v3.1, 30/07/04, possiblité de travailler
  28. C                  dans l'espace de référence et d'avoir les comp. de la
  29. C                  matrice jacobienne.
  30. C VERSION    : v1, 11/05/04, version initiale
  31. C HISTORIQUE : v1, 11/05/04, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC TNLIN      
  43. *-INC SMCHAEL
  44.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  45.       POINTEUR FC.MCHEVA
  46.       POINTEUR LCOF.LCHEVA
  47.       POINTEUR MYCOF.MCHEVA
  48.       POINTEUR JMAJAC.MCHEVA
  49.       POINTEUR JMIJAC.MCHEVA
  50.       POINTEUR JDTJAC.MCHEVA
  51.       POINTEUR JMAREG.MCHEVA
  52.       POINTEUR JDIAMA.MCHEVA
  53.       POINTEUR JPC.MCHEVA
  54. * les MCHEVA des coefficient
  55. *-INC SLCOMP
  56.       POINTEUR IVCOM.COMP
  57. *-INC SMTNLIN
  58. -INC SMLENTI
  59.       POINTEUR IICOM.MLENTI
  60. *-INC TMPREC
  61.       POINTEUR METRIQ.MPREC
  62. * Segments où l'on stocke les nombres d'éléments et nombre de points de
  63. * Gauss pour chaque champ à fin de vérification
  64.       POINTEUR LNELEM.MLENTI
  65.       POINTEUR LNPOGA.MLENTI
  66. *
  67.       REAL*8 XFCOM
  68. * Si IPRDU=1, on va chercher les coeffs dans VCOFPR
  69. * Si IPRDU=2, on va chercher les coeffs dans VCOFDU
  70.       INTEGER IPRDU
  71.       INTEGER IMPR,IRET
  72.       CHARACTER*8 NOMLOI
  73.       LOGICAL LREF
  74.       LOGICAL LJACO
  75. *
  76. * Executable statements
  77. *
  78.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcga'
  79. *      IESREL=IDIM
  80. *
  81.       NBCHE=0
  82.       SEGINI LCOF
  83.       JG=0
  84.       SEGINI LNELEM
  85.       JG=0
  86.       SEGINI LNPOGA
  87. *
  88. *      SEGPRT,TABVC
  89. *      WRITE(IOIMP,*) 'IPRDU=',IPRDU
  90.       SEGACT IVCOM
  91.       SEGACT IICOM
  92.       NCOCOF=IVCOM.DERCOF(/1)
  93.       LJACO=IVCOM.LTREF
  94.       DO ICOCOF=1,NCOCOF
  95.          IJGVD=IICOM.LECT(ICOCOF)
  96.          LDER=IVCOM.DERCOF(ICOCOF)
  97.          IF (LDER.EQ.0) THEN
  98.             MYCOF=TATRAV.VD(IJGVD)
  99.             SEGACT MYCOF
  100.             NEL=MYCOF.WELCHE(/6)
  101.             NPG=MYCOF.WELCHE(/5)
  102.             SEGDES MYCOF
  103.             LCOF.LISCHE(**)=MYCOF
  104.             LNELEM.LECT(**)=NEL
  105.             LNPOGA.LECT(**)=NPG
  106.          ELSEIF (LDER.EQ.1) THEN
  107.             MYCOF=TATRAV.DVD(IJGVD)
  108.             SEGACT MYCOF
  109.             NEL=MYCOF.WELCHE(/6)
  110.             NPG=MYCOF.WELCHE(/5)
  111.             SEGDES MYCOF
  112.             LCOF.LISCHE(**)=MYCOF
  113.             LNELEM.LECT(**)=NEL
  114.             LNPOGA.LECT(**)=NPG
  115.          ELSEIF (LDER.EQ.2) THEN
  116.             MYCOF=TATRAV.VD(IJGVD)
  117.             SEGACT MYCOF
  118.             NEL=MYCOF.WELCHE(/6)
  119.             NPG=MYCOF.WELCHE(/5)
  120.             SEGDES MYCOF
  121.             LCOF.LISCHE(**)=MYCOF
  122.             LNELEM.LECT(**)=NEL
  123.             LNPOGA.LECT(**)=NPG
  124.             MYCOF=TATRAV.DVD(IJGVD)
  125.             SEGACT MYCOF
  126.             NEL=MYCOF.WELCHE(/6)
  127.             NPG=MYCOF.WELCHE(/5)
  128.             SEGDES MYCOF
  129.             LCOF.LISCHE(**)=MYCOF
  130.             LNELEM.LECT(**)=NEL
  131.             LNPOGA.LECT(**)=NPG
  132.          ELSE
  133.             WRITE(IOIMP,*) 'Erreur Grave 2'
  134.             GOTO 9999
  135.          ENDIF
  136.       ENDDO
  137.       SEGDES IICOM
  138. *
  139. * Cas particulier des coeffs dépendant de la matrice
  140. * jacobienne
  141. *
  142.       IF (LJACO) THEN
  143.          SEGACT JMAJAC
  144.          NEL=JMAJAC.WELCHE(/6)
  145.          NPG=JMAJAC.WELCHE(/5)
  146.          SEGDES JMAJAC
  147.          LCOF.LISCHE(**)=JMAJAC
  148.          LNELEM.LECT(**)=NEL
  149.          LNPOGA.LECT(**)=NPG
  150.          IF (JMIJAC.NE.0) THEN
  151.             SEGACT JMIJAC
  152.             NEL=JMIJAC.WELCHE(/6)
  153.             NPG=JMIJAC.WELCHE(/5)
  154.             SEGDES JMIJAC
  155.          ELSE
  156.             NEL=0
  157.             NPG=0
  158.          ENDIF
  159.          LCOF.LISCHE(**)=JMIJAC
  160.          LNELEM.LECT(**)=NEL
  161.          LNPOGA.LECT(**)=NPG
  162.          SEGACT JDTJAC
  163.          NEL=JDTJAC.WELCHE(/6)
  164.          NPG=JDTJAC.WELCHE(/5)
  165.          SEGDES JDTJAC
  166.          LCOF.LISCHE(**)=JDTJAC
  167.          LNELEM.LECT(**)=NEL
  168.          LNPOGA.LECT(**)=NPG
  169.          IF (JMAREG.NE.0) THEN
  170.             SEGACT JMAREG
  171.             NEL=JMAREG.WELCHE(/6)
  172.             NPG=JMAREG.WELCHE(/5)
  173.             SEGDES JMAREG
  174.             LCOF.LISCHE(**)=JMAREG
  175.             LNELEM.LECT(**)=NEL
  176.             LNPOGA.LECT(**)=NPG
  177.          ENDIF
  178.          IF (JDIAMA.NE.0) THEN
  179.             SEGACT JDIAMA
  180.             NEL=JDIAMA.WELCHE(/6)
  181.             NPG=JDIAMA.WELCHE(/5)
  182.             SEGDES JDIAMA
  183.             LCOF.LISCHE(**)=JDIAMA
  184.             LNELEM.LECT(**)=NEL
  185.             LNPOGA.LECT(**)=NPG
  186.          ENDIF
  187.          IF (JPC.NE.0) THEN
  188.             SEGACT JPC
  189.             NEL=JPC.WELCHE(/6)
  190.             NPG=JPC.WELCHE(/5)
  191.             SEGDES JPC
  192.             LCOF.LISCHE(**)=JPC
  193.             LNELEM.LECT(**)=NEL
  194.             LNPOGA.LECT(**)=NPG
  195.          ENDIF
  196.       ENDIF
  197. * Vérifications des dimensions
  198. *   Calcul des max
  199.       JG=LNELEM.LECT(/1)
  200.       NELMAX=1
  201.       NPGMAX=1
  202.       DO IG=1,JG
  203.          NELMAX=MAX(NELMAX,LNELEM.LECT(IG))
  204.          NPGMAX=MAX(NPGMAX,LNPOGA.LECT(IG))
  205.       ENDDO
  206.       SEGSUP LNELEM
  207.       SEGSUP LNPOGA
  208. *   Vérif proprement dite
  209. * Inutilisable car JMIJAC peut être nul...
  210. *      SEGACT LCOF.LISCHE(*)
  211.       NL=LCOF.LISCHE(/1)
  212.       DO IL=1,NL
  213.          MYCOF=LCOF.LISCHE(IL)
  214.          IF (MYCOF.NE.0) THEN
  215.             SEGACT MYCOF
  216.          ENDIF
  217.       ENDDO
  218.       IG=0
  219.       DO ICOCOF=1,NCOCOF
  220.          LDER=IVCOM.DERCOF(ICOCOF)
  221.          IF (LDER.EQ.0) THEN
  222.             IG=IG+1
  223.             MYCOF=LCOF.LISCHE(IG)
  224.             NDLIG =MYCOF.WELCHE(/1)
  225.             NDCOL =MYCOF.WELCHE(/2)
  226.             N2DLIG=MYCOF.WELCHE(/3)
  227.             N2DCOL=MYCOF.WELCHE(/4)
  228.             NDNOEU=MYCOF.WELCHE(/5)
  229.             NDELM =MYCOF.WELCHE(/6)
  230.             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  231.      $           N2DCOL.NE.1
  232.      $           .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  233.      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  234.                WRITE(IOIMP,*) 'Erreur dims MYCOF'
  235.                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
  236.                WRITE(IOIMP,*) 'NDLIG=',NDLIG
  237.                WRITE(IOIMP,*) 'NDCOL=',NDCOL
  238.                WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
  239.                WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
  240.                WRITE(IOIMP,*) 'NDNOEU=',NDNOEU
  241.                WRITE(IOIMP,*) 'NDELM =',NDELM
  242.                WRITE(IOIMP,*) 'NPGMAX=',NPGMAX
  243.                WRITE(IOIMP,*) 'NELMAX=',NELMAX
  244.                GOTO 9999
  245.             ENDIF
  246.          ELSEIF (LDER.EQ.1) THEN
  247.             IG=IG+1
  248.             MYCOF=LCOF.LISCHE(IG)
  249.             NDLIG =MYCOF.WELCHE(/1)
  250.             NDCOL =MYCOF.WELCHE(/2)
  251.             N2DLIG=MYCOF.WELCHE(/3)
  252.             N2DCOL=MYCOF.WELCHE(/4)
  253.             NDNOEU=MYCOF.WELCHE(/5)
  254.             NDELM =MYCOF.WELCHE(/6)
  255.             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  256. * Test faux si utilisation de 'EREF'
  257. *     $           N2DCOL.NE.IESREL.OR.
  258.      $           (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  259.      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  260.                WRITE(IOIMP,*) 'Erreur dims MYCOF'
  261.                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
  262.                GOTO 9999
  263.             ENDIF
  264.          ELSEIF (LDER.EQ.2) THEN
  265.             IG=IG+1
  266.             MYCOF=LCOF.LISCHE(IG)
  267.             NDLIG =MYCOF.WELCHE(/1)
  268.             NDCOL =MYCOF.WELCHE(/2)
  269.             N2DLIG=MYCOF.WELCHE(/3)
  270.             N2DCOL=MYCOF.WELCHE(/4)
  271.             NDNOEU=MYCOF.WELCHE(/5)
  272.             NDELM =MYCOF.WELCHE(/6)
  273.             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  274.      $           N2DCOL.NE.1
  275.      $           .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  276.      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  277.                WRITE(IOIMP,*) 'Erreur dims MYCOF'
  278.                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
  279.                GOTO 9999
  280.             ENDIF
  281.             IG=IG+1
  282.             MYCOF=LCOF.LISCHE(IG)
  283.             NDLIG =MYCOF.WELCHE(/1)
  284.             NDCOL =MYCOF.WELCHE(/2)
  285.             N2DLIG=MYCOF.WELCHE(/3)
  286.             N2DCOL=MYCOF.WELCHE(/4)
  287.             NDNOEU=MYCOF.WELCHE(/5)
  288.             NDELM =MYCOF.WELCHE(/6)
  289.             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  290. * Test faux si utilisation de 'EREF'
  291. *     $           N2DCOL.NE.IESREL.OR.
  292.      $           (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  293.      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  294.                WRITE(IOIMP,*) 'Erreur dims MYCOF'
  295.                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
  296.                GOTO 9999
  297.             ENDIF
  298.          ENDIF
  299.       ENDDO
  300. *
  301. * Cas particulier matrice jacobienne
  302. *
  303.       IF (LJACO) THEN
  304.          IG=IG+1
  305.          MYCOF=LCOF.LISCHE(IG)
  306.          NDLIG =MYCOF.WELCHE(/1)
  307.          NDCOL =MYCOF.WELCHE(/2)
  308.          N2DLIG=MYCOF.WELCHE(/3)
  309. *         N2DCOL=MYCOF.WELCHE(/4)
  310.          IESREF=MYCOF.WELCHE(/4)
  311.          NDNOEU=MYCOF.WELCHE(/5)
  312.          NDELM =MYCOF.WELCHE(/6)
  313.          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
  314.      $        N2DLIG.NE.IDIM.OR.
  315. *     $        N2DCOL.NE.IDIM.OR.
  316.      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  317.      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  318.          WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  319.          GOTO 9999
  320.       ENDIF
  321.       IG=IG+1
  322.       MYCOF=LCOF.LISCHE(IG)
  323.       IF (MYCOF.NE.0) THEN
  324.          NDLIG =MYCOF.WELCHE(/1)
  325.          NDCOL =MYCOF.WELCHE(/2)
  326.          N2DLIG=MYCOF.WELCHE(/3)
  327.          N2DCOL=MYCOF.WELCHE(/4)
  328.          NDNOEU=MYCOF.WELCHE(/5)
  329.          NDELM =MYCOF.WELCHE(/6)
  330.          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
  331. *     $           N2DLIG.NE.IDIM.OR.N2DCOL.NE.IDIM.OR.
  332.      $        N2DCOL.NE.IDIM.OR.
  333.      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  334.      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  335.             WRITE(IOIMP,*) 'Erreur dims JMIJAC'
  336.             GOTO 9999
  337.          ENDIF
  338.       ENDIF
  339.       IG=IG+1
  340.       MYCOF=LCOF.LISCHE(IG)
  341.       NDLIG =MYCOF.WELCHE(/1)
  342.       NDCOL =MYCOF.WELCHE(/2)
  343.       N2DLIG=MYCOF.WELCHE(/3)
  344.       N2DCOL=MYCOF.WELCHE(/4)
  345.       NDNOEU=MYCOF.WELCHE(/5)
  346.       NDELM =MYCOF.WELCHE(/6)
  347.       IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
  348.      $     N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
  349.      $     (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  350.      $     .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  351.          WRITE(IOIMP,*) 'Erreur dims JDTJAC'
  352.          GOTO 9999
  353.       ENDIF
  354.       IF (JMAREG.NE.0) THEN
  355.          IG=IG+1
  356.          MYCOF=LCOF.LISCHE(IG)
  357.          NDLIG =MYCOF.WELCHE(/1)
  358.          NDCOL =MYCOF.WELCHE(/2)
  359.          N2DLIG=MYCOF.WELCHE(/3)
  360.          N2DCOL=MYCOF.WELCHE(/4)
  361.          NDNOEU=MYCOF.WELCHE(/5)
  362.          NDELM =MYCOF.WELCHE(/6)
  363.          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
  364.      $        N2DLIG.NE.IESREF.OR.N2DCOL.NE.IESREF.OR.
  365.      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  366.      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  367.             WRITE(IOIMP,*) 'Erreur dims JMAREG'
  368.             GOTO 9999
  369.          ENDIF
  370.       ENDIF
  371.       IF (JDIAMA.NE.0) THEN
  372.          IG=IG+1
  373.          MYCOF=LCOF.LISCHE(IG)
  374.          NDLIG =MYCOF.WELCHE(/1)
  375.          NDCOL =MYCOF.WELCHE(/2)
  376.          N2DLIG=MYCOF.WELCHE(/3)
  377.          N2DCOL=MYCOF.WELCHE(/4)
  378.          NDNOEU=MYCOF.WELCHE(/5)
  379.          NDELM =MYCOF.WELCHE(/6)
  380.          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
  381.      $        N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
  382.      $        NDNOEU.NE.1.OR.NDELM.NE.1) THEN
  383.             WRITE(IOIMP,*) 'Erreur dims JDIAMA'
  384.             GOTO 9999
  385.          ENDIF
  386.       ENDIF
  387.       IF (JPC.NE.0) THEN
  388.          IG=IG+1
  389.          MYCOF=LCOF.LISCHE(IG)
  390.          NDLIG =MYCOF.WELCHE(/1)
  391.          NDCOL =MYCOF.WELCHE(/2)
  392.          N2DLIG=MYCOF.WELCHE(/3)
  393.          N2DCOL=MYCOF.WELCHE(/4)
  394.          NDNOEU=MYCOF.WELCHE(/5)
  395.          NDELM =MYCOF.WELCHE(/6)
  396.          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
  397.      $        N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
  398.      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
  399.      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
  400.             WRITE(IOIMP,*) 'Erreur dims JPC'
  401.             GOTO 9999
  402.          ENDIF
  403.       ENDIF
  404.       ENDIF
  405. *
  406. * Initialisation du segment contenant la valeur de la loi de
  407. * comportement
  408.       NBLIG=1
  409.       NBCOL=1
  410.       N2LIG=1
  411.       N2COL=1
  412.       NBPOI=NPGMAX
  413.       NBELM=NELMAX
  414.       SEGINI FC
  415. *
  416. * Calcul proprement dit
  417. *
  418.       CALL CALCGB(IVCOM,LCOF,METRIQ,
  419.      $     FC,
  420.      $     IMPR,IRET)
  421.       IF (IRET.NE.0) GOTO 9999
  422. *
  423. * Fin
  424. *
  425.       SEGDES FC
  426. * Inutilisable car JMIJAC peut être nul...
  427. *      SEGDES LCOF.LISCHE(*)
  428.       NL=LCOF.LISCHE(/1)
  429.       DO IL=1,NL
  430.          MYCOF=LCOF.LISCHE(IL)
  431.          IF (MYCOF.NE.0) THEN
  432.             SEGDES MYCOF
  433.          ENDIF
  434.       ENDDO
  435.       SEGSUP LCOF
  436.       SEGDES IVCOM
  437.  
  438. *
  439. * Normal termination
  440. *
  441.       IRET=0
  442.       RETURN
  443. *
  444. * Format handling
  445. *
  446. *
  447. * Error handling
  448. *
  449.  9999 CONTINUE
  450.       IRET=1
  451.       WRITE(IOIMP,*) 'An error was detected in subroutine calcga'
  452.       RETURN
  453. *
  454. * End of subroutine CALCGA
  455. *
  456.       END
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  

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