xmgredit5 and PGI compiler support

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 
+

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)

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();
 }
 
 /*