From 3a77c8a93be75a4769992ba5e876fea36c365b60 Mon Sep 17 00:00:00 2001 From: Petra Lasch-Born <lasch@pik-potsdam.de> Date: Wed, 12 Dec 2018 16:54:29 +0100 Subject: [PATCH] Eine Neue Datei hochladen --- .../win_appl_help_functions.f90 | 92 +++++++++++++++++++ 1 file changed, 92 insertions(+) create mode 100644 source_code/version2.2_windows/win_appl_help_functions.f90 diff --git a/source_code/version2.2_windows/win_appl_help_functions.f90 b/source_code/version2.2_windows/win_appl_help_functions.f90 new file mode 100644 index 0000000..cf748fa --- /dev/null +++ b/source_code/version2.2_windows/win_appl_help_functions.f90 @@ -0,0 +1,92 @@ +!*****************************************************************! +!* *! +!* 4C (FORESEE) Simulation Model *! +!* *! +!* Subroutines for: *! +!* - windows shell - *! +!* *! +!* contains: *! +!* GetFile *! +!* GetFileF *! +!* *! +!* 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 GetFile ( filename, filter_spec, text ) + +use dflogm + +implicit none +integer id +logical ex +character(512):: filename +character(*) :: text + +!Settings for FileOpen +character*512 :: file_get +character*(*) :: filter_spec + +include '4C_dialogs.fd' + +logical retlog + + call FileOpen (filename, filter_spec) + inquire (File = filename, exist = ex) + if(ex .eqv. .true.) then + write(*,'(A,A)') ' Simulation control file: ', trim(filename) + else + filename = ' ' + endif + +END SUBROUTINE GetFile + +!*************************************************************** + +! needed for time_out in Open Existing File +SUBROUTINE GetFileF ( filename, filter_spec, text ) + +use dflogm + +implicit none + +integer id +logical ex +character(150) :: filename +character(*) :: text + +!Settings for FileOpen +character*512 :: file_get +character*(*) :: filter_spec + +include '4C_dialogs.fd' + +logical retlog +!logical retdir + + call FileOpen (file_get, filter_spec) + do + filename = file_get + ex = .true. + if(ex .eqv. .true.) then + write(*,'(A,A)') ' Simulation control file: ', trim(filename) + exit + else + write(*,'(A)') ' Simulation control file: ', trim(filename), ' not exists' + write(*,'(A)',advance='no') ' Try again' + PAUSE + call FileOpen (file_get, filter_spec) + cycle + endif + enddo + +END SUBROUTINE GetFileF + +!*************************************************************** -- GitLab