Eine Neue Datei hochladen

source_code/version2.2_windows/win_appl_help_functions.f90

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