From 836f2e9e23bac42f3c083b14f06c9d37de5e983c Mon Sep 17 00:00:00 2001 From: miaocb Date: Tue, 3 Mar 2020 10:13:25 +0800 Subject: [PATCH 1/2] add the ability to remove last open/land boundary segment in xmgredit5 --- src/Utility/ACE/xmgredit5/bcwin.c | 48 ++++++++++++++++++++++++++++--- 1 file changed, 44 insertions(+), 4 deletions(-) diff --git a/src/Utility/ACE/xmgredit5/bcwin.c b/src/Utility/ACE/xmgredit5/bcwin.c index 5062f4804..9e34f519f 100644 --- a/src/Utility/ACE/xmgredit5/bcwin.c +++ b/src/Utility/ACE/xmgredit5/bcwin.c @@ -38,7 +38,9 @@ int check_boundary_overlap(int gridno); void accept_adcircbound(Widget w, XtPointer cd); void adcirc_defineland_proc(void); void adcirc_defineopen_proc(void); -void adcirc_deleteopen_proc(void); +void adcirc_removeland_proc(void); +void adcirc_removeopen_proc(void); +void adcirc_clearall_proc(void); void create_adcircbound_frame(void); void define_adcirc_landb(int gridno, int ind1, int ind2); void define_adcirc_openb(int gridno, int ind1, int ind2); @@ -79,11 +81,23 @@ void create_adcircbound_frame(void) XtAddCallback(wbut, XmNactivateCallback, (XtCallbackProc) adcirc_defineland_proc, (XtPointer) NULL); + wbut = + XtVaCreateManagedWidget("Remove last open boundary segment", + xmPushButtonWidgetClass, rc2, NULL); + XtAddCallback(wbut, XmNactivateCallback, + (XtCallbackProc) adcirc_removeopen_proc, + (XtPointer) NULL); + wbut = + XtVaCreateManagedWidget("Remove last land boundary segment", + xmPushButtonWidgetClass, rc2, NULL); + XtAddCallback(wbut, XmNactivateCallback, + (XtCallbackProc) adcirc_removeland_proc, + (XtPointer) NULL); wbut = XtVaCreateManagedWidget("Clear all", xmPushButtonWidgetClass, rc2, NULL); XtAddCallback(wbut, XmNactivateCallback, - (XtCallbackProc) adcirc_deleteopen_proc, + (XtCallbackProc) adcirc_clearall_proc, (XtPointer) NULL); wbut = XtVaCreateManagedWidget("Write open/land boundary segments", @@ -122,6 +136,18 @@ void adcirc_defineopen_proc(void) set_action(OPENB1ST); } +/* + * remove last open boundary +*/ +void adcirc_removeopen_proc(void) +{ + set_action(0); + if (nopenb > 0) + { + nopenb--; + do_drawgrid(); + } +} /* * select land boundary */ @@ -131,13 +157,27 @@ void adcirc_defineland_proc(void) set_action(LANDB1ST); } + +/* + * remove last land boundary +*/ +void adcirc_removeland_proc(void) +{ + set_action(0); + if (nlandb > 0) + { + nlandb--; + do_drawgrid(); + } +} /* - * delete open boundary + * clear all open and land boundary */ -void adcirc_deleteopen_proc(void) +void adcirc_clearall_proc(void) { nopenb = 0; nlandb = 0; + do_drawgrid(); } /* From a541eb9d1ecd83b0d02e7a80a668074b1f5db9de Mon Sep 17 00:00:00 2001 From: miaocb Date: Tue, 3 Mar 2020 10:56:07 +0800 Subject: [PATCH 2/2] Add support for PGI compiler --- mk/Make.defs.pgi | 95 +++++++++++++++++++++++++++++++++++++++ src/Core/misc_modules.F90 | 21 ++++----- 2 files changed, 106 insertions(+), 10 deletions(-) create mode 100644 mk/Make.defs.pgi diff --git a/mk/Make.defs.pgi b/mk/Make.defs.pgi new file mode 100644 index 000000000..1c8bc42f4 --- /dev/null +++ b/mk/Make.defs.pgi @@ -0,0 +1,95 @@ +################################################################################ +# Parallel SCHISM Makefile +# +# User makes environment settings for particular OS / PLATFORM / COMPILER / MPI +# below as well as setting flags having to do with included algorithms (e.g. sediment) +# and the compiler configuration (debug, timing). +# +# The environment settings are based on the following options. +# +# Compiler name: +# FCS: Serial compiler (for utilities) +# FCP: Parallel compiler +# FLD: Linker (in general same as parallel compiler) +# +# Compilation flags +# FCSFLAGS: Flags for serial compilation +# FCPFLAGS: Flags for parallel compilation (including all pre-processing flags) +# FLDFLAGS: Flags for linker (e.g., -O2) +# +# Preprocessor flags: +# DEBUG: Enable debugging code +# ORDERED_SUM: Enable globally ordered sums & dot-products for bit reproducibility +# of state quantities independent of number of processors (note: this can +# significantly degrade performance); +# INCLUDE_TIMING: Enable wallclock timing of code (note: this can have slight +# effect on performance); +# MPI_VERSION = 1 or 2: Version of MPI (try 2 first, if compile fails due to mpi +# related errors then switch to version 1; +# +# Libraries (needed for parallel code) +# MTSLIBS: Flags for linking ParMeTiS/MeTiS libaries +################################################################################ + +################################################################################ +## Sciclone/Bora (Broadwell) +################################################################################ +ENV = pgi + +################################################################################ +# Alternate executable name if you do not want the default. +################################################################################ +EXEC := pschism_$(ENV) + +################################################################################ +# Environment +################################################################################ + +FCP = mpif90 +FCS = pgfortran +FLD = $(FCP) +# MPI vserion (1 or 2) +PPFLAGS := $(PPFLAGS) -DMPIVERSION=2 #-DUSE_WRAP + +#Pure MPI +FCPFLAGS = $(PPFLAGS) -O -mcmodel=medium #-assume byterecl +FLDFLAGS = -O -mcmodel=medium #for final linking of object files + +#Hybrid +#FCPFLAGS = $(PPFLAGS) -O2 -mcmodel=medium -assume byterecl -ipo -axCORE-AVX2 -xSSE4.2 -qopenmp +#FLDFLAGS = -O2 -mcmodel=medium -ipo -axCORE-AVX2 -xSSE4.2 -qopenmp +#EXEC := $(EXEC)_OMP + +#####Libraries +##MTSLIBS = -L/share/apps/ParMetis-3.1-Sep2010/ -lparmetis -lmetis +MTSLIBS = -L./ParMetis-3.1-Sep2010/ -lparmetis -lmetis +CDFLIBS = -L$(NETCDF)/lib -lnetcdf -lnetcdff +CDFMOD = -I$(NETCDF)/include # modules for netcdf + + +################################################################################ +# Algorithm preference flags. +# Comment out unwanted modules and flags. +################################################################################ + +# -DSCHISM is always on and is defined elsewhere + +include ../mk/include_modules + +# Don't comment out the follow ifdef +ifdef USE_GOTM + GTMMOD = -I/sciclone/home10/yinglong/SCHISM/svn/trunk/src/GOTM3.2.5/modules/IFORT/ #modules + GTMLIBS = -L/sciclone/home10/yinglong/SCHISM/svn/trunk/src/GOTM3.2.5/lib/IFORT/ -lturbulence_prod -lutil_prod +else + GTMMOD = + GTMLIBS = +endif + + +######### Specialty compiler flags and workarounds +# Add -DNO_TR_15581 like below for allocatable array problem in sflux_subs.F90 +# PPFLAGS := $(PPFLAGS) -DNO_TR_15581 + +# Obsolete flags: use USE_WRAP flag to avoid problems in ParMetis lib (calling C from FORTRAN) +# PPFLAGS := $(PPFLAGS) -DUSE_WRAP + diff --git a/src/Core/misc_modules.F90 b/src/Core/misc_modules.F90 index 69d078a1a..447f1b3dc 100644 --- a/src/Core/misc_modules.F90 +++ b/src/Core/misc_modules.F90 @@ -65,11 +65,11 @@ subroutine get_param(fname,varname,vartype,ivarvalue,varvalue1,varvalue2,ndim1,i real(rkind),intent(out) :: varvalue1 character(len=2),intent(out) :: varvalue2 integer,optional,intent(in) :: ndim1 - integer,optional,intent(out) :: iarr1(10000) - real(rkind),optional,intent(out) :: arr1(10000) + integer,optional,intent(out) :: iarr1(:) + real(rkind),optional,intent(out) :: arr1(:) character(len=300) :: line_str,str_tmp,str_tmp2 - integer :: lstr_tmp,lstr_tmp2,line,len_str,loc,loc2 + integer :: lstr_tmp,lstr_tmp2,line,len_str,loc,loc2,ndim str_tmp2=adjustl(varname) lstr_tmp2=len_trim(str_tmp2) @@ -121,18 +121,19 @@ subroutine get_param(fname,varname,vartype,ivarvalue,varvalue1,varvalue2,ndim1,i if(myrank==0) write(99,*)varname,' = ',real(varvalue1) #endif else !arrays - if(.not.present(ndim1)) call parallel_abort('get_param: ndim1 not found') - if(ndim1>10000) call parallel_abort('get_param: ndim1>10000') -!' + if(present(ndim1)) then + ndim = ndim1 + else + ndim = 0 + call parallel_abort('get_param: ndim1 not found') + endif if(vartype==3) then !integer array if(.not.present(iarr1)) call parallel_abort('get_param: iarr1 not found') -!' - read(str_tmp2,*)iarr1(1:ndim1) + read(str_tmp2,*)iarr1(1:ndim) else if(vartype==4) then !double array if(.not.present(arr1)) call parallel_abort('get_param: arr1 not found') -!' - read(str_tmp2,*)arr1(1:ndim1) + read(str_tmp2,*)arr1(1:ndim) else write(errmsg,*)'get_param: unknown type:',vartype call parallel_abort(errmsg)