C EXCHA1 SOURCE OF166741 25/02/20 21:16:28 12165 SUBROUTINE EXCHA1(ICHAM,ILISR,CMOT) ************************************************************************ * * EXTRACTION DES VARIABLES DONT DEPENDENT LES PARAMETRES DU * MATERIAU. * * ICHAM (E) INTEGER POINTEUR SUR LE MCHAML * ILISR (S) INTEGER POINTEUR SUR UN OBJET DE TYPE SMLMOTS * CONTENANT LES NOMS DES VARIABLES * CMOT (E) * ************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCNOYAU -INC CCASSIS -INC SMCHAML -INC SMLMOTS -INC SMNUAGE -INC SMEVOLL -INC SMTABLE c cccccc PARAMETER ( NNOMCH=29 ) c cccccc CHARACTER*(*) CMOT CHARACTER*8 NOMVXT,NOMVYT CHARACTER*(LOCOMP) NOMCHT,LNOMCH(NNOMCH) CHARACTER*4 MOTSIM DATA MOTSIM / 'SIMU' / DATA LNOMCH / 'TRAC ','EVOL ','COMP ','FLXY ', & 'FLXZ ','CISY ','CISZ ','JDA ', & 'EM0 ','EM1 ','EM2 ','EM3 ', & 'EM4 ','EM5 ','EM6 ','EM7 ', & 'EM8 ','MONP ','MONN ','MONO ', & 'COEV ','TREV ','TRAS ','TRAT ', $ 'PULO ','ECRO ','SJCB ','SJTB ', $ 'SJSB '/ ICAS = 1 IF (CMOT.EQ.'COVA') ICAS = 2 *------------- activation de la liste de MOTS ------------------------ JGM = 20 JGN = LOCOMP SEGINI MLMOT1 ITE1 = 0 MCHELM = ICHAM NSOUS = ICHAML(/1) *------------------ boucle sur les sous chamelem --------------------- DO 1 I1=1,NSOUS MCHAML = ICHAML(I1) NCOMP = NOMCHE(/2) *-------------------- boucle sur les composantes --------------------- DO 2 I2=1,NCOMP IF (TYPCHE(I2).EQ.'REAL*8 ') THEN GOTO 2 ELSE IF (TYPCHE(I2).EQ.'POINTEURPOINT ') THEN GOTO 2 ELSE IF (TYPCHE(I2).EQ.'POINTEURMAILLAGE') THEN GOTO 2 ELSE IF (TYPCHE(I2).EQ.'POINTEURMCHAML ') THEN GOTO 2 ELSE IF (TYPCHE(I2).EQ.'POINTEURCHPOINT ') THEN GOTO 2 ELSE IF (TYPCHE(I2).EQ.'POINTEURMMODEL ') THEN GOTO 2 ELSE IF (TYPCHE(I2).EQ.'POINTEURLISTREEL') THEN GOTO 2 ELSE IF (TYPCHE(I2).EQ.'POINTEURNUAGE ') THEN NOMCHT = NOMCHE(I2) IF (ICAS.EQ.1) THEN CALL PLACE(LNOMCH,NNOMCH,iplac,NOMCHT) MELVAL = IELVAL(I2) C SEGACT MELVAL NOE = IELCHE(/1) NEL = IELCHE(/2) DO 3 I3=1,NEL DO 4 I4=1,NOE MNUAGE = IELCHE(I4,I3) IF (MNUAGE.EQ.0) THEN MOTERR(1:8) = 'MCHAML' INTERR = MCHAML CALL ERREUR(356) RETURN ENDIF SEGACT MNUAGE NVAR = NUANOM(/2) IPOSI = 0 DO 5 I5 = 1,NVAR IF (NUANOM(I5).EQ.NOMCHT) IPOSI = I5 5 CONTINUE IF (IPOSI.NE.0) THEN DO 6 I6 = 1,NVAR IF (I6.EQ.IPOSI) THEN IF (iplac.EQ.0) THEN IF (NUATYP(I6).EQ.'EVOLUTIO') THEN NUAVIN=NUAPOI(I6) SEGACT NUAVIN MEVOL1=NUAINT(1) C SEGDES NUAVIN SEGACT MEVOL1 N1=MEVOL1.IEVOLL(/1) C C ON TESTE L'OBJET EVOLUTION C IF(N1.NE.1) THEN MOTERR(1:8)='EVOLUTIO' INTERR(1)=MEVOL1 CALL ERREUR(110) C SEGDES MEVOL1 C SEGDES MNUAGE C SEGDES MELVAL C SEGDES MCHAML GOTO 9000 ENDIF IF(MEVOL1.ITYEVO.NE.'REEL') THEN MOTERR(1:8)='EVOLUTIO' MOTERR(9:16)='REEL ' CALL ERREUR(79) C SEGDES MEVOL1 C SEGDES MNUAGE C SEGDES MELVAL C SEGDES MCHAML GOTO 9000 ENDIF KEVOL1=MEVOL1.IEVOLL(1) C SEGDES MEVOL1 SEGACT KEVOL1 IF(KEVOL1.TYPX.NE.'LISTREEL'.OR. & KEVOL1.TYPY.NE.'LISTREEL')THEN MOTERR(1:8)='EVOLUTIO' MOTERR(9:16)='LISTREEL' INTERR(1)=MEVOL1 CALL ERREUR(630) C SEGDES KEVOL1 C SEGDES MNUAGE C SEGDES MELVAL C SEGDES MCHAML GOTO 9000 ENDIF NOMVXT=KEVOL1.NOMEVX(1:8) C SEGDES KEVOL1 DO 7 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 8 7 CONTINUE ITE1 = ITE1 + 1 IF (ITE1.GT.JGM) THEN JGM = JGM + 20 SEGADJ MLMOT1 ENDIF MLMOT1.MOTS(ITE1) = NOMVXT 8 CONTINUE ENDIF ENDIF ELSE NOMVXT = NUANOM(I6) DO 9 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 10 9 CONTINUE ITE1 = ITE1 + 1 IF (ITE1.GT.JGM) THEN JGM = JGM + 20 SEGADJ MLMOT1 ENDIF MLMOT1.MOTS(ITE1) = NOMVXT 10 CONTINUE ENDIF 6 CONTINUE ELSE IF (nvar.gt.2) THEN goto 1 ELSE *--------- un parametre du mchaml ne correspond a aucun ----------- *------------------- nom de composante du NUAGE --------------------- MOTERR(1:8) = NOMCHT CALL ERREUR(677) C SEGDES MNUAGE C SEGDES MELVAL C SEGDES MCHAML GOTO 9000 ENDIF C SEGDES MNUAGE 4 CONTINUE 3 CONTINUE C SEGDES MELVAL ELSE IF (ICAS.EQ.2) THEN DO 11 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 12 11 CONTINUE ITE1 = ITE1+1 IF (ITE1.GT.JGM) THEN JGM= JGM+20 SEGADJ MLMOT1 ENDIF MLMOT1.MOTS(ITE1) = NOMCHT 12 CONTINUE ENDIF ELSE IF (TYPCHE(I2).EQ.'POINTEUREVOLUTIO') THEN NOMCHT = NOMCHE(I2) CALL PLACE(LNOMCH,NNOMCH,iplac,NOMCHT) IF (iplac.NE.0) GOTO 2 IF (ICAS.EQ.1) THEN MELVAL = IELVAL(I2) NOE = IELCHE(/1) NEL = IELCHE(/2) DO 13 I13=1,NEL DO 14 I14=1,NOE MEVOLL = IELCHE(I14,I13) IF (MEVOLL.EQ.0) THEN MOTERR(1:8) = 'MCHAML' INTERR = MCHAML CALL ERREUR(356) RETURN ENDIF KEVOLL = IEVOLL(1) IF (KEVOLL.EQ.0) THEN MOTERR(1:8) = 'MCHAML' INTERR = MCHAML CALL ERREUR(356) RETURN ENDIF NOMVYT=NOMEVY(1:8) IF (NOMCHT.EQ.NOMVYT) THEN NOMVXT=NOMEVX(1:8) DO 15 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 16 15 CONTINUE ITE1 = ITE1 + 1 IF (ITE1.GT.JGM) THEN JGM = ITE1 * 2 + 10 SEGADJ MLMOT1 ENDIF MLMOT1.MOTS(ITE1) = NOMVXT 16 CONTINUE ELSE IF (NOMCHT.EQ.'MOCO'. & AND.NOMVYT(1:4).EQ.'RAID') THEN *calcul frequentiel DO 151 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.'TEMP') GOTO 161 151 CONTINUE ITE1 = ITE1 + 1 IF (ITE1.GT.JGM) THEN JGM = ITE1 * 2 + 10 SEGADJ MLMOT1 ENDIF MLMOT1.MOTS(ITE1) = 'TEMP' 161 CONTINUE ELSE * Le nom de la composante ne correspond pas a l'ordonnee de l'EVOLUTION MOTERR(1:8) = NOMCHT MOTERR(9:20) = NOMEVY CALL ERREUR(678) C SEGDES KEVOLL C SEGDES MELVAL C SEGDES MCHAML GOTO 9000 END IF C SEGDES KEVOLL 14 CONTINUE 13 CONTINUE C SEGDES MELVAL ELSE IF (ICAS.EQ.2) THEN DO 17 IU=1,ITE1 IF( MLMOT1.MOTS(IU) . EQ.NOMCHT) GO TO 18 17 CONTINUE ITE1 = ITE1+1 IF (ITE1.GT.JGM) THEN JGM = ITE1 * 2 + 10 SEGADJ MLMOT1 ENDIF MLMOT1.MOTS(ITE1) = NOMCHT 18 CONTINUE ENDIF C ELSE IF (TYPCHE(I2).EQ.'POINTEURLISTMOTS') THEN C IF (ICAS.EQ.1) THEN C MELVAL=IELVAL(I2) C SEGACT,MELVAL N2PTEL=IELCHE(/1) N2EL=IELCHE(/2) C C Le LISTMOTS donne les noms des variables dont depend C la composante, dans l'optique d'une evaluation de la C composante par une fonction externe. C HYPOTHESE de CHAMP UNIFORME : la composante depend C des memes variables en tout point d'integration de C tout element de la sous-zone. C Cette hypothese est necessaire car la composante ne C peut etre associee qu'a une seule fonction externe. C EN CONFORMITE AVEC VARINU.eso C IF (N2PTEL.NE.1.AND.N2EL.NE.1) THEN MOTERR=NOMCHE(I2) CALL ERREUR(953) GOTO 9000 ENDIF MLMOT2=IELCHE(1,1) C SEGACT,MLMOT2 JESIMU=0 IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN JESIMU=1 ENDIF NPARA=MLMOT2.MOTS(/2)-JESIMU IF (ITE1.EQ.0) THEN ITE1=NPARA IF (ITE1.GT.JGM) THEN JGM=NPARA SEGADJ,MLMOT1 ENDIF DO 19 IP=1,NPARA JP=IP+JESIMU MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP) 19 CONTINUE ELSE DO 20 IP=1,NPARA NOMCHT = MLMOT2.MOTS(IP+JESIMU) DO 21 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 20 21 CONTINUE ITE1=ITE1+1 IF (ITE1.GT.JGM) THEN JGM=JGM+20 SEGADJ,MLMOT1 ENDIF MLMOT1.MOTS(ITE1)=NOMCHT 20 CONTINUE ENDIF C SEGDES,MLMOT2 C SEGDES,MELVAL C ELSE IF (ICAS.EQ.2) THEN C NOMCHT = NOMCHE(I2)(1:8) DO 22 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 23 22 CONTINUE ITE1=ITE1+1 IF (ITE1.GT.JGM) THEN JGM=JGM+20 SEGADJ,MLMOT1 ENDIF MLMOT1.MOTS(ITE1)=NOMCHT 23 CONTINUE C ENDIF C *-------- Cas d'une table ELSE IF (TYPCHE(I2).EQ.'POINTEURTABLE') THEN C IF (ICAS.EQ.1) THEN C MELVAL=IELVAL(I2) C SEGACT,MELVAL N2PTEL=IELCHE(/1) N2EL=IELCHE(/2) C C La Table contient un LISTMOTS qui donne les C noms des variables dont depend C la composante, dans l'optique d'une evaluation de la C composante par une fonction externe. C HYPOTHESE de CHAMP UNIFORME : la composante depend C des memes variables en tout point d'integration de C tout element de la sous-zone. C Cette hypothese est necessaire car la composante ne C peut etre associee qu'a une seule fonction externe. C EN CONFORMITE AVEC VARINU.eso C IF (N2PTEL.NE.1.AND.N2EL.NE.1) THEN MOTERR(1:8)=NOMCHE(I2)(1:8) CALL ERREUR(953) GOTO 9000 ENDIF MTAB1=IELCHE(1,1) SEGACT,MTAB1 if (NBESC.NE.0) SEGACT IPILOC C Recherche de la liste de mots a ouvrir ivar = 0 DO 630 IN=1,MTAB1.MLOTAB if (mtab1.mtabti(in).ne.'MOT') goto 630 IP=MTAB1.MTABII(IN) IDEBCH=IPCHAR(IP) IFINCH=IPCHAR(IP+1)-1 IF (ICHARA(IDEBCH:IFINCH).EQ.'VARIABLES') IVAR=IN 630 CONTINUE if (ivar.eq.0) GOTO 631 MLMOT2=MTAB1.MTABIV(IVAR) SEGACT,MLMOT2 JESIMU=0 IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN JESIMU=1 ENDIF NPARA=MLMOT2.MOTS(/2)-JESIMU IF (ITE1.EQ.0) THEN ITE1=NPARA IF (NPARA.GT.JGM) THEN JGM=NPARA SEGADJ,MLMOT1 ENDIF DO 29 IP=1,NPARA JP=IP+JESIMU MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP) 29 CONTINUE ELSE DO 30 IP=1,NPARA NOMCHT = MLMOT2.MOTS(IP+JESIMU) DO 31 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 30 31 CONTINUE ITE1=ITE1+1 IF (ITE1.GT.JGM) THEN JGM=JGM+20 SEGADJ,MLMOT1 ENDIF MLMOT1.MOTS(ITE1)=NOMCHT 30 CONTINUE ENDIF C SEGDES,MLMOT2 631 CONTINUE if (NBESC.NE.0) SEGDES,IPILOC SEGDES,MTAB1 C SEGDES,MELVAL C ELSE IF (ICAS.EQ.2) THEN C NOMCHT =NOMCHE(I2)(1:8) DO 32 IU=1,ITE1 IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 33 32 CONTINUE ITE1=ITE1+1 IF (ITE1.GT.JGM) THEN JGM=JGM+20 SEGADJ,MLMOT1 ENDIF MLMOT1.MOTS(ITE1)=NOMCHT 33 CONTINUE C ENDIF C *-------- Cas d'un CHARGEMENT (DEVA = TEMP, COVA = "nom composante") ELSE IF (TYPCHE(I2).EQ.'POINTEURCHARGEME') THEN C IF (ICAS.EQ.1) THEN NOMCHT = 'TEMP' ELSE IF (ICAS.EQ.2) THEN NOMCHT = NOMCHE(I2)(1:8) ENDIF C C On verifie si NOMCHT pas deja dans la liste : DO 40 IU=1,ITE1 IF( MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 41 40 CONTINUE ITE1 = ITE1+1 IF (ITE1.GT.JGM) THEN JGM = JGM + 20 SEGADJ MLMOT1 ENDIF MLMOT1.MOTS(ITE1) = NOMCHT 41 CONTINUE C *-------- le type de la composante du mchaml est incorrect ---------- ELSE MOTERR(1:8) = NOMCHE(I2)(1:8) CALL ERREUR(679) GOTO 9000 END IF 2 CONTINUE C SEGDES MCHAML 1 CONTINUE IF (ITE1.NE.JGM) THEN JGM = ITE1 SEGADJ MLMOT1 ENDIF 9000 CONTINUE IF (IERR.NE.0) THEN SEGSUP,MLMOT1 ILISR = 0 ELSE SEGDES,MLMOT1 ILISR = MLMOT1 ENDIF C SEGDES MCHELM RETURN END