Télécharger manuel.eso

Retour à la liste

manuel
C MANUEL    SOURCE    OF166741  23/06/30    21:15:06     11696          
      SUBROUTINE MANUEL
C
C   FABRICATION MANUELLE D OBJETS DIVERS ET VARIES
C   DE TYPE ELEMENT,CHAMPOIN,SOLUTION, RIGIDITE, CHAMELEM
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
 
-INC SMELEME
      SEGMENT MTRT
         INTEGER MTT(NTT)
      ENDSEGMENT
 
      PARAMETER (LMOOPT=6)
      CHARACTER*4 MOOPT(LMOOPT)
      DATA MOOPT/'CHPO','MODE','RIGI','CHAM','CHML','OBJE'/
 
      CALL LIRMOT(NOMS,NOMBR,I,0)
      IF (I.NE.0) GOTO 2
 
      CALL LIRMOT(MOOPT,LMOOPT,IMOT,1)
      IF (IERR.NE.0) RETURN
      GO TO (100,200,300,500,600,700),IMOT
      CALL ERREUR(21)
      RETURN
 
 100  CALL MANUCH
      GO TO 30
 200  CALL MANUMO
      GO TO 30
 300  CALL MANURI
      GO TO 30
 500  CALL MAMANU
      GO TO 30
 600  CALL MANUC5
      GO TO 30
 700  CALL MANUOB
      GO TO 30
c
c==== Cas des Objets MAILLAGES ====================================
   2  CONTINUE
      ITYP=I
      CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0)
      IF (ICOUL.EQ.0) ICOUL=IDCOUL+1
      ICOUL=ICOUL-1
      NBSOUS=0
      NBREF=0
      NBELEM=1
c---- SUPERELEMENT ---------------
      IF(NOMS(ITYP).EQ.'SUPE') THEN
         CALL LIROBJ('MAILLAGE',IPT1,0,IRETOU)
         IF (IRETOU.EQ.0) GO TO 25
         SEGACT IPT1
         IF(IPT1.ITYPEL.NE.1) THEN
            CALL CHANGE (IPT1,1)
            IF (IERR.NE.0) RETURN
            SEGACT IPT1
         ENDIF
         NBNN = IPT1.NUM(/2)
         SEGINI MELEME
         ICOLOR(1)=ICOUL
         ITYPEL=ITYP
         DO I=1,NBNN
           NUM(I,1)=IPT1.NUM(1,I)
         ENDDO
         GO TO 11
   25    NTT=50
         SEGINI MTRT
         NBNN=0
   28    CONTINUE
         CALL LIROBJ('POINT   ',IP,0,IRETOU)
         IF(IRETOU.EQ.0)GO TO 29
         NBNN=NBNN + 1
         IF(NBNN.GT.NTT) THEN
            NTT=NTT+50
            SEGADJ MTRT
         ENDIF
         MTT(NBNN) = IP
         GO TO 28
   29    CONTINUE
         SEGINI MELEME
         ICOLOR(1)=ICOUL
         ITYPEL=ITYP
         DO I=1,NBNN
           NUM(I,1)=MTT(I)
         ENDDO
         SEGSUP MTRT
c---- AUTRE TYPE D'ELEMENTS ---------------
      ELSE
         NBNN=NBNNE(ITYP)
c        dans le cas POLYgone et MULtiplicateur le nbre de noeuds par
c        element est indefini d'ou la lecture facultative des points
         IF (NOMS(ITYP).EQ.'POLY') THEN
           NBNN = 14
           IDOBL = 0
         ELSE IF (NOMS(ITYP).EQ.'MULT') THEN
           NBNN = 9999
           IDOBL = 0
         ELSE
           IDOBL = 1
         ENDIF
         SEGINI MELEME
         ICOLOR(1)=ICOUL
         ITYPEL=ITYP
C SG On ajoute la possibilite de generer un element a partir
C des premiers points d'un maillage de 'POI1'
         CALL LIROBJ('MAILLAGE',IPT1,0,IRETOU)
         IF (IERR.NE.0) RETURN
         IF (IRETOU.NE.0) THEN
            SEGACT IPT1
            IF(IPT1.ITYPEL.NE.1) THEN
               CALL CHANGE(IPT1,1)
               IF (IERR.NE.0) RETURN
               SEGACT IPT1
            ENDIF
            NBNN1=IPT1.NUM(/2)
            IF (NBNN1.EQ.0) THEN
               NBELEM=0
               SEGADJ MELEME
               GOTO 11
            ENDIF
            IF (IDOBL.EQ.0) NBNN=NBNN1
            SEGINI MELEME
            ICOLOR(1)=ICOUL
            ITYPEL=ITYP
            DO I=1,NBNN
               NUM(I,1)=IPT1.NUM(1,(MOD(I-1,NBNN1))+1)
            ENDDO
         ELSE
            DO I=1,NBNN
c          on donne ici la possibilite de creer un meleme avec 0 element
               IF(I.EQ.1) THEN
                  CALL LIROBJ('POINT   ',IP,0,IRETOU)
               ELSE
                  CALL LIROBJ('POINT   ',IP,IDOBL,IRETOU)
               ENDIF
               IF (IRETOU.NE.1) THEN
                  IF (I.EQ.1) THEN
                     NBELEM = 0
                     SEGADJ MELEME
                     if(iimpi.ge.1) write(ioimp,*
     $                    )'MAILLAGE DE 0 ELEMENT CREE'
                  ENDIF
                  IF (IDOBL.EQ.0) THEN
C              CAS DU POLYGONE ou du MULT
                     NBNN = I-1
                     SEGADJ MELEME
                  ENDIF
                  GOTO 11
               ENDIF
               NUM(I,1)=IP
            ENDDO
         ENDIF
      ENDIF
  11  CONTINUE
      IF (IERR.NE.0) THEN
        SEGSUP MELEME
      ELSE
        CALL ECROBJ('MAILLAGE',MELEME)
        SEGDES MELEME
      ENDIF
 
 30   CONTINUE
c      RETURN
      END
 
 
 

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