!*****************************************************************! !* *! !* 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 !***************************************************************