diff --git a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90 b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
index 5dc32693334ef0799c022fe822e030e795fcb2af..21624225f96b1e14542c64c6fabfc490ddcfcf05 100644
--- a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
+++ b/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
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index 56678d5940bc4c78dd51aed52918d5212ab2de9d..5053b5068f78fb97b7ab591a4532411eda47b7ea 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -925,31 +925,27 @@ USE MODD_IO, ONLY: GSMONOPROC, ISP, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
!
-USE MODE_ALLOCBUFFER_ll
USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
-REAL, DIMENSION(:,:,:,:), TARGET, INTENT(INOUT) :: PFIELD ! array containing the data field
-INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
-!
-INTEGER :: IERR
-real, dimension(:,:), pointer :: zfieldp2d
-real, dimension(:,:,:), pointer :: zfieldp3d
-REAL, DIMENSION(:,:,:,:), POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-logical :: glfi, gnc4
-INTEGER :: IRESP
-INTEGER :: IHEXTOT
-class(tfieldmetadata), allocatable :: tzfield
-!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+!
+INTEGER :: IERR
+real, dimension(:,:), allocatable :: zfield2d
+real, dimension(:,:,:), allocatable :: zfield3d
+real, dimension(:,:,:,:), allocatable :: zfield4d
+logical :: glfi, gnc4
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
+class(tfieldmetadata), allocatable :: tzfield
+
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
-!
-GALLOC = .FALSE.
+
IRESP = 0
-ZFIELDP => NULL()
-!
+
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X4',IRESP)
@@ -967,20 +963,20 @@ IF (IRESP==0) THEN
tzfield%ndimlist(3) = tzfield%ndimlist(5) !Necessary if time dimension
tzfield%ndimlist(4:) = NMNHDIM_UNUSED
end if
- zfieldp2d => pfield(jphext+1, jphext+1, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp2d, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp2d, iresp )
- pfield(:, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :), dim = 1, ncopies = ihextot ), &
- dim = 2, ncopies = ihextot )
+ allocate( zfield2d(size(pfield,2), size(pfield,3)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield2d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield2d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:, :, :, :) = Spread( Spread( zfield2d(:, :), dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
else
if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
tzfield%ndimlist(1:2) = NMNHDIM_ONE
end if
- zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
- pfield(:, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :), dim = 1, ncopies = ihextot ), &
- dim = 2, ncopies = ihextot )
+ allocate( zfield4d(1, 1, size(pfield,3), size(pfield,4)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield4d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield4d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:, :, :, :) = Spread( Spread( zfield4d(1,1,:,:), dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
endif
else if ( lpack .and. l2d .and. Size( pfield, 2 ) == ihextot ) then
Allocate( tzfield, source = tpfield )
@@ -992,18 +988,20 @@ IF (IRESP==0) THEN
tzfield%ndimlist(4) = tzfield%ndimlist(5) !Necessary if time dimension
tzfield%ndimlist(5:) = NMNHDIM_UNUSED
end if
- zfieldp3d => pfield(:, jphext + 1, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp3d, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp3d, iresp )
- pfield(:, :, :, :) = Spread( pfield(:, jphext + 1, :, :), dim = 2, ncopies = ihextot )
+ allocate( zfield3d(size(pfield,1), size(pfield,3), size(pfield,4)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield3d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield3d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:, :, :, :) = Spread( zfield3d(:, :, :), dim = 2, ncopies = ihextot )
else
if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
tzfield%ndimlist(2) = NMNHDIM_ONE
end if
- zfieldp => pfield(:, jphext + 1 : jphext + 1, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
- pfield(:,:, :, :) = Spread( pfield(:, jphext + 1, :, :), dim = 2, ncopies = ihextot )
+ allocate( zfield4d(size(pfield,1), 1, size(pfield,3), size(pfield,4)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield4d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield4d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:,:, :, :) = Spread( zfield4d(:, 1, :, :), dim = 2, ncopies = ihextot )
endif
else
if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
@@ -1012,13 +1010,12 @@ IF (IRESP==0) THEN
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
+ call Allocbuffer_ll( zfield4d, pfield, tpfield%cdir )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfield4d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfield4d, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
- ALLOCATE(ZFIELDP(0,0,0,0))
- GALLOC = .TRUE.
+ allocate( zfield4d(0,0,0,0) )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1027,27 +1024,30 @@ IF (IRESP==0) THEN
!because metadata of field has been modified in IO_Field_read_xxx
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
- IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ELSE IF (TPFIELD%CDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X4', '2D not (yet) allowed for parallel execution' )
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:),PFIELD(:,JPHEXT+1,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- PFIELD(:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,zfield4d,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ELSE IF (TPFIELD%CDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X4', '2D not (yet) allowed for parallel execution' )
+ CALL SCATTER_XXFIELD('XX',zfield4d(:,1,:,:),PFIELD(:,JPHEXT+1,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ PFIELD(:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(zfield4d,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ END IF
ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ! Broadcast Field
+ if ( isp == tpfile%nmaster_rank ) pfield(:,:,:,:) = zfield4d(:,:,:,:)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
- ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- END IF
+ end if
END IF
END IF
!
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-!
IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
@@ -1082,30 +1082,26 @@ USE MODD_IO, ONLY: GSMONOPROC, ISP, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
!
-USE MODE_ALLOCBUFFER_ll
USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
-REAL, DIMENSION(:,:,:,:,:), TARGET, INTENT(INOUT) :: PFIELD ! array containing the data field
-INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
+REAL, DIMENSION(:,:,:,:,:), INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
-INTEGER :: IERR
-real, dimension(:,:,:), pointer :: zfieldp3d
-real, dimension(:,:,:,:), pointer :: zfieldp4d
-REAL, DIMENSION(:,:,:,:,:), POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-logical :: glfi, gnc4
-INTEGER :: IRESP
-INTEGER :: IHEXTOT
-class(tfieldmetadata), allocatable :: tzfield
+INTEGER :: IERR
+real, dimension(:,:,:), allocatable :: zfield3d
+real, dimension(:,:,:,:), allocatable :: zfield4d
+real, dimension(:,:,:,:,:), allocatable :: zfield5d
+logical :: glfi, gnc4
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
+class(tfieldmetadata), allocatable :: tzfield
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
-GALLOC = .FALSE.
IRESP = 0
-ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X5',IRESP)
@@ -1115,7 +1111,7 @@ call IO_Format_read_select( tpfile, glfi, gnc4 )
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
if ( lpack .and. l1d .and. Size( pfield, 1 ) == ihextot .and. Size( pfield, 2 ) == ihextot ) then
- Allocate( tzfield, source = tpfield )
+ allocate( tzfield, source = tpfield )
if ( tpfile%ldimreduced ) then
tzfield%ndims = tzfield%ndims - 2
if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
@@ -1125,23 +1121,23 @@ IF (IRESP==0) THEN
tzfield%ndimlist(4) = tzfield%ndimlist(6) !Necessary if time dimension
tzfield%ndimlist(5:) = NMNHDIM_UNUSED
end if
- zfieldp3d => pfield(jphext+1, jphext+1, :, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp3d, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp3d, iresp )
- pfield(:, :, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :, :), dim = 1, ncopies = ihextot ), &
- dim = 2, ncopies = ihextot )
+ allocate( zfield3d(size(pfield,3), size(pfield,4), size(pfield,5)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield3d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield3d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:, :, :, :, :) = Spread( Spread( zfield3d(:, :, :), dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
else
if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
tzfield%ndimlist(1:2) = NMNHDIM_ONE
end if
- zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
- pfield(:, :, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :, :), dim = 1, ncopies = ihextot ), &
- dim = 2, ncopies = ihextot )
+ allocate( zfield5d(1, 1, size(pfield,3), size(pfield,4), size(pfield,5)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield5d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield5d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:, :, :, :, :) = Spread( Spread( zfield5d(1,1,:,:,:), dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
endif
else if ( lpack .and. l2d .and. Size( pfield, 2 ) == ihextot ) then
- Allocate( tzfield, source = tpfield )
+ allocate( tzfield, source = tpfield )
if ( tpfile%ldimreduced ) then
tzfield%ndims = tzfield%ndims - 1
if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
@@ -1151,18 +1147,20 @@ IF (IRESP==0) THEN
tzfield%ndimlist(5) = tzfield%ndimlist(6) !Necessary if time dimension
tzfield%ndimlist(6:) = NMNHDIM_UNUSED
end if
- zfieldp4d => pfield(:, jphext + 1, :, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp4d, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp4d, iresp )
- pfield(:, :, :, :, :) = Spread( pfield(:, jphext + 1, :, :, :), dim = 2, ncopies = ihextot )
+ allocate( zfield4d(size(pfield,1), size(pfield,3), size(pfield,4), size(pfield,5)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield4d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield4d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:, :, :, :, :) = Spread( zfield4d(:, :, :, :), dim = 2, ncopies = ihextot )
else
if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
tzfield%ndimlist(2) = NMNHDIM_ONE
end if
- zfieldp => pfield(:, jphext + 1 : jphext + 1, :, :, :)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
- pfield(:,:, :, :, :) = Spread( pfield(:, jphext + 1, :, :, :), dim = 2, ncopies = ihextot )
+ allocate( zfield5d(size(pfield,1), 1, size(pfield,3), size(pfield,4), size(pfield,5)) )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfield5d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfield5d, iresp )
+ if ( iresp == 0 .or. iresp == -111 ) &
+ pfield(:,:, :, :, :) = Spread( zfield5d(:, 1, :, :, :), dim = 2, ncopies = ihextot )
endif
else
if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
@@ -1171,13 +1169,12 @@ IF (IRESP==0) THEN
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
+ call Allocbuffer_ll( zfield5d, pfield, tpfield%cdir )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfield5d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfield5d, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
- ALLOCATE(ZFIELDP(0,0,0,0,0))
- GALLOC = .TRUE.
+ allocate( zfield5d(0,0,0,0,0) )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1186,27 +1183,30 @@ IF (IRESP==0) THEN
!because metadata of field has been modified in IO_Field_read_xxx
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
- IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ELSE IF (TPFIELD%CDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X5', '2D not (yet) allowed for parallel execution' )
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:,:),PFIELD(:,JPHEXT+1,:,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,zfield5d,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ELSE IF (TPFIELD%CDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X5', '2D not (yet) allowed for parallel execution' )
+ CALL SCATTER_XXFIELD('XX',zfield5d(:,1,:,:,:),PFIELD(:,JPHEXT+1,:,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
+ ELSE
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(zfield5d,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ END IF
ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ! Broadcast Field
+ if ( isp == tpfile%nmaster_rank ) pfield(:,:,:,:,:) = zfield5d(:,:,:,:,:)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
- ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- END IF
+ end if
END IF
END IF
!
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-!
IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
@@ -1240,27 +1240,23 @@ USE MODD_IO, ONLY: GSMONOPROC, ISP
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
!
-USE MODE_ALLOCBUFFER_ll
USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
-REAL, DIMENSION(:,:,:,:,:,:), TARGET, INTENT(INOUT) :: PFIELD ! array containing the data field
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
+REAL, DIMENSION(:,:,:,:,:,:), INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
-INTEGER :: IERR
-REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-logical :: glfi, gnc4
-INTEGER :: IRESP
-INTEGER :: IHEXTOT
+INTEGER :: IERR
+real, dimension(:,:,:,:,:,:), allocatable :: zfield6d
+logical :: glfi, gnc4
+INTEGER :: IRESP
+INTEGER :: IHEXTOT
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
-GALLOC = .FALSE.
IRESP = 0
-ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X6',IRESP)
@@ -1274,13 +1270,12 @@ IF (IRESP==0) THEN
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
- if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
- if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
+ call Allocbuffer_ll( zfield6d, pfield, tpfield%cdir )
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfield6d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfield6d, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
- GALLOC = .TRUE.
+ allocate( zfield6d(0,0,0,0,0,0) )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1289,20 +1284,23 @@ IF (IRESP==0) THEN
!because metadata of field has been modified in IO_Field_read_xxx
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
- IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ELSE IF (TPFIELD%CDIR == 'XY') THEN
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- END IF
+ !Share data only if no error
+ if ( iresp == 0 .or. iresp == -111 ) then
+ IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
+ ! XX or YY Scatter Field
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,zfield6d,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ELSE IF (TPFIELD%CDIR == 'XY') THEN
+ ! XY Scatter Field
+ CALL SCATTER_XYFIELD(zfield6d,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ELSE
+ ! Broadcast Field
+ if ( isp == tpfile%nmaster_rank ) pfield(:,:,:,:,:,:) = zfield6d(:,:,:,:,:,:)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ END IF
+ end if
END IF
END IF
!
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-!
IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP