1 : C EXTRA7 SOURCE CHAT 05/01/12 23:53:19 5004 2 : SUBROUTINE EXTRA7 (IPBASE,MOT, IPTR) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * E X T R A 7 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * SOUS-PROGRAMME POUR EXTRAIRE D'UNE BASE MODALE 14 : * UNE 'RIGIDITE', 15 : * OU L'OBJET SOLUTION DE SOUS-TYPE 'MODE ', 16 : * OU L'OBJET SOLUTION DE SOUS_TYPE 'SOLUSTAT', 17 : * OU L'OBJET SOLUTION DE SOUS_TYPE 'PSEUMODE'. 18 : * 19 : * MODULES UTILISES: 20 : * ----------------- 21 : * 22 : -INC CCOPTIO 23 : -INC SMBASEM 24 : -INC SMSTRUC 25 : * 26 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 27 : * ----------- 28 : * 29 : * IPBASE (E) POINTEUR SUR LE SEGMENT MBASEM 30 : * MOT (E) MOT-CLE : 'RIGI', OU 'MASS', 31 : * OU 'MODE', OU 'STAT', 'PSMO'. 32 : * IPTR (S) POINTEUR SUR UN OBJET RIGIDITE SI 'RIGI' OU 'MASS' 33 : * POINTEUR SUR UN OBJET SOLUTION 34 : * SI 'MODE' OU 'STAT' OU 'PSMO'. 35 : * 36 : CHARACTER*4 MOT 37 : * 38 : * MODE DE FONCTIONNEMENT : 39 : * ------------------------ 40 : * 41 : * ON SUPPOSE QUE LE PROGRAMME APPELANT A VERIFIE QUE LE 42 : * MOT-CLE SOIT CORRECT. 43 : * 44 : * AUTEUR, DATE DE CREATION: 45 : * ------------------------- 46 : * 47 : * LIONEL VIVAN 4 MARS 1988 48 : * 49 : * LANGAGE: 50 : * -------- 51 : * 52 : * ESOPE + FORTRAN77 53 : * 54 : ************************************************************************ 55 : * 56 : IF (MOT.EQ.'MODE' .OR. MOT.EQ.'STAT' .OR. MOT.EQ.'PSMO') THEN 57 : MBASEM=IPBASE 58 : SEGACT,MBASEM 59 : NBAS=LISBAS(/1) 60 : DO 10 I=1,NBAS 61 : MSOBAS=LISBAS(I) 62 : SEGACT,MSOBAS 63 : IF (I.EQ.1) THEN 64 : IF (MOT.EQ.'MODE') THEN 65 : IPTM1=IBSTRM(2) 66 : ELSE IF (MOT.EQ.'STAT') THEN 67 : IPTM1=IBSTRM(3) 68 : ELSE 69 : IPTM1=IBSTRM(5) 70 : ENDIF 71 : ELSE 72 : IF (MOT.EQ.'MODE') THEN 73 : IPTM2=IBSTRM(2) 74 : ELSE IF (MOT.EQ.'STAT') THEN 75 : IPTM2=IBSTRM(3) 76 : ELSE 77 : IPTM2=IBSTRM(5) 78 : ENDIF 78 : CALL FUSOLU(IPTM1,IPTM2,IPTM3) 79 : IF (IERR.NE.0) RETURN 79 : CALL DTSOLU(IPTM1) 80 : IF (IERR.NE.0) RETURN 81 : IPTM1=IPTM3 82 : ENDIF 83 : SEGDES,MSOBAS 84 : 10 CONTINUE 85 : SEGDES,MBASEM 86 : IPTR=IPTM1 87 : * 88 : ELSE IF (MOT.EQ.'MASS' .OR. MOT.EQ.'RIGI') THEN 89 : MBASEM=IPBASE 90 : SEGACT,MBASEM 91 : NBAS=LISBAS(/1) 92 : DO 20 I=1,NBAS 93 : MSOBAS=LISBAS(I) 94 : SEGACT,MSOBAS 95 : MSOSTU=IBSTRM(1) 96 : SEGDES,MSOBAS 97 : SEGACT,MSOSTU 98 : IF (I.EQ.1) THEN 99 : IF (MOT.EQ.'MASS') THEN 100 : IPTR1=ISMASS 101 : ELSE 102 : IPTR1=ISRAID 103 : ENDIF 104 : ELSE 105 : IF (MOT.EQ.'MASS') THEN 106 : IPTR2=ISMASS 107 : ELSE 108 : IPTR2=ISRAID 109 : ENDIF 109 : CALL FUSRIG(IPTR1,IPTR2,IPTR3) 110 : IF (IERR.NE.0) RETURN 110 : CALL DTRIGI(IPTR1) 111 : IF (IERR.NE.0) RETURN 112 : IPTR1=IPTR3 113 : ENDIF 114 : SEGDES,MSOSTU 115 : 20 CONTINUE 116 : SEGDES,MBASEM 117 : IPTR=IPTR1 118 : ENDIF 119 : * 120 : END 121 :
© Cast3M 2003 - All rights reserved.
Disclaimer