C EXTR20 SOURCE FANDEUR 10/12/09 21:15:03 6810 SUBROUTINE EXTR20 (IPCHAR,CMOT,ICHGT,LCHGT,IEC, & IPRES1,CTYP1,IPRES2,CTYP2) C======================================================================= C C RESULTAT = EXTRAIRE CHARGEME ... ; C C 1) CHARGEME 'CHAR' (ENTIER) CHARGEME C 2) CHARGEME 'CHAM' (ENTIER) CHPOINT ou MCHAML C 3) CHARGEME 'TRAJ' (ENTIER) CHPOINT C 4) CHARGEME 'EVOL' (ENTIER) EVOLUTION C 5) CHARGEME 'VITE' (ENTIER) EVOLUTION C 6) CHARGEME 'COMP' LISTMOTS C 7) CHARGEME 'LIE ' CHARGEME C 8) CHARGEME 'LIBR' CHARGEME C 9) CHARGEME MOT 'TABLES' TABLES C 10) CHARGEME MOT CHARGEME C 11) CHARGEME LISTMOTS CHARGEME C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO -INC CCGEOME -INC SMCHARG -INC SMEVOLL -INC SMLMOTS CHARACTER*(4) CMOT CHARACTER*(8) CTYP1,CTYP2 CHARACTER*4 MCOMP IPRES1 = 0 CTYP1 = ' ' IPRES2 = 0 CTYP2 = ' ' MCHARG = IPCHAR SEGACT,MCHARG NCHAR = KCHARG(/1) C IF (NCHAR.LT.IEC) THEN INTERR(1) = IEC CALL ERREUR(690) GOTO 9999 ENDIF C ICHG2 = ICHGT + 2 GOTO ( 1010, 1000, 10, 20, 30, 40, 50, 60, 70, 70), ICHG2 GOTO 9999 C C MOT-CLE 'CHAR' ==> ICHGT = 1 C---------------- 10 CONTINUE N = 1 SEGINI,MCHAR1 MCHAR1.KCHARG(1) = KCHARG(IEC) MCHAR1.CHANOM(1) = CHANOM(IEC) MCHAR1.CHANAT(1) = CHANAT(IEC) MCHAR1.CHAMOB(1) = CHAMOB(IEC) MCHAR1.CHALIE(1) = CHALIE(IEC) SEGDES,MCHAR1 IPRES1 = MCHAR1 CTYP1 = 'CHARGEME' GOTO 9999 C C MOT-CLE 'CHAM' ==> ICHGT = 2 C---------------- 20 CONTINUE ICHARG = KCHARG(IEC) SEGACT,ICHARG IF (CHATYP.EQ.'CHPOINT ' .OR. CHATYP.EQ.'MCHAML ') THEN IPRES1 = ICHPO1 CTYP1 = CHATYP ELSE INTERR(1) = IEC CALL ERREUR(688) ENDIF SEGDES,ICHARG GOTO 9999 C C MOT-CLE 'TRAJ' ==> ICHGT = 3 C--------------- 30 CONTINUE IF (CHAMOB(IEC).EQ.'TRAJ') THEN ICHARG = KCHARG(IEC) SEGACT,ICHARG IPRES1 = ICHPO4 CTYP1 = 'CHPOINT' SEGDES,ICHARG ELSE INTERR(1) = IEC CALL ERREUR(900) ENDIF GOTO 9999 C C MOT-CLE 'EVOL' ==> ICHGT = 4 C--------------- 40 CONTINUE ICHARG = KCHARG(IEC) SEGACT,ICHARG IF (CHATYP.EQ.'CHPOINT ' .OR. CHATYP.EQ.'MCHAML ') THEN SEGINI,KEVOLL NUMEVX = IDCOUL NUMEVY = 'REEL' TYPX = 'LISTREEL' TYPY = 'LISTREEL' NOMEVX = 'TEMPS' NOMEVY = CHANOM(IEC) IPROGX = ICHPO2 IPROGY = ICHPO3 KEVTEX = 'Evolution temporelle de '//CHANOM(IEC) SEGDES,KEVOLL N = 1 SEGINI,MEVOLL ITYEVO = 'REEL' IEVTEX = 'Evolution extraite d''un CHARGEMENT' IEVOLL(1) = KEVOLL SEGDES,MEVOLL IPRES1 = MEVOLL CTYP1 = 'EVOLUTIO' ELSE INTERR(1) = IEC CALL ERREUR(689) ENDIF SEGDES,ICHARG GOTO 9999 C C MOT-CLE 'VITE' ==> ICHGT = 5 C--------------- 50 CONTINUE IF (CHAMOB(IEC).EQ.'TRAN' .OR. CHAMOB(IEC).EQ.'ROTA') THEN ICHARG = KCHARG(IEC) SEGACT,ICHARG SEGINI,KEVOLL NUMEVX = IDCOUL NUMEVY = 'REEL' TYPX = 'LISTREEL' TYPY = 'LISTREEL' IPROGX = ICHPO6 IPROGY = ICHPO7 NOMEVX = 'TEMPS' NOMEVY = CHANOM(IEC) KEVTEX='Evolution temporelle de '//CHANOM(IEC) SEGDES,KEVOLL SEGDES,ICHARG N = 1 SEGINI,MEVOLL ITYEVO = 'REEL' IEVTEX = 'Evolution extraite d''un CHARGEMENT' IEVOLL(1) = KEVOLL SEGDES,MEVOLL IPRES1 = MEVOLL CTYP1 = 'EVOLUTIO' ELSE INTERR(1) = IEC CALL ERREUR(901) ENDIF GOTO 9999 C MOT-CLE 'COMP' ==> ICHGT = 6 C---------------- 60 CONTINUE JGN = 4 JGM = NCHAR SEGINI,MLMOTS MOTS(1) = CHANOM(1) NMO1 = 1 DO icha = 2, NCHAR DO kcha = 1, NMO1 IF (CHANOM(icha).EQ.MOTS(kcha)) GOTO 61 ENDDO NMO1 = NMO1 + 1 MOTS(NMO1) = CHANOM(icha) 61 CONTINUE ENDDO IF (JGM.NE.NMO1) THEN JGM = NMO1 SEGADJ,MLMOTS ENDIF SEGDES,MLMOTS IPRES1 = MLMOTS CTYP1 = 'LISTMOTS' GOTO 9999 C C MOT-CLE 'LIE ' OU 'LIBR' ==> ICHGT = 7 ou 8 C-------------------------- 70 CONTINUE N = NCHAR SEGINI,MCHAR1 kcha = 0 DO icha = 1, NCHAR IF (CHALIE(icha).EQ.CMOT) then kcha = kcha + 1 MCHAR1.KCHARG(kcha) = KCHARG(icha) MCHAR1.CHANAT(kcha) = CHANAT(icha) MCHAR1.CHANOM(kcha) = CHANOM(icha) MCHAR1.CHAMOB(kcha) = CHAMOB(icha) MCHAR1.CHALIE(kcha) = CHALIE(icha) ENDIF ENDDO IF (kcha.LE.0) THEN SEGSUP,MCHAR1 MOTERR(1:4) = CMOT CALL ERREUR(899) ELSE IF (kcha.NE.N) THEN N = kcha SEGADJ,MCHAR1 ENDIF SEGDES,MCHAR1 IPRES1 = MCHAR1 CTYP1 = 'CHARGEME' ENDIF GOTO 9999 C COMPOSANTE MOT ou LISTMOTS ==> ICHGT = 0 C---------------------------- 1000 CONTINUE N = NCHAR SEGINI,MCHAR1 NCOMP = 1 MCOMP = CMOT MLMOTS = LCHGT IF (LCHGT.GT.0) THEN SEGACT,MLMOTS NCOMP = MLMOTS.MOTS(/2) ENDIF kcha = 0 DO icomp = 1, NCOMP IF (LCHGT.GT.0) MCOMP = MLMOTS.MOTS(icomp) kcha1 = 0 DO icha = 1, NCHAR IF (CHANOM(icha).EQ.MCOMP) THEN kcha = kcha + 1 MCHAR1.KCHARG(kcha) = KCHARG(icha) MCHAR1.CHANAT(kcha) = CHANAT(icha) MCHAR1.CHANOM(kcha) = CHANOM(icha) MCHAR1.CHAMOB(kcha) = CHAMOB(icha) MCHAR1.CHALIE(kcha) = CHALIE(icha) kcha1 = 1 ENDIF ENDDO IF (kcha1.EQ.0) THEN MOTERR(1:4) = MCOMP CALL ERREUR(685) ENDIF ENDDO IF (LCHGT.GT.0) SEGDES,MLMOTS IF (IERR.EQ.0) THEN IF (kcha.NE.N) THEN N = kcha SEGADJ,MCHAR1 ENDIF SEGDES,MCHAR1 IPRES1 = MCHAR1 CTYP1 = 'CHARGEME' ELSE SEGSUP,MCHAR1 ENDIF GOTO 9999 C TABLES DE CHARGEMENT DE LA COMPOSANTE CMOT ==> ICHGT = -1 C-------------------------------------------- 1010 CONTINUE kcha = 0 DO icha = 1, NCHAR IF (CHANOM(icha).EQ.CMOT) THEN kcha = kcha + 1 ICHARG = KCHARG(icha) ENDIF ENDDO IF (kcha.NE.1) THEN IF (kcha.EQ.0) THEN MOTERR(1:4) = CMOT CALL ERREUR(685) ELSE CALL ERREUR(697) CALL ERREUR(512) ENDIF ELSE SEGACT,ICHARG IPRES1 = ICHPO2 CTYP1 = 'TABLE ' IPRES2 = ICHPO1 CTYP2 = 'TABLE ' SEGDES,ICHARG * Mettre une verification sur le type de ichpo1 et ichpo2 : TABLE ? ENDIF GOTO 9999 9999 CONTINUE SEGDES,MCHARG RETURN END