Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

EXODUS_FOR: Refactor to avoid fortran malloc free #443

Merged
merged 5 commits into from
Mar 13, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion packages/seacas/cmake/FortranSettings.cmake
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ IF (${PROJECT_NAME}_ENABLE_Fortran)
ENDIF()

IF ("${CMAKE_Fortran_COMPILER_ID}" MATCHES "GNU")
SET(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fcray-pointer -fdefault-real-8 -fdefault-integer-8 -fno-range-check")
SET(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fdefault-integer-8 -fno-range-check")
ELSEIF ("${CMAKE_Fortran_COMPILER_ID}" MATCHES "LLVMFlang")
SET(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fdefault-integer-8")
ELSEIF ("${CMAKE_Fortran_COMPILER_ID}" MATCHES "XL")
Expand Down
183 changes: 13 additions & 170 deletions packages/seacas/libraries/exodus_for/src/addrwrap.F
Original file line number Diff line number Diff line change
Expand Up @@ -187,21 +187,14 @@ SUBROUTINE EXGFRM (IDEXO, NFRAME, IDSCF, COORD, ITAGS, IERR)

INTEGER*4 IDEXO4 ! (R)
integer*4 nframe4 ! (R)
integer*4 itags4(1) ! (W)
INTEGER*4 IERR4 ! (W)

POINTER (PITAGS4, ITAGS4)

idexo4 = idexo

NFRAME = EXINQI (IDEXO, EXNCF)
NFRAME4 = NFRAME

CALL I4ALLOC (NFRAME, PITAGS4)

call exgfrm4(idexo4, nframe4, idscf, coord, itags4, ierr4)

CALL I4I8 (NFRAME, PITAGS4, ITAGS)
call exgfrm4(idexo4, nframe4, idscf, coord, itags, ierr4)
ierr = ierr4

END
Expand All @@ -224,19 +217,12 @@ SUBROUTINE EXPFRM (IDEXO, NFRAME, IDSCF, COORD, ITAGS, IERR)

INTEGER*4 IDEXO4 ! (R)
integer*4 nframe4 ! (R)
integer*4 itags4(1) ! (R)
INTEGER*4 IERR4 ! (W)

POINTER (PITAGS4, ITAGS4)

idexo4 = idexo
NFRAME4 = NFRAME

CALL I8I4 (NFRAME, ITAGS, PITAGS4)

call expfrm4(idexo4, nframe4, idscf, coord, itags4, ierr4)

CALL I4FREE (PITAGS4)
call expfrm4(idexo4, nframe4, idscf, coord, itags, ierr4)
ierr = ierr4

END
Expand Down Expand Up @@ -463,24 +449,11 @@ SUBROUTINE EXGECPP (IDEXO, ITYPE, IDELB, COUNTS, IERR)

INTEGER*4 IDEXO4 ! (R)
INTEGER*4 ITYPE4 ! (R)
INTEGER*4 COUNTS4 (1) ! (NUMELB) ! (W)
POINTER (PCOUNTS4, COUNTS4)
INTEGER*4 IERR4 ! (W)

CHARACTER* (MXSTLN) NAMELB

INTEGER NUMELB
INTEGER NUMATR
INTEGER NUMLNK

IDEXO4 = IDEXO
ITYPE4 = ITYPE
CALL EXGELB4 (IDEXO4, IDELB, NAMELB, NUMELB, NUMLNK,
& NUMATR, IERR4)

CALL I4ALLOC (NUMELB, PCOUNTS4)
CALL EXGECPP4 (IDEXO4, ITYPE4, IDELB, COUNTS4, IERR4)
CALL I4I8 (NUMELB, PCOUNTS4, COUNTS)
CALL EXGECPP4 (IDEXO4, ITYPE4, IDELB, COUNTS, IERR4)
IERR = IERR4
END

Expand Down Expand Up @@ -1226,21 +1199,12 @@ SUBROUTINE EXGSSC (IDEXO, IDESS, INCNT, IERR)
INTEGER IERR ! (W)

INTEGER*4 IDEXO4 ! (R)
INTEGER*4 INCNT4 (1) ! (W)
POINTER (PINCNT4, INCNT4)
INTEGER*4 IERR4 ! (W)

INTEGER NDESS
INTEGER NINCNT

IDEXO4 = IDEXO
CALL EXGSP4 (IDEXO4, IDESS, NINCNT, NDESS, IERR4)
CALL I4ALLOC (NINCNT, PINCNT4)

CALL EXGSSC4 (IDEXO4, IDESS, INCNT4, IERR4)

CALL I4I8 (NINCNT, PINCNT4, INCNT)
CALL EXGSSC4 (IDEXO4, IDESS, INCNT, IERR4)
IERR = IERR4

END

SUBROUTINE EXGCSSC (IDEXO, INCNT, IERR)
Expand All @@ -1256,20 +1220,10 @@ SUBROUTINE EXGCSSC (IDEXO, INCNT, IERR)
INTEGER IERR ! (W)

INTEGER*4 IDEXO4 ! (R)
INTEGER*4 INCNT4 (1) ! (W)
POINTER (PINCNT4, INCNT4)
INTEGER*4 IERR4 ! (W)

INTEGER NINCNT

IDEXO4 = IDEXO
NINCNT = EXINQI (IDEXO, EXSSEL)

CALL I4ALLOC (NINCNT, PINCNT4)

CALL EXGCSSC4 (IDEXO4, INCNT4, IERR4)

CALL I4I8 (NINCNT, PINCNT4, INCNT)
CALL EXGCSSC4 (IDEXO4, INCNT, IERR4)
IERR = IERR4
END

Expand Down Expand Up @@ -1402,16 +1356,12 @@ SUBROUTINE EXGVTT (IDEXO, NELBLK, NVAREL, ISEVOK, IERR)
INTEGER*4 IDEXO4 ! (R)
INTEGER*4 NELBLK4 ! (R)
INTEGER*4 NVAREL4 ! (R)
INTEGER*4 ISEVOK4(1) ! (NVAREL,NELBLK) (W)
POINTER (PISEVOK4, ISEVOK4)
INTEGER*4 IERR4 ! (W)

IDEXO4 = IDEXO
NELBLK4 = NELBLK
NVAREL4 = NVAREL
CALL I4ALLOC (NVAREL*NELBLK, PISEVOK4)
CALL EXGVTT4 (IDEXO4, NELBLK4, NVAREL4, ISEVOK4, IERR4)
CALL I4I8 (NVAREL*NELBLK, PISEVOK4, ISEVOK)
CALL EXGVTT4 (IDEXO4, NELBLK4, NVAREL4, ISEVOK, IERR4)
IERR = IERR4
END

Expand All @@ -1431,16 +1381,12 @@ SUBROUTINE EXGNSTT (IDEXO, NBLK, NVAR, ISVOK, IERR)
INTEGER*4 IDEXO4 ! (R)
INTEGER*4 NBLK4 ! (R)
INTEGER*4 NVAR4 ! (R)
INTEGER*4 ISVOK4(1) ! (NVAR,NBLK) (W)
POINTER (PISVOK4, ISVOK4)
INTEGER*4 IERR4 ! (W)

IDEXO4 = IDEXO
NBLK4 = NBLK
NVAR4 = NVAR
CALL I4ALLOC (NVAR*NBLK, PISVOK4)
CALL EXGNSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK4, IERR4)
CALL I4I8 (NVAR*NBLK, PISVOK4, ISVOK)
CALL EXGNSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK, IERR4)
IERR = IERR4
END

Expand All @@ -1460,16 +1406,12 @@ SUBROUTINE EXGSSTT (IDEXO, NBLK, NVAR, ISVOK, IERR)
INTEGER*4 IDEXO4 ! (R)
INTEGER*4 NBLK4 ! (R)
INTEGER*4 NVAR4 ! (R)
INTEGER*4 ISVOK4(1) ! (NVAR,NBLK) (W)
POINTER (PISVOK4, ISVOK4)
INTEGER*4 IERR4 ! (W)

IDEXO4 = IDEXO
NBLK4 = NBLK
NVAR4 = NVAR
CALL I4ALLOC (NVAR*NBLK, PISVOK4)
CALL EXGSSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK4, IERR4)
CALL I4I8 (NVAR*NBLK, PISVOK4, ISVOK)
CALL EXGSSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK, IERR4)
IERR = IERR4
END

Expand Down Expand Up @@ -1900,25 +1842,12 @@ SUBROUTINE EXPECPP (IDEXO, ITYPE, IDELB, COUNTS, IERR)

INTEGER*4 IDEXO4 ! (R)
INTEGER*4 ITYPE4 ! (R)
INTEGER*4 COUNTS4 (1) ! (NUMELB) ! (R)
POINTER (PCOUNTS4, COUNTS4)
INTEGER*4 IERR4 ! (W)

CHARACTER* (MXSTLN) NAMELB

INTEGER NUMELB
INTEGER NUMLNK
INTEGER NUMATR

IDEXO4 = IDEXO
ITYPE4 = ITYPE

CALL EXGELB4 (IDEXO4, IDELB, NAMELB, NUMELB, NUMLNK,
& NUMATR, IERR4)

CALL I8I4 (NUMELB, COUNTS, PCOUNTS4)
CALL EXPECPP4 (IDEXO4, ITYPE4, IDELB, COUNTS4, IERR4)
CALL I4FREE (PCOUNTS4)
CALL EXPECPP4 (IDEXO4, ITYPE4, IDELB, COUNTS, IERR4)
IERR = IERR4
END

Expand Down Expand Up @@ -2526,16 +2455,12 @@ SUBROUTINE EXPVTT (IDEXO, NELBLK, NVAREL, ISEVOK, IERR)
INTEGER*4 IDEXO4 ! (R)
INTEGER*4 NELBLK4 ! (R)
INTEGER*4 NVAREL4 ! (R)
INTEGER*4 ISEVOK4 (1) ! (NVAREL,NELBLK) (R)
POINTER (PISEVOK4, ISEVOK4)
INTEGER*4 IERR4 ! (W)

IDEXO4 = IDEXO
NELBLK4 = NELBLK
NVAREL4 = NVAREL
CALL I8I4 (NVAREL*NELBLK, ISEVOK, PISEVOK4)
CALL EXPVTT4 (IDEXO4, NELBLK4, NVAREL4, ISEVOK4, IERR4)
CALL I4FREE (PISEVOK4)
CALL EXPVTT4 (IDEXO4, NELBLK4, NVAREL4, ISEVOK, IERR4)
IERR = IERR4
END

Expand All @@ -2555,16 +2480,12 @@ SUBROUTINE EXPNSTT (IDEXO, NBLK, NVAR, ISVOK, IERR)
INTEGER*4 IDEXO4 ! (R)
INTEGER*4 NBLK4 ! (R)
INTEGER*4 NVAR4 ! (R)
INTEGER*4 ISVOK4 (1) ! (NVAR,NBLK) (R)
POINTER (PISVOK4, ISVOK4)
INTEGER*4 IERR4 ! (W)

IDEXO4 = IDEXO
NBLK4 = NBLK
NVAR4 = NVAR
CALL I8I4 (NVAR*NBLK, ISVOK, PISVOK4)
CALL EXPNSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK4, IERR4)
CALL I4FREE (PISVOK4)
CALL EXPNSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK, IERR4)
IERR = IERR4
END

Expand All @@ -2584,16 +2505,12 @@ SUBROUTINE EXPSSTT (IDEXO, NBLK, NVAR, ISVOK, IERR)
INTEGER*4 IDEXO4 ! (R)
INTEGER*4 NBLK4 ! (R)
INTEGER*4 NVAR4 ! (R)
INTEGER*4 ISVOK4 (1) ! (NVAR,NBLK) (R)
POINTER (PISVOK4, ISVOK4)
INTEGER*4 IERR4 ! (W)

IDEXO4 = IDEXO
NBLK4 = NBLK
NVAR4 = NVAR
CALL I8I4 (NVAR*NBLK, ISVOK, PISVOK4)
CALL EXPSSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK4, IERR4)
CALL I4FREE (PISVOK4)
CALL EXPSSTT4 (IDEXO4, NBLK4, NVAR4, ISVOK, IERR4)
IERR = IERR4
END

Expand Down Expand Up @@ -4088,78 +4005,4 @@ SUBROUTINE EXPPV(idexo, time_step, var_type, var_index,

C-----------------------------------------------------------------------

SUBROUTINE I8I4 (N, I8, PI4)

C CREATE I4 ARRAY AND COPY I8 ARRAY CONTENTS TO I4

IMPLICIT NONE
INTEGER N
INTEGER I8 (*)
INTEGER*4 I4 (1)
POINTER (PI4, I4)
INTEGER I

CALL I4ALLOC (N, PI4)
DO I = 1, N
I4 (I) = I8 (I)
END DO
END

SUBROUTINE I4I8 (N, PI4, I8)

C COPY I4 ARRAY CONTENTS TO I8 AND FREE I4 ARRAY

IMPLICIT NONE
INTEGER N
INTEGER*4 I4 (1)
POINTER (PI4, I4)
INTEGER I8 (*)
INTEGER I

DO I = 1, N
I8 (I) = I4 (I)
END DO
CALL I4FREE (PI4)
END

SUBROUTINE I4ALLOC (N, PI4)

C ALLOCATE DYNAMIC I4 ARRAY N ELEMENTS IN SIZE

IMPLICIT NONE
INTEGER N
INTEGER*4 I4 (1)
POINTER (PI4, I4)
INTEGER MALLOC
INTEGER*4 NB

PI4 = 0
IF (N .EQ. 0) RETURN
NB = N * 4
#if defined(__XLF__)
PI4 = MALLOC (%val(NB))
#else
PI4 = MALLOC (NB)
#endif
if (PI4 .EQ. 0) then
write (*,*)
* 'ERROR: Unable to allocate array of size ',N,' in I4ALLOC'
stop 'Exodus Memory Allocation Error'
end if
END

SUBROUTINE I4FREE (PI4)

C FREE DYNAMIC MEMORY ASSOCIATED WITH I4 ARRAY REFERENCED BY PI4

IMPLICIT NONE
INTEGER*4 I4 (1)
POINTER (PI4, I4)

IF (PI4 .EQ. 0) RETURN
#if !defined(__XLF__)
CALL FREE(PI4)
#endif
PI4 = 0
END
#endif
Loading
Loading