1 : C LICHT SOURCE GOUNAND 05/06/07 21:15:09 5076 2 : SUBROUTINE LICHT(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 connaissant le pointeur MCHPOI 8 : C 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 : -INC CCOPTIO 24 : -INC SMCHPOI 25 : CHARACTER*8 TYPE 26 : IF (MCHPOI.NE.0) THEN 27 : SEGACT MCHPOI 28 : TYPE=MTYPOI 29 : NSOUPO=IPCHP(/1) 30 : IF(NSOUPO.EQ.0) THEN 31 : IGEOM=0 32 : MPOVAL=0 33 : ELSEIF(NSOUPO.EQ.1) THEN 34 : MSOUPO=IPCHP(1) 35 : SEGACT MSOUPO 36 : IGEOM=IGEOC 37 : MPOVAL=IPOVAL 38 : SEGDES MSOUPO 39 : SEGACT MPOVAL*MOD 40 : ELSE 41 : * WRITE(IOIMP,*) ' Le chpoint MCHPOI=',MCHPOI 42 : * $ ,'est partitionné..' 43 : * WRITE(IOIMP,*) ' NSOUPO=',NSOUPO 44 : IGEOM=0 45 : MPOVAL=0 46 : * GOTO 9999 47 : ENDIF 48 : SEGDES MCHPOI 49 : ELSE 50 : MPOVAL=0 51 : TYPE=' ' 52 : IGEOM=0 53 : ENDIF 54 : * 55 : * Normal termination 56 : * 57 : RETURN 58 : * 59 : * Error handling 60 : * 61 : 9999 CONTINUE 62 : WRITE(IOIMP,*) 'An error was detected in subroutine licht' 63 : RETURN 64 : END 65 : 66 : 67 : 68 : 69 :
© Cast3M 2003 - All rights reserved.
Disclaimer