diff --git a/CMakeLists.txt b/CMakeLists.txt index 94b6e28..2ce3d4b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -6,21 +6,18 @@ cmake_minimum_required (VERSION 3.7.2) set (libMeshb_VERSION_MAJOR 7) -set (libMeshb_VERSION_MINOR 54) +set (libMeshb_VERSION_MINOR 80) project(libMeshb VERSION ${libMeshb_VERSION_MAJOR}.${libMeshb_VERSION_MINOR} LANGUAGES C) option(WITH_GMF_AIO "Use Unix low-level and asynchronous I/O for higher speed" OFF) option(WITH_GMF_CPACK "Enable cpack target to generate a zip file containing binaries" OFF) -option(WITH_GMF_FORTRAN "Build the Fortran API" ON ) +option(WITH_GMF_CTEST "Enable ctest ti run basic validation tests" OFF) include (CheckLanguage) check_language (Fortran) -if(CMAKE_Fortran_COMPILER AND WITH_GMF_FORTRAN) +if(CMAKE_Fortran_COMPILER) enable_language(Fortran) set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/modules) - if (CMAKE_Fortran_COMPILER_ID STREQUAL GNU) - set (CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy") - endif () endif() if (NOT CMAKE_BUILD_TYPE) @@ -71,6 +68,12 @@ install (DIRECTORY sample_meshes DESTINATION share/libMeshb) # SET PACKAGE AND DEPLOYMENT VARIABLES ###################################### +if(WITH_GMF_CTEST) + enable_testing() + include_directories(${PROJECT_SOURCE_DIR}/testing) + add_subdirectory(testing) +endif() + if (WITH_GMF_CPACK) include (InstallRequiredSystemLibraries) set (CPACK_GENERATOR TXZ) @@ -112,6 +115,6 @@ install(FILES message("-- Build mode : " ${CMAKE_BUILD_TYPE}) message("-- cpack target enabled : " ${WITH_GMF_CPACK}) +message("-- ctest target enabled : " ${WITH_GMF_CTEST}) message("-- Asynchronous IO : " ${WITH_GMF_AIO}) -message("-- Fortran API : " ${WITH_GMF_FORTRAN}) message("-- Install directory : " ${CMAKE_INSTALL_PREFIX}) diff --git a/Documentation/fortran_api.md b/Documentation/fortran_api.md new file mode 100644 index 0000000..44d6a3e --- /dev/null +++ b/Documentation/fortran_api.md @@ -0,0 +1,105 @@ +## GENERAL COMMENTS + +Default datatypes throughout the API are 4-byte integers and 8-byte reals except for the library's index, which is an 8-byte integer. + +All procedures' arguments are fixed and no more variable arguments are used. + +The API is provided to access vertices and some elements. Adding new elements if straightforward but other arbitrary keywords need a dedicated API. + +See corresponding C procedures in the main documentation for further information about what these procedures are doing. This readme file is only intended for argument’s description. + + +## GENERAL PURPOSE PROCEDURES + +### gmfopenmeshf77( "filename", mode, version, dimension) + +Calls C GmfOpenMesh() with the same arguments. + +### gmfclosemeshf77(lib) + +Calls C GmfCloseMesh() with the same arguments. + + +### gmfgotokwdf77(lib, kwd) + +Calls C GmfGotoKwd() with the same arguments. + +### gmfstatkwdf77(lib, kwd, NmbTyp, SolSiz, TypTab, HOdeg, HOsiz) + +Calls C GmfStatKwd with the right arguments depending on whether the keyword is regular, HO or a solution. + +From Fortran you need to provide all arguments even if they are not needed. + +### gmfsetkwdf77(lib, kwd, NmbTyp, SolSiz, TypTab, HOdeg, HOsiz) + +Calls C GmfSetKwd with the right arguments depending on whether the keyword is regular, HO or a solution. + +From Fortran you need to provide all arguments even if they are not needed. + +### gmfsethonodesorderingf77(lib, kwd, source-ordering, destination-ordering) + +Calls C GmfSetHONodesOrdering() with the same arguments. + +### gmfgetlinef77(lib, kwd, IntTab, RealTab, Ref) + +Reads a full line of a giver keyword's data. +Right now, the default data kinds are integer*4 and real*8. + +Integer fields are stored in IntTab(), floating point values are stored in DblTab() and if the keyword includes a reference (GmfVertices and all elements), it is stored in Ref. + +Note that even though some keywords don't need all the parameters, you need to provide them all to the function call, use dummy parameters if needed. + +### gmfsetlinef77(lib, kwd, IntTab, RealTab, Ref) + +Writes a full line of a giver keyword's data. +Right now, the default data kinds are integer*4 and real*8. + +Integer fields are stored in IntTab(), floating point values are stored in DblTab() and if the keyword includes a reference (GmfVertices and all elements), it is stored in Ref. + +Note that even though some keywords don't need all the parameters, you need to provide them all to the function call, use dummy parameters if needed. + + +### gmfget blockf77(lib, kwd, BegIdx, EndIdx, MapTyp, MapTab, BegInt, EndInt, BegReal, EndReal, BegRef, EndRef) + +Reads multiple data lines in a row. + +You need to provide tables big enough to store all the data in one huge memory area. + +BegIdx and EndIdx are the first and last line number to be read (1 .. NbElements reads the whole mesh). + +BegInt points to the first entity integer's data. + +EndInt points to the last entity integer's data. + +BegReal points to the first entity REAL*8's data. + +EndReal points to the last entity REAL*8's data. + +BegRef points to the first entity's reference + +EndRef points to the last entity's reference + +Like with gmgetlinef77(), some arguments may be useless depending on the keyword but you need to provide some dummy argument instead. + + +### gmfset blockf77(lib, kwd, BegIdx, EndIdx, MapTyp, MapTab, BegInt, EndInt, BegReal, EndReal, BegRef, EndRef) + +Writes multiple data lines in a row. + +You need to provide tables big enough to store all the data in one huge memory area. + +BegIdx and EndIdx are the first and last line number to be read (1 .. NbElements reads the whole mesh). + +BegInt points to the first entity integer's data. + +EndInt points to the last entity integer's data. + +BegReal points to the first entity REAL*8's data. + +EndReal points to the last entity REAL*8's data. + +BegRef points to the first entity's reference + +EndRef points to the last entity's reference + +Like with gmsetlinef77(), some arguments may be useless depending on the keyword but you need to provide some dummy argument instead. diff --git a/Documentation/libMeshb7.pdf b/Documentation/libMeshb7.pdf index c398e2e..a3098d6 100644 Binary files a/Documentation/libMeshb7.pdf and b/Documentation/libMeshb7.pdf differ diff --git a/Documentation/libMeshb7.tex b/Documentation/libMeshb7.tex index 99bd6eb..830c8b2 100644 --- a/Documentation/libMeshb7.tex +++ b/Documentation/libMeshb7.tex @@ -36,9 +36,9 @@ \begin{flushright} \Large Lo\"ic MAR\'ECHAL / INRIA, Gamma Project\\ -\Large March 2019 \\ -\normalsize Document v1.92 \\ -\normalsize Library v7.60 +\Large February 2024 \\ +\normalsize Document v1.93 \\ +\normalsize Library v7.79 \end{flushright} \end{titlepage} @@ -80,7 +80,7 @@ \subsection{A comprehensive C library} Reading, writing and querying files is easily done by calling a couple of commands which are provided in an ANSI C file ``libmeshb7.c'' and a header file ``libmeshb7.h''. All is needed is compiling those files along with the calling software. -Fortran APIs are also available: ``libmeshb7.ins'' for F77 and F90. +A partial Fortran API is also available: ``libmeshb7.ins'' for F77 and F90. Refer to fortran\_api.md for more information. \subsection{ASCII vs. Binary} @@ -101,6 +101,8 @@ \subsubsection{About performance} The \emph{libMeshb} performs very poorly in ASCII mode, which is more processor bound rather than hard-drive bound. Don't expect more than 5 or 10 MB/s throughput. +Higher performance can be achieved through \emph{asynchronous} and \emph{low-level} I/O. This mode is enabled by setting a flag while compiling: (-DWITH\_GMF\_AIO) and linking with an additional library (-lrt). + \subsubsection{Compatibility issue: little vs. big endian} When it comes to binary storage, the compatibility problem posed by endianness always comes to mind. @@ -467,7 +469,7 @@ \subsubsection{Writing mode} \normalfont \paragraph{Asynchronous Input Output:} -to get best performance out of flash storage SSD (more than a GB/s), the library needs to access the filesystem through low-level functions and perform the reading and processing tasks in parallel using asynchronous I/O. To do so, you need to compile the library with the {\tt -DWITH\_GMF\_AIO} option and link the final executable with the {\tt -lrt} library under Linux. +to get best performance out of flash storage SSD (more than a GB/s), the library needs to access the filesystem through low-level functions and perform the reading and processing tasks in parallel using asynchronous I/O. To do so, you need to compile the library with the {\tt -DWITH\_AIO} option and link the final executable with the {\tt -lrt} library under Linux. \subsection{GmfCloseMesh} diff --git a/LICENSE.txt b/LICENSE.txt index 6df08a8..97e0f51 100644 --- a/LICENSE.txt +++ b/LICENSE.txt @@ -1,6 +1,6 @@ MIT License -Copyright (c) 2001-2022 Loïc Maréchal / INRIA +Copyright (c) 2001-2024 Loïc Maréchal / INRIA Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/README.md b/README.md index 6f63254..273cdc1 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT) -## libMeshb version 7.62 +## libMeshb version 7.80 A library to handle the *.meshb file format. ## Overview @@ -33,14 +33,16 @@ Can call user's own pre and post processing routines in a separate thread while ## Usage The **libMeshb** library is written in *ANSI C*. It is made of a single C file and a header file to be compiled and linked alongside the calling program. -It may be used in C, C++, F77 and F90 programs (Fortran 77 and 90 APIs are provided). +It may be used in C and C++ programs (a partial Fortran77 API is provided). Tested on *Linux*, *macOS*, and *Windows 7->10*. Reading a mesh file is fairly easy: +("triangles.meshb" should be in version 1 with single precision floating points numbers) + ```C++ int64_t LibIdx; -int ver, dim, NmbVer, NmbTri, (*Nodes)[4], *Domains; +int i, ver, dim, NmbVer, NmbTri, (*Nodes)[4], *Domains; float (*Coords)[3]; // Open the mesh file for reading @@ -67,7 +69,7 @@ GmfGotoKwd( LibIdx, GmfTriangles ); // Read each line of triangle data into your own data structures for(i=0;i 3' c Check memory bounds - NmbVer = gmfstatkwd(InpMsh, GmfVertices) + NmbVer = gmfstatkwdf77(InpMsh, GmfVertices, 0, s, t, d, ho) if(NmbVer.gt.n) STOP 'Too many vertices' - NmbQad = gmfstatkwd(InpMsh, GmfQuadrilaterals) + NmbQad = gmfstatkwdf77(InpMsh, GmfQuadrilaterals, 0, s, t, d, ho) if(NmbQad.gt.n) STOP 'Too many quads' print*, 'input mesh : ',NmbVer,' vertices,',NmbQad,'quads' c Read the vertices - res = gmfgotokwd(InpMsh, GmfVertices) + res = gmfgotokwdf77(InpMsh, GmfVertices) do i = 1, NmbVer - res = gmfgetlin(InpMsh, GmfVertices - +, VerTab(1,i), VerTab(2,i), VerTab(3,i), RefTab(i)) + res = gmfgetlinef77(InpMsh, GmfVertices, dummyint(1), + +VerTab(1,i), RefTab(i)) end do c Read the quads - res = gmfgotokwd(InpMsh, GmfQuadrilaterals) + res = gmfgotokwdf77(InpMsh, GmfQuadrilaterals) do i = 1, NmbQad - res = gmfgetlin(InpMsh, GmfQuadrilaterals - +, QadTab(1,i),QadTab(2,i),QadTab(3,i),QadTab(4,i),QadTab(5,i)) + res =gmfgetlinef77(InpMsh, GmfQuadrilaterals, + + QadTab(1,i), dummyreal(1), QadTab(5,i)) end do c Close the quadrilateral mesh - res = gmfclosemesh(InpMsh) + res = gmfclosemeshf77(InpMsh) c ------------------------ c Create a triangular mesh c ------------------------ - OutMsh = gmfopenmesh('tri.mesh', GmfWrite, ver, dim) + OutMsh = gmfopenmeshf77('tri.mesh', GmfWrite, 2, 3) if(OutMsh.eq.0) STOP ' OutMsh = 0' + print*, 'output IDX: ',OutMsh c Set the number of vertices - res = gmfsetkwd(OutMsh, GmfVertices, NmbVer, 0 , 0) + res = gmfsetkwdf77(OutMsh, GmfVertices, NmbVer, 0, t, 0, ho) c Then write them down do i = 1, NmbVer - res = gmfsetlin(InpMsh, GmfVertices - +, VerTab(1,i), VerTab(2,i), VerTab(3,i), RefTab(i)) + res = gmfsetlinef77(OutMsh, GmfVertices, dummyint, + +VerTab(1,i), RefTab(i)) end do c Write the triangles - res = gmfsetkwd(OutMsh, GmfTriangles, 2*NmbQad, 0, 0) + res = gmfsetkwdf77(OutMsh, GmfTriangles, 2*NmbQad, 0, t, 0, ho) do i=1,NmbQad - res = gmfsetlin(InpMsh, GmfTriangles, - + QadTab(1,i),QadTab(2,i),QadTab(3,i),QadTab(5,i)) - res = gmfsetlin(InpMsh, GmfTriangles, - + QadTab(1,i),QadTab(3,i),QadTab(4,i),QadTab(5,i)) + res = gmfsetlinef77(OutMsh, GmfTriangles, + + QadTab(1,i), dummyreal, QadTab(5,i)) +c Modify the quad to build the other triangle's diagonal + QadTab(2,i) = QadTab(3,i); + QadTab(3,i) = QadTab(4,i); + res = gmfsetlinef77(OutMsh, GmfTriangles, + + QadTab(1,i), dummyreal, QadTab(5,i)) end do c Don't forget to close the file - res = gmfclosemesh(OutMsh) + res = gmfclosemeshf77(OutMsh) print*, 'output mesh: ',NmbVer,' vertices,', + 2*NmbQad,'triangles' - end + +c ---------------------- +c Create a solution file +c ---------------------- + + OutMsh = gmfopenmeshf77('tri.sol', GmfWrite, 2, 3) + if(OutMsh.eq.0) STOP ' OutMsh = 0' + print*, 'output IDX: ',OutMsh + +c Set the solution kinds + t(1) = GmfSca; + t(2) = GmfVec; + t(3) = GmfSca; +c Set the number of solutions (one per vertex) + res = gmfsetkwdf77(OutMsh, GmfSolAtVertices, NmbVer, 3, t, 0, ho) + +c Write the dummy solution fields + do i = 1, NmbVer + sol(1) = i + sol(2) = i*2 + sol(3) = i*3 + sol(4) = i*4 + sol(5) = -i + res = gmfsetlinef77(OutMsh, GmfSolAtVertices, + +dummyint, sol, dummyref) + end do + +c Don't forget to close the file + res = gmfclosemeshf77(OutMsh) + + print*, 'output sol: ',NmbVer,' solutions' + + end diff --git a/examples/test_libmeshb.f90 b/examples/test_libmeshb.f90 new file mode 100644 index 0000000..0bfcef8 --- /dev/null +++ b/examples/test_libmeshb.f90 @@ -0,0 +1,194 @@ +! libMeshb 7.79 basic example: +! read a quad mesh, split it into triangles and write the result back +! write an associated dummy .sol file containing some data + +!> A FAIRE ajouter time +!> A FAIRE ajouter iteration +!> A FAIRE ajouter nom des champs + +program test_libmeshb_f90 + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + use iso_fortran_env + use iso_c_binding, only: C_NULL_CHAR + use libmeshb7 + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + implicit none + + integer(int64) :: InpMsh, OutMsh, OutSol + character(80) :: InpFile + character(80) :: OutFile + character(80) :: SolFile + integer(int32) :: i + integer(int32) :: NmbVer,NmbQad,NmbTri,ver,dim,res,kwd + integer(int32) :: NmbField,ho,s,d + integer(int32), pointer :: fields(:) + character(32) , pointer :: fieldsName(:)=>null() + real(real64) , pointer :: sol(:) + real(real64) , pointer :: VerTab(:,:) + integer(int32), pointer :: VerRef( :) + integer(int32), pointer :: QadTab(:,:) + integer(int32), pointer :: QadRef( :) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + print '(/"test_libmeshb_f90")' + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + InpFile='../sample_meshes/quad.mesh' + OutFile='./tri.mesh' + SolFile='./tri.sol' + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Open the quadrilateral mesh file for reading + print '(/"Input Mesh Open : ",a )',trim(InpFile) + + InpMsh=GmfOpenMeshF90(name=trim(InpFile),GmfKey=GmfRead,ver=ver,dim=dim) + + print '( "Input Mesh Idx : ",i0)',InpMsh + print '( "Input Mesh ver : ",i0)',ver + print '( "Input Mesh dim : ",i0)',dim + + if( InpMsh==0 ) stop ' InpMsh = 0' + if( ver<=1 ) stop ' version <= 1' + if( dim/=3 ) stop ' dimension <> 3' + + ! Read the vertices + + NmbVer = GmfstatkwdF90(unit=InpMsh, GmfKey=GmfVertices) + print '( "Input Mesh NmbVer : ",i0)', NmbVer + allocate(VerTab(1:3,1:NmbVer)) + allocate(VerRef( 1:NmbVer)) + + res=GmfGotoKwdF90(unit=InpMsh, GmfKey=GmfVertices) + do i=1,NmbVer + res=GmfGetLineF90(unit=InpMsh, GmfKey=GmfVertices, Tab=VerTab(:,i), Ref=VerRef(i)) + end do + + ! Read the quads + + NmbQad = GmfstatkwdF90(unit=InpMsh, GmfKey=GmfQuadrilaterals) + print '( "Input Mesh NmbQad : ",i0)', NmbQad + allocate(QadTab(1:4,1:NmbQad)) + allocate(QadRef( 1:NmbQad)) + + res=GmfgotokwdF90(unit=InpMsh, GmfKey=GmfQuadrilaterals) + do i=1,NmbQad + res=GmfGetLineF90(unit=InpMsh, GmfKey=GmfQuadrilaterals, Tab=QadTab(:,i), Ref=QadRef(i)) + enddo + + ! Close the quadrilateral mesh + res=GmfCloseMeshF90(unit=InpMsh) + print '("Input Mesh Close : ",a)',trim(InpFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Create a triangular mesh + NmbTri=2*NmbQad + + print '(/"Output Mesh Open : ",a )',trim(OutFile) + + OutMsh=GmfOpenMeshF90(name=trim(OutFile),GmfKey=GmfWrite,ver=ver,dim=dim) + + print '( "Output Mesh Idx : ",i0)',InpMsh + print '( "Output Mesh ver : ",i0)',ver + print '( "Output Mesh dim : ",i0)',dim + if( OutMsh==0 ) STOP ' OutMsh = 0' + + ! Set the number of vertices + res=GmfSetKwdF90(unit=OutMsh, GmfKey=GmfVertices, Nmb=NmbVer) + print '( "Output Mesh NmbVer : ",i0)', NmbVer + + ! Then write them down + do i=1,NmbVer + res=GmfSetLineF90(unit=OutMsh, GmfKey=GmfVertices, Tab=VerTab(:,i), Ref=VerRef(i)) + end do + + ! Write the triangles + res=GmfSetKwdF90(unit=OutMsh, GmfKey=GmfTriangles, Nmb=NmbTri) + print '( "Output Mesh NmbTri : ",i0)', NmbTri + + do i=1,NmbQad + res=GmfSetLineF90(unit=OutMsh, GmfKey=GmfTriangles, Tab=QadTab(1:3,i), Ref=QadRef(i)) + ! Modify the quad to build the other triangle's diagonal + QadTab(2,i) = QadTab(3,i) + QadTab(3,i) = QadTab(4,i) + res=GmfSetLineF90(unit=OutMsh, GmfKey=GmfTriangles, Tab=QadTab(1:3,i), Ref=QadRef(i)) + end do + + ! Don't forget to close the file + res=GmfCloseMeshF90(unit=OutMsh) + print '("Output Mesh Close : ",a)',trim(OutFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Create a solution file + + print '(/"Output Solu Open : ",a )',trim(SolFile) + + OutSol=GmfOpenMeshF90(name=trim(SolFile),GmfKey=GmfWrite,ver=ver,dim=dim) + + print '( "Output Solu Idx : ",i0)',OutSol + print '( "Output Solu ver : ",i0)',ver + print '( "Output Solu dim : ",i0)',dim + if( OutSol==0 ) STOP ' OutSol = 0' + + ! Set the solution kinds + NmbField=3 + allocate( fields (1:NmbField)) + allocate( fieldsName(1:NmbField)) + fields(1:NmbField) = [GmfSca,GmfVec,GmfSca] + fieldsName(1:NmbField)=['sca_1','vec_1','sca_2'] + + !nomDesChamps : block + ! integer :: iField,nChar + ! character(:), pointer :: fieldName=>null() + ! res=GmfSetKwdF90(unit=OutSol, GmfKey=GmfReferenceStrings, Nmb=NmbField) + ! do iField=1,NmbField + ! nChar=len_trim(fieldsName(iField)) ! print '("nChar: ",i0)',nChar + ! allocate(character(len=nChar+3) :: fieldName) + ! write(fieldName,'(a,1x,i0,a)')trim(fieldsName(iField)),iField,C_NULL_CHAR + ! print '("fieldName: ",a)',fieldName + ! + ! !ress=GmfSetLin(unit=OutSol, GmfKey=GmfReferenceStrings, GmfSolAtVertices, 1, fieldName) + ! + ! deallocate(fieldName) + ! enddo + !end block nomDesChamps + + allocate(sol(1:5)) ! 1+ dim+ 1 + print '( "Output Solu NmbVer : ",i0)',NmbVer + print '( "Output Solu nFields : ",i0)',NmbField + print '( "Output Solu fields : ", *(i0,1x))',fields(1:NmbField) + + ! Set the number of solutions (one per vertex) + res=GmfSetKwdF90(unit=OutSol, GmfKey=GmfSolAtVertices, Nmb=NmbVer, d=NmbField, t=fields(1:NmbField), s=0, ho=ho) + + ! Write the dummy solution fields + do i=1,NmbVer + sol( 1)=VerTab(1,i) + sol(2:4)=[VerTab(1,i),VerTab(2,i),0d0] + sol( 5)=VerTab(2,i) + res=GmfSetLineF90(unit=OutMsh, GmfKey=GmfSolAtVertices, dTab=sol(:)) + enddo + + ! Don't forget to close the file + res=GmfCloseMeshF90(unit=OutSol) + print '("Output Solu Close : ",a)',trim(SolFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Cleanning Memory + deallocate(VerTab,VerRef) + deallocate(QadTab,QadRef) + deallocate(fields,fieldsName,sol) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> User Control + print '(/"Control:"/"vizir4 -in ",a," -sol ",a/)',trim(OutFile),trim(SolFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + +end program test_libmeshb_f90 diff --git a/examples/test_libmeshb_HO.f90 b/examples/test_libmeshb_HO.f90 new file mode 100644 index 0000000..25a43f3 --- /dev/null +++ b/examples/test_libmeshb_HO.f90 @@ -0,0 +1,237 @@ +! libMeshb 7 basic example: +! read a Q2 quad mesh while using the automatic HO reordering feature, +! split it into P2 triangles and write the result back using fast block transfer + +program test_libmeshb_HO_f90 + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + use iso_fortran_env + use libmeshb7 + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + implicit none + integer(int64) :: InpMsh, OutMsh, m(1) + character(80) :: InpFile + character(80) :: OutFile + character(80) :: SolFile + integer(int32) :: i,iTria + integer(int32) :: GmfCell,GmfOrd + integer(int32) :: NmbVer,NmbQad,NmbTri,ver,dim,res + real(real64) , pointer :: VerTab(:,:) + integer(int32), pointer :: VerRef( :) + integer(int32), pointer :: QadTab(:,:),QadRef( :) + integer(int32), pointer :: TriTab(:,:),TriRef( :) + integer(int32) :: t(1),d,ho,s + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + print '(/"test_libmeshb_HO_f90")' + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + InpFile='../sample_meshes/quad_q2.mesh' + OutFile='./tri_p2.mesh' + SolFile='./tri_p2.sol' + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Open the quadrilateral mesh file for reading + print '(/"Input Mesh File : ",a )',trim(InpFile) + + ! Open the mesh file and check the version and dimension + InpMsh=GmfOpenMeshF90(name=trim(InpFile),GmfKey=GmfRead,ver=ver,dim=dim) + print '( "Input Mesh Idx : ",i0)',InpMsh + print '( "Input Mesh ver : ",i0)',ver + print '( "Input Mesh dim : ",i0)',dim + + if( InpMsh==0 ) stop ' InpMsh = 0' + if( ver<=1 ) stop ' version <= 1' + if( dim/=3 ) stop ' dimension <> 3' + + ! Read the vertices using a vector of 3 consecutive doubles to store the coordinates + + NmbVer = GmfstatkwdF90(unit=InpMsh, GmfKey=GmfVertices) + print '( "Input Mesh NmbVer: ",i0)', NmbVer + allocate(VerTab(1:3,1:NmbVer)) + allocate(VerRef( 1:NmbVer)) + + res=GmfGetBlockF90( & + & unit=InpMsh ,& + & GmfKey=GmfVertices ,& + & ad0=1 ,& + & ad1=NmbVer ,& + & Tab=VerTab(:,1:NmbVer) ,& + & Ref=VerRef( 1:NmbVer) ) + + do i=1,10 + print '(3x,"ver",i6," xyz:",3(f12.5,1x)," ref: ",i0)',i,VerTab(1:3,i),VerRef(i) + enddo + + ! Read GmfQuadrilateralsQ2 + GmfCell=GmfQuadrilateralsQ2 ! <= + GmfOrd =GmfQuadrilateralsQ2Ordering ! <= + + NmbQad=GmfstatkwdF90(unit=InpMsh,GmfKey=GmfCell) + print '( "Input Mesh NmbQad: ",i0)', NmbQad + allocate(QadTab(1:9,1:NmbQad)) + allocate(QadRef( 1:NmbQad)) + + if( .not. GmfstatkwdF90(unit=InpMsh,GmfKey=GmfOrd)==0 )then + print '("Input Mesh Reordering HO Nodes")' + block + integer :: BasTab(1:2,1:9) + integer :: OrdTab(1:2,1:9) + integer :: ord + integer :: nNode + !> 04 07 03 + !> 08 09 06 + !> 01 05 02 + BasTab(1:2,01)=[0,0] + BasTab(1:2,02)=[2,0] + BasTab(1:2,03)=[2,2] + BasTab(1:2,04)=[0,2] + BasTab(1:2,05)=[1,0] + BasTab(1:2,06)=[2,1] + BasTab(1:2,07)=[1,2] + BasTab(1:2,08)=[0,1] + BasTab(1:2,09)=[1,1] + + print '("Input Mesh Requested Order")' + do i=1,size(BasTab,2) + print '(3x,"uv(",i2.2,")=",2(i2,1x))',i,BasTab(1:2,i) + enddo + + !> Q2 -> ord=2 + ord=2 + nNode=(ord+1)*(ord+1) ! <= + + res=GmfGetBlockF90( & + & unit=InpMsh ,& + & GmfKey=GmfOrd ,& + & ad0=1 ,& + & ad1=nNode ,& + & Tab=OrdTab(:,1:nNode) ) + + print '("Input Mesh Order")' + do i=1,size(OrdTab,2) + print '(3x,"uv(",i2.2,")=",2(i2,1x))',i,OrdTab(1:2,i) + enddo + + res=GmfSetHONodesOrderingF90(unit=InpMsh,GmfKey=GmfCell,BasTab=BasTab,OrdTab=OrdTab) + end block + endif + + ! Read the quads using one single vector of 5 consecutive integers + res=GmfGetBlockF90( & + & unit=InpMsh ,& + & GmfKey=GmfQuadrilateralsQ2,& + & ad0=1 ,& + & ad1=NmbQad ,& + & Tab=QadTab(:,1:) ,& + & Ref=QadRef( 1:) ) + + ! Close the quadrilateral mesh + print '("Input Mesh Close : ",a)',trim(InpFile) + + print '("Input Mesh")' + do i=1,10 !NmbQad + print '(3x,"qad",i6," nd:",9(i6,1x)," ref: ",i0)',i,QadTab(1:9,i),QadRef(i) + enddo + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Convert the quad Q2 mesh into a triangular P2 one + + ! Allocate TriTab and TriRef + NmbTri=2*NmbQad + allocate(TriTab(1:6,1:NmbTri)) + allocate(TriRef( 1:NmbTri)) + + !> 04 07 03 03 04 07 03 + !> 08 09 06 => 09 06 + 08 09 + !> 01 05 02 01 05 02 01 + + !> 03 + !> 06 05 + !> 01 04 02 + do i=1,NmbQad + iTria=2*i-1 + TriTab(1,iTria) = QadTab(1,i) + TriTab(2,iTria) = QadTab(2,i) + TriTab(3,iTria) = QadTab(3,i) + TriTab(4,iTria) = QadTab(5,i) + TriTab(5,iTria) = QadTab(6,i) + TriTab(6,iTria) = QadTab(9,i) + TriRef( iTria) = QadRef( i) + + iTria=2*i + TriTab(1,iTria) = QadTab(1,i) + TriTab(2,iTria) = QadTab(3,i) + TriTab(3,iTria) = QadTab(4,i) + TriTab(4,iTria) = QadTab(9,i) + TriTab(5,iTria) = QadTab(7,i) + TriTab(6,iTria) = QadTab(8,i) + TriRef( iTria) = QadRef( i) + enddo + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Write a triangular mesh + + print '(/"Output Mesh File : ",a )',trim(OutFile) + + print '("Output Mesh")' + do i=1,10 + print '(3x,"tri",i6," nd:",6(i6,1x)," ref: ",i0)',i,TriTab(1:6,i),TriRef(i) + enddo + + ! Open the mesh file and check the version and dimension + OutMsh=GmfOpenMeshF90(name=trim(OutFile),GmfKey=GmfWrite,ver=ver,dim=dim) + print '( "Output Mesh Idx : ",i0)',InpMsh + print '( "Output Mesh ver : ",i0)',ver + print '( "Output Mesh dim : ",i0)',dim + if( OutMsh==0 ) STOP ' OutMsh = 0' + + ! Set the number of vertices + res=GmfSetKwdF90(unit=OutMsh, GmfKey=GmfVertices, Nmb=NmbVer) + print '( "Output Mesh NmbVer: ",i0)', NmbVer + + ! Write them down using separate pointers for each scalar entry + res=GmfSetBlockF90( & + & unit=OutMsh ,& + & GmfKey=GmfVertices ,& + & ad0=1 ,& + & ad1=NmbVer ,& + & Tab=VerTab(:,1:NmbVer),& + & Ref=VerRef( 1:NmbVer) ) + + ! Write the triangles using 4 independant set of arguments + ! for each scalar entry: node1, node2, node3 and reference + res=GmfSetKwdF90(unit=OutMsh, GmfKey=GmfTrianglesP2, Nmb=NmbTri) + print '( "Output Mesh NmbTri: ",i0)', NmbTri + + res=GmfSetBlockF90( & + & unit=OutMsh ,& + & GmfKey=GmfTrianglesP2 ,& + & ad0=1 ,& + & ad1=NmbTri ,& + & Tab=TriTab(:,1:NmbTri),& + & Ref=TriRef( 1:NmbVer) ) + + ! Don't forget to close the file + res=GmfCloseMeshF90(unit=OutMsh) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Cleanning Memory + deallocate(VerTab,VerRef) + deallocate(QadTab,QadRef) + deallocate(TriTab,TriRef) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + print '(/"control:"/"vizir4 -in ",a/)',trim(OutFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + +end program test_libmeshb_HO_f90 + + \ No newline at end of file diff --git a/examples/test_libmeshb_block.f b/examples/test_libmeshb_block.f index baa56da..90640eb 100644 --- a/examples/test_libmeshb_block.f +++ b/examples/test_libmeshb_block.f @@ -1,34 +1,33 @@ -c libMeshb 7.5 example: transform a quadrilateral mesh into a triangular one -c using fast block transfer and pipelined post processing +c libMeshb 7.79 example: transform a quadrilateral mesh into a triangular one +c using fast block transfer include 'libmeshb7.ins' - external qad2tri - integer n parameter (n=4000) - integer i, ver, dim, res + integer i, ver, dim, res, NmbVer, NmbQad +, RefTab(n), TriTab(4,2*n), QadTab(5,n) - integer*8 InpMsh, OutMsh, NmbVer, NmbQad - real*8 VerTab(3,n) + integer t(1),d,ho,s, fooint(1) + integer*8 InpMsh, OutMsh + real*8 VerTab(3,n),foodbl(1) c -------------------------------------------- c Open the quadrilateral mesh file for reading c -------------------------------------------- - InpMsh = gmfopenmesh('../sample_meshes/quad.meshb' + InpMsh = gmfopenmeshf77('../sample_meshes/quad.meshb' +,GmfRead,ver,dim) if(InpMsh.eq.0) STOP ' InpMsh = 0' if(dim.ne.3) STOP ' dimension <> 3' c Check memory bounds - NmbVer = gmfstatkwd(InpMsh, GmfVertices) + NmbVer = gmfstatkwdf77(InpMsh, GmfVertices, 0, s, t, d, ho) if(NmbVer.gt.n) STOP 'Too many vertices' - NmbQad = gmfstatkwd(InpMsh, GmfQuadrilaterals) + NmbQad = gmfstatkwdf77(InpMsh, GmfQuadrilaterals, 0, s, t, d, ho) if(NmbQad.gt.n) STOP 'Too many quads' c Print some information on the open file @@ -40,78 +39,72 @@ c Read the vertices using a vector of 3 consecutive doubles c to store the coordinates - res = gmfgetblock(InpMsh,GmfVertices, - + 1_8, NmbVer, 0, %val(0), %val(0), - + GmfDoubleVec, 3, VerTab(1,1), VerTab(1,NmbVer), - + GmfInt, RefTab( 1), RefTab( NmbVer)) + res = gmfgetblockf77(InpMsh, GmfVertices, + + 1, NmbVer, 0, fooint(1), + + fooint(1), fooint(1), + + VerTab(1,1), VerTab(1,NmbVer), + + RefTab( 1), RefTab( NmbVer)) c Read the quads using one single vector of 5 consecutive integers - res = gmfgetblock(InpMsh,GmfQuadrilaterals, - + 1_8, NmbQad, 0, %val(0), %val(0), - + GmfIntVec, 5, QadTab(1,1), QadTab(1,NmbQad)) + res = gmfgetblockf77(InpMsh, GmfQuadrilaterals, + + 1, NmbQad, 0, fooint(1), + + QadTab(1,1), QadTab(1,NmbQad), + + foodbl(1), foodbl(1), + + QadTab(5,1), QadTab(5,NmbQad)) c Close the quadrilateral mesh - res = gmfclosemesh(InpMsh) + res = gmfclosemeshf77(InpMsh) + + +c ------------------------------------------- +c Convert the quad mesh into a triangular one +c ------------------------------------------- + + do i = 1,2*NmbQad + if(mod(i,2) .EQ. 1) then + TriTab(1,i) = QadTab(1,(i+1)/2) + TriTab(2,i) = QadTab(2,(i+1)/2) + TriTab(3,i) = QadTab(3,(i+1)/2) + TriTab(4,i) = QadTab(5,(i+1)/2) + else + TriTab(1,i) = QadTab(1,(i+1)/2) + TriTab(2,i) = QadTab(3,(i+1)/2) + TriTab(3,i) = QadTab(4,(i+1)/2) + TriTab(4,i) = QadTab(5,(i+1)/2) + endif + end do c ----------------------- c Write a triangular mesh c ----------------------- - OutMsh = gmfopenmesh('tri.meshb', GmfWrite, ver, dim) + OutMsh = gmfopenmeshf77('tri.meshb', GmfWrite, ver, dim) if(OutMsh.eq.0) STOP ' OutMsh = 0' c Set the number of vertices - res = gmfsetkwd(OutMsh, GmfVertices, NmbVer, 0, 0) + res = gmfsetkwdf77(OutMsh, GmfVertices, NmbVer, 0, t, 0, ho) c Write them down using separate pointers for each scalar entry - res = gmfsetblock(OutMsh,GmfVertices, - + 1_8, NmbVer, 0, %val(0), %val(0), - + GmfDouble, VerTab(1,1), VerTab(1,NmbVer), - + GmfDouble, VerTab(2,1), VerTab(2,NmbVer), - + GmfDouble, VerTab(3,1), VerTab(3,NmbVer), - + GmfInt, RefTab(1), RefTab(NmbVer)) + res = gmfsetblockf77(OutMsh, GmfVertices, + + 1, NmbVer, 0, fooint(1), + + fooint(1), fooint(1), + + VerTab(1,1), VerTab(1,NmbVer), + + RefTab(1), RefTab(NmbVer)) c Write the triangles using 4 independant set of arguments c for each scalar entry: node1, node2, node3 and reference - res = gmfsetkwd(OutMsh, GmfTriangles, 2*NmbQad, 0, 0) - res = gmfsetblock(OutMsh, GmfTriangles, - + 1_8, 2*NmbQad, 0, %val(0), - + qad2tri, 2, QadTab, TriTab, - + GmfInt, TriTab(1,1), TriTab(1,2*NmbQad), - + GmfInt, TriTab(2,1), TriTab(2,2*NmbQad), - + GmfInt, TriTab(3,1), TriTab(3,2*NmbQad), - + GmfInt, TriTab(4,1), TriTab(4,2*NmbQad)) + res = gmfsetkwdf77(OutMsh, GmfTriangles, 2*NmbQad, 0, t, 0, ho) + res = gmfsetblockf77(OutMsh, GmfTriangles, + + 1, 2*NmbQad, 0, fooint(1), + + TriTab(1,1), TriTab(1,2*NmbQad), + + foodbl(1), foodbl(1), + + TriTab(4,1), TriTab(4,2*NmbQad)) c Don't forget to close the file - res = gmfclosemesh(OutMsh) + res = gmfclosemeshf77(OutMsh) print*, 'output mesh :',NmbVer,' vertices,', + 2*NmbQad,'triangles' - end - - -c A subroutine that reads quads ans splits them into triangles -c it is executed concurently with the block writing - subroutine qad2tri(BegIdx,EndIdx,QadTab,TriTab) - - integer*8 i,BegIdx,EndIdx - integer TriTab(4,*),QadTab(5,*) - - do i = BegIdx,EndIdx - if(mod(i,2) .EQ. 1) then - TriTab(1,i) = QadTab(1,(i+1)/2) - TriTab(2,i) = QadTab(2,(i+1)/2) - TriTab(3,i) = QadTab(3,(i+1)/2) - TriTab(4,i) = QadTab(5,(i+1)/2) - else - TriTab(1,i) = QadTab(1,(i+1)/2) - TriTab(2,i) = QadTab(3,(i+1)/2) - TriTab(3,i) = QadTab(4,(i+1)/2) - TriTab(4,i) = QadTab(5,(i+1)/2) - endif - end do - - return end diff --git a/examples/test_libmeshb_block.f90 b/examples/test_libmeshb_block.f90 new file mode 100644 index 0000000..e47b856 --- /dev/null +++ b/examples/test_libmeshb_block.f90 @@ -0,0 +1,274 @@ +! libMeshb 7.79 example: transform a quadrilateral mesh into a triangular one +! using fast block transfer + +program test_libmeshb_block_f90 + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + use iso_fortran_env + use libmeshb7 + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + implicit none + integer(int64) :: InpMsh, OutMsh, OutSol + character(80) :: InpFile + character(80) :: OutFile + character(80) :: SolFile + integer :: i + integer :: NmbVer,NmbQad,NmbTri,ver,dim,res + real(real64) , pointer :: VerTab(:,:) + integer , pointer :: VerRef( :) + integer , pointer :: QadTab(:,:),QadRef( :) + integer , pointer :: TriTab(:,:),TriRef( :) + integer(int32) :: NmbField,ho,s,d + integer(int32), pointer :: fields(:) + character(32) , pointer :: fieldsName(:)=>null() + real(real64) , pointer :: solTab(:,:) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + print '(/"test_libmeshb_block_f90")' + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + InpFile='../sample_meshes/quad.mesh' + OutFile='./tri.meshb' + SolFile='./tri.solb' + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Open the quadrilateral mesh file for reading + print '(/"Input Mesh Open : ",a )',trim(InpFile) + + ! Open the mesh file and check the version and dimension + InpMsh=GmfOpenMeshF90(name=trim(InpFile),GmfKey=GmfRead,ver=ver,dim=dim) + + print '( "Input Mesh Idx : ",i0)',InpMsh + print '( "Input Mesh ver : ",i0)',ver + print '( "Input Mesh dim : ",i0)',dim + + ! Allocate VerRef + NmbVer = GmfstatkwdF90(unit=InpMsh, GmfKey=GmfVertices) + print '( "Input Mesh NmbVer : ",i0)', NmbVer + allocate(VerTab(1:3,1:NmbVer)) + allocate(VerRef( 1:NmbVer)) + + ! Read the vertices using a vector of 3 consecutive doubles to store the coordinates + res=GmfGetBlockF90( & + & unit=InpMsh ,& + & GmfKey=GmfVertices ,& + & ad0=1 ,& + & ad1=NmbVer ,& + & Tab=VerTab(:,1:NmbVer) ,& + & Ref=VerRef( 1:NmbVer) ) + + do i=1,10 + print '(3x,"ver",i6," xyz:",3(f12.5,1x)," ref: ",i0)',i,VerTab(1:3,i),VerRef(i) + enddo + + ! Allocate QadTab + NmbQad=GmfstatkwdF90(unit=InpMsh, GmfKey=GmfQuadrilaterals) + print '( "Input Mesh NmbQad : ",i0)', NmbQad + allocate(QadTab(1:4,1:NmbQad)) + allocate(QadRef( 1:NmbQad)) + + ! Read the quads using one single vector of 4 consecutive integers + res=GmfGetBlockF90( & + & unit=InpMsh ,& + & GmfKey=GmfQuadrilaterals,& + & ad0=1 ,& + & ad1=NmbQad ,& + & Tab=QadTab(:,1:) ,& + & Ref=QadRef( 1:) ) + + do i=1,10 + print '(3x,"qad",i6," nd:",4(i6,1x)," ref: ",i0)',i,QadTab(1:4,i),QadRef(i) + enddo + + !!> Lecture par tableau 1D sans recopie (interface à écrire en indiquand le stride) + !block + ! use iso_c_binding, only: c_loc,c_f_pointer + ! integer , pointer :: nodes(:) + ! + ! call c_f_pointer(cptr=c_loc(QadTab), fptr=nodes, shape=[4*NmbQad]) !> binding QadTab(:,:) and nodes(:) + ! + ! res=GmfGetElements( & + ! & InpMsh ,& + ! & GmfQuadrilaterals ,& + ! & 1 ,& + ! & NmbQad ,& + ! & 0, m ,& + ! & nodes( 1), nodes(4*NmbQad-3),& + ! & QadRef( 1), QadRef(NmbQad) ) + !end block + + ! Close the quadrilateral mesh + res=GmfCloseMeshF90(unit=InpMsh) + print '("Input Mesh Close : ",a)',trim(InpFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Allocate TriTab and TriRef + NmbTri=2*NmbQad + allocate(TriTab(1:3,1:NmbTri)) + allocate(TriRef( 1:NmbTri)) + + ! Convert the quad mesh into a triangular one + do i=1,NmbTri + if(mod(i,2) .EQ. 1) then + TriTab(1,i) = QadTab(1,(i+1)/2) + TriTab(2,i) = QadTab(2,(i+1)/2) + TriTab(3,i) = QadTab(3,(i+1)/2) + TriRef( i) = QadRef( (i+1)/2) + else + TriTab(1,i) = QadTab(1,(i+1)/2) + TriTab(2,i) = QadTab(3,(i+1)/2) + TriTab(3,i) = QadTab(4,(i+1)/2) + TriRef( i) = QadRef( (i+1)/2) + endif + end do + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Write a triangular mesh + print '(/"Output Mesh Open : ",a )',trim(OutFile) + + OutMsh=GmfOpenMeshF90(name=trim(OutFile),GmfKey=GmfWrite,ver=ver,dim=dim) + + print '( "Output Mesh Idx : ",i0)',InpMsh + print '( "Output Mesh ver : ",i0)',ver + print '( "Output Mesh dim : ",i0)',dim + if(OutMsh==0) STOP ' OutMsh = 0' + + ! Set the number of vertices + res=GmfSetKwdF90(unit=OutMsh, GmfKey=GmfVertices, Nmb=NmbVer) + print '( "Output Mesh NmbVer : ",i0)', NmbVer + + ! Write them down using separate pointers for each scalar entry + res=GmfSetBlockF90( & + & unit=OutMsh ,& + & GmfKey=GmfVertices ,& + & ad0=1 ,& + & ad1=NmbVer ,& + & Tab=VerTab(:,1:NmbVer),& + & Ref=VerRef( 1:NmbVer) ) + + ! Write the triangles using 4 independant set of arguments + ! for each scalar entry: node1, node2, node3 and reference + res=GmfSetKwdF90(unit=OutMsh, GmfKey=GmfTriangles, Nmb=NmbTri) + print '( "Output Mesh NmbTri : ",i0)', NmbTri + + res=GmfSetBlockF90( & + & unit=OutMsh ,& + & GmfKey=GmfTriangles ,& + & ad0=1 ,& + & ad1=NmbTri ,& + & Tab=TriTab(:,1:NmbTri),& + & Ref=TriRef( 1:NmbVer) ) + + !!> Ecriture par tableau 1D sans recopie (interface fortran à écrire) + !block + ! use iso_c_binding, only: c_loc,c_f_pointer + ! integer , pointer :: nodes(:) + ! + ! print '(/"binding TriTab(:,:) and nodes(:)")' + ! + ! call c_f_pointer(cptr=c_loc(TriTab), fptr=nodes, shape=[3*NmbTri]) !> binding TriTab(:,:) and nodes(:) + ! + ! print '(/"Triangle: ",i6)',1 + ! print '( "TriTab:",3(i6,1x) )',TriTab(1,1),TriTab(2,1),TriTab(3,1) + ! print '( "nodes: ",3(i6,1x)/)',nodes(1),nodes(2),nodes(3) + ! print '(/"Triangle: ",i6)',NmbTri + ! print '( "TriTab:",3(i6,1x) )',TriTab(1,NmbTri),TriTab(2,NmbTri),TriTab(3,NmbTri) + ! print '( "nodes: ",3(i6,1x)/)',nodes(3*NmbTri-2),nodes(3*NmbTri-1),nodes(3*NmbTri) + ! + ! res=GmfSetElements( & + ! & InpMsh ,& + ! & GmfTriangles ,& + ! & 1 ,& + ! & NmbTri ,& + ! ! 0, m ,& + ! & 0, c_null_ptr ,& + ! & nodes( 1), nodes(3*NmbTri-2),& + ! & TriRef( 1), TriRef(NmbTri) ) + ! + !end block + + ! Don't forget to close the file + res=GmfCloseMeshF90(unit=OutMsh) + print '("Output Mesh Close : ",a)',trim(OutFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! Create a solution file + + print '(/"Output Solu Open : ",a )',trim(SolFile) + + OutSol=GmfOpenMeshF90(name=trim(SolFile),GmfKey=GmfWrite,ver=ver,dim=dim) + + print '( "Output Solu Idx : ",i0)',OutSol + print '( "Output Solu ver : ",i0)',ver + print '( "Output Solu dim : ",i0)',dim + if( OutSol==0 ) STOP ' OutSol = 0' + + ! Set the solution kinds + NmbField=3 + allocate( fields (1:NmbField)) + allocate( fieldsName(1:NmbField)) + fields(1:NmbField) = [GmfSca,GmfVec,GmfSca] + fieldsName(1:NmbField)=['sca_1','vec_1','sca_2'] + + !nomDesChamps : block + ! integer :: iField,nChar + ! character(:), pointer :: fieldName=>null() + ! res=GmfSetKwdF90(unit=OutSol, GmfKey=GmfReferenceStrings, Nmb=NmbField) + ! do iField=1,NmbField + ! nChar=len_trim(fieldsName(iField)) ! print '("nChar: ",i0)',nChar + ! allocate(character(len=nChar+3) :: fieldName) + ! write(fieldName,'(a,1x,i0,a)')trim(fieldsName(iField)),iField,C_NULL_CHAR + ! print '("fieldName: ",a)',fieldName + ! + ! !ress=GmfSetLin(unit=OutSol, GmfKey=GmfReferenceStrings, GmfSolAtVertices, 1, fieldName) + ! + ! deallocate(fieldName) + ! enddo + !end block nomDesChamps + + allocate(solTab(1:5,NmbVer)) ! 1+ dim+ 1 + print '( "Output Solu NmbVer : ",i0)',NmbVer + print '( "Output Solu nFields : ",i0)',NmbField + print '( "Output Solu fields : ", *(i0,1x))',fields(1:NmbField) + + ! Set the number of solutions (one per vertex) + res=GmfSetKwdF90(unit=OutSol, GmfKey=GmfSolAtVertices, Nmb=NmbVer, d=NmbField, t=fields(1:NmbField), s=0, ho=ho) + + ! Compute the dummy solution fields + do i=1,NmbVer + solTab( 1,i)=VerTab(1,i) + solTab(2:4,i)=[VerTab(1,i),VerTab(2,i),0d0] + solTab( 5,i)=VerTab(2,i) + enddo + + res=GmfSetBlockF90( & + & unit=OutMsh ,& + & GmfKey=GmfSolAtVertices ,& + & ad0=1 ,& + & ad1=NmbVer ,& + & Tab=solTab(:,1:NmbVer) ) + + ! Don't forget to close the file + res=GmfCloseMeshF90(unit=OutSol) + print '("Output Solu Close : ",a)',trim(SolFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Cleanning Memory + deallocate(VerTab,VerRef) + deallocate(QadTab,QadRef) + deallocate(TriTab,TriRef) + deallocate(solTab) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + print '(/"Constrol"/"vizir4 -in ",a," -sol ",a,/)',trim(OutFile),trim(SolFile) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + +end program test_libmeshb_block_f90 \ No newline at end of file diff --git a/examples/test_libmeshb_block_bindC.f90 b/examples/test_libmeshb_block_bindC.f90 new file mode 100644 index 0000000..b8fdeb5 --- /dev/null +++ b/examples/test_libmeshb_block_bindC.f90 @@ -0,0 +1,138 @@ +program test_libmeshb_block_bindC + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + use, intrinsic :: iso_fortran_env + use, intrinsic :: iso_c_binding + use libmeshb7 + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + implicit none + + character(80) :: InpFile + character(80) :: OutFile + + integer(c_long) :: InpMsh + integer(c_long) :: OutMsh + integer(c_int) :: NmbVer + real(c_double), pointer :: VerTab(:,:) + integer(c_int), pointer :: VerRef( :) + integer(c_int) :: NmbQad + integer(c_int) :: ver + integer(c_int) :: dim + type(c_ptr) :: RefTab + type(c_ptr) :: QadTab + type(c_ptr) :: TriTab + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !if(!(InpMsh = GmfOpenMesh("../sample_meshes/quad.meshb", GmfRead, &ver, &dim))) + interface + function GmfOpenMesh(name, Gmf, ver, dim) result(unit) bind(c, name="GmfOpenMesh") + use, intrinsic :: iso_c_binding + type(c_ptr) , value :: name + integer(c_int), value :: Gmf + integer(c_int) :: ver + integer(c_int) :: dim + integer(c_long) :: unit + end function GmfOpenMesh + + function GmfStatKwd(unit, Gmf) result(numb) bind(c, name="GmfStatKwd") + use, intrinsic :: iso_c_binding + integer(c_long), value :: unit + integer(c_int) , value :: Gmf + integer(c_int) :: numb + end function GmfStatKwd + + subroutine GmfSetKwd(unit, Gmf, numb) bind(c, name="GmfSetKwd") + use, intrinsic :: iso_c_binding + integer(c_long), value :: unit + integer(c_int) , value :: Gmf + integer(c_int) :: numb + end subroutine GmfSetKwd + + subroutine GmfCloseMesh(unit) bind(c, name="GmfCloseMesh") + use, intrinsic :: iso_c_binding + integer(c_long), value :: unit + end subroutine GmfCloseMesh + + !GmfGetBlock(InpMsh, GmfVertices, 1, NmbVer, 0, NULL, NULL, + !GmfFloat, &VerTab[1][0], &VerTab[ NmbVer ][0], + !GmfFloat, &VerTab[1][1], &VerTab[ NmbVer ][1], + !GmfFloat, &VerTab[1][2], &VerTab[ NmbVer ][2], + !GmfInt, &RefTab[1], &RefTab[ NmbVer ] ); + + !subroutine GmfGetBlock(unit, Gmf, ) + ! + !end subroutine + + end interface + + + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + InpFile='../sample_meshes/quad.mesh' + OutFile='./tri.mesh' + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !block + ! integer :: nChar + ! character(:), pointer :: nameC=>null() + ! + ! nChar=len_trim(InpFile) !> print '("nChar: ",i0)',nChar + ! allocate(character(len=nChar+1) :: nameC) + ! nameC = trim(InpFile) // C_NULL_CHAR + ! + ! InpMsh=GmfOpenMesh(name=c_loc(nameC), Gmf=GmfRead, ver=ver, dim=dim) + ! + !end block + + InpMsh=GmfOpenMesh(name=convertName(name=InpFile), Gmf=GmfRead, ver=ver, dim=dim) + + print '(/"Input Mesh File: ",a," Idx=",i0," version: ",i0," dim: ",i0)',trim(InpFile),InpMsh,ver,dim + if( InpMsh==0) stop ' InpMsh = 0' + if( ver<=1 ) stop ' version <= 1' + if( dim/=3 ) stop ' dimension <> 3' + + NmbVer=GmfStatKwd(unit=InpMsh, Gmf=GmfVertices) + allocate(VerTab(1:3,1:NmbVer)) + allocate(VerRef( 1:NmbVer)) + print '("vertices : ",i0)', NmbVer + + NmbQad=GmfStatKwd(unit=InpMsh, Gmf=GmfQuadrilaterals) + !allocate(QadTab(1:4,1:NmbQad)) + !allocate(QadRef( 1:NmbQad)) + print '("quads : ",i0)', NmbQad + + + call GmfCloseMesh(unit=InpMsh) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + OutMsh=GmfOpenMesh(name=convertName(name=OutFile), Gmf=GmfWrite, ver=ver, dim=dim) + + print '(/"Output Mesh File: ",a," Idx=",i0," version: ",i0," dim: ",i0)',trim(OutFile),OutMsh,ver,dim + if( OutMsh==0) stop ' OutMsh = 0' + + call GmfSetKwd(unit=OutMsh, Gmf=GmfVertices, numb=NmbVer); + call GmfCloseMesh(unit=OutMsh) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + +contains + + function convertName(name) result (res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + character(*) :: name + integer :: nChar + character(:), pointer :: nameC=>null() + type(c_ptr) :: res + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + nChar=len_trim(name) ! print '("nChar: ",i0)',nChar + allocate(character(len=nChar+1) :: nameC) + nameC=trim(name) // C_NULL_CHAR + res=c_loc(nameC) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function convertName + +end program test_libmeshb_block_bindC diff --git a/examples/test_libmeshb_block_pipeline.f b/examples/test_libmeshb_block_pipeline.f deleted file mode 100644 index e54a85c..0000000 --- a/examples/test_libmeshb_block_pipeline.f +++ /dev/null @@ -1,135 +0,0 @@ - -c libmeshb example: transform a quadrilateral mesh into a triangular one -c using fast block transfer and pipelined post processing - - include 'libmeshb7.ins' - - external qad2tri, movver - - integer n - parameter (n=4000) - integer i, ver, dim, res - +, RefTab(n), TriTab(4,2*n), QadTab(5,n) - integer*8 NmbVer, NmbQad, InpMsh, OutMsh - real*8 VerTab(3,n) - - -c -------------------------------------------- -c Open the quadrilateral mesh file for reading -c -------------------------------------------- - - InpMsh = gmfopenmesh('../sample_meshes/quad.meshb' - +,GmfRead,ver,dim) - print*, 'input mesh :', InpMsh,'version :',ver,'dim :',dim - - if(InpMsh.eq.0) STOP ' InpMsh = 0' - if(dim.ne.3) STOP ' dimension <> 3' - -c Check memory bounds - NmbVer = gmfstatkwd(InpMsh, GmfVertices) - if(NmbVer.gt.n) STOP 'Too many vertices' - - i = gmfstatkwd(InpMsh, GmfSolAtQuadrilaterals) - print*, i,'GmfSolAtQuadrilaterals' - - NmbQad = gmfstatkwd(InpMsh, GmfQuadrilaterals) - if(NmbQad.gt.n) STOP 'Too many quads' - - print*, 'input mesh : ',NmbVer,' vertices,',NmbQad,'quads' - -c Read the vertices - res = gmfgetblock(InpMsh, GmfVertices, 1_8, NmbVer, - + 0, %val(0), movver, 1, VerTab, - + GmfDouble, VerTab(1,1), VerTab(1,2), - + GmfDouble, VerTab(2,1), VerTab(2,2), - + GmfDouble, VerTab(3,1), VerTab(3,2), - + GmfInt, RefTab(1), RefTab(2)) - -c Read the quads - res = gmfgetblock(InpMsh, GmfQuadrilaterals, 1_8, NmbQad, - + 0, %val(0), %val(0), - + GmfInt, QadTab(1,1), QadTab(1,2), - + GmfInt, QadTab(2,1), QadTab(2,2), - + GmfInt, QadTab(3,1), QadTab(3,2), - + GmfInt, QadTab(4,1), QadTab(4,2), - + GmfInt, QadTab(5,1), QadTab(5,2)) - -c Close the quadrilateral mesh - res = gmfclosemesh(InpMsh) - print*, QadTab(1,1),QadTab(2,1),QadTab(3,1),QadTab(4,1) - - -c ------------------------ -c Create a triangular mesh -c ------------------------ - - OutMsh = gmfopenmesh('tri.meshb', GmfWrite, ver, dim) - if(OutMsh.eq.0) STOP ' OutMsh = 0' - -c Set the number of vertices - res = gmfsetkwd(OutMsh, GmfVertices, NmbVer, 0 , 0) - -c Then write them down - res = gmfsetblock(OutMsh, GmfVertices, 1_8, NmbVer, - + 0, %val(0) ,%val(0), - + GmfDouble, VerTab(1,1), VerTab(1,2), - + GmfDouble, VerTab(2,1), VerTab(2,2), - + GmfDouble, VerTab(3,1), VerTab(3,2), - + GmfInt, RefTab(1), RefTab(2)) - -c Write the triangles - res = gmfsetkwd(OutMsh, GmfTriangles, 2*NmbQad, 0, 0) - res = gmfsetblock(OutMsh, GmfTriangles, 1_8, 2*NmbQad, - + 0,%val(0), - + qad2tri, 2, QadTab, TriTab, - + GmfInt, TriTab(1,1), TriTab(1,2), - + GmfInt, TriTab(2,1), TriTab(2,2), - + GmfInt, TriTab(3,1), TriTab(3,2), - + GmfInt, TriTab(4,1), TriTab(4,2)) - -c Don't forget to close the file - res = gmfclosemesh(OutMsh) - - print*, 'output mesh : ',NmbVer,' vertices,', - + 2*NmbQad,'triangles' - - end - - - - subroutine qad2tri(BegIdx,EndIdx,QadTab,TriTab) - - integer*8 i,BegIdx,EndIdx - integer TriTab(4,*),QadTab(5,*) - print*, 'beg : ',BegIdx, 'end : ', EndIdx - - do i = BegIdx,EndIdx - if(mod(i,2) .EQ. 1) then - TriTab(1,i) = QadTab(1,i/2) - TriTab(2,i) = QadTab(2,i/2) - TriTab(3,i) = QadTab(3,i/2) - TriTab(4,i) = QadTab(5,i/2) - else - TriTab(1,i) = QadTab(1,i/2) - TriTab(2,i) = QadTab(3,i/2) - TriTab(3,i) = QadTab(4,i/2) - TriTab(4,i) = QadTab(5,i/2) - endif - end do - - return - end - - - subroutine movver(BegIdx,EndIdx,VerTab) - - integer*8 i,BegIdx,EndIdx - real*8 VerTab(3,*) - print*, 'beg : ',BegIdx, 'end : ', EndIdx - - do i = BegIdx,EndIdx - VerTab(1,i) = VerTab(1,i)*2 - end do - - return - end diff --git a/examples/test_libmeshb_sol.c b/examples/test_libmeshb_sol.c index fe69c07..5e85c9f 100644 --- a/examples/test_libmeshb_sol.c +++ b/examples/test_libmeshb_sol.c @@ -1,5 +1,5 @@ -// libMeshb 7.5 basic example: read a general purpose solution file +// libMeshb 7.66 basic example: read a general purpose solution file #include #include @@ -8,37 +8,72 @@ int main() { - int i, j, NmbSol, ver, dim, SolSiz, NmbTyp, TypTab[ GmfMaxTyp ]; - long long InpMsh; - double *SolTab; + int i, j, NmbSolLin, ver, dim, TotSolSiz, NmbSolTyp, SolTypTab[ GmfMaxTyp ]; + int DatTypTab[10], DatSizTab[10]; + int64_t MshIdx; + double *SolTab; + char *DatBegTab[10], *DatEndTab[10]; + char *TypStr[5] = {"", "GmfSca", "GmfVec", "GmfSymMat", "GmfMat"}; // Open the "out.sol" mesh file - if(!(InpMsh = GmfOpenMesh("../sample_meshes/out.sol", GmfRead, &ver, &dim))) + if(!(MshIdx = GmfOpenMesh("../sample_meshes/out.sol", GmfRead, &ver, &dim))) return(1); - printf("InpMsh: idx = %lld, version = %d, dimension = %d\n", InpMsh, ver, dim); + printf("MshIdx: idx = %lld, version = %d, dimension = %d\n", MshIdx, ver, dim); if(ver < 2) return(1); // Read the number vertices and associated solution size for memory allocation - NmbSol = (int)GmfStatKwd(InpMsh, GmfSolAtVertices, &NmbTyp, &SolSiz, TypTab); - printf("NmbSol = %d, NmbTyp = %d, SolSiz = %d\n", NmbSol, NmbTyp, SolSiz); - SolTab = malloc( (NmbSol+1) * SolSiz * sizeof(double)); - printf("SolTab: %p -> %p\n", SolTab, SolTab+(NmbSol+1) * SolSiz * sizeof(double)); + NmbSolLin = GmfStatKwd(MshIdx, GmfSolAtVertices, &NmbSolTyp, &TotSolSiz, SolTypTab); + printf("NmbSol = %d, NmbTyp = %d, SolSiz = %d\n", NmbSolLin, NmbSolTyp, TotSolSiz); + for(i=0;i $) @@ -12,30 +17,10 @@ install (TARGETS Meshb.7 EXPORT meshb-target DESTINATION lib COMPONENT libraries install (EXPORT meshb-target NAMESPACE ${PROJECT_NAME}:: DESTINATION lib/cmake/${PROJECT_NAME}) install (TARGETS Meshb.7 EXPORT libMeshb-target DESTINATION lib COMPONENT libraries) -install (EXPORT libMeshb-target DESTINATION lib/cmake/${PROJECT_NAME}) -export (PACKAGE libMeshb) +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) -#################################### -# BUILD THE LIBRARY WITH FORTRAN API -#################################### +install (EXPORT libMeshb-target DESTINATION lib/cmake/${PROJECT_NAME}) +export (PACKAGE libMeshb) -if (CMAKE_Fortran_COMPILER AND WITH_GMF_FORTRAN) - file(GLOB_RECURSE SOURCES *.[chfF] *.[fF]90) - add_library(Meshbf.7 STATIC ${SOURCES}) - set_target_properties(Meshbf.7 PROPERTIES COMPILE_FLAGS "-DF77API") - target_include_directories(Meshbf.7 - INTERFACE ${CMAKE_CURRENT_BINARY_DIR} - PRIVATE ${CMAKE_CURRENT_BINARY_DIR} - PRIVATE ${CMAKE_BINARY_DIR} - PUBLIC ${CMAKE_SOURCE_DIR} ) - - install(FILES libmeshb7.ins DESTINATION include) - - install(TARGETS Meshbf.7 - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - PUBLIC_HEADER DESTINATION include - ARCHIVE DESTINATION lib) -endif () diff --git a/sources/libmeshb7.c b/sources/libmeshb7.c index d2fa30d..bc737fa 100644 --- a/sources/libmeshb7.c +++ b/sources/libmeshb7.c @@ -2,14 +2,14 @@ /*----------------------------------------------------------------------------*/ /* */ -/* LIBMESHB V7.62 */ +/* LIBMESHB V7.80 */ /* */ /*----------------------------------------------------------------------------*/ /* */ /* Description: handles .meshb file format I/O */ /* Author: Loic MARECHAL */ /* Creation date: dec 09 1999 */ -/* Last modification: jan 07 2022 */ +/* Last modification: feb 27 2024 */ /* */ /*----------------------------------------------------------------------------*/ @@ -21,28 +21,11 @@ // Silent Visual Studio warnings on string functions #define _CRT_SECURE_NO_WARNINGS -#ifdef F77API - // Add a final underscore to Fortran procedure names #ifdef F77_NO_UNDER_SCORE -#define NAMF77(c,f) f -#define APIF77(x) x -#else -#define NAMF77(c,f) f ## _ -#define APIF77(x) x ## _ -#endif - -// Pass parameters as pointers in Fortran -#define VALF77(v) *v -#define TYPF77(t) t* - +#define APIF77(x) x #else - -// Pass parameters as values in C -#define NAMF77(c,f) c -#define VALF77(v) v -#define TYPF77(t) t - +#define APIF77(x) x ## _ #endif @@ -144,7 +127,7 @@ int my_aio_write ( struct aiocb *aiocbp){return(aio_write (aiocbp));} struct aiocb { FILE *aio_fildes; // File descriptor - off_t aio_offset; // File offset + size_t aio_offset; // File offset void *aio_buf; // Location of buffer size_t aio_nbytes; // Length of transfer int aio_lio_opcode; // Operation to be performed @@ -158,7 +141,7 @@ int my_aio_error(const struct aiocb *aiocbp) // Set the file position and read a block of data int my_aio_read(struct aiocb *aiocbp) { - if( (MYFSEEK(aiocbp->aio_fildes, (off_t)aiocbp->aio_offset, SEEK_SET) == 0) + if( (MYFSEEK(aiocbp->aio_fildes, (size_t)aiocbp->aio_offset, SEEK_SET) == 0) && (fread(aiocbp->aio_buf, 1, aiocbp->aio_nbytes, aiocbp->aio_fildes) == aiocbp->aio_nbytes) ) { @@ -180,7 +163,7 @@ size_t my_aio_return(struct aiocb *aiocbp) // Set the file position and write a block of data int my_aio_write(struct aiocb *aiocbp) { - if( (MYFSEEK(aiocbp->aio_fildes, (off_t)aiocbp->aio_offset, SEEK_SET) == 0) + if( (MYFSEEK(aiocbp->aio_fildes, (size_t)aiocbp->aio_offset, SEEK_SET) == 0) && (fwrite(aiocbp->aio_buf, 1, aiocbp->aio_nbytes, aiocbp->aio_fildes) == aiocbp->aio_nbytes) ) { @@ -209,13 +192,13 @@ int my_aio_write(struct aiocb *aiocbp) #define RegKwd 2 #define SolKwd 3 #define CmtKwd 4 +#define F77Kwd 5 #define WrdSiz 4 #define FilStrSiz 64 #define BufSiz 10000L #define MaxArg 20 - /*----------------------------------------------------------------------------*/ /* Structures */ /*----------------------------------------------------------------------------*/ @@ -223,7 +206,7 @@ int my_aio_write(struct aiocb *aiocbp) typedef struct { int typ, deg, NmbNod, SolSiz, NmbWrd, NmbTyp, TypTab[ GmfMaxTyp ]; - int *OrdTab; + int *OrdTab, NmbInt, NmbDbl; int64_t NmbLin; size_t pos; char fmt[ GmfMaxTyp*9 ]; @@ -231,7 +214,7 @@ typedef struct typedef struct { - int dim, ver, mod, typ, cod, FilDes, FltSiz; + int dim, ver, mod, typ, cod, FilDes, FltSiz, SolTypSiz[5]; int64_t NexKwdPos, siz; size_t pos; jmp_buf err; @@ -470,12 +453,33 @@ const char *GmfKwdFmt[ GmfMaxKwd + 1 ][3] = {"PyramidsGID", "i", "iii"}, {"PrismsGID", "i", "iii"}, {"HexahedraGID", "i", "iii"}, + {"SolAtBoundaryPolygons", "i", "sr"}, + {"SolAtPolyhedra", "i", "sr"}, + {"VertexOnGeometryNode", "i", "iiiiii"}, + {"VertexOnGeometryEdge", "i", "iiiiirdrii"}, + {"EdgeOnGeometryEdge", "i", "iiiiiii"}, + {"VertexOnGeometryFace", "i", "iiiiirrdrii"}, + {"EdgeOnGeometryFace", "i", "iiiiiii"}, + {"TriangleOnGeometryFace", "i", "iiiiiii"}, + {"QuadrialteralOnGeometryFace", "i", "iiiiiii"}, + {"MeshOnGeometry", "i", "iiiiiidrdrii"} }; #ifdef TRANSMESH int GmfMaxRefTab[ GmfMaxKwd + 1 ]; #endif +static char F77RefFlg[ GmfMaxKwd + 1 ] = +{ + 0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,0,1,0,0,0, + 0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0 +}; + /*----------------------------------------------------------------------------*/ /* Prototypes of local procedures */ @@ -495,9 +499,6 @@ static void SwpWrd (char *, int); static int SetFilPos(GmfMshSct *, int64_t); static int64_t GetFilPos(GmfMshSct *msh); static int64_t GetFilSiz(GmfMshSct *); -#ifdef F77API -static void CalF77Prc(int64_t, int64_t, void *, int, void **); -#endif /*----------------------------------------------------------------------------*/ @@ -697,6 +698,12 @@ int64_t GmfOpenMesh(const char *FilNam, int mod, ...) if(!ScaKwdTab(msh)) return(0); + // Preset solution entities sizes + msh->SolTypSiz[ GmfSca ] = 1; + msh->SolTypSiz[ GmfVec ] = msh->dim; + msh->SolTypSiz[ GmfSymMat ] = msh->dim * (msh->dim - 1); + msh->SolTypSiz[ GmfMat ] = msh->dim * msh->dim; + return(MshIdx); } else if(msh->mod == GmfWrite) @@ -771,6 +778,12 @@ int64_t GmfOpenMesh(const char *FilNam, int mod, ...) RecWrd(msh, (unsigned char *)&msh->dim); } + // Preset solution entities sizes + msh->SolTypSiz[ GmfSca ] = 1; + msh->SolTypSiz[ GmfVec ] = msh->dim; + msh->SolTypSiz[ GmfSymMat ] = msh->dim * (msh->dim - 1); + msh->SolTypSiz[ GmfMat ] = msh->dim * msh->dim; + return(MshIdx); } else @@ -896,7 +909,7 @@ int GmfGotoKwd(int64_t MshIdx, int KwdCod) int GmfSetKwd(int64_t MshIdx, int KwdCod, int64_t NmbLin, ...) { - int i, *TypTab; + int i, typ, *TypTab; int64_t CurPos; va_list VarArg; GmfMshSct *msh = (GmfMshSct *)MshIdx; @@ -969,7 +982,10 @@ int GmfSetKwd(int64_t MshIdx, int KwdCod, int64_t NmbLin, ...) fprintf(msh->hdl, "%d ", kwd->NmbTyp); for(i=0;iNmbTyp;i++) - fprintf(msh->hdl, "%d ", kwd->TypTab[i]); + { + typ = kwd->TypTab[i] > GmfMat ? GmfSca : kwd->TypTab[i]; + fprintf(msh->hdl, "%d ", typ); + } fprintf(msh->hdl, "\n"); } @@ -1000,7 +1016,10 @@ int GmfSetKwd(int64_t MshIdx, int KwdCod, int64_t NmbLin, ...) RecWrd(msh, (unsigned char *)&kwd->NmbTyp); for(i=0;iNmbTyp;i++) - RecWrd(msh, (unsigned char *)&kwd->TypTab[i]); + { + typ = kwd->TypTab[i] > GmfMat ? GmfSca : kwd->TypTab[i]; + RecWrd(msh, (unsigned char *)&typ); + } if(!strcmp("hr", GmfKwdFmt[ KwdCod ][2])) { @@ -1024,16 +1043,31 @@ int GmfSetKwd(int64_t MshIdx, int KwdCod, int64_t NmbLin, ...) /* Read a full line from the current kwd */ /*----------------------------------------------------------------------------*/ -int NAMF77(GmfGetLin, gmfgetlin)(TYPF77(int64_t)MshIdx, TYPF77(int)KwdCod, ...) +int GmfGetLin(int64_t MshIdx, int KwdCod, ...) { - int i, err; + int i, err, typ, *IntTab, *RefPtr, IntVal; + int64_t LngVal; float *FltSolTab, FltVal, *PtrFlt; - double *DblSolTab, *PtrDbl; + double *DblSolTab, *PtrDbl, *DblTab, DblVal; va_list VarArg; - GmfMshSct *msh = (GmfMshSct *) VALF77(MshIdx); - KwdSct *kwd = &msh->KwdTab[ VALF77(KwdCod) ]; + GmfMshSct *msh = (GmfMshSct *)MshIdx; + KwdSct *kwd; - if( (VALF77(KwdCod) < 1) || (VALF77(KwdCod) > GmfMaxKwd) ) + // Special trick: if the kwd is negative the call come from Fortran + if(KwdCod < 0) + { + // Set Fortran mode ON + KwdCod = -KwdCod; + kwd = &msh->KwdTab[ KwdCod ]; + typ = F77Kwd; + } + else + { + kwd = &msh->KwdTab[ KwdCod ]; + typ = kwd->typ; + } + + if( (KwdCod < 1) || (KwdCod > GmfMaxKwd) ) return(0); // Save the current stack environment for longjmp @@ -1048,7 +1082,7 @@ int NAMF77(GmfGetLin, gmfgetlin)(TYPF77(int64_t)MshIdx, TYPF77(int)KwdCod, ...) // Start decoding the arguments va_start(VarArg, KwdCod); - switch(kwd->typ) + switch(typ) { case InfKwd : case RegKwd : case CmtKwd : { @@ -1067,8 +1101,8 @@ int NAMF77(GmfGetLin, gmfgetlin)(TYPF77(int64_t)MshIdx, TYPF77(int)KwdCod, ...) } else { - safe_fscanf(msh->hdl, "%lf", - va_arg(VarArg, double *), msh->err); + PtrDbl = va_arg(VarArg, double *); + safe_fscanf(msh->hdl, "%lf",PtrDbl, msh->err); } } else if(kwd->fmt[i] == 'i') @@ -1087,8 +1121,7 @@ int NAMF77(GmfGetLin, gmfgetlin)(TYPF77(int64_t)MshIdx, TYPF77(int)KwdCod, ...) } else if(kwd->fmt[i] == 'c') { - safe_fgets( va_arg(VarArg, char *), - WrdSiz * FilStrSiz, msh->hdl, msh->err); + safe_fscanf(msh->hdl, "%s", va_arg(VarArg, char *), msh->err); } } } @@ -1136,6 +1169,62 @@ int NAMF77(GmfGetLin, gmfgetlin)(TYPF77(int64_t)MshIdx, TYPF77(int)KwdCod, ...) ScaDblWrd(msh, (unsigned char *)&DblSolTab[i]); } }break; + + case F77Kwd : + { + IntTab = va_arg(VarArg, int *); + DblTab = va_arg(VarArg, double *); + RefPtr = va_arg(VarArg, int *); + + for(i=0;iSolSiz;i++) + { + if(kwd->fmt[i] == 'i') + { + if(msh->ver <= 3) + { + if(msh->typ & Asc) + safe_fscanf(msh->hdl, "%d", &IntVal, msh->err); + else + ScaWrd(msh, (unsigned char *)&IntVal); + } + else + { + if(msh->typ & Asc) + safe_fscanf(msh->hdl, INT64_T_FMT, &LngVal, msh->err); + else + ScaDblWrd(msh, (unsigned char *)&LngVal); + + IntVal = (int)LngVal; + } + + if(!F77RefFlg[ KwdCod ] || (i < kwd->SolSiz - 1)) + IntTab[i] = IntVal; + else + *RefPtr = IntVal; + } + else if(kwd->fmt[i] == 'r') + { + if(msh->FltSiz == 32) + { + if(msh->typ & Asc) + safe_fscanf(msh->hdl, "%f", &FltVal, msh->err); + else + ScaWrd(msh, (unsigned char *)&FltVal); + + DblVal = (double)FltVal; + } + else + { + if(msh->typ & Asc) + safe_fscanf(msh->hdl, "%lf", &DblVal, msh->err); + else + ScaDblWrd(msh, (unsigned char *)&DblVal); + } + + DblTab[i] = DblVal; + } + } + }break; } va_end(VarArg); @@ -1148,17 +1237,31 @@ int NAMF77(GmfGetLin, gmfgetlin)(TYPF77(int64_t)MshIdx, TYPF77(int)KwdCod, ...) /* Write a full line from the current kwd */ /*----------------------------------------------------------------------------*/ -int NAMF77(GmfSetLin, gmfsetlin)(TYPF77(int64_t) MshIdx, TYPF77(int) KwdCod, ...) +int GmfSetLin(int64_t MshIdx, int KwdCod, ...) { - int i, pos, *IntBuf, err; + int i, pos, *IntBuf, err, typ, *IntTab, *RefPtr; int64_t *LngBuf; float *FltSolTab, *FltBuf; - double *DblSolTab, *DblBuf; + double *DblSolTab, *DblBuf, *DblTab; va_list VarArg; - GmfMshSct *msh = (GmfMshSct *) VALF77(MshIdx); - KwdSct *kwd = &msh->KwdTab[ VALF77(KwdCod) ]; + GmfMshSct *msh = (GmfMshSct *)MshIdx; + KwdSct *kwd; + + // Special trick: if the kwd is negative the call come from Fortran + if(KwdCod < 0) + { + // Set Fortran mode ON + KwdCod = -KwdCod; + kwd = &msh->KwdTab[ KwdCod ]; + typ = F77Kwd; + } + else + { + kwd = &msh->KwdTab[ KwdCod ]; + typ = kwd->typ; + } - if( ( VALF77(KwdCod) < 1) || ( VALF77(KwdCod) > GmfMaxKwd) ) + if( (KwdCod < 1) || (KwdCod > GmfMaxKwd) ) return(0); // Save the current stack environment for longjmp @@ -1184,111 +1287,192 @@ int NAMF77(GmfSetLin, gmfsetlin)(TYPF77(int64_t) MshIdx, TYPF77(int) KwdCod, ... // Start decoding the arguments va_start(VarArg, KwdCod); - if(kwd->typ != SolKwd) + switch(typ) { - if(msh->typ & Asc) + case InfKwd : case RegKwd : case CmtKwd : { - for(i=0;iSolSiz;i++) + if(msh->typ & Asc) { - if(kwd->fmt[i] == 'r') - { - if(msh->FltSiz == 32) -#ifdef F77API - fprintf(msh->hdl, "%.9g ", *(va_arg(VarArg, float *))); -#else - fprintf(msh->hdl, "%.9g ", va_arg(VarArg, double)); -#endif - else - fprintf(msh->hdl, "%.17g ", VALF77(va_arg(VarArg, TYPF77(double)))); - } - else if(kwd->fmt[i] == 'i') + for(i=0;iSolSiz;i++) { - if(msh->ver <= 3) - fprintf(msh->hdl, "%d ", VALF77(va_arg(VarArg, TYPF77(int)))); - else + if(kwd->fmt[i] == 'r') { - // [Bruno] %ld -> INT64_T_FMT - fprintf( msh->hdl, INT64_T_FMT " ", - VALF77(va_arg(VarArg, TYPF77(int64_t)))); + if(msh->FltSiz == 32) + fprintf(msh->hdl, "%.9g ", va_arg(VarArg, double)); + else + fprintf(msh->hdl, "%.17g ", va_arg(VarArg, double)); } + else if(kwd->fmt[i] == 'i') + { + if(msh->ver <= 3) + fprintf(msh->hdl, "%d ", va_arg(VarArg, int)); + else + { + // [Bruno] %ld -> INT64_T_FMT + fprintf(msh->hdl, INT64_T_FMT " ", va_arg(VarArg, int64_t)); + } + } + else if(kwd->fmt[i] == 'c') + fprintf(msh->hdl, "%s ", va_arg(VarArg, char *)); } - else if(kwd->fmt[i] == 'c') - fprintf(msh->hdl, "%s ", va_arg(VarArg, char *)); } - } - else - { - pos = 0; - - for(i=0;iSolSiz;i++) + else { - if(kwd->fmt[i] == 'r') + pos = 0; + + for(i=0;iSolSiz;i++) { - if(msh->FltSiz == 32) - { - FltBuf = (void *)&msh->buf[ pos ]; -#ifdef F77API - *FltBuf = (float)*(va_arg(VarArg, float *)); -#else - *FltBuf = (float)va_arg(VarArg, double); -#endif - pos += 4; - } - else + if(kwd->fmt[i] == 'r') { - DblBuf = (void *)&msh->buf[ pos ]; - *DblBuf = VALF77(va_arg(VarArg, TYPF77(double))); - pos += 8; + if(msh->FltSiz == 32) + { + FltBuf = (void *)&msh->buf[ pos ]; + *FltBuf = (float)va_arg(VarArg, double); + pos += 4; + } + else + { + DblBuf = (void *)&msh->buf[ pos ]; + *DblBuf = va_arg(VarArg, double); + pos += 8; + } } - } - else if(kwd->fmt[i] == 'i') - { - if(msh->ver <= 3) + else if(kwd->fmt[i] == 'i') { - IntBuf = (void *)&msh->buf[ pos ]; - *IntBuf = VALF77(va_arg(VarArg, TYPF77(int))); - pos += 4; + if(msh->ver <= 3) + { + IntBuf = (void *)&msh->buf[ pos ]; + *IntBuf = va_arg(VarArg, int); + pos += 4; + } + else + { + LngBuf = (void *)&msh->buf[ pos ]; + *LngBuf = va_arg(VarArg, int64_t); + pos += 8; + } } - else + else if(kwd->fmt[i] == 'c') { - LngBuf = (void *)&msh->buf[ pos ]; - *LngBuf = VALF77(va_arg(VarArg, TYPF77(int64_t))); - pos += 8; + memset(&msh->buf[ pos ], 0, FilStrSiz * WrdSiz); + strncpy(&msh->buf[ pos ], va_arg(VarArg, char *), FilStrSiz * WrdSiz); + pos += FilStrSiz; } } - else if(kwd->fmt[i] == 'c') - { - memset(&msh->buf[ pos ], 0, FilStrSiz * WrdSiz); - strncpy(&msh->buf[ pos ], va_arg(VarArg, char *), FilStrSiz * WrdSiz); - pos += FilStrSiz; - } + + RecBlk(msh, msh->buf, kwd->NmbWrd); } + }break; - RecBlk(msh, msh->buf, kwd->NmbWrd); - } - } - else - { - if(msh->FltSiz == 32) + case SolKwd : { - FltSolTab = va_arg(VarArg, float *); + if(msh->FltSiz == 32) + { + FltSolTab = va_arg(VarArg, float *); - if(msh->typ & Asc) - for(i=0; iSolSiz; i++) - fprintf(msh->hdl, "%.9g ", (double)FltSolTab[i]); + if(msh->typ & Asc) + for(i=0; iSolSiz; i++) + fprintf(msh->hdl, "%.9g ", (double)FltSolTab[i]); + else + RecBlk(msh, (unsigned char *)FltSolTab, kwd->NmbWrd); + } else - RecBlk(msh, (unsigned char *)FltSolTab, kwd->NmbWrd); - } - else + { + DblSolTab = va_arg(VarArg, double *); + + if(msh->typ & Asc) + for(i=0; iSolSiz; i++) + fprintf(msh->hdl, "%.17g ", DblSolTab[i]); + else + RecBlk(msh, (unsigned char *)DblSolTab, kwd->NmbWrd); + } + }break; + + case F77Kwd : { - DblSolTab = va_arg(VarArg, double *); + IntTab = va_arg(VarArg, int *); + DblTab = va_arg(VarArg, double *); + RefPtr = va_arg(VarArg, int *); if(msh->typ & Asc) - for(i=0; iSolSiz; i++) - fprintf(msh->hdl, "%.17g ", DblSolTab[i]); + { + for(i=0;iSolSiz;i++) + { + if(kwd->fmt[i] == 'r') + { + if(msh->FltSiz == 32) + fprintf(msh->hdl, "%.9g ", (float)DblTab[i]); + else + fprintf(msh->hdl, "%.17g ", DblTab[i]); + } + else if(kwd->fmt[i] == 'i') + { + if(msh->ver <= 3) + if(!F77RefFlg[ KwdCod ] || (i < kwd->SolSiz - 1)) + fprintf(msh->hdl, "%d ", IntTab[i]); + else + fprintf(msh->hdl, "%d ", *RefPtr); + else + { + if(!F77RefFlg[ KwdCod ] || (i < kwd->SolSiz - 1)) + fprintf(msh->hdl, INT64_T_FMT " ", (int64_t)IntTab[i]); + else + fprintf(msh->hdl, INT64_T_FMT " ", (int64_t)*RefPtr); + } + } + } + } else - RecBlk(msh, (unsigned char *)DblSolTab, kwd->NmbWrd); - } + { + pos = 0; + + for(i=0;iSolSiz;i++) + { + if(kwd->fmt[i] == 'r') + { + if(msh->FltSiz == 32) + { + FltBuf = (void *)&msh->buf[ pos ]; + *FltBuf = (float)DblTab[i]; + pos += 4; + } + else + { + DblBuf = (void *)&msh->buf[ pos ]; + *DblBuf = DblTab[i]; + pos += 8; + } + } + else if(kwd->fmt[i] == 'i') + { + if(msh->ver <= 3) + { + IntBuf = (void *)&msh->buf[ pos ]; + + if(!F77RefFlg[ KwdCod ] || (i < kwd->SolSiz - 1)) + *IntBuf = IntTab[i]; + else + *IntBuf = *RefPtr; + + pos += 4; + } + else + { + LngBuf = (void *)&msh->buf[ pos ]; + + if(!F77RefFlg[ KwdCod ] || (i < kwd->SolSiz - 1)) + *LngBuf = (int64_t)IntTab[i]; + else + *LngBuf = (int64_t)*RefPtr; + + pos += 8; + } + } + } + + RecBlk(msh, msh->buf, kwd->NmbWrd); + } + }break; } va_end(VarArg); @@ -1403,7 +1587,10 @@ int GmfCpyLin(int64_t InpIdx, int64_t OutIdx, int KwdCod) memset(s, 0, FilStrSiz * WrdSiz); if(InpMsh->typ & Asc) - safe_fgets(s, WrdSiz * FilStrSiz, InpMsh->hdl, InpMsh->err); + { + //safe_fgets(s, WrdSiz * FilStrSiz, InpMsh->hdl, InpMsh->err); + safe_fscanf(InpMsh->hdl, "%s", s, InpMsh->err); + } else #ifdef WITH_GMF_AIO read(InpMsh->FilDes, s, WrdSiz * FilStrSiz); @@ -1437,39 +1624,29 @@ int GmfCpyLin(int64_t InpIdx, int64_t OutIdx, int KwdCod) /* Bufferized asynchronous reading of all keyword's lines */ /*----------------------------------------------------------------------------*/ -int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, - TYPF77(int) KwdCod, - TYPF77(int64_t) BegIdx, - TYPF77(int64_t) EndIdx, - TYPF77(int) MapTyp, - void *MapTab, - void *prc, ... ) +int GmfGetBlock( int64_t MshIdx, int KwdCod, int64_t BegIdx, int64_t EndIdx, + int MapTyp, void *MapTab, void *prc, ... ) { char *UsrDat[ GmfMaxTyp ], *UsrBas[ GmfMaxTyp ], *FilPos, *EndUsrDat; char *FilBuf = NULL, *FrtBuf = NULL, *BckBuf = NULL, *BegUsrDat; - char *StrTab[5] = { "", "%f", "%lf", "%d", INT64_T_FMT }; + char *StrTab[4] = { "%f", "%lf", "%d", INT64_T_FMT }; char **BegTab, **EndTab; int i, j, k, *FilPtrI32, *UsrPtrI32, FilTyp[ GmfMaxTyp ]; - int UsrTyp[ GmfMaxTyp ], TypSiz[5] = {0,4,8,4,8}; + int UsrTyp[ GmfMaxTyp ], TypSiz[4] = {4,8,4,8}; int *IntMapTab = NULL, err, TotSiz = 0, IniFlg = 1, mod = GmfArgLst; int *TypTab, *SizTab, typ, VecCnt, ArgCnt = 0; float *FilPtrR32, *UsrPtrR32; double *FilPtrR64, *UsrPtrR64; int64_t BlkNmbLin, *FilPtrI64, *UsrPtrI64, BlkBegIdx, BlkEndIdx = 0; int64_t *LngMapTab = NULL, OldIdx = 0, UsrNmbLin, VecLen; - size_t FilBegIdx = VALF77(BegIdx), FilEndIdx = VALF77(EndIdx); + size_t FilBegIdx = BegIdx, FilEndIdx = EndIdx; void (*UsrPrc)(int64_t, int64_t, void *) = NULL; - size_t UsrLen[ GmfMaxTyp ], ret, LinSiz, b, NmbBlk; + size_t UsrLen[ GmfMaxTyp ], ret, LinSiz, b, l, NmbBlk; va_list VarArg; - GmfMshSct *msh = (GmfMshSct *) VALF77(MshIdx); - KwdSct *kwd = &msh->KwdTab[ VALF77(KwdCod) ]; + GmfMshSct *msh = (GmfMshSct *)MshIdx; + KwdSct *kwd = &msh->KwdTab[ KwdCod ]; struct aiocb aio; -#ifdef F77API - int NmbArg = 0; - void *ArgTab[ MaxArg ]; -#else char *UsrArg = NULL; -#endif // Save the current stack environment for longjmp if( (err = setjmp(msh->err)) != 0) @@ -1487,7 +1664,7 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, } // Check mesh and keyword - if( (VALF77(KwdCod) < 1) || (VALF77(KwdCod) > GmfMaxKwd) || !kwd->NmbLin ) + if( (KwdCod < 1) || (KwdCod > GmfMaxKwd) || !kwd->NmbLin ) return(0); // Make sure it's not a simple information keyword @@ -1502,9 +1679,9 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, UsrNmbLin = FilEndIdx - FilBegIdx + 1; // Get the renumbering map if any - if(VALF77(MapTyp) == GmfInt) + if(MapTyp == GmfInt) IntMapTab = (int *)MapTab; - else if(VALF77(MapTyp) == GmfLong) + else if(MapTyp == GmfLong) LngMapTab = (int64_t *)MapTab; // Start decoding the arguments @@ -1512,28 +1689,17 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, LinSiz = 0; // Get the user's preprocessing procedure and argument adresses, if any -#ifdef F77API - if(prc) - { - UsrPrc = (void (*)(int64_t, int64_t, void *))prc; - NmbArg = *(va_arg(VarArg, int *)); - - for(i=0;ityp != RegKwd) && (kwd->typ != SolKwd) ) - return(0); + longjmp(msh->err, -36); // Read the first data type to select between list and table mode - typ = VALF77(va_arg(VarArg, TYPF77(int))); + typ = va_arg(VarArg, int); // If the table mode is selected, read the four additional tables // containing the arguments: type, vector size, begin and end pointers @@ -1557,14 +1723,21 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, if(IniFlg) IniFlg = 0; else - typ = VALF77(va_arg(VarArg, TYPF77(int))); + typ = va_arg(VarArg, int); - // In case the type is a vector. get its size and change the type - // for the corresponding scalar type if(typ >= GmfFloatVec && typ <= GmfLongVec) { + // In case the type is a vector, get its size and change + // the type for the corresponding scalar type typ -= 4; - VecCnt = VALF77(va_arg(VarArg, TYPF77(int))); + VecCnt = va_arg(VarArg, int); + } + else if(typ >= GmfSca && typ <= GmfMat) + { + // In case it is a mathematical solution, expand it + // to the right size with the mesh file's own real kind + VecCnt = msh->SolTypSiz[ typ ]; + typ = (msh->ver == 1) ? GmfFloat : GmfDouble; } else VecCnt = 1; @@ -1583,6 +1756,13 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, typ -= 4; VecCnt = SizTab[ ArgCnt ]; } + else if(typ >= GmfSca && typ <= GmfMat) + { + // In case it is a mathematical solution, expand it + // to the right size with the mesh file's own real kind + VecCnt = msh->SolTypSiz[ typ ]; + typ = (msh->ver == 1) ? GmfFloat : GmfDouble; + } else VecCnt = 1; @@ -1592,7 +1772,10 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, } if(UsrNmbLin > 1) - VecLen = (size_t)(EndUsrDat - BegUsrDat) / (UsrNmbLin - 1); + { + VecLen = (size_t)(EndUsrDat - BegUsrDat); + VecLen /= UsrNmbLin - 1; + } else VecLen = 0; @@ -1600,7 +1783,7 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, for(i=0;iSolSiz;j++) { @@ -1655,29 +1838,25 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, else UsrDat[j] = UsrBas[k] + (OldIdx - 1) * UsrLen[k]; - safe_fscanf(msh->hdl, StrTab[ UsrTyp[j] ], UsrDat[j], msh->err); + safe_fscanf(msh->hdl, StrTab[ UsrTyp[j] - GmfFloat ], UsrDat[j], msh->err); } - if(i >= FilBegIdx) + if(l >= FilBegIdx) OldIdx++; // Call the user's preprocessing procedure if(UsrPrc) -#ifdef F77API - CalF77Prc(1, kwd->NmbLin, UsrPrc, NmbArg, ArgTab); -#else UsrPrc(1, kwd->NmbLin, UsrArg); -#endif } } else { // Allocate both front and back buffers if(!(BckBuf = malloc(BufSiz * LinSiz))) - return(0); + longjmp(msh->err, -37); if(!(FrtBuf = malloc(BufSiz * LinSiz))) - return(0); + longjmp(msh->err, -38); // Setup the ansynchonous parameters memset(&aio, 0, sizeof(struct aiocb)); @@ -1688,7 +1867,7 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, #else aio.aio_fildes = msh->hdl; #endif - aio.aio_offset = (off_t)(GetFilPos(msh) + (FilBegIdx-1) * LinSiz); + aio.aio_offset = (size_t)(GetFilPos(msh) + (FilBegIdx-1) * LinSiz); NmbBlk = UsrNmbLin / BufSiz; @@ -1706,16 +1885,16 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, if (err != 0) { printf (" Error at aio_error() : %s\n", strerror (err)); - exit(1); + longjmp(msh->err, -39); } if (ret != aio.aio_nbytes) { printf(" Error at aio_return()\n"); - exit(1); + longjmp(msh->err, -40); } // Increment the reading position - aio.aio_offset += (off_t)aio.aio_nbytes; + aio.aio_offset += (size_t)aio.aio_nbytes; // and swap the buffers if(aio.aio_buf == BckBuf) @@ -1754,7 +1933,7 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, printf("aio_offset = " INT64_T_FMT "\n",(int64_t)aio.aio_offset); printf("aio_nbytes = " INT64_T_FMT "\n",(int64_t)aio.aio_nbytes); printf("errno = %d\n",errno); - exit(1); + longjmp(msh->err, -41); } } @@ -1779,7 +1958,7 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, for(j=0;jSolSiz;j++) { if(msh->cod != 1) - SwpWrd(FilPos, TypSiz[ FilTyp[j] ]); + SwpWrd(FilPos, TypSiz[ FilTyp[j] - GmfFloat ]); // Reorder HO nodes on the fly if(kwd->OrdTab && (j != kwd->SolSiz-1)) @@ -1855,17 +2034,13 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, } } - FilPos += TypSiz[ FilTyp[j] ]; + FilPos += TypSiz[ FilTyp[j] - GmfFloat ]; } } // Call the user's preprocessing procedure if(UsrPrc) -#ifdef F77API - CalF77Prc(BlkBegIdx, BlkEndIdx, UsrPrc, NmbArg, ArgTab); -#else UsrPrc(BlkBegIdx, BlkEndIdx, UsrArg); -#endif } } @@ -1881,39 +2056,29 @@ int NAMF77(GmfGetBlock, gmfgetblock)( TYPF77(int64_t) MshIdx, /* Bufferized writing of all keyword's lines */ /*----------------------------------------------------------------------------*/ -int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, - TYPF77(int) KwdCod, - TYPF77(int64_t) BegIdx, - TYPF77(int64_t) EndIdx, - TYPF77(int) MapTyp, - void *MapTab, - void *prc, ... ) +int GmfSetBlock( int64_t MshIdx, int KwdCod, int64_t BegIdx, int64_t EndIdx, + int MapTyp, void *MapTab, void *prc, ... ) { char *UsrDat[ GmfMaxTyp ], *UsrBas[ GmfMaxTyp ]; - char *StrTab[5] = { "", "%.9g", "%.17g", "%d", "%lld" }, *FilPos; + char *StrTab[4] = {"%.9g", "%.17g", "%d", "%lld" }, *FilPos; char *FilBuf = NULL, *FrtBuf = NULL, *BckBuf = NULL; char **BegTab, **EndTab, *BegUsrDat, *EndUsrDat; int i, j, *FilPtrI32, *UsrPtrI32, FilTyp[ GmfMaxTyp ]; - int UsrTyp[ GmfMaxTyp ], TypSiz[5] = {0,4,8,4,8}; + int UsrTyp[ GmfMaxTyp ], TypSiz[4] = {4,8,4,8}; int err, *IntMapTab = NULL, typ, mod = GmfArgLst; int *TypTab, *SizTab, IniFlg = 1, TotSiz = 0, VecCnt, ArgCnt = 0; float *FilPtrR32, *UsrPtrR32; double *FilPtrR64, *UsrPtrR64; int64_t UsrNmbLin, BlkNmbLin = 0, BlkBegIdx, BlkEndIdx = 0; int64_t *FilPtrI64, *UsrPtrI64, *LngMapTab = NULL, OldIdx = 0; - size_t FilBegIdx = VALF77(BegIdx), FilEndIdx = VALF77(EndIdx); + size_t FilBegIdx = BegIdx, FilEndIdx = EndIdx; void (*UsrPrc)(int64_t, int64_t, void *) = NULL; size_t UsrLen[ GmfMaxTyp ], ret, LinSiz, VecLen, s, b, NmbBlk; va_list VarArg; - GmfMshSct *msh = (GmfMshSct *) VALF77(MshIdx); - KwdSct *kwd = &msh->KwdTab[ VALF77(KwdCod) ]; + GmfMshSct *msh = (GmfMshSct *)MshIdx; + KwdSct *kwd = &msh->KwdTab[ KwdCod ]; struct aiocb aio; -#ifdef F77API - int NmbArg = 0; - void *ArgTab[ MaxArg ]; -#else char *UsrArg = NULL; -#endif // Save the current stack environment for longjmp if( (err = setjmp(msh->err)) != 0) @@ -1928,7 +2093,7 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, } // Check mesh and keyword - if( (VALF77(KwdCod) < 1) || (VALF77(KwdCod) > GmfMaxKwd) || !kwd->NmbLin ) + if( (KwdCod < 1) || (KwdCod > GmfMaxKwd) || !kwd->NmbLin ) return(0); // Make sure it's not a simple information keyword @@ -1948,9 +2113,9 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, UsrNmbLin = FilEndIdx - FilBegIdx + 1; // Get the renumbering map if any - if(VALF77(MapTyp) == GmfInt) + if(MapTyp == GmfInt) IntMapTab = (int *)MapTab; - else if(VALF77(MapTyp) == GmfLong) + else if(MapTyp == GmfLong) LngMapTab = (int64_t *)MapTab; // Start decoding the arguments @@ -1958,28 +2123,17 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, LinSiz = 0; // Get the user's postprocessing procedure and argument adresses, if any -#ifdef F77API - if(prc) - { - UsrPrc = (void (*)(int64_t, int64_t, void *))prc; - NmbArg = *(va_arg(VarArg, int *)); - - for(i=0;ityp != RegKwd) && (kwd->typ != SolKwd) ) - return(0); + longjmp(msh->err, -42); // Read the first data type to select between list and table mode - typ = VALF77(va_arg(VarArg, TYPF77(int))); + typ = va_arg(VarArg, int); // If the table mode is selected, read the four additional tables // containing the arguments: type, vector size, begin and end pointers @@ -2003,14 +2157,21 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, if(IniFlg) IniFlg = 0; else - typ = VALF77(va_arg(VarArg, TYPF77(int))); + typ = va_arg(VarArg, int); // In case the type is a vector. get its size and change the type // for the corresponding scalar type if(typ >= GmfFloatVec && typ <= GmfLongVec) { typ -= 4; - VecCnt = VALF77(va_arg(VarArg, TYPF77(int))); + VecCnt = va_arg(VarArg, int); + } + else if(typ >= GmfSca && typ <= GmfMat) + { + // In case it is a mathematical solution, expand it + // to the right size with the mesh file's own real kind + VecCnt = msh->SolTypSiz[ typ ]; + typ = (msh->ver == 1) ? GmfFloat : GmfDouble; } else VecCnt = 1; @@ -2029,6 +2190,13 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, typ -= 4; VecCnt = SizTab[ ArgCnt ]; } + else if(typ >= GmfSca && typ <= GmfMat) + { + // In case it is a mathematical solution, expand it + // to the right size with the mesh file's own real kind + VecCnt = msh->SolTypSiz[ typ ]; + typ = (msh->ver == 1) ? GmfFloat : GmfDouble; + } else VecCnt = 1; @@ -2038,7 +2206,10 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, } if(UsrNmbLin > 1) - VecLen = (size_t)(EndUsrDat - BegUsrDat) / (UsrNmbLin - 1); + { + VecLen = EndUsrDat - BegUsrDat; + VecLen /= UsrNmbLin - 1; + } else VecLen = 0; @@ -2046,7 +2217,7 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, for(i=0;ityp & Asc) { if(UsrPrc) -#ifdef F77API - CalF77Prc(1, kwd->NmbLin, UsrPrc, NmbArg, ArgTab); -#else UsrPrc(1, kwd->NmbLin, UsrArg); -#endif for(s=FilBegIdx; s<=FilEndIdx; s++) for(j=0;jSolSiz;j++) @@ -2089,22 +2256,22 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, if(UsrTyp[j] == GmfFloat) { UsrPtrR32 = (float *)UsrDat[j]; - fprintf(msh->hdl, StrTab[ UsrTyp[j] ], (double)*UsrPtrR32); + fprintf(msh->hdl, StrTab[ UsrTyp[j] - GmfFloat ], (double)*UsrPtrR32); } else if(UsrTyp[j] == GmfDouble) { UsrPtrR64 = (double *)UsrDat[j]; - fprintf(msh->hdl, StrTab[ UsrTyp[j] ], *UsrPtrR64); + fprintf(msh->hdl, StrTab[ UsrTyp[j] - GmfFloat ], *UsrPtrR64); } else if(UsrTyp[j] == GmfInt) { UsrPtrI32 = (int *)UsrDat[j]; - fprintf(msh->hdl, StrTab[ UsrTyp[j] ], *UsrPtrI32); + fprintf(msh->hdl, StrTab[ UsrTyp[j] - GmfFloat ], *UsrPtrI32); } else if(UsrTyp[j] == GmfLong) { UsrPtrI64 = (int64_t *)UsrDat[j]; - fprintf(msh->hdl, StrTab[ UsrTyp[j] ], *UsrPtrI64); + fprintf(msh->hdl, StrTab[ UsrTyp[j] - GmfFloat ], *UsrPtrI64); } if(j < kwd->SolSiz -1) @@ -2125,10 +2292,10 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, { // Allocate the front and back buffers if(!(BckBuf = malloc(BufSiz * LinSiz))) - return(0); + longjmp(msh->err, -43); if(!(FrtBuf = malloc(BufSiz * LinSiz))) - return(0); + longjmp(msh->err, -44); // Setup the asynchronous parameters memset(&aio, 0, sizeof(struct aiocb)); @@ -2138,7 +2305,7 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, #else aio.aio_fildes = msh->hdl; #endif - aio.aio_offset = (off_t)GetFilPos(msh); + aio.aio_offset = (size_t)GetFilPos(msh); NmbBlk = UsrNmbLin / BufSiz; @@ -2162,7 +2329,7 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, printf("aio_offset = " INT64_T_FMT "\n",(int64_t)aio.aio_offset); printf("aio_nbytes = " INT64_T_FMT "\n",(int64_t)aio.aio_nbytes); printf("errno = %d\n",errno); - exit(1); + longjmp(msh->err, -45); } } @@ -2181,11 +2348,7 @@ int NAMF77(GmfSetBlock, gmfsetblock)( TYPF77(int64_t) MshIdx, // Call user's preprocessing first if(UsrPrc) -#ifdef F77API - CalF77Prc(BlkBegIdx, BlkEndIdx, UsrPrc, NmbArg, ArgTab); -#else UsrPrc(BlkBegIdx, BlkEndIdx, UsrArg); -#endif // Then copy it's data to the file buffer for(i=0;ierr, -46); } if (ret != aio.aio_nbytes) { printf(" Error at aio_return()\n"); - exit(1); + longjmp(msh->err, -47); } // Move the write position - aio.aio_offset += (off_t)aio.aio_nbytes; + aio.aio_offset += (size_t)aio.aio_nbytes; } // Swap the buffers @@ -2321,8 +2484,6 @@ int GmfSetHONodesOrdering(int64_t MshIdx, int KwdCod, int *BasTab, int *OrdTab) GmfMshSct *msh = (GmfMshSct *)MshIdx; KwdSct *kwd; - // printf("\n\tGmfSetHONodesOrdering 0\n"); - if( (KwdCod < 1) || (KwdCod > GmfMaxKwd) ) return(0); @@ -2415,9 +2576,6 @@ int GmfSetHONodesOrdering(int64_t MshIdx, int KwdCod, int *BasTab, int *OrdTab) #endif -#ifndef F77API - - /*----------------------------------------------------------------------------*/ /* Read an EGADS binary CAD and return the byte flow and its exact byte size */ /*----------------------------------------------------------------------------*/ @@ -2533,8 +2691,6 @@ void GmfSetFloatPrecision(int64_t MshIdx , int FltSiz) GmfSetLin(MshIdx, GmfFloatingPointPrecision, FltSiz); } -#endif - /*----------------------------------------------------------------------------*/ /* Find every kw present in a meshfile */ @@ -2760,6 +2916,13 @@ static void ExpFmt(GmfMshSct *msh, int KwdCod) kwd->SolSiz *= kwd->NmbNod; kwd->NmbWrd *= kwd->NmbNod; } + + // Count the final number of intergers and reals needed by the Fortran API + for(i=0;iSolSiz;i++) + if(kwd->fmt[i] == 'i') + kwd->NmbInt++; + else if(kwd->fmt[i] == 'r') + kwd->NmbDbl++; } @@ -2944,11 +3107,11 @@ static int SetFilPos(GmfMshSct *msh, int64_t pos) { #ifdef WITH_GMF_AIO if(msh->typ & Bin) - return((lseek(msh->FilDes, (off_t)pos, 0) != -1)); + return((lseek(msh->FilDes, (size_t)pos, 0) != -1)); else - return((MYFSEEK(msh->hdl, (off_t)pos, SEEK_SET) == 0)); + return((MYFSEEK(msh->hdl, (size_t)pos, SEEK_SET) == 0)); #else - return((MYFSEEK(msh->hdl, (off_t)pos, SEEK_SET) == 0)); + return((MYFSEEK(msh->hdl, (size_t)pos, SEEK_SET) == 0)); #endif } @@ -2983,7 +3146,7 @@ static int64_t GetFilSiz(GmfMshSct *msh) #ifdef WITH_GMF_AIO CurPos = lseek(msh->FilDes, 0, 1); EndPos = lseek(msh->FilDes, 0, 2); - lseek(msh->FilDes, (off_t)CurPos, 0); + lseek(msh->FilDes, (size_t)CurPos, 0); #else CurPos = MYFTELL(msh->hdl); @@ -2992,7 +3155,7 @@ static int64_t GetFilSiz(GmfMshSct *msh) EndPos = MYFTELL(msh->hdl); - if(MYFSEEK(msh->hdl, (off_t)CurPos, SEEK_SET) != 0) + if(MYFSEEK(msh->hdl, (size_t)CurPos, SEEK_SET) != 0) longjmp(msh->err, -33); #endif } @@ -3005,7 +3168,7 @@ static int64_t GetFilSiz(GmfMshSct *msh) EndPos = MYFTELL(msh->hdl); - if(MYFSEEK(msh->hdl, (off_t)CurPos, SEEK_SET) != 0) + if(MYFSEEK(msh->hdl, (size_t)CurPos, SEEK_SET) != 0) longjmp(msh->err, -35); } @@ -3017,10 +3180,8 @@ static int64_t GetFilSiz(GmfMshSct *msh) /* Fortran 77 API */ /*----------------------------------------------------------------------------*/ -#ifdef F77API - -int64_t APIF77(gmfopenmesh)( char *FilNam, int *mod, - int *ver, int *dim, int StrSiz ) +int64_t APIF77(gmfopenmeshf77)( char *FilNam, int *mod, + int *ver, int *dim, long int StrSiz ) { int i = 0; char TmpNam[ GmfStrSiz ]; @@ -3038,23 +3199,23 @@ int64_t APIF77(gmfopenmesh)( char *FilNam, int *mod, TmpNam[ StrSiz ] = 0; if(*mod == GmfRead) - return(GmfOpenMesh(TmpNam, *mod, ver, dim)); + return(GmfOpenMesh(TmpNam, GmfRead, ver, dim)); else - return(GmfOpenMesh(TmpNam, *mod, *ver, *dim)); + return(GmfOpenMesh(TmpNam, GmfWrite, *ver, *dim)); } -int APIF77(gmfclosemesh)(int64_t *idx) +int APIF77(gmfclosemeshf77)(int64_t *idx) { return(GmfCloseMesh(*idx)); } -int APIF77(gmfgotokwd)(int64_t *MshIdx, int *KwdIdx) +int APIF77(gmfgotokwdf77)(int64_t *MshIdx, int *KwdIdx) { return(GmfGotoKwd(*MshIdx, *KwdIdx)); } -int APIF77(gmfstatkwd)( int64_t *MshIdx, int *KwdIdx, int *NmbTyp, - int *SolSiz, int *TypTab, int *deg, int *NmbNod) +int APIF77(gmfstatkwdf77)( int64_t *MshIdx, int *KwdIdx, int *NmbTyp, + int *SolSiz, int *TypTab, int *deg, int *NmbNod ) { if(!strcmp(GmfKwdFmt[ *KwdIdx ][2], "hr")) return(GmfStatKwd(*MshIdx, *KwdIdx, NmbTyp, SolSiz, TypTab, deg, NmbNod)); @@ -3064,8 +3225,8 @@ int APIF77(gmfstatkwd)( int64_t *MshIdx, int *KwdIdx, int *NmbTyp, return(GmfStatKwd(*MshIdx, *KwdIdx)); } -int APIF77(gmfsetkwd)( int64_t *MshIdx, int *KwdIdx, int *NmbLin, - int *NmbTyp, int *TypTab, int *deg, int *NmbNod) +int APIF77(gmfsetkwdf77)( int64_t *MshIdx, int *KwdIdx, int *NmbLin, + int *NmbTyp, int *TypTab, int *deg, int *NmbNod ) { if(!strcmp(GmfKwdFmt[ *KwdIdx ][2], "hr")) return(GmfSetKwd(*MshIdx, *KwdIdx, *NmbLin, *NmbTyp, TypTab, *deg, *NmbNod)); @@ -3075,245 +3236,108 @@ int APIF77(gmfsetkwd)( int64_t *MshIdx, int *KwdIdx, int *NmbLin, return(GmfSetKwd(*MshIdx, *KwdIdx, *NmbLin)); } - -int APIF77(gmfsethonodesordering)(int64_t *MshIdx, int *KwdCod, int *BasTab, int *OrdTab) +int APIF77(gmfsethonodesorderingf77)( int64_t *MshIdx, int *KwdCod, + int *BasTab, int *OrdTab ) { return(GmfSetHONodesOrdering(*MshIdx, *KwdCod, BasTab, OrdTab)); } -/* -int APIF77(gmfreadbyteflow)(int64_t *MshIdx, char *BytFlo, int *NmbByt) -{ - int TmpNmb; - char *TmpFlo; - - TmpFlo = GmfReadByteFlow(*MshIdx, &TmpNmb); - - if(!TmpFlo || NmbByt <= 0 || !BytFlo || TmpNmb > *NmbByt) - return(0); - - *NmbByt = TmpNmb; - memcpy(BytFlo, TmpFlo, *NmbByt); - free(TmpFlo); - - return(TmpNmb); -} -int APIF77(gmfwritebyteflow)(int64_t *MshIdx, char *BytFlo, int *NmbByt) +int APIF77(gmfgetlinef77)(int64_t *MshIdx, int *kwd, int *i, double *d, int *r) { - return(GmfWriteByteFlow(*MshIdx, BytFlo, *NmbByt)); + // Special trick: use a negative value kwd to set Fortran mode on + return(GmfGetLin(*MshIdx, -*kwd, i, d, r)); } -int APIF77(gmfgetfloatprecision)(int64_t *MshIdx) +int APIF77(gmfsetlinef77)(int64_t *MshIdx, int *kwd, int *i, double *d, int *r) { - return(GmfGetFloatPrecision(*MshIdx)); + // Special trick: use a negative value kwd to set Fortran mode on + return(GmfSetLin(*MshIdx, -*kwd, i, d, r)); } -int APIF77(gmfsetfloatprecision)(int64_t *MshIdx, int *FltSiz) +int APIF77(gmfgetblockf77)(int64_t *MshIdx, int *KwdCod, + int *BegIdx, int *EndIdx, + int *MapTyp, int *MatTab, + int *BegInt, int *EndInt, + double *BegDbl, double *EndDbl, + int *BegRef, int *EndRef) { - GmfSetFloatPrecision(*MshIdx, *FltSiz); - return(0); -} -*/ - -/*----------------------------------------------------------------------------*/ -/* Duplication macros */ -/*----------------------------------------------------------------------------*/ - -#define DUP(s,n) DUP ## n (s) -#define DUP1(s) s -#define DUP2(s) DUP1(s),s -#define DUP3(s) DUP2(s),s -#define DUP4(s) DUP3(s),s -#define DUP5(s) DUP4(s),s -#define DUP6(s) DUP5(s),s -#define DUP7(s) DUP6(s),s -#define DUP8(s) DUP7(s),s -#define DUP9(s) DUP8(s),s -#define DUP10(s) DUP9(s),s -#define DUP11(s) DUP10(s),s -#define DUP12(s) DUP11(s),s -#define DUP13(s) DUP12(s),s -#define DUP14(s) DUP13(s),s -#define DUP15(s) DUP14(s),s -#define DUP16(s) DUP15(s),s -#define DUP17(s) DUP16(s),s -#define DUP18(s) DUP17(s),s -#define DUP19(s) DUP18(s),s -#define DUP20(s) DUP19(s),s - - -#define ARG(a,n) ARG ## n (a) -#define ARG1(a) a[0] -#define ARG2(a) ARG1(a),a[1] -#define ARG3(a) ARG2(a),a[2] -#define ARG4(a) ARG3(a),a[3] -#define ARG5(a) ARG4(a),a[4] -#define ARG6(a) ARG5(a),a[5] -#define ARG7(a) ARG6(a),a[6] -#define ARG8(a) ARG7(a),a[7] -#define ARG9(a) ARG8(a),a[8] -#define ARG10(a) ARG9(a),a[9] -#define ARG11(a) ARG10(a),a[10] -#define ARG12(a) ARG11(a),a[11] -#define ARG13(a) ARG12(a),a[12] -#define ARG14(a) ARG13(a),a[13] -#define ARG15(a) ARG14(a),a[14] -#define ARG16(a) ARG15(a),a[15] -#define ARG17(a) ARG16(a),a[16] -#define ARG18(a) ARG17(a),a[17] -#define ARG19(a) ARG18(a),a[18] -#define ARG20(a) ARG19(a),a[19] - - -/*----------------------------------------------------------------------------*/ -/* Call a fortran thread with 1 to 20 arguments */ -/*----------------------------------------------------------------------------*/ - -static void CalF77Prc( int64_t BegIdx, int64_t EndIdx, - void *prc, int NmbArg, void **ArgTab ) -{ - switch(NmbArg) - { - case 1 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 1)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 1)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 1)); - }break; - - case 2 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 2)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 2)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 2)); - }break; - - case 3 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 3)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 3)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 3)); - }break; - - case 4 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 4)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 4)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 4)); - }break; - - case 5 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 5)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 5)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 5)); - }break; - - case 6 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 6)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 6)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 6)); - }break; - - case 7 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 7)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 7)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 7)); - }break; - - case 8 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 8)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 8)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 8)); - }break; - - case 9 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 9)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 9)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 9)); - }break; - - case 10 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 10)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 10)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 10)); - }break; - - case 11 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 11)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 11)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 11)); - }break; - - case 12 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 12)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 12)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 12)); - }break; - - case 13 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 13)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 13)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 13)); - }break; + int i, TypTab[ MaxArg ], SizTab[ MaxArg ]; + char *BegTab[ MaxArg ], *EndTab[ MaxArg ]; + GmfMshSct *msh = (GmfMshSct *)*MshIdx; + KwdSct *kwd = &msh->KwdTab[ *KwdCod ]; - case 14 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 14)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 14)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 14)); - }break; - - case 15 : + // Fortran call to getblock uses the GmfArgTab mode where pointers are passed + // through tables: types[], vec sizes[], begin pointers[] and end pointers[] + for(i=0;iSolSiz;i++) + { + if(kwd->fmt[i] == 'i') { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 15)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 15)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 15)); - }break; + TypTab[i] = GmfInt; + SizTab[i] = 1; - case 16 : + if( (F77RefFlg[ *KwdCod ]) && (i == kwd->SolSiz-1) ) + { + BegTab[i] = (char *)BegRef; + EndTab[i] = (char *)EndRef; + } + else + { + BegTab[i] = (char *)&BegInt[i]; + EndTab[i] = (char *)&EndInt[i]; + } + }else if(kwd->fmt[i] == 'r') { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 16)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 16)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 16)); - }break; + TypTab[i] = GmfDouble; + SizTab[i] = 1; + BegTab[i] = (char *)&BegDbl[i]; + EndTab[i] = (char *)&EndDbl[i]; + } + } - case 17 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 17)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 17)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 17)); - }break; + return(GmfGetBlock( *MshIdx, *KwdCod, *BegIdx, *EndIdx, *MapTyp, MatTab, + NULL, GmfArgTab, TypTab, SizTab, BegTab, EndTab )); +} - case 18 : - { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 18)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 18)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 18)); - }break; +int APIF77(gmfsetblockf77)(int64_t *MshIdx, int *KwdCod, + int *BegIdx, int *EndIdx, + int *MapTyp, int *MatTab, + int *BegInt, int *EndInt, + double *BegDbl, double *EndDbl, + int *BegRef, int *EndRef) +{ + int i, TypTab[ MaxArg ], SizTab[ MaxArg ]; + char *BegTab[ MaxArg ], *EndTab[ MaxArg ]; + GmfMshSct *msh = (GmfMshSct *)*MshIdx; + KwdSct *kwd = &msh->KwdTab[ *KwdCod ]; - case 19 : + // Fortran call to setblock uses the GmfArgTab mode where pointers are passed + // through tables: types[], vec sizes[], begin pointers[] and end pointers[] + for(i=0;iSolSiz;i++) + { + if(kwd->fmt[i] == 'i') { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 19)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 19)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 19)); - }break; + TypTab[i] = GmfInt; + SizTab[i] = 1; - case 20 : + if( (F77RefFlg[ *KwdCod ]) && (i == kwd->SolSiz-1) ) + { + BegTab[i] = (char *)BegRef; + EndTab[i] = (char *)EndRef; + } + else + { + BegTab[i] = (char *)&BegInt[i]; + EndTab[i] = (char *)&EndInt[i]; + } + }else if(kwd->fmt[i] == 'r') { - void (*prc1)(int64_t *, int64_t *, DUP(void *, 20)) = - (void (*)(int64_t *, int64_t *, DUP(void *, 20)))prc; - prc1(&BegIdx, &EndIdx, ARG(ArgTab, 20)); - }break; + TypTab[i] = GmfDouble; + SizTab[i] = 1; + BegTab[i] = (char *)&BegDbl[i]; + EndTab[i] = (char *)&EndDbl[i]; + } } -} -#endif + return(GmfSetBlock( *MshIdx, *KwdCod, *BegIdx, *EndIdx, *MapTyp, MatTab, + NULL, GmfArgTab, TypTab, SizTab, BegTab, EndTab )); +} diff --git a/sources/libmeshb7.h b/sources/libmeshb7.h index bd67928..5237375 100644 --- a/sources/libmeshb7.h +++ b/sources/libmeshb7.h @@ -2,51 +2,52 @@ /*----------------------------------------------------------------------------*/ /* */ -/* LIBMESHB V7.61 */ +/* LIBMESHB V7.80 */ /* */ /*----------------------------------------------------------------------------*/ /* */ /* Description: handle .meshb file format I/O */ /* Author: Loic MARECHAL */ /* Creation date: dec 09 1999 */ -/* Last modification: sep 27 2021 */ +/* Last modification: feb 27 2024 */ /* */ /*----------------------------------------------------------------------------*/ // [Bruno] get PRINTF_INT64_MODIFIER // #include -#include - #ifndef LIBMESHB7_H #define LIBMESHB7_H +#include + + /*----------------------------------------------------------------------------*/ /* Defines */ /*----------------------------------------------------------------------------*/ -#define GmfStrSiz 1024 -#define GmfMaxTyp 1000 -#define GmfMaxKwd GmfLastKeyword - 1 -#define GmfMshVer 1 -#define GmfRead 1 -#define GmfWrite 2 -#define GmfSca 1 -#define GmfVec 2 -#define GmfSymMat 3 -#define GmfMat 4 -#define GmfFloat 1 -#define GmfDouble 2 -#define GmfInt 3 -#define GmfLong 4 -#define GmfFloatVec 5 -#define GmfDoubleVec 6 -#define GmfIntTab 7 -#define GmfIntVec 7 -#define GmfLongTab 8 -#define GmfLongVec 8 -#define GmfArgTab 100 -#define GmfArgLst 101 +#define GmfStrSiz 1024 +#define GmfMaxTyp 1000 +#define GmfMaxKwd GmfLastKeyword - 1 +#define GmfMshVer 1 +#define GmfRead 1 +#define GmfWrite 2 +#define GmfSca 1 +#define GmfVec 2 +#define GmfSymMat 3 +#define GmfMat 4 +#define GmfFloat 8 +#define GmfDouble 9 +#define GmfInt 10 +#define GmfLong 11 +#define GmfFloatVec 12 +#define GmfDoubleVec 13 +#define GmfIntTab 14 +#define GmfIntVec 14 +#define GmfLongTab 15 +#define GmfLongVec 15 +#define GmfArgTab 100 +#define GmfArgLst 101 enum GmfKwdCod { @@ -268,6 +269,16 @@ enum GmfKwdCod GmfPyramidsGID, GmfPrismsGID, GmfHexahedraGID, + GmfSolAtBoundaryPolygons, + GmfSolAtPolyhedra, + GmfVerticesOnGeometryNodes, + GmfVerticesOnGeometryEdges, + GmfEdgesOnGeometryEdges, + GmfVerticesOnGeometryFaces, + GmfEdgesOnGeometryFaces, + GmfTrianglesOnGeometryFaces, + GmfQuadrialteralsOnGeometryFaces, + GmfMeshOnGeometry, GmfLastKeyword }; diff --git a/sources/libmeshb7.ins b/sources/libmeshb7.ins index 0ee9a64..2e80863 100644 --- a/sources/libmeshb7.ins +++ b/sources/libmeshb7.ins @@ -2,48 +2,40 @@ c---------------------------------------------------------- c -c LIBMESH V 7.56 +c LIBMESH V 7.80 c c---------------------------------------------------------- c c Description: handles .meshb file format I/O c Author: Loic MARECHAL c Creation date: dec 08 2015 -c Last modification: nov 27 2020 +c Last modification: feb 27 2024 c c---------------------------------------------------------- c Procedures definition - external gmfopenmesh - external gmfclosemesh - external gmfstatkwd - external gmfsetkwd - external gmfgotokwd - external gmfgetlin - external gmfsetlin - external gmfgetblock - external gmfsetblock - external gmfsethonodesordering -c external gmfreadbyteflow -c external gmfwritebyteflow -c external gmfgetfloatprecision -c external gmfsetfloatprecision + external gmfopenmeshf77 + external gmfclosemeshf77 + external gmfstatkwdf77 + external gmfsetkwdf77 + external gmfgotokwdf77 + external gmfsethonodesorderingf77 + external gmfgetlinef77 + external gmfsetlinef77 + external gmfgetblockf77 + external gmfsetblockf77 - integer*8 gmfopenmesh - integer gmfclosemesh - integer gmfstatkwd - integer gmfsetkwd - integer gmfgotokwd - integer gmfgetlin - integer gmfsetlin - integer gmfgetblock - integer gmfsetblock - integer gmfsethonodesordering -c integer gmfreadbyteflow -c integer gmfwritebyteflow -c integer gmfgetfloatprecision -c integer gmfsetfloatprecision + integer*8 gmfopenmeshf77 + integer gmfclosemeshf77 + integer gmfstatkwdf77 + integer gmfsetkwdf77 + integer gmfgotokwdf77 + integer gmfsethonodesorderingf77 + integer gmfgetlinef77 + integer gmfsetlinef77 + integer gmfgetblockf77 + integer gmfsetblockf77 c Parameters definition @@ -69,23 +61,23 @@ c Parameters definition integer gmfarglst parameter (gmfmaxtyp=1000) - parameter (gmfmaxkwd=103) + parameter (gmfmaxkwd=227) parameter (gmfread=1) parameter (gmfwrite=2) parameter (gmfsca=1) parameter (gmfvec=2) parameter (gmfsymmat=3) parameter (gmfmat=4) - parameter (gmffloat=1) - parameter (gmfdouble=2) - parameter (gmfint=3) - parameter (gmflong=4) - parameter (gmfinttab=7) - parameter (gmflongtab=8) - parameter (gmffloatvec=5) - parameter (gmfdoublevec=6) - parameter (gmfintvec=7) - parameter (gmflongvec=8) + parameter (gmffloat=8) + parameter (gmfdouble=9) + parameter (gmfint=10) + parameter (gmflong=11) + parameter (gmfinttab=14) + parameter (gmflongtab=15) + parameter (gmffloatvec=12) + parameter (gmfdoublevec=13) + parameter (gmfintvec=14) + parameter (gmflongvec=15) parameter (gmfargtab=100) parameter (gmfarglst=101) @@ -291,6 +283,32 @@ c Keywords list integer gmfreferencestrings integer gmfprisms9 integer gmfhexahedra12 + integer gmfquadrilaterals6 + integer gmfboundarypolygonheaders + integer gmfboundarypolygonvertices + integer gmfinnerpolygonheaders + integer gmfinnerpolygonvertices + integer gmfpolyhedraheaders + integer gmfpolyhedrafaces + integer gmfdomains + integer gmfverticesgid + integer gmfedgesgid + integer gmftrianglesgid + integer gmfquadrilateralsgid + integer gmftetrahedragid + integer gmfpyramidsgid + integer gmfprismsgid + integer gmfhexahedragid + integer gmfsolatboundarypolygons + integer gmfsolatpolyhedra + integer gmfverticesongeometrynodes + integer gmfverticesongeometryedges + integer gmfedgesongeometryedges + integer gmfverticesongeometryfaces + integer gmfedgesongeometryfaces + integer gmftrianglesongeometryfaces + integer gmfquadrialteralsongeometryfaces + integer gmfmeshongeometry parameter (gmfmeshversionformatted=1) parameter (gmfdimension=3) @@ -492,3 +510,29 @@ c Keywords list parameter (gmfreferencestrings=199) parameter (gmfprisms9=200) parameter (gmfhexahedra12=201) + parameter (gmfquadrilaterals6=202) + parameter (gmfboundarypolygonheaders=203) + parameter (gmfboundarypolygonvertices=204) + parameter (gmfinnerpolygonheaders=205) + parameter (gmfinnerpolygonvertices=206) + parameter (gmfpolyhedraheaders=207) + parameter (gmfpolyhedrafaces=208) + parameter (gmfdomains=209) + parameter (gmfverticesgid=210) + parameter (gmfedgesgid=211) + parameter (gmftrianglesgid=212) + parameter (gmfquadrilateralsgid=213) + parameter (gmftetrahedragid=214) + parameter (gmfpyramidsgid=215) + parameter (gmfprismsgid=216) + parameter (gmfhexahedragid=217) + parameter (gmfsolatboundarypolygons=218) + parameter (gmfsolatpolyhedra=219) + parameter (gmfverticesongeometrynodes=220) + parameter (gmfverticesongeometryedges=221) + parameter (gmfedgesongeometryedges=222) + parameter (gmfverticesongeometryfaces=223) + parameter (gmfedgesongeometryfaces=224) + parameter (gmftrianglesongeometryfaces=225) + parameter (gmfquadrialteralsongeometryfaces=226) + parameter (gmfmeshongeometry=227) diff --git a/sources/libmeshb7_mod.f90 b/sources/libmeshb7_mod.f90 index 2dd263d..4fa2c46 100644 --- a/sources/libmeshb7_mod.f90 +++ b/sources/libmeshb7_mod.f90 @@ -1,603 +1,846 @@ - - !---------------------------------------------------------- ! -! LIBMESH V 7.56 +! LIBMESH V 7.79 ! !---------------------------------------------------------- ! -! Description: handles .meshb file format I/O -! Author: Loic MARECHAL -! Creation date: dec 08 2015 -! Last modification: nov 27 2020 +! Description: handles .meshb file format I/O +! Author: Loic MARECHAL +! Creation date: dec 08 2015 +! Last modification: feb 12 2024 ! !---------------------------------------------------------- module libmeshb7 - use, intrinsic :: iso_c_binding, only: c_int,c_long,c_loc,c_ptr + use iso_fortran_env + use, intrinsic :: iso_c_binding, only: c_int,c_long,c_loc,c_ptr,c_null_ptr implicit none - !Procedures definition - external gmfopenmesh - external gmfclosemesh - external gmfstatkwd - external gmfsetkwd - external gmfgotokwd - external gmfgetlin - external gmfsetlin - external gmfgetblock - external gmfsetblock - external gmfsethonodesordering - !external gmfreadbyteflow - !external gmfwritebyteflow - !external gmfgetfloatprecision - !external gmfsetfloatprecision - - integer(8) :: gmfopenmesh - integer(4) :: gmfclosemesh - integer(4) :: gmfstatkwd - integer(4) :: gmfsetkwd - integer(4) :: gmfgotokwd - integer(4) :: gmfgetlin - integer(4) :: gmfsetlin - integer(4) :: gmfgetblock - integer(4) :: gmfsetblock - integer(4) :: gmfsethonodesordering - !integer(4) :: gmfreadbyteflow - !integer(4) :: gmfwritebyteflow - !integer(4) :: gmfgetfloatprecision - !integer(4) :: gmfsetfloatprecision - - - !Parameters definition - integer(4) :: gmfmaxtyp - integer(4) :: gmfmaxkwd - integer(4) :: gmfread - integer(4) :: gmfwrite - integer(4) :: gmfsca - integer(4) :: gmfvec - integer(4) :: gmfsymmat - integer(4) :: gmfmat - integer(4) :: gmffloat - integer(4) :: gmfdouble - integer(4) :: gmfint - integer(4) :: gmflong - integer(4) :: gmfinttab - integer(4) :: gmflongtab - integer(4) :: gmffloatvec - integer(4) :: gmfdoublevec - integer(4) :: gmfintvec - integer(4) :: gmflongvec - integer(4) :: gmfargtab - integer(4) :: gmfarglst - - parameter (gmfmaxtyp=1000) - parameter (gmfmaxkwd=103) - parameter (gmfread=1) - parameter (gmfwrite=2) - parameter (gmfsca=1) - parameter (gmfvec=2) - parameter (gmfsymmat=3) - parameter (gmfmat=4) - parameter (gmffloat=1) - parameter (gmfdouble=2) - parameter (gmfint=3) - parameter (gmflong=4) - parameter (gmfinttab=7) - parameter (gmflongtab=8) - parameter (gmffloatvec=5) - parameter (gmfdoublevec=6) - parameter (gmfintvec=7) - parameter (gmflongvec=8) - parameter (gmfargtab=100) - parameter (gmfarglst=101) + ! Procedures definition + integer(int64) , external :: gmfopenmeshf77 + integer(int32) , external :: gmfclosemeshf77 + integer(int32) , external :: GmfStatKwdf77 + integer(int32) , external :: gmfsetkwdf77 + integer(int32) , external :: gmfgotokwdf77 + integer(int32) , external :: gmfsethonodesorderingf77 + integer(int32) , external :: gmfgetlinef77 + integer(int32) , external :: gmfsetlinef77 + integer(int32) , external :: gmfgetblockf77 + integer(int32) , external :: gmfsetblockf77 + + + ! Parameters definition + integer(int32), parameter :: gmfmaxtyp=1000 + integer(int32), parameter :: gmfmaxkwd=227 + integer(int32), parameter :: gmfread=1 + integer(int32), parameter :: gmfwrite=2 + integer(int32), parameter :: gmfsca=1 + integer(int32), parameter :: gmfvec=2 + integer(int32), parameter :: gmfsymmat=3 + integer(int32), parameter :: gmfmat=4 + integer(int32), parameter :: gmffloat=8 + integer(int32), parameter :: gmfdouble=9 + integer(int32), parameter :: gmfint=10 + integer(int32), parameter :: gmflong=11 + integer(int32), parameter :: gmfinttab=14 + integer(int32), parameter :: gmflongtab=15 + integer(int32), parameter :: gmffloatvec=12 + integer(int32), parameter :: gmfdoublevec=13 + integer(int32), parameter :: gmfintvec=14 + integer(int32), parameter :: gmflongvec=15 + integer(int32), parameter :: gmfargtab=100 + integer(int32), parameter :: gmfarglst=101 + + ! Keywords list + integer(int32), parameter :: gmfdimension=3 + integer(int32), parameter :: gmfmeshversionformatted=1 + integer(int32), parameter :: gmfvertices=4 + integer(int32), parameter :: gmfedges=5 + integer(int32), parameter :: gmftriangles=6 + integer(int32), parameter :: gmfquadrilaterals=7 + integer(int32), parameter :: gmftetrahedra=8 + integer(int32), parameter :: gmfprisms=9 + integer(int32), parameter :: gmfhexahedra=10 + integer(int32), parameter :: gmfiterationsall=11 + integer(int32), parameter :: gmftimesall=12 + integer(int32), parameter :: gmfcorners=13 + integer(int32), parameter :: gmfridges=14 + integer(int32), parameter :: gmfrequiredvertices=15 + integer(int32), parameter :: gmfrequirededges=16 + integer(int32), parameter :: gmfrequiredtriangles=17 + integer(int32), parameter :: gmfrequiredquadrilaterals=18 + integer(int32), parameter :: gmftangentatedgevertices=19 + integer(int32), parameter :: gmfnormalatvertices=20 + integer(int32), parameter :: gmfnormalattrianglevertices=21 + integer(int32), parameter :: gmfnormalatquadrilateralvertices=22 + integer(int32), parameter :: gmfangleofcornerbound=23 + integer(int32), parameter :: gmftrianglesp2=24 + integer(int32), parameter :: gmfedgesp2=25 + integer(int32), parameter :: gmfsolatpyramids=26 + integer(int32), parameter :: gmfquadrilateralsq2=27 + integer(int32), parameter :: gmfisolatpyramids=28 + integer(int32), parameter :: gmfsubdomainfromgeom=29 + integer(int32), parameter :: gmftetrahedrap2=30 + integer(int32), parameter :: gmffault_neartri=31 + integer(int32), parameter :: gmffault_inter=32 + integer(int32), parameter :: gmfhexahedraq2=33 + integer(int32), parameter :: gmfextraverticesatedges=34 + integer(int32), parameter :: gmfextraverticesattriangles=35 + integer(int32), parameter :: gmfextraverticesatquadrilaterals=36 + integer(int32), parameter :: gmfextraverticesattetrahedra=37 + integer(int32), parameter :: gmfextraverticesatprisms=38 + integer(int32), parameter :: gmfextraverticesathexahedra=39 + integer(int32), parameter :: gmfverticesongeometricvertices=40 + integer(int32), parameter :: gmfverticesongeometricedges=41 + integer(int32), parameter :: gmfverticesongeometrictriangles=42 + integer(int32), parameter :: gmfverticesongeometricquadrilaterals=43 + integer(int32), parameter :: gmfedgesongeometricedges=44 + integer(int32), parameter :: gmffault_freeedge=45 + integer(int32), parameter :: gmfpolyhedra=46 + integer(int32), parameter :: gmfpolygons=47 + integer(int32), parameter :: gmffault_overlap=48 + integer(int32), parameter :: gmfpyramids=49 + integer(int32), parameter :: gmfboundingbox=50 + integer(int32), parameter :: gmfbody=51 + integer(int32), parameter :: gmfprivatetable=52 + integer(int32), parameter :: gmffault_badshape=53 + integer(int32), parameter :: gmfend=54 + integer(int32), parameter :: gmftrianglesongeometrictriangles=55 + integer(int32), parameter :: gmftrianglesongeometricquadrilaterals=56 + integer(int32), parameter :: gmfquadrilateralsongeometrictriangles=57 + integer(int32), parameter :: gmfquadrilateralsongeometricquadrilaterals=58 + integer(int32), parameter :: gmftangents=59 + integer(int32), parameter :: gmfnormals=60 + integer(int32), parameter :: gmftangentatvertices=61 + integer(int32), parameter :: gmfsolatvertices=62 + integer(int32), parameter :: gmfsolatedges=63 + integer(int32), parameter :: gmfsolattriangles=64 + integer(int32), parameter :: gmfsolatquadrilaterals=65 + integer(int32), parameter :: gmfsolattetrahedra=66 + integer(int32), parameter :: gmfsolatprisms=67 + integer(int32), parameter :: gmfsolathexahedra=68 + integer(int32), parameter :: gmfdsolatvertices=69 + integer(int32), parameter :: gmfisolatvertices=70 + integer(int32), parameter :: gmfisolatedges=71 + integer(int32), parameter :: gmfisolattriangles=72 + integer(int32), parameter :: gmfisolatquadrilaterals=73 + integer(int32), parameter :: gmfisolattetrahedra=74 + integer(int32), parameter :: gmfisolatprisms=75 + integer(int32), parameter :: gmfisolathexahedra=76 + integer(int32), parameter :: gmfiterations=77 + integer(int32), parameter :: gmftime=78 + integer(int32), parameter :: gmffault_smalltri=79 + integer(int32), parameter :: gmfcoarsehexahedra=80 + integer(int32), parameter :: gmfcomments=81 + integer(int32), parameter :: gmfperiodicvertices=82 + integer(int32), parameter :: gmfperiodicedges=83 + integer(int32), parameter :: gmfperiodictriangles=84 + integer(int32), parameter :: gmfperiodicquadrilaterals=85 + integer(int32), parameter :: gmfprismsp2=86 + integer(int32), parameter :: gmfpyramidsp2=87 + integer(int32), parameter :: gmfquadrilateralsq3=88 + integer(int32), parameter :: gmfquadrilateralsq4=89 + integer(int32), parameter :: gmftrianglesp3=90 + integer(int32), parameter :: gmftrianglesp4=91 + integer(int32), parameter :: gmfedgesp3=92 + integer(int32), parameter :: gmfedgesp4=93 + integer(int32), parameter :: gmfirefgroups=94 + integer(int32), parameter :: gmfdrefgroups=95 + integer(int32), parameter :: gmftetrahedrap3=96 + integer(int32), parameter :: gmftetrahedrap4=97 + integer(int32), parameter :: gmfhexahedraq3=98 + integer(int32), parameter :: gmfhexahedraq4=99 + integer(int32), parameter :: gmfpyramidsp3=100 + integer(int32), parameter :: gmfpyramidsp4=101 + integer(int32), parameter :: gmfprismsp3=102 + integer(int32), parameter :: gmfprismsp4=103 + integer(int32), parameter :: gmfhosolatedgesp1=104 + integer(int32), parameter :: gmfhosolatedgesp2=105 + integer(int32), parameter :: gmfhosolatedgesp3=106 + integer(int32), parameter :: gmfhosolattrianglesp1=107 + integer(int32), parameter :: gmfhosolattrianglesp2=108 + integer(int32), parameter :: gmfhosolattrianglesp3=109 + integer(int32), parameter :: gmfhosolatquadrilateralsq1=110 + integer(int32), parameter :: gmfhosolatquadrilateralsq2=111 + integer(int32), parameter :: gmfhosolatquadrilateralsq3=112 + integer(int32), parameter :: gmfhosolattetrahedrap1=113 + integer(int32), parameter :: gmfhosolattetrahedrap2=114 + integer(int32), parameter :: gmfhosolattetrahedrap3=115 + integer(int32), parameter :: gmfhosolatpyramidsp1=116 + integer(int32), parameter :: gmfhosolatpyramidsp2=117 + integer(int32), parameter :: gmfhosolatpyramidsp3=118 + integer(int32), parameter :: gmfhosolatprismsp1=119 + integer(int32), parameter :: gmfhosolatprismsp2=120 + integer(int32), parameter :: gmfhosolatprismsp3=121 + integer(int32), parameter :: gmfhosolathexahedraq1=122 + integer(int32), parameter :: gmfhosolathexahedraq2=123 + integer(int32), parameter :: gmfhosolathexahedraq3=124 + integer(int32), parameter :: gmfbezierbasis=125 + integer(int32), parameter :: gmfbyteflow=126 + integer(int32), parameter :: gmfedgesp2ordering=127 + integer(int32), parameter :: gmfedgesp3ordering=128 + integer(int32), parameter :: gmftrianglesp2ordering=129 + integer(int32), parameter :: gmftrianglesp3ordering=130 + integer(int32), parameter :: gmfquadrilateralsq2ordering=131 + integer(int32), parameter :: gmfquadrilateralsq3ordering=132 + integer(int32), parameter :: gmftetrahedrap2ordering=133 + integer(int32), parameter :: gmftetrahedrap3ordering=134 + integer(int32), parameter :: gmfpyramidsp2ordering=135 + integer(int32), parameter :: gmfpyramidsp3ordering=136 + integer(int32), parameter :: gmfprismsp2ordering=137 + integer(int32), parameter :: gmfprismsp3ordering=138 + integer(int32), parameter :: gmfhexahedraq2ordering=139 + integer(int32), parameter :: gmfhexahedraq3ordering=140 + integer(int32), parameter :: gmfedgesp1ordering=141 + integer(int32), parameter :: gmfedgesp4ordering=142 + integer(int32), parameter :: gmftrianglesp1ordering=143 + integer(int32), parameter :: gmftrianglesp4ordering=144 + integer(int32), parameter :: gmfquadrilateralsq1ordering=145 + integer(int32), parameter :: gmfquadrilateralsq4ordering=146 + integer(int32), parameter :: gmftetrahedrap1ordering=147 + integer(int32), parameter :: gmftetrahedrap4ordering=148 + integer(int32), parameter :: gmfpyramidsp1ordering=149 + integer(int32), parameter :: gmfpyramidsp4ordering=150 + integer(int32), parameter :: gmfprismsp1ordering=151 + integer(int32), parameter :: gmfprismsp4ordering=152 + integer(int32), parameter :: gmfhexahedraq1ordering=153 + integer(int32), parameter :: gmfhexahedraq4ordering=154 + integer(int32), parameter :: gmffloatingpointprecision=155 + integer(int32), parameter :: gmfhosolatedgesp4=156 + integer(int32), parameter :: gmfhosolattrianglesp4=157 + integer(int32), parameter :: gmfhosolatquadrilateralsq4=158 + integer(int32), parameter :: gmfhosolattetrahedrap4=159 + integer(int32), parameter :: gmfhosolatpyramidsp4=160 + integer(int32), parameter :: gmfhosolatprismsp4=161 + integer(int32), parameter :: gmfhosolathexahedraq4=162 + integer(int32), parameter :: gmfhosolatedgesp1nodespositions=163 + integer(int32), parameter :: gmfhosolatedgesp2nodespositions=164 + integer(int32), parameter :: gmfhosolatedgesp3nodespositions=165 + integer(int32), parameter :: gmfhosolatedgesp4nodespositions=166 + integer(int32), parameter :: gmfhosolattrianglesp1nodespositions=167 + integer(int32), parameter :: gmfhosolattrianglesp2nodespositions=168 + integer(int32), parameter :: gmfhosolattrianglesp3nodespositions=169 + integer(int32), parameter :: gmfhosolattrianglesp4nodespositions=170 + integer(int32), parameter :: gmfhosolatquadrilateralsq1nodespositions=171 + integer(int32), parameter :: gmfhosolatquadrilateralsq2nodespositions=172 + integer(int32), parameter :: gmfhosolatquadrilateralsq3nodespositions=173 + integer(int32), parameter :: gmfhosolatquadrilateralsq4nodespositions=174 + integer(int32), parameter :: gmfhosolattetrahedrap1nodespositions=175 + integer(int32), parameter :: gmfhosolattetrahedrap2nodespositions=176 + integer(int32), parameter :: gmfhosolattetrahedrap3nodespositions=177 + integer(int32), parameter :: gmfhosolattetrahedrap4nodespositions=178 + integer(int32), parameter :: gmfhosolatpyramidsp1nodespositions=179 + integer(int32), parameter :: gmfhosolatpyramidsp2nodespositions=180 + integer(int32), parameter :: gmfhosolatpyramidsp3nodespositions=181 + integer(int32), parameter :: gmfhosolatpyramidsp4nodespositions=182 + integer(int32), parameter :: gmfhosolatprismsp1nodespositions=183 + integer(int32), parameter :: gmfhosolatprismsp2nodespositions=184 + integer(int32), parameter :: gmfhosolatprismsp3nodespositions=185 + integer(int32), parameter :: gmfhosolatprismsp4nodespositions=186 + integer(int32), parameter :: gmfhosolathexahedraq1nodespositions=187 + integer(int32), parameter :: gmfhosolathexahedraq2nodespositions=188 + integer(int32), parameter :: gmfhosolathexahedraq3nodespositions=189 + integer(int32), parameter :: gmfhosolathexahedraq4nodespositions=190 + integer(int32), parameter :: gmfedgesreferenceelement=191 + integer(int32), parameter :: gmftrianglereferenceelement=192 + integer(int32), parameter :: gmfquadrilateralreferenceelement=193 + integer(int32), parameter :: gmftetrahedronreferenceelement=194 + integer(int32), parameter :: gmfpyramidreferenceelement=195 + integer(int32), parameter :: gmfprismreferenceelement=196 + integer(int32), parameter :: gmfhexahedronreferenceelement=197 + integer(int32), parameter :: gmfboundarylayers=198 + integer(int32), parameter :: gmfreferencestrings=199 + integer(int32), parameter :: gmfprisms9=200 + integer(int32), parameter :: gmfhexahedra12=201 + integer(int32), parameter :: gmfquadrilaterals6=202 + integer(int32), parameter :: gmfboundarypolygonheaders=203 + integer(int32), parameter :: gmfboundarypolygonvertices=204 + integer(int32), parameter :: gmfinnerpolygonheaders=205 + integer(int32), parameter :: gmfinnerpolygonvertices=206 + integer(int32), parameter :: gmfpolyhedraheaders=207 + integer(int32), parameter :: gmfpolyhedrafaces=208 + integer(int32), parameter :: gmfdomains=209 + integer(int32), parameter :: gmfverticesgid=210 + integer(int32), parameter :: gmfedgesgid=211 + integer(int32), parameter :: gmftrianglesgid=212 + integer(int32), parameter :: gmfquadrilateralsgid=213 + integer(int32), parameter :: gmftetrahedragid=214 + integer(int32), parameter :: gmfpyramidsgid=215 + integer(int32), parameter :: gmfprismsgid=216 + integer(int32), parameter :: gmfhexahedragid=217 + integer(int32), parameter :: gmfsolatboundarypolygons=218 + integer(int32), parameter :: gmfsolatpolyhedra=219 + integer(int32), parameter :: gmfverticesongeometrynodes=220 + integer(int32), parameter :: gmfverticesongeometryedges=221 + integer(int32), parameter :: gmfedgesongeometryedges=222 + integer(int32), parameter :: gmfverticesongeometryfaces=223 + integer(int32), parameter :: gmfedgesongeometryfaces=224 + integer(int32), parameter :: gmftrianglesongeometryfaces=225 + integer(int32), parameter :: gmfquadrialteralsongeometryfaces=226 + integer(int32), parameter :: gmfmeshongeometry=227 + + interface GmfStatKwdF90 + module procedure GmfStatKwdF90_0 !> vertices & nodes + module procedure GmfStatKwdF90_1 !> solutions + end interface GmfStatKwdF90 + + interface GmfSetKwdF90 + module procedure GmfSetKwdF90_0 !> vertices & nodes + module procedure GmfSetKwdF90_1 !> solutions + end interface GmfSetKwdF90 + + interface GmfGetLineF90 + module procedure GmfGetLineF90_i + module procedure GmfGetLineF90_d + end interface GmfGetLineF90 + + interface GmfSetLineF90 + module procedure GmfSetLineF90_i + module procedure GmfSetLineF90_d + module procedure GmfSetLineF90_sol_i + module procedure GmfSetLineF90_sol_d + end interface GmfSetLineF90 + + interface GmfGetBlockF90 + !module procedure GmfGetBlockF90_00 + module procedure GmfGetBlockF90_01 !> nodes + ref + module procedure GmfGetBlockF90_01Bis !> nodes + module procedure GmfGetBlockF90_02 !> vertices + ref + module procedure GmfGetBlockF90_02Bis !> solutions + end interface GmfGetBlockF90 + + interface GmfSetBlockF90 + !module procedure GmfGetBlockF90_00 + module procedure GmfSetBlockF90_01 !> nodes + ref + module procedure GmfSetBlockF90_02 !> vertices + ref + module procedure GmfSetBlockF90_02Bis !> solutions + end interface GmfSetBlockF90 + +contains + + function GmfOpenMeshF90(name, GmfKey, ver, dim) result(unit) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + character(*) , intent(in) :: name + integer(int32), intent(in) :: GmfKey + integer(int32), intent(inout) :: ver + integer(int32), intent(inout) :: dim + integer(int64) :: unit + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + unit = GmfOpenMeshf77(trim(name), GmfKey, ver, dim) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfOpenMeshF90 + + function GmfCloseMeshF90(unit) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: res + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfCloseMeshF77(unit) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfCloseMeshF90 + + function GmfStatKwdF90_0(unit, GmfKey) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: Nmb + integer(int32) :: res + !> + integer(int32) :: t(1),d,ho,s + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res = GmfStatKwdf77(unit, GmfKey, 0, 0, t(1), 0, 0) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfStatKwdF90_0 + + function GmfStatKwdF90_1(unit, GmfKey, r, s, t, d, ho) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: Nmb + integer(int32) :: res + !> + integer(int32) :: r,s,t(:),d,ho + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res = GmfStatKwdf77(unit, GmfKey, r, s, t(1), d, ho) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfStatKwdF90_1 + + function GmfGotoKwdF90(unit, GmfKey) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: res + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfgotokwdF77(unit, GmfKey) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfGotoKwdF90 + + function GmfSetKwdF90_0(unit, GmfKey, Nmb) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: Nmb + !> + integer(int32) :: t(1),d,ho,s + integer(int32) :: res + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res = GmfSetKwdF77(unit, GmfKey, Nmb, 0, t(1), 0, ho) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetKwdF90_0 + + function GmfSetKwdF90_1(unit, GmfKey, Nmb, d, t, s, ho) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: Nmb + integer(int32) :: t(:) + integer(int32) :: d,ho,s + integer(int32) :: res + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res = GmfSetKwdF77(unit, GmfKey, Nmb, d, t, s, ho) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetKwdF90_1 + + function GmfSetHONodesOrderingF90(unit, GmfKey, BasTab, OrdTab) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: BasTab(:,:) + integer(int32) :: OrdTab(:,:) + integer(int32) :: res + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfSetHONodesOrderingF77(unit,GmfKey,BasTab,OrdTab) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetHONodesOrderingF90 + + function GmfGetLineF90_i(unit, GmfKey, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Reading Nodes and Ref + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: Tab(:) + integer(int32) :: Ref + integer(int32) :: res + !> + real(real64) :: dTab(1) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfGetLineF77(unit, GmfKey, Tab(1), dTab(1), Ref) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfGetLineF90_i + + function GmfGetLineF90_d(unit, GmfKey, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Reading Vertices and Ref + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + real(real64) :: Tab(:) + integer(int32) :: Ref + integer(int32) :: res + !> + integer(int32) :: iTab(1) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfGetLineF77(unit, GmfKey, iTab(1), Tab(1), Ref) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + end function GmfGetLineF90_d + + function GmfSetLineF90_i(unit, GmfKey, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Writting Nodes and Ref + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: Tab(:) + integer(int32) :: Ref + integer(int32) :: res + !> + real(real64) :: dTab(1) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfSetLineF77(unit, GmfKey, Tab(1), dTab(1), Ref) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetLineF90_i + + function GmfSetLineF90_d(unit, GmfKey, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Writting Vertices and Ref + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + real(real64) :: Tab(:) + integer(int32) :: Ref + integer(int32) :: res + !> + integer(int32) :: iTab(1) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfSetLineF77(unit, GmfKey, iTab(1), Tab(1), Ref) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetLineF90_d + + function GmfSetLineF90_sol_i(unit, GmfKey, iTab) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Writting Nodes and Ref + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + integer(int32) :: iTab(:) + integer(int32) :: iRef + integer(int32) :: res + !> + real(real64) :: dTab(1) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfSetLineF77(unit, GmfKey, iTab(1), dTab(1), iRef) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetLineF90_sol_i + + function GmfSetLineF90_sol_d(unit, GmfKey, dTab) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !> Writting Vertices and Ref + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64) :: unit + integer(int32) :: GmfKey + real(real64) :: dTab(:) + integer(int32) :: res + !> + integer(int32) :: iRef + integer(int32) :: iTab(1) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + res=GmfSetLineF77(unit, GmfKey, iTab(1), dTab(1), iRef) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetLineF90_sol_d + + function GmfGetBlockF90_00(unit, GmfKey, ad0, ad1, iTab, dTab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + integer(int32), intent(inout) :: iTab(:,:) + real(real64) , intent(inout) :: dTab(:,:) + integer(int32), intent(inout) :: Ref( :) + integer(int32) :: res + !> + integer(int32) :: Nmb + integer(int32), pointer :: map(:)=>null() + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + Nmb=ad1-ad0+1 + + res=GmfGetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & iTab(1, 1),& + & iTab(1,Nmb),& + & dTab(1, 1),& + & dTab(1,Nmb),& + & Ref( 1),& + & Ref( Nmb) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfGetBlockF90_00 + + function GmfGetBlockF90_01(unit, GmfKey, ad0, ad1, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + integer(int32), intent(inout) :: Tab(:,:) + integer(int32), intent(inout) :: Ref( :) + integer(int32) :: res + !> + integer(int32) :: Nmb + real(real64) :: dTab(1) + integer(int32), pointer :: map(:)=>null() + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + + Nmb=ad1-ad0+1 + + print '("GmfGetBlockF90_01 (ad0,ad1)=(",i0,",",i0,") Nmb=",i0)',ad0,ad1,Nmb + print '("GmfGetBlockF90_01 size(Tab)=",i0,"x",i0)',size(Tab,1),size(Tab,2) + print '("GmfGetBlockF90_01 size(Ref)= ",i0)',size(Ref) + + res=GmfGetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & Tab(1, 1) ,& + & Tab(1,Nmb) ,& + & dTab(1) ,& + & dTab(1) ,& + & Ref( 1) ,& + & Ref( Nmb) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfGetBlockF90_01 - !Keywords list - integer(4) :: gmfmeshversionformatted - integer(4) :: gmfdimension - integer(4) :: gmfvertices - integer(4) :: gmfedges - integer(4) :: gmftriangles - integer(4) :: gmfquadrilaterals - integer(4) :: gmftetrahedra - integer(4) :: gmfprisms - integer(4) :: gmfhexahedra - integer(4) :: gmfiterationsall - integer(4) :: gmftimesall - integer(4) :: gmfcorners - integer(4) :: gmfridges - integer(4) :: gmfrequiredvertices - integer(4) :: gmfrequirededges - integer(4) :: gmfrequiredtriangles - integer(4) :: gmfrequiredquadrilaterals - integer(4) :: gmftangentatedgevertices - integer(4) :: gmfnormalatvertices - integer(4) :: gmfnormalattrianglevertices - integer(4) :: gmfnormalatquadrilateralvertices - integer(4) :: gmfangleofcornerbound - integer(4) :: gmftrianglesp2 - integer(4) :: gmfedgesp2 - integer(4) :: gmfsolatpyramids - integer(4) :: gmfquadrilateralsq2 - integer(4) :: gmfisolatpyramids - integer(4) :: gmfsubdomainfromgeom - integer(4) :: gmftetrahedrap2 - integer(4) :: gmffault_neartri - integer(4) :: gmffault_inter - integer(4) :: gmfhexahedraq2 - integer(4) :: gmfextraverticesatedges - integer(4) :: gmfextraverticesattriangles - integer(4) :: gmfextraverticesatquadrilaterals - integer(4) :: gmfextraverticesattetrahedra - integer(4) :: gmfextraverticesatprisms - integer(4) :: gmfextraverticesathexahedra - integer(4) :: gmfverticesongeometricvertices - integer(4) :: gmfverticesongeometricedges - integer(4) :: gmfverticesongeometrictriangles - integer(4) :: gmfverticesongeometricquadrilaterals - integer(4) :: gmfedgesongeometricedges - integer(4) :: gmffault_freeedge - integer(4) :: gmfpolyhedra - integer(4) :: gmfpolygons - integer(4) :: gmffault_overlap - integer(4) :: gmfpyramids - integer(4) :: gmfboundingbox - integer(4) :: gmfbody - integer(4) :: gmfprivatetable - integer(4) :: gmffault_badshape - integer(4) :: gmfend - integer(4) :: gmftrianglesongeometrictriangles - integer(4) :: gmftrianglesongeometricquadrilaterals - integer(4) :: gmfquadrilateralsongeometrictriangles - integer(4) :: gmfquadrilateralsongeometricquadrilaterals - integer(4) :: gmftangents - integer(4) :: gmfnormals - integer(4) :: gmftangentatvertices - integer(4) :: gmfsolatvertices - integer(4) :: gmfsolatedges - integer(4) :: gmfsolattriangles - integer(4) :: gmfsolatquadrilaterals - integer(4) :: gmfsolattetrahedra - integer(4) :: gmfsolatprisms - integer(4) :: gmfsolathexahedra - integer(4) :: gmfdsolatvertices - integer(4) :: gmfisolatvertices - integer(4) :: gmfisolatedges - integer(4) :: gmfisolattriangles - integer(4) :: gmfisolatquadrilaterals - integer(4) :: gmfisolattetrahedra - integer(4) :: gmfisolatprisms - integer(4) :: gmfisolathexahedra - integer(4) :: gmfiterations - integer(4) :: gmftime - integer(4) :: gmffault_smalltri - integer(4) :: gmfcoarsehexahedra - integer(4) :: gmfcomments - integer(4) :: gmfperiodicvertices - integer(4) :: gmfperiodicedges - integer(4) :: gmfperiodictriangles - integer(4) :: gmfperiodicquadrilaterals - integer(4) :: gmfprismsp2 - integer(4) :: gmfpyramidsp2 - integer(4) :: gmfquadrilateralsq3 - integer(4) :: gmfquadrilateralsq4 - integer(4) :: gmftrianglesp3 - integer(4) :: gmftrianglesp4 - integer(4) :: gmfedgesp3 - integer(4) :: gmfedgesp4 - integer(4) :: gmfirefgroups - integer(4) :: gmfdrefgroups - integer(4) :: gmftetrahedrap3 - integer(4) :: gmftetrahedrap4 - integer(4) :: gmfhexahedraq3 - integer(4) :: gmfhexahedraq4 - integer(4) :: gmfpyramidsp3 - integer(4) :: gmfpyramidsp4 - integer(4) :: gmfprismsp3 - integer(4) :: gmfprismsp4 - integer(4) :: gmfhosolatedgesp1 - integer(4) :: gmfhosolatedgesp2 - integer(4) :: gmfhosolatedgesp3 - integer(4) :: gmfhosolattrianglesp1 - integer(4) :: gmfhosolattrianglesp2 - integer(4) :: gmfhosolattrianglesp3 - integer(4) :: gmfhosolatquadrilateralsq1 - integer(4) :: gmfhosolatquadrilateralsq2 - integer(4) :: gmfhosolatquadrilateralsq3 - integer(4) :: gmfhosolattetrahedrap1 - integer(4) :: gmfhosolattetrahedrap2 - integer(4) :: gmfhosolattetrahedrap3 - integer(4) :: gmfhosolatpyramidsp1 - integer(4) :: gmfhosolatpyramidsp2 - integer(4) :: gmfhosolatpyramidsp3 - integer(4) :: gmfhosolatprismsp1 - integer(4) :: gmfhosolatprismsp2 - integer(4) :: gmfhosolatprismsp3 - integer(4) :: gmfhosolathexahedraq1 - integer(4) :: gmfhosolathexahedraq2 - integer(4) :: gmfhosolathexahedraq3 - integer(4) :: gmfbezierbasis - integer(4) :: gmfbyteflow - integer(4) :: gmfedgesp2ordering - integer(4) :: gmfedgesp3ordering - integer(4) :: gmftrianglesp2ordering - integer(4) :: gmftrianglesp3ordering - integer(4) :: gmfquadrilateralsq2ordering - integer(4) :: gmfquadrilateralsq3ordering - integer(4) :: gmftetrahedrap2ordering - integer(4) :: gmftetrahedrap3ordering - integer(4) :: gmfpyramidsp2ordering - integer(4) :: gmfpyramidsp3ordering - integer(4) :: gmfprismsp2ordering - integer(4) :: gmfprismsp3ordering - integer(4) :: gmfhexahedraq2ordering - integer(4) :: gmfhexahedraq3ordering - integer(4) :: gmfedgesp1ordering - integer(4) :: gmfedgesp4ordering - integer(4) :: gmftrianglesp1ordering - integer(4) :: gmftrianglesp4ordering - integer(4) :: gmfquadrilateralsq1ordering - integer(4) :: gmfquadrilateralsq4ordering - integer(4) :: gmftetrahedrap1ordering - integer(4) :: gmftetrahedrap4ordering - integer(4) :: gmfpyramidsp1ordering - integer(4) :: gmfpyramidsp4ordering - integer(4) :: gmfprismsp1ordering - integer(4) :: gmfprismsp4ordering - integer(4) :: gmfhexahedraq1ordering - integer(4) :: gmfhexahedraq4ordering - integer(4) :: gmffloatingpointprecision - integer(4) :: gmfhosolatedgesp4 - integer(4) :: gmfhosolattrianglesp4 - integer(4) :: gmfhosolatquadrilateralsq4 - integer(4) :: gmfhosolattetrahedrap4 - integer(4) :: gmfhosolatpyramidsp4 - integer(4) :: gmfhosolatprismsp4 - integer(4) :: gmfhosolathexahedraq4 - integer(4) :: gmfhosolatedgesp1nodespositions - integer(4) :: gmfhosolatedgesp2nodespositions - integer(4) :: gmfhosolatedgesp3nodespositions - integer(4) :: gmfhosolatedgesp4nodespositions - integer(4) :: gmfhosolattrianglesp1nodespositions - integer(4) :: gmfhosolattrianglesp2nodespositions - integer(4) :: gmfhosolattrianglesp3nodespositions - integer(4) :: gmfhosolattrianglesp4nodespositions - integer(4) :: gmfhosolatquadrilateralsq1nodespositions - integer(4) :: gmfhosolatquadrilateralsq2nodespositions - integer(4) :: gmfhosolatquadrilateralsq3nodespositions - integer(4) :: gmfhosolatquadrilateralsq4nodespositions - integer(4) :: gmfhosolattetrahedrap1nodespositions - integer(4) :: gmfhosolattetrahedrap2nodespositions - integer(4) :: gmfhosolattetrahedrap3nodespositions - integer(4) :: gmfhosolattetrahedrap4nodespositions - integer(4) :: gmfhosolatpyramidsp1nodespositions - integer(4) :: gmfhosolatpyramidsp2nodespositions - integer(4) :: gmfhosolatpyramidsp3nodespositions - integer(4) :: gmfhosolatpyramidsp4nodespositions - integer(4) :: gmfhosolatprismsp1nodespositions - integer(4) :: gmfhosolatprismsp2nodespositions - integer(4) :: gmfhosolatprismsp3nodespositions - integer(4) :: gmfhosolatprismsp4nodespositions - integer(4) :: gmfhosolathexahedraq1nodespositions - integer(4) :: gmfhosolathexahedraq2nodespositions - integer(4) :: gmfhosolathexahedraq3nodespositions - integer(4) :: gmfhosolathexahedraq4nodespositions - integer(4) :: gmfedgesreferenceelement - integer(4) :: gmftrianglereferenceelement - integer(4) :: gmfquadrilateralreferenceelement - integer(4) :: gmftetrahedronreferenceelement - integer(4) :: gmfpyramidreferenceelement - integer(4) :: gmfprismreferenceelement - integer(4) :: gmfhexahedronreferenceelement - integer(4) :: gmfboundarylayers - integer(4) :: gmfreferencestrings - integer(4) :: gmfprisms9 - integer(4) :: gmfhexahedra12 + function GmfGetBlockF90_01Bis(unit, GmfKey, ad0, ad1, Tab) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + integer(int32), intent(inout) :: Tab(:,:) + integer(int32) :: res + !> + integer(int32) :: Nmb + real(real64) :: dTab(1) + integer(int32) :: Ref(1) + integer(int32), pointer :: map(:)=>null() - parameter (gmfmeshversionformatted=1) - parameter (gmfdimension=3) - parameter (gmfvertices=4) - parameter (gmfedges=5) - parameter (gmftriangles=6) - parameter (gmfquadrilaterals=7) - parameter (gmftetrahedra=8) - parameter (gmfprisms=9) - parameter (gmfhexahedra=10) - parameter (gmfiterationsall=11) - parameter (gmftimesall=12) - parameter (gmfcorners=13) - parameter (gmfridges=14) - parameter (gmfrequiredvertices=15) - parameter (gmfrequirededges=16) - parameter (gmfrequiredtriangles=17) - parameter (gmfrequiredquadrilaterals=18) - parameter (gmftangentatedgevertices=19) - parameter (gmfnormalatvertices=20) - parameter (gmfnormalattrianglevertices=21) - parameter (gmfnormalatquadrilateralvertices=22) - parameter (gmfangleofcornerbound=23) - parameter (gmftrianglesp2=24) - parameter (gmfedgesp2=25) - parameter (gmfsolatpyramids=26) - parameter (gmfquadrilateralsq2=27) - parameter (gmfisolatpyramids=28) - parameter (gmfsubdomainfromgeom=29) - parameter (gmftetrahedrap2=30) - parameter (gmffault_neartri=31) - parameter (gmffault_inter=32) - parameter (gmfhexahedraq2=33) - parameter (gmfextraverticesatedges=34) - parameter (gmfextraverticesattriangles=35) - parameter (gmfextraverticesatquadrilaterals=36) - parameter (gmfextraverticesattetrahedra=37) - parameter (gmfextraverticesatprisms=38) - parameter (gmfextraverticesathexahedra=39) - parameter (gmfverticesongeometricvertices=40) - parameter (gmfverticesongeometricedges=41) - parameter (gmfverticesongeometrictriangles=42) - parameter (gmfverticesongeometricquadrilaterals=43) - parameter (gmfedgesongeometricedges=44) - parameter (gmffault_freeedge=45) - parameter (gmfpolyhedra=46) - parameter (gmfpolygons=47) - parameter (gmffault_overlap=48) - parameter (gmfpyramids=49) - parameter (gmfboundingbox=50) - parameter (gmfbody=51) - parameter (gmfprivatetable=52) - parameter (gmffault_badshape=53) - parameter (gmfend=54) - parameter (gmftrianglesongeometrictriangles=55) - parameter (gmftrianglesongeometricquadrilaterals=56) - parameter (gmfquadrilateralsongeometrictriangles=57) - parameter (gmfquadrilateralsongeometricquadrilaterals=58) - parameter (gmftangents=59) - parameter (gmfnormals=60) - parameter (gmftangentatvertices=61) - parameter (gmfsolatvertices=62) - parameter (gmfsolatedges=63) - parameter (gmfsolattriangles=64) - parameter (gmfsolatquadrilaterals=65) - parameter (gmfsolattetrahedra=66) - parameter (gmfsolatprisms=67) - parameter (gmfsolathexahedra=68) - parameter (gmfdsolatvertices=69) - parameter (gmfisolatvertices=70) - parameter (gmfisolatedges=71) - parameter (gmfisolattriangles=72) - parameter (gmfisolatquadrilaterals=73) - parameter (gmfisolattetrahedra=74) - parameter (gmfisolatprisms=75) - parameter (gmfisolathexahedra=76) - parameter (gmfiterations=77) - parameter (gmftime=78) - parameter (gmffault_smalltri=79) - parameter (gmfcoarsehexahedra=80) - parameter (gmfcomments=81) - parameter (gmfperiodicvertices=82) - parameter (gmfperiodicedges=83) - parameter (gmfperiodictriangles=84) - parameter (gmfperiodicquadrilaterals=85) - parameter (gmfprismsp2=86) - parameter (gmfpyramidsp2=87) - parameter (gmfquadrilateralsq3=88) - parameter (gmfquadrilateralsq4=89) - parameter (gmftrianglesp3=90) - parameter (gmftrianglesp4=91) - parameter (gmfedgesp3=92) - parameter (gmfedgesp4=93) - parameter (gmfirefgroups=94) - parameter (gmfdrefgroups=95) - parameter (gmftetrahedrap3=96) - parameter (gmftetrahedrap4=97) - parameter (gmfhexahedraq3=98) - parameter (gmfhexahedraq4=99) - parameter (gmfpyramidsp3=100) - parameter (gmfpyramidsp4=101) - parameter (gmfprismsp3=102) - parameter (gmfprismsp4=103) - parameter (gmfhosolatedgesp1=104) - parameter (gmfhosolatedgesp2=105) - parameter (gmfhosolatedgesp3=106) - parameter (gmfhosolattrianglesp1=107) - parameter (gmfhosolattrianglesp2=108) - parameter (gmfhosolattrianglesp3=109) - parameter (gmfhosolatquadrilateralsq1=110) - parameter (gmfhosolatquadrilateralsq2=111) - parameter (gmfhosolatquadrilateralsq3=112) - parameter (gmfhosolattetrahedrap1=113) - parameter (gmfhosolattetrahedrap2=114) - parameter (gmfhosolattetrahedrap3=115) - parameter (gmfhosolatpyramidsp1=116) - parameter (gmfhosolatpyramidsp2=117) - parameter (gmfhosolatpyramidsp3=118) - parameter (gmfhosolatprismsp1=119) - parameter (gmfhosolatprismsp2=120) - parameter (gmfhosolatprismsp3=121) - parameter (gmfhosolathexahedraq1=122) - parameter (gmfhosolathexahedraq2=123) - parameter (gmfhosolathexahedraq3=124) - parameter (gmfbezierbasis=125) - parameter (gmfbyteflow=126) - parameter (gmfedgesp2ordering=127) - parameter (gmfedgesp3ordering=128) - parameter (gmftrianglesp2ordering=129) - parameter (gmftrianglesp3ordering=130) - parameter (gmfquadrilateralsq2ordering=131) - parameter (gmfquadrilateralsq3ordering=132) - parameter (gmftetrahedrap2ordering=133) - parameter (gmftetrahedrap3ordering=134) - parameter (gmfpyramidsp2ordering=135) - parameter (gmfpyramidsp3ordering=136) - parameter (gmfprismsp2ordering=137) - parameter (gmfprismsp3ordering=138) - parameter (gmfhexahedraq2ordering=139) - parameter (gmfhexahedraq3ordering=140) - parameter (gmfedgesp1ordering=141) - parameter (gmfedgesp4ordering=142) - parameter (gmftrianglesp1ordering=143) - parameter (gmftrianglesp4ordering=144) - parameter (gmfquadrilateralsq1ordering=145) - parameter (gmfquadrilateralsq4ordering=146) - parameter (gmftetrahedrap1ordering=147) - parameter (gmftetrahedrap4ordering=148) - parameter (gmfpyramidsp1ordering=149) - parameter (gmfpyramidsp4ordering=150) - parameter (gmfprismsp1ordering=151) - parameter (gmfprismsp4ordering=152) - parameter (gmfhexahedraq1ordering=153) - parameter (gmfhexahedraq4ordering=154) - parameter (gmffloatingpointprecision=155) - parameter (gmfhosolatedgesp4=156) - parameter (gmfhosolattrianglesp4=157) - parameter (gmfhosolatquadrilateralsq4=158) - parameter (gmfhosolattetrahedrap4=159) - parameter (gmfhosolatpyramidsp4=160) - parameter (gmfhosolatprismsp4=161) - parameter (gmfhosolathexahedraq4=162) - parameter (gmfhosolatedgesp1nodespositions=163) - parameter (gmfhosolatedgesp2nodespositions=164) - parameter (gmfhosolatedgesp3nodespositions=165) - parameter (gmfhosolatedgesp4nodespositions=166) - parameter (gmfhosolattrianglesp1nodespositions=167) - parameter (gmfhosolattrianglesp2nodespositions=168) - parameter (gmfhosolattrianglesp3nodespositions=169) - parameter (gmfhosolattrianglesp4nodespositions=170) - parameter (gmfhosolatquadrilateralsq1nodespositions=171) - parameter (gmfhosolatquadrilateralsq2nodespositions=172) - parameter (gmfhosolatquadrilateralsq3nodespositions=173) - parameter (gmfhosolatquadrilateralsq4nodespositions=174) - parameter (gmfhosolattetrahedrap1nodespositions=175) - parameter (gmfhosolattetrahedrap2nodespositions=176) - parameter (gmfhosolattetrahedrap3nodespositions=177) - parameter (gmfhosolattetrahedrap4nodespositions=178) - parameter (gmfhosolatpyramidsp1nodespositions=179) - parameter (gmfhosolatpyramidsp2nodespositions=180) - parameter (gmfhosolatpyramidsp3nodespositions=181) - parameter (gmfhosolatpyramidsp4nodespositions=182) - parameter (gmfhosolatprismsp1nodespositions=183) - parameter (gmfhosolatprismsp2nodespositions=184) - parameter (gmfhosolatprismsp3nodespositions=185) - parameter (gmfhosolatprismsp4nodespositions=186) - parameter (gmfhosolathexahedraq1nodespositions=187) - parameter (gmfhosolathexahedraq2nodespositions=188) - parameter (gmfhosolathexahedraq3nodespositions=189) - parameter (gmfhosolathexahedraq4nodespositions=190) - parameter (gmfedgesreferenceelement=191) - parameter (gmftrianglereferenceelement=192) - parameter (gmfquadrilateralreferenceelement=193) - parameter (gmftetrahedronreferenceelement=194) - parameter (gmfpyramidreferenceelement=195) - parameter (gmfprismreferenceelement=196) - parameter (gmfhexahedronreferenceelement=197) - parameter (gmfboundarylayers=198) - parameter (gmfreferencestrings=199) - parameter (gmfprisms9=200) - parameter (gmfhexahedra12=201) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + + Nmb=ad1-ad0+1 + + print '("GmfGetBlockF90_01Bis (ad0,ad1)=(",i0,",",i0,") Nmb=",i0)',ad0,ad1,Nmb + print '("GmfGetBlockF90_01Bis size(Tab)=",i0,"x",i0)',size(Tab,1),size(Tab,2) + print '("GmfGetBlockF90_01Bis size(Ref)= ",i0)',size(Ref) + + res=GmfGetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & Tab(1, 1) ,& + & Tab(1,Nmb) ,& + & dTab(1) ,& + & dTab(1) ,& + & Ref( 1) ,& + & Ref( 1) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfGetBlockF90_01Bis + + function GmfGetBlockF90_02(unit, GmfKey, ad0, ad1, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + real(real64) , intent(inout) :: Tab(:,:) + integer(int32), intent(inout) :: Ref( :) + integer(int32) :: res + !> + integer(int32) :: iTab(1) + integer(int32) :: Nmb + integer(int32), pointer :: map(:)=>null() + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + Nmb=ad1-ad0+1 + + print '("GmfGetBlockF90_02 (ad0,ad1)=(",i0,",",i0,") Nmb=",i0)',ad0,ad1,Nmb + print '("GmfGetBlockF90_02 size(Tab)=",i0,"x",i0)',size(Tab,1),size(Tab,2) + print '("GmfGetBlockF90_02 size(Ref)= ",i0)',size(Ref) + + res=GmfGetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & iTab(1) ,& + & iTab(1) ,& + & Tab(1, 1) ,& + & Tab(1,Nmb) ,& + & Ref( 1) ,& + & Ref( Nmb) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfGetBlockF90_02 + + function GmfGetBlockF90_02Bis(unit, GmfKey, ad0, ad1, Tab) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + real(real64) , intent(inout) :: Tab(:,:) + integer(int32) :: res + !> + integer(int32) :: Ref (1) + integer(int32) :: iTab(1) + integer(int32) :: Nmb + integer(int32), pointer :: map(:)=>null() + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + Nmb=ad1-ad0+1 + + print '("GmfGetBlockF90_02Bis (ad0,ad1)=(",i0,",",i0,") Nmb=",i0)',ad0,ad1,Nmb + print '("GmfGetBlockF90_02Bis size(Tab)=",i0,"x",i0)',size(Tab,1),size(Tab,2) + print '("GmfGetBlockF90_02Bis size(Ref)= ",i0)',size(Ref) + + res=GmfGetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & iTab(1) ,& + & iTab(1) ,& + & Tab(1, 1) ,& + & Tab(1,Nmb) ,& + & Ref( 1) ,& + & Ref( 1) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfGetBlockF90_02Bis + + function GmfSetBlockF90_01(unit, GmfKey, ad0, ad1, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + integer(int32), intent(inout) :: Tab(:,:) + integer(int32), intent(inout) :: Ref( :) + integer(int32) :: res + !> + integer(int32) :: Nmb + real(real64) :: dTab(1) + integer(int32), pointer :: map(:)=>null() -! !> interface GmfSetHONodesOrdering_c -! interface -! function GmfSetHONodesOrdering_c(InpMsh, GmfKey, BasOrd, FilOrd) result(iErr) bind(c, name="GmfSetHONodesOrdering") -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! import c_long,c_int,c_ptr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! integer(c_long) , intent(in) :: InpMsh -! integer(c_int) , intent(in) :: GmfKey -! !integer(c_int) , intent(in) :: BasOrd(:,:) -! !integer(c_int) , intent(in) :: FilOrd(:,:) -! type(c_ptr) , intent(in) :: BasOrd -! type(c_ptr) , intent(in) :: FilOrd -! integer(c_int) :: iErr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! end function GmfSetHONodesOrdering_c -! -! function GmfCloseMesh_c(InpMsh) result(iErr) bind(c, name="GmfCloseMesh") -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! import c_long,c_int,c_ptr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! integer(c_long) , intent(in) :: InpMsh -! integer(c_int) :: iErr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! end function GmfCloseMesh_c -! -! end interface -! -! -! public :: GmfSetHONodesOrdering_f90 -! public :: GmfOpenMesh_f90 -! public :: GmfCloseMesh_f90 - - - !> les lignes suivantes sont en conflit avec la variable integer(4) :: gmfsethonodesordering - !interface GmfSetHONodesOrdering - ! module procedure GmfSetHONodesOrdering_f90 - ! module procedure GmfSetHONodesOrdering_c - !end interface + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + Nmb=ad1-ad0+1 + + print '("GmfSetBlockF90_01 (ad0,ad1)=(",i0,",",i0,") Nmb=",i0)',ad0,ad1,Nmb + print '("GmfSetBlockF90_01 size(Tab)=",i0,"x",i0)',size(Tab,1),size(Tab,2) + print '("GmfSetBlockF90_01 size(Ref)= ",i0)',size(Ref) + + res=GmfSetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & Tab(1, 1) ,& + & Tab(1,Nmb) ,& + & dTab(1) ,& + & dTab(1) ,& + & Ref( 1) ,& + & Ref( Nmb) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetBlockF90_01 -contains + function GmfSetBlockF90_02(unit, GmfKey, ad0, ad1, Tab, Ref) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + real(real64) , intent(inout) :: Tab(:,:) + integer(int32), intent(inout) :: Ref( :) + integer(int32) :: res + !> + integer(int32) :: iTab(1) + integer(int32) :: Nmb + integer(int32), pointer :: map(:)=>null() + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + Nmb=ad1-ad0+1 + + print '("GmfSetBlockF90_02 (ad0,ad1)=(",i0,",",i0,") Nmb=",i0)',ad0,ad1,Nmb + print '("GmfSetBlockF90_02 size(Tab)=",i0,"x",i0)',size(Tab,1),size(Tab,2) + print '("GmfSetBlockF90_02 size(Ref)= ",i0)',size(Ref) + + res=GmfSetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & iTab(1) ,& + & iTab(1) ,& + & Tab(1, 1) ,& + & Tab(1,Nmb) ,& + & Ref( 1) ,& + & Ref( Nmb) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetBlockF90_02 + + function GmfSetBlockF90_02Bis(unit, GmfKey, ad0, ad1, Tab) result(res) + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + integer(int64), intent(in) :: unit + integer(int32), intent(in) :: GmfKey + integer(int32), intent(in) :: ad0 + integer(int32), intent(in) :: ad1 + real(real64) , intent(inout) :: Tab(:,:) + integer(int32) :: res + !> + integer(int32) :: Ref(1) + integer(int32) :: iTab(1) + integer(int32) :: Nmb + integer(int32), pointer :: map(:)=>null() + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + Nmb=ad1-ad0+1 + + print '("GmfSetBlockF90_02Bis (ad0,ad1)=(",i0,",",i0,") Nmb=",i0)',ad0,ad1,Nmb + print '("GmfSetBlockF90_02Bis size(Tab)=",i0,"x",i0)',size(Tab,1),size(Tab,2) + print '("GmfSetBlockF90_02Bis size(Ref)= ",i0)',size(Ref) -! subroutine GmfSetHONodesOrdering_f90(unit, GmfKey, BasOrd, FilOrd) -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! use, intrinsic :: iso_c_binding, only: c_loc,c_int,c_long,c_ptr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! integer(8), intent(in) :: unit -! integer(4), intent(in) :: GmfKey -! integer(4), intent(in), pointer :: BasOrd(:,:) -! integer(4), intent(in), pointer :: FilOrd(:,:) -! !> -! integer(c_int) :: iErr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! !> Broker -! iErr=GmfSetHONodesOrdering_c( & -! & InpMsh=int(unit,kind=c_long) ,& -! & GmfKey=int(GmfKey,kind=c_int) ,& -! & BasOrd=c_loc(BasOrd) ,& -! & FilOrd=c_loc(FilOrd) ) -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! -! return -! end subroutine GmfSetHONodesOrdering_f90 -! -! subroutine GmfOpenMesh_f90(unit, GmfKey, BasOrd, FilOrd) -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! use, intrinsic :: iso_c_binding, only: c_loc,c_int,c_long -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! integej1r(8), intent(in) :: unit -! !> -! integer(c_int) :: iErr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! !> Broker -! iErr=GmfOpenMesh_c(InpMsh=int(unit,kind=c_long) ) -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! return -! end subroutine GmfOpenMesh_f90 -! -! subroutine GmfCloseMesh_f90(unit, GmfKey, BasOrd, FilOrd) -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! use, intrinsic :: iso_c_binding, only: c_loc,c_int,c_long -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! integer(8), intent(in) :: unit -! !> -! integer(c_int) :: iErr -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! !> Broker -! iErr=GmfCloseMesh_c(InpMsh=int(unit,kind=c_long) ) -! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -! return -! end subroutine GmfCloseMesh_f90 - - - - -end module libmeshb7 + res=GmfSetBlockF77(unit ,& + & GmfKey ,& + & ad0 ,& + & ad1 ,& + & int32 ,& + & map ,& + & iTab( 1) ,& + & iTab( 1) ,& + & Tab(1, 1) ,& + & Tab(1,Nmb) ,& + & Ref( 1) ,& + & Ref( 1) ) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + return + end function GmfSetBlockF90_02Bis + +end module libmeshb7 \ No newline at end of file diff --git a/todolist.md b/todolist.md index 5a5305f..5b76c73 100644 --- a/todolist.md +++ b/todolist.md @@ -4,8 +4,8 @@ - Read and allocate the required ElementGID, then build the list of elements that do not belong to the local domain and return it to the caller. ### Distributed parallel write -- Open a mesh file in writing mode but only create the skeleton of the mesh structure to enable further concurrent write access. -- Open an existing mesh file in writing mode and enable concurrent block write thanks to the existing structure. +- Open a mesh file in write mode but only create the skeleton of the mesh structure to enable further concurrent write access. +- Open an existing mesh file in write mode and enable concurrent block writes, thanks to the existing file structure. ## STANDARD PRIORITY @@ -13,31 +13,23 @@ - Setup a keyword to store Pk elements. - Give along a routine to convert to and from well-known high-order numberings. -### Handle arbitrary degree polygons and polyhedra -- Add a helper that cuts a polyhedron through a plane and generates the intersection's triangulated mesh in an STL-like format. - ### Solution fields comments - Add a procedure that would search for a string among comments. - Input: keyword name, physical property, free comment, wildcards. - Output: list of solutions keywords and particular field number. -### Convert HO examples to Fortran -- test_libmeshb_HO.c -- test_libmeshb_p2_sol.c - -### Add F77 API to GmfSetHONodesOrdering -An easy one. - ### Add IHOSol* + DHOSol* for each element kinds, -for example +For example: + "IHOSolAtVertices", "i", "ii" // ii = degree + index in DSol + "DHOSolAtVertices", "i", "hr" // High Order solution ### Topological operations --Add a helper to build the list of inner or surface triangles from tetrahedra --Add a helper to build the list of unique edges from tetrahedra --Add a helper to get the face neighborhood between tets and triangles --Add a helper to get an edge's shell of triangles or tets +- Add a helper to build the list of inner or surface triangles from tetrahedra +- Add a helper to build the list of unique edges from tetrahedra +- Add a helper to get the face neighborhood between tets and triangles +- Add a helper to get an edge's shell of triangles or tets ### Documentation @@ -63,3 +55,7 @@ for example - Added a set of keywords for each kind of element that stores the number of vertices and their barycentric coordinates. - Added a section about the AIO mode (Asynchronous Input Output). - Added a helper that evaluates the quality of a mesh numbering in terms of efficient cache reuse and inner concurrency. +- Added F77 API to GmfSetHONodesOrdering +- Completely rewrote the whole Fortran API because GFortran dropped support for C variable argumeents procedure. +- H.O. tests converted to Fortran by Christophe Peyret +- Added a helper that cuts a polyhedron through a plane and generates the intersection's triangulated mesh in an STL-like format. diff --git a/whatsnew.md b/whatsnew.md index 1fb0960..dad7d3b 100644 --- a/whatsnew.md +++ b/whatsnew.md @@ -1,8 +1,6 @@ -## Release 7.62 +## Release 7.80 -1. Corrected two bugs: - - GmfOpenMesh: could crash with a stack overflow a present some security issues - - test\_libmeshb\_pipeline.f: the Fortran version of the user's procedure call was crashing - -2. New helpers functions system to easily add specific features related to the libMeshb: - - See the helper's [readme](utilities/libmeshb7_helpers.md) for more information about the new functions to handle polyhedral meshes. +1. Complete rewrite of the Fortran API: + - No more variable arguments procedures are used in Fortran as such feature is no more supported by gfortran. + - Line-based read and write go through three tables: one that stores all INTEGER4 values, one for REAL8 and an INTEGER4 scalar to store the reference. + - Block based access use the same data structures but each table is duplicated: one to store pointers to the first entities and the other one to store pointers to the last entities. This way, the procedure is able to compute the byte stride and store the mesh file data directly to or from the user's data structures. \ No newline at end of file