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   26/01/09    21:15:02     12441          
  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(1:4).EQ.'METR') THEN
  168.          CALL CCGMET(LCOF,NOMLOI,FC,IMPR,IRET)
  169.          IF (IRET.NE.0) GOTO 9999
  170.       ELSEIF (NOMLOI.EQ.'X1      ') THEN
  171.          NLFC=FC.WELCHE(/6)
  172.          NPFC=FC.WELCHE(/5)
  173.          IF (IFOMOD.NE.0.AND.IFOMOD.NE.4.AND.IFOMOD.NE.5) then
  174.             write(ioimp,*) 'erreur compor X1, ifomod=',ifomod
  175.             goto 9999
  176.          endif
  177.          JPC=LCOF.LISCHE(6)
  178.          NLPC=JPC.WELCHE(/6)
  179.          NPPC=JPC.WELCHE(/5)
  180.          IF (((NLPC.NE.1).AND.(NLPC.NE.NLFC)).OR.
  181.      $        ((NPPC.NE.1).AND.(NPPC.NE.NPFC))) THEN
  182.             WRITE(IOIMP,*) 'Erreur dims JPC'
  183.             GOTO 9999
  184.          ENDIF
  185.          DO ILFC=1,NLFC
  186.             IF (NLPC.EQ.1) THEN
  187.                ILPC=1
  188.             ELSE
  189.                ILPC=ILFC
  190.             ENDIF
  191.             DO IPFC=1,NPFC
  192.                IF (NPPC.EQ.1) THEN
  193.                   IPPC=1
  194.                ELSE
  195.                   IPPC=IPFC
  196.                ENDIF
  197.                FC.WELCHE(1,1,1,1,IPFC,ILFC)=
  198.      $              JPC.WELCHE(1,1,1,1,IPPC,ILPC)
  199.             ENDDO
  200.          ENDDO
  201.       ELSE
  202.          WRITE(IOIMP,*) 'Loi de comportement ',NOMLOI
  203.          WRITE(IOIMP,*) 'non définie dans calcgb'
  204.          GOTO 9999
  205.       ENDIF
  206. *
  207. * Normal termination
  208. *
  209.       IRET=0
  210.       RETURN
  211. *
  212. * Format handling
  213. *
  214. *
  215. * Error handling
  216. *
  217.  9999 CONTINUE
  218.       IRET=1
  219.       WRITE(IOIMP,*) 'An error was detected in subroutine calcgb'
  220.       RETURN
  221. *
  222. * End of subroutine CALCGB
  223. *
  224.       END
  225.  
  226.  

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