source: LMDZ6/trunk/libf/phylmd/rrtm/gridpoint_buffers.F90 @ 3592

MODULE GRIDPOINT_BUFFERS

!     Purpose.
!     --------
!           GRIDPOINT_BUFFERS defines the type "gridpoint buffer",
!           and the operations to create and destroy instances of
!           the type.

!     Author.
!     -------
!        Mike Fisher *ECMWF*

!     Modifications.
!     --------------
!        Original : 1999-11-10
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCT0   , ONLY : NPRINTLEV , LALLOPR
USE YOMGEM   , ONLY : NGPTOT
USE YOMLUN   , ONLY : NULOUT

IMPLICIT NONE
SAVE

PRIVATE
PUBLIC gridpoint_buffer, &
 & ALLOCATE_GRIDPOINT_BUFFER, &
 & ALLOCATED_GRIDPOINT_BUFFER, &
 & DEALLOCATE_GRIDPOINT_BUFFER  

TYPE gridpoint_buffer 
CHARACTER(LEN=1), POINTER :: CLNAME(:)
INTEGER(KIND=JPIM) :: IFIELDS
INTEGER(KIND=JPIM) :: IDGEN
INTEGER(KIND=JPIM) :: IDGENL
INTEGER(KIND=JPIM) :: IBLEN
INTEGER(KIND=JPIM) :: IPACK
LOGICAL   :: LFILLED
REAL(KIND=JPRB),    POINTER :: GPBUF(:)
END TYPE gridpoint_buffer

#include "abor1.intfb.h"

!-----------------------------------------------------------------------

CONTAINS
SUBROUTINE ALLOCATE_GRIDPOINT_BUFFER (CDNAME,YDGPBUF,KFIELDS,KPACK, &
                                &     KGPTOT)

TYPE (gridpoint_buffer),INTENT(OUT)        :: YDGPBUF
CHARACTER(LEN=*) , INTENT(IN)  :: CDNAME
INTEGER(KIND=JPIM)        , INTENT(IN)  :: KFIELDS,KPACK
INTEGER(KIND=JPIM)        , INTENT(IN),OPTIONAL  :: KGPTOT

INTEGER(KIND=JPIM)   ::   J, IGPTOT
REAL(KIND=JPRB)      :: ZDUM
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:ALLOCATE_GRIDPOINT_BUFFER',0,ZHOOK_HANDLE)

IF(PRESENT(KGPTOT))THEN
   IGPTOT=KGPTOT
ELSE
   IGPTOT=NGPTOT
ENDIF

ALLOCATE (YDGPBUF%CLNAME(LEN(CDNAME)))

DO J=1,LEN(CDNAME)
  YDGPBUF%CLNAME(J)  = CDNAME(J:J)
ENDDO

YDGPBUF%IFIELDS = KFIELDS
YDGPBUF%IPACK   = KPACK

IF (KPACK > 1) CALL ABOR1('ALLOCATE_GRIDPOINT_BUFFER: KPACK > 1')
YDGPBUF%IBLEN = IGPTOT  * KFIELDS

ALLOCATE (YDGPBUF%GPBUF(YDGPBUF%IBLEN))
IF (NPRINTLEV >= 1.OR. LALLOPR) &
 & WRITE(NULOUT,91) CDNAME,SIZE(YDGPBUF%GPBUF),SHAPE(YDGPBUF%GPBUF)  
YDGPBUF%GPBUF(:) = HUGE(ZDUM)
YDGPBUF%LFILLED = .FALSE.

IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:ALLOCATE_GRIDPOINT_BUFFER',1,ZHOOK_HANDLE)
91  FORMAT(1X,'ALLOCATED GRIDPOINT BUFFER ',A,', SIZE=',I8,', SHAPE=',7I8)
END SUBROUTINE ALLOCATE_GRIDPOINT_BUFFER

SUBROUTINE DEALLOCATE_GRIDPOINT_BUFFER (YDGPBUF)
TYPE (gridpoint_buffer),INTENT(INOUT) :: YDGPBUF
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:DEALLOCATE_GRIDPOINT_BUFFER',0,ZHOOK_HANDLE)
IF (NPRINTLEV >= 1.OR. LALLOPR) &
 & WRITE(NULOUT,92) (YDGPBUF%CLNAME(J),J=1,SIZE(YDGPBUF%CLNAME))  

DEALLOCATE (YDGPBUF%GPBUF)
DEALLOCATE (YDGPBUF%CLNAME)
YDGPBUF%LFILLED = .FALSE.

IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:DEALLOCATE_GRIDPOINT_BUFFER',1,ZHOOK_HANDLE)
92  FORMAT(1X,'DEALLOCATED GRIDPOINT BUFFER:,',100A1)
END SUBROUTINE DEALLOCATE_GRIDPOINT_BUFFER

LOGICAL FUNCTION ALLOCATED_GRIDPOINT_BUFFER (YDGPBUF)
TYPE (gridpoint_buffer),INTENT(IN) :: YDGPBUF
ALLOCATED_GRIDPOINT_BUFFER =  ASSOCIATED (YDGPBUF%GPBUF)
END FUNCTION ALLOCATED_GRIDPOINT_BUFFER

END MODULE GRIDPOINT_BUFFERS