diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90 index 3d4808a06156d6e6e4ebe04a5893f58d9f000c8e..84cd2cce78e516b3d191df67ed39398a391babc8 100644 --- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 +++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90 @@ -11,27 +11,6 @@ ! $Date$ !----------------------------------------------------------------- !----------------------------------------------------------------- -SUBROUTINE TRANSFR(KDEST,KSOURCE,KSIZE) -IMPLICIT NONE -INTEGER :: KSIZE -REAL(KIND=8) , DIMENSION(KSIZE):: KSOURCE -REAL , DIMENSION(KSIZE):: KDEST - -KDEST(:) = KSOURCE(:) - -END SUBROUTINE TRANSFR - -SUBROUTINE TRANSFW(KDEST,KSOURCE,KSIZE) -IMPLICIT NONE -INTEGER :: KSIZE -REAL(KIND=8) , DIMENSION(KSIZE):: KDEST -REAL , DIMENSION(KSIZE):: KSOURCE - -KDEST(:) = KSOURCE(:) - -END SUBROUTINE TRANSFW - - MODULE MODE_READWRITE_LFI ! USE MODD_IO_ll @@ -98,7 +77,7 @@ ILENG = 1 ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) PFIELD = TRANSFER(IWORK(IWORK(2)+3),PFIELD) ! KRESP=IRESP ! @@ -132,7 +111,7 @@ ILENG = SIZE(PFIELD) ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) PFIELD = TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) ! KRESP=IRESP ! @@ -166,7 +145,7 @@ ILENG = SIZE(PFIELD) ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) ) ! KRESP=IRESP ! @@ -200,7 +179,7 @@ ILENG = SIZE(PFIELD) ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) ) ! KRESP=IRESP ! @@ -234,7 +213,7 @@ ILENG = SIZE(PFIELD) ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) ) ! KRESP=IRESP ! @@ -268,7 +247,7 @@ ILENG = SIZE(PFIELD) ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) ) ! KRESP=IRESP ! @@ -302,7 +281,7 @@ ILENG = SIZE(PFIELD) ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) PFIELD = RESHAPE( TRANSFER(IWORK(IWORK(2)+3:),PFIELD,SIZE(PFIELD)) , SHAPE(PFIELD) ) ! KRESP=IRESP ! @@ -608,7 +587,7 @@ ILENG=1 ! CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) ! -IF (GGOOD) CALL TRANSFR(TPDATA%TIME,IWORK(IWORK(2)+3),ILENG) +IF (GGOOD) TPDATA%TIME = TRANSFER(IWORK(IWORK(2)+3),TPDATA%TIME) ! IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) ! @@ -770,7 +749,7 @@ ILENG = 1 CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP) ! IF (IRESP==0) THEN - CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG) + IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3) = TRANSFER(PFIELD,IWORK(1)) 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 '& @@ -809,7 +788,7 @@ ILENG = SIZE(PFIELD) CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP) ! IF (IRESP==0) THEN - CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG) + IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD)) 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 '& @@ -857,7 +836,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 - CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG) + IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD)) 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 '& @@ -896,7 +875,7 @@ ILENG = SIZE(PFIELD) CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP) ! IF (IRESP==0) THEN - CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG) + IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD)) 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 '& @@ -935,7 +914,7 @@ ILENG = SIZE(PFIELD) CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP) ! IF (IRESP==0) THEN - CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG) + IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD)) 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 '& @@ -974,7 +953,7 @@ ILENG = SIZE(PFIELD) CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP) ! IF (IRESP==0) THEN - CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG) + IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD)) 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 '& @@ -1013,7 +992,7 @@ ILENG = SIZE(PFIELD) CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP) ! IF (IRESP==0) THEN - CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG) + IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = TRANSFER(PFIELD,IWORK(1),SIZE(PFIELD)) 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 '& @@ -1385,7 +1364,7 @@ ILENG=1 CALL WRITE_PREPARE(TZFIELD,ILENG,IWORK,ITOTAL,IRESP) ! IF (IRESP==0) THEN - CALL TRANSFW(IWORK(LEN_TRIM(TZFIELD%CCOMMENT)+3),TPDATA%TIME,ILENG) + IWORK(LEN_TRIM(TZFIELD%CCOMMENT)+3) = TRANSFER(TPDATA%TIME,IWORK(1)) YRECFM=TRIM(TZFIELD%CMNHNAME) IF( LEN_TRIM(TZFIELD%CMNHNAME) > LEN(YRECFM) ) & CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_T0','field name was truncated to '&