! ! Contains: ! ! Module Stuff ! Subroutines: ! ThreadDlg ! OnThreadEnd ! Functions: ! Worker ! ! Thread used in Overlaying Global Grid ! MODULE STUFF integer hThread logical bStopped integer MaxRange integer iprogress END MODULE STUFF ! subroutine ThreadDlg USE DFWIN USE DFLOGM USE GLOBAL USE STUFF IMPLICIT NONE INTEGER:: iDummy TYPE (DIALOG):: Dlg ! SECURITY_ATTRIBUTES type, defined in DFMT.F90 TYPE (T_SECURITY_ATTRIBUTES),POINTER:: NULL_SA INTEGER:: idThread INTERFACE INTEGER(4) FUNCTION Worker(h) !DEC$ATTRIBUTES STDCALL:: Worker INTEGER h END FUNCTION END INTERFACE INCLUDE "Resource.fd" iDummy=DlgInit(IDD_DIALOG1, Dlg) iDummy=DlgSet(Dlg,IDC_PROGRESS,0,DLG_RANGEMIN) ! division: 210 ; NUMEL: 20*(4**nslice) MaxRange = 210 + 20*(4**nslice) iDummy=DlgSet(Dlg,IDC_PROGRESS,MaxRange,DLG_RANGEMAX) iDummy=DlgSet(Dlg,IDC_PROGRESS,0) hThread = CreateThread(NULL_SA, 0, LOC(Worker), LOC(Dlg), 0, LOC(idThread)) iDummy = DlgSet(Dlg, IDC_OK, .false., DLG_ENABLE) iDummy=DlgModal(Dlg) CALL DlgUnInit(Dlg) end subroutine ThreadDlg INTEGER(4) FUNCTION Worker(Dlg) !DEC$ATTRIBUTES STDCALL:: Worker !DEC$ATTRIBUTES REFERENCE:: Dlg USE DFLOGM USE DFWIN USE ICOSAHEDRON USE GLOBAL TYPE(DIALOG):: Dlg include "resource.fd" !--------------------------------------------------------------- INTEGER :: m_slice ! copy of n_slice, allowing it to be changed (counted-down) INTEGER :: facets_done, i, j, k INTEGER, DIMENSION(3) :: node_number REAL, DIMENSION(3) :: rx, ry, rz DOUBLE PRECISION, PARAMETER :: s = 1.107148719D0 DOUBLE PRECISION :: dot1, dot2, dot3, x1, x2, x3, y1, y2, y3, z1, z2, z3 DOUBLE PRECISION, DIMENSION(12) :: lat, lon DOUBLE PRECISION, DIMENSION(3) :: v1, v2, v3 DOUBLE PRECISION, DIMENSION(3, 12) :: abg !Cartesian (alpha, beta, gamma) coordinates of these vertices. !--------------------------------------------------------------- integer iprogress iprogress = 0 !--------------------------------------------------------------- !generate basic form with a vertex (a 5-fold axis) up; highest symmetry axis lat(1) = 1.570796327D0 lon(1) = 0.0D0 DO i = 2, 6 lat(i) = lat(1) - s lon(i) = (i - 2.0D0) * 1.256637061D0 END DO DO i = 7, 11 lat(i) = -lat(1) + s lon(i) = (i - 7.0D0) * 1.256637061D0 + .628318531D0 END DO lat(12) = -lat(1) lon(12) = 0.0D0 DO i = 1, 12 abg(1, i) = COS(lat(i)) * COS(lon(i)) abg(2, i) = COS(lat(i)) * SIN(lon(i)) abg(3, i) = SIN(lat(i)) END DO !------------------------------------------------------- !create output file for dumping results as they are found: OPEN (UNIT = 729, FILE = "Icosahedron.tmp", FORM = "UNFORMATTED") ! unconditional; overwrites any existing file !------------------------------------------------------- !find all 20 faces and subdivide each into four spherical triangles; ! WRITE (*, "(' Creating global grid by level-',I1,' subdivision of icosahedron facets:')") n_slice ! WRITE (*, *) ! advance, because next WRITE will not m_slice = nslice facets_done = 0 DO i = 1, 10 DO j = (i + 1), 11 DO k = (j + 1), 12 dot1 = abg(1, i) * abg(1, j) + abg(2, i) * abg(2, j) + abg(3, i) * abg(3, j) dot2 = abg(1, j) * abg(1, k) + abg(2, j) * abg(2, k) + abg(3, j) * abg(3, k) dot3 = abg(1, k) * abg(1, i) + abg(2, k) * abg(2, i) + abg(3, k) * abg(3, i) IF ((dot1 > 0.3D0) .AND. (dot2 > 0.3D0) .AND. (dot3 > 0.3D0)) THEN x1 = abg(1, i) x2 = abg(1, j) x3 = abg(1, k) y1 = abg(2, i) y2 = abg(2, j) y3 = abg(2, k) z1 = abg(3, i) z2 = abg(3, j) z3 = abg(3, k) !Note: Divide will call itself, recursively. !Therefore, all inputs are simple numbers (not vectors), !to go on stack as values, not addresses. !Also, note that output is sent to a temporary file, to avoid multiple copies on stack! CALL Divide(x1, y1, z1, x2, y2, z2, x3, y3, z3, m_slice) ! using copy m_slice = n_slice facets_done = facets_done + 1 ! WRITE (*, "('+',I8,' facets out of 20 divided into elements')") facets_done iprogress = iprogress + facets_done iDummy = DlgSet(Dlg,IDC_PROGRESS,iprogress, DLG_POSITION) ! Commented out to be compatible with DVF 6.0 ! CALL DLGFLUSH(DLG) END IF END DO END DO END DO !----------------------------------------------------------------------- !read binary file, extracting groups of 3 uvecs, and assigning to lists: CLOSE (UNIT = 729) OPEN (UNIT = 729, FILE = "Icosahedron.tmp", STATUS = "OLD", FORM = "UNFORMATTED") numnod = 0 !initialization IF (nslice == 0) THEN numel = 20 ELSE numel = 20 * (4**nslice) END IF ! WRITE (*, *) ! advance, because next WRITE will not DO i = 1, numel READ (729) rx(1), ry(1), rz(1), rx(2), ry(2), rz(2), rx(3), ry(3), rz(3) DO j = 1, 3 node_number(j) = 0 ! initialization k_loop: DO k = 1, numnod IF (rx(j) == nodeABG(1, k)) THEN IF (ry(j) == nodeABG(2, k)) THEN IF (rz(j) == nodeABG(3, k)) THEN !this node is already defined node_number(j) = k EXIT k_loop END IF END IF END IF END DO k_loop ! k = 1, numnod IF (node_number(j) == 0) THEN !no match was found; define a new node numnod = numnod + 1 node_number(j) = numnod nodeABG(1, numnod) = rx(j) nodeABG(2, numnod) = ry(j) nodeABG(3, numnod) = rz(j) END IF !record this element nodes(1:3, i) = node_number(1:3) END DO ! j = 1, 3 IF (MOD(i, 100) == 0) THEN ! WRITE (*, "('+',I8,' elements out of ',I8,' scanned for new nodes')") i, numel END IF iprogress = iprogress + 1 iDummy = DlgSet(Dlg,IDC_PROGRESS,iprogress, DLG_POSITION) ! Commented out to be compatible with DVF 6.0 ! CALL DLGFLUSH(DLG) END DO ! i = 1, numel ! WRITE (*, "('+',I8,' elements out of ',I8,' scanned for new nodes')") numel, numel ! CLOSE (UNIT = 729, STATUS = "DELETE") CLOSE (UNIT = 729) ! Initialize new array if(allocated(EQCM)) then do i = 1, NUMNOD EQCM(1:6, i) = 0. enddo endif Worker = 1 CALL OnThreadEnd(Dlg) END FUNCTION Worker !--------------------------------------------------- !Called when the thread is about to end in order to !reenable controls !--------------------------------------------------- SUBROUTINE OnThreadEnd(Dlg) USE DFLOGM USE DFWIN USE STUFF TYPE(DIALOG):: Dlg INCLUDE "Resource.fd" iDummy = DlgSet(Dlg, IDC_OK, .TRUE., DLG_ENABLE) iDummy = CloseHandle(hThread) END SUBROUTINE OnThreadEnd