Télécharger la plaquette Cast3M


fr en

Télécharger lichtl.eso

Retour à la liste

Numérotation des lignes : 

lichtl

  1. C LICHTL    SOURCE    CB215821  20/11/25    13:33:40     10792          
  2.       SUBROUTINE LICHTL(MCHPOI,MPOVAL,TYPE,IGEOM)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C
  7. C Ce SP active le segment MPOVAL en lecture seule connaissant le pointeur
  8. C MCHPOI d'un CHPOINT et renvoie aussi le pointeur IGEOC (non actif)
  9. C MSOUPO a lui aussi ete desactivé
  10. C
  11. C***********************************************************************
  12. C HISTORIQUE : 26/10/98 : prise en compte du cas particulier
  13. C              où MCHPOI est vide (NSOUPO=0 ou MCHPOI=0),
  14. C              on renvoie alors
  15. C              MPOVAL=0 et IGEOM=0 sans messages d'erreur...
  16. C HISTORIQUE :
  17. C HISTORIQUE :
  18. C***********************************************************************
  19. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  20. C en cas de modification de ce sous-programme afin de faciliter
  21. C la maintenance !
  22. C***********************************************************************
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCHPOI
  27.       CHARACTER*8 TYPE
  28.       IF (MCHPOI.NE.0) THEN
  29.          SEGACT MCHPOI
  30.          TYPE=MTYPOI
  31.          NSOUPO=IPCHP(/1)
  32.          IF(NSOUPO.EQ.0) THEN
  33.             IGEOM=0
  34.             MPOVAL=0
  35.          ELSEIF(NSOUPO.EQ.1) THEN
  36.             MSOUPO=IPCHP(1)
  37.             SEGACT MSOUPO
  38.             IGEOM=IGEOC
  39.             MPOVAL=IPOVAL
  40.             SEGDES MSOUPO
  41.             SEGACT MPOVAL
  42.          ELSE
  43. *            WRITE(IOIMP,*) ' Le chpoint MCHPOI=',MCHPOI
  44. *     $           ,'est partitionné..'
  45. *            WRITE(IOIMP,*) ' NSOUPO=',NSOUPO
  46.             IGEOM=0
  47.             MPOVAL=0
  48. *            GOTO 9999
  49.          ENDIF
  50.          SEGDES MCHPOI
  51.       ELSE
  52.          MPOVAL=0
  53.          TYPE='        '
  54.          IGEOM=0
  55.       ENDIF
  56. *
  57. * Normal termination
  58. *
  59.       RETURN
  60. *
  61. * Error handling
  62. *
  63.  9999 CONTINUE
  64.       WRITE(IOIMP,*) 'An error was detected in subroutine licht'
  65.       RETURN
  66.       END
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  

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