Download ccgmur.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer