From 318ae31d40cebcd4245057ca89f6783487d907eb Mon Sep 17 00:00:00 2001
From: Petra Lasch-Born <lasch@pik-potsdam.de>
Date: Wed, 12 Dec 2018 16:56:56 +0100
Subject: [PATCH] Eine Neue Datei hochladen
---
.../version2.2_windows/getopenfilename.f90 | 92 +++++++++++++++++++
1 file changed, 92 insertions(+)
create mode 100644 source_code/version2.2_windows/getopenfilename.f90
diff --git a/source_code/version2.2_windows/getopenfilename.f90 b/source_code/version2.2_windows/getopenfilename.f90
new file mode 100644
index 0000000..0dbacf7
--- /dev/null
+++ b/source_code/version2.2_windows/getopenfilename.f90
@@ -0,0 +1,92 @@
+!*****************************************************************!
+!* *!
+!* 4C (FORESEE) Simulation Model *!
+!* *!
+!* *!
+!* Subroutines for: *!
+!* - windows shell - *!
+!* *!
+!* contains: *!
+!* FileOpen *!
+!* *!
+!* Copyright (C) 1996-2018 *!
+!* Potsdam Institute for Climate Impact Reserach (PIK) *!
+!* Authors and contributors see AUTHOR file *!
+!* This file is part of 4C and is licensed under BSD-2-Clause *!
+!* See LICENSE file or under: *!
+!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
+!* Contact: *!
+!* https://gitlab.pik-potsdam.de/XXXXXXXXXXXXXXXXXXXXX *!
+!* *!
+!*****************************************************************!
+
+Subroutine FileOpen (file_spec, filter_spec)
+
+! Following example of calling the Win32 API routine GetOpenFileName
+
+use comdlg32
+!use dflib ! In case QuickWin is used
+implicit none
+
+! Declare structure used to pass and receive attributes
+!
+type(T_OPENFILENAME) ofn
+
+! Declare filter specification. This is a concatenation of
+! pairs of null-terminated strings. The first string in each pair
+! is the file type name, the second is a semicolon-separated list
+! of file types for the given name. The list ends with a trailing
+! null-terminated empty string.
+!
+character*(*) :: filter_spec
+
+! Declare string variable to return the file specification.
+! Initialize with an initial filespec, if any - null string
+! otherwise
+
+character*512 :: file_spec
+integer status,ilen
+ofn%lStructSize = SIZEOF(ofn)
+ofn%hwndOwner = NULL ! For non-console applications,
+ ! set this to the Hwnd of the
+ ! Owner window. For QuickWin
+ ! and Standard Graphics projects,
+ ! use GETHWNDQQ(QWIN$FRAMEWINDOW)
+ !
+ofn%hInstance = NULL ! For Win32 applications, you
+ ! can set this to the appropriate
+ ! hInstance
+ !
+ofn%lpstrFilter = loc(filter_spec)
+ofn%lpstrCustomFilter = NULL
+ofn%nMaxCustFilter = 0
+ofn%nFilterIndex = 1 ! Specifies initial filter value
+ofn%lpstrFile = loc(file_spec)
+ofn%nMaxFile = sizeof(file_spec)
+ofn%nMaxFileTitle = 0
+ofn%lpstrInitialDir = NULL ! Use Windows default directory
+ofn%lpstrTitle = loc(""C)
+ofn%Flags = OFN_PATHMUSTEXIST
+ofn%lpstrDefExt = loc("txt"C)
+ofn%lpfnHook = NULL
+ofn%lpTemplateName = NULL
+
+! Call GetOpenFileName and check status
+do
+ status = GetOpenFileName(ofn)
+ if (status .eq. 0) then
+ write(*,'(A)',advance='no') ' No file name specified'
+ write(*,'(A)',advance='no') ' Program aborted'
+ PAUSE
+ STOP
+
+ else
+ ! Get length of file_spec by looking for trailing NUL
+ ilen = INDEX(file_spec,CHAR(0))
+
+ exit
+ end if
+enddo
+
+end Subroutine fileopen
+
--
GitLab