C TYPRIG SOURCE CHAT 09/10/09 21:25:44 6519 * SOUS-TYPE D'UN OBJET DE TYPE 'RIGIDITE'. SUBROUTINE TYPRIG (IPRIGI,LISTYP,NBTYP,NUMERO) ************************************************************************ * * T Y P R I G * ----------- * * FONCTION: * --------- * * DONNER LE SOUS-TYPE D'UN OBJET DE TYPE 'RIGIDITE', PARMI UNE * LISTE DE NOMS FOURNIS. * * MODE D'APPEL: * ------------- * * CALL TYPRIG (IPRIGI,LISTYP,NBTYP,NUMERO) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IPRIGI ENTIER (E) POINTEUR SUR L'OBJET DE TYPE 'RIGIDITE'. * LISTYP ENTIER (E) CONTIENT LA LISTE DES NOMS DE SOUS-TYPE * PERMIS. * TABLEAU A 2 LIGNES ET "NBTYP" COLONNES * CONTENANT 1 NOM DE 8 CARACTERES PAR * COLONNE (4 CARACTERES PAR ELEMENT). * NBTYP ENTIER (E) NOMBRE DE SOUS-TYPES POSSIBLES. * NUMERO ENTIER (S) NUMERO D'ORDRE DU NOM DU SOUS-TYPE TROUVE * DANS LA LISTE "LISTYP". * = 0 SI LE SOUS-TYPE N'EST PAS DANS LA * LISTE "LISTYP". * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 11 OCTOBRE 1984 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. * ************************************************************************ * IMPLICIT INTEGER(I-N) -INC SMRIGID * CHARACTER*8 LISTYP(*) * MRIGID = IPRIGI SEGACT,MRIGID * NUMERO = 0 DO 100 IB100=1,NBTYP IF (MTYMAT .EQ. LISTYP(IB100) ) THEN NUMERO = IB100 * --> SORTIE DE BOUCLE GOTO 110 END IF 100 CONTINUE * END DO 110 CONTINUE * SEGDES,MRIGID * END