Sources Esope | Cast3M

compus
C COMPUS    SOURCE    CB215821  20/11/04    21:15:46     10766          
      SUBROUTINE COMPUS(NOMVAL,XVAL,IVALIS,NVAL,NOMPAR,
     &                  VALPAR,NPARA,CMNAME,IERUT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C-----------------------------------------------------------------------
C
C     DESCRIPTION FONCTIONNELLE :
C     -------------------------
C
C     Version du module externe COMPUS integree au code pour eviter tout
C     probleme d'edition de lien et pour permettre le passage de tests
C     de non regression.
C
C     En utilisation normale, ce module doit etre surcharge par celui
C     de meme nom fourni par l'utilisateur.
C
C-----------------------------------------------------------------------
C
C     DESCRIPTION DE L'INTERFACE :
C     --------------------------
C     ENTREE : NOMVAL : NOMS DES COMPOSANTES
C     ENTREE : XVAL   : VALEURS DES COMPOSANTES
C     ENTREE : IVALIS : 1 SI LA COMPOSANTE EST A EVALUER, O SINON
C     ENTREE : NVAL   : NOMBRE DE COMPOSANTES
C     ENTREE : NOMPAR : NOMS DES PARAMETRES
C     ENTREE : VALPAR : VALEURS DES PARAMETRES
C     ENTREE : NPARA  : INTEGER, nombre de parametres
C     SORTIE : IERUT  : INTEGER, code retour
C                       IERUT= 0 : OK
C                       IERUT&lt;>0 : NOOK
C                       Les cas d'erreur pris en charge par la
C                       programmation de l'utilisateur doivent
C                       faire l'objet d'une affectation de IERUT
C                       differente de 0
C
C-----------------------------------------------------------------------
C
C     Arguments de l'interface
C
 
-INC PPARAM
 
      INTEGER            NPARA, NVAL, IERUT
      INTEGER            IVALIS(NVAL)
      CHARACTER*(*)      NOMPAR(NPARA)
      CHARACTER*(*)      NOMVAL(NVAL)
      CHARACTER*(4)      K4ILOI
      CHARACTER*(LOCOMP) NOMCMP
      CHARACTER*(*)      CMNAME
      REAL*8             VALPAR(NPARA), XVAL(NVAL)
C
C     Fonctions externes
C
      REAL*8       FVYOUN, FVNU, FVALPH, FVSMAX, FVAF0, FVAF1, FVAF2,
     &             FVAF3, FVAF4, FVAF5, FVAF6
      EXTERNAL     FVYOUN, FVNU, FVALPH, FVSMAX, FVAF0, FVAF1, FVAF2,
     &             FVAF3, FVAF4, FVAF5, FVAF6
C
C     Datas pour definir les parametrages de reference des composantes
C
 
C
C     Datas pour definir les parametrages de reference des composantes
C
      INTEGER      NPYOUN, NPNU, NPALPH, NPSMAX,
     &             NPAF0, NPAF1, NPAF2, NPAF3, NPAF4, NPAF5, NPAF6
      PARAMETER   (NPYOUN=3, NPNU=3, NPALPH=2, NPSMAX=3,
     &             NPAF0=3, NPAF1=5, NPAF2=3, NPAF3=4, NPAF4=3,
     &             NPAF5=3, NPAF6=3)
      REAL*8       PAYOUN(NPYOUN), PANU(NPNU), PAALPH(NPALPH),
     &             PASMAX(NPSMAX),
     &             PAAF0(NPAF0), PAAF1(NPAF1), PAAF2(NPAF2),
     &             PAAF3(NPAF3), PAAF4(NPAF4), PAAF5(NPAF5),
     &             PAAF6(NPAF6)
C
C
C
C---------------------- Debut du code executable -----------------------
C
C
      IERUT=0
      K4ILOI = CMNAME(13:16)
*
*
      IF (K4ILOI.EQ.'  22') THEN
 
C
C   BOUCLE SUR TOUTES LES COMPOSANTES
C
         DO 10 IC=1,NVAL
 
           NOMCMP = NOMVAL(IC)
 
           IF(IVALIS(IC).EQ.1) THEN
C
         IF (NOMCMP.EQ.'YOUN') THEN
            PAYOUN(1) = VALPAR (1)
            PAYOUN(2) = VALPAR (2)
            PAYOUN(3) = VALPAR (3)
            VALCMP=FVYOUN(PAYOUN,NPYOUN,IERUT)
C
         ELSE IF (NOMCMP.EQ.'NU  ') THEN
            PANU(1) = VALPAR (1)
            PANU(2) = VALPAR (2)
            PANU(3) = VALPAR (3)
            VALCMP=FVNU(PANU,NPNU,IERUT)
C
         ELSE IF (NOMCMP.EQ.'ALPH') THEN
            PAALPH(1) = VALPAR (1)
            PAALPH(2) = VALPAR (4)
            VALCMP=FVALPH(PAALPH,NPALPH,IERUT)
C
         ELSE IF (NOMCMP.EQ.'SMAX') THEN
            PASMAX(1) = VALPAR (1)
            PASMAX(2) = VALPAR (2)
            PASMAX(3) = VALPAR (3)
            VALCMP=FVSMAX(PASMAX,NPSMAX,IERUT)
C
         ELSE IF (NOMCMP.EQ.'AF0 ') THEN
            PAAF0 (1) = VALPAR (5)
            PAAF0 (2) = VALPAR (6)
            PAAF0 (3) = VALPAR (7)
            VALCMP=FVAF0(PAAF0 ,NPAF0,IERUT)
C
         ELSE IF (NOMCMP.EQ.'AF1 ') THEN
            PAAF1 (1) = VALPAR (5)
            PAAF1 (2) = VALPAR (6)
            PAAF1 (3) = VALPAR (7)
            PAAF1 (4) = VALPAR (8)
            PAAF1 (5) = VALPAR (9)
            VALCMP=FVAF1(PAAF1 ,NPAF1,IERUT)
C
         ELSE IF (NOMCMP.EQ.'AF2 ') THEN
            PAAF2 (1) = VALPAR (5)
            PAAF2 (2) = VALPAR (6)
            PAAF2 (3) = VALPAR (7)
            VALCMP=FVAF2(PAAF2 ,NPAF2,IERUT)
C
         ELSE IF (NOMCMP.EQ.'AF3 ') THEN
            PAAF3 (1) = VALPAR (5)
            PAAF3 (2) = VALPAR (6)
            PAAF3 (3) = VALPAR (7)
            PAAF3 (4) = VALPAR (8)
            VALCMP=FVAF3(PAAF3 ,NPAF3,IERUT)
C
         ELSE IF (NOMCMP.EQ.'AF4 ') THEN
            PAAF4 (1) = VALPAR (5)
            PAAF4 (2) = VALPAR (6)
            PAAF4 (3) = VALPAR (7)
            VALCMP=FVAF4(PAAF4 ,NPAF4,IERUT)
C
         ELSE IF (NOMCMP.EQ.'AF5 ') THEN
            PAAF5 (1) = VALPAR (5)
            PAAF5 (2) = VALPAR (6)
            PAAF5 (3) = VALPAR (7)
            VALCMP=FVAF5(PAAF5 ,NPAF5,IERUT)
C
         ELSE IF (NOMCMP.EQ.'AF6 ') THEN
            PAAF6 (1) = VALPAR (5)
            PAAF6 (2) = VALPAR (6)
            PAAF6 (3) = VALPAR (7)
            VALCMP=FVAF6(PAAF6 ,NPAF6,IERUT)
C
         ENDIF
          XVAL(IC)=VALCMP
           ENDIF
10       CONTINUE
 
 
C
C   AUTRES LOIS
C
      ELSE
            IERUT=201
C
      ENDIF
C
      RETURN
      END