From 9eb52dd911a02eca4099604e93114bd56311647d Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 21 Jun 2018 09:57:37 +0200
Subject: [PATCH] Philippe 21/06/2018: IO: LFI files are now correct if
MNH_REAL=4
---
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 87 +++++++++++++++++++++++-----
1 file changed, 72 insertions(+), 15 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index b8aad9a4f..8093e10a1 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -6,6 +6,7 @@
MODULE MODE_READWRITE_LFI
! Modifications:
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! Philippe Wautelet: 21/06/2018: read and write correctly if MNH_REAL=4
!
USE MODD_IO_ll
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH
@@ -66,6 +67,7 @@ INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
+REAL,DIMENSION(1) :: ZFIELD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -73,7 +75,11 @@ ILENG = 1
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) PFIELD = TRANSFER(IWORK(IWORK(2)+3),PFIELD)
+IF (GGOOD) THEN
+ !TRANSFER_I8_R works with 1D arrays
+ ZFIELD = TRANSFER_I8_R( (/ IWORK(IWORK(2)+3) /) )
+ PFIELD = ZFIELD(1)
+END IF
!
KRESP=IRESP
!
@@ -107,7 +113,7 @@ ILENG = SIZE(PFIELD)
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) PFIELD = TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD))
+IF (GGOOD) PFIELD = TRANSFER_I8_R(IWORK(IWORK(2)+3:))
!
KRESP=IRESP
!
@@ -141,7 +147,7 @@ ILENG = SIZE(PFIELD)
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) )
+IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
KRESP=IRESP
!
@@ -175,7 +181,7 @@ ILENG = SIZE(PFIELD)
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) )
+IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
KRESP=IRESP
!
@@ -209,7 +215,7 @@ ILENG = SIZE(PFIELD)
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) )
+IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
KRESP=IRESP
!
@@ -243,7 +249,7 @@ ILENG = SIZE(PFIELD)
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) )
+IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
KRESP=IRESP
!
@@ -277,7 +283,7 @@ ILENG = SIZE(PFIELD)
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) )
+IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
KRESP=IRESP
!
@@ -560,6 +566,7 @@ INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
TYPE(TFIELDDATA) :: TZFIELD
INTEGER, DIMENSION(3) :: ITDATE ! date array
+REAL,DIMENSION(1) :: ZTIME
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -596,7 +603,11 @@ ILENG=1
!
CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
-IF (GGOOD) TPDATA%TIME = TRANSFER(IWORK(IWORK(2)+3),TPDATA%TIME)
+IF (GGOOD) THEN
+ !TRANSFER_I8_R works with 1D arrays
+ ZTIME = TRANSFER_I8_R( (/ IWORK(IWORK(2)+3) /) )
+ TPDATA%TIME = ZTIME(1)
+END IF
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
@@ -767,7 +778,7 @@ ILENG = 1
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3) = TRANSFER(PFIELD,IWORK(1))
+ CALL TRANSFER_R_I8( (/PFIELD/) , IWORK(LEN(TPFIELD%CCOMMENT)+3:) )
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X0','field name was truncated to '&
@@ -806,7 +817,7 @@ ILENG = SIZE(PFIELD)
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD))
+ CALL TRANSFER_R_I8(PFIELD,IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X1','field name was truncated to '&
@@ -865,7 +876,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X2','writing '//TRIM(YVARNAM
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD))
+ CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(YVARNAME)
IF( LEN_TRIM(YVARNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X2','field name was truncated to '&
@@ -904,7 +915,7 @@ ILENG = SIZE(PFIELD)
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD))
+ CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X3','field name was truncated to '&
@@ -943,7 +954,7 @@ ILENG = SIZE(PFIELD)
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD))
+ CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X4','field name was truncated to '&
@@ -982,7 +993,7 @@ ILENG = SIZE(PFIELD)
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD))
+ CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X5','field name was truncated to '&
@@ -1021,7 +1032,7 @@ ILENG = SIZE(PFIELD)
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD))
+ CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X6','field name was truncated to '&
@@ -1466,4 +1477,50 @@ END SELECT
!
END SUBROUTINE WRITE_PREPARE
!
+SUBROUTINE TRANSFER_R_I8(PFIELDIN,KFIELDOUT)
+!
+REAL,DIMENSION(:), INTENT(IN) :: PFIELDIN
+INTEGER(KIND=8),DIMENSION(:),INTENT(OUT) :: KFIELDOUT
+!
+INTEGER :: ILENG
+#if (MNH_REAL == 4)
+REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8
+#endif
+!
+ILENG = SIZE(PFIELDIN)
+!
+#if (MNH_REAL == 8)
+ KFIELDOUT(:) = TRANSFER(PFIELDIN,KFIELDOUT(1),ILENG)
+#else
+ ALLOCATE(ZFIELD8(ILENG))
+ ZFIELD8(:) = REAL(PFIELDIN(:),KIND=8)
+ KFIELDOUT(:) = TRANSFER(ZFIELD8,KFIELDOUT(1),ILENG)
+ DEALLOCATE(ZFIELD8)
+#endif
+!
+END SUBROUTINE TRANSFER_R_I8
+!
+FUNCTION TRANSFER_I8_R(KFIELDIN) RESULT(PFIELDOUT)
+!
+INTEGER(KIND=8),DIMENSION(:),INTENT(IN) :: KFIELDIN
+REAL,DIMENSION(SIZE(KFIELDIN)) :: PFIELDOUT
+!
+INTEGER :: ILENG
+#if (MNH_REAL == 4)
+REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8
+#endif
+!
+ILENG = SIZE(PFIELDOUT)
+!
+#if (MNH_REAL == 8)
+ PFIELDOUT(:) = TRANSFER(KFIELDIN,PFIELDOUT(1),ILENG)
+#else
+ ALLOCATE(ZFIELD8(ILENG))
+ ZFIELD8(:) = TRANSFER(KFIELDIN,ZFIELD8(1),ILENG)
+ PFIELDOUT(:) = REAL(ZFIELD8(:),KIND=4)
+ DEALLOCATE(ZFIELD8)
+#endif
+!
+END FUNCTION TRANSFER_I8_R
+!
END MODULE MODE_READWRITE_LFI
--
GitLab