Télécharger fiquaf.eso

Retour à la liste

Numérotation des lignes :

  1. C FIQUAF SOURCE BP208322 16/11/18 21:17:16 9177
  2. SUBROUTINE FIQUAF(ITYQUF,MYQRFS,
  3. $ MYQRF,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : FIQUAF
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Cherche un QUAF par son nunméro.
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES : OOOETA (état d'un segment)
  17. C APPELE PAR : EXTFAC
  18. C***********************************************************************
  19. C ENTREES :
  20. C
  21. C SORTIES :
  22. C***********************************************************************
  23. C VERSION : v1, 17/12/02, version initiale
  24. C HISTORIQUE : v1, 17/12/02, création
  25. C HISTORIQUE :
  26. C***********************************************************************
  27. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  28. C en cas de modification de ce sous-programme afin de faciliter
  29. C la maintenance !
  30. C***********************************************************************
  31. -INC CCOPTIO
  32. -INC CCGEOME
  33. CBEGININCLUDE SIQUAF
  34. SEGMENT IQUAF
  35. INTEGER NUMQUF
  36. REAL*8 XCONQR(NDIMQR,NBNOQR)
  37. INTEGER NUCENT
  38. POINTEUR LFACE.MELEME
  39. ENDSEGMENT
  40. SEGMENT IQUAFS
  41. POINTEUR LISQRF(NBQRF).IQUAF
  42. ENDSEGMENT
  43. CENDINCLUDE SIQUAF
  44. POINTEUR MYQRFS.IQUAFS
  45. POINTEUR QRCOUR.IQUAF
  46. POINTEUR MYQRF.IQUAF
  47. *
  48. INTEGER IMPR,IRET
  49. *
  50. INTEGER MQSETA
  51. INTEGER IQRFS,NQRFS
  52. LOGICAL LFOUND
  53. *
  54. * Executable statements
  55. *
  56. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans fiquaf'
  57. LFOUND=.FALSE.
  58. * On veut laisser MYQRFS dans le même état (actif, inactif) qu'avant
  59. * l'appel à FIQUAF.
  60. CALL OOOETA(MYQRFS,MQSETA)
  61. IF (MQSETA.NE.1) SEGACT MYQRFS
  62. NQRFS=MYQRFS.LISQRF(/1)
  63. IQRFS=0
  64. * Boucle 1 : repeat...until
  65. 1 CONTINUE
  66. IQRFS=IQRFS+1
  67. QRCOUR=MYQRFS.LISQRF(IQRFS)
  68. SEGACT QRCOUR
  69. IF (QRCOUR.NUMQUF.EQ.ITYQUF) THEN
  70. LFOUND=.TRUE.
  71. ENDIF
  72. SEGDES QRCOUR
  73. IF (.NOT.LFOUND.AND.IQRFS.LT.NQRFS) GOTO 1
  74. IF (LFOUND) THEN
  75. MYQRF=QRCOUR
  76. ELSE
  77. WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYQUF),
  78. $ 'dans les quafs de reference'
  79. GOTO 9999
  80. ENDIF
  81. IF (MQSETA.NE.1) SEGDES MYQRFS
  82. *
  83. * Normal termination
  84. *
  85. IRET=0
  86. RETURN
  87. *
  88. * Format handling
  89. *
  90. *
  91. * Error handling
  92. *
  93. 9999 CONTINUE
  94. IRET=1
  95. WRITE(IOIMP,*) 'An error was detected in subroutine fiquaf'
  96. RETURN
  97. *
  98. * End of subroutine fiquaf
  99. *
  100. END
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  

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