Télécharger lirbas.eso

Retour à la liste

Numérotation des lignes :

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

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