diff --git a/source_code/version2.2_windows/win_appl.f90 b/source_code/version2.2_windows/win_appl.f90 new file mode 100644 index 0000000000000000000000000000000000000000..8983052dc0a7206f20883435bf2e7f98ff3ae09e --- /dev/null +++ b/source_code/version2.2_windows/win_appl.f90 @@ -0,0 +1,153 @@ +!*****************************************************************! +!* *! +!* 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