C LICHTM SOURCE CB215821 20/11/25 13:33:41 10792 SUBROUTINE LICHTM(MCHPOI,MPOVAL,TYPE,IGEOM) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C************************************************************************* C C Ce SP active le segment MPOVAL en lecture/ecriture connaissant le C pointeur MCHPOI d'un CHPOINT et renvoie aussi le pointeur IGEOC (non actif) C MSOUPO a lui aussi ete desactivé C C*********************************************************************** C HISTORIQUE : 26/10/98 : prise en compte du cas particulier C où MCHPOI est vide (NSOUPO=0 ou MCHPOI=0), C on renvoie alors C MPOVAL=0 et IGEOM=0 sans messages d'erreur... C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO -INC SMCHPOI CHARACTER*8 TYPE IF (MCHPOI.NE.0) THEN SEGACT MCHPOI TYPE=MTYPOI NSOUPO=IPCHP(/1) IF(NSOUPO.EQ.0) THEN IGEOM=0 MPOVAL=0 ELSEIF(NSOUPO.EQ.1) THEN MSOUPO=IPCHP(1) SEGACT MSOUPO IGEOM=IGEOC MPOVAL=IPOVAL SEGDES MSOUPO SEGACT MPOVAL*MOD ELSE * WRITE(IOIMP,*) ' Le chpoint MCHPOI=',MCHPOI * $ ,'est partitionné..' * WRITE(IOIMP,*) ' NSOUPO=',NSOUPO IGEOM=0 MPOVAL=0 * GOTO 9999 ENDIF SEGDES MCHPOI ELSE MPOVAL=0 TYPE=' ' IGEOM=0 ENDIF * * Normal termination * RETURN * * Error handling * 9999 CONTINUE WRITE(IOIMP,*) 'An error was detected in subroutine licht' RETURN END