1 : C COMPUS SOURCE CHAT 05/01/12 22:16:14 5004 2 : SUBROUTINE COMPUS(NOMVAL,XVAL,IVALIS,NVAL,NOMPAR, 3 : & VALPAR,NPARA,CMNAME,IERUT) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : C----------------------------------------------------------------------- 7 : C 8 : C DESCRIPTION FONCTIONNELLE : 9 : C ------------------------- 10 : C 11 : C Version du module externe COMPUS integree au code pour eviter tout 12 : C probleme d'edition de lien et pour permettre le passage de tests 13 : C de non regression. 14 : C 15 : C En utilisation normale, ce module doit etre surcharge par celui 16 : C de meme nom fourni par l'utilisateur. 17 : C 18 : C----------------------------------------------------------------------- 19 : C 20 : C DESCRIPTION DE L'INTERFACE : 21 : C -------------------------- 22 : C ENTREE : NOMVAL : CHARACTER*4, NOMS DES COMPOSANTES 23 : C ENTREE : XVAL : VALEURS DES COMPOSANTES 24 : C ENTREE : IVALIS : 1 SI LA COMPOSANTE EST A EVALUER, O SINON 25 : C ENTREE : NVAL : NOMBRE DE COMPOSANTES 26 : C ENTREE : NOMPAR : CHARACTER*4, NOMS DES PARAMETRES 27 : C ENTREE : VALPAR : VALEURS DES PARAMETRES 28 : C ENTREE : NPARA : INTEGER, nombre de parametres 29 : C SORTIE : IERUT : INTEGER, code retour 30 : C IERUT= 0 : OK 31 : C IERUT<>0 : NOOK 32 : C Les cas d'erreur pris en charge par la 33 : C programmation de l'utilisateur doivent 34 : C faire l'objet d'une affectation de IERUT 35 : C differente de 0 36 : C 37 : C----------------------------------------------------------------------- 38 : C 39 : C Arguments de l'interface 40 : C 41 : INTEGER NPARA, NVAL, IERUT 42 : INTEGER IVALIS(NVAL) 43 : CHARACTER*4 NOMPAR(NPARA) ,NOMVAL(NVAL) 44 : CHARACTER*4 K4ILOI,NOMCMP 45 : CHARACTER*16 CMNAME 46 : REAL*8 VALPAR(NPARA), XVAL(NVAL) 47 : C 48 : C Fonctions externes 49 : C 50 : REAL*8 FVYOUN, FVNU, FVALPH, FVSMAX, FVAF0, FVAF1, FVAF2, 51 : & FVAF3, FVAF4, FVAF5, FVAF6 52 : EXTERNAL FVYOUN, FVNU, FVALPH, FVSMAX, FVAF0, FVAF1, FVAF2, 53 : & FVAF3, FVAF4, FVAF5, FVAF6 54 : C 55 : C Datas pour definir les parametrages de reference des composantes 56 : C 57 : 58 : C 59 : C Datas pour definir les parametrages de reference des composantes 60 : C 61 : INTEGER NPYOUN, NPNU, NPALPH, NPSMAX, 62 : & NPAF0, NPAF1, NPAF2, NPAF3, NPAF4, NPAF5, NPAF6 63 : PARAMETER (NPYOUN=3, NPNU=3, NPALPH=2, NPSMAX=3, 64 : & NPAF0=3, NPAF1=5, NPAF2=3, NPAF3=4, NPAF4=3, 65 : & NPAF5=3, NPAF6=3) 66 : REAL*8 PAYOUN(NPYOUN), PANU(NPNU), PAALPH(NPALPH), 67 : & PASMAX(NPSMAX), 68 : & PAAF0(NPAF0), PAAF1(NPAF1), PAAF2(NPAF2), 69 : & PAAF3(NPAF3), PAAF4(NPAF4), PAAF5(NPAF5), 70 : & PAAF6(NPAF6) 71 : C 72 : C 73 : C 74 : C---------------------- Debut du code executable ----------------------- 75 : C 76 : C 77 : IERUT=0 78 : K4ILOI = CMNAME(13:16) 79 : * 80 : * 81 : IF (K4ILOI.EQ.' 22') THEN 82 : 83 : C 84 : C BOUCLE SUR TOUTES LES COMPOSANTES 85 : C 86 : DO 10 IC=1,NVAL 87 : 88 : NOMCMP = NOMVAL(IC) 89 : 90 : IF(IVALIS(IC).EQ.1) THEN 91 : C 92 : IF (NOMCMP.EQ.'YOUN') THEN 93 : PAYOUN(1) = VALPAR (1) 94 : PAYOUN(2) = VALPAR (2) 95 : PAYOUN(3) = VALPAR (3) 96 : VALCMP=FVYOUN(PAYOUN,NPYOUN,IERUT) 97 : C 98 : ELSE IF (NOMCMP.EQ.'NU ') THEN 99 : PANU(1) = VALPAR (1) 100 : PANU(2) = VALPAR (2) 101 : PANU(3) = VALPAR (3) 102 : VALCMP=FVNU(PANU,NPNU,IERUT) 103 : C 104 : ELSE IF (NOMCMP.EQ.'ALPH') THEN 105 : PAALPH(1) = VALPAR (1) 106 : PAALPH(2) = VALPAR (4) 107 : VALCMP=FVALPH(PAALPH,NPALPH,IERUT) 108 : C 109 : ELSE IF (NOMCMP.EQ.'SMAX') THEN 110 : PASMAX(1) = VALPAR (1) 111 : PASMAX(2) = VALPAR (2) 112 : PASMAX(3) = VALPAR (3) 113 : VALCMP=FVSMAX(PASMAX,NPSMAX,IERUT) 114 : C 115 : ELSE IF (NOMCMP.EQ.'AF0 ') THEN 116 : PAAF0 (1) = VALPAR (5) 117 : PAAF0 (2) = VALPAR (6) 118 : PAAF0 (3) = VALPAR (7) 119 : VALCMP=FVAF0(PAAF0 ,NPAF0,IERUT) 120 : C 121 : ELSE IF (NOMCMP.EQ.'AF1 ') THEN 122 : PAAF1 (1) = VALPAR (5) 123 : PAAF1 (2) = VALPAR (6) 124 : PAAF1 (3) = VALPAR (7) 125 : PAAF1 (4) = VALPAR (8) 126 : PAAF1 (5) = VALPAR (9) 127 : VALCMP=FVAF1(PAAF1 ,NPAF1,IERUT) 128 : C 129 : ELSE IF (NOMCMP.EQ.'AF2 ') THEN 130 : PAAF2 (1) = VALPAR (5) 131 : PAAF2 (2) = VALPAR (6) 132 : PAAF2 (3) = VALPAR (7) 133 : VALCMP=FVAF2(PAAF2 ,NPAF2,IERUT) 134 : C 135 : ELSE IF (NOMCMP.EQ.'AF3 ') THEN 136 : PAAF3 (1) = VALPAR (5) 137 : PAAF3 (2) = VALPAR (6) 138 : PAAF3 (3) = VALPAR (7) 139 : PAAF3 (4) = VALPAR (8) 140 : VALCMP=FVAF3(PAAF3 ,NPAF3,IERUT) 141 : C 142 : ELSE IF (NOMCMP.EQ.'AF4 ') THEN 143 : PAAF4 (1) = VALPAR (5) 144 : PAAF4 (2) = VALPAR (6) 145 : PAAF4 (3) = VALPAR (7) 146 : VALCMP=FVAF4(PAAF4 ,NPAF4,IERUT) 147 : C 148 : ELSE IF (NOMCMP.EQ.'AF5 ') THEN 149 : PAAF5 (1) = VALPAR (5) 150 : PAAF5 (2) = VALPAR (6) 151 : PAAF5 (3) = VALPAR (7) 152 : VALCMP=FVAF5(PAAF5 ,NPAF5,IERUT) 153 : C 154 : ELSE IF (NOMCMP.EQ.'AF6 ') THEN 155 : PAAF6 (1) = VALPAR (5) 156 : PAAF6 (2) = VALPAR (6) 157 : PAAF6 (3) = VALPAR (7) 158 : VALCMP=FVAF6(PAAF6 ,NPAF6,IERUT) 159 : C 160 : ENDIF 161 : XVAL(IC)=VALCMP 162 : ENDIF 163 : 10 CONTINUE 164 : 165 : 166 : C 167 : C AUTRES LOIS 168 : C 169 : ELSE 170 : IERUT=201 171 : C 172 : ENDIF 173 : C 174 : RETURN 175 : END 176 : 177 : 178 : 179 :
© Cast3M 2003 - All rights reserved.
Disclaimer