Eine Neue Datei hochladen

source_code/version2.2_windows/win_appl.f90

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*                                                               *!
+!*    - topmenu_win:   calls the dialog windows					 *!
+!*					   controls the application flow	         *!
+!*                                                               *!
+!*   - control functions: start  - ok button control			 *!
+!*						  cancel - exits the application, cancel *!
+!*								   button						 *!
+!*                        stepback - back button control		 *!
+!*                                                               *!
+!*                  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 topmenu_win 
+
+USE dflogm
+
+INCLUDE '4C_dialogs.fd'
+
+TYPE (DIALOG)  dlg_main
+integer(4) retint
+
+	call InitMain(dlg_main)
+
+end subroutine topmenu_win
+
+!***************************************************************
+!****** Control Functions **************************************
+!***************************************************************
+SUBROUTINE Start ( dlg, id, callbacktype )
+
+use dflogm
+use dflib
+
+use data_simul
+use data_stand
+use flag_field
+
+
+implicit none
+
+type (dialog) dlg, dlg_default_dir
+integer id
+integer callbacktype
+integer retint
+
+include '4C_dialogs.fd'
+
+logical retlog, push_state
+character :: text = 'Simulation control file: '
+character :: text_mes = 'Measurement file: '
+integer id_ctr
+!Settings for FileOpen
+character*(*),parameter :: filter_spec = &
+						  "Simulation control files (*.sim)"C//"*.sim"C// &
+						"All Files (*)"C//"*"C//""C
+character(512) filename
+
+logical retdir
+	
+	! get the radio button before the dlg was closed
+	retlog = DlgGet( dlg, IDC_RADIO_start, push_state ) 
+	if (push_state) id_ctr = IDC_RADIO_start
+	
+	retlog = DlgGet( dlg, IDC_RADIO_edit, push_state ) 
+	if (push_state) id_ctr = IDC_RADIO_edit
+
+		! get the control file
+		call GetFileF (filename, filter_spec, text)
+        retdir = changedirqq (actdir)
+		simfile = filename
+		call readsim
+		call winPath
+		call outtest
+		print *, '----------------------------------'
+		print *, '---- Start simulation... ---------'	
+	    ! simulation
+		call sim_control
+        call deallofile
+		
+	if ( allocated(flagsave)) deallocate(flagsave)
+
+    print *, '4C end'
+ 
+END SUBROUTINE Start
+
+!*******************************************
+
+SUBROUTINE Cancel ( dlg, id, callbacktype )
+
+use dflogm
+
+use data_simul
+use data_stand
+
+implicit none
+type (dialog) dlg
+integer id
+integer callbacktype
+integer retint
+
+
+include '4C_dialogs.fd'
+
+logical retlog, push_state
+
+    ! supress compiler warnings for unreferenced arguments
+	integer local_id, local_callbacktype
+	local_id = id
+	local_callbacktype = callbacktype
+
+	select case(id)
+
+	case (ID_CANCEL_FLAGS) 
+		call DlgSetReturn(dlg, ID_CANCEL_FLAGS)
+		call DlgExit(dlg)
+
+	case (ID_CANCEL_FILES)
+		call DlgSetReturn(dlg, ID_CANCEL_FILES)
+		call DlgExit(dlg)
+
+	case (ID_CANCEL_IDS)
+		call DlgSetReturn(dlg, ID_CANCEL_IDS)
+		call DlgExit(dlg)
+
+	case (ID_CANCEL_OUTF)	
+		call DLGSetReturn(dlg ,ID_CANCEL_OUTF)
+		call DlgExit(dlg)
+
+	case (IDCANCEL)	
+		call DLGSetReturn(dlg ,IDCANCEL)
+		call DlgExit(dlg)
+	
+	case (IDSTOP)
+		print *, ''
+		print *, '---------------------------------------------'
+		stop ' -------Program terminated by the user.------'
+
+	end select
+
+END SUBROUTINE Cancel