Skip to content

Commit

Permalink
Add files via upload
Browse files Browse the repository at this point in the history
  • Loading branch information
@3rav
3rav authored Jan 1, 2025
1 parent 81c705d commit 29e5fb3
Showing 1 changed file with 253 additions and 0 deletions.
253 changes: 253 additions & 0 deletions mingw-w64-calculix-ccx/ccx_dload.patch
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,253 @@
diff -urN src/dload.f src_dload/dload.f
--- src/dload.f 2024-08-05 19:13:20.699702200 +0200
+++ src_dload/dload.f 2024-06-17 03:56:16.000000000 +0200
@@ -1,6 +1,6 @@
!
! CalculiX - A 3-dimensional finite element program
-! Copyright (C) 1998-2024 Guido Dhondt
+! Copyright (C) 1998-2023 Guido Dhondt
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
@@ -105,168 +105,26 @@
!
real*8 f,time(2),coords(3),vold(0:mi(2),*),co(3,*),rho
!
+ integer ipompc(*),nodempc(3,*),nmpc,ikmpc(*),ilmpc(*)
+!
+ real*8 coefmpc(*),veold(0:mi(2),*)
+
!
!
! the code starting here up to the end of the file serves as
! an example for combined mechanical-lubrication problems.
! Please replace it by your own code for your concrete application.
!
- integer ifaceq(8,6),ifacet(6,4),ifacew(8,5),ig,nelem,nopes,
- & iflag,i,j,nope,ipompc(*),nodempc(3,*),nmpc,ikmpc(*),ilmpc(*),
- & node,idof,id
-!
- real*8 xl2(3,8),pres(8),xi,et,xsj2(3),xs2(3,7),shp2(7,8),
- & coefmpc(*),veold(0:mi(2),*)
-!
- include "gauss.f"
-!
- ifaceq=reshape((/4,3,2,1,11,10,9,12,
- & 5,6,7,8,13,14,15,16,
- & 1,2,6,5,9,18,13,17,
- & 2,3,7,6,10,19,14,18,
- & 3,4,8,7,11,20,15,19,
- & 4,1,5,8,12,17,16,20/),(/8,6/))
- ifacet=reshape((/1,3,2,7,6,5,
- & 1,2,4,5,9,8,
- & 2,3,4,6,10,9,
- & 1,4,3,8,10,7/),(/6,4/))
- ifacew=reshape((/1,3,2,9,8,7,0,0,
- & 4,5,6,10,11,12,0,0,
- & 1,2,5,4,7,14,10,13,
- & 2,3,6,5,8,15,11,14,
- & 4,6,3,1,12,15,9,13/),(/8,5/))
- iflag=2
-!
- nelem=noel
- ig=jltyp-20
-!
- if(lakonl(4:4).eq.'2') then
- nope=20
- nopes=8
- elseif(lakonl(4:4).eq.'8') then
- nope=8
- nopes=4
- elseif(lakonl(4:5).eq.'10') then
- nope=10
- nopes=6
- elseif(lakonl(4:4).eq.'4') then
- nope=4
- nopes=3
- elseif(lakonl(4:5).eq.'15') then
- nope=15
- elseif(lakonl(4:4).eq.'6') then
- nope=6
- endif
-!
-! treatment of wedge faces
-!
- if(lakonl(4:4).eq.'6') then
- if(ig.le.2) then
- nopes=3
- else
- nopes=4
- endif
- endif
- if(lakonl(4:5).eq.'15') then
- if(ig.le.2) then
- nopes=6
- else
- nopes=8
- endif
- endif
-!
- do i=1,nopes
- do j=1,3
- xl2(j,i)=0.d0
- enddo
- enddo
-!
- if((nope.eq.20).or.(nope.eq.8)) then
- do i=1,nopes
- node=konl(ifaceq(i,ig))
- idof=8*(node-1)
- call nident(ikmpc,idof,nmpc,id)
- if((id.eq.0).or.(ikmpc(id).ne.idof)) then
- write(*,*) '*ERROR in dload: node ',node
- write(*,*) ' is not connected to the oil film'
- call exit(201)
- endif
- node=nodempc(1,nodempc(3,ipompc(ilmpc(id))))
- pres(i)=vold(0,node)
- enddo
- elseif((nope.eq.10).or.(nope.eq.4)) then
- do i=1,nopes
- node=konl(ifacet(i,ig))
- node=konl(ifaceq(i,ig))
- idof=8*(node-1)
- call nident(ikmpc,idof,nmpc,id)
- if((id.eq.0).or.(ikmpc(id).ne.idof)) then
- write(*,*) '*ERROR in dload: node ',node
- write(*,*) ' is not connected to the oil film'
- call exit(201)
- endif
- node=nodempc(1,nodempc(3,ipompc(ilmpc(id))))
- pres(i)=vold(0,node)
- enddo
- else
- do i=1,nopes
- node=konl(ifacew(i,ig))
- node=konl(ifaceq(i,ig))
- idof=8*(node-1)
- call nident(ikmpc,idof,nmpc,id)
- if((id.eq.0).or.(ikmpc(id).ne.idof)) then
- write(*,*) '*ERROR in dload: node ',node
- write(*,*) ' is not connected to the oil film'
- call exit(201)
- endif
- node=nodempc(1,nodempc(3,ipompc(ilmpc(id))))
- pres(i)=vold(0,node)
- enddo
- endif
-!
- i=npt
-!
- if((lakonl(4:5).eq.'8R').or.
- & ((lakonl(4:4).eq.'6').and.(nopes.eq.4))) then
- xi=gauss2d1(1,i)
- et=gauss2d1(2,i)
- elseif((lakonl(4:4).eq.'8').or.
- & (lakonl(4:6).eq.'20R').or.
- & ((lakonl(4:5).eq.'15').and.(nopes.eq.8))) then
- xi=gauss2d2(1,i)
- et=gauss2d2(2,i)
- elseif(lakonl(4:4).eq.'2') then
- xi=gauss2d3(1,i)
- et=gauss2d3(2,i)
- elseif((lakonl(4:5).eq.'10').or.
- & ((lakonl(4:5).eq.'15').and.(nopes.eq.6))) then
- xi=gauss2d5(1,i)
- et=gauss2d5(2,i)
- elseif((lakonl(4:4).eq.'4').or.
- & ((lakonl(4:4).eq.'6').and.(nopes.eq.3))) then
- xi=gauss2d4(1,i)
- et=gauss2d4(2,i)
- endif
-!
- if(nopes.eq.8) then
- call shape8q(xi,et,xl2,xsj2,xs2,shp2,iflag)
- elseif(nopes.eq.4) then
- call shape4q(xi,et,xl2,xsj2,xs2,shp2,iflag)
- elseif(nopes.eq.6) then
- call shape6tri(xi,et,xl2,xsj2,xs2,shp2,iflag)
- else
- call shape3tri(xi,et,xl2,xsj2,xs2,shp2,iflag)
- endif
-!
-! determining the pressure
-!
- f=0.d0
- do j=1,nopes
- f=f+pres(j)*shp2(4,j)
- enddo
-!
- iscale=0
-!
+
+ if (loadtype(5:5).eq.'@') then
+
+ call ext_dload(f,kstep,kinc,time,noel,npt,layer,kspt,
+ & coords,jltyp,loadtype,vold,co,lakonl,konl,
+ & ipompc,nodempc,coefmpc,nmpc,ikmpc,ilmpc,iscale,veold,
+ & rho,amat,mi)
+
+ endif
+
return
end

diff -urN src/ext_dload.c src_dload/ext_dload.c
--- src/ext_dload.c 1970-01-01 01:00:00.000000000 +0100
+++ src_dload/ext_dload.c 2024-06-17 03:56:16.000000000 +0200
@@ -0,0 +1,55 @@
+#include <stdio.h>
+#include <windows.h>
+
+
+void (*fortran_function)( double * const, const int *, const int *, const double * const , const int *, const int *, const int *,const int *,
+ const double * const , const int *, const char * const , const double * const , const double * const , const char * const ,
+ const int * const , const int *, const int * const , const double * const , const int *,const int *, const int *,
+ int * const ,const double * const , const double *, const char * const , const int * const );
+
+
+void ext_dload_( double * const f, const int * kstep, const int *kinc, const double * const time, const int *noel, const int *npt, const int *layer,const int *kspt,
+ const double * const coords, const int *jltyp, const char * const loadtype, const double * const vold, const double * const co, const char * const lakonl,
+ const int * const konl, const int *ipompc, const int * const nodempc, const double * const coefmpc, const int *nmpc,const int *ikmpc, const int *ilmpc,
+ int* const iscale,const double * const veold, const double *rho, const char * const amat, const int * const mi) {
+ HINSTANCE lib_handle;
+ char *addsign = strrchr(loadtype, '@');
+ addsign++;
+ for (int i = 0; addsign[i] != '\0'; i++){
+ if(isspace(addsign[i])){
+ addsign[i] = '\0';
+ }
+ }
+ char *cpy = malloc((strlen(addsign) + 4) * sizeof(char));
+ strcpy(cpy, addsign);
+ strcat(cpy, ".dll");
+
+ // Load the Fortran DLL
+ lib_handle = LoadLibrary(cpy);
+ if (!lib_handle) {
+ printf("Error: Unable to load ");
+ printf(cpy);
+ printf("!\n");
+ exit(-1);
+ }
+ free(cpy);
+
+ // Get the function pointer
+ fortran_function = (void (*)())GetProcAddress(lib_handle, "dload_");
+ if (!fortran_function) {
+ printf("Error: Unable to locate function dload in DLL\n");
+ FreeLibrary(lib_handle);
+ exit(-1);
+ }
+
+ // Call the Fortran subroutine
+ (*fortran_function)(f, kstep, kinc, time, noel, npt, layer, kspt,
+ coords, jltyp, loadtype, vold, co, lakonl, konl,
+ ipompc, nodempc, coefmpc, nmpc, ikmpc, ilmpc,
+ iscale, veold, rho, amat, mi);
+
+ // Close the DLL
+ FreeLibrary(lib_handle);
+}
+
+

0 comments on commit 29e5fb3

Please sign in to comment.