Télécharger la plaquette Cast3M


fr en

Télécharger fiquaf.eso

Retour à la liste

Numérotation des lignes : 

fiquaf

  1. C FIQUAF    SOURCE    GOUNAND   21/06/02    21:15:59     11022          
  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.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCGEOME
  35. -INC TNLIN      
  36. *-INC SIQUAF
  37.       POINTEUR MYQRFS.IQUAFS
  38.       POINTEUR QRCOUR.IQUAF
  39.       POINTEUR MYQRF.IQUAF
  40. *
  41.       INTEGER IMPR,IRET
  42. *
  43.       INTEGER MQSETA
  44.       INTEGER IQRFS,NQRFS
  45.       LOGICAL LFOUND
  46. *
  47. * Executable statements
  48. *
  49.       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans fiquaf'
  50.       LFOUND=.FALSE.
  51. * On veut laisser MYQRFS dans le même état (actif, inactif) qu'avant
  52. * l'appel à FIQUAF.
  53.       CALL OOOETA(MYQRFS,MQSETA,IMOD)
  54.       IF (MQSETA.NE.1) SEGACT MYQRFS
  55.       NQRFS=MYQRFS.LISQRF(/1)
  56.       IQRFS=0
  57. * Boucle 1 : repeat...until
  58.  1    CONTINUE
  59.       IQRFS=IQRFS+1
  60.       QRCOUR=MYQRFS.LISQRF(IQRFS)
  61.       SEGACT QRCOUR
  62.       IF (QRCOUR.NUMQUF.EQ.ITYQUF) THEN
  63.          LFOUND=.TRUE.
  64.       ENDIF
  65.       SEGDES QRCOUR
  66.       IF (.NOT.LFOUND.AND.IQRFS.LT.NQRFS) GOTO 1
  67.       IF (LFOUND) THEN
  68.          MYQRF=QRCOUR
  69.       ELSE
  70.          WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYQUF),
  71.      $        'dans les quafs de reference'
  72.          GOTO 9999
  73.       ENDIF
  74.       IF (MQSETA.NE.1) SEGDES MYQRFS
  75. *
  76. * Normal termination
  77. *
  78.       IRET=0
  79.       RETURN
  80. *
  81. * Format handling
  82. *
  83. *
  84. * Error handling
  85. *
  86.  9999 CONTINUE
  87.       IRET=1
  88.       WRITE(IOIMP,*) 'An error was detected in subroutine fiquaf'
  89.       RETURN
  90. *
  91. * End of subroutine fiquaf
  92. *
  93.       END
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  

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