| [1989] | 1 | MODULE GRIDPOINT_BUFFERS |
|---|
| 2 | |
|---|
| 3 | ! Purpose. |
|---|
| 4 | ! -------- |
|---|
| 5 | ! GRIDPOINT_BUFFERS defines the type "gridpoint buffer", |
|---|
| 6 | ! and the operations to create and destroy instances of |
|---|
| 7 | ! the type. |
|---|
| 8 | |
|---|
| 9 | ! Author. |
|---|
| 10 | ! ------- |
|---|
| 11 | ! Mike Fisher *ECMWF* |
|---|
| 12 | |
|---|
| 13 | ! Modifications. |
|---|
| 14 | ! -------------- |
|---|
| 15 | ! Original : 1999-11-10 |
|---|
| 16 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning |
|---|
| 17 | |
|---|
| 18 | ! ------------------------------------------------------------------ |
|---|
| 19 | |
|---|
| 20 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
|---|
| 21 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
|---|
| 22 | |
|---|
| 23 | USE YOMCT0 , ONLY : NPRINTLEV , LALLOPR |
|---|
| 24 | USE YOMGEM , ONLY : NGPTOT |
|---|
| 25 | USE YOMLUN , ONLY : NULOUT |
|---|
| 26 | |
|---|
| 27 | IMPLICIT NONE |
|---|
| 28 | SAVE |
|---|
| 29 | |
|---|
| 30 | PRIVATE |
|---|
| 31 | PUBLIC gridpoint_buffer, & |
|---|
| 32 | & ALLOCATE_GRIDPOINT_BUFFER, & |
|---|
| 33 | & ALLOCATED_GRIDPOINT_BUFFER, & |
|---|
| 34 | & DEALLOCATE_GRIDPOINT_BUFFER |
|---|
| 35 | |
|---|
| 36 | TYPE gridpoint_buffer |
|---|
| 37 | CHARACTER(LEN=1), POINTER :: CLNAME(:) |
|---|
| 38 | INTEGER(KIND=JPIM) :: IFIELDS |
|---|
| 39 | INTEGER(KIND=JPIM) :: IDGEN |
|---|
| 40 | INTEGER(KIND=JPIM) :: IDGENL |
|---|
| 41 | INTEGER(KIND=JPIM) :: IBLEN |
|---|
| 42 | INTEGER(KIND=JPIM) :: IPACK |
|---|
| 43 | LOGICAL :: LFILLED |
|---|
| 44 | REAL(KIND=JPRB), POINTER :: GPBUF(:) |
|---|
| 45 | END TYPE gridpoint_buffer |
|---|
| 46 | |
|---|
| 47 | #include "abor1.intfb.h" |
|---|
| 48 | |
|---|
| 49 | !----------------------------------------------------------------------- |
|---|
| 50 | |
|---|
| 51 | CONTAINS |
|---|
| 52 | SUBROUTINE ALLOCATE_GRIDPOINT_BUFFER (CDNAME,YDGPBUF,KFIELDS,KPACK, & |
|---|
| 53 | & KGPTOT) |
|---|
| 54 | |
|---|
| 55 | TYPE (gridpoint_buffer),INTENT(OUT) :: YDGPBUF |
|---|
| 56 | CHARACTER(LEN=*) , INTENT(IN) :: CDNAME |
|---|
| 57 | INTEGER(KIND=JPIM) , INTENT(IN) :: KFIELDS,KPACK |
|---|
| 58 | INTEGER(KIND=JPIM) , INTENT(IN),OPTIONAL :: KGPTOT |
|---|
| 59 | |
|---|
| 60 | INTEGER(KIND=JPIM) :: J, IGPTOT |
|---|
| 61 | REAL(KIND=JPRB) :: ZDUM |
|---|
| 62 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
|---|
| 63 | |
|---|
| 64 | IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:ALLOCATE_GRIDPOINT_BUFFER',0,ZHOOK_HANDLE) |
|---|
| 65 | |
|---|
| 66 | IF(PRESENT(KGPTOT))THEN |
|---|
| 67 | IGPTOT=KGPTOT |
|---|
| 68 | ELSE |
|---|
| 69 | IGPTOT=NGPTOT |
|---|
| 70 | ENDIF |
|---|
| 71 | |
|---|
| 72 | ALLOCATE (YDGPBUF%CLNAME(LEN(CDNAME))) |
|---|
| 73 | |
|---|
| 74 | DO J=1,LEN(CDNAME) |
|---|
| 75 | YDGPBUF%CLNAME(J) = CDNAME(J:J) |
|---|
| 76 | ENDDO |
|---|
| 77 | |
|---|
| 78 | YDGPBUF%IFIELDS = KFIELDS |
|---|
| 79 | YDGPBUF%IPACK = KPACK |
|---|
| 80 | |
|---|
| 81 | IF (KPACK > 1) CALL ABOR1('ALLOCATE_GRIDPOINT_BUFFER: KPACK > 1') |
|---|
| 82 | YDGPBUF%IBLEN = IGPTOT * KFIELDS |
|---|
| 83 | |
|---|
| 84 | ALLOCATE (YDGPBUF%GPBUF(YDGPBUF%IBLEN)) |
|---|
| 85 | IF (NPRINTLEV >= 1.OR. LALLOPR) & |
|---|
| 86 | & WRITE(NULOUT,91) CDNAME,SIZE(YDGPBUF%GPBUF),SHAPE(YDGPBUF%GPBUF) |
|---|
| 87 | YDGPBUF%GPBUF(:) = HUGE(ZDUM) |
|---|
| 88 | YDGPBUF%LFILLED = .FALSE. |
|---|
| 89 | |
|---|
| 90 | IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:ALLOCATE_GRIDPOINT_BUFFER',1,ZHOOK_HANDLE) |
|---|
| 91 | 91 FORMAT(1X,'ALLOCATED GRIDPOINT BUFFER ',A,', SIZE=',I8,', SHAPE=',7I8) |
|---|
| 92 | END SUBROUTINE ALLOCATE_GRIDPOINT_BUFFER |
|---|
| 93 | |
|---|
| 94 | SUBROUTINE DEALLOCATE_GRIDPOINT_BUFFER (YDGPBUF) |
|---|
| 95 | TYPE (gridpoint_buffer),INTENT(INOUT) :: YDGPBUF |
|---|
| 96 | INTEGER(KIND=JPIM) :: J |
|---|
| 97 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
|---|
| 98 | |
|---|
| 99 | IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:DEALLOCATE_GRIDPOINT_BUFFER',0,ZHOOK_HANDLE) |
|---|
| 100 | IF (NPRINTLEV >= 1.OR. LALLOPR) & |
|---|
| 101 | & WRITE(NULOUT,92) (YDGPBUF%CLNAME(J),J=1,SIZE(YDGPBUF%CLNAME)) |
|---|
| 102 | |
|---|
| 103 | DEALLOCATE (YDGPBUF%GPBUF) |
|---|
| 104 | DEALLOCATE (YDGPBUF%CLNAME) |
|---|
| 105 | YDGPBUF%LFILLED = .FALSE. |
|---|
| 106 | |
|---|
| 107 | IF (LHOOK) CALL DR_HOOK('GRIDPOINT_BUFFERS:DEALLOCATE_GRIDPOINT_BUFFER',1,ZHOOK_HANDLE) |
|---|
| 108 | 92 FORMAT(1X,'DEALLOCATED GRIDPOINT BUFFER:,',100A1) |
|---|
| 109 | END SUBROUTINE DEALLOCATE_GRIDPOINT_BUFFER |
|---|
| 110 | |
|---|
| 111 | LOGICAL FUNCTION ALLOCATED_GRIDPOINT_BUFFER (YDGPBUF) |
|---|
| 112 | TYPE (gridpoint_buffer),INTENT(IN) :: YDGPBUF |
|---|
| 113 | ALLOCATED_GRIDPOINT_BUFFER = ASSOCIATED (YDGPBUF%GPBUF) |
|---|
| 114 | END FUNCTION ALLOCATED_GRIDPOINT_BUFFER |
|---|
| 115 | |
|---|
| 116 | END MODULE GRIDPOINT_BUFFERS |
|---|
| 117 | |
|---|
