Philippe 26/06/2024: IO_Field_read: 4D, 5D and 6D fields: ensure that data can...

Philippe 26/06/2024: IO_Field_read: 4D, 5D and 6D fields: ensure that data can not be overwritten in case of read error

src/LIB/SURCOUCHE/src/mode_allocbuff.f90

@@ -19,9 +19,9 @@ PRIVATE
 INTERFACE ALLOCBUFFER_ll
   MODULE PROCEDURE                                                                                              &
     ALLOCBUFFER_X1, ALLOCBUFFER_NEW_X1, ALLOCBUFFER_X2, ALLOCBUFFER_NEW_X2, ALLOCBUFFER_X3, ALLOCBUFFER_NEW_X3, &
-    ALLOCBUFFER_X4, ALLOCBUFFER_X5, ALLOCBUFFER_X6, &
+    ALLOCBUFFER_X4, ALLOCBUFFER_NEW_X4, ALLOCBUFFER_X5, ALLOCBUFFER_NEW_X5, ALLOCBUFFER_X6, ALLOCBUFFER_NEW_X6, &
     ALLOCBUFFER_N1, ALLOCBUFFER_NEW_N1, ALLOCBUFFER_N2, ALLOCBUFFER_NEW_N2, ALLOCBUFFER_N3, ALLOCBUFFER_NEW_N3, &
-    ALLOCBUFFER_N4,                                                                          &
+    ALLOCBUFFER_N4, ALLOCBUFFER_NEW_N4,                                                                         &
     ALLOCBUFFER_L1, ALLOCBUFFER_NEW_L1
 END INTERFACE
 
@@ -236,6 +236,35 @@ CASE default
 END SELECT
 END SUBROUTINE ALLOCBUFFER_N4
 
+SUBROUTINE ALLOCBUFFER_NEW_N4( KTAB_OUT, KTAB_IN, HDIR )
+  USE MODD_IO, ONLY: LPACK, L2D
+  !
+  INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(OUT) :: KTAB_OUT
+  INTEGER, DIMENSION(:,:,:,:),              INTENT(IN)  :: KTAB_IN
+  CHARACTER(LEN=*),                         INTENT(IN)  :: HDIR
+
+  INTEGER :: IIMAX, IJMAX
+
+  SELECT CASE(HDIR)
+  CASE('XX')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(KTAB_OUT(IIMAX+2*JPHEXT,SIZE(KTAB_IN,2),SIZE(KTAB_IN,3),SIZE(KTAB_IN,4)))
+  CASE('YY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(KTAB_OUT(IJMAX+2*JPHEXT,SIZE(KTAB_IN,2),SIZE(KTAB_IN,3),SIZE(KTAB_IN,4)))
+  CASE('XY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    IF (LPACK .AND. L2D) THEN
+      ! 2D compact case
+      ALLOCATE(KTAB_OUT(IIMAX+2*JPHEXT,1,SIZE(KTAB_IN,3),SIZE(KTAB_IN,4)))
+    ELSE
+      ALLOCATE(KTAB_OUT(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT,SIZE(KTAB_IN,3),SIZE(KTAB_IN,4)))
+    END IF
+  CASE default
+    ALLOCATE( KTAB_OUT, MOLD = KTAB_IN )
+  END SELECT
+END SUBROUTINE ALLOCBUFFER_NEW_N4
+
 SUBROUTINE ALLOCBUFFER_L1(LTAB_P,LTAB,HDIR,OALLOC)
 !
 LOGICAL,DIMENSION(:),POINTER           :: LTAB_P
@@ -541,6 +570,34 @@ CASE default
 END SELECT
 END SUBROUTINE ALLOCBUFFER_X4
 
+SUBROUTINE ALLOCBUFFER_NEW_X4( PTAB_OUT, PTAB_IN, HDIR )
+  USE MODD_IO, ONLY: LPACK, L2D
+  !
+  REAL, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(OUT) :: PTAB_OUT
+  REAL, DIMENSION(:,:,:,:),              INTENT(IN)  :: PTAB_IN
+  CHARACTER(LEN=*),                      INTENT(IN)  :: HDIR
+
+  INTEGER :: IIMAX,IJMAX
+
+  SELECT CASE(HDIR)
+  CASE('XX')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,SIZE(PTAB_IN,2),SIZE(PTAB_IN,3),SIZE(PTAB_IN,4)))
+  CASE('YY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(PTAB_OUT(IJMAX+2*JPHEXT,SIZE(PTAB_IN,2),SIZE(PTAB_IN,3),SIZE(PTAB_IN,4)))
+  CASE('XY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    IF (LPACK .AND. L2D) THEN ! 2D compact case
+      ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,1,SIZE(PTAB_IN,3),SIZE(PTAB_IN,4)))
+    ELSE
+      ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT,SIZE(PTAB_IN,3),SIZE(PTAB_IN,4)))
+    END IF
+  CASE default
+    ALLOCATE( PTAB_OUT, MOLD = PTAB_IN )
+  END SELECT
+END SUBROUTINE ALLOCBUFFER_NEW_X4
+
 SUBROUTINE ALLOCBUFFER_X5(PTAB_P,PTAB,HDIR,OALLOC)
 USE MODD_IO, ONLY: LPACK, L2D
 !
@@ -579,6 +636,34 @@ CASE default
 END SELECT
 END SUBROUTINE ALLOCBUFFER_X5
 
+SUBROUTINE ALLOCBUFFER_NEW_X5( PTAB_OUT, PTAB_IN, HDIR )
+  USE MODD_IO, ONLY: LPACK, L2D
+  !
+  REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(OUT) :: PTAB_OUT
+  REAL, DIMENSION(:,:,:,:,:),              INTENT(IN)  :: PTAB_IN
+  CHARACTER(LEN=*),                        INTENT(IN)  :: HDIR
+
+  INTEGER :: IIMAX,IJMAX
+
+  SELECT CASE(HDIR)
+  CASE('XX')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,SIZE(PTAB_IN,2),SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5)))
+  CASE('YY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(PTAB_OUT(IJMAX+2*JPHEXT,SIZE(PTAB_IN,2),SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5)))
+  CASE('XY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    IF (LPACK .AND. L2D) THEN ! 2D compact case
+      ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,1,SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5)))
+    ELSE
+      ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT,SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5)))
+    END IF
+  CASE default
+    ALLOCATE( PTAB_OUT, MOLD = PTAB_IN )
+  END SELECT
+END SUBROUTINE ALLOCBUFFER_NEW_X5
+
 SUBROUTINE ALLOCBUFFER_X6(PTAB_P,PTAB,HDIR,OALLOC)
 USE MODD_IO, ONLY: LPACK, L2D
 !
@@ -617,7 +702,32 @@ CASE default
 END SELECT
 END SUBROUTINE ALLOCBUFFER_X6
 
-END MODULE MODE_ALLOCBUFFER_ll
+SUBROUTINE ALLOCBUFFER_NEW_X6( PTAB_OUT, PTAB_IN, HDIR )
+  USE MODD_IO, ONLY: LPACK, L2D
+  !
+  REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE, INTENT(OUT) :: PTAB_OUT
+  REAL, DIMENSION(:,:,:,:,:,:),              INTENT(IN)  :: PTAB_IN
+  CHARACTER(LEN=*),                        INTENT(IN)  :: HDIR
 
+  INTEGER :: IIMAX,IJMAX
 
+  SELECT CASE(HDIR)
+  CASE('XX')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,SIZE(PTAB_IN,2),SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5),SIZE(PTAB_IN,6)))
+  CASE('YY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    ALLOCATE(PTAB_OUT(IJMAX+2*JPHEXT,SIZE(PTAB_IN,2),SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5),SIZE(PTAB_IN,6)))
+  CASE('XY')
+    CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+    IF (LPACK .AND. L2D) THEN ! 2D compact case
+      ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,1,SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5),SIZE(PTAB_IN,6)))
+    ELSE
+      ALLOCATE(PTAB_OUT(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT,SIZE(PTAB_IN,3),SIZE(PTAB_IN,4),SIZE(PTAB_IN,5),SIZE(PTAB_IN,6)))
+    END IF
+  CASE default
+    ALLOCATE( PTAB_OUT, MOLD = PTAB_IN )
+  END SELECT
+END SUBROUTINE ALLOCBUFFER_NEW_X6
 
+END MODULE MODE_ALLOCBUFFER_ll