Sources Esope | Cast3M

oooaph
C OOOAPH    SOURCE    PV090527  26/04/24    08:23:00     12524          
CMODE 92/03/19 15:37:03     STAN
      SUBROUTINE OOOAPH (HNOMV,PSEG,PARCH,HNOMVA,IDIM,NDIM,
     * NBMAX)
C---------------------------------------------------------------------
C              ARCHIVAGE DE SEGMENT
C      HNOMV       : NOM DU TABLEAU OU DE LA VARIABLE SIMPLE
C      PSEG        : SEGMENT ORIGINE
C      PARCH       : SEGMENT ARCHIVE
C      HNOMVA      : TABLEAU TRANSMIS
C      IDIM(NDIM)  : DIMENSIONS DU TABLEAU
C      NDIM        : NOMBRE DE DIMENSIONS D'UN TABLEAU
C      NBMAX       : NOMBRE MAX DE VALEURS A ARCHIVER
C
C      LONGUEURS:
C      =========
C      LOGIQUE: 5
C      INTEGER: 11  INTEGER*2 : 6   INTEGER*1 : 4
C      REAL*4 : 16  REAL*8    : 25  REAL*16   : 42
C      COMPLEX*8 : 35  COMPLEX*16: 53  COMPLEX*32 : 87
C
C H_MULLEMAN  LE  18/8/1991
C-----------------------------------------------------------------------
%INC IOOARC
%INC IOOCH
%INC IOOCH2
C
C-----------------------------------------------------------------------
C
      KAS=CHARACTER
                                                       GO TO 20
      ENTRY OOOAPL (HNOMV,PSEG,PARCH,LNOMVA,IDIM,NDIM,NBMAX)
      KAS=LOGICAL
      LLONG=1
                                                       GO TO 20
      ENTRY OOOAPM (HNOMV,PSEG,PARCH,MNOMVA,IDIM,NDIM,NBMAX)
      KAS=LOGICAL_2
      LLONG=1
                                                       GO TO 20
      ENTRY OOOAPN (HNOMV,PSEG,PARCH,NNOMVA,IDIM,NDIM,NBMAX)
      KAS=LOGICAL_1
      LLONG=1
                                                       GO TO 20
      ENTRY OOOAPI (HNOMV,PSEG,PARCH,INOMVA,IDIM,NDIM,NBMAX)
      KAS=INTEGER
      LLONG=11
                                                       GO TO 20
      ENTRY OOOAPJ (HNOMV,PSEG,PARCH,JNOMVA,IDIM,NDIM,NBMAX)
      KAS=INTEGER_2
      LLONG=6
                                                       GO TO 20
      ENTRY OOOAPK (HNOMV,PSEG,PARCH,KNOMVA,IDIM,NDIM,NBMAX)
      KAS=INTEGER_1
      LLONG=4
                                                       GO TO 20
      ENTRY OOOAPR (HNOMV,PSEG,PARCH,RNOMVA,IDIM,NDIM,NBMAX)
      KAS=REAL_4
      LLONG=16
                                                       GO TO 20
      ENTRY OOOAPD (HNOMV,PSEG,PARCH,DNOMVA,IDIM,NDIM,NBMAX)
      KAS=REAL_8
      LLONG=25
                                                       GO TO 20
      ENTRY OOOAPQ (HNOMV,PSEG,PARCH,QNOMVA,IDIM,NDIM,NBMAX)
      KAS=REAL_16
      LLONG=42
                                                       GO TO 20
      ENTRY OOOAPC (HNOMV,PSEG,PARCH,CNOMVA,IDIM,NDIM,NBMAX)
      KAS=COMPLEX
      LLONG=32
                                                       GO TO 20
      ENTRY OOOAPY (HNOMV,PSEG,PARCH,YNOMVA,IDIM,NDIM,NNMAX)
      KAS=COMPLEX_16
      LLONG=50
                                                       GO TO 20
      ENTRY OOOAPZ (HNOMV,PSEG,PARCH,ZNOMVA,IDIM,NDIM,NBMAX)
      KAS=COMPLEX_32
      LLONG=84
                                                       GO TO 20
      ENTRY OOOAPP (HNOMV,PSEG,PARCH,INOMVA,IDIM,NDIM,NBMAX)
      KAS=POINTEUR
      LLONG=11
C
  20  CONTINUE
C
C
      NMAX=1
      IF(NDIM.EQ.0) THEN
      ELSE
C*
        IF (KAS.EQ.CHARACTER) THEN
          IF (NDIM.EQ.1) THEN
          ELSE
            DO I=2,NDIM
              NMAX=NMAX*IDIM(I)
            ENDDO
          ENDIF
C
        ELSE
          DO I=1,NDIM
           NMAX=NMAX*IDIM(I)
          ENDDO
        ENDIF
      ENDIF
C
      IF (NMAX.GE.NBMAX) NMAX=NBMAX
      IF (KAS.EQ.CHARACTER) THEN
        LLONG=0
        DO I=1,NMAX
          LLONG = LLONG+LEN(HNOMVA(I))
        ENDDO
      ELSE
        LLONG=LLONG*NMAX
      ENDIF
      IF (INDICE+LLONG.GT.LOOK)THEN
         LOOK=LOOK+MAX(2000,LLONG)
         SEGADJ , PARCH
      ENDIF
      DO I=1,NMAX
        CASE           ,KAS
        WHEN , LOGICAL , LOGICAL_2 , LOGICAL_1
           CH5='FALSE'
           IF (KAS.EQ.LOGICAL) THEN
             IF(LNOMVA(I)) CH5='TRUE '
           ELSEIF (KAS.EQ.LOGICAL_2) THEN
             IF(MNOMVA(I)) CH5='TRUE '
           ELSE
             IF(NNOMVA(I)) CH5='TRUE '
           ENDIF
           PARCH.CHARIV(INDICE:INDICE)=CH5
           INDICE=INDICE+1
C
        WHEN , INTEGER , POINTEUR
           WRITE(CH11,FMT='(I11)') INOMVA(I)
C
           PARCH.CHARIV(INDICE:INDICE+10)=CH11
           INDICE=INDICE+11
C
        WHEN , INTEGER_2
           WRITE(CH6,FMT='(I6)') JNOMVA(I)
           PARCH.CHARIV(INDICE:INDICE+5)=CH6
           INDICE=INDICE+6
C
        WHEN , INTEGER_1
           WRITE(CH4,FMT='(I4)') KNOMVA(I)
           PARCH.CHARIV(INDICE:INDICE+3)=CH4
           INDICE=INDICE+4
C
        WHEN , REAL_4
           WRITE(CH16,FMT='(E16.9)') RNOMVA(I)
           PARCH.CHARIV(INDICE:INDICE+15)=CH16
           INDICE=INDICE+16
C
        WHEN , REAL_8
           WRITE(CH25,FMT='(E25.18)') DNOMVA(I)
           PARCH.CHARIV(INDICE:INDICE+24)=CH25
           INDICE=INDICE+25
C
        WHEN , REAL_16
           WRITE(CH42,FMT='(E42.35)') QNOMVA(I)
           PARCH.CHARIV(INDICE:INDICE+41)=CH42
           INDICE=INDICE+42
C
        WHEN , COMPLEX
           WRITE(CH16,FMT='(E16.9)') CNOMVA(1,I)
           PARCH.CHARIV(INDICE:INDICE+15)=CH16
           INDICE=INDICE+16
           WRITE(CH16,FMT='(E16.9)') CNOMVA(2,I)
           PARCH.CHARIV(INDICE:INDICE+15)=CH16
           INDICE=INDICE+16
        WHEN , COMPLEX_16
           WRITE(CH25,FMT='(E25.18)') YNOMVA(1,I)
           PARCH.CHARIV(INDICE:INDICE+24)=CH25
           INDICE=INDICE+25
           WRITE(CH25,FMT='(E25.18)') YNOMVA(2,I)
           PARCH.CHARIV(INDICE:INDICE+24)=CH25
           INDICE=INDICE+25
        WHEN , COMPLEX_32
           WRITE(CH42,FMT='(E42.35)') ZNOMVA(1,I)
           PARCH.CHARIV(INDICE:INDICE+41)=CH42
           INDICE=INDICE+42
           WRITE(CH42,FMT='(E42.35)') ZNOMVA(2,I)
           PARCH.CHARIV(INDICE:INDICE+41)=CH42
           INDICE=INDICE+42
         WHEN , CHARACTER
           LONG=LEN(HNOMVA(I))
           PARCH.CHARIV(INDICE:INDICE+LONG-1)=HNOMVA(I)(1:LONG)
           INDICE=INDICE+LONG
         ENDCASE
      ENDDO
      RETURN
      END