From ce9ab7e74109ba541beb9764f06b98f02c97bb45 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 14 Jan 2021 14:26:00 +0100
Subject: [PATCH] Philippe 14/01/2021: add ALLOCBUFFER_N4 subroutine
---
src/LIB/SURCOUCHE/src/mode_allocbuff.f90 | 49 +++++++++++++++++++++---
1 file changed, 44 insertions(+), 5 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90 b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
index e6d0e9a1a..4f2c3df4b 100644
--- a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
+++ b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
@@ -1,10 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/01/2021: add ALLOCBUFFER_N4 subroutine
!-----------------------------------------------------------------
MODULE MODE_ALLOCBUFFER_ll
@@ -16,10 +17,12 @@ IMPLICIT NONE
PRIVATE
INTERFACE ALLOCBUFFER_ll
- MODULE PROCEDURE ALLOCBUFFER_X1,ALLOCBUFFER_X2,ALLOCBUFFER_X3,&
- & ALLOCBUFFER_X4,ALLOCBUFFER_X5,ALLOCBUFFER_X6,&
- & ALLOCBUFFER_N1,ALLOCBUFFER_N2,ALLOCBUFFER_N3,&
- & ALLOCBUFFER_L1
+ MODULE PROCEDURE &
+ ALLOCBUFFER_X1, ALLOCBUFFER_X2, ALLOCBUFFER_X3, &
+ ALLOCBUFFER_X4, ALLOCBUFFER_X5, ALLOCBUFFER_X6, &
+ ALLOCBUFFER_N1, ALLOCBUFFER_N2, ALLOCBUFFER_N3, &
+ ALLOCBUFFER_N4, &
+ ALLOCBUFFER_L1
END INTERFACE
PUBLIC ALLOCBUFFER_ll
@@ -118,6 +121,42 @@ CASE default
END SELECT
END SUBROUTINE ALLOCBUFFER_N3
+SUBROUTINE ALLOCBUFFER_N4(KTAB_P,KTAB,HDIR,OALLOC)
+USE MODD_IO, ONLY: LPACK, L2D
+!
+INTEGER, DIMENSION(:,:,:,:), POINTER, INTENT(OUT) :: KTAB_P
+INTEGER, DIMENSION(:,:,:,:), TARGET, INTENT(IN) :: KTAB
+CHARACTER(LEN=*), INTENT(IN) :: HDIR
+LOGICAL, INTENT(OUT) :: OALLOC
+
+INTEGER :: IIMAX,IJMAX
+
+SELECT CASE(HDIR)
+CASE('XX')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(KTAB_P(IIMAX+2*JPHEXT,SIZE(KTAB,2),SIZE(KTAB,3)&
+ & ,SIZE(KTAB,4)))
+ OALLOC = .TRUE.
+CASE('YY')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(KTAB_P(IJMAX+2*JPHEXT,SIZE(KTAB,2),SIZE(KTAB,3)&
+ & ,SIZE(KTAB,4)))
+ OALLOC = .TRUE.
+CASE('XY')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ ALLOCATE(KTAB_P(IIMAX+2*JPHEXT,1,SIZE(KTAB,3),SIZE(KTAB,4)))
+ ELSE
+ ALLOCATE(KTAB_P(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT,SIZE(KTAB,3),SIZE(KTAB,4)))
+ END IF
+ OALLOC = .TRUE.
+CASE default
+ KTAB_P=>KTAB
+ OALLOC = .FALSE.
+END SELECT
+END SUBROUTINE ALLOCBUFFER_N4
+
SUBROUTINE ALLOCBUFFER_L1(LTAB_P,LTAB,HDIR,OALLOC)
!
LOGICAL,DIMENSION(:),POINTER :: LTAB_P
--
GitLab