Télécharger la plaquette Cast3M


fr en

Télécharger lirbas.eso

Retour à la liste

Numérotation des lignes : 

lirbas

  1. C LIRBAS    SOURCE    CHAT      05/01/13    01:20:37     5004
  2.       SUBROUTINE LIRBAS(ICOND,IRET1 ,IRET2 )
  3. C
  4. C     LECTURE D'UNE BASE ELEMENTAIRE
  5. C     ICOND LECTURE IMPERATIVE OU NON
  6. C     IRET1=MSOBAS     : POINTEURS DE LA BASE ELEMENTAIRE
  7. C     IRET2=MSOBAS     :
  8. C
  9.       IMPLICIT INTEGER(I-N)
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC SMBASEM
  14. -INC SMSTRUC
  15. C
  16.       IRET1=0
  17.       IRET2=0
  18.       CALL LIROBJ('BASEMODA',IP2,ICOND,IRETOU)
  19.       IF(IERR.NE.0) RETURN
  20.       IF(IRETOU.EQ.0) RETURN
  21.       MBASEM=IP2
  22.       SEGACT MBASEM
  23.       NBAS=LISBAS(/1)
  24.       MSOBAS=LISBAS(1)
  25.       IF(NBAS.EQ.1) GOTO 40
  26. C   BASE COMPLEXE
  27.       CALL LIROBJ('STRUCTUR',IRET,1,IRETOU)
  28.       IF(IERR.NE.0) GOTO 4000
  29.       MSTRUC=IRET
  30.       SEGACT MSTRUC
  31.       NSTRU=LISTRU(/1)
  32.       MSOSTU=LISTRU(1)
  33.       IF(NSTRU.EQ.1) GOTO 20
  34. C   STRUCTURE COMPLEXE
  35.       CALL LIRENT(IP3,1,IRETOU)
  36.       IF(IERR.NE.0) GOTO 3000
  37. C  ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES
  38.       SEGACT MSOSTU
  39.       ISRAI1=ISRAID
  40.       SEGDES MSOSTU
  41.       DO 10 NS=2,NSTRU
  42.       MSOSTU=LISTRU(NS)
  43.       SEGACT MSOSTU
  44.       IF(ISRAI1.NE.ISRAID) GOTO 2000
  45.       SEGDES MSOSTU
  46.   10  CONTINUE
  47.       IF(IP3.LE.0.OR.IP3.GT.NSTRU) GOTO 4000
  48.       MSOSTU=LISTRU(IP3)
  49.    20 CONTINUE
  50.       SEGDES MSTRUC
  51. C  ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE
  52.       DO 85 NB=1,NBAS
  53.       MSOBAS=LISBAS(NB)
  54.       SEGACT MSOBAS
  55.       IF(IBSTRM(1).EQ.MSOSTU) GOTO 35
  56.       SEGDES MSOBAS
  57.    85 CONTINUE
  58. C  *** INCOHERENCE ENTRE LA BASE ET LA STRUCTURE
  59.       GOTO 4000
  60.  2000 CONTINUE
  61.       SEGDES MSOSTU
  62.  3000 CONTINUE
  63.       SEGDES MSTRUC
  64.  4000 CALL ERREUR(216)
  65.       SEGDES MBASEM
  66.       GOTO 5000
  67. C
  68.    35 CONTINUE
  69.       SEGDES MSOBAS
  70.    40 CONTINUE
  71.       SEGDES MBASEM
  72.       IRET1=MSOBAS
  73.       IRET2=MBASEM
  74.  5000 CONTINUE
  75.       RETURN
  76.       END
  77.  
  78.  

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