Sources Esope | Cast3M

ooodms
C OOODMS    SOURCE    PV090527  26/04/24    08:23:05     12524          
      SUBROUTINE OOODMS (IDE,N)
C-------------------------------------------------------------------
C
C                          DUMP D'UN SEGMENT
C
C     IDE    POINTEUR SUR LE SEGMENT A DUMPER
C
C     SI N NEGATIF ON CHANGE DE REGION DE DUMP
C
C*       DUMP EN HEXA DES SEGMENTS A CHAQUE ACTIVATION/DESACTIVATION
C*         LA PORTEE DU DUMP EST CONTROLEE A L'AIDE DU PARM 'MAP'
C*            FOURNI DS LE PARM.GO DE LA CARTE EXEC
C*
C*       PORTEE DU DUMP :
C*                  -PAS DE DUMP SI ABSENCE DU PARM MAP DS PARM.GO
C*                  -SYSTEMATIQUE SI MAP=0
C*                  -LIMITE AUX SGM DE LA REGION I TQ I=MAP
C
C PROGRAMMEUR : PALLAUD puis MOUGIN
C       MODIF : 18/09/87    FORMATS POUR HP9000
C       MODIF : 26/10/88    FORMATS POUR CONVEX
C       MODIF : 22/03/2016  WIN64  =>  INTRODUCTION
C
C-----------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOVAL
%INC IOOUNIT
C
      CHARACTER*8 LPARM
      CHARACTER*3 LMOIS(12)
C
      DATA LMOIS  / 'JAN' , 'FEV' , 'MAR' , 'AVR' , 'MAI' , 'JUN'
     *            , 'JUI' , 'AOU' , 'SEP' , 'OCT' , 'NOV' , 'DEC' /
C
C  INITIALISATION
      DATA MAPX /999999999/
      DATA MAPA /0/
C
C****** PAS DE DUMP
C
  10  IF (MAPX.LT.0)                                   RETURN
C
C****** INIT DE MAPX
C
      IF (MAPX.EQ.999999999) THEN
         CALL OOOPRM (LRET,'MAP',LPARM,LLPARM,MAPX)
         IF (LRET.NE.3) MAPX=-1
                                                       GO TO 10
      ENDIF
C
C****** CHGT DE REGION :INIT NUM REGION MAPA
C
      IF (N.LE.0) THEN
         MAPA=-N
                                                       RETURN
      ENDIF
C
C****** TEST IMP DUMP
C
      IF (MAPX.NE.0)                                   THEN
        IF (MAPX.NE.MAPA)                              RETURN
      ENDIF
C
C******  IMPRESSION DE L'EN TETE DU DUMP PUIS TRACE-BACK
C
      IVERS=OOOVAL(GO,NUMVERSION)
      IVER1=IVERS/10
      IVER2=IVERS-10*IVER1
      IDATE=OOOVAL(GO,DATEVERSION)
      IMOIS=IDATE/100
      IYEAR=IDATE-IMOIS*100
      WRITE(JLST,1000) IVER1,IVER2 , LMOIS(IMOIS) , IYEAR ,IDE
C
      CALL OOOZZ5
      WRITE(JLST,2000)
C
C******  DUMP DU SEGMENT PAR PAQUET DE MSLSM MOTS
C        LES LIGNES A ZERO NE SONT PAS IMPRIMEES
C
      ISG =MDISG(IDE)
      LSG =MSLS1(ISG)
      NZER=0
      LSMM=MSLSM
      DO 500 J=1,LSG,LSMM
        DO     I=1,LSMM
          IF (JSG(ISG+J+I-1).NE.0)                     GO TO 200
        ENDDO
        NZER=NZER+1
                                                       GO TO 500
C             INTERLIGNE SI LIGNES A ZERO
 200    IF (NZER.NE.0) WRITE(JLST,2000)
C        LE COMPTEUR AFFICHE 1 POUR LE PREMIER MOT DES DONNEES(J=5)
        K=J-(MSLZ1)
        WRITE(JLST,2000) K,(JSG(ISG+J+I-1),I=1,MSLSM)
        NZER=0
 500  CONTINUE
                                                       RETURN
C***********************************************************************
 1000 FORMAT ('0GEMAT ',I1,'.',I1,'  (',A,I3,')',15X
     1     ,'     *** DUMP DU SEGMENT DE POINTEUR : ',I22,' ***'//)
%IF UNIX32,UNIX64,WIN32,WIN64
 2000 FORMAT (I10,5X,8I10)
%ENDIF
%IF IBM,VAX,APOLLO,CONVEX
 2000 FORMAT (Z10,5X,8Z10)
%ENDIF
%IF CRAY,FPS,CDC,CFT77
 2000 FORMAT (Z18,5X,4Z18)
%ENDIF
%IF UNIVAC
 2000 FORMAT (O13,5X,8O14)
%ENDIF
      END