Esope source files

   1 : C COGAUF    SOURCE    GOUNAND   06/08/04    21:15:10     5520           
   2 :       SUBROUTINE COGAUF(JCOEFF,FFPG,SSFACT,NBELEF,
   3 :      $     JCOEFG,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : COGAUF
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : 
  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
  22 : C ENTREES/SORTIES    : -
  23 : C SORTIES            :
  24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25 : C***********************************************************************
  26 : C VERSION    : v2, 03/10/03, refonte complète (modif SMPOUET)
  27 : C VERSION    : v1, 17/01/03, version initiale
  28 : C HISTORIQUE : v1, 17/01/03, création
  29 : C HISTORIQUE :
  30 : C HISTORIQUE :
  31 : C***********************************************************************
  32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33 : C en cas de modification de ce sous-programme afin de faciliter
  34 : C la maintenance !
  35 : C***********************************************************************
  36 : -INC CCOPTIO
  37 : CBEGININCLUDE SFACTIV
  38 :       SEGMENT FACTIV
  39 :       POINTEUR IFACTI(NBSOUV).SFACTI
  40 :       ENDSEGMENT
  41 :       SEGMENT SFACTI
  42 :       POINTEUR ISFACT(NBSOFV).SSFACT
  43 :       ENDSEGMENT
  44 :       SEGMENT SSFACT
  45 :       LOGICAL LFACTI(NBELFV,NBELEV)
  46 :       ENDSEGMENT
  47 : CENDINCLUDE SFACTIV
  48 : CBEGININCLUDE SMCHAEL
  49 :       SEGMENT MCHAEL
  50 :       POINTEUR IMACHE(N1).MELEME
  51 :       POINTEUR ICHEVA(N1).MCHEVA
  52 :       ENDSEGMENT
  53 :       SEGMENT MCHEVA
  54 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  55 :       ENDSEGMENT
  56 :       SEGMENT LCHEVA
  57 :       POINTEUR LISCHE(NBCHE).MCHEVA
  58 :       ENDSEGMENT
  59 : CENDINCLUDE SMCHAEL
  60 :       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  61 :       POINTEUR JCOEFF.MCHEVA
  62 :       POINTEUR JCOEFG.MCHEVA
  63 : * Valeurs des fns d'interpolation du coeff. aux points de Gauss
  64 :       POINTEUR FFPG.MCHEVA
  65 : *
  66 :       INTEGER IMPR,IRET
  67 : *     
  68 : * Executable statements
  69 : *
  70 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cogauf'
  71 :       SEGACT SSFACT
  72 :       NBELFV=SSFACT.LFACTI(/1)
  73 :       NBELEV=SSFACT.LFACTI(/2)
  74 :       SEGACT JCOEFF
  75 :       NDLIG =JCOEFF.VELCHE(/1)
  76 :       NDCOL =JCOEFF.VELCHE(/2)
  77 :       N2DLIG=JCOEFF.VELCHE(/3)
  78 :       N2DCOL=JCOEFF.VELCHE(/4)
  79 :       NDNOEU=JCOEFF.VELCHE(/5)
  80 :       NBELEM=JCOEFF.VELCHE(/6)
  81 :       IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.1
  82 :      $     .OR.NDNOEU.NE.1
  83 :      $     .OR.(NBELEM.NE.1.AND.NBELEM.NE.NBELEV)) THEN
  84 :          WRITE(IOIMP,*) 'Erreur dims JCOEFF'
  85 :          GOTO 9999
  86 :       ENDIF
  87 :       NDDL=NDCOL
  88 :       NLVCOF=NBELEM
  89 :       SEGACT FFPG
  90 :       NDLIG =FFPG.VELCHE(/1)
  91 :       NDCOL =FFPG.VELCHE(/2)
  92 :       N2DLIG=FFPG.VELCHE(/3)
  93 :       N2DCOL=FFPG.VELCHE(/4)
  94 :       NDNOEU=FFPG.VELCHE(/5)
  95 :       NBELEM=FFPG.VELCHE(/6)
  96 :       IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL
  97 :      $     .OR.N2DLIG.NE.1.OR.N2DCOL.NE.1
  98 :      $     .OR.(NBELEM.NE.1.AND.NBELEM.NE.NBELFV)) THEN
  99 :          WRITE(IOIMP,*) 'Erreur dims FFPG'
 100 :          GOTO 9999
 101 :       ENDIF
 102 :       NBPOGO=NDNOEU
 103 :       NLFVFF=NBELEM
 104 :       IF (NLVCOF.EQ.1.AND.NLFVFF.EQ.1) THEN
 105 :          NLFCOG=1
 106 :       ELSE
 107 :          NLFCOG=NBELEF
 108 :       ENDIF
 109 : *
 110 : * Initialisations...
 111 : *
 112 :       NBLIG=1
 113 :       NBCOL=1
 114 :       N2LIG=1
 115 :       N2COL=1
 116 :       NBPOI=NBPOGO
 117 :       NBELM=NLFCOG
 118 :       SEGINI JCOEFG
 119 : *
 120 : * On effectue le calcul du coefficient aux points de Gauss
 121 : *
 121 :       CALL COGAF1(NDDL,NBPOGO,NBELEV,NBELFV,NBELEF,
 122 :      $     NLVCOF,NLFVFF,NLFCOG,
 123 :      $     JCOEFF.VELCHE,FFPG.VELCHE,SSFACT.LFACTI,
 124 :      $     JCOEFG.VELCHE,
 125 :      $     IMPR,IRET)
 126 :       IF (IRET.NE.0) GOTO 9999
 127 :       SEGDES JCOEFG
 128 :       SEGDES SSFACT
 129 :       SEGDES JCOEFF
 130 :       SEGDES FFPG
 131 : *
 132 : * Normal termination
 133 : *
 134 :       IRET=0
 135 :       RETURN
 136 : *
 137 : * Format handling
 138 : *
 139 : *
 140 : * Error handling
 141 : *
 142 :  9999 CONTINUE
 143 :       IRET=1
 144 :       WRITE(IOIMP,*) 'An error was detected in subroutine cogauf'
 145 :       RETURN
 146 : *
 147 : * End of subroutine COGAUF
 148 : *
 149 :       END
 150 : 
 151 :