I.1.10 Dump_XMGrace_Multi_Mesh Procedure

The main documentation of the Dump_XMGrace_Multi_Mesh Procedure contains additional explanation of this code listing.

  ! Set number of Mathematic Vectors and Distributed Vectors allowed
  ! in the call line. This can be changed here and it will change all 
  ! necessary code to match. This makes use of the replicate m4 macros.
  ! Setting this to a number greater than 6 triggers errors on compilers 
  ! that limit lines to 132 characters (like Absoft).

  define(REP_NUMBER, 6)

  subroutine Dump_XMGrace_Multi_Mesh (Filename, Mesh, Coordinate, &
    Xmin, Xmax, Ymin, Ymax, Zmin, Zmax &
    REP_ARGS([Variable[]i[]_MV]) &
    REP_ARGS([Variable[]i[]_DV]) &
    , status)

    ! Input variables.

    type(character,*), intent(in) :: Filename       ! Output filename.
    type(Multi_Mesh_type), intent(inout) :: Mesh    ! Mesh to be output.
    type(character,1), intent(in) :: Coordinate     ! X, Y or Z (for output).
    ! Output Mathematic_Vector variables.
    REP_DECLARE([type(Mathematic_Vector_type), optional], [Variable[]i[]_MV])
    ! Output Distributed_Vector variables.
    REP_DECLARE([type(Distributed_Vector_type), optional], [Variable[]i[]_DV])
    ! Limits on the points to be output.
    type(real), intent(in), optional :: Xmin, Xmax, Ymin, Ymax, Zmin, Zmax

    ! Output variable.

    type(Status_type), optional :: status           ! Consolidated Status.

    ! Internal variables.

    type(integer) :: XMGrace_Status                 ! XMGrace file open status.
    type(integer) :: unit                           ! XMGrace output unit.
    ! Actual limits on the points to be output.
    type(real) :: A_Xmin, A_Xmax, A_Ymin, A_Ymax, A_Zmin, A_Zmax
    ! Status vector.
    type(Status_type), dimension(2+2*REP_NUMBER) :: dump_status
    type(Status_type) :: consolidated_status           ! Consolidated Status.
    ifelse(COMPILER, Lahey, [
      type(character,256) :: Error_Message ! String for compiler error message.
    ])

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    ! Verify requirements.

    VERIFY(Valid_State(Mesh),5)      ! Mesh is valid.
    ! Variable#_(DV|MV) is valid.
    define([VERIFY_VARIABLE],[
      if (PRESENT(Variable$1_$2)) then
        VERIFY(Valid_State(Variable$1_$2),5)
      end if
    ])
    fortext([Type], [DV MV], [
      forloop([Var],[1],[REP_NUMBER],[
        VERIFY_VARIABLE(Var,Type)
      ])
    ])

    ! Allocations and initializations.

    call Initialize (dump_status)
    call Initialize (consolidated_status)

    ! Set actual variables.

    if (PRESENT(Xmin)) then
      A_Xmin = Xmin
    else
      A_Xmin = -HUGE(one)
    end if
    if (PRESENT(Xmax)) then
      A_Xmax = Xmax
    else
      A_Xmax = HUGE(one)
    end if
    if (PRESENT(Ymin)) then
      A_Ymin = Ymin
    else
      A_Ymin = -HUGE(one)
    end if
    if (PRESENT(Ymax)) then
      A_Ymax = Ymax
    else
      A_Ymax = HUGE(one)
    end if
    if (PRESENT(Zmin)) then
      A_Zmin = Zmin
    else
      A_Zmin = -HUGE(one)
    end if
    if (PRESENT(Zmax)) then
      A_Zmax = Zmax
    else
      A_Zmax = HUGE(one)
    end if

    ! Open XMGrace file for writing.

    unit = 19
    if (this_is_IO_PE) then
      open (UNIT=unit, FILE=Filename, STATUS='new', IOSTAT=XMGrace_Status)
    end if
    call Broadcast (XMGrace_Status)
    if (XMGrace_Status > 0) then
      if (this_is_IO_PE) then
        ifelse(COMPILER, Lahey, [
          call IOSTAT_MSG (XMGrace_Status, Error_Message)
          write (6,*) 'Dump_XMGrace_Multi_Mesh: IOSTAT message = ', &
                       TRIM(Error_Message)
        ])
        write (6,*) 'Dump_XMGrace_Multi_Mesh: XMGrace_Status = ', XMGrace_Status
        write (6,*) 'Dump_XMGrace_Multi_Mesh: File open error -- ', &
                    'requested XMGrace file may already exist.'
      end if
      dump_status(1) = 'File Error'
    end if

    ! Write out variables.

    define([CALL_DUMP_XMGrace_VARIABLE],[
      pushdef([TYPE], [$2])
      ifelse(TYPE, [Mathematic], [
        pushdef([VARIABLE], [Variable$1_MV])
        pushdef([DUMPNUMBER], [2+$1])
      ],[
        pushdef([VARIABLE], [Variable$1_DV])
        pushdef([DUMPNUMBER], [2+REP_NUMBER+$1])
      ])
      pushdef([Dump_XMGrace_TYPE_Vector], expand(Dump_XMGrace_TYPE_Vector))
      if (PRESENT(VARIABLE)) then
        call Dump_XMGrace_TYPE_Vector (VARIABLE, Mesh, Coordinate, unit, &
                                       A_Xmin, A_Xmax, &
                                       A_Ymin, A_Ymax, &
                                       A_Zmin, A_Zmax, &
                                       dump_status(DUMPNUMBER))
      end if
      popdef([Dump_XMGrace_TYPE_Vector])
      popdef([DUMPNUMBER])
      popdef([VARIABLE])
      popdef([TYPE])
    ])
    fortext([Type], [Mathematic Distributed], [
      forloop([Var],[1],[REP_NUMBER],[
        CALL_DUMP_XMGrace_VARIABLE(Var,Type)
      ])
    ])

    ! Close XMGrace file.

    if (this_is_IO_PE) then
      close (UNIT=unit, IOSTAT=XMGrace_Status)
    end if
    call Broadcast (XMGrace_Status)
    if (XMGrace_Status > 0) dump_status(2) = 'File Error'

    ! Consolidate and handle status.

    consolidated_status = dump_status
    if (PRESENT(status)) then
      WARN_IF(Error(consolidated_status), 5)
      status = consolidated_status
    else
      VERIFY(Normal(consolidated_status), 5)
    end if
    call Finalize (consolidated_status)
    call Finalize (dump_status)

    ! Format statements.

!100 format (a,5(:,i11))
!101 format ((1pg15.8,4(:,1pg16.8)))

    ! Verify guarantees - none.
  
    return
  end subroutine Dump_XMGrace_Multi_Mesh