C VIDE SOURCE JC220346 13/03/22 21:15:01 7739 ************************************************************************ * NOM : VIDE * DESCRIPTION : Crée des objets vides de types/sous-types donnés ************************************************************************ * HISTORIQUE : 13/03/2012 : JCARDO : création de l'opérateur * HISTORIQUE : 17/04/2012 : JCARDO : ajout de SMDEFOR et SMVECTE * HISTORIQUE : 12/10/2012 : JCARDO : ajout de SMCHARG ************************************************************************ * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES * en cas de modification de ce sous-programme afin de faciliter * la maintenance ! ************************************************************************ * APPELÉ PAR : pilot.eso ************************************************************************ * ENTRÉES :: aucune * SORTIES :: aucune ************************************************************************ * SYNTAXE (GIBIANE) : * * OBJ1,...,OBJn = VIDE [GROUPE1,...,GROUPEn] * * ou TAB1 = VIDE ('TABULER' ( |LENTI1| ) ) [GROUPE1,...,GROUPEn] * |LREEL1| * |LMOTS1| * * * avec GROUPEi de la forme : MOTAi(/MOTBi)(*ENTIi) * ************************************************************************ SUBROUTINE VIDE IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCGEOME -INC CCOPTIO -INC SMELEME -INC SMCHPOI -INC SMCHAML -INC SMMODEL -INC SMRIGID -INC SMEVOLL -INC SMLENTI -INC SMLREEL -INC SMLMOTS -INC SMLCHPO -INC SMTABLE -INC SMDEFOR -INC SMVECTE -INC SMCHARG CHARACTER*20 MARG CHARACTER*8 CHAI,TYIN,TYOB CHARACTER*4 CHAA CHARACTER*4 MSPE(2) DATA MSPE/'* ','/ '/ PARAMETER (LMTYP=14) CHARACTER*8 MTYP(LMTYP) DATA MTYP/'MAILLAGE', . 'CHPOINT ', . 'MCHAML ', . 'MMODEL ', . 'RIGIDITE', . 'EVOLUTIO', . 'LISTENTI', . 'LISTREEL', . 'LISTMOTS', . 'LISTCHPO', . 'TABLE ', . 'DEFORME ', . 'VECTEUR ', . 'CHARGEME'/ CHARACTER*4 MNAT(2) DATA MNAT/'DIFF','DISC'/ * On crée le segment IPSORT pour que l'ordre des objets en sortie * corresponde bien à celui des arguments en entrée (ordre inverse) * => MOINS UTILE POUR L'OPTION 'TABULER' (MAIS QUAND MÊME UTILISÉ) SEGMENT IPSORT INTEGER IPOOBJ(NOBJ) CHARACTER*8 MTYPOB(NOBJ) ENDSEGMENT * NOBJ = nombre d'objets vides créés au total par cette subroutine NOBJ=0 SEGINI IPSORT * ************************************************************** * DÉTERMINATION DU MODE D'ÉCRITURE EN SORTIE * ************************************************************** * * Deux possibilités pour sortir les résultats : * * - Option 'TABU' => les objets sont placés dans une table dont * les indices peuvent être choisis soit par * l'utilisateur, soit automatiquement * * ITAB | IRET | TYIN * ---------+----------------+--------------- * 1 | 0 | ENTIER * 2 | -> LISTENTI | ENTIER * 3 | -> LISTREEL | FLOTTANT * 4 | -> LISTMOTS | MOT * * - Par défaut => on sort les objets séparément * CALL LIRCHA(CHAA,1,LCHTA) * ============= * OPTION 'TABU' * ============= IF (CHAA.EQ.'TABU') THEN ITAB=1 TYIN='ENTIER ' * L'utilisateur a-t-il transmis une liste d'indices ? CHAI=' ' CALL LIRABJ(CHAI,IRET,0,IRETOU) IF (IRETOU.EQ.1) THEN * => OUI : objet LISTENTI, LISTREEL ou LISTMOTS IF (CHAI.EQ.'LISTENTI') THEN ITAB=2 TYIN='ENTIER ' MLENT1=IRET SEGACT MLENT1 ELSEIF (CHAI.EQ.'LISTREEL') THEN ITAB=3 TYIN='FLOTTANT' MLREE1=IRET SEGACT MLREE1 ELSEIF (CHAI.EQ.'LISTMOTS') THEN ITAB=4 TYIN='MOT ' MLMOT1=IRET SEGACT MLMOT1 * => NON : autres objets ELSEIF (CHAI.EQ.'MOT') THEN CALL REFUS ELSE C ERREUR CRITIQUE 39 (On ne veut pas d'objet de type %m1:8) MOTERR(1:8)=CHAI CALL ERREUR(39) WRITE(IOIMP,*) '(l''option TABU requiert ', & 'éventuellement un objet de type ', & 'LISTENTI, LISTREEL ou LISTMOTS)' ENDIF ENDIF * ================= * OPTION PAR DÉFAUT * ================= ELSE ITAB=0 * Le MOT qu'on a lu n'était pas censé être lu maintenant... CALL REFUS ENDIF * ************************************************************** * LECTURE DU TYPE D'OBJET VIDE À CRÉER * ************************************************************** * * On cherche des triplets de la forme ITYP[/MARG][*NLIR] * (l'ordre des options * et / est indifférent) * * - ITYP correspond au type d'objet à créer (position dans MTYP) * - MARG contient parfois le sous-type (par défaut = ' ') * - NLIR indique le nombre d'objets à créer (par défaut = 1) * NLIR=0 ICOD=1 * (ICOD permet d'obliger l'utilisateur à entrer au moins un MOT) 1 IF (NLIR.EQ.0) THEN * Lecture du type d'objet à créer. Si aucun => fin subroutine CALL LIRCHA(CHAI,ICOD,LCHAI) IF (LCHAI.EQ.0) GOTO 999 * On vérifie que ce type d'objet est prévu dans MTYP CALL OPTLI(ITYP,MTYP,CHAI,LMTYP) IF (ITYP.EQ.0) THEN C ERREUR CRITIQUE 9 (Objet inconnu %m1:8) MOTERR(1:8)=CHAI CALL ERREUR(9) WRITE(IOIMP,*) '(on ne sait pas créer ce type', & ' d''objet vide)' RETURN ENDIF * On a trouvé un MOT correct. NLIR=1 * On cherche les éventuels caractères * ou / IARG=0 MARG=' ' ISPA=0 DO 2 J=1,2 CALL LIRMOT(MSPE,2,ISPE,0) IF (ISPE.EQ.0) GOTO 2 * (Rmq: LIRMOT appelle REFUS si aucun mot ne correspond) IF (ISPA.EQ.ISPE) THEN C ERREUR CRITIQUE 880 (Syntaxe incorrecte, voir notice) CALL ERREUR(880) CHAI=MSPE(ISPE) WRITE(IOIMP,*) '(le caractère spécial ',CHAI(1:1), & ' apparait 2 fois)' RETURN ENDIF * Caractère * trouvé => mise à jour de NLIR IF (ISPE.EQ.1) CALL LIRENT(NLIR,1,IRET) * Caractère / trouvé => mise à jour de MARG IF (ISPE.EQ.2) THEN IARG=1 CALL LIRCHA(MARG,1,LMARG) ENDIF ISPA=ISPE 2 CONTINUE ENDIF * ************************************************************** * INITIALISATION D'UN SEGMENT VIDE POUR LE TYPE D'OBJET DÉSIRÉ * ************************************************************** GOTO (10,20,30,40,50,60,70,80,90,100,110,120,130,140),ITYP * =============================== * Objet MAILLAGE * =============================== * => MARG correspond au type d'élément (variable ITYPEL) 10 ITEL=ILCOUR IF (IARG.EQ.1) THEN CALL CHRMOT(NOMS,100,MARG(1:4),ITEL) IF (ITEL.EQ.0) THEN C ERREUR CRITIQUE 16 (Type d'élément incorrect) CALL ERREUR(16) WRITE(IOIMP,*) '(le nom ',MARG(1:4), & ' ne correspond à aucun élément connu)' RETURN ENDIF ENDIF NBELEM=0 NBSOUS=0 NBREF=0 NBNN=NBNNE(ITEL) IF (NOMS(ITEL).EQ.'POLY') THEN NBNN = 14 ELSE IF (NOMS(ITEL).EQ.'MULT') THEN NBNN = 9999 ENDIF SEGINI MELEME ITYPEL=ITEL IOBJ=MELEME SEGDES MELEME GOTO 900 * =============================== * Objet CHPOINT * =============================== * => MARG donne la nature du champ par points (variable JATTRI(1)) 20 NAT=1 NSOUPO=0 SEGINI MCHPOI IFOPOI=IFOMOD IJAT1=0 IF (IARG.EQ.1) THEN CALL CHRMOT(MNAT,2,MARG(1:4),IJAT1) IF (IJAT1.EQ.0) THEN C ERREUR CRITIQUE 881 (Syntaxe incorrecte : on attend %m1:30) MOTERR(1:30)='soit DISCRET, soit DIFFUS ' CALL ERREUR(881) WRITE(IOIMP,*) '(le mot ',MARG(1:LMARG),' ne désigne pas', & ' une nature valide)' RETURN ENDIF ENDIF JATTRI(1)=IJAT1 IOBJ=MCHPOI SEGDES MCHPOI GOTO 900 * =============================== * Objet MCHAML * =============================== * => MARG n'est pas utilisé 30 N1=0 N3=0 L1=8 SEGINI MCHELM IFOCHE=IFOMOD TITCHE=' ' IOBJ=MCHELM SEGDES MCHELM GOTO 900 * =============================== * Objet MMODEL * =============================== * => MARG n'est pas utilisé 40 N1=0 SEGINI MMODEL IOBJ=MMODEL SEGDES MMODEL GOTO 900 * =============================== * Objet RIGIDITE * =============================== * => MARG indique le type de matrice (variable MTYMAT) 50 NRIGEL=0 SEGINI MRIGID MTYMAT=MARG(1:8) IOBJ=MRIGID SEGDES MRIGID GOTO 900 * =============================== * Objet EVOLUTIO * =============================== * => MARG n'est pas utilisé 60 N=0 SEGINI MEVOLL IOBJ=MEVOLL SEGDES MEVOLL GOTO 900 * =============================== * Objet LISTENTI * =============================== * => MARG n'est pas utilisé 70 JG=0 SEGINI MLENTI IOBJ=MLENTI SEGDES MLENTI GOTO 900 * =============================== * Objet LISTREEL * =============================== * => MARG n'est pas utilisé 80 JG=0 SEGINI MLREEL IOBJ=MLREEL SEGDES MLREEL GOTO 900 * =============================== * Objet LISTMOTS * =============================== * => MARG n'est pas utilisé 90 JGN=4 JGM=0 SEGINI MLMOTS IOBJ=MLMOTS SEGDES MLMOTS GOTO 900 * =============================== * Objet LISTCHPO * =============================== * => MARG n'est pas utilisé 100 N1=0 SEGINI MLCHPO IOBJ=MLCHPO SEGDES MLCHPO GOTO 900 * =============================== * Objet TABLE * =============================== * => MARG donne le sous-type de la table (indice 'SOUSTYPE') 110 M=0 SEGINI MTABLE IF (IARG.EQ.1) THEN CALL ECCTAB(MTABLE,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0, & 'MOT',0,0.D0,MARG(1:8) ,.TRUE.,0) ENDIF IOBJ=MTABLE SEGDES MTABLE GOTO 900 * =============================== * Objet DEFORME * =============================== * => MARG n'est pas utilisé 120 NDEF=0 SEGINI MDEFOR IOBJ=MDEFOR SEGDES MDEFOR GOTO 900 * =============================== * Objet VECTEUR * =============================== * => MARG n'est pas utilisé 130 NVEC=0 ID=0 SEGINI MVECTE IOBJ=MVECTE SEGDES MVECTE GOTO 900 * =============================== * Objet CHARGEME * =============================== * => MARG n'est pas utilisé 140 N=0 SEGINI MCHARG IOBJ=MCHARG SEGDES MCHARG GOTO 900 * ************************************************************** * FIN DE LA CRÉATION D'UN OBJET * ************************************************************** 900 CONTINUE * S'il y avait plusieurs objets de même type à créer, en voilà un de moins NLIR=NLIR-1 * On mémorise son pointeur et son type dans le segment IPSORT NOBJ=NOBJ+1 SEGADJ IPSORT IPOOBJ(NOBJ)=IOBJ MTYPOB(NOBJ)=MTYP(ITYP) * On remonte là-haut pour voir s'il y a d'autres objets à créer * (cette fois, ce ne sera plus obligatoire) ICOD=0 GOTO 1 * ************************************************************** * FIN DE LA SUBROUTINE * ************************************************************** * * On écrit sur la sortie les objets stockés dans IPSORT : * - Option 'TABU' => les objets sont placés dans une table * - Par défaut => on sort les objets séparément * 999 CONTINUE * ============================================= * SORTIE SOUS FORME DE PLUSIEURS OBJETS SÉPARÉS * ============================================= IF (ITAB.EQ.0) THEN DO IA=1,NOBJ IB=NOBJ-IA+1 * (il faut inverser l'ordre pour ECROBJ) CALL ECROBJ(MTYPOB(IB),IPOOBJ(IB)) ENDDO * ===================================== * SORTIE SOUS FORME D'UNE TABLE INDICÉE * ===================================== * Si l'objet LISTENTI/LISTREEL/LISTMOTS définissant les indices à * utiliser est trop court, les indices manquants seront des entiers * correspondant à l'ordre de création de l'objet ELSE M=NOBJ SEGINI MTAB1 CHAI=' ' IVAL=0 XVAL=0.D0 LONGLI=NOBJ IF (ITAB.EQ.2) LONGLI=MLENT1.LECT(/1) IF (ITAB.EQ.3) LONGLI=MLREE1.PROG(/1) IF (ITAB.EQ.4) LONGLI=MLMOT1.MOTS(/2) DO IA=1,NOBJ IF (IA.GT.LONGLI) THEN * L'objet LIST**** est trop petit, on change de mode * d'indexation ITAB=1 TYIN='ENTIER ' ENDIF IF (ITAB.EQ.1) IVAL=IA IF (ITAB.EQ.2) IVAL=MLENT1.LECT(IA) IF (ITAB.EQ.3) XVAL=MLREE1.PROG(IA) IF (ITAB.EQ.4) CHAI(1:4)=MLMOT1.MOTS(IA) IPOO=IPOOBJ(IA) TYOB=MTYPOB(IA) CALL ECCTAB(MTAB1,TYIN,IVAL,XVAL,CHAI,.TRUE.,0, & TYOB,0 ,0.D0,' ' ,.TRUE.,IPOO) ENDDO CALL ECROBJ('TABLE',MTAB1) SEGDES MTAB1 ENDIF SEGSUP IPSORT RETURN END