!
!     file fish.f
!
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 2004 by UCAR                 .
!  .                                                             .
!  .       UNIVERSITY CORPORATION for ATMOSPHERIC RESEARCH       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                      FISHPACK version 5.0                   .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!     *                                                               *
!     *                        F I S H P A C K                        *
!     *                                                               *
!     *                                                               *
!     *     A PACKAGE OF FORTRAN SUBPROGRAMS FOR THE SOLUTION OF      *
!     *                                                               *
!     *      SEPARABLE ELLIPTIC PARTIAL DIFFERENTIAL EQUATIONS        *
!     *                                                               *
!     *                  (Version 5.0 , JUNE 2004)                    *
!     *                                                               *
!     *                             BY                                *
!     *                                                               *
!     *        JOHN ADAMS, PAUL SWARZTRAUBER AND ROLAND SWEET         *
!     *                                                               *
!     *                             OF                                *
!     *                                                               *
!     *         THE NATIONAL CENTER FOR ATMOSPHERIC RESEARCH          *
!     *                                                               *
!     *                BOULDER, COLORADO  (80307)  U.S.A.             *
!     *                                                               *
!     *                   WHICH IS SPONSORED BY                       *
!     *                                                               *
!     *              THE NATIONAL SCIENCE FOUNDATION                  *
!     *                                                               *
!     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
!

!     this module is used by all fishpack solvers to allocate
!     real and complex work space
      MODULE fish

         TYPE fishworkspace
            DOUBLE PRECISION,DIMENSION(:),ALLOCATABLE :: rew
            COMPLEX,DIMENSION(:),ALLOCATABLE :: cxw
         END TYPE fishworkspace

      CONTAINS
         SUBROUTINE allocatfish(irwk,icwk,wsave,ierror)
         IMPLICIT NONE
         TYPE (fishworkspace) :: wsave
!        irwk is the required real work space length
!        icwk is the required integer work space length
         INTEGER, INTENT(IN) :: irwk,icwk
!        ierror is set to 20 if the dynamic allocation is unsuccessful
!        (e.g., this would happen if m,n are too large for the computers memory
         INTEGER, INTENT(INOUT) :: ierror
         INTEGER :: istatus
!        first deallocate to avoid memory leakage
         write(*,*) 'fish.F: allocatfish'
         if(allocated(wsave%rew)) then
            write(*,*) 'allocated wsave%rew, size= ',size(wsave%rew)
            DEALLOCATE(wsave%rew,STAT=istatus)
            write(*,*) 'deallocate wsave%rew, istatus=',istatus
         end if
!        allocate irwk words of real work space
         if (irwk > 0) then
            ALLOCATE(wsave%rew(irwk),STAT = istatus)
            write(*,*) 'fish.F: allocatfish, irwk:',irwk
         end if
!
         if(allocated(wsave%cxw)) then
            write(*,*) 'allocated wsave%cxw, size=',size(wsave%cxw)
            DEALLOCATE(wsave%cxw,STAT=istatus)
            write(*,*) 'deallocate wsave%cxw, istatus=',istatus
         end if
!        allocate icwk words of complex work space
         if (icwk > 0) then
            ALLOCATE(wsave%cxw(icwk),STAT = istatus)
            write(*,*) 'fish.F: allocatfish, icrk:',icwk
         end if
         ierror = 0
!        flag fatal error if allocation fails
         if (istatus .ne. 0 ) then
            ierror = 20
         END IF
         RETURN
        END SUBROUTINE allocatfish

        SUBROUTINE BLK_space(N,M,irwk,icwk)
!       this subroutine computes the real and complex work space
!       requirements (generous estimate) of blktri for N,M values
        IMPLICIT NONE
        INTEGER,INTENT(IN) :: N,M
        INTEGER,INTENT(OUT) :: irwk,icwk
        INTEGER :: L,log2n
!       compute nearest integer greater than or equal to
!       log base 2 of n+1, i.e., log2n is smallest integer
!       such that 2**log2n >= n+1
        log2n = 1
        do
           log2n = log2n+1
           if (n+1 <= 2**log2n) EXIT
        end do
        L = 2**(log2n+1)
        irwk = (log2n-2)*L+5+MAX0(2*N,6*M)+log2n+2*n
        icwk = ((log2n-2)*L+5+log2n)/2+3*M+N
        RETURN
        END SUBROUTINE BLK_space

        SUBROUTINE GEN_space(N,M,irwk)
!       this subroutine computes the real work space
!       requirement (generously) of genbun for the current N,M
        IMPLICIT NONE
        INTEGER,INTENT(IN) :: N,M
        INTEGER,INTENT(OUT) :: irwk
        INTEGER :: log2n
!       compute nearest integer greater than or equal to
!       log base 2 of n+1, i.e., log2n is smallest integer
!       such that 2**log2n >= n+1
        log2n = 1
        do
           log2n = log2n+1
           if (n+1 <= 2**log2n) EXIT
        end do
        irwk = 4*N + (10 + log2n)*M
        RETURN
        END SUBROUTINE GEN_space

        SUBROUTINE fishfin(wsave,ierror)
!       this subroutine releases allocated work space
!       fishfin should be called after a fishpack solver has finished
!       TYPE (fishworkspace) variable wsave.
        IMPLICIT NONE
        TYPE (fishworkspace) :: wsave
        INTEGER,intent(out)  :: ierror
        INTEGER              :: istatus
!
        write(*,*) 'fish.F: fishfin'
        if(allocated(wsave%rew)) then
           write(*,*) 'deallocated wsave%rew, size= ',size(wsave%rew)
           DEALLOCATE(wsave%rew,STAT=istatus)
        end if
        if(allocated(wsave%cxw)) then
           write(*,*) 'deallocated wsave%cxw, size=',size(wsave%cxw)
           DEALLOCATE(wsave%cxw,STAT=istatus)
        end if
! #ifndef G95
         ! if(associated(wsave%rew))DEALLOCATE(wsave%rew)
         ! if(associated(wsave%cxw))DEALLOCATE(wsave%cxw)
! #endif
        if (istatus .ne. 0 ) then
           ierror = 20
        END IF

        END SUBROUTINE fishfin

      END MODULE fish