Esope source files

   1 : C CCGRAS    SOURCE    GOUNAND   05/12/21    21:16:45     5281           
   2 :       SUBROUTINE CCGRAS(LCOF,
   3 :      $     FC,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : CCGRAS
   9 : C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
  10 : C               un rayonnement en surface
  11 : C     
  12 : C     
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES          :
  18 : C APPELE PAR       :
  19 : C***********************************************************************
  20 : C ENTREES            :
  21 : C ENTREES/SORTIES    :
  22 : C SORTIES            : -
  23 : C TRAVAIL            :
  24 : C***********************************************************************
  25 : C VERSION    : v1, 10/09/04, version initiale
  26 : C HISTORIQUE : v1, 10/09/04, création
  27 : C HISTORIQUE :
  28 : C HISTORIQUE :
  29 : C***********************************************************************
  30 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31 : C en cas de modification de ce sous-programme afin de faciliter
  32 : C la maintenance !
  33 : C***********************************************************************
  34 : -INC CCOPTIO
  35 : CBEGININCLUDE SMCHAEL
  36 :       SEGMENT MCHAEL
  37 :       POINTEUR IMACHE(N1).MELEME
  38 :       POINTEUR ICHEVA(N1).MCHEVA
  39 :       ENDSEGMENT
  40 :       SEGMENT MCHEVA
  41 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  42 :       ENDSEGMENT
  43 :       SEGMENT LCHEVA
  44 :       POINTEUR LISCHE(NBCHE).MCHEVA
  45 :       ENDSEGMENT
  46 : CENDINCLUDE SMCHAEL
  47 :       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  48 :       POINTEUR FC.MCHEVA
  49 :       POINTEUR LCOF.LCHEVA
  50 :       POINTEUR T1.MCHEVA
  51 :       POINTEUR T2.MCHEVA
  52 :       POINTEUR T3.MCHEVA
  53 : *     
  54 :       INTEGER IMPR,IRET
  55 : *     
  56 : * Executable statements
  57 : *     
  58 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgras'
  59 :       NLFC=FC.VELCHE(/6)
  60 :       NPFC=FC.VELCHE(/5)
  61 :       T1=LCOF.LISCHE(1)
  62 :       T2=LCOF.LISCHE(2)
  63 :       T3=LCOF.LISCHE(3)
  64 :       NLC1=T1.VELCHE(/6)
  65 :       NPC1=T1.VELCHE(/5)
  66 :       NLC2=T2.VELCHE(/6)
  67 :       NPC2=T2.VELCHE(/5)
  68 :       NLC3=T3.VELCHE(/6)
  69 :       NPC3=T3.VELCHE(/5)
  70 :       DO ILFC=1,NLFC
  71 :          IF (NLC1.EQ.1) THEN
  72 :             ILC1=1
  73 :          ELSE
  74 :             ILC1=ILFC
  75 :          ENDIF
  76 :          IF (NLC2.EQ.1) THEN
  77 :             ILC2=1
  78 :          ELSE
  79 :             ILC2=ILFC
  80 :          ENDIF
  81 :          IF (NLC3.EQ.1) THEN
  82 :             ILC3=1
  83 :          ELSE
  84 :             ILC3=ILFC
  85 :          ENDIF
  86 :          DO IPFC=1,NPFC
  87 :             IF (NPC1.EQ.1) THEN
  88 :                IPC1=1
  89 :             ELSE
  90 :                IPC1=IPFC
  91 :             ENDIF
  92 :             IF (NPC2.EQ.1) THEN
  93 :                IPC2=1
  94 :             ELSE
  95 :                IPC2=IPFC
  96 :             ENDIF
  97 :             IF (NPC3.EQ.1) THEN
  98 :                IPC3=1
  99 :             ELSE
 100 :                IPC3=IPFC
 101 :             ENDIF
 102 :             XT1=T1.VELCHE(1,1,1,1,IPC1,ILC1)
 103 :             XT2=T2.VELCHE(1,1,1,1,IPC2,ILC2)
 104 :             XT3=T3.VELCHE(1,1,1,1,IPC3,ILC3)
 105 :             FC.VELCHE(1,1,1,1,IPFC,ILFC)=
 106 :      $           XT1*XT2*XT3**3
 107 :          ENDDO
 108 :       ENDDO
 109 : *     
 110 : * Normal termination
 111 : *     
 112 :       IRET=0
 113 :       RETURN
 114 : *     
 115 : * Format handling
 116 : *     
 117 : *     
 118 : * Error handling
 119 : *     
 120 :  9999 CONTINUE
 121 :       IRET=1
 122 :       WRITE(IOIMP,*) 'An error was detected in subroutine ccgras'
 123 :       RETURN
 124 : *     
 125 : * End of subroutine CCGRAS
 126 : *     
 127 :       END
 128 : 
 129 :