Télécharger part.eso

Retour à la liste

part
C PART      SOURCE    CB215821  19/07/31    21:15:52     10277          
************************************************************************
* NOM         : PART
* DESCRIPTION : Partitionne un maillage ou un modele
************************************************************************
* APPELE PAR : pilot.eso
************************************************************************
* ENTREES :: aucune
* SORTIES :: aucune
************************************************************************
* SYNTAXE (GIBIANE) :
*
*   TABL1 = PART ('NESC') | 'OPTI' MAIL1 (ENTI1) ;
*                         |
*                         | 'ARLE' | MAIL1 | ENTI1 ;
*                         |        | MODL1 |      
*                         |                
*                         | 'CONN' MAIL1 ;
*                         |                
*                         | 'SEPA' MAIL1 SEPA1 (SEPA2 ...) ;
*
*                               avec SEPAi = | 'FACE'                
*                                            | 'LIGN'                
*                                            | 'MAIL' MAIL2          
*                                            | 'ANGL' (FLOT2) ('TELQ')
*
************************************************************************
      SUBROUTINE PART
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC CCASSIS
 
      SEGMENT IPOS(0)
      SEGMENT ICPR(0)
      SEGMENT IADJ(0)
      SEGMENT JADJC(0)
 
      PARAMETER(NMOT1=5,NMOT2=4,NMOT3=1)
      CHARACTER*4 LMOT1(NMOT1),LMOT2(NMOT2),LMOT3(NMOT3)
      DATA LMOT1/'NESC','OPTI','ARLE','CONN','SEPA'/
      DATA LMOT2/'LIGN','FACE','MAIL','ANGL'/ 
      DATA LMOT3/'TELQ'/ 
 
 
*     +---------------------------------------------------------------+
*     |   L E C T U R E   D E S   A R G U M E N T S   C O M M U N S   |
*     +---------------------------------------------------------------+
 
*     LECTURE DU MOT-CLE PRINCIPAL (OU DU MOT-CLE 'ESCL' SI PRESENT)
*     ==============================================================
      KESCL=1
      KPRIN=0
      KQUOI=0
      DO 10 I=1,2
         CALL LIRMOT(LMOT1,NMOT1,IMOT1,0)
         IF (IMOT1.EQ.0) GOTO 20
         IF (IMOT1.EQ.1) THEN 
            KESCL=0
            GOTO 10
         ENDIF
         IF (KPRIN.GT.0) THEN
            MOTERR(1:16)='MOT     '//LMOT1(IMOT1)
            CALL ERREUR(11)
            RETURN
         ENDIF
         KPRIN=1
         KQUOI=IMOT1-1
 10   CONTINUE
 20   CONTINUE
      IF (KQUOI.EQ.0) THEN
         CALL ERREUR(498)
         RETURN
      ENDIF
 
*     LECTURE DE L'OBJET A PARTITIONNER
*     =================================
      CALL LIROBJ('MAILLAGE',MEL1,0,KMELEM)
      IF (KMELEM.EQ.0) THEN
         CALL LIROBJ('MMODEL  ',IPMODL,0,KMMODE)
         IF (KMMODE.EQ.0) THEN
            MOTERR(1:40)='MAILLAGEMODELE'
            CALL ERREUR(471)
            RETURN
         ENDIF
         CALL ACTOBJ('MMODEL  ',IPMODL,1)
      ENDIF
 
*     LECTURE DES PARAMETRES SPECIFIQUES DIRECTEMENT DANS LA SECTION
*     DEDIEE CI-DESSOUS
*     ==============================================================
      GOTO(100,200,300,400),KQUOI
 
 
 
*     +---------------------------------------------------------------+
*     |                   O P T I O N   ' O P T I '                   |
*     +---------------------------------------------------------------+
 
 100  CONTINUE
 
*     NOMBRE DE ZONES DANS LA PARTITION (CE DOIT ETRE UNE PUISSANCE
*     ENTIERE POSITIVE DE 2)
*     =============================================================
      CALL LIRENT(NBZONE,0,IRETOU)
      IF (IRETOU.NE.0) THEN
*        On verifie la validite de la valeur specifiee
         NBZON=MAX(1,NBZONE)
         NB=(LOG(FLOAT(NBZON))/LOG(2.))+1.E-6
         IF (2**NB.NE.NBZONE) THEN
            INTERR(1)=NBZONE
            CALL ERREUR(36)
            RETURN
         ENDIF
      ELSE
*        Par defaut, c'est celle qui est directement superieure au
*        nombre d'assistants
         NBZONE=MAX(1,NBESC)
         NB=(LOG(FLOAT(NBZONE))/LOG(2.))+1.E-6
         NBZONE=2**NB
      ENDIF
 
*     PARTITION D'UN MAILLAGE
*     =======================
      IF (KMELEM.NE.0) THEN
*        On reprend ce qui est fait dans la renumerotation en N-D
*        (Nested Dissection)
         CALL PART2(MEL1,IPOS,NB,ICPR,IADJ,JADJC)
*         WRITE(IOIMP,*) ' apres part2 ierr ',ierr
c          NODES=IPOS(/1)/3
         CALL PART4(MEL1,IPOS,ICPR,NB,ITAB,IADJ,JADJC,KESCL)
*         WRITE(IOIMP,*) ' apres part4 ierr ',ierr
 
*     PARTITION D'UN MODELE
*     =====================
      ELSE
         WRITE(IOIMP,*) 'MMODEL non implemente pour l''option OPTI'
         CALL ERREUR(251)
         RETURN      
 
      ENDIF
      GOTO 1000
 
 
*     +---------------------------------------------------------------+
*     |                   O P T I O N   ' A R L E '                   |
*     +---------------------------------------------------------------+
 
 200  CONTINUE
 
*     NOMBRE DE ZONES DANS LA PARTITION
*     =================================
      CALL LIRENT(NZO,1,IRETOU)
      IF (IERR.NE.0) RETURN
      IF (NZO.LT.1) THEN
         INTERR(1)=NZO
         CALL ERREUR(36)
         RETURN
      ENDIF
*      NBZONE=MAX(1,NBESC)
*      NZO=MIN(NZO,NBZONE)
 
*     PARTITION D'UN MAILLAGE
*     =======================
      IF (KMELEM.NE.0) THEN
         CALL PART5(MEL1,ITAB,NZO,KESCL)
 
*     PARTITION D'UN MODELE
*     =====================
      ELSE
         CALL PART6(NZO,IPMODL,ITAB,IRET,KESCL)
         IF (IRET.NE.0) RETURN
 
      ENDIF
      GOTO 1000
 
 
*     +---------------------------------------------------------------+
*     |                   O P T I O N   ' C O N N '                   |
*     +---------------------------------------------------------------+
 
 300  CONTINUE
 
*     PARTITION D'UN MAILLAGE
*     =======================
      IF (KMELEM.NE.0) THEN
         CALL PART7(MEL1,0,0,0,0,0,0.D0,0,ITAB,KESCL)
         IF (IERR.NE.0) RETURN
 
*     PARTITION D'UN MODELE
*     =====================
      ELSE
         WRITE(IOIMP,*) 'MMODEL non implemente pour l''option CONN'
         CALL ERREUR(251)
         RETURN      
      ENDIF
      GOTO 1000
 
 
*     +---------------------------------------------------------------+
*     |                   O P T I O N   ' S E P A '                   |
*     +---------------------------------------------------------------+
 
 400  CONTINUE
 
*     LECTURE D'UNE OU PLUSIEURS OPTIONS DE SEPARATION
*     ================================================
      KLI=0
      KFA=0
      KMA=0
      KAN=0
 
      MEL2=0
      CANGL=0.D0
 
 401  CONTINUE
      CALL LIRMOT(LMOT2,NMOT2,IMOT2,0)
      IF (IMOT2.EQ.0) GOTO 402
 
*     SEPARATEUR 'LIGN'
      IF (IMOT2.EQ.1) THEN
         KLI=1
 
*     SEPARATEUR 'FACE'
      ELSEIF (IMOT2.EQ.2) THEN
         KFA=1
 
*     SEPARATEUR 'MAIL'
      ELSEIF (IMOT2.EQ.3) THEN
         IF (KMA.EQ.1) THEN
            CALL ERREUR(717)
            RETURN
         ENDIF
         KMA=1
 
*        Lecture du maillage faisant office de separation
         CALL LIROBJ('MAILLAGE',MEL2,0,IRET)
         IF (IRET.EQ.0) THEN
            MOTERR(1:4)='MAIL'
            CALL ERREUR(166)
            RETURN
         ENDIF
 
*     SEPARATEUR 'ANGL'
      ELSEIF (IMOT2.EQ.4) THEN
         IF (KAN.EQ.1) THEN
            CALL ERREUR(717)
            RETURN
         ENDIF
         KAN=1
 
*        Lecture de l'angle seuil
         CALL LIRREE(XANGL,0,IRET)
         IF (IRET.EQ.0) XANGL=20.D0
         CANGL=COS(XANGL*XPI/180.D0)
 
*        Lecture du mot-cle 'TELQ' si present
         CALL LIRMOT(LMOT3,NMOT3,IMOT3,0)
 
      ENDIF
 
      GOTO 401
 
 402  CONTINUE
 
*     PARTITION D'UN MAILLAGE
*     =======================
      IF (KMELEM.NE.0) THEN
         CALL PART7(MEL1,KLI,KFA,KMA,MEL2,KAN,CANGL,IMOT3,ITAB,KESCL)
         IF (IERR.NE.0) RETURN
 
 
*     PARTITION D'UN MODELE
*     =====================
      ELSE
         WRITE(IOIMP,*) 'MMODEL non implemente pour l''option SEPA'
         CALL ERREUR(251)
         RETURN      
      ENDIF
      GOTO 1000
 
 
*     +---------------------------------------------------------------+
*     |            F I N   D E   L A   S U B R O U T I N E            |
*     +---------------------------------------------------------------+
 
 1000 CONTINUE
 
*      WRITE(IOIMP,*) ' avant ECROBJitab ierr ',itab,ierr
      CALL ECROBJ('TABLE',ITAB)
 
      END
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales