prfuse
C PRFUSE SOURCE SP204843 24/10/08 21:15:06 12026 SUBROUTINE PRFUSE *============================================================= * * Interface entre la directive "ET" et le sous-programme "FUSE" * *============================================================= * * Modifications : * * PM 09/10/2007 : fusion de deux LISTCHPOs * PM 09/10/2007 : respect de l'ordre des opérandes * CB 23/01/2017 : ET entre un LISTMOT et un MOT * *============================================================= * * Remarques : * *============================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMTABLE -INC CCNOYAU -INC CCASSIS -INC SMELEME -INC SMLMOTS -INC CCGEOME -INC SMLREEL -INC SMLENTI -INC SMANNOT -INC SMLOBJE EXTERNAL LONG LOGICAL IR1,IR2,IR3,LTELQ CHARACTER*(8) CTYP,CTYP1,CTYP2,ICHAT,TYPRET,TYPRE1 CHARACTER*(LOCHAI) LEMOT,LEMOT1,LEMOT2 REAL*8 XVAL CHARACTER*4 LISTMO(1) DATA LISTMO / 'TELQ' / IP0 = 0 IP1 = 0 IP2 = 0 * Recherche préalable du mot-clef 'TELQUEL' éventuel IF (IERR.NE.0) RETURN LTELQ = (IRE2.EQ.1) * Lecture du premier objet * ------------------------ IF(IRETOU.EQ.0) THEN * Cet opérateur a encore besoin d'un opérande. RETURN ENDIF IF(CTYP.EQ.'LOGIQUE ') THEN IF(IERR.NE.0) RETURN GOTO 213 ELSE IF(CTYP.EQ.'MOT ') THEN IF (IERR.NE.0) RETURN IF(IRETOU.EQ.0) THEN * Cet opérateur a encore besoin d'un opérande. RETURN ENDIF IF(CTYP2 .EQ. 'LISTMOTS') THEN IF(IERR.NE.0) RETURN GOTO 222 ELSE IF( IERR.NE.0) RETURN IF (LTELQ) THEN * Concaténation avec respect des espaces avant et après ELSE * Suppressions des espaces en fin de mot ENDIF GOTO 225 ENDIF ELSE IF(CTYP.EQ.'FLOTTANT') THEN IF(IERR.NE.0) RETURN CTYP='LISTREEL' II=16 GOTO 24 ELSE IF(CTYP.EQ.'ENTIER ') THEN IF(IERR.NE.0) RETURN * suivant que l'objet suivant est un ENTIER/LISTENTI ou pas, * on considère cette entrée comme un FLOTTANT IF(IERR.NE.0) RETURN IF(CTYP.NE.'ENTIER '.AND.CTYP.NE.'LISTENTI') THEN XVAL1=FLOAT(IP1) IP1=0 CTYP='LISTREEL' II=16 ELSE CTYP='LISTENTI' II=17 ENDIF GOTO 24 ELSE MOTERR(1:8)=CTYP IF(CTYP.EQ.'POINT ') THEN II = 1 GOTO 24 ENDIF IF(CTYP.EQ.'MAILLAGE') THEN II = 2 GOTO 24 ENDIF IF(CTYP.EQ.'CHPOINT ') THEN II = 3 GOTO 24 ENDIF IF(CTYP.EQ.'MCHAML ') THEN II = 20 GOTO 24 ENDIF IF(CTYP.EQ.'RIGIDITE') THEN II = 4 GOTO 24 ENDIF IF(CTYP.EQ.'EVOLUTIO') THEN II = 18 GOTO 24 ENDIF IF(CTYP.EQ.'CHARGEME') THEN II = 15 GOTO 24 ENDIF IF(CTYP.EQ.'STRUCTUR') THEN II = 5 GOTO 24 ENDIF IF(CTYP.EQ.'SOLUTION') THEN II = 6 GOTO 24 ENDIF IF(CTYP.EQ.'ATTACHE ') THEN II = 7 GOTO 24 ENDIF IF(CTYP.EQ.'ELEMSTRU') THEN II = 10 GOTO 24 ENDIF IF(CTYP.EQ.'BLOQSTRU') THEN II = 11 GOTO 24 ENDIF IF(CTYP.EQ.'BASEMODA') THEN II = 12 GOTO 24 ENDIF IF(CTYP.EQ.'DEFORME ') THEN II = 13 GOTO 24 ENDIF IF(CTYP.EQ.'VECTEUR ') THEN II = 14 GOTO 24 ENDIF IF(CTYP.EQ.'LISTREEL') THEN II = 16 GOTO 24 ENDIF IF(CTYP.EQ.'LISTENTI') THEN II = 17 GOTO 24 ENDIF IF(CTYP.EQ.'MMODEL ') THEN II = 19 GOTO 24 ENDIF IF(CTYP.EQ.'LISTMOTS') THEN II = 21 GOTO 24 ENDIF IF(CTYP.EQ.'NUAGE ') THEN II = 22 GOTO 24 ENDIF IF(CTYP.EQ.'MATRIK') THEN II = 23 GOTO 24 ENDIF IF(CTYP.EQ.'LISTCHPO') THEN II = 24 GOTO 24 ENDIF IF(CTYP.EQ.'ANNOTATI') THEN II = 25 GOTO 24 ENDIF IF(CTYP.EQ.'LISTOBJE') THEN II = 26 GOTO 24 ENDIF IF(CTYP.EQ.'TABLE') THEN MTABLE = IP1 > 'MOT',ID3,RR1,LEMOT,IR1,ID2) IF (LEMOT.EQ.'LIAISONS_STATIQUES'.OR. > LEMOT.EQ.'BASE_MODALE') GOTO 2000 GOTO 1000 ENDIF GOTO 999 ENDIF * ================ * Première syntaxe * ================ * Lecture deuxième objet, lui aussi avec pointeur * ----------------------------------------------- 24 CONTINUE ICODE=1 * pour les fusions mixtes, on est encore indécis sur le type du * deuxième objet. IF(CTYP.EQ.'POINT '.OR.CTYP.EQ.'MAILLAGE'.OR. & CTYP.EQ.'LISTENTI'.OR.CTYP.EQ.'LISTREEL'.OR. & CTYP.EQ.'LISTMOTS'.OR. & CTYP.EQ.'CHPOINT '.OR.CTYP.EQ.'LISTCHPO'.OR. & CTYP.EQ.'LISTOBJE') ICODE=0 * on lit a priori un objet de même type que le premier * cas où on a un LISTOBJE uniquement, on fait la 2eme syntaxe IF (CTYP.EQ.'LISTOBJE'.AND.IRETOU.EQ.0) GOTO 1010 IF (CTYP.EQ.'LISTOBJE'.OR.CTYP2.EQ.'LISTOBJE') THEN IF(IERR.NE.0) RETURN II = 26 IF (CTYP.NE.'LISTOBJE') THEN IPX = IP2 IP2 = IP1 IP1 = IPX CTYP1 = CTYP2 CTYP2 = CTYP CTYP = CTYP1 ENDIF ELSE MOTERR(1:8)=CTYP IF(IERR.NE.0) RETURN ENDIF GOTO ( 1,2,3,4,205,206,207,999,999,210,211,212,214,215,216, $ 217,218,219,220,221,222,223,224,226,227,228),II *-- Création maillage 1 CONTINUE 2 CONTINUE IF (CTYP.NE.'POINT '.AND.CTYP.NE.'MAILLAGE') GOTO 999 IF(IRETOU.EQ.1.AND.CTYP.EQ.'POINT ') THEN * on a deux points ENDIF IF(IRETOU.EQ.0) THEN * on a lu des objets de types différents mais compatibles IF(CTYP.EQ.'MAILLAGE') THEN ENDIF IF(IERR.NE.0) RETURN ENDIF CTYP='MAILLAGE' GOTO 100 *-- Création CHPOINT 3 CONTINUE IF(IRETOU.EQ.1) THEN * La concaténation de deux champ-points donne un champ-point IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 IF (IRETOU.EQ.0) RETURN IF (IRETOU.NE.IP1.AND.IRETOU.NE.IP2) GOTO 100 ELSE *PM autrement, on peut obtenir une liste de chpoints GOTO 226 ENDIF *-- Création RIGIDITE 4 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création STRUCTURE 205 CONTINUE GOTO 100 *-- Création SOLUTION 206 CONTINUE GOTO 100 *-- Création ATTACHE 207 CONTINUE GOTO 100 *-- Création ELEMSTRU 210 CONTINUE GOTO 100 *-- Création BLOQSTRU 211 CONTINUE GOTO 100 *-- Création BASE MODALE 212 CONTINUE GOTO 100 *-- Opération LOGIQUE 213 CONTINUE IR3=IR1.AND.IR2 * lecture optionnelle d'autres logiques do i=1,1000 if(iretou.eq.0) goto 2130 ir3=ir3.and.ir2 enddo 2130 continue RETURN *-- Création DEFORMEE 214 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création VECTEUR 215 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création CHARGEMENT 216 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création LISTREEL 217 CONTINUE IF(IP1 .NE. 0)THEN C On a lu un LISTREEL en 1er argument IF(IRETOU.EQ.0) THEN C On n'a pas lu un LISTREEL en 2eme argument IF(IERR.NE.0) RETURN IF((CTYP.NE.'ENTIER ').AND.(CTYP.NE.'FLOTTANT')) GOTO 999 C On a lu des objets de types différents mais compatibles IF (CTYP.EQ.'ENTIER ') THEN XVAL2=FLOAT(IVAL2) ELSE ENDIF IF(IERR.NE.0) RETURN MLREE2=IP1 SEGACT,MLREE2 JG =JG1 + 1 SEGINI,MLREE1 IF(JG1 .GT. 0)THEN C Recopie en FORTRAN & JG1 ,JG1 ,JG1, & 1,0,0.D0,IRETOU) ENDIF ELSE C On a lu un LISTREEL en 2eme argument MLREE1=IRETOU ENDIF ELSE C On n'a pas lu un LISTREEL en 1er argument IF(IRETOU.EQ.0) THEN C On n'a pas lu un LISTREEL en 2eme argument IF(IERR.NE.0) RETURN IF((CTYP.NE.'ENTIER ').AND.(CTYP.NE.'FLOTTANT')) GOTO 999 C On a lu des objets de types différents mais compatibles IF (CTYP.EQ.'ENTIER ') THEN XVAL2=FLOAT(IVAL2) ELSE ENDIF IF(IERR.NE.0) RETURN JG=2 SEGINI,MLREE1 ELSE C On a lu un LISTREEL en 2eme argument MLREE2=IP2 SEGACT,MLREE2 JG =JG1 + 1 SEGINI,MLREE1 IF(JG1 .GT. 0) THEN C Recopie en FORTRAN & JG1 ,JG1 ,JG1, & 1,0,0.D0,IRETOU) ENDIF ENDIF ENDIF CTYP='LISTREEL' SEGACT,MLREE1*NOMOD IRETOU=MLREE1 GOTO 100 *-- Création LISTENTI 218 CONTINUE IF(IRETOU.EQ.0) THEN * on n'a pas lu un LISTENTI IF(IERR.NE.0) RETURN IF(CTYP.NE.'ENTIER ') GOTO 999 IF(IERR.NE.0) RETURN ENDIF CTYP='LISTENTI' IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création EVOLUTION 219 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création MODELE 220 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création MCHAML 221 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création LISTMOTS 222 CONTINUE IF (IP1 .GT. 0 .AND. IP2 .GT. 0) THEN C LISTMOTS 'ET' LISTMOTS ELSEIF(IP1 .GT. 0 .AND. IP2 .EQ. 0) THEN C LISTMOTS 'ET' MOT IF(CTYP2 .EQ. 'MOT') THEN IF (IERR.NE.0) RETURN MLMOT1=IP1 SEGACT,MLMOT1 SEGINI,MLMOT2 IRETOU=MLMOT2 DO III=1,JGM-1 ENDDO SEGDES,MLMOT1,MLMOT2 ELSE GOTO 999 ENDIF ELSEIF(IP1 .EQ. 0 .AND. IP2 .GT. 0) THEN C MOT 'ET' LISTMOTS IF(CTYP .EQ. 'MOT') THEN CTYP = CTYP2 MLMOT1=IP2 SEGACT,MLMOT1 SEGINI,MLMOT2 IRETOU=MLMOT2 DO III=2,JGM ENDDO SEGDES,MLMOT1,MLMOT2 ELSE GOTO 999 ENDIF ENDIF GOTO 100 *-- Création NUAGE 223 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création MATRIK 224 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création LISTCHPO 226 CONTINUE IF (CTYP.NE.'CHPOINT '.AND.CTYP.NE.'LISTCHPO') GOTO 999 IF(IRETOU.EQ.0) THEN * on a lu des objets de types différents mais compatibles * (le cas de 2 champ-points est traité ailleurs) IF(CTYP.EQ.'CHPOINT ') THEN ELSE ENDIF IF(IERR.NE.0) RETURN ENDIF CTYP='LISTCHPO' IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 GOTO 100 *-- Création ANNOTATI 227 CONTINUE IF(IP1.EQ.0 .OR. IP2.EQ.0) GOTO 999 MANNO1=IP1 MANNO2=IP2 SEGACT,MANNO1,MANNO2 NBANN1=MANNO1.ICLAS(/1) NBANN2=MANNO2.ICLAS(/1) NBANNO=NBANN1+NBANN2 SEGINI,MANNO3 DO K1=1,NBANN1 MANNO3.ICLAS(K1) = MANNO1.ICLAS(K1) MANNO3.ISEGT(K1) = MANNO1.ISEGT(K1) ENDDO DO K2=1,NBANN2 MANNO3.ICLAS(NBANN1+K2) = MANNO2.ICLAS(K2) MANNO3.ISEGT(NBANN1+K2) = MANNO2.ISEGT(K2) ENDDO IRETOU=MANNO3 GOTO 100 *-- Creation LISTOBJE 228 CONTINUE C On a forcément un LISTOBJE en premier argument IF (CTYP.NE.CTYP2) THEN C LISTOBJE ET "un autre objet" MLOBJ1 = IP1 SEGACT,MLOBJ1 CTYP1 = MLOBJ1.TYPOBJ NBOB1 = MLOBJ1.LISOBJ(/1) IF (CTYP1.NE.CTYP2.AND.NBOB1.NE.0) THEN CTYP = CTYP2 GOTO 999 ENDIF NOBJ = 1 SEGINI,MLOBJE TYPOBJ = CTYP2 LISOBJ(1) = IP2 IP2 = MLOBJE ENDIF IF (IERR.NE.0) RETURN GOTO 100 * Sortie sans problème, écriture résultat 100 CONTINUE RETURN * Fusion de chaines, limitation à 512 caractères 225 CONTINUE IRET=IRET1+IRET2 IF(IRET.GT.512) THEN RETURN ENDIF LEMOT(1:IRET1) = LEMOT1(1:IRET1) LEMOT(IRET1+1:IRET) = LEMOT2(1:IRET2) RETURN * ================ * Deuxième syntaxe * ================ * Fusion de tous les indices d'une table 1000 CONTINUE MTABLE=IP1 IF (IRETOU.EQ.1) THEN * ET DE TABLES ESCLAVE * WRITE(IOIMP,*) ' TABLE ESCLAVE DANS ET' * IF (LODESL) THEN * WRITE(IOIMP,*) ' LODESL REMIS À FAUX DANS PRFUSE ' * LODESL=.FALSE. * CALL ABORT * ENDIF > 'MOT',ID3,RR1,CTYP,IR1,ID2) IF (CTYP.NE.'ESCLAVE') THEN * Donnez une TABLE de sous-type %m1:8 MOTERR(1:8)='ESCLAVE' * Le sous-type de la table est incorrect RETURN ENDIF SEGACT MTABLE ML=MLOTAB * L'INDICE 1 EST LE SOUSTYPE, l'INDICE 2 EST LE CREATEUR IND=MTABII(3) CTYP=' ' > CTYP,ID3,RR1,TYPRET,IR1,ID1) IRETOU=ID1 IF (CTYP.EQ.'POINT') THEN NBNN=1 NBSOUS=0 NBREF=0 NBELEM=ML-2 SEGINI MELEME ITYPEL=1 NUM(1,1)=ID1 ICOLOR(1)=IDCOUL DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN NUM(1,I-2)=ID2 ICOLOR(I-2)=IDCOUL ENDDO IRETOU=MELEME CTYP='MAILLAGE' ELSEIF (CTYP.EQ.'FLOTTANT') THEN JG=ML-2 SEGINI,MLREE1 DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN ENDDO IRETOU= MLREE1 CTYP ='LISTREEL' ELSEIF (CTYP.EQ.'ENTIER') THEN JG=ML-2 SEGINI,MLENT1 MLENT1.LECT(1)=ID3 DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN MLENT1.LECT(I-2)=ID3 ENDDO IRETOU= MLENT1 CTYP ='LISTENTI' ELSEIF (CTYP.EQ.'MAILLAGE') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'MCHAML') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'CHPOINT ') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'RIGIDITE') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'MATRIK ') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'MMODEL') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'LISTREEL') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'LISTENTI') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'EVOLUTIO') THEN DO I=4,ML IND=MTABII(I) > CTYP,ID3,RR1,' ',IR1,ID2) IF (IERR.NE.0) RETURN IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSE * On ne veut pas d'objet de type %m1:8 MOTERR(1:8)=CTYP RETURN ENDIF SEGDES,MTABLE GOTO 100 ENDIF * Fusion de tous les indices d'un LISTOBJE (copié sur les TABLES) 1010 CONTINUE MLOBJE=IP1 SEGACT MLOBJE CTYP=' ' CTYP=TYPOBJ ML=LISOBJ(/1) ID1=LISOBJ(1) IF (CTYP.EQ.'POINT') THEN NBNN=1 NBSOUS=0 NBREF=0 NBELEM=ML SEGINI MELEME ITYPEL=1 DO I=1,ML NUM(1,I)=LISOBJ(I) ICOLOR(I)=IDCOUL ENDDO IRETOU=MELEME CTYP='MAILLAGE' ELSEIF (CTYP.EQ.'ENTIER') THEN JG=ML SEGINI,MLENT1 DO I=1,ML MLENT1.LECT(I)=LISOBJ(I) ENDDO IRETOU= MLENT1 CTYP ='LISTENTI' ELSEIF (CTYP.EQ.'MAILLAGE') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'MCHAML') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'CHPOINT ') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'RIGIDITE') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'MATRIK ') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'MMODEL') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'LISTREEL') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'LISTENTI') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSEIF (CTYP.EQ.'EVOLUTIO') THEN DO I=2,ML ID2=LISOBJ(I) IF (IERR.NE.0) RETURN ID1=IRETOU ENDDO ELSE * On ne veut pas d'objet de type %m1:8 MOTERR(1:8)=CTYP RETURN ENDIF GOTO 100 * ================= * Troisième syntaxe * ================= * FUSION TABLE DE MODES 2000 CONTINUE IPOUT = IPTAB2 IL = 0 IF (LEMOT.EQ.'LIAISONS_STATIQUES') THEN & 'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,IP1) ELSE & 'MOT',0,0.0D0,'BASE_MODALE',.TRUE.,IP1) & 'TABLE',0,0.0D0,' ',.TRUE.,IPTAB3) IPTAB2 = IPTAB3 & 'MOT',0,0.0D0,'BASE_DE_MODES',.TRUE.,IP1) & 'MOT',0,0.0D0,'MAILLAGE',.TRUE.,IP1) cbp : plutot qu'ecrire le mot MAILLAGE(???), on fusionne les 2 maillages > 'TABLE',ID3,RR1,' ',.TRUE.,IP1) IF (IERR.NE.0) RETURN MTABLE = IP1 > 'MAILLAGE',ID3,RR1,' ',.TRUE.,IPT1) IF (IERR.NE.0) RETURN ENDIF c ---copie de la IKO ieme table (IKO=1,2) IKO = 0 2100 IKO = IKO + 1 SEGACT MTABLE c ---boucle sur les modes ou les solutions statiques IF (LEMOT.EQ.'LIAISONS_STATIQUES') THEN IMA = MLOTAB - 1 ELSE IMA = MLOTAB - 2 ENDIF IM = 0 2160 IM = IM + 1 CTYP=' ' c > 'TABLE',ID3,RR1,' ',.TRUE.,ITMOD) > CTYP,ID3,RR1,' ',.TRUE.,ITMOD) IF(CTYP.NE.'TABLE') GOTO 2161 IF (ITMOD.GT.0) THEN IL = IL + 1 & 'TABLE',0,0.0D0,' ',.TRUE.,ITMOD) ENDIF 2161 CONTINUE IF (IM.LT.IMA) GOTO 2160 c ---fin de boucle sur les modes ou les solutions statiques SEGDES MTABLE IF (IKO.EQ.1) THEN IF (LEMOT.EQ.'LIAISONS_STATIQUES') THEN IF (IRETOU.EQ.0) GOTO 2300 MTABLE = IP1 ELSE IF (IRETOU.EQ.0) GOTO 2300 > 'TABLE',ID3,RR1,' ',.TRUE.,MTABLE) c fusion des 2 maillages > 'MAILLAGE',ID3,RR1,' ',.TRUE.,IPT2) * A qoi sert cet appel a uniq? ** iordre=0 ** CALL UNIQMA(IPT3,NBDIF,iordre) & 'MAILLAGE',0,0.0D0,' ',.TRUE.,IPT3) ENDIF GOTO 2100 ENDIF c ---fin de boucle sur les tables IKO=1,2 RETURN * ========= * ERREUR 39 * ========= 999 CONTINUE * On ne veut pas d'objet de type %m1:8 MOTERR(1:8)=CTYP END
© Cast3M 2003 - Tous droits réservés.
Mentions légales