module convert
!
!     (c) Copyright 1991 to 1998 by Michael A. Beer, William D. Dorland, 
!     P. B. Snyder, Q. P. Liu, and Gregory W. Hammett. ALL RIGHTS RESERVED.
!     

  private
  public :: c2r, r2c

  interface c2r
     module procedure x1c2r
     module procedure x2c2r
     module procedure x3c2r
     module procedure x4c2r
  end interface

  interface r2c
     module procedure x1r2c
     module procedure x2r2c
     module procedure x3r2c
     module procedure x4r2c
  end interface

contains 

  subroutine x4c2r(a, a_ri)

    complex, dimension(:,:,:,:) :: a
    real, dimension(:,:,:,:,:) :: a_ri

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x4c2r: size(a, 1) does not match size(a_ri, 2)')
    if(size(a, 2) /= size(a_ri, 3)) call aborter (6, 'x4c2r: size(a, 2) does not match size(a_ri, 3)')
    if(size(a, 3) /= size(a_ri, 4)) call aborter (6, 'x4c2r: size(a, 3) does not match size(a_ri, 4)')
    if(size(a, 4) /= size(a_ri, 5)) call aborter (6, 'x4c2r: size(a, 4) does not match size(a_ri, 5)')
    a_ri(1,:,:,:,:) = real(a(:,:,:,:))
    a_ri(2,:,:,:,:) = aimag(a(:,:,:,:))

  end subroutine x4c2r

  subroutine x4r2c(a, a_ri)

    real, dimension(:,:,:,:,:) :: a_ri
    complex, dimension(:,:,:,:) :: a

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x4r2c: size(a, 1) does not match size(a_ri, 2)')
    if(size(a, 2) /= size(a_ri, 3)) call aborter (6, 'x4r2c: size(a, 2) does not match size(a_ri, 3)')
    if(size(a, 3) /= size(a_ri, 4)) call aborter (6, 'x4r2c: size(a, 3) does not match size(a_ri, 4)')
    if(size(a, 4) /= size(a_ri, 5)) call aborter (6, 'x4r2c: size(a, 4) does not match size(a_ri, 5)')
    a(:,:,:,:) = cmplx(a_ri(1,:,:,:,:), a_ri(2,:,:,:,:))

  end subroutine x4r2c

  subroutine x3c2r(a, a_ri)

    complex, dimension(:,:,:) :: a
    real, dimension(:,:,:,:) :: a_ri

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x3c2r: size(a, 1) does not match size(a_ri, 2)')
    if(size(a, 2) /= size(a_ri, 3)) call aborter (6, 'x3c2r: size(a, 2) does not match size(a_ri, 3)')
    if(size(a, 3) /= size(a_ri, 4)) call aborter (6, 'x3c2r: size(a, 3) does not match size(a_ri, 4)')
    a_ri(1,:,:,:) = real(a(:,:,:))
    a_ri(2,:,:,:) = aimag(a(:,:,:))

  end subroutine x3c2r

  subroutine x3r2c(a, a_ri)

    real, dimension(:,:,:,:) :: a_ri
    complex, dimension(:,:,:) :: a

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x3r2c: size(a, 1) does not match size(a_ri, 2)')
    if(size(a, 2) /= size(a_ri, 3)) call aborter (6, 'x3r2c: size(a, 2) does not match size(a_ri, 3)')
    if(size(a, 3) /= size(a_ri, 4)) call aborter (6, 'x3r2c: size(a, 3) does not match size(a_ri, 4)')
    a(:,:,:) = cmplx(a_ri(1,:,:,:), a_ri(2,:,:,:))

  end subroutine x3r2c

  subroutine x2c2r(a, a_ri)

    complex, dimension(:,:) :: a
    real, dimension(:,:,:) :: a_ri

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x2c2r: size(a, 1) does not match size(a_ri, 2)')
    if(size(a, 2) /= size(a_ri, 3)) call aborter (6, 'x2c2r: size(a, 2) does not match size(a_ri, 3)')
    a_ri(1,:,:) = real(a(:,:))
    a_ri(2,:,:) = aimag(a(:,:))

  end subroutine x2c2r

  subroutine x2r2c(a, a_ri)

    real, dimension(:,:,:) :: a_ri
    complex, dimension(:,:) :: a

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x2r2c: size(a, 1) does not match size(a_ri, 2)')
    if(size(a, 2) /= size(a_ri, 3)) call aborter (6, 'x2r2c: size(a, 2) does not match size(a_ri, 3)')
    a(:,:) = cmplx(a_ri(1,:,:), a_ri(2,:,:))

  end subroutine x2r2c

  subroutine x1c2r(a, a_ri)

    complex, dimension(:) :: a
    real, dimension(:,:) :: a_ri

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x2c2r: size(a, 1) does not match size(a_ri, 2)')
    a_ri(1,:) = real(a(:))
    a_ri(2,:) = aimag(a(:))

  end subroutine x1c2r

  subroutine x1r2c(a, a_ri)

    real, dimension(:,:) :: a_ri
    complex, dimension(:) :: a

    if(size(a, 1) /= size(a_ri, 2)) call aborter (6, 'x2r2c: size(a, 1) does not match size(a_ri, 2)')
    a(:) = cmplx(a_ri(1,:), a_ri(2,:))

  end subroutine x1r2c

  Subroutine Aborter(iunit,ierrmsg)
!----------------------------------------------------------------------
!  ABORT A PROGRAM AFTER A FATAL ERROR CONDITION IS DETECTED.
!
!
! input: iunit  Unit Number of the file to write error messages to.
!        ierrmsg  An error message to write ilunerr
!
!       The advantage of using this subroutine is that it will
!       generate a traceback showing the chain of subroutines which
!       eventually bombed, and it forces an arithmetic error which
!       the job control system can detect as a fatal error.
!
    character ierrmsg*(*)
    common /abortcmn/ zz0,zz1
!
! zz0 is in a common block to prevent an optimizing compiler
! from evaluating 1.0/zz0 during compilation rather than during
! execution.
!
    write(iunit,1001)
1001 format(//' %ABORTER:  ** FATAL ERROR.  ABORT SUBROUTINE CALLED **'//)
  
    write(iunit,1002)ierrmsg
1002 format(1x,a,//)

! on CRAY's and VAXes:
! generate a divide-by-zero error:
    zz1=1.0/zz0         !^
    ilunerr=5           !^

! on the DecStation:
!^      call exit(1)

    write(ilunerr,1010) zz0
1010 format(' ?ABORTER-- ZZ0= ',1PE11.4,' AND STILL EXECUTING...')

  end subroutine aborter

end module convert