Skip navigation links
(CGNS Documentation Home Page) (Steering Committee Charter) (Overview and Entry-Level Document) (A User's Guide to CGNS) (Mid-Level Library) (Standard Interface Data Structures) (SIDS File Mapping Manual) (CGIO Manual) (Parallel CGNS User's Guide) (ADF Implementation) (HDF5 Implementation) (Python Implementation) (CGNS Tools and Utilities)

(Introduction) (The ADF Software Library) (Glossary of Terms) (History of ADF Version Releases) (File System Architectures) (File Version Control Numbering) (Design Considerations) (Conventions and Implementations) (Error Messages) (Default Values and Limits) (Database-Level Routines) (Data Structure and Management Routines) (Data Query Routines) (Data I/O Routines) (Miscellaneous Routines) (Sample Fortran Program) (Sample C Program)

Data I/O Routines

Note: For all data I/O routines, the system is based on indexing starting from 1 and not 0. (That is, the first element in an array is indexed as 1 and not zero.)

Read the Data From a Node Having Stride Capabilities


ADF_Read_Data (ID,s_start[],s_end[],s_stride[],m_num_dims,m_dims[],
               m_start[],m_end[],m_stride[],data,error_return)


Language C Fortran
Routine Name ADF_Read_Data ADFREAD
Input const double ID
const int s_start[]
const int s_end[]
const int s_stride[]
const int m_num_dims
const int m_dims[]
const int m_start[]
const int m_end[]
const int m_stride[]
real*8 ID
integer s_start()
integer s_end()
integer s_stride()
integer m_num_dims
integer m_dims(m_num_dims)
integer m_start(m_num_dims)
integer m_end(m_num_dims)
integer m_stride(m_num_dims)
Output char *data
int *error_return
character*(*) data
integer error_return

    ID   The ID of the node to use.
 
s_start[] The starting index to use for each dimension of the array within the database node (1D array; i.e., list of indices). The maximum number of dimensions an array is allowed in ADF is 12.
 
s_end[] The ending index to use for each dimension of the array within the database node (1D array; i.e., list of indices).
 
s_stride[] The stride value to use for each dimension of the array within the database node (1D array; i.e., list of indices).
 
m_num_dims The number of dimensions to use in memory.
 
m_dims[] The dimension values to use for the array in memory (1D array; i.e., list of indices).
 
m_start[] The starting index to use for each dimension of the array in memory (1D array; i.e., list of indices).
 
m_end[] The ending index to use for each dimension of the array in memory (1D array; i.e., list of indices).
 
m_stride[] The stride value to use for each dimension of the array in memory (1D array; i.e., list of indices).
 
data The starting address of the data in memory.
 
error_return Error return code.

This routine, ADF_Read_Data, provides general purpose read capabilities. It allows for a general specification of the starting location within the data well as fixed step lengths (strides) through the data from the initial position. This capability works for both the data on disk and the data being stored in memory. One set of integer vectors (s_start, etc.) is used to describe the mapping of the data within the node, and a second set of integer vectors (m_start) is used to describe the mapping of the desired data within memory.

There can be a significant performance penalty for using ADF_Read_Data when compared with ADF_Read_All_Data. If performance is a major consideration, it is best to organize data to take advantage of the speed of Adf_Read_All_Data.

The data are stored in both memory and on disk in "Fortran ordering." That is, the first index varies the fastest.

ADF_Read_Data will not accept "negative" indexing. That is, it is not possible to reverse the ordering of the data from the node into memory.

Be careful when writing data using ADF_Write_All_Data and then using ADF_Read_Data to randomly access the data. ADF_Write_All_Data takes a starting address in memory and writes N words to disk, making no assumption as to the order of the data. ADF_Read_Data assumes that the data have Fortran-like ordering to navigate through the data in memory and on disk. It assumes that the first dimension varies the fastest. It would be easy for a C program to use the default array ordering (last dimension varying fastest) and write the data out using ADF_Write_All_Data. Then another program might use ADF_Read_Data to access a subsection of the data, and the routine would not return what was expected.

Note: If all the data type of the node is a compound data type, such as ("I4[3],R8"), the partial capabilities will access one or more of these 20-byte data entities. You cannot access a subset of an occurrence of the data type.

Note: See the section on Fortran character array portability.

Example 1

This example shows ADFREAD being used to emulate the same capabilities as those in ADFRALL.

   PROGRAM TEST
   C
         PARAMETER (MAXROW=10)
         PARAMETER (MAXCOL=3)
   C
         REAL R4ARRI(MAXROW,MAXCOL)
         REAL R4ARRO(MAXROW,MAXCOL)
         INTEGER IDIMI(2),IDIMO(2)
         INTEGER IDBEG(2),IDEND(2),IDINCR(2)
         INTEGER IMBEG(2),IMEND(2),IMINCR(2)
   C
   C *** NODE IDS
   C
         REAL*8 RID,CID
   C
   C *** OPEN DATABASE
   C
         CALL ADFDOPN('db.adf','NEW',' ',RID,IERR)
   C
   C *** GENERATE SOME DATA
   C
         IDIMI(1) = MAXROW
         IDIMI(2) = MAXCOL
         DO 200 ICOL = 1,MAXCOL
            DO 100 IROW = 1,MAXROW
               R4ARRI(IROW,ICOL) = 2.0*ICOL*IROW
     100    CONTINUE
     200 CONTINUE
         PRINT *,' ORIGINAL ARRAY:'
         WRITE(*,300)((R4ARRI(I,J),J=1,MAXCOL),I=1,MAXROW)
     300 FORMAT(3(5X,F10.2))
   C
   C *** GENERATE A NODE AND PUT DATA IN IT
   C
         CALL ADFCRE(RID,'NODE 1',CID,IERR)
         CALL ADFSLB(CID,'LABEL FOR NODE 1',IERR)
         CALL ADFPDIM(CID,'R4',2,IDIMI,IERR)
         CALL ADFWALL(CID,R4ARRI,IERR)
   C
   C *** GET INFORMATION FROM NODE
   C
   C *** GET DATA FROM NODE (EXACTLY EQUIVALENT TO ADFRALL)
   C
         IDBEG(1) = 1
         IDEND(1) = MAXROW
         IDINCR(1) = 1
   C
         IDBEG(2) = 1
         IDEND(2) = MAXCOL
         IDINCR(2) = 1
   C
         IDIMO(1) = MAXROW
         IDIMO(2) = MAXCOL
   C
         IMBEG(1) = 1
         IMEND(1) = MAXROW
         IMINCR(1) = 1
   C
         IMBEG(2) = 1
         IMEND(2) = MAXCOL
         IMINCR(2) = 1
         CALL ADFREAD(CID,IDBEG,IDEND,IDINCR,
        X             2,IDIMO,IMBEG,IMEND,IMINCR,
        X             R4ARRO,IERR)
         CALL ERRCHK(IERR)
   C
         PRINT *,' ARRAY PULLED FROM DISK USING ADFREAD:'
         WRITE(*,300)((R4ARRO(I,J),J=1,MAXCOL),I=1,MAXROW)
   C
         STOP
         END

   C
   C ************* SUBROUTINES ****************
   C
         SUBROUTINE ERRCHK(IERR)
   C
   C *** CHECK ERROR CONDITION
   C
         CHARACTER*80 MESS
         IF (IERR .GT. 0) THEN
            CALL ADFERR(IERR,MESS)
            PRINT *,MESS
            CALL ABORT('ADF ERROR')
         ENDIF
         RETURN
         END

The resulting output is:

   ORIGINAL ARRAY:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
            10.00          20.00          30.00
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00

   ARRAY PULLED FROM DISK USING ADFREAD:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
            10.00          20.00          30.00
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00
Example 2

This example illustrates some of the flexibility available with ADF_Read_Data. An array is created and written to disk using ADFWALL. Then every other entry in the second column is read back into every other element of a vector.

   PROGRAM TEST
   C
         PARAMETER (MAXROW=10)
         PARAMETER (MAXCOL=3)
   C
         REAL R4ARRI(MAXROW,MAXCOL),R4VECO(MAXROW)
         INTEGER IDIMD(2)
         INTEGER IDBEG(2),IDEND(2),IDINCR(2)
   C
   C *** NODE IDS
   C
         REAL*8 RID,CID
   C
   C *** OPEN DATABASE
   C
         CALL ADFDOPN('db.adf','NEW',' ',RID,IERR)
   C
   C *** GENERATE SOME DATA
   C
         IDIMD(1) = MAXROW
         IDIMD(2) = MAXCOL
         DO 200 ICOL = 1,MAXCOL
            DO 100 IROW = 1,MAXROW
               R4ARRI(IROW,ICOL) = 2.0*ICOL*IROW
     100    CONTINUE
     200 CONTINUE
   C
         DO 250 I = 1,MAXROW
            R4VECO(I) = 0.0
     250 CONTINUE
   C
         PRINT *,' ORIGINAL ARRAY:'
         WRITE(*,300)((R4ARRI(I,J),J=1,MAXCOL),I=1,MAXROW)
     300 FORMAT(3(5X,F10.2))
   C
   C *** GENERATE A NODE AND PUT DATA IN IT
   C
         CALL ADFCRE(RID,'NODE 1',CID,IERR)
         CALL ADFSLB(CID,'LABEL FOR NODE 1',IERR)
         CALL ADFPDIM(CID,'R4',2,IDIMD,IERR)
         CALL ADFWALL(CID,R4ARRI,IERR)
   C
   C *** GET DATA FROM NODE USING STRIDED READ
   C
   C ****** TAKE EVERY OTHER NUMBER FROM THE 2ND COLUMN OF THE ARRAY
   C        AND PUT IT IN SEQUENTIALLY IN A VECTOR IN MEMORY
   C
   C *** DATABASE STRIDE INFORMATION
   C
         IDBEG(1) = 1
         IDEND(1) = MAXROW
         IDINCR(1) = 2
   C
         IDBEG(2) = 2
         IDEND(2) = 2
         IDINCR(2) = 1
   C
   C *** MEMORY STRIDE INFORMATION
   C
         NDIMM = 1
         IDIMM = MAXROW
         IMBEG = 1
         IMEND = MAXROW
         IMINCR = 2
   C
         CALL ADFREAD(CID,IDBEG,IDEND,IDINCR,
        X             NDIMM,IDIMM,IMBEG,IMEND,IMINCR,
        X             R4VECO,IERR)
         CALL ERRCHK(IERR)
   C
         PRINT *,' VECTOR WITH DATA EXTRACTED FROM ARRAY'
         WRITE(*,400)(R4VECO(J),J=1,MAXROW)
     400 FORMAT(3(5X,F10.2))
   C
         STOP
         END

   C
   C ************* SUBROUTINES ****************
   C
         SUBROUTINE ERRCHK(IERR)
   C
   C *** CHECK ERROR CONDITION
   C
         CHARACTER*80 MESS
         IF (IERR .GT. 0) THEN
            CALL ADFERR(IERR,MESS)
            PRINT *,MESS
            CALL ABORT('ADF ERROR')
         ENDIF
         RETURN
         END

The resulting output is:

   ORIGINAL ARRAY:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
            10.00          20.00          30.00
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00
   VECTOR WITH DATA EXTRACTED FROM ARRAY
             4.00           0.00          12.00
             0.00          20.00           0.00
            28.00           0.00          36.00
             0.00

Read All the Data From a Node


ADF_Read_All_Data (ID,data,error_return)

Language C Fortran
Routine Name ADF_Read_All_Data ADFRALL
Input const double ID real*8 ID
Output char *data
int *error_return
character*(*) data
integer error_return

    ID   The ID of the node to use.
 
data The starting address of the data in memory.
 
error_return Error return code.

This routine, ADF_Read_All_Data, reads all data from a node. It reads all the node's data and returns them into a contiguous memory space.

The disk performance of ADF_Read_All_Data is very good. The routine issues a single read command to the system for the entire data set; therefore, it is as fast as the system can return the data.

Note: See the section on Fortran character array portability.

Example

See the example for ADF_Get_Data_Type.

Read a Contiguous Block of Data From a Node


ADF_Read_Block_Data (ID,b_start,b_end,data,error_return)

Language C Fortran
Routine Name ADF_Read_Block_Data ADFRBLK
Input const double ID
const long b_start
const long b_end
real*8 ID
integer b_start
integer b_end
Output char *data
int *error_return
character*(*) data
integer error_return

    ID   The ID of the node to use.
 
b_start The starting point of the block in token space.
 
b_end The ending point of the block in token space.
 
data The starting address of the data in memory.
 
error_return Error return code.

This routine, ADF_Read_Block_Data, reads a block of data from a node and returns it into a contiguous memory space.

Note: See the section on Fortran character array portability.

Write the Data to a Node Having Stride Capabilities


ADF_Write_Data (ID,s_start[],s_end[],s_stride[],m_num_dims,m_dims[],
                m_start[],m_end[],m_stride[],data,error_return)


Language C Fortran
Routine Name ADF_Write_Data ADFWRIT
Input const double ID
const int s_start[]
const int s_end[]
const int s_stride[]
const int m_num_dims
const int m_dims[]
const int m_start[]
const int m_end[]
const int m_stride[]
char *data
real*8 ID
integer s_start()
integer s_end()
integer s_stride()
integer m_num_dims
integer m_dims(m_num_dims)
integer m_start(m_num_dims)
integer m_end(m_num_dims)
integer m_stride(m_num_dims)
character*(*) data
Output int *error_return integer error_return

    ID   The ID of the node to use.
 
s_start[] The starting index to use for each dimension of the array within the database node (1D array; i.e., list of indices). The maximum number of dimensions an array is allowed in ADF is 12.
 
s_end[] The ending index to use for each dimension of the array within the database node (1D array; i.e., list of indices).
 
s_stride[] The stride value to use for each dimension of the array within the database node (1D array; i.e., list of indices).
 
m_num_dims The number of dimensions to use in memory.
 
m_dims[] The dimension values to use for the array in memory (1D array; i.e., list of indices).
 
m_start[] The starting index to use for each dimension of the array in memory (1D array; i.e., list of indices).
 
m_end[] The ending index to use for each dimension of the array in memory (1D array; i.e., list of indices).
 
m_stride[] The stride value to use for each dimension of the array in memory (1D array; i.e., list of indices).
 
data The starting address of the data in memory.
 
error_return Error return code.

This routine, ADF_Write_Data, provides general purpose write capabilities. It allows offsets and strides within both the data in memory and the node on disk. One set of integer vectors (s_start, etc.) is used to describe the mapping of the data within the node, and a second set of integer vectors (m_start, etc.) is used to describe the mapping of the desired data within memory.

There can be a significant performance penalty for using ADF_Write_Data when compared with ADF_Write_All_Data. If performance is a major consideration, it is best to organize data to take advantage of the speed of ADF_Write_All_Data.

The data are stored in both memory and on disk in "Fortran ordering." That is, the first index varies the fastest.

ADF_Write_Data will not accept "negative" indexing. That is, it is not possible to reverse the ordering of the data from the node into memory.

Be careful when using ADF_Read_All_Data to randomly access data that has been written using ADF_Write_Data. ADF_Read_All_Data takes a starting address in memory and takes N contiguous words from disk, making no assumption as to the order of the data. ADF_Write_Data assumes that the data have Fortran-like ordering to navigate through the data on disk and in memory. It assumes that the first dimension varies the fastest.

Note: See the section on Fortran character array portability.

Example 1

This example uses ADF_Write_Data to perform exactly the same task as ADF_Write_All_Data. ADF_Write_All_Data should be used whenever possible for performance reasons.

   PROGRAM TEST
   C
         PARAMETER (MAXCHR=32)
         PARAMETER (MAXROW=10)
         PARAMETER (MAXCOL=3)
   C
         CHARACTER*(MAXCHR) NODNAM,LABL
         CHARACTER*(MAXCHR) DTYPE
         REAL R4ARRI(MAXROW,MAXCOL)
         REAL R4ARRO(MAXROW,MAXCOL)
         INTEGER IDIMI(2),IDIMO(2)
         INTEGER IDBEG(2),IDEND(2),IDINCR(2)
         INTEGER IMBEG(2),IMEND(2),IMINCR(2)
   C
   C *** NODE IDS
   C
         REAL*8 RID,CID
   C
   C *** OPEN DATABASE
   C
         CALL ADFDOPN('db.adf','NEW',' ',RID,IERR)
   C
   C *** GENERATE SOME DATA
   C
         IDIMI(1) = MAXROW
         IDIMI(2) = MAXCOL
         DO 200 ICOL = 1,MAXCOL
            DO 100 IROW = 1,MAXROW
               R4ARRI(IROW,ICOL) = 2.0*ICOL*IROW
     100    CONTINUE
     200 CONTINUE
         PRINT *,' ORIGINAL ARRAY:'
         WRITE(*,300)((R4ARRI(I,J),J=1,MAXCOL),I=1,MAXROW)
     300 FORMAT(3(5X,F10.2))
   C
   C *** GENERATE A NODE AND PUT DATA IN IT
   C     THIS IS EXACTLY EQUIVALENT TO USING ADFWALL
   C
         CALL ADFCRE(RID,'NODE 1',CID,IERR)
         CALL ADFSLB(CID,'LABEL FOR NODE 1',IERR)
         CALL ADFPDIM(CID,'R4',2,IDIMI,IERR)
   C
         IDBEG(1) = 1
         IDEND(1) = MAXROW
         IDINCR(1) = 1
   C
         IDBEG(2) = 1
         IDEND(2) = MAXCOL
         IDINCR(2) = 1
   C
         IDIMO(1) = MAXROW
         IDIMO(2) = MAXCOL
   C
         IMBEG(1) = 1
         IMEND(1) = MAXROW
         IMINCR(1) = 1
   C
         IMBEG(2) = 1
         IMEND(2) = MAXCOL
         IMINCR(2) = 1
   C
         CALL ADFWRIT(CID,IDBEG,IDEND,IDINCR,2,IDIMO,IMBEG,
        X             IMEND,IMINCR,R4ARRI,IERR)
         CALL ERRCHK(IERR)
   C
   C *** GET INFORMATION FROM NODE
   C
         CALL ADFGNAM(CID,NODNAM,IERR)
         CALL ADFGLB(CID,LABL,IERR)
         CALL ADFGDT(CID,DTYPE,IERR)
         CALL ADFGND(CID,NDIM,IERR)
         CALL ADFGDV(CID,IDIMO,IERR)
         CALL ADFRALL(CID,R4ARRO,IERR)
         CALL ERRCHK(IERR)
   C
         PRINT *,' '
         PRINT *,' NODE NAME            = ',NODNAM
         PRINT *,' LABEL                = ',LABL
         PRINT *,' DATA TYPE            = ',DTYPE
         PRINT *,' NUMBER OF DIMENSIONS = ',NDIM
         PRINT *,' DIMENSIONS           = ',IDIMO
         PRINT *,' ADFRALL DATA:'
         WRITE(*,300)((R4ARRO(I,J),J=1,MAXCOL),I=1,MAXROW)
   C
         STOP
         END

   C
   C ************* SUBROUTINES ****************
   C
         SUBROUTINE ERRCHK(IERR)
   C
   C *** CHECK ERROR CONDITION
   C
         CHARACTER*80 MESS
         IF (IERR .GT. 0) THEN
            CALL ADFERR(IERR,MESS)
            PRINT *,MESS
            CALL ABORT('ADF ERROR')
         ENDIF
         RETURN
         END

The resulting output is:

   ORIGINAL ARRAY:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
            10.00          20.00          30.00
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00

   NODE NAME            = NODE 1
   LABEL                = LABEL FOR NODE 1
   DATA TYPE            = R4
   NUMBER OF DIMENSIONS =            2
   DIMENSIONS           =           10           3
   ADFRALL DATA:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
            10.00          20.00          30.00
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00
Example 2

This example illustrates the capability to write a full matrix to an ADF file and then use ADF_Write_Data to rewrite selected portions of the matrix with new data from a much smaller data structure.

   PROGRAM TEST
   C
         PARAMETER (MAXCHR=32)
         PARAMETER (MAXROW=10)
         PARAMETER (MAXCOL=3)
   C
         CHARACTER*(MAXCHR) NODNAM,LABL
         CHARACTER*(MAXCHR) DTYPE
         REAL R4ARRI(MAXROW,MAXCOL),R4VEC(MAXCOL)
         REAL R4ARRO(MAXROW,MAXCOL)
         INTEGER IDIMI(2),IDIMO(2),IDIMM(2)
         INTEGER IDBEG(2),IDEND(2),IDINCR(2)
         INTEGER IMBEG(2),IMEND(2),IMINCR(2)
   C
   C *** NODE IDS
   C
         REAL*8 RID,CID
   C
   C *** OPEN DATABASE
   C
         CALL ADFDOPN('db.adf','NEW',' ',RID,IERR)
   C
   C *** GENERATE SOME DATA
   C
         IDIMI(1) = MAXROW
         IDIMI(2) = MAXCOL
         DO 200 ICOL = 1,MAXCOL
            DO 100 IROW = 1,MAXROW
               R4ARRI(IROW,ICOL) = 2.0*ICOL*IROW
     100    CONTINUE
            R4VEC(ICOL) = 2.2*ICOL
     200 CONTINUE
         PRINT *,' ORIGINAL ARRAY:'
         WRITE(*,300)((R4ARRI(I,J),J=1,MAXCOL),I=1,MAXROW)
     300 FORMAT(3(5X,F10.2))
   C
   C *** GENERATE A NODE AND WRITE THE ARRAY IN IT
   C
         CALL ADFCRE(RID,'NODE 1',CID,IERR)
         CALL ADFSLB(CID,'LABEL FOR NODE 1',IERR)
         CALL ADFPDIM(CID,'R4',2,IDIMI,IERR)
         CALL ADFWALL(CID,R4ARRI,IERR)
         CALL ERRCHK(IERR)
   C
   C *** GET INFORMATION FROM NODE (JUST TO PROVE ITS RIGHT)
   C
         CALL ADFGNAM(CID,NODNAM,IERR)
         CALL ADFGLB(CID,LABL,IERR)
         CALL ADFGDT(CID,DTYPE,IERR)
         CALL ADFGND(CID,NDIM,IERR)
         CALL ADFGDV(CID,IDIMO,IERR)
         CALL ADFRALL(CID,R4ARRO,IERR)
         CALL ERRCHK(IERR)
   C
         PRINT *,' '
         PRINT *,' NODE NAME            = ',NODNAM
         PRINT *,' LABEL                = ',LABL
         PRINT *,' DATA TYPE            = ',DTYPE
         PRINT *,' NUMBER OF DIMENSIONS = ',NDIM
         PRINT *,' DIMENSIONS           = ',IDIMO
         PRINT *,' ORIGINAL DATA ON DISK:'
         WRITE(*,300)((R4ARRO(I,J),J=1,MAXCOL),I=1,MAXROW)
   C
   C *** NOW, USING A VECTOR WITH NEW DATA IN IT, SCATTER
   C     IT INTO THE DATABASE (THIS MODIFIES THE 5TH ROW
   C     OF THE MATRIX)
   C
         IDBEG(1)  = 5
         IDEND(1)  = 5
         IDINCR(1) = 1
   C
         IDBEG(2)  = 1
         IDEND(2)  = MAXCOL
         IDINCR(2) = 1
   C
         NMDIM = 1
         IDIMM(1)  = MAXCOL
         IMBEG(1)  = 1
         IMEND(1)  = MAXCOL
         IMINCR(1) = 1
   C
         CALL ADFWRIT(CID,IDBEG,IDEND,IDINCR,
        X             NMDIM,IDIMM,IMBEG,IMEND,IMINCR,
        X             R4VEC,IERR)
         CALL ERRCHK(IERR)
   C
   C *** NOW PULL THE REVISED ARRAY OFF DISK AND PRINT IT
   C
         CALL ADFRALL(CID,R4ARRO,IERR)
         CALL ERRCHK(IERR)
   C
         PRINT *,' '
         PRINT *,' AFTER SCATTER:'
         WRITE(*,300)((R4ARRO(I,J),J=1,MAXCOL),I=1,MAXROW)
   C
   STOP
   END

   C
   C ************* SUBROUTINES ****************
   C
         SUBROUTINE ERRCHK(IERR)
   C
   C *** CHECK ERROR CONDITION
   C
         CHARACTER*80 MESS
         IF (IERR .GT. 0) THEN
            CALL ADFERR(IERR,MESS)
            PRINT *,MESS
            CALL ABORT('ADF ERROR')
         ENDIF
         RETURN
         END

The resulting output is:

   ORIGINAL ARRAY:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
            10.00          20.00          30.00
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00

   NODE NAME            = NODE 1
   LABEL                = LABEL FOR NODE 1
   DATA TYPE            = R4
   NUMBER OF DIMENSIONS =            2
   DIMENSIONS           =           10            3
   ORIGINAL DATA ON DISK:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
            10.00          20.00          30.00
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00
   AFTER SCATTER:
             2.00           4.00           6.00
             4.00           8.00          12.00
             6.00          12.00          18.00
             8.00          16.00          24.00
             2.20           4.40           6.60
            12.00          24.00          36.00
            14.00          28.00          42.00
            16.00          32.00          48.00
            18.00          36.00          54.00
            20.00          40.00          60.00

Write All the Data to a Node


ADF_Write_All_Data (ID,data,error_return)

Language C Fortran
Routine Name ADF_Write_All_Data ADFWALL
Input const double ID
const char *data
real*8 ID
character*(*) data
Output int *error_return integer error_return

    ID   The ID of the node to use.
 
data The starting address of the data in memory.
 
error_return Error return code.

This routine, ADF_Write_All_Data, writes all data to a node. It copies all the node's data from a contiguous memory space into a contiguous disk space.

The disk performance of ADF_Write_All_Data is very good. The routine issues a single write command to the system for the entire data set; therefore, it is as fast as the system can put the data on disk.

Note: See the section on Fortran character array portability.

Example

See the example for ADF_Get_Data_Type.

Write a Contiguous Block of Data To a Node


ADF_Write_Block_Data (ID,b_start,b_end,data,error_return)

Language C Fortran
Routine Name ADF_Write_Block_Data ADFWBLK
Input const double ID
const long b_start
const long b_end
char *data
real*8 ID
integer b_start
integer b_end
character*(*) data
Output int *error_return integer error_return

    ID   The ID of the node to use.
 
b_start The starting point of the block in token space.
 
b_end The ending point of the block in token space.
 
data The starting address of the data in memory.
 
error_return Error return code.

This routine, ADF_Write_Block_Data, writes a contiguous block of data from memory to a node.

Note: See the section on Fortran character array portability.