Esope source files

   1 : C COGAF1    SOURCE    GOUNAND   06/08/04    21:15:02     5520           
   2 :       SUBROUTINE COGAF1(NDDL,NBPOGO,NBELEV,NBELFV,NBELEF,
   3 :      $     NLVCOF,NLFVFF,NLFCOG,
   4 :      $     JCOEFF,FFPG,SSFACT,
   5 :      $     JCOEFG,
   6 :      $     IMPR,IRET)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 :       IMPLICIT INTEGER (I-N)
   9 : C***********************************************************************
  10 : C NOM         : COGAF1
  11 : C PROJET      : Noyau linéaire NLIN
  12 : C DESCRIPTION :
  13 : C             
  14 : C LANGAGE     : Fortran 77 (sauf E/S)
  15 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16 : C               mél : gounand@semt2.smts.cea.fr
  17 : C***********************************************************************
  18 : C APPELES          : -
  19 : C APPELE PAR       : COGAUF
  20 : C***********************************************************************
  21 : C ENTREES            :
  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 :       INTEGER NDDL,NBPOGO,NBELEV,NBELFV,NBELEF
  38 :       REAL*8 JCOEFF (NDDL,NLVCOF)
  39 :       REAL*8 FFPG  (NDDL,NBPOGO,NLFVFF)
  40 :       LOGICAL SSFACT(NBELFV,NBELEV)
  41 :       REAL*8 JCOEFG(NBPOGO,NLFCOG)
  42 : *
  43 :       INTEGER IMPR,IRET
  44 :       INTEGER IBPOGO,IDDL,IBELEV,IBELEF,IBELFV
  45 : *     
  46 : * Executable statements
  47 : *
  48 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cogaf1'
  49 :       IF (NLFCOG.EQ.1) THEN
  50 :          IF (NLVCOF.NE.1.OR.NLFVFF.NE.1) THEN
  51 :             WRITE(IOIMP,*) 'Erreur grave 1'
  52 :             GOTO 9999
  53 :          ENDIF
  54 :          DO IBPOGO=1,NBPOGO
  55 :             DO IDDL=1,NDDL
  56 :                JCOEFG(IBPOGO,1)=JCOEFG(IBPOGO,1)+
  57 :      $              ( FFPG(IDDL,IBPOGO,1)
  58 :      $               *JCOEFF(IDDL,1))
  59 :             ENDDO
  60 :          ENDDO
  61 :       ELSEIF (NLFCOG.EQ.NBELEF) THEN
  62 :          IBELEF=0
  63 :          DO IBELEV=1,NBELEV
  64 :             DO IBELFV=1,NBELFV
  65 :                IF (SSFACT(IBELFV,IBELEV)) THEN
  66 :                   IF (NLVCOF.EQ.1) THEN
  67 :                      ILVCOF=1
  68 :                   ELSE
  69 :                      ILVCOF=IBELEV
  70 :                   ENDIF
  71 :                   IF (NLFVFF.EQ.1) THEN
  72 :                      ILFVFF=1
  73 :                   ELSE
  74 :                      ILFVFF=IBELFV
  75 :                   ENDIF
  76 :                   IBELEF=IBELEF+1
  77 :                   DO IBPOGO=1,NBPOGO
  78 :                      DO IDDL=1,NDDL
  79 :                         JCOEFG(IBPOGO,IBELEF)=
  80 :      $                       JCOEFG(IBPOGO,IBELEF)
  81 :      $                       + (JCOEFF(IDDL,ILVCOF)
  82 :      $                          *FFPG(IDDL,IBPOGO,ILFVFF))
  83 :                      ENDDO
  84 :                   ENDDO
  85 :                ENDIF
  86 :             ENDDO
  87 :          ENDDO
  88 :       ELSE
  89 :          WRITE(IOIMP,*) 'Erreur grave 2'
  90 :          GOTO 9999
  91 :       ENDIF
  92 : *
  93 : * Normal termination
  94 : *
  95 :       IRET=0
  96 :       RETURN
  97 : *
  98 : * Format handling
  99 : *
 100 : *
 101 : * Error handling
 102 : *
 103 :  9999 CONTINUE
 104 :       IRET=1
 105 :       WRITE(IOIMP,*) 'An error was detected in subroutine cogaf1'
 106 :       RETURN
 107 : *
 108 : * End of subroutine COGAF1
 109 : *
 110 :       END
 111 : 
 112 :