next up previous
Next: READBIGIO - read Up: FORTRAN Examples Previous: FORTRAN Examples

MAKEBIGIO - make a big image

*+  MAKEBIGIO - make a big image
      SUBROUTINE MAKEBIGIO ( STATUS )
*    Description :
*     Initialise a SuperCOSMOS mapping data set.
*    Invocation :
*     CALL MAKEBIGIO ( STATUS )
*    Parameters :
*     STATUS=INTEGER (given and returned)
*           global status
*    Method :
*     Create a header file is the subdirectory for the bigimage.
*    Authors :
*     B.D.Kelly (ROE)
*    History :
*     24.01.1995: original (BDK)
*    endhistory
*    Type Definitions :
      IMPLICIT NONE
*    Global constants :
      INCLUDE 'SAE_PAR'

*    Status :
      INTEGER STATUS

*    Local variables :
      CHARACTER*132 MAPNAME   ! name of directory to hold bigimage
      CHARACTER*16 DTYPE      ! data type
      INTEGER BD              ! bigimage descriptor
      INTEGER*2 VALUES(20)    ! values written to the bigimage
      INTEGER LANE            ! lane number
      INTEGER ROW             ! row number
      INTEGER J               ! loop counter
      CHARACTER*132 ERRMSG    ! buffer for error messages
*-

      IF ( STATUS .NE. SAI__OK ) RETURN

*
*   Invent a row of pixel values
*
      DO J = 1, 20
         VALUES(J) = J
      ENDDO
*
*   Get the mapname, which is the name of the directory to hold the
*   bigimage 
*
      CALL PAR_GET0C ( 'MAPNAME', MAPNAME, STATUS )
*
*   Create the bigimage
*
      DTYPE = 'I2S'
      CALL COSMAP_CREATE ( MAPNAME, 3, 20, 30, DTYPE, STATUS )
      IF ( STATUS .NE. SAI__OK ) THEN
         CALL COSMAP_ERRTRAN ( ERRMSG, STATUS )
         CALL ERR_REP ( ' ', ERRMSG, STATUS )
      ELSE
*
*      Open the bigimage and write the invented data to it. Each row of
*      pixels in each lane is the same 
*
         CALL COSMAP_OPEN ( MAPNAME, 'update', BD, STATUS )
         IF ( STATUS .NE. SAI__OK ) THEN
            CALL COSMAP_ERRTRAN ( ERRMSG, STATUS )
            CALL ERR_REP ( ' ', ERRMSG, STATUS )
         ELSE
            DO LANE = 1, 3
               DO ROW = 1, 30
                  CALL COSMAP_PUTROW ( BD, LANE, ROW, VALUES, STATUS )
               ENDDO
            ENDDO
            IF ( STATUS .NE. SAI__OK ) THEN
               CALL COSMAP_ERRTRAN ( ERRMSG, STATUS )
               CALL ERR_REP ( ' ', ERRMSG, STATUS )
            ENDIF
         ENDIF
      ENDIF

      END



SuperCOSMOS development
Tue Aug 20 12:02:13 BST 1996