diff --git a/src/MNH/mode_mnh_zwork.f90 b/src/MNH/mode_mnh_zwork.f90
index 041a5e4409a136c9be2da38a34121366ceb9b05a..fe0e5782319a6c69ecd3bb23f210456dbf4ff5e1 100644
--- a/src/MNH/mode_mnh_zwork.f90
+++ b/src/MNH/mode_mnh_zwork.f90
@@ -19,7 +19,7 @@ MODULE MODE_MNH_ZWORK
!
INTEGER,SAVE :: IJS,IJN, IIW,IIA
!
- INTEGER, SAVE :: IIU,IJU,IKU
+ INTEGER, SAVE :: IIU,IJU,IKU,IIJKU
LOGICAL, SAVE :: GWEST , GEAST
LOGICAL, SAVE :: GSOUTH , GNORTH
@@ -37,7 +37,8 @@ MODULE MODE_MNH_ZWORK
!REAL , ALLOCATABLE, DIMENSION(:,:,:,:) , TARGET :: ZT3D_A1,ZT3D_A2,ZT3D_A3,ZT3D_A4
!REAL , POINTER , DIMENSION(:,:,:,:) :: ZT3D
REAL,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:,:,:) :: ZT3D
-
+
+ REAL,SAVE , ALLOCATABLE, TARGET , DIMENSION(:) :: ZT1D_OSIZE
REAL,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:) :: ZT2D_OSIZE
REAL,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:,:) :: ZT3D_OSIZE
REAL,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:,:,:) :: ZT4D_OSIZE
@@ -53,6 +54,17 @@ MODULE MODE_MNH_ZWORK
INTEGER , ALLOCATABLE, DIMENSION (:) :: NT3D_POOL_G
INTEGER :: NT3D_TOP_G , NT3D_TOP_G_MAX = 0
LOGICAL,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:,:,:) :: GT3D
+
+ INTEGER, parameter :: JPMAX_T3D_I = 4
+ INTEGER , ALLOCATABLE, DIMENSION (:) :: NT3D_POOL_I
+ INTEGER :: NT3D_TOP_I , NT3D_TOP_I_MAX = 0
+ INTEGER,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:,:,:) :: IT3D
+
+ INTEGER, parameter :: JPMAX_T1D_R = 60
+ INTEGER , ALLOCATABLE, DIMENSION (:) :: NT1D_POOL_R
+ INTEGER :: NT1D_TOP_R , NT1D_TOP_R_MAX = 0
+ REAL,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:) :: ZT1D
+
CONTAINS
@@ -76,6 +88,7 @@ CONTAINS
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=NKMAX + 2* JPVEXT
+ IIJKU = IIU*IJU*IKU
!
! Computation bound
!
@@ -113,10 +126,11 @@ CONTAINS
ALLOCATE (ZT3D(IIU,IJU,IKU,JPMAX_T3D))
!$acc enter data create(ZT3D)
+ ALLOCATE (ZT1D_OSIZE(0))
ALLOCATE (ZT2D_OSIZE(IIU,0))
ALLOCATE (ZT3D_OSIZE(IIU,IJU,0))
ALLOCATE (ZT4D_OSIZE(IIU,IJU,IKU,0))
- !$acc enter data create(ZT2D_OSIZE,ZT3D_OSIZE,ZT4D_OSIZE)
+ !$acc enter data create(ZT1D_OSIZE,ZT2D_OSIZE,ZT3D_OSIZE,ZT4D_OSIZE)
ALLOCATE (NT3D_POOL(JPMAX_T3D))
NT3D_TOP = 0
@@ -129,11 +143,33 @@ CONTAINS
ALLOCATE (GT3D(IIU,IJU,IKU,JPMAX_T3D_G))
!$acc enter data create(GT3D)
- ALLOCATE (NT3D_POOL_G(JPMAX_T3D))
+ ALLOCATE (NT3D_POOL_G(JPMAX_T3D_G))
NT3D_TOP_G = 0
- DO JI = 1, JPMAX_T3D
+ DO JI = 1, JPMAX_T3D_G
NT3D_POOL_G(JI) = JI
END DO
+
+!------ Integer pool
+
+ ALLOCATE (IT3D(IIU,IJU,IKU,JPMAX_T3D_I))
+ !$acc enter data create(IT3D)
+
+ ALLOCATE (NT3D_POOL_I(JPMAX_T3D_I))
+ NT3D_TOP_I = 0
+ DO JI = 1, JPMAX_T3D_I
+ NT3D_POOL_I(JI) = JI
+ END DO
+
+!------ Real 1D pool
+
+ ALLOCATE (ZT1D(IIU*IJU*IKU,JPMAX_T1D_R))
+ !$acc enter data create(ZT1D)
+
+ ALLOCATE (NT1D_POOL_R(JPMAX_T1D_R))
+ NT1D_TOP_R = 0
+ DO JI = 1, JPMAX_T1D_R
+ NT1D_POOL_R(JI) = JI
+ END DO
!------ Default values
@@ -145,12 +181,17 @@ CONTAINS
ZUNIT3D = 1.0
ZT3D = XUNDEF
+ ZT1D = XUNDEF
+
+ IT3D = 0.0
+
+ GT3D = .FALSE.
!$acc end kernels
!$acc update host (ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
!$acc update host (ZUNIT3D)
- !$acc update host (ZT3D)
+ !$acc update host (ZT3D,ZT1D)
END IF
@@ -546,6 +587,161 @@ CONTAINS
END FUNCTION MNH_ALLOCATE_GT3D
+ !------------ End Logical Pool
+
+ !-------- Real 1D Pool Managment
+
+ SUBROUTINE MNH_GET_ZT1D_N0(KTEMP)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP
+
+ IF (NT1D_TOP_R == JPMAX_T1D_R ) THEN
+ WRITE( *, '( " MNH_GET_ZT1D_N0: NT1D_TOP_R too big (increaze JPMAX_T1D_R) , NT1D_TOP_R=",I4 )' ) NT1D_TOP_R
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH_GET_ZT1D_N0', 'NT1D_TOP_R too big (increaze JPMAX_T1D_R)' )
+ ELSE
+ NT1D_TOP_R = NT1D_TOP_R + 1
+ KTEMP = NT1D_POOL_R(NT1D_TOP_R)
+ NT1D_POOL_R(NT1D_TOP_R) = - KTEMP
+ IF ( NT1D_TOP_R > NT1D_TOP_R_MAX ) THEN
+ NT1D_TOP_R_MAX = NT1D_TOP_R
+ !WRITE( *, '( " MNH_GET_ZT1D: NT1D_TOP_R_MAX=",I4," KTEMP=",I4 )' ) NT1D_TOP_R_MAX,KTEMP
+ END IF
+ ENDIF
+ !WRITE( *, '( "MNH_GET_ZT1D: reserving ZT1D (",I4,")" )' ) KTEMP
+
+ END SUBROUTINE MNH_GET_ZT1D_N0
+
+ SUBROUTINE MNH_GET_ZT1D(KTEMP1,KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9, &
+ KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP1
+ INTEGER,OPTIONAL :: KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9
+ INTEGER,OPTIONAL :: KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18
+
+ CALL MNH_GET_ZT1D_N0(KTEMP1)
+ IF (PRESENT(KTEMP2)) CALL MNH_GET_ZT1D_N0(KTEMP2)
+ IF (PRESENT(KTEMP3)) CALL MNH_GET_ZT1D_N0(KTEMP3)
+ IF (PRESENT(KTEMP4)) CALL MNH_GET_ZT1D_N0(KTEMP4)
+ IF (PRESENT(KTEMP5)) CALL MNH_GET_ZT1D_N0(KTEMP5)
+ IF (PRESENT(KTEMP6)) CALL MNH_GET_ZT1D_N0(KTEMP6)
+ IF (PRESENT(KTEMP7)) CALL MNH_GET_ZT1D_N0(KTEMP7)
+ IF (PRESENT(KTEMP8)) CALL MNH_GET_ZT1D_N0(KTEMP8)
+ IF (PRESENT(KTEMP9)) CALL MNH_GET_ZT1D_N0(KTEMP9)
+ IF (PRESENT(KTEMP10)) CALL MNH_GET_ZT1D_N0(KTEMP10)
+ IF (PRESENT(KTEMP11)) CALL MNH_GET_ZT1D_N0(KTEMP11)
+ IF (PRESENT(KTEMP12)) CALL MNH_GET_ZT1D_N0(KTEMP12)
+ IF (PRESENT(KTEMP13)) CALL MNH_GET_ZT1D_N0(KTEMP13)
+ IF (PRESENT(KTEMP14)) CALL MNH_GET_ZT1D_N0(KTEMP14)
+ IF (PRESENT(KTEMP15)) CALL MNH_GET_ZT1D_N0(KTEMP15)
+ IF (PRESENT(KTEMP16)) CALL MNH_GET_ZT1D_N0(KTEMP16)
+ IF (PRESENT(KTEMP17)) CALL MNH_GET_ZT1D_N0(KTEMP17)
+ IF (PRESENT(KTEMP18)) CALL MNH_GET_ZT1D_N0(KTEMP18)
+
+ END SUBROUTINE MNH_GET_ZT1D
+
+ SUBROUTINE MNH_REL_ZT1D_N0(KTEMP)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP
+
+ IF ( ( NT1D_TOP_R > JPMAX_T1D_R ) .OR. ( NT1D_TOP_R < 1 ) ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH_REL_ZT1D_N0', 'invalid value for NT1D_TOP_R' )
+ ELSE
+ NT1D_POOL_R(KTEMP) = KTEMP
+ IF (KTEMP == NT1D_TOP_R) THEN
+ NT1D_TOP_R = NT1D_TOP_R - 1
+ ELSE
+ WRITE( *, '( "MNH_REL_ZT1D_N0: invalid value for KTEMP <> NT1D_TOP_R (",2I8,")" )' ) KTEMP, NT1D_TOP_R
+ FLUSH(6)
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH_REL_ZT1D_N0', 'invalid value for KTEMP <> NT1D_TOP_R' )
+ END IF
+ ENDIF
+ !WRITE( *, '( "MNH_REL_ZT1D_N0: releasing ZT1D (",I4,")" )' ) KTEMP
+
+ END SUBROUTINE MNH_REL_ZT1D_N0
+
+ SUBROUTINE MNH_REL_ZT1D(KTEMP1,KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9, &
+ KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18, &
+ KTEMP19,KTEMP20)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP1
+ INTEGER,OPTIONAL :: KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9
+ INTEGER,OPTIONAL :: KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18
+ INTEGER,OPTIONAL :: KTEMP19,KTEMP20
+
+ IF (PRESENT(KTEMP20)) CALL MNH_REL_ZT1D_N0(KTEMP20)
+ IF (PRESENT(KTEMP19)) CALL MNH_REL_ZT1D_N0(KTEMP19)
+ IF (PRESENT(KTEMP18)) CALL MNH_REL_ZT1D_N0(KTEMP18)
+ IF (PRESENT(KTEMP17)) CALL MNH_REL_ZT1D_N0(KTEMP17)
+ IF (PRESENT(KTEMP16)) CALL MNH_REL_ZT1D_N0(KTEMP16)
+ IF (PRESENT(KTEMP15)) CALL MNH_REL_ZT1D_N0(KTEMP15)
+ IF (PRESENT(KTEMP14)) CALL MNH_REL_ZT1D_N0(KTEMP14)
+ IF (PRESENT(KTEMP13)) CALL MNH_REL_ZT1D_N0(KTEMP13)
+ IF (PRESENT(KTEMP12)) CALL MNH_REL_ZT1D_N0(KTEMP12)
+ IF (PRESENT(KTEMP11)) CALL MNH_REL_ZT1D_N0(KTEMP11)
+ IF (PRESENT(KTEMP10)) CALL MNH_REL_ZT1D_N0(KTEMP10)
+ IF (PRESENT(KTEMP9)) CALL MNH_REL_ZT1D_N0(KTEMP9)
+ IF (PRESENT(KTEMP8)) CALL MNH_REL_ZT1D_N0(KTEMP8)
+ IF (PRESENT(KTEMP7)) CALL MNH_REL_ZT1D_N0(KTEMP7)
+ IF (PRESENT(KTEMP6)) CALL MNH_REL_ZT1D_N0(KTEMP6)
+ IF (PRESENT(KTEMP5)) CALL MNH_REL_ZT1D_N0(KTEMP5)
+ IF (PRESENT(KTEMP4)) CALL MNH_REL_ZT1D_N0(KTEMP4)
+ IF (PRESENT(KTEMP3)) CALL MNH_REL_ZT1D_N0(KTEMP3)
+ IF (PRESENT(KTEMP2)) CALL MNH_REL_ZT1D_N0(KTEMP2)
+ CALL MNH_REL_ZT1D_N0(KTEMP1)
+
+ END SUBROUTINE MNH_REL_ZT1D
+
+ FUNCTION MNH_ALLOCATE_ZT1D(PTAB,KI) RESULT (KINDEX)
+
+ REAL, POINTER, CONTIGUOUS , DIMENSION(:), INTENT(INOUT) :: PTAB
+ INTEGER , INTENT(IN) :: KI
+ INTEGER :: KINDEX
+
+ !local
+
+ IF (KI .EQ. IIU) THEN
+ CALL MNH_GET_ZT1D_N0(KINDEX)
+ PTAB => ZT1D(:,KINDEX)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'GEN', 'MNH_ALLOCATE_ZT1D', ' Size mismatsh ' )
+ END IF
+ !WRITE( *, '( "MNH_ALLOCATE_ZT1D: KI=(",I4,") , KINDEX=(",I4,")" )' ) KI,KINDEX
+ !FLUSH(6)
+
+ END FUNCTION MNH_ALLOCATE_ZT1D
+
+ FUNCTION MNH_ALLOCATE_ZT1DP(PTAB,KI) RESULT (KINDEX)
+
+ REAL, POINTER, CONTIGUOUS , DIMENSION(:), INTENT(INOUT) :: PTAB
+ INTEGER , INTENT(IN) :: KI
+ INTEGER :: KINDEX
+
+ !local
+
+ IF (KI .LE. IIJKU) THEN
+ CALL MNH_GET_ZT1D_N0(KINDEX)
+ IF (KI .NE. 0) THEN
+ PTAB(1:KI) => ZT1D(:,KINDEX)
+ ELSE
+ PTAB => ZT1D_OSIZE
+ END IF
+ ELSE
+ call Print_msg( NVERB_ERROR, 'GEN', 'MNH_ALLOCATE_ZT1DP', ' Size mismatsh ' )
+ END IF
+ !WRITE( *, '( "MNH_ALLOCATE_ZT1DP: KI=(",I9,") , KINDEX=(",I4,")" )' ) KI,KINDEX
+
+ END FUNCTION MNH_ALLOCATE_ZT1DP
+
+ ! End Real 1D management
+
SUBROUTINE MNH_CHECK_IN_ZT3D(HSUB)
IMPLICIT NONE