Télécharger la plaquette Cast3M


fr en

Télécharger calcgb.eso

Retour à la liste

Numérotation des lignes : 

calcgb

  1. C CALCGB    SOURCE    GOUNAND   21/06/02    21:15:05     11022          
  2.       SUBROUTINE CALCGB(IVCOM,LCOF,METRIQ,
  3.      $     FC,
  4.      $     IMPR,IRET)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM         : CALCGB
  9. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss
  10. C
  11. C
  12. C LANGAGE     : ESOPE
  13. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C               mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES          :
  17. C APPELE PAR       :
  18. C***********************************************************************
  19. C ENTREES            :
  20. C ENTREES/SORTIES    :
  21. C SORTIES            : -
  22. C TRAVAIL            :
  23. C***********************************************************************
  24. C VERSION    : v1, 11/05/04, version initiale
  25. C HISTORIQUE : v1, 11/05/04, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC TNLIN
  37. *-INC SMCHAEL
  38.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  39.       POINTEUR FC.MCHEVA
  40.       POINTEUR LCOF.LCHEVA
  41.       POINTEUR MYCOF.MCHEVA
  42.       POINTEUR JPC.MCHEVA
  43. * les MCHEVA des coefficient
  44. *-INC SLCOMP
  45.       POINTEUR IVCOM.COMP
  46. *-INC TMPREC
  47.       POINTEUR METRIQ.MPREC
  48.       INTEGER IMPR,IRET
  49.       CHARACTER*8 NOMLOI
  50.       REAL*8 MAXVAL
  51. *
  52. * Executable statements
  53. *
  54.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcgb'
  55.       NOMLOI=IVCOM.NOMCOM
  56. *      WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
  57. *
  58. * Dispatching
  59. *
  60.       IF (NOMLOI.EQ.'RIEN    ') THEN
  61.          FC.WELCHE(1,1,1,1,1,1)=1.D0
  62.       ELSEIF (NOMLOI.EQ.'IDEN    ') THEN
  63.          NLFC=FC.WELCHE(/6)
  64.          NPFC=FC.WELCHE(/5)
  65.          MYCOF=LCOF.LISCHE(1)
  66.          NLC=MYCOF.WELCHE(/6)
  67.          NPC=MYCOF.WELCHE(/5)
  68.          N2C=MYCOF.WELCHE(/4)
  69.          IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  70.             WRITE(IOIMP,*) 'Erreur grave 1'
  71.             GOTO 9999
  72.          ENDIF
  73.          DO ILFC=1,NLFC
  74.             DO IPFC=1,NPFC
  75.                FC.WELCHE(1,1,1,1,IPFC,ILFC)=
  76.      $              MYCOF.WELCHE(1,1,1,1,IPFC,ILFC)
  77.             ENDDO
  78.          ENDDO
  79.       ELSEIF (NOMLOI.EQ.'1/X     ') THEN
  80.          NLFC=FC.WELCHE(/6)
  81.          NPFC=FC.WELCHE(/5)
  82.          MYCOF=LCOF.LISCHE(1)
  83.          NLC=MYCOF.WELCHE(/6)
  84.          NPC=MYCOF.WELCHE(/5)
  85.          N2C=MYCOF.WELCHE(/4)
  86.          IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  87.             WRITE(IOIMP,*) 'Erreur grave 2'
  88.             GOTO 9999
  89.          ENDIF
  90.          DO ILFC=1,NLFC
  91.             DO IPFC=1,NPFC
  92.                FC.WELCHE(1,1,1,1,IPFC,ILFC)=1.D0/
  93.      $              MYCOF.WELCHE(1,1,1,1,IPFC,ILFC)
  94.             ENDDO
  95.          ENDDO
  96.       ELSEIF (NOMLOI.EQ.'MAXI    ') THEN
  97.          NLFC=FC.WELCHE(/6)
  98.          NPFC=FC.WELCHE(/5)
  99.          MYCOF=LCOF.LISCHE(1)
  100.          NLC=MYCOF.WELCHE(/6)
  101.          NPC=MYCOF.WELCHE(/5)
  102.          N2C=MYCOF.WELCHE(/4)
  103.          IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  104.             WRITE(IOIMP,*) 'Erreur grave 3'
  105.             GOTO 9999
  106.          ENDIF
  107.          DO ILFC=1,NLFC
  108.             MAXVAL=FC.WELCHE(1,1,1,1,1,ILFC)
  109.             DO IPFC=2,NPFC
  110.                MAXVAL=MAX(MAXVAL,FC.WELCHE(1,1,1,1,IPFC,ILFC))
  111.             ENDDO
  112.             DO IPFC=1,NPFC
  113.                FC.WELCHE(1,1,1,1,IPFC,ILFC)=MAXVAL
  114.             ENDDO
  115.          ENDDO
  116.       ELSEIF (NOMLOI.EQ.'RAYS    ') THEN
  117.          CALL CCGRAS(LCOF,FC,IMPR,IRET)
  118.          IF (IRET.NE.0) GOTO 9999
  119.       ELSEIF (NOMLOI.EQ.'MUR     ') THEN
  120.          CALL CCGMUR(LCOF,FC,IMPR,IRET)
  121.          IF (IRET.NE.0) GOTO 9999
  122.       ELSEIF (NOMLOI.EQ.'SUTH    ') THEN
  123.          CALL CCGSUT(LCOF,FC,IMPR,IRET)
  124.          IF (IRET.NE.0) GOTO 9999
  125.       ELSEIF (NOMLOI.EQ.'DIV     ') THEN
  126.          CALL CCGDIV(LCOF,FC,IMPR,IRET)
  127.          IF (IRET.NE.0) GOTO 9999
  128.       ELSEIF (NOMLOI.EQ.'TAU     ') THEN
  129.          CALL CCGTAU(LCOF,FC,1,IMPR,IRET)
  130.          IF (IRET.NE.0) GOTO 9999
  131.       ELSEIF (NOMLOI.EQ.'SIGMA   ') THEN
  132.          CALL CCGTAU(LCOF,FC,2,IMPR,IRET)
  133.          IF (IRET.NE.0) GOTO 9999
  134.       ELSEIF (NOMLOI.EQ.'MADSMID ') THEN
  135.          CALL CCGMMD(LCOF,NOMLOI,FC,IMPR,IRET)
  136.          IF (IRET.NE.0) GOTO 9999
  137.       ELSEIF (NOMLOI.EQ.'VOLORI  ') THEN
  138.          CALL CCGADV(LCOF,NOMLOI,FC,IMPR,IRET)
  139.          IF (IRET.NE.0) GOTO 9999
  140.       ELSEIF (NOMLOI(1:3).EQ.'AHU') THEN
  141.          CALL CCGAHU(LCOF,NOMLOI,FC,IMPR,IRET)
  142.          IF (IRET.NE.0) GOTO 9999
  143. *      ELSEIF (NOMLOI(1:3).EQ.'AHP') THEN
  144. *         CALL CCGAHP(LCOF,NOMLOI,METRIQ,FC,IMPR,IRET)
  145. *         IF (IRET.NE.0) GOTO 9999
  146.       ELSEIF ((NOMLOI(1:4).EQ.'QEQU').OR.(NOMLOI(1:4).EQ.'QALI')) THEN
  147.          CALL CCGQME(LCOF,NOMLOI,FC,IMPR,IRET)
  148.          IF (IRET.NE.0) GOTO 9999
  149.       ELSEIF (NOMLOI(1:4).EQ.'D/DX') THEN
  150.          CALL CCGRAD(LCOF,NOMLOI,FC,IMPR,IRET)
  151.          IF (IRET.NE.0) GOTO 9999
  152.       ELSEIF (NOMLOI.EQ.'TAILDIRE') THEN
  153.          CALL CCGTDI(LCOF,FC,IMPR,IRET)
  154.          IF (IRET.NE.0) GOTO 9999
  155.       ELSEIF (NOMLOI(1:6).EQ.'MUSTAB') THEN
  156.          CALL CCGMUS(LCOF,NOMLOI,FC,IMPR,IRET)
  157.          IF (IRET.NE.0) GOTO 9999
  158.       ELSEIF (NOMLOI(1:3).EQ.'TSU') THEN
  159.          CALL CCGTSU(LCOF,NOMLOI,FC,IMPR,IRET)
  160.          IF (IRET.NE.0) GOTO 9999
  161.       ELSEIF (NOMLOI(1:3).EQ.'VNO') THEN
  162.          CALL CCGNOR(LCOF,NOMLOI,FC,IMPR,IRET)
  163.          IF (IRET.NE.0) GOTO 9999
  164.       ELSEIF (NOMLOI(1:4).EQ.'IMET') THEN
  165.          CALL CCGIME(LCOF,NOMLOI,FC,IMPR,IRET)
  166.          IF (IRET.NE.0) GOTO 9999
  167.       ELSEIF (NOMLOI.EQ.'X1      ') THEN
  168.          NLFC=FC.WELCHE(/6)
  169.          NPFC=FC.WELCHE(/5)
  170.          IF (IFOMOD.NE.0.AND.IFOMOD.NE.4.AND.IFOMOD.NE.5) then
  171.             write(ioimp,*) 'erreur compor X1, ifomod=',ifomod
  172.             goto 9999
  173.          endif
  174.          JPC=LCOF.LISCHE(6)
  175.          NLPC=JPC.WELCHE(/6)
  176.          NPPC=JPC.WELCHE(/5)
  177.          IF (((NLPC.NE.1).AND.(NLPC.NE.NLFC)).OR.
  178.      $        ((NPPC.NE.1).AND.(NPPC.NE.NPFC))) THEN
  179.             WRITE(IOIMP,*) 'Erreur dims JPC'
  180.             GOTO 9999
  181.          ENDIF
  182.          DO ILFC=1,NLFC
  183.             IF (NLPC.EQ.1) THEN
  184.                ILPC=1
  185.             ELSE
  186.                ILPC=ILFC
  187.             ENDIF
  188.             DO IPFC=1,NPFC
  189.                IF (NPPC.EQ.1) THEN
  190.                   IPPC=1
  191.                ELSE
  192.                   IPPC=IPFC
  193.                ENDIF
  194.                FC.WELCHE(1,1,1,1,IPFC,ILFC)=
  195.      $              JPC.WELCHE(1,1,1,1,IPPC,ILPC)
  196.             ENDDO
  197.          ENDDO
  198.       ELSE
  199.          WRITE(IOIMP,*) 'Loi de comportement ',NOMLOI
  200.          WRITE(IOIMP,*) 'non définie dans calcgb'
  201.          GOTO 9999
  202.       ENDIF
  203. *
  204. * Normal termination
  205. *
  206.       IRET=0
  207.       RETURN
  208. *
  209. * Format handling
  210. *
  211. *
  212. * Error handling
  213. *
  214.  9999 CONTINUE
  215.       IRET=1
  216.       WRITE(IOIMP,*) 'An error was detected in subroutine calcgb'
  217.       RETURN
  218. *
  219. * End of subroutine CALCGB
  220. *
  221.       END
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  

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