C OPERMU SOURCE PASCAL 22/11/21 21:15:05 11502 SUBROUTINE OPERMU C_______________________________________________________________________ C C multiplie un champ par point par un objet rigidite. C multiplie un listreel par un flottant (ou un entier) C multiplie un listreel par un listreel terme a terme. C multiplie un objet rigidite par un flottant (ou 1 entier) C multiplie un champs par elemt par un flottant (ou 1 entier) C multiplie un champ par element par un autre champ par element C multiplie un champ par element par une evolution C multiplie un champ par point par un autre champ par point C multiplie un champ par point par un flottant (ou 1 entier) C multiplie un champ par point par une evolution C multiplie 2 nombres (flottant ou entier) C multiplie un point par un nombre C multiplie un objet evolutio (ordonnees) par un flottant C (ou un entier) C multiplie un objet evolutio par un objet evolutio C multiplie une table soustype vecteur par un reel C multiplie une table soustype LIAISONS_STATIQUES ou C BASE_DE_MODES par une rigidite C C passage aux nouveaux MCHAML par jm campenon le 29 10 90 C C_______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMLENTI -INC SMLREEL -INC SMTABLE -INC SMLMOTS PARAMETER (NCLEVO = 2) C CHARACTER*8 COMP CHARACTER*4 CLEVO(NCLEVO) INTEGER ICH1 INTEGER IOPERA INTEGER IARGU INTEGER I1 REAL*8 FLO INTEGER ICHR INTEGER IRET DATA CLEVO/'ABSC','ORDO'/ ICH1 = 0 IOPERA = 0 IARGU = 0 I1 = 0 FLO = 0.D0 ICHR = 0 IRET = 0 C_______________________________________________________________________ C C produit de deux CHPOINT C_______________________________________________________________________ C CALL LIROBJ('CHPOINT',ICHP1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 1 CALL ACTOBJ('CHPOINT ',ICHP1,1) CALL LIROBJ('CHPOINT',ICHP2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 1 ENDIF CALL ACTOBJ('CHPOINT ',ICHP2,1) CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETOU) IF ( IRETOU .EQ. 1) THEN CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU) IF (IERR .NE. 0) RETURN CALL LIROBJ('LISTMOTS',MLMOT3,1,IRETOU) IF (IERR .NE. 0) RETURN CALL LIROBJ('LISTREEL',MLREE1,0,IRETOU) IF (IERR .NE. 0) RETURN IF(IRETOU .EQ. 1)THEN SEGACT,MLREE1 ENDIF SEGACT,MLMOT1,MLMOT2,MLMOT3 CALL MUCHP1(ICHP1,ICHP2,MLMOT1,MLMOT2,MLMOT3,MLREE1,1,IRET) ELSE CALL MUPOSC(ICHP1,ICHP2,1,IRET) ENDIF IF (IERR .NE. 0) RETURN IF (IRET.NE.0) THEN CALL ACTOBJ('CHPOINT ',IRET,1) CALL ECROBJ('CHPOINT ',IRET) ENDIF RETURN C 1 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C multiplication de deux ENTIER C_______________________________________________________________________ C CALL LIRENT(IRE1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 2 CALL LIRENT(IRE2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 2 ENDIF C Cas du produit de 2 ENTIERS CALL ECRENT(IRE1*IRE2) RETURN C 2 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C multiplication de deux FLOTTANT C_______________________________________________________________________ C CALL LIRREE(FLO1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 3 CALL LIRREE(FLO2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 3 ENDIF CALL ECRREE(FLO1*FLO2) RETURN C 3 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'un FLOTTANT par un POINT C_______________________________________________________________________ C CALL LIRREE(FLO1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 4 CALL LIROBJ('POINT',IPT,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 4 ENDIF SEGACT MCOORD*MOD nbpts=nbpts+1 segadj mcoord DO ILDIM=1,IDIM+1 XCOOR((nbpts-1)*(idim+1)+ildim)= > XCOOR((IPT-1)*(IDIM+1)+ILDIM)*FLO1 ENDDO IRET=nbpts SEGACT MCOORD*NOMOD CALL ECROBJ('POINT',IRET) RETURN C 4 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'un CHPOINT par un FLOTTANT C_______________________________________________________________________ C CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 5 CALL LIROBJ('CHPOINT',ICH1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 5 ENDIF CALL ACTOBJ('CHPOINT ',ICH1,1) C IOPERA= 2 pour l'operation PRODUIT C IARGU = 2 pour FLOTTANT IOPERA= 2 IARGU = 2 I1 = 0 CALL OPCHP1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET) IF(IRET.NE.0) THEN CALL ACTOBJ('CHPOINT ',ICHR,1) CALL ECROBJ('CHPOINT ',ICHR) ELSE CALL ERREUR(26) ENDIF RETURN C 5 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'un MCHAML par un FLOTTANT C_______________________________________________________________________ C CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 6 CALL LIROBJ('MCHAML',ICH1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 6 ENDIF CALL ACTOBJ('MCHAML ',ICH1,1) C IOPERA= 2 pour l'operation PRODUIT C IARGU = 2 pour FLOTTANT IOPERA= 2 IARGU = 2 I1 = 0 ICHR = 0 IRET = 0 CALL ACTOBJ('MCHAML',ICH1,1) CALL OPCHE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET) IF(IRET.NE.0) THEN CALL ACTOBJ('MCHAML ',ICHR,1) CALL ECROBJ('MCHAML ',ICHR) ELSE CALL ERREUR(26) ENDIF RETURN C 6 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'une RIGIDITE par un FLOTTANT C_______________________________________________________________________ C CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 7 CALL LIROBJ('RIGIDITE',IRIG,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 7 ENDIF CALL MUFLRI(IRIG,FLO,IRET,1) IF (IRET.NE.0) CALL ECROBJ('RIGIDITE',IRET) RETURN C 7 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'un MATRIK par un FLOTTANT C_______________________________________________________________________ C CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 71 CALL LIROBJ('MATRIK ',IRIG,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 71 ENDIF CALL PRDMF(FLO,IRIG,IRET) IF (IRET.NE.0) CALL ECROBJ('MATRIK ',IRET) RETURN C 71 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'une RIGIDITE par un CHPOINT C_______________________________________________________________________ C CALL LIROBJ('CHPOINT',ICHP,0,IRETOU) IF (IRETOU.EQ.0) GOTO 8 CALL ACTOBJ('CHPOINT ',ICHP,1) CALL LIROBJ('RIGIDITE',IRIG,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 8 ENDIF CALL MUCPRI(ICHP,IRIG,ICHR) CALL ACTOBJ('CHPOINT ',ICHR,1) CALL ECROBJ('CHPOINT ',ICHR) RETURN C 8 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'un MATRIK par un CHPOINT C_______________________________________________________________________ C CALL LIROBJ('CHPOINT ',ICHP,0,IRETOU) IF (IRETOU.EQ.0) GOTO 9 CALL ACTOBJ('CHPOINT ',ICHP,1) CALL LIROBJ('MATRIK ',IRIG,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 9 ENDIF CALL PRDMCP(IRIG,ICHP,ICHR) CALL ACTOBJ('CHPOINT ',ICHR,1) CALL ECROBJ('CHPOINT ',ICHR) RETURN C 9 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit de deux MCHAML C_______________________________________________________________________ C CALL LIROBJ('MMODEL',IPMODL,0,IRETOU) IF (IRETOU.EQ.0) IPMODL=0 IF(IPMODL .NE. 0) CALL ACTOBJ('MMODEL ',IPMODL,1) CALL LIROBJ('MCHAML',ICHP1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 10 CALL ACTOBJ('MCHAML ',ICHP1,1) CALL LIROBJ('MCHAML',ICHP2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 10 ENDIF CALL ACTOBJ('MCHAML ',ICHP2,1) C LMOT1 = -1 LMOT2 = -1 LMOT3 = -1 ILREE = -1 CALL LIROBJ('LISTMOTS',LMOT1,0,IRETOU) IF ( IRETOU .EQ. 1) THEN CALL LIROBJ('LISTMOTS',LMOT2,1,IRETOU) IF (IERR .NE. 0) RETURN CALL LIROBJ('LISTMOTS',LMOT3,1,IRETOU) IF (IERR .NE. 0) RETURN CALL LIROBJ('LISTREEL',ILREE,0,IRETOU) IF (IERR .NE. 0) RETURN ENDIF C CALL MUCHSC(IPMODL,ICHP1,ICHP2,IPCHMU,LMOT1,LMOT2,LMOT3,ILREE,1) IF(IERR.NE.0) RETURN C IF (IPCHMU.NE.0) THEN CALL ACTOBJ('MCHAML ',IPCHMU,1) CALL ECROBJ('MCHAML ',IPCHMU) ELSE CALL ERREUR(26) ENDIF RETURN 10 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit ENTIER EVOLUTION C_______________________________________________________________________ C CALL LIRENT(I1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 101 CALL LIROBJ('EVOLUTIO',ICH1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 101 ENDIF CALL ACTOBJ('EVOLUTIO',ICH1,1) C IOPERA= 2 pour l'operation PRODUIT C IARGU = 1 pour ENTIER IOPERA= 2 IARGU = 1 FLO = 0.D0 ICLE = 0 CALL LIRMOT(CLEVO,NCLEVO,ICLE,0) IF (ICLE.EQ.0) ICLE = 2 CALL OPEVO1(ICH1,IOPERA,IARGU,ICLE,I1,FLO,ICHR,IRET) IF(IRET.NE.0) THEN CALL ACTOBJ('EVOLUTIO',ICHR,1) CALL ECROBJ('EVOLUTIO',ICHR) ELSE CALL ERREUR(26) ENDIF RETURN C 101 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit FLOTTANT EVOLUTION C_______________________________________________________________________ C CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 11 CALL LIROBJ('EVOLUTIO',ICH1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 11 ENDIF CALL ACTOBJ('EVOLUTIO',ICH1,1) C IOPERA= 2 pour l'operation PRODUIT C IARGU = 2 pour FLOTTANT IOPERA= 2 IARGU = 2 I1 = 0 ICLE = 0 CALL LIRMOT(CLEVO,NCLEVO,ICLE,0) IF (ICLE.EQ.0) ICLE = 2 CALL OPEVO1(ICH1,IOPERA,IARGU,ICLE,I1,FLO,ICHR,IRET) IF(IRET.NE.0) THEN CALL ACTOBJ('EVOLUTIO',ICHR,1) CALL ECROBJ('EVOLUTIO',ICHR) ELSE CALL ERREUR(26) ENDIF RETURN C 11 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit de deux EVOLUTIO C_______________________________________________________________________ C CALL LIROBJ('EVOLUTIO',IEVOL1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 12 CALL ACTOBJ('EVOLUTIO',IEVOL1,1) CALL LIROBJ('EVOLUTIO',IEVOL2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 12 ENDIF CALL ACTOBJ('EVOLUTIO',IEVOL2,1) CALL PUIS(IEVOL1,IEVOL2,ICHR,1) CALL ACTOBJ('EVOLUTIO',ICHR,1) CALL ECROBJ('EVOLUTIO',ICHR) RETURN C 12 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit FLOTTANT LISTREEL C_______________________________________________________________________ C CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 13 CALL LIROBJ('LISTREEL',ICH1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 13 ENDIF MLREEL=ICH1 SEGACT,MLREEL C IOPERA= 2 pour l'operation PRODUIT C IARGU = 2 pour FLOTTANT IOPERA= 2 IARGU = 2 I1 = 0 CALL OPLRE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET) IF(IRET.NE.0) THEN MLREEL=ICHR SEGACT,MLREEL*NOMOD CALL ECROBJ('LISTREEL',ICHR) ELSE CALL ERREUR(26) ENDIF RETURN C 13 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit CHPOINT EVOLUTION C_______________________________________________________________________ C CALL LIROBJ('CHPOINT ',ICHP,0,IRETOU) IF (IRETOU.EQ.0) GOTO 14 CALL ACTOBJ('CHPOINT ',ICHP,1) CALL LIROBJ('EVOLUTIO',IEVOL,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 14 ENDIF CALL ACTOBJ('EVOLUTIO',IEVOL,1) CALL VARCHP(ICHP,IEVOL,IRET,IRETOU) IF (IRETOU.NE.0) THEN CALL ACTOBJ('CHPOINT ',IRET,1) CALL ECROBJ('CHPOINT ',IRET) ENDIF RETURN C 14 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit MCHAML EVOLUTION C_______________________________________________________________________ C CALL LIROBJ('MCHAML ',IPCHP,0,IRETOU) IF (IRETOU.EQ.0) GOTO 15 CALL ACTOBJ('MCHAML ',IPCHP,1) CALL LIROBJ('EVOLUTIO',IEVOL,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 15 ENDIF CALL ACTOBJ('EVOLUTIO',IEVOL,1) CALL VARCHE(IPCHP,IEVOL,IPCHMU,IRETOU) C IF (IRETOU.NE.0) THEN CALL ACTOBJ('MCHAML ',IPCHMU,1) CALL ECROBJ('MCHAML ',IPCHMU) ENDIF RETURN C 15 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit LISTREEL LISTREEL C_______________________________________________________________________ C CALL LIROBJ('LISTREEL',ICH1,0,IRETOU) IF(IRETOU.EQ.0) GOTO 16 MLREEL=ICH1 SEGACT,MLREEL*NOMOD CALL LIROBJ('LISTREEL',ICHR,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 16 ENDIF MLREEL=ICHR SEGACT,MLREEL*NOMOD C IOPERA= 2 pour l'operation PRODUIT C IARGU = 0 IOPERA= 2 IARGU = 0 I1 = 0 FLO = 0.D0 CALL OPLRE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET) IF(IRET.NE.0) THEN MLREEL=ICHR SEGACT,MLREEL*NOMOD CALL ECROBJ('LISTREEL',ICHR) ELSE CALL ERREUR(26) ENDIF RETURN C 16 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit LISTENTI ENTIER C_______________________________________________________________________ C CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU) IF(IRETOU.EQ.0) GOTO 17 SEGACT,MLENT1 CALL LIRENT(IVA,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 17 ENDIF JG=MLENT1.LECT(/1) SEGINI,MLENTI DO 160 I=1,JG LECT(I)=MLENT1.LECT(I)*IVA 160 CONTINUE SEGACT,MLENTI*NOMOD CALL ECROBJ('LISTENTI',MLENTI) RETURN C 17 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit LISTENTI FLOTTANT C_______________________________________________________________________ C CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU) IF(IRETOU.EQ.0) GOTO 18 SEGACT,MLENT1 CALL LIRREE(XVA,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 18 ENDIF JG=MLENT1.LECT(/1) SEGINI,MLREEL DO 170 I=1,JG PROG(I)=REAL(MLENT1.LECT(I))*XVA 170 CONTINUE SEGACT,MLREEL*NOMOD CALL ECROBJ('LISTREEL',MLREEL) RETURN C 18 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit LISTENTI LISTENTI C_______________________________________________________________________ C CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU) IF(IRETOU.EQ.0) GOTO 19 SEGACT,MLENT1 CALL LIROBJ('LISTENTI',MLENT2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 19 ENDIF SEGACT,MLENT2 JG=MLENT2.LECT(/1) IF(MLENT1.LECT(/1).NE.JG) THEN CALL ERREUR (217) RETURN ENDIF SEGINI MLENTI DO 180 I=1,JG LECT(I)=MLENT1.LECT(I)*MLENT2.LECT(I) 180 CONTINUE SEGACT,MLENTI*NOMOD CALL ECROBJ('LISTENTI',MLENTI) RETURN C 19 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit TABLE-VECTEUR FLOTTANT C_______________________________________________________________________ C CALL LIRREE(FLO1,0,IRETOU) IF(IRETOU.EQ.0) GOTO 20 CALL LIRTAB('VECTEUR',MTAB1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 20 ENDIF SEGINI,MTABLE=MTAB1 DO 200 I=1,MLOTAB IF (MTABTV(I).EQ.'FLOTTANT') THEN RMTABV(I)=RMTABV(I)*FLO1 ELSE IF (MTABTV(I).EQ.'ENTIER ') THEN RMTABV(I)=REAL(MTABIV(I))*FLO1 MTABTV(I)='FLOTTANT' ENDIF 200 CONTINUE SEGDES,MTABLE,MTAB1 CALL ECROBJ('TABLE ',MTABLE) RETURN C 20 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit d'une RIGIDITE par un CHPOINT C_______________________________________________________________________ C CALL LIROBJ('LISTCHPO',ILCHP,0,IRETOU) IF (IRETOU.EQ.0) GOTO 21 CALL LIROBJ('RIGIDITE',IRIG,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 21 ENDIF CALL MUCPLI(ILCHP,IRIG,IRET) CALL ECROBJ('LISTCHPO',IRET) RETURN C 21 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit table-liaisons_statiques RIGIDITE C_______________________________________________________________________ C CALL LIRTAB('LIAISONS_STATIQUES',ITBST,0,IRETOU) IF(IRETOU.EQ.0) CALL LIRTAB('BASE_DE_MODES',ITBST,0,IRETOU) IF(IRETOU.EQ.0) GOTO 22 call lirobj('RIGIDITE',ir1,1,iretou) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 22 ENDIF call prmu(ir1,itbst) RETURN C 22 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit LISTREEL LISTENTI C_______________________________________________________________________ C CALL LIROBJ('LISTREEL',MLREE1,0,IRETOU) IF(IRETOU.EQ.0) GOTO 23 SEGACT,MLREE1 CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 23 ENDIF SEGACT,MLENT1 JG=MLENT1.LECT(/1) IF(MLREE1.PROG(/1).NE.JG) THEN CALL ERREUR (217) RETURN ENDIF SEGINI,MLREEL DO 220 I=1,JG PROG(I)=MLREE1.PROG(I)*REAL(MLENT1.LECT(I)) 220 CONTINUE SEGACT,MLREEL*NOMOD CALL ECROBJ('LISTREEL',MLREEL) RETURN 23 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit ENTIER NUAGE C_______________________________________________________________________ C CALL LIRENT(I1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 24 CALL LIROBJ('NUAGE ',ICH1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 24 ENDIF CALL ACTOBJ('NUAGE ',ICH1,1) IF (IERR.NE.0) RETURN C IOPERA= 2 pour l'operation PRODUIT C IARGU = 1 pour ENTIER IOPERA= 2 IARGU = 1 FLO = 0.D0 C Lecture du nom de la composante CALL LIRCHA(COMP,1,IRETOU) IF (IERR.NE.0) RETURN CALL OPNUA1(ICH1,IOPERA,IARGU,COMP,I1,FLO,ICHR,IRET) IF (IERR.NE.0) RETURN IF(IRET.NE.0) THEN CALL ACTOBJ('NUAGE ',ICHR,1) CALL ECROBJ('NUAGE ',ICHR) ELSE C ERREUR 5 car erreurs gerees dans OPNUA1 CALL ERREUR(5) ENDIF RETURN 24 CONTINUE IF (IERR .NE. 0) RETURN C_______________________________________________________________________ C C produit FLOTTANT NUAGE C_______________________________________________________________________ C CALL LIRREE(X1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 30 CALL LIROBJ('NUAGE ',ICH1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 30 ENDIF CALL ACTOBJ('NUAGE ',ICH1,1) IF (IERR.NE.0) RETURN C IOPERA= 2 pour l'operation PRODUIT C IARGU = 1 pour ENTIER IOPERA= 2 IARGU = 2 I1 = 0 C Lecture du nom de la composante CALL LIRCHA(COMP,1,IRETOU) IF (IERR.NE.0) RETURN CALL OPNUA1(ICH1,IOPERA,IARGU,COMP,I1,FLO,ICHR,IRET) IF (IERR.NE.0) RETURN IF(IRET.NE.0) THEN CALL ACTOBJ('NUAGE ',ICHR,1) CALL ECROBJ('NUAGE ',ICHR) ELSE C ERREUR 5 car erreurs gerees dans OPNUA1 CALL ERREUR(5) ENDIF RETURN C_______________________________________________________________________ C C ON A DONC RIEN TROUVE POUR FAIRE L OPERATION C_______________________________________________________________________ C 30 CONTINUE IF (IERR .NE. 0) RETURN CALL QUETYP(MOTERR(1:8),0,IRETOU) IF(IRETOU.NE.0) THEN CALL LIROBJ(MOTERR(1:8),IRET,1,IRETOU) CALL QUETYP(MOTERR(9:16),0,IRETOU) IF (IRETOU.EQ.0) MOTERR(9:16) = ' ???? ' CALL ERREUR(532) ELSE CALL ERREUR(533) ENDIF RETURN END