gridpoint_buffers.F90

Go to the documentation of this file.

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