C COMPUS SOURCE CHAT 05/01/12 22:16:14 5004 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 : CHARACTER*4, 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 : CHARACTER*4, 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<>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 INTEGER NPARA, NVAL, IERUT INTEGER IVALIS(NVAL) CHARACTER*4 NOMPAR(NPARA) ,NOMVAL(NVAL) CHARACTER*4 K4ILOI,NOMCMP CHARACTER*16 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